Programmer Power Tools/Programmer Power Tools.iso/tex/webtp55.arc/ASM2INL.PAS

Pascal/Delphi Source File | 1989-12-05 | 53.4 KB | 1,878 lines

{$R-,S-,I-,F-,V-,B-,N-,A+}
Unit Asm2Inl;
{-Convert assembler instructions to inlines}


{ based on the inline assembler in Inline219 by L. David Baldwin
  changed for use with TANGLE, 3.8.89 Peter Sawatzki

28 Vers 2.20 Fix sign extension bug, 4.8.89 PS
------------ 17-27: L. David Baldwin ---------
27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
26 Vers 2.18 Implement the sign extension bit for some instructions
25 Vers 2.17 Convert to Turbo 4.
24 Vers 2.16 Change byte size check in MemReg so the likes of
             MOV [DI+$FE],AX will assemble right.
   Allow ',' in DB pseudo op instruction.
23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
22 Vers 2.14 Change output format to better accomodate map file line numbers.
21 Vers 2.13 Allow JMP SHORT direct using symbols.
20 Vers 2.12 Allow CALL and JMP direct using symbols.
19 Vers 2.11
   Fix bug in CallJmp and ShortJmp which didn't restrict short
   jump range properly.
   Fix bug which didn't allow CALL or JMP register. (CALL BX).
18 Vers 2.1
   Fix bug in Accum which occasionally messed up IN and OUT instr.
   Fix unintialized function in getnumber for quoted chars.
17 Vers 2.03
    Change GetSymbol to accept about anything after '>' or '<'
    Add 'NEW' pseudoinstruction.
    Fix serious bug in defaultextension.
    Add Wait_Already to prevent 2 'WAIT's from occuring.
    Use 'tindex<maxbyte' comparison rather than <= which won't work
    with integer comparison in this case.
}

Interface
Const
  Maxbyte        = 4000;          {MaxInt}
  InBufMax       = 4000;
Var
  TextArray      : Array[0..Maxbyte] Of Char;

Procedure SetupAsm;
Function FeedAsm(Ch : Char) : Boolean;
Function DoAsm(InsertComments : Boolean) : Boolean;
Function ObjSize : Word;

Implementation
Const
  Symbolleng     = 32;            {maximum of 32 char symbols}
  CR             = 13; Lf = 10; Tab = 9;
  BigStringSize  = 127;
Type
  SymString      = String[Symbolleng];
  IndxReg        = (BX, SI, DI, BP, None);
  IndxSet        = Set Of IndxReg;
  PtrType        = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
  String4        = String[4];
  String5        = Array[1..5] Of Char;
  Symtype        = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
                    LfBrack, RtBrack, Plus, Comma, STsym);
  BigString      = String[BigStringSize]; {125 chars on a turbo line}
  Label_Info_ptr = ^Label_Info;
  Label_Info     = Record
                     Name           : SymString;
                     ByteCnt        : Integer;
                     Next           : Label_Info_ptr;
                   End;
  Fixup_Info_Ptr = ^Fixup_Info;
  Fixup_Info     = Record
                     Name           : SymString;
                     Indx, Indx2, Fix_pt : Integer;
                     Jmptype        : (Short, Med);
                     Prev, Next     : Fixup_Info_Ptr;
                   End;

Var
  InBufEnd       : 0..InBufMax;
  InBuf          : Array[0..InBufMax] Of Char;
  StartChi       : Word;
  EofInstr       : Boolean;
  NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
  Displace, WordSize, Wait_Already : Boolean;
  Addr           : Integer;
  Sym            : Symtype;
  Reg1, Reg2, W1, W2: byte;
  ModeByte,Sti_val : Integer;
  SaveOfs, DataVal : Record
                       Symb           : Boolean;
                       Sname          : SymString;
                       Value          : Integer;
                     End;
  IRset          : IndxSet;
  Rmm, Md        : Integer;
  ByWord         : PtrType;
  Byt, SignExt   : Byte;
  Tindex, Tindex0, Column, ByteCount, LastSlash : Integer;

  TokStr           : SymString;
  UCh, LCh       : Char;
  Chi, OldChi    : Integer;

  Start_Col      : Integer;
  Firstlabel, Pl : Label_Info_ptr;
  Firstfix, Pf   : Fixup_Info_Ptr;

  Function GetStr(p : Word) : String;
  Var
    s              : String;
  Begin
    s := '';
    Dec(p);
    While (p < InBufEnd) And (InBuf[p] <> '/') Do Begin
      Inc(Byte(s[0]));
      s[Length(s)] := InBuf[p];
      Inc(p);
    End;
    GetStr := s
  End;

  Procedure InsertStr(s : BigString); Forward;

  Procedure Error(s : BigString);
  Begin
    If Not Aerr Then Begin
      WriteLn;
      WriteLn(GetStr(StartChi));
      Write('':(Start_Col+(Chi-StartChi)),'^Error');
      If Length(s) > 0 Then
        Write(': ', s);
      WriteLn;
      Aerr := True;
      InsertStr('{!Error: '+s+'}'); {-mark error in source file}
    End;
  End;

  Procedure SetupAsm;
  Begin
    InBufEnd := 0;
  End;

  Function FeedAsm(Ch : Char) : Boolean;
  Begin
    If InBufEnd = InBufMax Then
      FeedAsm := False
    Else Begin
      FeedAsm := True;
      InBuf[InBufEnd] := Ch;
      Inc(InBufEnd)
    End
  End;

  {the following are definitions and variables for the parser}
