			   {file ASSEMBLE}

  implement (*assemble*)

    type
      opsizetype = array[bytte..long] of 0..2;
      numopcodetype = array[opcodetype] of 0..15;
      ctodtype = array['0'..'9'] of 0..9;

      $IF MC68020$
      subopcodetype = fmove..flognp1;
      numsubopcodetype = array[subopcodetype] of 0..127;
      imm_or_reg = (imm,inreg);
      $END$

    const
      immediateops = [addi,andi,cmpi,moveI,subi];

      opsize = opsizetype[0,1,2];

      numopcode = numopcodetype
	[13,13,0,5,{add}
	 12,0,{andd}  14,14,{ASd}  16 of 6,{BRA,Bcc}  4 of 0,{bit}
	 4,{CHK}  4,{CLR}  3 of 11,{cmp}  0,{CMPI} 8,{DIVS}

	 $IF MC68020$
	 4,{DIVSL} 4,{EXTB} 14,{BFEXTS} 14,{BFEXTU} 14,{BFINS} 0,{CHK2}
	 $END$

	 5 of 4,{EXT..LINK}  14,14,{LSd}
	 1,2{move & movea place holders - opcode determined by size},
	 4 of 4{MOVEtoCCR,MOVEfromSR,moveI(dummy, see movea),MOVEM},7{MOVEQ},
	 12,{MULS}  4,4,{NEG,NOT}  8,{OR}  4,4,{PEA,RTS}  16 of 5{Scc},
	 9,9,0,5{sub},  5 of 4{SWAP..UNLK}

	 $IF MC68020$ {68881 instructions}
         { ,17 of 15   11 new instructions  Don Novy  1/17/90 }
           ,28 of 15
         $END$

	 ];

      $IF MC68020$
      numsubopcode = numsubopcodetype
	[0{fmove},4{fsqrt},24{fabs},29{fcos},14{fsin},20{flogn},10{fatan},
	16{fetox},34{fadd},56{fcmp},32{fdiv},26{fneg},35{fmul},40{fsub},
	6{flognp1}];
     $END$

       ctod = ctodtype[0,1,2,3,4,5,6,7,8,9];


    var
      immediateop: boolean;

      instruction: packed record case integer of
		     1: (instropcode: 0..15;      (* 12..15 *)
			 case integer of
			   1: (cond: 0..15;
			       displ: byt);
			   2: (reg1: 0..7;
			       opmode: 0..7;
			       eamode: 0..7;
			       eareg: 0..7);
			   3: (dummy: 0..7;
			       bit8: boolean;
			       size: 0..3)

		     $IF MC68020$;
			   4: (Coprocid : 0..7;
			       zeros    : 0..7;
			       morezeros: 0..63)
		    $END$
						    );
		     2: (instrout: shortint);
		     end;

      extension: array[1..2] of packed record
		   size: shortint;
		   case integer of
		     1:(trash: byt;
			bext: byt);
		     2:(wext: shortint);
		     3:(lext: integer);
		     4:(regclass: 0..1;     { indexed addrmode }
			reg: regrange;
			case boolean of
			  true: (islong: boolean;
				 $IF not MC68020$
				 dummy: 0..7;
				 disp: byt)
				 $END$
			  $IF MC68020$
				 scale: 0..3;
				 case bigdisplacement: boolean of
				   false: (disp: byt);
				   true:  (basesuppress: boolean;
					   indexsuppress: boolean;
					   disp_size: 0..3;
					   index_indirect: 0..15;
					   case integer of
					     0: (w_disp: shortint);
					     1: (l_disp: integer)));
			  false: (Doffset: imm_or_reg;
				  D_offset: 0..31;
				  Dwidth: imm_or_reg;
				  D_width: 0..31)
			  $END$
		       );
		     5:(mask: packed array[0..15] of boolean); { for MOVEM }

		     $IF MC68020$
		     6: (sourcetype : 0..7;
			 case boolean of
			   true: (sourceFreg : 0..7;
				  destFreg   : 0..7;
				  fop        : 0..127);
			   false:(fivebits   : 0..31;
				  fp0,
				  fp1,
				  fp2,
				  fp3,
				  fp4,
				  fp5,
				  fp6,
				  fp7        : boolean));
		     7: (w_ext: shortint;
			 l_ext: integer);
		     $END$


		   end;


    function getextension: integer;
      begin
      if extension[1].size = 0 then getextension := 1
      else getextension := 2;
      end;

    procedure extendint(i: integer; storage: stortype);
      (* create extension of appropriate size for integer data *)
      var variantrec: packed record case integer of
	    0: (l: integer);
	    1: (wdummy: shortint;
		case integer of
		  0: (w: shortint);
		  1: (bdummy: byt;
		      b: byt) );
	    end;
      begin
      variantrec.l := i;
      with extension[getextension] do
	case storage of
	  bytte: begin size := 2; bext := variantrec.b end;
	  wrd: begin size := 2; wext := variantrec.w end;
	  long: begin size := 4; lext := variantrec.l end;
	  $IF MC68020$
	  multi: if (i<= 32767) and (i>= -32768) then
		   begin size := 2; wext := variantrec.w; end
		 else
		   begin size := 4; lext := variantrec.l; end;
	  $END$
	  end; (*case*)
      end; (* extendint *)

    procedure maskext(var attr: attrtype; predecr: boolean);
      (* emit mask extension for MOVEM *)
      var elem: 0..15; rt: regtype; rn: regrange;
      begin
      with extension[getextension],attr do
	begin wext := 0;  {initialize mask to all zeroes }
	size := 2;
	for rt := A to D do
	  for rn := 0 to maxreg do
	    if regs[rt,rn] then
	      begin elem := 8*ord(rt=A)+rn;
	      if predecr then mask[elem] := true
	      else mask[15-elem] := true;
	      end;
	end;
      end; (*maskext*)

    procedure makeEA(var attr: attrtype);
      (* make effective address field of instruction reflect attr *)
      var
	diff,
	refloc,   {location of reference}
	targetloc {location being referenced}
	  : integer;
	nametemp: alpha;
	bite,block: integer;
	reftemp: reflistptr;
	extension1temp: shortint;
	$IF MC68020$
	displacement_fudge: shortint;  {for use with indexing addrmode}
	$END$

      procedure svaltostring(valp: csp; var name: string);
	var
	  k: integer;
	begin
	with valp^ do
	  if cclass = paofch then
	    begin
	    name[0] := chr(slgth);
	    for k := 1 to slgth do name[k] := sval[k];
	    end
	  else escape(-8);
	end;

      procedure extendindex(offset: integer);
	begin
	with attr,extension[getextension] do
	  begin

	  $IF not MC68020$
	  size := 2;
	  dummy := 0;
	  if offset >= 0 then disp := offset
			 else disp := 256+offset;
	  islong := indexstorage = long;
	  reg := indexreg; regclass := 0 {D};
	  $END$
	  $IF MC68020$
	  if (offset > 127) or (offset < -128) or
	     ((addrmode = locinreg) and (gloptr <> NIL)) then
	    begin
	    displacement_fudge := 2;
	    bigdisplacement := true;
	    basesuppress := false;
	    index_indirect := 0; { no indirect }
	    if (offset > 32767) or (offset < -32768) then
	      begin
	      size := 6;
	      disp_size := 3;
	      l_disp := offset;
	      if indexed then
		indexsuppress := false
	      else
		indexsuppress := true;
	      end
	    else
	      begin
	      size := 4;
	      indexsuppress := false;
	      disp_size := 2;
	      w_disp := offset;
	      end;
	    end
	  else
	    begin
	    bigdisplacement := false;
	    size := 2;
	    if offset >= 0 then disp := offset
			   else disp := 256+offset;
	    end;
	  regclass := 0 {D};
	  if indexed then
	    begin
	    scale := indexscale;
	    islong := indexstorage = long;
	    reg := indexreg;
	    end
	  else
	    begin
	    scale := 0;
	    islong := false;
	    reg := 0;
	    end;
	  $END$

	  end;
	end;

      begin (*makeEA*)
      with attr,instruction do
	case addrmode of
	  inFreg:     escape(-8); { Should be handled elsewhere }
	  inDreg:     begin eamode := 0; eareg := regnum end;
	  inAreg:     begin eamode := 1; eareg := regnum end;
	  postincr:   begin eamode := 3; eareg := regnum end;
	  topofstack: begin eamode := 3; eareg := SP end;
	  predecr:    begin eamode := 4; eareg := regnum end;
	  locinreg:
	    begin
	    extension1temp := extension[1].size;

	    eareg := regnum;
	    if indexed then
	      begin eamode := 6; extendindex(offset) end
	    else
	      if (offset = 0) and (gloptr = NIL) then eamode := 2
	      else
		begin
		$IF MC68020$
		displacement_fudge := 0;
		if (offset > 32767) or (offset < -32768) then
		  begin
		  eamode := 6;
		  extendindex(offset);
		  end
		else
		$END$
		  begin eamode := 5; extendint(offset,wrd) end;
		end;
	    if gloptr <> NIL then {global variable, put out ref }
	      begin
	      refloc := codephile.bytecount+extension1temp+2
			$IF MC68020$ + displacement_fudge $END$;
	      if gloptr = currentglobal then
		begin
		outputref('',refloc,glob16);
		end
	      else outputref(gloptr^,refloc,abs16);
	      end;
	    end;
	  shortabs:
	    begin eamode := 7; eareg := 0;
	    if absaddr.intval then extendint(absaddr.ival+offset,wrd)
	    else
	      with absaddr.valp^ do
		begin
		svaltostring(absaddr.valp,nametemp);
		refloc := codephile.bytecount+extension[1].size+2;
		outputref(nametemp,refloc,abs16);
		extendint(offset,wrd)
		end;
	    end;
	  longabs:
	    begin eamode := 7; eareg := 1;
	    if absaddr.intval then
	      extendint(absaddr.ival+offset,long)
	    else
	      with absaddr.valp^ do
		begin
		svaltostring(absaddr.valp,nametemp);
		refloc := codephile.bytecount+extension[1].size+2;
		outputref(nametemp,refloc,abs32);
		extendint(offset,long);
		end;
	    end;
	  prel:
	    begin eamode := 7;
	    if indexed then
	      begin eareg := 3; extendindex(absaddr.ival+offset) end
	    else
	      begin eareg := 2;
	      if absaddr.intval then extendint(absaddr.ival+offset,wrd)
	      else
		with absaddr.valp^ do
		  begin
		  svaltostring(absaddr.valp,nametemp);
		  refloc := codephile.bytecount+extension[1].size+2;
		  if ((offset-refloc) >= -32768) and
		     ((offset-refloc) <= 32767) then
		    begin
		    outputref(nametemp,refloc,rel16);
		    extendint(offset-refloc,wrd);
		    end
		  else
		    begin
		    outputref(nametemp,refloc,rel16v);
		    extendint(offset,wrd);
		    end;
		  end;
	      end;
	    end;
	  immediate:
	    begin eamode := 7; eareg := 4; extendint(smallval,storage) end;
	  namedconst:
	    with constptr^ do
	      begin
	      eamode := 7;
	      refloc := codephile.bytecount+extension[1].size+2;
	      if isdumped then
		begin targetloc := offset+location;
		diff := targetloc-refloc;
		if (diff >= -32768) and (diff <= 32767) and not immediateop then
		  begin eareg := 2;  {pcrel}
		  extendint(diff,wrd);
		  end
		else if (callmode = abscall) or immediateop then
		  begin eareg := 1;  {long absolute}
		  outputref('',refloc,abs32);
		  extendint(targetloc,long);
		  end
		else
		  begin
		  if ((offset-refloc) >= -32768) and
		     ((offset-refloc) <=  32767) then
		    begin
		    eareg := 2;  { pc relative }
		    outputref(namep^,refloc,rel16);
		    extendint(offset-refloc,wrd);
		    end
		  else
		    begin
		    eareg := 1;  {long absolute}
		    outputref('',refloc,abs32);
		    extendint(targetloc,long);
		    end;
		  end;
		end
	      else {not isdumped}
		if (callmode = abscall) or immediateop then
		  begin eareg := 1;    {long absolute}
		  outputref(namep^,refloc,abs32);
		  extendint(offset,long);
		  end
		else
		  begin eareg := 2;  { pc relative }
		  if ((offset-refloc) >= -32768) and
		     ((offset-refloc) <=  32767) then
		    begin
		    outputref(namep^,refloc,rel16);
		    extendint(offset-refloc,wrd);
		    end
		  else
		    begin
		    outputref(namep^,refloc,rel16v);
		    extendint(offset,wrd);
		    end;
		  end;
	      end;
	  labelledconst:
	    begin new(reftemp);
	    reftemp^.next := constvalp^.conlbl;
	    constvalp^.conlbl := reftemp;
	    eamode := 7; eareg := 2;
	    reftemp^.pc := codephile.bytecount+extension[1].size+2;
	    extendint(offset,wrd);
	    end;
	  enumconst:
	    begin new(reftemp);
	    reftemp^.next := enumstp^.enumlbl;
	    enumstp^.enumlbl := reftemp;
	    eamode := 7; eareg := 2;
	    reftemp^.pc := codephile.bytecount+extension[1].size+2;
	    extendint(offset,wrd);
	    end;
	  end; (*case*)
      end; (*makeEA*)

    procedure emit0(*opcode: opcodetype*);
      (* emit zero-address instruction *)
      begin
      with instruction do
	begin instropcode := numopcode[opcode];
	immediateop := opcode in immediateops;
	case opcode of
	  rts: begin reg1 := 7; opmode := 1; eamode := 6; eareg := 5 end;
	  trapv: begin reg1 := 7; opmode := 1; eamode := 6; eareg := 6 end;
	  end; (*case*)
	outputcodeword(instrout);
	end;
      end; (*emit0*)

    procedure emit1(*opcode: opcodetype; var dest: attrtype*);
      (* emit one-address instruction *)
      begin extension[1].size := 0;
      with instruction do
	begin instropcode := numopcode[opcode];
	immediateop := opcode in immediateops;
	case opcode of
	  bra..ble:
	    begin cond := ord(opcode)-ord(bra);
	    with dest do
	      if storage = bytte then
		if offset < 0 then displ := 256+offset
		else displ := offset
	      else
		begin displ := 0; extendint(offset,wrd) end;
	    end;
	  clr,neg,nott,tst:
	    begin
	    if opcode = clr then reg1 := 1
	    else if opcode = tst then reg1 := 5
	    else if opcode = neg then reg1 := 2
	    else {nott} reg1 := 3;
	    opmode := ord(dest.storage) - ord(bytte);
	    makeEA(dest);
	    end;

	  $IF MC68020$
	  extb,
	  $END$
	  ext,swap:
	    begin reg1 := 4;
	    $IF MC68020$
	    if opcode = extb then
	      opmode := 7
	    else
	    $END$
	    if opcode = swap then opmode := 1
	    else opmode := 2+ord(dest.storage)-ord(wrd);
	    eamode := 0;
	    eareg := dest.regnum;
	    end;
	  jmp,jsr:
	    begin reg1 := 7;
	    opmode := 2+ord(opcode = jmp);
	    makeEA(dest);
	    end;
	  link: { treated as 1-address instr since displ always 0 }
	    $IF MC68020$
	    if dest.storage = long then
	      begin
	      reg1 := 4; opmode := 0;
	      eamode := 1; eareg := dest.regnum;
	      extendint(0,long);
	      end
	    else
	    $END$
	      begin
	      reg1 := 7; opmode := 1;
	      eamode := 2; eareg := dest.regnum;
	      extendint(0,wrd);
	      end;
	  movetoCCR,movefromSR:
	    begin reg1 := 2*ord(opcode = movetoCCR);
	    opmode := 3;
	    makeEA(dest);
	    end;
	  pea:
	    begin reg1 := 4; opmode := 1;
	    makeEA(dest);
	    end;
	  st..sle:
	    begin size := 3;
	    cond := ord(opcode) - ord(st);
	    makeEA(dest);
	    end;
	  trap:
	    begin reg1 := 7;
	    opmode := 1;
	    eamode := dest.smallval div 8;
	    eareg := dest.smallval mod 8;
	    end;
	  unlk:
	    begin reg1 := 7; opmode := 1;
	    eamode := 3; eareg := dest.regnum;
	    end;
	  $IF MC68020$
	  fblt,fbne,fbeq,fble,fbge,fbgt:  { Don Novy  1/22/90 }
            begin
            coprocid :=  1;               { Bits 11-9 = Coprocessor ID        }
            zeros    :=  2;               { Bits  8-7 = 01 for fbcc           }
                                          { Bit     6 = Size = 0 for 16 bits  }
                                          { Bits  5-0 = Conditional Predicate }
            if      opcode = fblt then morezeros := 20
            else if opcode = fbne then morezeros := 14
            else if opcode = fbeq then morezeros :=  1
            else if opcode = fble then morezeros := 21
            else if opcode = fbge then morezeros := 19
            else                       morezeros := 18; { fbgt }
            extendint(dest.offset,wrd);
            end;
          fslt,fsne,fseq,fsle,fsge,fsgt:  { Don Novy  1/22/90 }
            begin
            coprocid := 1;                { Bits 11-9 = Coprocessor ID }
            zeros    := 1;                { Bits  8-6 = 001 for fscc   }
            makeEA(dest);
	    with extension[getextension] do
              begin
              size := 2;                  { extension is 2 bytes }
                                          { 2nd word = Conditional Predicate }
              if      opcode = fslt then wext := 20
              else if opcode = fsne then wext := 14
              else if opcode = fseq then wext :=  1
              else if opcode = fsle then wext := 21
              else if opcode = fsge then wext := 19
              else                       wext := 18; { fsgt }
              end;
            end;
          $END$
	  end; (*case*)
	outputcodeword(instrout);
	with extension[1] do
	  if size = 2 then outputcodeword(wext)
	  else if size = 4 then outputcodelong(lext)
	  $IF MC68020$
	  else if size = 6 then
	    begin
	    outputcodeword(w_ext);
	    outputcodelong(l_ext);
	    end
	  $END$;
	end; {with instruction}
      end; (*emit1*)

    procedure emit2(*opcode: opcodetype; var source,dest: attrtype*);
      (* emit two-address instruction *)
      label 1;
      var k: 1..2; smode,sreg: 0..7; flip: boolean;

      procedure andoraddsub;
	(* process vanilla and, or, add or sub instruction *)
	begin
	with dest,instruction do
	  begin opmode := ord(storage)-ord(bytte);
	  if addrmode <> inDreg then
	    begin opmode := opmode+4;
	    reg1 := source.regnum;
	    makeEA(dest);
	    end
	  else begin reg1 := regnum; makeEA(source) end;
	  end;
	end; (*andoraddsub*)

      procedure addorsub;
	var opa,opi,opq,altopq: opcodetype;
	begin
	if opcode = add then
	  begin opa := adda; opi := addi; opq := addq; altopq := subq end
	else (* op = sub *)
	  begin opa := suba; opi := subi; opq := subq; altopq := addq end;
	with source,instruction do
	  if (addrmode = immediate) and (smallval <= 8) and (smallval >= -8)
	    and (smallval <> 0) then (*quick*)
	    if smallval > 0 then opcode := opq
	    else begin smallval := -smallval; opcode := altopq end
	  else if dest.addrmode = inAreg then opcode := opa
	  else if (addrmode = immediate) and (dest.addrmode <> inDreg) then
	    opcode := opi
	  else andoraddsub;
	end; (*addorsub*)

      begin (*emit2*)
      extension[1].size := 0;
      extension[2].size := 0;
      flip := false;
      if (source.addrmode = immediate) and (opcode <> moveq)
	 $IF MC68020$ and (dest.addrmode <> inFreg) $END$ then
	source.storage := dest.storage
      else if (source.addrmode = shortabs) and (dest.storage = long)
	  and (opcode in [moveI,addi,andi,cmpi,subi]) then
	begin flip := true; source.addrmode := longabs end;
      with instruction do
	begin
    1:  instropcode := numopcode[opcode];
	immediateop := opcode in immediateops;
	case opcode of
	  add:
	    begin addorsub;
	    if opcode <> add then goto 1;
	    end;
	  adda,suba:
	    with dest do
	      begin reg1 := regnum;
	      opmode := 3+4*ord(storage = long);
	      makeEA(source);
	      end;
	  addi,subi,andi,cmpi:
	    begin
	    if opcode = andi then reg1 := 1
	    else if opcode = cmpi then reg1 := 6
	    else if opcode = addi then reg1 := 3
	    else (*subi*) reg1 := 2;
	    opmode := ord(dest.storage)-ord(bytte);
	    if (source.addrmode = shortabs) and (dest.storage = long) then
	      source.addrmode := longabs;
	    makeEA(source); { produce extension, ignore <ea> fields in instr }
	    makeEA(dest);
	    end;
	  addq,subq:
	    begin reg1 := source.smallval mod 8;
	    opmode := ord(dest.storage) - ord(bytte) + 4*(ord(opcode = subq));
	    makeEA(dest);
	    end;
	  andd,orr:
	    andoraddsub;
	  asl,asr,lsl,lsr:
	    begin bit8 := (opcode = asl) or (opcode = lsl);
	    eamode := ord(opcode > asr);
	    with dest do
	      begin eareg := regnum;
	      size := ord(storage) - ord(bytte);
	      end;
	    with source do
	      if addrmode = immediate then reg1 := smallval mod 8
	      else
		begin reg1 := regnum; eamode := eamode+4 end;
	    end;
	  bchg,bclr,bset,btst:
	    begin
	    if source.addrmode = inDreg then
	      begin reg1 := source.regnum; bit8 := true end
	    else
	      begin
	      reg1 := 4; bit8 := false;
	      extendint(source.smallval,wrd);
	      end;
	    case opcode of
	      btst: size := 0;
	      bchg: size := 1;
	      bclr: size := 2;
	      bset: size := 3;
	      end;
	    makeEA(dest);
	    end;

	  $IF MC68020$
	  bfexts, bfextu:
	    begin
	    if opcode = bfexts then
	      reg1 := 5
	    else {opcode = bfextu}
	      reg1 := 4;
	    opmode := 7;
	    with extension[getextension] do
	      begin
	      size := 2;
	      regclass := 0;
	      reg := dest.regnum;
	      if source.bitoffset.variable = -1 then
		begin
		Doffset := imm;
		D_offset := source.bitoffset.static;
		end
	      else
		begin
		Doffset := inreg;
		D_offset := source.bitoffset.variable;
		end;
	      Dwidth := imm;
	      D_width := source.bitsize;
	      end;
	    makeEA(source);
	    end;
	  bfins:
	    begin
	    reg1 := 7;
	    opmode := 7;
	    with extension[getextension] do
	      begin
	      size := 2;
	      regclass := 0;
	      reg := source.regnum;
	      if dest.bitoffset.variable = -1 then
		begin
		Doffset := imm;
		D_offset := dest.bitoffset.static;
		end
	      else
		begin
		Doffset := inreg;
		D_offset := dest.bitoffset.variable;
		end;
	      Dwidth := imm;
	      D_width := dest.bitsize;
	      end;
	    makeEA(dest);
	    end;

	  chk2:
	    begin
	    if dest.storage = wrd then reg1 := 1
		{ storage = long} else reg1 := 2;
	    opmode := 3;
	    with extension[getextension] do
	      begin
	      size := 2;
	      if dest.addrmode = inDreg then regclass := 0
	       {dest.addrmode = inAreg} else regclass := 1;
	      reg := dest.regnum;
	      islong := true;
	      scale := 0;
	      bigdisplacement := false;
	      disp := 0;
	      end;
	    makeEA(source);
	    end;
	  $END$

	  chk,lea,divs,muls:
	    begin reg1 := dest.regnum;
	    if opcode = chk then
	      begin
	      $IF MC68020$
	      if dest.storage = long then
		opmode := 4
	      else
	      $END$
		opmode := 6;
	      end
	    $IF MC68020$
	    else if ((opcode = muls) or (opcode = divs)) and
		    (dest.storage = long) then
	      begin
	      instropcode := 4;
	      reg1 := 6;
	      with extension[getextension] do
		begin
		size := 2;
		regclass := 0;
		reg := dest.regnum;
		islong := true;
		scale := 0;
		bigdisplacement := false;
		if opcode = muls then
		  begin
		  opmode := 0;
		  disp := 0;
		  end
		else {opmode = divs}
		  begin
		  opmode := 1;
		  disp := reg;
		  end;
		end;
	      end
	    $END$
	    else opmode := 7;
	    makeEA(source);
	    end;

	  $IF MC68020$
	  divsl:
	    begin
	    reg1 := 6;
	    with extension[getextension] do
	      begin
	      size := 2;
	      regclass := 0;
	      reg := dest.regnum;
	      islong := true;
	      scale := 0;
	      bigdisplacement := false;
	      opmode := 1;
	      disp := divsl_reg;
	      end;
	    makeEA(source);
	    end;
	  $END$

	  cmp,cmpa:
	    with dest do
	      begin reg1 := regnum;
	      if addrmode = inAreg then opmode := 3 + 4*ord(storage = long)
	      else opmode := ord(storage)-ord(bytte);
	      makeEA(source);
	      end;
	  cmpm:
	    with dest do
	      begin eareg := source.regnum; eamode := 1;
	      opmode := 4+ord(storage)-ord(bytte);
	      reg1 := regnum;
	      end;
	  move,movea,moveI:
	    begin
	    if dest.addrmode = inDreg then
	      with source do
		if addrmode = immediate then
		  if (smallval >= -128) and (smallval <= 127) then
		    begin opcode := moveq; goto 1 end;
	    instropcode :=
		     2*ord(dest.storage <> bytte)+ord(dest.storage<> long);
	    makeEA(source);
	    smode := eamode; sreg := eareg;
	    makeEA(dest);
	    opmode := eamode; reg1 := eareg;
	    eamode := smode; eareg := sreg;
	    if opcode = moveI then  { MOVE.L #<abs or named const>, ... }
	      eareg := 4;           { change abs or named const to immediate }
	    end;
	  movem:
	    begin instropcode := 4;
	    opmode := 2+ord(dest.storage = long);
	    if dest.addrmode = multiple then
	      begin reg1 := 6;
	      maskext(dest,source.addrmode = predecr);
	      makeEA(source);
	      end
	    else
	      begin reg1 := 4;
	      maskext(source,dest.addrmode = predecr);
	      makeEA(dest);
	      end;
	    end;
	  moveq:
	    begin reg1 := dest.regnum;
	    bit8 := false;
	    with source do
	      if smallval >= 0 then displ := smallval
	      else displ := 256+smallval;
	    end;
	  sub:
	    begin addorsub;
	    if opcode <> sub then goto 1;
	    end;

	  $IF MC68020$
	  fmovem:
	    begin
	    coprocid := 1;
	    zeros := 0;
	    with extension[getextension] do
	      begin
	      size := 2;
	      fivebits := 16;
	      if source.addrmode = fmultiple then
		begin
		sourcetype := 7;
		fp0 := source.fregs[0];
		fp1 := source.fregs[1];
		fp2 := source.fregs[2];
		fp3 := source.fregs[3];
		fp4 := source.fregs[4];
		fp5 := source.fregs[5];
		fp6 := source.fregs[6];
		fp7 := source.fregs[7];
		makeEA(dest);
		end
	      else
		begin
		sourcetype := 6;
		fp0 := dest.fregs[0];
		fp1 := dest.fregs[1];
		fp2 := dest.fregs[2];
		fp3 := dest.fregs[3];
		fp4 := dest.fregs[4];
		fp5 := dest.fregs[5];
		fp6 := dest.fregs[6];
		fp7 := dest.fregs[7];
		makeEA(source);
		end;
	      end;
	    end;
	  fmove..flognp1:
	    with extension[getextension] do
	      begin
	      size := 2;
	      coprocid := 1;
	      zeros := 0;
	      fop := numsubopcode[opcode];
	      if (source.addrmode = inFreg) and (dest.addrmode = inFreg) then
		begin
		morezeros := 0;
		sourceFreg := source.regnum;
		destFreg := dest.regnum;
		sourcetype := 0;
		end
	      else if source.addrmode = inFreg then
		begin
		makeEA(dest);
		sourcetype := 3;
		destFreg := source.regnum;
		case dest.storage of
		  bytte:  sourceFreg := 6;
		  wrd:    sourceFreg := 4;
		  long:   sourceFreg := 0;
		  multi:  sourceFreg := 5;
		end; {case}
		end
	      else {dest.addrmode = inFreg}
		begin
		makeEA(source);
		sourcetype := 2;
		destFreg := dest.regnum;
		case source.storage of
		  bytte:  sourceFreg := 6;
		  wrd:    sourceFreg := 4;
		  long:   sourceFreg := 0;
		  multi:  sourceFreg := 5;
		end; {case}
		end;
	      end;
	  $END$

	  end; (*case*)
	outputcodeword(instrout);
	for k := 1 to 2 do
	  with extension[k] do
	    if size = 2 then outputcodeword(wext)
	    else if size = 4 then outputcodelong(lext)
	    $IF MC68020$
	    else if size = 6 then
	      begin
	      outputcodeword(w_ext);
	      outputcodelong(l_ext);
	      end
	    $END$;
	end; {with instruction}
      if flip then source.addrmode := shortabs;
      end; (*emit2*)


