			  { 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)
          
	  $IF MC68020$                          { Don Novy  1/18/90 }
          else if addrmode = inFcc then
            begin
            { The value is in the 68881 condition codes; }
            { i.e. it is the result of an fcmp.          }
            freeregs(attr);
            getregattr(D,op);                   { Get a data register }
            
            case eclass of                      { Don Novy  1/22/90 }
              eqnode: emit1(fseq,op);
              nenode: emit1(fsne,op);
              gtnode: emit1(fsgt,op);
              genode: emit1(fsge,op);
              ltnode: emit1(fslt,op);
              lenode: emit1(fsle,op);
              end; { case }
                                                
            { Leave addrmode = inFcc to flag that the }
            { 68020 condition codes are not set.      }

            regnum  := op.regnum;
            indexed := false;
            storage := bytte;                   { Don Novy  1/22/90 }
            end
          $END$
          
          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;
	      { Split this into 2 if statements  Don Novy  1/18/90 }
              if lform = reals then
		begin
		genexpr(fcond);
		
                $IF MC68020$                  { Don Novy  1/18/90 }
                if attr^.addrmode = inFcc then
                  begin
                  { The conditional test was done with an fcmp. }
                  { The result is in the 68881 condition codes. }
                  getbrattr(flbl^.pc,defined,op);
                  case eclass of
                    eqnode: emit1(fbne,op);
                    nenode: emit1(fbeq,op);
                    gtnode: emit1(fble,op);
                    genode: emit1(fblt,op);
                    ltnode: emit1(fbge,op);
                    lenode: emit1(fbgt,op);
                    end { case }
                  end
                else
                $END$
                
                  begin                         { Software compare }
                  emit1(tst,fcond^.attr^);      { TST.size attr }
                  getbrattr(flbl^.pc,defined,op);
                  emit1(beq,op);                { BEQ flbl }
		  end
                end
	      else if lform = power 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}

