{                                Inliner

    Version 1.00                                     File: INLINER.PAS
Last revised: 12 Apr 1985                          Author: Anthony M. Marcy

DESCRIPTION

   Inliner is an assembler which translates 8088 assembly language directly
into Turbo Pascal INLINE code.  It is written in, and generates code for,
Turbo Pascal 2.00 for the IBM PC.  This program is in the public domain.
   Inliner accepts a source language similar, but not identical, to that
of the IBM Macro Assembler (MASM).  It produces a single Turbo INLINE statement
ready to be merged into a Pascal program or used as an Include file.
   All 8088 instructions are supported.  MASM pseudo-ops are not, and there
are a few differences in syntax between Inliner and MASM, as detailed below.
   System requirements are those for running Turbo.  If you can compile
Inliner, you can run it.  (If you can't compile it, you don't need it.)
Maximum assembly program size is set by the size of memory.  Inliner can use
all available contiguous memory.
   The new version 3.00 of Turbo has changes to the INLINE statement which
make it not always compatible with code written for Turbo 2.00.  Inliner 1.00
is designed to work with Turbo 2.00.  In particular, assembly programs which
contain both labels and constant identifiers, and assembled by Inliner, may
not compile correctly under Turbo 3.00.

GETTING STARTED

   You will be prompted for a source file and a target file.  If no source
filename extension is given, .ASM is assumed.  The default target file is
your source filename with extension .PAS; a carriage return accepts the
default, or you may enter any legal filename.
   Quick trick: entering TRM: as the source file will allow you to type your
input directly into Inliner.  It will not be saved, however, and no editing
is available.  End your input with ctrl-z.  Entering NUL as the target file
will cause no output file to be generated, but you can still see the output
on the screen.  Handy if you just need a line or two, or for testing what
will "work".
   Inliner may also be started from the DOS command line, thus:
                A> inliner infile.asm outfile.pas
The second parameter may be omitted, in which case the default is assumed.


INSTRUCTION FORMAT

   An Inliner source line takes the general form:
               label: opcode operand, operand ;comment
Each of these components is optional.

   A LABEL can be anything that would be legal as a Turbo identifier, limited
in length to a maximum of twenty characters.  The colon is mandatory after
a label.

   OPCODEs are the standard Intel mnemonics.  LOCK and the various REP
prefixes are supported.  The segment override prefix can only be placed before
an operand, not before the opcode.

   OPERANDs can be of three general kinds: register, address, and immediate.
Register operands are the usual mnemonics - AX,BX, etc.
Address operands have the following form:
               prefix: (type) [base] [index] offset
Each component is optional.  The ordering is strict.
       prefix is a segment override -- DS, CS, SS, or ES
       type is a single letter --  N   Near
                                   F   Far
                                   S   Short
                                   W   Word
                                   B   Byte
       base is a base register -- BX or BP
       index is an index register -- SI or DI
       offset is either a literal constant or a Turbo identifier

Turbo identifiers are copied into the INLINE code.  Any identifier which does
not occur as a label is assumed to be a Turbo identifier. The compiler replaces
variable names with their offsets within their segments; it replaces constant
identifiers with their values.  The location counter, *, is also legal.  See
the Turbo manual for details.
     ADD AL,var1     ;var1 is a global variable in the data segment
     ADD AL,[BP]var2 ;var2 is a local variable in the stack segment
     ADD AL,CS:var3  ;var3 is a typed constant in the code segment

Immediate operands are distinguished by being prefixed with an equal sign.
They may be constants or Turbo variables.  Thus,
     MOV AX,=2 ;loads the value 2 into AX
     MOV AX,2  ;loads AX with the word at offset 2 in the data segment
     MOV AX,var1  ;loads AX with the contents of variable var1
     MOV AX,=var1 ;loads the offset of variable var1 into AX
The equal sign is optional in the INT, RET, IN, and OUT instructions, and
before character literals.

   CONSTANTs can be decimal integers (positive or negative), hex constants
in Turbo format (preceded by $), constant identifers, or character literals
enclosed in single quotes.  Examples:  2   -128   $FF   cons   'x'
   The type must be specified when it cannot otherwise be deduced:
     ADD AX,[BP]2  ;AX - must be a word operand
     INC (W)[BP]2  ;requires (W) or (B)
Immediate numeric constants default to (B)yte if in the range -128..255,
otherwise (W)ord.

   JMP requires special treatment.  A (F)ar jump to an absolute address may be
coded with two operands, both immediate constants, representing the segment
and the offset:
     JMP =$0060,=$0100   ;absolute address 0060:0100
A (N)ear jump to an offset in the CS requires a single immediate operand:
     JMP =$0100   ;address CS:0100
     JMP =*-1   ;this instruction jumps to itself
An indirect jump takes either a register or an address operand.  In the latter
case, the type must be specified:
     JMP AX     ;must be (N)ear
     JMP (F)[BP][SI]
     JMP (N)var1
Lastly, the jump target may be an Inliner label.  For forward references,
more efficient code can be generated if (S)hort is specified when possible:
     JMP lab1
     JMP (S)lab2

   CALL is similar to JMP, except that (S)hort cannot be used.

   The conditional jump instructions -- JE, JNE, etc. -- take a single
operand which may be either an immediate constant in the range -128..127
or an Inliner label.

   The string instructions vary slightly from MASM syntax.  REP, REPZ, etc.,
are considered prefixes which must be placed before a string opcode on the
same line.  The special no-operand forms of the string opcodes -- MOVSB,
MOVSW, etc. -- are not implemented.  Instead, use the basic opcode with
a type specifier.  The full two-operand forms may also be written.
     REP CMPS (B)
     REP MOVS (W)[SI],[DI]

   Other instructions resemble their counterparts in MASM.  Refer to the
Macro Assembler manual for their formats.  Inliner does not support any
pseudo-ops, such as PROC, END, DW, or ASSUME.  Nor does it support the
8087 mnemonics.
   Pascal declarations should be used to define data, in place of DB, DW,
EQU, etc.  But remember that your variables are Turbo variables -- Inliner
cannot see your declarations to check type or addressibility.  You must
provide segment overrides where needed.


EXAMPLES

   Here are some more examples of Inliner code:

     PUSH BP
 h2: CMP var1,=-1    ;byte variable assumed
     CMP var1,(W)=-1  ;unless overridden
     MOV var2,=var4  ;address is always two bytes
     JE (S)h5
     REPE SCAS(B) ;instead of SCASB
     shl ax,cl   ;lower case is OK
     ESC = 23 , [ DI ] var2 ;spaces are OK, too
     MOV ES:4,'&'
 h5: SUB (W)var3,=$40
     NOP
     CALL (N)xyz ;indirect through variable xyz
                 ;unless xyz is a label
     MOV [BX][DI],CS
     RET (N) 4   ;(N) or (F) required

     -----------------------------------------------------------------

   Inliner is supported on the RBBS-PC operated by
              James Miles
              "The Programmer's Toolbox"
              (301) 540-7230 (data)
              24 Hrs.
Comments, bug reports, and suggested improvements are encouraged.  Address
them to ANTHONY MARCY or to SYSOP.  If you make extensions or revisions
to this program, please upload so that all may share.

                             Enjoy!

     -----------------------------------------------------------------}