Var
  Segm, NValue   : Integer;
  Symname        : SymString;
  {end of parser defs}

  Procedure GetCh;
    {return next char in uch and lch with uch in upper case.}
  Begin
    If Chi < InBufEnd Then Begin
      LCh := InBuf[Chi];
      If LCh = '/' Then
        LCh := Chr(CR);
      UCh := Upcase(LCh);
      Inc(Chi);
    End Else Begin
      LCh := Chr(CR);
      UCh := Chr(CR);
      TheEnd := True
    End;
  End;

  Procedure SkipSpaces;
  Begin
    While (UCh = ' ') Or (UCh = Chr(Tab)) Do GetCh;
  End;

  Function GetDec(Var V : Integer) : Boolean;
  Const
    Ssize = 8;
  Var
    s: String[Ssize];
    Getd: Boolean;
    Code: Integer;
  Begin
    Getd := False;
    s := '';
    While (UCh >= '0') And (UCh <= '9') Do
      Begin
        Getd := True;
        If Ord(s[0]) < Ssize Then s := s+UCh;
        GetCh;
      End;
    If Getd Then
      Begin
        Val(s, V, Code);
        If Code <> 0 Then Error('Bad number format');
      End;
    GetDec := Getd;
  End;

  Function GetHex(Var H : Integer) : Boolean;
  Var
    Digit: Integer; {check for '$' before the call}
  Begin
    H := 0; GetHex := False;
    While (UCh In ['A'..'F', '0'..'9']) Do
      Begin
        GetHex := True;
        If (UCh >= 'A') Then Digit := Ord(UCh)-Ord('A')+10
        Else Digit := Ord(UCh)-Ord('0');
        If H And $F000 <> 0 Then Error('Overflow');
        H := (H Shl 4)+Digit;
        GetCh;
      End;
  End;

  Function GetNumber(Var N : Integer) : Boolean;
    {get a number and return it in n}
  Var Term       : Char;
    Err            : Boolean;
  Begin
    N := 0;
    If UCh = '(' Then GetCh;      {ignore ( }
    If (UCh = '''') Or (UCh = '"') Then
      Begin
        GetNumber := True;
        Term := UCh; GetCh; Err := False;
        While (UCh <> Term) And Not Err Do Begin
          Err := N And $FF00 <> 0;
          N := (N Shl 8)+Ord(LCh);
          GetCh;
          If Err Then Error('Overflow')
        End;
        GetCh;                    {use up termination char}
      End
    Else If UCh = '$' Then
      Begin                       {a hex number}
        GetCh;
        If Not GetHex(N) Then Error('Hex number exp');
        GetNumber := True;
      End
    Else
      GetNumber := GetDec(N);     {maybe a decimal number}
    If UCh = ')' Then GetCh;      {ignore an ending parenthesis}
  End;

  Function GetExpr(Var Rslt : Integer) : Boolean;
  Var
    Rs1, Rs2, SaveChi : Integer;
    Pos, Neg       : Boolean;
  Begin
    SaveChi := Chi;
    GetExpr := False;
    SkipSpaces;
    Neg := UCh = '-';
    Pos := UCh = '+';
    If Pos Or Neg Then GetCh;
    If GetNumber(Rs1) Then
      Begin
        GetExpr := True;
        If Neg Then Rs1 := -Rs1;
        If (UCh = '+') Or (UCh = '-') Then
          If GetExpr(Rs2) Then
            Inc(Rs1, Rs2);        {getexpr will take care of sign}
        Rslt := Rs1;
      End
    Else
      Begin
        Chi := SaveChi-1; GetCh;
      End;
  End;

  {$v+}
  Function GetSymbol(Var s : SymString) : Boolean;
  Const
    Symchars : Set Of Char = ['@'..'Z', '0'..'9', '_', '+', '-', '$', '*'];
  Begin
    If UCh In Symchars Then
      Begin
        GetSymbol := True;
        s[0] := Chr(0);
        While UCh In Symchars Do
          Begin
            If Ord(s[0]) < Symbolleng Then s := s+UCh;
            GetCh;
          End
      End
    Else GetSymbol := False;
  End;
  {$v-}

  Function GetAddress : Boolean;
  Var
    Result         : Boolean;
    SaveChi        : Integer;
  Begin
    Result := False; SaveChi := Chi;
    If GetExpr(Segm) Then
      Begin
        SkipSpaces;
        If UCh = ':' Then
          Begin
            GetCh; SkipSpaces;
            Result := GetExpr(NValue);
          End;
      End;
    GetAddress := Result;
    If Not Result Then
      Begin Chi := SaveChi-1; GetCh; End;
  End;

  Procedure ErrNull;
  Begin Error(''); End;

  Procedure ErrIncorrect;
  Begin Error('Incorrect or No Operand'); End;

  Procedure SegmErr;
  Begin Error('Segm Reg not Permitted'); End;

  Procedure WordReg;
  Begin Error('Word Reg Exp'); End;

  Procedure DataLarge;
  Begin Error('Data Too Large'); End;

  Procedure Chk_BwPtr;
  Begin
    If ByWord >= DwPtr Then Error('BYTE or WORD Req''d');
  End;

  Function ByteSize(Val : Integer) : Boolean;
    {return true if val is a byte}
  Begin
    ByteSize := (Hi(Val) = 0) Or (Val And $FF80 = $FF80);
  End;

  Function ShortSize(Val : Integer) : Boolean;
    {return true if val is ShortInt size}
  Begin
    ShortSize := (Val >= -128) And (Val <= 127);
  End;

  Function ReadByte : Boolean;
  Var Rb         : Boolean;
  Begin
    Rb := GetExpr(NValue);
    If Rb Then
      If ByteSize(NValue) Then
        Byt := Lo(NValue)
      Else DataLarge;
    ReadByte := Rb;
  End;

  Function RetIndex (keyword,inst: String; var index: Byte): boolean;
  Var
    p: Byte;
  Begin
    While KeyWord[Length(KeyWord)]=' ' Do
      Dec(Byte(KeyWord[0]));
    KeyWord:= KeyWord+'.';
    if KeyWord='.' Then
      KeyWord:= '$never$';
    p:= Pos(KeyWord,inst);
    RetIndex:= p>0;
    Index:= 0;
    While p>0 Do Begin
      If inst[p]='.' Then
        Inc(index);
      Dec(p)
    End
  End;

  Procedure GetString;
  {Fill in TokStr, str, id2,id3.  They are, in fact, all in the
   same locations}
  Var
    I: Integer;
  Begin
    SkipSpaces;
    TokStr := '          ';
    I := 1;
    While (UCh >= '@') And (UCh <= 'Z')
       Or (UCh >= '0') And (UCh <= '9') Do Begin
      If I <= Symbolleng Then Begin
        TokStr[I]:= UCh;
        Inc(I);
      End;
      GetCh;
    End;
    TokStr[0] := Chr(I-1);
  End;

  Procedure InsertChr(C : Char);
  Begin
    If Tindex < Maxbyte Then
      Begin
        TextArray[Tindex] := C;
        Inc(Tindex); Inc(Column);
      End
    Else
      Begin
        WriteLn('Object Code Overflow!');
        Halt(1);
      End;
  End;

  Procedure InsertStr(s : BigString);
  Var I          : Integer;
  Begin
    For I := 1 To Ord(s[0]) Do InsertChr(s[I]);
  End;

  Function Hex2(B : Byte) : String4;
  Const HexDigs  : Array[0..15] Of Char = '0123456789ABCDEF';
  Var Bz         : Byte;
  Begin
    Bz := B And $F; B := B Shr 4;
    Hex2 := HexDigs[B]+HexDigs[Bz];
  End;

  Function Hex4(W : Integer) : String4;
  Begin Hex4 := Hex2(Lo(W))+Hex2(Hi(W)); End;

  Procedure InsertByte(B : Byte);
  Begin
    InsertStr('$'+Hex2(B));
    ByteCount := ByteCount+1;
    LastSlash := Tindex;
    InsertChr('/');
    Wait_Already := False;        {any byte inserted cancels a WAIT}
  End;

  Procedure InsertWord(W : Integer);
  Begin
    InsertByte(Lo(W)); InsertByte(Hi(W));
  End;

  Procedure InsertHi_Low(W : Integer);
    {insert a word in reverse order}
  Begin
    InsertByte(Hi(W)); InsertByte(Lo(W));
  End;

  Procedure InsertWait;
  Begin                           {Insert a 'WAIT' for Fl Pt only if none already input}
    If Not Wait_Already Then InsertByte($9B);
  End;

  Procedure Modify_Byte(I : Integer; Modify : Byte);
    {Modify an ascii byte string in textarray by adding modify to its value}
  Var
    St             : String4;
    J              : Integer;

    Function HexToByte(I : Integer; Var J : Integer) : Byte;
    {Starting at tindex, i, convert hex to a byte. return j, the tindex where
     byte started}
    Var
      Result, Tmp    : Byte;
      K              : Integer;
      C              : Char;
    Const
      Hex            : Set Of Char = ['0'..'9', 'A'..'F'];
    Begin
      Result := 0;
      While Not(TextArray[I] In Hex) Do Inc(I); {skip '/' and '$'}
      J := I;
      For K := I To I+1 Do Begin
        C := TextArray[K];
        If C <= '9' Then Tmp := Ord(C)-Ord('0') Else Tmp := Ord(C)-Ord('A')+10;
        Result := (Result Shl 4)+Tmp
      End;
      HexToByte := Result
    End;

  Begin
    St := Hex2(HexToByte(I, J)+Modify);
    TextArray[J] := St[1];
    TextArray[J+1] := St[2]
  End;

  Procedure DoNext;
  Var
    TmpCh: Char;
  Begin
    OldChi := Chi;
    Symbol := False;
    If Sym = EOLsym Then Exit;    {do nothing}
    SkipSpaces;                   {note commas are significant}
    If (UCh = Chr(CR)) Or (UCh = ';') Then
      Sym := EOLsym
    Else
      If UCh = ',' Then Begin
        Sym := Comma;
        GetCh
      End Else
        If (UCh = '>') Or (UCh = '<') Then Begin
          TmpCh := UCh;
          GetCh;
          If Not GetSymbol(Symname) Then Error('Symbol Name Exp');
          If TmpCh = '<' Then
            Sym := Disp8
          Else
            Sym := Disp16;
          Symbol := True {disp8/16 is a symbol}
        End Else
          If GetAddress Then
            If NoAddrs Then
              ErrNull
            Else
              Sym := Address
          Else
            If GetExpr(NValue) Then
              If ByteSize(NValue) Then
                Sym := Disp8
              Else
                Sym := Disp16
            Else
              If (UCh >= '@') And (UCh <= 'Z') Then Begin
                GetString;
                Symname := TokStr;
                If (TokStr = 'FAR') Or (TokStr = 'NEAR')
                Or (TokStr = 'SHORT') Then
                  Sym := JmpDist
                Else
                  If TokStr = 'ST' Then
                    Sym := STsym
                  Else
                    Sym := Identifier
              End Else
                If UCh = '+' Then Begin
                  Sym := Plus;
                  GetCh
                End Else
                  If UCh = '[' Then Begin
                    Sym := LfBrack;
                    GetCh
                  End Else
                    If UCh = ']' Then Begin
                      Sym := RtBrack;
                      GetCh
                    End Else Begin
                      Sym:= Othersym;
                      GetCh
                    End
  End;

Procedure NextA;
{-Get the next item but also process any
  'WORD' 'BYTE', 'DWORD', 'QWORD',etc 'PTR'}
Var
  Indx: Byte;
Const
  TheInst = 'BYTE.WORD.DWORD.QWORD.TBYTE.';
Begin
  DoNext;
  If Sym = Identifier Then
    If RetIndex(TokStr,TheInst,Indx) Then Begin
      ByWord:= PtrType(Indx);
      DoNext;
      If TokStr = 'PTR' Then
        DoNext {ignore 'PTR'}
    End
End;

  Procedure Displace_Bytes(W : Integer);
  Var C: Char;
  Begin
    If Displace Then With SaveOfs Do Begin
      If Symb Then Begin
        {-displacement is a symbol}
        If W = 1 Then
          C := '>'
        Else
          C := '<';
        InsertStr(C+Sname);
        If Value <> 0 Then {Add it in too, don't reverse bytes}
          InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
        If W = 1 Then
          Inc(ByteCount, 2)
        Else
          Inc(ByteCount);
        LastSlash := Tindex;
        InsertChr('/')
      End Else
        If W = 1 Then
          InsertWord(Value)
        Else
          InsertByte(Lo(Value))
    End
  End;

  Procedure Data_Bytes(WordSize : Boolean);
  Var
    C: Char;
  Begin
    With DataVal Do Begin
      If Symb Then Begin {data is a symbol}
        If WordSize Then
          C := '>'
        Else
          C := '<';
        InsertStr(C+Sname);
        If Value <> 0 Then    {add it in too}
          InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
        If WordSize Then
          Inc(ByteCount, 2)
        Else
          Inc(ByteCount);
        LastSlash:= Tindex;
        InsertChr('/');
      End Else
        If WordSize Then
          InsertWord(Value)
        Else
          InsertByte(Lo(Value))
    End
  End;

  Function GetIR : Boolean;
  Var
    Indx: Byte;
  Const
    TheInst = 'BX.SI.DI.BP.';
  Begin
    GetIR := False;
    If (Sym = Identifier) Then
      If RetIndex(TokStr,TheInst,Indx) Then Begin
        IRset:= IRset+[IndxReg(Indx)];
        GetIR := True;
        NextA;
      End
  End;

  Function MemReg(Var W : Byte) : Boolean;
  Label
    Abort;

  {Does not handle the 'reg' part of the mem/reg. Returns disp true if
  a displacement is found with w=0 for byte disp and w=1 for word
  disp.  Any displacement is output in saveofs.}

  Var
    SaveChi        : Integer;
    Dsp16, OldAddrs, Result_MemReg : Boolean;
  Begin
    SaveChi:= OldChi;
    Dsp16:= False;
    Result_MemReg:= False;
    OldAddrs:= NoAddrs;
    NoAddrs:= True;
    SaveOfs.Value := 0;
    SaveOfs.Symb := False;
    IRset := [];
    {',' or cr terminate a MemReg}
    While (Sym <> Comma) And (Sym <> EOLsym) Do Begin
      If Sym = LfBrack Then Begin
        Result_MemReg := True;
        NextA
      End;
      If Sym = Plus Then NextA;
      If (Sym = Disp8) Or (Sym = Disp16) Then With SaveOfs Do Begin
        Dsp16 := Dsp16 Or (Sym = Disp16);
        If Symbol Then Begin
          Symb := True;
          Sname := Symname
        End Else
          Inc(Value, NValue);
        NextA;
      End Else
        If Not GetIR Then
          If Sym = RtBrack Then
            NextA
          Else
            If Result_MemReg Then Begin
              Error('Comma or Line End Exp');
              NextA
            End
          Else
            GoTo Abort
    End; {While}
    If Result_MemReg Then Begin
      {-at least one '[' found}
      If (IRset = []) Or (IRset = [BP]) Then Rmm := 6
      Else If IRset = [BX, SI] Then Rmm := 0
      Else If IRset = [BX, DI] Then Rmm := 1
      Else If IRset = [BP, SI] Then Rmm := 2
      Else If IRset = [BP, DI] Then Rmm := 3
      Else If IRset = [SI] Then Rmm := 4
      Else If IRset = [DI] Then Rmm := 5
      Else If IRset = [BX] Then Rmm := 7
      Else Error('Bad Register Combination');
      NextA;                    {pass over any commas}
      With SaveOfs Do
        Dsp16 := Dsp16 Or (Symb And (Value <> 0)) Or Not ShortSize(Value);
      If IRset = [] Then Begin
        Displace := True;
        Md := 0;
        W := 1
      End {direct address} Else
        If (IRset = [BP]) And Not Dsp16 Then Begin
          Displace := True;
          Md := 1;
          W := 0
        End {bp must have displ} Else
          If (SaveOfs.Value = 0) And Not SaveOfs.Symb Then Begin
            Displace := False;
            Md := 0;
            W := 3
          End Else
            If Not Dsp16 Then {8 bit} Begin
              Displace := True;
              Md := 1;
              W := 0
            End Else Begin
              Displace := True;
              Md := 2;
              W := 1
            End;
      ModeByte := 64*Md+Rmm
    End Else Begin {not a MemReg}
Abort: Chi := SaveChi-1; GetCh;  {restore as in beginning}
       NextA
    End;
    NoAddrs := OldAddrs;
    MemReg := Result_MemReg
  End;

  Function St_St : Boolean;       {pick up st,st(i) or st(i),st or just st(i)}
  Var
    Err, Rslt  : Boolean;

    Function GetSti_Val : Boolean;
    Var
      Grslt: Boolean;
    Begin
      NextA;
      Grslt := Sym = Disp8;
      If Grslt Then Begin
        Sti_val := NValue;
        Err := ((Sti_val And $F8) <> 0); {check limit of 7}
        NextA
      End;
      GetSti_Val := Grslt
    End;

  Begin
    Err := False;
    Rslt := Sym = STsym;
    If Rslt Then Begin
      If GetSti_Val Then Begin
        St_first := False;    {st(i) is first}
        While (Sym = Comma) Or (Sym = STsym) Do NextA;
      End Else Begin
        St_first := True;     {st preceeds st(i)}
        If Sym = Comma Then NextA;
        If Sym=STsym Then Begin
          If Not GetSti_Val Then
            Err := True
        End Else
          Err:= True;
        If Err Then
          ErrNull
      End
    End;
    St_St := Rslt
  End;

  Function FstiOnly : Boolean;
  {-Fl Pt instructions having only one form using st(i) operand
    faddp,fmulp,fsubp,fsubrp,fdivp,fdivrp,ffree,fxch -- 0..7}
  Var
    Indx           : Byte;
    Rslt           : Boolean;
  Const
    Stiary         : Array[0..7] of Word =
      ($DEC0, $DEC8, $DEE8, $DEE0, $DEF8, $DEF0, $DDC0, $D9C8);
    TheInst = 'FADDP.FMULP.FSUBP.FSUBRP.FDIVP.FDIVRP.FFREE.FXCH.';
  Begin
    Rslt:= RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NextA;
      If Not St_St Then Begin
        If Sym = EOLsym Then
          Sti_val := 1
        Else
          ErrIncorrect
      End;
      InsertWait;
      InsertHi_Low(Stiary[Indx]+Sti_val)
    End;
    FstiOnly := Rslt
  End;

  Function FmemOnly : Boolean;
  {-Fl Pt instructions having only one form using a memory operand}
  {fldenv,fldcw,fstenv,fstcw,fbstp,fbld,frstor,fsave,fstsw,
  fnsave,fnstcw,fnstenv,fnstsw--0..12 }
  Var Indx       : Byte;
    Rslt           : Boolean;
  Const
    Memary: Array [0..12] of Word = (
              $D920, $D928, $D930, $D938, $DF30, $DF20, $DD20, $DD30, $DD38,
              $DD30, $D938, $D930, $DD38);
    TheInst = 'FLDENV.FLDCW.FSTENV.FSTCW.FBSTP.FBLD.FRSTOR.FSAVE.'+
              'FSTSW.FNSAVE.FNSTCW.FNSTENV.FNSTSW.';
  Begin
    Rslt:= RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NextA;
      If Indx < 9 Then InsertWait; {fwait}
      If MemReg(W1) Then Begin
        InsertHi_Low(Memary[Indx]+ModeByte);
        Displace_Bytes(W1)
      End Else
        ErrIncorrect
    End;
    FmemOnly := Rslt;
  End;

  Function FldType : Boolean;
  {Do fld,fst,fstp-- 0..2}
  Type
    Arraytype      = Array[0..2, DwPtr..UnkPtr] Of Word;
  Var
    Indx: Byte;
    Tmp: Word;
    Rslt           : Boolean;
  Const
    Fldarray       : Arraytype = (
            ($D900, $DD00, $DB28, $D9C0),
            ($D910, $DD10, 0, $DDD0),
            ($D918, $DD18, $DB38, $DDD8));
    TheInst = 'FLD.FST.FSTP.';
  Begin
    Rslt:= RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NextA;
      InsertWait;               {fwait}
      If ByWord >= DwPtr Then
        Tmp:= Fldarray[Indx, ByWord];
      If MemReg(W1) Then Begin
        If (ByWord >= DwPtr) And (ByWord <= TbPtr) Then Begin
          InsertHi_Low(Tmp+ModeByte);
          Displace_Bytes(W1);
          If Tmp = 0 Then Error('TBYTE not Permitted')
        End Else
          Error('DWORD, QWORD, or TBYTE Req''d')
      End Else
        If St_St Then
          InsertHi_Low(Tmp+Sti_val)
        Else
          ErrIncorrect
    End;
    FldType := Rslt;
  End;

  Function FildType : Boolean;
  {-do fild,fist,fistp-- 0..2}
  Type
    Arraytype      = Array[0..2, WPtr..QwPtr] Of Word;
  Var
    Indx: Byte;
    Tmp: Word;
    Rslt           : Boolean;
  Const
    Fildarray      : Arraytype = (
           ($DF00, $DB00, $DF28),
           ($DF10, $DB10, 0),
           ($DF18, $DB18, $DF38));
    TheInst = 'FILD.FIST.FISTP.';
  Begin
    Rslt:= RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NextA;
      If MemReg(W1) Then Begin
        If (ByWord >= WPtr) And (ByWord <= QwPtr) Then Begin
          InsertWait;       {fwait}
          Tmp := Fildarray[Indx, ByWord];
          InsertHi_Low(Tmp+ModeByte);
          Displace_Bytes(W1);
          If Tmp = 0 Then Error('QWORD not Permitted')
        End Else
          Error('WORD, DWORD, or QWORD Req''d')
      End Else
        ErrIncorrect
    End;
    FildType := Rslt;
  End;

  Function FaddType : Boolean;
  {-The fadd,fmul,fcom,fcomp,fsub,fsubr,fdiv,fdivr instructions}
  Var
    Indx: Byte;
    Rslt           : Boolean;
  Const
    TheInst = 'FADD.FMUL.FCOM.FCOMP.FSUB.FSUBR.FDIV.FDIVR.';
  Begin
    Rslt := RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NoAddrs := True;
      NextA;
      InsertWait;               {fwait}
      If MemReg(W1) Then Begin
        If ByWord = DwPtr Then
          InsertByte($D8)
        Else
          If ByWord = QwPtr Then
            InsertByte($DC)
          Else
            Error('DWORD or QWORD Req''d');
        InsertByte(ModeByte+8*Indx);
        Displace_Bytes(W1)
      End Else
        If St_St Then Begin
          {-Must be st,st(i) or st(i),st }
          If St_first Or (Indx = 2 {fcom} ) Or (Indx = 3 {fcomp} ) Then
            InsertByte($D8)
          Else
            InsertByte($DC);
          ModeByte := $C0+8*Indx+Sti_val;
          If Not St_first And (Indx >= 6 {fdiv} ) Then
            ModeByte := ModeByte Xor 8; {reverse fdiv,fdivr for not st_first}
          InsertByte(ModeByte)
        End Else
          ErrIncorrect
    End;
    FaddType := Rslt
  End;

  Function FiaddType : Boolean;
    {the fiadd,fimul,ficom,ficomp,fisub,fisubr,fidiv,fidivr instructions}
  Var
    Indx: Byte;
    Rslt: Boolean;
  Const
    TheInst = 'FIADD.FIMUL.FICOM.FICOMP.FISUB.FISUBR.FIDIV.FIDIVR.';
  Begin
    Rslt := RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NoAddrs := True;
      NextA;
      If MemReg(W1) Then Begin
        InsertWait;           {fwait}
        If ByWord = DwPtr Then
          InsertByte($DA)
        Else
          If ByWord = WPtr Then
            InsertByte($DE)
          Else
            Error('WORD or DWORD Req''d');
        InsertByte(ModeByte+8*Indx);
        Displace_Bytes(W1)
      End Else
        ErrIncorrect
    End;
    FiaddType := Rslt
  End;

  Function Fnoperand : Boolean;
  {-do the Fl Pt no operand instructions}
  Var
    Indx: Byte;
    Rslt: Boolean;
  Const
    TheInst =
     'FNOP.FCHS.FABS.FTST.FXAM.FLD1.FLDL2T.FLDL2E.FLDPI.FLDLG2.FLDLN2.FLDZ.'+
     'F2XM1.FYL2X.FPTAN.FPATAN.FXTRACT.FDECSTP.FINCSTP.FPREM.FYL2XP1.FSQRT.'+
     'FRNDINT.FSCALE.FENI.FDISI.FCLEX.FINIT.FCOMPP.FNCLEX.FNDISI.FNENI.FNINIT.';

    Fnopcode       : Array[0..32] Of Word =
    ($D9D0, $D9E0, $D9E1, $D9E4, $D9E5, $D9E8,
     $D9E9, $D9EA, $D9EB, $D9EC, $D9ED, $D9EE,
     $D9F0, $D9F1, $D9F2, $D9F3, $D9F4, $D9F6,
     $D9F7, $D9F8, $D9F9, $D9FA, $D9FC, $D9FD,
     $DBE0, $DBE1, $DBE2, $DBE3, $DED9,
     $DBE2, $DBE1, $DBE0, $DBE3);

  Begin
    Rslt:= RetIndex(TokStr,TheInst,Indx);
    If Rslt Then Begin
      NextA;
      If Indx < 29 Then InsertWait; {fwait}
      InsertHi_Low(Fnopcode[Indx]);
    End;
    Fnoperand := Rslt
  End;

  Function Register(Var R, W : Byte) : Boolean;
  Const
    TheInst = 'AL.CL.DL.BL.AH.CH.DH.BH.'+
              'AX.CX.DX.BX.SP.BP.SI.DI.';
  Begin
    Register:= False;
    If (Sym=Identifier) Then
    If RetIndex(TokStr,TheInst,R) Then Begin
      Register:= True;
      NextA;
      If Sym = Comma Then NextA;
      W:= R Div 8;             {w=1 for word type register}
      R:= R And 7
    End
  End;

  Function SegRegister(Var R : Byte) : Boolean;
  Var
    Result_Segr : Boolean;
  Const
    TheInst = 'ES.CS.SS.DS.';
  Begin
    SegRegister:= False;
    If (Sym = Identifier) Then
      If RetIndex(TokStr,TheInst,R) Then Begin
        SegRegister:= True;
        NextA;
        If Sym = Comma Then
          NextA;
      End
  End;

  Function Data(Var Wd : Boolean) : Boolean;
  {-See if immediate data is present.  Set wd if data found is word size}
  Var SaveChi    : Integer;
    Result         : Boolean;
  Begin
    Result := False; Wd := False;
    SaveChi := OldChi;
    With DataVal Do Begin
      Value := 0;
      Symb := False;
      While (Sym = Disp8) Or (Sym = Disp16) Do Begin
        Result := True;
        If Symbol Then Begin
          Wd := Wd Or (Sym = Disp16);
          Symb := True;
          Sname := Symname
        End Else
          Inc(Value, NValue);
        NextA;
        If Sym = Plus Then NextA
      End;
      Result := (Sym = EOLsym) And Result;
      Wd := Wd Or Not ByteSize(Value)
    End;
    Data := Result;
    If Not Result Then Begin
       Chi := SaveChi-1;
      GetCh;
      NextA
    End
  End;

  Function TwoOperands : Boolean;
  {-Handles codes with two operands}
  Type
    InsType        = (Mov, Adc, Addx, Andx, Cmp, Orx, Sbb, Sub, Xorx, Test, Xchg, Lds, Les, Lea);
    Codetype       = Array[Mov..Lea] Of Byte;
    Shcodetype     = Array[Mov..Test] Of Byte;
  Var
    Inst           : InsType;
    Tmp            : Byte;
  Const
    TheInst  = 'MOV.ADC.ADD.AND.CMP.OR.SBB.SUB.XOR.TEST.XCHG.LDS.LES.LEA.';
    Immedop  : Codetype = ($C6,$80,$80,$80,$80,$80,$80,$80,$80,$F6,$00,$00,$00,$00);
    Immedreg : Codetype = ($00,$10,$00,$20,$38,$08,$18,$28,$30,$00,$00,$00,$00,$00);
    Memregop : Codetype = ($88,$10,$00,$20,$38,$08,$18,$28,$30,$84,$86,$C5,$C4,$8D);
    Shimmedop: Shcodetype=($00,$14,$04,$24,$3C,$0C,$1C,$2C,$34,$A8);

    Function ChkSignExt(WordSize : Boolean) : Byte; {Thanx to Jim LeMay}
    Begin
      If (Immedop[Inst] = $80) And Not WordSize And ShortSize(DataVal.Value) Then
        ChkSignExt := 2           { the sign extension bit }
      Else ChkSignExt := 0;       { no  sign extension bit }
    End;

  Begin
    TwoOperands:= False;
    if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
      Exit;
    TwoOperands:= True;
    NoAddrs:= True;
    NextA;
    If Register(Reg1, W1) Then Begin
      If Register(Reg2, W2) Then Begin
        {-mov reg,reg}
        If Inst >= Lds Then Error('Register not Permitted');
        If W1 <> W2 Then Error('Registers Incompatible');
        If (Inst = Xchg) And ((W1 = 1) And ((Reg1 = 0) Or (Reg2 = 0))) Then
          InsertByte($90+Reg1+Reg2)
        Else Begin
          InsertByte(Memregop[Inst]+W1);
          InsertByte($C0+Reg1+8*Reg2);
        End
      End Else
        If SegRegister(Reg2) Then Begin
          {-mov reg,segreg}
          If (W1 = 0) Or (Inst <> Mov) Then SegmErr;
          InsertByte($8C); InsertByte($C0+8*Reg2+Reg1);
        End Else
          If Data(WordSize) Then Begin
            {-mov reg,data}
            If Inst >= Xchg Then Error('Immediate not Permitted');
            If (Ord(WordSize) > W1) Then DataLarge;
            SignExt := ChkSignExt(W1 = 1); {the sign extension bit}
            If (Inst = Mov) Then
              InsertByte($B0+8*W1+Reg1)
            Else
              If (Reg1 = 0) {ax or al} Then Begin
                InsertByte(Shimmedop[Inst]+W1); {add ac,immed}
                SignExt := 0;   {no sign extenstion for AL,AX}
              End Else Begin
                InsertByte(Immedop[Inst]+W1+SignExt);
                InsertByte($C0+Immedreg[Inst]+Reg1);
              End;
            {-output the immediate data}
            Data_Bytes((SignExt = 0) And (W1 > 0))
          End Else
            If MemReg(W2) Then Begin
              {-mov reg,mem/reg}
              If (Inst = Mov) And (Reg1 = 0) {ax or al} And (Rmm = 6) And (Md = 0) Then
                {-mov ac,mem}
                InsertByte($A0+W1)
              Else Begin
                Tmp := Memregop[Inst];
                If Inst <= Xchg Then Begin
                  Inc(Tmp,W1);
                  If Inst <> Test Then Tmp := Tmp Or 2 {to,from bit}
                End;
                InsertByte(Tmp);
                InsertByte(ModeByte+8*Reg1)
              End;
              Displace_Bytes(W2) {add on any displacement bytes}
            End Else
              ErrNull
        End Else
          If SegRegister(Reg1) Then Begin
            If Inst <> Mov Then
              SegmErr;
            InsertByte($8E);
            If Register(Reg2, W2) Then Begin
              {-mov segreg,reg}
              If (W2 = 0) Then
                WordReg;
              InsertByte($C0+8*Reg1+Reg2)
            End Else
              If MemReg(W2) Then Begin
                {-mov segreg,mem/reg}
                InsertByte(ModeByte+8*Reg1);
                Displace_Bytes(W2) {add any displacement bytes}
              End Else
                ErrNull
          End Else
            If MemReg(W1) And (Inst <= Xchg) Then Begin
              If Register(Reg2, W2) Then Begin
                {-mov mem/reg,reg}
                If (W2 > Ord(ByWord)) Then Error('Byte Reg Exp');
                If (Inst = Mov) And (Reg2 = 0) {ax or al}
                And (Rmm = 6) And (Md = 0) Then {mov ac, mem}
                  InsertByte($A2+W2)
                Else Begin
                  InsertByte(Memregop[Inst]+W2);
                  InsertByte(ModeByte+8*Reg2)
                End;
                Displace_Bytes(W1)
              End Else
                If SegRegister(Reg2) Then Begin
                  {-mov mem/reg,segreg}
                  If (Inst <> Mov) Then SegmErr;
                  InsertByte($8C);
                  InsertByte(ModeByte+8*Reg2);
                  Displace_Bytes(W1)
                End Else
                  If (Data(WordSize)) And (Inst < Xchg) Then Begin
                    {-mov mem/reg, data}
                    Chk_BwPtr;
                    If (Ord(WordSize) > Ord(ByWord)) Then DataLarge;
                    SignExt:= ChkSignExt(ByWord = WPtr); {the sign extension bit}
                    InsertByte(Immedop[Inst]+Ord(ByWord)+SignExt);
                    InsertByte(ModeByte+Immedreg[Inst]);
                    Displace_Bytes(W1);   {add displacement bytes}
                    Data_Bytes((SignExt = 0) And (ByWord = WPtr)); {the immediate data}
                  End Else
                    ErrNull
            End Else
              If (Sym = Disp8) Or (Sym = Disp16) Then
                Error('Immediate not Permitted')
              Else
                ErrNull
  End;

  Function OneOperand: Boolean;
  {Handles codes with one operand}
  Type
    InsType        = (Dec, Inc, Push, Pop, Nott, Neg);
    Codetype       = Array[Dec..Neg] Of Byte;
  Var
    Inst           : InsType;
    Pushpop        : Boolean;
  Const
    TheInst = 'DEC.INC.PUSH.POP.NOT.NEG.';
    Regop          : Codetype = ($48,$40,$50,$58,$00,$00);
    Segregop       : Codetype = ($00,$00,$06,$07,$00,$00);
    Memregop       : Codetype = ($FE,$FE,$FF,$8F,$F6,$F6);
    Memregcode     : Codetype = ($08,$00,$30,$00,$10,$18);
  Begin
    OneOperand := False;
    If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
      Exit;
    OneOperand := True;
    Pushpop := (Inst = Push) Or (Inst = Pop);
    NoAddrs := True;
    NextA;
    If Register(Reg1, W1) Then
      If (W1 = 1) And (Inst < Nott) Then
        {-16 bit register instructions}
        InsertByte(Regop[Inst]+Reg1)
      Else Begin
        {-byte register or neg,not with any reg}
        InsertByte(Memregop[Inst]+W1);
        InsertByte($C0+Memregcode[Inst]+Reg1);
        If Pushpop Then
          WordReg;
      End
    Else
      If SegRegister(Reg1) Then Begin
        {-segment reg--push,pop only}
        InsertByte(Segregop[Inst]+8*Reg1);
        If Not Pushpop Then SegmErr
      End Else
        If MemReg(W1) Then Begin
          {-memreg  (not register)}
          If Not Pushpop Then Chk_BwPtr;
          InsertByte(Memregop[Inst] Or Ord(ByWord));
          InsertByte(ModeByte+Memregcode[Inst]);
          Displace_Bytes(W1);
        End Else
          ErrIncorrect;
  End;

  Function NoOperand : Boolean;
  {-Those instructions consisting only of opcode}
  Const
    Nmbsop = 31;
  Type
    Opfield   = Array[0..Nmbsop] Of Byte;
  Var
    Index      : Byte;
  Const
    TheInst = 'DAA.AAA.NOP.MOVSB.MOVSW.CMPSB.CMPSW.XLAT.HLT.'
             +'CMC.DAS.AAS.CBW.CWD.PUSHF.POPF.SAHF.LAHF.'
             +'STOSB.STOSW.LODSB.LODSW.SCASB.SCASW.INTO.IRET.'+
             +'CLC.STC.CLI.STI.CLD.STD.';
    Opcode: Opfield = (
              $27, $37, $90, $A4, $A5, $A6, $A7, $D7, $F4,
              $F5, $2F, $3F, $98, $99, $9C, $9D, $9E, $9F, $AA, $AB, $AC, $AD,
              $AE, $AF, $CE, $CF, $F8, $F9, $FA, $FB, $FC, $FD);
  Begin
    NoOperand := False;
    If Not RetIndex(TokStr,TheInst,Index) Then
      Exit;
    NoOperand := True;
    InsertByte(Opcode[Index]);
    NextA;
  End;

  Function Prefix : Boolean;
  {process the prefix instructions}
  Const
    Nmbsop   = 11;
  Type
    Opfield = Array[0..Nmbsop] Of Byte;
  Var
    Index: Byte;
    SaveWait       : Boolean;
    Opc            : Byte;
  Const
    TheInst = 'LOCK.REP.REPZ.REPNZ.REPE.REPNE.WAIT.FWAIT.ES.DS.CS.SS.';
    Opcode: Opfield = ($F0,$F2,$F3,$F2,$F3,$F2,$9B,$9B,$26,$3E,$2E,$36);
  Begin
    Prefix := False;
    if Not RetIndex(TokStr,TheInst,Index) Then
      Exit;
    Prefix:= True;
    Opc := Opcode[Index];
    SaveWait := Wait_Already; {save any WAIT already programed}
    InsertByte(Opc);
    Wait_Already := SaveWait Or (Opc = $9B); {set for WAIT or FWAIT}
    Tindex0 := Tindex;      {for future fix ups}
    If UCh = ':' Then GetCh; {es: etc permitted with a colon}
  End;

  Function FindLabel(Var B : Integer) : Boolean;
  {-Find a label if it exists in the label chain}
  Var
    Found      : Boolean;
  Begin
    Pl:= Firstlabel;
    Found:= False;
    While (Pl <> Nil) And Not Found Do
      With Pl^ Do
        If Symname = Name Then Begin
          Found := True;
          B := ByteCnt
        End Else
          Pl := Next;
    FindLabel:= Found
  End;

  Function ShortJmp : Boolean;
  {-short jump instructions}
  Const
    Numjmp = 34;
  Type
    Opfield = Array[0..Numjmp] Of Byte;
  Var
    I: Byte;
    B: Integer;
  Const
    TheInst =  'JO.JNO.JB.JNAE.JNB.JAE.JE.JZ.JNE.JNZ.JBE.JNA.'
              +'JNBE.JA.LOOPN.LOOPZ.LOOPE.LOOP.JCXZ.JS.JNS.JP.JPE.'
              +'JNP.JPO.JL.JNGE.JNL.JGE.JLE.JNG.JNLE.JG.JC.JNC.';
    Opcode         : Opfield = (
              $70, $71, $72, $72, $73, $73, $74, $74, $75, $75, $76, $76,
              $77, $77, $E0, $E1, $E1, $E2, $E3, $78, $79, $7A, $7A, $7B,
              $7B, $7C, $7C, $7D, $7D, $7E, $7E, $7F, $7F, $72, $73);

  Begin
    ShortJmp := False;
    If Not RetIndex(TokStr,TheInst,i) Then
      Exit;
    ShortJmp := True;
    NoAddrs := True;
    InsertByte(Opcode[I]);
    NextA;
    If Sym = Identifier Then Begin
      If FindLabel(B) Then Begin
        Addr := B-(ByteCount+1);
        If (Addr <= $7F) And (Addr >= -128) Then
          InsertByte(Lo(Addr))
        Else
          Error('Too Far')
      End Else Begin
        {-enter jump into fixups}
        New(Pf);
        With Pf^ Do Begin
          Next := Firstfix;
          If Firstfix <> Nil Then
            Firstfix^.Prev := Pf;
          Firstfix := Pf;
          Prev := Nil;
          Jmptype := Short;
          Name := Symname;
          Fix_pt := ByteCount; Indx := Tindex;
          InsertByte(0) {dummy insertion}
        End
      End;
      NextA
    End Else
      Error('Label Exp')
  End;

  Function ShfRot : Boolean;
  Type
    InsType        = (Rclx, Rcrx, Rolx, Rorx, Salx, Sarx, Shlx, Shrx);
    Codetype       = Array[Rclx..Shrx] Of Byte;
  Var
    Inst           : InsType;
    CL             : Byte;
  Const
    TheInst = 'RCL.RCR.ROL.ROR.SAL.SAR.SHL.SHR.';
    Regcode        : Codetype = ($10, $18, 0, 8, $20, $38, $20, $28);
  Begin
    ShfRot:= False;
    If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
      Exit;
    ShfRot:= True;
    NoAddrs := True;
    NextA;
    InsertByte($D0);      {may get modified later}
    If Register(Reg1, W1) Then
      InsertByte($C0+Regcode[Inst]+Reg1)
    Else
      If MemReg(W2) Then Begin
        Chk_BwPtr;
        W1:= Ord(ByWord);
        InsertByte(ModeByte+Regcode[Inst]);
        Displace_Bytes(W2);
      End Else
        Error('Reg or Mem Exp');
    If Sym = Comma Then NextA;
    CL := 0;
    If (Sym = Identifier) And (TokStr = 'CL') Then
      CL := 2
    Else
      If NValue <> 1 Then Error('CL or 1 Exp');
    NextA;
    Modify_Byte(Tindex0, CL+W1); {modify the opcode}
  End;

  Function CallJmp : Boolean;
  Type
    InsType   = (CALL, JMP);
    Codetype       = Array[CALL..JMP] Of Byte;
  Var
    Inst           : InsType;
    Dist           : (Long, Shrt, Near,NoDist);
    Tmp            : Byte;
    Dwtmp          : PtrType;
    B              : Integer;
    WordSize       : Boolean;
  Const
    TheInst = 'CALL.JMP.';
    TheDist = 'FAR.NEAR.SHORT.';
    Shortop        : Codetype = ($E8, $E9);
    Longop         : Codetype = ($9A, $EA);
    Longcode       : Codetype = ($18, $28);
    Shortcode      : Codetype = ($10, $20);
  Begin
    CallJmp := False;
    if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
      Exit;
    CallJmp := True;
    NextA;
    Dist := Nodist;
    Dwtmp := ByWord;              {could have passed a 'DWORD PTR' here}
    If Sym = JmpDist Then Begin
      If Not RetIndex(TokStr,TheDist,Byte(Dist)) Then
        Dist:= NoDist;
      NextA
    End;
    If (Sym = Address) Then Begin
      InsertByte(Longop[Inst]);
      InsertWord(NValue);
      InsertWord(Segm);
    End Else
      If Register(Reg1, W1) Then Begin
        If W1 = 0 Then WordReg;
        If Dist = Long Then Error('FAR not Permitted');
        InsertByte($FF);
        InsertByte($C0+Shortcode[Inst]+Reg1);
      End Else
        If Sym = Identifier Then Begin
          If Dist = Long Then Error('Far not Permitted with Label');
          If FindLabel(B) Then Begin
            Addr := B-(ByteCount+2);
            If Inst = CALL Then Begin
              InsertByte($E8);
              InsertWord(Addr-1)
            End Else
              If (Addr <= $7F) And (Addr >= -128) And (Dist <> Near) Then Begin
                {-short jump}
                InsertByte($EB);
                InsertByte(Lo(Addr))
              End Else Begin
                InsertByte($E9);
                InsertWord(Addr-1)
              End
          End {findlabel} Else Begin
            {enter it into fixup chain}
            New(Pf);
            With Pf^ Do Begin
              Next := Firstfix;
              If Firstfix <> Nil Then
                Firstfix^.Prev := Pf;
              Firstfix := Pf;
              Prev := Nil;
              Name := Symname;
              If Dist = Shrt Then Begin
                Jmptype := Short;
                InsertByte($EB);
                Fix_pt := ByteCount;
                Indx := Tindex;
                InsertByte(0); {dummy insertion}
              End Else Begin
                Jmptype := Med;
                If Inst = CALL Then InsertByte($E8) Else InsertByte($E9);
                Fix_pt := ByteCount; Indx := Tindex;
                InsertByte(0); {dummy insertion}
                Indx2 := Tindex;
                InsertByte(0) {another dummy byte}
              End
            End {With Pf^}
          End
        End {identifier} Else
          If Data(WordSize) Then Begin
            {Direct CALL or JMP}
            If (Inst=JMP) And (Dist=Shrt) Then Begin
              If WordSize Then Error('Must be byte size');
              InsertByte($EB);
              Data_Bytes(False);
            End Else Begin
              If Not((Dist = Nodist) Or (Dist = Near)) Or (Dwtmp <> UnkPtr) Then
                Error('Only NEAR permitted');
              If Not WordSize Then Error('Must be word size');
              InsertByte(Shortop[Inst]);
              Data_Bytes(True)
            End
          End Else
            If MemReg(W1) Then Begin
              If (Dist = Long) Or (Dwtmp = DwPtr) Then
                Tmp := Longcode[Inst]
              Else
                Tmp := Shortcode[Inst];
              InsertByte($FF);
              InsertByte(ModeByte+Tmp);
              Displace_Bytes(W1)
            End Else
              ErrNull;
    NextA
  End;

  Procedure Retrn(Far : Boolean);
  Const
    RetCodes1: array[boolean] of Byte = ($C2,$CA);
    RetCodes2: array[boolean] of Byte = ($C3,$CB);
  Begin
    If (Sym = Disp16) Or (Sym = Disp8) Then Begin
      InsertByte(RetCodes1[Far]);
      InsertWord(NValue);
      NextA
    End Else
      InsertByte(RetCodes2[Far])
  End;

  Function OtherInst : Boolean;
  Type
    Instsym = (Ret,Retf,Aam,Aad,Inn,Out,Mul,Imul,Divd,Idiv,Int);
  Var
    Index: Instsym;
    Tmp: Byte;
  Const
    TheInst = 'RET.RETF.AAM.AAD.IN.OUT.MUL.IMUL.DIV.IDIV.INT.';

    Procedure MulDiv(B : Byte);
    Var
      Wordbit: Integer;
    Begin
      InsertByte($F6);
      If Register(Reg2, W2) Then Begin
        InsertByte($C0+B+Reg2);
        Wordbit := W2;
      End Else
        If MemReg(W2) Then Begin
          Chk_BwPtr;
          Wordbit := Ord(ByWord);
          InsertByte(ModeByte+B);
          Displace_Bytes(W2)
        End Else
          Error('Reg or Mem Exp');
      Modify_Byte(Tindex0, Wordbit)
    End;

    Function DXreg : Boolean;
    Begin
      DXreg := False;
      If Sym = Identifier Then
        If TokStr = 'DX' Then Begin
          DXreg := True;
          NextA
        End
    End;

    Function Accum(Var W : Byte) : Boolean;
    Var
      Result_acc : Boolean;
      {See if next is AL or AX}
    Begin
      Result_acc := False;
      If (Sym = Identifier) Then Begin
          Result_acc:= (TokStr = 'AX') Or (TokStr = 'AL');
          If Result_acc Then Begin
            If TokStr[2] = 'X' Then
              W := 1
            Else
              W := 0; {word vs byte register}
            NextA
          End
        End;
      Accum:= Result_acc
    End;

  Begin
    OtherInst := False;
    if not RetIndex(TokStr,TheInst,Byte(Index)) Then
      Exit;
    OtherInst := True;
    NextA;
    Case Index Of
      Ret : Retrn(False);
      Retf : Retrn(True);
      Out : Begin
              If DXreg Then
                InsertByte($EE) {out dx,ac}
              Else
                If Sym = Disp8 Then Begin
                  {out port,ac}
                  InsertByte($E6);
                  InsertByte(Lo(NValue));
                  NextA
                End Else
                  Error('DX or Port Exp');
              If Sym = Comma Then NextA;
              If Accum(W1) Then
                Modify_Byte(Tindex0, W1) {al or ax}
              Else
                Error('AX or AL Exp')
            End;
      Inn : Begin
              If Accum(W1) Then Begin
                If Sym = Comma Then NextA;
                If DXreg Then
                  InsertByte($EC+W1) {in ac,dx}
                Else Begin
                  If Sym = Disp8 Then Begin     {in ac,port}
                    InsertByte($E4+W1);
                    InsertByte(Lo(NValue));
                    NextA;
                  End Else
                    Error('DX or Port Exp')
                End
              End Else
                Error('AX or AL Exp')
            End;
      Aam : Begin
              InsertByte($D4);
              Insertbyte($0A)
            End;
      Aad : Begin
              InsertByte($D5);
              InsertByte($0A)
            End;
      Mul : MulDiv($20);
      Imul : MulDiv($28);
      Divd : MulDiv($30);
      Idiv : MulDiv($38);
      Int : If Sym = Disp8 Then Begin
              If NValue = 3 Then
                InsertByte($CC)
              Else Begin
                InsertByte($CD);
                InsertByte(Lo(NValue))
              End;
              NextA
            End Else
              ErrNull;
    End;
  End;

  Function GetQuoted(Var Ls : BigString) : Boolean;
  Var SaveChi, K : Integer;
    Term           : Char;
    Gq             : Boolean;
  Begin
    SkipSpaces;
    SaveChi := Chi; K := 1;
    Gq := False;
    If (UCh = '''') Or (UCh = '"') Then Begin
      Term := UCh; GetCh;
      While (UCh <> Term) And (UCh <> Chr(CR)) Do
        If (UCh <> Chr(CR)) And (K <= BigStringSize) Then Begin
          Ls[K]:= LCh;
          Inc(K);
          GetCh
        End;
      GetCh;                    {pass by term}
      Gq := Not(UCh In ['+', '-', '*', '/']) {else was meant to be expr}
    End;
    Ls[0] := Chr(K-1);
    If Not Gq Then Begin
      Chi := SaveChi-1;
      GetCh
    End;
    GetQuoted := Gq
  End;

  Procedure DataByte;
  Var
    I: Integer;
    Lst: BigString;
  Begin
    Repeat
      If GetQuoted(Lst) Then
        For I := 1 To Ord(Lst[0]) Do
          InsertByte(Lo(Ord(Lst[I])))
      Else
        If ReadByte Then
          InsertByte(Byt)
        Else
          ErrNull;
      While (UCh = ' ') Or (UCh = Chr(Tab)) Or (UCh = ',') Do GetCh;
    Until (UCh = Chr(CR)) Or (UCh = ';') Or Aerr;
    NextA;
  End;

  Procedure Chk_For_Label;
  Var
    Dum1, Dum2 : Byte;
  Begin
    If Not Prefix Then Begin
      {-could be prefix here}
      SkipSpaces;
      If (TokStr[0] > Chr(0)) And (UCh = ':') Then Begin
        {-label found}
        Sym := Identifier;
        If Register(Dum1, Dum2) Then
          Error('Register name used as label')
        Else Begin
          GetCh;
          Symname := TokStr;
          Pl:= Firstlabel; {check for duplication of label}
          While Pl <> Nil Do With Pl^ Do Begin
            If Symname = Name Then Error('Duplicate Label');
            Pl := Next
          End;
          New(Pl);          {add the label to the label chain}
          With Pl^ Do Begin
            Next:= Firstlabel;
            Firstlabel:= Pl;
            ByteCnt:= ByteCount;
            Name:= Symname
          End;
          Pf := Firstfix;   {see if any fixups are required}
          While Pf <> Nil Do With Pf^ Do Begin
            If Name = Symname Then Begin
              {-remove this fixup from chain}
              If Pf = Firstfix Then
                Firstfix := Next
              Else
                Prev^.Next := Next;
              If Next <> Nil Then Next^.Prev := Prev;
              Dispose(Pf);
              Addr := ByteCount-(Fix_pt+1);
              If Jmptype = Short Then
                If Addr+$80 <= $FF Then
                  Modify_Byte(Indx, Lo(Addr))
                Else
                  Error('Too Far')
              Else Begin
                {-jmptype=med}
                Dec(Addr);
                Modify_Byte(Indx, Lo(Addr));
                Modify_Byte(Indx2, Hi(Addr))
              End
            End;
            Pf := Next
          End
        End; {label found}
        GetString; {for next item to use}
      End
    End {neither a label or a prefix} Else
      GetString {it was a prefix}
  End;

  Procedure Interpret;
  Begin
    Tindex0 := Tindex;            {opcode position}
    GetString;
    Chk_For_Label;
    While Prefix Do               {process any prefix instructions}
      GetString;
    If Length(TokStr)=0 Then
      NextA                       {if not a string find out what}
    Else
      If NoOperand
      Or OneOperand
      Or TwoOperands
      Or ShortJmp
      Or CallJmp
      Or ShfRot
      Or OtherInst
      Or FaddType
      Or Fnoperand
      Or FiaddType
      Or FldType
      Or FmemOnly
      Or FildType
      Or FstiOnly Then
        {void}
      Else
        If TokStr='DB' Then
          DataByte
        Else
          If TokStr = 'NEW' Then Begin
            NewFnd := True;
            NextA
          End Else
            If TokStr = 'END' Then Begin
              TheEnd := True;
              NextA
            End Else
              Error('Unknown Instruction');
    If Sym <> EOLsym Then Error('End of Line Exp');
  End;

  Function DoAsm(InsertComments : Boolean) : Boolean;
  Var
    s              : String;

    Procedure LabelReport;        {Report any fixups not made and restore heap}
    Var
      Pftmp          : Fixup_Info_Ptr;
      Pltmp          : Label_Info_ptr;
    Begin
      Pf := Firstfix;
      While Pf <> Nil Do With Pf^ Do Begin
        WriteLn('Label not Found-- ', Name);
        DoAsm := False;
        Pftmp := Next;
        Dispose(Pf);
        Pf := Pftmp
      End;
      Pl := Firstlabel;
      While Pl <> Nil Do Begin
        Pltmp := Pl^.Next;
        Dispose(Pl);
        Pl := Pltmp
      End
    End;

  Begin {DoAsm}
    Wait_Already := False;
    EofInstr := False;
    NewFnd := True;
    TheEnd := False;
    Tindex := 0;
    Chi := 0;
    DoAsm := True;                {-we assume there's no error}
    While NewFnd And Not TheEnd Do Begin
      NewFnd := False;
      Start_Col := 1;
      ByteCount := 0;
      Firstlabel := Nil; Firstfix := Nil;
    (* InsertStr('inline(');
     * if InsertComments then
     * InsertStr(^m^j);
     *)

      While Not TheEnd And Not NewFnd Do Begin
        Aerr:= False; NoAddrs := False;
        ByWord:= UnkPtr;
        Column:= 0;
        GetCh;
        Sym := Othersym;
        SkipSpaces;
        If UCh <> Chr(CR) Then Begin {skip blank lines}
          StartChi := Chi;
          Interpret;
          If Aerr Then          {-mark error}
            DoAsm := False;
          If InsertComments And Not NewFnd Then Begin
            s := GetStr(StartChi);
            If s <> '' Then
              InsertStr(#9'{'+s+'}'^m^J)
          End;
          If Column>72 Then Begin
            InsertStr(^m^j);
            Column:= 0
          End
        End;
        If TheEnd Or NewFnd Then {-Fix up the last '/' inserted}
          TextArray[LastSlash] := ' '
      End;
      LabelReport {report any fixups not made and dispose all heap items}
    End
  End;

  Function ObjSize : Word;
  Begin
    ObjSize := Tindex
  End;

End.