AssemblerU.pas

unit AssemblerU;
{
This is the main unit for assembling code.

It loads instruction set information from textfiles into SymbolConvertions and Opcode.
This information is then used during the assembling process to determine what
machine code corresponds to assembly code.

The textfiles contain binary strings.  The machine codes are generated by adding
these strings together.  There are examples in the instruction set file to help
illustrate this.

The instruction set files contain symbols which also include registers.  These
are used for operands.  There are a few "symbols" that are defined in this program.

for example, i8, i16, mem8, mem16

future changes
- add support for EQU operator.(similar to #DEFINE in c or const in Delphi)
ie. CR        EQU   0Dh
    DOLLAR    EQU   '$'
- support for includes
ie. include SE.ASM
- proc declarations
ie. Textln PROC

Addressing modes still need to be supported.
Here are some sites with information on this.
http://www.cs.tut.fi/~siponen/upros/intel/intel_addr.html


}

{$define WeAreDebugging}

// leave out this directive to prevent certain error finding code from being used

interface
uses classes,windows;
  type
        // ---------------------------------------------------------------------
        SymbolConvertion = record
           Symbol: string;
           // contains a symbol ie. 'ax', 'cx', 'cl'...
           Binary: string; // contains the binary number the symbol is converted to
        end;
        InstructionSetID = record
           FileName: string;
           Colour: integer;
        end;
        MyOperand = record
           operandDef: integer;
           NoMachineCode: boolean; // true only when the operand does not add any binary to the machine code
           { some instructions only accept 1 register. for example "xor ax, 0030h"
            for that instruction the opcode and the immediate value are the only
            things affecting the machine code and the register is already known
            since no other registers can use them
           }
           Name: string; // ie. 'reg8', 'reg16', 'stck'(floating stack)...
        end;
        MyAttribute = record
            name: string; // name of the property
            offset: integer; // number of bytes offset into the struct
        end;
        MyStruct = record
           name: string; // the name of the structure
           attribute: array of MyAttribute; // attributes of the structure
        end;
        MyOpcode = record
                 Processor: string;
                 // stores the version of processor, the instruction was first used in
                 // ie. '80186' for push i8 and push i16
                 opcode: string; // ie. 'mov', 'lea', 'pop'...
                 Operand1: MyOperand;
                 operand2: MyOperand; // ie. 'i8', 'reg8', reg16'...
                 operand3: MyOperand; // rarely used
                 OpcodeInBinary: string; // ie. '10110'
                 Colour: integer;
                 typeID: byte; // identifies the type of instruction it is.
                 {
                   optDefault is NormOpcode
                   optPref is for prefixes
                 }
                 ModeDefined: boolean; // true when the location of the addressing mode bits is defined
                 MachAfterMode: string; // machine code bits placed to the right
                 // of the addressing mode in the instruction
                 DIASMOnly: boolean; // true when the instruction is only to be used for disassembling purposes.
                 // This means there is another instruction that is more efficient.
                 asmonly: boolean; // for instructions that are not to be disassembled(this means the identical machine code is used for another assembly statement)
                 RevMachOperand: boolean; // true if the machine code for the operands is reversed.
                 // if true, the machine code for the first operand that you see in the the assembly statement, goes after the machine code of the second operand.
                 branch: boolean; // indicates that the instruction does or can change the IP value
                 // jumps and calls would be such instructions.
                 // This is used when disassembling programs so the disassembler can branch just like the processor does
                 StopDiasm: boolean;
                 { when an instruction with this set to true is found, the
                 disassembler will stop.  Data after this instruction will be made into a hex dump}
        end;
        MyDefine = record
            name: string; // ie. 'reg8'
            values: array of string; // ie. ('al','bl','cl','dl','ah','bh','ch','dh')
        end;
        MyCodeLabel = record
            name: string; // name of the label
            StaticAddress16: integer;
            // The address of a label relative to the start of the program.
            // With COM programs this is the lower 16 bit value of the RAM address
        end;
        // ---------------------------------------------------------------------
        tDebugOutput = class

           private
                 pTextFile: Textfile;
                 pFileAssigned: boolean;
                 pOutputToGUI: boolean;
                 pFileName: string;
                 function GetOutputToGUI: boolean;
                 procedure SetOutputToGUI(NewVal: boolean);
                 function GetFileSet: boolean;
                 function GetFileName: string;
                 procedure SetFileName(NewFN: string);
           public
                 procedure Output(s: string);
                 procedure AssignF(fn: string); overload;
                 procedure AssignF; overload;
                 procedure CloseF;
                 constructor Create;
                 property FileName: string read GetFileName write SetFileName;
                 property FileSet: boolean read GetFileSet;
                 property OutputToGUI: boolean read GetOutputToGUI write SetOutputToGUI;
        end;
        // -------------------------------------------
        procedure FreeAssemblerU;
        procedure LoadInstructionSet(FileName: string);
        function AssembleTStringsToFile(code: TStrings; COMFileName: string): string;
        function AssembleSourceFileToProgramFile(SourceFileName,COMFileName: string): string;
        function ExecuteFile(FileName, DefaultDir: string): HWND;
        function MakeHTMLOpcodeTable(fn: string): string;
        function MakeSourceCodeHTMLDocument(code: TStrings;fn,Title: string): string;
        procedure DisassembleCOMProgram(Code: TStrings; COMFN: string);
        procedure InitializeAssemblerU;
        function ReferenceToBinary(OpDefine: string; MemRef: string;ShowDebug: boolean;var mode: byte; var error: boolean;var prefix: string): string;
        procedure DisassembleEXEProgram(Code: TStrings; EXEFN: string);
        procedure MakeOpcodeHeader;

var
  OutputDebug: tDebugOutput;
  OutputDebugMessages: boolean;
  MakeAssembleProcessDoc: boolean;
  CaseSensative: boolean; // set to false when things are to be converted to lower case before comparing to find a match
  CurrentLine: integer; // the current line being assembled
  CurrentByteCompiling: integer;

implementation

uses SysUtils,Dialogs,StringManiU,ShellAPI,MainU;

type ByteArray = array of byte;
     Equate = record
        identifier, NewValue: string;
     end;

var
     CompiledProgram: ByteArray;
     MyCritError: boolean; // true only when an error occurs that would cause
     SetFiles: array of InstructionSetID; // used to list all instruction set files that have already been loaded to prevent eternal recursive loops
     Symbols: array of SymbolConvertion; // registers and things that need converted
     Opcode: array of MyOpcode;
     Defines: array of MyDefine;
     Structs: array of MyStruct; // structures defined in the assembly code
     Labels: array of MyCodeLabel; // labels used to address different areas in the program
     OpcodeTypes: array of string; // values loaded from instruction set files
     radix: word; { defined the default number base when there are no trailing
     letters to define the number base of an immediate value }

const
     // defines
     MemReference = -2;
     ImmediateValueDefine = -1;

// opcode types
   optDefault = 0; // the default value
   optPref = 1; // prefixes

   Prefixes: array[0..5] of string = ('00101110','00111110','00100110','01100100','01100101','00110110');

   // Segment Register Overrides used for memory references (indexes into the prefix array)
   CSoverride = 0;
   DSoverride = 1;
   ESoverride = 2;
   FSoverride = 3;
   GSoverride = 4;
   SSoverride = 5;


function ExecuteFile(FileName, DefaultDir: string): HWND;
begin
     Result := ShellExecute(MainFrm.handle,nil,PChar(FileName), '',
     PChar(DefaultDir), SW_SHOWNORMAL);
end;

// --------------------- tDebugOutput Class -------------------------
constructor tDebugOutput.Create;
begin
    // inherited create;
     pFileAssigned:=false;
     pOutputToGUI:=true;
     pFileName:='DebugData.txt';
end;

procedure tDebugOutput.AssignF(fn: string);
begin
     pFileName:=fn;
     AssignFile(pTextFile,fn);
     Reset(pTextFile);
     pFileAssigned:=true;
end;

procedure tDebugOutput.AssignF;
begin
     if pFileName<>'' then
     begin
          AssignFile(pTextFile,pfilename);
          Rewrite(pTextFile);
          pFileAssigned:=true;
     end
     else
         ShowMessage('error assigning a file to a blank file name');
end;

procedure tDebugOutput.CloseF;
begin
     if pFileAssigned then
        CloseFile(pTextFile);
     pFileAssigned:=false;
end;

procedure tDebugOutput.Output(s: string);
begin
     if OutputDebugMessages then
     begin
          s:=IntToStr(CurrentLine)+': '+s;
          if pFileAssigned and not pOutputToGUI then
             WriteLn(pTextFile,s)
          else if pOutputToGUI then
               MainFrm.DebugOutput.lines.add(s)
          else
              ShowMessage('Error writing to a file that hasn''t been assigned.');
     end;
end;

procedure tDebugOutput.SetOutputToGUI(NewVal: boolean);
begin
     pOutputToGUI:=NewVal;
     if NewVal then
        Self.CloseF;
end;

function tDebugOutput.GetFileSet: boolean;
begin
     result:=(pFileName<>''); // return false if the filename is blank
end;

function tDebugOutput.GetFileName: string;
begin
     result:=pFileName;
end;

procedure tDebugOutput.SetFileName(NewFN: string);
begin
     if pFileName='' then
        OutputToGUI:=true
     else
         pFileName:=NewFN;
end;

function tDebugOutput.GetOutputToGUI: boolean;
begin
     result:=pOutputToGUI;
end;

// ---------------------------------------------------------

procedure FreeInstructionSet;
var
  x: integer;
begin
     Symbols:=nil;
     Opcode:=nil;
     for x:=high(Defines) downto 0 do
         Defines[x].Values:=nil;
     Defines:=nil;
end;

procedure FreeAssemblerU; // free memory used in the unit
begin
     FreeInstructionSet;
     OutputDebug.Destroy;
end;

procedure InitializeAssemblerU;
begin
     MakeAssembleProcessDoc:=true;
     OutputDebug:=tDebugOutput.Create;
end;

function MyLowerCase(s: string): string;
begin
     if CaseSensative then
        result:=s
     else
         result:=LowerCase(s);
end;

function Opcode1MoreEfficientThan2(var op1,op2: MyOpcode): boolean;
var
 c2,c1: byte;
 ResultSet: boolean;
begin
     result:=false;
     if (op1.Operand1.Name='')and(op2.Operand1.Name<>'') then
        result:=true
     else if op2.Operand1.Name='' then
          result:=false
     else
     begin
          ResultSet:=false;
          c2:=0;
          if op2.Operand1.NoMachineCode then
             inc(c2);
          if op2.Operand2.NoMachineCode or (op2.Operand2.Name='') then
             inc(c2);
          c1:=0;
          if op1.Operand1.NoMachineCode then
             inc(c1);
          if op1.Operand2.NoMachineCode or (op1.Operand2.Name='') then
             inc(c1);
          if c1=c2 then
          begin
               if ((op1.Operand1.Name='i8')or(op1.Operand1.Name='i16'))
               and((op2.Operand1.Name='i8')or(op2.Operand1.Name='i16')) then
               begin
                    if op1.Operand1.Name<op2.Operand1.Name then // if op1.Operand1.Name='i16' and op2.Operand1.Name='i8'
                    begin
                         result:=false; // op1 is less efficient than op2
                         ResultSet:=true;
                    end;
               end;
               if not ResultSet then
               begin
                  if ((op1.Operand2.Name='i8')or(op1.Operand2.Name='i16'))
                  and((op2.Operand2.Name='i8')or(op2.Operand2.Name='i16')) then
                  begin
                    if op1.Operand1.Name<op2.Operand1.Name then // if op1.Operand1.Name='i16' and op2.Operand1.Name='i8'
                    begin
                         result:=false;
                         ResultSet:=true;
                    end;
                    if not ResultSet then
                    if Length(op1.OpcodeInBinary)>Length(op2.OpcodeInBinary) then
                    begin
                         result:=false;// op1 is less efficient than op2
                         ResultSet:=true;
                    end;
                  end;
                  if ((op2.Operand2.Name='i8')or(op2.Operand2.Name='i16'))
                  and not ((op1.Operand2.Name='i8')or(op1.Operand2.Name='i16')or(op1.Operand2.Name='')) then
                  begin
                       result:=true;
                       ResultSet:=true;
                  end;
               end;
          end
          else
              result:=(c1>c2);
     end;
end;

function MachineGreater(i1,i2: integer): boolean;
// used by a sort procedure
var
  c1,c2: integer;
begin
     c1:=Length(Opcode[i1].OpcodeInBinary);
     c2:=Length(Opcode[i2].OpcodeInBinary);
     if Opcode[i1].ModeDefined then
        inc(c1,5+Length(Opcode[i1].MachAfterMode));
     if Opcode[i2].ModeDefined then
        inc(c2,5+Length(Opcode[i2].MachAfterMode));
     if c1>c2 then
        result:=true
     else
     begin
         { if Opcode[i1].OpcodeInBinary>Opcode[i2].OpcodeInBinary then
             result:=true
          else  }
              result:=false;
     end;
end;

procedure SwapOpcodes(i1,i2: integer);
var
   buf: MyOpcode; // a buffer
begin
     buf:=Opcode[i1];
     Opcode[i1]:=Opcode[i2];
     Opcode[i2]:=buf;
end;

procedure SortOpcodesAlphabetically;
// use selection sort to sort the opcodes alphabetically
var
  x: integer;
  Sorted: boolean;

begin
     Sorted:=false;
     while not Sorted do
     begin
          Sorted:=true;
          for x:=high(Opcode)-1 downto 0 do
          begin
               if Opcode[x].Opcode>Opcode[x+1].Opcode then
               begin
                    SwapOpcodes(x,x+1);
                    Sorted:=false;
               end;
          end;
     end;
end;

procedure SortOpcodesEfficiency;
// use selection sort to sort the opcodes by efficiency
var
  x: integer;
  Sorted: boolean;
begin
     Sorted:=false;
     while not Sorted do
     begin
          Sorted:=true;
          for x:=high(Opcode)-1 downto 0 do
          begin
               if Opcode1MoreEfficientThan2(Opcode[x],Opcode[x+1]) then
               begin
                    SwapOpcodes(x,x+1);
                    Sorted:=false;
               end;
          end;
     end;
end;

procedure SortOpcodesMachine;
// use selection sort to sort the opcodes alphabetically
var
  x: integer;
  Sorted: boolean;
begin
     Sorted:=false;
     while not Sorted do
     begin
          Sorted:=true;
          for x:=high(Opcode)-1 downto 0 do
          begin
               if MachineGreater(x,x+1) then
               begin
                    SwapOpcodes(x,x+1);
                    Sorted:=false;
               end;
          end;
     end;
end;

function GetDefine(operand: string): integer;
// returns the index of the define containing the operand
var
  x,y: integer;
  b: byte;
  pref: string;
  error: boolean;
begin
     operand:=LowerCase(operand);
     result:=ImmediateValueDefine; // immediate values
     for x:=high(Defines) downto 0 do
         if Defines[x].name=Operand then
         begin
              result:=x;
              exit;
         end;
     if result<0 then
        for x:=high(Defines) downto 0 do
            with Defines[x] do
            for y:=high(Values) downto 0 do
            if Values[y]=operand then
            begin
                 result:=x;
                 exit;
            end;
     if (result<0)and(operand<>'') then
     begin
          if ReferenceToBinary('mem',operand,false,b,error,pref)<>'' then
          begin
               if not error then
                  result:=MemReference;
          end
          else if (operand='mem'){any memory reference}or(operand='mem8'{reference to 8-bit value})
          or(operand='mem16'{reference to 16-bit value})or(operand='mem32'{reference to 32-bit value})
          or(operand='mem64'{reference to 64-bit value})or(operand='mem80'{reference to 80-bit value})
          or(operand='mem128'{reference to 128-bit value})  then
             result:=MemReference;
     end;
end;

function GetSymbol(s: string): integer;
var
  x: integer;
begin
     result:=-1;
     s:=LowerCase(s);
     for x:=high(Symbols) downto 0 do
         if Symbols[x].Symbol=s then
         begin
              result:=x;
              break;
         end;
end;

function GetMyLabel(LBLName: string; ShowDebug: boolean): MyCodeLabel;
var
  x: integer;
begin
     result.name:='';
     result.StaticAddress16:=$100; // default values if the label is not found
     for x:=high(Labels) downto 0 do
         if LBLName = Labels[x].name then
         begin
              result:=Labels[x];
              break; // break the for loop
         end;
     if ShowDebug then
        if result.name='' then
           OutputDebug.Output('Undefined label: "'+LBLName+'"');
end;

// ------------------- number base convertions ------------------------------

function InCPPHex(HexStr: string): boolean;
begin
     result:=false;
     HexStr:=LowerCase(HexStr);
     if copy(HexStr,1,2)='0x' then
        result:=true
     else if copy(HexStr,1,3)='-0x' then
        result:=true;
end;

function DecToInt(DecStr: string;var error: boolean): integer;
var
  c: char;
  pos1: integer;
begin
     result:=0;
     if DecStr='' then
        error:=true
     else
     begin
          c:=DecStr[Length(DecStr)];
          if (c='d')or(c='D') then
             DecStr:=Copy(DecStr,1,Length(DecStr)-1);
          val(DecStr,result,pos1);
          if pos1<>0 then
             error:=true;
     end;
end;

function HexToInt(HexStr: string;var error: boolean): integer;
// HexStr must be in lowercase
// HexStr = ie. '- 2424ac45h'
var
  signed: boolean;
  len1: integer;
  c: byte; // stores the ascii value of a hex digit
  d: byte; // stores the binary digit
begin
     result:=0;
     ClearAllSpaces(HexStr);
     if HexStr='' then Exit;
     Signed:=(HexStr[1]='-');
     if HexStr[length(HexStr)]<>'h' then
        HexStr:=HexStr+'h';
     if not signed then
        HexStr:=' '+HexStr;
     len1:=length(HexStr)-1;
     for d:=len1 downto 2 do
     begin
          c:=ord(HexStr[d]);
          if (c>=97)and(c<=102) then
             result:=result or ((c-87) shl ((len1-d) shl 2))
          else if (c>=48)and(c<=57) then
             result:=result or ((c-48) shl ((len1-d) shl 2))
          else
          begin
               OutputDebug.Output('Invalid hex digit "'+HexStr[d]+'" in '+HexStr);
               error:=true;
               break;
          end;
     end;
     if signed then
        result:=-result;
end;

function CPPHexToInt(HexStr: string;var error: boolean): integer;
// HexStr must be in lower case
// HexStr = ie. '-0x2424ac45'
var
  signed: boolean;
  len1: integer;
  c: byte; // stores the ascii value of a hex digit
  d: byte; // stores the binary digit
begin
     result:=0;
     error:=false;
     ClearAllSpaces(HexStr);
     if HexStr='' then Exit;
     Signed:=(HexStr[1]='-');
     if not signed then
        HexStr:=' '+HexStr;
     len1:=length(HexStr);
     // ie. HexStr = ' 0x02FF'
     for d:=len1 downto 4 do
     begin
          c:=ord(HexStr[d]);
          if (c>=97)and(c<=102) then
             result:=result or ((c-87) shl ((len1-d) shl 2))
          else if (c>=48)and(c<=57) then
               result:=result or ((c-48) shl ((len1-d) shl 2))
          else
          begin
               OutputDebug.Output('Invalid hex digit: '+HexStr);
               error:=true;
               break;
          end;
     end;
     if signed then
        result:=-result;
end;

function BinToInt(binStr: string;var error: boolean): integer;
var
  signed: boolean;
  c: byte; // stores the ascii value of a hex digit
  d: byte; // stores the binary digit
begin
     error:=false;
     result:=0;
     ClearAllSpaces(binStr);
     if binStr='' then Exit;
     Signed:=(binStr[1]='-');
     if binStr[length(binStr)]<>'b' then
        binStr:=binStr+'b';
     if not signed then
        binStr:=' '+BinStr;
     for d:=length(BinStr)-1 downto 2 do
     begin
          c:=ord(BinStr[d]);
          if (c>=48)and(c<=49) then
             result:=result or (ord(c=49) shl (length(BinStr)-1-d))
          else
          begin
               OutputDebug.Output('Invalid binary digit: '+BinStr);
               error:=true;
               break;
          end;
     end;
     if signed then
        result:=-result;
end;

function OctToInt(binStr: string;var error: boolean): integer;
var
  signed: boolean;
  c: byte; // stores the ascii value of a hex digit
  d: byte; // stores the binary digit
begin
     result:=0;
     error:=false;
     ClearAllSpaces(binStr);
     if binStr='' then Exit;
     Signed:=(binStr[1]='-');
     if binStr[length(binStr)]<>'o' then
        binStr:=binStr+'o';
     if not signed then
        binStr:=' '+BinStr;
     for d:=length(BinStr)-1 downto 2 do
     begin
          c:=ord(BinStr[d]);
          if (c>=48)and(c<=57) then
             result:=result or ((c-48) shl (3*(length(BinStr)-1-d)))
          else
          begin
               OutputDebug.Output('Invalid octal digit: '+BinStr);
               error:=true;
               break;
          end;
     end;
     if signed then
        result:=-result;
end;

function IntToBinary(i: integer;Bytes: byte): string;
var
  signed: boolean;
  d: byte; // stores the binary digit
begin
     result:='';
     if bytes=0 then
        exit;
     if (bytes=1)and(i>255) then
        OutputDebug.Output('Value out of 8 bit range: '+inttostr(i));
     signed:=(i<0);
     if signed then
        inc(i);
     i:=abs(i);
     for d:=7 downto 0 do // byte, word, or dword
         result:=result+chr(48{ord('0')}+i shr d and 1);
     if Bytes>1 then // word or dword
        for d:=15 downto 8 do
            result:=result+chr(48{ord('0')}+i shr d and 1);
     if Bytes=4 then // dword
        result:=result+IntToBinary(i shr 16,2);

     if signed then // do a logical NOT operation on the digits of a negative number
        for d:=length(result) downto 1 do
            result[d]:=chr(48+ord(result[d]='0'));
end;

// ----------------------------------------------------------------------------

function ImmediateValueToInt(opa: string;ConvertLabels: boolean; Bytes: byte; var error: boolean): integer;
{
         opa = the immediate value ie. opa = '-3423h'
         error = set to true if an error occurs
}
var
  lbl: MyCodeLabel;
  ConvertSuccess: boolean;
begin
     ClearFirstSpaces(opa);
     result:=0;
     error:=false;
     if opa='' then
     begin
          OutputDebug.Output('Error getting an immediate value from a blank');
          error:=true;
          exit;
     end;
     if InCPPHex(opa) then // ie. opa='0xFF'
     begin
          result:=CPPHexToInt(LowerCase(opa),error);
     end
     else
     begin
          ConvertSuccess:=true;
          case opa[length(opa)] of
           'h','H': if OnlyChars(LowerCase(opa),'-0123456789abcdefh') then
                       result:=HexToInt(LowerCase(opa),error) // hex
                    else
                        ConvertSuccess:=false;
           'd','D': if OnlyChars(opa,'-0123456789dD') then
                       result:=DecToInt(opa,error) // decimal(base 10)
                    else
                        ConvertSuccess:=false;
           'b','B': if OnlyChars(opa,'-01bB') then
                       result:=BinToInt(opa,error) // binary
                    else
                        ConvertSuccess:=false;
           'o','O': if OnlyChars(opa,'-01234567oO') then
                       result:=OctToInt(opa,error) // octal
                    else
                        ConvertSuccess:=false;
           '''': result:=ord(opa[2]);  // ascii characters
          else
              ConvertSuccess:=false;
          end;
          if not ConvertSuccess then
          begin
               error:=false;
             if OnlyChars(LowerCase(opa),'-0123456789abcdef') then
             begin
                case radix of
                2:   if OnlyChars(opa,'-01') then
                        result:=BinToInt(opa+'b',error) // binary
                     else
                         error:=true;
                8:   if OnlyChars(opa,'-01234567') then
                        result:=OctToInt(opa+'o',error) // octal
                     else
                         error:=true;
                10:
                   if ValidInt(opa) then
                   begin
                        result:=StrToInt(opa); // decimal
                   end
                   else
                       error:=true;
                16:      result:=HexToInt(LowerCase(opa)+'h',error); // hex
                else
                    error:=true;
                end;
             end
             else
                 error:=true;
             if error then
                error:=false
             else
                 exit; // if it was successfully converted to an integer, then exit
             if ConvertLabels then
             begin
                 lbl:=GetMyLabel(MyLowerCase(opa),false);
                 if lbl.name='' then
                 begin
                      if (LowerCase(ClearFirstWord(opa))='offset')and(bytes>1) then
                      begin
                           lbl:=GetMyLabel(LowerCase(opa),false);
                           if lbl.name='' then
                              error:=true
                           else
                               result:=lbl.StaticAddress16; // the offset value
                      end
                      else
                          error:=true; // indicate that an error has occured
                 end
                 else
                 begin
                      if bytes=1 then
                         result:=lbl.StaticAddress16-CurrentByteCompiling
                         // address relative to the current instruction
                      else if bytes=2 then
                          result:=lbl.StaticAddress16;
                          // address relative to the beginning of the segment
                      // label
                 end;
             end
             else
             // if it can't be converted using all those options, there is an error because it couldn't be converted to an integer.
                  error:=true;
          end;
     end;
end;

function GetImmediateValueInBinary(opa: string;Bytes: byte): string;
var
  error: boolean;
begin
     result:=IntToBinary(ImmediateValueToInt(opa,true,bytes,error),Bytes);
     if error then
        MyCritError:=true;
end;

procedure CheckForDuplicateInstructions;
var
  instr,instr2: integer;
  MatchFound: boolean;
  s: string;
begin
     MatchFound:=false;
     for instr:=high(Opcode) downto 0 do
     begin
         for instr2:=high(Opcode) downto 0 do
            if instr2<>instr then
             if (Opcode[instr].Opcode=Opcode[instr2].Opcode)and // names match for example, both are 'mov'
             (Opcode[instr].OpcodeInBinary=Opcode[instr2].OpcodeInBinary)and // machine code for opcode match
             (Opcode[instr].Operand1.Name=Opcode[instr2].Operand1.Name)and // first operands match
             (Opcode[instr].Operand2.Name=Opcode[instr2].Operand2.Name)and
             (Opcode[instr].DiasmOnly=Opcode[instr2].DiasmOnly) then // second operands match
             begin
                  s:=Opcode[instr].Opcode;
                  if Opcode[instr].Operand1.Name<>'' then
                  begin
                       s:=s+' '+Opcode[instr].Operand1.Name;
                       if Opcode[instr].Operand2.Name<>'' then
                          s:=s+', '+Opcode[instr].Operand2.Name;
                  end;
                  ShowMessage('An instruction was loaded twice from the instruction set files.  The instruction is...'
                  +#13+s+#13+'There may be more repeated instructions.');
                  MatchFound:=true;
                  break;
             end;
         if MatchFound then
            break;
     end;
end;

procedure RecLoadInstructionSet(FileName: string);
// loads data for assembling code from a file
// this is recursive because of the include option

   procedure FormatOperandName(var Operand: MyOperand);
   begin
        Operand.NoMachineCode:=false;
        if Operand.Name<>'' then
        begin
             if (Operand.Name[1]='"')and(Operand.Name[Length(Operand.Name)]='"') then
             begin
                  // ie. "al", "ax"...
                  Operand.NoMachineCode:=true; // no binary code used to define this operand
                  Operand.Name:=copy(Operand.Name,2,length(Operand.Name)-2);
                  // remove the quote signs
                  Operand.OperandDef:=GetDefine(Operand.Name);
             end;
        end;
   end;

   function SubStrFound(SubStr: string;var MainString: string): boolean;
   var
     pos1: integer;
   begin
        pos1:=pos(SubStr,MainString);
        if pos1=0 then
           result:=false
        else
        begin
             MainString:=Copy(MainString,1,pos1-1)+Copy(MainString,pos1+Length(SubStr),999);
             result:=true;
        end;
   end;

var
  tf: Textfile;
  s,s2: string;
  x,i: integer; // used to store temperary integer values
  InstructionSetFileIndex: integer; // stores the index of this file in the array of instruction set file names
  mode: byte;
  error: boolean;
  SetColour: integer; // a colour for the instructions
const
  mdSymbol = 0; // define symbols like registers
  mdDefine = 1; // define operand types like reg8, reg16, seg...
  mdOpcode = 2; // define opcodes
  mdExample = 3; // do nothing, this section is just for
  mdOpcodeTypes = 4; // listing and assigning identifiers for the types of opcodes, ie. jcc, call, string...
begin
     FileName:=LowerCase(FileName);
     if pos(':\',FileName)=0 then
        FileName:=MainU.GetProgDir+'\'+FileName;
     if FileExists(FileName) then
     begin
          for x:=high(SetFiles) downto 0 do
          begin
               if FileName=SetFiles[x].FileName then
                  exit;
                  // exit the procedure because this file is already getting
                  // loaded or has been loaded
          end;
          SetLength(SetFiles,high(SetFiles)+2);
          SetFiles[high(SetFiles)].FileName:=LowerCase(FileName);
          InstructionSetFileIndex:=high(SetFiles);
          Mode:=mdExample;
          AssignFile(tf,FileName);
          Reset(tf);
          Setcolour:=$FFFFFF; // default colour for the instructions
          while not eof(tf) do
          begin
               Readln(tf,s);
               s:=LowerCase(CleanString(s));
               if s<>'' then
               begin
                    s2:=ClearFirstWordSpecial(s,' ');
                    if s2<>'' then
                    begin
                    if s2[1]='#' then
                    begin
                         if (pos('define',s2)=2) then
                            mode:=mdDefine
                         else if (pos('symbol',s2)=2) then
                              mode:=mdSymbol
                         else if (pos('opcode',s2)=2) then
                              mode:=mdOpcode
                         else if (pos('example',s2)=2) then
                              mode:=mdExample
                         else if (pos('colour',s2)=2) then
                         begin
                              Setcolour:=ImmediateValueToInt(s,false,4,error);
                              SetFiles[InstructionSetFileIndex].Colour:=SetColour;
                              if error then
                                 ShowMessage('Error getting a colour for the instructions in: '+FileName);
                         end
                         else if (pos('include',s2)=2) then
                         begin
                              x:=pos('<',s);
                              if x>0 then
                              begin
                                   s:=copy(s,x+1,999);
                                   x:=pos('>',s);
                                   if x>0 then
                                   begin
                                        s:=copy(s,1,x-1);
                                        s:=CleanString(s);
                                        // s now is the filename of an included
                                        if pos('\',s)=0 then
                                           s:=Copy(FileName,1,LastPos('\',FileName))+s;
                                        RecLoadInstructionSet(s);
                                   end;
                              end;
                         end
                         else if (pos('opcodetypes',s2)=2) then
                         begin
                              mode:=mdOpcodeTypes;
                         end;
                    end
                    else
                    begin
                         case mode of
                           mdSymbol: begin
                                          SetLength(Symbols,high(Symbols)+2);
                                          with Symbols[high(Symbols)] do
                                          begin
                                               Binary:=s2;
                                               Symbol:=ClearFirstWord(s);
                                          end;
                                     end;
                           mdDefine: begin
                                          SetLength(Defines,high(Defines)+2);
                                          with Defines[high(Defines)] do
                                          begin
                                               name:=s2;
                                               Values:=nil;
                                               ClearFirstWord(s); // remove the equal sign
                                               ClearAllSpaces(s);
                                               s2:=ClearFirstWord(s);
                                               while s2<>'' do
                                               begin
                                                    SetLength(Values,high(Values)+2);
                                                    Values[high(Values)]:=s2;
                                                    s2:=ClearFirstWord(s);
                                               end;
                                          end;
                                     end;
                           mdOpcode: begin
                                          SetLength(Opcode,high(Opcode)+2);
                                          with Opcode[high(Opcode)] do
                                          begin
                                               OpcodeInBinary:=s2;
                                               x:=pos('#prefix',s);
                                               if x<>0 then
                                               begin
                                                    typeID:=optPref;
                                                    s:=copy(s,1,x-1)+copy(s,x+7,999);
                                               end
                                               else
                                                   typeID:=optDefault;
                                               x:=pos('#mode',s);
                                               if x<>0 then
                                               begin
                                                    modedefined:=true;
                                                    s:=copy(s,1,x-1)+copy(s,x+5,999);
                                                    if s[x]='+' then
                                                    begin
                                                         i:=pos(' ',copy(s,x,999))+x;
                                                         s2:=copy(s,x+1,i-x-2);
                                                         MachAfterMode:=s2;
                                                         s:=Copy(s,1,x-1)+Copy(s,i,999);
                                                    end;
                                               end
                                               else
                                               begin
                                                    modedefined:=false;
                                                    MachAfterMode:='';
                                               end;
                                               x:=pos('#processor',s);
                                               if x<>0 then
                                               begin
                                                    s:=copy(s,1,x-1)+copy(s,x+10,999);
                                                    if s[x]='=' then
                                                    begin
                                                         i:=pos(' ',copy(s,x,999))+x;
                                                         s2:=copy(s,x+1,i-x-2);
                                                         Processor:=s2;
                                                         s:=Copy(s,1,x-1)+Copy(s,i,999);
                                                    end;
                                               end
                                               else
                                                    Processor:='';
                                               DiasmOnly:=SubStrFound('#diasmonly',s);
                                               ASMOnly:=SubStrFound('#asmonly',s);
                                               RevMachOperand:=SubStrFound('#revmachoperand',s);
                                               Branch:=SubStrFound('#branch',s);
                                               StopDiasm:=SubStrFound('#stopdiasm',s);
                                               Opcode:=ClearFirstWord(s);
                                               Operand1.Name:=ClearFirstWord(s);
                                               ClearAllSpaces(s);
                                               if Operand1.Name<>'' then
                                               begin
                                                    Operand2.Name:=ClearFirstWord(s);
                                                    if Operand2.Name<>'' then
                                                       Operand3.Name:=ClearFirstWord(s)
                                                    else
                                                        Operand3.Name:='';
                                               end
                                               else
                                               begin
                                                    Operand2.Name:='';
                                                    Operand3.Name:='';
                                               end;
                                               operand1.OperandDef:=GetDefine(Operand1.Name);
                                               FormatOperandName(operand1);
                                               operand2.OperandDef:=GetDefine(Operand2.Name);
                                               FormatOperandName(operand2);
                                               operand3.OperandDef:=GetDefine(Operand3.Name);
                                               FormatOperandName(operand3);
                                               Colour:=SetColour;
                                          end;
                                     end;
                           mdOpcodeTypes:
                                         begin
                                              SetLength(OpcodeTypes,High(OpcodeTypes)+2);
                                              OpcodeTypes[high(OpcodeTypes)]:=CleanString(s);
                                         end;
                           mdExample:
                         end;
                    end;
                    end;
               end;
          end;
          CloseFile(tf);
     end
     else
         ShowMessage('Instruction set file not found: '+FileName);
end;

procedure LoadInstructionSet(FileName: string);
begin
     SetFiles:=nil; // clear the file names
     FreeInstructionSet; // free the currently loaded instruction set
     // This free can't be in the recursive procedure.
     RecLoadInstructionSet(FileName); // call the recursive loading procedure
     CheckForDuplicateInstructions;
end;

function GetConstantPortion(var MemAddress: string): integer;
// ie. MemAddress = 'si+di+23h+1'
// result = the sum of all constant values that can come from that address

// memaddress is set to an expression that with the constant portions eliminated
// after this procedure: ie. memaddress = 'si+di' and the result would be 23h+1 or 35+1 or 36

var
  term: array of string;
  pos1,x: integer;
  error: boolean;
  s: string;
  LBL: MyCodeLabel;
begin
     result:=0;
     // load all the terms from MemAddress into separate elements in the term array.
     s:=MemAddress;
     pos1:=pos('+',s);
     while pos1<>0 do
     begin
          SetLength(Term,high(Term)+2); // add an element to the array
          Term[high(Term)]:=Copy(s,1,pos1-1);
          s:=Copy(s,pos1+1,999);
          pos1:=pos('+',s);
     end;
     SetLength(Term,high(Term)+2); // add the last term into the array
     Term[high(Term)]:=s;
     // -------------------- load complete ----------------------

     // add all of the constant terms together
      for pos1:=0 to high(Term) do
     begin
          x:=ImmediateValueToInt(Term[pos1],false,2,error);
          if not error then // if the term is a valid immediate value, add it to the result and clear it
          begin
               result:=result+x;
               Term[pos1]:=''; // clear this constant term
          end
          else // try getting a value from it if it is a label
          begin
               LBL:=GetMyLabel(Term[pos1],false);
               if LBL.Name<>'' then
               begin
                    result:=result+LBL.StaticAddress16;
                    Term[pos1]:=''; // clear this constant term
               end;
          end;
     end;
     // --------------------- addition complete ------------------

     // now put the remaining terms back into MemAddress
     MemAddress:=''; // clear the string so it can be filled with the terms that could not be evaluated to constant values ie. register names
     for pos1:=0 to high(Term) do // loop through all the terms
     begin
          MemAddress:=MemAddress+Term[pos1];
          if pos1<>high(Term) then // if pos1 is not the last term,
             MemAddress:=MemAddress+'+'; // add a + sign
     end;
     if MemAddress<>'' then
        while MemAddress[length(MemAddress)]='+' do // remove any trailing + signs
        begin
             MemAddress:=copy(MemAddress,1,length(MemAddress)-1); // get rid of it.
             if MemAddress='' then
                break;
        end;
end;

function ReferenceToBinary(OpDefine: string; MemRef: string;ShowDebug: boolean;var mode: byte; var error: boolean;var prefix: string): string;
// ie. OpDefine = 'mem64'
// ie. MemRef = 'data[Si+bX]'
// ie. MemRef = '[si+data+3]'
// where 'data' is a label
// prefix is set to any binary that should be placed before the opcode
// error only when the size of a memory reference does not match what is determined from OpDefine

   procedure SetPrefix(sregStr: string);
   begin
        if sregStr='cs' then
           Prefix:=Prefixes[CSOverride]
        else if sregStr='ds' then
             Prefix:=Prefixes[DSOverride]
        else if sregStr='es' then
             Prefix:=Prefixes[ESOverride]
        else if sregStr='fs' then
             Prefix:=Prefixes[FSOverride]
        else if sregStr='gs' then
             Prefix:=Prefixes[GSOverride]
        else if sregStr='ss' then
             Prefix:=Prefixes[SSOverride]
        else
        begin
             error:=true;
             if ShowDebug then
                OutputDebug.Output('unable to extract the segment register from the memory reference "'+MemRef+'", substring checked for register: "'+sregStr+'"');
             exit;
        end;
   end;

var
  LBL: MyCodeLabel;
  s,s2: string;
  pos1: integer;
begin
     error:=false;
     result:='';
     prefix:='';
     pos1:=pos('[',MemRef);
     // ie. MemRef = 'data[si]'
     if pos1>0 then
     begin
          MemRef:=LowerCase(MemRef);
          s:=Copy(MemRef,1,pos1-1); // s becomes the part of the string before the first '['
          // ie. s = ' data '
          ClearLastSpaces(s);
          ClearFirstSpaces(s);
          ClearDoubleSpaces(s);
          LBL.StaticAddress16:=0;
          if s='' then
          begin
               LBL.StaticAddress16:=0;
               LBL.name:='';
          end
          else
          begin
               if (pos(' ',s)>0)and(s[Length(s)]=':') then
               begin
                    for pos1:=Length(s)-1 downto 1 do
                         if (s[pos1]=' ')and(pos1<>Length(s)-2) then
                            break;
                    s2:=Copy(s,pos1+1,Length(s)-pos1-1);
                    SetPrefix(s2);
                    s:=Copy(s,1,pos1-1);
               end;
               if pos(' ',s)<1 then
               begin
                    LBL:=GetMyLabel(s,false);
                    if LBL.name='' then // label not found
                    begin
                         LBL.StaticAddress16:=0;
                         if OpDefine='mem' then
                         begin
                              if (s='byte')or(s='word')or(s='dword')or(s='qword')or(s='pword')or(s='oword') then
                              begin
                                   if ShowDebug then
                                      OutputDebug.Output(
                                      'HINT: This instruction does not need you to define a size in the memory reference for "'+MemRef+'"');
                              end
                              else if ShowDebug then
                              begin
                                   OutputDebug.Output('Undefined label: "'+s+'"');
                                   error:=true;
                              end;
                         end
                         else
                         if ((s='byte')and(OpDefine<>'mem8'))
                         or ((s='word')and(OpDefine<>'mem16'))
                         or ((s='dword')and(OpDefine<>'mem32'))
                         or ((s='qword')and(OpDefine<>'mem64'))
                         or ((s='pword')and(OpDefine<>'mem80'))
                         or ((s='oword')and(OpDefine<>'mem128'))
                         then
                         begin
                              if ShowDebug then
                                 OutputDebug.Output(OpDefine+' expected but "'+s+'" found');
                              error:=true;
                              exit;
                         end;
                    end;
               end
               else if OpDefine<>'mem' then
               // more than one word before the square brackets
               begin
                    s2:=ClearFirstWordSpecial(s,' '+#9);
                    if ((s2='byte')and(OpDefine<>'mem8'))
                    or ((s2='word')and(OpDefine<>'mem16'))
                    or ((s2='dword')and(OpDefine<>'mem32'))
                    or ((s2='qword')and(OpDefine<>'mem64'))
                    or ((s2='pword')and(OpDefine<>'mem80'))
                    or ((s2='oword')and(OpDefine<>'mem128'))
                    then
                    begin
                         error:=true;
                         exit;
                    end;
               end;
          end;
          MemRef:=copy(MemRef,pos1+1,999);
          ClearAllSpaces(MemRef);
          pos1:=pos(']',MemRef); // ie. MemRef = 'si ]'
          if pos1>0 then
          begin
               MemRef:=Copy(MemRef,1,pos1-1); // ie. MemRef = 'si'
               pos1:=pos(':',MemRef);
               if pos1>0 then
               begin
                    s:=Copy(MemRef,1,pos1-1);
                    SetPrefix(s);
                    MemRef:=Copy(MemRef,pos1+1,999);
               end;
               LBL.StaticAddress16:=LBL.StaticAddress16+GetConstantPortion(MemRef);
               //mode:=2; // currently this is the only supported addressing mode
               if LBL.StaticAddress16>255 then
                  mode:=2 // use 16-bit offset
               else if LBL.StaticAddress16<>0 then
                   mode:=1 // use 8-bit offset
               else
                   mode:=0;
               // Now, check to see if there is a segment override to use
               // Output the binary for reg and offset
               if (MemRef='bx+si')or(MemRef='si+bx') then // [BX+SI] + d16/d8/0
               begin
                    result:='000'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if (MemRef='bx+di')or(MemRef='di+bx') then // [BX+DI] + d16/d8/0
               begin
                    result:='001'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if (MemRef='bp+si')or(MemRef='si+bp') then // [BP+SI] + d16/d8/0
               begin
                    result:='010'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if (MemRef='bp+di')or(MemRef='di+bp') then // [BP+DI] + d16/d8/0
               begin
                    result:='011'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if MemRef='si' then // [SI] + d16
               begin
                    result:='100'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if MemRef='di' then // [DI] + d16
               begin
                    result:='101'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if MemRef='bp' then // [BP] + d16
               begin
                    result:='110'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if MemRef='bx' then // [BX] + d16
               begin
                    result:='111'+IntToBinary(LBL.StaticAddress16,mode);
                    Exit;
               end
               else if MemRef='' then
               begin
                    result:='110'+IntToBinary(LBL.StaticAddress16,2);
                    mode:=0;
                    Exit;
               end;
          end;
     end;
     error:=true;
     if ShowDebug then
        OutputDebug.Output('unable to assemble the memory reference "'+MemRef+'"');
end;

function ClearFirstOperand(var OperandStr: string): string;
begin
     result:=ClearFirstWordSpecial(OperandStr,',');
     if result='''' then // condition met when the operand is ',' (a comma)
     begin
          result:=''',''';
          ClearFirstWord(OperandStr);
     end;
     if result='' then
        if OperandStr<>'' then
           result:=ClearFirstWord(OperandStr);
end;

function GetBinaryFor(s: string): string;
// s is an assembly statement.  The statement must be cleared of any comments and labels.
// returns the machine code for it
var
  s2: string;
  opa: array[1..3] of string;
  x: integer; // used as counter in loops
  OpcodeIndex,i: integer;
  opcodefound,Allfound,error: boolean;
  operandcount: byte;
  AddressingMode: byte;
  pref: string;

  function GetStatement: string;
  begin
       result:=s2;
       if operandCount>0 then
          result:=result+' '+opa[1];
       if operandCount>1 then
          result:=result+', '+opa[2];
  end;

  function OperandStatementMatch(op1: string;var operand1: MyOperand): boolean;
  // operand1 sent as a pointer because MyOperand is such a large type that a pointer should execute faster
  // function checks to see if 2 an operand expression from an assembly statement is of the same type as operand1
  var
    op1def: integer; // stores GetDefine(op1)
  begin
       result:=false;
       op1def:=GetDefine(op1);
       if ((op1def=operand1.OperandDef)and not operand1.nomachinecode)or
       ((operand1.nomachinecode)and(operand1.name=op1)) then
       begin // if the first operand matches the type of operand in opcode[OpcodeIndex].operand1
             if operand1.operandDef=MemReference then
             begin
               if op1def=MemReference then
               begin
                  ReferenceToBinary(operand1.Name,op1,false, AddressingMode,error,pref);
                  if not error then
                  // if the size of memory being referenced matches the size determined in the opcode array,
                     result:=true
                  else
                      result:=false;
               end
               else
                   result:=false;
             end
             else if op1def<>MemReference then
             // if op1 is not a memory reference when the operand is not
                 result:=true
             else
                 result:=false;
       end
       else if operand1.Name<>'' then
       begin
            if operand1.Name[1]='i' then
            begin
                 if operand1.Name='i8' then
                 begin
                      i:=ImmediateValueToInt(op1,true,1,error);
                      if error then
                         result:=false
                      else
                      if (i<256)and(i>=-128) then
                         result:=true;
                 end
                 else if operand1.Name='i16' then
                 begin
                      i:=ImmediateValueToInt(op1,true,1,error);
                      if error then
                         result:=false
                      else
                      if (i<$10000)and(i>=-$8000) then
                         result:=true;
                 end;
            end
            else
                result:=false;
       end
       else
           result:=false;
  end;
  function GetOperandsBinary(OperandStr: string; Operand: MyOperand): string;
  begin
       result:='';
       if not operand.NoMachineCode then
       begin // if the operand adds any machine code to the program
             if operand.Name='i8' then
                result:=GetImmediateValueInBinary(OperandStr,1)
             else if operand.Name='i16' then
                  result:=GetImmediateValueInBinary(OperandStr,2)
             else if operand.OperandDef=MemReference then
                  result:=ReferenceToBinary(Operand.Name,OperandStr,true,AddressingMode,error,pref)
             else
             begin
                  x:=GetSymbol(OperandStr); // second operand
                  if x<0 then
                  begin
                       OutputDebug.Output('unknown operand: '+OperandStr);
                       result:='';
                       exit;
                  end
                  else
                      result:=Symbols[x].Binary;
             end;
       end;
  end;

  procedure GetNextDataEntry;
  begin
       ClearFirstSpaces(s);  // bug when ',',' ' are the byte (any parsing character causes errors)
       x:=pos(',',s);
       if x>0 then
       begin
            if s[1]='''' then
            begin
                 x:=pos('''',Copy(s,2,999))+1;
                 s2:=copy(s,1,x); // get the quoted section
                 s:=copy(s,x+1,999);
                 x:=pos(',',s);
                 if x>0 then
                    s:=copy(s,x+1,999);// get the part after the comma
            end
            else
            if s[1]='"' then
            begin
                 x:=pos('"',Copy(s,2,999))+1;
                 s2:=copy(s,1,x); // get the quoted section
                 s:=copy(s,x+1,999);
                 x:=pos(',',s);
                 if x>0 then
                    s:=copy(s,x+1,999);// get the part after the comma
            end
            else
            begin
                 s2:=copy(s,1,x-1);
                 s:=copy(s,x+1,999);
            end;
       end
       else
       begin
            s2:=s;
            s:='';
       end;
  end;
  var
  {$ifdef WeAreDebugging}
  prefixbinary,opcodebinary,modebinary:string;
  {$endif}
  op1binary,op2binary,op3Binary: string;
  label AddFirstOperand;
  label AddSecondOperand;
  label EndOfAddFirst2Operands;
begin
     result:='';
     if s='' then exit;
     CleanString(s);
     if (s='')or(length(s)=1) then exit;
     s2:=LowerCase(ClearFirstWord(s)); // s2 should indicate the opcode
     { eventually, to speed up the assembling process, it would be good to sort
     the opcodes and use a binary search, but for now we'll just loop through all of them. }

     // --- check to see if this defines data

     if length(s2)>1 then
     if s2[1]='d' then
     begin
          if s2='db' then // define bytes
          begin
               GetNextDataEntry;
               while s2<>'' do
               begin
                    if (s2[1]<>'''')or(length(s2)<=3)or(s2[3]='''') then
                       result:=result+GetImmediateValueInBinary(s2,1)
                    else // ie. s2 = ''Hello World!''
                        for x:=2 to length(s2)-1 do
                            result:=result+IntToBinary(ord(s2[x]),1);
                    GetNextDataEntry;
               end;
               exit;
          end
          else if s2='dw' then // define words
          begin
               GetNextDataEntry;
               while s2<>'' do
               begin
                    result:=result+GetImmediateValueInBinary(s2,2);
                    GetNextDataEntry;
               end;
               exit;
          end
          else if s2='dd' then // define double words
          begin
               //ShowMessage('dd '+s);
               //exit;
          end;
     end;

     // -----------------------------------------------------
     // ---- check to see if this contains opcodes ----------

      ClearAllTabs(s);
     opa[1]:=ClearFirstOperand(s);

     opa[2]:=ClearFirstOperand(s);
     opa[3]:=ClearFirstOperand(s);
     if opa[1]='' then
        OperandCount:=0
     else if opa[2]='' then
        OperandCount:=1
     else
     begin
          if opa[3]='' then
             OperandCount:=2
          else
              OperandCount:=3;
     end;
     OpcodeFound:=false;

     for OpcodeIndex:=high(opcode) downto -1 do // loop through the opcodes to find a match for s2
         if OpcodeIndex>=0 then
         if not opcode[OpcodeIndex].DiasmOnly then
         if opcode[OpcodeIndex].opcode=s2 then // if the opcode name matches the name from the source code then
         begin
              opcodeFound:=true;
              allfound:=true;
              if (operandCount<>0) then
              begin
                   allfound:=OperandStatementMatch(opa[1],opcode[OpcodeIndex].operand1);
                   if allfound then
                      if operandCount>1 then
                      begin
                           allfound:=OperandStatementMatch(opa[2],opcode[OpcodeIndex].operand2);
                           if allfound then
                              if OperandCount>2 then
                                 allfound:=OperandStatementMatch(opa[3],opcode[OpcodeIndex].operand3);
                      end;
              end
              else
              begin
                   if opcode[OpcodeIndex].operand1.Name<>'' then
                      AllFound:=false;
              end;
              if allfound then
                 break;
         end;
     if OpcodeIndex<0 then
     begin
          if not OpcodeFound then
             OutputDebug.Output('Unknown opcode: "'+s2+'"')
          else
              OutputDebug.Output('Invalid combination of opcode and operands: "'+GetStatement+'"');
          Exit;
     end;
     {$ifdef WeAreDebugging}
     op1binary:='';
     op2binary:='';
     op3binary:='';
     prefixbinary:='';
     opcodebinary:=opcode[OpcodeIndex].OpcodeInBinary+'(opcode)';
     {$endif}
     result:=opcode[OpcodeIndex].OpcodeInBinary;
     if opcode[OpcodeIndex].modedefined then // if the addressing mode is shown in the instruction set files then...
     begin
          if Opcode[OpcodeIndex].Operand1.OperandDef=MemReference then
             ReferenceToBinary(Opcode[OpcodeIndex].Operand1.Name,opa[1],true,AddressingMode,error,pref)
          else if Opcode[OpcodeIndex].Operand2.OperandDef=MemReference then
               ReferenceToBinary(Opcode[OpcodeIndex].Operand2.Name,opa[2],true,AddressingMode,error,pref);
          ModeBinary:=Copy(IntToBinary(AddressingMode,1),7,2);
          result:=result+ModeBinary+opcode[OpcodeIndex].MachAfterMode;
          // add the binary digits for the addressing mode
          // Also, add any machine code bits that should be to the right of the addressing mode
          {$ifdef WeAreDebugging}
          if pref<>'' then
             prefixbinary:=pref+'(prefix)';
          {$endif}
          result:=pref+result;
          // ReferenceToBinary function may have put some binary for prefixes like segment overrides
          // these binary digits should be added before the opcode
     end;
     if operandcount>0 then
     begin
          if opcode[OpcodeIndex].RevMachOperand then
             goto AddSecondOperand;
          AddFirstOperand:

          Op1Binary:=GetOperandsBinary(opa[1],Opcode[OpcodeIndex].Operand1);
          result:=result+op1binary;
          if opcode[OpcodeIndex].RevMachOperand then
             goto EndOfAddFirst2Operands;
          AddSecondOperand:
          if operandcount>1 then
          begin
               Op2Binary:=GetOperandsBinary(opa[2],Opcode[OpcodeIndex].Operand2);
               result:=result+op2binary;
               if opcode[OpcodeIndex].RevMachOperand then
                  goto AddFirstOperand;
          end;
          EndOfAddFirst2Operands:

          if OperandCount>2 then
          begin
               Op3Binary:=GetOperandsBinary(opa[3],Opcode[OpcodeIndex].Operand3);
               result:=result+op3binary;
          end;
          {$ifdef WeAreDebugging}
          if (Length(result) and 7<>0) then
          begin
               s:=s2; // opcode name
               if opcode[OpcodeIndex].RevMachOperand then
               begin
                    s2:=op1binary;
                    op1binary:=op2binary;
                    op2binary:=s2;
                    // binary for operands swapped
               end;
               if operandCount>0 then
               begin
                    s:=s+' '+opa[1];
                    if OperandCount>1 then
                    begin
                         s:=s+', '+opa[2];
                         if OperandCount>2 then
                            s:=s+', '+opa[3];
                    end;
               end;
               s2:=Opcode[OpcodeIndex].opcode;
               if Opcode[OpcodeIndex].operand1.name<>'' then
               begin
                    s2:=s2+' '+Opcode[OpcodeIndex].operand1.name;
                    if Opcode[OpcodeIndex].operand2.name<>'' then
                    begin
                         s2:=s2+', '+Opcode[OpcodeIndex].operand2.name;
                         if Opcode[OpcodeIndex].operand3.name<>'' then
                            s2:=s2+', '+Opcode[OpcodeIndex].operand3.name;
                    end;
               end;
               s2:=s2+'; ';
               s2:=s2+prefixbinary;
               if opcodebinary<>'' then
               begin
                    if prefixbinary<>'' then
                       s2:=s2+'+';
                    s2:=s2+opcodebinary;
               end;
               if ModeBinary<>'' then
               begin
                    if s2<>'' then
                       s2:=s2+'+';
                    s2:=s2+ModeBinary+Opcode[OpcodeIndex].MachAfterMode;
               end;
               if op1binary<>'' then
               begin
                    if s2<>'' then
                       s2:=s2+'+';
                    s2:=s2+op1binary;
               end;
               if op2binary<>'' then
                    s2:=s2+op2binary;
               if op3binary<>'' then
                    s2:=s2+op3binary;
               ShowMessage('Error assembling '+s+' ; binary result is '+s2+'  which has a length of '
               +Inttostr(Length(result))+' which is not a multiple of 8.');
          end;
          {$endif}
     end;
end;

procedure AppendCompiledProgramWithBinary(bins: string);
// convert bins, a string of binary digits, to some bytes and add that to the end of the COM program
var
  b: byte;
  x,x2,y: integer; // loop counter
  len1,len2: integer; // stores length of bins
begin
     if bins='' then exit; // no need to do anything when there is nothing to add to the array
     len1:=length(bins);
     {$IfDef WeAreDebugging}
     if len1 and 7<>0 then
     begin
          ShowMessage('Error getting a multiple of 8 binary digits for a machine code instruction: "'+bins+'"');
          OutputDebug.Output('Error getting a multiple of 8 binary digits for a machine code instruction: '+Bins);
          OutputDebug.Output('This error is in an instruction set file.  Contact the people that created the instruction set file and tell them what instruction caused the problem.');
     end;
     {$EndIf}
     len2:=len1 shr 3;
     SetLength(CompiledProgram,high(CompiledProgram)+1+len2);
     dec(len2);
     for x:=len2 downto 0 do // loop from the first byte(first in string) to the end
     begin
          b:=0;
          x2:=((x+1) shl 3); // address of the last(lowest order) binary digit in the byte
          for y:=7 downto 0 do
              b:=b or (ord(bins[x2-y]='1') shl y);
          CompiledProgram[high(CompiledProgram)+x-len2]:=b;
     end;
end;

type
    tPointArray = array of tPoint;
    StringArray = array of string;

procedure AddString(var sa: StringArray;const s: string);
begin
     SetLength(sa,high(sa)+2);
     sa[high(sa)]:=s;
end;

var OnFirstCodePass: boolean;

function RecInitialPasses(var code: StringArray;var Addresses: tPointArray): integer;
var
  Equates: array of Equate; // contains all the values to replace

  function InsertEquates(s: string): string;
  {
  s = the line of code
  result = the string with all the equates inserted
  }
  var
     pos1,pos2: integer;
     CurSection: string;
  begin
       pos1:=0;
       pos2:=1;
       CurSection:=' ';
       while (pos2<>0)and(CurSection<>'') do // loop through all the sections(words,identifiers...) of the line
       begin
            CurSection:=copy(s,pos1+1,999);
            pos1:=GetPosOfFirstChar(#09+' +-=*/()[],;',CurSection)+pos1;
            // for each part, check to see if it matches the identifier of an equate

            CurSection:=Copy(s,pos2+1,pos1-pos2-1);
            // if a match is found, replace the equate's identifier with the new value
            pos2:=pos1;
       end;
       result:=s;
  end;
var
  x,pos1: integer;
  labelled, error,commented: boolean;
  CurByte,temp: integer;
  s,s2,s3: string;
  instruct: boolean; // true only when checking lines of code that are inside the definition of a data structure
  LBL: MyCodeLabel;
  TheCode: array of String;
  NewPass: boolean;
begin
     CurByte:=$100;
     instruct:=false;
     error:=false;
     commented:=false;
     NewPass:=OnFirstCodePass;
     Addresses:=nil;
     for x:=0 to high(code) do
     begin // pass through code to assign addresses to labels, possibly set org value,
          s:=code[x];
          RemoveComment(s); // If there is a comment in the line, remove it.
          ReplaceValues(#9,' ',s); // Replace tablets with spaces.
          ClearFirstSpaces(s);
          ClearLastSpaces(s);
          if commented and (s='*') then
             commented:=false;
          CurrentLine:=x;
          if (s<>'')and not commented then
          begin
               s2:=s;
               s3:=ClearFirstWordSpecial(s2,' ');
               if (MyLowerCase(s3)='comment')and(GetWithNoSpaces(s2)='*') then
               begin
                    commented:=true;
                    s:='';
                    s3:='';
               end;
               pos1:=pos(':',s3);
               labelled:=(pos1>1);
               if not labelled then
               begin
                    // Check to see if there is db, dw, or dd just after the first word.
                    // This is another way to have labels.
                    s2:=s;
                    s3:=ClearFirstWordSpecial(s2,' ');
                    s3:=LowerCase(ClearFirstWordSpecial(s2,' '));
                    if (s3='db')or(s3='dw')or(s3='dd') then
                    begin
                         pos1:=Length(s)-Length(s2)-Length(s3)-1;
                         labelled:=true;
                    end
                    else if (s3='=')or(s3='equ') then // equate
                    begin
                         pos1:=Length(s)-Length(s2)-Length(s3)-2;
                         // index of the space or whatever character just after the equate identifier
                         SetLength(Equates,high(Equates)+2);
                         with Equates[high(Equates)] do
                         begin
                              identifier:=Copy(s,1,pos1);
                              NewValue:=s2;
                         end;
                         s:=''; // clear the line
                    end;
                    // if it indicates a label, set pos1 to the character just after the first word.
               end;
               if labelled then // the line has a label if there is a : character on the line
               begin
                    s2:=LowerCase(copy(s,1,pos1-1));
                    labelled:=false;
                    for pos1:=high(labels) downto 0 do
                        if labels[pos1].name=LowerCase(s2) then
                        begin
                             labelled:=true;
                             if Labels[pos1].StaticAddress16<>CurByte then
                             begin
                                  NewPass:=true;
                                  Labels[pos1].StaticAddress16:=CurByte;
                             end;
                             s:=Copy(s,Length(s2)+1,999);
                        end;
                    if not labelled then
                    begin
                    if instruct then
                    begin // label within a structure
                         with structs[high(structs)] do
                         begin
                              SetLength(Attribute,High(Attribute)+2);
                              Attribute[high(Attribute)].name:=s2;
                              if high(Attribute)<=0 then
                                 Attribute[high(Attribute)].Offset:=0
                              else
                                  Attribute[high(Attribute)].Offset:=
                                  Attribute[high(Attribute)-1].Offset+(Length(GetBinaryFor(s)) shr 3);
                         end;
                    end
                    else
                    begin
                         Setlength(labels,high(labels)+2);
                         with labels[high(labels)] do
                         begin
                              labels[high(labels)].name:=s2;
                              StaticAddress16:=CurByte;
                         end;
                         s:=copy(s,pos1+1,999);
                         ClearFirstSpaces(s);
                    end;
                    end;
               end;
               if s<>'' then
               begin
                    if s[1]='#' then  // if the line uses a directive
                    begin
                         if LowerCase(s)='#make_exe#' then
                            OutputDebug.Output('The assembler can''t make exe files')
                         else if LowerCase(s)<>'#case_sensative#' then
                              CaseSensative:=true
                         else if LowerCase(s)<>'#make_com#' then
                              OutputDebug.Output('unrecognized directive: '+s);
                         // ie. s = '#make_COM#'
                         // ie. s = '#make_EXE#'
                    end
                    else if LowerCase(s)='struc' then
                    begin
                         ShowMessage(s);
                    end
                    else if LowerCase(s)='end' then // if this marks the end of the program's code
                         break // break the loop
                    else if s<>'' then // if the line has some code
                    begin
                         pos1:=pos(' ',s);
                         if (LowerCase(copy(s,1,pos1-1))='org')or(LowerCase(copy(s,1,pos1-1))='.org')or(LowerCase(copy(s,1,pos1-1))='.stack') then
                         begin
                              temp:=ImmediateValuetoInt(copy(s,pos1+1,999),false,2,error);
                              CurByte:=CurByte+temp-result;
                              result:=temp;
                              if error then
                                 OutputDebug.Output('error getting the origin value from: '+s);
                         end
                         else if (LowerCase(copy(s,1,pos1-1))='.radix') then
                         begin
                              temp:=ImmediateValuetoInt(copy(s,pos1+1,999),false,2,error);
                              radix:=temp;
                              if error then
                                 OutputDebug.Output('error getting the radix value from: '+s);
                         end
                         else
                         begin
                              OutputDebugMessages:=false;
                              SetLength(TheCode,high(TheCode)+2);
                              s:=InsertEquates(s);
                              TheCode[high(TheCode)]:=s;
                              CurrentLine:=x;
                              s:=GetBinaryFor(s);
                              inc(CurByte,length(s) shr 3);
                              // add the number of bytes of machine code used in this line's assembly statement.
                              SetLength(Addresses,high(Addresses)+2);
                              Addresses[high(Addresses)].x:=CurByte;
                              Addresses[high(Addresses)].y:=x;
                              OutputDebugMessages:=true;
                         end;
                    end;
               end;
          end;
     end;
     if NewPass then
     begin
          OnFirstCodePass:=false;
          RecInitialPasses(code,Addresses);
     end
     else
     begin
          SetLength(Code,high(TheCode)+1);
          for x:=high(TheCode) downto 0 do
              Code[x]:=TheCode[x];
     end;
end;

function GetOrgFirstPass(var Code: StringArray;var Addresses: tPointArray): integer;
// assigns addresses to labels and clears them out of the code
// returns the org value
{  Addresses: array of tpoint;
  // x = addresses after the assembling of each instruction
  // y = line number}
{
Code starts out as an array containing all the code from a source file.
Comments are removed.
Any directives are handled.
The labels are all addressed and then removed.
Each line that may have something to assemble stays for later.  Blank lines are removed because they won't affect the assembling process.
Addresses is an array containing the line numbers so even though lines are removed, debug information can still refer to the same line from the source file.

}

begin
     Structs:=nil;
     CompiledProgram:=nil;
     SetLength(Addresses,0);
     MainFrm.DebugOutput.clear;
     OutputDebugMessages:=true;
     result:=$100; // start of the COM program(default)
     CaseSensative:=false;
     radix:=10; // default radix
     OnFirstCodePass:=true;
     result:=RecInitialPasses(code,Addresses);
end;

function AssembleCodeToFile(code: StringArray; COMFileName: string): string;
var // assemble a program file using the assembly code from the code parameter
  x,by: integer;
  Addresses: tPointArray; // used for identifying line numbers for each line of code
  s,s2: string;
  f: file;
  ASMPDoc: TextFile;
const
     // this is a com program generated when no instructions are in the code.
     NoCodeProgram: array[0..124] of byte = (
     $B4, $0E,{mov ah,0Eh} $BE, $00, $00,{mov si,0 startloop:} $8A, $84, $11, $01,
     {mov al,msg[si]}$CD, $10,{int 10h} $46,{inc si} $0A, $C0,{or al,al} $75, $F5,
     {jnz startloop}$C3,{RET, start of message msg:} $4E, $6F, $20, $70, $72, $6F, $67,
     $72, $61, $6D, $20, $6D, $61, $64, $65, $20, $62, $65, $63, $61, $75, $73,
     $65, $20, $74, $68, $65, $72, $65, $20, $77, $61, $73, $20, $6E, $6F, $20,
     $69, $6E, $73, $74, $72, $75, $63, $74, $69, $6F, $6E, $73, $20, $74, $6F,
     $20, $61, $73, $73, $65, $6D, $62, $6C, $65, $2E, $20, $20, $54, $68, $69,
     $73, $20, $69, $73, $20, $61, $6E, $20, $61, $75, $74, $6F, $6D, $61, $74,
     $69, $63, $61, $6C, $6C, $79, $20, $67, $65, $6E, $65, $72, $61, $74, $65,
     $64, $20, $70, $72, $6F, $67, $72, $61, $6D, $2E, $00);
     { this is data for a program that just says,
     "No program made because there was no instructions to assemble.
     This is an automatically generated program."
     }
begin
     SortOpcodesEfficiency;
     by:=GetOrgFirstPass(code,addresses); // assign addresses to labels and get org value
     CurrentByteCompiling:=by;
     OutputDebugMessages:=true; // start outputing messages
     if not OutputDebug.OutputToGUI then
        OutputDebug.AssignF;
     if MakeAssembleProcessDoc then
     begin
          AssignFile(ASMPDoc,GetFNWithExtentionAs(COMFileName,'txt'));
          Rewrite(ASMPDoc);
     end;
     for x:=0 to high(Code) do // pass through the code to add machine code to the program
     begin
          s:=Code[x];
          CurrentByteCompiling:=Addresses[x].x;
          CurrentLine:=Addresses[x].y;
          s2:=s;
          s:=GetBinaryFor(s);
          if MakeAssembleProcessDoc then
          begin
               s2:=s2+#9;
               s2:=s2+';'+s+'b,   Line: '+IntToStr(CurrentLine)+
               ',    Byte after instruction: '+IntToStr(CurrentByteCompiling-by);
               WriteLN(ASMPDoc,s2);
          end;
          AppendCompiledProgramWithBinary(s);
     end;
     COMFileName:=GetFNWithExtentionAs(COMFileName,'com'); // make the extention 'com'
     AssignFile(f,COMFileName);
     Rewrite(f,1);
     x:=high(CompiledProgram)+1;
     if x>0 then
        BlockWrite(f,CompiledProgram[0],x)
     else
         BlockWrite(f,NoCodeProgram,SizeOf(NoCodeProgram)); // just write the RET instruction to thee file if nothing else
     CloseFile(f);
     if MakeAssembleProcessDoc then
        CloseFile(ASMPDoc);
     OutputDebug.Output('COM program file "'+COMFileName+'" successfully created ['+inttostr(CurrentByteCompiling-$100)+' bytes]');
     result:=COMFileName; // return the name of the program file
     labels:=nil;
     Addresses:=nil;
     if not OutputDebug.OutputToGUI then
        OutputDebug.CloseF;
end;

function AssembleTStringsToFile(code: TStrings; COMFileName: string): string;
var
  StrArray: StringArray;
  lin: integer;
begin
     SetLength(StrArray,code.count+1);
     for lin:=0 to code.count do
         StrArray[lin]:=code[lin];
     result:=AssembleCodeToFile(StrArray,COMFileName);
     StrArray:=nil;
end;

function AssembleSourceFileToProgramFile(SourceFileName,COMFileName: string): string;
// assembles code from SourceFileName into COMFileName and returns the name of the output file.
// if something is wrong with the COMFileName, the result isn't the same as the COMFileName.
var
  StrArray: StringArray;
  s: string;
  tf: TextFile;
begin
     if FileExists(SourceFileName) then
     begin
          AssignFile(tf,SourceFileName);
          Reset(tf);
          StrArray:=nil;
          while not eof(tf) do // loop through the lines of the file loading them into StrArray
          begin
               SetLength(StrArray,high(StrArray)+2);
               ReadLN(tf,s);
               StrArray[high(StrArray)]:=s;
          end;
          CloseFile(tf);
          result:=AssembleCodeToFile(StrArray,COMFileName); // assemble the code and get the name of the outputted program file
          StrArray:=nil;
     end
     else
         ShowMessage('Unable to assemble because the source file "'+SourceFileName+'" could not be found.');
end;

// ---------  HTML Document creating section  --------------

function MakeHTMLOpcodeTable(fn: string): string;
// returns the name of the created HTML file
var
   HTMLf: TextFile; // the HTML file
   y: integer;
   s: string;
const MaxColumn = 4;

   function GetBinaryDisplay(BinStr: string): string;
   // return a formated string that helps organize the binary. (ie. group nibbles and bytes)
   var
     c: integer;
   begin
        for c:=Length(BinStr) shr 3 downto 1 do
        begin
             StringManiU.InsertChar(BinStr,c shl 3+1,' ');
             StringManiU.InsertChar(BinStr,c shl 3+1,',');
             StringManiU.InsertChar(BinStr,c shl 3-3,' ');
        end;
        result:=BinSTR;
   end;

begin
     SortOpcodesAlphabetically; // put opcodes in order so they look better in the html document
     fn:=GetFNWithExtentionAs(fn,'HTML'); // set the file extention
     AssignFile(HTMLf,fn);
     Rewrite(HTMLf);
     WriteLN(HTMLf,'<HTML>');
     WriteLN(HTMLf,'<!-- Created with MyAssembler -->');
     WriteLN(HTMLf,'');
     WriteLN(HTMLf,'<HEAD><TITLE>Instruction Set</TITLE></HEAD>');
     WriteLN(HTMLf,'<BODY>');
     WriteLN(HTMLf,'');
     // make the legend to show the colours with associated instruction set files
     WriteLN(HTMLf,'<TABLE Border="1" CellPadding="3">');
     WriteLN(HTMLf,'<CAPTION><STRONG>Instruction Set Legend</STRONG></CAPTION>');
     for y:=high(SetFiles) downto 0 do
     begin
          WriteLN(HTMLf,' <TR>');
          WriteLN(HTMLf,'   <TD BGColor="#'+IntToHex(SetFiles[y].Colour,6)+'" Width="30"></TD>');
          WriteLN(HTMLf,'   <TD>'+SetFiles[y].FileName+'</TD>');
          WriteLN(HTMLf,' </TR>');
     end;
     WriteLN(HTMLf,'</TABLE>');
     WriteLN(HTMLf,'<BR>');
     // make the opcode table
     WriteLN(HTMLf,'<TABLE Border="1" CellPadding="5">');
     WriteLN(HTMLf,'<CAPTION><STRONG>Instruction Set</STRONG></CAPTION>');
     WriteLN(HTMLf,'<TR><TD><B>Opcode</B></TD><TD><B>Operands</B></TD><TD><B>Machine code</B></TD></TR>');
     for y:=high(Opcode) downto 0 do
     begin
          WriteLN(HTMLf,' <TR BGColor="#'+IntToHex(Opcode[y].Colour,6)+'">'); // set the backround colour
          s:=#09+'<TD>'+Opcode[y].Opcode+'</TD><TD>';
          if Opcode[y].Operand1.Name<>'' then
          begin
               s:=s+' '+Opcode[y].Operand1.Name; // write the first operand
               if Opcode[y].Operand2.Name<>'' then
               begin
                    s:=s+', '+Opcode[y].Operand2.Name; // write the second operand if there is one
                    if Opcode[y].Operand3.Name<>'' then
                       s:=s+', '+Opcode[y].Operand3.Name; // write the third operand if there is one
               end;
          end;
          WriteLN(HTMLf,s+'</TD><TD>'+GetBinaryDisplay(Opcode[y].OpcodeInBinary)+'</TD>'); // add in the binary
          if Opcode[y].Diasmonly or Opcode[y].RevMachOperand then
          begin
               s:='   <TD>';
               if Opcode[y].Diasmonly then
                  s:=s+'DiasmOnly ';
               if Opcode[y].RevMachOperand then
                  s:=s+' RevMachOperand ';
               s:=s+'   </TD>';
               WriteLN(HTMLf,s);
          end;
          WriteLN(HTMLf,' </TR>');
     end;
     WriteLN(HTMLf,'');
     WriteLN(HTMLf,'</TABLE>');
     WriteLN(HTMLf,'');
     WriteLN(HTMLf,'<SUB>Opcode table created with MyAssembler</SUB>');
     WriteLN(HTMLf,'');
     WriteLN(HTMLf,'</BODY>');
     WriteLN(HTMLf,'</HTML>');
     CloseFile(HTMLf);
     result:=fn;
end;

function MakeSourceCodeHTMLDocument(code: TStrings;fn,Title: string): string;
// creates an html document for displaying assembly code
{
For each line, the keyword, label, data(db,dw,dd...), opcode(mov, lea...), and
comment should be split into separate strings and added together using html formatting

This should be done when you read this.

}
var
  HTMLf: TextFile;
  s,s2,s3,s4: string;
  lin: integer;
  x,y: integer;
  forloopvar: integer;
  labelStr, KeyWordStr,dataStr,OpcodeStr,OperandStr,CommentStr: string;
  commented,FoundKeyWord,CollinLabelled: boolean;
const KeyWords: array[0..9] of string =('org','.org','.stack','end','#make_com#','.radix','struc','endstruc','istruc','iend');
// words to format as keywords
const
   InternalDoc = '"Purple"'; // colour of the documentation
   BGColour = '"White"'; // colour of the background
   LBLColour = '"Maroon"'; // colour of the labels
   LineCountColour='"Gray"'; // colour of line count
   KeyWordsColour='"DarkGreen"'; // colour for keywords
   OpcodeColour='"Black"'; // colour for opcodes
   OperandsColour='"Navy"'; // colour for operands
   DataColour='"#404040"'; // colour for data definitions
begin
     fn:=GetFNWithExtentionAs(fn,'HTML');
     AssignFile(HTMLf,fn);
     Rewrite(HTMLf);
     WriteLN(HTMLf,'<HTML>');
     WriteLN(HTMLf,'<!-- Created with MyAssembler -->');
     WriteLN(HTMLf,'');
     WriteLN(HTMLf,'<HEAD><TITLE>Source code for '+Title+'</TITLE></HEAD>');
     WriteLN(HTMLf,'<BODY>');
     WriteLN(HTMLf,'<H2>'+ShortenName(Title)+'</H2>');
     WriteLN(HTMLf,'<TABLE BgColor='+BGColour+' CellPadding="0" CellSpacing="0" Border="1" bordercolor="#F0F0F0">');
     commented:=false;
     for lin:=0 to code.count do
     begin
          WriteLN(HTMLf,'<TR><TD Width="40"><FONT COLOR='+LineCountColour+'>'
          +IntToStr(lin)+'</FONT></TD>');
          WriteLN(HTMLf,'<TD>');
          s:=code[lin];
          // replace the greater than, and less than signs with entities so they aren't confused with tags
          ReplaceValues('<','&lt',s);
          ReplaceValues('>','&gt',s); // There are no < or > signs left in the string.
          //ReplaceValues(#9,'<dd>',s); // tabulates used for indenting before the first text(none-space, none-tabulate)
          // it was eliminated because sometimes it is tabbed in without

          ClearFirstSpaces(s);
          ClearLastSpaces(s);
          ClearDoubleSpaces(s);
          CommentStr:='';
          KeywordStr:='';
          LabelStr:='';
          DataStr:='';
          OpcodeStr:='';
          OperandStr:='';
          if not commented then
          begin
               x:=pos(';',s);
               y:=pos('//',s);
               if (x>0)and(y<=0) then
                  y:=x
               else if (x<=0)and(y>0) then
                    x:=y;
               if x<y then
                  y:=x;
               if y<>0 then
               // if documentation is on the line, use italic and the documentation colour on it
               begin
                    CommentStr:=Copy(s,y,999);
                    s:=Copy(s,1,y-1);
               end;
          end;
          if commented then
             CommentStr:=s
          else if LowerCase(GetWithNoSpaces(s))='comment*'then // multilined comment
          begin
               CommentStr:=s;
               commented:=true;
          end;
          if GetWithNoSpaces(s)='*' then // the end of a multilined comment
          begin
               CommentStr:=s;
               commented:=false;
          end;
          if CommentStr=s then
               s:='';
          if not commented and (s<>'') then // no multilined comment is used
          begin
               s3:=ClearFirstWordSpecial(s,' '+#9);
               s2:=s;
               CollinLabelled:=(s3[Length(s3)]=':'); // labelled set to true only if : is found in the first word
               if not CollinLabelled then
               begin
                    s3:=LowerCase(s3);
                    if (s3='db')or(s3='dw')or(s3='dd')or(s3='dq')or(s3='dp') then
                       s4:=s3
                    else
                        s4:=LowerCase(GetFirstWordSpecial(s2,' '+#9))
               end
               else
               begin
                    LabelStr:=s3+' ';
                    s3:=LowerCase(s3);
                    s4:=LowerCase(GetFirstWordSpecial(s2,' '+#9));
               end;
               if (s4='db')or(s4='dw')or(s4='dd')or(s4='dq')or(s4='dp') then
               begin
                    if not CollinLabelled then
                    begin

                         if not ((s3='db')or(s3='dw')or(s3='dd')or(s4='dq')or(s4='dp')) then
                            LabelStr:=s3+' ';
                    end;
                    if s3<>s4 then
                       ClearFirstWordSpecial(s,' '+#9);
                    FoundKeyword:=true;
                    dataStr:=s4;
               end;
               FoundKeyWord:=false;
               s4:=LowerCase(s3);
               for forloopvar:=high(KeyWords) downto 0 do
               begin
                    if s4=KeyWords[forloopvar] then
                    begin
                         KeywordStr:=s3;
                         FoundKeyWord:=true;
                         break;
                    end;
               end;
               if not FoundKeyWord then
               begin
                  if (s4='db')or(s4='dw')or(s4='dd')or(s4='dq')or(s4='dp') then
                  begin
                       DataStr:=s3;
                       FoundKeyWord:=true;
                  end
                  else
                  for forloopvar:=high(Opcode) downto 0 do
                  begin
                       if s4=Opcode[forloopvar].Opcode then
                       begin
                            OpcodeStr:=s3;
                            FoundKeyWord:=true;
                            break;
                       end;
                  end;
               end;
               if not FoundKeyWord and (LabelStr='') then
                  s:=s3+' '+s;
               OperandStr:=s;
          end;

          if LabelStr='' then
             s:='<DD>' // indent any line other than ones using labels
          else
              s:='<FONT Color='+LBLColour+'>'+LabelStr+'</FONT>';
          if KeywordStr<>'' then
             s:=s+'<FONT Color='+KeywordsColour+'><B>'+KeywordStr+'</B></FONT>';
          if DataStr<>'' then
             s:=s+'<FONT Color='+DataColour+'><B>'+DataStr+'</B></FONT>';
          if OpcodeStr<>'' then
             s:=s+'<FONT Color='+OpcodeColour+'><B>'+OpcodeStr+'</B></FONT>';
          if OperandStr<>'' then
             s:=s+'<FONT Color='+OperandsColour+'> '+OperandStr+' </FONT>';
          if CommentStr<>'' then
             s:=s+'<FONT Color='+InternalDoc+'><I>'+CommentStr+'</I></FONT>';

          WriteLN(HTMLf,s);
          WriteLN(HTMLf,'</TD></TR>');
     end;
     WriteLN(HTMLf,'</TABLE>');
     WriteLN(HTMLf,'<SUB>created with MyAssembler</SUB>');
     WriteLN(HTMLf,'</BODY>');
     WriteLN(HTMLf,'</HTML>');
     CloseFile(HTMLf);
     result:=fn;
end;


// ------------------------- Disassembling section ----------------------------

function GetByteInBinary(b: byte): string;
var // returns a string of '1' and '0' characters that store the b value in binary
  c: byte;
begin
     result:='';
     for c:=7 downto 0 do
         result:=result+chr(48+ord(((b shr c) and 1)<>0));
end;


function DisassembleMemoryReference(DefineString: string;mode: byte;PrefixNum: integer; var BinString: string): string;
{
 DefineString = the type of operand or define (ie. 'mem','mem8','mem16','mem32','memf')
BinString = the binary for machine code that starts at the beginning of the operand
          The first bits of the string that store the operand are removed
result = the disassembled operand
}
var
  x: byte;
  Offset: integer;
  error: boolean;
  memSize,OffsetStr: string;
begin
     result:='?';
     if length(BinString)>=19 then
     begin
          memSize:='';
          if DefineString='mem8' then // 8-bit reference
             memSize:='BYTE PTR '
          else if DefineString='mem16' then // 16-bit reference
             memSize:='WORD PTR '
          else if DefineString='mem32' then // 32-bit reference
             memSize:='DWORD PTR '
          else if DefineString='mem64' then // quad word
             memSize:='QWORD PTR '
          else if DefineString='mem80' then // penta word(I made it up because I couldn't find any uses for it)
             memSize:='PWORD PTR '
          else if DefineString='mem128' then // octal word(I made it up because I couldn't find any uses for it)
             memSize:='OWORD PTR ';
          if PrefixNum>=0 then
             case PrefixNum of
              CSoverride: memSize:=memSize+'CS:';
              DSoverride: memSize:=memSize+'DS:';
              ESoverride: memSize:=memSize+'ES:';
              FSoverride: memSize:=memSize+'FS:';
              GSoverride: memSize:=memSize+'GS:';
              SSoverride: memSize:=memSize+'SS:';
             end;
          x:=BinToInt(copy(BinString,1,3),error);
          if (mode=1)or(mode=2)or((mode=0)and(x=6)) then
          begin
               Offset:=BinToInt(copy(BinString,4,8),error);
               if (mode=2)or((mode=0)and(x=6)) then
                  Offset:=Offset or (BinToInt(copy(BinString,12,8),error) shl 8);
          end
          else
              Offset:=0;
          if (mode=0)and(x=6) then
              OffsetStr:=IntToHex(Offset,4)+'h'
          else if (mode=0)or(mode=3) then
             OffsetStr:=''
          else
              OffsetStr:='+'+IntToHex(Offset,mode shl 1)+'h';
          if mode<>3 then // for modes 0,1, and 2
             case x of
               0: result:=memSize+'[BX+SI'+OffsetStr+']';
               1: result:=memSize+'[BX+DI'+OffsetStr+']';
               2: result:=memSize+'[BP+SI'+OffsetStr+']';
               3: result:=memSize+'[BP+DI'+OffsetStr+']';
               4: result:=memSize+'[SI'+OffsetStr+']';
               5: result:=memSize+'[DI'+OffsetStr+']';
               6: if mode=0 then
                     result:=memSize+'['+OffsetStr+']'
                  else
                      result:=memSize+'[BP'+OffsetStr+']';
               7: result:=memSize+'[BX'+OffsetStr+']';
             end
          else
             case x of // for addressing mode 3
               0: result:=memSize+'[AX]';
               1: result:=memSize+'[CX]';
               2: result:=memSize+'[DX]';
               3: result:=memSize+'[BX]';
               4: result:=memSize+'[SP]';
               5: result:=memSize+'[BP]';
               6: result:=memSize+'[SI]';
               7: result:=memSize+'[DI]';
             end;
          case mode of
          0: begin
                  if x=6 then
                     BinString:=copy(BinString,20,999) // 3-bit R/M and 16-bit offset
                  else
                      BinString:=copy(BinString,4,999); // 3-bit R/M and no offset
             end;
          1: BinString:=copy(BinString,12,999); // 3-bit R/M and 8-bit offset
          2: BinString:=copy(BinString,20,999); // 3-bit R/M and 16-bit offset
          3: BinString:=copy(BinString,4,999); // 3-bit R/M and no offset
          end;
          // eliminate the bits used for this memory reference
     end;
end;

function DisassembleOperand(DefineString: string;AddressingMode: byte; PrefixNum: integer; var BinString: string): string;
{
DefineString = the type of operand or define (ie. 'reg8', 'reg16','i8','i16')
BinString = the binary for machine code that starts at the beginning of the operand
          The first bits of the string that store the operand are removed
result = the disassembled operand
}
var
  w: integer;
  x,sy: integer;
  error: boolean;
  s: string;
begin
     result:='?';
     if DefineString[1]='i' then
     begin
          if DefineString='i8' then // 8 bit immediate value
          begin
               s:=copy(BinString,1,8);
               result:=IntToHex(BinToInt(s,error),2)+'h';
               BinString:=Copy(BinString,9,999);
               Exit; // return the byte in hex
          end
          else if DefineString='i16' then // 16 bit immediate value
          begin
               w:=BinToInt(copy(BinString,1,8),error);
               w:=(BinToInt(copy(BinString,9,8),error) shl 8) or w;
               result:=IntToHex(w,4)+'h'; // return the word in hex
               BinString:=Copy(BinString,17,999);
               Exit;
          end
          else if DefineString='i32' then
          begin
               w:=BinToInt(copy(BinString,1,8),error);
               w:=(BinToInt(copy(BinString,9,8),error) shl 8) or w;
               w:=(BinToInt(copy(BinString,17,8),error) shl 16) or w;
               w:=(BinToInt(copy(BinString,25,8),error) shl 24) or w;
               result:=IntToHex(w,8)+'h'; // return the DWord in hex
               BinString:=Copy(BinString,33,999);
               Exit;
          end;
     end
     else
     if pos('mem',DefineString)=1 then
     begin
          if (DefineString='mem')or(DefineString='mem8')or(DefineString='mem16')or
          (DefineString='mem32')or(DefineString='mem64')or(DefineString='mem80') then
          begin // if the operand is a memory reference, disassemble it and exit
               result:=DisassembleMemoryReference(DefineString,AddressingMode,PrefixNum,BinString);
               exit;
          end;
     end;
     // loop to try finding the define in the defines array
     for w:=high(defines) downto 0 do
         if DefineString=defines[w].name then
         begin
              // loop to find the symbol in define[w] that matches the binary
              for x:=high(defines[w].values) downto 0 do
              begin
                   for sy:=high(Symbols) downto 0 do
                   begin
                       if Symbols[sy].symbol=defines[w].values[x] then
                       if StringEqual(Symbols[sy].binary,BinString) then
                       begin
                            result:=Symbols[sy].symbol; // ie. result = 'al'
                            BinString:=Copy(BinString,1+Length(Symbols[sy].binary),999);
                            exit;
                       end;
                   end;
              end;
         end;
     ShowMessage('Unable to get '+DefineString+' type operand from bit stream: '+Copy(BinString,1,10)+'...');
     MyCritError:=true; // if the thing couldn't be disassembled by now, there is a problem.
end;

function DecodeInstructionFromBinaryStr(var s: string;var opc: integer): integer;
// replaces s with an assembly statement
// opc becomes the index of the instruction into the opcode array, if the instruction is decoded properly
// returns the number of bytes used to store the instruction in machine code
var
   x: integer;
   found: boolean;
   binStr,binStrBackUp: string;
   operand1,operand2: string;
   s2: string;
   AddressingMode: byte; // used for instructions containing memory references
   PrefixNum: integer;
   label EndOfPass;
   label EndOfDecodeOperands;
   label FirstOperand;
   label SecondOperand;
begin
     // s = all bytes of the ShortBuf converted to binary
     BinStr:=s;
     binStrBackUp:=BinStr;
     result:=0;
     AddressingMode:=2;
     PrefixNum:=-1;
     for x:=High(Prefixes) downto 0 do
         if StringEqual(Prefixes[x],BinStr) then
         begin
              PrefixNum:=x;
              BinStr:=Copy(BinStr,Length(Prefixes[x])+1,999);
              break;
         end;
     found:=false;
     for x:=High(Opcode) downto 0 do // loop through the opcodes to find one that uses the same machine code as BinStr
         if not Opcode[x].AsmOnly then
         if StringEqual(Opcode[x].OpcodeInBinary,BinStr) then
         begin
              s:=Opcode[x].Opcode;

                BinStr:=copy(BinStr,1+length(Opcode[x].OpcodeInBinary),999);
                {Now, the opcode section is removed from the string. so we can
                focus on decoding operands.}
                if Opcode[x].modedefined then
                begin
                     if BinStr[1]='1' then
                        AddressingMode:=2
                     else
                         AddressingMode:=0;
                     if BinStr[2]='1' then
                        AddressingMode:=AddressingMode or 1;
                     if AddressingMode=3 then // addressing mode 3 is not actually used.
                     begin
                          binStr:=binStrBackUp;
                          goto EndOfPass; // keep searching for a match because this isn't it.
                     end;
                     // cut the 2 first bits off the binary stream
                     if Opcode[x].MachAfterMode<>'' then
                        if copy(binStr,1,length(Opcode[x].MachAfterMode))<>Opcode[x].MachAfterMode then
                        begin
                             binStr:=binStrBackUp;
                             goto EndOfPass; // keep searching for a match because this isn't it.
                        end;
                     BinStr:=Copy(BinStr,3+Length(Opcode[x].MachAfterMode),999);
                end;
                if Opcode[x].Operand1.Name<>'' then
                // if there is atleast 1 operand then
                begin
                     // now, lets decode the first operand and add its symbol or immediate value to the assembly statement
                     if Opcode[x].RevMachOperand then
                        goto SecondOperand;
                     FirstOperand:
                     s2:=Opcode[x].Operand1.Name; // ie. s3 = 'reg8'
                     if Opcode[x].Operand1.nomachinecode then
                        operand1:=Opcode[x].Operand1.name
                     else
                         operand1:=DisassembleOperand(s2,AddressingMode,PrefixNum,BinStr);
                     if Opcode[x].RevMachOperand then
                        goto endofDecodeOperands;
                     SecondOperand:
                     if Opcode[x].Operand2.Name<>'' then
                     begin
                          s2:=Opcode[x].Operand2.Name; // ie. s2 = 'i8'
                          if Opcode[x].Operand2.nomachinecode then
                             operand2:=Opcode[x].Operand2.name
                          else
                              operand2:=DisassembleOperand(s2,AddressingMode,PrefixNum,BinStr);
                     end;
                     if Opcode[x].RevMachOperand then
                          goto FirstOperand;
                     EndOfDecodeOperands:

                     // Now, add the operands on to the end of the opcode
                     if operand1<>'' then
                     begin
                          s:=s+' '+operand1;
                          if operand2<>'' then
                             s:=s+', '+operand2;
                     end;
                end;
                result:=((Length(binStrBackUp)-Length(BinStr)) shr 3);
                found:=true;
                opc:=x;
                break;
                EndOfPass:
           end;
       if not found then
       begin
            ShowMessage('Unable to resolve instruction from binary stream '+copy(binStrBackUp,1,24)+'...');
            MyCritError:=true;
            s:='';
            result:=0;
       end;
end;

procedure DisassembleCOMProgramToStrings(var Code: StringArray; const COMFN: string);
const NumBytesToRead = 1024;
var
  ProgramBuffer: array of byte;// stores all the program file's data
  ReadingBuffer: array[0..NumBytesToRead-1] of byte;
  f: file;
  x,y,z,HighProgramBuffer: integer;
  Bread: integer;
  s: string;
begin
     if FileExists(COMFN) then
     begin
          AssignFile(f,COMFN);
          Reset(f,1);
          SetLength(Code,0); // clear the array
          AddString(Code,'; program: '+COMFN);
          AddString(Code,'; disassembled with MyAssembler');
          AddString(Code,'; machine code for each statement is commented beside the statement');
          AddString(Code,'');
          BRead:=NumBytesToRead;
          MyCritError:=false;
          while not eof(f) and (BRead=NumBytesToRead) do
          begin
               BlockRead(f,ReadingBuffer,NumBytesToRead,Bread);
               y:=high(ProgramBuffer)+1;
               SetLength(ProgramBuffer,y+Bread-1);
               for x:=BRead-1 downto 0 do
                   ProgramBuffer[x+y]:=ReadingBuffer[x];
          end;
          y:=1;
          BRead:=0; // Now, BRead stores the offset into the programbuffer for decoding each instruction
          HighProgramBuffer:=High(ProgramBuffer);
          while (y<>0) and (BRead<HighProgramBuffer+2) do
          begin
               // convert bytes to a binary string and store the string in s
               s:='';
               for x:=0 to 15 do
                   s:=s+GetByteInBinary(ProgramBuffer[x+BRead]);
               y:=DecodeInstructionFromBinaryStr(s,x);
               // show the machine code in the comment
               s:=s+#09+#09+'; db ';
               for z:=0 to y-1 do
               begin
                    s:=s+IntToHex(ProgramBuffer[z+BRead],2)+'h';
                    if z<y-1 then // if this is not the last byte of machine code for the instruction
                       s:=s+', ';
               end;
               if not MyCritError then
               begin
                    inc(BRead,y);
                    AddString(Code,s); // add the assembly statement to code
                    if (x>0)and(x<=high(Opcode)) then
                    begin
                         if Opcode[x].stopDiasm then
                            AddString(Code,'');
                         if Opcode[x].Branch then
                            AddString(Code,'');
                    end;
               end
               else
                   break;
          end;
          if BRead<HighProgramBuffer then
          begin
               // hex dump here
               AddString(Code,'; disassembling process incomplete because of an error');
               AddString(Code,'');
               AddString(Code,'; The rest of the program will use a hex dump.');
               while (BRead<HighProgramBuffer) do
               begin
                    s:='db ';
                    for x:=7 downto 0 do // loop through bytes on the line so more than one byte can go on each line
                    begin
                         if BRead>=HighProgramBuffer then
                            break;
                         s:=s+IntToHex(ProgramBuffer[BRead],2)+'h';
                         if (BRead<HighProgramBuffer)and(x<>0) then
                            s:=s+',';
                         inc(BRead);
                    end;
                    AddString(Code,s);
               end;
          end;
          CloseFile(f); // Close the program file
     end
     else
         ShowMessage('COM program file not found: '+COMFN);
end;

procedure DisassembleCOMProgram(Code: TStrings; COMFN: string);
// Disassemble a COM file and store the source in the code parameter.
var
  x: integer;
  sa: StringArray;
begin
     SortOpcodesMachine;
     DisassembleCOMProgramToStrings(sa,COMFN);
     Code.Clear;
     for x:=0 to high(sa) do
         Code.Add(sa[x]);
     SetLength(sa,0);
end;

// ----------------------------------------------------------------------------
// ----------------------- EXE file disassembling -----------------------------
const EXEFileSigniture = $4D5A;
      HighBigBuf = 255;

procedure DisassembleEXEProgram(Code: TStrings; EXEFN: string);
// disassemble an EXE file and put the source code in Code
var
  f: file;
  Bigbuffer: array[0..HighBigBuf] of byte;
  w: word;

  function GetWordFromArrayAtByte(i: integer): word;
  begin
       result:=BigBuffer[i] or (BigBuffer[i+1] shl 8);
  end;

begin
     if FileExists(EXEFN) then
     begin
          AssignFile(f,EXEFN);
          Reset(f,1);
          Code.Clear;
          Code.Add('; program: '+EXEFN);
          Code.Add('; disassembled with MyAssembler');
          Code.Add('; ps: This is at the very beginning of development and is not working at all');
          Code.Add('');
          BlockRead(f,BigBuffer[0], HighBigBuf);
          w:=GetWordFromArrayAtByte(0);
          Code.Add('; EXE Signature:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(2);
          Code.Add('; length of last used sector in file:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(4);
          Code.Add('; size of file, incl. header:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(6);
          Code.Add('; number of relocation table items:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(8);
          Code.Add('; size of header:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(10);
          Code.Add('; min. paragraphs needed above program:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(12);
          Code.Add('; max. paragraphs needen above program:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(14);
          Code.Add('; displacement of stack segment in module rel. to start of prog.:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(16);
          Code.Add('; contents of SP reg. at entry:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(18);
          Code.Add('; checksum:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(20);
          Code.Add('; contents of IP reg. at entry:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(22);
          Code.Add('; displacement of code module rel. to start of prog.:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(24);
          Code.Add('; offset to first relocation item in file rel. to start of prog.:');
          Code.Add('dw '+IntToHex(w,4)+'h');
          w:=GetWordFromArrayAtByte(26);
          Code.Add('; overlay number 0 for resident prog.:');
          Code.Add('dw '+IntToHex(w,4)+'h');

          CloseFile(f);
     end
     else
         ShowMessage('Not able to find EXE file to disassemble: '+EXEFN);


end;

// ----------------------------------------------------------------------------

function BinStrToByteCPPHex(BinStr: string;count:integer;var NumBytes: integer): string;
var
  b: byte;
  c,c2: integer;
  e: boolean;
begin
     dec(count);
     result:='';
     NumBytes :=0;
     for c:=0 to count do // loop through bytes
     begin
          b := BinToInt(copy(BinStr,1,8),e);
          if e then
             break;
          result := result + '0x'+IntToHex(b,2);
          inc(NumBytes);
          if c<>count then
             result:=result+',';
          if length(Binstr)<8 then
          begin
               if Binstr<>'' then
               begin
                    for c2:=length(Binstr) to 8 do
                    begin
                         Binstr:=Binstr+'0';
                    end;
                    b := BinToInt(copy(BinStr,1,8),e);
                    result := result + '0x'+IntToHex(b,2)+',';
                    //inc(c); // not allowed because c is a control variable in the for-loop
                    // this increment is now done with assembly where Delphi won't complain. :P
                    asm
                       inc dword [c];
                    end;
               end;
               break;
          end;
          BinStr := copy(BinStr,8,999); // remove first byte from the string
     end;
     if c<>count then
     begin
        for c2:=c+1 to count do
        begin
             result:=result+'0x00';
             if c2<>count then
                result:=result+',';
        end;
     end;
end;

function MyOperandToCPPString(op: MyOperand): string;
begin
     result:='{NoMachineCode: '+inttostr(ord(op.NoMachineCode))+',';
     result:=result+'type: '+op.Name+'}';
end;

function OperandCount(op:MyOpcode): integer;
begin
     if op.operand1.name='' then
        result:=0
     else if op.operand2.name='' then
          result:=1
     else if op.operand3.name='' then
          result:=2
     else
         result:=3;
end;

procedure MakeOpcodeHeader;
var
  tf: TextFile;
  x,y,usedBytes: integer;
  s: string;
  e: boolean;
  TheOpcode: MyOpcode;
  
const LineSpace = '   ';
      MaxBytesOfMachineCode = 5;
      // maximum number of bytes of machine code to start an instruction
begin
     SortOpcodesAlphabetically;
     // make sure the array of opcodes is sorted by name
     AssignFile(tf,'opcodes.h');
     Rewrite(tf);
     WriteLn(tf,'/*');
     WriteLn(tf,'* file created by MyAssembler');
     WriteLn(tf,'* Date file Created: '+DateToStr(date));
     WriteLn(tf,'* defines opcodes and data to assemble those opcodes');
     WriteLn(tf,'*/');
     WriteLn(tf,'');
     WriteLn(tf,'// define the operand types');
     y:=high(Defines);
     for x:=y downto 0 do
     begin
          WriteLn(tf,'#define '+Defines[x].name+' '+inttostr(x));
     end;
     inc(y);
     WriteLn(tf,'#define mem '+inttostr(y)+' // any memory reference can be of this type');
     inc(y);
     WriteLn(tf,'#define i8 '+inttostr(y)+' // 8-bit immediate values');
     inc(y);
     WriteLn(tf,'#define mem8 '+inttostr(y)+' // 8-bit memory references');
     inc(y);
     WriteLn(tf,'#define i16 '+inttostr(y)+' // 16-bit immediate values');
     inc(y);
     WriteLn(tf,'#define mem16 '+inttostr(y)+' // 16-bit memory references (word)');
     inc(y);
     WriteLn(tf,'#define mem32 '+inttostr(y)+' // 32-bit memory references (dword)');
     inc(y);
     WriteLn(tf,'#define mem64 '+inttostr(y)+' // 64-bit memory references (qword)');
     inc(y);
     WriteLn(tf,'#define mem80 '+inttostr(y)+' // 80-bit memory references (10 bytes used for some floating point values pword)');
     inc(y);
     WriteLn(tf,'#define mem128 '+inttostr(y)+' // 128-bit memory references (used for some MMX - oword)');
     WriteLn(tf,'// stck = st0,st1,st2,st3,st4,st5,st6,st7 are all to be defined elsewhere');

     WriteLn(tf,'// Here are some "types" of operands that are actually constants.');
     WriteLn(tf,'// These are used for instructions that take operands that have to be specific values.');
     inc(y);
     WriteLn(tf,'#define al '+inttostr(y)+' // al register');
     inc(y);
     WriteLn(tf,'#define ax '+inttostr(y)+' // ax register');
     inc(y);
     WriteLn(tf,'#define cl '+inttostr(y)+' // cl register');
     inc(y);
     WriteLn(tf,'#define dl '+inttostr(y)+' // dl register');
     inc(y);
     WriteLn(tf,'#define dx '+inttostr(y)+' // dx register');


     WriteLn(tf,'');
     WriteLn(tf,'struct Operand // stores information on an operand');
     WriteLn(tf,'{');
     WriteLn(tf,'  short int NoMachineCode;');
     WriteLn(tf,'    // 0 usually, meaning the operand does add machine code to the instruction');
     WriteLn(tf,'  short int type;');
     WriteLn(tf,'    // indicates what type of operand it is (ie. is it a mem16?, mem8?)');
     WriteLn(tf,'};');
     WriteLn(tf,'');
     WriteLn(tf,'#define MaxMachCodeBytes '+inttostr(MaxBytesOfMachineCode));
     WriteLn(tf,'// maximum number of bytes of machine code used to begin a machine code instruction');
     WriteLn(tf,'');
     WriteLn(tf,'// this is not enough information to assemble all instructions though.');
     WriteLn(tf,'// this is not complete.');
     WriteLn(tf,'struct Opcode');
     WriteLn(tf,'{');
     WriteLn(tf,'   char OpcodeClassName[50]; ');
     WriteLn(tf,'     // string stores the name of the opcode class (ie. "jmp") always in lower case');
     WriteLn(tf,'   unsigned char MachineCode[MaxMachCodeBytes]; // stores some machine code');
     WriteLn(tf,'   short int OpcodeDefSize; ');
     WriteLn(tf,'     // number of bytes of unchangable machine code at the beginning of the instruction');
     WriteLn(tf,'   short int NumOfOperands; ');
     WriteLn(tf,'     // stores number of operands used by the instruction(0..3)');
     WriteLn(tf,'   short int RevMachOperand; ');
     WriteLn(tf,'     // 0, usually indicating the machine code for operands is not to be reversed');
     WriteLn(tf,'     // nonzero, when the machine code for operands is to be reversed');
     WriteLn(tf,'   Operand operand1; // first operand, often needed but not always');
     WriteLn(tf,'   Operand operand2; // second operand, if needed');
     WriteLn(tf,'   Operand operand3; // third operand, rarely used');
     WriteLn(tf,'};');
     WriteLn(tf,'');
     WriteLn(tf,'#define NumSegmentRegs 6');
     s:='const unsigned char SegmentOverridePrefix[NumSegmentRegs] = {';
     for x:=5 downto 0 do
     begin
          s:=s+'0x'+IntToHex(bintoint(Prefixes[x],e),2);
          if e then
             break; // break the for-loop
          if x<>0 then
             s:=s+',';
     end;
     s:=s+'};';

     WriteLn(tf,s);
     WriteLn(tf,'// used before instructions using memory references ');

     WriteLn(tf,'');
     WriteLn(tf,'const char SegmentRegisters[NumSegmentRegs][3] = {"cs","ds","es","fs","gs","ss"};');
     WriteLn(tf,'// segment register names (index in array corresponds to override byte in SegmentOverridePrefix array) ');
     WriteLn(tf,'');
     y:=0;
     for x:=high(opcode) downto 0 do // loop through opcodes
         if opcode[x].DIASMOnly then
            inc(y);
     WriteLn(tf,'#define MAXOpcode '+inttostr(y));
     WriteLn(tf,'// total number of opcodes in the instruction set ');
     WriteLn(tf,'');
     WriteLn(tf,'const Opcode opcode[MAXOpcode] = {');
     for x:=high(opcode) downto 0 do // loop through opcodes
     begin
          TheOpcode:=opcode[x];
          with TheOpcode do
          begin
            if not DIASMOnly then
            begin
               writeln(tf,'');
               y:= OperandCount(TheOpcode);
               if branch then
                  writeln(tf,'// branch instruction');
               writeln(tf,'{');
               writeln(tf,LineSpace+'OpcodeClassName: "'+opcode+'",');
               writeln(tf,LineSpace+'RevMachOperand: '+inttostr(ord(RevMachOperand))+',');
               writeln(tf,LineSpace+'MachineCode: {'+
               BinStrToByteCPPHex(OpcodeInBinary,MaxBytesOfMachineCode,usedBytes)+'},');
               writeln(tf,LineSpace+'OpcodeDefSize: '+IntToStr(usedBytes)+',');
               writeln(tf,LineSpace+'NumOfOperands: '+IntToStr(y)+',');
               s:='//'+opcode+' ';
               if y>0 then
               begin
                  s:=s+operand1.name;
                  writeln(tf,LineSpace+'operand1: '+MyOperandToCPPString(operand1)+',');
                  if y>1 then
                  begin
                     writeln(tf,LineSpace+'operand2: '+MyOperandToCPPString(operand2)+',');
                     s:=s+','+operand2.name;
                     if y>2 then
                     begin
                        writeln(tf,LineSpace+'operand3: '+MyOperandToCPPString(operand3));
                        s:=s+','+operand3.name;
                     end;
                  end;
               end;
               writeln(tf,LineSpace+s); // write a comment showing the opcode and it's operands

(*
        MyOpcode = record
                 Processor: string;
                 // stores the version of processor, the instruction was first used in
                 // ie. '80186' for push i8 and push i16
                 opcode: string; // ie. 'mov', 'lea', 'pop'...
                 Operand1: MyOperand;
                 operand2: MyOperand; // ie. 'i8', 'reg8', reg16'...
                 operand3: MyOperand; // rarely used
                 OpcodeInBinary: string; // ie. '10110'
                 Colour: integer;
                 typeID: byte; // identifies the type of instruction it is.
                 {
                   optDefault is NormOpcode
                   optPref is for prefixes
                 }
                 ModeDefined: boolean; // true when the location of the addressing mode bits is defined
                 MachAfterMode: string; // machine code bits placed to the right
                 // of the addressing mode in the instruction
                 DIASMOnly: boolean; // true when the instruction is only to be used for disassembling purposes.
                 // This means there is another instruction that is more efficient.
                 asmonly: boolean; // for instructions that are not to be disassembled(this means the identical machine code is used for another assembly statement)
                 RevMachOperand: boolean; // true if the machine code for the operands is reversed.
                 // if true, the machine code for the first operand that you see in the the assembly statement, goes after the machine code of the second operand.
                 branch: boolean; // indicates that the instruction does or can change the IP value
                 // jumps and calls would be such instructions.
                 // This is used when disassembling programs so the disassembler can branch just like the processor does
                 StopDiasm: boolean;
                 { when an instruction with this set to true is found, the
                 disassembler will stop.  Data after this instruction will be made into a hex dump}
        end;
*)
               s:='}';
               if x<>0 then
                  s:=s+',';
               WriteLn(tf,s);
             end; // end of if-statement
          end; // end with statement
     end;
     WriteLn(tf,'};');
     WriteLn(tf,'');
     WriteLn(tf,'// The list of opcodes is sorted alphabetically to more efficiently search for an opcode.');
     WriteLn(tf,'// To make it even more efficient, data is defined on the location(indexes) of opcodes that start with specific letters.');
     WriteLn(tf,'// Here is a struct to store this information.');
     WriteLn(tf,'');
     WriteLn(tf,'struct LetterIndex // stores information on the ');
     WriteLn(tf,'{');
     WriteLn(tf,'  int StartIndex;');
     WriteLn(tf,'    // index of the first Operand in the array with a certain letter');
     WriteLn(tf,'  int Num;');
     WriteLn(tf,'    // number of opcodes starting with the letter');
     WriteLn(tf,'};');
     WriteLn(tf,'');
     WriteLn(tf,'// Now, define the array to store the indexes for efficiently finding the index of an opcode.');
     WriteLn(tf,'const LetterIndex = {');
     y:=0;
     //for x:=0 to 25 do

     WriteLn(tf,'};');
     CloseFile(tf);
end;

end.