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


56.4
date     93.04.15.11.56.55;  author jwh;  state Exp;
branches ;
next     56.3;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

39.1
date     89.09.26.16.25.39;  author dew;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.05.10.17.16;  author jwh;  state Exp;
branches ;
next     38.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

25.1
date     88.03.02.09.08.44;  author bayes;  state Exp;
branches ;
next     24.2;

24.2
date     88.02.09.09.38.07;  author brad;  state Exp;
branches ;
next     24.1;

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

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

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

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

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

19.1
date     87.06.01.07.51.02;  author jws;  state Exp;
branches ;
next     18.2;

18.2
date     87.05.30.11.20.28;  author jws;  state Exp;
branches ;
next     18.1;

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

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

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

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

14.1
date     87.04.01.14.38.09;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.03.18.10.46.59;  author jws;  state Exp;
branches ;
next     13.1;

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

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

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

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

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

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

7.1
date     86.11.20.13.08.48;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.19.15.48.39;  author bayes;  state Exp;
branches ;
next     6.1;

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

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

4.1
date     86.09.30.19.12.45;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.24.09.57.34;  author hal;  state Exp;
branches ;
next     3.1;

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

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

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


desc
@Base file for PWS 3.2 release.

@


56.4
log
@
  Disallowed maskboolexpr from working on packed boolean expressions.