program inliner;

const
  tsize = 200;     { size of symbol table }

type
  filename = string[20];
  opcode = (nul,
            mov,push,pop,xchg,in_,out,xlat,lea,lds,les,lahf,sahf,pushf,
            popf,add,adc,inc,sub,sbb,dec,neg,cmp,aas,das,mul,imul,aam,div_,
            idiv,aad,cbw,cwd,not_,shl_,sal,shr_,sar,rol,ror,rcl,rcr,and_,
            test_,or_,xor_,aaa,daa,rep,repe,repz,repne,repnz,movs,cmps,scas,
            lods,stos,call,jmp,ret,je,jz,jl,jnge,jle,jng,jb,jnae,jbe,jna,jp,
            jpe,jo,js,jne,jnz,jnl,jge,jnle,jg,jnb,jae,jnbe,ja,jnp,jpo,jno,jns,
            loop,loopz,loope,loopnz,loopne,jcxz,int,into,iret,
            clc,cmc,stc,cld,std,cli,sti,hlt,wait,esc,lock,nop,
            valid,
            assume,comment,db,dd,dq,dt,dw,end_,equ,even,extrn,group,include,
            label_,name,org,proc,public,record_,segment,struc,macro,endm,
            page,subttl,title,
            fld,fst,fstp,fxch,fcom,fcomp,fcompp,ftst,fxam,fadd,fsub,fmul,fdiv,
            fsqrt,fscale,fprem,frndint,fxtract,fabs,fchs,fptan,fpatan,f2xm1,
            fyl2x,fyl2xp1,fldz,fld1,fldpi,fldl2t,fldl2e,fldlg2,fldln2,finit,
            feni,fdisi,fldcw,fstcw,fstsw,fclex,fstenv,fldenv,fsave,frstor,
            fincstp,fdecstp,ffree,fnop,fwait,
            last);
  regs = (firstreg,ax,bx,cx,dx,sp,bp,si,di,al,bl,cl,dl,ah,bh,ch,dh,
          ds,ss,cs,es,lastreg);
  line = string[80];
  idtype = string[20];
  attr = record                   { attributes of an operand }
           isop: boolean;
           isaddr: boolean;
           isid: boolean;
           isconst: boolean;
           value: integer;
           isreg: boolean;
           issreg: boolean;
           rg: regs;
           isimmed: boolean;
           isidx,isbase: boolean;
           idx,base: regs;
           isbyte,isword: boolean;
           isshort,isnear,isfar: boolean;
           ident: idtype;
         end;
  cptr = ^codrec;
  codrec = record                  { intermediate form of a line of code }
             next: cptr;
             labeln: integer;
             op: opcode;
             op1,op2: attr;
             repx: opcode;
             lockx: boolean;
             override: regs;
             source: line;
             errn: byte;
           end;
  charset = set of char;

