{                                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);
  end;

begin   { generate }
  t := ''; errn := codpnt^.errn;
  op1 := codpnt^.op1; op2 := codpnt^.op2;
  with codpnt^ do begin
  if errn=0 then begin
    if repx in [rep,repne,repnz] then emit($f2);
    if repx in [repe,repz] then emit($f3);
    if lockx then emit($f0);
    if override in [ds,cs,ss,es] then emit($26+(rn[override] shl 3));

    case op of

   nul: ;

   mov: begin
      w := 1;
      if not (op1.isop and op2.isop)
      then error(1)
      else if op1.issreg then begin
          if op1.rg=cs then error(10);
          q0 := $8e;
          if op2.isreg then regtoreg(q0,op1,op2)
          else if op2.isaddr then regmem(q0,op1,op2)
          else error(10);
        end
      else if op2.issreg then begin
          q0 := $8c;
          if op1.isreg then regtoreg(q0,op2,op1)
          else if op1.isaddr then regmem(q0,op2,op1)
          else error(10);
        end
      else if op2.isimmed then begin
          if op1.isreg
          then imtoreg($b0,op1,op2)
          else imtorm($c6,0,op1,op2,false);
        end
      else if op1.isreg and (op1.rg in [ax,al]) and op2.isaddr
              and not op2.isbase and not op2.isidx then begin
          if op1.rg = ax then emit($a1) else emit($a0);
          emitimm(op2);
        end
      else if op2.isreg and (op2.rg in [ax,al]) and op1.isaddr
              and not op1.isbase and not op1.isidx then begin
          if op2.rg = ax then emit($a3) else emit($a2);
          emitimm(op1);
        end
      else if op1.isreg and op2.isreg then begin
          q0 := $8a;
          regtoreg(q0,op1,op2); end
      else if (op1.isreg and op2.isaddr) or (op1.isaddr and op2.isreg)
        then begin
          q0 := $88;
          if op1.isaddr
          then regmem(q0,op2,op1)
          else begin
            q0 := q0+2;
            regmem(q0,op1,op2)
            end
        end
      else error(10);
    end;

   add,adc,sub,sbb,cmp,and_,or_,xor_,test_:
    begin
      if not (op1.isop and op2.isop)
      then error(1)
      else
      if op2.isimmed
      then if op1.isreg and ((op1.rg=ax) or (op1.rg=al))
           then begin
             if op1.isword then op2.isbyte := false;
             case op of
            add: q0 := $04;
            adc: q0 := $14;
            sub: q0 := $2c;
            sbb: q0 := $1c;
            cmp: q0 := $3c;
            and_: q0 := $24;
            or_ : q0 := $0c;
            xor_: q0 := $34;
            test_: q0 := $a8;
             end;
             imtoacc(q0,op1,op2);
           end
           else begin
             q0 := $80;
             case op of
            add: q1 := 0;
            adc: q1 := 2;
            sub: q1 := 5;
            sbb: q1 := 3;
            cmp: q1 := 7;
            and_: q1 := 4;
            or_ : q1 := 1;
            xor_: q1 := 6;
            test_: begin q0 := $f6; q1 := 0; end;
             end;
             if op in [add,adc,sub,sbb,cmp]
             then imtorm(q0,q1,op1,op2,true)
             else imtorm(q0,q1,op1,op2,false);
           end

      else if op1.isreg and op2.isreg
           then begin
             case op of
            add: q0 := $02;
            adc: q0 := $12;
            sub: q0 := $2a;
            sbb: q0 := $1a;
            cmp: q0 := $3a;
            and_: q0 := $22;
            or_ : q0 := $0a;
            xor_: q0 := $32;
            test_: q0 := $84;
             end;
             regtoreg(q0,op1,op2);
           end
      else if (op1.isaddr and op2.isreg) or (op1.isreg and op2.isaddr)
           then begin
             case op of
            add: q0 := $00;
            adc: q0 := $10;
            sub: q0 := $28;
            sbb: q0 := $18;
            cmp: q0 := $38;
            and_: q0 := $20;
            or_ : q0 := $08;
            xor_: q0 := $30;
            test_: q0 := $84;
             end;
             if op1.isaddr
             then regmem(q0,op2,op1)
             else begin
               if op<>test_ then q0 := q0+2;
               regmem(q0,op1,op2)
               end
           end
      else error(10);
    end;

   push,pop:
    begin
    with op1 do begin
      oneop;
      if issreg then begin
        if (op=pop) and (rg=cs) then error(10);
        case op of
       push: q0 := $06;
       pop:  q0 := $07;
        end;
        emit(q0+(rn[rg] shl 3));
        end
      else if isreg then begin
        if not isword then error(3);
        case op of
       push: q0 := $50;
       pop:  q0 := $58;
        end;
        emit(q0+rn[rg]);
        end
      else if isaddr then begin
        if isbyte then error(3);
        case op of
       push: begin q0 := $ff; q1 := 6; end;
       pop:  begin q0 := $8f; q1 := 0; end;
        end;
        emit(q0);
        onerm(q1,op1);
        end
      else error(10);
    end;
    end;

   inc,dec:
    begin
    with op1 do begin
      oneop;
      if isreg and isword then begin
        case op of
       inc: q0 := $40;
       dec: q0 := $48;
        end;
        emit(q0+rn[rg]);
        end
      else if isaddr or isreg then begin
        if isbyte then w := 0
        else if isword then w := 1
        else error(7);
        case op of
       inc: q1 := 0;
       dec: q1 := 1;
        end;
        emit($fe+w);
        onerm(q1,op1);
        end
      else error(10);
    end;
    end;

   xchg:
    begin
      if not op2.isop then error(1);
      if op1.isreg and op2.isreg and ((op1.rg=ax) or (op2.rg=ax))
      then begin
        if op1.rg<>ax
        then emit($90+rn[op1.rg])
        else emit($90+rn[op2.rg]);
        end
      else if op1.isreg and op2.isreg
      then regtoreg($86,op1,op2)
      else if op1.isreg and op2.isaddr
      then regmem($86,op1,op2)
      else if op1.isaddr and op2.isreg
      then regmem($86,op2,op1)
      else error(10);
    end;

   mul,imul,div_,idiv,neg,not_:
    begin
      oneop;
      if op1.isbyte then q0 := $f6
      else if op1.isword then q0 := $f7
      else error(7);
      case op of
     mul:  q1 := 4;
     imul: q1 := 5;
     div_:  q1 := 6;
     idiv: q1 := 7;
     neg:  q1 := 3;
     not_:  q1 := 2;
      end;
      emit(q0);
      onerm(q1,op1);
    end;

   in_: inout($e4,op1,op2);
   out: inout($e6,op2,op1);

   lea,lds,les:
    begin
      if not op2.isop then error(1);
      if not(op1.isreg and op1.isword and op2.isaddr) then error(10);
      case op of
     lea: q0 := $8d;
     lds: q0 := $c5;
     les: q0 := $c4;
      end;
      emit(q0);
      onerm(rn[op1.rg],op2);
    end;

   shl_,sal,shr_,sar,rol,ror,rcl,rcr:
    begin
    with op2 do begin
      if not isop then error(1);
      if isidx or isbase then error(10);
      if isconst and (value=1) then q0 := $d0
      else if isreg and (rg=cl) then q0 := $d2
      else error(10);
      case op of
     shl_,sal: q1 := 4;
     shr_: q1 := 5;
     sar: q1 := 7;
     rol: q1 := 0;
     ror: q1 := 1;
     rcl: q1 := 2;
     rcr: q1 := 3;
      end;
      if op1.isword
      then q0 := q0+1
      else if not op1.isbyte then error(7);
      if not(op1.isreg or op1.isaddr) then error(10);
      emit(q0);
      onerm(q1,op1);
    end;
    end;

   lods,stos,scas:
    begin
    with op1 do begin
      if op2.isop then error(11);
      if not op1.isop then error(7);
      case op of
     lods: q0 := $ac;
     stos: q0 := $aa;
     scas: q0 := $ae;
      end;
      if isword then q0 := q0+1 else if not isbyte then error(7);
      if isbase or isimmed or isreg then error(10);
      if isidx and (((idx=si) and (op in [stos,scas]))
                    or ((idx=di) and (op=lods))) then error(10);
      emit(q0);
    end; end;

   movs,cmps:
    begin
      if op2.isop then begin
        checktype(op1,op2);
        if op2.isidx and (((op2.idx=di) and (op=movs))
           or ((op2.idx=si) and (op=cmps))) then error(10);
        if op2.isbase or op2.isimmed or op2.isreg then error(10);
        end
      else if op1.isop then begin
        if op1.isword then w := 1
        else if op1.isbyte then w := 0
        else error(7);
        if op1.isimmed or op1.isreg or op1.isaddr then error(10);
        end
      else error(7);
      if op1.isop then begin
        if op1.isbase or op1.isimmed or op1.isreg then error(10);
        if op1.isidx and (((op1.idx=si) and (op=movs))
           or ((op1.idx=di) and (op=cmps))) then error(10);
        end;
      case op of
     movs: emit($a4+w);
     cmps: emit($a6+w);
      end;
    end;

   ret:
    begin
      if op2.isop then error(11);
      if not op1.isop then error(1);
      with op1 do begin
        if isidx or isbase or isreg or isid then error(10);
        if isconst then q0 := $c2 else q0 := $c3;
        if isfar then q0 := q0+8
        else if not isnear
          then if isshort then error(10) else error(7);
        emit(q0);
        if isconst then emit2(value);
      end
    end;

   jmp,call:
    begin
    with op1 do begin
      w := 1;
      if op2.isop then begin
        if not (isimmed and op2.isimmed) then error(10);
        if isnear or op2.isnear then error(3);
        case op of
       jmp:  emit($ea);
       call: emit($9a);
        end;
        emitimm(op1);
        emitimm(op2);
        end
      else if not op1.isop then error(1)
      else if isfar then begin
        if (not isaddr) or (isid and search(ident)) then error(10);
        emit($ff);
        case op of
       jmp:  onerm(5,op1);
       call: onerm(3,op1);
        end;
        end
      else if isimmed and isconst then begin
        if (value<=127) and (value>=-128) and (op=jmp)
        then begin emit($eb); emit(value); end
        else begin
          case op of
         jmp:  emit($e9);
         call: emit($e8);
          end;
          emitimm(op1); end;
        end
      else if isid and search(ident) then begin
        if isidx or isbase then error(2);
        q1 := tab[n].val-loc-2;
        if pass=3 then begin
          if (op=jmp) and (q1 >= -128) and (q1 <= 127)
          then begin
            emit($eb);
            if isshort then emit(q1)
            else begin emit(q1); emit($90); end;
            end
          else begin
            case op of
           jmp:  begin
              if isshort then error(17);
              emit($e9); end;
           call: begin
              if isshort then error(10);
              emit($e8); end;
            end;
            emit2(q1-1);
            end;
          end
        else begin  {pass2}
            if (op=jmp) and (isshort or ((tab[n].val > -1) and (q1 > -128)))
            then begin emit2(0); isshort := true; end
            else begin emit2(0); emit(0); end;
          end;
        end
      else if (isreg or isaddr) and not (isbyte or isshort) then begin
        if not (isnear or isreg) then error(7);
        emit($ff);
        case op of
       jmp:  onerm(4,op1);
       call: onerm(2,op1);
        end;
        end
      else error(10);
    end;
    end;

   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:
    begin
      oneop;
      with op1 do begin
      if (isimmed and isconst)
      then if not ((value>=-128) and (value<=127)) then error(12) else
      else if not (isid and not (isidx or isbase)) then error(10);
      case op of
     je,jz:   q0 := $74;
     jl,jnge: q0 := $7c;
     jle,jng: q0 := $7e;
     jb,jnae: q0 := $72;
     jbe,jna: q0 := $76;
     jp,jpe:  q0 := $7a;
     jo:      q0 := $70;
     js:      q0 := $78;
     jne,jnz: q0 := $75;
     jnl,jge: q0 := $7d;
     jnle,jg: q0 := $7f;
     jnb,jae: q0 := $73;
     jnbe,ja: q0 := $77;
     jnp,jpo: q0 := $7b;
     jno:     q0 := $71;
     jns:     q0 := $79;
     loop:          q0 := $e2;
     loopz,loope:   q0 := $e1;
     loopnz,loopne: q0 := $e0;
     jcxz:          q0 := $e3;
      end;
      if isconst
      then begin emit(q0); emit(value); end
      else begin
        if (pass=3) and not search(ident) then error(16);
        q1 := tab[n].val-loc-2;
        if (pass=3) and ((q1 < -128) or (q1 > 127)) then error(17);
        emit(q0);
        emit(q1);
        end;
      end;
    end;

   int:
    begin
    with op1 do begin
      oneop;
      if isidx or isbase or not isconst then error(10);
      if (value < 0) or (value > 255) then error(12);
      if value=3 then emit($cc)
      else begin emit($cd); emit(value); end;
    end;
    end;

   esc:
    begin
      if not op2.isop then error(1);
      if not op1.isimmed then error(10);
      if (op1.value < 0) or (op1.value > 63) then error(10);
      emit($d8+(op1.value shr 3));
      onerm((op1.value and 7),op2);
    end;

   xlat,lahf,sahf,pushf,popf,aaa,daa,aas,das,cbw,cwd,into,iret,clc,cmc,
   stc,cld,std,cli,sti,hlt,wait,aam,aad,nop:
    begin
      if op1.isop then error(11);
      case op of
     xlat: emit($d7);
     lahf: emit($9f);
     sahf: emit($9e);
     pushf:emit($9c);
     popf: emit($9d);
     aaa:  emit($37);
     daa:  emit($27);
     aas:  emit($3f);
     das:  emit($2f);
     cbw:  emit($98);
     cwd:  emit($99);
     into: emit($ce);
     iret: emit($cf);
     clc:  emit($f8);
     cmc:  emit($f5);
     stc:  emit($f9);
     cld:  emit($fc);
     std:  emit($fd);
     cli:  emit($fa);
     sti:  emit($fb);
     hlt:  emit($f4);
     wait: emit($9b);
     aam:  begin emit($d4); emit($0a); end;
     aad:  begin emit($d5); emit($0a); end;
     nop:  emit($90);
      end;
    end;

    else error(29);
    end; { case op }
  end; { if errn }

  if pass=3 then begin                { finish constructing the target line }
    if codpnt = firstentry
    then begin
      writeln(targ,'Inline(');
      writeln; writeln('Inline('); end;
    message;
    if next = nil then  t := t + '  );';
    while length(t) < 25 do t := t+' ';
    t := t + '   { ' + source;
    if length(t) < oldlen-4          { make it look pretty }
    then begin
      if length(t) > oldlen-8 then oldlen := oldlen+2;
      while length(t) < oldlen-4 do t := t+' ';
      end;
    t := t+' }';
    oldlen := length(t);
    writeln(targ,t); writeln(t);     { and write it to the file }
    codpnt := next;
  end;

