head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.30.53;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.07.53;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.28.35;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.06.22;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.15.15;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.15.56;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.01.09;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.00.02;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.13.38;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.02.09;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.07.58;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.44.31;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.33.06;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.40.01;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.21.57.41;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.47.33;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.33.06;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.15.33;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.38.30;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.23.43;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.14.00;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.27.03;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.06.05;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.16.44;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.15.52.20;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.28.07;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.33.42;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.17.54.34;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.32.37;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.16.57;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.46.59;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.11.10;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.12.26.01;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.04.46;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.09.58;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.09.46.59;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.10.26.26;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.15.09;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.25.02;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.07.43.46;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.14.37.07;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.09.53.57;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.10.59;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.08.34.30;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.14.25.27;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.00.29;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.12.45.55;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.12.32;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.17.21;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.13.37.18;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.15.46;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.00.47;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.16.57.30;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.14.18.41;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.05.15;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.18.29;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.08.09;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.13.10.56;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@			   {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 $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:
	    begin
	    coprocid := 1;
	    zeros := 2;
	    morezeros := 20;
	    extendint(dest.offset,wrd);
	    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*)


@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 961
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 961
			   {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 $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:
	    begin
	    coprocid := 1;
	    zeros := 2;
	    morezeros := 20;
	    extendint(dest.offset,wrd);
	    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*)


@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