var
  reg: array[regs] of string[2];             { register mnemonics }
  rn: array[regs] of 0..7;                   { register numbers   }
  mn: array[opcode] of string[6];            { opcode mnemonics   }
  tab: array[0..tsize] of record             { symbol table }
                            id: idtype;
                            val: integer;
                          end;
  src,targ: text;                       { source and target files }
  errn,pass: byte;                      { error #, pass # }
  atstart,ok: boolean;
  t: string[132];                       { target line }
  loc: integer;          { location counter }
  tcnt: integer;         { number of entries in symbol table }
  n: integer;            { index into symbol table }
  oldlen: integer;
  firstentry: cptr;      { points to first line of intermediate code }
  codpnt: cptr;          { points to current line of intermediate code }

  op: opcode;
  op1,op2: attr;
  repx: opcode;
  lockx: boolean;
  override: regs;


procedure error(j: integer);    { only the first error in a line is recorded }

begin
  if errn = 0 then errn := j;
end;

procedure message;         { print error messages }

begin
  if errn <> 0
  then begin
    ok := false;
    t := t + '***';
    case errn of
     1: t := t + 'NOT ENOUGH OPERANDS';
     2: t := t + 'INVALID OPERAND';
     3: t := t + 'TYPE CONFLICT';
     4: t := t + 'INVALID OPCODE';
     5: t := t + 'INVALID REGISTER';
     6: t := t + 'SYNTAX ERROR';
     7: t := t + 'TYPE NOT SPECIFIED';
     8: t := t + 'ILLEGAL REGISTER';
     9: t := t + 'ERROR IN CONSTANT';
    10: t := t + 'ILLEGAL OPERAND';
    11: t := t + 'TOO MANY OPERANDS';
    12: t := t + 'CONSTANT TOO BIG';
    13: t := t + 'DUPLICATE PREFIX';
    14: t := t + 'IDENTIFIER TOO LONG';
    15: t := t + 'DUPLICATE LABEL';
    16: t := t + 'UNDEFINED LABEL';
    17: t := t + 'LABEL TOO FAR';
    18: t := t + 'NOT IMPLEMENTED';
  { 29: system error }

    else t := t + 'SYSTEM ERROR';
    end;
    t := t + '***'
  end
end;

function stupcase(st: idtype): idtype;

var i: integer;

begin
  for i := 1 to length(st) do
    st[i] := upcase(st[i]);
  stupcase := st
end;  { stupcase }

procedure startup;       { input names of source and target files }

var
  exists: boolean;
  inf,outf,tempstr: filename;
  commandline: string[127] absolute cseg:$80;
  params: string[127];
  default: byte;

  procedure chkinf;             { does source file exist? }
  begin
    inf := stupcase(inf);
    if pos('.',inf) = 0
    then inf := inf + '.ASM';
    assign(src,inf);
    {$I-} reset(src) {$I+} ;            { if so, open it }
    exists := (ioresult = 0);
    if pos(':',inf) = 0
    then inf := chr(default+65) + ':' + inf;
    if not exists
    then writeln('File ', inf, ' not found');
  end;

  procedure chkoutf;               { is target filename valid? }
  begin
    outf := stupcase(outf);
    assign(targ,outf);
    {$I-} rewrite(targ) {$I+} ;         { if so, open it }
    exists := (ioresult = 0);
    if pos(':',outf) = 0
    then outf := chr(default+65) + ':' + outf;
    if not exists
    then writeln('can''t open file ',outf);
  end;

begin
  inf := ''; outf := ''; params := commandline;
  Inline(
     $B4/$19                    { MOV AH,=$19 }
    /$CD/$21                    { INT =$21    }
    /$88/$86/default );         { MOV [BP]default,AL }
  while (params <> '') and (params[1] = ' ') do
    delete(params,1,1);
  if params <> ''
  then begin                                       { command line parameters }
    while (params <> '') and (params[1] <> ' ') do begin
      inf := inf + params[1];
      delete(params,1,1); end;
    chkinf;
    if not exists then begin
      commandline := '';
      startup; end
    else begin
      writeln('Source file: ',inf);
      while (params <> '') and (params[1] = ' ') do
        delete(params,1,1);
      if params <> ''
      then while (params <> '') and (params[1] <> ' ') do begin
        outf := outf + params[1];
        delete(params,1,1); end
      else outf := copy(inf,1,pos('.',inf)) + 'PAS';
      chkoutf;
      if not exists then begin
        commandline := '';
        startup; end
      else writeln('Target file: ',outf);
      end;
    end
  else begin                                        { prompt for filenames }
    repeat
      write('  Source file [.ASM] ? '); readln(inf);
      chkinf;
    until exists;
    tempstr := copy(inf,1,pos('.',inf)) + 'PAS';
    repeat
      repeat
        write('  Target file [',tempstr,'] ? ');
        readln(outf); outf := stupcase(outf);
      until inf <> outf;
      if outf = '' then outf := tempstr;
      chkoutf;
    until exists;
    end;
  writeln;
end;  { startup }

procedure init;               { initialize tables }

begin
  mn[mov ] := 'MOV' ;   mn[push] := 'PUSH';   mn[pop ] := 'POP' ;
  mn[xchg] := 'XCHG';   mn[in_ ] := 'IN'  ;   mn[out ] := 'OUT' ;
  mn[xlat] := 'XLAT';   mn[lea ] := 'LEA' ;   mn[lds ] := 'LDS' ;
  mn[les ] := 'LES' ;   mn[lahf] := 'LAHF';   mn[pushf] := 'PUSHF';
  mn[sahf] := 'SAHF';   mn[popf] := 'POPF';   mn[add ] := 'ADD' ;
  mn[adc ] := 'ADC' ;   mn[inc ] := 'INC' ;   mn[sub ] := 'SUB' ;
  mn[sbb ] := 'SBB' ;   mn[dec ] := 'DEC' ;   mn[cmp ] := 'CMP' ;
  mn[aas ] := 'AAS' ;   mn[das ] := 'DAS' ;   mn[mul ] := 'MUL' ;
  mn[imul] := 'IMUL';   mn[aam ] := 'AAM' ;   mn[div_] := 'DIV' ;
  mn[idiv] := 'IDIV';   mn[aad ] := 'AAD' ;   mn[cbw ] := 'CBW' ;
  mn[cwd ] := 'CWD' ;   mn[aaa ] := 'AAA' ;   mn[daa ] := 'DAA' ;
  mn[not_] := 'NOT' ;   mn[shl_] := 'SHL' ;   mn[sal ] := 'SAL' ;
  mn[shr_] := 'SHR' ;   mn[sar ] := 'SAR' ;   mn[rol ] := 'ROL' ;
  mn[ror ] := 'ROR' ;   mn[rcl ] := 'RCL' ;   mn[rcr ] := 'RCR' ;
  mn[and_] := 'AND' ;   mn[or_ ] := 'OR'  ;   mn[test_] := 'TEST';
  mn[xor_] := 'XOR' ;   mn[rep ] := 'REP' ;   mn[repne] := 'REPNE';
  mn[repe] := 'REPE';   mn[repz] := 'REPZ';   mn[repnz] := 'REPNZ';
  mn[movs] := 'MOVS';   mn[neg ] := 'NEG' ;   mn[nop ] := 'NOP' ;
  mn[cmps] := 'CMPS';   mn[scas] := 'SCAS';   mn[lods] := 'LODS';
  mn[stos] := 'STOS';   mn[call] := 'CALL';   mn[jmp ] := 'JMP' ;
  mn[ret ] := 'RET' ;   mn[je  ] := 'JE'  ;   mn[jz  ] := 'JZ'  ;
  mn[jl  ] := 'JL'  ;   mn[jnge] := 'JNGE';   mn[jle ] := 'JLE' ;
  mn[jng ] := 'JNG' ;   mn[jb  ] := 'JB'  ;   mn[jnae] := 'JNAE';
  mn[jbe ] := 'JBE' ;   mn[jna ] := 'JNA' ;   mn[jp  ] := 'JP'  ;
  mn[jpe ] := 'JPE' ;   mn[jo  ] := 'JO'  ;   mn[js  ] := 'JS'  ;
  mn[jne ] := 'JNE' ;   mn[jnz ] := 'JNZ' ;   mn[jnl ] := 'JNL' ;
  mn[jge ] := 'JGE' ;   mn[jnle] := 'JNLE';   mn[jg  ] := 'JG'  ;
  mn[jnb ] := 'JNB' ;   mn[jae ] := 'JAE' ;   mn[jnbe] := 'JNBE';
  mn[ja  ] := 'JA'  ;   mn[jnp ] := 'JNP' ;   mn[jpo ] := 'JPO' ;
  mn[jno ] := 'JNO' ;   mn[jns ] := 'JNS' ;   mn[loopz ] := 'LOOPZ' ;
  mn[loop] := 'LOOP';   mn[jcxz] := 'JCXZ';   mn[loopnz] := 'LOOPNZ';
  mn[int ] := 'INT' ;   mn[into] := 'INTO';   mn[loope ] := 'LOOPE' ;
  mn[iret] := 'IRET';   mn[clc ] := 'CLC' ;   mn[loopne] := 'LOOPNE';
  mn[cmc ] := 'CMC' ;   mn[stc ] := 'STC' ;   mn[cld ] := 'CLD' ;
  mn[std ] := 'STD' ;   mn[cli ] := 'CLI' ;   mn[sti ] := 'STI' ;
  mn[hlt ] := 'HLT' ;   mn[wait] := 'WAIT';   mn[esc ] := 'ESC' ;
  mn[lock] := 'LOCK';
  mn[valid] := '';
  mn[db  ] := 'DB'  ;   mn[assume ] := 'ASSUME' ;
  mn[dd  ] := 'DD'  ;   mn[comment] := 'COMMENT';
  mn[dq  ] := 'DQ'  ;   mn[extrn  ] := 'EXTRN'  ;
  mn[dt  ] := 'DT'  ;   mn[group  ] := 'GROUP'  ;
  mn[dw  ] := 'DW'  ;   mn[include] := 'INCLUDE';
  mn[end_] := 'END' ;   mn[label_ ] := 'LABEL'  ;
  mn[equ ] := 'EQU' ;   mn[public ] := 'PUBLIC' ;
  mn[even] := 'EVEN';   mn[record_] := 'RECORD' ;
  mn[name] := 'NAME';   mn[segment] := 'SEGMENT';
  mn[org ] := 'ORG' ;   mn[struc  ] := 'STRUC'  ;
  mn[proc] := 'PROC';   mn[macro  ] := 'MACRO'  ;
  mn[endm] := 'ENDM';   mn[subttl ] := 'SUBTTL' ;
  mn[page] := 'PAGE';   mn[title  ] := 'TITLE'  ;
  mn[fld   ] := 'FLD'   ;  mn[fst   ] := 'FST'   ;  mn[fstp  ] := 'FSTP'  ;
  mn[fxch  ] := 'FXCH'  ;  mn[fcom  ] := 'FCOM'  ;  mn[fcomp ] := 'FCOMP' ;
  mn[fcompp] := 'FCOMPP';  mn[ftst  ] := 'FTST'  ;  mn[fxam  ] := 'FXAM'  ;
  mn[fadd  ] := 'FADD'  ;  mn[fsub  ] := 'FSUB'  ;  mn[fmul  ] := 'FMUL'  ;
  mn[fdiv  ] := 'FDIV'  ;  mn[fsqrt ] := 'FSQRT' ;  mn[fscale] := 'FSCALE';
  mn[fprem ] := 'FPREM' ;  mn[fabs  ] := 'FABS'  ;  mn[frndint] := 'FRNDINT';
  mn[fchs  ] := 'FCHS'  ;  mn[fptan ] := 'FPTAN' ;  mn[fxtract] := 'FXTRACT';
  mn[fpatan] := 'FPATAN';  mn[f2xm1 ] := 'F2XM1' ;  mn[fyl2x ] := 'FYL2X' ;
  mn[fldz  ] := 'FLDZ'  ;  mn[fld1  ] := 'FLD1'  ;  mn[fyl2xp1] := 'FYL2XP1';
  mn[fldpi ] := 'FLDPI' ;  mn[fldl2t] := 'FLDL2T';  mn[fldl2e] := 'FLDL2E';
  mn[fldlg2] := 'FLDLG2';  mn[fldln2] := 'FLDLN2';  mn[finit ] := 'FINIT' ;
  mn[feni  ] := 'FENI'  ;  mn[fdisi ] := 'FDISI' ;  mn[fldcw ] := 'FLDCW' ;
  mn[fstcw ] := 'FSTCW' ;  mn[fstsw ] := 'FSTSW' ;  mn[fclex ] := 'FCLEX' ;
  mn[fstenv] := 'FSTENV';  mn[fldenv] := 'FLDENV';  mn[fsave ] := 'FSAVE' ;
  mn[frstor] := 'FRSTOR';  mn[ffree ] := 'FFREE' ;  mn[fincstp] := 'FINCSTP';
  mn[fnop  ] := 'FNOP'  ;  mn[fwait ] := 'FWAIT' ;  mn[fdecstp] := 'FDECSTP';

  reg[ax] := 'AX';  reg[bx] := 'BX';  reg[cx] := 'CX';  reg[dx] := 'DX';
  reg[sp] := 'SP';  reg[bp] := 'BP';  reg[si] := 'SI';  reg[di] := 'DI';
  reg[al] := 'AL';  reg[bl] := 'BL';  reg[cl] := 'CL';  reg[dl] := 'DL';
  reg[ah] := 'AH';  reg[bh] := 'BH';  reg[ch] := 'CH';  reg[dh] := 'DH';
  reg[ds] := 'DS';  reg[ss] := 'SS';  reg[cs] := 'CS';  reg[es] := 'ES';
  rn[ax] := 0;      rn[bx] := 3;      rn[cx] := 1;      rn[dx] := 2;
  rn[sp] := 4;      rn[bp] := 5;      rn[si] := 6;      rn[di] := 7;
  rn[al] := 0;      rn[bl] := 3;      rn[cl] := 1;      rn[dl] := 2;
  rn[ah] := 4;      rn[bh] := 7;      rn[ch] := 5;      rn[dh] := 6;
  rn[ds] := 3;      rn[ss] := 2;      rn[cs] := 1;      rn[es] := 0;
end;   { init }

function search(symbol: idtype): boolean;     { search symbol table }
begin                                         { return index in global n }
  n := 0;
  symbol := stupcase(symbol);
  while (tab[n].id <> symbol) and (n <= tcnt) do n := n+1;
  if n = tcnt+1
  then search := false
  else search := true;
end;

procedure generate;                   { pass 2 -- maintain location counter }
                                      { pass 3 -- generate object code }
var
  q0,w,md,rm: byte;
  q1: integer;

  procedure oneop;         { test for exactly one operand }
  begin
      if op2.isop then error(11);
      if not op1.isop then error(1);
  end;

  procedure emit(q:byte);             { emit one byte }
    function hex(d:byte): char;
    begin
      if d <= 9
      then hex := chr(48+d)
      else hex := chr(55+d);
    end;
  begin
    loc := loc+1;
    if (pass=3) and (errn = 0) then begin
      if atstart then t := t+' ' else t := t+'/';
      atstart := false;
      t := t+'$'+hex(q shr 4)+hex(q and 15);
    end;
  end;

  procedure emit2(q:integer);         { emit two bytes }
  begin
    begin
      emit(q and $ff);
      emit(q shr 8);
    end
  end;

  procedure emitid(ident: idtype);    { emit identifier }
  begin
    loc := loc+2;
    if (pass=3) and (errn = 0) then t := t+'/'+ident;
  end;

  procedure emitimm(op:attr);         { emit immediate value }
  begin
  with op do
    if isid then emitid(ident)
    else if isconst then if (w=1) then emit2(value) else emit(value)
    else error(10);
  end;

  procedure checktype(op1,op2:attr);  { check compatibility of operands }
  begin
    if (op1.isword and not op2.isbyte) or (op2.isword and not op1.isbyte)
    then w := 1
    else if (op1.isbyte and not op2.isword) or (op2.isbyte and not op1.isword)
         then w := 0
    else if not (op1.isbyte or op1.isword or op2.isbyte or op2.isword)
         then error(7)
    else error(3);
    if op1.issreg or op2.issreg then w := 0;
  end;

  procedure modrm(q:byte; op:attr);       { construct the modregr/m byte }
  begin
  with op do begin
    if isid then md := 2
    else if isconst
      then if (value <= 127) and (value >= -128) then md := 1 else md := 2
    else md := 0;

    if isidx and isbase
    then begin
      if base = bx then rm := 0 else rm := 2;
      if idx = di then rm := rm+1;
      end
    else if not isidx and not isbase
    then begin
      md := 0; rm := 6; end
    else begin
      rm := 4;
      if isidx and (idx = di) then rm := rm+1;
      if isbase
      then if base = bp then rm := rm+2 else rm := rm+3;
      end;
      emit((md shl 6)+(q shl 3)+rm);
      if isid then emitid(ident);
      if isconst then begin
        if (value <= 127) and (value >= -128) then begin
          emit(value);
          if (md=0) and (rm=6) then if value<0 then emit($ff) else emit(0);
          end
        else emit2(value);
        end;
  end; end;

  procedure regtoreg(q:byte; op1,op2:attr);
  begin
    checktype(op1,op2);
    emit(q+w);
    emit(192 + (rn[op1.rg] shl 3) + rn[op2.rg]);
  end;

  procedure imtoacc(q:byte; op1,op2:attr);
  begin
    checktype(op1,op2);
    emit(q+w);
    emitimm(op2);
  end;

  procedure imtoreg(q:byte; op1,op2:attr);
  begin
    if op1.isword and op2.isbyte then w := 1 else checktype(op1,op2);
    emit(q+(w shl 3)+rn[op1.rg]);
    emitimm(op2);
  end;

  procedure onerm(q:byte; op:attr);
  begin
  with op do begin
    if isreg
    then emit(192+(q shl 3)+rn[rg])
    else if isaddr then modrm(q,op)
    else error(10);
  end;
  end;

  procedure imtorm(q,r:byte; op1,op2:attr; ext:boolean);
  begin
    if op1.isbyte and op2.isword then error(3)
    else if op1.isbyte and op2.isbyte then w := 0
    else if op1.isword and op2.isword then w := 1
    else if op1.isword and op2.isbyte then if ext then w := 3 else w := 1
    else if op1.isaddr and op2.isbyte then w := 0
    else if op1.isaddr and op2.isword then w := 1
    else error(29);
    emit(q+w);
    onerm(r,op1);
    emitimm(op2);
  end;

  procedure regmem(q: byte; op1,op2: attr);
  begin
    checktype(op1,op2);
    emit(q+w);
    modrm(rn[op1.rg],op2);
  end;

  procedure inout(q:byte; op1,op2:attr);
  begin
    if not (op1.isreg and (op1.rg in [ax,al])) then error(10);
    if op1.rg=ax then w := 1 else w := 0;
    if op2.isconst then begin
      if op2.isidx or op2.isbase then error(10);
      if (op2.value < 0) or (op2.value > 255) then error(12);
      emit(q+w);
      emit(op2.value);
      end
    else if op2.isreg and (op2.rg=dx) then emit(q+8+w)
    else error(10);