end; {with}
end; { generate }


procedure address;         { compute address of each label }

begin
  if codpnt^.labeln <> 0
  then tab[codpnt^.labeln].val := loc;
  generate;                { advance location counter }
  codpnt^.errn := errn;
  codpnt := codpnt^.next;
end;


procedure parse_line;       { scan source and build intermediate code }

var
  s: line;       { source line }
  p: integer;    { index into s }
  m: idtype;     { mnemonic opcode }
  labeln: integer;
  temp: line;
  id: idtype;    { identifier }
  preventry: cptr;    { points to previous line of intermediate code }

label nocode;

  function more: boolean;      { any more characters on this line? }
  begin
    more := p <= length(s);
  end;

  procedure skipblank;
  begin
    while more and (s[p] = ' ') do
    p := p+1;
  end;

  function alpha: boolean;
  begin
    alpha := more and (s[p] in ['a'..'z','A'..'Z']);
  end;

  function digit: boolean;
  begin
    digit := more and (s[p] in ['0'..'9']);
  end;

  function peek(aset: charset): boolean;   { is next character in aset? }
  begin
    if more and (s[p] in aset) then peek := true else peek := false;
  end;

  function test(c: char): boolean;       { is the next character c? }
  begin                                  { if so, scan over it      }
    if more and (upcase(s[p]) = c)
    then begin
      p := p+1; skipblank;
      test := true
      end
    else test := false
  end;

  procedure getid;               { found an alpha }
  begin                          { get rest of identifier }
    id := '';
    while alpha or digit or peek(['_']) do begin
      if length(id) < 20
      then id := id + s[p]       { return it in id }
      else error(14);
      p := p+1;
    end;
    skipblank;
  end;

  procedure enter(symbol: idtype; var m: integer);
                               { make entry in symbol table }
  begin
    if search(symbol)
    then error(15)
    else if tcnt = tsize then begin
      writeln; writeln('Assembly Aborted -- Symbol Table Full');
      close(src); close(targ);
      halt; end
    else begin
      tcnt := tcnt+1;
      tab[tcnt].id := stupcase(symbol);
      tab[tcnt].val := -1;
      m := tcnt;
    end;
  end;

  function code: boolean;            { found an id }
                                     { is it an opcode? }
  begin
    op := nul;
    m := stupcase(id);
    repeat                           { if so, return it in op }
      op := succ(op)
    until (mn[op] = m) or (op = last);
    if op in [rep,repe,repz,repne,repnz] then begin
      if repx <> nul then error(13);
      repx := op;                      { REP prefix }
      if alpha then begin              { look for another opcode }
        getid;
        code := code; end
      else error(4);
      end
    else if op=lock then begin
      if lockx then error(13);
      lockx := true;                   { LOCK prefix }
      if alpha then begin              { look for another opcode }
        getid;
        code := code; end
      else error(4);
      end
    else if (op > valid) and (op <> last) then error(18)
    else if op <> last then begin
      code := true;
      if (repx<>nul) and not (op in [movs,cmps,scas,lods,stos]) then error(4);
      end
    else begin code := false; op := nul; end;
  end;  { code }

  procedure getoperand(var opr: attr);    { scan an operand }
                                          { determine its attributes }
  var r: regs;

  label gotid;

    procedure makebyte;         { it's a byte }
    begin
      if opr.isword then error(3) else opr.isbyte := true;
    end;

    procedure makeword;         { it's a word }
    begin
      if opr.isbyte then error(3) else opr.isword := true;
    end;

    procedure getnum;           { scan a numeric literal }

    var code: integer;
        minus: boolean;

      procedure gethex;           { scan a hexadecimal literal }
      begin
        if id = '-' then minus := true;
        id := '$'; p := p+1;
        while more and (digit or (upcase(s[p]) in ['A','B','C','D','E','F']))
        do begin
          id := id + s[p];        { return it in id }
          p := p+1;
        end;
        if id = '$' then error(2);
      end;

    begin
      id := ''; minus := false;
      if test('+') then;
      if test('-') then id := '-';
      if peek(['$'])
      then gethex                          { hex }
      else while digit do begin            { decimal }
        id := id + s[p];
        p := p+1;
      end;
      if id = '' then error(2);
      with opr do begin
        val(id,value,code);              { return value }
        if code<>0
        then if id='-32768'
          then value := $8000
          else error(9);
        if minus then value := -value
      end;
      if id[1] = '-' then delete(id,1,1);
      skipblank;
    end;   { getnum }


    procedure getchar;          { scan a character literal }
    begin
      with opr do begin
      p := p+1;
      value := ord(s[p]); p := p+1;
      if not test('''') then error(2)
      else begin
        isconst := true;
        isimmed := true;
        if not isword then isbyte := true;
      end;
    end; end;

    function testreg: boolean;        { is id a register name? }
    begin
      r := firstreg;
      temp := stupcase(id);
      repeat
        r := succ(r)                  { if so, return register number in r }
      until (reg[r] = temp) or (r = lastreg);
      if r <> lastreg then testreg := true else testreg := false;
    end;


  begin  {getoperand}
    with opr do begin
    isop := true;
    if not (alpha or digit or peek(['=','$','*','[','+','-','(','''']))
    then error(2)
    else begin
      if alpha then begin
        getid;
        if testreg and (r in [ds,cs,ss,es]) and peek([':'])
        then begin                                { segment override prefix }
          if test(':') then;
          if override<>lastreg then error(13);
          override := r; end
        else goto gotid;
        end;
      if test('(') then begin                     { type modifier }
        if test('B') then makebyte
        else if test('W') then makeword
        else if test('S') then isshort := true
        else if test('N') then isnear := true
        else if test('F') then isfar := true
        else error(6);
        if not test(')') then error(6);
        end;
      if test('=') then isimmed := true;
      if test('[')
      then begin                                  { base or index register }
        if isimmed then error(2);
        isaddr := true;
        getid;
        if testreg
        then begin
          if not test(']') then error(6);
          if r in [bx,bp]
          then begin                              { base register }
            isbase := true; isop := true;
            base := r;
            if test('[')
            then begin
              getid;
              if testreg
              then begin
                if not test(']') then error(6);
                if r in [si,di]
                then begin                        { and index register }
                  isidx := true;
                  idx := r;
                  end
                else error(8)
                end
              else error(5)
              end
            end
          else if r in [si,di]
            then begin                            { index register }
              isidx := true;
              idx := r;
            end
          else error(8);
          end
        else error(5)
        end;
      if alpha
      then begin                                  { identifier }
        getid;
gotid:  if testreg
        then begin                                { it's a register }
          if r in [ds,ss,cs,es]
          then issreg := true
          else isreg := true;
          if r in [ax,bx,cx,dx,sp,bp,si,di,ds,ss,cs,es]
          then makeword;
          if r in [ah,bh,ch,dh,al,bl,cl,dl]
          then makebyte;
          if isimmed then error(2);
          rg := r;
          end
        else begin                              { it's a variable or label id }
          isaddr := not isimmed;
          isid := true;
          ident := id;
          if isimmed then makeword;
          end;
      end  {alpha}
      else if digit or peek(['$','+','-'])
      then begin                                  { numeric literal }
        getnum;
        isaddr := not isimmed;
        isconst := true;
        if isimmed
        then if (value <= 255) and (value >= -128) and not isword
             then makebyte
             else makeword;
      end
      else if test('*')
      then begin                                { location counter reference }
        ident := '*';
        isaddr := not isimmed;
        isid := true;
        if isimmed then makeword;
        if test('+') then ident := '*+';
        if test('-') then ident := '*-';
        if ident<>'*' then begin
          if not peek(['$','0'..'9']) then error(9);
          getnum;
          ident := ident + id;
        end;
      end
      else if peek(['''']) then getchar;        { character literal }
    if isbase and (base=bp) and not isidx and not (isid or isconst)
    then begin
      isconst := true; value := 0;
      ident := '$00';
      end;
    end;
    if isimmed and not (isid or isconst) then error(6);
    end; {with}
    skipblank;
  end;   {getoperand}


begin    { parse_line }
  errn := 0; labeln := 0;
  op := nul; repx := nul; lockx := false; override := lastreg;
  with op1 do begin
      isop := false; isaddr := false;
      isid := false; isreg := false; issreg := false;
      isidx := false; isbase := false;
      isbyte := false; isword := false;
      isshort := false; isnear := false; isfar := false;
      isimmed := false; isconst := false;
    end;
  op2 := op1;
  readln(src,s);                       { read in a source line }
  for p := 1 to length(s) do
    if ord(s[p]) < 32 then s[p] := ' ';
  p := 1;
  if more
  then begin
    skipblank;
    if alpha then begin
      getid;
      if test(':') then begin                               { label }
        enter(id,labeln);
        if alpha
        then getid
        else goto nocode;
        end;
      if code                                             { opcode }
      then begin
        if more and not peek([';'])
        then begin
          getoperand(op1);                               { first operand }
          if test(',')
          then begin
            if more
            then getoperand(op2)                         { second operand }
            else error(6);
            if more and not peek([';']) then error(6);
            end
          else if more and not peek([';']) then error(6);
          end
        end
        else error(4)
      end
    else
nocode: if more and not peek([';']) then error(6);
  preventry := codpnt;
  if maxavail > sizeof(codrec) shr 4 +1
  then new(codpnt)                    { create new line of intermediate code }
  else begin
    writeln; writeln('Assembly Aborted -- Out of Memory');
    close(src); close(targ); halt; end;
  if firstentry = nil then firstentry := codpnt;
  preventry^.next := codpnt;                                { and link it }
  codpnt^.next := nil;
  codpnt^.labeln := labeln;
  codpnt^.op := op;                                { enter the data }
  codpnt^.op1 := op1;
  codpnt^.op2 := op2;
  codpnt^.repx := repx;
  codpnt^.lockx := lockx;
  codpnt^.override := override;
  codpnt^.errn := errn;
  codpnt^.source := s;
  end;
end;  { parse_line }


begin  { main }
  writeln('                    InLiner'); writeln;
  startup;
  init;
  atstart := true; ok := true;
  oldlen := 0; loc := 0; tcnt := 0;

  pass := 1; firstentry := nil;
  while not eof(src) do parse_line;

  pass := 2; codpnt := firstentry; loc := 0;
  while codpnt <> nil do address;

  pass := 3; codpnt := firstentry; loc := 0;
  while codpnt <> nil do generate;

  writeln;
  if ok then writeln('Assembly Successful')
        else writeln('Assembled with Errors');
  close(src); close(targ);
end.