@
text
@			  { file GENMOVE }

    import
      assemble,genexprmod,symtable,genutils,float_hdw;
    implement {moveit}

    var  { used by needscheck, emitcheck }
      targetlo,targethi: integer;

    procedure maskboolexpr(*fexp: exptr*);
    var op: attrtype;
    begin
      with fexp^ do
	if etyptr = boolptr then
	  if ((ekind = xpr) and (attr^.addrmode <> topofstack)
	      and (not attr^.packd)) then
	    with op do
	      begin storage := bytte; addrmode := immediate; smallval := 1;
	      emit2(andi,op,attr^);
	      end;
    end;

    function needscheck
	  (fexp: exptr; target: stp;
		    assignstmt: boolean):boolean;
    var
      sourcelo,sourcehi: integer;
      source: stp;
      sourceattr: attrptr;
    begin
    needscheck := false;
    if (target^.form <= subrange) and (target <> intptr) and
       (fexp^.eclass <> litnode) then
      begin
      genexpr(fexp); { get attribute record }
      source := fexp^.etyptr;
      sourceattr := fexp^.attr;
      getbounds(target,targetlo,targethi);
      with sourceattr^ do
	begin
	if packd then
	  begin
	  if (bitsize = 31) and not signbit then
	    sourcehi := maxint
	  else
	    sourcehi := power_table[bitsize-ord(signbit)]-1;
	  end
	else { not packed }
	  case storage of
	    bytte: if signbit then
		    sourcehi := 127
		  else sourcehi := 255;
	    wrd: if signbit then
		    sourcehi := 32767
		  else sourcehi := 65535;
	    long: sourcehi := maxint;
	    end;
	if signbit then
	  sourcelo := -sourcehi-1
	else sourcelo := 0;
	end;
      if ((fexp^.eclass = succnode) or
	 (fexp^.eclass = prednode)) and
	 (fexp^.etyptr = target) and
	 assignstmt then
	needscheck := false
      else if (sourcelo < targetlo) or
	      (sourcehi > targethi) then
	     needscheck := true;
      end;
    end; {needscheck}

  procedure emitcheck(fexp: exptr; target: stp;
			    assignstmt: boolean);
    var
      r, op: attrtype;
      branchoffset: shortint;
    begin
    if needscheck(fexp,target,assignstmt) then
      TRY
	maskboolexpr(fexp); loadvalue(fexp);

	$IF MC68020$
	if (targethi > 32767) or (targetlo < -32768) then escape(0);
	$END$

	$ovflcheck on$
	$IF not MC68020$
	if (targethi - targetlo) < 0 then escape(0); { overflow check }
	if (targethi - targetlo) > 32767 then escape(0);
	$END$
	$if not ovflchecking$
	  $ovflcheck off$
	$end$
	with fexp^,attr^ do
	  begin
	  r.addrmode := inDreg;
	  r.storage := wrd;
	  if storage = long then escape(0);
	  if storage = bytte then extend(fexp,wrd);

	  $IF MC68020$
	  r.regnum := attr^.regnum;
	  if targetlo = 0 then {use chk}
	    begin
	    with op do
	      begin addrmode := immediate; smallval := targethi; end;
	    emit2(chk,op,r);
	    end
	  else
	    begin
	    with op do
	      begin
	      addrmode := labelledconst;
	      offset := 0;
	      new(constvalp);
	      with constvalp^ do
		begin
		cclass := chk2_bounds;
		lower := targetlo;
		upper := targethi;
		size := wrd;
		end;
	      constvalp := poolit(constvalp);
	      end;
	    emit2(chk2,op,r);
	    end;
	  $END$

	  $IF not MC68020$
	  if targetlo = 0 then r.regnum := attr^.regnum
	  else
	    begin { use scratch register for check}
	    r.regnum := getreg(D);
	    emit2(move,attr^,r);
	    with op do
	      begin addrmode := immediate; smallval := targetlo end;
	    emit2(sub,op,r);
	    end; {targetlo <> 0}
	  with op do
	    begin addrmode := immediate; smallval := targethi-targetlo end;
	  emit2(chk,op,r);
	  if targetlo <> 0 then freeit(D,r.regnum);
	  $END$

	  end; {with}
      RECOVER
	begin
	if (escapecode <> 0) and
	   (escapecode <> -4) then
	  escape(escapecode);

	$IF MC68020$
	with fexp^,attr^ do
	  begin
	  r.addrmode := inDreg;
	  r.storage := long;
	  r.regnum := attr^.regnum;
	  extend(fexp,long);
	  end;
	if targetlo = 0 then {use chk}
	  begin
	  with op do
	    begin addrmode := immediate; smallval := targethi; end;
	  emit2(chk,op,r);
	  end
	else
	  begin
	  with op do
	    begin
	    addrmode := labelledconst;
	    offset := 0;
	    new(constvalp);
	    with constvalp^ do
	      begin
	      cclass := chk2_bounds;
	      lower := targetlo;
	      upper := targethi;
	      size := long;
	      end;
	    constvalp := poolit(constvalp);
	    end;
	  emit2(chk2,op,r);
	  end;
	$END$

	$IF not MC68020$
	ensure_valid_condition_code := true;

	if (targetlo<-32768) or (targethi>32767)
	   or (fexp^.attr^.storage = long)
	   or not (fexp^.attr^.signbit) then
	  begin
	  extend(fexp,long);
	  branchoffset := 8;
	  end
	else
	  begin
	  extend(fexp,wrd);
	  branchoffset := 6;
	  end;

	ensure_valid_condition_code := false;
	if targetlo <> 0 then
	  with op do
	    begin
	    addrmode := immediate;
	    smallval := targetlo;
	    emit2(cmpi,op,fexp^.attr^);  { CMPI targetlo,source }
	    end
	else { if condition code not valid emit TST }
	  if fexp^.eclass in [succnode,prednode] then
	    emit1(tst,fexp^.attr^);
	with op do
	  begin
	  offset := branchoffset;
	  storage := bytte;
	  end;
	emit1(blt,op);                   { BLT *+10 }
	with op do
	  begin addrmode := immediate; smallval := targethi end;
	emit2(cmpi,op,fexp^.attr^);      { CMPI targethi,source }
	with op do
	  begin offset := 2; storage := bytte end;
	emit1(ble,op);                   { BLE *+4 }
	op.smallval := 7;
	emit1(trap,op);                  { TRAP #7 }
	$END$

	end; {recover}
    end; {emitcheck}

    PROCEDURE BITADDRESS{FEXP: EXPTR};
      VAR
	op1,op2,op3: attrtype;
      BEGIN { BITADDRESS }
      WITH FEXP^.ATTR^ DO
	BEGIN
	OFFSET := OFFSET + mydiv(BITOFFSET.STATIC,16) * 2;
	BITOFFSET.STATIC := (BITOFFSET.STATIC mod 16);
	IF BITOFFSET.VARIABLE <> -1 THEN
	  BEGIN
	  op2.addrmode := inDreg; op2.regnum := bitoffset.variable;
	  op2.storage := bitoffset.storage;
	  IF BITOFFSET.STATIC <> 0 THEN
	    BEGIN { ADD CONSTANT BITOFFSET TO VARIABLE BITOFFSET }
	    op1.addrmode := immediate;
	    op1.smallval := bitoffset.static;
	    emit2(add,op1,op2);              { ADD #static,variable }
	    bitoffset.static := 0;
	    END;
	  { EXTRACT WORD COMPONENT OF BITOFFSET.VARIABLE }
	  op1.addrmode := inDreg; op1.regnum := getreg(D);
	  op1.storage := bitoffset.storage;
	  emit2(move,op2,op1);               { MOVE variable,temp }
	  with op3 do
	    begin addrmode := immediate; smallval := 4; end;
	  emit2(asr,op3,op1);                { LSR #4,temp }
	  op3.smallval := 1;
	  emit2(lsl,op3,op1);                { LSL #1,temp }
	  op3.smallval := 15;
	  $IF MC68020$
	  op2.storage := long; { bit field instructions need long value }
	  $END$
	  emit2(andi,op3,op2);               { AND #15,variable }
	  IF INDEXED THEN
	    BEGIN
	    $IF MC68020$
	    {account for scale factor}
	    if indexscale <> 0 then
	      begin
	      op3.regnum := indexreg;
	      op3.storage := long;
	      if indexstorage <> long then
		begin
		emit1(ext,op3);
		indexstorage := long;
		end;
	      op2.addrmode := immediate;
	      op2.smallval := indexscale;
	      emit2(lsl,op2,op3);
	      indexscale := 0;
	      end;
	    $END$
	    if indexstorage < bitoffset.storage then
	      begin
	      op3.regnum := indexreg; op3.storage := long;
	      emit1(ext,op3);              { EXT.L Dindexreg }
	      indexstorage := long;
	      end
	    else if bitoffset.storage < indexstorage then
	      begin
	      op1.storage := long;
	      emit1(ext,op1);              { EXT.L temp }
	      bitoffset.storage := long;
	      end;
	    op3.addrmode := inDreg; op3.regnum := indexreg;
	    op3.storage := indexstorage;
	    emit2(add,op1,op3);              { ADD temp,indexreg }
	    FREEIT(D,op1.regnum);
	    END
	  ELSE
	    BEGIN
	    INDEXED := TRUE;
	    INDEXREG := op1.regnum;
	    indexstorage := bitoffset.storage;
	    $IF MC68020$
	      indexscale := 0;
	    $END$
	    END;
	  END; { IF BITOFFSET.VARIABLE }
	END; { WITH }
      END; { BITADDRESS }

    PROCEDURE UNPACK ( FEXP : EXPTR );
      VAR
	op1,op2: attrtype;
	SHIFTEMP : REGRANGE;
      BEGIN
	WITH FEXP^.ATTR^ DO
	  BEGIN
	  IF BITOFFSET.VARIABLE = -1 THEN
	    BEGIN { CONSTANT BITOFFSET }
	    if bitsize = 1 then
	      begin
	      if bitoffset.static >= 8 then
		begin
		offset := offset + 1;
		bitoffset.static := bitoffset.static - 8;
		checkoffset(fexp);
		end;
	      op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	      emit2(btst,op1,fexp^.attr^);       { BTST 7-static,oprnd }
	      freeregs(fexp^.attr);
	      with op2 do
		begin
		addrmode := inDreg;
		regnum := getreg(D);
		storage := bytte;
		end;
	      emit1(sne,op2);                    { SNE temp }
	      emit1(neg,op2);                    { NEG.B temp }
	      storage := bytte;
	      end
	    else IF (BITSIZE = 8) AND (BITOFFSET.STATIC IN [0,8])
		and ((not force_unpack) or signbit) THEN
	       BEGIN
	       IF BITOFFSET.STATIC = 8 THEN OFFSET := OFFSET + 1;
	       packd := false;
	       STORAGE := BYTTE;
	       checkoffset(fexp);
	       end
	    ELSE IF (BITSIZE = 16) AND (BITOFFSET.STATIC = 0)
		and ((not force_unpack) or signbit) THEN
	      BEGIN
	      packd := false;
	      STORAGE := WRD;
	      end
	    ELSE
	      BEGIN
	      with op2 do
		begin
		addrmode := inDreg; regnum := getreg(D);
		end;

	      $IF MC68020$
	      if signbit then
		emit2(bfexts,fexp^.attr^,op2)
	      else
		begin { make sure status register bit N is cleared }
		emit2(bfextu,fexp^.attr^,op2);
		op2.storage := long;
		with op1 do
		  begin
		  addrmode := immediate;
		  if fexp^.attr^.bitsize = 31 then
		    smallval := maxint
		  else
		    smallval := power_table[fexp^.attr^.bitsize] - 1;
		  end;
		emit2(andi,op1,op2);
		end;
	      freeregs(fexp^.attr);
	      storage := long;
	      signbit := true;
	      $END$

	      $IF not MC68020$
	      if ((bitoffset.static MOD 8)+bitsize <= 8) and (not signbit)
		then begin
		offset := offset + (bitoffset.static DIV 8);
		bitoffset.static := (bitoffset.static MOD 8) + 24;
		op2.storage := bytte;
		end
	      else if ((bitoffset.static+bitsize) <= 16) and (not signbit)
		then begin
		bitoffset.static := bitoffset.static + 16;
		op2.storage := wrd;
		end
	      else op2.storage := long;
	      emit2(move,fexp^.attr^,op2);            { MOVE fexp,temp }
	      freeregs(fexp^.attr);
	      if signbit then
		begin { unpack using left shift, right shift }
		emitshift(bitoffset.static,op2.regnum,lsl,long);
		emitshift(32-bitsize,op2.regnum,asr,long);
		end
	      else
		begin { unpack with a right shift, AND }
		emitshift(32-(bitoffset.static+bitsize),op2.regnum,lsr,long);
		getcomplmaskattr(0,32-bitsize,32,op1);
		op2.storage := long;
		emit2(andi,op1,op2);                  { AND.L mask,temp }
		signbit := true;
		end;
	      STORAGE := LONG;
	      $END$

	      END;
	    END { CONSTANT BITOFFSET }
	  ELSE { VARIABLE BITOFFSET }
	    BEGIN
	    with op2 do
	      begin
	      addrmode := inDreg; regnum := getreg(D); storage := long;
	      end;

	    $IF MC68020$
	    if signbit then
	      emit2(bfexts,fexp^.attr^,op2)
	    else
	      begin { make sure status register bit N is cleared }
	      emit2(bfextu,fexp^.attr^,op2);
	      op2.storage := long;
	      with op1 do
		begin
		addrmode := immediate;
		if fexp^.attr^.bitsize = 31 then
		  smallval := maxint
		else
		  smallval := power_table[fexp^.attr^.bitsize] - 1;
		end;
	      emit2(andi,op1,op2);
	      end;
	    freeregs(fexp^.attr);
	    FREEIT(D,BITOFFSET.VARIABLE);
	    storage := long;
	    signbit := true;
	    $END$

	    $IF not MC68020$
	    emit2(move,fexp^.attr^,op2);            { MOVE.L fexp,temp }
	    freeregs(fexp^.attr);
	    op1.addrmode := inDreg; op1.regnum := bitoffset.variable;
	    emit2(lsl,op1,op2);
	    FREEIT(D,BITOFFSET.VARIABLE);
	    if signbit then emitshift(32-bitsize,op2.regnum,asr,long)
		       else emitshift(32-bitsize,op2.regnum,lsr,long);
	    signbit := true;
	    STORAGE := LONG;
	    $END$

	    END; { VARIABLE BITOFFSET }
	  if packd then
	    begin
	    ADDRMODE := inDreg;
	    REGNUM := op2.regnum;
	    ACCESS := DIRECT;
	    INDEXED := FALSE;
	    OFFSET := 0;
	    PACKD := FALSE;
	    end;
	  END; { WITH }
	END; { UNPACK }

    procedure pushaddress(*fexp: exptr*);
      var
	op1,op2: attrtype;
      begin genexpr(fexp);
      with fexp^,attr^ do
	begin
	if packd then
	  begin { handle field of a packed structure }
	  offset := offset + mydiv(bitoffset.static,8);
	  if bitoffset.variable <> -1 then
	    begin { extract byte component of bitoffset.variable }
	    with op1 do
	      begin addrmode := immediate; smallval := 3; end;
	    with op2 do
	      begin
	      addrmode := inDreg;
	      regnum := attr^.bitoffset.variable;
	      storage := attr^.bitoffset.storage;
	      end;
	    emit2(lsr,op1,op2);
	    if indexed then
	      begin
	      with op1 do
		begin
		addrmode := inDreg;
		regnum := attr^.indexreg;
		storage := attr^.indexstorage;
		$IF MC68020$
		if indexscale <> 0 then
		  begin
		  if storage = wrd then
		    begin
		    storage := long;
		    emit1(ext,op1);
		    end;
		  if indexscale = 1 then
		    emit2(add,op1,op1)
		  else
		    emitshift(indexscale,regnum,asl,long);
		  if indexstorage = long then ovflck
		  else indexstorage := long;
		  end;
		$END$
		end;
	      if indexstorage < bitoffset.storage then
		begin
		op1.storage := long;
		emit1(ext,op1);
		indexstorage := long;
		end
	      else if bitoffset.storage < indexstorage then
		begin
		op2.storage := long;
		emit1(ext,op2);
		end;
	      emit2(add,op2,op1);
	      freeit(D,op2.regnum);
	      end
	    else
	      begin
	      indexed := true;
	      indexreg := op2.regnum;
	      indexstorage := bitoffset.storage;
	      $IF MC68020$
		indexscale := 0;
	      $END$
	      end;
	    end;
	  packd := false;
	  end; { if packd }
	if addrmode = inFreg then pushrealaddress(fexp)
	else if (addrmode in memorymodes)
	    or (access = indirect) and (addrmode <> loconstack) then
	  begin checkoffset(fexp);
	  if access = direct then emit1(pea,attr^)
	  else
	    begin SPminus.storage := long;
	    emit2(move,attr^,SPminus);
	    end;
	  freeregs(attr);
	  end
	else
	  if (addrmode = topofstack) and
	     (etyptr = realptr) then
	    begin { real VALUE is on stack }
	    getlocstorage(8,op1);
	    op1.storage := long;
	    emit2(move,attr^,op1);
	    op1.offset := op1.offset + 4;
	    emit2(move,attr^,op1);
	    op1.offset := op1.offset - 4;
	    emit1(pea,op1);
	    freeregs(attr);
	    end
	else if addrmode <> loconstack then
	  escape(-8);
	end; {with}
      end; {pushaddress}

    procedure loadaddress(fexp: exptr;
		       fromcheckoffset: boolean);
      var
	op: attrtype;
	storagetemp: stortype;
      begin genexpr(fexp);
	with fexp^, attr^ do
	  begin
	  if addrmode = loconstack then
	    begin
	    getregattr(A,op);
	    emit2(movea,SPplus,op);
	    end
	  else if (addrmode in memorymodes) or
	      (access = indirect) then
	    if addrinreg(fexp) then op.regnum := regnum {i.e.,do nothing}
	    else
	      begin
	      if not fromcheckoffset then
		checkoffset(fexp);
	      freeregs(attr);
	      getregattr(A,op);
	      { Emit2 overwrites source storage }
	      $range off$
	      storagetemp := storage;
	      if access = direct then emit2(lea,attr^,op)
	      else emit2(movea,attr^,op);
	      storage := storagetemp;
	      $if rangechecking$
		$range on$
	      $end$
	      end
	  else
	    begin
	    escape(-8);
	    op.regnum := 0;
	    end;
	  addrmode := locinreg; regnum := op.regnum;
	  access := direct; indexed := false;
	  offset := 0; gloptr := NIL;
	  end; {with}
      end; {loadaddress}

    procedure moveaddress(* fexp: exptr; var dest: attrtype *);
      { Generate 'MOVE.L' <fexp>,<dest>.
	Code produced for various source modes:

	  locinreg

	     not indexed - direct   LEA    d(Ar),As
				    MOVE.L As,<dest>

			 - indirect MOVE.L d(Ar),<dest>

	     indexed     - direct   LEA    d(Ar,Dx),As
				    MOVE.L As,<dest>

			 - indirect MOVE.L d(Ar,Dx),<dest>

	  absolute

	     not indexed - direct   MOVE.L #d<fexp>,<dest>

			 - indirect MOVE.L d<fexp>,<dest>

	     indexed     - direct   LEA    d<fexp>,Ar
				    LEA    0(Ar,Dx),As
				    MOVE.L As,<dest>

			 - indirect LEA    d<fexp>,Ar
					   MOVE.L 0(Ar,Dx),<dest>  }
      label 1;
      var op: attrtype;
      begin
      dest.storage := long;
      genexpr(fexp);
      with fexp^, attr^ do
   1:   if addrmode = locinreg then
	  if access = direct then
	    begin loadaddress(fexp,false);
	    op.addrmode := inAreg; op.regnum := regnum;
	    emit2(move,op,dest);
	    freeit(A,regnum);
	    end
	  else
	    begin checkoffset(fexp);
	    emit2(move,attr^,dest);
	    freeregs(fexp^.attr);
	    end
	else if addrmode = inDreg then
	  begin emit2(move,attr^,dest); freeit(D,regnum) end
	else if addrmode = immediate then
	  emit2(move,attr^,dest)
	else {absolute,namedconst}
	  if ((access = direct) and (indexed or (addrmode = prel)
	     or (addrmode = namedconst) and (callmode = relcall)))
	     or (addrmode = labelledconst) then
	    begin loadaddress(fexp,false); goto 1 {treat as locinreg} end
	  else
	    begin
	    if access = indirect then
	      begin
	      checkoffset(fexp); {load base reg}
	      emit2(move,attr^,dest);
	      freeregs(attr);
	      end
	    else {not indexed, access = direct}
	      emit2(moveI,attr^,dest);
	    end;
      end; {moveaddress}

    procedure movevalue{fexp: exptr; var at: attrtype};
      { generate MOVE <source> ; fexp points to source expression,
	caller must provide destination in "at"  }
      begin
	makeaddressable(fexp);
	with fexp^ do
	  if attr^.addrmode = inFreg then moverealvalue(fexp,at)
	  else
	    begin
	    if (attr^.addrmode = topofstack) and
	       (etyptr = realptr) then
	      begin { real VALUE is on stack }
	      at.storage := long;
	      emit2(move,attr^,at);
	      at.offset := at.offset + 4;
	      emit2(move,attr^,at);
	      at.offset := at.offset - 4;
	      at.storage := multi;
	      end
	    else
	      emit2(move,attr^,at);
	    freeregs(attr);
	    end;
      end; {movevalue}

    procedure pushvalue(*fexp: exptr*);
      var i : shortint;
      begin
	makeaddressable(fexp);
	with fexp^, attr^ do
	  if addrmode = inFreg then pushrealvalue(fexp)
	  else
	    begin
	    if addrmode <> topofstack then
	      begin
	      if etyptr^.unpacksize = 8 then { reals and prok vars }
		begin SPminus.storage := long;
		offset := offset + 4;
		for i := 0 to 1 do
		  begin
		  offset := offset - (i*4);
		  checkoffset(fexp);
		  emit2(move,attr^,SPminus);
		  end;
		end
	      else if etyptr^.unpacksize <> 0 then
		begin SPminus.storage := storage;
		if (addrmode = immediate) and (smallval = 0) then
		  emit1(clr,SPminus)
		else emit2(move,attr^,SPminus);
		end;
	      freeregs(attr);
	      addrmode := topofstack;
	      end;
	    end; { with }
      end;

    procedure loadvalue(*fexp: exptr*);
      { fetch value to D register, update value and machine images }
      var op: attrtype;
      begin
	makeaddressable(fexp);
	with fexp^, attr^ do
	  if etyptr^.form = reals then loadrealvalue(fexp)
	  else
	    if addrmode <> inDreg then
	      begin
	      freeregs(attr);
	      getregattr(D,op);
	      op.storage := storage;
	      emit2(move,attr^,op);
	      addrmode := inDreg;
	      regnum := op.regnum;
	      indexed := false;
	      end;
      end; {loadvalue}

    procedure genpaofchcond(fcond: exptr; var flbl: reflistptr;
			     defined: boolean);
      { generate code for a packed array of char comparison,
	emitting a false jump to flbl}
      var
	loop : addrrange;
	tlbl,lbl3,lbl4 : localref;
	op,regtemp,reg2 : attrtype;
      begin
      with fcond^ do
	if opnd1^.etyptr^.unpacksize = 0 then
	  case eclass of
	    eqnode, lenode, genode : {do nothing}
	      flbl := NIL;
	    nenode, ltnode, gtnode :
	      begin
	      getbrattr(flbl^.pc,defined,op);
	      emit1(bra,op);
	      end;
	  end { case }
	else
	  begin
	  loadaddress(opnd1,false);
	  loadaddress(opnd2,false);
	  getregattr(D,regtemp);
	  if opnd1^.etyptr^.aisstrng then
	    begin
	    if (eclass <> eqnode) and (eclass <> nenode) then
	      begin
	      getregattr(D,reg2);
	      emit2(moveq,immed0,reg2);             { MOVEQ #0,Dregtemp }
	      reg2.storage := bytte;
	      opnd1^.attr^.addrmode := postincr;
	      emit2(move,opnd1^.attr^,reg2);      { MOVE.B (Aopnd1)+,Dregtemp }
	      regtemp.storage := wrd;
	      emit2(move,reg2,regtemp);
	      emit1(swap,regtemp);
	      emit2(move,reg2,regtemp);
	      regtemp.storage := bytte;
	      opnd2^.attr^.addrmode := postincr;
	      emit2(move,opnd2^.attr^,reg2);
	      emit2(cmp,reg2,regtemp);       { CMP.B Dreg2,Dregtemp }
	      lbl3.next := NIL;
	      getbrattr(lbl3.pc,false,op);
	      emit1(bls,op);                         { BLS lbl3 }
	      with opnd2^.attr^ do
		begin
		addrmode := locinreg;
		offset := -1; gloptr := NIL;
		end;
	      emit2(move,reg2,regtemp);
	      fixreflist(addr(lbl3));
	      emit1(tst,regtemp);                    { lbl3 TST.B Dregtemp }
	      lbl4.next := NIL;
	      getbrattr(lbl4.pc,false,op);
	      emit1(beq,op);                         { BEQ lbl4 }
	      end
	    else { = , <> }
	      begin
	      emit2(moveq,immed0,regtemp);             { MOVEQ #0,Dregtemp }
	      regtemp.storage := bytte;
	      emit2(move,opnd1^.attr^,regtemp);      { MOVE.B (Aopnd1),Dregtemp }
	      op.addrmode := immediate; op.smallval := 1;
	      regtemp.storage := wrd;
	      emit2(addq,op,regtemp);                { ADDQ #1,Dregtemp }
	      end;
	    end
	  else {compare pa of char}
	    begin
	    regtemp.storage := long;
	    op.addrmode := immediate; op.smallval := opnd1^.etyptr^.unpacksize;
	    emit2(move,op,regtemp);             { MOVE(Q/.L) #unpacksize,Dregtemp}
	    end;
	  loop := codephile.bytecount;
	  opnd2^.attr^.addrmode := postincr;
	  with opnd1^.attr^ do
	    begin addrmode := postincr; storage := bytte end;
	  emit2(cmpm,opnd2^.attr^,opnd1^.attr^);{loop CMPM.B (Aopnd2)+,(Aopnd1)+}
	  tlbl.next := NIL;
	  if eclass = eqnode then getbrattr(flbl^.pc,defined,op)
	  else getbrattr(tlbl.pc,false,op);
	  emit1(bne,op);                             { BNE flbl/tlbl }
	  op.addrmode := immediate; op.smallval := 1;
	  emit2(subq,op,regtemp);                    { SUBQ #1,Dregtemp }
	  getbrattr(loop,true,op);
	  emit1(bne,op);                             { BNE loop }
	  if eclass = nenode then
	    begin getbrattr(flbl^.pc,defined,op);
	    emit1(bra,op);                           { BRA flbl }
	    end
	  else if opnd1^.etyptr^.aisstrng then
	    if eclass <> eqnode then
	      begin
	      fixreflist(addr(lbl4));                    { lbl4 EQU * }
	      emit1(swap,regtemp);
	      regtemp.storage := bytte;
	      emit2(cmp,reg2,regtemp);
	      freeit(D,reg2.regnum);
	      end;
	  if eclass <> eqnode then
	    fixreflist(addr(tlbl));                      { tlbl EQU * }
	  if (eclass <> eqnode) and (eclass <> nenode) then
	    getbrattr(flbl^.pc,defined,op);
	  case eclass of
	    eqnode,nenode: ;
	    ltnode: emit1(bcc,op);                   { BCC flbl }
	    lenode: emit1(bhi,op);                   { BHI flbl }
	    gtnode: emit1(bls,op);                   { BLS flbl }
	    genode: emit1(bcs,op);                   { BCS flbl }
	    end;
	  freeit(A,opnd1^.attr^.regnum);
	  freeit(A,opnd2^.attr^.regnum);
	  forgetbasereg(opnd1^.attr^.regnum);
	  forgetbasereg(opnd2^.attr^.regnum);
	  freeit(D,regtemp.regnum);
	  end;
      end; { genpaofchcond }

    procedure gencond(*fcond: exptr; var flbl: reflistptr; defined: boolean*);
      { generate code for a condition, emitting a false jump to lbl;
	if defined = true, the jump is backward; otherwise, fixup info
	is returned in flbl }
      var
	lform: structform;
	destonleft,signed: boolean;
	op: attrtype;
	bptr,truelist: reflistptr;

      begin {gencond}
	if not defined then
	  begin
	  new(flbl);
	  flbl^.next := NIL;
	  end;
	with fcond^ do
	  case eclass of
	    eqnode..supersetnode:
	      begin
	      lform := opnd2^.etyptr^.form;
	      if (lform=power) or (lform = reals) then
		begin {call runtime support function, test returned byte}
		genexpr(fcond);
		emit1(tst,fcond^.attr^);      { TST.size attr }
		getbrattr(flbl^.pc,defined,op);
		emit1(beq,op);                { BEQ flbl }
		end
	      else if lform = arrays then genpaofchcond(fcond,flbl,defined)
	      else
		begin
		relCMP(fcond,destonleft,signed);
		getbrattr(flbl^.pc,defined,op);
		if destonleft then
		  case eclass of
		    eqnode: emit1(bne,op);
		    nenode: emit1(beq,op);
		    ltnode:
		      if signed then emit1(bge,op)
		      else emit1(bcc,op);
		    lenode:
		      if signed then emit1(bgt,op) else emit1(bhi,op);
		    gtnode:
		      if signed then emit1(ble,op) else emit1(bls,op);
		    genode:
		      if signed then emit1(blt,op) else emit1(bcs,op);
		    end
		else
		  case eclass of
		    eqnode: emit1(bne,op);
		    nenode: emit1(beq,op);
		    ltnode:
		      if signed then emit1(ble,op) else emit1(bls,op);
		    lenode:
		      if signed then emit1(blt,op) else emit1(bcs,op);
		    gtnode:
		      if signed then emit1(bge,op) else emit1(bcc,op);
		    genode:
		      if signed then emit1(bgt,op) else emit1(bhi,op);
		    end;
		end;
	      end;
	    andnode,
	    ornode:
	      if shortcircuit then
		begin
		truelist := NIL;
		if not defined then flbl := NIL;
		if eclass = andnode then
		  genshortand(fcond,truelist,flbl,true,defined,false,NIL)
		else { eclass = ornode }
		  begin
		  genshortor(fcond,truelist,flbl,true,defined,false,NIL);
		  if not defined then
		    begin
		    new(bptr);
		    bptr^.next := flbl;
		    flbl := bptr;
		    end;
		  getbrattr(flbl^.pc,defined,op);
		  emit1(bra,op);
		  end;
		fixreflist(truelist);
		forgetbaseregs;
		end
	      else
		begin
		genexpr(fcond);
		freeit(D,attr^.regnum);
		getbrattr(flbl^.pc,defined,op);
		emit1(beq,op);                  { BEQ flbl }
		end;
	    notnode:
	      begin
	      genexpr(opnd);
	      if (opnd^.attr^.addrmode <> inDreg) or
		 (shortcircuit) then {cc not valid}
		begin makeaddressable(opnd);
	    $IF MC68020$
		emit1(tst,opnd^.attr^);       { TST.size attr }
	    $END$
	    $IF not MC68020$
		if opnd^.attr^.addrmode = namedconst then
		  begin
		  op.addrmode := immediate;
		  op.smallval := 0;
		  emit2(cmpi,op,opnd^.attr^);
		  end
		else
		  emit1(tst,opnd^.attr^);
	    $END$
		end;
	      freeregs(opnd^.attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(bne,op);                  { BNE flbl }
	      end;
	    oddnode:
	      begin
	      makeaddressable(opnd);
	      with opnd^.attr^ do
		if not (addrmode in memorymodes) then
		  loadvalue(opnd)
		else
		  begin
		  case storage of
		    bytte: {ok};
		    wrd: offset := offset + 1;
		    long: offset := offset + 3;
		  end; { case }
		  checkoffset(opnd);
		  end;
	      emit2(btst,immed0,opnd^.attr^);           { BTST #0,attr }
	      freeregs(opnd^.attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(beq,op);                  { BEQ flbl }
	      end; { oddnode }
	    idnode,
	    succnode,      { Added 9/5/89 JWH }
	    fcallnode,
	    derfnode,
	    subscrnode,
	    selnnode,
	    unqualfldnode:
	      begin makeaddressable(fcond);
	    $IF MC68020$
	      emit1(tst,attr^);               { TST.size attr }
	    $END$
	    $IF not MC68020$
	      if attr^.addrmode = namedconst then
		begin
		op.addrmode := immediate;
		op.smallval := 0;
		emit2(cmpi,op,attr^);
		end
	      else
		emit1(tst,attr^);
	    $END$
	      freeregs(attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(beq,op);                  { BEQ flbl }
	      end;
	    litnode:
	      if fcond^.litval.ival = 0 then
		begin
		getbrattr(flbl^.pc,defined,op);
		emit1(bra,op);                { BRA flbl }
		end
	      else
		if not defined then
		  flbl^.pc := -1;             { no Bcc emitted }
	    end; {case}
      end; {gencond}

    PROCEDURE PACK (LHS, RHS : EXPTR);
      VAR
	op1,op2,op3: attrtype;
	lstorage : stortype;
	xfersize : stortype;
      BEGIN { PACK }
      WITH LHS^, ATTR^ DO
	BEGIN
	MAKEADDRESSABLE(RHS);
	if bitsize <= 8 then lstorage := bytte
	else if bitsize <= 16 then lstorage := wrd
	else lstorage := long;
	if rhs^.attr^.storage < lstorage then extend(rhs,lstorage);
	BITADDRESS(LHS);
	IF ACCESS = INDIRECT THEN
	  LOADADDRESS(LHS,false)
	ELSE checkoffset(lhs);
	IF BITOFFSET.VARIABLE = -1 THEN { CONSTANT BITOFFSET }
	  begin
	  if (bitsize = 1) and (rhs^.eclass = litnode) then
	    begin
	    if bitoffset.static >= 8 then
	      begin
	      offset := offset + 1;
	      bitoffset.static := bitoffset.static - 8;
	      end;
	    op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	    if rhs^.litval.ival = 0 then emit2(bclr,op1,lhs^.attr^)
				    else emit2(bset,op1,lhs^.attr^);
	    freeregs(attr);
	    end
	  else IF (BITSIZE = 8) AND (BITOFFSET.STATIC IN [0,8]) THEN
	    BEGIN
	    if rhs^.attr^.addrmode = topofstack then loadvalue(rhs);
	    IF BITOFFSET.STATIC = 8 THEN OFFSET := OFFSET + 1;
	    with rhs^.attr^ do
	      case storage of
		bytte: {ok};
		wrd: offset := offset+1;
		long: offset := offset+3;
	      end;
	    storage := bytte;
	    emit2(move,rhs^.attr^,{lhs}attr^);
	    FREEREGS(RHS^.ATTR);
	    FREEREGS({LHS}ATTR);
	    END
	  ELSE IF (BITSIZE = 16) AND (BITOFFSET.STATIC = 0) THEN
	    BEGIN
	    if rhs^.attr^.addrmode = topofstack then loadvalue(rhs);
	    with rhs^.attr^ do
	      case storage of
		bytte: extend(rhs,wrd);
		wrd: {ok};
		long: offset := offset+2;
		end;
	    {lhs^.attr^}storage := wrd;
	    emit2(move,rhs^.attr^,{lhs^}attr^);
	    FREEREGS(RHS^.ATTR);
	    FREEREGS({LHS^}ATTR);
	    END
	  ELSE

	    $IF MC68020$
	    begin
	    loadvalue(rhs);
	    if rhs^.attr^.storage = bytte then
	      begin
	      if bitsize >= 17 then extend(rhs,long)
	      else if bitsize >= 9 then extend(rhs,wrd);
	      end
	    else if rhs^.attr^.storage = wrd then
	      if bitsize >= 17 then extend(rhs,long);
	    emit2(bfins,rhs^.attr^,lhs^.attr^);
	    freeit(D,rhs^.attr^.regnum);
	    freeregs(lhs^.attr);
	    end;
	    $END$


	    $IF not MC68020$
	    BEGIN
	    if (bitsize = 1) then
	      begin
	      maskboolexpr(rhs);
	      if bitoffset.static >= 8 then
		begin
		offset := offset + 1;
		bitoffset.static := bitoffset.static - 8;
		end;
	      op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	      emit2(bclr,op1,lhs^.attr^);
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      xfersize := bytte;
	      end
	    else if (bitoffset.static MOD 8) + bitsize <= 8 then
	      begin
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      getcomplmaskattr(bitoffset.static-24,bitsize,8,op2);
	      {lhs^.attr^}storage := bytte;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := bytte;
	      end
	    else if (bitoffset.static + bitsize) <= 16 then
	      begin
	      bitoffset.static := bitoffset.static + 16;
	      getcomplmaskattr(bitoffset.static-16,bitsize,16,op2);
	      {lhs^.attr^}storage := wrd;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := wrd;
	      end
	    else
	      begin
	      getcomplmaskattr(bitoffset.static,bitsize,32,op2);
	      {lhs^.attr^}storage := long;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := long;
	      end;
	    loadvalue(rhs); extend(rhs,xfersize);
	    emitshift(32-(bitsize+bitoffset.static),rhs^.attr^.regnum,
								    lsl,long);
	    IF SIGNBIT and (bitoffset.static <> 0) THEN
	      BEGIN  {strip off extra sign bits}
	      case xfersize of
		bytte: begin
		      rhs^.attr^.storage := bytte;
		      getcomplmaskattr(0,bitoffset.static-24,8,op2);
		      end;
		wrd: begin
		      rhs^.attr^.storage := wrd;
		      getcomplmaskattr(0,bitoffset.static-16,16,op2);
		      end;
		long: begin
		      rhs^.attr^.storage := long;
		      getcomplmaskattr(0,bitoffset.static,32,op2);
		      end;
	      end; { case }
	      emit2(andi,op2,rhs^.attr^);
	      END;
	    case xfersize of
	      bytte: storage := bytte;
	      wrd: storage := wrd;
	      long: storage := long;
	    end;
	    emit2(orr,rhs^.attr^,{lhs^}attr^);
	    FREEIT(D,rhs^.attr^.regnum);
	    FREEREGS(LHS^.ATTR);
	    END;
	    $END$

	  END { CONSTANT BITOFFSET }
	ELSE  { VARIABLE BITOFFSET }

	  $IF MC68020$
	  begin
	  loadvalue(rhs);
	  if rhs^.attr^.storage = bytte then
	    begin
	    if bitsize >= 17 then extend(rhs,long)
	    else if bitsize >= 9 then extend(rhs,wrd);
	    end
	  else if rhs^.attr^.storage = wrd then
	    if bitsize >= 17 then extend(rhs,long);
	  emit2(bfins,rhs^.attr^,lhs^.attr^);
	  freeit(D,rhs^.attr^.regnum);
	  freeregs(lhs^.attr);
	  freeit(D,bitoffset.variable);
	  end;
	  $END$

	  $IF not MC68020$
	  begin maskboolexpr(rhs);
	  with op2 do
	    begin
	    addrmode := inDreg; regnum := getreg(D); storage := long;
	    end;
	  getcomplmaskattr(0,(32-bitsize),32,op1);
	  emit2(move,op1,op2);                  { MOVE.L mask,temp }
	  op1.addrmode := inDreg; op1.regnum := bitoffset.variable;
	  op1.storage := bytte;
	  emit1(neg,op1);
	  op3.addrmode := immediate; op3.smallval := 32-bitsize;
	  emit2(add,op3,op1);
	  emit2(lsl,op1,op2);                  { locate mast temp }
	  IF SIGNBIT THEN
	    BEGIN
	    with op3 do
	      begin
	      addrmode := inDreg; regnum := getreg(D); storage := long;
	      end;
	    emit2(move,op2,op3);
	    END;
	  emit1(nott,op2);                     { complement mask }
	  lhs^.attr^.storage := long;
	  emit2(andd,op2,lhs^.attr^);          { AND.L mask,destination }
	  freeit(D,op2.regnum);
	  loadvalue(rhs); extend(rhs,long);
	  rhs^.attr^.storage := long;
	  emit2(lsl,op1,rhs^.attr^);           { position source in reg }
	  FREEIT(D,BITOFFSET.VARIABLE);
	  IF SIGNBIT THEN
	    BEGIN
	    emit2(andd,op3,rhs^.attr^);         { mask off extra sign bits }
	    FREEIT(D,op3.regnum);
	    END;
	  emit2(orr,rhs^.attr^,lhs^.attr^);
	  FREEIT(D,rhs^.attr^.regnum);
	  FREEREGS(LHS^.ATTR);
	  END; { VARIABLE BITOFFSET }
	  $END$

	END; { WITH }
      END; { PACK }

    procedure packtopack(*lhs,rhs: exptr*);
      var
	shiftcount,masksize,maskoffset,shiftsize: shortint;
	xfersize,shiftopsize: stortype;
	signextend: boolean;
	op1,op2: attrtype;
      begin
	$IF MC68020$
	pack(lhs,rhs);
	$END$

	$IF not MC68020$
	if (lhs^.attr^.bitoffset.variable <> -1) or
	   (rhs^.attr^.bitoffset.variable <> -1) then pack(lhs,rhs)
	else with lhs^, attr^ do begin
	  bitaddress(lhs);
	  if (bitsize = 8) and (bitoffset.static in [0,8]) then pack(lhs,rhs)
	  else if (bitsize = 16) and (bitoffset.static = 16) then pack(lhs,rhs)
	  else begin { this is a pack to pack special case }
	    if access = indirect then
	      loadaddress(lhs,false)
	    else checkoffset(lhs);
	    {determine access size for the destination}
	    if (bitoffset.static MOD 8) + bitsize <= 8 then
	      begin
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      xfersize := bytte;
	      end
	    else if (bitoffset.static + bitsize) <= 16 then
	      begin
	      bitoffset.static := bitoffset.static + 16;
	      xfersize := wrd;
	      end
	    else xfersize := long;
	    {load the rhs in a register}
	    bitaddress(rhs);
	    with rhs^, attr^ do begin
	      if access = indirect then
		loadaddress(rhs,false)
	      else checkoffset(rhs);
	      signextend := signbit and (bitsize < lhs^.attr^.bitsize);
	      with op1 do
		begin addrmode := inDreg; regnum := getreg(D); end;
	      { get rhs in a register without unpacking then field yet }
	      if ((bitoffset.static MOD 8)+bitsize <= 8) and
		 (not signextend or (xfersize = bytte)) then
		begin
		offset := offset + (bitoffset.static DIV 8);
		bitoffset.static := (bitoffset.static MOD 8) + 24;
		op1.storage := bytte;
		end
	      else if ((bitoffset.static+bitsize) <= 16) and
		      (not signextend or (xfersize <= wrd)) then
		begin
		bitoffset.static := bitoffset.static + 16;
		op1.storage := wrd;
		end
	      else op1.storage := long;
	      emit2(move,{rhs^}attr^,op1);         { MOVE rhs,reg }
	      freeregs({rhs^}attr);
	      end; { with rhs^}
	    {clear lhs destination field}
	    {lhs^.attr^}storage := xfersize;
	    case xfersize of
	      bytte: if bitsize <> 8 then
		begin
		getcomplmaskattr(bitoffset.static-24,bitsize,8,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	      wrd: if bitsize <> 16 then
		begin
		getcomplmaskattr(bitoffset.static-16,bitsize,16,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	      long:
		begin
		getcomplmaskattr(bitoffset.static,bitsize,32,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	    end; { case xfersize }
	    {position the rhs correctly in the register to
	     match the destination field location}
	    shiftcount := (rhs^.attr^.bitoffset.static + rhs^.attr^.bitsize)
			 - (bitoffset.static + bitsize);
	    if (rhs^.attr^.signbit) and (rhs^.attr^.bitsize < bitsize) then
	      with rhs^.attr^ do
		begin {unpack rhs using sign extension}
		case xfersize of
		  bytte: shiftcount := bitoffset.static - 24;
		  wrd: shiftcount := bitoffset.static - 16;
		  long: shiftcount := bitoffset.static;
		end;
		while shiftcount < 0 do shiftcount := shiftcount + 8;
		shiftsize := shiftcount + 32 - bitoffset.static;
		if      shiftsize <= 8 then  shiftopsize := bytte
		else if shiftsize <= 16 then shiftopsize := wrd
		else                         shiftopsize := long;
		emitshift(shiftcount,op1.regnum,lsl,shiftopsize);
		shiftcount := shiftcount - (bitoffset.static + bitsize)
			   + lhs^.attr^.bitoffset.static + lhs^.attr^.bitsize;
		emitshift(shiftcount,op1.regnum,asr,shiftopsize);
		bitsize := bitsize + shiftcount;
		end { with rhs^.attr^ }
	    else if shiftcount > 0 then
	      emitshift(shiftcount,op1.regnum,lsl,xfersize)
	    else if shiftcount < 0 then
	      emitshift(-shiftcount,op1.regnum,lsr,op1.storage);
	    { maskoff the rhs garbage bits if necessary }
	    if bitsize > rhs^.attr^.bitsize then
	      begin
	      masksize := rhs^.attr^.bitsize;
	      maskoffset := rhs^.attr^.bitoffset.static - shiftcount;
	      end
	    else if bitsize < rhs^.attr^.bitsize then
	      begin
	      masksize := bitsize;
	      maskoffset := bitoffset.static;
	      end
	    else if (bitsize = 8) and (xfersize = bytte) then masksize := 0
	    else if (bitsize = 16) and (xfersize = wrd) then masksize := 0
	    else begin
	      masksize := bitsize;
	      maskoffset := bitoffset.static;
	      end;
	    if masksize <> 0 then
	      begin
	      case xfersize of
		bytte: getmaskattr(maskoffset-24,masksize,8,op2);
		wrd: getmaskattr(maskoffset-16,masksize,16,op2);
		long: getmaskattr(maskoffset,masksize,32,op2);
	      end;
	      op1.storage := xfersize;
	      emit2(andi,op2,op1);
	      end;
	    { store into the destination field }
	    {lhs^.attr^}storage := xfersize;
	    if (xfersize = bytte) and (bitsize = 8) then
	      emit2(move,op1,{lhs^}attr^)
	    else if (xfersize = wrd) and (bitsize = 16) then
	      emit2(move,op1,{lhs^}attr^)
	    else
	      emit2(orr,op1,{lhs^}attr^);
	    freeit(D,op1.regnum);
	    freeregs({lhs^}attr);
	    end; {pack to pack special case}
	  end; {with lhs^, attr^}
	$END$

	end; {packtopack}

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@d15 2
a16 1
	  if (ekind = xpr) and (attr^.addrmode <> topofstack) then
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1418
			  { file GENMOVE }

    import
      assemble,genexprmod,symtable,genutils,float_hdw;
    implement {moveit}

    var  { used by needscheck, emitcheck }
      targetlo,targethi: integer;

    procedure maskboolexpr(*fexp: exptr*);
    var op: attrtype;
    begin
      with fexp^ do
	if etyptr = boolptr then
	  if (ekind = xpr) and (attr^.addrmode <> topofstack) then
	    with op do
	      begin storage := bytte; addrmode := immediate; smallval := 1;
	      emit2(andi,op,attr^);
	      end;
    end;

    function needscheck
	  (fexp: exptr; target: stp;
		    assignstmt: boolean):boolean;
    var
      sourcelo,sourcehi: integer;
      source: stp;
      sourceattr: attrptr;
    begin
    needscheck := false;
    if (target^.form <= subrange) and (target <> intptr) and
       (fexp^.eclass <> litnode) then
      begin
      genexpr(fexp); { get attribute record }
      source := fexp^.etyptr;
      sourceattr := fexp^.attr;
      getbounds(target,targetlo,targethi);
      with sourceattr^ do
	begin
	if packd then
	  begin
	  if (bitsize = 31) and not signbit then
	    sourcehi := maxint
	  else
	    sourcehi := power_table[bitsize-ord(signbit)]-1;
	  end
	else { not packed }
	  case storage of
	    bytte: if signbit then
		    sourcehi := 127
		  else sourcehi := 255;
	    wrd: if signbit then
		    sourcehi := 32767
		  else sourcehi := 65535;
	    long: sourcehi := maxint;
	    end;
	if signbit then
	  sourcelo := -sourcehi-1
	else sourcelo := 0;
	end;
      if ((fexp^.eclass = succnode) or
	 (fexp^.eclass = prednode)) and
	 (fexp^.etyptr = target) and
	 assignstmt then
	needscheck := false
      else if (sourcelo < targetlo) or
	      (sourcehi > targethi) then
	     needscheck := true;
      end;
    end; {needscheck}

  procedure emitcheck(fexp: exptr; target: stp;
			    assignstmt: boolean);
    var
      r, op: attrtype;
      branchoffset: shortint;
    begin
    if needscheck(fexp,target,assignstmt) then
      TRY
	maskboolexpr(fexp); loadvalue(fexp);

	$IF MC68020$
	if (targethi > 32767) or (targetlo < -32768) then escape(0);
	$END$

	$ovflcheck on$
	$IF not MC68020$
	if (targethi - targetlo) < 0 then escape(0); { overflow check }
	if (targethi - targetlo) > 32767 then escape(0);
	$END$
	$if not ovflchecking$
	  $ovflcheck off$
	$end$
	with fexp^,attr^ do
	  begin
	  r.addrmode := inDreg;
	  r.storage := wrd;
	  if storage = long then escape(0);
	  if storage = bytte then extend(fexp,wrd);

	  $IF MC68020$
	  r.regnum := attr^.regnum;
	  if targetlo = 0 then {use chk}
	    begin
	    with op do
	      begin addrmode := immediate; smallval := targethi; end;
	    emit2(chk,op,r);
	    end
	  else
	    begin
	    with op do
	      begin
	      addrmode := labelledconst;
	      offset := 0;
	      new(constvalp);
	      with constvalp^ do
		begin
		cclass := chk2_bounds;
		lower := targetlo;
		upper := targethi;
		size := wrd;
		end;
	      constvalp := poolit(constvalp);
	      end;
	    emit2(chk2,op,r);
	    end;
	  $END$

	  $IF not MC68020$
	  if targetlo = 0 then r.regnum := attr^.regnum
	  else
	    begin { use scratch register for check}
	    r.regnum := getreg(D);
	    emit2(move,attr^,r);
	    with op do
	      begin addrmode := immediate; smallval := targetlo end;
	    emit2(sub,op,r);
	    end; {targetlo <> 0}
	  with op do
	    begin addrmode := immediate; smallval := targethi-targetlo end;
	  emit2(chk,op,r);
	  if targetlo <> 0 then freeit(D,r.regnum);
	  $END$

	  end; {with}
      RECOVER
	begin
	if (escapecode <> 0) and
	   (escapecode <> -4) then
	  escape(escapecode);

	$IF MC68020$
	with fexp^,attr^ do
	  begin
	  r.addrmode := inDreg;
	  r.storage := long;
	  r.regnum := attr^.regnum;
	  extend(fexp,long);
	  end;
	if targetlo = 0 then {use chk}
	  begin
	  with op do
	    begin addrmode := immediate; smallval := targethi; end;
	  emit2(chk,op,r);
	  end
	else
	  begin
	  with op do
	    begin
	    addrmode := labelledconst;
	    offset := 0;
	    new(constvalp);
	    with constvalp^ do
	      begin
	      cclass := chk2_bounds;
	      lower := targetlo;
	      upper := targethi;
	      size := long;
	      end;
	    constvalp := poolit(constvalp);
	    end;
	  emit2(chk2,op,r);
	  end;
	$END$

	$IF not MC68020$
	ensure_valid_condition_code := true;

	if (targetlo<-32768) or (targethi>32767)
	   or (fexp^.attr^.storage = long)
	   or not (fexp^.attr^.signbit) then
	  begin
	  extend(fexp,long);
	  branchoffset := 8;
	  end
	else
	  begin
	  extend(fexp,wrd);
	  branchoffset := 6;
	  end;

	ensure_valid_condition_code := false;
	if targetlo <> 0 then
	  with op do
	    begin
	    addrmode := immediate;
	    smallval := targetlo;
	    emit2(cmpi,op,fexp^.attr^);  { CMPI targetlo,source }
	    end
	else { if condition code not valid emit TST }
	  if fexp^.eclass in [succnode,prednode] then
	    emit1(tst,fexp^.attr^);
	with op do
	  begin
	  offset := branchoffset;
	  storage := bytte;
	  end;
	emit1(blt,op);                   { BLT *+10 }
	with op do
	  begin addrmode := immediate; smallval := targethi end;
	emit2(cmpi,op,fexp^.attr^);      { CMPI targethi,source }
	with op do
	  begin offset := 2; storage := bytte end;
	emit1(ble,op);                   { BLE *+4 }
	op.smallval := 7;
	emit1(trap,op);                  { TRAP #7 }
	$END$

	end; {recover}
    end; {emitcheck}

    PROCEDURE BITADDRESS{FEXP: EXPTR};
      VAR
	op1,op2,op3: attrtype;
      BEGIN { BITADDRESS }
      WITH FEXP^.ATTR^ DO
	BEGIN
	OFFSET := OFFSET + mydiv(BITOFFSET.STATIC,16) * 2;
	BITOFFSET.STATIC := (BITOFFSET.STATIC mod 16);
	IF BITOFFSET.VARIABLE <> -1 THEN
	  BEGIN
	  op2.addrmode := inDreg; op2.regnum := bitoffset.variable;
	  op2.storage := bitoffset.storage;
	  IF BITOFFSET.STATIC <> 0 THEN
	    BEGIN { ADD CONSTANT BITOFFSET TO VARIABLE BITOFFSET }
	    op1.addrmode := immediate;
	    op1.smallval := bitoffset.static;
	    emit2(add,op1,op2);              { ADD #static,variable }
	    bitoffset.static := 0;
	    END;
	  { EXTRACT WORD COMPONENT OF BITOFFSET.VARIABLE }
	  op1.addrmode := inDreg; op1.regnum := getreg(D);
	  op1.storage := bitoffset.storage;
	  emit2(move,op2,op1);               { MOVE variable,temp }
	  with op3 do
	    begin addrmode := immediate; smallval := 4; end;
	  emit2(asr,op3,op1);                { LSR #4,temp }
	  op3.smallval := 1;
	  emit2(lsl,op3,op1);                { LSL #1,temp }
	  op3.smallval := 15;
	  $IF MC68020$
	  op2.storage := long; { bit field instructions need long value }
	  $END$
	  emit2(andi,op3,op2);               { AND #15,variable }
	  IF INDEXED THEN
	    BEGIN
	    $IF MC68020$
	    {account for scale factor}
	    if indexscale <> 0 then
	      begin
	      op3.regnum := indexreg;
	      op3.storage := long;
	      if indexstorage <> long then
		begin
		emit1(ext,op3);
		indexstorage := long;
		end;
	      op2.addrmode := immediate;
	      op2.smallval := indexscale;
	      emit2(lsl,op2,op3);
	      indexscale := 0;
	      end;
	    $END$
	    if indexstorage < bitoffset.storage then
	      begin
	      op3.regnum := indexreg; op3.storage := long;
	      emit1(ext,op3);              { EXT.L Dindexreg }
	      indexstorage := long;
	      end
	    else if bitoffset.storage < indexstorage then
	      begin
	      op1.storage := long;
	      emit1(ext,op1);              { EXT.L temp }
	      bitoffset.storage := long;
	      end;
	    op3.addrmode := inDreg; op3.regnum := indexreg;
	    op3.storage := indexstorage;
	    emit2(add,op1,op3);              { ADD temp,indexreg }
	    FREEIT(D,op1.regnum);
	    END
	  ELSE
	    BEGIN
	    INDEXED := TRUE;
	    INDEXREG := op1.regnum;
	    indexstorage := bitoffset.storage;
	    $IF MC68020$
	      indexscale := 0;
	    $END$
	    END;
	  END; { IF BITOFFSET.VARIABLE }
	END; { WITH }
      END; { BITADDRESS }

    PROCEDURE UNPACK ( FEXP : EXPTR );
      VAR
	op1,op2: attrtype;
	SHIFTEMP : REGRANGE;
      BEGIN
	WITH FEXP^.ATTR^ DO
	  BEGIN
	  IF BITOFFSET.VARIABLE = -1 THEN
	    BEGIN { CONSTANT BITOFFSET }
	    if bitsize = 1 then
	      begin
	      if bitoffset.static >= 8 then
		begin
		offset := offset + 1;
		bitoffset.static := bitoffset.static - 8;
		checkoffset(fexp);
		end;
	      op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	      emit2(btst,op1,fexp^.attr^);       { BTST 7-static,oprnd }
	      freeregs(fexp^.attr);
	      with op2 do
		begin
		addrmode := inDreg;
		regnum := getreg(D);
		storage := bytte;
		end;
	      emit1(sne,op2);                    { SNE temp }
	      emit1(neg,op2);                    { NEG.B temp }
	      storage := bytte;
	      end
	    else IF (BITSIZE = 8) AND (BITOFFSET.STATIC IN [0,8])
		and ((not force_unpack) or signbit) THEN
	       BEGIN
	       IF BITOFFSET.STATIC = 8 THEN OFFSET := OFFSET + 1;
	       packd := false;
	       STORAGE := BYTTE;
	       checkoffset(fexp);
	       end
	    ELSE IF (BITSIZE = 16) AND (BITOFFSET.STATIC = 0)
		and ((not force_unpack) or signbit) THEN
	      BEGIN
	      packd := false;
	      STORAGE := WRD;
	      end
	    ELSE
	      BEGIN
	      with op2 do
		begin
		addrmode := inDreg; regnum := getreg(D);
		end;

	      $IF MC68020$
	      if signbit then
		emit2(bfexts,fexp^.attr^,op2)
	      else
		begin { make sure status register bit N is cleared }
		emit2(bfextu,fexp^.attr^,op2);
		op2.storage := long;
		with op1 do
		  begin
		  addrmode := immediate;
		  if fexp^.attr^.bitsize = 31 then
		    smallval := maxint
		  else
		    smallval := power_table[fexp^.attr^.bitsize] - 1;
		  end;
		emit2(andi,op1,op2);
		end;
	      freeregs(fexp^.attr);
	      storage := long;
	      signbit := true;
	      $END$

	      $IF not MC68020$
	      if ((bitoffset.static MOD 8)+bitsize <= 8) and (not signbit)
		then begin
		offset := offset + (bitoffset.static DIV 8);
		bitoffset.static := (bitoffset.static MOD 8) + 24;
		op2.storage := bytte;
		end
	      else if ((bitoffset.static+bitsize) <= 16) and (not signbit)
		then begin
		bitoffset.static := bitoffset.static + 16;
		op2.storage := wrd;
		end
	      else op2.storage := long;
	      emit2(move,fexp^.attr^,op2);            { MOVE fexp,temp }
	      freeregs(fexp^.attr);
	      if signbit then
		begin { unpack using left shift, right shift }
		emitshift(bitoffset.static,op2.regnum,lsl,long);
		emitshift(32-bitsize,op2.regnum,asr,long);
		end
	      else
		begin { unpack with a right shift, AND }
		emitshift(32-(bitoffset.static+bitsize),op2.regnum,lsr,long);
		getcomplmaskattr(0,32-bitsize,32,op1);
		op2.storage := long;
		emit2(andi,op1,op2);                  { AND.L mask,temp }
		signbit := true;
		end;
	      STORAGE := LONG;
	      $END$

	      END;
	    END { CONSTANT BITOFFSET }
	  ELSE { VARIABLE BITOFFSET }
	    BEGIN
	    with op2 do
	      begin
	      addrmode := inDreg; regnum := getreg(D); storage := long;
	      end;

	    $IF MC68020$
	    if signbit then
	      emit2(bfexts,fexp^.attr^,op2)
	    else
	      begin { make sure status register bit N is cleared }
	      emit2(bfextu,fexp^.attr^,op2);
	      op2.storage := long;
	      with op1 do
		begin
		addrmode := immediate;
		if fexp^.attr^.bitsize = 31 then
		  smallval := maxint
		else
		  smallval := power_table[fexp^.attr^.bitsize] - 1;
		end;
	      emit2(andi,op1,op2);
	      end;
	    freeregs(fexp^.attr);
	    FREEIT(D,BITOFFSET.VARIABLE);
	    storage := long;
	    signbit := true;
	    $END$

	    $IF not MC68020$
	    emit2(move,fexp^.attr^,op2);            { MOVE.L fexp,temp }
	    freeregs(fexp^.attr);
	    op1.addrmode := inDreg; op1.regnum := bitoffset.variable;
	    emit2(lsl,op1,op2);
	    FREEIT(D,BITOFFSET.VARIABLE);
	    if signbit then emitshift(32-bitsize,op2.regnum,asr,long)
		       else emitshift(32-bitsize,op2.regnum,lsr,long);
	    signbit := true;
	    STORAGE := LONG;
	    $END$

	    END; { VARIABLE BITOFFSET }
	  if packd then
	    begin
	    ADDRMODE := inDreg;
	    REGNUM := op2.regnum;
	    ACCESS := DIRECT;
	    INDEXED := FALSE;
	    OFFSET := 0;
	    PACKD := FALSE;
	    end;
	  END; { WITH }
	END; { UNPACK }

    procedure pushaddress(*fexp: exptr*);
      var
	op1,op2: attrtype;
      begin genexpr(fexp);
      with fexp^,attr^ do
	begin
	if packd then
	  begin { handle field of a packed structure }
	  offset := offset + mydiv(bitoffset.static,8);
	  if bitoffset.variable <> -1 then
	    begin { extract byte component of bitoffset.variable }
	    with op1 do
	      begin addrmode := immediate; smallval := 3; end;
	    with op2 do
	      begin
	      addrmode := inDreg;
	      regnum := attr^.bitoffset.variable;
	      storage := attr^.bitoffset.storage;
	      end;
	    emit2(lsr,op1,op2);
	    if indexed then
	      begin
	      with op1 do
		begin
		addrmode := inDreg;
		regnum := attr^.indexreg;
		storage := attr^.indexstorage;
		$IF MC68020$
		if indexscale <> 0 then
		  begin
		  if storage = wrd then
		    begin
		    storage := long;
		    emit1(ext,op1);
		    end;
		  if indexscale = 1 then
		    emit2(add,op1,op1)
		  else
		    emitshift(indexscale,regnum,asl,long);
		  if indexstorage = long then ovflck
		  else indexstorage := long;
		  end;
		$END$
		end;
	      if indexstorage < bitoffset.storage then
		begin
		op1.storage := long;
		emit1(ext,op1);
		indexstorage := long;
		end
	      else if bitoffset.storage < indexstorage then
		begin
		op2.storage := long;
		emit1(ext,op2);
		end;
	      emit2(add,op2,op1);
	      freeit(D,op2.regnum);
	      end
	    else
	      begin
	      indexed := true;
	      indexreg := op2.regnum;
	      indexstorage := bitoffset.storage;
	      $IF MC68020$
		indexscale := 0;
	      $END$
	      end;
	    end;
	  packd := false;
	  end; { if packd }
	if addrmode = inFreg then pushrealaddress(fexp)
	else if (addrmode in memorymodes)
	    or (access = indirect) and (addrmode <> loconstack) then
	  begin checkoffset(fexp);
	  if access = direct then emit1(pea,attr^)
	  else
	    begin SPminus.storage := long;
	    emit2(move,attr^,SPminus);
	    end;
	  freeregs(attr);
	  end
	else
	  if (addrmode = topofstack) and
	     (etyptr = realptr) then
	    begin { real VALUE is on stack }
	    getlocstorage(8,op1);
	    op1.storage := long;
	    emit2(move,attr^,op1);
	    op1.offset := op1.offset + 4;
	    emit2(move,attr^,op1);
	    op1.offset := op1.offset - 4;
	    emit1(pea,op1);
	    freeregs(attr);
	    end
	else if addrmode <> loconstack then
	  escape(-8);
	end; {with}
      end; {pushaddress}

    procedure loadaddress(fexp: exptr;
		       fromcheckoffset: boolean);
      var
	op: attrtype;
	storagetemp: stortype;
      begin genexpr(fexp);
	with fexp^, attr^ do
	  begin
	  if addrmode = loconstack then
	    begin
	    getregattr(A,op);
	    emit2(movea,SPplus,op);
	    end
	  else if (addrmode in memorymodes) or
	      (access = indirect) then
	    if addrinreg(fexp) then op.regnum := regnum {i.e.,do nothing}
	    else
	      begin
	      if not fromcheckoffset then
		checkoffset(fexp);
	      freeregs(attr);
	      getregattr(A,op);
	      { Emit2 overwrites source storage }
	      $range off$
	      storagetemp := storage;
	      if access = direct then emit2(lea,attr^,op)
	      else emit2(movea,attr^,op);
	      storage := storagetemp;
	      $if rangechecking$
		$range on$
	      $end$
	      end
	  else
	    begin
	    escape(-8);
	    op.regnum := 0;
	    end;
	  addrmode := locinreg; regnum := op.regnum;
	  access := direct; indexed := false;
	  offset := 0; gloptr := NIL;
	  end; {with}
      end; {loadaddress}

    procedure moveaddress(* fexp: exptr; var dest: attrtype *);
      { Generate 'MOVE.L' <fexp>,<dest>.
	Code produced for various source modes:

	  locinreg

	     not indexed - direct   LEA    d(Ar),As
				    MOVE.L As,<dest>

			 - indirect MOVE.L d(Ar),<dest>

	     indexed     - direct   LEA    d(Ar,Dx),As
				    MOVE.L As,<dest>

			 - indirect MOVE.L d(Ar,Dx),<dest>

	  absolute

	     not indexed - direct   MOVE.L #d<fexp>,<dest>

			 - indirect MOVE.L d<fexp>,<dest>

	     indexed     - direct   LEA    d<fexp>,Ar
				    LEA    0(Ar,Dx),As
				    MOVE.L As,<dest>

			 - indirect LEA    d<fexp>,Ar
					   MOVE.L 0(Ar,Dx),<dest>  }
      label 1;
      var op: attrtype;
      begin
      dest.storage := long;
      genexpr(fexp);
      with fexp^, attr^ do
   1:   if addrmode = locinreg then
	  if access = direct then
	    begin loadaddress(fexp,false);
	    op.addrmode := inAreg; op.regnum := regnum;
	    emit2(move,op,dest);
	    freeit(A,regnum);
	    end
	  else
	    begin checkoffset(fexp);
	    emit2(move,attr^,dest);
	    freeregs(fexp^.attr);
	    end
	else if addrmode = inDreg then
	  begin emit2(move,attr^,dest); freeit(D,regnum) end
	else if addrmode = immediate then
	  emit2(move,attr^,dest)
	else {absolute,namedconst}
	  if ((access = direct) and (indexed or (addrmode = prel)
	     or (addrmode = namedconst) and (callmode = relcall)))
	     or (addrmode = labelledconst) then
	    begin loadaddress(fexp,false); goto 1 {treat as locinreg} end
	  else
	    begin
	    if access = indirect then
	      begin
	      checkoffset(fexp); {load base reg}
	      emit2(move,attr^,dest);
	      freeregs(attr);
	      end
	    else {not indexed, access = direct}
	      emit2(moveI,attr^,dest);
	    end;
      end; {moveaddress}

    procedure movevalue{fexp: exptr; var at: attrtype};
      { generate MOVE <source> ; fexp points to source expression,
	caller must provide destination in "at"  }
      begin
	makeaddressable(fexp);
	with fexp^ do
	  if attr^.addrmode = inFreg then moverealvalue(fexp,at)
	  else
	    begin
	    if (attr^.addrmode = topofstack) and
	       (etyptr = realptr) then
	      begin { real VALUE is on stack }
	      at.storage := long;
	      emit2(move,attr^,at);
	      at.offset := at.offset + 4;
	      emit2(move,attr^,at);
	      at.offset := at.offset - 4;
	      at.storage := multi;
	      end
	    else
	      emit2(move,attr^,at);
	    freeregs(attr);
	    end;
      end; {movevalue}

    procedure pushvalue(*fexp: exptr*);
      var i : shortint;
      begin
	makeaddressable(fexp);
	with fexp^, attr^ do
	  if addrmode = inFreg then pushrealvalue(fexp)
	  else
	    begin
	    if addrmode <> topofstack then
	      begin
	      if etyptr^.unpacksize = 8 then { reals and prok vars }
		begin SPminus.storage := long;
		offset := offset + 4;
		for i := 0 to 1 do
		  begin
		  offset := offset - (i*4);
		  checkoffset(fexp);
		  emit2(move,attr^,SPminus);
		  end;
		end
	      else if etyptr^.unpacksize <> 0 then
		begin SPminus.storage := storage;
		if (addrmode = immediate) and (smallval = 0) then
		  emit1(clr,SPminus)
		else emit2(move,attr^,SPminus);
		end;
	      freeregs(attr);
	      addrmode := topofstack;
	      end;
	    end; { with }
      end;

    procedure loadvalue(*fexp: exptr*);
      { fetch value to D register, update value and machine images }
      var op: attrtype;
      begin
	makeaddressable(fexp);
	with fexp^, attr^ do
	  if etyptr^.form = reals then loadrealvalue(fexp)
	  else
	    if addrmode <> inDreg then
	      begin
	      freeregs(attr);
	      getregattr(D,op);
	      op.storage := storage;
	      emit2(move,attr^,op);
	      addrmode := inDreg;
	      regnum := op.regnum;
	      indexed := false;
	      end;
      end; {loadvalue}

    procedure genpaofchcond(fcond: exptr; var flbl: reflistptr;
			     defined: boolean);
      { generate code for a packed array of char comparison,
	emitting a false jump to flbl}
      var
	loop : addrrange;
	tlbl,lbl3,lbl4 : localref;
	op,regtemp,reg2 : attrtype;
      begin
      with fcond^ do
	if opnd1^.etyptr^.unpacksize = 0 then
	  case eclass of
	    eqnode, lenode, genode : {do nothing}
	      flbl := NIL;
	    nenode, ltnode, gtnode :
	      begin
	      getbrattr(flbl^.pc,defined,op);
	      emit1(bra,op);
	      end;
	  end { case }
	else
	  begin
	  loadaddress(opnd1,false);
	  loadaddress(opnd2,false);
	  getregattr(D,regtemp);
	  if opnd1^.etyptr^.aisstrng then
	    begin
	    if (eclass <> eqnode) and (eclass <> nenode) then
	      begin
	      getregattr(D,reg2);
	      emit2(moveq,immed0,reg2);             { MOVEQ #0,Dregtemp }
	      reg2.storage := bytte;
	      opnd1^.attr^.addrmode := postincr;
	      emit2(move,opnd1^.attr^,reg2);      { MOVE.B (Aopnd1)+,Dregtemp }
	      regtemp.storage := wrd;
	      emit2(move,reg2,regtemp);
	      emit1(swap,regtemp);
	      emit2(move,reg2,regtemp);
	      regtemp.storage := bytte;
	      opnd2^.attr^.addrmode := postincr;
	      emit2(move,opnd2^.attr^,reg2);
	      emit2(cmp,reg2,regtemp);       { CMP.B Dreg2,Dregtemp }
	      lbl3.next := NIL;
	      getbrattr(lbl3.pc,false,op);
	      emit1(bls,op);                         { BLS lbl3 }
	      with opnd2^.attr^ do
		begin
		addrmode := locinreg;
		offset := -1; gloptr := NIL;
		end;
	      emit2(move,reg2,regtemp);
	      fixreflist(addr(lbl3));
	      emit1(tst,regtemp);                    { lbl3 TST.B Dregtemp }
	      lbl4.next := NIL;
	      getbrattr(lbl4.pc,false,op);
	      emit1(beq,op);                         { BEQ lbl4 }
	      end
	    else { = , <> }
	      begin
	      emit2(moveq,immed0,regtemp);             { MOVEQ #0,Dregtemp }
	      regtemp.storage := bytte;
	      emit2(move,opnd1^.attr^,regtemp);      { MOVE.B (Aopnd1),Dregtemp }
	      op.addrmode := immediate; op.smallval := 1;
	      regtemp.storage := wrd;
	      emit2(addq,op,regtemp);                { ADDQ #1,Dregtemp }
	      end;
	    end
	  else {compare pa of char}
	    begin
	    regtemp.storage := long;
	    op.addrmode := immediate; op.smallval := opnd1^.etyptr^.unpacksize;
	    emit2(move,op,regtemp);             { MOVE(Q/.L) #unpacksize,Dregtemp}
	    end;
	  loop := codephile.bytecount;
	  opnd2^.attr^.addrmode := postincr;
	  with opnd1^.attr^ do
	    begin addrmode := postincr; storage := bytte end;
	  emit2(cmpm,opnd2^.attr^,opnd1^.attr^);{loop CMPM.B (Aopnd2)+,(Aopnd1)+}
	  tlbl.next := NIL;
	  if eclass = eqnode then getbrattr(flbl^.pc,defined,op)
	  else getbrattr(tlbl.pc,false,op);
	  emit1(bne,op);                             { BNE flbl/tlbl }
	  op.addrmode := immediate; op.smallval := 1;
	  emit2(subq,op,regtemp);                    { SUBQ #1,Dregtemp }
	  getbrattr(loop,true,op);
	  emit1(bne,op);                             { BNE loop }
	  if eclass = nenode then
	    begin getbrattr(flbl^.pc,defined,op);
	    emit1(bra,op);                           { BRA flbl }
	    end
	  else if opnd1^.etyptr^.aisstrng then
	    if eclass <> eqnode then
	      begin
	      fixreflist(addr(lbl4));                    { lbl4 EQU * }
	      emit1(swap,regtemp);
	      regtemp.storage := bytte;
	      emit2(cmp,reg2,regtemp);
	      freeit(D,reg2.regnum);
	      end;
	  if eclass <> eqnode then
	    fixreflist(addr(tlbl));                      { tlbl EQU * }
	  if (eclass <> eqnode) and (eclass <> nenode) then
	    getbrattr(flbl^.pc,defined,op);
	  case eclass of
	    eqnode,nenode: ;
	    ltnode: emit1(bcc,op);                   { BCC flbl }
	    lenode: emit1(bhi,op);                   { BHI flbl }
	    gtnode: emit1(bls,op);                   { BLS flbl }
	    genode: emit1(bcs,op);                   { BCS flbl }
	    end;
	  freeit(A,opnd1^.attr^.regnum);
	  freeit(A,opnd2^.attr^.regnum);
	  forgetbasereg(opnd1^.attr^.regnum);
	  forgetbasereg(opnd2^.attr^.regnum);
	  freeit(D,regtemp.regnum);
	  end;
      end; { genpaofchcond }

    procedure gencond(*fcond: exptr; var flbl: reflistptr; defined: boolean*);
      { generate code for a condition, emitting a false jump to lbl;
	if defined = true, the jump is backward; otherwise, fixup info
	is returned in flbl }
      var
	lform: structform;
	destonleft,signed: boolean;
	op: attrtype;
	bptr,truelist: reflistptr;

      begin {gencond}
	if not defined then
	  begin
	  new(flbl);
	  flbl^.next := NIL;
	  end;
	with fcond^ do
	  case eclass of
	    eqnode..supersetnode:
	      begin
	      lform := opnd2^.etyptr^.form;
	      if (lform=power) or (lform = reals) then
		begin {call runtime support function, test returned byte}
		genexpr(fcond);
		emit1(tst,fcond^.attr^);      { TST.size attr }
		getbrattr(flbl^.pc,defined,op);
		emit1(beq,op);                { BEQ flbl }
		end
	      else if lform = arrays then genpaofchcond(fcond,flbl,defined)
	      else
		begin
		relCMP(fcond,destonleft,signed);
		getbrattr(flbl^.pc,defined,op);
		if destonleft then
		  case eclass of
		    eqnode: emit1(bne,op);
		    nenode: emit1(beq,op);
		    ltnode:
		      if signed then emit1(bge,op)
		      else emit1(bcc,op);
		    lenode:
		      if signed then emit1(bgt,op) else emit1(bhi,op);
		    gtnode:
		      if signed then emit1(ble,op) else emit1(bls,op);
		    genode:
		      if signed then emit1(blt,op) else emit1(bcs,op);
		    end
		else
		  case eclass of
		    eqnode: emit1(bne,op);
		    nenode: emit1(beq,op);
		    ltnode:
		      if signed then emit1(ble,op) else emit1(bls,op);
		    lenode:
		      if signed then emit1(blt,op) else emit1(bcs,op);
		    gtnode:
		      if signed then emit1(bge,op) else emit1(bcc,op);
		    genode:
		      if signed then emit1(bgt,op) else emit1(bhi,op);
		    end;
		end;
	      end;
	    andnode,
	    ornode:
	      if shortcircuit then
		begin
		truelist := NIL;
		if not defined then flbl := NIL;
		if eclass = andnode then
		  genshortand(fcond,truelist,flbl,true,defined,false,NIL)
		else { eclass = ornode }
		  begin
		  genshortor(fcond,truelist,flbl,true,defined,false,NIL);
		  if not defined then
		    begin
		    new(bptr);
		    bptr^.next := flbl;
		    flbl := bptr;
		    end;
		  getbrattr(flbl^.pc,defined,op);
		  emit1(bra,op);
		  end;
		fixreflist(truelist);
		forgetbaseregs;
		end
	      else
		begin
		genexpr(fcond);
		freeit(D,attr^.regnum);
		getbrattr(flbl^.pc,defined,op);
		emit1(beq,op);                  { BEQ flbl }
		end;
	    notnode:
	      begin
	      genexpr(opnd);
	      if (opnd^.attr^.addrmode <> inDreg) or
		 (shortcircuit) then {cc not valid}
		begin makeaddressable(opnd);
	    $IF MC68020$
		emit1(tst,opnd^.attr^);       { TST.size attr }
	    $END$
	    $IF not MC68020$
		if opnd^.attr^.addrmode = namedconst then
		  begin
		  op.addrmode := immediate;
		  op.smallval := 0;
		  emit2(cmpi,op,opnd^.attr^);
		  end
		else
		  emit1(tst,opnd^.attr^);
	    $END$
		end;
	      freeregs(opnd^.attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(bne,op);                  { BNE flbl }
	      end;
	    oddnode:
	      begin
	      makeaddressable(opnd);
	      with opnd^.attr^ do
		if not (addrmode in memorymodes) then
		  loadvalue(opnd)
		else
		  begin
		  case storage of
		    bytte: {ok};
		    wrd: offset := offset + 1;
		    long: offset := offset + 3;
		  end; { case }
		  checkoffset(opnd);
		  end;
	      emit2(btst,immed0,opnd^.attr^);           { BTST #0,attr }
	      freeregs(opnd^.attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(beq,op);                  { BEQ flbl }
	      end; { oddnode }
	    idnode,
	    succnode,      { Added 9/5/89 JWH }
	    fcallnode,
	    derfnode,
	    subscrnode,
	    selnnode,
	    unqualfldnode:
	      begin makeaddressable(fcond);
	    $IF MC68020$
	      emit1(tst,attr^);               { TST.size attr }
	    $END$
	    $IF not MC68020$
	      if attr^.addrmode = namedconst then
		begin
		op.addrmode := immediate;
		op.smallval := 0;
		emit2(cmpi,op,attr^);
		end
	      else
		emit1(tst,attr^);
	    $END$
	      freeregs(attr);
	      getbrattr(flbl^.pc,defined,op);
	      emit1(beq,op);                  { BEQ flbl }
	      end;
	    litnode:
	      if fcond^.litval.ival = 0 then
		begin
		getbrattr(flbl^.pc,defined,op);
		emit1(bra,op);                { BRA flbl }
		end
	      else
		if not defined then
		  flbl^.pc := -1;             { no Bcc emitted }
	    end; {case}
      end; {gencond}

    PROCEDURE PACK (LHS, RHS : EXPTR);
      VAR
	op1,op2,op3: attrtype;
	lstorage : stortype;
	xfersize : stortype;
      BEGIN { PACK }
      WITH LHS^, ATTR^ DO
	BEGIN
	MAKEADDRESSABLE(RHS);
	if bitsize <= 8 then lstorage := bytte
	else if bitsize <= 16 then lstorage := wrd
	else lstorage := long;
	if rhs^.attr^.storage < lstorage then extend(rhs,lstorage);
	BITADDRESS(LHS);
	IF ACCESS = INDIRECT THEN
	  LOADADDRESS(LHS,false)
	ELSE checkoffset(lhs);
	IF BITOFFSET.VARIABLE = -1 THEN { CONSTANT BITOFFSET }
	  begin
	  if (bitsize = 1) and (rhs^.eclass = litnode) then
	    begin
	    if bitoffset.static >= 8 then
	      begin
	      offset := offset + 1;
	      bitoffset.static := bitoffset.static - 8;
	      end;
	    op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	    if rhs^.litval.ival = 0 then emit2(bclr,op1,lhs^.attr^)
				    else emit2(bset,op1,lhs^.attr^);
	    freeregs(attr);
	    end
	  else IF (BITSIZE = 8) AND (BITOFFSET.STATIC IN [0,8]) THEN
	    BEGIN
	    if rhs^.attr^.addrmode = topofstack then loadvalue(rhs);
	    IF BITOFFSET.STATIC = 8 THEN OFFSET := OFFSET + 1;
	    with rhs^.attr^ do
	      case storage of
		bytte: {ok};
		wrd: offset := offset+1;
		long: offset := offset+3;
	      end;
	    storage := bytte;
	    emit2(move,rhs^.attr^,{lhs}attr^);
	    FREEREGS(RHS^.ATTR);
	    FREEREGS({LHS}ATTR);
	    END
	  ELSE IF (BITSIZE = 16) AND (BITOFFSET.STATIC = 0) THEN
	    BEGIN
	    if rhs^.attr^.addrmode = topofstack then loadvalue(rhs);
	    with rhs^.attr^ do
	      case storage of
		bytte: extend(rhs,wrd);
		wrd: {ok};
		long: offset := offset+2;
		end;
	    {lhs^.attr^}storage := wrd;
	    emit2(move,rhs^.attr^,{lhs^}attr^);
	    FREEREGS(RHS^.ATTR);
	    FREEREGS({LHS^}ATTR);
	    END
	  ELSE

	    $IF MC68020$
	    begin
	    loadvalue(rhs);
	    if rhs^.attr^.storage = bytte then
	      begin
	      if bitsize >= 17 then extend(rhs,long)
	      else if bitsize >= 9 then extend(rhs,wrd);
	      end
	    else if rhs^.attr^.storage = wrd then
	      if bitsize >= 17 then extend(rhs,long);
	    emit2(bfins,rhs^.attr^,lhs^.attr^);
	    freeit(D,rhs^.attr^.regnum);
	    freeregs(lhs^.attr);
	    end;
	    $END$


	    $IF not MC68020$
	    BEGIN
	    if (bitsize = 1) then
	      begin
	      maskboolexpr(rhs);
	      if bitoffset.static >= 8 then
		begin
		offset := offset + 1;
		bitoffset.static := bitoffset.static - 8;
		end;
	      op1.addrmode := immediate; op1.smallval := 7-bitoffset.static;
	      emit2(bclr,op1,lhs^.attr^);
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      xfersize := bytte;
	      end
	    else if (bitoffset.static MOD 8) + bitsize <= 8 then
	      begin
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      getcomplmaskattr(bitoffset.static-24,bitsize,8,op2);
	      {lhs^.attr^}storage := bytte;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := bytte;
	      end
	    else if (bitoffset.static + bitsize) <= 16 then
	      begin
	      bitoffset.static := bitoffset.static + 16;
	      getcomplmaskattr(bitoffset.static-16,bitsize,16,op2);
	      {lhs^.attr^}storage := wrd;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := wrd;
	      end
	    else
	      begin
	      getcomplmaskattr(bitoffset.static,bitsize,32,op2);
	      {lhs^.attr^}storage := long;
	      emit2(andi,op2,{lhs^}attr^);
	      xfersize := long;
	      end;
	    loadvalue(rhs); extend(rhs,xfersize);
	    emitshift(32-(bitsize+bitoffset.static),rhs^.attr^.regnum,
								    lsl,long);
	    IF SIGNBIT and (bitoffset.static <> 0) THEN
	      BEGIN  {strip off extra sign bits}
	      case xfersize of
		bytte: begin
		      rhs^.attr^.storage := bytte;
		      getcomplmaskattr(0,bitoffset.static-24,8,op2);
		      end;
		wrd: begin
		      rhs^.attr^.storage := wrd;
		      getcomplmaskattr(0,bitoffset.static-16,16,op2);
		      end;
		long: begin
		      rhs^.attr^.storage := long;
		      getcomplmaskattr(0,bitoffset.static,32,op2);
		      end;
	      end; { case }
	      emit2(andi,op2,rhs^.attr^);
	      END;
	    case xfersize of
	      bytte: storage := bytte;
	      wrd: storage := wrd;
	      long: storage := long;
	    end;
	    emit2(orr,rhs^.attr^,{lhs^}attr^);
	    FREEIT(D,rhs^.attr^.regnum);
	    FREEREGS(LHS^.ATTR);
	    END;
	    $END$

	  END { CONSTANT BITOFFSET }
	ELSE  { VARIABLE BITOFFSET }

	  $IF MC68020$
	  begin
	  loadvalue(rhs);
	  if rhs^.attr^.storage = bytte then
	    begin
	    if bitsize >= 17 then extend(rhs,long)
	    else if bitsize >= 9 then extend(rhs,wrd);
	    end
	  else if rhs^.attr^.storage = wrd then
	    if bitsize >= 17 then extend(rhs,long);
	  emit2(bfins,rhs^.attr^,lhs^.attr^);
	  freeit(D,rhs^.attr^.regnum);
	  freeregs(lhs^.attr);
	  freeit(D,bitoffset.variable);
	  end;
	  $END$

	  $IF not MC68020$
	  begin maskboolexpr(rhs);
	  with op2 do
	    begin
	    addrmode := inDreg; regnum := getreg(D); storage := long;
	    end;
	  getcomplmaskattr(0,(32-bitsize),32,op1);
	  emit2(move,op1,op2);                  { MOVE.L mask,temp }
	  op1.addrmode := inDreg; op1.regnum := bitoffset.variable;
	  op1.storage := bytte;
	  emit1(neg,op1);
	  op3.addrmode := immediate; op3.smallval := 32-bitsize;
	  emit2(add,op3,op1);
	  emit2(lsl,op1,op2);                  { locate mast temp }
	  IF SIGNBIT THEN
	    BEGIN
	    with op3 do
	      begin
	      addrmode := inDreg; regnum := getreg(D); storage := long;
	      end;
	    emit2(move,op2,op3);
	    END;
	  emit1(nott,op2);                     { complement mask }
	  lhs^.attr^.storage := long;
	  emit2(andd,op2,lhs^.attr^);          { AND.L mask,destination }
	  freeit(D,op2.regnum);
	  loadvalue(rhs); extend(rhs,long);
	  rhs^.attr^.storage := long;
	  emit2(lsl,op1,rhs^.attr^);           { position source in reg }
	  FREEIT(D,BITOFFSET.VARIABLE);
	  IF SIGNBIT THEN
	    BEGIN
	    emit2(andd,op3,rhs^.attr^);         { mask off extra sign bits }
	    FREEIT(D,op3.regnum);
	    END;
	  emit2(orr,rhs^.attr^,lhs^.attr^);
	  FREEIT(D,rhs^.attr^.regnum);
	  FREEREGS(LHS^.ATTR);
	  END; { VARIABLE BITOFFSET }
	  $END$

	END; { WITH }
      END; { PACK }

    procedure packtopack(*lhs,rhs: exptr*);
      var
	shiftcount,masksize,maskoffset,shiftsize: shortint;
	xfersize,shiftopsize: stortype;
	signextend: boolean;
	op1,op2: attrtype;
      begin
	$IF MC68020$
	pack(lhs,rhs);
	$END$

	$IF not MC68020$
	if (lhs^.attr^.bitoffset.variable <> -1) or
	   (rhs^.attr^.bitoffset.variable <> -1) then pack(lhs,rhs)
	else with lhs^, attr^ do begin
	  bitaddress(lhs);
	  if (bitsize = 8) and (bitoffset.static in [0,8]) then pack(lhs,rhs)
	  else if (bitsize = 16) and (bitoffset.static = 16) then pack(lhs,rhs)
	  else begin { this is a pack to pack special case }
	    if access = indirect then
	      loadaddress(lhs,false)
	    else checkoffset(lhs);
	    {determine access size for the destination}
	    if (bitoffset.static MOD 8) + bitsize <= 8 then
	      begin
	      offset := offset + (bitoffset.static DIV 8);
	      bitoffset.static := (bitoffset.static MOD 8) + 24;
	      xfersize := bytte;
	      end
	    else if (bitoffset.static + bitsize) <= 16 then
	      begin
	      bitoffset.static := bitoffset.static + 16;
	      xfersize := wrd;
	      end
	    else xfersize := long;
	    {load the rhs in a register}
	    bitaddress(rhs);
	    with rhs^, attr^ do begin
	      if access = indirect then
		loadaddress(rhs,false)
	      else checkoffset(rhs);
	      signextend := signbit and (bitsize < lhs^.attr^.bitsize);
	      with op1 do
		begin addrmode := inDreg; regnum := getreg(D); end;
	      { get rhs in a register without unpacking then field yet }
	      if ((bitoffset.static MOD 8)+bitsize <= 8) and
		 (not signextend or (xfersize = bytte)) then
		begin
		offset := offset + (bitoffset.static DIV 8);
		bitoffset.static := (bitoffset.static MOD 8) + 24;
		op1.storage := bytte;
		end
	      else if ((bitoffset.static+bitsize) <= 16) and
		      (not signextend or (xfersize <= wrd)) then
		begin
		bitoffset.static := bitoffset.static + 16;
		op1.storage := wrd;
		end
	      else op1.storage := long;
	      emit2(move,{rhs^}attr^,op1);         { MOVE rhs,reg }
	      freeregs({rhs^}attr);
	      end; { with rhs^}
	    {clear lhs destination field}
	    {lhs^.attr^}storage := xfersize;
	    case xfersize of
	      bytte: if bitsize <> 8 then
		begin
		getcomplmaskattr(bitoffset.static-24,bitsize,8,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	      wrd: if bitsize <> 16 then
		begin
		getcomplmaskattr(bitoffset.static-16,bitsize,16,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	      long:
		begin
		getcomplmaskattr(bitoffset.static,bitsize,32,op2);
		emit2(andi,op2,{lhs^}attr^);           { ANDI mask,lhs }
		end;
	    end; { case xfersize }
	    {position the rhs correctly in the register to
	     match the destination field location}
	    shiftcount := (rhs^.attr^.bitoffset.static + rhs^.attr^.bitsize)
			 - (bitoffset.static + bitsize);
	    if (rhs^.attr^.signbit) and (rhs^.attr^.bitsize < bitsize) then
	      with rhs^.attr^ do
		begin {unpack rhs using sign extension}
		case xfersize of
		  bytte: shiftcount := bitoffset.static - 24;
		  wrd: shiftcount := bitoffset.static - 16;
		  long: shiftcount := bitoffset.static;
		end;
		while shiftcount < 0 do shiftcount := shiftcount + 8;
		shiftsize := shiftcount + 32 - bitoffset.static;
		if      shiftsize <= 8 then  shiftopsize := bytte
		else if shiftsize <= 16 then shiftopsize := wrd
		else                         shiftopsize := long;
		emitshift(shiftcount,op1.regnum,lsl,shiftopsize);
		shiftcount := shiftcount - (bitoffset.static + bitsize)
			   + lhs^.attr^.bitoffset.static + lhs^.attr^.bitsize;
		emitshift(shiftcount,op1.regnum,asr,shiftopsize);
		bitsize := bitsize + shiftcount;
		end { with rhs^.attr^ }
	    else if shiftcount > 0 then
	      emitshift(shiftcount,op1.regnum,lsl,xfersize)
	    else if shiftcount < 0 then
	      emitshift(-shiftcount,op1.regnum,lsr,op1.storage);
	    { maskoff the rhs garbage bits if necessary }
	    if bitsize > rhs^.attr^.bitsize then
	      begin
	      masksize := rhs^.attr^.bitsize;
	      maskoffset := rhs^.attr^.bitoffset.static - shiftcount;
	      end
	    else if bitsize < rhs^.attr^.bitsize then
	      begin
	      masksize := bitsize;
	      maskoffset := bitoffset.static;
	      end
	    else if (bitsize = 8) and (xfersize = bytte) then masksize := 0
	    else if (bitsize = 16) and (xfersize = wrd) then masksize := 0
	    else begin
	      masksize := bitsize;
	      maskoffset := bitoffset.static;
	      end;
	    if masksize <> 0 then
	      begin
	      case xfersize of
		bytte: getmaskattr(maskoffset-24,masksize,8,op2);
		wrd: getmaskattr(maskoffset-16,masksize,16,op2);
		long: getmaskattr(maskoffset,masksize,32,op2);
	      end;
	      op1.storage := xfersize;
	      emit2(andi,op2,op1);
	      end;
	    { store into the destination field }
	    {lhs^.attr^}storage := xfersize;
	    if (xfersize = bytte) and (bitsize = 8) then
	      emit2(move,op1,{lhs^}attr^)
	    else if (xfersize = wrd) and (bitsize = 16) then
	      emit2(move,op1,{lhs^}attr^)
	    else
	      emit2(orr,op1,{lhs^}attr^);
	    freeit(D,op1.regnum);
	    freeregs({lhs^}attr);
	    end; {pack to pack special case}
	  end; {with lhs^, attr^}
	$END$

	end; {packtopack}

@


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.2
log
@

      Added 1 line of code to routine gencond in file GENMOVE.
    Compiler was abnormally terminating with the succesor
    function in a conditional (sometimes). The change was to
    include succnode among the expression types that actually
    get processed (and not ignored).

    Jeff, 9/5/89.
@
text
@@


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


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.2
log
@Avoid emitting a TST instruction with pc relative addressing for the
operand.  Instead emit a CMPI #,-- in its place when compiling for
the 68010. (68020 allows TST with pc relative addressing mode.)
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@d978 1
d980 11
d1023 1
d1025 11
@


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.2
log
@See comments on 18.2 version of GENEXPR.
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@d949 1
a949 1
		  genshortand(fcond,truelist,flbl,true,defined,false)
d952 1
a952 1
		  genshortor(fcond,truelist,flbl,true,defined,false);
@


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.2
log
@Misc. fixes for STARS and bugs found in HP-UX -- see BAR/JWS for detail
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d491 2
a492 2
	      regnum := bitoffset.variable;
	      storage := bitoffset.storage;
d500 2
a501 2
		regnum := indexreg;
		storage := indexstorage;
@


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.2
log
@Pws2unix automatic delta on Wed Nov 19 15:16:12 MST 1986
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@d758 1
d1022 3
a1024 1
	      else flbl^.pc := -1;        { no Bcc emitted }
@


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.2
log
@Changes from Scott Bayes.
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d344 2
a345 1
	    else IF (BITSIZE = 8) AND (BITOFFSET.STATIC IN [0,8]) THEN
d352 2
a353 1
	    ELSE IF (BITSIZE = 16) AND (BITOFFSET.STATIC = 0) THEN
@


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


1.1
log
@Initial revision
@
text
@@
