/* EPC Imp to C Translation Release 4 Version Apr 95 */


#include "imptoc.h"

#undef PI

/** 23Sep98                                                        cprocs08.2*/
/**        Extended DoLongIntop to cope with the unsigned ops via RTs        */
/** 24Mar98                                                      cprocs08.1.1*/
/**        Corrections to Caddresscomplexopnd for case when real&imag are in */
/** 30Jan98                                                      cprocs08.1  */
/**        Changes to Ccall for Microsoft STDCALL (back compatible)          */
/**        Correction to Cpushbytes                                          */
/** 30Sep97                                                      cprocs08    */
/*       Added Ctrampcall for KAI parallel support                           */
/**      Incorporated updates from AK for Cdim,Cdividelongint &              */
/**      Cdividelongdouble                                                   */
/**       Ameneded CCopyBytes to use subroutine if no unclaimed regs         */
/**      Improved Cinregbylit to use LEA if CC set                           */
/** 30Sep97                                                      cprocs07.4.2*/
/*       Changes to Cunasscheck to cope with 8 byte integer and Misaligneds  */
/** 02Sep97                                                      cprocs07.4.1*/
/*         Changes to Cpushparam & ccall so params pushed always a           */
/*         a multiple of 8 bytes                                             */
/** 02Au97                                                        cprocs07.4 */
/*         All the following from ANDY or CMCP slightly amended by pds       */
/*         When coercing an I*4 to I*8 in ConvertII, explicitly              */
/*         forget the contents of the source register (because               */
/*         the generated code corrupts it)                                   */
/*         ensure all stack temporaries created for i*8 are                  */
/*         8-byte aligned to avoid stack "memory" problems                   */
/*         at BitWordShift in Cbitops call __ush64 rather                    */
/*         than __ash64                                                      */
/*         in Caddress, set FRAMEADDRTAKEN when taking an                    */
/*         address by means of a store into the stack frame                  */
/*         in ConvertIR check for FregVal as well as RegVal                  */
/*         when checking for I*8 operand in a register                       */
/*         in Cdividelongint change lockreg call to lockregister             */
/*         in IndRegVal case since lockreg doesn't nest and add              */
/*         lockregister call to IndRegModVal-by-a-literal case               */
/*         in Cnoteresult for I*8 results, only unlock and                   */
/*         forget the address register if it has been allocated              */
/*         Prepare i*8 parameters of __arem64() and __cshft64()              */
/*         by calling Csplitdouble rather than Cdividelongint                */
/*         in effort to avoid register locking confusion                     */
/*         In ConvertIR when the operand is a RegVal move the                */
/*         claiming of the target freg to after the store into               */
/*         the temporary to avoid FP reg stack confusion.                    */
/**        Correct the array FPcompares in DoLongIntOp                       */
/** 10Jun97                                                    cprocs07.3    */
/**        Merged in a number of corrections from AK for I*8 stuff           */
/** 30May97                                                    cprocs07.2    */
/**        Call Mexpcall & Mspcall with enumeration types(pds)               */
/** 26May97                                                    cprocs07.1    */
/**        Correct case of some Fortran entry points (ak)                    */
/**        Correct faulty C syntax (ak)                                      */
/**        Additions to Cdividelongint and LoadRealGeneral to cope with      */
/**        misaligned ints, plus additions to Csign, Cdim, Cminmax and       */
/**        Cbitops for 64-bit ints.                         (CMcP)           */
/** 01Apr97                                                    cprocs07      */
/**        Additions to support 64-bit signed integers      (CMcP)           */
/**        Corrections to EISHFT (Fortran only) (pds)                        */
/** 02Apr97                                                    cprocs06.2    */
/**        Improved Cstbits to eliminate an AND when operating on            */
/**        the leftmost bits of a bitfield                                   */
/**        Made loadintgen try harder if claim reg fails                     */
/** 06Jan97                                                    cprocs06.1    */
/**         Made names consistent for tarnslation to C                       */
/** 29Nov96                                                    cprocs06      */
/**        Added the P6 only instructions when targetvariant=PPRO2           */
/** 24Oct96                                                    cprocs05.3    */
/**        Deferred some simple coercions as per GCC                         */
/** 16Oct96                                                    cprocs05..2   */
/**        Used eprocs version of PIC. Added support for qrndsngl (for DG)   */
/**        and code mininimisation option for GPT as well as further         */
/**        improvements to Pentium pro code                                  */
/** 11July96                                                    cprocs05.1   */
/**        Corrected reg memory management for _cmval code                   */
/** 23Feb96                                                    cprocs05      */
/**        Added Cautostackop to support alloca(pds)                         */
/**        Reactivated the _Cmval code in note index                         */
/**        Changed code in Cswitch cos of Lynxos assembler                   */
/** 05Dec95                                                    cprocs04.9    */
/**         Further improvements to CLdbits & Cstbits                        */
/** 23Nov95                                                    cprocs04.8    */
/**        Improvements to C ldbits and Cstbits                              */
/** 23Aug95                                                    cprocs04.7    */
/**        Changes for swopped data to be loaded(&unswapped)                 */
/**        Some infrastructure support for 64 bit ints                       */
/** 08Aug95                                                    cprocs04.6    */
/**        Added in Load quad & store quad (All FPops acually quad)          */
/** 28Jly95                                                   cprocs04.5     */
/**        Forced in truncation for convert rr 8->4 bytes                    */
/* 31May95                                                   cprocs04.4      */
/**         Changed Generate Float consts to work with USLC also             */
/**         Changed _intval to _Intvalue & Creinitialise                     */
/* 18Apr95                                                   cprocs04.3      */
/**        Change to Cnoteindex not to set elevel on loaded index            */
/*         before the operation is complete                                  */
/*          Added cglabel code to reload GOTREG for C++ catchblocks          */
/* 23Jan95                                                   cprocs04.2      */
/**        Changes to ensure shift by 32 is correct for F90                  */
/**        Hardware does shift modulo 31 so frigging about is needed         */
/**        but only 0-32 inclusive need to be correct                        */
/* 20Dec94                                                   cprocs04.1      */
/**          Corrections to C bitops and also assigning real*4 to real*8     */
/* 08Sep94                                                   cprocs04        */
/**         Changes to code sequences after reading Pentium Optimisatios     */
/* 03Jun94                                                   cprocs03        */
/**         Changes to fix to avoid problems when IMP IO called from Ftran   */
/**         Corrections to Cincreg & Cdecreg                                 */
/* 25Mar93                                                   cprocs02        */
/**         Changes for the latest Bprocs                                    */
/** Nov93                                                       cprocs01     */
/**         Initial Pentium version base on mips cprocs7.3(qv)               */
/***/
#define modulename ("cprocs")
/***/
/**************************************************************************/
/**                                                                      **/
/**                          Module includes                             **/
/**                                                                      **/
/**************************************************************************/
/***/
/* **** for booting ******  %ENDOFLIST                                       */
#include "cgtarget.h"
/***/
#include "cgconsts.h"
/***/
#include "boconsts.h"
/***/
#include "ecodes.h"
/***/
#include "archdefs.h"
/***/
#include "archrvars.h"
/***/
#include "prototypes.h"
/**** for booting   %LIST                                                    */
/***/
/**************************************************************************/
/**                                                                      **/
/**                  Global data                                         **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
extern struct Stkfmt Stk [Stklimit+1];
extern int Elevel;
extern int Labadjust;
extern int FirstDisplayLevel;
extern int MainFrameOffset;
extern int TargetReg;
extern int TargetFreg;
extern int FirstTarget;
extern int TargetDToS;

static const struct Stkfmt ZeroStk = {0};

/* Physical register masks showing registers that have been allocated by     */
/* the optimiser to register variables. All such registers have their        */
/* corresponding bit in the mask set.                                        */
int RegClaimMaskA;
int RegClaimMaskB;
/***/
static int ReturnInstr=0;
/***/
static struct paramfmt *ParI;	/*set via CsetParI whenever Call Level changes*/
/***/
struct Stkfmt LitZero;
struct Stkfmt LitOne;
/***/
int Report;
int localca;
int cgoptions;	/*as determined by ftncomp*/
extern int currentFSP;
extern int calllevel;	/* Nesting level of proc calls                         */
#define CHKOFLOW (0x200000)	/* option bit for soft overflow checks           */
#define RNDSNGL (0x8000000)	/* force extra rounding to single precision      */
#define NOREG 0	/* Memory only instruction*/
#define DESTREG 1	/* Memory => reg instr    */
#define DESTSTORE 2	/* Reg => store instrn    */
#define SOURCELIT 3	/* Lit => Store Lit is in reg */
int Regvaropt;	/*set by Cinitialise*/
int diagnostics;	/*set by Cinitialise*/
int setdbx;	/*set by Cinitialise*/
extern int Pic;	/*  0 => defaults   */
/**/
static int Contexts;
static int FirstTime;	/*set by Cinitialise*/
static int addrf387;
static int	/*set by C Setfputraps*/ areaf387;
static int f387=0x12731273;
static int f387pr64=0x13731373;
static int fixPrecision = 1;
static int ParIIsSet;
/***/
/***/
int QCIResMask;
int QCFResMask;
/***/
/*%IF Language=CCOMP %THENSTART                                              */
int QCDepth;
/*%FINISH                                                                    */
/***/
static char AuxstackName [12]="s#auxstdata";
static struct Stkfmt Auxstk;
/***/
static int RegvarSpace;	/*displacement of temporary space on stack to  */
/*store FRegvars across function calls.        */
static int convarea;	/* Offset of 4 byte area for real truncation */
static int floatarea1;
static int floatarea2;
static int floatoffset1;
static int floatoffset2	/*locations for fixed to flt convsn            */;
int ParamsSaved=-1;	/*set by Cinitialise                      */
int saveparams;	/*set by Cstartproc and Csideentry and    */
/*read by Ccountparams                    */
/***/
int cmplxtemp;	/*temp location for saving Complex*16 results  */
/***/
static struct Stkfmt Stkunassigned;
/*an Estack-like entry addressing the unassigned*/
/*   pattern in GLA                             */
extern unsigned char StackStflags [256+1];	/* records stack frame access */

/***/
/**/
/* comparison of registers with zero (unsigned then signed)                  */
/**/
static const int jops [11+1] = {
	JA<<16,JB<<16,JE<<16,
	JNE<<16,JAE<<16,JBE<<16,JG<<16,JL<<16,
	JE<<16,JNE<<16,JGE<<16,JLE<<16};
static const int jopsr [11+1] = {
	JB<<16,JA<<16,JE<<16,
	JNE<<16,JBE<<16,JAE<<16,JL<<16,JG<<16,
	JE<<16,JNE<<16,JLE<<16,JGE<<16};
/**/
/* The next arrays are for building correct comparison sequences             */
/* for Ecode compares from the (absurdly) restricted MIPS comparison         */
/* operations. the 0 & 255 are mask fields for putting in the                */
/* register nos into the operation. Signed and unsigned sequences            */
/* are built the same way. Only the set operations is different              */
/**/
static const unsigned char Inversejump [JG-(JO)+1] = {
	JNO,
	JO,JNB,JB,JNE,JE,JA,0,
	JBE,JNS,JS,JNP,JP,JGE,JL,JG,
	JLE};
static const unsigned char setjump [JG-(JO)+1] = {
	SETO,
	SETNO,SETB,SETNB,SETE,SETNEQ,SETBE,0,
	SETA,SETS,SETNS,SETP,SETNP,SETL,SETGE,SETLEQ,
	SETG};

static const unsigned char cmovcc [JG-(JO)+1] = {
	CMOVO,
	CMOVNO,CMOVB,CMOVNB,CMOVE,CMOVNEQ,CMOVBE,0,
	CMOVA,CMOVS,CMOVNS,CMOVP,CMOVNP,CMOVL,CMOVGE,CMOVLEQ,

	CMOVG};
static const unsigned char Invcc [ALWAYS-(GT)+1] = {
	LT,
	GT,EQ,NE,LE,GE,255,255,
	255,255,255,255,255,255,ALWAYS,NEVER
};
/***/
/* Equivalent CC values for unsigned compare with zero                       */
static const unsigned char UnsCC [ALWAYS-(GT)+1] = {
	NE,
	NEVER,EQ,NE,ALWAYS,EQ,255,255,
	255,255,255,255,255,255,NEVER,ALWAYS
};
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**                  imports                                             **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
static struct procfmt *PI;
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**                  local specs                                         **/
/**                                                                      **/
/**************************************************************************/
/***/
extern void Cdiscard( struct Stkfmt *);
void Cjump( int ,int ,int );
void Cnoteindex( int ,struct Stkfmt *,struct Stkfmt *);
void Crefer( struct Stkfmt *,int ,int );
void Caddress( struct Stkfmt *);
int Cstoreop( struct Stkfmt *,struct Stkfmt *,int );
void CIntBinaryOp( int ,struct Stkfmt *,struct Stkfmt *,int );
void CIntUnaryOp(int ,struct Stkfmt *);
void CRealBinaryOp( int ,struct Stkfmt *,struct Stkfmt *);
void ConvertIR( struct Stkfmt *,int );
void ConvertII( struct Stkfmt *,int );
void ConvertIU( struct Stkfmt *,int );
void ConvertUI( struct Stkfmt *,int );
void ConvertUU( struct Stkfmt *,int );
int LoadIntTgt( struct Stkfmt *);
int LoadIntRO( struct Stkfmt *);
int LoadIntRONoExt( struct Stkfmt *);
int LoadIntRW( struct Stkfmt *,int );
int LoadIntRWNoExt( struct Stkfmt *,int );
int LoadIntGeneral( struct Stkfmt *,int ,int ,int );
int LoadRealTgt( struct Stkfmt *,int );
int LoadRealRO( struct Stkfmt *,int );
int LoadRealRW( struct Stkfmt *,int ,int );
int LoadRealGeneral( struct Stkfmt *,int ,int ,int );
void Ccopybytes( struct Stkfmt *,struct Stkfmt *,struct Stkfmt *,int );
void Cdiscardopnd( struct Stkfmt *);
void ConvertRIR( struct Stkfmt *,int );
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            management of register records on Estack                  **/
/**                                                                      **/
/**************************************************************************/
/***/
void Cresetreguse(int Oldlevel,int Newlevel) {
	/****************************************************************/
	/** Ensure that register properties associated with            **/
	/** Estk(Oldlevel) are redefined to be associated with         **/
	/** Estk(Newlevel)                                             **/
	/****************************************************************/
	ResetReguse(Oldlevel,Newlevel);
}	/* Cresetreguse  */
/***/

extern void Cstackfr(int, int);

void Cstackr(int R,int size) {
	/****************************************************************/
	/** create an Estack entry for value held in a general register**/
	/** The register is presumed claimed(ie lock=1 Eitem unknown)  **/
	/****************************************************************/
	struct Stkfmt *Lstk;

	if (size == 8) {
		Cstackfr(R, size);
		Lstk = &Stk [Elevel];
		if (Lstk->Form == (FregVal|Regflag))
			Lstk->Form = RegVal|Regflag;
		else
			Lstk->Form = Regvar|Regflag;
		Lstk->Type = IntType;
		return;
	}

	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));

	/** A Regvar register cannot be refered to as RegVal at any time             */
	if ((RegClaimMaskA&(1<<R))!=0) {
		Lstk->Form=Regvar|Regflag;
	} else {
		Lstk->Form=RegVal|Regflag;
	}

	Lstk->Type=IntType;
	Lstk->Reg=R;
	Lstk->Size=size;
	unlockreg(R);
	lockregister(R,Elevel,size);
}	/* Cstackr    */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void Cstackfr(int FR,int Bytes) {
	/****************************************************************/
	/** create an Estack entry for value in a floating register    **/
	/****************************************************************/
	struct Stkfmt *Lstk;

	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));

	/** A Fregvar register cannot be refered to as a FregVal at any time         */
	if ((RegClaimMaskB&(1<<(FR-FRBASE)))!=0) {
		Lstk->Form=Fregvar|Regflag;
	} else {
		Lstk->Form=FregVal|Regflag;
	}

	Lstk->Type=RealType;
	Lstk->Reg=FR;
	Lstk->Size=Bytes;
	if (registerstatus(FR)>0)  unlockreg(FR);
	currentFSP-=1;
	lockregister(FR,Elevel,Bytes);

}	/* Cstackfr     */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void Cpushoperand(struct Stkfmt *Operand) {
	/****************************************************************/
	/** create an Estack entry for a prepared operand              **/
	/****************************************************************/
	int Form,Size,Bytes;
	if (Elevel>=Stklimit)  Mabort(17);
	Form=Operand->Form&31;
	/*      %IF Form=RegVal %THEN Cstackr(operand_reg,operand_size) %AND %RETURN */
	/*      %IF Form=FregVal %THEN Cstackfr(operand_reg,operand_size) %AND %RETURN*/
	Elevel+=1;
	Stk [Elevel]=*Operand;
	if (IsRegForm [Form]!=0) {
		if (IsIndRegForm [Form]==0) {
			Size=Operand->Size;
			Bytes=Size;

#if(Directcomplex==1) 
			if (((Target==SPARC)&&(Size==16))||((targetvariant==M88110)&&(Operand->Imagreg!=0)))  Bytes=(unsigned)Size
			>>1;

#endif
		} else {
			Size=4;
			Bytes=4;
		}
		lockregister(Operand->Reg,Elevel,Bytes);
		if ((Directcomplex==1)&&(Size!=Bytes)) {
			lockregister(Operand->Imagreg,Elevel,Bytes);
		}
	}
	if (IsModForm [Form]!=0) {
		if (IsRegForm [Operand->Modform&31]!=0) {
			lockregister(Operand->Modreg,Elevel,4);
		}
	}
}	/* Cpush operand    */
/***/
void Cmakedouble(struct Stkfmt *MSH, struct Stkfmt *LSH) {
	/*********************************************************************/
	/* Construct a 64-bit int from two 32-bit pieces and leave on Estack */
	/*********************************************************************/
    struct Stkfmt res = {0};
	int Mform = MSH->Form&31;
	int Lform = LSH->Form&31;

	if (Mform == Lform) {
		if (Mform == LitVal) {
			res.Form = LitVal;
			res.Type = IntType;
			res.Size = 8;
			res.Intvalue = LSH->Intvalue;
			res.Modintval = MSH->Intvalue;
			Cpushoperand(&res);
			return;
		} else if ((Mform == TempVal || Mform == ConstVal || 
					(Mform == DirVal && MSH->Base == LSH->Base)) &&
				   ((MSH->Offset - LSH->Offset) == 4)) {
			res = *LSH;
			res.Size = 8;
			res.Type = IntType;
			Cpushoperand(&res);
			return;
		}
	}
	StkTemp(&res, ARCH(tempspace(8, 8)), 8);
	res.Type = IntType;
	res.Size = 4;
	Cstoreop(&res, LSH, 0);
	res.Offset += 4;
	Cstoreop(&res, MSH, 0);
	res.Offset -= 4;
	res.Size = 8;
	Cpushoperand(&res);
}
/**/
int Cdividelongint(struct Stkfmt *Opnd,struct Stkfmt *Clsh,struct Stkfmt *Cmsh) {
	/************************************************************************/
	/** Divide a 64 bit integer into two 32 bit integers                   **/
	/************************************************************************/
	/***/
	int Form,Size,Areg,Type,Flags;

	Form=Opnd->Form&31;
	Size=(unsigned)Opnd->Size>>1;
	Type=Opnd->Type;	/* caddress changes this to Int */
	if (Type==MisIntType) Type = IntType;
	Flags=Opnd->Flags;
	Areg=-1;
	*Clsh=*Opnd;
	Clsh->Type=Type;
	Clsh->Size=Size;
	if ((Form==DirVal)||(Form==TempVal)||(Form==ConstVal)||(Form==DirAddr)) {
		/*******************************************************/
		/** Load a Direct Reference to a Longint              **/
		/*******************************************************/
		*Cmsh=*Clsh;
		Cmsh->Offset=Clsh->Offset+Size;
	} else if (Form==IndRegVal) {
		*Cmsh=*Clsh;
		Cmsh->Form=IndRegModVal;
		Cmsh->Modform=LitVal;
		Cmsh->Modintval=Size;
		lockregister(Clsh->Reg,0,4);  /* lock address reg for two accesses */
		Areg=-2;
	} else if ((Form==IndRegModVal)&&(Clsh->Modform==LitVal)) {
		*Cmsh=*Clsh;
		Cmsh->Modintval=Cmsh->Modintval+Size;
		lockregister(Clsh->Reg,0,4);  /* lock address reg for two accesses */
		Areg=-2;
	} else if (Form==LitVal) {
		*Cmsh=*Clsh;
		Cmsh->Intvalue=Cmsh->Modintval;
	} else {
		/*******************************************************/
		/** Load an InDirect Reference to a Longint           **/
		/*******************************************************/
		/**/
		Caddress(Opnd);	/* load address            */
		Areg=LoadIntRO(Opnd);	/*         into a register */
		/**/
		lockregister(Areg,0,4)	/*avoid address reg being reused*/;
		/* until both parts have been accessed */
		memset(Clsh,0,sizeof( struct Stkfmt));
		Clsh->Form=IndRegVal;
		Clsh->Reg=Areg;
		Clsh->Size=Size;
		Clsh->Type=Type;
		Clsh->Flags=Flags;
		*Cmsh=*Clsh;
		Cmsh->Form=IndRegModVal;
		Cmsh->Modform=LitVal;
		Cmsh->Modintval=Size;
	}




	return Areg;

}	/* Cdivide longint  */
/***/
void Csplitdouble(struct Stkfmt *Lstk) {
	/*************************************************************************/
	/*  Turn a 64 bit integer into two 32 bit ones (MSH on top)              */
	/*************************************************************************/
	struct Stkfmt lsh, msh;
	int areg;

	areg=Cdividelongint(Lstk, &lsh, &msh);
	if (areg >= 0) {
       unlockreg(areg);
       unlockreg(areg);
       /* unlock once for the lock imposed by Cdividelongint and
       ** unlock again for the lock imposed by LoadIntRO called
       ** by Cdividelongint -- Cpushoperand below will reimpose
       ** a lock
       */
	} else if (areg==-2) {
		unlockreg(lsh.Reg);
		unlockreg(lsh.Reg);
	}
	Cpushoperand(&lsh);
	Cpushoperand(&msh);
}
/***/
/**************************************************************************/
/**                                                                      **/
/**            Support for 'Optimiser' Ecodes                            **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
int claimtgtreg() {
	/*************************************************************************/
	/** Returns integer target register if one has been allocated,          **/
	/** otherwise returns a claimed register.                               **/
	/*************************************************************************/
	struct Stkfmt Tstk;
	if (TargetReg>=0) {
		if (Elevel>0) {
			Tstk.Form=RegVal;
			Tstk.Type=IntType;
			Tstk.Reg=TargetReg;
			Tstk.Size=4;
			MCurrentvalue(&Tstk,Elevel);
		}
		return claimnamedtgt(TargetReg);
	} else {
		return claimreg();
	}
}	/* claim tgt reg    */
/***/
int claimtgtfreg() {
	/************************************************************************/
	/** Returns float register if one has been allocated, otherwise        **/
	/** returns a claimed float register.                                  **/
	/************************************************************************/
	struct Stkfmt Tstk;
	if (TargetFreg>=0) {
		if (Elevel>0) {
			Tstk.Form=FregVal;
			Tstk.Type=RealType;
			Tstk.Reg=TargetFreg;
			Tstk.Size=4;
			MCurrentvalue(&Tstk,Elevel);
		}
		return claimnamedtgt(TargetFreg);
	} else {
		return claimfreg();
	}
}	/* claim tgt freg   */
/***/
/***/
void Cstkregvar(int Creg,int Size,int Offset) {
	/*****************************************************************************/
	/** Create an Estack entry for a variable held in an FORTRAN or C optimiser **/
	/** register                                                                **/
	/*****************************************************************************/
	int Reg;

#if(Language==CCOMP) 
	Reg=CRegVarMap [Creg];

#else
	Reg=CregMap [Creg];

#endif
	Cstackr(Reg,Size);
	/*      Stk(Elevel)_Form=Regvar ! Regflag                                    */	/* Done in cstackr */
	if (Size>=4) {
		SetExtFlag(Reg,REGUNKNOWNEXT);
	} else {
		SetExtFlag(Reg,REGUNEXTENDED);
	}
	Stk [Elevel].Offset=Offset;
	/**/
}	/* Cstkregvar       */
/***/
void Cstkfregvar(int Cfreg,int Size) {
	/*****************************************************************************/
	/** Create an Estack entry for a variable held in an FORTRAN or C optimiser **/
	/** floating point register                                                 **/
	/*****************************************************************************/
	int Reg;

#if(Language==CCOMP) 
	Reg=CRegVarMap [Cfreg];

#else
	Reg=CfregMap [Cfreg];

#endif
	Cstackfr(Reg,Size);
	/*      Stk(Elevel)_Form= Fregvar ! Regflag                                  */	/* Done in cstackr */
	/**/
}	/* Cstkfregvar      */
/***/
void CregSTop(int Op,int ECFlag,struct Stkfmt *LHS,struct Stkfmt *RHS) {
	/*************************************************************************/
	/** Implement LHS(regvar) = LHS(regvar) Op RHS (IADDST,... etc)         **/
	/** We do this by setting the TargetReg to that of the RHS and then     **/
	/** calling C Int Binary Op.                                            **/
	/** If ECFlag is non-zero then we stack an E-stack entry giving the     **/
	/** result of the operation.                                            **/
	/*************************************************************************/
	struct Stkfmt DestStk;
	int Junk;

	/** Do the given operation, targetting the LHS register                      */
	DestStk=*LHS;
	TargetReg=LHS->Reg;
	TargetFreg=-1;
	FirstTarget=1;
	TargetDToS=0;
	CIntBinaryOp(Op,LHS,RHS,0);
	TargetReg=-1;

	/** Now store the result of the operation in the Regvar. This is             */
	/** normally a nop but serves to unlock the register(s) and is               */
	/** needed if OP calls a support procedure which disables the                */
	/** targetting.                                                              */
	Elevel-=1;
	Junk=Cstoreop(&DestStk,&Stk [Elevel+1],ECFlag);

}	/* CregSTop         */
/***/
void CFregSTop(int Op,int ECFlag,struct Stkfmt *LHS,struct Stkfmt *RHS) {
	/*************************************************************************/
	/** Implement LHS(Regvar) = LHS(regvar) Op RHS (RADDST,... etc)         **/
	/** We do this by setting the TargetFreg to that of the RHS and then    **/
	/** calling C Real Binary Op.                                           **/
	/** If ECFlag is non-zero then we stack an E-stack entry giving the     **/
	/** result of the operation.                                            **/
	/*************************************************************************/
	struct Stkfmt DestStk;
	int Junk;

	/** Do the given operation, targetting the LHS register                      */
	DestStk=*LHS;
	TargetReg=-1;
	TargetFreg=LHS->Reg;
	FirstTarget=1;
	TargetDToS=0;
	CRealBinaryOp(Op,LHS,RHS);
	TargetFreg=-1;

	/** Now store the result of the operation in the Fregvar. This is            */
	/** normally a nop but serves to unlock regsister(s) and is                  */
	/** needed if OP calls a support procedure which disables the                */
	/** targetting.                                                              */
	Elevel-=1;
	Junk=Cstoreop(&DestStk,&Stk [Elevel+1],ECFlag);

}	/* CFregSTOp        */
/***/
void CChangeContexts(int set,int unset) {
	/************************************************************************/
	/* Generate a CXTCHANGE type instruction to record the contexts being  **/
	/* set and/or unset.  Also set global flags to aid some code generator **/
	/* decisions.                                                          **/
	/************************************************************************/
	struct instrfmt *instr;

	instr=(struct instrfmt*)(BNewInstr());
	instr->group=CXTCHANGE;
	instr->u0.CXTset=set;
	instr->u1.CXTunset=unset;

	Contexts|=set;
	Contexts|=~unset;

}	/*CChangeContexts */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            conversions                                               **/
/**                                                                      **/
/**************************************************************************/
/***/
static void GenerateFloatConstants() {
	/*************************************************************************/
	/**  Two 64 bit constants and a work word are set up in the GLA         **/
	/**  The work word has the top part of 2**52 set the bottom empty       **/
	/*************************************************************************/
	static const int aa [2+1] = {
		0x127F1E7F,0x1A7F167F,
		0x3F000000	};
	Msetconst((int)&aa [0],8,&floatarea1,&floatoffset1);
	Msetconst((int)&aa [2],4,&floatarea2,&floatoffset2	/* make 0.5 poolable*/);
	/* works on USLC but consts become read only                                 */
}
/***/
static void Extendreg(int Oldreg,int Newreg,int Oldsize,int Newsize,int type) {
	/*************************************************************************/
	/** Sign or zero extends the register as appropiate. Newsize can not    **/
	/** be greater than the register size                                   **/
	/*************************************************************************/
	int mask,shift;
	if (type==UintType) {
		/* mask off top bite                                                         */
		mask=-1;
		if ((Oldsize==2)||(Newsize==2))  mask=0xFFFF;
		if ((Oldsize==1)||(Newsize==1))  mask=255;
		if (mask==-1)  return ;
		ARCH(oplit(AND,Oldreg,mask,Newreg));
		SetExtFlag(Newreg,REGUNSIGNEDEXT);	 
		return ;
	}
	/* we need to sign extend                                                    */
	if (Oldsize==2 && (MINCODESIZE!=0 || Oldreg!=Newreg)) {
		ARCH(rr(MOVSX,Oldreg,-1,Newreg));
		SetExtFlag(Newreg,REGSIGNEDEXT);	 
		return ;
	}
	if (Oldsize==1 && Oldreg<=3 && (MINCODESIZE!=0 || Oldreg!=Newreg)) {
		ARCH(rr(LB,Oldreg,-1,Newreg));
		SetExtFlag(Newreg,REGSIGNEDEXT);        
		return ;
	}
	shift=8*(4-Oldsize);
	ARCH(rlit(SHL,Oldreg,shift,Newreg));
	ARCH(rlit(SAR,Newreg,shift,Newreg));
	SetExtFlag(Newreg,REGSIGNEDEXT);
}
/***/
void ConvertRR(struct Stkfmt *Stk,int Newsize) {
	/****************************************************************/
	/** converts between real sizes                                **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	int form,freg1,bytes;
	struct Stkfmt Tstk;


	form=Stk->Form&31;
	bytes=Stk->Size;
	if ((Stk->Size==Newsize)&&((Newsize>4)||((cgoptions&RNDSNGL)==0)||(form!=FregVal))) {
		Elevel+=1;
	} else {
		if ((Stk->Form&31)!=FregVal) {
			freg1=LoadRealRO(Stk,bytes);
			unlockreg(freg1);
			Cstackfr(freg1,Newsize);
		} else {
			Elevel+=1;
			Stk->Size=Newsize;
		}
		if (Newsize==4) {
			/*            %IF convarea=0 %THEN convarea=epermspace(4,4)                  */
			/*            Gladir(Tstk,convarea,4)                                        */
			convarea=ARCH(tempspace(4,4));
			StkTemp(&Tstk,convarea,4);
			ARCH(oprx(FSTPm,currentFSP,&Tstk,DESTSTORE));
			ARCH(modinstrprops(DESTROYABLE,0,0,PRECISIONREDN));
			ARCH(oprx(FLDm,currentFSP,&Tstk,DESTREG));
			ARCH(modinstrprops(DESTROYABLE,0,0,PRECISIONREDN));
		}
	}
}	/* Convert RR       */
/***/
void ConvertRI(struct Stkfmt *Lstk,int Newsize,int Mode) {
	/****************************************************************/
	/** converts between real and integer                          **/
	/** Mode = 0   TNC (ie truncate towards zero)                  **/
	/**        1   RND (ie the nearest integer)                    **/
	/**        2   FLOOR (ie Truncate towards minus infinity)      **/
	/**        3   CEIL  (ie Truncate towards plus  infinity)      **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	int op,bytes,wreg3,j;
	struct instrfmt *curinstr;
	struct Stkfmt Tstk;


	bytes=Lstk->Size;
	if (floatarea1<=0)  GenerateFloatConstants();
	if ((bytes==4)&&((cgoptions&RNDSNGL)!=0)) {
		curinstr=BCurInstr();
		if ((curinstr->privprops&PRECISIONREDN)==0) {
			ConvertRR(Lstk,4);
			Elevel-=1;
		}
	}
	if (Mode==1) {
		ConvertRIR(Lstk,1)	/* Deal with exact halfs correctly */;
		wreg3=currentFSP;
		Elevel-=1;
	} else {
		ARCH(opr(PUSH,EAX));	/* make space                                          */
		ARCH(fopmem(FSTCW,ESP,0,2));	/* Save current mode                           */
		wreg3=LoadRealRW(Lstk,-1,bytes);
		ARCH(fopfixmem(FLDCW,floatarea1,floatoffset1+(2*Mode),2));	/* Force right rounding mode*/
	}
	op=FISTP;
	if (Newsize==8) {
		j=ARCH(tempspace(8,8));
		op=FISTPd;
	} else {
/*		j=ARCH(tempspace(4,4));	*/
		/* last line commented out and two new lines added due to chip bug on P6 */
		/* bug does dot affect the double store so store double but use lower 32 bits */
		j=ARCH(tempspace(8,8));
		op=FISTPd;
	}
	StkTemp(&Tstk,j,Newsize);
	ARCH(oprx(op,0,&Tstk,DESTSTORE));
	CheckConflict(STACK,j,8);
	Tstk.Type=Intval;
	Cpushoperand(&Tstk);
	unlockreg(wreg3);
	if (Mode!=1) {
		ARCH(fopmem(FLDCW,ESP,0,2));	/* Back to original rounding                   */
		ARCH(rlit(ADD,ESP,4,ESP));
	}
}	/* Convert RI       */
/***/
void ConvertRU(struct Stkfmt *SStk,int Newsize) {
	/*****************************************************************/
	/** converts between real and unsigned integer                  **/
	/** descriptor to result on Estack                              **/
	/** On SPARC, works by using clib.a __ftou and __fdou.          **/
	/** These are envoked by the routine Mexpcall.                  **/
	/*****************************************************************/
	int reg,j;
	double Two63;
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	struct Stkfmt Tstk;
	Two63=256.0*256.0*256.0*256.0*256.0*256.0*256.0*128.0;
	if (floatarea1<=0)  GenerateFloatConstants();
	TargetReg=-1;	/* Ensure no more targetting as we may now be */
	TargetFreg=-1;	/* doing a nested call                        */
	enotecc(-1);	/* Notify EMachine that cond codes changed    */
	ARCH(opr(PUSH,EAX));	/* make space                                          */
	ARCH(fopmem(FSTCW,ESP,0,2));	/* Save current mode                           */
	if (Newsize==8) {
		Elevel+=1;
		estkrconst(8,(int)&Two63);
		if (SStk->Size!=8) {
			estklit(SStk->Size); eop(CVTRR);
		}
		eop(RSUB);
		Elevel-=1;
		ARCH(fopfixmem(FLDCW,floatarea1,floatoffset1,2))	/* Force to rnd to zero */;
	} else {
		ARCH(fopfixmem(FLDCW,floatarea1,floatoffset1+4,2))	/* Force to rnd dowm to -inf */;
	}
	reg=LoadRealRW(SStk,-2,SStk->Size);
	j=ARCH(tempspace(8,8));
	StkTemp(&Tstk,j,8);
	ARCH(oprx(FISTPd,0,&Tstk,DESTSTORE));
	CheckConflict(STACK,j,8);
	unlockreg(currentFSP);
	StkTemp(&Tstk,j,Newsize)	/*ls Newsize bytes */;
	Tstk.Type=UintType;
	if (Newsize==8)  {
		reg=claimreg();
		ARCH(loadri(LW,EBP,Tstk.Offset+4,reg));
		ARCH(oplit(XOR,reg,0x80000000,reg));
		ARCH(storeri(ST,reg,EBP,Tstk.Offset+4));
		unlockreg(reg);
	}
	Cpushoperand(&Tstk);
	ARCH(fopmem(FLDCW,ESP,0,2));	/* Back to original rounding                   */
	ARCH(rlit(ADD,ESP,4,ESP));
}	/* Convert RU       */
/***/
void ConvertRIR(struct Stkfmt *Rstk,int Mode) {
	/****************************************************************/
	/** converts between real and integer leaving the result real  **/
	/** Mode = 0   TNCRR (ie truncate towards zero)                **/
	/**        1   RNDRR (ie the nearest integer)                  **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	int bytes,reg,regi,lab1,lab2,Index1,Index2;
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	bytes=Rstk->Size;
	if (floatarea1<=0)  GenerateFloatConstants();
	ARCH(opr(PUSH,EAX));	/* make space                                          */
	ARCH(fopmem(FSTCW,ESP,0,2));	/* Save current mode                           */
	ARCH(fopfixmem(FLDCW,floatarea1,floatoffset1,2));	/* Force round to zero mode*/
	reg=LoadRealRW(Rstk,-1,bytes);
	if (Mode==1) {
		/* Round to nearest even does not deal with 0.5                              */
		/* correctly 50 of the time so must struggle                                 */
		ARCH(oponly(FTST,0,0));
		regi=claimnamedreg(EAX);
		lab1=Mprivatelabel();
		lab2=Mprivatelabel();
		Index1=BLocateLabel(lab1+Labadjust,0);
		Index2=BLocateLabel(lab2+Labadjust,0);
		ARCH(oponly(FSTSW,1<<EAX,0))	/* in AX*/;
		ARCH(oplit(TEST,EAX,0x100,EAX));
		ARCH(bcctf(JZ<<16,Index1,0));
		ARCH(fopfixmem(FSUBm,floatarea2,floatoffset2,4));
		ARCH(bcctf(JMP<<16,Index2,0));
		eplabel(lab1);
		ARCH(fopfixmem(FADDm,floatarea2,floatoffset2,4));
		eplabel(lab2);
		unlockreg(EAX);
	}
	ARCH(oponly(FRNDINT,0,0));
	Cstackfr(reg,bytes);
	ARCH(fopmem(FLDCW,ESP,0,2));	/* Back to original rounding                   */
	ARCH(rlit(ADD,ESP,4,ESP));
}	/* Convert RIR      */
/***/
void ConvertIR(struct Stkfmt *Stk1,int Newsize) {
	/****************************************************************/
	/** converts integer to real                                   **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	int op,form,reg,j,oldsize;
	struct Stkfmt Lstk;
	double x;
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/

	if (Stk1->Size<4) {
		ConvertII(Stk1,4);
		Elevel-=1;	/*assume Stk1 points to result of Convert II*/
	}

	oldsize=Stk1->Size;
	form=Stk1->Form&31;
	if ((Language!=PASCAL)&&(form==LitVal)&&(Newsize<=8)&&(oldsize==4)) {
		if (Newsize==8)  x=(double)Stk1->Intvalue; 
		else (*(float  *)((int)&x))=(double)Stk1->Intvalue;
		estkrconst(Newsize,(int)&x);

		/*Note: PASCAL only converts a LitVal to a Real when cross-compiling         */
		/*      and under these circumstances the conversion is performed            */
		/*      at runtime to allow for the case when the host and target            */
		/*      support different notations for reals                                */
	} else {
		/**/
		enotecc(-1);
		if (oldsize==8 && 
			(form==RegVal || form==FregVal) &&
			Stk1->Reg==currentFSP) {
		    reg = currentFSP;
		} else {
		    if (oldsize==8)  op=FILDd; 
		    else op=FILD;
		    if ((form==RegVal)||(form==Regvar)||((Stk1->Flags&STKSWOPPED)!=0)||
			    (IsAddrForm[form]!=0)) 	/* Intreg => freg via store only */{

			    j=ARCH(tempspace(oldsize,(oldsize==8? 8 : 4)));
			    StkTemp(&Lstk,j,oldsize);
			    Elevel+=1;
			    Cpushoperand(&Lstk);
			    eop(ESTORE);
		    	reg=claimfreg();
			    ARCH(oprx(op,reg,&Lstk,DESTREG));
		    } else {
		    	reg=claimfreg();
			    ARCH(oprx(op,reg,Stk1,DESTREG));
		    }
		}
		unlockreg(reg);
		Cstackfr(reg,Newsize);
	}
}	/* Convert IR       */
/***/
void ConvertUR(struct Stkfmt *Stk1,int Newsize) {
	/****************************************************************/
	/** converts unsigned integer to real                          **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	int reg,form;
	struct Stkfmt Msh,Lsh;
	double Two32;
	double x;
	float y;

	Two32=256.0*256.0*256.0*256.0;
	if (Stk1->Size<4) {
		ConvertUU(Stk1,4);
		Elevel-=1;	/* remove result of Convert UU from Estk */
	}

	form=Stk1->Form&31;
	if ((Language!=PASCAL)&&(form==LitVal)&&(Newsize<=8)&&(Stk1->Size==4)) {
		if (Newsize==8) {
			if (Stk1->Intvalue<0) {
				x=(double)(Stk1->Intvalue+1);
				x=(x)+((double)((unsigned)0xFFFFFFFF));
			} else {
				x=(double)Stk1->Intvalue;
			}
			estkrconst(8,(int)&x);
		} else {
			if (Stk1->Intvalue<0) {
				x=(double)(Stk1->Intvalue+1);
				y=(x)+((double)((unsigned)0xFFFFFFFF));
			} else {
				y=(double)Stk1->Intvalue;
			}
			estkrconst(4,(int)&y);
		}
	} else {

		/**/
		/* the following inline code is pds patent float needs tests with -Maxint    */
		/**/
		if (Stk1->Size==8) 	/* integer*8 to real */{
			reg=Cdividelongint(Stk1,&Lsh,&Msh);
			if (reg>=0) {
				unlockreg(reg); unlockreg(reg);
			} else if (reg==(-2)) {
				
				unlockreg(Lsh.Reg); unlockreg(Lsh.Reg);
			}
			Cpushoperand(&Msh);
			Cpushoperand(&Lsh);
			estklit(8);	/* Float LSH as unsigned */
			eop(CVTUR);
			eop(EXCH);	/* Float MSH */
			estklit(8);	 
			eop(CVTUR);
			estkrconst(8,(int)&Two32);
			eop(RMULT);	/* Result=MSH*2**32+LSH  */
			eop(RADD);
		} else {
			reg=claimreg();
			ARCH(rr(XOR,reg,reg,reg));
			ARCH(opr(PUSH,reg));
			unlockreg(reg);
			reg=LoadIntRO(Stk1);
			ARCH(opr(PUSH,reg));
			unlockreg(reg);
			reg=claimfreg();
			ARCH(fopmem(FILDd,ESP,0,8));
			unlockreg(reg);
			Cstackfr(reg,Newsize);
			ARCH(rlit(ADD,ESP,8,ESP));
		}
	}
}	/* Convert UR       */
/***/
void ConvertSBI(struct Stkfmt *SStk,int Newsize) {
	/****************************************************************/
	/** converts a signed byte to integer                          **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	SStk->Size=1;
	ConvertII(SStk,Newsize);
}	/* Convert SBI      */
/***/
void ConvertII(struct Stkfmt *Lstk,int Newsize) {
	/****************************************************************/
	/** converts between integer sizes                             **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	int Form,Reg,j;
	struct Stkfmt Tstk;
#if(Language==CCOMP)
	int MinSize;
#endif

	Form=Lstk->Form&31;
	if (((Lstk->Flags&STKSWOPPED)==0)&&(IsDomAccessForm [Form]!=0)&&((Newsize<=Lstk->Size)&&(Lstk->Size
	    <=4))) {
		Elevel+=1;
		Stk [Elevel].Size=Newsize;
		Stk [Elevel].Type=IntType;
		return ;
	}
	if (Form==LitVal) {

#if(Language==CCOMP) 

		/* In C and C++ we must do an explicit sign extension for LitVals */
		if (Lstk->Size<Newsize) {
			MinSize=Lstk->Size<<3;
		} else {
			MinSize=Newsize<<3;
		}
		if (MinSize<32) {
			if ((Lstk->Intvalue&(1<<(MinSize-1)))==0) {
				Lstk->Intvalue=Lstk->Intvalue&((1<<MinSize)-1);
			} else {
				Lstk->Intvalue=Lstk->Intvalue|(-(1<<MinSize));
			}
		}


#endif
		if (Newsize==8) {
		    /* propagate sign into Modintval field */
		    if (Lstk->Intvalue < 0)
			Lstk->Modintval = -1;
		    else
			Lstk->Modintval = 0;
		}
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
		/* Short Regvars are  kept appropiately extended */
	} else if ((Form==Regvar)&&(Newsize==4)) {
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
	} else {
		Lstk->Type=IntType;
		if (Newsize>=Lstk->Size) {
			if (Newsize==8) {
				if (Lstk->Size==8) {Cpushoperand(Lstk); return;}
				j=ARCH(tempspace(8,8));
				StkTemp(&Tstk,j,4);
				Tstk.Type=IntType;
				Reg=claimreg();
				unlockreg(Reg);
				Reg=LoadIntRW(Lstk,Reg);
				unlockreg(Reg);	/* load will have locked it */
				ARCH(oprx(ST,Reg,&Tstk,DESTSTORE));
				ARCH(rlit(SAR,Reg,31,Reg));
				forgetreg(Reg);
				Tstk.Offset=Tstk.Offset+4;
				ARCH(oprx(ST,Reg,&Tstk,DESTSTORE));
				Tstk.Offset=Tstk.Offset-4;
				Tstk.Size=8;
				Cpushoperand(&Tstk);
				return ;
			} else {
				if (TargetReg>=0) {
					Reg=LoadIntTgt(Lstk);
				} else {
					Reg=LoadIntRO(Lstk);
				}
			}
		} else if (Lstk->Size==8) {
			if (Form==RegVal || Form==FregVal) {
			    j=ARCH(tempspace(8,8));
			    StkTemp(&Tstk,j,8);
			    Tstk.Type=IntType;
			    Reg=LoadIntRW(Lstk, -1);
			    unlockreg(Reg);
			    ARCH(oprx(FISTPd, 0, &Tstk, DESTSTORE));
			    CheckConflict(STACK, j, 8);
			    Tstk.Type=IntType;
			    Tstk.Size=Newsize;
			    Cpushoperand(&Tstk);
			    return;
			} else {
			    Cdiscardopnd(Lstk);
			    Lstk->Size=Newsize;
			    Cpushoperand(Lstk);
			}
			return ;
		} else if ((Form==Regvar)&&(Newsize<4)) {
			Reg=LoadIntRWNoExt(Lstk,-1);
			Extendreg(Reg,Reg,Newsize,Lstk->Size,IntType);
		} else {
			if (TargetReg>=0) {
				if ((SimpleRegForm [Form]==0)||(Lstk->Reg!=TargetReg)) {
					Reg=claimnamedtgt(TargetReg);
				}
				Reg=LoadIntGeneral(Lstk,TargetReg,0,2);
			} else {
				Reg=LoadIntRONoExt(Lstk);
			}
			SetExtFlag(Reg,REGUNEXTENDED);
		}


		Cstackr(Reg,Newsize);
	}

	Stk [Elevel].Type=IntType;
}	/* Convert II       */
/***/
void ConvertIU(struct Stkfmt *Lstk,int Newsize) {
	/****************************************************************/
	/** converts between signed and unsigned integers              **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/
	int OldReg,reg,j,NewReg,Form,Oldsize;
	struct Stkfmt Tstk;
	Form=Lstk->Form&31;
	Oldsize=Lstk->Size;
	if (((Lstk->Flags&STKSWOPPED)==0)&&(IsDomAccessForm [Form]!=0)&&((Newsize<=Oldsize)&&(Oldsize<=4))) {
		Elevel+=1;
		Stk [Elevel].Size=Newsize;
		Stk [Elevel].Type=UintType;
		return ;
	}
	if (Form==LitVal) {
		if (Oldsize<4) {
			if ((Lstk->Intvalue&(1<<((Oldsize<<3)-1)))==0) {
				Lstk->Intvalue=Lstk->Intvalue&((1<<(Oldsize<<3))-1);
			} else {
				Lstk->Intvalue=Lstk->Intvalue|(-(1<<(Oldsize<<3)));
			}
		}
		if (Newsize<4)  Lstk->Intvalue=Lstk->Intvalue&((1<<(Newsize<<3))-1);
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
		/* Short Regvars are  kept appropiately extended */
	} else if ((Form==Regvar)&&(Newsize==4)) {
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
	} else {
		Lstk->Type=IntType;
		if (Newsize>Oldsize) {
			if (Newsize==8) {
				j=ARCH(tempspace(8,8));
				StkTemp(&Tstk,j,4);
				Tstk.Type=IntType;
				reg=claimreg();
				unlockreg(reg);
				reg=LoadIntRW(Lstk,reg);
				if (Oldsize<4) {
					Extendreg(reg,reg,Oldsize,4,IntType);
				}
				unlockreg(reg);	/* load will have locked it */
				ARCH(oprx(ST,reg,&Tstk,DESTSTORE));
				ARCH(rr(XOR,reg,reg,reg));
				Tstk.Offset=Tstk.Offset+4;
				ARCH(oprx(ST,reg,&Tstk,DESTSTORE));
				Tstk.Offset=Tstk.Offset-4;
				Tstk.Size=8;
				Cpushoperand(&Tstk);
				return ;
			} else if (SimpleRegForm [Lstk->Form&31]!=0) {
				OldReg=LoadIntRONoExt(Lstk);
				NewReg=claimtgtreg();

				Extendreg(OldReg,NewReg,Oldsize,4,IntType);
				if (Newsize<4) {
					Extendreg(NewReg,NewReg,4,Newsize,UintType);
				}

				unlockreg(OldReg);
			} else if (Newsize<4) {
				OldReg=LoadIntRONoExt(Lstk);
				NewReg=claimtgtreg();
				ARCH(oplit(AND,OldReg,((1<<(Newsize<<3))-1),NewReg));
				unlockreg(OldReg);
			} else {
				if (TargetReg>=0)  NewReg=LoadIntTgt(Lstk); 
				else NewReg=LoadIntRO(Lstk);
			}



			SetExtFlag(NewReg,REGUNSIGNEDEXT);
		} else if (Lstk->Size==8) {
                        if (Form==RegVal || Form==FregVal) {
                            j=ARCH(tempspace(8,8));
                            StkTemp(&Tstk,j,8);
                            Tstk.Type=IntType;
                            reg=LoadIntRW(Lstk, -1);
                            unlockreg(reg);
                            ARCH(oprx(FISTPd, 0, &Tstk, DESTSTORE));
                            CheckConflict(STACK, j, 8);
                            Tstk.Type=IntType;
                            Tstk.Size=Newsize;
                            Cpushoperand(&Tstk);
                            return;
                        }
			Cdiscardopnd(Lstk);
			Lstk->Size=Newsize;
			Cpushoperand(Lstk);
			return ;
		} else if ((Form==Regvar)&&(Newsize<4)) {
			NewReg=LoadIntRWNoExt(Lstk,-1);
			Extendreg(NewReg,NewReg,Newsize,4,UintType);
		} else {
			if (TargetReg>=0) {
				if ((SimpleRegForm [Form]==0)||(Lstk->Reg!=TargetReg)) {
					NewReg=claimnamedtgt(TargetReg);
				}
				NewReg=LoadIntGeneral(Lstk,TargetReg,0,2);
			} else {
				NewReg=LoadIntRONoExt(Lstk);
			}
			SetExtFlag(NewReg,REGUNEXTENDED);
		}


		Cstackr(NewReg,Newsize);
	}

	Stk [Elevel].Type=UintType;
}	/* Convert IU       */
/**/
/***/
void ConvertUI(struct Stkfmt *Lstk,int Newsize) {
	/****************************************************************/
	/** converts unsigned integer to integer                       **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	int Form,OldReg,reg,j,NewReg,Oldsize;
	struct Stkfmt Tstk;
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/

	Form=Lstk->Form&31;
	Oldsize=Lstk->Size;
	if (((Lstk->Flags&STKSWOPPED)==0)&&(IsDomAccessForm [Form]!=0)&&
		(Newsize<=Oldsize && Oldsize<=4)) {
		Elevel+=1;
		Stk [Elevel].Size=Newsize;
		Stk [Elevel].Type=IntType;
		return ;
	}
	if (Form==LitVal) {
		if (Oldsize<4)  Lstk->Intvalue=Lstk->Intvalue&((1<<(Oldsize<<3))-1);
		if (Newsize<4) {
			if ((Lstk->Intvalue&(1<<((Newsize<<3)-1)))==0) {
				Lstk->Intvalue=Lstk->Intvalue&((1<<(Newsize<<3))-1);
			} else {
				Lstk->Intvalue=Lstk->Intvalue|(-(1<<(Newsize<<3)));
			}
		}
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
		/* Short Regvars are  kept appropiately extended */
	} else if ((Form==Regvar)&&(Newsize==4)) {
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
	} else {
		Lstk->Type=UintType;
		if (Newsize>Oldsize) {
			if (Newsize==8) {
				j=ARCH(tempspace(8,8));
				StkTemp(&Tstk,j,4);
				Tstk.Type=IntType;
				reg=claimreg();
				unlockreg(reg);
				reg=LoadIntRW(Lstk,reg);
				if (Oldsize<4) {
					Extendreg(reg,reg,Oldsize,4,UintType);
				}
				unlockreg(reg);	/* load will have locked it */
				ARCH(oprx(ST,reg,&Tstk,DESTSTORE));
				ARCH(rr(XOR,reg,reg,reg));
				Tstk.Offset=Tstk.Offset+4;
				ARCH(oprx(ST,reg,&Tstk,DESTSTORE));
				Tstk.Offset=Tstk.Offset-4;
				Tstk.Size=8;
				Cpushoperand(&Tstk);
				return ;
			} else if (SimpleRegForm [Lstk->Form&31]!=0) {
				OldReg=LoadIntRONoExt(Lstk);
				NewReg=claimtgtreg();
				ARCH(oplit(AND,OldReg,((1<<(Oldsize<<3))-1),NewReg));
				unlockreg(OldReg);
				SetExtFlag(NewReg,REGSIGNEDEXT);
			} else {
				NewReg=LoadIntRO(Lstk);
			}

		} else if (Oldsize==8) {
			Cdiscardopnd(Lstk);
			Lstk->Size=Newsize;
			Cpushoperand(Lstk);
			return ;
		} else if ((Form==Regvar)&&(Newsize<4)) {
			NewReg=LoadIntRWNoExt(Lstk,-1);
			Extendreg(NewReg,NewReg,Lstk->Size,Newsize,UintType);
		} else {
			if (TargetReg>=0) {
				if ((SimpleRegForm [Form]==0)||(Lstk->Reg!=TargetReg)) {
					NewReg=claimnamedtgt(TargetReg);
				}
				NewReg=LoadIntGeneral(Lstk,TargetReg,0,2);
			} else {
				NewReg=LoadIntRONoExt(Lstk);
			}
			SetExtFlag(NewReg,REGUNEXTENDED);
		}


		Cstackr(NewReg,Newsize);
	}

	Stk [Elevel].Type=IntType;
}	/* Convert UI       */
/***/
void ConvertUU(struct Stkfmt *Lstk,int Newsize) {
	/****************************************************************/
	/** converts unsigned integer to unsigned integer              **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	int Reg,j,Form,MinSize;
	struct Stkfmt Tstk;
	/**/
	/* Warning the code in this convert routine appears to make the hidden       */
	/*assumption that the operand is also at ESTK(ELEVEL+1) !!!                  */
	/**/

	Form=Lstk->Form&31;
	if (((Lstk->Flags&STKSWOPPED)==0)&&(IsDomAccessForm [Form]!=0)&&((Newsize<=Lstk->Size)&&(Lstk->Size
	    <=4))) {
		Elevel+=1;
		Stk [Elevel].Size=Newsize;
		Stk [Elevel].Type=UintType;
		return ;
	}
	if (Form==LitVal) {
		if (Lstk->Size<Newsize) {
			MinSize=Lstk->Size<<3;
		} else {
			MinSize=Newsize<<3;
		}
		if (MinSize<32)  Lstk->Intvalue=Lstk->Intvalue&((1<<MinSize)-1);
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
		/* Short Regvars are  kept appropiately extended */
	} else if ((Form==Regvar)&&(Newsize==4)) {
		Lstk->Size=Newsize;
		Cpushoperand(Lstk);
	} else {
		Lstk->Type=UintType;
		if (Newsize>=Lstk->Size) {
			if (Newsize==8) {
				j=ARCH(tempspace(8,8));
				StkTemp(&Tstk,j,4);
				Tstk.Type=UintType;
				Reg=claimreg();
				unlockreg(Reg);
				Reg=LoadIntRW(Lstk,Reg);
				unlockreg(Reg);	/* load will have locked it */
				ARCH(oprx(ST,Reg,&Tstk,DESTSTORE));
				ARCH(rr(XOR,Reg,Reg,Reg));
				Tstk.Offset=Tstk.Offset+4;
				ARCH(oprx(ST,Reg,&Tstk,DESTSTORE));
				Tstk.Offset=Tstk.Offset-4;
				Tstk.Size=8;
				Cpushoperand(&Tstk);
				return ;
			} else {
				if (TargetReg>=0) {
					Reg=LoadIntTgt(Lstk);
				} else {
					Reg=LoadIntRO(Lstk);
				}
			}
		} else if (Lstk->Size==8) {
			Cdiscardopnd(Lstk);
			Lstk->Size=Newsize;
			Cpushoperand(Lstk);
			return ;
		} else if ((Form==Regvar)&&(Newsize<4)) {
			Reg=LoadIntRWNoExt(Lstk,-1);
			Extendreg(Reg,Reg,Lstk->Size,Newsize,UintType);
		} else {
			if (TargetReg>=0) {
				if ((SimpleRegForm [Form]==0)||(Lstk->Reg!=TargetReg)) {
					Reg=claimnamedtgt(TargetReg);
				}
				Reg=LoadIntGeneral(Lstk,TargetReg,0,2);
			} else {
				Reg=LoadIntRONoExt(Lstk);
			}
			SetExtFlag(Reg,REGUNEXTENDED);
		}


		Cstackr(Reg,Newsize);
	}

	Stk [Elevel].Type=UintType;
}	/* Convert UU       */
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            store access                                              **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
int LoadIntTgt(struct Stkfmt *Stk) {
	/*************************************************************************/
	/** Attempts to load a copy of an Estack entry into the current target  **/
	/** register. If no target is set then the routine has the same effect  **/
	/** as Load Int RW.                                                     **/
	/*************************************************************************/
	int Reg;

	if (TargetReg>=0) {
		if (!((registerstatus(TargetReg)==1)&&(((IsRegForm [Stk->Form&31]!=0)&&(Stk->Reg==TargetReg))||((IsModForm
		    [Stk->Form&31]!=0)&&(SimpleRegForm [Stk->Modform&31]!=0)&&(Stk->Modreg==TargetReg)))))  Reg=claimnamedtgt
		(TargetReg);
		return LoadIntGeneral(Stk,TargetReg,1,2);
	}
	return LoadIntRW(Stk,-1);

}	/* Load Int Tgt     */
/***/
int LoadIntRO(struct Stkfmt *Stk) {
	/*************************************************************************/
	/** Creates a read only copy of the Estack entry in a register. If the  **/
	/** Estack entry represents a Regvar then the number of the Regvar      **/
	/** register is returned, otherwise the effect is the same as           **/
	/** Load Int RW. The return register is extended to the full 32 bits.   **/
	/*************************************************************************/
	int Form;
	Form=Stk->Form&31;
	if ((Form==RegVal || Form==Regvar || Form==RegAddr) &&
		(Stk->Size>=4 || 
		   (Stk->Type==IntType && GetExtFlag(Stk->Reg)==REGSIGNEDEXT) ||
		   (Stk->Type==UintType && GetExtFlag(Stk->Reg)==REGUNSIGNEDEXT))) {
		lockreg(Stk->Reg);
		return Stk->Reg;
	}
	return LoadIntGeneral(Stk,-1,1,0);
}	/* Load Int RO      */
int LoadIntValueRO(int value) {
	/*************************************************************************/
	/**     Loads a value into a register. Same as xx loadLit but does some **/
	/**   optimisations in Load Int General                                 **/
	/*************************************************************************/
	struct Stkfmt Tstk;
	Tstk=LitOne;
	Tstk.Intvalue=value;
	return LoadIntGeneral(&Tstk,-1,1,0);
}	/* Load Int Value RO*/
/***/
int LoadIntRONoExt(struct Stkfmt *Stk) {
	/*************************************************************************/
	/** Creates a read only copy of the Estack entry in a register.         **/
	/** The register is not implicitly extended to full 32 bits width.      **/
	/*************************************************************************/
	int Form;
	Form=Stk->Form&31;
	if ((Form==RegVal)||(Form==Regvar)||(Form==RegAddr)) {
		lockreg(Stk->Reg);
		return Stk->Reg;
	} else {
		return LoadIntGeneral(Stk,-1,0,0);
	}
}	/* Load Int RO NoExt*/
/***/
int LoadIntRW(struct Stkfmt *Stk,int Reg) {
	/*************************************************************************/
	/** Creates a read/write copy of the Estack entry in a register. The    **/
	/** register is extended to the full 32 bits width.                     **/
	/*************************************************************************/
	if (((Stk->Form&31)==RegVal)&&(Stk->Size==4)&&(Reg<0)&&(Stk->Reg<FRBASE)&&(registerstatus(Stk->Reg)
	    <=1)) {
		CleanRegister(Stk->Reg,4);
		return Stk->Reg;
	}
	return LoadIntGeneral(Stk,Reg,1,1);
}	/* Load Int RW      */
/***/
int LoadIntRWNoExt(struct Stkfmt *Stk,int Reg) {
	/*************************************************************************/
	/** Creates a read/write copy of the Estack entry in a register. The    **/
	/** register is not implicitly extended to the full 32 bits width.      **/
	/*************************************************************************/
	if (((Stk->Form&31)==RegVal)&&(Reg<0)&&(Stk->Reg<FRBASE)&&(registerstatus(Stk->Reg)<=1)) {
		CleanRegister(Stk->Reg,4);
		return Stk->Reg;
	}
	return LoadIntGeneral(Stk,Reg,0,1);
}	/* Load Int RW NoExt*/
/***/
int LoadIntGeneral(struct Stkfmt *Stk,int Reg,int ExtFlag,int IsRW) {
	/*************************************************************************/
	/** Stk describes an integer or real*4 value (1,2 or 4 bytes).          **/
	/** If Reg is >= 0 then this integer register must be loaded.           **/
	/** Result is the integer register to which the value has been loaded.  **/
	/** If the Estack entry represents a Regvar then a copy of the Regvar   **/
	/** is created in a scratch register.                                   **/
	/** This routine also does extension of any item less than 32 bits wide **/
	/** if ExtFlag#0 and the item has not already been marked as extended   **/
	/** in extflag.                                                         **/
	/** If IsRW is non-zero then the routine only returns a previously      **/
	/** unlocked register as a result. If IsRW is 1 then the register has   **/
	/** its tracking erased.                                                **/
	/*************************************************************************/
	int Bytes,SourceReg,Form,Value,type,Key,ReqDisp,Exten,SType,Base;
	int Offset,KeyData1,KeyData2,KeyRW,ReqReg,Flags;

	Form=Stk->Form&31;
	Bytes=Stk->Size;
	Base=Stk->Base;
	Offset=Stk->Offset;
	Flags=Stk->Flags;
	ReqReg=Reg;	/* Save original request */

	if (Bytes>4) {
	    /* involves a 64-bit int in a FP register -- call LoadRealGeneral() */
		Stk->Type = IntType;
	    return LoadRealGeneral(Stk, Reg, Bytes, IsRW);
	}

	if (SimpleRegForm [Form]!=0) {
		if (Bytes>4)  Mabort(12);
		if ((Bytes<4)&&(ExtFlag!=0)&&(Form!=Regvar)&&(GetExtFlag(Stk->Reg)==REGUNEXTENDED)) 	/*held extended*/{
			if (Stk->Reg>=FRBASE)  Mabort(25);
			/*******************************************/
			/* We need to extend this signed register **/
			/*******************************************/
			if (Reg<0) {
				if (registerstatus(Stk->Reg)<=1)  Reg=Stk->Reg; 
				else Reg=claimreg();
			} else CleanRegister(Reg,4);
			Extendreg(Stk->Reg,Reg,Bytes,4,Stk->Type);
			if (Stk->Reg!=Reg)  unlockreg(Stk->Reg);
			return Reg;
		}

		if (Reg<0)  Reg=claimreg();
		SourceReg=Stk->Reg;
Rcopy:

		/*****************************************************/
		/* Copy from SourceReg to Reg                       **/
		/*****************************************************/
		if (IsRW!=0)  CleanRegister(Reg,4); 
		else CopyRegMemory(SourceReg,Reg);

		if (SourceReg<FRBASE) {
			if (SourceReg!=Reg)  ARCH(copyireg(SourceReg,Reg));
		} else {
			Mabort(25);
		}

		if (Reg!=SourceReg)  unlockreg(SourceReg);
		SetExtFlag(Reg,GetExtFlag(SourceReg));
		return Reg;

	}

	if ((Form==LitVal)||(Form==Flitval)) {
		/************************************************************/
		/* Load a real or integer constant into an integer register                  */
		/************************************************************/
		Value=Stk->Intvalue;
		if ((Reg<0)||(Value<-32768)||(Value>32767)) {
                        SourceReg=CheckRegKey(CONSTINT,Value,0,4,IsRW);
                        if (SourceReg>=0) {
                                if (Reg>=0)  goto Rcopy;
                                if (IsRW==1)  CleanRegister(SourceReg,4);
                                SetExtFlag(SourceReg,REGSIGNEDEXT);
                                return SourceReg;
                        }
                }
                if ((Value<-32768)||(Value>32767)) {
			  if (SourceReg>=0) {
                        SourceReg=CheckCloseConst(Value,&ReqDisp);
				if (Reg<0)  Reg=claimreg(); 
				else CleanRegister(Reg,4);
				/**/
				ARCH(rlit(ADD,SourceReg,ReqDisp,Reg));
				if (IsRW!=1)  setregmemory(Reg,CONSTINT,Value,0,Bytes,0);
				SetExtFlag(Reg,REGSIGNEDEXT);
				return Reg;
			}
		}
		if (Reg<0)  Reg=claimreg(); 
		else CleanRegister(Reg,4);

		/*****************************************************/
		/* load literal to Reg                              **/
		/*****************************************************/
		ARCH(loadlit(Value,Reg));
		/**/
		/* the value x'7fff' is used as a dummy by estkmarker and can not be         */
		/* set in register memeory since it will be patched int a different value    */
		/**/
		if ((IsRW!=1)&&(Value!=0x7FFF))  setregmemory(Reg,CONSTINT,Value,0,Bytes,0);
		SetExtFlag(Reg,REGSIGNEDEXT);
		return Reg;
	}

	/**********************************************************/
	/* Search for any suitable tracked data in the registers **/
	/**********************************************************/
	Key=EFormMemKeys [Form];
	if ((Key!=0)&&(Bytes<=4)&&(((Flags&(STKVOL|STKSWOPPED))==0)||(Key==ADDROF))) {
		if (Reg<0)  KeyRW=IsRW; 
		else KeyRW=0;
		if (Key==INDMODDT) {
			if (((Stk->Modform&31)==LitVal)&&((0<=Stk->Modintval)&&(Stk->Modintval<=0xFFF))&&(((-0xFFFFF)<=Offset
			    )&&(Offset<=0xFFFFF))) {
				KeyData1=(Offset<<12)|Stk->Modintval;
				KeyData2=Base;
				SourceReg=CheckRegKeyandExt(Key,KeyData1,KeyData2,Bytes,KeyRW,Stk->Type);
			} else {
				SourceReg=-1;
				Key=0;
			}
		} else if (Key==INDREGDT) {
			if ((Stk->Reg!=Reg)&&((Form==IndRegVal)||((Stk->Modform&31)==LitVal)||((Stk->Modform&31)==Regvar)||((Stk
			    ->Modform&31)==RegVal))) 	/*RegClaimMaskA&(1<<Stk_Reg)#0 %and*/{
				if (Form==IndRegModVal) {
					if ((Stk->Modform&31)==LitVal) {
						KeyData1=Stk->Modintval;
					} else {
						KeyData1=((0x80000000|(Stk->Scale<<28))|(Stk->Modreg<<24))|(Stk->Cmval&0xFFFFFF);
					}
				} else {
					KeyData1=0;
				}
				KeyData2=Stk->Reg;
				SourceReg=CheckRegKeyandExt(Key,KeyData1,KeyData2,Bytes,KeyRW,Stk->Type);
			} else {
				SourceReg=-1;
				Key=0;
			}
		} else {
			KeyData1=Offset;
			KeyData2=Base;
			SourceReg=CheckRegKeyandExt(Key,KeyData1,KeyData2,Bytes,KeyRW,Stk->Type);
		}

		if (SourceReg>=0) {
			if ((Bytes==4)||(ExtFlag==0)) {
				if (Key==INDREGDT) {
					unlockreg(Stk->Reg);
					if ((Stk->Modform&31)==RegVal)  unlockreg(Stk->Modreg);
				}
				if (Reg>=0) {
					if (Reg==SourceReg) {
						unlockreg(SourceReg); 
						return SourceReg;
					}
					goto Rcopy;
				}
				if (IsRW==1)  CleanRegister(SourceReg,4);
				return SourceReg;
			} else {
				Exten=GetExtFlag(SourceReg);
				SType=Stk->Type;
				if (((SType==IntType)&&(Exten==REGSIGNEDEXT))||((SType==UintType)&&(Exten==REGUNSIGNEDEXT))) {
					if (Key==INDREGDT)  unlockreg(Stk->Reg);
					if (Reg>=0)  goto Rcopy;
					if (IsRW==1)  CleanRegister(SourceReg,4);
					return SourceReg;
				} else {
					unlockreg(SourceReg);
				}
			}
		}
	}

	if ((Bytes>4)&&(IsAddrForm [Form]==0))  Mabort(12);
	if (Reg>=0){
		CleanRegister(Reg,4);
	} else {
		if (countunclaimedregs()==0  && SimpleRegForm[Form]==0 &&
			IsRegForm[Form]!=0 && registerstatus(Stk->Reg)==1) {
			Reg=Stk->Reg; lockreg(Reg);
		} else Reg=claimreg();
	}


	/*****************************************************/
	/* load Reg from Stk                                **/
	/*****************************************************/

	type=Stk->Type;
	if (type==IntType)  type=LoadIntVal; 
	else if (type==UintType)  type=LoadUintVal; 
	else if (type==MisIntType
	    )  type=LoadMisIntVal; 
	else if (type==MisUintType)  type=LoadMisUintVal; 
	else if (type==RealType)
		type=LoadRealVal; 
	else type=LoadIntVal;





	/* Next line is a frig to allow IMP to get by without passing type info      */
	/* Should be able to remove it once IMP passes type info                     */
	if ((Language==IMP)&&(Bytes==1))  type=LoadUintVal;

	if (type==LoadRealVal)  type=LoadIntVal;
	/*Load Int is only called to load a real if                                  */
	/*     the destination register is to be an                                  */
	/*     integer register (ie: when loading                                    */
	/*     up parameters)                                                        */
	if (ReqReg<0)  unlockregister(Reg);	/* May be short of regs in indexed access)*/
	ARCH(stkaccess(type,Reg,Stk));
	if (ReqReg<0)  CleanRegister(Reg,4);

	if ((IsRW!=1)&&(Key!=0)&&(Bytes<=4)&&(((Flags&(STKVOL|STKSWOPPED))==0)||(Key==ADDROF))) {
		setregmemory(Reg,Key,KeyData1,KeyData2,Bytes,0);
	}

	if (Stk->Type==UintType) {
		SetExtFlag(Reg,REGUNSIGNEDEXT);
	} else {
		SetExtFlag(Reg,REGSIGNEDEXT);
	}

	return Reg;

}	/* Load Int General */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int LoadRealTgt(struct Stkfmt *Stk,int Newsize) {
	/*************************************************************************/
	/** Attempts to load the target float register with the value of the    **/
	/** E-stack entry. If no current float target is set then the routine   **/
	/** has the same effect as Load Real RO.                                **/
	/*************************************************************************/
	int Form,Reg;

	Form=Stk->Form&31;
	if (TargetFreg>=0) {
		if ((SimpleRegForm [Form]==0)||(Stk->Reg!=TargetFreg)) {
			Reg=claimnamedtgt(TargetFreg);
		}
		return LoadRealGeneral(Stk,TargetFreg,Newsize,0);
	}
	return LoadRealRO(Stk,Newsize);
}	/* Load Real Tgt    */
/***/
int LoadRealRO(struct Stkfmt *Stk,int Newsize) {
	/*************************************************************************/
	/** Loads a register with the value of the Estack entry. If the Estack  **/
	/** entry represents a Fregvar then the Fregvar register(s) are         **/
	/** returned as the result, otherwise the routine has the same effect   **/
	/** as Load Real RW.                                                    **/
	/**                                                                     **/
	/** On the M88110, Load Real RO will load into the Extended Register    **/
	/** File.                                                               **/
	/*************************************************************************/
	int Form = Stk->Form&31;
	if ((Form==Fregvar || Form==FregVal || Form==Regvar || Form==RegVal) &&
		(Stk->Reg>=FRBASE) && (Newsize==Stk->Size)) {
		lockreg(Stk->Reg);
		return Stk->Reg;
	}
	return LoadRealGeneral(Stk,-1,Newsize,0);
}	/* Load Real RO     */
/***/
int LoadRealRW(struct Stkfmt *Stk,int Reg,int Newsize) {
	/*************************************************************************/
	/** Stk describes a real value (4 or 8 bytes) to be loaded as Newsize   **/
	/** if Reg is >=0 then this register must be loaded                     **/
	/** if Reg is < 0 then a write-able register must be loaded (a new      **/
	/**               register is always returned if Stk_Size#Newsize)      **/
	/**                                                                     **/
	/** On the M88110, Load Real RW willl load into the Extended Register   **/
	/** File unless specifically requested otherwise (else arithmetic will  **/
	/** be attempted using a mixture of integer and floating-point          **/
	/** registers)                                                          **/
	/*************************************************************************/
	int Form = Stk->Form&31;
	if ((Form==FregVal || Form==RegVal) && (Reg<0) &&
		(Stk->Reg>=FRBASE) && (registerstatus(Stk->Reg)<=1) &&
		(currentFSP==Stk->Reg)) {
		CleanRegister(Stk->Reg,Stk->Size);
		return Stk->Reg;
	}
	return LoadRealGeneral(Stk,Reg,Newsize,1);
}	/* Load Real RW     */
/***/
int LoadRealGeneral(struct Stkfmt *Stk,int Reg,int Newsize,int IsRW) {
	/*************************************************************************/
	/** Stk describes a real value (4 or 8 bytes) to be loaded as Newsize   **/
	/** or an int value (8 bytes) to be loaded into an FP register          **/
	/** if Reg is >=0 then this register must be loaded                     **/
	/** if Reg is < 0 then a write-able register must be loaded (a new      **/
	/**               register is always returned if Stk_Size#Newsize)      **/
	/** result is the fp register to which the value has been loaded        **/
	/** If IsRW is non-zero then only a previously unlocked register or     **/
	/** register pair is returned as the result. If IsRW is 1 then the      **/
	/** register(s) have their tracking cleared.                            **/
	/**                                                                     **/
	/** On the Pentium all loads go to top of stack and the loaded size     **/
	/** will always be the stack width(80 bits). If the item is already     **/
	/** loaded it is left where it is (UNLESS ...                           **/
	/*************************************************************************/
	/***/
	int Bytes,Form,Value,Area,Base,Offset,KeyData1,KeyData2,Type;

	if (Reg>=0 && Reg<FRBASE)  Mabort(26);
	Form=Stk->Form&31;
	Bytes=Stk->Size;
	Base=Stk->Base;
	Offset=Stk->Offset;

	if ((Form==RegVal || Form==Regvar) && Bytes!=8) {
		/*         %IF Bytes#4 %THEN Mabort(28)                                      */
		/*************************************************/
		/* SPARC: Handle copying of an integer register **/
		/* into a floating point register               **/
		/*************************************************/
		if (Stk->Type==RealType && Newsize==Bytes) {
			/**************************************************************/
			/* SPARC: No conversion required - a real in an int register **/
			/**************************************************************/
			if (Reg<0)  Reg=claimfreg();
			if (IsRW!=0)  CleanRegister(Reg,Bytes); 
			else CopyRegMemory(Stk->Reg,Reg);
			if (Stk->Reg<FRBASE) {
				Mabort(987);	/* Can not move between regs & FP stack */
			} else {
				Reg=Stk->Reg;
			}
			return Reg;
		} else {
			/**************************************************************/
			/* SPARC: Load to float reg and convert from integer to real **/
			/**************************************************************/
			Mabort(988);	/* no can do on target000                                      */
		}
	}
	/***********************************************************************/
	/* We are loading a genuine float and no type conversion is necessary **/
	/***********************************************************************/
	if  (Form==FregVal || Form==Fregvar || (Form==RegVal && Bytes==8)) {
		if ((IsRW!=0)&&(Stk->Reg!=currentFSP)) 	/* need brought to top*/{
			if (Form==FregVal || Form==RegVal) {
				manipulateFS(FASTTOTOP,Stk->Reg);
				return currentFSP;
				/* Fregvar */
			} else {
				Reg=claimfreg();
				ARCH(fopr(FLDd,Stk->Reg));
				return Reg;
			}
		}
		/*         %IF Reg<0 %THEN Reg=claim freg                                    */
		return Stk->Reg;
		/*Form=Freg or Fregvar*/
	}


	/*      %IF Reg<0 %THENSTART                                                 */
	Reg=claimfreg();
	/*      %FINISHELSESTART                                                     */
	/*         CleanRegister(Reg, Bytes)                                         */
	/*      %FINISH                                                              */

	if ((Form==Flitval)||(Form==LitVal)) {
		/*********************************************/
		/* We are loading a floating point constant **/
		/*********************************************/
		if (Bytes==8) {
			if (Form==Flitval) {
			    KeyData1=(*(int  *)((int)&Stk->Rlval));
			    KeyData2=(*(int  *)((int)&Stk->Rlval+4));
			} else {
			    KeyData1=Stk->Intvalue;
			    KeyData2=Stk->Modintval;
			}
		} else {
			if (Form==LitVal)  Value=Stk->Intvalue; 
			else Value=(*(int  *)((int)&Stk->Rval));
		}
		if (((Bytes==4)&&(Value==0))||((Bytes==8)&&((KeyData1|KeyData2)==0))) {
			ARCH(oponly(FLDZ,0,0));
		} else if (((Bytes==4)&&(Stk->Rval== 1.0)) ||
			   ((Bytes==8)&&(Form==Flitval)&&(Stk->Rlval== 1.0)) ||
			   ((Bytes==8)&&(Form==LitVal)&&(KeyData2==0)&&(KeyData1==1))) {
			ARCH(oponly(FLD1,0,0));
		} else {
			if (Bytes==4)  Msetconst((int)&Value,4,&Area,&Offset); 
			else if (Form==Flitval)
			    Msetconst((int)&Stk->Rlval,8,&Area,&Offset);
			else {
			    struct ll {  /* this is probably host-specific */
				int l;
				int h;
			    } ll;
			    ll.l = KeyData1;
			    ll.h = KeyData2;
			    Msetconst((int)&ll,8,&Area,&Offset);
			}
			cnstdir(Stk,Offset,Bytes);

#if(OutputASSEMBLER==Positive) 
			Stk->Base=Area;
#endif
			if (Bytes==8 && Form==LitVal)
			    ARCH(stkaccess(LoadIntVal,Reg,Stk));
			else
			    ARCH(stkaccess(LoadRealVal,Reg,Stk));
		}

		return Reg;

		/*Form=Flitval or Form=LitVal*/
	}

	/*****************************************************/
	/* load Reg from Stk                                **/
	/*****************************************************/

	Type=LoadRealVal;
	if (Stk->Type==IntType)
	    Type=LoadIntVal;
	else if (Stk->Type==MisIntType)
		Type=LoadMisIntVal;
	else if (Stk->Type==MisRealType)
	    Type=LoadMisRealVal;
	ARCH(stkaccess(Type,Reg,Stk));

	return Reg;

}	/* Load Real General*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int Cstoreop(struct Stkfmt *LHS,struct Stkfmt *RHS,int Dup) {
	/*******************************************************************/
	/** Value defined by RHS is assigned to LHS. If Dup is non-zero   **/
	/** then value must be retained in a register.                    **/
	/** Result is the reg used for retaining the value or -1 if there **/
	/** was no retention.                                             **/
	/*******************************************************************/
	int DupReg,SourceReg,ForceExt,SourceType,OldLHSForm,Key,Swopped;
	int Offset,Base,Volatile,Type,Rform,Lform,Op,reg,rega,junk,upperval,lowerval;
	int i8flag;

	struct Stkfmt Dupstk,LHSls,LHSms,RHSls,RHSms,Dupstkls,Dupstkms;

	Volatile=LHS->Flags&STKVOL;	 
	Swopped=LHS->Flags&STKSWOPPED;
	Rform=RHS->Form&31;
	Lform=LHS->Form&31;
	ForceExt=0;	/* Pds thinks this is never needed */
	/******************************************/
	/* Special case for bit fields in PASCAL **/
	/******************************************/
#if(Language==PASCAL)
	if (CPartWord(LHS)!=0) {
		struct Stkfmt Regstk;
		/* I'm not sure if I need to frig the stack here but */
		/* I shall do so to be on the safe side              */
		Regstk=*LHS;
		Cpushoperand(RHS);
		Cpushoperand(&Regstk);
		Elevel-=2;
		CBitFieldOp(InsertUU);
		return -1;	/* Dup not relevant here */
	}
#endif
	Base=LHS->Base;
	Offset=LHS->Offset;
	SourceType=RHS->Type;
	OldLHSForm=LHS->Form;
	/***************************************************************/
	/* In FORTRAN, if the type is unknown then we have to work it **/
	/* out from the E-stack type.                                 **/
	/***************************************************************/
#if (Language==FORTRAN && LanguageVariant==FORTRAN77)
	if (SourceType==0) {
		if (((Rform)==FregVal)||((Rform)==Fregvar)||(RHS->Size>4)) {
			SourceType=RealType;
		} else {
			SourceType=IntType;
		}
	}
#endif
	/***************************************************************/
	/* Assigning swopped reals works badly as the sequence is too  */
	/* complicated for the peepholer to remove the unnecessary     */
	/* swopping. Treat this case as two integer assigns by means of*/
	/* recursive eops.                                             */
	/***************************************************************/

#if(AllowReverseEndianData!=0)
	if (LHS->Size==8 && RHS->Size==8 && Dup==0  && 
		(LHS->Flags&RHS->Flags&STKSWOPPED)!=0) {
		Cdiscardopnd(LHS);
		Cdiscardopnd(RHS);
		Cpushoperand(RHS);
		Cpushoperand(LHS);
		eop(EADDRESS); eop(DUPL);
		epromote(3);
		eop(EADDRESS); eop(DUPL);
		erefer(4,(IntType<<24)|4);
		epromote(3);
		erefer(4,(IntType<<24)|4);
		eop(ESTORE);
		erefer(0,(IntType<<24)|4);
		eop(EXCH);
		erefer(0,(IntType<<24)|4);
		eop(ESTORE);
		return -1;
	}
#endif

	/***************************************************************/
	/** Optimise for case of rhs a Literal and no duplicate reqd  **/
	/***************************************************************/
	if ((Dup==0)&&
	    ((Rform==LitVal)||(Rform==Flitval))&&
	    ((LHS->Size<=4)||((LHS->Size==8)&&((Lform==DirVal)||(Lform==TempVal))))) {
		if (LHS->Size==8) {
			if (Rform==Flitval) {
				upperval=(*(int  *)((int)&RHS->Rlval+4));
				lowerval=(*(int  *)((int)&RHS->Rlval));
			} else {
				upperval=RHS->Modintval;
				lowerval=RHS->Intvalue;
			}
			if ((LHS->Flags&STKSWOPPED)!=0) {
				junk=upperval;
				upperval=lowerval;
				lowerval=junk;
			}
			LHS->Size=4;
			LHS->Offset=LHS->Offset+4;
			ARCH(oprx(MOV,upperval,LHS,SOURCELIT));
			LHS->Offset=LHS->Offset-4;
		} else {
			if (Rform==Flitval) {
				lowerval=(*(int  *)((int)&RHS->Rval));
			} else {
				lowerval=RHS->Intvalue;
			}
		}
		ARCH(oprx(MOV,lowerval,LHS,SOURCELIT));
		SourceReg=-1;	/* No SourceReg */

		goto CheckConf;
	}

	/**************************************************************/
	/* Pick off integer*8 assignments and do them in two parts   **/
	/* by splitting and recursive calls                          **/
	/**************************************************************/
	i8flag = ((LHS->Size==8)&&(LHS->Type!=RealType)&&(LHS->Type!=MisRealType));
	if (i8flag && Lform != RegVal && Rform != RegVal && Rform != FregVal) {
		reg=Cdividelongint(LHS,&LHSls,&LHSms);
		rega=Cdividelongint(RHS,&RHSls,&RHSms);
		if (Dup!=0) {
			if (Lform==TempVal) {
				Cpushoperand(LHS); 
				Dup=0;
			}
			if (Rform==TempVal) {
				Cpushoperand(RHS); 
				Dup=0;
			}
		}
		if (Dup!=0) 	/*Still */{
			Key=ARCH(tempspace(8,8));
			StkTemp(&Dupstk,Key,8);
			DupReg=Cdividelongint(&Dupstk,&Dupstkls,&Dupstkms);
			DupReg=Cstoreop(&Dupstkms,&RHSms,1);
			Elevel-=1;
			junk=Cstoreop(&LHSms,&Stk [Elevel+1],0);
			DupReg=Cstoreop(&Dupstkls,&RHSls,1);
			Elevel-=1;
			junk=Cstoreop(&LHSls,&Stk [Elevel+1],0);
			Cpushoperand(&Dupstk);
		} else {
			junk=Cstoreop(&LHSms,&RHSms,0);
			junk=Cstoreop(&LHSls,&RHSls,0);
		}
		return -1;
	}

	if (Dup!=0) {
		/*********************************************************************/
		/* We are required to generate a Duplicate of the RHS in a register **/
		/*********************************************************************/
		if (((SourceType==RealType)||(SourceType==MisRealType)||i8flag)&&
			(IsAddrForm [Rform]==0)) {
			if (((Rform==FregVal || (i8flag&&Rform==RegVal))&&(TargetFreg<0))) {
				DupReg=RHS->Reg;
			} else if (TargetDToS!=0) {
				DupReg=LoadRealGeneral(RHS,-1,RHS->Size,2);
			} else if (TargetFreg>=0) {
				if ((SimpleRegForm [Rform]==0)||(RHS->Reg!=TargetFreg)) {
					DupReg=claimnamedtgt(TargetFreg);
				}
				DupReg=LoadRealGeneral(RHS,TargetFreg,RHS->Size,2);
			} else {
				DupReg=LoadRealGeneral(RHS,-1,RHS->Size,2);
			}


		} else {
			if ((Rform==RegVal)&&(RHS->Reg<FRBASE)&&(TargetReg<0)) {
				DupReg=RHS->Reg;
			} else if (TargetReg>=0) {
				if ((SimpleRegForm [Rform]==0)||(RHS->Reg!=TargetReg)) {
					DupReg=claimnamedtgt(TargetReg);
				}
				DupReg=LoadIntGeneral(RHS,TargetReg,0,2);
			} else {
				DupReg=LoadIntGeneral(RHS,-1,0,2);
			}

			if (Lform==Regvar) {
				if (LHS->Type==UintType)  Extendreg(DupReg,DupReg,4,LHS->Size,UintType);
				if ((LHS->Type==IntType)&&(LHS->Size<4))  Extendreg(DupReg,DupReg,LHS->Size,4,IntType);
			}
		}
		if ((DupReg<FRBASE)&&(Swopped!=0)&&(LHS->Size>1)) {
			SourceReg=claimreg();	/* Store swopped corrupts DupReg */
			ARCH(rr(MOV,DupReg,-1,SourceReg));
			ARCH(modinstrprops(0,COPYINSTR,0,0));
		} else SourceReg=DupReg;
		/*now Dup=0*/
	} else {
		if (SimpleRegForm [Lform]!=0) {
			/*****************************************************************/
			/* No Duplicate is required and the LHS is of a simple register **/
			/* form so we load the RHS into the LHS register directly -     **/
			/* doing any necessary type coercions on reals.                 **/
			/*****************************************************************/
			if ((Lform==FregVal)||(Lform==Fregvar)||(i8flag&&Lform==RegVal)) {
				SourceReg=LoadRealGeneral(RHS,LHS->Reg,LHS->Size,2);
			} else {
				SourceReg=LoadIntGeneral(RHS,LHS->Reg,0,2);
				if (SimpleRegForm[Rform]!=0) { /* wont have been extended by load */
					if (LHS->Type==UintType)
						Extendreg(SourceReg,SourceReg,4,LHS->Size,UintType);
					if ((LHS->Type==IntType)&&(LHS->Size<4))
						Extendreg(SourceReg,SourceReg,LHS->Size,4,IntType);
				}
			}
		} else {
			/**************************************************************/
			/* No Duplicate is required and the LHS is not a simple      **/
			/* register form so we have to load a read only copy of the  **/
			/* RHS into a register.                                      **/
			/* 4 Byte reals in store are assigned via int regs           **/
			/**************************************************************/
			if (((SourceType==RealType)||(SourceType==MisRealType)||i8flag)&&(IsAddrForm [Rform]==0)&&((Rform==FregVal)
			    ||(Rform==Fregvar)||(RHS->Size>=8)||(LHS->Size>=8))) {
				if ((targetvariant!=M88110)||(((Rform!=Fregvar)&&(Rform!=FregVal))||(RHS->Reg>=FRBASE))) {
					SourceReg=LoadRealRO(RHS,RHS->Size);
				} else {
					SourceReg=RHS->Reg;
				}
			} else {
				if ((Swopped!=0)&&(LHS->Size>1)) {
					SourceReg=LoadIntRW(RHS,-1)	/* Store Swopped will corrupt */;
				} else if (ForceExt!=0) {
					SourceReg=LoadIntRO(RHS);
				} else {
					if ((RHS->Size==1)&&(1==LHS->Size))  RHS->Type=UintType;	/*Avoid a wasted sign extension*/
					SourceReg=LoadIntRONoExt(RHS);
				}

			}

			/*Simpleregform ... else*/
		}
		/*Dup#0   ... else ..*/
	}
	/******************************************************************/
	/* We now store SourceReg (RO register copy of RHS) into the LHS **/
	/******************************************************************/
	/**/
	if ((Dup!=0)&&(IsRegForm [Lform]!=0)) {
		if (IsIndRegForm [Lform]!=0) {
			notereguse(LHS->Reg,-255,4);
		} else {
			notereguse(LHS->Reg,-255,LHS->Size);
		}
		if ((Dup!=0)&&(Lform>=Regvar))  DupReg=LHS->Reg;	/* Economy use lH reg for dup*/
	}
	/**/
	if (SourceReg<FRBASE) {
		Type=StoreIntVal;
		if ((LHS->Type==MisIntType)||(LHS->Type==MisUintType))  Type=LHS->Type+8;
		if ((LHS->Size==1)&&(SourceReg>3)) 	/* esi & edi not usable for byte stores*/{
			reg=claimbyteopreg();
			ARCH(copyireg(SourceReg,reg));
			unlockreg(SourceReg);
			SourceReg=reg;
			if (Dup!=0)  DupReg=SourceReg;
		}
		ARCH(stkaccess(Type,SourceReg,LHS));
	} else {
		if (LHS->Size>8)  Op=FSTPq; 
		else if (LHS->Size==4)  Op=FSTPm; 
		else if (i8flag) Op=FISTPd;
		else Op=FSTPd;

		if ((Dup!=0)&&(LHS->Size<=8)&&(Swopped==0)&&!i8flag)  Op+=3; /* Dont pop stack*/
		if (SourceReg!=currentFSP) {
			manipulateFS(FASTTOTOP,SourceReg); 
			SourceReg=currentFSP;
		}
		if ((Dup!=0)&&((LHS->Size>8)||(Swopped!=0)||i8flag)) /* No store long without popping*/{
			ARCH(fopr(FLDd,SourceReg))	/* So copy before the store */;
		}
		ARCH(oprx(Op,SourceReg,LHS,DESTSTORE));
	}
CheckConf:

	/**/
	/*****************************************************************/
	/* We now have to check for any conflicts with the register     **/
	/* memory caused by storing into the LHS                        **/
	/*****************************************************************/
	LHS->Form=OldLHSForm;
	if (SimpleRegForm [Lform]==0) {
		Key=EFormMemKeys [Lform];
		if (Key==DATAAT) {
			CheckConflict(Base,Offset,LHS->Size);
			if ((Volatile|Swopped)==0 && SourceReg>=0)
				setregmemory(SourceReg,DATAAT,Offset,Base,LHS->Size,1)
				;
		} else {
			if ((Contexts&CXTnoalias)==0) {
				CheckIndConflict(LHS);
			} else {
				CheckConflict(Base,Offset,LHS->Size);
			}
			if (Key!=0 && LHS->Size<=4 && SourceReg>=0 && (Volatile|Swopped)==0) {
				if (Key==INDMODDT) {
					if ((LHS->Modform&31)==LitVal && (0<=LHS->Modintval && 
						LHS->Modintval<=0xFFF) && (-0xFFFFF)<Offset && Offset<0xFFFFF) {
						setregmemory(SourceReg,INDMODDT,(Offset<<12)|LHS->Modintval,Base,LHS->Size,1);
					}
				} else if (Key==INDREGDT) {
					if ((RegClaimMaskA&(1<<LHS->Reg))!=0) {
						if (Lform==IndRegVal) {
							setregmemory(SourceReg,INDREGDT,0,LHS->Reg,LHS->Size,1);
						} else if ((LHS->Modform&31)==RegVal || (LHS->Modform&31)==Regvar) {
							setregmemory(SourceReg,INDREGDT,
								((0x80000000|(LHS->Scale<<28))|(LHS->Modreg<<24))|(LHS->Cmval&0xFFFFFF),
							    LHS->Reg,LHS->Size,1);
						} else if ((LHS->Modform&31)==LitVal) {
							setregmemory(SourceReg,INDREGDT,LHS->Modintval,LHS->Reg,LHS->Size,1);
						}


					}
				} else {
					setregmemory(SourceReg,Key,Offset,Base,LHS->Size,1);
				}

			}
		}
	} else {
		checkregconflict(LHS->Reg);
	}
	if (Dup!=0) {
		/****************************************************************/
		/* We were required to generate a duplicate so we stack its    **/
		/* E-stack entry and force its type to be the same as the RHS. **/
		/****************************************************************/
		unlockreg(SourceReg);	/*to avoid a doublelock                               */
		if (((SourceType==RealType)||(SourceType==MisRealType))&&(IsAddrForm [Rform]==0)) {
			Cstackfr(DupReg,RHS->Size);
		} else {
			Cstackr(DupReg,RHS->Size);
		}
		if (SourceType==UintType)  Stk [Elevel].Type=UintType;
		return DupReg;
	} else {
		if (SourceReg>=0)  unlockreg(SourceReg);
		return -1;
	}
}	/* C Storeop        */
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            parameter processing                                      **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
void Cpushparam(struct Stkfmt *Stk) {
	/****************************************************************/
	/** the value or address in Stk is added to the parameter list **/
	/****************************************************************/
	int index,type,offset,reg,Treg,len,Form,align,op;
	struct Stkfmt Lstk,Lstkls,Lstkms;


	Mparaminfo2(&len,&index,&type,&offset,&align,&reg);
	/*      printstring("mparaminfo2"); write(type,4); write(reg,4); newline     */
	Treg=reg;	/* remember target                                                */
	Form=Stk->Form&31;
	Lstk=*Stk;
	if (index==0 && (ParI->paramsize&7)==4) ARCH(opr(PUSH,EDI));
	switch (type) {

	case Uintval:
	case Intval:
TIntval:
		if (Lstk.Size==8) {
			if (Form==FregVal) {
				reg=LoadIntRW(Stk,-1);
				ARCH(oplit(SUB,ESP,8,ESP));
				ARCH(fopmem(FISTPd,ESP,0,8));
			} else {
				Treg=Cdividelongint(&Lstk,&Lstkls,&Lstkms);
				reg=LoadIntRO(&Lstkms);
				ARCH(opr(PUSH,reg));
				unlockreg(reg);
				reg=LoadIntRO(&Lstkls);
				ARCH(opr(PUSH,reg));
				if (Treg >= 0) unlockreg(Treg);
			}
			unlockreg(reg);
			return ;
		}

	case Ptrval:
	case CHARval:
	case CHARlenval:
		if (Lstk.Size>4)  Mabort(29);
		if (Form==LitVal) {
			ARCH(oplitmem(PUSH,Lstk.Intvalue,ESP,0,4));
			return ;
		}
		if (Lstk.Size<len) {
			reg=LoadIntRO(&Lstk);
			ARCH(opr(PUSH,reg));
			unlockreg(reg);
			return ;
		}
		Treg=-1;
		if (Form==DirVal)  Treg=CheckRegKey(DATAAT,Lstk.Offset,Lstk.Base,Lstk.Size,0);
		if ((MINCODESIZE!=0)&&(Treg<0)) {
			ARCH(oprx(PUSH,0,&Lstk,NOREG));
		} else {
			/* On Pentium push from memory is slow as it blocks both pipes               */
			if (Treg>=0)  unlockreg(Treg);
			reg=LoadIntRO(&Lstk);
			ARCH(opr(PUSH,reg));
			unlockreg(reg);
		}
		return ;

	case Realval:
	case Floatval:
		if (Form==Flitval) 	/*Passing a Literal*/{
			if (Lstk.Size>4) {
				ARCH(oplitmem(PUSH,(*(int  *)((int)&Lstk.Rlval+4)),ESP,0,4));
				ARCH(oplitmem(PUSH,(*(int  *)((int)&Lstk.Rlval)),ESP,0,4));
			} else {
				ARCH(oplitmem(PUSH,(*(int  *)((int)&Lstk.Rval)),ESP,0,4));
			}
		} else if ((Lstk.Size==4)&&(Form!=FregVal)&&(Form!=Fregvar)) {
			Lstk.Type=Intval;
			goto TIntval;
			/* Passed in store or in integer reg*/
		} else {
			reg=LoadRealRW(Stk,-1,len);
			if (len>8) {
				op=FSTPq;
				ARCH(oplit(SUB,ESP,len,ESP));
			} else {
				if (len==8)  op=FSTPd;
				else op=FSTPm;
				/* best on 386          target oplit(SUB,ESP,len,ESP)                        */
				ARCH(opr(PUSH,EAX));
				if (len==8)  ARCH(opr(PUSH,ECX));
			}
			ARCH(fopmem(op,ESP,0,len));
			unlockreg(reg);
		}

		/**/
		return ;

	case Cmplxval:	/*currently only implemented for COMPLEX*8 leaf support procedures*/
#if(Language==FORTRAN) 
		/**/
		{
			struct Stkfmt Rstk,Istk;
			op=Caddresscomplexopnd(Stk,&Rstk,&Istk);
			if (((Istk.Form&31)!=FregVal)&&(Istk.Size==4)&&((Istk.Flags&STKSWOPPED)==0)) {
				ARCH(oprx(PUSH,-1,&Istk,NOREG));
				ARCH(oprx(PUSH,-1,&Rstk,NOREG));
			} else {
				reg=LoadRealRW(&Istk,-1,(unsigned)len>>1);
				if (len>16)  op=FSTPq;
				else if (len==16)  op=FSTPd;
				else op=FSTPm;
	
				ARCH(oplit(SUB,ESP,len,ESP));
				ARCH(fopmem(op,ESP,(unsigned)len>>1,len));
				unlockreg(reg);
				reg=LoadRealRW(&Rstk,-1,(unsigned)len>>1);
				ARCH(fopmem(op,ESP,0,len));
				unlockreg(reg);
			}
			return ;
		}
#endif

	case Structval:
	case Stringval:
		if (len==4)  goto TIntval;	/* 4 byte struct as int */
		if ((Lstk.Form==LitVal)&&(Lstk.Intvalue==0)) 	/* Pass zeroed aggreagte*/{
			ARCH(oplit(SUB,ESP,((len+3)&(-4)),ESP));
			Cstackr(ESP,4);
			estklit(len);
			eop(EZERO);
			return ;
		}
		Mabort(31);

	case ResAddrval:
		/*      reg=OUTPARAM1REG                                                     */
		goto TIntval;

	case ResLenval:
		goto TIntval;

		/**/
	default:
		Mabort(967);
	}
}	/* Cpush param      */
/***/
void Cpushbytes(int Number,struct Stkfmt *LStk) {
	/****************************************************************/
	/** Push Number of bytes to the parameter stack                **/
	/** records by value go into param area on RS6000              **/
	/****************************************************************/
	int index,type,offset,len,Reg,align;

	ParI->loadedpars=ParI->loadedpars+1;
	Mparaminfo2(&len,&index,&type,&offset,&align,&Reg);
	if ((type!=Structval) && (type!=Stringval)) Mabort(32);
	if (index==0 && (ParI->paramsize&7)==4) ARCH(opr(PUSH,EDI));

	if (Number<=4) {
		Crefer(LStk,0,4);
		Reg=LoadIntRO(LStk);
		ARCH(opr(PUSH,Reg))	/* get posn right for < 4 bytes */;
		unlockreg(Reg);
	} else {
		/* Further improvements possible for up to 8 byte structs */
		Elevel+=2;
		ARCH(oplit(SUB,ESP,((Number+3)&(-4)),ESP));
		/* Must copy ESP here in case MVB call a support RT */
		Reg=claimreg();
		ARCH(rr(MOV,ESP,-1,Reg));
		Cstackr(Reg,4);
		epromote(2);
		eop(MVB);
	}
}	/* Cpushbytes       */
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            administrative and control code generation                **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
void Cgeneratenop() {
	ARCH(plantnop());
}
/**/
void Cjump(int Cond,int Labelid,int Option) {
	/****************************************************************/
	/** Cond specifies the conditions under which transfer is to   **/
	/** be made to Labelid. The hardware condition codes will      **/
	/** already be set.                                            **/
	/**                                                            **/
	/** Option         = 0  generate normal jump(RS6 only option)  *                 **/
	/**                = 1  generate jump without delay slot instr **/
	/**                = 2  generate jump but don't discard        **/
	/**                   current condition codes                  **/
	/**                = 3  SPARC: generate non-annulled jump      **/
	/**                   without delay slot instruction           **/
	/**                                                            **/
	/** Cond         = bcop<<16!reg1!reg2                          **/
	/**                                                            **/
	/****************************************************************/
	/***/
	/***/
	int index,bcop;
	bcop=((unsigned)Cond>>16)&255;
	if (Cond==-1)  Mabort(59);	/* Condition codes not set */
	/**/
	if (bcop==0) {
		bcop=Cond&255;
		if ((0<=bcop)&&(bcop<=5)) {
			if ((Cond&0xFF00)!=Icompare)  Cond=jops [bcop]; 
			else Cond=jops [bcop+6];
		} else {
			if (!((bcop==ALWAYS)||(bcop==NEVER)))  Mabort(59);
		}
		if (bcop==ALWAYS)  Cond=JMP<<16;
		/* of attemp to stay compatible withh CC machines for never & always*/
	}
	if (bcop!=NEVER) {
		/**/
		index=BLocateLabel(Labelid+Labadjust,0);
		/**/
		ARCH(bcctf(Cond,index,0));
		/**/
	}

	if (Option!=2)  enotecc(-1);	/*avoid redundant establist logical             */
}	/* Cjump            */
/***/
int CinvertCC(int Cond) {
	/*************************************************************************/
	/** Reverse Cond   cannot do this in eprocs on non CC machines          **/
	/*************************************************************************/
	int bcop;
	bcop=((unsigned)Cond>>16)&255;
	if (bcop==JMP)  return NEVER;
	if ((bcop==0)&&((Cond&255)==ALWAYS))  return NEVER;
	if ((bcop==0)&&((Cond&255)==NEVER))  return ALWAYS;
	return (Cond&0xFFFF)|(Inversejump [bcop-(JO)]<<16);
}
/***/
void Creversedjump(int Cond,int Labelid,int Option) {
	/****************************************************************/
	/** As Cjump but reverse the condition                         **/
	/** It is invalid to attempt to do this in Eprocs              **/
	/** as reversing a condition may be machine dependent          **/
	/****************************************************************/
	Cjump(CinvertCC(Cond),Labelid,Option);
}
/***/
void Cjumpcond(int Cond,struct Stkfmt *Stk1,struct Stkfmt *Stk2,int Labelid) {
	/****************************************************************/
	/** Cond specifies the conditions which, if satisfied between  **/
	/** Stk1 and Stk2, will cause transfer to Labelid.             **/
	/** Cond & x'ff' = GT                                          **/
	/**                LT                                          **/
	/**                EQ                                          **/
	/**                NE                                          **/
	/**                GE                                          **/
	/**                LE                                          **/
	/**                                                            **/
	/** Cond & x'f00' =  Icompare    signed integer comparison     **/
	/**                  Rcompare    floating point comparison     **/
	/**                  UIcompare   unsigned integer comparison   **/
	/****************************************************************/
	int Type;
	Type=Cond&0xF00;
	Cond&=0xFF;
	if (Type==Icompare) {
		CIntBinaryOp(IGT+Cond,Stk1,Stk2,0);
	} else if (Type==UIcompare) {
		CIntBinaryOp(UGT+Cond,Stk1,Stk2,0);
	} else {
		CRealBinaryOp(RGT+Cond,Stk1,Stk2);
	}

	Cjump(ereadcc(),Labelid,0);
}	/* Cjumpcond        */
/***/
void Cestablishlogical() {
	/******************************************************************/
	/** Convert hanging condition codes into 0/1 value in a register **/
	/******************************************************************/
	int Reg1,Reg,Condition,ccop;

	Condition=ereadcc();
	if (Condition==-1)  Mabort(59);	/* condition codes not set */
	ccop=((unsigned)Condition>>16)&255;
	/**/
	if (Report!=0) {
		printf("\nCestablishlogical start\n");
	}
	/**/
	if ((Condition==ALWAYS)||(ccop==JMP)) {
		enotecc(-1);
		estklit(1);
	} else if ((Condition==NEVER)||(ccop==0)) {
		enotecc(-1);
		estklit(0);
	} else {
		/**/
		/* The zero must be set up with a MOV. Anything clever will change the Flags */
		/**/
		if (targetvariant==PPRO2) {
			Reg=claimreg();
			Reg1=claimreg();
			ARCH(rlit(MOV,Reg,0,Reg))	/* Will not convext to xor unlike target oplit or target loadlit*/;
			ARCH(rlit(MOV,Reg1,1,Reg1))	/* Will not convext to xor unlike target oplit or target loadlit*/;
			ARCH(rr(cmovcc [ccop-(JO)],Reg1,-1,Reg));
			unlockreg(Reg1);
		} else {
			Reg=claimbyteopreg();
			ARCH(rlit(MOV,Reg,0,Reg))	/* Will not convext to xor unlike target oplit or target loadlit*/;
			ARCH(opr(setjump [ccop-(JO)],Reg));
		}
		unlockreg(Reg);
		Cstackr(Reg,4);
		enoteestcc((ccop<<16)|Reg);
	}

	/**/
	/**/
	if (Report!=0) {
		printf("Cestablishlogical end\n\n");
	}
	/**/
}	/* Cestablishlogical*/
/***/
void Cgjump(int Level,int Offset) {
	/****************************************************************/
	/** Jump to global label restoring registers. Destination code **/
	/** address is at GLA + Offset.                                **/
	/** Assumes jump is internal to a compilation unit ie that     **/
	/** Gla and TOC can be relied on                               **/
	/** Also assumes that stack is standard and no register vars   **/
	/** have to be reset                                           **/
	/****************************************************************/
	struct Stkfmt Lstk;


	enotecc(-1);
	Gladir(&Lstk,Offset,4);
	ARCH(stkaccess(LoadIntVal,RESULTREG,&Lstk));	/* Pick up address             */
	/**/
	/* on mips we can not unwind the stack this must be done on arrival          */
	/**/
	ARCH(opr(JMPPTR,RESULTREG))	/* and go to address in RESULTREG*/;
	ARCH(modinstrprops(0,JUMPINSTR,0,0));
}	/* Cgjump */
void Cglabelcode() {
	/****************************************************************/
	/** Code executed on rentering from inner procedure                     **/
	/** Code must be proof against being fallen into repeatedly!            **/
	/****************************************************************/
	struct fragfmt *frag;
	if (Pic!=0) {
		ARCH(GOTfix(GOTREG));
		frag=(struct fragfmt*)(PI->curfrag);
		frag->props=((frag->props|NOCOALESCEHEAD)|NOCOALESCETAIL)|NOOPTIMFRAG;
		BBreakFrag(0);
	}
}

void Ctestval(int Type1,struct Stkfmt *Stk1) {
	/****************************************************************/
	/** set condition codes according to the value of Stk1         **/
	/** Type = Icompare  integer comparison                        **/
	/**        Rcompare  real comparison                           **/
	/**        UIcompare unsigned integer comparison               **/
	/****************************************************************/
	int Reg,Size,Freg,Freg1,areg,breg,label,lindex,Form;
	struct Stkfmt Fzero,Stkls,Stkms;

	if (Type1!=Rcompare) {
		if (Stk1->Size==8) 	/*int*8*/{
			areg=Cdividelongint(Stk1,&Stkls,&Stkms);
			if (Type1==Icompare) 	/* Top bit of LSH will mess up CC */{
				label=Mprivatelabel();
				lindex=BLocateLabel(label+Labadjust,0);
				breg=claimbyteopreg();
				Reg=LoadIntRO(&Stkms);
				ARCH(rr(TEST,Reg,Reg,Reg));
				ARCH(opr(SETG,breg));
				unlockreg(Reg);
				ARCH(bcc(JNZ<<16,lindex,0));
				Reg=LoadIntRO(&Stkls);
				ARCH(rr(TEST,Reg,Reg,Reg));
				ARCH(opr(SETA,breg))	/* A=above or greater unsigned */;
				ARCH(rlit(TEST,breg,1,breg));
				Mplabel(label);
				unlockreg(Reg);
				unlockreg(breg);
				enotecc(EQ);
			} else {
				CIntBinaryOp(IOR,&Stkms,&Stkls,0)	/* Will set fgags */;
				Cdiscard(&Stk [Elevel]);
				enotecc(EQ);
			}
			if (areg >= 0) unlockreg(areg);
			return ;
		}
		Reg=LoadIntRO(Stk1);
		ARCH(rr(TEST,Reg,Reg,Reg));
		enotecc(EQ);
		/**/
		unlockreg(Reg);
		/* Rcompare */
	} else {
		Size=Stk1->Size;
		Form=Stk1->Form&31;
		if (targetvariant==PPRO2) {
			if ((Form!=FregVal)&&(Form!=Fregvar)) {
				Freg1=claimfreg();

				ARCH(oponly(FLDZ,0,0))	/*make a 0.0*/;
				Freg=LoadRealRW(Stk1,-1,Size);
			} else {
				Freg=LoadRealRW(Stk1,-1,Size);
				Freg1=claimfreg();
				ARCH(oponly(FLDZ,0,0))	/*make a 0.0*/;
				ARCH(fopr(FXCH,currentFSP+1));
			}
			ARCH(fopr(FCOMIP,currentFSP+1));
			unlockreg(currentFSP);
			manipulateFS(FDISCARD,currentFSP);
		} else {
			Freg=LoadRealRW(Stk1,-1,Size);
			/**/
			memset(&Fzero,0,sizeof( struct Stkfmt));
			Fzero.Size=4;	 
			Fzero.Form=Flitval;
			ARCH(oprx(FCOMPm,Freg,&Fzero,DESTREG));
			Reg=claimnamedreg(EAX);
			ARCH(oponly(FSTSW,1<<EAX,0))	/*x'dfe0' fstsw %ax*/;
			ARCH(oponly(SAHF,0,1<<EAX));
			unlockreg(Reg);
			unlockreg(Freg);
		}
		enotecc(EQ);
		/**/
	}

}	/* Ctestval         */
/***/
void Cswitch(int Switchid,int Swtabad) {
	/****************************************************************/
	/** generate code to jump to a switch label                    **/
	/** Swtabad is the address of the record with all switch info  **/
	/** the switch index is in an implementation defined register  **/
	/** The latter must be the same as estkresult Reg for F77      **/
	/****************************************************************/
	struct fragfmt *frag;
	struct Swtabfmt *Tab;
	struct instrfmt *Linstr;
	int reg1,offset,lower;

	Tab=(struct Swtabfmt*)(Swtabad);
	/**/

#if(Language!=CCOMP) 
	Mlabel(Switchid);
#endif
	enotecc(-1);
	if (Tab->Mode!=SPARSESWITCH) {
		/* we only produce code to use the index table if it is not sparse */
		reg1=RETURNREG;	/*%o0           */
#if(Language!=CCOMP) 
		lower=Tab->Lower;
#else
		lower=0;
#endif
		/**/
		/* method is to do a call pop the address and load from the table            */
		/* either an absolute or a GP relative address. If pic turn the              */
		/* relative address into an absolute one. Finally jump to it                 */
		/* for efficiency the table should be word alligned which may                */
		/* mean the backend has to adjust the offset in the table                    */
		/**/
		if ((OutputASSEMBLER==Positive)&&(Pic==0)) {
			offset=-(4*lower);
			ARCH(genmemaccess(JMPPTR,CODE,offset,RESULTREG,2,RESULTREG,4,NOREG,1));
		} else {
			offset=7;
			if (Pic!=0)  offset+=2;
			if ((lower>32)||(lower<-28)) {
				ARCH(rlit(SUB,RESULTREG,lower,RESULTREG));
			} else {
				offset-=4*lower;	/* Addjust in load if <1 byte */
			}
			ARCH(calllocal(0,0));
			ARCH(opr(POP,EDX));
			ARCH(genmemaccess(LW,EDX,offset,RESULTREG,2,RESULTREG,4,DESTREG,0));
		}
		ARCH(modinstrprops(0,0,0,DSWITCHLOADINSTR));
		Linstr=BCurInstr();
		Linstr->u0.offset=Tab->Labbase;	/* Needed to form label in assembler */
		Linstr->disp=offset;	/* Needed for correct offset in assembler */
		if (!((OutputASSEMBLER==Positive)&&(Pic==0))) {
			if (Pic!=0)  ARCH(rr(ADD,EDX,RESULTREG,RESULTREG));
			ARCH(opr(JMPPTR,RESULTREG));
		}
		ARCH(modinstrprops(0,JUMPINSTR,0,0));
		frag=(struct fragfmt*)(PI->curfrag);
		frag->props=(frag->props|NOCOALESCEHEAD)|NOGISFRAG;
		ARCH(modinstrprops(0,0,0,DSWITCHJUMPINSTR));
	}
	/**/
	frag=(struct fragfmt*)(PI->curfrag);
	if (Tab->Mode!=SPARSESWITCH) {
		frag->props=frag->props|DSWITCHJUMPFRAG;
	}
	frag->switchtab=Swtabad;
	BBreakFrag(0);	/*to ensure the SWITCHTAB is the frag's last instruction*/
	/**/

}	/* Cswitch          */
/***/
void Cswitchjump(int Switchid,int Swtabad,struct Stkfmt *Stk) {
	/****************************************************************/
	/** Load the switch index to an implementation defined register**/
	/** and generate code to jump to the switch code for Switchid  **/
	/****************************************************************/
	struct Swtabfmt *Tab;
	int Lower,Upper,Rangelab,Index,i,Mode,reg,Range;

	/***********************************************************/
	/*Check if Switch Bound Checking is on                    **/
	/***********************************************************/
	Tab=(struct Swtabfmt*)(Swtabad);
	Rangelab=Tab->Rangelab;
	Mode=Tab->Mode;
	Index=BLocateLabel(Switchid+Labadjust,0);

	/***********************************************************/
	/**/
	reg=LoadIntRW(Stk,RESULTREG)	/*%o0*/;
	enotecc(-1);
	if ((Rangelab!=-1)&&(Mode!=SPARSESWITCH)) {
		/***********************************************************/
		/*If the Switch Table Mode is set to 1 then generate that **/
		/*falls through if the switch variable is in range: if the**/
		/*Mode is not set to 1 then generate code which jumps to  **/
		/*INDEX as fast as possible                               **/
		/*Of course if it is a sparse switch we do not need this  **/
		/*code at all                                             **/
		/***********************************************************/
		Lower=Tab->Lower;
		Range=Tab->Entries-1;
		Upper=Lower+Range;
#if (Language==CCOMP)
		if (Lower!=0) ARCH(oplit(SUB,reg,Lower,reg));
#endif
		if (Stk->Form==LitVal) {
			/* Can improve this further by fishing                                       */
			/* actual label from table and substituting for index                        */
			/* but must beware if it is not set since                                    */
			/* compiler will Mabort "label not defined"                                  */
			i=Stk->Intvalue;
			if ((i<Lower)||(i>Upper)) {
				ARCH(bcctf(JMP<<16,Rangelab,0));
			} else {
				if (Mode!=1)  ARCH(bcctf(JMP<<16,Index,0));
			}
		} else {
#if (Language==CCOMP)
			ARCH(rlit(CMP,reg,Range,reg));
			if (Mode!=1) {
				ARCH(bcctf(JBE<<16,Index,0));
			} else {
				ARCH(bcctf(JA<<16,Rangelab,0));
			}
#else
			if (Lower==Upper) {
				ARCH(rlit(CMP,reg,Lower,reg));
				if (Mode!=1) {
					ARCH(bcctf(JE<<16,Index,0));
				} else {
					ARCH(bcctf(JNE<<16,Rangelab,0));
				}
				/*Pathological case Upper>2**31*/
			} else if (Upper<Lower) {
				ARCH(rlit(CMP,reg,Lower,reg));
				ARCH(bcctf(JB<<16,Rangelab,0));
				ARCH(rlit(CMP,reg,Upper,reg));
				if (Mode!=1) {
					ARCH(bcctf(JBE<<16,Index,0));
				} else {
					ARCH(bcctf(JA<<16,Rangelab,0));
				}
			} else {
				ARCH(rlit(CMP,reg,Lower,reg));
				ARCH(bcctf(JL<<16,Rangelab,0));
				ARCH(rlit(CMP,reg,Upper,reg));
				if (Mode!=1) {
					ARCH(bcctf(JLE<<16,Index,0));
				} else {
					ARCH(bcctf(JG<<16,Rangelab,0));
				}
			};

#endif
			if (Mode!=1)  ARCH(bcctf(JMP<<16,Rangelab,0));
		}
	} else {
		if ((Language!=CCOMP)&&(Mode!=1))  ARCH(bcctf(JMP<<16,Index,0));
	}
	/**/
	/***********************************************************/
	/**/
	unlockreg(RESULTREG);

}	/* Cswitchjump      */
/***/
void Cfswitchjump(int Switchid,struct Stkfmt *Stk) {
	/****************************************************************/
	/** Load the switch index to an implementation defined register**/
	/** and generate code to jump to the switch code for Switchid  **/
	/** do not perform range checking                              **/
	/****************************************************************/
	int reg;

	reg=LoadIntRW(Stk,RESULTREG);
#if (Language==CCOMP)
	Mabort(980);		/* C always needs Range checking */
#endif
	Cjump(JMP<<16,Switchid,0);
	unlockreg(RESULTREG);
}	/* Cfswitchjump     */
/***/
void Cshift(int Opcode,struct Stkfmt *Stk1,struct Stkfmt *Stk2) {
	/****************************************************************/
	/** Opcode = 0  ISHLL                                          **/
	/**          1  ISHLA         L  left     L  logical           **/
	/**          2  ISHRL         R  right    A  arithmetic        **/
	/**          3  ISHRA                                          **/
	/** stack result of   Stk1  shift by  Stk2                     **/
	/****************************************************************/
	if ((0<=Opcode)&&(Opcode<=3)) 	/*can use int binary op*/{
		CIntBinaryOp(ISHLL+Opcode,Stk1,Stk2,0);
	} else {
		Mabort(33);
	}
}	/* Cshift           */
/***/
void Creturn() {
	/****************************************************************/
	/** return from procedure                                      **/
	/** any result values will already be loaded                   **/
	/** On target R4000 jump to end since exit sequence is complex    **/
	/****************************************************************/
	int Index;
	struct fragfmt *frag;
	frag=(struct fragfmt*)(PI->curfrag);
	frag->props=frag->props|RETURNBRANCH;	/* Jumps to return */
	Index=BLocateLabel(PI->returnlab+Labadjust,0);
	ARCH(bcctf(JMP<<16,Index,0));
}	/* Creturn          */

void Cduplicate() {
	/****************************************************************/
	/** replicate Etos and stack                                   **/
	/****************************************************************/
	struct Stkfmt *Etos;
	int reg;

	Etos=&Stk [Elevel];
	if (((Etos->Form&31)==Fregvar)||((Etos->Form&31)==FregVal)) {
		ARCH(fopr(FLDd,Etos->Reg));
		reg=claimfreg();
#if((Language==FORTRAN)&&(Directcomplex==1))
		if (Etos->Imagreg>0) {
			ARCH(fopr(FLDd,Etos->Imagreg));
			reg=claimfreg();
			Cstackcmplxfr(reg+1,reg,Etos->Size);
			return;
		}
#endif
		Cstackfr(reg,Etos->Size);
	} else Cpushoperand(Etos);
}	/* Cduplicate       */
/***/
void Cdiscardopnd(struct Stkfmt *Stk1) {
	/****************************************************************/
	/** clear any register info associated with operand            **/
	/****************************************************************/
	int Form;
	Form=Stk1->Form&31;
	if (IsRegForm [Form]!=0) {
		if (Stk1->Reg>=FRBASE) {
			if (Stk1->Imagreg>=FRBASE)  manipulateFS(FDISCARD,Stk1->Imagreg);
			manipulateFS(FDISCARD,Stk1->Reg);
		} else unlockreg(Stk1->Reg);
	}
	if ((IsModForm [Form]!=0)&&(IsRegForm [Stk1->Modform&31]!=0))  unlockreg(Stk1->Modreg);
}	/* Cdiscardopnd     */
/**/
void Cdiscard(struct Stkfmt *Lstk) {
	/*************************************************************************/
	/**      Clear info associated with Lstk                                **/
	/**  There is a naughty assumption than Lstk==Etos beware!              **/
	/*************************************************************************/
	Cdiscardopnd(Lstk);
	Elevel-=1;
}	/* Cdiscard         */
/***/
void CCopyAsm(char * Asm,int AFlag) {
	/****************************************************************/
	/** Copy assembler line into instruction stream                **/
	/** Assumes Estack is empty and code generation is up-to-date  **/
	/** AFlag is non-zero if line might contain actual instruction **/
	/****************************************************************/
	struct fragfmt *frag;
	struct instrfmt *instr;
	/**/
	if (AFlag!=0) {
		frag=(struct fragfmt*)(PI->curfrag);
		if ((PI->fragsize!=0)&&((frag->props&USERASSEMFRAG)==0)) {
			BBreakFrag(0);
		}
	}
	/**/
	instr=(struct instrfmt*)(BNewInstr());
	instr->u1.immval=(int)Asm;
	instr->group=COPYASM;
	if (AFlag!=0) {
		frag=(struct fragfmt*)(PI->curfrag);
		frag->props=frag->props|USERASSEMFRAG;
	}
	/**/
	if (AFlag!=0) {
		rclearregs(1);	/* forget register memory                        */
	}
	/**/
}	/* CCopyAsm */
/***/
void Cboundcheck(struct Stkfmt *Bound,struct Stkfmt *Lower,struct Stkfmt *Upper,int Boundlab) {
	/****************************************************************/
	/** all values are integer                                     **/
	/** unless Lower <= Bound <= Upper then jump to Boundlab       **/
	/****************************************************************/
	int BoundReg,Bytes;

	/* Boundlab is outside current proc for IMP so allow for Cjump's actions */


#if(Language==IMP) 
	Boundlab-=Labadjust;
#endif

	Bytes=Bound->Size;
	BoundReg=LoadIntRW(Bound,-1);
	Bound->Form=RegVal|Regflag;
	Bound->Reg=BoundReg;
	/***/
	Cjumpcond(LT|Icompare,Bound,Lower,Boundlab);
	lockreg(BoundReg);	/* just in case it gets trampled */
	/***/
	Cjumpcond(GT|Icompare,Bound,Upper,Boundlab);
	Cstackr(BoundReg,Bytes);
}	/* Cboundcheck      */
/***/
static void GenerateCmpcode(int Align,int Len,int ESIsub) {
	/*************************************************************************/
	/** generates code to compare LEN bytes at [ESI] with                   **/
	/** [EDI]. If ALIGN is set to 0 then a word comparision                 **/
	/** is performed (and the alignment is assumed to be correct).          **/
	/** otherwise a byte comparision will be generated.                     **/
	/**                                                                     **/
	/** Assumes: ALIGN= 4 => both operands are word aligned                 **/
	/**          ALIGN= 1 => both operands are byte aligned                 **/
	/**                                                                     **/
	/** Assumes: LEN< 0 => length is not a LitVal                           **/
	/**          LEN> 0 => length is a LitVal                               **/
	/** If ESI is allocated to the Front End its value is evaluated         **/
	/** in ESIsub and an exch performed at the last minute                  **/
	/*************************************************************************/
	int LoadOp,Cnt;
	if (Align==4) {
		LoadOp=CMPSD; 
		Cnt=(unsigned)Len>>2;
	} else {
		LoadOp=CMPSB; 
		Cnt=Len; 
		Align=1;
	}
	if ((Len>0)&&(Cnt==1)) {
		/*****************************************************/
		/** Generate an Unrolled Loop                       **/
		/*****************************************************/
		/**/
		if (ESIsub!=ESI)  ARCH(rr(XCHG,ESI,-1,ESIsub));
		ARCH(oponly(LoadOp,(1<<ESI)|(1<<EDI),(1<<ESI)|(1<<EDI)));
		ARCH(modinstrprops(0,LOADINSTR,0,0));
	} else {
		/*****************************************************/
		/** Generate a Loop                                 **/
		/*****************************************************/
		if (Cnt>0) {
			ARCH(loadlit(Cnt,ECX));
		} else {
			ARCH(rr(TEST,ECX,ECX,ECX))	/* Ensure dynamic len of 0 OK*/;
		}
		if (ESIsub!=ESI)  ARCH(rr(XCHG,ESI,-1,ESIsub));
		ARCH(oponly(LoadOp,(1<<ECX)|(1<<ESI)|(1<<EDI),(1<<ECX)|(1<<ESI)|(1<<EDI)));
		ARCH(addprefix(iprefix,REP))	/* Make it loop */;
		ARCH(modinstrprops(0,LOADINSTR,0,0));
		if (ESIsub!=ESI)  ARCH(rr(XCHG,ESI,-1,ESIsub));
	}
}	/* of Generate Cmpcode                                                     */
/***/
void Ccomparebytes(int Opcode,struct Stkfmt *Num,struct Stkfmt *Fromad,struct Stkfmt *Withad) {
	/****************************************************************/
	/** Opcode = 0  CPBGT (== GT)                                  **/
	/**          1  CPBLT (== LT)                                  **/
	/**          2  CPBEQ (== EQ)                                  **/
	/**          3  CPBNE (== NE)                                  **/
	/**          4  CPBGE (== GE)                                  **/
	/**          5  CPBLE (== LE)                                  **/
	/** Set hanging condition code                                 **/
	/****************************************************************/
	int Count,Align,Walign;
	int reg1,reg2,reg3;

	/**/
	/*****************************************************/
	/** Check Optimisation Potential                    **/
	/*****************************************************/
	/**/
	enotecc(-1);
	if (Num->Form==LitVal) {
		Count=Num->Intvalue;
		if (Count<=0)  Mabort(19);	/*Invalid Op to Ccomparebytes*/
	} else Count=-1;
	if ((Fromad->Form==AddrDir)&&(Withad->Form==AddrDir)&&(Count>0)) {
		Align=Fromad->Offset&3;
		Walign=Withad->Offset&3;
		/*assume worst case*/
	} else {
		Align=3; 
		Walign=1;
	}


	/*****************************************************/
	/** Initialise for In-Line Code                     **/
	/*****************************************************/
	/**/
	if (registerstatus(ESI)>=8) 	/* ESI alloced to FE*/{
		if (registerstatus(EDX)==0)  reg1=EDX; 
		else reg1=EAX;
		Conditionalreleasereg(reg1,Fromad);
		reg1=LoadIntRW(Fromad,reg1);
	} else {
		Conditionalreleasereg(ESI,Fromad);
		reg1=LoadIntRW(Fromad,ESI);
	}
	Conditionalreleasereg(EDI,Withad);
	reg2=LoadIntRW(Withad,EDI);
	Conditionalreleasereg(ECX,Num);
	if (Count<0)  reg3=LoadIntRW(Num,ECX);
	if (((Align==Walign)&&(Walign==0))&&(Count>0)&&((Count&3)==0)) {
		GenerateCmpcode(1	/*4 on big endian mcs*/,Count,reg1);
	} else {
		GenerateCmpcode(1	/*alignment*/,Count	/*bytes*/,reg1);
	}

	/*****************************************************/
	/** Tidy Up After In-Lining Code                    **/
	/*****************************************************/
	/**/
	enotecc(jops [Opcode]);
	unlockreg(reg1);
	forgetreg(reg1);
	unlockreg(EDI);
	forgetreg(EDI);
	unlockreg(ECX);
	forgetreg(ECX);

}	/* Ccomparebytes    */
/***/
#define LeftToRight 0
#define RightToLeft 1
static void GenerateCopycode(int Sizecode,int Count,int Direction,struct Stkfmt *Num,struct Stkfmt 
*Fromad,struct Stkfmt *Toad) {
	/**************************************************************************/
	/** Generates in-line code for a Copy Operation.                         **/
	/**                                                                      **/
	/** parameters: Sizecode= 0 for a Byte copy                              **/
	/**                     = 1 for a Halfword copy                          **/
	/**                     = 2 for a Word copy                              **/
	/**                                                                      **/
	/**             Count= number of bytes to copy                           **/
	/**                  = 0 if the count is unknown at compile-time         **/
	/**                                                                      **/
	/**************************************************************************/
	/**/
	int SourceReg,CountReg,DestReg,LoadOp;
	/*****************************************************/
	/** Initialise for In-Line Code                     **/
	/*****************************************************/
	/**/
	if (Sizecode==0)  LoadOp=MOVSB; 
	else LoadOp=MOVSD;

	Conditionalreleasereg(EDI,Toad);
	DestReg=LoadIntRW(Toad,EDI);

	if (registerstatus(ESI)>=8) 	/* ESI alloced to FE*/{
		if (registerstatus(EDX)==0)  SourceReg=EDX; 
		else SourceReg=EAX;
		Conditionalreleasereg(SourceReg,Fromad);
		SourceReg=LoadIntRW(Fromad,SourceReg);
	} else {
		Conditionalreleasereg(ESI,Fromad);
		SourceReg=LoadIntRW(Fromad,ESI);
	}
	if (((unsigned)Count>>Sizecode)==1) 	/* Plant unrolled loop */{
		if (SourceReg!=ESI)  ARCH(rr(XCHG,ESI,-1,SourceReg));
		ARCH(oponly(LoadOp,(1<<ESI)|(1<<EDI),(1<<ESI)|(1<<EDI)));
		if (Sizecode==1)  ARCH(addprefix(osprefix,SHORTOPND));
		ARCH(modinstrprops(0,LOADINSTR|STOREINSTR,0,0));
	} else {
		Conditionalreleasereg(ECX,Num);
		CountReg=LoadIntRW(Num,ECX);

		/*****************************************************/
		/** Generate the In-Line Code                       **/
		/*****************************************************/

		if (SourceReg!=ESI)  ARCH(rr(XCHG,ESI,-1,SourceReg));
		if (Direction==RightToLeft) {
			ARCH(rr(ADD,ECX,ESI,ESI));
			ARCH(rr(ADD,ECX,EDI,EDI));
			ARCH(oponly(STD,0,0))	/* Direction flag for backwards )*/;
			ARCH(modinstrprops(DESTROYABLE,0,0,0));
			ARCH(opr(DEC,ESI));
			ARCH(opr(DEC,EDI));
		}
		ARCH(oponly(LoadOp,((1<<ECX)|(1<<ESI))|(1<<EDI),((1<<ECX)|(1<<ESI))|(1<<EDI)));
		ARCH(addprefix(iprefix,REP))	/* Make it loop */;
		if (Sizecode==1)  ARCH(addprefix(osprefix,SHORTOPND));
		ARCH(modinstrprops(0,LOADINSTR|STOREINSTR,0,0));
		if (Direction==RightToLeft) {
			ARCH(oponly(CLD,0,0));
			ARCH(modinstrprops(DESTROYABLE,0,0,0));
		}
		unlockreg(CountReg);
		forgetreg(CountReg);
	}
	if (SourceReg!=ESI)  ARCH(rr(XCHG,ESI,-1,SourceReg));
	unlockreg(SourceReg);
	unlockreg(DestReg);
	forgetreg(SourceReg);
	forgetreg(DestReg);

	CheckIndConflict(Toad);	/* update the register tracking */

}	/* Generate Copycode */

/***/
void Ccopybytes(struct Stkfmt *Num,struct Stkfmt *Fromad,struct Stkfmt *Toad,int Size) {
	/****************************************************************/
	/** if Size = 1 then Num is in bytes                           **/
	/**         = 2 then Num is 16 bit word (aligned) items        **/
	/**         = 4 then Num is 32 bit word (aligned) items        **/
	/****************************************************************/
	int NumReg,freeregs;
	int Sizecode;	/*=0 if Size= 1*/
	/*=1 if Size= 2*/
	/*=2 if Size= 4*/

	int Bytes;

	/* Handle any conflict with the register tracking caused by byte copying     */
	if ((Num->Form==LitVal)&&(Num->Intvalue>0)&&((Toad->Form&31)==AddrDir)&&(Toad->Base==STACK)) {
		CheckConflict(Toad->Base,Toad->Offset,Size*Num->Intvalue);
	} else {
		CheckIndConflict(Toad);
	}

	Sizecode=(unsigned)Size>>1;
	if ((Num->Form==LitVal)&&(Num->Intvalue>=0)) 	/* Can fall over large unsigned ints here */{
		Bytes=Num->Intvalue<<Sizecode;
		if (Bytes<=0) {
			Cdiscardopnd(Toad);
			Cdiscardopnd(Fromad);
			return ;
		}
	} else {
		Bytes=0;
	}

	freeregs=countunclaimedregs();	/* inline copy needs one unclaimed reg here */

	if (IsModForm[Toad->Form] && !(IsIndRegForm[Toad->Form] &&
		SimpleRegForm[Toad->Modform])) freeregs--;
	if ((Fromad->Form==AddrDir && AddrDir==Toad->Form) &&
	    Fromad->Base==Toad->Base && Toad->Offset>Fromad->Offset &&
	    Bytes>abs(Toad->Offset-Fromad->Offset) && freeregs>0) {
		GenerateCopycode(Sizecode,Bytes,RightToLeft,Num,Fromad,Toad);
	} else if ( freeregs>0 && ((Language!=FORTRAN && LanguageVariant!=FORTRAN90) ||
	  (Fromad->Form==AddrDir && AddrDir==Toad->Form) ||
	   (Fromad->Domain!=0 && Toad->Domain!=0 && Fromad->Domain!=Toad->Domain))) {
		GenerateCopycode(Sizecode,Bytes,LeftToRight,Num,Fromad,Toad);
	} else {
		if ((Num->Form&31)==LitVal) {
			Num->Intvalue=Num->Intvalue<<Sizecode;
			Sizecode=0;
		}

		if (Sizecode==0) {
			Elevel+=3;	/* Mspcall expects stacked arguments */
		} else {
			/**/
			Elevel+=2;
			NumReg=LoadIntRW(Num,-1);
			/**/
			ARCH(oplit(SHL,NumReg,Sizecode,NumReg))	/* Num=Num<<Sizecode */;
			Cstackr(NumReg,4);
			/**/
		}
		/**/
		enotecc(-1);
		TargetReg=-1;	/* Ensure no targetting as we may now be */
		TargetFreg=-1;	/* doing a nested call                   */
		/**/

#if(Language==CCOMP) 
		/* swap operands to use standard Clib rt memcpy                              */
		epromote(2);	 
		epromote(3);	 
		epromote(3);
		Mspcall(sp_memcpy);	/* memcpy */
		/* s_bcopy */

#else
		Mspcall(sp_bmove);
#endif
	}

}	/*Ccopybytes        */
/***/
void Cunasscheck(struct Stkfmt *Stk1,int Unasslab) {
	/****************************************************************/
	/** if the Stk item is unassigned then jump to Unasslab - it   **/
	/** relies on Stk_Type being maintained correctly              **/
	/** Heavily revised by PDS for rs6000. Inhereited version      **/
	/** was found to be unsound                                    **/
	/****************************************************************/
	int Reg,Size,Type,Form,StkRegflag;
	struct Stkfmt Lstk;

	/* Unasslab is outside current proc for IMP so allow for Cjump's actions */


#if(Language==IMP) 
	Unasslab-=Labadjust;
#endif
	Lstk=*Stk1;			/* copy across size type etc      */
	Form=Stk1->Form&(Regflag-1);
	Type=Stk1->Type;
	if (Type==MisRealType)  Type=RealType;
	if (Type==MisIntType || Type==MisUintType || Type==UintType) Type=IntType;
	Size=Stk1->Size;
	StkRegflag=0;			/* dont leave in register       */
	if ((Language==FORTRAN)&&(Form!=DirVal))  StkRegflag=1;
	/**/
	if (StkRegflag==0) Cpushoperand(&Lstk);	/* put original back     */
	if (Type==RealType) {
		if (StkRegflag==0)  Reg=LoadRealRO(&Lstk,Size); 
		else {
			Reg=LoadRealTgt(&Lstk,Size);
			Cstackfr(Reg,Size);
		}
	} else {
		if (StkRegflag==0)  Reg=LoadIntRO(&Lstk); 
		else {
			Reg=LoadIntTgt(&Lstk);
			Cstackr(Reg,Size);
		}
	}
	Stkunassigned.Type=Type;
	Stkunassigned.Size=Size;
	Lstk.Form=RegVal|Regflag;	 
	Lstk.Reg=Reg;
	if (Type==RealType || (Type==IntType && Size==8)) {
		Lstk.Form=FregVal|Regflag;
		if (StkRegflag!=0) {		/* If going to leave it stacked */
			Lstk.Reg=claimfreg();	/* must create a copy since it will be popped */
			ARCH(fopr(FLDd,currentFSP));
		}
	}
	epredictjump(0);			/* wont jump       */
	Cjumpcond(EQ|(Type<<8),&Lstk,&Stkunassigned,Unasslab);
	if (StkRegflag!=0 && Type!=RealType && Size!=8)  notereguse(Reg,-Elevel,Size);
	/*because Cjumpcond would have unlocked Reg*/

	/*      After the check the Stk is returned to the Estack.                   */
	/*      The check can be followed by an IADDST etc or an address call        */
	/*      neither of which work correctly if the result is the register        */
	/*      copy made for the test. Fortran does not have these nasties          */
	/*      except on DirVals hence the specials. Other Languages have to        */
	/*      rely on the register memory to avoid store accesses                  */
}	/* Cunasscheck      */
/***/
void Cevaluate(struct Stkfmt *StkEntry,int ForceExt) {
	/****************************************************************/
	/** Force loading of StkEntry item to a register and stack it. **/
	/** Also forces register extension if ForceExt#0.              **/
	/****************************************************************/
	int Reg,Size,Form,Type;
	Size=StkEntry->Size;
	Form=StkEntry->Form&31;
	Type=StkEntry->Type;
	if (((Type==RealType)||(Type==MisRealType))&&(IsAddrForm [Form]==0)) {
		Reg=LoadRealTgt(StkEntry,Size);
		Cstackfr(Reg,Size);
	} else {
		if (ForceExt!=0) {
			if (TargetReg>=0) {
				if ((SimpleRegForm [Form]==0)||(StkEntry->Reg!=TargetReg)) {
					Reg=claimnamedtgt(TargetReg);
				}
				Reg=LoadIntRWNoExt(StkEntry,TargetReg);
			} else {
				Reg=LoadIntRONoExt(StkEntry);
			}
		} else {
			Reg=LoadIntTgt(StkEntry);
		}
		Cstackr(Reg,Size);
		if (Type==UintType)  Stk [Elevel].Type=UintType;
	}
}	/* Cevaluate        */
/***/
void CStructRes(struct Stkfmt *LStk,int Size,int Alignment) {
	/*************************************************************************/
	/** Pass back a structure result LStk==Stk(Elevel+1) is address or res  **/
	/** Address of area is first param                                      **/
	/*************************************************************************/
	struct Stkfmt Tstk;
	int Reg;
	Elevel+=1;	/* Leave Lstk on Estack*/
	estkpar(0,-4,0,4)	/* Push result space address */;
	/* allowing for param offset */
	Tstk=Stk [Elevel];	/* Keep a copy */

	if (Alignment>=4)  Alignment=4; 
	else Alignment=1;
	if (Alignment==4)  Size=(unsigned)Size>>2;
	estklit(Size);	/* Push copy size */
	Elevel-=3;
	Ccopybytes(&Stk [Elevel+3],&Stk [Elevel+1],&Stk [Elevel+2],Alignment);
	Reg=LoadIntRW(&Tstk,RESULTREG);
	PI->privprops=PI->privprops|RETURNSINT;
	unlockreg(RESULTREG);
}	/*CStructRes*/

void Cnoteresult(int Type,struct Stkfmt *Stk) {
	/****************************************************************/
	/** Type = IntType                                             **/
	/**        RealType                                            **/
	/** Stk is the result of the current function. Load it to      **/
	/** appropriate register(s)                                    **/
	/****************************************************************/
	int Reg,Areg;
	struct Stkfmt Msh,Lsh;

	if (Type==RealType) {
		if (Stk->Size==4) {
			PI->privprops=PI->privprops|RETURNSSREAL;
		} else {
			PI->privprops=PI->privprops|RETURNSDREAL;
		}
		Reg=FRESULTREG;
	} else {
		if (Stk->Size<=4) {
			PI->privprops=PI->privprops|RETURNSINT;
		} else {
			PI->privprops=PI->privprops|RETURNSLONG;
		}
		Reg=RESULTREG;
	}
	/**/
	if (Type==RealType) {
		Reg=LoadRealRW(Stk,Reg,Stk->Size);
	} else {
		if (Stk->Size<=4) {
			Reg=LoadIntRW(Stk,Reg);
		} else {
			Areg=Cdividelongint(Stk,&Lsh,&Msh);
			if (Areg!=EDX) {
				Reg=LoadIntRW(&Msh,EDX);
				forgetreg(Reg);	 
				unlockreg(Reg);
				Reg=LoadIntRW(&Lsh,RESULTREG);
			} else {
				Reg=LoadIntRW(&Lsh,RESULTREG);
				forgetreg(Reg);
				unlockreg(Reg);
				Reg=LoadIntRW(&Msh,EDX);
			}
			if (Areg>=0) {
		               unlockreg(Areg);	 
				forgetreg(Areg);
			}
		}
	}
	unlockreg(Reg);
	forgetreg(Reg);

}	/* Cnoteresult      */
/***/
void CnoteIOres() {
	/*************************************************************************/
	/**   AN IO SUCCESS-FAIL FLAG IS IN EAX Save it                         **/
	/*************************************************************************/
	if (PI->IOsave==0)  PI->IOsave=ARCH(tempspace(4,4));
	estkdir(0,PI->IOsave,0,4);
	eop(EDUPSTORE);	/* Leavine a copy in EAX*/
}	/*CnoteIOres*/
/***/
void CstkIOres() {
	/*************************************************************************/
	/**   Restore the Flag saved in the above routine                       **/
	/*************************************************************************/
	estkdir(0,PI->IOsave,0,4);
}	/*CstkIOres*/
/***/
void Cargproc(struct Stkfmt *Stk,int Argslen) {
	/******************************************************************/
	/** Call a procedure passed as an argument.                      **/
	/** Stk is a pointer to 2 words: Word 0 - ep address             **/
	/**                              Word 1 - environment info       **/
	/******************************************************************/
	int Form;

	Form=Stk->Form&31;
	/*      %IF Form = RegVal %OR Form = Regvar %THENSTART                       */
	/*         Reg = Load Int RW (Stk, ClaimSafeReg)                             */
	/*         Cstackr (Reg,4)                                                   */
	/*         Elevel = Elevel - 1                                               */
	/*      %FINISH                                                              */
	/* Pds does not see what above achieves. A Regvar is safe a regval unthinkable*/
	/**/
	Mcall(0,1,0,Argslen,0)	/* get Mcall to do all its nice things */;
	/*   id of 0 signals call via pointer  */
}	/* Cargproc         */
/***/
void Cautostackop(int Op,struct Stkfmt *Lstk) {
	/*************************************************************************/
	/**  Obtain or adjust the front of the Autostack for alloca. Note any   **/
	/**  adjusting must mean we need a real frame pointer                   **/
	/*************************************************************************/
	int Form,Reg1;

	if (Op==SFA) 	/* Read out stack front address as is*/{
		Elevel+=1;
		Lstk=&Stk [Elevel];
		memset(Lstk,0,sizeof( struct Stkfmt));
		Lstk->Form=Regvar|Regflag;
		Lstk->Type=IntType;
		Lstk->Reg=STACKPOINTER;
		Lstk->Size=4;
	} else if (Op==ASF) {
		Form=Lstk->Form&31;
		if (Form==LitVal) {
			ARCH(oplit(ADD,STACKPOINTER,Lstk->Intvalue,STACKPOINTER));
		} else {
			Reg1=LoadIntRO(Lstk);
			ARCH(rr(ADD,Reg1,-1,STACKPOINTER));
			unlockreg(Reg1);
		}
		PI->privprops=(PI->privprops|NOTLEAFRT)|NONVIRTUALFP;
	} else Mabort(999);

}	/*Cautostackop*/
/***/
void Cgetauxsf() {
	/****************************************************************/
	/** Stack the address of the auxiliary stack front             **/
	/** Not used by compilers with swopped data                    **/
	/****************************************************************/
	int auxstackdisp,label,reg1,index;

#if(!((Language==CCOMP)||(Language==FORTRAN))) 
	/*check any admin required to   */
	if (Auxstk.Form==0) 	/* make the Auxilary Stack known*/{
		auxstackdisp=epermspace(4,4);
		pd4(GLA,auxstackdisp,0);
		pdxref(GLA,auxstackdisp,pxname(2,AuxstackName));	/*data*/

		Auxstk.Base=GLA;	/*initialise an Estack record for */
		Auxstk.Size=4;	/*    access to the Auxilary Stack*/
		Auxstk.Offset=auxstackdisp;
		Auxstk.Modform=LitVal;
	}

	if (PI->auxstacklab==0) {
		/* The code below is only executed if we are handling the first reference    */
		/* to the Auxilary Stack within the procedure being compiled and we          */
		/* therefore have to generate code to check if the Auxilary Stack exists.    */

		/*****************************************************/
		/* Generate:   REG1= AUXSTDATA_cur                  **/
		/*****************************************************/
		/**/
		reg1=claimnamedreg(RESULTREG);	/* Must use this in case call jump round     */
		/**/
		Auxstk.Form=IndDirModVal;
		Auxstk.Modintval=8;
		/**/
		ARCH(stkaccess(LoadIntVal,reg1,&Auxstk));
		/*code: LD [%GLABASE+disp],%AREG*/
		/*      LD [%AREG+0X8],%REG1    */
		/**/
		/*****************************************************/
		/* Generate:   %IF REG1= 0 %THENSTART               **/
		/*****************************************************/
		/**/
		label=Mprivatelabel();
		index=BLocateLabel(label+Labadjust,0);
		enotecc(-1);
		/**/
		ARCH(rr(TEST,reg1,reg1,reg1))	/* fast check for zero */;
		ARCH(bcctf(JNE<<16,index,0));
		/*code: cmpi %REG1,0X0,CC0*/
		/*      BNE  label        */
		/**/
		unlockreg(reg1);	/*the register contains junk if we fall through*/

		/*****************************************************/
		/* Generate:   REG1= AUXST (0)                      **/
		/*****************************************************/
		/**/
		estklit(0);	/* Stack param for s#auxst            */
		TargetReg=-1;	/* Ensure no targetting as we may now */
		TargetFreg=-1;	/* be doing a nested call             */
		Mspcall(sp_auxst);	/* Should call s#auxst                */

		/*****************************************************/
		/* Generate:    label: %FINISH                      **/
		/*****************************************************/
		/**/
		eplabel(label);	/*define the position of LABEL*/
		/**/
		/*   Put REG on the ESTACK                                                   */
		/**/
		/*  A side-effect of the above call on Mspcall is to put the result          */
		/*  result register on the Estack even if the generated code when            */
		/*  executed jumps around the call - hence no action is required to          */
		/*  put REG on the Estack                                                    */

		PI->auxstacklab=-1;	/*set flag to note that the auxstack now exists*/
		/*for the current procedure being compiled     */
	} else {

		/*The code below is only executed if the Auxilary Stack has already          */
		/*been referenced by the procedure being compiled - no code is required      */
		/*to check if the Stack has been created.                                    */
		/**/
		/*         simply place AUXSTDATA_cur on the ESTACK                          */

		/*****************************************************/
		/* Generate:   REG1= AUXSTDATA_cur                  **/
		/*****************************************************/
		/**/
		reg1=claimtgtreg();
		Auxstk.Form=IndDirModVal;
		Auxstk.Modintval=8;
		/**/
		ARCH(stkaccess(LoadIntVal,reg1,&Auxstk));
		/*code: LD  [%GLABASE+disp],%AREG*/
		/*      LD  [%AREG+0X8],%REG1    */

		/**/
		/* Put REG1 on the ESTACK                                                    */
		/**/
		Cstackr(reg1,4);
	}

	/* auxstack omission */

#endif
}	/* Cgetauxsf        */
/***/
void Cadjustauxsf(struct Stkfmt *Len) {
	/****************************************************************/
	/** Move the auxiliary stack front by Len - assumes that the   **/
	/** increment is a multiple of 8 except for PASCAL and MODULA  **/
	/** Not used by compilers with swopped data                    **/
	/****************************************************************/
	int reg1,index;


#if(!((Language==CCOMP)||(Language==FORTRAN))) 

#if((Language==PASCAL)||(Language==MODULA)) 
	/* make the literal a multiple of 8 */
	if (Len->Form==LitVal)  Len->Intvalue=((unsigned)(Len->Intvalue+7)>>3)<<3;

#endif
	/**/
	/*****************************************************/
	/* Load Registers                                   **/
	/*****************************************************/
	/**/
	reg1=LoadIntRW(Len,-1)	/*load ETOS in a register*/;
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=8;
	/**/
	if (Len->Form!=LitVal) {
		/*****************************************************/
		/* Generate code for: REG1= (REG1+7) & ~7           **/
		/*****************************************************/
		/**/

#if(((Language==PASCAL)||(Language==MODULA))) 
		ARCH(oplit(ADD,reg1,7,reg1));
		ARCH(oplit(SHR,reg1,3,reg1));
		ARCH(oplit(SHL,reg1,3,reg1));

#endif
		/**/
	}
	/**/
	/*****************************************************/
	/* Generate Code for:  REG1= REG1 + AUXSTDATA_cur   **/
	/*****************************************************/
	/**/
	ARCH(oprx(ADD,reg1,&Auxstk,DESTREG));	/*code: ADD %REG1,AUXSDATA_cur*/
	/**/
	/***************************************************************/
	/* Generate Code for:  %IF REG1> AUXSTDATA_max %THEN -> ABORT **/
	/***************************************************************/
	/**/
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=12;
	enotecc(-1);
	/**/
	ARCH(oprx(CMP,reg1,&Auxstk,DESTREG));	/*code: cmp %REG1,AUXSTDATA_max*/
	/**/
	if (PI->auxstacklab==-1)  PI->auxstacklab=Mprivatelabel();
	/*note: -1 implies that code to check the existence of the Auxstack has      */
	/*      already been generated but as yet no label has been acquired to      */
	/*      jump to if Auxstack overflow or underflow is detected by EAUXADD     */
	/*      or EAUXRES.                                                          */

	index=BLocateLabel(PI->auxstacklab+Labadjust,0);
	/**/
	ARCH(bcctf(JG<<16,index,0));	/*code: BG label*/
	/**/

	/*****************************************************/
	/* Generate Code for:  AUXSTDATA_cur= REG1          **/
	/*****************************************************/
	/**/
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=8;
	/**/
	ARCH(stkaccess(StoreIntVal,reg1,&Auxstk));	/*code: ST %R1,[%AR+8]*/
	/**/
	notereguse(reg1,0,4);
	/* auxstack omission */

#endif
}	/* Cadjustsf        */
/***/
void Cresetauxsf(struct Stkfmt *Reset) {
	/****************************************************************/
	/** Reset the auxiliary stack front to Reset value             **/
	/** Not used by compilers with swopped data                    **/
	/****************************************************************/
	int reg1,reg2,index;


#if(!((Language==CCOMP)||(Language==FORTRAN))) 
	/*****************************************************/
	/* Load Registers                                   **/
	/*****************************************************/
	/**/
	lockreg(RESULTREG);	/*make sure that the   */
	/*     result register */
	/*     is not corrupted*/
	/**/
	reg1=LoadIntRW(Reset,-1)	/*reg1= ETOS           */;
	reg2=claimreg();
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=4;
	/**/
	ARCH(stkaccess(LoadIntVal,reg2,&Auxstk));	/*reg2=AUXSTDATA_base*/
	/**/
	/************************************************************/
	/* Generate Code for: %IF REG1< EPCAUX_base %ORC           **/
	/*                        REG1> EPCAUX_max  %THEN -> ABORT **/
	/************************************************************/
	/**/
	enotecc(-1);
	/**/
	ARCH(rr(CMP,reg2,reg1,reg1))	/*code: cmp %REG1,%REG2,CC0*/;
	/**/
	if (PI->auxstacklab==-1)  PI->auxstacklab=Mprivatelabel();
	/*note: -1 implies that code to check the existence of the Auxstack has      */
	/*      already been generated but as yet no label has been acquired to      */
	/*      jump to if Auxstack overflow or underflow is detected by EAUXADD     */
	/*      or EAUXRES.                                                          */

	index=BLocateLabel(PI->auxstacklab+Labadjust,0);
	/**/
	ARCH(bcctf(JL<<16,index,0))	/*code: BL label */;
	/**/
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=12;
	index=BLocateLabel(PI->auxstacklab+Labadjust,0);
	/**/
	ARCH(stkaccess(LoadIntVal,reg2,&Auxstk));	/*reg2=AUXSTDATA_max         */
	ARCH(rr(CMP,reg2,reg1,reg1))	/*code: cmp %REG1,%REG2,CC0*/;
	ARCH(bcctf(JG<<16,index,0))	/*code: BG label      */;
	/**/
	unlockreg(reg2);

	/*****************************************************/
	/* Generate Code for:  AUXSTDATA_cur= REG1          **/
	/*****************************************************/
	/**/
	Auxstk.Form=IndDirModVal;
	Auxstk.Modintval=8;
	/**/
	ARCH(stkaccess(StoreIntVal,reg1,&Auxstk));	/*code: ST %R1,[%AR+8]*/
	/**/
	unlockreg(reg1);
	/**/
	unlockreg(RESULTREG);	/*unlock the        */
	/*       result     */
	/*       register(s)*/
	/* omission of aux stack support */

#endif
}	/* Cresetauxsf      */
/***/
void Cfillbytes(struct Stkfmt *Ad,struct Stkfmt *Num,struct Stkfmt *Filler) {
	/****************************************************************/
	/** Fill the area at Ad with Num copies of Filler              **/
	/****************************************************************/
	int reg1,reg2,reg3,base,form;
	form=Ad->Form&31;
	if ((form==AddrDir)||(form==AddrDirMod))  base=Ad->Base; 
	else base=-1;
	Conditionalreleasereg(EAX,Filler);
	/*      reg1=Claim named reg(EAX)                                            */
	reg1=LoadIntRW(Filler,EAX);
	Conditionalreleasereg(EDI,Ad);
	/*      reg2=Claim named reg(EDI)                                            */
	reg2=LoadIntRW(Ad,EDI);
	Conditionalreleasereg(ECX,Num);
	/*      reg3=Claim named reg(ECX)                                            */
	reg3=LoadIntRW(Num,ECX);

	ARCH(oponly(STOSB,(1<<ECX)|(1<<EDI),((1<<ECX)|(1<<EDI))|(1<<EAX)));
	ARCH(modinstrprops(0,STOREINSTR,0,0));
	ARCH(addprefix(iprefix,REP));
	ARCH(alterareaoffset(base,-1))	/* Scheduler need to know area if pos */;
	unlockreg(reg1);
	unlockreg(reg2);
	forgetreg(reg2);
	unlockreg(reg3);
	forgetreg(reg2);
}	/* Cfillbytes       */
/***/
void Cstkoldframe() {
	/****************************************************************/
	/** Stack the frame pointer for the preceding stack frame      **/
	/****************************************************************/
	struct Stkfmt Lstk;
	/**/
	memset(&Lstk,0,sizeof( struct Stkfmt));
	Lstk.Form=IndRegVal;
	Lstk.Reg=EBP;
	Lstk.Type=Intval;
	Lstk.Size=4;
	Cpushoperand(&Lstk);
	/***/
}	/* Cstkoldframe     */
/***/
void CSetStructResult(int Offset,int Size,int Align) {
	/*************************************************************************/
	/** Pass a stack area at 'offset' to receive the result of a fn that    **/
	/** that returns an aggregate. This hidden parameter must have been     **/
	/** noted in among the parameter descriptor list passed to Mprecall     **/
	/** and this call must be in the correct place as defined by the list.  **/
	/** Normally first or last                                              **/
	/** When dealing with reverse endian structs there is no problem as the **/
	/** user is required to return the right sort of structure from a fn    **/
	/*************************************************************************/
	struct Stkfmt Lstk;
	memset(&Lstk,0,sizeof( struct Stkfmt));	 
	Lstk.Form=DirVal;	/* set Lst to describe area*/
	Lstk.Size=Size;	 
	Lstk.Base=STACK;
	Lstk.Offset=Offset;	/* Offset already adjusted in Esetstructres             */
	Caddress(&Lstk);	/* take its address                                        */
	Cpushparam(&Lstk);	/* and pass it                                           */
}	/* CSetStructResult */

void Cstkresult(int Type,int Bytes) {
	/****************************************************************/
	/** Type = IntType, RealType etc.                              **/
	/**                                                            **/
	/** Create a stack entry defining the result of the function   **/
	/** from which control has just returned                       **/
	/****************************************************************/
	int Reg,j;
	struct Stkfmt result,msh,lsh;

	/* assume result in reg for time being; cope with memory-based results later */

	/**/
	if (Type==RealType)  Reg=claimfreg(); 
	else Reg=RESULTREG;	/*on top of stack*/
	/*%g3*/
	/**/
	if (Type==StructType) {
		/**/
		Cstackr(Reg,4);
		Stk [Elevel].Form=RegAddr|Regflag;
		Stk [Elevel].Size=4;
		/**/
	} else if (Type==RealType) {
		/**/
		Cstackfr(Reg,Bytes);
	} else if (Type==SetType) {
		Cstackr(Reg,4);
		Crefer(&Stk [Elevel],0,4);
		Stk [Elevel].Size=Bytes;
		Stk [Elevel].Type=Type;
	} else if ((Type==IntType || Type==UintType) && Bytes==8) {
		j=ARCH(tempspace(8,8));
		Stkdir(&result,j,8);
		Reg=Cdividelongint(&result,&lsh,&msh);
		Cstackr(EAX,4);
		j=Cstoreop(&lsh,&Stk [Elevel],0);
		Elevel-=1;
		Cstackr(EDX,4);
		j=Cstoreop(&msh,&Stk [Elevel],0);
		if (Reg >= 0) unlockreg(Reg);
		Elevel-=1;
		Cpushoperand(&result);
		Stk [Elevel].Type=Type;
	} else {
		if ((TargetReg>=0)&&(Reg!=TargetReg)) {
			/**/
			ARCH(copyireg(Reg,TargetReg));
			Reg=claimnamedtgt(TargetReg);
			/**/
		}
		Cstackr(Reg,Bytes);
		Stk [Elevel].Type=Type;
	}




}	/* Cstkresult       */
/***/
void Cstkvr() {
	/****************************************************************/
	/** Create a stack entry defining the variable return index    **/
	/****************************************************************/
	int Reg;

	Reg=RESULTREG;
	Cstackr(Reg,4);

}	/* Cstkvr           */
/***/
/***/
void Ctrampcall(int Id,int Numpars,int Parsize,int Callprops) {
	/****************************************************************/
	/** If Id <> 0 then it's a normal call, otherwise it's a error **/
	/** CallProps gives the call properties:                       **/
	/**                                                            **/
	/**  2**0        : set if call may not return                  **/
	/**  2**16       : set if display register passed via call     **/
	/**  2**17       : set if EDX used as on call to mcount        **/
	/**  2**18       : set if a GENUINE hidden parameter passed    **/
	/**  2**24-2**31 : the procedure type                          **/
	/****************************************************************/
	struct Stkfmt PfDescriptor;
	int reg;

	enotecc(-1);
	PI->privprops=PI->privprops|NOTLEAFRT;
	if (Id==0) {
		Mabort(85);
	} else {
		/**/
		PfDescriptor=Stk [Elevel+1];

		reg=LoadIntRW(&PfDescriptor,EAX)	/* this locks EAX */;
		ARCH(rr(MOV,EBP,EDI,EDI))	/* Old EBP to edi */;
		ARCH(rr(MOV,EAX,FRAMEPOINTER,FRAMEPOINTER));	/* environment to EBP reg */;

		ARCH(call(Id,Parsize,Callprops));
		unlockreg(reg);	/* see above */

		ARCH(rr(MOV,EDI,EBP,EBP))	/* restore old framepointer*/;
		PI->privprops=PI->privprops|CALLSINTERNAL;	/* Could be internal!*/
	}


	/* Params have been rounded up to 8 bytes invisible to FE */

	if ((Parsize&7)==4) Parsize+=4;
	if ((Callprops&(1<<18))!=0)  Parsize-=4;	/* Hidden one removed by callee*/

	if (Parsize==0)  return ;
	/**/
	/* Mark non nested parameter reclaim instructions for later optimisation     */
	/* by the peepholer                                                          */
	/**/
	ARCH(rlit(ADD,ESP,Parsize,ESP));
	if (calllevel==1)  ARCH(modinstrprops(0,0,0,PARAMRECLAIM));
}	/* Ctrampcall            */
/***/

void Ccall(int Id,int Numpars,int Parsize,int Callprops) {
	/****************************************************************/
	/** If Id <> 0 then it's a normal call, otherwise it's a call  **/
	/** using a proc structure whose address is in some known reg. **/
	/** CallProps gives the call properties:                       **/
	/**                                                            **/
	/**  2**0        : set if call may not return                  **/
	/*   2**1        : set if non standard call (ie Msoft's STDCALL)*/
	/**  2**16       : set if display register passed via call     **/
	/**  2**17       : set if EDX used as on call to mcount        **/
	/**  2**18       : set if a GENUINE hidden parameter passed    **/
	/**  2**24-2**31 : the procedure type                          **/
	/****************************************************************/
	struct Stkfmt PfDescriptor;
	int reg;

	enotecc(-1);
	PI->privprops=PI->privprops|NOTLEAFRT;
	if (Id!=0) {
		ARCH(call(Id,Parsize,Callprops));
		/**/
	} else {
		/**/
		PfDescriptor=Stk [Elevel+1];
		/**/

#if(Language==CCOMP || Language==FORTRAN || Language==MODULA) 
		reg=LoadIntRW(&PfDescriptor,EDX);
		/* Languages using proc descriptors */

#else
		reg=LoadIntRW(&PfDescriptor,EAX)	/* this locks EAX */;
		ARCH(loadri(LW,EAX,0,EDX))	/* entry address to EDX by convention */;
		ARCH(rr(MOV,EBP,EDI,EDI))	/* Old EBP to edi */;
		ARCH(loadri(LW,EAX,4,FRAMEPOINTER))	/* environment to EBP reg */;

#endif
		ARCH(callind(EDX,Parsize,Callprops,0));
		unlockreg(reg);	/* see above */

#if(!((Language==CCOMP)||(Language==FORTRAN)||(Language==MODULA))) 
		ARCH(rr(MOV,EDI,EBP,EBP))	/* restore old framepointer*/;

#endif
		/**/
		/**/
		PI->privprops=PI->privprops|CALLSINTERNAL;	/* Could be internal!*/
	}


	/* If doing a Microsoft STDCALL parameters are removed by callee */
	/* However any alignment space must be removed here */
	if (Callprops&2) {
		if ((Parsize&7)==0) return;
		ARCH(rlit(ADD,ESP,4,ESP));
		if (calllevel==1)  ARCH(modinstrprops(0,0,0,PARAMRECLAIM));
		return;
	}
	/* Params have been rounded up to 8 bytes invisible to FE */

	if ((Parsize&7)==4) Parsize+=4;
	if ((Callprops&(1<<18))!=0)  Parsize-=4;	/* Hidden one removed by callee*/

	if (Parsize==0)  return ;
	/**/
	/* Mark non nested parameter reclaim instructions for later optimisation     */
	/* by the peepholer                                                          */
	/**/
	ARCH(rlit(ADD,ESP,Parsize,ESP));
	if (calllevel==1)  ARCH(modinstrprops(0,0,0,PARAMRECLAIM));
}	/* Ccall            */
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            computational code generation                             **/
/**                                                                      **/
/**************************************************************************/
/***/
int Shiftval(int N) {
	/***************************************************************************/
	/** returns  power    if N is a positive power of two                        */
	/** returns  -1       otherwise                                              */
	/***************************************************************************/
	int i;

	if ((N<=0)||((N&(N-1))!=0))  return -1;
	for (i=0; i<=30; i++) {
		if (((N&1)!=0))  return i;
		N=(unsigned)N>>1;
	}
	return -1;
}	/*Shiftval*/
/***/
static int classifylmult(int val) {
	/*************************************************************************/
	/** Check if multiply by val can be done faster by shifts&adds          **/
	/** returns class! shiftval<,16 where class signifies:-                 **/
	/**    =0    multiply is fastest                                        **/
	/**    =1    use small const method                                     **/
	/**    =2    power of 2 use shift                                       **/
	/**    =3    power of 2 +1                                              **/
	/**    =4    power of 2 -1                                              **/
	/**    =5    val =small const *2**N                                     **/
	/*************************************************************************/
	static const int MAXSMALL=9;
	int sval,i;
	sval=Shiftval(val&(-2));
	if (sval>0)  return (sval<<16)|(2+(val&1));

#if(MINCODESIZE!=0) 
	return 0;
#endif
	if (targetvariant!=0)  return 0;	/* Pentium pro mult is PDQ*/
	if ((1<=val)&&(val<=MAXSMALL))  return 1;
	sval=Shiftval(val+1);
	if (sval>0)  return (sval<<16)|4;
	/**/
	sval=0;
	for (i=1; i<=24; i++) {
		if ((val&1)!=0)  goto on;
		val=(unsigned)val>>1;	 
		sval++;
	}
	return 0;
on:

	if ((1<=val)&&(val<=MAXSMALL))  return (sval<<16)|5;
	return 0;
}	/*classify lmult*/
/***/
static void LiteralMultiply(int class,int lit,int RO,int *reg) {
	/******************************************************************************/
	/** class is the class of the multiplier as determined above                 **/
	/** lit is the multiplier which is to be converted into a sequence of shifts,**/
	/** adds,subs or negs. Reg it the register initially holding                 **/
	/** the multiplicand and is set to register number for the result            **/
	/** of the multiply. This routine sometimes uses a scratch register.         **/
	/** RO is non zero if the initial value must not be overwritten              **/
	/******************************************************************************/
	int resreg;	/* working register which will have result      */
	int orig;	/* copy of original register passed in          */
	int shval;	/* amount of shift        */;
	orig=*reg;
	shval=(unsigned)class>>16;
	switch (class&15) {
	case 1:
		/* small literal                                                            */
		if (RO==0)  resreg=orig;
		else resreg=claimreg();
		switch (lit) {
		case 1:

			unlockreg(orig);
			if (RO!=0)  unlockreg(resreg);
			return ;
		case 2:

			if (RO==0) {
				ARCH(rr(ADD,orig,orig,orig));
			} else {
				ARCH(genmemaccess(LEA,resreg,0,orig,0,orig,1,DESTREG,0));
			}
wayout:

			unlockreg(orig);
			if (resreg!=orig)  unlockreg(resreg);
			forgetreg(resreg);
			*reg=resreg;
			return ;
		case 3:

			ARCH(genmemaccess(LEA,resreg,0,orig,1,orig,1,DESTREG,0));
			goto wayout;
		case 4:

			if (!(orig==resreg))  ARCH(rr(MOV,orig,resreg,resreg));
			ARCH(rlit(SHL,resreg,2,resreg));
			goto wayout;
		case 5:

			ARCH(genmemaccess(LEA,resreg,0,orig,2,orig,1,DESTREG,0));
			goto wayout;
		case 6:

			ARCH(genmemaccess(LEA,resreg,0,orig,1,orig,1,DESTREG,0));
			ARCH(rr(ADD,resreg,resreg,resreg));
			goto wayout;
		case 7:

			if (resreg==orig) {
				resreg=claimreg();
			}
			ARCH(rr(MOV,orig,resreg,resreg));
			ARCH(rlit(SHL,resreg,3,resreg));
			ARCH(rr(SUB,orig,resreg,resreg));
			goto wayout;
		case 8:

			if (!(orig==resreg))  ARCH(rr(MOV,orig,resreg,resreg));
			ARCH(rlit(SHL,resreg,3,resreg));
			goto wayout;
		case 9:

			ARCH(genmemaccess(LEA,orig,0,orig,3,orig,1,DESTREG,0));
			goto wayout;
		}	/* end of switch on lit */
	case 2:
		/* Power of 2                                                               */
		if (RO!=0) {
			resreg=claimreg();
			ARCH(rr(MOV,orig,resreg,resreg));
		} else {
			resreg=orig;
		}
		ARCH(rlit(SHL,resreg,shval,resreg));
		goto wayout;
	case 3:
		/* (Power of 2) +1                                                          */
		resreg=orig;
		LiteralMultiply((shval<<16)|2,lit,1,&resreg);
		ARCH(rr(ADD,orig,resreg,resreg));
		goto wayout;
	case 4:
		/* (Power of 2) -1                                                          */
		resreg=orig;
		LiteralMultiply((shval<<16)|2,lit,1,&resreg);
		ARCH(rr(SUB,orig,resreg,resreg));
		goto wayout;
	case 5:
		/* (small const)*(2**N)                                                     */
		resreg=orig;
		LiteralMultiply(1,(unsigned)lit>>shval,0,&resreg);
		ARCH(rlit(SHL,resreg,shval,resreg));
		goto wayout;
	}	/* end of switch on class */
}	/* Literal Multiply */
/***/
void Ctestmaskbits(struct Stkfmt *LHS,struct Stkfmt *RHS,int CCFlag) {
	CIntBinaryOp(IAND,LHS,RHS,CCFlag);
}

static void UnsignedCompare(int Val1,int Val2,int *UnsignedGT,int *UnsignedLT,int *UnsignedEQ) {
	/***************************************************************************/
	/** compares Val1 and Val2 byte-by-byte (assumed unsigned) and sets the      */
	/** appropriate global variable UnsignedGT, UnsignedLT, UnsignedEQ to 1      */
	/** and the other two to 0                                                   */
	/***************************************************************************/
	int i,b1,b2;
	*UnsignedGT=0;	 
	*UnsignedLT=0;	 
	*UnsignedEQ=0;
	for (i=0; i<=1; i++) {
		b1=((unsigned)Val1>>(16-(16*i)))&0xFFFF;
		b2=((unsigned)Val2>>(16-(16*i)))&0xFFFF;
		if (b1>b2) {
			*UnsignedGT=1; 
			return ;
		}
		if (b1<b2) {
			*UnsignedLT=1; 
			return ;
		}
	}
	*UnsignedEQ=1;
}	/* UnsignedCompare */
/***/
static void DoLongIntOp(int Op, struct Stkfmt *LHS, struct Stkfmt *RHS) {
	/*************************************************************************/
	/* do 64-bit signed integer versions of some binary and unary operations */
	/* leaving a descriptor to the result on the Estack                      */
	/*************************************************************************/
	int FPop = 0;
	int Suppop=-1;
	struct Stkfmt Least, LeastR, Most, MostR;
	int reg, areg, areg2;
	static int FPcompares[ILE-IGT+1] = {RGT, RLT, REQ, RNE, RGE, RLE};

	switch(Op) {
	  case IADD:
		FPop = RADD;
		break;

	  case UADD:
		Suppop=exp_ulladd;
		break;

	  case ISUB:
		FPop = RSUB;
		break;

	  case USUB:
		Suppop=exp_ullsub;
		break;

	  case IMULT:
		FPop = RMULT;
		break;

	  case UMULT:
		Suppop=exp_ullmul;
		break;

	  case IDIV:
		FPop = RDIV;
		break;

	  case UDIV:
		Suppop=exp_ulldiv;
		break;
	  case IREM:
	    /* push operands onto Estack as 32-bit words and call support func */
		Elevel += 2;
		epromote(2);
		Elevel -= 1;
		Csplitdouble(&Stk[Elevel+1]);
		edemote(3);
		edemote(3);
		Elevel -= 1;
		Csplitdouble(&Stk[Elevel+1]);
	    Mspcall(sp_arem64);    /* __arem64() */
	    Stk[Elevel].Type = IntType;
	    break;

	  case UREM:
		Suppop=exp_ullrem;
		break;
	  case ISHLL:
	  case ISHLA:
	  case ISHRL:
	  case ISHRA:
		/* get operand into edx/eax, shift amount into ecx and call support func */
		Conditionalreleasereg(EAX, LHS);
		Conditionalreleasereg(EDX, LHS);
		Conditionalreleasereg(ECX, RHS);
		claimnamedreg(EAX);
		areg=Cdividelongint(LHS, &Least, &Most);
		(void)LoadIntRW(&Least, EAX);
		userlockreg(EAX);
		(void)LoadIntRW(&Most, EDX);
		userlockreg(EDX);
		if (areg >= 0) unlockreg(areg);
		if (RHS->Size == 8) {
			areg=Cdividelongint(RHS, &Least, &Most);
			(void)LoadIntRW(&Least, ECX);
			if (areg >= 0) unlockreg(areg);
		 else if (areg==-2) unlockreg(Most.Reg);
		} else {
			(void)LoadIntRW(RHS, ECX);
		}
		userlockreg(ECX);
		if (Op == ISHLL || Op == ISHLA)
			Mspcall(sp_ashl64);    /* __ashl64() */
		else if (Op == ISHRL)
			Mspcall(sp_ushr64);    /* __ushr64() */
		else
			Mspcall(sp_ashr64);    /* __ashr64() */
		Cstkresult(IntType, 8);
		unlockpermreg(EAX);
		unlockpermreg(EDX);
		unlockpermreg(ECX);
		forgetreg(EAX);
		forgetreg(EDX);
		forgetreg(ECX);
		break;

	  case IABS:
		reg = LoadIntRW(LHS, -1);
		ARCH(oponly(FABS, 0, 0));
		unlockregister(reg);
		Cstackr(reg, 8);
		break;

	  case INEG:
	    reg = LoadIntRW(LHS, -1);
	    ARCH(oponly(FCHS, 0, 0));
		unlockregister(reg);
	    Cstackr(reg, 8);
	    break;

	  case INOT:
		areg=Cdividelongint(LHS, &Least, &Most);
		CIntUnaryOp(INOT, &Least);
		CIntUnaryOp(INOT, &Most);
		if (areg >= 0) unlockreg(areg);
		Elevel -= 2;
		Cmakedouble(&Stk[Elevel+2], &Stk[Elevel+1]);
		break;

	  case BNOT:
		areg = Cdividelongint(LHS, &Least, &Most);
		CIntUnaryOp(BNOT, &Least);
		Elevel -= 1;
		if (areg >= 0) unlockreg(areg);
		 else if (areg==-2) unlockreg(Most.Reg);
		Cmakedouble(&LitZero, &Stk[Elevel+1]);
		break;

	  case IAND:
	  case IOR:
	  case IXOR:
		areg = Cdividelongint(LHS, &Least, &Most);
		areg2 = Cdividelongint(RHS, &LeastR, &MostR);
		CIntBinaryOp(Op, &Least, &LeastR, 0);
		CIntBinaryOp(Op, &Most, &MostR, 0);
		if (areg >= 0) unlockreg(areg);
		if (areg2 >= 0) unlockreg(areg2);
		Elevel -= 2;
		Cmakedouble(&Stk[Elevel+2], &Stk[Elevel+1]);
		break;

	  case IGT:
	  case ILT:
	  case IEQ:
	  case INE:
	  case IGE:
	  case ILE:
		FPop = FPcompares[Op-IGT];
		break;

	  case UGT:
	  case ULT:
	  case UGE:
	  case ULE:
		Suppop=exp_ullcmp;
		break;

	  case UEQ:
	  case UNE:
		FPop = FPcompares[Op-UGT];
		break;
	  default:
		Mabort(85);  /* can't do this operation in 64-bits */
		break;
	}
	if (FPop != 0) {
		struct Stkfmt LHregval, RHregval;

#if (Language!=FORTRAN)
 
    /* the code below does not work for Fortran90 as the
    ** compiler does not cause CsetFPUtraps to be called
    **
    ** a review is in progress
    */

		if (fixPrecision) {  /* ensure 64-bit operation */
#if (OutputASSEMBLER!=0)
			pdbytes(areaf387, addrf387, 4, &f387pr64);
#endif
			fixPrecision = 0;
		}
#endif

		LHregval = RHregval = ZeroStk;
		LHregval.Form = RHregval.Form = FregVal|Regflag;
		LHregval.Type = RHregval.Type = RealType;  /* lie */
		LHregval.Size = RHregval.Size = 8;
		LHregval.Reg  = LoadIntRO(LHS);
		RHregval.Reg  = LoadIntRO(RHS);
		CRealBinaryOp(FPop, &LHregval, &RHregval);
		if (FPop >= RGT && FPop <= RLE)
			return;
		Stk[Elevel].Type = IntType;
		if ((Stk[Elevel].Form&31)==FregVal)
			Stk[Elevel].Form=RegVal|Regflag;
		if (FPop==RDIV) {
			/* round the answer towards zero */
			if (floatarea1<=0)  GenerateFloatConstants();
			ARCH(opr(PUSH, EAX));             /* make space at top of stack */
			ARCH(fopmem(FSTCW, ESP, 0, 2));   /* save current FPU control word */
			ARCH(fopfixmem(FLDCW, floatarea1, floatoffset1, 2));  /* set rounding */
			ARCH(oponly(FRNDINT, 0, 0));      /* round FDIV result towards zero */
			ARCH(fopmem(FLDCW, ESP, 0, 2));   /* restore previous FPU control word */
			ARCH(rlit(ADD, ESP, 4, ESP));     /* reclaim stack space */
		}
		return;
	}

	if (Suppop>=0) {
		Cdiscardopnd(LHS);
		Cdiscardopnd(RHS);
		Cpushoperand(LHS);
		Cpushoperand(RHS);
		Mexpcall(Suppop);
		if (Suppop==exp_ullcmp) {
			Cdiscard(&Stk[Elevel]);
			ARCH(rr(TEST,EAX,EAX,EAX));
			enotecc(jops[Op-UGT+6]);
		}
	}
}	/* DoLongIntOp */
/***/
static int SimpleI8Mult(struct Stkfmt *Lit, struct Stkfmt *Opnd) {
    /****************************************************************************/
    /* if Lit is 0 or 1 then push appropriate result and return 1 else return 0 */
    /****************************************************************************/
	if (Lit->Intvalue == 0 && Lit->Modintval == 0) {
		Cdiscardopnd(Opnd);
		LitZero.Size = 8;
		Cpushoperand(&LitZero);
		LitZero.Size = 4;
		return 1;
	} else if (Lit->Intvalue == 1 && Lit->Modintval == 0) {
        Cdiscardopnd(Opnd);
        Cpushoperand(Opnd);
        return 1;
	}
	return 0;
}
/***/
void CIntBinaryOp(int Op,struct Stkfmt *LHS,struct Stkfmt *RHS,int CCFlag) {
	/****************************************************************/
	/** supports IADD,ISUB,IMULT,IDIV,IGT,ILT,IEQ,INE,IGE,ILE,IAND,**/
	/** IOR,IXOR,ISHLL,ISHRL,ISHLA,ISHRA,UGT,ULT,UEQ,UNE,UGE,ULE,  **/
	/** UADD,USUB,UMULT,UDIV,UREM                                  **/
	/** descriptor to result on Estack                             **/
	/** CCFlag signifies :-                                        **/
	/**     For arithmetics #0 set the implied cc                  **/
	/**     For compares Bit mask of CC fields best avoided        **/
	/****************************************************************/
	static const short int Iop [ULE-(IADD)+1] = {
				ADD,
				SUB,IMUL,IDIVIDE,0,0,IDIVIDE,AND,
				OR,0,XOR,SHLV,SHRV,SHLV,SARV,CMP,
				CMP,CMP,CMP,CMP,CMP,0,	/*UMULT .. ULE now follow*/0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,MUL,DIV,DIV,ADD,
				SUB,CMP,CMP,CMP,CMP,CMP,CMP		};
	static const short int Ioplit [ULE-(IADD)+1] = {
				ADD,
				SUB,IMUL,0,0,0,0,AND,
				OR,0,XOR,SHL,SHR,SHL,SAR,CMP,
				CMP,CMP,CMP,CMP,CMP,0,	/*UMULT .. ULE now follow*/0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,MUL,0,0,ADD,
				SUB,CMP,CMP,CMP,CMP,CMP,CMP		};
	/**/
	static const unsigned char Litrange [ULE-(IADD)+1] = {
				3,
				3,3,0,0,0,0,3,
				3,0,3,4,4,4,4,3,
				3,3,3,3,3,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,0,0,0,0,
				0,0,0,0,3,0,0,3,
				3,3,3,3,3,3,3		};
	/**/
	/* The valid ranges for literal operations are defined in this table         */
	/**/
	static const int ranges [11+1] = {
			/* range 0 invalid        */	1,	0,
			/* range 1 signed 16 bits */	-32768,	32767,
			/* range 2 16 bits        */	0,	0xFFFF,
			/* range 3 signed 32 bits */	0x80000000,	0x7FFFFFFF,
			/* range 4 shift literal  */	0,	63,
			/* range 5 15 bits        */	0,	0x7FFF		};

	/**/
	/* range 5 for doing unsigned ops with signed instructions                   */
	/**/
	int Lform,Rform,Reg,Lreg,Rreg,Shift,Lflags,Lval,Rval,Res,bytes,label,Intvalue;
	int ALUop,UnsignedGT,UnsignedLT,UnsignedEQ,ALUoplit,Signed;
	int DoingUnsigned,index,Lowlitlmt,Highlitlmt;

	Lform=LHS->Form&31;
	Rform=RHS->Form&31;
	bytes=LHS->Size;
	DoingUnsigned=0;
	if (Op==INMOD) {
		/**/
		if (bytes==8)
		    Mabort(85);

		if (Rform!=LitVal) {
			RHS->Reg=LoadIntRW(RHS,-1);
			RHS->Form=RegVal|Regflag;
			RHS->Size=4;
			Rform=RegVal;
		}
		/**/
		enotecc(-1);
		label=Mprivatelabel();
		if (Rform!=LitVal) {
			/* take a safe copy */
			Rreg=claimsafereg();
			ARCH(copyireg(RHS->Reg,Rreg));
		}
		CIntBinaryOp(IREM,LHS,RHS,0);
		Reg=Stk [Elevel].Reg;
		ARCH(rr(TEST,Rreg,Rreg,Rreg));
		ARCH(bcc(JGE<<16,BLocateLabel(label+Labadjust,0),0));
		if (Rform==LitVal) {
			ARCH(oplit(ADD,Reg,RHS->Intvalue,Reg));
		} else {
			ARCH(rr(ADD,Reg,Rreg,Reg));
			unlockreg(Rreg);
		}
		eplabel(label);
		/**/
		goto Return;
	}
	if (Op==UNMOD) {
		if (bytes==8)
		    Mabort(85);

		CIntBinaryOp(UREM,LHS,RHS,0);
		/* no need to fiddle result since it must be +ve (unsigned) */
		goto Return;
	}
	if (Op==IMDIV) {
		if (bytes==8)
		    Mabort(85);

		label=Mprivatelabel();
		CIntBinaryOp(IDIV,LHS,RHS,0);
		Reg=Stk [Elevel].Reg;

		enotecc(-1);
		ARCH(rr(TEST,Reg,Reg,Reg));
		ARCH(bcc(JL<<16,BLocateLabel(label+Labadjust,0),0));
		ARCH(opr(DEC,Reg));

		eplabel(label);
		goto Return;
	}
	ALUop=Iop [Op-(IADD)];
	ALUoplit=Ioplit [Op-(IADD)];
	index=Litrange [Op-(IADD)];
	Lowlitlmt=ranges [2*index];
	Highlitlmt=ranges [(2*index)+1];
	/**/
	/* Check for const operands or regs with Known value                         */
	/**/
	Lflags=0;
	if (Lform==LitVal) {
		Lval=LHS->Intvalue;
		Lflags=2;
	}
	if ((Lform==RegVal) && (CheckConstantOp(LHS->Reg,&Lval)!=0))  Lflags=2;
	if (Rform==LitVal) {
		Rval=RHS->Intvalue;
		Lflags|=1;
	}
	if ((Rform==RegVal) && (CheckConstantOp(RHS->Reg,&Rval)!=0))  Lflags|=1;
	if (Lflags!=3 || bytes==8) goto Nofold;
	/* Can fold op */
	if ((UGT<=Op) && (Op<=ULE))  UnsignedCompare(Lval,Rval,&UnsignedGT,&UnsignedLT,&UnsignedEQ);
	switch (Op) {

	case IADD:
	case UADD:
		/* guard against compile-time overflow */
		if (((Lval>=0) && (Rval>=0)) && ((0x7FFFFFFF-Lval)<Rval))  goto Nofold;
		if (Op==IADD) {
			if (((Lval<0) && (Rval<0)) && (((int)0x80000001-Lval)>Rval))  goto Nofold;
		}
		/**/
		Res=Lval+Rval;
		goto Set;

	case IAND:
		Res=Lval&Rval;
		goto Set;

	case IOR:
		Res=Lval|Rval;
		goto Set;

	case IXOR:
		Res=Lval^Rval;
		goto Set;

	case ISUB:
		/* guard against compile-time overflow */
		if (((Lval>=0) && (Rval<0)) && ((Lval-0x7FFFFFFF)>Rval))  goto Nofold;
		if (((Lval<0) && (Rval>=0)) && ((Lval-(int)0x80000001)<Rval))  goto Nofold;
		/**/
		Res=Lval-Rval;
		goto Set;

	case IMULT:
	case UMULT:
		{
			double l,r;
			l=(double)Lval;
			r=(double)Rval;
			if (fabs(l*r)<0x7FFFFFFF)  Res=Lval*Rval;
			else Lflags=0;
		}
		if (Lflags>0)  goto Set;
		goto Nofold;

	case IDIV:
		if ((Lval!=0x80000000) && (Rval!=0)) {
			Res=Lval / Rval;
			goto Set;
		}
		goto Nofold;
Set:
		Cdiscardopnd(LHS);
		Cdiscardopnd(RHS);
		estklit(Res);
		goto Return;

	case IGT:
		if (Lval>Rval)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetICC;

	case ILT:
		if (Lval<Rval)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetICC;

	case IEQ:
		if (Lval==Rval)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetICC;

	case INE:
		if (Lval!=Rval)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetICC;

	case IGE:
		if (Lval>=Rval)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetICC;
	case ILE:
		if (Lval<=Rval)  Res=ALWAYS;	
		else Res=NEVER;

SetICC:

		enotecc(Res);		/* CCfield irrelvant for always & never   */
		Cdiscardopnd(LHS);
		Cdiscardopnd(RHS);
		return ;

	case UGT:
		if (UnsignedGT==1)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetUCC;
	case ULT:
		if (UnsignedLT==1)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetUCC;
	case UEQ:
		if (UnsignedEQ==1)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetUCC;
	case UNE:
		if (UnsignedEQ==0)  Res=ALWAYS;	
		else Res=NEVER;
		goto SetUCC;
	case UGE:
		if ((UnsignedGT==1)||(UnsignedEQ==1))  Res=ALWAYS;	
		else Res=NEVER;
		goto SetUCC;
	case ULE:
		if ((UnsignedLT==1)||(UnsignedEQ==1))  Res=ALWAYS;	
		else Res=NEVER;

SetUCC:
                enotecc(Res);           /* CCfield irrelvant for always & never   */
                Cdiscardopnd(LHS);
                Cdiscardopnd(RHS);
                return ;

		/***/
	case ISHLL:
		Res=Lval<<Rval;
		goto Set;
	case ISHRL:
		Res=(unsigned)Lval>>Rval;
		goto Set;
	case ISHLA:
		Res=Lval<<Rval;
		goto Set;
	case ISHRA:
		if (Lval>=0) {
			Lval=(unsigned)Lval>>Rval;
			goto Set;
		}
		for (Res=1; Res<=Rval; Res++)  Lval=((unsigned)Lval>>1)|0x80000000;
		Res=Lval;
		goto Set;
	default:		
		;
	}
Nofold:

	switch (Op) {

	case UADD:
		LHS->Type=UintType;
		RHS->Type=UintType;
		DoingUnsigned=1;
		/**/
		/**/

	case IADD:
	case IAND:
	case IOR:
	case IXOR:

		if ((Lform==LitVal) && (CCFlag==0) &&
		      ((bytes<=4 && LHS->Intvalue==0) ||
		       (bytes==8 && LHS->Intvalue==0 && LHS->Modintval==0))) {
			Cdiscardopnd(RHS);
			if (Op==IAND) {
				LitZero.Size=(bytes==8? 8 : 4);
				Cpushoperand(&LitZero);
				LitZero.Size=4;
			} else Cpushoperand(RHS);
			goto Return;
		} else if ((Rform==LitVal) && (CCFlag==0) &&
			     ((bytes<=4 && RHS->Intvalue==0) ||
			      (bytes==8 && RHS->Intvalue==0 && RHS->Modintval==0))) {
			Cdiscardopnd(LHS);
			if (Op==IAND) {
				LitZero.Size=(bytes==8? 8 : 4);
				Cpushoperand(&LitZero);
				LitZero.Size=4;
			} else Cpushoperand(LHS);
			goto Return;
		}

i8op:
		if (bytes==8) {
			DoLongIntOp(Op, LHS, RHS);
			goto Return;
		}

		if (Lform==LitVal) {
rlitop:

			if (TargetReg>=0)  Reg=claimnamedtgt(TargetReg);
			else Reg=-1;
			/**/
			if (LHS->Size>RHS->Size) {
				Reg=LoadIntRW(RHS,Reg);
			} else {
				Reg=LoadIntRWNoExt(RHS,Reg);
			}
			/**/
			/**/
			if ((Lowlitlmt<=LHS->Intvalue) && 
			    (LHS->Intvalue<=Highlitlmt) && (ALUoplit!=0)) {
				ARCH(oplit(ALUoplit,Reg,LHS->Intvalue,Reg));
			} else {
				Lreg=LoadIntRO(LHS);
				ARCH(rr(ALUop,Reg,Lreg,Reg));
				unlockreg(Lreg);
			}
			/**/
		} else if (Rform==LitVal) {
roplit:
			if (TargetReg<0)  Reg=-1;
			else Reg=claimnamedtgt(TargetReg);
			/**/
			if (RHS->Size>LHS->Size) {
				Reg=LoadIntRW(LHS,Reg);
			} else {
				Reg=LoadIntRWNoExt(LHS,Reg);
			}
			/**/
			if ((Lowlitlmt<=RHS->Intvalue) &&
			    (RHS->Intvalue<=Highlitlmt) &&
			    (ALUoplit!=0)) {
				ARCH(oplit(ALUoplit,Reg,RHS->Intvalue,Reg));
			} else {
				Rreg=LoadIntRO(RHS);
				ARCH(rr(ALUop,Reg,Rreg,Reg));
				unlockreg(Rreg);
			}
			/**/
		} else {
ropr:
			if ((TargetReg<0) ||
			    ((RHS->Reg==TargetReg)&&((Rform==RegVal)||(Rform==Regvar))))
				Reg=-1; 
			else Reg=claimnamedtgt(TargetReg);
			/**/
			/* it is possible to run right out of regs here if both sides */
			/* are indregmodvals modified by regvals and all user regs are*/
			/* claimed                                                    */
			if (Reg<0) {
				Reg=claimunusedreg();
				if (Reg>=0) {
					unlockreg(Reg);
					Reg=-1;
				} else {
					if ((IsRegForm [Lform]!=0)&&(registerstatus(LHS->Reg)==1)) {
						Reg=LHS->Reg;
					} else {
						Elevel+=2;
						freeregs();
						Elevel-=2;
					}
				}
			}
			/**/
			if (CCFlag!=0) {
				Reg=LoadIntRW(LHS,Reg);
			} else {
				Reg=LoadIntRWNoExt(LHS,Reg);
			}
			/**/
			if ((CCFlag!=0)||(RHS->Size<4)||((RHS->Flags&STKSWOPPED)!=0)) {
				Rreg=LoadIntRO(RHS);
				ARCH(rr(ALUop,Rreg,Reg,Reg));
				unlockreg(Rreg);
			} else {
				ARCH(oprx(ALUop,Reg,RHS,DESTREG));
			}
			/**/
		}
		/***/
		forgetreg(Reg);
stackreturn:

		if ((Language==CCOMP)&&(LHS->Size<4)) {
			Cstackr(Reg,LHS->Size	/* result width is that of LHS */);
		} else {
			Cstackr(Reg,4)	/* result width is 4 */;
		}

		goto Return;
		/***/

	case USUB:
		LHS->Type=UintType;
		RHS->Type=UintType;
		DoingUnsigned=1;
		/**/
		/**/

	case ISUB:
		/***/

		if (bytes==8) goto i8op;
		if ((Rform==LitVal) && (ALUoplit!=0))  goto roplit;
		goto ropr;

	case ISHLL:
	case ISHRL:
	case ISHLA:
	case ISHRA:
		if (LHS->Size == 8) {
			DoLongIntOp(Op, LHS, RHS);
			goto Return;
		}

		if ((LHS->Type==UintType)||(LHS->Type==MisUintType))  DoingUnsigned=1;
		if ((Rform==LitVal) && (ALUoplit!=0) && (0<=RHS->Intvalue) && (RHS->Intvalue<=31))
			  goto roplit;
		Conditionalreleasereg(ECX,RHS);
		Rreg=LoadIntGeneral(RHS,ECX,1,0);
		userlockreg(ECX);
		if (TargetReg<0)  Reg=-1;
		else Reg=claimnamedtgt(TargetReg);
		/**/
		Reg=LoadIntRW(LHS,Reg);
		label=Mprivatelabel();
		ARCH(opr(DEC,ECX));
		ARCH(bcctf(JL<<16,BLocateLabel(label+Labadjust,0),0));
		ARCH(oplit(ALUoplit,Reg,1,Reg))	/* shift by 1 */;
		ARCH(opr(ALUop,Reg))	/* and by (x-1)*/;
		eplabel(label);
		unlockpermreg(ECX);
		forgetreg(Reg);
		unlockreg(Reg);
		goto stackreturn;
		/***/

	case UGT:
	case ULT:
	case UEQ:
	case UNE:
	case UGE:
	case ULE:
		LHS->Type=UintType;
		RHS->Type=UintType;
		Signed=0;
		Op-=UGT;
		if (LHS->Size == 8 || RHS->Size == 8) {
			DoLongIntOp(Op+UGT, LHS, RHS);
			goto Return;
		}
		goto docompare;

	case IGT:
	case ILT:
	case IEQ:
	case INE:
	case IGE:
	case ILE:
		Signed=1;
		Op-=IGT;

		if (LHS->Size == 8 || RHS->Size == 8) {
			DoLongIntOp(Op+IGT, LHS, RHS);
			goto Return;
		}

docompare:
		/**/
		/* compares of = and # still work correctly on swopped items so avoid unswopping*/
		/**/
		if (((Op==(IEQ-IGT)) || (Op==(INE-IGT))) &&
			 ((LHS->Flags&STKSWOPPED)!=0) && ((RHS->Flags&STKSWOPPED)!=0)) {
			LHS->Flags=LHS->Flags&(~STKSWOPPED);
			RHS->Flags=RHS->Flags&(~STKSWOPPED);
		}
		if (Lform==LitVal) {
			Intvalue=LHS->Intvalue;
			if ((Intvalue==1) && (Op==(ILE-IGT)) && (Signed!=0)) {
				Intvalue=0;
				Op=ILT-IGT;
			}
			/* Change 1<=x to 0<x without loss of generality*/

			if ((Language==IMP) && (RHS->Size==1))  Signed=0;
			if ((Op==(IEQ-IGT)) || (Op==(INE-IGT)) || ((RHS->Flags&STKSWOPPED)==0)) {
				if (((RHS->Size==4) && (Intvalue>127 || Intvalue<-128 || (RHS->Flags&STKSWOPPED)!=0)) ||
					((RHS->Size==1) && 
						(((Signed==1) && ((-128<=Intvalue) && (Intvalue<=127))) || 
						((Signed==0) && ((0<=Intvalue) && (Intvalue<=255))))) ||
					 ((RHS->Size==2) && 
						(((Signed==1) && ((-32768<=Intvalue) && (Intvalue<=32767))) ||
						 ((Signed==0) && ((0<=Intvalue) && (Intvalue<=0xFFFF)))))) {
					ARCH(oprx(ALUoplit,Intvalue,RHS,SOURCELIT));
					enotecc(jopsr [Op+(6*Signed)]);
					goto Return;
				}
			}
			/**/
			Rreg=LoadIntRO(RHS);
			/**/
			if (Intvalue==0) {
				ARCH(rr(TEST,Rreg,Rreg,Rreg));
				enotecc(jopsr [Op+(6*Signed)]);
				unlockreg(Rreg);
				goto Return;
			}
			/**/
			ARCH(oplit(ALUoplit,Rreg,Intvalue,Rreg));
			unlockreg(Rreg);
			enotecc(jopsr [Op+(6*Signed)]);
		} else if (Rform==LitVal) {
			Intvalue=RHS->Intvalue;
			if ((Intvalue==1) && (Op==(IGE-IGT)) && (Signed!=0)) {
				Intvalue=0;
				Op=IGT-IGT;
			}
			/* Change x>=1 to x>0 without loss of generality*/
			/**/
			if ((Language==IMP) && (LHS->Size==1))  Signed=0;
			if ((Op==(IEQ-IGT)) || (Op==(INE-IGT))||((LHS->Flags&STKSWOPPED)==0)) {
				if (((LHS->Size==4) && 
					(Intvalue>127 || Intvalue<-128 || (LHS->Flags&STKSWOPPED)!=0)) || 
				    ((LHS->Size==1) && 
					(((Signed==1) && ((-128<=Intvalue) && (Intvalue<=127))) ||
					((Signed==0) && ((0<=Intvalue) && (Intvalue<=255))))) ||
				    ((LHS->Size==2) && 
					(((Signed==1) && ((-32768<=Intvalue) && (Intvalue<=32767))) ||
					((Signed==0) && ((0<=Intvalue) && (Intvalue<=0xFFFF)))))) {
					ARCH(oprx(ALUoplit,Intvalue,LHS,SOURCELIT));
					enotecc(jops [Op+(6*Signed)]);
					goto Return;
				}
			}
			/**/
			Lreg=LoadIntRO(LHS);
			/**/
			if (Intvalue==0) {
				ARCH(rr(TEST,Lreg,Lreg,Lreg));
				enotecc(jops [Op+(6*Signed)]);
				unlockreg(Lreg);
				goto Return;
			}
			/**/
			ARCH(oplit(ALUoplit,Lreg,Intvalue,Lreg));
			/**/
			unlockreg(Lreg);
			enotecc(jops [Op+(6*Signed)]);
		} else {
			Lreg=LoadIntRO(LHS);
			if ((RHS->Size==1)||((RHS->Flags&STKSWOPPED)!=0)) {
				Rreg=LoadIntRO(RHS);
				ARCH(rr(ALUop,Rreg,Lreg,Lreg));
				unlockreg(Rreg);
			} else {
				ARCH(oprx(ALUop,Lreg,RHS,DESTREG));
			}
			unlockreg(Lreg);
			enotecc(jops [Op+(6*Signed)]);
		}

		goto Return;
		/***/

	case UMULT:
		DoingUnsigned=1;
		LHS->Type=UintType;
		RHS->Type=UintType;

	case IMULT:
		if (Lform==LitVal) {
			if (CCFlag==0) {

				if (bytes==8)
					if (SimpleI8Mult(LHS, RHS)) return;
					goto i8op;

				TargetReg=-1;	/* Don't allow targetting when doing lit. mult. */
				TargetFreg=-1;
				if (LHS->Intvalue==0) {
					Cdiscardopnd(RHS);
					Cpushoperand(&LitZero);
					return ;
				}
				Shift=classifylmult(LHS->Intvalue);
				if (Shift>0) {
					Rreg=LoadIntRW(RHS,-1);
					LiteralMultiply(Shift,LHS->Intvalue,0,&Rreg);
					forgetreg(Rreg);
					Reg=Rreg;
					goto stackreturn;
				}
			}
			if (DoingUnsigned==0)  goto rlitop;
		}
		if (Rform==LitVal) {
			if (CCFlag==0) {

				if (bytes==8)
					if (SimpleI8Mult(RHS, LHS)) return;
					goto i8op;

				TargetReg=-1;	/* Don't allow targetting when doing a lit. mult. */
				TargetFreg=-1;
				if (RHS->Intvalue==0) {
					Cdiscardopnd(LHS);
					Cpushoperand(&LitZero);
					return ;
				}
				Shift=classifylmult(RHS->Intvalue);
				if (Shift>0) {
					Lreg=LoadIntRW(LHS,-1);
					LiteralMultiply(Shift,RHS->Intvalue,0,&Lreg);
					forgetreg(Lreg);
					Reg=Lreg;
					goto stackreturn;
				}
			}
			if (DoingUnsigned==0)  goto roplit;
		}
		/**/
		if (bytes==8) goto i8op;
		if (DoingUnsigned==0) goto ropr;
		/* Now unsigned which must use EAX/EDX                                       */
		Conditionalreleasereg(EAX,LHS);
		Reg=LoadIntRW(LHS,EAX);
		Lreg=claimnamedreg(EDX);
		userlockreg(EAX);
		userlockreg(EDX);
		if ((RHS->Size<4)||((RHS->Flags&STKSWOPPED)!=0)) {
			Rreg=LoadIntRO(RHS);
			ARCH(opr(ALUop,Rreg));
			unlockreg(Rreg);
		} else {
			ARCH(oprx(ALUop,EAX,RHS,NOREG));
		}
		unlockpermreg(EAX);
		unlockpermreg(EDX);
		forgetreg(EDX);
		forgetreg(EAX);
		goto stackreturn;
		/***/

	case UDIV:
		DoingUnsigned=1;
		if (bytes==8) {
			DoLongIntOp(Op, LHS, RHS);
			goto Return;
		}
		LHS->Type=UintType;
		RHS->Type=UintType;
		/**/
		if (Rform==LitVal) {
			Shift=Shiftval(RHS->Intvalue);
			if (Shift>0) {
				enotecc(-1);
				Lreg=LoadIntRO(LHS);
				Reg=claimtgtreg();
				ARCH(rlit(SHR,Lreg,Shift,Reg));
				unlockreg(Lreg);
				forgetreg(Reg);
				goto stackreturn;
			}
			if (Shift==0) 	/*optimisation for divide by 1*/{
				Cdiscardopnd(LHS);
				Cpushoperand(LHS);
				goto Return;
			}
		}

	case IDIV:
		if (bytes==8) goto i8op;
		if (Rform==LitVal) {
			Shift=Shiftval(RHS->Intvalue);
			if (Shift>0) {
				Reg=LoadIntRW(LHS,-1);
				label=Mprivatelabel();
				index=BLocateLabel(label+Labadjust,0);
				ARCH(rr(TEST,Reg,Reg,Reg));
				ARCH(bcctf(JGE<<16,index,0));
				ARCH(rlit(ADD,Reg,RHS->Intvalue-1,Reg));
				Mplabel(label);
				ARCH(rlit(SAR,Reg,Shift,Reg));
				unlockreg(Reg);
				goto stackreturn;
			}
		}
		goto dodivide;

	case UREM:
		DoingUnsigned=1;
		if (bytes==8) {
			DoLongIntOp(Op, LHS, RHS);
			goto Return;
		}
		LHS->Type=UintType;
		RHS->Type=UintType;
		if (Rform==LitVal) {
			Shift=Shiftval(RHS->Intvalue);
			if (Shift>0) {
				Lreg=LoadIntRO(LHS);
				Reg=claimtgtreg();
				ARCH(rlit(AND,Lreg,RHS->Intvalue-1,Reg));	/* oplit may optimise and not set cc0*/
				unlockreg(Lreg);
				forgetreg(Reg);
				goto stackreturn;
			}
			if (Shift==0) {
				Cdiscardopnd(LHS);
				Cpushoperand(&LitZero);
				goto Return;
			}
		}
		/***/
dodivide:
		Elevel+=2;
		Lreg=claimnamedreg(EDX);
		Elevel-=2;
		Conditionalreleasereg(EAX,LHS);
		Reg=LoadIntRW(LHS,EAX);
		userlockreg(EAX);
		userlockreg(EDX);
		if (DoingUnsigned==1) {
			ARCH(rr(XOR,EDX,EDX,EDX));
		} else {
			if (targetvariant==0) {
				ARCH(rr(MOV,EAX,EDX,EDX));
				ARCH(rlit(SAR,EDX,31,EDX))	/* Recommended instead oc CDQ on P5 & earlier*/;
			} else {
				ARCH(oponly(CDQ,257<<EDX,1<<EAX));
			}
		}
		if ((Rform==LitVal)||(RHS->Size<4)||((RHS->Flags&STKSWOPPED)!=0)) {
			Rreg=LoadIntRO(RHS);	/* divisor                                             */
			ARCH(opr(ALUop,Rreg));
			unlockreg(Rreg);
		} else {
			ARCH(oprx(ALUop,EAX,RHS,NOREG));
		}
		unlockpermreg(EAX);
		unlockpermreg(EDX);
		forgetreg(EDX);
		forgetreg(EAX);
		Reg=EAX;
		if ((Op==IREM)||(Op==UREM))  Reg=EDX;	/* here be remainder */
		goto stackreturn;

	case IREM:
		if (bytes==8) goto i8op;
		if (Rform==LitVal) {
			Shift=Shiftval(RHS->Intvalue);
			if (Shift>0) {
				Lreg=LoadIntRO(LHS);
				Reg=claimtgtreg();
				label=Mprivatelabel();
				index=BLocateLabel(label+Labadjust,0);
				ARCH(rr(MOV,Lreg,Reg,Reg));
				ARCH(rlit(AND,Reg,RHS->Intvalue-1,Reg));	/* oplit may optimise and not set cc0*/
				ARCH(bcctf(JE<<16,index,0));
				ARCH(rr(TEST,Lreg,Lreg,Lreg));
				ARCH(bcctf(JGE<<16,index,0));
				ARCH(oplit(ADD,Reg,-RHS->Intvalue,Reg));
				eplabel(label);
				unlockreg(Lreg);
				forgetreg(Reg);
				goto stackreturn;
			}
			if (Shift==0) {
				Cdiscardopnd(LHS);
				Cpushoperand(&LitZero);
				goto Return;
			}
		}
		goto dodivide;
	}
Return:

	if (DoingUnsigned!=0)  Stk [Elevel].Type=UintType;

}	/* C Int Binary Op  */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void CIntUnaryOp(int Op,struct Stkfmt *RHS) {
	/****************************************************************/
	/** supports INEG,IABS                                         **/
	/** descriptor to result on Estack                             **/
	/****************************************************************/
	int Reg,Rreg,bytes,Label,Index,intval;

	bytes=RHS->Size;

	if (bytes==8) {
	    DoLongIntOp(Op, RHS, NULL);
	    return;
	}

	intval=RHS->Intvalue;
	if (((RHS->Form==LitVal)||(((RHS->Form&31)==RegVal)&&(CheckConstantOp(RHS->Reg,&intval)!=0)))) {
		if (RHS->Form!=LitVal)  Cdiscardopnd(RHS);
		if ((Op==INEG)&&(intval!=0x80000000)) {
			estklit(-intval); 
			return ;
		}
		if (Op==INOT) {
			estklit(~intval); 
			return ;
		}
		if (Op==BNOT) {
			estklit(intval^1); 
			return ;
		}
		if ((Op==IABS)&&(intval!=0x80000000)) {
			estklit(abs(intval)); 
			return ;
		}
	}
	/**/
	if (TargetReg<0)  Reg=-1; 
	else Reg=claimnamedtgt(TargetReg);
	Rreg=LoadIntRW(RHS,Reg);

	if (Op==INEG) {
		ARCH(opr(NEG,Rreg));
	} else if (Op==INOT) {
		ARCH(opr(NOT,Rreg));	/* not  result                                         */
	} else if (Op==BNOT) {
		ARCH(rlit(XOR,Rreg,1,Rreg));
	} else {
		if (!(Op==IABS))  Mabort(15);
		Label=Mprivatelabel();
		Index=BLocateLabel(Label+Labadjust,0);
		ARCH(rr(TEST,Rreg,Rreg,Rreg));	/* set flags                                 */
		ARCH(bcctf(JGE<<16,Index,0));
		ARCH(opr(NEG,Rreg));
		eplabel(Label);
	}


	unlockreg(Rreg);
	forgetreg(Rreg);
	Cstackr(Rreg,bytes);
}	/* Int Unary Op     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void CRealBinaryOp(int Op,struct Stkfmt *LHS,struct Stkfmt *RHS) {
	/****************************************************************************/
	/** supports RADD,RSUB,RMULT,RDIV,RGT,RLT,REQ,RNE,RGE,RLE                  **/
	/** descriptor to result on Estack                                         **/
	/****************************************************************************/
	static const int RRop [RDIV+12-(RADD)+1] = {
				(FADDm<<16)|FADDP,
				(FSUBm<<16)|FSUBP,(FMULm<<16)|FMULP,(FDIVm<<16)|FDIVP,
				(FADDd<<16)|FADDP,(FSUBd<<16)|FSUBP,(FMULd<<16)|FMULP,
				(FDIVd<<16)|FDIVP,
				FADDP,FSUBP,FMULP,FDIVP,FADDP,FSUBP,FMULP,FDIVP
				};
	static const int RRopr [RDIV+12-(RADD)+1] = {
				(FADDm<<16)|FADDP,
				(FSUBRm<<16)|FSUBRP,(FMULm<<16)|FMULP,(FDIVRm<<16)|FDIVRP,
				(FADDd<<16)|FADDP,(FSUBRd<<16)|FSUBRP,(FMULd<<16)|FMULP,
				(FDIVRd<<16)|FDIVRP,
				FADDP,FSUBRP,FMULP,FDIVRP,FADDP,FSUBRP,FMULP,FDIVRP
				};
	static const int P5comp [RGT+11-(RGT)+1] = {
				(0x4500<<16)|JZ,
				(0x100<<16)|JNZ,(0x4000<<16)|JNZ,(0x4000<<16)|JZ,
				(0x100<<16)|JZ,(0x4500<<16)|JNZ,(0x100<<16)|JNZ,(0x4500<<16)|JZ,

				(0x4000<<16)|JNZ,(0x4000<<16)|JZ,(0x4500<<16)|JNZ,
				(0x100<<16)|JZ		};

	static const int P6comp [RGT+11-(RGT)+1] = {
				JA<<16,JB<<16,JE<<16,JNE<<16,JAE<<16,JBE<<16,
				JB<<16,JA<<16,JE<<16,JNE<<16,JBE<<16,JAE<<16		};
	/**/
	int cc,Flags,Lform,Rform,Reg,Lreg,Rreg,Bytes,Opcodes,Opcodesr,Rev,EAXresvd;
	struct Stkfmt Recip;
	double RHValue;


	Bytes=LHS->Size;

	Lform=LHS->Form&31;
	Rform=RHS->Form&31;
	if (Lform==FregVal && Rform!=FregVal)  Bytes=RHS->Size;
	Lreg=LHS->Reg;
	Rreg=RHS->Reg;
	if ((Op==REQ || Op==RNE) &&
		Lform!=FregVal && Rform!=FregVal && Bytes==4 && RHS->Size==4 &&
		((Lform==Flitval && LHS->Rval!=0) || (Rform==Flitval && RHS->Rval!=0))) {
		LHS->Type=IntType;
		RHS->Type=IntType;
		LHS->Intvalue=(*(int  *)((int)&LHS->Rval));
		RHS->Intvalue=(*(int  *)((int)&RHS->Rval));
		CIntBinaryOp((Op-REQ)+IEQ,LHS,RHS,0);
		return ;	/* Integer regs better for exact equalls */
		/* But avoid problems with -0.0          */
		/* By insisting on non zero Literal      */
	}
	EAXresvd=0;
	/**/
	/* Real comparisions will need EAX. Grab it first if free. This avoids       */
	/* loading an arraybase into EAX - corrupting it and reloading it as         */
	/* otherwise can happen                                                      */
	/**/
	if (targetvariant!=PPRO2 && RGT<=Op && Op<=RLE && registerstatus(EAX)==0 &&
		countunclaimedregs()>1 &&  ((LHS->Flags|RHS->Flags)&STKSWOPPED)==0) {
		Reg=claimnamedreg(EAX);
		EAXresvd=1;
	}
	/**/
	/* Force long double to load                                                 */
	/**/
	if (( (targetvariant==PPRO2 && Op>RDIV) ||
		Bytes>8 || (LHS->Flags&STKSWOPPED)!=0) &&
	    Lform!=FregVal) {
		Lreg=LoadRealRO(LHS,8);
		Lform=FregVal;
	}
	if (( (targetvariant==PPRO2 && Op>RDIV) ||
		RHS->Size>8 || (RHS->Flags&STKSWOPPED)!=0) &&
	    Rform!=FregVal) {
		Rreg=LoadRealRO(RHS,8);
		Rform=FregVal;
	}
	if (Rform==Flitval) {
		if (RHS->Size==4)  RHValue=RHS->Rval;
		else RHValue=RHS->Rlval;
	}
	if (Rform==Flitval && Op==RDIV && RHValue!=0) {
		memset(&Recip,0,sizeof( struct Stkfmt));
		Recip.Form=Flitval;
		Recip.Size=RHS->Size;
		if (RHS->Size==4) {
			Recip.Rval=((double)1) / RHValue;
			if ((Recip.Rval*RHS->Rval)== 1.0)  Opcodes=(FMULm<<16)|FMULP;
		} else {
			Recip.Rlval=((double)1) / RHValue;
			if ((Recip.Rlval*RHS->Rlval)== 1.0)  Opcodes=(FMULd<<16)|FMULP;
		}
	}
	if (Op<=RDIV) {
		Opcodes=RRop [(Op+Bytes)-4-(RADD)];
		Opcodesr=RRopr [(Op+Bytes)-4-(RADD)];
	} else {
		Opcodes=(FCOMPm<<16)|FCOMPP;
		if (Bytes==8)  Opcodes=(FCOMPd<<16)|FCOMPP;
		if (targetvariant==PPRO2)  Opcodes=(FCOMIP<<16)|FCOMIP;
		Opcodesr=Opcodes;
	}
	/**/
	/**/
	/* First do the RR case                                                      */
	/**/
	if ((Rform==FregVal || Rform==Fregvar) &&
		(Lform==FregVal || Lform==Fregvar)) {
		if (Lreg==currentFSP && Rreg==(currentFSP+1)) {
			Rev=0;
		} else if (Rreg==currentFSP && Lreg==(currentFSP+1)) {
			Rev=1;
		} else if (Rreg==(currentFSP+1)) {
			manipulateFS(FASTTOTOP,Lreg);
			Lreg=currentFSP;
			Rev=0;
		} else if (Lreg==(currentFSP+1)) {
			manipulateFS(FASTTOTOP,Rreg);
			Rreg=currentFSP;
			Rev=1;
		} else if (Rreg==currentFSP) {
			manipulateFS(BUBBLETOTOP,Lreg);
			Lreg=currentFSP;
			Rreg=Lreg+1;
			Rev=0;
		} else if (Lreg==currentFSP) {
			manipulateFS(BUBBLETOTOP,Rreg);
			Rreg=currentFSP;
			Lreg=Rreg+1;
			Rev=1;
		} else {
			Mabort(939);	/* Stack in a twist */
		};





		/**/
		if (Rev==1) {
			ARCH(fopr(Opcodes&0xFFFF,Lreg));
			unlockreg(Rreg);
			if (targetvariant==PPRO2 && Op>=RGT)  manipulateFS(FDISCARD,currentFSP);
			else unlockreg(Lreg);
		} else {
			ARCH(fopr(Opcodesr&0xFFFF,Rreg));
			unlockreg(Lreg);
			if (targetvariant==PPRO2 && Op>=RGT)  manipulateFS(FDISCARD,currentFSP);
			else unlockreg(Rreg);
		}
	} else {
		/**/
		/* Now rorce the no reg case to 1 reg case                                   */
		/**/
		if (!(((Rform==FregVal)||(Rform==Fregvar))||((Lform==FregVal)||(Lform==Fregvar)))) {
			if (Rform==DirVal && Lform!=DirVal) {
				Rreg=LoadRealRW(RHS,-1,Bytes);
				Rform=FregVal;
			} else {
				Lreg=LoadRealRW(LHS,-1,Bytes);
				Lform=FregVal;
			}
		}
		/**/
		/* now deal with the two variants on one reg form                            */
		/**/
		if (Lform==FregVal || Lform==Fregvar) {
			if (Lreg!=currentFSP) {
				manipulateFS(FASTTOTOP,Lreg);
				Lreg=currentFSP;
			}
			if (Op==RDIV && Opcodes==RRop [RMULT-RADD]) {
				ARCH(oprx((unsigned)Opcodes>>16,Lreg,&Recip,DESTREG));
			} else {
				ARCH(oprx((unsigned)Opcodes>>16,Lreg,RHS,DESTREG));
			}
			Rev=0;
			unlockreg(Lreg);
		} else {
			if (Rreg!=currentFSP) {
				manipulateFS(FASTTOTOP,Rreg);
				Rreg=currentFSP;
			}
			ARCH(oprx((unsigned)Opcodesr>>16,Rreg,LHS,DESTREG));
			Rev=1;
			unlockreg(Rreg);
		}
	}
	/***/
	if (RADD<=Op && Op<=RDIV) {
		Reg=claimfreg();
		if (Bytes==4 || RHS->Size==4)  Cstackfr(Reg,4);
		else Cstackfr(Reg,8);
		return ;
	}
	/***/
	if ((Op==REQ || Op==RNE) && Bytes==4)
		PI->privprops=PI->privprops|SREALEQ;	/* Note comp for exact equality*/
	if (targetvariant==PPRO2) {
		cc=P6comp [Op+(6*Rev)-(RGT)];
	} else {
		Flags=P5comp [Op+(6*Rev)-(RGT)];
		cc=Flags<<16;
		Flags=(unsigned)Flags>>16;
		if (EAXresvd==0)  Reg=claimnamedreg(EAX);
		ARCH(oponly(FSTSW,1<<EAX,0))	/* in AX*/;
		ARCH(rlit(TEST,EAX,Flags,EAX));
		unlockreg(EAX);
		forgetreg(EAX);
	}
	enotecc(cc);
}	/* Real Binary Op   */
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void Chip(int key) {
	/*************************************************************************/
	/**  generate code for intrinsic fn calls by EMCHIP                     **/
	/*************************************************************************/
	int Lab,Lab2,Index,Index2,Freg,Reg;
	static const int dsqrtneg=2;
	static const int alogsmall=21;
	if (!((5<=key)&&(key<=9)))  {	/* all bar sin,cos,tan,atan,atan2*/
		ARCH(oponly(FTST,0,0));
		Reg=claimnamedreg(EAX);
		releasereg(ECX);
		releasereg(EDX);
		ARCH(oponly(FSTSW,1<<EAX,0));
		Lab=Mprivatelabel();
		Index=BLocateLabel(Lab+Labadjust,0);
		unlockreg(EAX);
	}
	switch (key) {
		/***/
	case 1:	/*sqrt*/

		ARCH(oplit(TEST,EAX,0x100,EAX));
		ARCH(bcctf(JZ<<16,Index,0));
		estklit(dsqrtneg);
		unlockreg(currentFSP);
		Mexpcall(exp_mle);
		Freg=claimfreg();	/* get back reg unlocked for Mexpcall which does not return*/
		eplabel(Lab);
		ARCH(oponly(FSQRT,0,0));
		return ;
		/***/
	case 3:	/*log*/

	case 4:	/*log10*/

		ARCH(oplit(TEST,EAX,0x100,EAX));
		ARCH(bcctf(JZ<<16,Index,0));
		estklit(alogsmall);
		unlockreg(currentFSP);
		Mexpcall(exp_mle);
		Freg=claimfreg();	/* get back reg unlocked for Mexpcall which does not return*/
		eplabel(Lab);
		Freg=claimreg();
		if (key==3)  ARCH(oponly(FLDLN2,0,0));
		else ARCH(oponly(FLDLG2,0,0));
		ARCH(fopr(FXCH,currentFSP+1));
		ARCH(oponly(FYL2X,0,0));
		unlockreg(Freg);
		return ;
		/***/
	case 5:	/*sin*/

		ARCH(oponly(FSIN,0,0));
		return ;
		/***/
	case 6:	/*cos*/

		ARCH(oponly(FCOS,0,0));
		return ;
		/***/
	case 7:	/*tan*/

		Lab=Mprivatelabel();
		Lab2=Mprivatelabel();
		Index=BLocateLabel(Lab+Labadjust,0);
		Index2=BLocateLabel(Lab2+Labadjust,0);
		Reg=claimnamedreg(EAX);
		releasereg(ECX);
		releasereg(EDX);
		ARCH(oponly(FPTAN,0,0));
		ARCH(oponly(FSTSW,1<<EAX,0))	/*x'dfe0' fstsw %ax*/;
		ARCH(oplit(TEST,EAX,0x400,EAX));
		ARCH(bcctf(JZ<<16,Index2,0));
		Freg=claimreg();
		ARCH(oponly(FLDPI,0,0));
		ARCH(fopr(FADD,currentFSP));	/*fadd %st(0),%st make 2*pi*/

		ARCH(fopr(FXCH,currentFSP+1))	/*fxch %st(1)*/;
		eplabel(Lab);
		ARCH(oponly(FPREM,0,0));
		ARCH(oponly(FSTSW,1<<EAX,0))	/*x'dfe0' fstsw %ax*/;
		ARCH(oplit(TEST,EAX,0x400,EAX));
		ARCH(bcctf(JNZ<<16,Index,0));
		ARCH(fopr(FSTPd,currentFSP+1))	/*fstp %st(1) cunningly remove st(1)*/;
		ARCH(oponly(FPTAN,0,0))		/* pushes 1 ontop of result*/;
		eplabel(Lab2);
		ARCH(fopr(FSTPd,currentFSP))	/*fstp %st(0) cunningly remove '1.0'*/;
		unlockreg(Freg);
		unlockreg(EAX);
		return ;
		/***/
	case 8:	/*atan*/

		Freg=claimreg();
		ARCH(oponly(FLD1,0,0));
		ARCH(oponly(FPATAN,0,0));
		unlockreg(Freg);
		return ;
		/***/
	case 9:	/*atan2*/

		Elevel-=1;
		Freg=LoadRealRW(&Stk [Elevel+1],-1,8)	/* Get second parameter */;
		ARCH(oponly(FPATAN,0,0));
		unlockreg(Freg);
		return ;
	}
}	/*Chip*/

/***/
void CRealUnaryOp(int Op,int DestReg,struct Stkfmt *RHS) {
	/***************************************************************************/
	/** supports RNEG,RABS,EMCHIP ( == sqrt)                                  **/
	/** puts the descriptor to result on Estack                               **/
	/**                                                                       **/
	/** if DestReg>=0 then DestReg nominates the result result (it need/must  **/
	/**                                                 not be claimed first) **/
	/**                                                                       **/
	/** on M88110, C Real Unary Op does not corrupt the source register as    **/
	/** other targets do when the size of the operation is 8 bytes.           **/
	/***************************************************************************/
	int Rreg,Bytes,Opcode;

	Bytes=RHS->Size;
	/**/
	if (Op==EMCHIP) 	/*some sort of on chip fn*/{
		Rreg=LoadRealRW(RHS,-1,Bytes);
		Chip(DestReg&15);
		Bytes=8;	/* Result is 64 bit op Pentium */
	} else {
		Rreg=LoadRealRW(RHS,DestReg,Bytes);
		if (Op==RNEG) {
			Opcode=FCHS;
		} else if (Op==RABS) {
			Opcode=FABS;
		} else {
			Mabort(16);
		}

		/**/
		ARCH(oponly(Opcode,0,0));
	}
	forgetreg(Rreg);
	Cstackfr(currentFSP,Bytes);

}	/* Real Unary Op    */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void CsetFPUtraps() {
	/*************************************************************************/
	/** Enable FPU exceptions for:                                          **/
	/**   Invalid, Overflow, [Underflow off,] Div by zero (bits 27,26,25,24)**/
	/*************************************************************************/

	if (areaf387==0) {
		areaf387 = GLA;
		addrf387 = epermspace(4, 4);
#if (OutputASSEMBLER!=0)
		pdbytes(areaf387, addrf387, 4, &f387);
#endif
	}
	ARCH(oponly(FINIT,0,0));
	ARCH(fopfixmem(FLDCW,areaf387,addrf387,4));
	/*      B Break Frag(0);     ! Peephole optimisations may not realise side effects*/
}	/*CsetFPUtraps*/

void Cdocharop(int Op,struct Stkfmt *C1,struct Stkfmt *LenC1,struct Stkfmt *C2,struct Stkfmt *LenC2
,int CCType) {
	/****************************************************************/
	/** character comparison and assignment                        **/
	/****************************************************************/
	int Len1,Len2;

	if (C1->Form==LitVal)  C1->Size=1;	/*int as character*/
	if (C2->Form==LitVal)  C2->Size=1;
	Len1=LenC1->Intvalue;
	Len2=LenC2->Intvalue;
	if ((LenC1->Form==LitVal)&&(LenC2->Form==LitVal)&&(Len1==Len2)) {
		if (Op==EASGNCHAR) {
			/**/
			Elevel+=3;	/*manipulate Estack so */
			epromote(3);	/*  that its entries   */
			epromote(3);	/*  are in the order   */
			Elevel-=3;	/*  expected by eop MVB*/
			Ccopybytes(C2,C1,LenC1,1	/*size*/);
			/*Ccopybytes is very good at this - note that because of the*/
			/*  Promotes above the contents of the records addressed by */
			/*  C1, LenC1, C2, LenC2 have been exchanged and hence the  */
			/*  peculiar order of parameters passed to Ccopybytes       */
			/**/
		} else {
			/**/
			Elevel+=3;	/*manipulate Estack so */
			epromote(3);	/*  that its entries   */
			epromote(3);	/*  are in the order   */
			Elevel-=3;	/*  expected by eop CPB*/
			Ccomparebytes(CCType,C2,LenC1,C1);
			/*Ccomparebytes is very good at this - note that because of */
			/*  the Promotes above the contents of the records addressed*/
			/*  by C1, LenC1, C2, LenC2 have been exchanged and hence   */
			/*  the peculiar order of parameters passed to Ccopybytes   */
		}
	} else {
		enotecc(-1);
		TargetReg=-1;	/* Ensure no targetting as we may now be */
		TargetFreg=-1;	/* doing a nested call                   */
		if (Op==EASGNCHAR) {
			Elevel+=4;
			Mspcall(sp_cpystr);	/*f_cpystr*/
		} else {
			Elevel+=5;
			Mspcall(sp_cpstr);	/*f_cpstr*/
		}
	}
	/**/
}	/* C Do Charop      */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/**************************************************************************/
/**                                                                      **/
/**            address        refer      note index                      **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
static const unsigned char Eaddrform [31+1] = {
                              128,          /* LitVal => Special */
                              AddrConst,    /* Const => AddrConst */
                              130,          /* RegVal => Special */
                              131,          /* FregVal => Special */
                              AddrDir,      /* TempVal => AddrDir */
                              AddrDir,      /* DirVal => AddrDir */
                              RegAddr,      /* IndRegVal => RegAddr */
                              TempAddr,     /* IndTempVal => TempAddr */
                              DirAddr,      /* IndDirVal => DirAddr */
                              255,          /* AddrConst has no address */
                              255,          /* AddrDir has no address */
                         255/*130*/,        /* Regaddr should be as RegVal */
                         255/*AddrDir*/,    /* TempAddr should be as TempVal */
                         255/*AddrDir*/,    /* DirAddr should be as DirVal */
                              255,          /* AddrDirMod has no address */
                              255,          /* RegModAddr has no address */
                              255,          /* TempModAddr has no address */
                              255,          /* DirModAddr has no address */
                              RegModAddr,   /* IndRegModVal => RegModAddr */
                              TempModAddr,  /* IndTempModVal => TempModAddr */
                              DirModAddr,   /* IndDirModVal => DirModAddr */
                              AddrDirMod,   /* AddrDirModVal => AddrDirMod */
                              255,255,      /* All others have no Address*/
                              DispModAddr,  /* IndDispodVal => DispModAddr */
                              255,255,      /* All others have no Address*/
                              130,          /* Regvar => Special */
                              130,          /* Fregvar => Special */
                              128,          /* Flitval=>Special(same as LitVal) */
                              255,255        /* No address */
};
/***/
static const unsigned char Erefform [31+1] = {
                              255,          /* LitVal => Nocando */
                              255,          /* Const => Nocando */
                      Regflag|IndRegVal,    /* RegVal => IndRegVal */
                              255,          /* FregVal => Nocando */
                              IndTempVal,   /* TempVal => IndTempVal */
                              IndDirVal,    /* DirVal => IndDirVal */
                              128,          /* IndRegVal => Must Load */
                              128,          /* IndTempVal => Must Load */
                              128,          /* IndDirVal => Must Load */
                              ConstVal,     /* AddrConst => ConstVal */
                              DirVal,       /* AddrDir => DirVal */
                      Regflag|IndRegVal,    /* Regaddr should be as RegVal */
                              IndTempVal,   /* TempAddr should be as TempVal */
                              IndDirVal,    /* DirAddr should be as DirVal */
                              AddrDirModVal,/* AddrDirMod => AddrDirModVal */
                              IndRegModVal, /* RegModAddr => IndRegModVal */
                              IndTempModVal,/* TempModAddr => IndTempModVal */
                              IndDirModVal, /* DirModAddr => IndDirModVal */
                              128,          /* IndRegModVal => Must Load */
                              128,          /* IndTempModVal => Must Load */
                              128,          /* IndDirModVal => Must Load */
                              128,          /* AddrDirModVal => Must Load */
                              255,255,      /* => Nocando */
                              128,          /* IndDispModVal => Must Load */
                              128,          /* AddrDispModVal => Must Load */
                              IndDispModVal,/* DispModAddr => IndDispModVal */
                      Regflag|IndRegVal,    /* Regvar => IndRegVal */
                              254,          /* Fregvar special */
                              255,255,255  /* All others => Nocando*/
};
/***/
void Cnoteindex(int Scale,struct Stkfmt *Base,struct Stkfmt *Index) {
	/****************************************************************************/
	/** incorporate Index info into Base which is mapped to top                **/
	/** item on the Estack                                                     **/
	/****************************************************************************/
	int Reg,Form,Iform,Bform;

	Bform=Base->Form;
	Iform=Index->Form&31;
	Base->Domain=0;
	/**/
	if ((Scale==0)&&(Iform!=RegVal)&&(Iform!=LitVal)&&((Bform&31)==RegVal)) {
		Elevel+=1;
		eop(EXCH);
		Elevel-=1;
		Cnoteindex(Scale,&Stk [Elevel],&Stk [Elevel+1]	/* so fixed up base is available */);
		return ;
	}
	if (Iform==LitVal) {
		Index->Intvalue=Index->Intvalue<<Scale;
		Scale=0;
		if (Index->Intvalue==0)  return ;
		if (Bform==AddrDir) {
			Base->Offset=Base->Offset+Index->Intvalue;
			return ;
		}
	}
	/**/
	/* For present load all swopped indexes. This saves problems */
	/* but may be inefficient if the index has to be spilled     */
	if (((AddrDirMod<=Iform)&&(Iform<=DispModAddr)) || (Index->Size!=4) || 
		((Index->Flags&(STKVOL|STKSWOPPED|STKBSSWOPPED))!=0)) {
		Reg=LoadIntRO(Index);
		/*         Note Add Reguse(Reg,-Elevel,4)                                    */
		memset(Index,0,sizeof( struct Stkfmt));
		Index->Form=RegVal|Regflag;
		Index->Size=4;
		Index->Reg=Reg;
	}
	/**/
	switch (Bform&31) {
		/***/
	case RegVal:	/*  (reg)      */

	case Regvar:	/*  (reg)      */

		Base->Form=RegModAddr|Regflag;
		goto Set;
		/***/
	case TempVal:	/*  (temp)     */

	case DirVal:	/*  (dir)      */

		Base->Form=Bform+12;
		goto Set;
		/***/
	case AddrDir:	/*  *dir       */

	case RegAddr:	/*  (reg) is * */

	case TempAddr:	/*  (temp) is **/

	case DirAddr:	/*  (dir) is * */

		Base->Form=Bform+4;
Set:
		Base->Modreg=Index->Reg;
		Base->ModBase=Index->Base;
		Base->Modform=Index->Form;
		Base->Modoffset=Index->Offset;
		Base->Modintval=Index->Intvalue;
		Base->Scale=Scale;
		Form=Base->Modform&31;
		if ((Base->Flags&STKSWOPPED)!=0)  Base->Flags=(Base->Flags&(~STKSWOPPED))|STKBSSWOPPED;
		if ((Form==Regvar)||(Form==RegVal)||(Form==IndRegVal)) {
			NoteAddReguse(Base->Modreg,-Elevel,4);
		}
		return ;
		/***/
	case AddrDirMod:	/*  *dir+M     */

	case TempModAddr:	/*  (temp)+M   */

	case DirModAddr:	/*  (dir)+M    */

	case DispModAddr:	/* (ptr to other stack frame)+M */

	case RegModAddr:	/* (reg)+M   */

		if ((Index->Form==LitVal)&&(Base->Modform==LitVal)) {
			Base->Modintval=Base->Modintval+Index->Intvalue;
			return ;
		}

		/*following use of Cmval does not assist current RISC implementations*/
		/*and has therefore been suppressed in the interest of simplifying   */
		/*the code. It should be re-instated and fully supported in the load */
		/*and store procedures if addressing of the form base+index+offset is*/
		/*supported on an architecture. PENTIUM is such an architecture.     */

		if (Index->Form==LitVal) {
			Base->Cmval=Base->Cmval+Index->Intvalue;
			return ;
		}
		if (Base->Modform==LitVal) {
			Base->Cmval=Base->Cmval+Base->Modintval;
			Base->Modintval=0;
			goto Set;
		}
		goto IndSet;

	case IndRegVal:	/* ((reg))     */

	case IndDirVal:	/* ((dir))     */

	case IndTempVal:	/* ((temp))    */


#if((Language==FORTRAN)&&(LanguageVariant==FORTRAN77)) 
		Base->Form=Bform+12;
		goto Set;

#endif

	case IndDispModVal:	/*  (display value)+M */

	case AddrDispModVal:	/* (ptr to other stack frame)+M */

		PI->privprops=PI->privprops|GLOBALACCESS;
	case IndRegModVal:	/* ((reg)+M)   */

	case IndTempModVal:	/* ((temp)+M)  */

	case IndDirModVal:	/* ((dir)+M)   */

	case AddrDirModVal:	/* (*dir+M)    */

IndSet:

		/***/
	case LitVal:	/*  lit        */

	case ConstVal:	/*  const      */

		Reg=LoadIntRO(Base);
		Base->Flags=Base->Flags&(~(STKSWOPPED|STKBSSWOPPED));
		NoteAddReguse(Reg,-Elevel,4);
		Base->Reg=Reg;
		Base->Form=RegModAddr|Regflag;
		Base->Cmval=0;
		goto Set;
		/***/
	case FregVal:	/*  (freg)     */

	case Fregvar:	/*  (freg)     */

	case AddrConst:	/*  *const     */

		Mabort(13);
		/***/
	}
}	/* Cnoteindex       */
/***/
/***/
void Crefer(struct Stkfmt *Stk,int Offset,int size) {
	/*****************************************************************/
	/** Modify an address by adding an offset and then convert the  **/
	/** the address to a reference to that which is at the address. **/
	/** When Offset is zero this is the exact converse of Caddress  **/
	/*****************************************************************/
	int Reg,Form,Rform;
	struct Stkfmt Mstk;

	if (Offset!=0) {
		memset(&Mstk,0,sizeof( struct Stkfmt));
		Mstk.Form=LitVal;
		Mstk.Size=4;
		Mstk.Intvalue=Offset;
		Cnoteindex(0,Stk,&Mstk);
	}
	/**/
	Form=Stk->Form&31;
	Rform=Erefform [Form];
	if (IsRegForm [Form]!=0)  Reg=Stk->Reg;
	if (Rform==255) {
		if ((Language==CCOMP)&&(Form==LitVal)) {
			Rform=128;
		} else {
			Mabort(14);
		}
	}
	/**/
	if (Rform==128) 	/* A load needed */{
		Reg=LoadIntRO(Stk);
		Stk->Reg=Reg;
		Stk->Intvalue=0;
		Rform=Erefform [RegVal];
		Stk->Cmval=0;
		Stk->Flags=Stk->Flags&(~(STKSWOPPED|STKBSSWOPPED|STKIXSWOPPED));
	}
	/**/
	Stk->Form=Rform;
	if ((Rform!=IndDirVal)&&(Rform!=IndRegVal)&&(Rform!=IndRegModVal)&&(Rform!=AddrDir)&&(Rform!=DirModAddr
	    )) {
		Stk->Domain=0;
	}
	if ((Rform&Regflag)!=0) {
		if (SimpleRegForm [Rform&31]==0)  size=4;
		NoteAddReguse(Reg,-Elevel,size);
	}
	if ((Stk->Flags&STKSWOPPED)!=0)  Stk->Flags=(Stk->Flags&(~STKSWOPPED))|STKBSSWOPPED;

}	/* Crefer           */
/***/
void Caddress(struct Stkfmt *Stk) {
	/****************************************************************/
	/**    Change operand from a var to an address                 **/
	/**    Addresses always have size 4                            **/
	/****************************************************************/
	int I,Aform,Form,Offset,Size,Bytes,realreg,imagreg,base;
	struct Stkfmt Mod;

	Form=Stk->Form&31;
	Aform=Eaddrform [Form];
	if (Aform==255)  return ;	/* treat as noop for Atholl */
	if (Aform>128)  goto Addrregvar;
	if (Aform==128) goto Addrlit;
	Stk->Size=4;	 
	Stk->Type=IntType;
	Stk->Form=Aform|(Stk->Form&Regflag);
	Stk->Flags=Stk->Flags&(~(STKSWOPPED|STKVOL));	/* addresses of swopped items */
	/* are not swopped  or volatile                                              */
	if ((Stk->Form!=IndDirVal)&&(Stk->Form!=IndRegVal)&&(Stk->Form!=IndRegModVal)&&(Stk->Form!=AddrDir)
	    &&(Stk->Form!=DirModAddr)) {
		Stk->Domain=0;
	}

	/* The following sequence occurs when an array element                       */
	/* has been dumped and the address is called on the Indtempval               */

	I=Stk->Cmval;
	if ((I!=0)&&(Aform<AddrDirMod)) 	/*Unmodifed  form*/{
		Stk->Cmval=0;
		Mod=LitOne;	 
		Mod.Intvalue=I;
		CIntBinaryOp(IADD,Stk,&Mod,0);
	}
	return ;
	/***/
Addrlit:	/*  lit        */

	if (Stk->Size==8)  I=8; 
	else I=4;
	Offset=epermspace(8,4);
	/*note: take care not to corrupt Stk_Intvalue                                */
	if (Form==LitVal)  Msetconst((int)&Stk->Intvalue,I,&base,&Offset); 
	else {
		if (I==4)  Msetconst((int)&Stk->Rval,I,&base,&Offset); 
		else Msetconst((int)&Stk->Rlval,I,&base,&Offset
		    );
	}
	Stk->Form=AddrDir;
	Stk->Base=base;
	Stk->Size=4;
	Stk->Offset=Offset;
	Stk->Domain=0;
	return ;
	/***/
Addrregvar:	/*  (reg)    (freg)     */

	Size=Stk->Size;
	Offset=ARCH(tempspace(Size,Size));
	if ((Size==16)||(Stk->Imagreg>=FRBASE)) {
		/**********************************************************************/
		/** Handle a SPARC Complex*16 or M88110 Complex*8/Complex*16 FregVal **/
		/**********************************************************************/
		/**/
		Bytes=(unsigned)Size>>1;	/*store the Real part*/
		realreg=Stk->Reg;
		imagreg=Stk->Imagreg;
		Stk->Size=Bytes;
		if (imagreg<realreg) {	/* normal order */
			StkTemp(&Mod,Offset+Bytes,Bytes);
			Mod.Type=Stk->Type;
			Stk->Reg=Stk->Imagreg;	/*first store the Imaginary part*/
			I=Cstoreop(&Mod,Stk,0);
			Mod.Offset=Mod.Offset-Bytes;
			Offset=Mod.Offset;	/* StkTemp may alter offset */
			Stk->Reg=realreg;	/*continue to store the Real part */
		} else {
			StkTemp(&Mod,Offset,Bytes);
			Mod.Type=Stk->Type;
			Stk->Reg=realreg;
			I=Cstoreop(&Mod,Stk,0);
			Offset=Mod.Offset;
			Mod.Offset=Mod.Offset+Bytes;
			Stk->Reg=imagreg;
		}
	} else {
		StkTemp(&Mod,Offset,Size);
		Offset=Mod.Offset;	/* In case adjusted                                      */
	}
	Mod.Type=Stk->Type;
	I=Cstoreop(&Mod,Stk,0);
	Stk->Base=STACK;
	Stk->Offset=Offset;
	Stk->Form=AddrDir;
	Stk->Size=4;
	Stk->Domain=0;
        PI->privprops|=FRAMEADDRTAKEN;
	return ;
}	/* Caddress         */
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**            initialisation                                            **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
void Cinitialise(int lang,int options,int unassigneddisp) {
	/***************************************************************************/
	/** called by Minitialise                                                 **/
	/** options have bit value significance                                   **/
	/**   x'00000001'  enable miscellaneous architecture specific tracing     **/
	/**   x'00000002'  generate assembly listing for each frag                **/
	/**   x'00000004'  enable peephole optimisation tracing                   **/
	/**   x'00000008'  parameters are independent (FORTRAN only)              **/
	/**   x'00000010'  enable put memory allocation tracing                   **/
	/**   x'00000080'  enable put file monitoring                             **/
	/**   x'00000100'  enable global scheduling                               **/
	/**   x'00000200'  enable leaf routine optimisation                       **/
	/**   x'00000400'  enable peephole optimisation                           **/
	/**   x'00010000'  profiling                                              **/
	/**   x'00020000'  enable DBX/SDB information generation                  **/
	/**   x'00040000'  minimum diags preparation                              **/
	/**   x'00080000'  dynamic line number updating                           **/
	/**   x'00100000'  prepare static line no table (later)                   **/
	/**   x'00200000'  support overflow checking                              **/
	/**   x'00400000'  allow compiler allocation of registers (FORTRAN only)  **/
	/**   x'00800000'  set FPU traps if compiling a main program              **/
	/**   x'01000000'  enable basic block instruction scheduling              **/
	/**   x'02000000'  prepare for FORTRAN argument checking                  **/
	/**   x'04000000'  generate assembly listing without addresses            **/
	/**   x'08000000'  RNDSNGL option tested in DGUX mode only                **/
	/**   x'10000000'  Target dependent and not currently used                **/
	/**   x'20000000'  line profiling                                         **/
	/**   x'40000000'  leave external symbol names in mixed case              **/
	/**                                                                       **/
	/** Additionally, bits 12-15 give the architecture variant for which      **/
	/** backend optimisation should be performed                              **/
	/**                                                                       **/
	/** unassigned disp is the offset in GLA of an 8-byte unassigned pattern  **/
	/***************************************************************************/

	Regvaropt=options&0x400000;
	diagnostics=options&0x40000;
	setdbx=options&0x20000;
	cgoptions=options;
	/*      printstring("Options ="); phex(cgoptions); newline                   */
	if (Language!=lang)  Mabort(55);	/*frontend and backend must be the same*/
	FirstTime=1;

#if Language==CCOMP
	QCDepth=0;
	CLogStk(8,0);
#endif

	QCIResMask=0;	/* No integer ?: result register selected           */
	QCFResMask=0;	/* No float ?: result register pair selected        */
	ReturnInstr=0;	/* Clear the marker for the last return instruction */
	RegClaimMaskA=0;	/* No registers allocated by the optimiser yet      */
	RegClaimMaskB=0;
	ParIIsSet=0;

	enotecc(-1);

	if ((Language!=PASCAL)&&(diagnostics!=0)) {
		/**/
		cnstdir(&Stkunassigned,unassigneddisp,8);
		/*create a DirVal to the Unassigned Pattern*/
	}
	memset(&LitZero,0,sizeof( struct Stkfmt));	 
	LitZero.Size=4;	 
	LitZero.Form=LitVal;
	memset(&LitOne,0,sizeof( struct Stkfmt));	 
	LitOne.Size=4;	 
	LitOne.Form=LitVal;	 
	LitOne.Intvalue=1;
	/**/
	areaf387=0;
	fixPrecision = 1;
	/**/
	Contexts=0;
	Rinitialise();
}	/* Cinitialise      */
/***/
void Creinitialise(int unassigneddisp) {
	/***************************************************************************/
	/** called by Minitialise                                                 **/
	/** unassigned disp is the offset in GLA of an 8-byte unassigned pattern  **/
	/***************************************************************************/

	FirstTime=1;

	ReturnInstr=0;	/* Clear the marker for the last return instruction*/
	RegClaimMaskA=0;	/* No registers allocated by the optimiser yet*/
	RegClaimMaskB=0;
	ParIIsSet=0;

	enotecc(-1);

	/*     %IF Language# PASCAL %AND diagnostics# 0 %THENSTART                   */
	/*        cnstdir (Stkunassigned,unassigned disp,8)                          */
	/*                                                                           */	/*create a DirVal to the Unassigned Pattern*/
	/*     %FINISH                                                               */
	/**/
	/**/
	floatarea1=0;
	convarea=0;
	Contexts=0;
	areaf387=0;
	fixPrecision = 1;
	memset(&Auxstk,0,sizeof( struct Stkfmt));
	RReinitialise();
}	/* Creinitialise    */
/***/

void Cstartproc(int Props) {
	/****************************************************************/
	/** called by Mstartproc                                       **/
	/** options have bit value significance                        **/
	/**   x'00000080'  procedure has side-entries                  **/
	/**                                                            **/
	/** performs Cproc initialisations at Procedure Entry          **/
	/****************************************************************/


#if(Language==FORTRAN) 
	Regvaropt=0;	/* If FORTRAN do not reserve optimiser registers */
	/* until the code generator sees a call on eproccode*/

#else
	Regvaropt=cgoptions&0x400000;

#endif

	RegvarSpace=0;	/*Mark Fregvar storage space as unallocated*/
#if Language==CCOMP
	QCDepth=0;
	CLogStk(8,0);
#endif

	ReturnInstr=0;

	cmplxtemp=0;	/*reset offset of a temp Complex*16 result*/
	/*used for integer to real conversions*/
	if ((Language!=FORTRAN)||(Regvaropt!=0)) {
		ParamsSaved=1;
		/* IMP and PASCAL and Optimising FORTRAN will, on                            */
		/* entry, dump the parameter registers to stack, and                         */
		/* are therefore are available for allocation                                */
		if ((Props&128)!=0) {
			saveparams=0;
			/* tell Ccountparams not to save the parameters if                           */
			/* the procedure contains side entries (as the                               */
			/* FORTRAN Compiler itself will copy them in)                                */
		} else {
			saveparams=1;
			/* ask Ccountparams to save the parameter registers                          */
		}
	} else {
		ParamsSaved=0;
		/* Non-Optimising FORTRAN will keep its parameters in                        */
		/* registers - they are not off-loaded and hence the                         */
		/* registers are not available for allocation                                */
		if ((diagnostics!=0)||(setdbx!=0)) {
			saveparams=1;
			/* ask Ccountparams to save the parameters so that                           */
			/* they are available for FORTRAN diagnostics or DBX                         */
			/* but still preserve/protect the parameter registers                        */
		} else {
			saveparams=0;
			/* tell Ccountparams not to save the parameters                              */
		}
	}
	RInitregAllocation();

}	/* Cstartproc       */

void Csideentry(int Index) {
	/****************************************************************/
	/** called by Msideentry - Index > 0 implies a real side-entry **/
	/**                                                            **/
	/** performs Cproc initialisations at Procedure Side Entry     **/
	/****************************************************************/

	Regvaropt=0;

#if(Language==FORTRAN) 
	if ((Index>0)&&((diagnostics!=0)||(setdbx!=0))) {
		saveparams=1;
	} else saveparams=0;

#endif
	ParamsSaved=0;
	/*=> Ccountparams will not save the parameters                               */
	/*   and will therefore protect them using Lowreg                            */
	RInitregAllocation();

}	/* Csideentry       */

/**/
/* THE FOLLOWING ROUTINE SHOULD BE MOVED TO THE EPROCS MODULE                */
/**/
void Eproccode(int Props,int *paramprops) {
	/*************************************************************************/
	/** called by FORTRAN compiler before generating the main               **/
	/** body of code but after any prologue has been completed              **/
	/**                                                                     **/
	/** props are as follows:                                               **/
	/**                                                                     **/
	/**    2**0     Set if external                                         **/
	/**    2**1     Set if main entry       (2**31 is used by FORTRAN!)     **/
	/**    2**2     Set if display not required (Implied for FORTRAN & C)   **/
	/**    2**3     Set if there are no local variables                     **/
	/**    2**4     Set if this is a side entry                             **/
	/**    2**5     Set if there are no internal blocks or procedures       **/
	/**    2**6     Set to fill the stack with the unassigned pattern       **/
	/**    2**7     Set if this procedure contains side entries             **/
	/*************************************************************************/
	if (Report!=0) {
		printf("Eproccode:\n");
	}
	Regvaropt=cgoptions&0x400000;
	if (Regvaropt!=0) {
		if ((Props&128)!=0) 	/*procedure contains side-entries*/{
			saveparams=0;
			/* tell Ccountparams not to save the parameters (as                          */
			/* the FORTRAN Compiler itself will copy them in)                            */
		} else {
			saveparams=1;
			/* ask Ccountparams to save the parameter registers                          */
		}
		ParamsSaved=1;	/*parameter registers are available for allocation*/
		RInitregAllocation();
		Ccountparams(paramprops,0);
	}

}	/* Eproccode        */


/***/
/***/
void Creport(int value) {
	/****************************************************************/
	/** called by Emonon and Emonoff                               **/
	/****************************************************************/
	Report=value;
}	/*Creport*/
/***/
void CsetParI(struct paramfmt *ParIaddr) {
	/****************************************************************/
	/** called by Mprocs whenever Call Level changes               **/
	/****************************************************************/
	ParIIsSet=1;
	ParI=ParIaddr;	/*map onto the current param info record*/
}	/* CsetParI         */
/***/
struct paramfmt *GetParI() {
	/****************************************************************/
	/* Allows ParI record to be accessed by regs module            **/
	/****************************************************************/
	if (ParIIsSet==0)  Mabort(77);
	return ParI;
}	/*GetParI*/
/***/
struct procfmt *GetPI() {
	/****************************************************************/
	/* Allows PI record to be accessed by regs module              **/
	/****************************************************************/
	return PI;
}	/*GetPI*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void CsetPI(struct procfmt * PIaddr) {
	/****************************************************************/
	/** called by Mprocs whenever ProcLevel changes                **/
	/****************************************************************/
	PI=PIaddr;	/*map onto the current proc info record*/
	/**/
	p5setpi(PIaddr);
	/**/
}	/* Csetpi           */

void evolatile(int area,int offset,int bytes) {
	/*******************************************************************************/
	/** A variable in C has been declared as volatile and thus should not         **/
	/** be altered only in a register, ie all changes have to affect the location **/
	/*******************************************************************************/
	CheckConflict(area,offset,bytes);
}	/* Evolatile */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/* this was originall in xprocs                                              */
/***/
#if  Language==CCOMP
/* The register holding the result of a partial logical expression (or 0 if  */
/* one is not currently being evaluated)                                     */
static int LogStkReg=-1;
/***/
/* The layout type of the exit from the partial logical expression           */
static int LogStkLayout;
/***/
/* Flags set depending on whether FALSE and TRUE handlers have been used     */
static int LogStkFU;
static int LogStkTU;
/***/
/* Array of bits corresponding to FALSE/TRUE labels used in the              */
/* evaluation of partial logical expressions. If a bit is set then           */
/* the corresponding label has been used.                                    */
#define MaxLogStkLabels 1024
static int LogStkLabUsed [(((unsigned)MaxLogStkLabels>>5)-1)+1];
/***/
static const unsigned char Falsecc [ALWAYS-(GT)+1] = {
	LE,
	GE,NE,EQ,LT,GT,255,255,
	255,255,255,255,255,255,ALWAYS,NEVER
};
/***/
#define MaxQCDepth 30	/* Maximum depth of ?: expression in C */
/***/
/** The result registers for the current depths of ?: constructs.            */
static unsigned char QCResRegs [MaxQCDepth];
static unsigned char QCResFRegs [MaxQCDepth];
/***/
#endif
static const int Bmaskval [31+1] = {
	0x1,0x3,0x7,0xF,
	0x1F,0x3F,0x7F,0xFF,
	0x1FF,0x3FF,0x7FF,0xFFF,0x1FFF,0x3FFF,0x7FFF,0xFFFF,

	0x1FFFF,0x3FFFF,0x7FFFF,0xFFFFF,0x1FFFFF,0x3FFFFF,
	0x7FFFFF,0xFFFFFF,
	0x1FFFFFF,0x3FFFFFF,0x7FFFFFF,0xFFFFFFF,0x1FFFFFFF,
	0x3FFFFFFF,0x7FFFFFFF,0xFFFFFFFF
};
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**                      FORTRAN specific routines                       **/
/**                                                                      **/
/**************************************************************************/
/***/

#if(((Language==FORTRAN)&&(Directcomplex==0))||(Language==PASCAL)||(Language==MODULA)) 


static void AddressOpnd(struct Stkfmt *Opnd,struct Stkfmt *Cr,struct Stkfmt *Ci,int *Areg,int PartSize
) {
	/****************************************************************************/
	/** 'Opnd' represents the address of a complex operand.                      */
	/** Set up 'Cr' and 'Ci' to represent the real and imaginary parts (resp) of */
	/** 'Opnd'.  If an addressing register is required it will be assigned to    */
	/** 'Areg'.  'PartSize' is the size in bytes of each component of 'Opnd'.    */
	/** Addresses are never swopped so we can not handle swopped complex here    */
	/** swopped complex must use the Direct complex routines                     */
	/****************************************************************************/

	if (Opnd->Form==AddrDir) {
		*Areg=-1;
		*Cr=*Opnd;
		Cr->Form=DirVal;
		Cr->Size=PartSize;
		Cr->Type=RealType;
		*Ci=*Cr;
		Ci->Offset=Ci->Offset+PartSize;
	} else {
		/**/
		if ((Opnd->Form&31)==RegAddr) {
			if (*Areg==-1) {
				*Areg=Opnd->Reg;
			} else {
				ARCH(rr(OR,Opnd->Reg,Opnd->Reg,*Areg));
			}
		} else {
			if (!(*Areg>0))  *Areg=claimreg();
			ARCH(stkaccess(LoadIntVal,*Areg,Opnd));
		}
		lockregister(*Areg,0,4)	/* avoid address reg being reused */;
		/**/	/* until both halves accessed */
		memset(Cr,0,sizeof( struct Stkfmt));
		Cr->Form=IndRegVal|Regflag;
		Cr->Reg=*Areg;
		Cr->Size=PartSize;
		Cr->Type=RealType;
		*Ci=*Cr;
		Ci->Form=IndRegModVal|Regflag;
		Ci->Modform=LitVal;
		Ci->Modintval=PartSize;
	}

}	/*AddressOpnd*/

static void StoreTOS(struct Stkfmt *Dest) {
	/********************************************************************/
	/** Store the current top of Estack in 'Dest' and pop Estack                 */
	/********************************************************************/

	int j;

	j=Cstoreop(Dest,&Stk [Elevel],0);
	Elevel-=1;

}	/*StoreTOS*/

void CxOperation(int Op,int Flags,struct Stkfmt *LHS,struct Stkfmt *RHS1,struct Stkfmt *RHS2) {
	/*************************************************************************/
	/** Op = 1   CXADD           5   CXNEG          9   CONJG               **/
	/**      2   CXSUB           6   CXASGN        10   CMPLX1              **/
	/**      3   CXMULT          7   CXEQ          11   CMPLX2              **/
	/**      4   CXDIV           8   CXNE                                   **/
	/**                                                                     **/
	/** Flags = Variant<<8 ! Sizecode for all ops except CXASGN, which has  **/
	/** Flags = Variant<<8 ! DestSizecode<<2 ! SourceSizecode               **/
	/**                                                                     **/
	/**         Variant:  0   complex  op  complex                          **/
	/**                   1   complex  op  real                             **/
	/**                   2      real  op  complex                          **/
	/**                                                                     **/
	/**        Sizecode:  0    8                                            **/
	/**                   1   16                                            **/
	/**                                                                     **/
	/** RHS1 & RHS2 are addresses of complex opnds except when Op = 10 / 11 **/
	/** in which case they are real operand(s)                              **/
	/**                                                                     **/
	/** LHS is always the address of the destination complex.               **/
	/*************************************************************************/

	static const int CXxCX=0;
	static const int CXxR=1;
	static const int RxCX=2;

	static const int eops [11] = {
		RADD,RSUB,RMULT,RDIV,RNEG,0,REQ,RNE,NEG,0,0	};

	int Variant,Size,D,DestSize,DestD,Op1,Ax,Ay,Az,Freg1,Freg2;
	int Proc,Label,Index;

	struct Stkfmt Xr,Xi,Yr,Yi,Zr,Zi;


	Variant=(unsigned)Flags>>8;
	Size=Flags&3;
	if (Size==0)  D=4; 
	else D=8;
	if (Op==6) {
		DestSize=((unsigned)Flags>>2)&3;
		if (DestSize==0)  DestD=4;
		else DestD=8;
	} else {
		DestD=D;
	}

	if ((Op==4)&&(Variant==0)) {
		/* use support procedure */
		Elevel+=3;	/* to allow operands to be pushed        */
		TargetReg=-1;	/* Ensure no targetting as we may now be */
		TargetFreg=-1;	/* doing a nested call                   */

		/* see whether either operand is misaligned */
		if ((Size!=0) && 
		    ((RHS1->Type==MisRealType) || 
		    ((RHS1->Form==AddrDir)&&((RHS1->Offset&7)!=0)) ||
		    (RHS2->Type ==MisRealType) || 
		    ((RHS2->Form==AddrDir)&&((RHS2->Offset&7)!=0)))) {
			Proc=sp_cdmdiv;
		} else {
			if (Size=0) Proc=sp_ccdiv; else Proc=sp_cddiv;
		}

		Mspcall(Proc);
		return ;
	}

	Ax=-1;
	Ay=-1;
	Az=-1;

	if ((7<=Op)&&(Op<=8)) 	/* adjust pointers for CXEQ and CXNE */{
		RHS2=RHS1;	/* so that RHS1 and RHS2 are the two */
		RHS1=LHS;	/* operands and LHS is unused        */
	}

	/* C16 * C16 done differently on M88K */
	if (Op<10)  AddressOpnd(RHS1,&Xr,&Xi,&Ax,D);
	if ((Op<=4)||((7<=Op)&&(Op<=8)))  AddressOpnd(RHS2,&Yr,&Yi,&Ay,D);
	if (!((7<=Op)&&(Op<=8)))  AddressOpnd(LHS,&Zr,&Zi,&Az,DestD);

	Op1=eops [Op-1];

	switch (Op) {

	default:
		Mabort(35);	/* Invalid Op in CX Operation */

	case 1:	/* CXADD   CXxCX or CXxR             */

	case 2:	/* CXSUB   CXxCX or CXxR or RxCX     */


		CRealBinaryOp(Op1,&Xr,&Yr);
		if (Variant==CXxCX) {
			CRealBinaryOp(Op1,&Xi,&Yi);
		} else if (Variant==RxCX) {
			CRealUnaryOp(RNEG,-1,&Yi);
		} else {
			Elevel+=1;
			Stk [Elevel]=Xi;
		}


Store:

		epromote(2);
		StoreTOS(&Zr);
		StoreTOS(&Zi);

Free:

		/* turn permlocked registers into ordinary temporaries again */
		/**/
		return ;


	case 3:	/* CXMULT    CXxCX or CXxR      */

	case 4:	/* CXDIV     CXxR               */



		CRealBinaryOp(Op1,&Xr,&Yr);
		if (Variant==CXxCX) {
			CRealBinaryOp(Op1,&Xi,&Yi);
			Elevel-=2;
			CRealBinaryOp(RSUB,&Stk [Elevel+1],&Stk [Elevel+2]);
		}

		CRealBinaryOp(Op1,&Xi,&Yr);
		if (Variant==CXxCX) {
			CRealBinaryOp(Op1,&Xr,&Yi);
			Elevel-=2;
			CRealBinaryOp(RADD,&Stk [Elevel+1],&Stk [Elevel+2]);
		}
		goto Store;

	case 5:	/* CXNEG       1 complex opnd */


		CRealUnaryOp(RNEG,-1,&Xr);
		CRealUnaryOp(RNEG,-1,&Xi);

		goto Store;

	case 6:	/* CXASGN     CXxCX or CXxR or RxCX     */


Asgn:
		Freg1=LoadRealRW(&Xr,-1,DestD);
		Xr.Form=FregVal|Regflag;
		Xr.Reg=Freg1;
		Xr.Size=DestD;
		Elevel+=1;
		Stk [Elevel]=Xr;

		if (Variant==RxCX) {
			StoreTOS(&Zr);
			goto Free;
		} else if (Variant==CXxR) {
			Xi.Type=RealType;
			Xi.Form=Flitval;
			Xi.Intvalue=0;
			Xi.Size=4;
		}


		Freg2=LoadRealRW(&Xi,-1,DestD);
		Xi.Form=FregVal|Regflag;
		Xi.Reg=Freg2;
		Xi.Size=DestD;
		Elevel+=1;
		Stk [Elevel]=Xi;

		goto Store;


	case 7:	/* CXEQ     CXxCX */

	case 8:	/* CXNE     CXxCX */


		Label=Mprivatelabel();
		CRealBinaryOp(REQ,&Xr,&Yr);
		/**/
		Index=BLocateLabel(Label+Labadjust,0);
		ARCH(bcctf(JNE<<16,Index,0));
		/**/
		/**/
		CRealBinaryOp(REQ,&Xi,&Yi);
		/**/
		eplabel(Label);
		if (Op==7)  Op1=JE;
		else Op1=JNE;
		enotecc(Op1<<16);

		goto Free;

	case 9:	/* CONJG     negate imaginary part */


		Elevel+=1;
		Stk [Elevel]=Xr;
		CRealUnaryOp(RNEG,-1,&Xi);

		goto Store;


	case 10:	/* CMPLX1   (Zr, Zi) := (Xr, 0.0) */


		Variant=CXxR;
		Xr=*RHS1;
		memset(&Xi,0,sizeof( struct Stkfmt));	/* Unassigned at this point */
		goto Asgn;


	case 11:	/* CMPLX2   (Zr, Zi) := (Xr, Yr)  */


		Variant=CXxCX;
		Xr=*RHS1;
		Xi=*RHS2;
		goto Asgn;

	}
}	/* Cx Operation */
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/*%if Language=FORTRAN %and Directcomplex=0*/

#endif


#if((Language==FORTRAN)&&(Directcomplex==1))

/* RS6000:                                                                   */
/* We have variable length registers so always need two. There are no        */
/* operations on registerpairs so there areno easy short cuts                */
/**/
/* SPARC:                                                                    */
/*  Whenever we put a Complex*8 onto the Estack (always as an FregVal), we   */
/*  aim to have the value in a register pair so that a subsequent DCXASGN    */
/*  might be able to use STDF instruction instead of two STF instruction.    */
/*  An additional benefit of this approach is that if the Real part has to   */
/*  be released then the Imaginary part will also be released. Note however  */
/*  source operands do not have to be loaded into a register pair - they     */
/*  may be if the source operand is a DirVal aligned on an 8-byte boundary.  */
/*  (Normally source operands are unlocked after the a binary operation, and */
/*  are consequentially unpaired and put into register memory).              */
/**/
/*  If the compiler can distinguish Complex*8 operands as being 8-byte       */
/*  aligned then such operands could be handled as REAL*8 operands           */
/*  in any Load or Store operation.                                          */
/**/
/* M88110:                                                                   */
/*  All Complex Binary Operations occur ONLY in the Extended Register File   */
/*  and NEVER in the General Register File.  For this reason there is        */
/*  no scope for handling a COMPLEX*8 as a single double precision           */
/*  value in a Load or Store operation.  The operations are                  */
/*  always:                                                                  */
/*            source op source -> target                                     */
/*     never: source op source -> source                                     */
/**/
/*  (Complex Unary Operations could happen in the General Register File      */
/*   but this should only happen if the operand is a "true" FregVal,   !   a Complex*8 support procedure 
function result).                                                            */
/**/

static int LoadRealRS(struct Stkfmt *Stk,int Newsize) {
	/*************************************************************************/
	/** LOAD REAL                               **/	/*Read-only/Estack-stackable*/
	/**                                                                     **/
	/** Loads a register with the value of STK which describes a floating   **/
	/** point value of either 4 or 8 bytes which is to be loaded as Newsize.**/
	/**                                                                     **/
	/** It is assumed that the register loaded may (eventually) be locked   **/
	/** to a Estack entry and thus register memory inspection will not      **/
	/** include any currently locked registers.                             **/
	/**                                                                     **/
	/** It is also assumed that the register loaded will not be overwritten **/
	/** with some new value, and that therefore the register may be placed  **/
	/** in register memory if appropriate.                                  **/
	/**                                                                     **/
	/** For the M88110, Load Real must load into the Extended Register File **/
	/** unless specifically requested otherwise (else arithmetic will be    **/
	/** attempted using a mixture of integer and floating-point registers)  **/
	/*************************************************************************/
	if (((Stk->Form&31)==FregVal)&&(Stk->Size==Newsize)&&(Stk->Reg>=FRBASE)) {
		return Stk->Reg;
	} else {
		return LoadRealGeneral(Stk,-1,Newsize,2);
	}
}	/* Load Real RS     */

void Cstackcmplxfr(int Realreg,int Imagreg,int Size) {
	/****************************************************************/
	/** Create a Complex FregVal on the Top of the Estack          **/
	/****************************************************************/
	/***/
	struct Stkfmt *Lstk;

	if (Realreg==Imagreg)  Mabort(777);
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=FregVal|Regflag;
	Lstk->Type=RealType;
	Lstk->Reg=Realreg;
	Lstk->Imagreg=Imagreg;
	Lstk->Size=Size;
	unlockregister(Imagreg);
	unlockregister(Realreg);
	lockregister(Realreg,Elevel,(unsigned)Size>>1);
	lockregister(Imagreg,Elevel,(unsigned)Size>>1);
	currentFSP-=2;

}	/* Cstackcmplxfr    */
/***/
int Caddresscomplexopnd(struct Stkfmt *Opnd,struct Stkfmt *Cr,struct Stkfmt *Ci) {
	/****************************************************************/
	/** Load the Address of an Operand which is assumed to be of   **/
	/** type Complex                                               **/
	/****************************************************************/
	/***/
	int Form,Size,Areg,Type,Flags;

	Form=Opnd->Form&31;
	Size=(unsigned)Opnd->Size>>1;
	Type=Opnd->Type;	/* caddress changes this to Int                            */
	Flags=Opnd->Flags;
	Areg=-1;
	*Cr=*Opnd;
	Cr->Size=Size;
	if ((Form==DirVal)||(Form==TempVal)) {
		/*******************************************************/
		/** Load a Direct Reference to a Complex              **/
		/*******************************************************/
		*Ci=*Cr;
		Ci->Offset=Cr->Offset+Size;
	} else if (Form==IndRegVal) {
		*Ci=*Cr;
		Ci->Form=IndRegModVal;
		Ci->Modform=LitVal;
		Ci->Modintval=Size;
		lockregister(Cr->Reg,0,4);	/* double lock so stays while both bits accessed */
	} else if ((Form==IndRegModVal)&&(Cr->Modform==LitVal)) {
		*Ci=*Cr;
		Ci->Modintval=Ci->Modintval+Size;
	} else if ((Form==FregVal)||(Form==Fregvar)) {
		/*******************************************************/
		/** Load a Complex FREGVAL or Complex FREGVAR         **/
		/*******************************************************/
		*Ci=*Cr;
		Ci->Reg=Cr->Imagreg;
		if ( Ci->Reg>Cr->Reg) {
			if (Cr->Reg==currentFSP) {
				targetfopr(FXCH,Ci->Reg)
				Ci->Reg=Cr->Reg;
				Cr->Reg=Cr->Imagreg;
			} else {
				Mabort(979);
		}
		Ci->Imagreg=0;
		Cr->Imagreg=0;
	} else {
		/*******************************************************/
		/** Load an InDirect Reference to a Complex           **/
		/*******************************************************/
		/**/
		Caddress(Opnd);	/* load address            */
		Areg=LoadIntRO(Opnd);	/*         into a register */
		/**/
		lockregister(Areg,0,4)	/*avoid address reg being reused*/;
		/* until both parts have been accessed */
		memset(Cr,0,sizeof( struct Stkfmt));
		Cr->Form=IndRegVal;
		Cr->Reg=Areg;
		Cr->Size=Size;
		Cr->Type=Type;
		Cr->Flags=Flags;
		*Ci=*Cr;
		Ci->Form=IndRegModVal;
		Ci->Modform=LitVal;
		Ci->Modintval=Size;
	}



	return Areg;

}	/* Caddress complex opnd                                                   */
/***/
void Ccmplxunasscheck(struct Stkfmt *LHS,int Unasslab) {
	/****************************************************************/
	/** if the Stk item is unassigned then jump to Unasslab - the  **/
	/** Stk item is of type Complex                                **/
	/****************************************************************/
	/***/
	int Realreg;	/*register containing the real part     */
	int Imagreg;	/*register containing the imaginary part*/
	int Tempreg;	/* Top of fstack containing popable copy */
	int Lareg;	/*base register of a Complex*16 operand */
	int Size;	/*operand size - either 8 or 16 */
	int Bytes;	/*size of Real or Imaginary part*/
	/***/
	struct Stkfmt Lr;
	struct Stkfmt Li;
	struct Stkfmt Lstk;

	Size=LHS->Size;
	Bytes=(unsigned)Size>>1;
	/**/
	Lareg=Caddresscomplexopnd(LHS,&Lr,&Li);
	Realreg=LoadRealRS(&Lr,Bytes)	/*load the real part of a Complex*16*/;
	Imagreg=LoadRealRS(&Li,Bytes)	/*load the imaginary part           */;
	Stkunassigned.Type=RealType;
	Stkunassigned.Size=Bytes;
	Tempreg=claimfreg();
	ARCH(fopr(FLDd,currentFSP));
	Stkfreg(&Lstk,Tempreg,Bytes);
	Cjumpcond(EQ|Rcompare,&Lstk,&Stkunassigned,Unasslab);
	/**/
	Tempreg=claimfreg();
	ARCH(fopr(FLDd,currentFSP+1));
	/**/
	Cjumpcond(EQ|Rcompare,&Lstk,&Stkunassigned,Unasslab);
	/**/
	Cstackcmplxfr(Realreg,Imagreg,Size);

}	/* Ccmpxunasscheck  */
/***/

static void ComplexUnaryOp(int Op,int Size,int Newsize,struct Stkfmt *Lr,struct Stkfmt *Li) {
	/****************************************************************/
	/** Perform a Unary Complex Operation and put the Result on    **/
	/** the Estack                                                 **/
	/**                                                            **/
	/** Op  = DCXNEG                                               **/
	/**     = DECONJG                                              **/
	/**                                                            **/
	/** Size= 4  =>  complex*8 result, complex*8 operand           **/
	/**     = 8  =>  complex*16 result, complex*16 operand         **/
	/****************************************************************/
	/***/
	int Realreg;
	int Imagreg;


	if (((Lr->Form&31)==FregVal)&&((Li->Form&31)==FregVal)) {
		Realreg=Lr->Reg;	 
		Imagreg=Li->Reg;
		if (!(((Realreg-1)==Imagreg)&&(Imagreg==currentFSP))) {
			manipulateFS(BUBBLETOTOP,Realreg);
			if (Op==DCXNEG) ARCH(oponly(FCHS,0,0));
			manipulateFS(BUBBLETOTOP,Imagreg);
			ARCH(oponly(FCHS,0,0));
			Cstackcmplxfr (currentFSP+1,currentFSP,Size<<1);
			return;
		}
	} else {
		Realreg=LoadRealRW(Lr,-1,Newsize);
		Imagreg=LoadRealRW(Li,-1,Newsize);
	}
	if (Realreg==Imagreg)  Realreg++;	/* Doubleswop*/
	if (Op==DCXNEG) {
		ARCH(fopr(FXCH,currentFSP+1));
		ARCH(oponly(FCHS,0,0));
		ARCH(fopr(FXCH,currentFSP+1));
	}
	ARCH(oponly(FCHS,0,0));

	Cstackcmplxfr(Realreg,Imagreg,Size<<1);

}	/* Complex Unary Op */

static int LoadComplex(struct Stkfmt *Cr,struct Stkfmt *Ci) {
	/****************************************************************/
	/** Load the Real part (and possibly the Imaginary part) of a  **/
	/** Complex Operand into a register) - the Operand should have **/
	/** been derived from Caddress complex opnd above                       **/
	/**                                                            **/
	/** M88110: this procedure is equivalent to:                   **/
	/**         Load Real RO (Cr,Cr_Size)                          **/
	/****************************************************************/
	/***/
	int Size;
	int Freg,Fireg;

	Size=Cr->Size;
	/************************************************************/
	/** Load Real Part into the Register Store                 **/
	/************************************************************/
	Freg=LoadRealRW(Cr,-1,Size);
	Fireg=LoadRealRW(Ci,-1,Size);
	return Freg;

}	/* Load Complex     */


static void ComplexBinaryOp(int Op,int Variant,int Size,struct Stkfmt *Lr,struct Stkfmt *Li,struct Stkfmt
*Rr,struct Stkfmt *Ri) {
	/****************************************************************/
	/** Perform a Binary Complex Operation and put the Result on   **/
	/** the Estack                                                 **/
	/**                                                            **/
	/** Variant= 0  =>  complex op complex                         **/
	/**        = 1  =>  complex op real                            **/
	/** Variant= 2  => real op complex                            **/
	/**                                                            **/
	/** Size   = 4  =>  complex*8 result, complex*8/real*4 opnds   **/
	/**        = 8  =>  complex*16 result, complex*16/real*8 opnds **/
	/**                                                            **/
	/** Does not support Complex / Complex                         **/
	/****************************************************************/

	/*The result of Complex Binary Operation is a Complex FregVal which          */
	/*are stored on the Estack as follows:                                       */
	/**/
	/*  Complex*8 FregVal  ==  Real*8 FregVal                                    */
	/*                     ==  Stk_Size= 8                                       */
	/*                     ==  Stk_Reg= Real part                                */
	/*                     ==  Stk_Reg+1= Imaginary part      (if SPARC)         */
	/*                     ==  Stk_Imagreg= Imaginary FregVal (if M88110)        */
	/**/
	/*  Complex*16 FregVal ==  Real*8 FregVal (for Real part)                    */
	/*                     ==  Stk_Size= 16                                      */
	/*                     ==  Stk_Imagreg= id of Real*8 FregVal (for Imaginary) */
	/**/
	/*SPARC:                                                                     */
	/*By doubling-up a Complex*8 FregVal, loads and stores via DirVals could     */
	/*potentially be performed with one instruction, and if one of the registers */
	/*has to be released then both will automatically be released                */
	/**/
	/*M88110:                                                                    */
	/*It is not anticpated that Complex FregVals will ever, or do, exist in      */
	/*the General Register File - they will be in the Extended Register File.    */


	static const unsigned char Opcodesr [DCXNE-(DCXADD)+1] = {
				rFADD,
				rFSUB,rFMUL,rFDIV,0,0,0,FCOMPP,
				FCOMPP		};
	static const unsigned char Opcodes [DCXNE-(DCXADD)+1] = {
				rFADDP,
				rFSUBP,rFMULP,rFDIVP,0,0,0,FCOMPP,
				FCOMPP		};

	int Lrreg;	/*LHS_real        */
	int Lireg;	/*LHS_imaginary   */
	int Rrreg;	/*RHS_real        */
	int Rireg;	/*RHS_imaginary   */
	int Realreg;	/*RESULT_real     */
	int Imagreg;	/*RESULT_imaginary*/
	int Workreg;
	int Workreg1;
	int x;
	int Index;
	/***/
	int Opcode,Opcoder;
	int Label;
	int Cond;
	/***/

	/************************************************************/
	/** Load the Real Parts of LHS and RHS                     **/
	/************************************************************/
	/**/
	/* At present this only works if all operand in store                        */
	/**/
	if (Variant==2) {
		Lrreg=LoadRealRO(Lr,Size);
	} else {
		Lrreg=Lr->Reg;
		if (!((Lr->Form&31)==FregVal))  Lrreg=LoadComplex(Lr,Li);
	}
	if (Variant!=1) {
		Rrreg=Rr->Reg;
		if (!((Rr->Form&31)==FregVal))  Rrreg=LoadComplex(Rr,Ri);
	} else {
		Rrreg=LoadRealRO(Rr,Size);
	}

	/**/
	/* The Fstack is assumed now to be (deepest first)                           */
	/* Variant =0  C1r,C1i,C2r,C2i                                               */
	/*         =1  C1r,C1i,X                                                     */
	/*         =2  X,C2r,C2i                                                     */
	/* where X is a REal operand                                                 */
	/**/
	/**/
	/* Check for operands the wrong way round. It does not always matter         */
	/**/
	if (Rrreg>Lrreg) {
		if ((Variant==0)&&((Op==DCXADD)||(Op==DCXMULT)))  goto cont;
		if (Op==DCXADD) {
			Variant=3-Variant;
			goto cont;
		}
		if (Variant==0) 	/* Rearrange from C1r,C1i,C2r,C2i*/	/* C1r,C1i,C2i,C2r */{
			ARCH(fopr(FXCH,currentFSP+1));
			ARCH(fopr(FXCH,currentFSP+3))	/* C2r,C1i,C2i,C1r */;
			ARCH(fopr(FXCH,currentFSP+1))	/* C2r,C1i,C1r,C2i */;
			ARCH(fopr(FXCH,currentFSP+2))	/* C2r,C2i,C1r,C1i */;
		} else {
			ARCH(fopr(FXCH,currentFSP+Variant));
			ARCH(fopr(FXCH,(currentFSP+3)-Variant));
		}
	}
cont:

	if ((Op==DCXEQ)||(Op==DCXNE)) {
		goto DoCompare;
	}

	Opcode=Opcodes [Op-(DCXADD)];
	Opcoder=Opcodesr [Op-(DCXADD)];
	switch (Op) {


	case DCXADD:
		/*requires up to 6 fp registers                                             */
	case DCXSUB:

		/* Pentium:  Complex add/sub  Complex                                        */
		if (Variant==0) 	/*  C1r,C1i,C2r,C2i */	/* C1r,Ri,C2r */{
			ARCH(fopr(Opcode,currentFSP+2));
			unlockreg(currentFSP);	/* Release old top */
			ARCH(fopr(Opcode,currentFSP+2))	/* Rr,Ri */;
			unlockreg(currentFSP);	/* Release old top */
			/* C1r,C1i,X   */
		} else if (Variant==1) {
			ARCH(fopr(Opcode,currentFSP+2))	/* Rr,Ri*/;
			unlockreg(currentFSP);	/* Release old top */
			/* X,C2r,C2i       */
		} else {
			if (!(Variant==2))  Mabort(953);
			ARCH(fopr(FXCH,currentFSP+2))	/* C2i,C2r,X       */;
			if (Opcode==rFSUBP)  Opcode=rFSUBRP;
			ARCH(fopr(Opcode,currentFSP+1))	/* C2i,Rr          */;
			unlockreg(currentFSP);
			ARCH(fopr(FXCH,currentFSP+1))	/* Rr,C2i          */;
			if (Op==DCXSUB)  ARCH(oponly(FCHS,0,0));
		}

		goto ReturnOP8;


		/*  SPARC: Complex*16 div Real*8                                             */
		/*  SPARC: Complex*16 mul Complex*16                                         */

	case DCXDIV:	/*Variant= 1 (Complex*8 / Real*4) only*/

	case DCXMULT:	/* Variants 1 & 0 */

		if (Variant==0) {
			Workreg=claimfreg();
			ARCH(fopr(FLDd,currentFSP+3))	/* C1r,C1i,C2r,C2i,C1r */;
			ARCH(fopr(FMUL,currentFSP+2))	/* C1r,C1i,C2r,C2i,Pr    */;
			Workreg=claimfreg();
			ARCH(fopr(FLDd,currentFSP+3))	/* C1r,C1i,C2r,C2i,Pr,C1i*/;
			ARCH(fopr(FMUL,currentFSP+2))	/* C1r,C1i,C2r,C2i,Pr,P'r*/;
			ARCH(fopr(FSUBP,currentFSP+1))	/*C1r,C1i,C2r,C2i,Rr     */;
			unlockreg(currentFSP);
			ARCH(fopr(FXCH,currentFSP+4))	/* Rr,C1i,C2r,C2i,C1r    */;
			ARCH(fopr(FMULP,currentFSP+1))	/* Rr,C1i,C2r,Pi         */;
			unlockreg(currentFSP);
			ARCH(fopr(FXCH,currentFSP+2))	/* Rr,Pi,C1i,C2r         */;
			ARCH(fopr(FMULP,currentFSP+1))	/* Rr,Pi,p'i             */;
			unlockreg(currentFSP);
			ARCH(fopr(FADDP,currentFSP+1))	/* Rr,Ri                 */;
			unlockreg(currentFSP);
			/* Variant = 1           */
		} else {
			ARCH(fopr(Opcoder,currentFSP+2));
			ARCH(fopr(Opcode,currentFSP+1));
			unlockreg(currentFSP);
		}
		goto ReturnOP4;


		/*  SPARC:  Complex*8 cmp  Complex*8                                         */
		/*  SPARC: Complex*16 cmp Complex*16                                         */
		/* M88110: Complex*16 cmp Complex*16                                         */
		/* M88110:  Complex*8 cmp  Complex*8                                         */

DoCompare:

		Label=Mprivatelabel();
		Index=BLocateLabel(Label+Labadjust,0);
		ARCH(fopr(FXCH,currentFSP+3))	/* C2i,C1i,C2r,C1r   */;
		Workreg=claimnamedreg(EAX);
		if (targetvariant==PPRO2) {
			ARCH(fopr(FCOMIP,currentFSP+1))	/* C2i,C1i        */;
			unlockreg(currentFSP);
			manipulateFS(FDISCARD,currentFSP);
			ARCH(fopr(FCOMPP,currentFSP+1));
			unlockreg(currentFSP);
			unlockreg(currentFSP);
			ARCH(bcctf(JNE<<16,Index,0));
			ARCH(oponly(FSTSW,1<<EAX,0));
			ARCH(oponly(SAHF,0,1<<EAX));
			eplabel(Label);
			if (Op!=DCXEQ)  Cond=JNE;
			else Cond=JE;
		} else {
			/**************************************************************/
			/** Compare Real Parts                                       **/
			/**************************************************************/
			ARCH(fopr(FCOMPP,currentFSP+1))	/* C2i,C1i        */;
			unlockreg(currentFSP);
			unlockreg(currentFSP);
			ARCH(oponly(FSTSW,1<<EAX,0));
			/**************************************************************/
			/** Compare Imaginary Parts                                  **/
			/**************************************************************/
			ARCH(fopr(FCOMPP,currentFSP+1));
			unlockreg(currentFSP);
			unlockreg(currentFSP);
			ARCH(rlit(TEST,EAX,0x4000,EAX));
			ARCH(bcctf(JE<<16,Index,0));
			ARCH(oponly(FSTSW,1<<EAX,0));
			eplabel(Label);
			ARCH(rlit(TEST,EAX,0x4000,EAX));
			if (Op==DCXEQ)  Cond=JNE;
			else Cond=JE;
		}
		unlockreg(Workreg);
		enotecc(Cond<<16);
		return ;

ReturnOP4:

ReturnOP8:

		Cstackcmplxfr(currentFSP+1,currentFSP,Size<<1);
		return ;

	}
}	/* Complex Binary Op*/

void DCXOperation(int Op,int Flags,struct Stkfmt *LHS,struct Stkfmt *RHS) {
	/*************************************************************************/
	/** Op = DCXADD     DCXNEG       DCXNE                                  **/
	/**      DCXSUB     DCXASGN      DECMPLX1                               **/
	/**      DCXMULT    DCXCVT       DECMPLX2                               **/
	/**      DCXDIV     DCXEQ        DECONJG                                **/
	/**                                                                     **/
	/** Flags = Variant<< 8 ! newsizecode<< 2 ! sizecode for DCXASGN, DCXCVT**/
	/**                                                                     **/
	/** Flags = Variant<< 8 ! Sizecode   for DCXADD, DCXSUB, DCXMULT,       **/
	/**                                      DCXDIV, DCXEQ , DCXNE          **/
	/** Flags = Sizecode                 for DCXNEG, DECONJG,               **/
	/**                                      DECMPLX1, DECMPLX2             **/
	/**                                                                     **/
	/**         Variant:  0   complex  op  complex                          **/
	/**                   1   complex  op  real                             **/
	/**                   2      real  op  complex                          **/
	/**                                                                     **/
	/**        Sizecode:  0   complex*8   or real*4                         **/
	/**                   1   complex*16  or real*8                         **/
	/**                                                                     **/
	/*************************************************************************/

	int Variant;
	int Size;
	int Newsize;
	int Lareg;	/*register containing base address of LHS*/
	int Rareg;	/*register containing base address of RHS*/
	int Realreg;	/*register containing the real part of the result     */
	int Imagreg;	/*register containing the imaginary part of the result*/
	int Reg;
	int x;
	/***/
	struct Stkfmt Lr;	/*Estack-like entry for the LHS_realpart        */
	struct Stkfmt Li;	/*Estack-like entry for the LHS_imaginarypart   */
	struct Stkfmt Rr;	/*Estack-like entry for the RHS_realpart        */
	struct Stkfmt Ri;	/*Estack-like entry for the RHS_imaginarypart   */
	struct Stkfmt Lstkzero;	/*Estack-like entry for 0.0 - used if Variant= 1*/
	struct Stkfmt Tempstk1;	/*Estack-like entry for Complex*16 / Complex*16 */
	struct Stkfmt Tempstk2;	/*Estack-like entry for Complex*16 / Complex*16 */
	/***/

	Variant=(unsigned)Flags>>8;
	Size=1<<((Flags&3)+2);	/*=either 4 or 8*/
	Newsize=1<<((((unsigned)Flags>>2)&3)+2);	/*=either 4 or 8*/
	if ((Op==DECMPLX1)||(Op==DECMPLX2))  Newsize=Size;
	/**/
	if ((Size==4)&&((Op==DCXEQ)||(Op==DCXNE))) 	/* Precision often too great !!*/{
		{
			struct instrfmt *instr;
			instr=BCurInstr();
			if (((RHS->Form&31)==FregVal)&&((LHS->Form&31)!=FregVal))  releasereg(RHS->Imagreg);
			if (((LHS->Form&31)==FregVal)&&((RHS->Form&31)!=FregVal))  releasereg(LHS->Imagreg);
			/* any stores made by release reg will be deleted by peepholer               */
			/* unless the 'DESTROYABLE' bit is removed                                   */
			while (instr->nextinstr!=0) {
				instr=(struct instrfmt*)(instr->nextinstr);
				instr->props=instr->props&(~DESTROYABLE);
			}
		}
	}
	/**/
	memset(&Lstkzero,0,sizeof( struct Stkfmt));
	Lstkzero.Form=Flitval;	/*this is the only example of     */
	Lstkzero.Rval= 0.0;	/*  an 8-byte Flitval and is      */
	Lstkzero.Size=Newsize;	/*  specially handled by Load Real*/
	Lstkzero.Type=RealType;
	/**/
	if (Op==DCXASGN) {
		/*******************************************************/
		/** Check for Complex Assignment Optimisations        **/
		/*******************************************************/
		if (Variant==2) 	/*Real= Complex*/{
			Rr=*RHS;
			if (Rr.Form>Regflag) {
				manipulateFS(FDISCARD,Rr.Imagreg);
				Rr.Imagreg=0;
			}
			Rr.Size=(unsigned)Rr.Size>>1;
			x=Cstoreop(LHS,&Rr,0);
			/*Handle REAL= COMPLEX as REAL=REAL                                          */
			return ;
		}
	}
	/**/
	if (Op==DCXDIV) {
		/*******************************************************/
		/** Check for Implementation by Support Procedure     **/
		/*******************************************************/
		if (Variant==0)  goto CallMspcall;
	}

	/*******************************************************/
	/** Make Complex Operands Addressable                 **/
	/*******************************************************/
	/**/
	if ((((Op==DCXASGN)||(Op==DCXSUB))&&(Variant==2))||((Op==DCXCVT)&&(Variant==1))) {
		Lareg=-1;
		Lr=*LHS;
		if (Op==DCXSUB) {
			Rareg=Caddresscomplexopnd(RHS,&Rr,&Ri);
		} else Rareg=-1;
	} else {
		if ((Op!=DECMPLX1)&&(Op!=DECMPLX2)) {
			Lareg=Caddresscomplexopnd(LHS,&Lr,&Li);
			if ((Variant==0)&&(Op!=DCXCVT)&&(Op!=DCXNEG)&&(Op!=DECONJG)) {
				Rareg=Caddresscomplexopnd(RHS,&Rr,&Ri);
			} else {
				Rr=*RHS;
				Rareg=-1;
			}
		}
	}

	switch (Op) {


	case DCXASGN:	/* (ETOS-1) = (ETOS-2) */


		if (Variant!=2) {
			if (Variant==1) {
				Ri=Lstkzero;
			} else {
				if (Newsize!=Size) {
					Ri.Reg=LoadRealRW(&Ri,-1,Newsize);
					Ri.Form=FregVal|Regflag;
					Ri.Size=Newsize;
					Ri.Type=RealType;
				}
			}
			/**/
			x=Cstoreop(&Li,&Ri,0);
		}

		if (Newsize!=Size) {
			Rr.Reg=LoadRealRW(&Rr,-1,Newsize);
			Rr.Form=FregVal|Regflag;
			Rr.Size=Newsize;
			Rr.Type=RealType;
		}
		x=Cstoreop(&Lr,&Rr,0);
		/**/
		goto Return;


	case DCXCVT:	/* Convert (ETOS-1) => ETOS */


		if (Variant==2) 	/*Real*X <- Complex*Y*/{
			Cdiscardopnd(&Li);
			Realreg=LoadRealRW(&Lr,-1,Newsize);
			Cstackfr(Realreg,Newsize);
			return ;
		}
		if (Variant==1) 	/*Complex*X <- Real*Y*/{
			Li=Lstkzero;
		}

		if (((Lr.Form&31)==FregVal)&&((Li.Form&31)==FregVal)) {
			Realreg=Lr.Reg;
			Imagreg=Li.Reg;
			if (!(((Realreg-1)==Imagreg)&&(Imagreg==currentFSP))) {
				manipulateFS(BUBBLETOTOP,Realreg);
				manipulateFS(BUBBLETOTOP,Imagreg);
				Imagreg=currentFSP; Realreg=currentFSP+1;
			}
		} else {
			Realreg=LoadRealRW(&Lr,-1,Newsize);
			Imagreg=LoadRealRW(&Li,-1,Newsize);
		}
		if (Realreg==Imagreg)  Realreg++;	/* Doubleswop*/
		Cstackcmplxfr(Realreg,Imagreg,Newsize<<1);

		/*note that Load Real always returns a   */
		/*write-able register if Newsize# Lr_Size*/
		goto Return;

	case DECMPLX1:	/* ((ETOS-1),0.0) => ETOS */


		/*the code below assumes that any conversions required will                  */
		/*    have been performed earlier by compiler generated Eops                 */
		/**/
		Realreg=LoadRealRW(LHS,-1,Newsize);
		Imagreg=LoadRealRW(&Lstkzero,-1,Newsize);
		if (Realreg==Imagreg)  Realreg++;	/* Doubleswop*/
		Cstackcmplxfr(Realreg,Imagreg,Newsize<<1);
		return ;
	case DECMPLX2:	/* ((ETOS-2),(ETOS-1)) => ETOS */


		/*the code below assumes that any conversions required will                  */
		/*    have been performed earlier by compiler generated Eops                 */
		/**/
		Realreg=LoadRealRW(LHS,-1,Newsize);
		Imagreg=LoadRealRW(RHS,-1,Newsize);
		if (Realreg==Imagreg)  Realreg++;	/* Doubleswop*/
		Cstackcmplxfr(Realreg,Imagreg,Newsize<<1);

		/*note that Load Real always returns a    */
		/*write-able register if LHS_Size# Newsize*/
		return ;

	case DCXNEG:
	case DECONJG:
		ComplexUnaryOp(Op,Size,Newsize,&Lr,&Li);
		goto Return;


	case DCXADD:	/* ETOS-2) + (ETOS-1) => ETOS*/
	case DCXSUB:	/* ETOS-2) - (ETOS-1) => ETOS*/
	case DCXMULT:	/* ETOS-2) * (ETOS-1) => ETOS*/
	case DCXDIV:	/* ETOS-2) / (ETOS-1) => ETOS*/
	case DCXEQ:	/* ETOS-2) eq (ETOS-1) => ETOS*/
	case DCXNE:	/* ETOS-2) ne (ETOS-1) => ETOS*/

		ComplexBinaryOp(Op,Variant,Size,&Lr,&Li,&Rr,&Ri);


Return:

		/*******************************************************/
		/** Exit from DCXOP                                   **/
		/*******************************************************/
		/**/
		return ;

CallMspcall:

		/*******************************************************/
		/** Invoke Support Procedures                         **/
		/*******************************************************/
		/**/
		/*the current implementation assumes that only                               */
		/*    Complex*8 / Complex*8 and                                              */
		/*    Complex*16/ Complex*16                                                 */
		/*are implemented as calls on the runtime library                            */

		Elevel+=2;
		enotecc(-1);
		TargetReg=-1;	/* Ensure no targetting as we may now be */
		TargetFreg=-1;	/* doing a nested call                   */

		if (Size==4) {
			/*******************************************************/
			/** Do COMPLEX*8 / COMPLEX*8                          **/
			/*******************************************************/
			/**/
			Mexpcall(exp_lccdiv);	/*call f_lccdiv as a leaf procedure*/
			/**/
			/*Note: f_lccdiv is described within Mexpcall as a longreal                  */
			/*      function implemented as a leaf procedure taking two                  */
			/*      longreal arguments and returning a longreal function                 */
			/*      result - this may not be appropriate for architectures               */
			/*      other than SPARC (especially if the parameter passing                */
			/*      mechanism has to seriously worry about longreal alignment)           */

			/*          %IF cgoptions&RNDSNGL#0 %THEN %START                             */
			/*             target fr(cvtsd,f0REG+1,f0REG+1); target fr(cvtsd,f0REG+2,f0REG+2)*/
			/*         %FINISH                                                           */
			Realreg=claimfreg();
			Imagreg=claimfreg();
			Cstackcmplxfr(Realreg,Imagreg,8)	/* Posn of IMAG is target dependent!*/;
		} else {
			/*******************************************************/
			/** Do COMPLEX*16 / COMPLEX*16                        **/
			/**                                                   **/
			/** ie: call leaf procedure f_lcddiv                  **/
			/**     Mexpcall regards f_lcddic as a routine        **/
			/**     since there is no mechanism for returning     **/
			/**     a complex*16 result. In fact we know it is in **/
			/**     FRs 1 and 2 as per IBM standards              **/
			/*******************************************************/
			/**/
			if (cmplxtemp==0)  cmplxtemp=ARCH(tempspace(16,8));
			Mexpcall(exp_lcddiv);	/*call f_lcddiv     */
			Realreg=claimfreg();
			Imagreg=claimfreg();
			Cstackcmplxfr(Realreg,Imagreg,16)	/* Posn of IMAG is target dependent!*/;
		}
		return ;


	}
}	/* DCX Operation                                                           */

void DCXCmerge(int Flags,struct Stkfmt *Boolean,struct Stkfmt *Tsource,struct Stkfmt *Fsource) {
	/****************************************************************/
	/** if Boolean = True then stack Tsource else stack Fsource    **/
	/**                                                            **/
	/** Flags = Sizecode                                           **/
	/**         Sizecode:  0   complex*8                           **/
	/**                    1   complex*16                          **/
	/**                                                            **/
	/****************************************************************/
	int Realreg,Imagreg,Areg,Reg;
	int Label1,Label2,Label3,comp;
	int Size;

	struct Stkfmt Cr;
	struct Stkfmt Ci;

	if (Boolean->Form==LitVal) {
		if (Boolean->Intvalue==0) {
			Cdiscard(Tsource);
			Cpushoperand(Fsource);
		} else {
			Cdiscard(Fsource);
			Cpushoperand(Tsource);
		}
		return ;
	}

	Label1=Mprivatelabel();
	Label2=Mprivatelabel();
	Size=1<<(Flags+2);
	if ((Fsource->Form&31)!=FregVal) {
		Ctestval(Icompare,Boolean);
		Cjump(Icompare|EQ,Label1,0);
		if ((Tsource->Form&31)!=FregVal) {
			Areg=Caddresscomplexopnd(Tsource,&Cr,&Ci);
			Realreg=LoadRealRW(&Cr,-1,Size);
			Imagreg=LoadRealRW(&Ci,-1,Size);
			unlockreg(currentFSP);
			unlockreg(currentFSP);
		}
		Cjump(ALWAYS,Label2,0);
		Mfrlabel(Label1,1);

		if ((Tsource->Form&31)==FregVal) {
			manipulateFS(FDISCARD,currentFSP);
			manipulateFS(FDISCARD,currentFSP);
		}
		Areg=Caddresscomplexopnd(Fsource,&Cr,&Ci);
		Reg=LoadRealRW(&Cr,-1,Size);
		Reg=LoadRealRW(&Ci,-1,Size);
		Cstackcmplxfr(currentFSP+1,currentFSP,Size<<1);
		Mfrlabel(Label2,1);
		return ;
	}

	/**/
	/* Fsource already loaded now load Tsources                                  */
	/**/
	if ((Tsource->Form&31)!=FregVal) {
		Areg=Caddresscomplexopnd(Tsource,&Cr,&Ci);
		Realreg=LoadRealRW(&Cr,-1,Size);
		Imagreg=LoadRealRW(&Ci,-1,Size);
	} else {
		Realreg=Tsource->Reg;	 
		Imagreg=Tsource->Imagreg;
	}
	/**/
	/* Now check which way up                                                    */
	/**/
	Ctestval(Icompare,Boolean);
	if (targetvariant!=PPRO2) {
		if (Imagreg<(int)Fsource->Imagreg)  comp=NE; 
		else comp=EQ;
		Cjump(Icompare|comp,Label1,0);
		/**/
		/* we want the bottom one                                                    */
		/**/
		manipulateFS(FDISCARD,currentFSP);
		manipulateFS(FDISCARD,currentFSP);
		Cjump(ALWAYS,Label2,0);
		Mfrlabel(Label1,1);
		/**/
		/* we want top one so store top into btm & pop                               */
		/**/
		ARCH(fopr(FSTPd,currentFSP+2));
		ARCH(fopr(FSTPd,currentFSP+2));
		Cstackcmplxfr(currentFSP+1,currentFSP,Size<<1);
		Mfrlabel(Label2,1);
	} else {
		if (Imagreg<(int)Fsource->Imagreg)  comp=FCMOVE; 
		else comp=FCMOVNE;
		ARCH(fopr(comp,currentFSP+2));
		ARCH(fopr(FXCH,currentFSP+1));
		ARCH(fopr(comp,currentFSP+3));
		/**/
		/* now discard bottom and undo FXCH by storing top two into next two &pop    */
		/**/
		enotecc(-1);
		ARCH(fopr(FSTPd,currentFSP+3));
		ARCH(fopr(FSTPd,currentFSP+1));
		unlockreg(currentFSP);
		unlockreg(currentFSP);
		Cstackcmplxfr(currentFSP+1,currentFSP,Size<<1);
	}
}	/* DCX Cmerge                                                              */
/***/
#endif/*%if Language=FORTRAN %and Directcomplex=1*/
/***/
/**/
/* Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/*%IF Language=FORTRAN %THENSTART                                            */
/***/
void Cstkreg(int Creg,int Offset) {
	/**************************************************************************/
	/** Create an Estack entry for a value held in an FORTRAN optimiser      **/
	/** register                                                             **/
	/**************************************************************************/
	int Reg;
	Reg=CregMap [Creg];
	Cstackr(Reg,4);
	Stk [Elevel].Offset=Offset;
	/**/
	/**/
}	/* Cstkreg                                                                 */
/***/
void Cstkfreg(int Cfreg,int Size) {
	/**************************************************************************/
	/** Create an Estack entry for a value held in an FORTRAN optimiser      **/
	/** floating point register                                              **/
	/**************************************************************************/
	int Reg;
	Reg=CfregMap [Cfreg];
	Cstackfr(Reg,Size);
	/**/
	/**/
}	/* Cstkfreg                                                                */
/***/
void Cstkbaseindex(int base,int index,int Offset,int Size,int Type,int Scale) {
	/**************************************************************************/
	/** Used by FORTRAN optimiser to nominate an item by                     **/
	/** basereg[+index][+offset] either index or offset will be zero. Scale  **/
	/** is 1,2,4 or 8.                                                       **/
	/**************************************************************************/
	struct Stkfmt *Lstk;
	int Reg,Scalep;

	Scalep=0;
	while (Scale!=1) {
		Scale=(unsigned)Scale>>1;
		Scalep++;
	}

	Reg=CregMap [base];

	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	if ((Offset==0)&&(index==0)) {
		Lstk->Form=IndRegVal;
	} else {
		Lstk->Form=IndRegModVal;
		if ((Offset==0)&&(index!=0)) {
			Lstk->Modform=Regvar;
			Lstk->Modreg=CregMap [index];


			Lstk->Scale=Scalep;
			notereguse(Lstk->Modreg,-Elevel,4);
		} else {
			Lstk->Modform=LitVal;
			Lstk->Modintval=Offset<<Scalep;
		}
	}
	Lstk->Type=Type;
	Lstk->Size=Size;
	Lstk->Reg=Reg;
	notereguse(Reg,-Elevel,4);
}	/* Cstkbaseindex                                                           */
/***/
/*%FINISH                                                                    */	/* %if Langauge=Fortan */
/***/
void Cinitreg(int base) {
	/*************************************************************************/
	/** Load an FORTRAN or USL C optimiser register with (ETOS)             **/
	/*************************************************************************/
	int Reg,OptReg;

	Elevel-=1;
	OptReg=CregMap [base];
	Reg=LoadIntGeneral(&Stk [Elevel+1],OptReg,1,0);
	/**/
	unlockreg(Reg);
}	/* Cinitreg                                                                */
/***/
void Cincregbylit(int base,int litval,int size,int type) {
	/*************************************************************************/
	/** increment an Optimiser register with a small literal                **/
	/** Avoid a formal establishing of CC but care still needed on MIPS     **/
	/** where there is a virtual 'cc'                                       **/
	/*************************************************************************/
	int Reg,shift,CC;
	Reg=CRegVarMap [base];
	CC=ereadcc();
	if (CC!=-1 && size==4) {
		ARCH(oprmem(LEA,Reg,litval,Reg,4));
	} else {
		if (CC!=-1)  ARCH(oponly(PUSHFD,1<<STACKPOINTER,1<<STACKPOINTER));
		ARCH(oplit(ADD,Reg,litval,Reg));
		if (size<4) {
			shift=(4-size)*8;
			ARCH(oplit(SHL,Reg,shift,Reg));
			if (type==UintType)  ARCH(oplit(SHR,Reg,shift,Reg)); 
			else ARCH(oplit(SAR,Reg,shift,Reg));
		}
		if (CC!=-1)  ARCH(oponly(POPFD,1<<STACKPOINTER,1<<STACKPOINTER));
	}
	forgetreg(Reg);
	checkregconflict(Reg);	/* forget scaled reg memory */
}	/* Cincregbylit                                                            */
/***/
void Cincreg(int base) {
	/*************************************************************************/
	/** Increment an FORTRAN optimiser register with (ETOS)                 **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	int Reg,Form;
	Reg=CregMap [base];
	Elevel-=1;
	Lstk=&Stk [Elevel+1];
	Form=Lstk->Form&31;
	if (Form==LitVal) {
		ARCH(oplit(ADD,Reg,Lstk->Intvalue,Reg));
	} else {
		ARCH(oprx(ADD,Reg,Lstk,DESTREG));
	}
}	/* Cincreg                                                                 */
/***/
void Cdecreg(int base) {
	/*************************************************************************/
	/** Decrement an FORTRAN optimiser register with (ETOS)                 **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	int Reg,Form;
	Reg=CregMap [base];
	Elevel-=1;
	Lstk=&Stk [Elevel+1];
	Form=Lstk->Form&31;
	if (Form==LitVal) {
		ARCH(oplit(ADD,Reg,-Lstk->Intvalue,Reg));
	} else {
		ARCH(oprx(SUB,Reg,Lstk,DESTREG));
	}
}	/* Cdecreg                                                                 */
/***/
/***/
void CpassFregMask(int Lmask) {
	/*************************************************************************/
	/** Reserves registers for the Optimiser.  The mask has a bit set for   **/
	/** each optimiser floating point register to be used in the forthcoming**/
	/** block.                                                              **/
	/**                                                                     **/
	/** It is assumed that the Estack is empty at the time of call.         **/
	/*************************************************************************/
	int i,mask;
	/**/
	/* First translate mask from logical regs to actual regs                     */
	/**/
	mask=0;
	if (!(Lmask==0))  Mabort(999);	/* Cant claim fregs on pentium*/
	if (Lmask!=0) {
		for (i=0; i<=31; i++) {
			if (((1<<i)&Lmask)!=0)  mask|=1<<(CfregMap [i]-f0REG);
		}
	}
}	/* CpassFregMask                                                           */
/***/
void CpassGregMask(int Lmask) {
	/*************************************************************************/
	/** Reserves registers for the Optimiser.  The mask has a bit set for   **/
	/** each optimiser general register to be used in the forthcoming       **/
	/** block.                                                              **/
	/**                                                                     **/
	/** It is assumed that the Estack is empty at the time of call.         **/
	/*************************************************************************/
	int i,mask;
	/**/
	/* First translate logical mask to physical mask                             */
	/**/
	mask=0;
	if (Lmask!=0) {
		for (i=0; i<=FRBASE-1; i++) {
			if (((1<<i)&Lmask)!=0)  mask|=1<<CregMap [i];
		}
	}

	if (RegClaimMaskA!=0) {
		for (i=0; i<=FRBASE-1; i++) {
			if (((1<<i)&RegClaimMaskA)!=0) {
				unlockpermreg(i); 
				forgetreg(i);
			}
		}
	}
	RegClaimMaskA=mask;
	if (RegClaimMaskA!=0) {
		for (i=0; i<=FRBASE-1; i++) {
			if (((1<<i)&RegClaimMaskA)!=0)  userlockreg(i);
		}
	}
	if (((mask&(1<<EDI))!=0)||((Pic!=0)&&((mask&(1<<EBX))!=0)))  Mabort(52);
}	/* CpassGregMask                                                           */
void Cmerge1(int Type,struct Stkfmt *Boolean,struct Stkfmt *Tsource,struct Stkfmt *Fsource) {
	/****************************************************************/
	/** if Boolean = True then stack Tsource else stack Fsource    **/
	/**                                                            **/
	/** Type = IntType                                             **/
	/**        RealType                                            **/
	/****************************************************************/
	int Resreg,Reg,Label,Size;

	if (Boolean->Form==LitVal) {
		if (Boolean->Intvalue==0) {
			Cdiscard(Tsource);
			Cpushoperand(Fsource);
		} else {
			Cdiscard(Fsource);
			Cpushoperand(Tsource);
		}
		return ;
	}

	Size=Tsource->Size;
	if (targetvariant!=PPRO2) {
		Label=Mprivatelabel();
		if ((Type==IntType && Size!=8)||
			(Type!=IntType && (Fsource->Form&31)!=FregVal)) {
			if (Type==IntType) {
				Resreg=LoadIntRW(Tsource,-1);
			} else {
				Resreg=LoadRealRW(Tsource,-1,Size);
			}
			Ctestval(Icompare,Boolean);
			Cjump(Icompare|NE,Label,0);
			unlockreg(Resreg);
			if (Type==IntType) {
				Reg=LoadIntRW(Fsource,Resreg);
				Cstackr(Reg,Size);
			} else {
				ARCH(fopr(FSTPd,currentFSP))	/* Pop stack by store to self & pop*/;
				Reg=LoadRealRW(Fsource,Resreg,Size);
				Cstackfr(Reg,Size);
			}
			Mfrlabel(Label,1);
		} else {
			Reg=LoadRealRW(Fsource,-1,Size);
			Resreg=LoadRealRW(Tsource,-1,Size)	/* Tsource over Fsource */;
			Ctestval(Icompare,Boolean);
			Cjump(Icompare|EQ,Label,0);
			ARCH(fopr(FXCH,currentFSP+1));
			Mfrlabel(Label,1);
			manipulateFS(FDISCARD,currentFSP);
			Cstackfr(currentFSP,Size);
		}
	} else {
		if (Type==IntType && Size!=8) {
			Resreg=LoadIntRW(Tsource,-1);
			Reg=LoadIntRO(Fsource);
			Ctestval(Icompare,Boolean);
			ARCH(rr(CMOVE,Reg,-1,Resreg));
			enotecc(-1);
			unlockreg(Reg);
			Cstackr(Resreg,Size);
		} else {
			Reg=LoadRealRW(Fsource,-1,Size);
			Resreg=LoadRealRW(Tsource,-1,Size)	/* Tsource over Fsource */;
			Ctestval(Icompare,Boolean);
			ARCH(fopr(FCMOVE,currentFSP+1));
			enotecc(-1);
			ARCH(fopr(FSTPd,currentFSP+1));
			unlockreg(currentFSP);
			Cstackfr(currentFSP,Size);
		}
	}
}	/* Cmerge1                                                                 */
#if (Language==FORTRAN)
void Cregtarget(int OptReg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to target an integer register             **/
	/*************************************************************************/
	if (OptReg<0) {
		TargetReg=-1;
	} else {
		TargetReg=CregMap [OptReg];
	}
}	/* Cregtarget                                                              */
/***/
void Cfregtarget(int OptReg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to target a floating point register       **/
	/*************************************************************************/
	if (OptReg<0) {
		TargetFreg=-1;
	} else {
		TargetFreg=CfregMap [OptReg];
	}
}	/* Cfregtarget                                                             */
/***/
int Cnumregs() {
	/*************************************************************************/
	/** Returns the number of registers available for allocation by the     **/
	/** FORTRAN optimiser                                                   **/
	/*************************************************************************/
	if (Pic==0)  return Cnumregsregs;
	return Cnumregsregs-1;
}	/* Cnumregs                                                                */
/***/
void Cincrjump(int Creg,int Opcode,int Labelid) {
	/*************************************************************************/
	/** Increments FORTRAN Creg by (ETOS) and jumps to Labelid using Opcode **/
	/** Opcode is an Eop in the range JINTGZ...JINTLEZ                      **/
	/*************************************************************************/
	struct procfmt *PI;
	struct Stkfmt *Lstk;
	int Reg,Reg1,Form;

	Reg=CregMap [Creg];

	Elevel-=1;
	Lstk=&Stk [Elevel+1];
	Form=Lstk->Form&31;
	/**/
	/* we are about to change the condition codes so notify EMachine */
	enotecc(-1);
	/**/
	if (Form==LitVal) {
		/**/
		ARCH(oplit(ADD,Reg,Lstk->Intvalue,Reg));
	} else {
		Reg1=LoadIntRO(Lstk);
		ARCH(rr(ADD,Reg,Reg1,Reg));
		/**/
		unlockreg(Reg1);
	}
	/**/
	Cstackr(Reg,4);
	ejump(Opcode,Labelid);
}	/* Cincrjump                                                               */
/***/
void Cdecrjump(int Creg,int Opcode,int Labelid) {
	/*************************************************************************/
	/** Decrements FORTRAN Creg by (ETOS) and jumps to Labelid using Opcode **/
	/** Opcode is an Eop in the range JINTGZ...JINTLEZ                      **/
	/*************************************************************************/
	struct procfmt *PI;
	struct Stkfmt *Lstk;
	int Reg,Reg1,Form;

	if (!(Creg<0))  Reg=CregMap [Creg];	/* special purpose reg                   */


	Elevel-=1;
	Lstk=&Stk [Elevel+1];
	Form=Lstk->Form&31;
	/**/
	/* we are about to change the condition codes so notify EMachine */
	enotecc(-1);
	/**/
	if (Form==LitVal) {
		/**/
		ARCH(oplit(ADD,Reg,-Lstk->Intvalue,Reg));
	} else {
		Reg1=LoadIntRO(Lstk);
		/**/
		ARCH(rr(SUB,Reg,Reg1,Reg));
		unlockreg(Reg1);
	}
	/**/
	Cstackr(Reg,4);
	ejump(Opcode,Labelid);
}	/* Cdecrjump                                                               */
/***/
void Cbitops(int Op) {
	/******************************************************************/
	/** Opcodes                                                      **/
	/**    BitWordShift    (0): whole word shift                     **/
	/**    BitFieldExtract (1): extract a bit field                  **/
	/**    BitSet          (2): set   a single bit                   **/
	/**    BitTest         (3): test  a single bit                   **/
	/**    BitClear        (4): clear a single bit                   **/
	/**    BitFieldRotate  (5): rotate a bit field (+ left | - right)**/
	/**                                                              **/
	/******************************************************************/
	static const unsigned char Bops [BitClear-(BitSet)+1] = {
				OR,
				0,AND		};
	/**/
	int Stk1reg,Stk2reg,Stk3Reg,Stk2form,Stk2val,Stk3form;
	int Stk3val,Resreg,code;
	int i8flag;
	struct Stkfmt *Stk1,*Stk2,*Stk3;
	if (!((BitWordShift<=Op)&&(Op<=BitFieldRotate)))  Mabort(23);
	switch (Op) {

	case BitWordShift:

		Stk2=&Stk [Elevel];	/*shiftwidth*/
		Stk1=&Stk [Elevel-1];	/*operand*/
		Elevel-=2;
		i8flag = (Stk1->Size == 8);
		/**/
		Stk2form=Stk2->Form&31;
		if (Stk2form==LitVal) {
			Stk2val=Stk2->Intvalue;
			if ((!i8flag && abs(Stk2val)>=32)||(i8flag && abs(Stk2val) >= 64)) {
				Cdiscardopnd(Stk1);
				Cpushoperand(&LitZero);
				if (i8flag) {
					Elevel -= 1;
					Cmakedouble(&LitZero, &Stk[Elevel+1]);
				}
			} else {
				if (Stk2val==0) {
					Elevel++;
				} else {
					if (Stk2val<0) {
						code=ISHRL;
						Stk2->Intvalue=-Stk2val;
					} else code=ISHLL;
					CIntBinaryOp(code,Stk1,Stk2,0);
				}
			}
		} else {
			/**/
			/*         C Int Binary op(ISHLL,Stk1,Stk2,0);! RS6000 works for -ves to -31 */
			if (!i8flag) {
			    Elevel+=2;
			    enotecc(-1);
			    TargetReg=-1;  /* Ensure no targetting as we may now be doing */
			    TargetFreg=-1; /* a nested call                               */
			    Mexpcall(exp_lishft);  /* call f_lishft as a leaf procedure           */
			} else {
				struct Stkfmt Least, Most;
				int areg;
                /* get operand into edx/eax, shift amount into ecx */
                /* and call support func                           */
                Conditionalreleasereg(EAX, Stk1);
                Conditionalreleasereg(EDX, Stk1);
                Conditionalreleasereg(ECX, Stk2);
                claimnamedreg(EAX);
                areg = Cdividelongint(Stk1, &Least, &Most);
                (void)LoadIntRW(&Least, EAX);
                userlockreg(EAX);
                (void)LoadIntRW(&Most, EDX);
                userlockreg(EDX);
                (void)LoadIntRW(Stk2, ECX);
		        if (areg >= 0) unlockreg(areg);
                userlockreg(ECX);
                Mspcall(sp_ush64);      /* __ush64() */
				Cstkresult(IntType, 8);
				unlockpermreg(EAX);
				unlockpermreg(ECX);
				unlockpermreg(EDX);
				forgetreg(EAX);
				forgetreg(EDX);
				forgetreg(ECX);
			}
			/**/
		}
		return ;

	case BitFieldExtract:

		Stk3=&Stk [Elevel];	/*width*/
		Stk2=&Stk [Elevel-1];	/*offset*/
		Stk1=&Stk [Elevel-2];	/*operand*/
		Elevel-=3;
		i8flag = (Stk1->Size == 8);
		/**/
		Stk2form=Stk2->Form&31;
		Stk3form=Stk3->Form&31;
		if (!i8flag && (Stk2form==LitVal)&&(Stk3form==LitVal)) {
			Stk2val=Stk2->Intvalue;
			Stk3val=Stk3->Intvalue;
			Resreg=claimtgtreg();
			Stk1reg=LoadIntRO(Stk1);
			/**/
			ARCH(oplit(SHL,Stk1reg,((32-Stk3val)-Stk2val),Resreg));
			ARCH(oplit(SHR,Resreg,(32-Stk3val),Resreg));
			/**/
			unlockreg(Stk1reg);
			Cstackr(Resreg,4);
		} else {
			/**/
			/**/
			/* do this with eops but note INOT does not yet fold consts                  */
			/**/
			Elevel+=3;	/* Put params back on Estack */
			estklit(-1);
			if (i8flag) {
				Elevel -= 1;
				ConvertII(&Stk[Elevel+1], 8);
			}
			eop(EXCH);
			eop(ISHLL);	/* Generate a mask           */
			eop(INOT);
			edemote(3);
			eop(ISHRL);
			eop(IAND);
			/**/
		}
		return ;

	case BitTest:

		Stk2=&Stk [Elevel];
		Stk1=&Stk [Elevel-1];
		i8flag = (Stk1->Size == 8);
		if (!i8flag && (Stk1->Form==LitVal)&&(LitVal==Stk2->Form)) {
			Elevel-=2;
			estklit((((unsigned)Stk1->Intvalue>>Stk2->Intvalue)&1));
		} else {
			eop(ISHRL);
			estklit(1);
			if (i8flag) {
				Elevel -= 1;
				ConvertII(&Stk[Elevel+1], 8);
			}
			eop(IAND);
		}
		return ;
	case BitSet:

	case BitClear:

		Stk2=&Stk [Elevel];	/*offset*/
		Stk1=&Stk [Elevel-1];	/*operand*/
		Elevel-=2;
		i8flag = (Stk1->Size == 8);
		/**/
		Stk2form=Stk2->Form&31;
		Stk2val=Stk2->Intvalue;
		if (i8flag) {
			Elevel += 1;   /* preserve operand */
            if (Stk2form == LitVal) {
				struct Stkfmt fixedpart = LitZero;
				struct Stkfmt varpart   = LitZero;
				if (Op == BitClear) fixedpart.Intvalue = -1;
				if (Stk2val >= 32) {
					varpart.Intvalue = 1 << (Stk2val - 32);
					if (Op == BitClear) varpart.Intvalue = ~varpart.Intvalue;
					Cmakedouble(&varpart, &fixedpart);
				} else {
					varpart.Intvalue = 1 << Stk2val;
					if (Op == BitClear) varpart.Intvalue = ~varpart.Intvalue;
					Cmakedouble(&fixedpart, &varpart);
				}
			} else {
				struct Stkfmt mask = LitOne;
				mask.Size = 8;
				mask.Modintval = 0;
				DoLongIntOp(ISHLL, &mask, Stk2);
				if (Op == BitClear) {
					Elevel -= 1;
					DoLongIntOp(INOT, Stk2, NULL);
				}
			}
			Elevel -= 2;
			DoLongIntOp((Op == BitClear? IAND : IOR), Stk1, Stk2);
			return;
		} else if (Stk2form==LitVal) {
			Resreg=LoadIntRW(Stk1,TargetReg);
			if (Op==BitSet)  ARCH(oplit(OR,Resreg,1<<Stk2val,Resreg));
			else ARCH(oplit(AND,Resreg,~(1<<Stk2val),Resreg));
		} else {
			Conditionalreleasereg(ECX,Stk2);
			Stk2reg=LoadIntRW(Stk2,ECX);
			Resreg=claimtgtreg();
			ARCH(loadlit(1,Resreg));
			ARCH(opr(SHLV,Resreg))	/* Shift by ECX (stk2reg) */;
			if (Op==BitClear)  ARCH(opr(NOT,Resreg));
			ARCH(oprx(Bops [Op-(BitSet)],Resreg,Stk1,DESTREG));
			/***/
			unlockreg(Stk2reg);
		}
		Cstackr(Resreg,4);
		return ;

	case BitFieldRotate:

		Stk3=&Stk [Elevel];
		if (Stk [Elevel-2].Size == 8) {
			epromote(3);
			Elevel -= 1;
			Csplitdouble(&Stk[Elevel+1]);
			edemote(4);   /* return most */
			edemote(4);  /* ... and least significant halves to proper posn */
			Mspcall(sp_cshft64);  /* __cshft64 */
		} else if ((Stk3->Form==LitVal)&&(Stk3->Intvalue==32)) {
			/* 32 fieldwidth                                                             */
			Stk2=&Stk [Elevel-1];
			Stk1=&Stk [Elevel-2];
			Elevel-=3;
			Conditionalreleasereg(ECX,Stk2);
			Stk2reg=LoadIntRW(Stk2,ECX);
			Stk1reg=LoadIntRO(Stk1);
			ARCH(oplit(AND,ECX,31,ECX));
			forgetreg(ECX); forgetreg(Stk1reg);
			ARCH(opr(ROLV,Stk1reg));
			unlockreg(Stk2reg);
			Cstackr(Stk1reg,4);
		} else {
			enotecc(-1);
			TargetReg=-1;	/* Ensure no targetting as we may now be */
			TargetFreg=-1;	/* doing a nested call                   */
			Mspcall(sp_ishftc);	/* F77ishftc                             */
		}
	}
}	/* Cbitops                                                                 */
/***/
void Cminus1exp(struct Stkfmt *Power) {
	/****************************************************************/
	/** Stack result of -1 ** Power  (integer valued)              **/
	/****************************************************************/
	struct instrfmt *instr;
	int Resreg,Preg,Pform,Pval,Resval;

	Pform=Power->Form&31;
	if (Pform!=LitVal) {
		if (TargetReg<0)  Resreg=-1; 
		else Resreg=claimnamedtgt(TargetReg);
		Preg=LoadIntRW(Power,Resreg);
		/***/
		ARCH(oplit(AND,Preg,1,Preg))	/*AND Power with 1*/;
		ARCH(rr(ADD,Preg,Preg,Preg));
		ARCH(opr(DEC,Preg));
		ARCH(opr(NEG,Preg));
		Cstackr(Preg,4);
	} else {
		Pval=Power->Intvalue;
		if ((Pval&0x1)==1)  Resval=-1; 
		else Resval=1;
		estklit(Resval);
	}

}	/* Cminus1exp                                                              */
/***/
void Csign(int Type,struct Stkfmt *X1,struct Stkfmt *X2) {
	/****************************************************************/
	/** Type = IntType                                             **/
	/**        RealType                                            **/
	/** stack result of  |X1|  if  X2 >=0                          **/
	/**                 -|X1|  if  X2 < 0                          **/
	/****************************************************************/
	int ResReg,Label,CondCodeReg,X1size,X2size,X1reg,X2reg,index,Op1,Op2,Form,reg;
	int i8flag = (Type == IntType && X1->Size == 8);
	struct instrfmt *instr;
	/***/
	enotecc(-1);
	Label=Mprivatelabel();
	index=BLocateLabel(Label+Labadjust,0);
	if (Type!=IntType || i8flag)  goto Real;
	/***/
Int:

	X1reg=LoadIntRW(X1,-1);
	if (targetvariant==PPRO2) {
		X2reg=LoadIntRW(X2,-1);
		ResReg=claimreg();
		ARCH(rr(MOV,X1reg,-1,ResReg));
		ARCH(opr(NEG,ResReg));
		ARCH(rr(XOR,X1reg,-1,X2reg));
		forgetreg(X2reg);
		ARCH(rr(CMOVL,ResReg,-1,X1reg));
	} else {
		X2reg=LoadIntRO(X2);
		ResReg=claimreg();
		ARCH(rr(XOR,X1reg,X2reg,ResReg));
		ARCH(bcctf((JGE<<16)|(ResReg<<8),index,0));	/* using ccfield 0 set by xor   */
		ARCH(opr(NEG,X1reg));
		eplabel(Label);
	}
	unlockreg(X2reg);
	unlockreg(ResReg);
	unlockreg(X1reg);
	Cstackr(X1reg,4);
	return ;

Real:

	X1size=X1->Size;
	X2size=X2->Size;
	Form=X2->Form&31;
	if (targetvariant!=PPRO2) {
/*		if ((Form==FregVal)||(Form==Fregvar)||((X2->Flags&STKSWOPPED)!=0)) {
*/
			if (i8flag)
				X2reg=LoadIntRW(X2,-1);
			else
			    X2reg=LoadRealRW(X2,-1,X2size);
			reg=claimfreg();
			ARCH(oponly(FLDZ,0,0));
			ARCH(fopr(FCOMPP,X2reg));
			unlockreg(reg);
			unlockreg(X2reg);
			if (i8flag)
			    X1reg=LoadIntRW(X1,-1);
			else
			    X1reg=LoadRealRW(X1,-1,X1size);
			ResReg=claimnamedreg(EAX);
			ARCH(oponly(FSTSW,1<<EAX,0));
			ARCH(oponly(FABS,0,0));
			ARCH(oplit(TEST,EAX,0x4500,EAX));
			ARCH(bcctf(JNZ<<16,index,0));
			unlockreg(EAX);	 
			forgetreg(EAX);
/*
		} else {
			if (X2size==8) {
				Caddress(X2);	 
				Crefer(X2,4,4);
			}
			X1reg=LoadRealRW(X1,-1,X1size);
			ARCH(oprx(TEST,0x80000000,X2,SOURCELIT));
			ARCH(oponly(FABS,0,0));
			ARCH(bcctf(JZ<<16,index,0));
		}
*/
		ARCH(oponly(FCHS,0,0));
		unlockreg(X1reg);
		eplabel(Label);
		if (i8flag)
			Cstackr(X1reg,8);
		else
		    Cstackfr(X1reg,X1size);
	} else {
		if (i8flag) {
		    X1reg=LoadIntRW(X1,-1);
		    X2reg=LoadIntRW(X2,-1);
		} else {
		    X1reg=LoadRealRW(X1,-1,X1size);
		    X2reg=LoadRealRW(X2,-1,X2size);
		}
		reg=claimfreg();
		ARCH(oponly(FLDZ,0,0));
		ARCH(fopr(FCOMIP,currentFSP+1));
		unlockreg(reg);
		manipulateFS(FDISCARD,currentFSP);
		ARCH(oponly(FABS,0,0));
/*		reg=claimfreg();*/
		ARCH(fopr(FLDd,currentFSP));
		   ARCH(oponly(FCHS,0,0));
		ARCH(fopr(FCMOVBE,currentFSP+1));
		ARCH(fopr(FSTPd,currentFSP+1));
/*		  unlockreg(currentFSP);*/
		if (i8flag)
			Cstackr(currentFSP,8);
		else
		    Cstackfr(currentFSP,X1size);
	}
}	/* Csign                                                                   */
/***/
void Cmod(int Type,struct Stkfmt *X1,struct Stkfmt *X2) {
	/****************************************************************/
	/** Type = IntType                                             **/
	/**        RealType                                            **/
	/** stack result of  X1 - int(X1/X2) * X2                      **/
	/****************************************************************/
	int Resreg,X1reg,X2reg,Ressize,Workreg;

	if (Type==IntType) {
		CIntBinaryOp(IREM,X1,X2,0);
	}

	if (Type==RealType) {
		Elevel+=2;
		TargetReg=-1;	 
		TargetFreg=-1;
		if ((X1->Size==4)||(X2->Size==4))  Mexpcall(exp_lamod); 
		else Mexpcall(exp_ldmod);	/* call f_lmod*/
		/* call f_ldmod */
	}

}	/* Cmod                                                                    */
/***/
void Cdim(int Type,struct Stkfmt *X1,struct Stkfmt *X2) {
	/****************************************************************/
	/** Type = IntType                                             **/
	/**        RealType                                            **/
	/** stack  X1 - X2  if X1 > X2                                 **/
	/**           0     if X1 <=X2                                 **/
	/****************************************************************/
	int Resreg,Label,wkreg,Size,X1reg,X2reg,x,Index;
	int i8flag = (Type == IntType && X1->Size == 8);

	if (Type==IntType && !i8flag) {
		if (X1->Form==LitVal && X2->Form==LitVal) {
			if (X1->Intvalue>X2->Intvalue)
				estklit(X1->Intvalue-X2->Intvalue); 
			else estklit(0);
		} else {
			if (TargetReg>=0)  Resreg=claimnamedtgt(TargetReg); 
			else Resreg=-1;
			X1reg=LoadIntRW(X1,Resreg)	/* Resreg == x1reg*/;
			X2reg=LoadIntRO(X2);
			ARCH(rr(SUB,X2reg,-1,X1reg));
			if (targetvariant!=PPRO2) {
				Label=Mprivatelabel();
				Index=BLocateLabel(Label+Labadjust,0);
				ARCH(bcctf(JGE<<16,Index,0));
				ARCH(rr(XOR,X1reg,X1reg,X1reg))	/* zero X1reg*/;
				eplabel(Label);
				unlockreg(X2reg);
			} else {
				unlockreg(X2reg);
				wkreg=claimreg();
				ARCH(rlit(MOV,wkreg,0,wkreg))	/* Does not affect Flags*/;
				ARCH(rr(CMOVL,wkreg,-1,X1reg));
				unlockreg(wkreg);
			}
			unlockreg(X1reg);
			Cstackr(X1reg,4);
		}
		/* RealType */
	} else {
		/**/
		enotecc(-1);
		Size=X1->Size;
		if (i8flag) {
		    X1reg=LoadIntRW(X1,-1);
		    X2reg=LoadIntRW(X2,-1);
		}else {
		    X1reg=LoadRealRW(X1,-1,Size);
		    X2reg=LoadRealRW(X2,-1,Size);
		}
		X1reg=currentFSP+1;	/* must now occupy top two cell */
		ARCH(fopr(FSUBP,X1reg));
		unlockreg(X2reg);
		if (targetvariant!=PPRO2) {
			Label=Mprivatelabel();
			ARCH(oponly(FTST,0,0));
			Resreg=claimnamedreg(EAX);
			ARCH(oponly(FSTSW,1<<EAX,0));
			ARCH(oplit(TEST,EAX,0x100,EAX));
			Index=BLocateLabel(Label+Labadjust,0);
			ARCH(bcctf(JZ<<16,Index,0));
			unlockreg(EAX);	 
			forgetreg(EAX);
			ARCH(fopr(FSTPd,currentFSP))	/* Pop stack by store to self & pop*/;
			ARCH(oponly(FLDZ,0,0));
			eplabel(Label);
		} else {
			Resreg=claimfreg();
			ARCH(oponly(FLDZ,0,0));
			ARCH(fopr(FCOMI,currentFSP+1));
			ARCH(fopr(FCMOVB,currentFSP+1));
			ARCH(fopr(FSTPd,currentFSP+1));
			unlockreg(Resreg);
		}
		if (i8flag)
		    Cstackr(X1reg,8);
		else
		    Cstackfr(X1reg,Size);
	}
}	/* Cdim                                                                    */
/***/
/***/
void Cmerge2(struct Stkfmt *Boolean,struct Stkfmt *Tsource1,struct Stkfmt *Tsource2,struct Stkfmt *Fsource1
,struct Stkfmt *Fsource2) {
        /****************************************************************/
        /** if Boolean = True then stack Tsource1 and Tsource2         **/
        /**                   else stack Fsource1 and Fsource2         **/
        /**                                                            **/
        /** (Type = IntType only supported)                            **/
        /****************************************************************/
        int Resreg1,Resreg2,Reg;
        int Label;
        int Size1,Size2;

        if (Boolean->Form==LitVal) {
                if (Boolean->Intvalue==0) {
                        Cdiscard(Tsource1);
                        Cdiscard(Tsource2);
                        Cpushoperand(Fsource2);
                        Cpushoperand(Fsource1);
                } else {
                        Cdiscard(Fsource1);
                        Cdiscard(Fsource2);
                        Cpushoperand(Tsource2);
                        Cpushoperand(Tsource1);
                }
        } else {

                Size1=Tsource1->Size;
                Size2=Tsource2->Size;
                Label=Mprivatelabel();
                Resreg1=LoadIntRW(Tsource1,-1);
                Resreg2=LoadIntRW(Tsource2,-1);
                Ctestval(Icompare,Boolean);
                Cjump(Icompare|NE,Label,0);

                unlockreg(Resreg1);
                Reg=LoadIntRW(Fsource1,Resreg1);
                unlockreg(Resreg2);
                Reg=LoadIntRW(Fsource2,Resreg2);

                Cstackr(Resreg2,Size2);
                Cstackr(Resreg1,Size1);
                Mfrlabel(Label,1);
        }

}       /* Cmerge2 */
/***/
void Cminmax(int Variant,struct Stkfmt *X1,struct Stkfmt *X2) {
	/****************************************************************/
	/** Variant = 0  IMIN                                          **/
	/**           1  RMIN                                          **/
	/**           2  IMAX                                          **/
	/**           3  RMAX                                          **/
	/** stack result of Variant(X1,X2)                             **/
	/****************************************************************/
	int Index,Resreg,X1reg,X2reg,Ressize,X1form,X2form,Cond,Label,I;
	int i8flag = ((Variant ==0 || Variant == 2) && X1->Size == 8);
	struct Stkfmt *A;
	struct Stkfmt *B;

	Resreg=-1;
	X1form=X1->Form&31;
	X2form=X2->Form&31;
	if ((Variant&1)!=0 || i8flag) goto Var_1;

Var_0:
Var_2:


	/*   Task 1: ---handle optimisations with literals                           */


	if (X2form==LitVal) {
		if (X1form==LitVal) {

			/*  do constant arithmetic                                                   */

			if (X1->Intvalue>=X2->Intvalue) {
				if (Variant==0)  I=X2->Intvalue; 
				else I=X1->Intvalue;
			} else {
				if (Variant==0)  I=X1->Intvalue; 
				else I=X2->Intvalue;
			}
			estklit(I);
			return ;
		}
		if ((X2->Intvalue==0)&&(Variant==2)) 	/*EIMAX*/{

			/*  optimise MAX(X1,0)                                                       */

			Cdim(IntType,X1,X2);
			return ;
		}
	}

	/*   Task 2: ---determine the result register                                */

	if (TargetReg>0) {
		Resreg=claimtgtreg();
	} else {
		if ((X1form==RegVal)&&(registerstatus(X1->Reg)<=1)) {
			Resreg=X1->Reg;
		} else {
			if ((X2form==RegVal)&&(registerstatus(X2->Reg)<=1)) {
				Resreg=X2->Reg;
			}
		}
	}

	/*   Task 3: ---decide which operand to load into the result register        */

	if ((X1form==LitVal)||((X1form==Regvar)&&(X1->Reg!=Resreg))||(((X2form==RegVal)||(X2form==Regvar))&&(X2
	    ->Reg==Resreg))) {
		A=X2;
		B=X1;
	} else {
		A=X1;
		B=X2;
	}

	/*   Task 4: ---load the operands and make them easily re-loadable           */

	A->Reg=LoadIntRW(A,Resreg);
	A->Form=RegVal|Regflag;

	if ((targetvariant==PPRO2)||(B->Form!=LitVal)) {
		B->Reg=LoadIntRO(B);
		B->Form=RegVal|Regflag;
	}

	/*   Task 5: ---generate code                                                */

	if (targetvariant!=PPRO2) {
		if (Variant==0)  Cond=Icompare|LE; 
		else Cond=Icompare|GE;

		Label=Mprivatelabel();
		Cjumpcond(Cond,A,B,Label);

		Resreg=LoadIntRW(B,A->Reg);
		Cstackr(Resreg,4);
		eplabel(Label);
	} else {
		if (Variant==0)  Cond=CMOVG; 
		else Cond=CMOVL;
		CIntBinaryOp(IGT,A,B,0);
		ARCH(rr(Cond,B->Reg,-1,A->Reg));
		enotecc(-1);
		Cstackr(A->Reg,4);
	}
	return ;

Var_1:

Var_3:


	Ressize=X1->Size;
	Label=Mprivatelabel();
	if (i8flag)
	    X1reg=LoadIntRW(X1,-1);
	else
	    X1reg=LoadRealRW(X1,-1,Ressize);
	if (X2form==FregVal || (i8flag && X2form==RegVal)) {
		manipulateFS(BUBBLETOTOP,X2->Reg);
		X2reg=currentFSP;
	} else {
		if (i8flag)
			X2reg=LoadIntRW(X2,-1);
		else
			X2reg=LoadRealRW(X2,-1,Ressize);
	}
	X1reg=currentFSP+1;
	if (targetvariant!=PPRO2) {
		ARCH(fopr(FCOM,X1reg))	/* Compare without disturbing*/;
		Resreg=claimnamedreg(EAX);
		ARCH(oponly(FSTSW,1<<EAX,0));
		ARCH(oplit(TEST,EAX,0x100,EAX));
		Index=BLocateLabel(Label+Labadjust,0);
		if (Variant>=2)  Cond=JNZ; 
		else Cond=JZ;
		ARCH(bcctf(Cond<<16,Index,0));
		unlockreg(EAX);
		forgetreg(EAX);
		ARCH(fopr(FXCH,X1reg));
		eplabel(Label);
		manipulateFS(FDISCARD,currentFSP)	/* discard top cell */;
	} else {
		ARCH(fopr(FCOMI,X1reg))	/* Compare without disturbing*/;
		if (Variant>=2)  Cond=FCMOVB; 
		else Cond=FCMOVG;
		ARCH(fopr(Cond,X1reg));
		ARCH(fopr(FSTPd,X1reg));
		unlockreg(X2reg);
	}
	if (i8flag)
	    Cstackr(X1reg,8);
	else
	    Cstackfr(X1reg,Ressize);
}	/* Cminmax                                                                 */
/***/
void Cdmult(struct Stkfmt *X1,struct Stkfmt *X2) {
	/****************************************************************/
	/** Stack X1 * X2 as real*8                                    **/
	/****************************************************************/
	CRealBinaryOp(RMULT,X1,X2)	/* All 80 bit items om P5*/;
	Stk [Elevel].Size=8;
}	/* Cdmult                                                                  */
/***/
void Cfdvacc(struct Stkfmt *X) {
	/***************************************************************************/
	/** Dope vector evaluation for FORTRAN                                    **/
	/**                                                                       **/
	/** On entry   (Etos) is Y      (Etos-1) is Z                             **/
	/** On exit    (Etos) is Y      (Etos-1) is Z + X.Y                       **/
	/***************************************************************************/
	struct Stkfmt *Y,*Z;
	struct Stkfmt SaveY;
	int RegY;

	Y=&Stk [Elevel];
	/**/
	/* Y must be put back onto the top of the Estack at the completion           */
	/* of this Eop. If Y represents a volatile register (either an Out           */
	/* or a Global) then it will be corrupted by the Multiply operation          */
	/* if the operation requires a call on .mul - for this register to           */
	/* be automatically preserved across a call on .mul it must be               */
	/* associated with an Estack entry - and I can think of no such              */
	/* mechanism which will achieve this - hence this code which looks           */
	/* ahead with foreknowledge of what C Int Binary Op will do                  */
	/**/
	Z=&Stk [Elevel-1];
	SaveY=*Y;	/* preserve Estack Entry */
	Elevel-=1;
	CIntBinaryOp(IMULT,X,Y,0)	/* perform Y := X.Y */;
	Elevel-=2;
	CIntBinaryOp(IADD,Z,Y,0)	/* eventual (Etos-1) := Z + X.Y */;
	Cpushoperand(&SaveY);	/*          (Etos)   := Y       */
}	/* Cfdvacc                                                                 */

#endif
	/* %if Language=FORTRAN */
/***/
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**                       C/C++ specific routines                        **/
/**                                                                      **/
/**************************************************************************/
/***/
#if Language==CCOMP
void CTarget(int LogReg) {
	/***************************************************************/
	/** Used by C and C++ optimiser to set the current physical   **/
	/** target register coresponding to the supplied logical      **/
	/** register number.                                          **/
	/***************************************************************/
	int TReg,Depth;
	if (LogReg!=127) {
		TReg=CRegVarMap [LogReg];

		if (TReg<FRBASE) {
			if ((RegClaimMaskA&(1<<TReg))!=0) {
				checkregconflict(TReg); 
				TargetReg=TReg;
			}
		} else {
			/*              TargetFreg=TReg                                              */
			/*              %IF RegClaimMaskB&(1<<(TReg-FRBASE))#0 %THEN checkregconflict(TReg)*/
		}

	} else if (QCDepth>=1) {
		if (QCDepth<=MaxQCDepth)  Depth=QCDepth; 
		else Depth=MaxQCDepth;
		TargetReg=QCResRegs [Depth-1];
		/*           TargetFreg=QCResFRegs(Depth)                                    */
		if ((RegClaimMaskA&(1<<TargetReg))!=0)  checkregconflict(TargetReg);
		/**/
		/*           %IF RegClaimMaskB&(1<<(TargetFreg-FRBASE))#0 %THEN !                                  
               checkregconflict(TargetFreg)                                  */
	};

	/***/
}	/* CTarget                                                                 */
/***/
void CQCcontrol(int Mode,int Size) {
	/*****************************************************************/
	/** Handle result register allocation for a ?: construct. If    **/
	/** Mode=1 then we are just about to enter the ?:. If Mode=2    **/
	/** then we have reached the end of one of the branches of the  **/
	/** ?: and Size holds the size of the ?: result. If Size is     **/
	/** negative then the result is a float with -Size. If Mode=3   **/
	/** then we are leaving the ?: construct with a result. If      **/
	/** Mode=4 then we are leaving the ?: construct with a void     **/
	/** result.                                                     **/
	/*****************************************************************/
	static int LastSize;	/* The result size of the current ?: */
	int Reg,Junk,StoreFlag,Form,StkReg,StkSize,Depth;

	if (Mode==1) {
		/* Allocate both float and integer result registers as we don't              */
		/* know what the result type is yet                                          */
		QCDepth+=1;
		if (QCDepth<=MaxQCDepth) {

			/* Allocate a float/double result reg                                        */
			if ((TargetDToS==0)&&(TargetFreg>=0)&&(QCDepth<MaxQCDepth)) {
				QCResFRegs [QCDepth-1]=TargetFreg;
			} else {
				QCResFRegs [QCDepth-1]=getQCfloatreg();
			}

			/* Allocate an int result reg. On the M88K we can use the                    */
			/* first of the float register pair                                          */
			if ((TargetReg>=0)&&(QCDepth<MaxQCDepth)) {
				QCResRegs [QCDepth-1]=TargetReg;
			} else {
				QCResRegs [QCDepth-1]=getQCintreg();
			}

		}

	} else if (Mode==4) {
		QCDepth-=1;
	} else {
		/* Get the current ?: result size                                            */
		if (Mode==3)  Size=LastSize; 
		else LastSize=Size;

		/* Get the current ?: depth                                                  */
		if (QCDepth<=MaxQCDepth)  Depth=QCDepth; 
		else Depth=MaxQCDepth;

		/* Get the characteristics of the EStack TOS (if there is one)               */
		if (Elevel>0) {
			Form=Stk [Elevel].Form&31;
			StkReg=Stk [Elevel].Reg;
			StkSize=Stk [Elevel].Size;
			StoreFlag=0;
		} else {
			StoreFlag=1;
		}

		/* If the EStack TOS is not in the correct register then we                  */
		/* need to claim the ?: result register and put it on the                    */
		/* E-stack                                                                   */
		if (Size<0) {
			Reg=QCResFRegs [Depth-1];
			if ((StoreFlag!=0)||((Form!=FregVal)&&(Form!=Fregvar))||(StkReg!=Reg)||(StkSize!=-Size)) {
				/*                 %IF Size>=-4 %THENSTART                                   */
				Junk=claimnamedtgt(Reg);
				/*                  %FINISHELSESTART                                         */
				/*                    Junk=claim named tgt pair (Reg)                        */
				/*                 %FINISH                                                   */
				Cstackfr(Reg,-Size);
				StoreFlag=1;
			}
		} else {
			Reg=QCResRegs [Depth-1];
			if ((StoreFlag!=0)||((Form!=RegVal)&&(Form!=Regvar))||(StkReg!=Reg)||(StkSize!=Size)) {
				Junk=claimnamedtgt(Reg);
				Cstackr(Reg,Size);
				StoreFlag=1;
			}
		}

		/* Store the result of the ?: branch in the result register                  */
		if (Mode==2) {
			if (StoreFlag!=0) {
				Elevel-=2;
				Junk=Cstoreop(&Stk [Elevel+2],&Stk [Elevel+1],0);
			} else {
				Elevel-=1;
			}
			/*              %IF Size=-8 %THENSTART                                       */
			/*                  unlock reg pair (Reg)                                    */
			/*               %FINISHELSESTART                                            */
			unlockreg(Reg);
			/*               %FINISH                                                     */
			/* Mode=3 */
		} else {
			QCDepth-=1;
		}
	};


	/* Set the ?: result register masks for the register allocator               */
	if (QCDepth>0) {
		if (QCDepth>MaxQCDepth)  Depth=MaxQCDepth; 
		else Depth=QCDepth;
		QCIResMask=1<<QCResRegs [Depth-1];
		QCFResMask=3<<(QCResFRegs [Depth-1]&31);
	} else {
		QCIResMask=0;
		QCFResMask=0;
	}

	/* Print debugging information                                               */
	if (Report!=0) {
		printf("  QCDepth %2d   Elevel %2d",QCDepth,Elevel);
		if (QCDepth>0) {
			if (QCDepth<=MaxQCDepth)  Depth=QCDepth; 
			else Depth=MaxQCDepth;
			printf("   QCResultReg %d   QCResultFRegPair %d",QCResRegs [Depth-1],QCResFRegs [Depth-1]);
		}
		printf("\n");
	}
}	/* CQCcontrol                                                              */
/***/
void CLogStk(int Option,int Label) {
	/****************************************************************************/
	/** This routine generates code for the exit of a conditional jumping code **/
	/** sequence for C and C++. The option parameter modifies the behaviour of **/
	/** the routine as follows:                                                **/
	/**   0 - initialise in preparation for generation of conditional          **/
	/**       establishment code (Label is undefined)                          **/
	/**   1 - notify conditional handler labels (Label is the number of a      **/
	/**       FALSE handler and Label+1 is a TRUE handler)                     **/
	/**   2 - generate exit code for last branch of conditional (Label         **/
	/**       points to after conditional code)                                **/
	/**   3 - generate FALSE handler code (Label points to after               **/
	/**       conditional code)                                                **/
	/**   4 - generate TRUE handler code (Label points to after conditional    **/
	/**       code)                                                            **/
	/**   5 - return RegVal result of conditional on E-stack (Label is         **/
	/**       undefined)                                                       **/
	/**   6 - exit conditional handling (Label is undefined)                   **/
	/**   7 - notify jump to a conditional handler label (Label holds index of **/
	/**       handler)                                                         **/
	/**   8 - initialise logical establishment system - called at start of     **/
	/**       every procedure (Label is undefined)                             **/
	/****************************************************************************/
	int condition,value,I;

	if (Option==0) {
		/**/
		if (LogStkReg!=-1)  Mabort(61);	/*Illegal option*/
		LogStkFU=0;
		LogStkTU=0;
		/**/
	} else if (Option==1) {
		/**/
		if (LogStkReg!=-1)  Mabort(61);	/*Illegal option*/
		if (Label<(MaxLogStkLabels-1)) {
			LogStkFU|=LogStkLabUsed [(unsigned)Label>>5]&(1<<(Label&31));
			LogStkTU|=LogStkLabUsed [((unsigned)(Label+1)>>5)]&(1<<((Label+1)&31));
		} else {
			LogStkFU=1;
			LogStkTU=1;
		}
		/**/
	} else if (Option==2) {
		condition=ereadcc();
		if ((LogStkReg!=-1)||(condition==-1))  Mabort(61);	/*Illegal option*/
		/**/
		if (LogStkFU==0) {
			if (LogStkTU==0) {
				LogStkLayout=2;
			} else {
				LogStkLayout=1;
			}

		} else if (LogStkTU==0) {
			LogStkLayout=2;
		} else {
			LogStkLayout=3;
		}

		/**/
		/* There is a fake CC on mips consisting of a branchop and 2 regs            */
		/* such that the op is true. Consequently strange manoevres are needed       */
		/* so that logstkreg does not use part ot the 'CC'                           */

		LogStkReg=claimreg();
		unlockreg(LogStkReg);
		/**/
		if (LogStkLayout==1) {
			condition=CinvertCC(condition);
			value=0;
		} else {
			value=1;
		}
		/**/
		if ((condition&0xFF)!=NEVER) {
			ARCH(rlit(MOV,LogStkReg,value,LogStkReg))	/* Will not convext to xor unlike target oplit */;
			Cjump(condition,Label,0);
			/**/
			/**/
		}
		/**/
		enotecc(-1);
		/**/
	} else {
		/**/
		if ((LogStkReg==-1)&&(Option<7))  Mabort(61);	/*Illegal LogStk option*/
		/**/
		if (Option==3) {
			if (LogStkLayout>=2) {
				/**/
				ARCH(loadlit(0,LogStkReg));
				if (LogStkLayout==3)  Cjump(ALWAYS,Label,0)	/*Ccfield immaterial for always*/;
				/**/
			}
		} else if (Option==4) {
			if ((LogStkLayout==1)||(LogStkLayout==3)) {
				/**/
				ARCH(loadlit(1,LogStkReg));
				/**/
			}
		} else if (Option==5) {
			/**/
			Cstackr(LogStkReg,4);
			/**/
		} else if (Option==6) {
			/**/
			LogStkReg=-1;
			/**/
		} else if (Option==7) {
			/**/
			if (Label<MaxLogStkLabels) {
				I=(unsigned)Label>>5;
				LogStkLabUsed [I]=LogStkLabUsed [I]|(1<<(Label&31));
			}
			/**/
		} else if (Option==8) {
			/**/
			LogStkReg=-1;
			for (I=0; I<=(((unsigned)MaxLogStkLabels>>5)-1); I++) {
				LogStkLabUsed [I]=0;
			}
			/**/
		} else {
			Mabort(61);	/*Illegal LogStk option*/
		};





	}


}	/* CLogStk                                                                 */
#endif
/***/
void CLDBits(struct Stkfmt *Word,int BStart,int NBits) {
	/****************************************************************************/
	/* A Bitfield of width NBits starting at bit BStart is extracted from the  **/
	/* given Word an left on the Estack. BStart is numbered from the LAE. Note **/
	/* that the size of the Word may be less then 4 bytes. If the width is     **/
	/* given as a negative value then the bitfield is taken to be signed with  **/
	/* a width given by the absolute magnitude of NBits. LAE=Low adr end       **/
	/* For swopped items the C front end will have amended Bstart suitably     **/
	/* We only have to be careful when loading 8 & 16 bit fileds from store    **/
	/****************************************************************************/
	int SrcReg,Resreg,WordSize,Bshift;

	WordSize=Word->Size<<3;
	/**/
	/** Swopped offsets already calculated by font-end                           */
	/*      %IF AllowReverseEndianData#0 %AND Word_Flags&STKSWOPPED#0 %START     */
	/*         Bstart=Wordsize-(Bstart+imod(NBits))                              */
	/*         Word_Flags=Word_Flags&(~STKSWOPPED)                               */
	/*      %FINISH                                                              */
	if ((WordSize==32)&&((NBits==16)||(NBits==-16))&&((BStart&15)==0)&&(SimpleRegForm [Word->Form&31]==0)
	    &&((Word->Flags&STKSWOPPED)==0)) {
		if (BStart!=0) {
			Caddress(Word);
			Crefer(Word,(unsigned)BStart>>3,2);
		}
		if (NBits<0)  Word->Type=IntType; 
		else Word->Type=UintType;
		Word->Size=2;
		Resreg=LoadIntTgt(Word);
		Cstackr(Resreg,4);
		if (NBits>0)  SetExtFlag(Resreg,REGUNSIGNEDEXT); 
		else SetExtFlag(Resreg,REGSIGNEDEXT);
		/* They are all cases of 8 bit 8 bit aligned fileds         */
		/* which can be handled similarly to the above coding       */
	} else if (((WordSize&15)==0)&&(abs(NBits)==8)&&((BStart&7)==0)&&(SimpleRegForm [Word->Form&31]==0)
	    &&((Word->Flags&STKSWOPPED)==0)) {
		if (BStart!=0) {
			Caddress(Word);
			Crefer(Word,(unsigned)BStart>>3,1);
		}
		if (NBits<0)  Word->Type=IntType; 
		else Word->Type=UintType;
		Word->Size=1;
		Resreg=LoadIntTgt(Word);
		Cstackr(Resreg,4);
		if (NBits>0)  SetExtFlag(Resreg,REGUNSIGNEDEXT); 
		else SetExtFlag(Resreg,REGSIGNEDEXT);
	} else {
		if (targetvariant!=0) {
			SrcReg=LoadIntTgt(Word);	/* Sign extend on PPRO to avoid partial reg stalls */
		} else {
			SrcReg=LoadIntRWNoExt(Word,-1)	/* No sign extension on Pentium */;
		}
		Resreg=SrcReg;
		/**/
		if (NBits>=0) {
			/*            !                                                              */
			/* We have an unsigned bit field so no sign extension is needed              */
			/**/
			if (!(BStart==0))  ARCH(rlit(SHR,Resreg,BStart,Resreg));
			if (!((BStart+NBits)==32))  ARCH(oplit(AND,SrcReg,Bmaskval [NBits-1],Resreg));
		} else {
			/**/
			/* We have a signed bit field so sign extension is required                  */
			/**/
			NBits=-NBits;
			Bshift=(32-BStart)-NBits;
			/**/
			if (NBits<32) {
				if (Bshift!=0)  ARCH(rlit(SHL,SrcReg,Bshift,Resreg));
				ARCH(rlit(SAR,Resreg,32-NBits,Resreg));
			}
			/**/
		}
		/**/
		forgetreg(Resreg);
		unlockreg(SrcReg);
		Cstackr(Resreg,4);
		if (NBits>0)  SetExtFlag(Resreg,REGUNSIGNEDEXT); 
		else SetExtFlag(Resreg,REGSIGNEDEXT);
	}


}	/* C LDBits                                                                */
/***/
void CSTBits(struct Stkfmt *Field,struct Stkfmt *Word,int BStart,int NBits,int DupFlag) {
	/****************************************************************************/
	/* A bitfield of width NBits starting at bit BStart is stored into the     **/
	/* Word. BStart is numbered from the MSB. Field is the value of the        **/
	/* bitfield to be stored. The size of the Word may be less than 4 bytes.   **/
	/* If DupFlag is non-zero then sign or zero extended copy of the bitfield  **/
	/* is left on the Estack. If the width is given as a negative value then   **/
	/* bitfield is taken to be signed with a width given by the absolute       **/
	/* magnitude of NBits. The value of the field after bit storage is always  **/
	/* left on the top of the E-stack.                                         **/
	/****************************************************************************/
	int DupReg,SrcReg,DestReg,WordSize,Bshift;
	int Bmask,PresMask,ShiftLit,SignFlag;
	/* %integer Swopflag  */

	WordSize=Word->Size<<3;
	if (NBits<0) {
		NBits=-NBits;
		SignFlag=1;
	} else {
		SignFlag=0;
	}
	/** Swopped offsets already calculated by font-end       */
	/*      %IF AllowReverseEndianData#0 %START              */
	/*         swopflag=Word_Flags&STKSWOPPED                */
	/*         %IF swopflag#0 %START                         */
	/*            BStart=Wordsize-(BStart+NBits)             */
	/*            Word_Flags=Word_Flags&(~STKSWOPPED)        */
	/*         %FINISH                                       */
	/*      %FINISH                                                              */
	DestReg=LoadIntRWNoExt(Word,-1);
	Bshift=BStart;
	Bmask=Bmaskval [NBits-1]<<Bshift;
	PresMask=Bmask^Bmaskval [WordSize-1];
	/**/
	if ((Field->Form&31)==LitVal) {
		/**/
		/* The bitfield value is a literal so we can do much of the                  */
		/* calculation at compile time                                               */
		/**/
		ShiftLit=(Field->Intvalue<<Bshift)&Bmask;
		/**/
		if ((targetvariant==0)&&(PresMask==0xFFFFFF00)&&(DestReg<=EBX)) {
			ARCH(rlit(MOVB,DestReg,ShiftLit,DestReg));
		} else if ((targetvariant==0)&&(PresMask==0xFFFF00FF)&&(DestReg<=EBX)) {
			ARCH(rlit(MOVB,DestReg+4,(unsigned)ShiftLit>>8,DestReg+4));
		} else {
			if (ShiftLit!=Bmask)  ARCH(oplit(AND,DestReg,PresMask,DestReg));
			if (ShiftLit!=0)  ARCH(oplit(OR,DestReg,ShiftLit,DestReg));
			/**/
		};

		if (DupFlag!=0) {
			if ((SignFlag==0)||((Field->Intvalue&(1<<(NBits-1)))==0)) {
				estklit(Field->Intvalue&Bmaskval [NBits-1]);
			} else {
				estklit(Field->Intvalue|((-1)<<NBits));
			}
		}
		/**/
	} else {
		/**/
		if (DupFlag==0) {
			SrcReg=LoadIntRWNoExt(Field,-1);
			if ((targetvariant==0)&&(NBits==8)&&(Bshift==0)&&(DestReg<=EBX)&&(SrcReg<=EBX)) {
				/* Can substitute a crafty MOVB for mask-and-or */
				ARCH(rr(MOVB,SrcReg,-1,DestReg));
			} else if ((targetvariant==0)&&((NBits==8)&&(8==Bshift))&&(DestReg<=EBX)&&(SrcReg<=EBX)) {
				ARCH(rr(MOVB,SrcReg,-1,DestReg+4));
			} else {
				ARCH(oplit(AND,DestReg,PresMask,DestReg));
				if (NBits+Bshift!=WordSize)
					ARCH(oplit(AND,SrcReg,Bmaskval [NBits-1],SrcReg));
				if (!(Bshift==0))  ARCH(oplit(SHL,SrcReg,Bshift,SrcReg));
				ARCH(rr(OR,SrcReg,DestReg,DestReg));
			}

			unlockreg(SrcReg);
		} else {
			SrcReg=LoadIntRWNoExt(Field,-1);
			if ((SignFlag==0)&&(Bshift==0)) {
				DupReg=SrcReg;
			} else {
				DupReg=claimreg();
			}
			ARCH(oplit(AND,SrcReg,Bmaskval [NBits-1],SrcReg));
			if (SignFlag==0) {
				if (!(DupReg==SrcReg))  ARCH(rr(MOV,SrcReg,DupReg,DupReg));
			} else {
				ARCH(rr(MOV,SrcReg,DupReg,DupReg));
				ARCH(rlit(SHL,DupReg,32-NBits,DupReg));
				ARCH(rlit(SAR,DupReg,32-NBits,DupReg));
			}
			if (!(Bshift==0))  ARCH(oplit(SHL,SrcReg,Bshift,SrcReg));
			ARCH(oplit(AND,DestReg,PresMask,DestReg));
			ARCH(rr(OR,SrcReg,DestReg,DestReg));
			unlockreg(SrcReg);
			Cstackr(DupReg,4);
			if (SignFlag==0) {
				SetExtFlag(DupReg,REGUNSIGNEDEXT); 
				Stk[Elevel].Type=UintType;
			} else SetExtFlag(DupReg,REGSIGNEDEXT);
		}
		/**/
	}


	forgetreg(DestReg);
	Cstackr(DestReg,(unsigned)WordSize>>3);
	/*      %IF AllowReverseEndianData#0 %AND swopflag#0 %START                  */
	/*         target opr(BSWAP,DestReg)                                         */
	/*         %IF wordsize#32 %THEN target oplit(SHR,DestReg,32-wordsize,DestReg)*/
	/*      %FINISH                                                              */
}	/* C STBits                                                                */
/***/
/*%FINISH                                                                    */	/* %if Language=CCOMP */
/***/
/***/
/**************************************************************************/
/**                                                                      **/
/**                    PASCAL/MODULA-2 specific routines                 **/
/**                                                                      **/
/**************************************************************************/
/***/

#if((Language==PASCAL)||(Language==MODULA)) 
/***/

static void move(int TOsize,int FROMsize,int TOtype,int FROMtype) {
	/*************************************************************************/
	/** implement STRMOVE: expects estack to contatin TO and FROM           **/
	/*************************************************************************/
	int L1;

	if (TOtype==PascalVariableString) {
		if (FROMtype==PascalVariableString) {

			/* string := string                                   */

			/* Generate code for :                                */
			/*                                                    */
			/*     copybytes(FROM, TO, len(FROM)+1)               */

			/* TO FR ...*/
			epromote(2);	/* FR TO ...*/
			eop(DUPL);	/* FR FR TO ...*/
			edemote(3);	/* FR TO FR ...*/
			erefer(0,(UintType<<24)+	/* len(FR) TO FR ...*/1);
			estklit(1);	/* 1 len(FR) TO FR ...*/
			eop(UADD);	/* len(FR)+1 TO FR ...*/
			eop(MVB);

		} else {

			/* string := array                                    */

			/* Generate code for :                                */
			/*                                                    */
			/*     len(TO) := FROMcapacity                        */
			/*     copybytes(FROM, TO+1, FROMcapacity)            */

			/* TO FR ...*/
			eop(DUPL);	/* TO TO FR ...*/
			estklit(FROMsize);	/* FRsize TO TO FR ...*/
			epromote(2);	/* TO FRsize TO FR ...*/
			erefer(0,(UintType<<24)+	/* len(TO) FRsize TO FR ...*/1);
			eop(ESTORE);	/* TO FR ...*/
			estklit(1);	/* 1 TO FR ...*/
			eop(INDEX1);	/* TO+1 FR ...*/
			estklit(FROMsize);	/* FRsize TO+1 FR ...*/
			eop(MVB);

		}
	} else {
		if (FROMtype==PascalVariableString) {

			/* array := string                                               */

			/* Generate code for :                                           */
			/*                                                               */
			/*     copybytes(FROM+1, TO, len(FROM));                         */
			/*     if len(FROM) < TOsize                                     */
			/*     then fillbytes(TO+len(FROM), TOsize-len(FROM), ' ');      */

			L1=Mprivatelabel();
			/* TO FR ...*/
			eop(DUPL);	/* TO TO FR ...*/
			epromote(3);	/* FR TO TO ...*/
			eop(DUPL);	/* FR FR TO TO ...*/
			erefer(0,(UintType<<24)+	/* len(FR) FR TO TO ...*/1);
			eop(DUPL);	/* len(FR) len(FR) FR TO TO ...*/
			epromote(3);	/* FR len(FR) len(FR) TO TO ...*/
			estklit(1);	/* 1 FR len(FR) len(FR) TO TO ...*/
			eop(INDEX1);	/* FR+1 len(FR) len(FR) TO TO ...*/
			epromote(4);	/* TO FR+1 len(FR) len(FR) TO ...*/
			epromote(3);	/* len(FR) TO FR+1 len(FR) TO ...*/
			eop(MVB);	/* len(FR) TO ...*/
			eop(DUPL);	/* len(FR) len(FR) TO ...*/
			edemote(3);	/* len(FR) TO len(FR) ...*/
			eop(INDEX1);	/* TO+len(FR) len(FR) ...*/
			epromote(2);	/* len(FR) TO+len(FR) ...*/
			estklit(TOsize);	/* TOsize len(FR) TO+len(FR) ...*/
			epromote(2);	/* len(FR) TOsize TO+len(FR) ...*/
			eop(DUPL);	/* len(FR) len(FR) TOsize TO+len(FR) ..*/
			estklit(TOsize);	/* TOsize len(FR) len(FR) TOsize TO+len(FR) ..*/
			ejump(JUGE,L1)	/* len(FR) TOsize TO+len(FR)*/;
			eop(USUB);	/* TOsize-len(FR) TO+len(FR)*/
			estklit(' ');	/* ' ' TOsize-len(FR) TO+len(FR)*/
			eop(EFILL);

			Mlabel(L1);

		} else {

			/* array := array                                                */

			if (TOsize>FROMsize) {

				/* Generate code for :                                        */
				/*                                                            */
				/*     copybytes(FROM, TO, FROMsize)                          */
				/*     fillbytes(TO+FROMsize,TOsize-FROMsize,' ')             */

				/* TO FR ...*/
				eop(DUPL);	/* TO TO FR ...*/
				edemote(3);	/* TO FR TO ...*/
				estklit(FROMsize);	/* FRsize TO FR TO ...*/
				eop(MVB);	/* TO ...*/
				estklit(FROMsize);	/* FRsize TO ...*/
				eop(INDEX1);	/* TO+FRsize*/
				estklit(TOsize-FROMsize);	/* TOsize-FRsize TO+FRsize*/
				estklit(' ');	/* ' ' TOsize-FRsize TO+FRsize ...*/
				eop(EFILL);

			} else {

				/* Generate code for :                                        */
				/*                                                            */
				/*     copybytes(FROM, TO, TOsize)                            */

				/* TO FR ...*/
				estklit(TOsize);	/* TOsize TO FR ...*/
				eop(MVB);

			}
		}
	}

}	/* move                                                                    */


static void BytesAndLen(int type,int size) {
	if (type==PascalVariableString) {
		/* FR*/
		eop(DUPL);	/* FR FR*/
		estklit(1);	/* 1 FR FR*/
		eop(INDEX1);	/* FR+1 FR*/
		epromote(2);	/* FR FR+1*/
		erefer(0,(UintType<<24)+	/* len(FR) FR+1*/1);
	} else {
		/* FR*/
		estklit(size);	/* FRsize FR*/
	}
}	/* BytesAndLen                                                             */

static void Add() {
	if ((Stk [Elevel].Form==LitVal)&&(Stk [Elevel-1].Form==LitVal)) {
		Elevel-=1;
		Stk [Elevel].Intvalue=Stk [Elevel].Intvalue+Stk [Elevel+1].Intvalue;
	} else {
		eop(UADD);
	}
}	/* Add                                                                     */


static void cat(int FR1size,int FR2size,int FR1type,int FR2type) {
	/********************************************************************/
	/** implement STRPLUS: expects FROM1 FROM2 TO on stack             **/
	/********************************************************************/

	/* Generate code for :                                             */
	/*                                                                 */
	/*   len(TO) := FROM1.len + FROM2.len                              */
	/*   copybytes(FROM1.bytes, TO+1, FROM1.len)                       */
	/*   copybytes(FROM2.bytes, TO+1+FROM1.len, FROM2.len)             */

	/* TO FR2 FR1*/
	eop(DUPL);	/* TO TO FR2 FR1*/
	erefer(0,(UintType<<24)+	/* len(TO) TO FR2 FR1*/1);
	epromote(3);	/* FR2 len(TO) TO FR1*/
	BytesAndLen(FR2type,FR2size)	/* FR2.l FR2.b len(TO) TO FR1*/;
	eop(DUPL);	/* FR2.l FR2.l FR2.b len(TO) TO FR1*/
	epromote(6);	/* FR1 FR2.l FR2.l FR2.b len(TO) TO*/
	BytesAndLen(FR1type,FR1size)	/* FR1.l FR1.b F2.l FR2.b ...*/;
	eop(DUPL);	/* FR1.l FR1.l FR1.b FR2.l FR2.l FR2.b len(TO) TO*/
	epromote(4);	/* FR2.l FR1.l FR1.l FR1.b FR2.l FR2.b len(TO) TO*/
	Add();	/* FR2.l+FR1.l FR1.l FR1.b FR2.l FR2.b len(TO) TO*/
	epromote(6);	/* len(TO) FR2.l+FR1.l FR1.l FR1.b FR2.l FR2.b TO*/
	eop(ESTORE);	/* FR1.l FR1.b FR2.l FR2.b TO*/
	eop(DUPL);	/* FR1.l FR1.l FR1.b FR2.l FR2.b TO*/
	epromote(6);	/* TO FR1.l FR1.l FR1.b FR2.l FR2.b*/
	estklit(1);	/* 1 TO FR1.l FR1.l FR1.b FR2.l FR2.b*/
	eop(INDEX1);	/* TO+1 FR1.l FR1.l FR1.b FR2.l FR2.b*/
	eop(DUPL);	/* TO+1 TO+1 FR1.l FR1.l FR1.b FR2.l FR2.b*/
	epromote(5);	/* FR1.b TO+1 TO+1 FR1.l FR1.l FR2.l FR2.b*/
	epromote(2);	/* TO+1 FR1.b TO+1 FR1.l FR1.l FR2.l FR2.b*/
	epromote(4);	/* FR1.l TO+1 FR1.b TO+1 FR1.l FR2.l FR2.b*/
	eop(MVB);	/* TO+1 FR1.l FR2.l FR2.b*/
	epromote(2);	/* FR1.l TO+1 FR2.l FR2.b*/
	eop(INDEX1);	/* TO+1+FR1.l FR2.l FR2.b*/
	epromote(2);	/* FR2.l TO+1+FR1.l FR2.b*/
	eop(MVB);

}	/* cat                                                                     */


void CstringOp(int op) {
	/******************************************************************/
	/** Opcodes: STRTOCH: convert string to char                     **/
	/**          STRPLUS: concatenate two strings                    **/
	/**          MOVESTR: copy and possibly convert a string         **/
	/**          PUSHSTR: move a string onto the stack               **/
	/******************************************************************/
	int Typesize,Ltype,Rtype,Lsize,Rsize,Raddr,Cond,index;
	int L1type,L2type,L1size,L2size,Char,Label2,Label3,CCfield;
	int dummy1,dummy2,dummy3,dummy4,FormalOffset,FormalReg;
	struct Stkfmt *RHS,*Temp;
	switch (op) {

	case STRPLUS:

		Typesize=Stk [Elevel].Intvalue;
		Elevel-=1;
		L1type=(unsigned)(Typesize&0xC0000)>>18;
		L2type=(unsigned)(Typesize&0x30000)>>16;	/* t-rhs ! */
		L1size=(unsigned)(Typesize&0xFF00)>>8;
		L2size=Typesize&0xFF;
		cat(L1size,L2size,L1type,L2type);
		return ;


	case PUSHSTR:

		Mparaminfo2(&dummy1,&dummy2,&dummy3,&FormalOffset,&dummy4,&FormalReg);
		Elevel+=1;
		Temp=&Stk [Elevel];

		/********************************************/
		/** evaluate address of actual parameter   **/
		/** and put it on Estack                   **/
		/********************************************/
		/**/
		memset(Temp,0,sizeof( struct Stkfmt));
		Temp->Form=RegModAddr;
		Temp->Reg=STACKPOINTER;
		Temp->Modform=LitVal;
		Temp->Modintval=PARAMBASE+FormalOffset;
		Temp->Size=4;
		/**/

		epromote(2);	/*get Estack in correct order for STRMOVE*/
		/* and fall through      */
	case STRMOVE:

		Typesize=Stk [Elevel].Intvalue;
		Elevel-=1;
		Ltype=(unsigned)(Typesize&0xC0000)>>18;
		Rtype=(unsigned)(Typesize&0x30000)>>16;
		Lsize=(unsigned)(Typesize&0xFF00)>>8;
		Rsize=Typesize&0xFF;
		move(Lsize,Rsize,Ltype,Rtype);
		return ;

	case STRTOCH:

		Typesize=Stk [Elevel].Intvalue;
		RHS=&Stk [Elevel-1];
		Elevel-=2;
		Rtype=(unsigned)(Typesize&0x30000)>>16;

		Char=claimreg();
		if (Rtype!=PascalVariableString) {

			/***********************************************/
			/** Generate code for: CHAR := RHS[1]         **/
			/***********************************************/
			/**/
			Raddr=LoadIntRO(RHS);
			ARCH(accessindri(LoadUintVal,Char,Raddr,0,1,0));
			unlockreg(Raddr);

		} else {

			/***********************************************/
			/** Generate code for: if length(RHS) = 0     **/
			/**                    then CHAR := ' '       **/
			/**                    else CHAR := RHS[1]    **/
			/***********************************************/
			/**/
			Raddr=LoadIntRO(RHS);
			Rsize=claimreg();
			Label2=Mprivatelabel();
			ARCH(accessindri(LoadUintVal,Rsize,Raddr,0,1,0));
			ARCH(loadlit(' ',Char));
			index=BLocateLabel(Label2+Labadjust,0);
			ARCH(rr(TEST,Rsize,Rsize,Rsize))	/* And with self */;
			ARCH(bcctf(JZ<<16,index,0));
			ARCH(accessindri(LoadUintVal,Char,Raddr,1,1,0));
			Mplabel(Label2);
			unlockreg(Raddr);
			unlockreg(Rsize);
			/**/

		}
		Cstackr(Char,4)	/* Pascal expects intermediate character */;
		Stk [Elevel].Type=UintType;	/* results to be size 4                  */
		return ;
	}	/* end of case */
}	/* CstringOp */
/***/
void CCheckRange(int Mode,struct Stkfmt *LStk,struct Stkfmt *Lower,struct Stkfmt *Upper,int ErrLab) {
	/****************************************************************/
	/** Check a value against bounds and leave it on Estack        **/
	/****************************************************************/
	int Reg,Size;

	if (Mode==UIcompare)  LStk->Type=UintType;
	if (Mode==Rcompare) {
		Size=LStk->Size;
		Reg=LoadRealRW(LStk,-1,Size);
		Cstackfr(Reg,Size);
		LStk=&Stk [Elevel];
		Cjumpcond(Mode|LT,LStk,Lower,ErrLab);
		Elevel-=1;
		Cstackfr(Reg,Size);
		Cjumpcond(Mode|GT,LStk,Upper,ErrLab);
		Elevel-=1;
		Cstackfr(Reg,Size);
	} else {
		Reg=LoadIntRW(LStk,-1);
		Cstackr(Reg,4);
		LStk=&Stk [Elevel];
		Cjumpcond(Mode|LT,LStk,Lower,ErrLab);
		Elevel-=1;
		Cstackr(Reg,4);
		Cjumpcond(Mode|GT,LStk,Upper,ErrLab);
		Elevel-=1;
		Cstackr(Reg,4);
	}
	if (Mode==UIcompare)  LStk->Type=UintType;
}	/*CCheckRange*/
/***/
void CCheckXX(int Cond,struct Stkfmt *LHS,struct Stkfmt *RHS,int ErrLab) {
	/***********************************************************************/
	/** if LHS Cond RHS then -> ErrLab. Leaves LHS on the Estack          **/
	/***********************************************************************/
	int Reg,Mode,Size;

	Mode=Cond&0xFF00;
	if (Mode==Rcompare) {
		LHS->Type=Realval;
		RHS->Type=Realval;
		Size=LHS->Size;
		Reg=LoadRealRW(LHS,-1,Size);
		Cstackfr(Reg,Size);
		LHS=&Stk [Elevel];
		Cjumpcond(Cond,LHS,RHS,ErrLab);
		Elevel-=1;
		Cstackfr(Reg,Size);
	} else {
		if (Mode==UIcompare) {
			LHS->Type=UintType;
			RHS->Type=UintType;
		} else {
			LHS->Type=IntType;
			RHS->Type=IntType;
		}
		Reg=LoadIntRW(LHS,-1);
		Cstackr(Reg,4);
		LHS=&Stk [Elevel];
		Cjumpcond(Cond,LHS,RHS,ErrLab);
		Elevel-=1;
		Cstackr(Reg,4);
	}
	if (Mode==UIcompare)  LHS->Type=UintType; 
	else if (Mode==Rcompare)  LHS->Type=RealType
	;
}	/*CCheckXX*/
/***/
void CCheckSetRange(struct Stkfmt *Set,int Min,int Max,int Lab) {
	/******************************************************************************/
	/** if any elements of Set outside Min..Max -> ErrLab. Leave                 **/
	/** Set on the Estack                                                        **/
	/******************************************************************************/
	int Reg,Mask,Xreg,Size,index;

	Size=Set->Size;
	Reg=LoadIntRW(Set,-1);
	Max=31-Max;
	Mask=~((unsigned)(((unsigned)0xFFFFFFFF>>Min)<<(Min+Max))>>Max);
	index=BLocateLabel(Lab+Labadjust,0);
	enotecc(-1);
	/**/
	ARCH(rlit(TEST,Reg,Mask,Reg));
	ARCH(bcctf(JNE<<16,index,0));
	Cstackr(Reg,Size);

}	/* CCheckSetRange */
/***/
void CSetBitOp(int Op,struct Stkfmt *Bit,struct Stkfmt *Set) {
	/*************************************************************************/
	/** Bit set/clr/tst for SETINCL, SETEXCL & SETIN                        **/
	/*************************************************************************/
	int TheBit,Lit,TheWord,TheOffset,TheSet,Reg,Opcode,Oplit,MaskReg,Size,Value;
	int OpcodeR,AccessUnit,LoadInst,StoreInst,Base,Offset;

	Bit->Type=UintType;
	Size=Set->Size;
	Base=Set->Base;
	Offset=Set->Offset;
	if (Size<=4)  AccessUnit=Size; 
	else AccessUnit=4;
	if ((Size==4)&&(Op==SETIN)&&(((Set->Form&30)==RegVal)||((Set->Form&31)==Regvar))&&(Set->Reg!=ECX)) {
		Value=1;
	} else {
		Value=0;
		Caddress(Set);
	}

	if ((Bit->Form&31)==LitVal) {
		Lit=1;
		TheWord=((unsigned)Bit->Intvalue>>5)<<2;
		TheBit=Bit->Intvalue&0x1F;
		TheSet=LoadIntRO(Set);
	} else {
		Lit=0;
		TheBit=claimnamedreg(ECX);
		TheBit=LoadIntRW(Bit,ECX);
		TheSet=LoadIntRO(Set);
		if (Size>4) 	/* may not be the first word */{
			TheWord=claimreg();
			/**/
			/* on power            target rrmm(SHL,TheBit,32-3,TheWord,3,29)	{ eqv to thebit>>5<<2}             */
			    / ARCH(rr(MOV,TheBit,TheWord,TheWord))	/* copy before shifting */;
			ARCH(oplit(SHR,TheWord,5,TheWord));
			ARCH(oplit(SHL,TheWord,2,TheWord));
			/**/
		} else {
			TheWord=-1;
		}
	}

	/* If Value = 0 then TheSet holds the base address of the set                */
	/* If Value = 1 then TheSet holds the set itself                             */
	/* The relevant word of the set is selected by TheWord as follows:           */
	/*  if Lit = 1 then TheWord is the literal byte-offset of the word           */
	/*  if Lit = 0 and TheWord = -1 then the word is the first one in the set    */
	/*  if Lit = 0 and TheWord # -1 then TheWord is a reg with the offset        */
	/* the bit index within this word is defined by TheBit as follows:           */
	/*   if Lit = 1 then TheBit holds the bit index as a literal                 */
	/*   if Lit = 0 then TheBit is a register which holds the bit index          */

	if (((Set->Form&31)!=Regvar)&&(Op==SETIN)) {
		Reg=TheSet;	/* can re-use the register   */
	} else {
		Reg=claimreg();	/* need to write back to set */
	}

	/* convention I have chosen is 1st element in LS Bit                         */
	if (Op==SETINCL) {
		Opcode=OR; 
		Oplit=OR;
	} else if (Op==SETEXCL) {
		Opcode=AND; 
		Oplit=AND;
	} else {
		Opcode
		    =TEST; 
		Oplit=TEST;
	}

	TheOffset=TheWord;
	if (TheWord==-1)  TheOffset=0;
	if (Lit!=0) 	/* literal bit index */{
		if (Value==0)  ARCH(accessindri(LoadUintVal,Reg,TheSet,TheOffset,AccessUnit,0));
		Lit=1<<TheBit;
		if (Op==SETEXCL)  Lit=~Lit;
		ARCH(oplit(Oplit,Reg,Lit,Reg));
		if (Op!=SETIN)  ARCH(accessindri(StoreUintVal,Reg,TheSet,TheOffset,AccessUnit,0));
		/* register bit index */
	} else {
		if (Value==0)  ARCH(accessindrr(LoadUintVal,Reg,TheWord,TheSet,AccessUnit,0));
		MaskReg=claimreg();
		ARCH(loadlit(1,MaskReg));
		ARCH(opr(SHLV,MaskReg))	/* Shift by ECX - TheBit*/;
		if (Op==SETEXCL)  ARCH(opr(NOT,MaskReg));
		ARCH(rr(Opcode,Reg,MaskReg,Reg));
		if (Op!=SETIN)  ARCH(accessindrr(StoreUintVal,Reg,TheWord,TheSet,AccessUnit,0));
		notereguse(MaskReg,0,4);
		notereguse(TheBit,0,4);
		if (TheWord!=-1)  notereguse(TheWord,0,4);
	}
	if (Op!=SETIN)  CheckConflict(Base,Offset,Size);
	notereguse(TheSet,0,4);
	if (Op!=SETIN)  notereguse(Reg,0,4);
	/*      rClearRegs(1) %IF Op#SETIN                                           */

}	/*C Set Bit Op*/
/***/
void CSetMemberOp(struct Stkfmt *Bit,struct Stkfmt *Set) {
	/****************************************************************/
	/** Bit IN Set                                                 **/
	/****************************************************************/
	CSetBitOp(SETIN,Bit,Set);
	enotecc(Icompare|NE);
}	/*C Set Member Op*/

void CSetBinaryOp(int Op,struct Stkfmt *LHS,struct Stkfmt *RHS,struct Stkfmt *Len) {
	/*********************************************************************/
	/** Implements SETI, SETU, SETD, SETSD, SETSING, SETRANGE           **/
	/*********************************************************************/
	int Bytes,Temp,SetReg,LReg,RReg,Ltemp,Rtemp,CountReg,Lab,SetOp;
	int Range,Rangereg,Index,CCfield,Reg,ECXreg;
	struct Stkfmt LStk;

	Bytes=Len->Intvalue;
	switch (Op) {

	case SETSING:

		/* claim space */
		memset(&LStk,0,sizeof( struct Stkfmt));
		LStk.Form=DirVal;
		LStk.Base=STACK;
		LStk.Offset=ARCH(tempspace(Bytes,4));
		LStk.Size=Bytes;

		/* zero it */
		Reg=LoadIntRO(&LitZero);
		if (Bytes<=4) {
			ARCH(stkaccess(StoreUintVal,Reg,&LStk));
		} else {
			for (Temp=0; Temp<=Bytes-4; Temp+=4) {
				ARCH(stkaccess(StoreUintVal,Reg,&LStk));
				LStk.Offset=LStk.Offset+4;
			}
		}
		unlockreg(Reg);

		/* set bit and leave on Estack */
		CSetBitOp(SETINCL,RHS,&LStk);
		LStk.Form=DirVal;
		LStk.Size=Bytes;
		Cpushoperand(&LStk);
		return ;

	case SETRANGE:

		ECXreg=claimnamedreg(ECX);	/* neded for shifting*/
		SetReg=claimtgtreg();
		enotecc(-1);
		Lab=Mprivatelabel();
		if ((LHS->Form&31)==LitVal) {
			Temp=LHS->Intvalue;
			RReg=LoadIntRW(RHS,ECXreg)	/* Into ECX for shift*/;
			ARCH(oplit(CMP,RReg,Temp,RReg));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(LT<<16,Index,CCfield));
			ARCH(loadlit(((-1)<<LHS->Intvalue),SetReg));
			ARCH(opr(NEG,RReg));
			ARCH(oplit(ADD,RReg,31,RReg))	/* RReg = 31 - RReg */;
			ARCH(opr(SHLV,SetReg));
			ARCH(opr(SHRV,SetReg));
			notereguse(RReg,0,0);
		} else if ((RHS->Form&31)==LitVal) {
			Temp=RHS->Intvalue;
			LReg=LoadIntRW(LHS,ECXreg)	/* Will be used for shifting */;
			ARCH(oplit(CMP,LReg,Temp,Temp));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(GT<<16,Index,CCfield));
			ARCH(loadlit(((unsigned)(-1)>>(31-RHS->Intvalue)),SetReg));
			ARCH(opr(SHRV,SetReg));
			ARCH(opr(SHLV,SetReg));
			notereguse(LReg,0,0);
		} else {
			RReg=LoadIntRW(RHS,ECXreg)	/* will be used first for shifting */;
			LReg=LoadIntRW(LHS,-1);
			ARCH(rr(CMP,RReg,LReg,LReg));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(LT<<16,Index,CCfield));
			ARCH(loadlit(-1,SetReg));
			ARCH(opr(NEG,RReg));
			ARCH(oplit(ADD,RReg,31,RReg))	/* RReg = 31 - RReg */;
			ARCH(rr(ADD,LReg,RReg,RReg))	/* RReg = 32 - no of bits */;
			ARCH(opr(SHRV,SetReg));
			ARCH(rr(MOV,LReg,RReg,RReg))	/* Copy to ECX */;
			ARCH(opr(SHLV,SetReg));
			notereguse(LReg,0,0);
			notereguse(RReg,0,0);
		}

		eplabel(Lab);
		Cstackr(SetReg,4);

		return ;

	case SETI:

	case SETU:

	case SETD:

	case SETSD:

		/* claim space */
		memset(&LStk,0,sizeof( struct Stkfmt));
		LStk.Form=AddrDir;
		LStk.Base=STACK;
		LStk.Offset=ARCH(tempspace(Bytes,4));
		LStk.Size=4;
		if (Op==SETSD)  SetOp=XOR;
		else if (Op==SETU)  SetOp=OR;
		else SetOp=AND;

		Caddress(RHS);
		RReg=LoadIntRO(RHS);
		Caddress(LHS);
		LReg=LoadIntRO(LHS);
		SetReg=LoadIntTgt(&LStk);
		Ltemp=claimreg();
		Rtemp=claimreg();
		if (Bytes<=8) 	/* unroll loop with interleaved load of RHS */{
			ARCH(accessindri(LoadUintVal,Rtemp,RReg,Bytes-4,4,0));
			do {
				Bytes-=4;
				ARCH(accessindri(LoadUintVal,Ltemp,LReg,Bytes,4,0));
				if (Op==SETD)  ARCH(opr(NOT,Rtemp));	/*Quick !!(-1)*/
				ARCH(rr(SetOp,Ltemp,Rtemp,Ltemp));
				if (Bytes!=0)  ARCH(accessindri(LoadUintVal,Rtemp,RReg,Bytes-4,4,0));
				ARCH(accessindri(StoreUintVal,Ltemp,SetReg,Bytes,4,0));
			} while (!(Bytes==0)) ;
			/* plant a loop */
		} else {
			enotecc(-1);
			Lab=Mprivatelabel();
			CountReg=claimreg();
			ARCH(loadlit(Bytes,CountReg));
			eplabel(Lab);
			ARCH(oplit(ADD,CountReg,-4,CountReg));
			ARCH(accessindrr(LoadUintVal,Rtemp,RReg,CountReg,4,0));
			ARCH(accessindrr(LoadUintVal,Ltemp,LReg,CountReg,4,0));
			if (Op==SETD)  ARCH(opr(NOT,Rtemp));	/* quick !!(-1)*/
			ARCH(rr(SetOp,Ltemp,Rtemp,Ltemp));
			ARCH(accessindrr(StoreUintVal,Ltemp,SetReg,CountReg,4,0));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(bcctf(NE<<16,Index,0));
			notereguse(CountReg,0,0);
		}
		unlockreg(LReg);
		unlockreg(RReg);

		unlockreg(LReg);
		unlockreg(RReg);
		unlockreg(Ltemp);
		notereguse(Rtemp,0,0);
		Cstackr(SetReg,4);
		Crefer(&Stk [Elevel],0,4);
		Stk [Elevel].Size=Len->Intvalue;

	}	/* end of case */
}	/*C Set Binary Op*/
/***/
int CPartWord(struct Stkfmt *Stk) {
	/*************************************************************************/
	/** Determine whether stack record represents a bit field               **/
	/*************************************************************************/
	int Form;

	Form=Stk->Modform&31;
	if ((Form==RegBitModAddr)||(Form==DirBitModAddr)) {
		return 1;
	} else {
		return 0;
	}
}	/*CPartWord*/

void CSetBinaryOp(int Op,struct Stkfmt *LHS,struct Stkfmt *RHS,struct Stkfmt *Len) {
	/*********************************************************************/
	/** Implements SETI, SETU, SETD, SETSD, SETSING, SETRANGE           **/
	/*********************************************************************/
	int Bytes,Temp,SetReg,LReg,RReg,Ltemp,Rtemp,CountReg,Lab,SetOp;
	int Range,Rangereg,Index,CCfield,Reg,ECXreg;
	struct Stkfmt LStk;

	Bytes=Len->Intvalue;
	switch (Op) {

	case SETSING:

		/* claim space */
		memset(&LStk,0,sizeof( struct Stkfmt));
		LStk.Form=DirVal;
		LStk.Base=STACK;
		LStk.Offset=ARCH(tempspace(Bytes,4));
		LStk.Size=Bytes;

		/* zero it */
		Reg=LoadIntRO(&LitZero);
		if (Bytes<=4) {
			ARCH(stkaccess(StoreUintVal,Reg,&LStk));
		} else {
			for (Temp=0; Temp<=Bytes-4; Temp+=4) {
				ARCH(stkaccess(StoreUintVal,Reg,&LStk));
				LStk.Offset=LStk.Offset+4;
			}
		}
		unlockreg(Reg);

		/* set bit and leave on Estack */
		CSetBitOp(SETINCL,RHS,&LStk);
		LStk.Form=DirVal;
		LStk.Size=Bytes;
		Cpushoperand(&LStk);
		return ;

	case SETRANGE:

		ECXreg=claimnamedreg(ECX);	/* neded for shifting*/
		SetReg=claimtgtreg();
		enotecc(-1);
		Lab=Mprivatelabel();
		if ((LHS->Form&31)==LitVal) {
			Temp=LHS->Intvalue;
			RReg=LoadIntRW(RHS,ECXreg)	/* Into ECX for shift*/;
			ARCH(oplit(CMP,RReg,Temp,RReg));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(LT<<16,Index,CCfield));
			ARCH(loadlit(((-1)<<LHS->Intvalue),SetReg));
			ARCH(opr(NEG,RReg));
			ARCH(oplit(ADD,RReg,31,RReg))	/* RReg = 31 - RReg */;
			ARCH(opr(SHLV,SetReg));
			ARCH(opr(SHRV,SetReg));
			notereguse(RReg,0,0);
		} else if ((RHS->Form&31)==LitVal) {
			Temp=RHS->Intvalue;
			LReg=LoadIntRW(LHS,ECXreg)	/* Will be used for shifting */;
			ARCH(oplit(CMP,LReg,Temp,Temp));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(GT<<16,Index,CCfield));
			ARCH(loadlit(((unsigned)(-1)>>(31-RHS->Intvalue)),SetReg));
			ARCH(opr(SHRV,SetReg));
			ARCH(opr(SHLV,SetReg));
			notereguse(LReg,0,0);
		} else {
			RReg=LoadIntRW(RHS,ECXreg)	/* will be used first for shifting */;
			LReg=LoadIntRW(LHS,-1);
			ARCH(rr(CMP,RReg,LReg,LReg));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(rlit(MOV,SetReg,0,SetReg))	/* Not affecting CC */;
			ARCH(bcctf(LT<<16,Index,CCfield));
			ARCH(loadlit(-1,SetReg));
			ARCH(opr(NEG,RReg));
			ARCH(oplit(ADD,RReg,31,RReg))	/* RReg = 31 - RReg */;
			ARCH(rr(ADD,LReg,RReg,RReg))	/* RReg = 32 - no of bits */;
			ARCH(opr(SHRV,SetReg));
			ARCH(rr(MOV,LReg,RReg,RReg))	/* Copy to ECX */;
			ARCH(opr(SHLV,SetReg));
			notereguse(LReg,0,0);
			notereguse(RReg,0,0);
		}

		eplabel(Lab);
		Cstackr(SetReg,4);

		return ;

	case SETI:

	case SETU:

	case SETD:

	case SETSD:

		/* claim space */
		memset(&LStk,0,sizeof( struct Stkfmt));
		LStk.Form=AddrDir;
		LStk.Base=STACK;
		LStk.Offset=ARCH(tempspace(Bytes,4));
		LStk.Size=4;
		if (Op==SETSD)  SetOp=XOR;
		else if (Op==SETU)  SetOp=OR;
		else SetOp=AND;

		Caddress(RHS);
		RReg=LoadIntRO(RHS);
		Caddress(LHS);
		LReg=LoadIntRO(LHS);
		SetReg=LoadIntTgt(&LStk);
		Ltemp=claimreg();
		Rtemp=claimreg();
		if (Bytes<=8) 	/* unroll loop with interleaved load of RHS */{
			ARCH(accessindri(LoadUintVal,Rtemp,RReg,Bytes-4,4,0));
			do {
				Bytes-=4;
				ARCH(accessindri(LoadUintVal,Ltemp,LReg,Bytes,4,0));
				if (Op==SETD)  ARCH(opr(NOT,Rtemp));	/*Quick !!(-1)*/
				ARCH(rr(SetOp,Ltemp,Rtemp,Ltemp));
				if (Bytes!=0)  ARCH(accessindri(LoadUintVal,Rtemp,RReg,Bytes-4,4,0));
				ARCH(accessindri(StoreUintVal,Ltemp,SetReg,Bytes,4,0));
			} while (!(Bytes==0)) ;
			/* plant a loop */
		} else {
			enotecc(-1);
			Lab=Mprivatelabel();
			CountReg=claimreg();
			ARCH(loadlit(Bytes,CountReg));
			eplabel(Lab);
			ARCH(oplit(ADD,CountReg,-4,CountReg));
			ARCH(accessindrr(LoadUintVal,Rtemp,RReg,CountReg,4,0));
			ARCH(accessindrr(LoadUintVal,Ltemp,LReg,CountReg,4,0));
			if (Op==SETD)  ARCH(opr(NOT,Rtemp));	/* quick !!(-1)*/
			ARCH(rr(SetOp,Ltemp,Rtemp,Ltemp));
			ARCH(accessindrr(StoreUintVal,Ltemp,SetReg,CountReg,4,0));
			Index=BLocateLabel(Lab+Labadjust,0);
			ARCH(bcctf(NE<<16,Index,0));
			notereguse(CountReg,0,0);
		}
		unlockreg(LReg);
		unlockreg(RReg);

		unlockreg(LReg);
		unlockreg(RReg);
		unlockreg(Ltemp);
		notereguse(Rtemp,0,0);
		Cstackr(SetReg,4);
		Crefer(&Stk [Elevel],0,4);
		Stk [Elevel].Size=Len->Intvalue;

	}	/* end of case */
}	/*C Set Binary Op*/
/***/
void CIndexpf(int ElsPerWord,struct Stkfmt *Base,struct Stkfmt *Index) {
	/*****************************************************************************/
	/** construct a descriptor to an indexed packed-field reference             **/
	/*****************************************************************************/
	static const int Shift [16+1] = {
		0,0,1,0,2,0,0,0,

		3,0,0,0,0,0,0,0,
		4	};
	int IndexReg,Width;

	Width=32 / ElsPerWord;
	CStackpf(Base,0);
	IndexReg=LoadIntRW(Index,-1);

	ARCH(oplit(SHL,IndexReg,Shift [Width],IndexReg));
	/* erase reguse since reg value has changed */
	notereguse(IndexReg,-255,4);

	Base->Modform=RegBitModAddr;
	Base->Modreg=IndexReg;
	Base->Modoffset=0;
	Base->BitSize=Width;
	Cpushoperand(Base);

}	/*CIndexpf*/
/***/
void CBitsRefer(int FieldOffset,int FieldSize) {
	/*************************************************************************/
	/** Stack a descriptor for a bit-packed field.                          **/
	/** This may be within another bit-field descriptor so need to check    **/
	/*************************************************************************/
	struct Stkfmt *TempStk;

	TempStk=&Stk [Elevel];
	if (CPartWord(TempStk)!=0) 	/* field within field */{
		Creferpf(TempStk,FieldOffset);
	} else {
		CStackpf(TempStk,FieldOffset);
	}
	if ((TempStk->Form&31)==RegAddr) {
		notereguse(TempStk->Reg,-Elevel,4);
	}
	TempStk->BitSize=FieldSize;
}	/*CBitsRefer*/
/***/
void CBitFieldOp(int Mode) {
	/*************************************************************************/
	/** PASCAL bit field operation                                          **/
	/** Bit offset is reg or lit and is from the left. Width is always lit  **/
	/** and < 32.                                                           **/
	/** Mode is one of ExtractII/UU/IU/UI or InsertII/UU/IU/UI              **/
	/** NB. PASCAL compiler assumes that all bit fields are unsigned, even  **/
	/**     for signed types such as integer. ie. integer-types which may   **/
	/**     be negative are not stored as bit-fields. This may possibly     **/
	/**     change in future versions of the compiler, hence all the modes. **/
	/** Implementation note: SPARC shift instructions only use LS 5 bits.   **/
	/** This allows 32-reg to be done as 'neg reg'. (saves 1 instr & 1 reg) **/
	/*************************************************************************/
	int BitOffset,WordOffset,ResultReg,Width,AddressReg;
	int Tempreg,NewSize;
	struct Stkfmt *Opnd;

	if ((ExtractII<=Mode)&&(Mode<=ExtractUI)) {
		Opnd=&Stk [Elevel+1];
		Width=Opnd->BitSize;
		NewSize=Stk [Elevel+2].Intvalue;
		if ((Opnd->Modform&31)==DirBitModAddr) 	/* literal offset 0..31 */{
			BitOffset=Opnd->Modoffset;
			Opnd->Modform=0;
			Crefer(Opnd,0,4);
			ResultReg=LoadIntRW(Opnd,-1);
			/**/
			if ((BitOffset+Width)==32) 	/* right justified */{
				ARCH(oplit(AND,ResultReg,((1<<Width)-1),ResultReg));
			} else {
				if (BitOffset!=0) {
					ARCH(rlit(SHL,ResultReg,BitOffset,ResultReg));
				}
				/* result is left justified - now right justify */
				ARCH(rlit(SHR,ResultReg,32-Width,ResultReg));
			}
			/**/
			/* RegBitModAddr - Reg offset possibly > 31 */
		} else {
			BitOffset=Opnd->Modreg;
			if (BitOffset!=ECX) {
				ResultReg=claimnamedreg(ECX);
				ARCH(rr(MOV,BitOffset,ECX,ECX));
				unlockreg(BitOffset);
				BitOffset=ECX;
			}
			Opnd->Modform=0;
			ResultReg=LoadIntRW(Opnd,-1)	/*then work out index during load*/;
			WordOffset=claimreg();
			/**/
			ARCH(rr(MOV,BitOffset,WordOffset,WordOffset));
			ARCH(oplit(SHR,WordOffset,5,WordOffset));
			ARCH(oplit(SHL,WordOffset,2,WordOffset));
			/* ON PowerPC             target rrmm(SHL,BitOffset,32-3,WordOffset,3,29);!  eqv >>5<<3*/
			ARCH(accessindrr(LoadUintVal,ResultReg,ResultReg,WordOffset,4,0));
			ARCH(opr(SHLV,ResultReg));
			/* result is left justified - now right justify */
			ARCH(rlit(SHR,ResultReg,32-Width,ResultReg));
			/**/
			notereguse(BitOffset,0,4);
			notereguse(WordOffset,0,4);
		}
		Cstackr(ResultReg,NewSize);
		/**/
		if ((Mode==ExtractUU)||(Mode==ExtractIU)) {
			Stk [Elevel].Type=UintType;
		} else {
			Stk [Elevel].Type=IntType;
		}
		/**/
		/* InsertII <= Mode <= InsertUI */
	} else {
		Opnd=&Stk [Elevel+2];
		Width=Opnd->BitSize;
		ResultReg=claimreg();
		if ((Opnd->Modform&31)==DirBitModAddr) 	/* literal offset 0..31 */{
			BitOffset=Opnd->Modoffset;
			Opnd->Modform=0;
			AddressReg=LoadIntRW(Opnd,-1);
			BitOffset=(32-Width)-BitOffset;
			/**/
			ARCH(accessindri(LoadIntVal,ResultReg,AddressReg,0,4,0));
			/* clear bit field */
			ARCH(oplit(AND,ResultReg,~(((1<<Width)-1)<<BitOffset),ResultReg));
			Opnd=&Stk [Elevel+1];
			if ((Opnd->Form&31)==LitVal) {
				if (Opnd->Intvalue!=0) {
					ARCH(oplit(OR,ResultReg,Opnd->Intvalue<<BitOffset,ResultReg));
				}
			} else {
				Tempreg=LoadIntRW(Opnd,-1);
				if (BitOffset!=0) {
					ARCH(rlit(SHL,Tempreg,BitOffset,Tempreg));
				}
				ARCH(rr(OR,ResultReg,Tempreg,ResultReg));
				notereguse(Tempreg,0,4);
			}
			WordOffset=0;	/* for the register tracking stuff at the end */
			/**/
			/* AddressReg holds address to store ResultReg */
			/* RegBitModAddr - Reg offset possibly > 31 */
		} else {
			BitOffset=Opnd->Modreg;
			if (BitOffset!=ECX) {
				ResultReg=claimnamedreg(ECX);
				ARCH(rr(MOV,BitOffset,ECX,ECX));
				unlockreg(BitOffset);
				BitOffset=ECX;
			}
			Opnd->Modform=0;
			AddressReg=LoadIntRW(Opnd,-1)	/*work out index during load*/;
			WordOffset=claimreg();
			/**/
			ARCH(rr(MOV,BitOffset,WordOffset,WordOffset));
			ARCH(oplit(SHR,WordOffset,5,WordOffset));
			ARCH(oplit(SHL,WordOffset,2,WordOffset));
			/* On power PC             target rrmm(SHL,BitOffset,32-3,WordOffset,3,29);! eqv to >>5<<2*/
			ARCH(rr(ADD,AddressReg,WordOffset,AddressReg));
			ARCH(accessindri(LoadIntVal,ResultReg,AddressReg,0,4,0));
			/* now do 32-bitoffset-width */
			ARCH(opr(NEG,BitOffset));
			ARCH(rlit(ADD,BitOffset,32-Width,BitOffset))	/*32-BitOffset*/;
			Opnd=&Stk [Elevel+1];
			if ((Opnd->Form==LitVal)&&(Opnd->Intvalue==0)) {
				Tempreg=-1;
			} else {
				Tempreg=LoadIntRW(Opnd,-1)	/*make field mask during load*/;
			}
			ARCH(loadlit(((1<<Width)-1),WordOffset));
			ARCH(opr(SHLV,WordOffset));
			ARCH(opr(NOT,WordOffset))	/* quick !! (-1)*/;
			/* now zero out field */
			ARCH(rr(AND,ResultReg,WordOffset,ResultReg));
			if (Tempreg!=-1) {
				ARCH(opr(SHLV,Tempreg));
				ARCH(rr(OR,Tempreg,ResultReg,ResultReg));
			}
			/**/
			if (!(Tempreg==-1))  notereguse(Tempreg,0,4);
			notereguse(BitOffset,0,4);
			notereguse(WordOffset,0,4);
			WordOffset=1;	/* for the register tracking stuff at the end */
			/* AddressReg holds address to store ResultReg */
		}
		/**/
		/* store ResultReg back */
		/**/
		ARCH(accessindri(StoreIntVal,ResultReg,AddressReg,0,4,0));
		/**/
		notereguse(ResultReg,0,4);
		notereguse(AddressReg,0,4);
		/* need to ensure reg tracking is consistent since have updated */
		/* a store location.                                            */
		Opnd=&Stk [Elevel+2];
		if ((Opnd->Form&31)==AddrDir) {
			if (WordOffset!=0) {
				/* register offset => forget every +ve offset from base */
				CheckConflict(Opnd->Base,0,0x3FFFFF);
			} else {
				/* literal offset within first word */
				CheckConflict(Opnd->Base,Opnd->Offset,4);
			}
		} else {
			rcleartracking();
		}
	}

}	/*CBitFieldOp*/
/***/
void CSaveBitRef(struct Stkfmt *Temp,struct Stkfmt *Ref) {
	/*************************************************************************/
	/** Save a bit reference into temporary                                 **/
	/*************************************************************************/
	int Junk,Literal,Offset;

	if (Ref->Modform==DirBitModAddr) {
		Literal=1;
		Offset=Ref->Modoffset;
	} else {
		Literal=0;
		Offset=Ref->Modreg;
	}
	Ref->Modform=0;
	Temp->Size=4;
	Junk=Cstoreop(Temp,Ref,0);
	Caddress(Temp);
	Crefer(Temp,4,4);
	memset(Ref,0,sizeof( struct Stkfmt));
	if (Literal!=0) {
		Ref->Form=LitVal;
		Ref->Intvalue=Offset;
	} else {
		Ref->Form=RegVal|Regflag;
		Ref->Reg=Offset;
	}
	Ref->Size=4;
	Junk=Cstoreop(Temp,Ref,0);

}	/*CSaveBitRef*/
/***/
void CRestBitRef(struct Stkfmt *Temp) {
	/*************************************************************************/
	/** Restore a bit reference from temporary                              **/
	/*************************************************************************/
	int Base,Offset;
	Temp->Size=4;
	Base=LoadIntRW(Temp,-1);
	Caddress(Temp);
	Crefer(Temp,4,4);
	Offset=LoadIntRW(Temp,-1);
	Cstackr(Base,4);
	Stk [Elevel].Form=RegAddr|Regflag;
	Stk [Elevel].Modform=RegBitModAddr;
	Stk [Elevel].Modreg=Offset;
	Stk [Elevel].BitSize=0;	/* this will be set sensibly before it is used */

}	/*CRestBitRef*/
/***/
void CBitAddr(struct Stkfmt *BitField) {
	/*************************************************************************/
	/** Give the byte address of a bit field. Must be correct for fields    **/
	/** which are byte-aligned (offsets 0,8,16 etc), but obviously bit-     **/
	/** aligned fields can only give a byte address.                        **/
	/*************************************************************************/
	int BitAddr,Offset,Literal;

	if (BitField->Modform==DirBitModAddr) {
		Literal=1;
		Offset=(unsigned)BitField->Modoffset>>3;
	} else {
		Literal=0;
		Offset=BitField->Modreg;
		/**/
		ARCH(rlit(SHR,Offset,3,Offset));
		/**/
	}

	BitField->Modform=0;
	BitAddr=LoadIntRW(BitField,-1);
	if (Literal!=0) {
		/**/
		ARCH(oplit(ADD,BitAddr,Offset,BitAddr));
		/**/
	} else {
		/**/
		ARCH(rr(ADD,BitAddr,Offset,BitAddr));
		/**/
		notereguse(Offset,0,4);
	}
	Cstackr(BitAddr,4);

}	/*CBitAddr*/

/* %if Language=PASCAL %or Language=MODULA */

#endif
/***/

/* end of automatic translation */