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


#include "imptoc.h"
/**                                                                eprocs15.1*/
/** 30Jan98 Added ecall3 for Pentium STD calls only as yet(Has props fld)    */
/**                                                                eprocs15  */
/** 12Oct97 Added etrampcall for KAP frigs for F90                           */
/**         Changed some of the folding to cope with 8 byte Litvals          */
/**                                                                eprocs14.2*/
/** 02Sep97 Added code to optimise 2**i into 1<<i (pds)                      */
/**                                                                eprocs14.1*/
/**         Added code to ejump for comparisons of I* with zero              */
/**                                                                  eprocs14*/
/**         Added Esetoptions2 and made Pic external and owned by eprocs     */
/** 04Apr96 Mechanincally translated from eprocs13.i & hand finished         */
/**                                                                   eprocs13*/
/** 12Feb96 Changed to work with an elfput in C. This means alternative      */
/**         specs and calls for put routines that have impstrings as params  */
/**         Correction to EIBITS to return zero for field of 0 bytes         */
/**         better here than in every version of Cbitops                     */
/**                                                                   eprocs12.6*/
/** 14Dec95 Changed to use Mcurrentvalue instead of Ccurrentvalue            */
/**         Used const ADDRESS SIZE (defined in cgtarget.inc) instead of     */
/**         4 for the size of an address ready for 64 bit architecture       */
/**                                                                   eprocs12.5*/
/** 21Nov95 Added some safe folding for the logical operations               */
/**                                                                   eprocs12.4*/
/** 02Oct95 Added EonetimeLabel for Labels that are referenced just once     */
/**                                                                   eprocs12.3*/
/** 22Aug95 Added extra stuff for Big Endian Intel hidden behind a flag      */
/**         'AllowReverseEndianData' which should be in cgtarget and set to  */
/**         0 for all normal compilers(pds)                                  */
/**                                                                   eprocs12.2*/
/** 09Aug95 Changes to Estkrconst - Conversion on the fly to a Literal       */
/**         will not work when compiling crossendian(pds)                    */
/**                                                                   eprocs12.1*/
/** 28Jly95 Changes to handle handling to cope withC++ -g compilations       */
/**         with nearly 6000 procedures in a single file(pds)                */
/**                                                                   eprocs12*/
/** 20Jly95 Extended the Einterface for multiple line no tables as reqd      */
/**         by Data General(pds)                                             */
/**                                                                   eprocs11*/
/** 09May95 Added Ereinitialise. All other modules bar code will need        */
/**         the appropiate reinitialise before working with this module(pds) */
/**                                                                   eprocs10.8*/
/** 02Feb95 Changes for PSAL in Elabel,Efrlabe & Estkregvar(pds)             */
/**         Resticted UCHECK to Forms that need checking(pds)                */
/**                                                                   eprocs10.7*/
/** 25Jan95 Removed some historic frig for scanf form exname (etc)           */
/**         Passed type information from exname to mgetprockey. Needed       */
/**         for Mexpcall to work properly                                    */
/**                                                                   eprocs10.6*/
/** 15Dec94 Extended Eparallel for the datasync instruction                  */
/**       Changed intval to intvalue in stkfmt for translation to C          */
/**                                                                   eprocs10.5*/
/** 10Nov94 Extended Etranslateca handle to return proc addresses (pds)      */
/**         Added Estkulit and estkemode(pds). Corrected Ebdbits for LE m-cs */
/**                                                                   eprocs10.4*/
/** 18Oct94 Amended 11aug fix so that it does not screw up displays(pds)     */
/**         Added code to eglabel for MIPs only as the ABI makes             */
/**         global jumps hard to implement                                   */
/**                                                                  eprocs10.3.1*/
/** 11Aug94 Fixed estkdir to handle strange combined literal offsets         */
/**         generated by USL C front end. (rt)                               */
/**                                                                  eprocs10.3*/
/** 11Aug94 Correction of typo in SETEXCL                                    */
/**                                                                  eprocs10.2*/
/** 27Jul94 Changed Eterminate to handle NULL pointer passed as area         */
/**         size array. Also added bit to exrecad_flags to indicate that     */
/**         symbol represents a called function. (rt)                        */
/**                                                                  eprocs10.1.1*/
/** 13Jul94 Changed EQCControl - this will not be implemented on PowerPC     */
/**         as the code generator will conform to the E-machine 5 definition */
/**         in which EQCControl is removed. Also changed egiveareaid to      */
/**         just return key if no information set up for area. Added extra   */
/**         tracing to show establishment of logicals. (rt)                  */
/**                                                                  eprocs10.1*/
/** 22Jul94 Addition of Eparallel.                                           */
/**                                                                  eprocs10*/
/** 10May94 Taking lastest GIS sources back to MIPS for testing. Fixed       */
/**         esetgisoptions to agree with E-machine specification. (rt)       */
/**                                                                  eprocs9.4*/
/** 03May94 Reactivate ASF & SFA For MIPS so alloca can be inlined(pds)      */
/**                                                                  eprocs9.3*/
/** 08Apr94 Various corrections reqd to RT's Merge. Added a conditional      */
/**         Establish logical to Ecjump                                      */
/**                                                                  eprocs9.2*/
/** 21Mar94 Merge of SPARC GIS development code generator with lastest       */
/**         sources. (rt)                                                    */
/**------------------------ START OF PENTIUM CHANGES ---------------------------*/
/** 14Mar94                                                          eprocs7.7*/
/**        Added monitoring to ca handle routines                            */
/** 07Feb94                                                          eprocs7.6*/
/**       Added target specific code for Pentium at Enoteiores and Estkiores */
/** 24Jan94                                                         eprocs7.5*/
/**       Restricted call of C discard Fixup to 4 byte items                 */
/** 08Dec93                                                         eprocs7.4*/
/**       Added call of C disard fixup to complement C record fixup since    */
/**       F77 implements cray pointers by overwriting fixups in some         */
/**       circumstances. Dummy this out at your peril ! (pds)                */
/**       Amended ETWjump to test >0 first for better spec nos               */
/** 17Nov93                                                         eprocs7.3*/
/**       Added use of INddsipmodval for globals for Pentium and merged      */
/**       in Madjust options for Pascal                                      */
/**       Added new Pasop(SETOPTION) including altering MinElevel.           */
/**       Checked for misaligned reals in estkdir,estkpar,estkglobal         */
/**       and erefer and set type to MisREal                                 */
/**------------------------- END OF PENTIUM CHANGES ----------------------------*/
/**                                                                  eprocs9.1*/
/** 21Mar94 Added new ESetEntityProps routine to set area/symbol properties and*/
/**         flags. Added new eop(EADDRITEM). (rt)                            */
/**                                                                  eprocs9 */
/** 07Jan94 Merged M88K and SPARC versions for GIS support. Extended number  */
/**         of E-stack types on which enotedomain operates. (rt)             */
/***/
/**----------------------- START OF SPARC F90 CHANGES --------------------------*/
/** 23Aug93                                                          eprocs3.6.1*/
/**         implement the PSEUDONOP ecode for Fortran90 edb                  */
/**         support - requires xprocs12.1.1 onwards.                         */
/** 12Aug93                                                                  */
/**         changed the constant firstuserarea from 11 to 21 (on             */
/**         Pete`s advice)                                                   */
/** 27July93                                                                 */
/**         make Ecjump available to Fortran90 (it is used by Fortran90      */
/**         to save any registers on the Estack prior to generating a        */
/**         a loop - note that labelid will always be set to zero).          */
/**         Clear fix up areas in Efix after problem on solaris              */
/**------------------------ END OF SPARC F90 CHANGES ---------------------------*/
/** 03Nov93                                                         eprocs8  */
/**          Merge of MIPS, USL C M88K and C++ M88K code generators. Added   */
/**          new Ecall3 procedure to handle passing of call properties. Got  */
/**          rid of incorrect masking of AdId values. (rt)                   */
/**----------------------- START OF USL C M88K CHANGES -------------------------*/
/**                                                                 eprocs3.4*/
/** 27Oct93  Mexname - returns external name for assembler production.       */
/**          EOP(TMASK) reintroduced. (md)                                   */
/**                                                                 eprocs3.3*/
/** 06Oct93  Egivename needed for USLC                                       */
/**          other USLC changes including __EPC_Data                         */
/**          GIS dummy routines                                              */
/**                                                                 eprocs3  */
/** 12Mar93  merge from RS6000 and 88k                                       */
/**------------------------ END OF USL C M88K CHANGES --------------------------*/
/**------------------------ START OF C++ M88K CHANGES --------------------------*/
/**                                                              eprocs34.6.1*/
/** 21-05-93 :- Replace edbits with MIPS edbits as it doesnt use "initdataad"*/
/**             which is a real frig and SHOULD NOT BE USED anywhere         */
/**                                                              eprocs34.6  */
/** 13 Nov 92 Altered Efix so as fixups done slightly differently. This      */
/**           was done for Elf but should be okay for Coff as well           */
/**                                                              eprocs34.5  */
/** 09 Nov 92 Implmented ETranslateCA, ENextCAHandle and EProcFrameSize.  (si)*/
/**                                                              eprocs34.4  */
/** 05 Oct 92 Copy CdupAdd code from INTEL and SPARC (GCA)                   */
/**                                                              eprocs34.3  */
/** SOMEBODY FAILED TO PUT COMMENT HERE.                                     */
/**                                                              eprocs34.2  */
/** 13 May 92 In ELineStart, return if lineno < 0, pending merge with        */
/**           SPARC C++ back end.                                            */
/**                                                              eprocs34.1  */
/** 27 Jan 92 Changed EProcPtr to take extra id parameter. This allows a     */
/**           number of fixups to be made to the same function without       */
/**           more than a single external reference having to be made. (rt)  */
/**------------------------- END OF C++ M88K CHANGES ---------------------------*/
/** 15Oct93                                                         eprocs7.3*/
/**          Added F77 op PSEUDONOP. (rt)                                    */
/** 02Sep93                                                         eprocs7.2*/
/**          Added E-stack tracing to Einitreg and enotedomain. Also         */
/**          extended domain information to be associated with AddrDir and   */
/**          DirModAddr E-stack types. (rt)                                  */
/** 10Aug93                                                         eprocs7.1*/
/**          Make Ecjump generally available. Conditionally compile          */
/**          C specific bit not whole routine(for F90)                       */
/**                                                                     eprocs7*/
/** 22Jul93                                                                  */
/**         Masked off values before placing them in _Adid field of          */
/**         E-stack records - this is because USL C may pass rubbish values  */
/**         in these fields in certain circumstances which can cause an      */
/**         array bound fault. Added eendhandles to force evaluation of      */
/**         code addresses. (rt)                                             */
/**                                                                     eprocs6*/
/** 19Jul93                                                                  */
/**         Fixed problem in EFix which can cause an array bound fault if    */
/**         there are many areas. (rt)                                       */
/**                                                                     eprocs5*/
/** 19July93                                                                 */
/**         Changed esetgisoptions so that it must be called before          */
/**         EInitialise. This avoids circular initialisation dependency in   */
/**         FORTRAN77 front end. (rt)                                        */
/**                                                                     eprocs4*/
/** 17June93                                                                 */
/**         Added new esetoptions routine to pass compiler options down      */
/**         to MSetOptions. Note that all the options are now documented.    */
/**         The option to enable mixed case external symbols (X'20000000')   */
/**         has been moved to X'40000000' as it clashed with the line        */
/**         profiling bit. Also Added esetgisoptions for passing options to  */
/**         the global scheduler. Improved ELineStart to handle line         */
/**         prefixes. These give extra information about the expansion route */
/**         for source lines which appear by virtue of being inlined. Changed*/
/**         memory allocation calls to use B Malloc interface. (rt)          */
/** 16June93                                                            eprocs3.6*/
/**         Add Enextcahandle %AND EgiveFirstuserarea                        */
/** 10June93                                                            eprocs3.5*/
/**         Change Eprocend to fn return framesize. Extended Efix            */
/**         to allow fixes to CA (area=CODE,offset=x'80000000')              */
/**                                                                     eprocs3.4*/
/**         Changes to Eprocptr for C++                                      */
/**                                                                 eprocs3.3*/
/** 18May93 Extended Ecjump to include JUMP with register freeing            */
/**         Correction to Elevels for EMCHIP                                 */
/**                                                                  eprocs3.2*/
/** 11May93 Introduce C invert CC for C++. Needed on non-CC machines         */
/**         like mips. Other machines do not need this change                */
/**                                                                 eprocs3.1*/
/** 16Apr93 Disable Fixup recording for C since it is unsound(pds)           */
/**         Add call to CfregSTop for raddst etc                             */
/**          Deal with Real multiply by 2.00                                 */
/**         Merge in some ULCS specifics from alanf                          */
/**         Merge in some F90 specifics from andyK                           */
/**         Change to Efix to default to the Ecode4 version of fixing        */
/**         Previouly defaulted to the 386 method unless each new Target     */
/**         was added into the conditional clause                            */
/**         Also added default clause to estructres which did nothing except */
/**         for specific Targets(pds)                                        */
/**                                                                  eprocs3 */
/** 12Mar93 Merge of RS6000 SPARC & 88K (gem)                                */
/**                                                                eprocs1.5 */
/** 10Nov92 Additions from AK for Fortran90 + Merge of some specials         */
/**        for USL C                                                         */
/**                                                                  eprocs1.4*/
/** 30Sep92 ebrac added to give sdb-dbx support for inner blocks             */
/**         Volatile attribute supported for USL C                           */
/**                                                                  eprocs1.3*/
/** 22Sep92 C unsigned store ops made available to Pascal & modula           */
/**         Also improved sequence for SETINCL if sets fit in single word    */
/**                                                               eprocs1.2  */
/** 03Jun92 call of Enextproc inserted into Eproc2 in case FE forgot         */
/**         Estkdcmplxvar added                                              */
/**                                                               eprocs1.1  */
/** 11May92 Correction to estructresult for Pascal & Modula                  */
/**         Modified call of C int Binary Op for comparisions                */
/**                                                              eprocs1     */
/** 26/11/91 - changes for consistency with Mprocs and Cprocs                */
/**         First version from sparc eprocs34                                */
/**         Changes include:                                                 */
/**         Introduction of EfrLabel as alternative to Elabel                */
/**         Revision of EDBITS to remove a kluge                             */
/**         Removal of old CComp specials                                    */
/**         Making Estore and operate&assign responsible for                 */
/**         ensuring items down th Estack are not corrupted when assigning   */
/**          ie EVAL & CEVAL redundant but still supported                   */
/**         More use of DUP now that an efficient DUP is provided by Cprocs  */
/**           Certain specials to avoid DUP are now redundant                */
/**           but still supported.                                           */
/**         Cdiscard dropped in favour of Cdiscardopnd                       */
/**         Push operand dropped. calls routed to existing Cpush operand     */
/***/
/**************************************************************************/
/**                                                                      **/
/** This module contains the E-machine procedural interfaces visible to  **/
/** a compiler.  The intention is that this code should be common to all **/
/** new RISC (and other?) code generators.                               **/
/**                                                                      **/
/**************************************************************************/
/***/
/***/
#include "cgtarget.h"
/***/
#include "ecodes.h"
/***/
#include "enames.h"
/***/
#include "cgconsts.h"
/***/
#include "boconsts.h"
/***/
/*************************************************************************/
/** Exports                                                             **/
/*************************************************************************/
/***/
void emonon( void );
void emonoff( void );
void erefer( int ,int );
void estkparind( int ,int ,char * ,int );

extern int FirstDisplayLevel;
extern int RegClaimMaskA;
extern int RegClaimMaskB;
int Pic;			/* Now owned and set by eprocs */
/***/

#include "prototypes.h"
/***/
/***/
/************************************************************/
/*                                                         **/
/*  Local constant definitions                             **/
/*                                                         **/
/************************************************************/
/***/
static const unsigned char Regop [IREMST-IADDST+1] = {
	IADD,
	ISUB,IMULT,IDIV,0,UREM,UDIV,IAND,
	IOR,0,IXOR,IREM};
/***/
static const unsigned char Falsecc [ALWAYS-(GT)+1] = {
	LE,
	GE,NE,EQ,LT,GT,255,255,
	255,255,255,255,255,255,ALWAYS,NEVER
};
/***/
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
};
/***/
#define increports 1

#define VOLBIT (0x80000000)	/* props bit for volatile operands */
#define CONSTBIT (0x40000000)	/* props bit for constant operands */
#define REVENDIAN (0x20000000)	/* props bit for swopped data*/


#if((Language==PASCAL)||(Language==MODULA)||((Language==FORTRAN)&&(LanguageVariant!=FORTRAN90)))
#define FirstUserArea 11

#else
#define FirstUserArea 21

#endif

/* Current call depth on E-machine                                           */
static int Depth=0;


#if((Language==CCOMP)&&(Target!=RS6))
extern void CQCcontrol( int ,int );
#endif

/***/
/***************************************/
/*                                    **/
/*  Support Procedure definitions     **/
/*                                    **/
/***************************************/
/***/

#if(Language==FORTRAN)
#define f77cxmult 0
#define f77cdmult 1
#define f77cqmult 2
#define f77cxdiv 3
#define f77cddiv 4
#define f77cqdiv 5
#define F77index 6
#define F77concat 7
#define f77pstop 8
#define f77cpystr 9
#define f77cpstr 10
#define f77ishft 15
#define f77ibits 16
#define f77ibset 17
#define f77btest 18
#define f77ibclr 19
#define f77ishftc 20
#endif
/***/

#if(Language==PASCAL)
#define paseol 13
#define paslazy 14
;
#endif
/***/
/***/
/************************************************************/
/*                                                         **/
/*  Global data                                            **/
/*                                                         **/
/************************************************************/
/***/
struct Stkfmt Stk [Stklimit+1];
/***/
int Elevel;
int ModifyCC=0;
int TargetReg=-1;
int TargetFreg=-1;
int FirstTarget=1;
int TargetDToS=0;
int JumpPredictFlag=-1;
/* = -1     => don't know                                                    */
/* =  1     => jump will probably NOT be taken                               */
/* =  2     => jump will probably be taken                                   */
/* = others =don't know                                                      */
/***/

#if(Target==SPARC)
/*   %EXTERNALINTEGER lprof labelseen = 0                                    */
int lprofjumpseen=0;
#endif
/***/
static int CCfield=0;	/* RS6000 details which CCfield to use                 */
/* is or'd into Cjumps first parameter                                       */
/* on all m-cs bar RS6000 is always zero                                     */
static int CCset;
static int CCest;
static int CondCode;
/***/
static int parfork;	/* use in eparallel */
static char parprefix [256];

#if(Target==M88K)
extern int CCreg;
#endif
/***/
static int Report=0;
int GlobCodeReport=0;
static int GlobECodeReport=0;
static int Elinedecodereport;	/*set on by Elinedecode and off by Elinestart*/
/***/
#define MAXLINEPREFIX 31
static int CurInLineDepth;
static int LinePrefixes [MAXLINEPREFIX+1];
/***/
static int Bitarea;
static int Bitval;
static int	/* all for EDBITS*/ Bitdisp;
/***/
/** cache to store backend optimiser options until EInitialise called -      */
/** esetoptions and esetgisoptions must be called before EInitialise         */
static int eccgoptions=0;
static int ecbotraceoptions=0;
static int ecboinhiboptions=0;
static int ecprocedure=0;
static int ecfraglow=0;
static int ecfraghigh=0;
static int ecbuffzone=0;
static int ecfloatopt=0;
static int ecunsafeopt=0;
static int ecgistrace=0;
static int ecgisinhib=0;
static int ecrangeregion=0;
static int ecattemptnum=0;
static int ecpassnum=0;
/***/
static int cahandlechunk;
static int cahandleindex;
/***/
static int ProgFaulty;
static int Proclevel;
static int ECdupflag;
static int Numcsave=0;
static int Currlineno=0;
/***/
static int Unasslab;
static int Boundlab;
/***/
static int STACKOffset=0;
static int PARAMOffset=0;
static int PARAMBase=0;	/*initialise by Minitialise*/
static int GLAoffset=0;
static int CNSTOffset=0;

#if(Target==PENTIUM)
static int DISPLAYOffset=0;

#else
static int DISPLAYOffset=-4;

#endif
static int highestproc=-1;
/***/
static struct Stkfmt Litzero;
static struct Stkfmt Litone;
/***/
struct AreaInfoFmt{
	char AreaName[32];
	int AreaId;
	int AreaProps;
};

#define AreaInfoFmtSize 40
/***/
/***/
static int AreaInfoBases [255+1];
#define MaxAreas 32767
/***/
static char * Typetext [MaxType+1] = {
	" (unknwn) ",
	" (INT)  "," (REAL) "," (UINT) ",
	" (SET)  "," (MREAL)"," (STRCT)"," (MINT) ",
	" (MUINT)"};
/***/
/***/
struct LabsFmt{
	int LabId;
	int GlaAd;
};

/*%CONSTINTEGER MaxLabs = 100                                                */
/*%OWNRECORD(LabsFmt)%ARRAY Labs(1:MaxLabs)                                  */
/***/
/***/
static int NewTemp(int Bytes) {
	Bytes=(Bytes+3)&0xFFFFFFFC;

#if(Target==RS6)
	return etempspace(Bytes,4)+STACKOffset;
#else
	return etempspace(Bytes,4);
#endif
}	/* New Temp  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void checkrecur(char * S) {
	if (Depth>0) {
		printf("RECURSIVE ");
		if (Depth>1) {
			printf("(%1d) ",Depth);
		}
	}
	printf("%s   ",S);
}	/* checkrecur  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/*%IF  ElfputinC = Positive %START                                           */
char * eimpstringtoc(char * impstring) {
	/*************************************************************************/
	/**  translates an impstring to a Cstring with a buffer for safety      **/
	/*************************************************************************/
	static char buff [256];
	int i,len;

	len=impstring[0]&255;		/* imp length byte */
	for (i=1; i<=len; i++) {
		buff[i-1]=impstring[i];
	}
	buff[len]=0;
	return buff;
}
char * ecstringtoimp(int adcstring) {
	/*************************************************************************/
	/**  translates a Cstring to IMP                                        **/
	/*************************************************************************/
	return (char *)adcstring;
/*
	char s [256] ;
	int i,j;
	for (i=0; i<=255; i++) {
		j=(*(unsigned char  *)(adcstring+i));
		if (j==0)   break ;
		s[i+1-1]=j;
	}
	(*(unsigned char  *)((int)s))=i;
	return s;
*/
}	/*ecstringtoimp*/

/***/
/*%FINISH                                                                    */
void enotecc(int val) {
	/**************************************************************************/
	/** Called by code generator EMachine of a change to the condition codes **/
	/**************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Enotecc  %x\n",val);
	}
#endif
	if (val>=0) {

#if(Target==RS6)
		CCfield=val&0xFF0000;
		val&=0xFFFF;
		;
#endif
		CondCode=val;
		CCset=1;
		CCest=0;
	} else {
		CCset=0;
	}
}	/* Enotecc  */
/***/
void enoteestcc(int val) {
	/*************************************************************/
	/** Called by code generator after logical establishment of **/
	/** the condition codes to a 0/1 value.                     **/
	/*************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("enotestcc %x\n",val);
	}
#endif
	CondCode=val;
	CCset=1;
	CCest=1;
}	/* enotestcc   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int ereadcc() {
	/*************************************************************/
	/** Used by code generator to find the current state of the **/
	/** condition codes. Returns -1 if condition codes not set. **/
	/*************************************************************/
	if (CCset==0)  return -1;
	else return CondCode|CCfield;
}	/* ereadcc   */
/***/
int ereadestcc() {
	/**************************************************************************/
	/* Return 1 if the condition codes have been established to a RegVal 0/1 **/
	/**************************************************************************/
	if ((CCset!=0)&&(CCest!=0))  return 1;
	else return 0;
}	/* ereadestcc  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/

int egivenameaddr(int Key) {
	/*************************************************************************/
	/**  Returns a pointer to the name for C written front ends             **/
	/*************************************************************************/
	struct AreaInfoFmt *InfoBase;

	InfoBase=(struct AreaInfoFmt*)((struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Key>>8]));
	return (int)InfoBase [Key&0xFF].AreaName;
}	/* egivenameaddr  */
/***/

#if((Language==CCOMP)&&(LanguageVariant==USLC))
char * egivename(int Key) {
	/*************************************************************************/
	/** As above but returns an imp string for Imp written front ends            */
	/*************************************************************************/
	char str [81] ;


#if(Target==M88K)
	if (Key==GLA) {
		return "__EPC_data";
	} else {
		strcpy(str,((char *)Mgetname(Key)));
		return Mexname(str);
	}

#else
	return ((char *)Mgetname(Key));

#endif
}	/* egivename   */

#else
char * egivename(int Key) {
	/*************************************************************************/
	/** As above but returns an imp string for Imp written front ends            */
	/*************************************************************************/
	return ((char *)egivenameaddr(Key));
}	/* egivename   */

#endif
/***/
void eareaalign(int id,int align) {
	/*************************************************************************/
	/** Specify (minimum) alignment requirements for area id                **/
	/** as bytes. Values 1,2,4,8,16 acceptable                              **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EAreaAlign");
		printf("Area %d to %d\n",id,align);
	}
#endif
	Mareaalign(id,align);
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int esetentityprops(int Id,int type,int vector) {
	/*************************************************************************/
	/** Specify the properties of of external symbol or procedure. If type  **/
	/** is 0 then the following procedure properties may be added to the    **/
	/** procedure using the following bits in vector. If type is 1 then the **/
	/** properties may be removed. This should only be used on ids          **/
	/** representing internal or external procedures:                       **/
	/**    2**0     Set if external                                         **/
	/**    2**1     Set if main entry                                       **/
	/**    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             **/
	/**    2**8     Used by Mtidyend for Pfix calls                         **/
	/**    2**9     Set if this procedure returns an aggregate              **/
	/**    2**10    Set if there are no pointers or aliases to locals       **/
	/**    2**11    Set if this proc is to be called from .init             **/
	/**    2**12    Set if this proc is to be called from .fini             **/
	/**    2**13    Set if proc contains calls with unknown control flow    **/
	/**    2**14    Set is proc has unknown return flow                     **/
	/**    2**15    Set if proc is a special buffer handling function       **/
	/**                                                                     **/
	/** If type is 2 then the following symbol flags may be added to the    **/
	/** symbol. If type is 3 then the flags may be removed:                 **/
	/**    2**0     Set if symbol name not to be changed by PUT             **/
	/**    2**1     Set if symbol is data external reference on AIX         **/
	/**    2**2     Set if symbol is internal                               **/
	/**    2**3     Set if symbol has no self aliases for internal pointers **/
	/**    2**4     Set if symbol is a called function on AIX               **/
	/**    2**5     Set if symbol is a defined entry point                  **/
	/**    2**6     Set if symbol is data item requiring a TOC entry on AIX **/
	/**                                                                     **/
	/** The new set of procedure properties or symbol flags are returned.   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("ESetEntityProps");
		printf("Entity %d Settype=%d Vector=%x\n",Id,type,vector);
	}
#endif
	return MSetEntityProps(Id,type,vector);
}	/* esetentityprops   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int egiveareaid(int Key) {
	/*************************************************************************/
	/** Returns the id for the given area                                   **/
	/*************************************************************************/
	struct AreaInfoFmt *InfoBase;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("egiveareaid");
		printf("%6d\n",Key);
	}
#endif
	if (AreaInfoBases [(unsigned)Key>>8]==0)  return Key;
	InfoBase=(struct AreaInfoFmt*)((struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Key>>8]));
	return InfoBase [Key&0xFF].AreaId;
}	/*egiveareaid*/

/***/
int egiveareaprops(int Key) {
	/*************************************************************************/
	/** Returns the properties for the given area                           **/
	/*************************************************************************/
	struct AreaInfoFmt *InfoBase;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("EGiveareaprops");
		printf("%6d\n",Key);
	}
#endif
	if (AreaInfoBases [(unsigned)Key>>8]==0)  return 0;
	InfoBase=(struct AreaInfoFmt*)((struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Key>>8]));
	return InfoBase [Key&0xFF].AreaProps;
}	/*EGiveareaprops*/

/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/************************************************************************/
/************************************************************************/
/***                      Error reporting                             ***/
/************************************************************************/
/************************************************************************/
/***/
/***/
static char * Opname(int opcode) {
	/*************************************************************************/
	/**    Gives the name for Opcode                                        **/
	/*************************************************************************/
	if (opcode>=768)  return Ecopname [opcode-768];
	if (opcode>=511)  return Epasopname [opcode-511];
	if (opcode>=256)  return Ef77opname [opcode-256];
	return Eopname [opcode];
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void LowEstack(int Opcode,int Reqlevel) {
	printf("******* ESTACK ERROR ******\n");
	printf("Op = %s  actual/required levels: %d/%d\n",Opname(Opcode),Elevel,Reqlevel);
	;
	imp_stop();
}	/* Low Estack  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void AreasOverflow() {
	printf("******* Too Many External Areas *******\n");
	;
	imp_stop();
}	/* AreasOverflow    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void EstkOverflow() {
	printf("\nEstk Overflow\n");
	Cdumpestack();
	;
	imp_stop();
}	/* EstkOverflow   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void UnsupportedOpcode(int Opcode) {
	/*************************************************************************/
	/**    Reports an unimplemented operation                               **/
	/*************************************************************************/
	printf("\n******* Unsupported Opcode ****** %s\n",Opname(Opcode));
	imp_stop();
}	/* Unsupported Opcode  */
/***/
/***/
/*************************************************************************/
/*************************************************************************/
/***             Externally visible procedures                         ***/
/*************************************************************************/
/*************************************************************************/
/***/
/***/
/**                    **********************/
/**                    *  Administration   **/
/**                    **********************/
/***/
/***/
void einitialise(int Lang,int Aver,int Astackca,int Aglaca,int options) {
	/*************************************************************************/
	/** called once at the start of compilation to initialise Eput          **/
	/*************************************************************************/
	int I;
	struct AreaInfoFmt *FixedAreas;

	ProgFaulty=0;
	if (Language!=Lang)  Mabort(55);
#if(increports!=0)
	if (Report!=0) {
		printf("Einitialise - Options:\n");
		printf("  CG_OPTIONS        = %x\n",eccgoptions);
		printf("  CG_TRACE_OPTIONS  = %x\n",ecbotraceoptions);
		printf("  CG_INHIB_OPTIONS  = %x\n",ecboinhiboptions);
		printf("  CG_PROCEDURE      = %d\n",ecprocedure);
		printf("  CG_FRAG_LOW       = %d\n",ecfraglow);
		printf("  CG_FRAG_HIGH      = %d\n",ecfraghigh);
		printf("  GIS_TRACE_OPTIONS = %x\n",ecgistrace);
		printf("  GIS_INHIB_OPTIONS = %x\n",ecgisinhib);
		printf("  GIS_REGION        = %d\n",ecrangeregion);
		printf("  GIS_ATTEMPT_NUM   = %d\n",ecattemptnum);
		printf("  GIS_PASS_NUM      = %d\n",ecpassnum);
		printf("  GIS_BUFF_ZONE     = %d\n",ecbuffzone);
		printf("  GIS_FLOAT_OPT     = %d\n",ecfloatopt);
		printf("  GIS_UNSAFE_OPT    = %d\n",ecunsafeopt);
	}
#endif
	CCset=0;
	CCest=0;
	Elevel=0;
	Depth=0;
	Bitarea=-1;

	BInitialise();
	BSetOptions(ecbotraceoptions,ecboinhiboptions,ecprocedure,ecfraglow,ecfraghigh);
	BSetGISOptions(ecbuffzone,ecfloatopt,ecunsafeopt,ecgistrace,ecgisinhib,ecrangeregion,ecattemptnum,
	    ecpassnum);
	BSetArchVariant((((unsigned)eccgoptions>>12)&0xF));

	AreaInfoBases [0]=(int)BMalloc(AreaInfoFmtSize<<8,1,MAEXTERNALNAMEAREA);
	FixedAreas=(struct AreaInfoFmt*)((struct AreaInfoFmt *)(AreaInfoBases [0]));
	for (I=0; I<=10; I++) {
		imp_strjam(FixedAreas [I].AreaName,FixedAreaNames [I],31);
		FixedAreas [I].AreaId=I;
		FixedAreas [I].AreaProps=0;
	}
	FixedAreas [10].AreaId=GLA;	/* Const really GLA */
	for (I=1; I<=255; I++) {
		AreaInfoBases [I]=0;
	}

	GLAoffset=0;

#if(Target==RS6)
	STACKOffset=(-144)-80;	/* Saveareasize*/
	DISPLAYOffset+=STACKOffset;
	;
#endif
	/***/

#if((Target==SPARC)||(OutputASSEMBLER==Negative)||(Language!=CCOMP))
	pinitialise(0,1,Language);
	;
#endif
	/***/
	Minitialise(Language,&PARAMBase);
	/***/
	Report=0;
	if (MInTraceRegion()!=0)  Report=GlobECodeReport;
	/***/
	/**    initialise first six words of GLA                                     */
	/***/

#if(LanguageVariant!=USLC)
	pfix(GLA,4,CODE,0);
	pfix(GLA,8,UST,0);
	pfix(GLA,12,SST,0);
	pd4(GLA,16,((Lang<<24)|options));
	pfix(GLA,20,DIAGS,0);
	;
#endif
	/***/
	/**    initialise first some useful stk records                              */
	/***/
	memset(&Litzero,0,sizeof( struct Stkfmt));
	Litzero.Size=ADDRESSSIZE;
	Litzero.Form=LitVal;
	memset(&Litone,0,sizeof( struct Stkfmt));
	Litone.Size=ADDRESSSIZE;
	Litone.Form=LitVal;
	Litone.Intvalue
	    =1;
	Proclevel=0;
	ECdupflag=0;
	Numcsave=0;
	CurInLineDepth=0;
	LinePrefixes [0]=0;
	cahandlechunk=0;
}	/* Einitialise */
void ereinitialise() {
	/*************************************************************************/
	/** Reinitialise                                                             */
	/*************************************************************************/
	int I;
	struct AreaInfoFmt *FixedAreas;

#if(increports!=0)
	if (Report!=0) {
		printf("Ereinitialise\n");
	}
#endif
	ProgFaulty=0;
	parfork=0;
	CCset=0;
	CCest=0;
	CCfield=0;
	CondCode=0;
	Elevel=0;
	Depth=0;
	Bitarea=-1;
	highestproc=-1;
	BReinitialise();

	AreaInfoBases [0]=(int)BMalloc(AreaInfoFmtSize<<8,1,MAEXTERNALNAMEAREA);
	FixedAreas=(struct AreaInfoFmt*)((struct AreaInfoFmt *)(AreaInfoBases [0]));
	for (I=0; I<=10; I++) {
		imp_strjam(FixedAreas [I].AreaName,FixedAreaNames [I],31);
		FixedAreas [I].AreaId=I;
		FixedAreas [I].AreaProps=0;
	}
	FixedAreas [10].AreaId=GLA;	/* Const really GLA */
	for (I=1; I<=255; I++) {
		AreaInfoBases [I]=0;
	}

	GLAoffset=0;
	PARAMOffset=0;
	CNSTOffset=0;
	/***/

#if((Target==SPARC)||(OutputASSEMBLER==Negative)||(Language!=CCOMP))
	preinitialise();
	;
#endif
	/***/
	MReinitialise();
	/***/
	Report=0;
	if (MInTraceRegion()!=0)  Report=GlobECodeReport;
	/***/
	/**    initialise first six words of GLA                                     */
	/***/

#if(LanguageVariant!=USLC)
	pfix(GLA,4,CODE,0);
	pfix(GLA,8,UST,0);
	pfix(GLA,12,SST,0);
	pd4(GLA,16,(Language<<24));
	pfix(GLA,20,DIAGS,0);
	;
#endif
	/***/
	Proclevel=0;
	ECdupflag=0;
	Numcsave=0;
	CurInLineDepth=0;
	LinePrefixes [0]=0;
	cahandlechunk=0;
}	/* EReinitialise  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetoptions2(int cgoptions,int botraceoptions,int boinhiboptions,
	int proc,int fraglow,int fraghigh,int picoption) {
	/***************************************************************************/
	/** Passes CODE generation options to the E-machine and back end          **/
	/** optimiser. This should be called before EInitialise.                  **/
	/**                                                                       **/
	/** cgoptions parameter has 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'00000800'  enable shrink wrapping 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'  M-C dependent (-qnomaf on PPC)                         **/
	/**   x'08000000'  now only used for PPC                                  **/
	/**   x'10000000'  now only used for PPC                                  **/
	/**   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                              **/
	/***************************************************************************/
	Msetoptions2(cgoptions);
	Pic=picoption;
	eccgoptions=cgoptions;
	/***************************************************************************/
	/**                                                                       **/
	/** botraceoptions parameter is used to select tracing from the backend   **/
	/** optimiser and is bit significant:                                     **/
	/**   x'00000001'  enable memory block allocation tracing                 **/
	/**   x'00000002'  enable fragment reorganisation tracing                 **/
	/**   x'00000004'  enable terse basic block scheduler tracing             **/
	/**   x'00000008'  enable verbose basic block scheduler tracing           **/
	/**   x'00000010'  enable buddy allocator tracing                         **/
	/**   x'00000020'  enable extended fragment reorganisation tracing        **/
	/**   x'00000040'  enable procedure entry name tracing                    **/
	/**   x'00000080'  enable fragment and instruction allocation tracing     **/
	/**   x'00000100'  enable pre and post global scheduling fragment tracing **/
	/**   x'00000200'  enable extended fragment instruction tracing           **/
	/**                                                                       **/
	/** boinhiboptions parameter is used to inhibit optimisations in the      **/
	/** backend optimiser and is bit significant:                             **/
	/**   x'00000001'  disables basic block scheduler                         **/
	/**   x'00000002'  disables delay slot filling                            **/
	/**   x'00000004'  disables switch and return improvement                 **/
	/**   x'00000008'  disables live register analysis (global inhib only)    **/
	/**   x'00000010'  disables predecessor list gen (global inhib only)      **/
	/**   x'00000020'  disables global scheduling (global inhib only)         **/
	/**   x'00000040'  disables fragment reorganisation 1                     **/
	/**   x'00000080'  disables fragment reorganisation 2                     **/
	/**   x'00000100'  disables fragment reorganisation 3                     **/
	/**   x'00000200'  disables fragment reorganisation 4                     **/
	/**   x'00000400'  disables fragment reorganisation 5                     **/
	/**   x'00000800'  disables fragment reorganisation 6                     **/
	/**   x'00001000'  disables fragment reorganisation 7                     **/
	/**   x'00002000'  disables fragment reorganisation 8                     **/
	/**   x'00004000'  disables fragment reorganisation 9                     **/
	/**   x'00008000'  disables global scheduling for any given procedure and **/
	/**                all subsequent procedures                              **/
	/**   x'00010000'  disables global scheduling for any given region and    **/
	/**                all higher numbered regions in the selected procedure  **/
	/**                                                                       **/
	/** The backend optimiser tracing and inhibition options may be selected  **/
	/** over a specific fragment range in a specific procedure. If proc is    **/
	/** zero then the inhibition/tracing applies to all fragments in  all     **/
	/** procedures, otherwise it only happends in the numbered procedure.     **/
	/** If proc is non-zero and fraglow is non-zero and fraghigh >= fraglow   **/
	/** then the inhibition/tracing only applies to the given range of        **/
	/** fragments in the given procedure.                                     **/
	/***************************************************************************/
	ecbotraceoptions=botraceoptions;
	ecboinhiboptions=boinhiboptions;
	ecprocedure=proc;
	ecfraglow=fraglow;
	ecfraghigh=fraghigh;
}	/*esetoptions*/
void esetoptions(int cgoptions,int botraceoptions,int boinhiboptions,
        int proc,int fraglow,int fraghigh) {

	esetoptions2(cgoptions&0xe7ffffff,botraceoptions,boinhiboptions,proc,
		fraglow,fraghigh,cgoptions>>27&3);
}
/***/
/**/
/* Copyright (c) 1993 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetgisoptions(int buffzone,int fullopt,int trace,int inhib,int rangeregion) {
	/********************************************************************************/
	/** Sets the options for the Global Instruction Scheduler (GIS). If GIS is not **/
	/** enabled then this call is ignored. The parameters are defined as follows:  **/
	/**  buffzone    - The number of bytes of buffer zone for speculative loads at **/
	/**                the start and end of the address space.                     **/
	/**  fullopt     - This parameter is now ignored.                              **/
	/**  trace       - Bit vector for GIS tracing.                                 **/
	/**  inhib       - Bit vector for GIS optimisation inhibition.                 **/
	/**  rangeregion - Region for which tracing or optimisation inhibition is      **/
	/**                selected or -1 is no region is selected.                    **/
	/********************************************************************************/
	ecbuffzone=buffzone;
	ecfloatopt=0;
	ecunsafeopt=0;
	ecgistrace=trace;
	ecgisinhib=inhib;
	ecrangeregion=rangeregion;
	ecattemptnum=0;
	ecpassnum=0;
	if (ecrangeregion==-1)  ecrangeregion=0;
}	/*esetgisoptions*/
/***/
/**/
/* Copyright (c) 1993 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetgisoptions2(int buffzone,int floatopt,int unsafeopt,int trace,int inhib,int rangeregion,int attemptnum
,int passnum) {
	/********************************************************************************/
	/** Sets the options for the Global Instruction Scheduler (GIS). This function **/
	/** allows extra options to be passed which are not available for              **/
	/** esetgisoptions. If GIS is not enabled then this call is ignored. The       **/
	/** parameters are defined as follows:                                         **/
	/**  buffzone    - The number of bytes of buffer zone for speculative loads at **/
	/**                the start and end of the address space.                     **/
	/**  floatopt    - Non-zero if certain floating point operations may be        **/
	/**                performed speculatively on the basis that floating point    **/
	/**                traps will be disabled.                                     **/
	/**  unsafeopt   - The unsafe optimisation level:                              **/
	/**                 0 - No unsafe optimisations are performed (other than      **/
	/**                     those allowed by setting BuffZone and FloatOpt).       **/
	/**                 1 - Data speculative potentially excepting instructions    **/
	/**                     may be issued but only if the data is speculative due  **/
	/**                     to possible call side effects.                         **/
	/**                 2 - Control and data speculative execution of potentially  **/
	/**                     excepting instructions is allowed but with many        **/
	/**                     heuristics to try and prevent invalid speculation.     **/
	/**                 3 - Control and data speculative execution of potentially  **/
	/**                     excepting instructions is allowed but with minimal     **/
	/**                     heuristics to prevent invalid speculation.             **/
	/**  trace       - Bit vector for GIS tracing.                                 **/
	/**  inhib       - Bit vector for GIS optimisation inhibition.                 **/
	/**  rangeregion - Region for which tracing or optimisation inhibition is      **/
	/**                selected or 0 is no region is selected.                     **/
	/**  attemptnum  - Schedule attempt number for which tracing or optimisation   **/
	/**                inhibition is selected or 0 if no attempt is selected.      **/
	/**  passnum     - Schedule pass number for which tracing or optimisation      **/
	/**                inhibition is selected or 0 if no pass is selected.         **/
	/********************************************************************************/
	ecbuffzone=buffzone;
	ecfloatopt=floatopt;
	ecunsafeopt=unsafeopt;
	ecgistrace=trace;
	ecgisinhib=inhib;
	ecrangeregion=rangeregion;
	ecattemptnum=attemptnum;
	ecpassnum=passnum;
}	/*esetgisoptions2*/
/***/
/**/
/* Copyright (c) 1993 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eterminate(int adareasizes) {
	/*************************************************************************/
	/** called once at the end of compilation by the code generator         **/
	/*************************************************************************/
	static int S [10];
	int I,J,codesize;
	if (ProgFaulty!=0)  return ;
	Mtidyend(&codesize);
	if (adareasizes!=0) {
		(*(int  *)(adareasizes))=codesize;
		J=0;
		for (I=1; I<=9; I++) {
			S [I-1]=(*(int  *)(adareasizes+J));
			J+=4;
		}
		S [2-1]=S [2-1]+GLAoffset;

		S [10-1]=0;
	}
#if(increports!=0)
	if (Report!=0) {
		printf("Eterminate ");
		if (adareasizes!=0) {
			for (I=1; I<=10; I++)  printf("%2d",S [I-1]);
		}
		printf("\n");
	}
#endif
	if ((OutputASSEMBLER==Negative)&&(adareasizes!=0)) {
		pterminate((int)&S [1-1]);
		(*(int  *)(adareasizes))=S [1-1];	/*to enable compiler to report code size*/
	}
	BTerminate();	/* Will free up anything allocated by Bmalloc */
}	/* Eterminate  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eccommon2(int visibility,int area,char * Name) {
	/*************************************************************************/
	/**      Define a common area (in range 11..MaxAreas)                   **/
	/*************************************************************************/
	int Prop;
	struct AreaInfoFmt *AreaBase;
	char S [256] ;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ecommon2");
		printf("%2d    %s- visibility %2d \n",area,Name,visibility);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((area<0)||(area>=MaxAreas))  AreasOverflow();
	strcpy(S,Name);
	if (strcmp(Name,"F#BLCM")==0) {
		Prop=BLANKCOMMON;
		strcpy(S,"_BLNK__");
	} else {
		Prop=NAMEDCOMMON;
	}

	if (AreaInfoBases [(unsigned)area>>8]==0) {
		AreaInfoBases [(unsigned)area>>8]=(int)BMalloc(AreaInfoFmtSize<<8,1,MAEXTERNALNAMEAREA);
	}
	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);

#if(OutputASSEMBLER!=Positive)

	AreaBase [area&0xFF].AreaId=pcommon2(visibility,S);
#endif
	imp_strjam(AreaBase [area&0xFF].AreaName,S,31);
	AreaBase [area&0xFF].AreaProps=Prop;

}	/* Eccommon2  */
/***/
void ecommon2(int visibility,int area,int maxlen, char * impstring) {
	/*************************************************************************/
	/* Version accepting an IMP string                                       */
	/*************************************************************************/
	char S [256];
	strcpy(S,eimpstringtoc(impstring));
	eccommon2(visibility,area,S);
}	/* ecommon2*/

void ecommon(int area,int maxlen,char * impstring) {
	/*************************************************************************/
	/**    Old version assumes all commons external                         **/
	/*************************************************************************/
	ecommon2(0,area,maxlen,impstring);
}	/* Ecommon  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eendcommon2(int area,int Length,int alignment) {
	/*************************************************************************/
	/** define length and alignment of previously defined common            **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eendcommon2");
		printf("area=%d  len=%d aligmnt=%d\n ",area,Length,alignment);
	}
#endif
	if (ProgFaulty!=0)  return ;
	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);

#if(OutputASSEMBLER!=Positive)
	pendcommon2(AreaBase [area&0xFF].AreaId,Length,AreaBase [area&0xFF].AreaProps,alignment);
#endif
}	/* Eendcommon2 */
/***/
void eendcommon(int area,int Length) {
	/*************************************************************************/
	/** define length of previously defined common(Old version)             **/
	/*************************************************************************/
	eendcommon2(area,Length,8);
}	/* Eendcommon  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void elinestart(int lineno) {
	/*************************************************************************/
	/** register start of a line and handle line prefixes                   **/
	/**                                                                     **/
	/** lineno = -1  --> enter a new inline block                           **/
	/** lineno = -2  --> exit the current inline block                      **/
	/*************************************************************************/
	if (Elinedecodereport>0) {
		Elinedecodereport--;
		if (Elinedecodereport==0)  emonoff();
	}
#if(increports!=0)
	if (Report!=0) {
		printf("Elinestart ");
		if (lineno<0) {
			printf("%5d",lineno);
		} else if (CurInLineDepth<=MAXLINEPREFIX) {
			MPrintLine(lineno,LinePrefixes [CurInLineDepth]);
		} else {
			MPrintLine(lineno,LinePrefixes [MAXLINEPREFIX]);
		};

		printf(" +++++++++++++++++++++++++++++++");
		printf("++++++++++++++++++++++++++++++++\n");
	}
#endif
	if (ProgFaulty!=0)  return ;

	if (lineno>=0) {

		/* if we have an ordinary line number then pass it and its */
		/* line prefix to mprocs to generate a line number marker  */
		if (lineno==Currlineno)  return ;
		Currlineno=lineno;
		if (CurInLineDepth<=MAXLINEPREFIX) {
			Mline(lineno,LinePrefixes [CurInLineDepth]);
		} else {
			Mline(lineno,LinePrefixes [MAXLINEPREFIX]);
		}

	} else if (lineno==-1) {

		/* if we are entering a new inline block then generate a prefix */
		CurInLineDepth++;
		if (CurInLineDepth<=MAXLINEPREFIX) {
			LinePrefixes [CurInLineDepth]=MAddLinePrefix(Currlineno,LinePrefixes [CurInLineDepth-1]);
		}

	} else {

		/* we are leaving an inline block */
		if (CurInLineDepth>0)  CurInLineDepth--;

	};


}	/* Elinestart   */
/***/
int ebrac(int type,int privateinfo) {
	/*************************************************************************/
	/** Put a marker in the instruction scheme to note a feature (ie block) **/
	/** for dbx or sdb. The content of the marker are target dependent      **/
	/** unlike Emarker(qv). It is presumed that the marker will hold some   **/
	/** form of location information so that the code generator can complete**/
	/** the sdb record when the address of the next instruction has         **/
	/** finally been determined                                             **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Ebrac  type=%d inf=%d\n",type,privateinfo);
	}
#endif
	if (ProgFaulty!=0)  return -1;
	return Mbrac(type,privateinfo);
}	/*Ebrac*/
/***/
int enextcahandle() {
	/*************************************************************************/
	/** This is a hack that has to be perpetuated. It puts a marker into    **/
	/** the code stream and then Etranslateca can return the ca after       ***/
	/** code generation                                                     **/
	/*************************************************************************/
	int handle,irecaddr;

	if (cahandlechunk==0) {
		cahandlechunk=(int)BMalloc(256,1,MACODEHANDLEAREA);
		cahandleindex=0;
	}
	handle=cahandlechunk+(cahandleindex<<3);
	cahandleindex++;
	if (cahandleindex>31)  cahandlechunk=0;
	(*(int  *)(handle))=handle;
	irecaddr=ebrac(0,handle+4);
#if(increports!=0)
	if (Report!=0) {
		printf("ENextcaHandle returns %x\n",handle);
	}
#endif
	return handle;
}	/*EnextCAhandle*/
/***/
int etranslateca(int handle) {
	/*************************************************************************/
	/** See previous routine                                                     */
	/*************************************************************************/
	struct Exdatafmt *exdata;
	if ((0<=handle)&&(handle<=highestproc)) {
		exdata=(struct Exdatafmt*)(exrecad(handle));
		return exdata->Ca;
	}
	if ((*(int  *)(handle))!=handle)  Mabort(80);	/* Invalid handle*/
#if(increports!=0)
	if (Report!=0) {
		printf("Etranslateca of %x to %x \n",handle,(*(int  *)(handle+4)));
	}
#endif
	return (*(int  *)(handle+4));
}	/*EtranslateCA*/
/***/
void epushfile() {
	/*************************************************************************/
	/** Put a marker in the code to indicate the start of a new source file **/
	int irecaddr;
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Epushfile\n");
	}
#endif
	irecaddr=Mbrac(1,0);
}	/*Epushfile*/
/***/
int epopfile() {
	/*************************************************************************/
	/** Put a marker in the code to indicate the end of a source file       **/
	/** It returns a handle which can be used by Etranslateca to return the **/
	/** relative offset of this files line no table                         **/
	/*************************************************************************/
	int handle,irecaddr;

	if (cahandlechunk==0) {
		cahandlechunk=(int)BMalloc(256,1,MACODEHANDLEAREA);
		cahandleindex=0;
	}
	handle=cahandlechunk+(cahandleindex<<3);
	cahandleindex++;
	if (cahandleindex>31)  cahandlechunk=0;
	(*(int  *)(handle))=handle;
	irecaddr=Mbrac(2,handle+4);
#if(increports!=0)
	if (Report!=0) {
		printf("Epopfile returns %x\n",handle);
	}
#endif
	return handle;
}	/*Epopfile*/
/***/
int egivecurrentsize(int area) {
	/*************************************************************************/
	/** Asks put to return the current size ot a Emachine area              **/
	/*************************************************************************/
	int res;

#if(OutputASSEMBLER==Positive)
	res=-1;

#else
	{
		extern int pgivecurrentsize( int );
		res=pgivecurrentsize(area);
	}

#endif
#if(increports!=0)
	if (Report!=0) {
		printf("Egivecurrentsize returns %d\n",res);
	}
#endif
	return res;
}	/*Egivecurrentsize*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eendhandles() {
	/*************************************************************************/
	/** Forces the evaluation of any outstanding code handles. No further   **/
	/** code should be generated after this call - it should preceeed the   **/
	/** Eterminate call                                                     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("eendhandles\n");
	}
#endif
	MEndProcs();
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void elinedecode() {
	/*************************************************************************/
	/** decompile code generated from last Elinedecode or Elinestart        **/
	/**                                               **/	/*deprecated procedure*/
	/*************************************************************************/
	static int noteReport=-1;

	if (noteReport==-1)  noteReport=Report;
	if (noteReport==0) {
		Elinedecodereport=3;
		emonon();
	}
}	/* Elinedecode */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void elinedebug(int lineno) {
	/*************************************************************************/
	/** generate debugging information for this line of code                **/
	/*************************************************************************/
	Mlinedebug(lineno);
}	/*Elinedebug*/
/***/
int estkmarker() {
	/*************************************************************************/
	/**    Stacks a literal(<=16bits) whose exact value will be given later **/
	/**    via a call of Esetmarker. The result is an identifier which is   **/
	/**    returned when the value is specified.                            **/
	/*************************************************************************/
	int mark;
	mark=(int)Mmarker();
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkmarker ");
		printf("%x \n",mark);
	}
#endif
	Depth++;
	estklit(0x7FFF);	/* to guarantee 16-bit hole for later plugging             */
	Depth--;
	return mark;
}	/* Estkmarker  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetmarker(struct instrfmt * Markerid,int NewValue) {
	/*************************************************************************/
	/**    Nominate the value of the literal stacked by estkmarker(above)   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Esetmarker ");
		printf("%x==%5d\n",(int)Markerid,NewValue);
	}
#endif
	Msetopd(Markerid,NewValue);	/* Fill the Value                               */
}	/* Esetmarker  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int eswapmode() {
	/*************************************************************************/
	/**    Specify the swapping needed for compiler produced data           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Eswapmode\n");
	}
#endif
	return 0;
}	/* Eswapmode */
/***/
int egivefirstuserarea() {
	/*************************************************************************/
	/** Returns the First area that the front ends can define               **/
	/*************************************************************************/
	return FirstUserArea;
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
void ecopyasm(char * Asm,int AFlag) {
	/*************************************************************************/
	/**    Copies a line of assembler (from  asm(...) ) into instruction    **/
	/**    stream.  Asm is the line, which is assumed to be in              **/
	/**    static storage.  The line has no trailing newline.               **/
	/**    AFlag is non-zero for lines which may be actual instructions.    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		if (Depth>0)  printf("recursive ");
		printf("ecopyasm : AFlag = %d\n",AFlag);
		printf("%s\n",Asm);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0) {
		Cestablishlogical();
		CCset=0;
	}

	CCopyAsm(Asm,AFlag);

}	/* ecopyasm */
/***/
void ecopystabx(char *  Asm) {
/***********************************************************************/
/*    Copies a line of assembler (from  asm(...) ) into instruction    */
/*    stream.  Asm is the line, which is assumed to be in              */
/*    static storage.  The line has no trailing newline.               */
/***********************************************************************/
        if (CCset!=0) {
                Cestablishlogical();
                CCset=0;
        }

#if(Target==RS6)
      CCopyStabx(Asm)
#endif

} /* ECopyStabx */
/***/
void emonon() {
	/*************************************************************************/
	/** turn on internal tracing                                            **/
	/*************************************************************************/
	Report=1;
	GlobECodeReport=1;

#if(Language!=CCOMP)
	GlobCodeReport=1;
#endif
}	/* emonon  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void emonoff() {
	/*************************************************************************/
	/** turn off internal tracing                                           **/
	/*************************************************************************/
	Report=0;
	GlobECodeReport=0;

#if(Language!=CCOMP)
	GlobCodeReport=0;
#endif
}	/* Emonoff   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecodeon() {
	/*************************************************************************/
	/** turn on code listing                                                **/
	/*************************************************************************/

#if((Language==CCOMP)||(Language==IMP))
	GlobCodeReport=1;
#endif
}	/* Ecodeon   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecodeoff() {
	/*************************************************************************/
	/** turn off code listing                                               **/
	/*************************************************************************/

#if((Language==CCOMP)||(Language==IMP))
	GlobCodeReport=0;
#endif
}	/* Ecodeoff */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void efaulty() {
	/*************************************************************************/
	/** compilation has a fault - no object file to be generated            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Efaulty\n");
	}
#endif
	ProgFaulty=1;

#if(OutputASSEMBLER!=Positive)
	pfaulty();
#endif
}	/* Efaulty   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/**                 **********************/
/**                 * Stack operations  **/
/**                 **********************/
/***/
void enotedomain(int domain) {
	/*************************************************************************/
	/** Notes the domain of the entry at the top of the E-stack. If the     **/
	/** E-stack form may not have a domain associated with it then the call **/
	/** is ignored. Positive domain labels in the range 1 - 32767 signify   **/
	/** that the object represented by the E-stack entry is an address in   **/
	/** the given domain. Negative domain labels in the range -32768 to -1  **/
	/** represent access domains - these are associated with the memory     **/
	/** location holding the E-stack object. Items in a domain may be       **/
	/** aliased with items which are not marked as having a domain or are   **/
	/** in the same domain but may not be aliased with items from other     **/
	/** domains.                                                            **/
	/*************************************************************************/
	struct Stkfmt *stktos;
	int form;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("enotedomain");
		printf("%d\n",domain);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel==0) {
		printf("Empty E-Stack for enotedomain\n");
		imp_stop();
	}
	stktos=&Stk [Elevel];
	form=stktos->Form&31;
	if ((domain>=0)&&(IsDomAddrForm [form]!=0)) {
		stktos->Domain=domain;
	} else if ((domain<0)&&(IsDomAccessForm [form]!=0)) {
		stktos->Domain=domain;
	} else {
		stktos->Domain=0;
	};

}	/* enotedomain */
/***/
void estklit(int Val) {
	/*************************************************************************/
	/** stacks Val as a 32-bit integer literal                              **/
	/*************************************************************************/
	struct Stkfmt *Lstk;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("estklit");
		printf("%7d\n",Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=LitVal;
	Lstk->Intvalue=Val;
	Lstk->Size=4;
	Lstk->Type=IntType;
}	/* estklit  */
/***/
void estkulit(int Val) {
	/*************************************************************************/
	/** stacks Val as a 32-bit unsigned literal                             **/
	/*************************************************************************/
	struct Stkfmt *Lstk;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkulit");
		printf("%7d\n",Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=LitVal;
	Lstk->Intvalue=Val;
	Lstk->Size=4;
	Lstk->Type=UintType;
}	/* Estkulit  */
/***/
void estkemode(int Val) {
	/*************************************************************************/
	/** stacks Val as a 32-bit emachine mode                                **/
	/** a mode is used only to infulence the amachine never as an operand        */
	/** hence has no side effects like establishing logicals                **/
	/** used in preference to estklit for adding the control value to       **/
	/** EPOWERI direct compex ops and many others                           **/
	/*************************************************************************/
	struct Stkfmt *Lstk;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("estkemode");
		printf("%7d\n",Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=LitVal;
	Lstk->Intvalue=Val;
	Lstk->Size=4;
}	/* estkemode */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkconst(int Len,int Ad) {
	/*************************************************************************/
	/** stacks the constant, allocating space for it if necessary           **/
	/*************************************************************************/
	int area,offset;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkconst");
		printf("%5d  %x",Len,(*(int  *)(Ad)));
		if (Len>4) {
			printf(" %x",(*(int  *)(Ad+4)));
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	Msetconst(Ad,Len,&area,&offset);
	Depth++;
	estkdir(area,offset,0,Len);
	Depth--;
}	/* Estkconst   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkrconst(int Len,int Ad) {
	/*************************************************************************/
	/** stacks the constant, allocating space for it if necessary           **/
	/*************************************************************************/
	int area,offset,ToAddr,i,ivalue;
	float rvalue;
	double dvalue;
	struct Stkfmt *Rstk;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("estkrconst");
		printf("%5d",Len);
		if (Len>8) {
			for (i=0; i<=Len-4; i+=4) {
				bytemove(4,Ad+(4*i),(int)&ivalue);
				printf("%x ",ivalue);
			}
		} else {
			if (Len==4)  ToAddr=(int)&rvalue;
			else ToAddr=(int)&dvalue;
			;
			bytemove(Len,Ad,ToAddr);
			if (Len==4)  printf(" %f",rvalue);
			else printf(" %f",dvalue);
			;
		}
		printf("\n");
	}
#endif

	if (ProgFaulty!=0)  return ;

	Depth++;
	if ((eswapmode()!=0)||(Target==SPARC)||(Len>8)) {
		Msetconst(Ad,Len,&area,&offset);
		estkdir(area,offset,0,(((RealType<<24)|Len)|CONSTBIT));
	} else if (Len==4) {
                estklit(0);     /* dummy */
                Rstk=&Stk [Elevel];
                ToAddr=(int)&Rstk->Rval;
                bytemove(Len,Ad,ToAddr);
		Stk [Elevel].Form=Flitval;
		Stk [Elevel].Type=RealType;
	} else {
		estklit(0);	/* dummy */
		Rstk=&Stk [Elevel];
		ToAddr=(int)&Rstk->Rlval;
		bytemove(Len,Ad,ToAddr);
		Rstk->Form=Flitval;
		Rstk->Type=RealType;
		Rstk->Size=Len;
	};

	Depth--;
}	/* estkrconst  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static void printid(char *AdId) {
	/*************************************************************************/
	/**  outputs an ID whose address is AdId. Allow for C & imp strings     **/
	/**  Also allow for backend to have been translated to C                **/
	/**  This means imp string operations are nou usable                    **/
	/*************************************************************************/
	int i,len;
	if (AdId==0)  return ;
	len=(unsigned char  )AdId [0];
	if (len<32) 	/* assume IMP string */{
		for (i=1; i<=len; i++) {
			printf("%c",(unsigned char  )AdId [i]);
		}
	} else {		/* assume Cstring */
		printf("\"%s\"",AdId);
	}
}
/***/
void estkdir(int Area,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks a direct operand                                             **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	struct Stkfmt *Lstk;
	int Bytes,Type,stkprops;

	stkprops=0;
	if ((Props&VOLBIT)!=0)  stkprops|=STKVOL;
	if ((Props&CONSTBIT)!=0)  stkprops|=STKCONST;
#if(AllowReverseEndianData!=0)
	if ((Props&REVENDIAN)!=0)  stkprops|=STKSWOPPED;
#endif
	Props&=~((VOLBIT|CONSTBIT)|REVENDIAN);
	Bytes=(unsigned)(Props<<8)>>8;
	Type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("estkdir");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Area>>8]);
		printf("%s [%d]",egivename(Area),Area&0xFF);
		if (Offset>0)  printf(" +");
		printf("%2d %s %2d",Offset,Typetext [Type],Bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		if ((stkprops&STKVOL)!=0)  printf(" [volatile]");
		if ((stkprops&STKCONST)!=0)  printf(" [constant]");
#if(AllowReverseEndianData!=0)
		if ((stkprops&STKSWOPPED)!=0)  printf(" [Swopped]");
#endif
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Language==FORTRAN)&&(Area==PARAMS)) {
		Depth++;
		estkpar(0,Offset,AdId,Props);
		Depth--;
	} else if ((Area==STACK)&&(Offset>0)) {

		/* zero or positive offsets must be handled specially */
		/* otherwise they will not be adjusted properly       */
		Depth++;
		estkdir(STACK,-1,AdId,Props);
		eop(EADDRESS);
		estklit(Offset+1);
		eop(IADD);
		Lstk=&Stk [Elevel];
		Lstk->Form=RegAddr;
		Depth--;

	} else {
		if (CCset!=0 && CCest==0)  Cestablishlogical();
		if (Area==GLA)  Offset+=GLAoffset;
		if (Area==CNST)  Offset+=CNSTOffset;
		if (Area==STACK)  Offset+=STACKOffset;
		if (Elevel>=Stklimit)  EstkOverflow();
		Elevel+=1;
		Lstk=&Stk [Elevel];
		memset(Lstk,0,sizeof( struct Stkfmt));
		Lstk->Form=DirVal;
		Lstk->Size=Bytes;
		Lstk->Base=Area;
		Lstk->Offset=Offset;
		Lstk->AdId=AdId;
		if ((Target!=PENTIUM)&&(Type==RealType)&&(Bytes>=8)&&((Offset&7)!=0)) {
			Type=MisRealType;
		}
		Lstk->Type=Type;
		Lstk->Flags=stkprops;
	};

}	/* estkdir   */
/***/
/**/
/* Copyright (c) 1991 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/*****************************************************************************/
/**            code generation service proced                               **/
/** Not for public use but are here because of the need to be compatible    **/
/** with the current values of STACK Offset and GLA offset                  **/
/*****************************************************************************/
/***/
/***/
void Stkreg(struct Stkfmt *Stk,int reg,int size) {
	/***************************************************************************/
	/* Create a RegVal stack entry for the given register with the given size **/
	/***************************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=RegVal|Regflag;
	Stk->Reg=reg;
	Stk->Size=size;
}	/* stkreg  */
/***/
void Stkfreg(struct Stkfmt *Stk,int reg,int size) {
	/****************************************************************************/
	/* Create a FregVal stack entry for the given register with the given size **/
	/****************************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=FregVal|Regflag;
	Stk->Reg=reg;
	Stk->Size=size;
	Stk->Type=RealType;
}	/* Stkfreg  */
/***/
void Stkdir(struct Stkfmt *Stk,int Offset,int size) {
	/**********************************************************************/
	/* Create a DirVal E-stack descriptor with the given offset and size **/
	/**********************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=DirVal;
	Stk->Base=STACK;
	Stk->Offset=Offset+STACKOffset;
	Stk->Size=size;
}	/* Stkdir  */
/***/
void StkTemp(struct Stkfmt *Stk,int Offset,int size) {
	/**********************************************************************/
	/* Create a TempVal E-stack descriptor with the given offset and size**/
	/* Only reqd for CrossEndian work as TempVals are never swapped      **/
	/**********************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=TempVal;
	Stk->Base=STACK;
	Stk->Offset=Offset+STACKOffset;
	Stk->Size=size;
}	/* Stkdir   */
/***/
void Gladir(struct Stkfmt *Stk,int Offset,int size) {
	/**************************************************************************/
	/* Create a GLA DirVal E-stack descriptor with the given offset and size **/
	/**************************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=DirVal;
	Stk->Base=GLA;
	Stk->Offset=Offset+GLAoffset;
	Stk->Size=size;
}	/* Gladir   */
/***/
void cnstdir(struct Stkfmt *Stk,int Offset,int size) {
	/**************************************************************************/
	/** Create a CNST DirVal E-stack descriptor with the given offset & size**/
	/** Consts may be in a read only area or may be mapped onto the GLa     **/
	/** Even if in the GLA a separate base is desirable since consts can    **/
	/** be freely rescheduled                                               **/
	/**************************************************************************/
	memset(Stk,0,sizeof( struct Stkfmt));
	Stk->Form=DirVal;
	Stk->Base=CNST;
	Stk->Offset=Offset+CNSTOffset;
	Stk->Size=size;
}	/* cnstdir  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkind(int Area,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks an indirect operand                                          **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	struct AreaInfoFmt *AreaBase;
	int bytes,type,stkprops;


	if ((Props&VOLBIT)!=0)  stkprops=STKVOL;
	else stkprops=0;
#if(AllowReverseEndianData!=0)
	if ((Props&REVENDIAN)!=0)  stkprops=(stkprops|STKSWOPPED)|STKBSSWOPPED;
#endif
	Props&=~(VOLBIT|REVENDIAN);
	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkind");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Area>>8]);
		printf("%s + %d %s %d",egivename(Area),Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		if ((stkprops&STKVOL)!=0)  printf("    [volatile]");
#if(AllowReverseEndianData!=0)
		if ((stkprops&STKSWOPPED)!=0)  printf(" [Swopped]");
#endif
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Area==PARAMS) {
		Depth++;
		estkparind(0,Offset,AdId,Props);
		Depth--;
	} else {
		if (Area==STACK)  Offset+=STACKOffset;
		if (Area==GLA)  Offset+=GLAoffset;
		if (Area==CNST)  Offset+=CNSTOffset;
		if (Elevel>=Stklimit)  EstkOverflow();
		if (CCset!=0 && CCest==0)  Cestablishlogical();
		Elevel+=1;
		Lstk=&Stk [Elevel];
		memset(Lstk,0,sizeof( struct Stkfmt));
		Lstk->Form=IndDirVal;
		Lstk->Size=bytes;
		Lstk->Base=Area;
		Lstk->Offset=Offset;
		Lstk->AdId=AdId;
		Lstk->Type=type;
		Lstk->Flags=stkprops;
	}
}	/* Estkind   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkglobal(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks a direct operand local to an enclosing level                 **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	int Bytes,Type;

	Bytes=(unsigned)(Props<<8)>>8;
	Type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("estkglobal");
		printf("Level= %d Off=%d %s size=%d",Level,Offset,Typetext [Type],Bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Level==Proclevel)||(Level==0)) {
		estkdir(STACK,Offset,AdId,Props);
		return ;
	}
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=IndDirModVal;

#if(Target==PENTIUM)
	Lstk->Form=IndDispModVal;
#endif
	Lstk->Modform=LitVal;
	Lstk->Offset=DISPLAYOffset-(((Level-FirstDisplayLevel)+1)*ADDRESSSIZE);
	Lstk->Modintval=Offset;
	Lstk->Size=Bytes;
	Lstk->Base=STACK;
	Lstk->AdId=AdId;
	if ((Target!=PENTIUM)&&(Type==RealType)&&(Bytes>=8)&&((Offset&7)!=0)) {
		Type=MisRealType;
	}
	Lstk->Type=Type;
}	/* estkglobal*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkgind(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks an indirect operand local to an enclosing level              **/
	/*************************************************************************/
	int bytes,type;

	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkgind");
		printf("Level=%2d Off= %d %s Size=%d",Level,Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Depth++;
	if ((Level==0)||(Level==Proclevel)) {
		estkind(STACK,Offset,AdId,Props);
	} else {
		estkglobal(Level,Offset,AdId,4);
		erefer(0,Props);
	}
	Depth--;
}	/* Estkgind  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetparamoffset(int NewOffset) {
	/*************************************************************************/
	/** Sets the parameter offset value                                     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("esetparamoffset");
		printf("Old=%d New=%d\n",PARAMOffset,NewOffset);
	}
#endif
	PARAMOffset=NewOffset;
}	/* esetparamoffset */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkpar(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks a direct parameter operand                                   **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	int bytes,type,stkprops;

	if ((Props&VOLBIT)!=0)  stkprops=STKVOL;
	else stkprops=0;
#if(AllowReverseEndianData!=0)
	if ((Props&REVENDIAN)!=0)  stkprops|=STKSWOPPED;
#endif
	Props&=~(VOLBIT|REVENDIAN);
	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("estkpar");
		printf("Level=%2d Off= %d %s Size=%d",Level,Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("   ");
			printid(AdId);
		}
		if ((stkprops&STKVOL)!=0)  printf("    [volatile]");
#if(AllowReverseEndianData!=0)
		if ((stkprops&STKSWOPPED)!=0)  printf(" [Swopped]");
#endif
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Offset+=PARAMOffset;
	if (Level==0)  Level=Proclevel;	/* 0 Shorthand for current frame             */
	if (Level==Proclevel) {
		/* Via current AP                                                            */
		Elevel+=1;
		Lstk=&Stk [Elevel];
		memset(Lstk,0,sizeof( struct Stkfmt));
		Lstk->Form=DirVal;
		Lstk->Base=PARAMS;
		Lstk->Offset=Offset;
		Lstk->Size=bytes;
		Lstk->AdId=AdId;
		Lstk->Type=type;
		Lstk->Flags=stkprops;
		MAdjustPar(Lstk,PARAMOffset)	/* allow code generator to fiddle it */;
		if ((Target!=PENTIUM)&&(type==RealType)&&(bytes>=8)&&((Lstk->Offset&7)!=0)) {
			Lstk->Type=MisRealType;
		}
		return ;
	}
	/**/

#if((Target==SPARC)||(Target==RS6)||(Target==PENTIUM))
	Offset=(Offset-PARAMOffset)+PARAMBase;
	;
#endif
	/**/

#if(Target==RS6)
	/**/
	/* RS6000 has variable sized save areas between params and stack variables   */
	/* The max area is very large so it is important not to inflate it. as a     */
	/* result one can not find global params by fiddling the offset and treating */
	/* it a global variable since the fiddle factor will not be known untill after*/
	/* the inner procedures have been generated. We stack a parampointer on the  */
	/* back of each display so we go via the local display to the level and then */
	/* via the parampointer to the params                                        */
	/**/
	Elevel+=1;
	Lstk=&Stk [Elevel];
	memset(Lstk,0,sizeof( struct Stkfmt));
	Lstk->Form=IndDirModVal;
	Lstk->Modform=LitVal;
	Lstk->Offset=DISPLAYOffset-(((Level-FirstDisplayLevel)+1)*ADDRESSSIZE);
	Lstk->Modintval=((Level-FirstDisplayLevel)+3)*(-ADDRESSSIZE);
	Lstk->Size=ADDRESSSIZE;
	Lstk->Type=IntType;
	Lstk->AdId=AdId;
	Lstk->Base=STACK;
	erefer(Offset,Props);
	return ;
	;
#endif
	Depth++;
	estkglobal(Level,Offset,AdId,Props);
	Depth--;
}	/* estkpar  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkparind(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks an indirect parameter operand                                **/
	/*************************************************************************/
	estkpar(Level,Offset,AdId,ADDRESSSIZE);
	erefer(0,Props);
}	/* estkparind  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetstructresult(int offset,int size,int align) {
	/*************************************************************************/
	/** Tells the code generator where the space on stack for a structure   **/
	/** result has been allocated.                                          **/
	/** Align is 1,2,4 or 8 bytes.                                               */
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("esetstructresult");
		printf("Off=%2d Size=%d align=%d\n",offset,size,align);
	}
#endif
	if (ProgFaulty!=0)  return ;
	CSetStructResult(STACKOffset+offset,size,align);
}	/* esetstructresult    */
/***/
void estructres(int size,int alignment) {
	/*************************************************************************/
	/** Generate code to create a struct result                             **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("estructres");
		printf("Size=%2d Align=%d\n",size,alignment);
	}
#endif
	/**/
	if (ProgFaulty!=0)  return ;
	/**/

#if(Target==SPARC)
	Depth++;
	estklit(size);
	Depth--;
	CCset=0;
	if (alignment==1) {
		Mexpcall(36);	/* .stret1 */
	} else if (alignment==2) {
		Mexpcall(37);	/* .stret2 */
	} else {
		Mexpcall(38);	/* .stret4 */
	};


#else
	Elevel-=1;
	CStructRes(&Stk [Elevel+1],size,alignment);

#endif

}	/* estructres  */
/***/
void estkresult(int Class,int Type,int Bytes) {
	/*************************************************************************/
	/** defines the result stacked by a function call                       **/
	/** Type = 1  int                                                       **/
	/**      = 2  real                                                      **/
	/**      = 3  uint                                                      **/
	/**      = 6  struct                                                    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkresult");
		printf("Class=%d Type=%d Size=%d\n",Class,Type,Bytes);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cstkresult(Type,Bytes);
}	/* Estkresult  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void erefer(int Offset,int Props) {
	/*************************************************************************/
	/** stacks the address of a direct operand                              **/
	/*************************************************************************/
	struct Stkfmt *Lstk;
	int bytes,type,stkprops;

	if ((Props&VOLBIT)!=0)  stkprops=STKVOL;
	else stkprops=0;
#if(AllowReverseEndianData!=0)
	if ((Props&REVENDIAN)!=0)  stkprops|=STKSWOPPED;
#endif
	Props&=~((VOLBIT|CONSTBIT)|REVENDIAN);
	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("erefer");
		printf("%2d %s %d",Offset,Typetext [type],bytes);
		if ((stkprops&VOLBIT)!=0)  printf("    [volatile]");
#if(AllowReverseEndianData!=0)
		if ((stkprops&STKSWOPPED)!=0)  printf(" [Swopped]");
#endif
		printf("\n");
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel<1)  Mabort(62);	/* erefer requires operand */
	Lstk=&Stk [Elevel];
	if ((Target!=PENTIUM)&&(type==RealType)&&(bytes>=8)&&((Lstk->Form==AddrDir)||(Lstk->Form==AddrDirMod
	    ))&&((((Lstk->Offset+Offset)&7))!=0)) {
		type=MisRealType;
	}
	Crefer(Lstk,Offset,bytes);
	Lstk->Size=bytes;
	Lstk->Type=type;

#if(AllowReverseEndianData>0)
	Lstk->Flags=(Lstk->Flags&(STKBSSWOPPED|STKIXSWOPPED))|stkprops;
#endif
}	/* erefer    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/

#if((Language==PASCAL)||(Language==MODULA))
void ebitsrefer(int FieldOffset,int FieldSize) {
	/*************************************************************************/
	/** stacks a descriptor for a bit-packed field                          **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("ebitsrefer");
		printf("%7d %7d\n",FieldOffset,FieldSize);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	CBitsRefer(FieldOffset,FieldSize);
};	/*ebitsrefer*/
#endif	/* %if Language=PASCAL %or Language=MODULA */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void epromote(int Level) {
	/*************************************************************************/
	/** move the entry at Level in Estack to the top of the Estack          **/
	/**  - the top entry is at level 1                                      **/
	/*************************************************************************/
	struct Stkfmt E;
	int I;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("epromote");
		printf("%5d\n",Level);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	if (!((0<Level)&&(Level<=Elevel)))  Mabort(63);	/* Inconsistent E-stack */
	if (Level==1)  return ;
	Level=(Elevel-Level)+1;
	E=Stk [Level];
	Cresetreguse(Level,Elevel+1);	/* to avoid problems                          */
	for (I=Level; I<=Elevel-1; I++) {
		Stk [I]=Stk [I+1];
		Cresetreguse(I+1,I);
	}
	Stk [Elevel]=E;
	Cresetreguse(Elevel+1,Elevel);
}	/* epromote  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edemote(int Level) {
	/*************************************************************************/
	/** move the entry at the top of the Estack to Level in Estack          **/
	/**  - the top entry is at level 1                                      **/
	/*************************************************************************/
	struct Stkfmt E;
	int I;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edemote");
		printf("%5d\n",Level);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	if (!((0<Level)&&(Level<=Elevel)))  Mabort(63);	/* Inconsistent E-stack */
	if (Level==1)  return ;
	Level=(Elevel-Level)+1;
	E=Stk [Elevel];
	Cresetreguse(Elevel,Elevel+1);	/* to avoid problems                         */
	for (I=Elevel; I>=Level+1; I--) {
		Stk [I]=Stk [I-1];
		Cresetreguse(I-1,I);
	}
	Stk [Level]=E;
	Cresetreguse(Elevel+1,Level);
}	/* Edemote   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkaddr(int Area,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks the address of a direct operand                              **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int bytes,type;

	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkaddr");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Area>>8]);
		printf("%s + %d %s %d",egivename(Area),Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	Depth++;
	estkdir(Area,Offset,AdId,Props);
	eop(EADDRESS);
	Depth--;
}	/* Estkaddr  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkgaddr(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks the address of a global operand                              **/
	/*************************************************************************/
	int bytes,type;

	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkgaddr");
		printf("Lev=%d Off=%d %s Size=%d",Level,Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	Depth++;
	estkglobal(Level,Offset,AdId,Props);
	eop(EADDRESS);
	Depth--;
}	/* Estkgaddr */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkpaddr(int Level,int Offset,char *AdId,int Props) {
	/*************************************************************************/
	/** stacks the address of a parameter operand                           **/
	/*************************************************************************/
	int bytes,type;

	bytes=(unsigned)(Props<<8)>>8;
	type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkpaddr");
		printf("Lev=%d Off=%d %s Size=%d",Level,Offset,Typetext [type],bytes);
		if (AdId!=0) {
			printf("    ");
			printid(AdId);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	Depth++;
	estkpar(Level,Offset,AdId,Props);
	eop(EADDRESS);
	Depth--;
}	/* Estkpaddr */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecstkprocaddr(char * S) {
	/*************************************************************************/
	/** stacks the address of a procedure                                   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkprocaddr");
		printf("%s\n",S);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mgetprocaddr(S);
}	/* Estkprocaddr*/
void estkprocaddr(int maxlen, char *impstring) {
	ecstkprocaddr(eimpstringtoc(impstring));
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void esetcontexts(int contexts) {
	/*********************************************************************************/
	/* This routine allows a compiler front end to tell the code generator       */
	/* the contexts in which subsequent E-code operations are to be compiled.    */
	/**/
	/* Each bit position in 'contexts' represents a different context and        */
	/* a 1-bit in any position switches that context 'on'.  A 0-bit leaves       */
	/* its context unchanged.                                                    */
	/**/
	/* The only contexts currently defined are:                                  */
	/**/
	/*    CXTnoalias = X'00000001'                                               */
	/**/
	/*      In this context loads and stores are guaranteed not to interfere     */
	/*      and so may be freely rescheduled.                                    */
	/**/
	/*    CXTnoreuse = X'00000002'                                               */
	/**/
	/*      In this context general floating point operands (not FregVars)       */
	/*      are not expected to be reused and a code generator for a machine     */
	/*      with a small number of floating point registers may choose to        */
	/*      use for the destination of an operation the same register as         */
	/*      it uses for one of the operands.                                     */
	/**/
	/*    CXToverlap = X'00000004'                                               */
	/**/
	/*      In this context the loads and stores in adjacent instances of an unrolled*/
	/*      loop are guaranteed not to interfere and so may be freely rescheduled.*/
	/**/
	/*********************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("esetcontexts"); printf(" %x\n",contexts);
	}
#endif

	CChangeContexts(contexts,0);

}	/* esetcontexts */
/***/
void eunsetcontexts(int contexts) {
	/*********************************************************************************/
	/* This is the complementary routine to E Set Contexts.  Each 1-bit          */
	/* in 'contexts' switches its associated context 'off'.  Each 0-bit          */
	/* leaves its context unchanged.                                             */
	/*********************************************************************************/

#if(increports!=0)
	if (Report!=0) {
		checkrecur("EunsetContexts"); printf(" %x\n",contexts);
	}
#endif

	CChangeContexts(0,contexts);

}	/* EUnsetContexts */
/***/
void epredictjump(int Flag) {
	/*************************************************************************/
	/** Used by the compiler to predict the outcome for the forthcoming     **/
	/** EJUMP, EDECRJUMP or EINCRJUMP                                       **/
	/**                                                                     **/
	/** Flag = 0  => the Jump will probably NOT be taken                    **/
	/** Flag = 1  => the Jump will probably be taken                        **/
	/** (any other value means dont know)                                   **/
	/*************************************************************************/
	int I;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("EpredictJump");
		printf("%3d\n",Flag);
	}
#endif
	if (Flag==0)  I=1;
	else if (Flag==1)  I=2;
	else I=-1;
	;
	JumpPredictFlag=I;
}	/* EpredictJump  */
/***/
/**/
/* Copyright (c) 1991 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int ecsetfiles(char * source, char * object, int flag) {
	/*************************************************************************/
	/* interface ro psetfiles2. Creates obj file unless flag=1 Sytaxcheck    */
	/* returns descriptor to objectfile or -1 (could not create)             */
	/* or 0 if syntax check only                                             */
	/*************************************************************************/

	return psetfiles2(source,object,flag);
}

int esetfiles (int max1, char * impsource, int max2, char * impobject, int flag){
	/*************************************************************************/
	/* version of above but with imp strings                                 */
	/*************************************************************************/
	char source[256];
	char object[256];

	strcpy(source,eimpstringtoc(impsource));
	strcpy(object,eimpstringtoc(impobject));
	return ecsetfiles(source,object,flag);
}

void einitreg(int base) {
	/*************************************************************************/
	/** Used by FORTRAN or USL C optimiser to initialise basereg            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Einitreg");
		printf("%5d\n",base);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cinitreg(base);
}	/* Einitreg  */
/***/
void eclaimregvar(int LogReg) {
	/*************************************************************************/
	/** used by optimiser to notify its use of a register                   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		if (Depth>0)  printf("recursive ");
		printf("EClaimRegVar %d\n",LogReg);
	}
#endif
	allocregvar(LogReg);
}	/* EClaimRegVar*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int eclaimcsereg(int Props,int Calls) {
	/*************************************************************************/
	/** Return a suitable register (pair) for front-end to use temporarily  **/
	/** for holding a CSE or return -1 if none is available.                **/
	/** 'Calls' is > 0 if the region of code over which the CSE is live     **/
	/** contains function call(s) -- may influence choice of register.      **/
	/*************************************************************************/
	int Reg,Bytes,Type;
	Bytes=(unsigned)(Props<<8)>>8;
	Type=(unsigned)Props>>24;
#if(increports!=0)
	if (Report!=0) {
		if (Depth>0)  printf("recursive ");
		printf("EClaimCSEReg  %s Size=%d Calls=%d \n",Typetext [Type],Bytes,Calls);
	}
#endif
	Reg=alloccsereg(Type,Bytes,Calls);
#if(increports!=0)
	if (Report!=0) {
		printf("... returns reg %d\n",Reg);
	}
#endif
	return Reg;
}	/*EClaimCSEReg*/
/***/
void efreecsereg(int Reg) {
	/*************************************************************************/
	/** Give back a previously-claimed CSE register to the code generator.  **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		if (Depth>0)  printf("recursive ");
		printf("Efreecsereg  %d\n",Reg);
	}
#endif
	freecsereg(Reg);
}	/*Efreecsereg*/
/***/
void eincreg(int base) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to increment basereg                      **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eincreg");
		printf("%5d\n",base);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cincreg(base);
}	/* Eincreg   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edecreg(int base) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to decrement basereg                      **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edecreg");
		printf("%5d\n",base);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cdecreg(base);
}	/* Edecreg   */
/***/
void eincregbylit(int base,int val,int size,int type) {
	/*************************************************************************/
	/** used by optimiser to increment basereg                              **/
	/** does not establish logical or touch CC                              **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		if (Depth>0)  printf("recursive ");
		printf("Eincreg %d bylit %d   %s Size=%d\n",base,val,Typetext [type],size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cincregbylit(base,val,size,type);
}	/* Eincregbylit */
/***/
void epassfregmask(int Mask) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to reserve floating point registers. The  **/
	/** mask has a bit set for each register to be used in the forthcoming  **/
	/** block.                                                              **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EpassFregMask"); printf(" %x\n",Mask);
	}
#endif
	CpassFregMask(Mask);
}	/* EpassFregMask */
/***/
void epassgregmask(int Mask) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to reserve floating point registers. The  **/
	/** mask has a bit set for each register to be used in the forthcoming  **/
	/** block.                                                              **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EpassGregMask"); printf(" %x\n",Mask);
	}
#endif
	CpassGregMask(Mask);
}	/* EpassGregMask */
/***/

#if((Language==FORTRAN)||(Language==PSAL))
/***/
void estkregvar(int Reg,int Offset) {
	/*************************************************************************/
	/** Used FORTRAN optimiser to push a register variable onto the E-stack **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkregvar");
		printf("%3d",Reg);
		if (Offset!=0) {
			printf(" +");
			printf("%2d",Offset);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkregvar(Reg,4,Offset);
}	/* Estkregvar  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkreg(int reg,int Offset) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser                                           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkreg");
		printf("%5d",reg);
		if (Offset!=0) {
			printf(" +");
			printf("%2d",Offset);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkreg(reg,Offset);
}	/* Estkreg   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkfreg(int Freg,int Size) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser                                           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkfreg");
		printf("%d Size=%d\n",Freg,Size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkfreg(Freg,Size);
}	/* Estkfreg  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void estkfregvar(int Freg,int Size) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser                                           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkfregvar");
		printf("%d Size=%d\n",Freg,Size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkfregvar(Freg,Size);
}	/* Estkfregvar */
/***/

#if(Directcomplex==1)
void estkdcmplxvar(int Rreg,int Ireg,int Size) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser when direct complexes available           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkdcmplxvar");
		printf("R=%d  I=%d Size=%d\n",Rreg,Ireg,Size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstackcmplxfr(Rreg,Ireg,Size);
}	/* Estkdcmplxvar                                                           */

#endif
/***/
void estkbaseindex(int base,int indexreg,int Offset,int Props) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to nominate an item by                    **/
	/** basereg[+index][+offset] either index or offset will be zero        **/
	/*************************************************************************/
	int Type,Size;

	Size=((unsigned)Props<<8)>>8;
	Type=(unsigned)(Props&(~REVENDIAN))>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkbaseindex");
		printf("%5d",base);
		if (indexreg!=0) {
			printf(",%d",indexreg);
		}
		if (Offset!=0) {
			printf(" +%2d",Offset);
		}
		printf(" %s  %d\n",Typetext [Type],Size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkbaseindex(base,indexreg,Offset,Size,Type,1);
#if(AllowReverseEndianData!=0)
        if ((Props&REVENDIAN)!=0)  Stk [Elevel].Flags|=STKSWOPPED;
#endif
}	/* Estkbaseindex */
/***/
void estkbasescaledindex(int base,int indexreg,int Offset,int Scale,int Props) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to nominate an item by                    **/
	/** basereg[+index][+offset] either index or offset will be zero and    **/
	/** the other should be scaled                                          **/
	/*************************************************************************/
	int Type,Size;
	Size=((unsigned)Props<<8)>>8;
	Type=(unsigned)(Props&(~REVENDIAN))>>24;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkbasescaledindex");
		printf("%5d",base);
		if (indexreg!=0) {
			printf(",%1d",indexreg);
		}
		if (Offset!=0) {
			printf(" +%d",Offset);
		}
		printf(" scaled by %d %s %d\n",Scale,Typetext [Type],Size);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Cstkbaseindex(base,indexreg,Offset,Size,Type,Scale);
#if(AllowReverseEndianData!=0)
        if ((Props&REVENDIAN)!=0)  Stk [Elevel].Flags|=STKSWOPPED;
#endif
}	/* Estkbasescaledindex */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eregtarget(int Reg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to nominate the preferred target for next **/
	/** integer operation                                                   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eregtarget");
		printf("%5d\n",Reg);
	}
#endif
	Cregtarget(Reg);
}	/* Eregtarget  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void efregtarget(int Freg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to nominate the preferred target for next **/
	/** real operation                                                      **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Efregtarget");
		printf("%5d\n",Freg);
	}
#endif
	Cfregtarget(Freg);
}	/* Efregtarget */
/***/
int enumregs() {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to enquire how many regs available to     **/
	/** allocate                                                            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Enumregs");
		printf("\n");
	}
#endif
	return Cnumregs();
}	/* Enumregs                                                                */
/***/
/**/
/* Copyright (c) 1991 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void elockreg(int reg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to notify its use of a register           **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Elockreg");
		printf("%5d\n",reg);
	}
#endif
}	/* Elockreg                                                                */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eunlockreg(int reg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to notify that its use of a register is   **/
	/** complete                                                            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eunlockreg");
		printf("%5d\n",reg);
	}
#endif
}	/* Eunlockreg                                                              */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void elockfreg(int freg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to notify its use of a floating point     **/
	/** register                                                            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Elockfreg");
		printf("%5d\n",freg);
	}
#endif
}	/* Elockfreg                                                               */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eunlockfreg(int freg) {
	/*************************************************************************/
	/** Used by FORTRAN optimiser to notify that its use of a floating      **/
	/** point register is complete                                          **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eunlockfreg");
		printf("%5d\n",freg);
	}
#endif
}	/* Eunlockfreg                                                             */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eincrjump(int reg,int Opcode,int Labelid) {
	/**************************************************************************/
	/** FORTRAN: Increment reg by top of Estack and jump to Labelid using    **/
	/** Opcode which is an Eop in the range JINTGZ...JINTLEZ                 **/
	/**************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eincrjump");
		printf("Reg=%d  %s %d\n",reg,Opname(Opcode),Labelid);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cincrjump(reg,Opcode,Labelid);
}	/* Eincrjump                                                               */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edecrjump(int reg,int Opcode,int Labelid) {
	/**************************************************************************/
	/** FORTRAN: Decrement reg by top of Estack and jump to Labelid using    **/
	/** Opcode which is an Eop in the range JINTGZ...JINTLEZ                 **/
	/**************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edecrjump");
		printf("Reg=%d  %s %d\n",reg,Opname(Opcode),Labelid);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cdecrjump(reg,Opcode,Labelid);
}	/* Edecrjump                                                               */

/* %if Language=FORTRAN */

#endif
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecjump(int Opcode,int Labelid) {
	/*************************************************************************/
	/** Jumps with register freeing. If Opcode is JFALSE or JUMP then a     **/
	/** jump is made to Labelid otherwise a jump is made to (Labelid+1).    **/
	/*************************************************************************/

#if(increports!=0)
	if (Report!=0) {
		checkrecur("ECJump");
		printf("%s  %d\n",Opname(Opcode),Labelid);
		Cdumpestack();
	}
#endif

	if (ProgFaulty!=0)  return ;

	if (Opcode==JUMP) {
		if ((CCset!=0) && (CCest==0)) Cestablishlogical();
		freeregs();
		if (Labelid>0)  Cjump(Icompare|ALWAYS,Labelid,0);
		return ;
	}

#if(Language==CCOMP)
	{
	double lzero;
	float nzero;
	Depth++;
	if ((CCset==0)||(CCest!=0)) {
		if (Elevel<1)  Mabort(73);	/* ECJump requires an operand */
		if ((Stk [Elevel].Type!=RealType)&&(Stk [Elevel].Type!=MisRealType)) {
			estklit(0);
			eop(INE);
			/* otherwise we have to compare*/
		} else {
			if (Stk [Elevel].Size==4) 	/* with a real 0.0, to allow 0.5*/{
				nzero= 0.0;	/* and so on to be evaluated as*/
				estkrconst(4,(int)&nzero)	/* TRUE*/;
			} else {
				lzero= 0.0;
				estkrconst(8,(int)&lzero);
			}
			eop(RNE);
		}
	}
	freeregs();
	if (Opcode==JFALSE) {
		CLogStk(7,Labelid);
		Creversedjump(ereadcc(),Labelid,0);
	} else {
		CLogStk(7,Labelid+1);
		Cjump(ereadcc(),Labelid+1,0);
	}
	Depth--;
	}
#endif
}	/* ECJump    */
/***/

#if(Language==CCOMP)
/***/
void estkregvar(int Reg,int Size,int Offset) {
	/*************************************************************************/
	/** Used by C and C++ optimiser to push a register variable onto the    **/
	/** E-stack.                                                            **/
	/*************************************************************************/
	int Type;

	Type=(unsigned)Size>>24;
	Size=(unsigned)(Size<<8)>>8;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Estkregvar");
		printf("Reg=%d   Size=%d %s",Reg,Size,Typetext [Type]);
		if (Offset!=0) {
			printf("  +");
			printf("%2d",Offset);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel>=Stklimit)  EstkOverflow();
	if (CCset!=0 && CCest==0)  Cestablishlogical();

	if ((Type==RealType)||(Type==MisRealType)) {
		Cstkfregvar(Reg,Size);
	} else {
		Cstkregvar(Reg,Size,Offset);
	}

	Stk [Elevel].Type=Type;

}	/* Estkregvar  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void etarget(int Reg) {
	/**************************************************************************/
	/** Used by C and C++ optimiser to nominate the preferred target for an  **/
	/** operation. If the given logical register is zero or negative then    **/
	/** the current target registers are forgotten. Bit 7 is used as a flag  **/
	/** to indicate that the target is unpaired and is involved in a         **/
	/** coercion from a paired to a single register. If this flag is set     **/
	/** then we have to be careful not to consider the target as pairable.   **/
	/** If the given register number is 127 then this represents a pseudo    **/
	/** register designed to hold the result of a questionmark-colon         **/
	/** expression.                                                          **/
	/**************************************************************************/
	int TReg;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Etarget");
		printf("%5d",Reg&0x7F);
		if (Reg>127)  printf("    Double to Single");
		printf("\n");
	}
#endif
	/**/
	TargetReg=-1;
	TargetFreg=-1;
	FirstTarget=1;
	TargetDToS=0;
	/**/
	if (Reg>0) {
		TargetDToS=((unsigned)Reg>>7)&1;
		CTarget(Reg&0x7F);
	}
}	/* Etarget   */
/***/
void elogneg() {
	/*************************************************************************/
	/** Special logical inversion for C and C++. If the condition codes are **/
	/** set then the condition is merely inverted, otherwise the value on   **/
	/** the top of the E-stack is compared with zero.                       **/
	/*************************************************************************/
	float nzero;
	double lzero;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("ELogNeg");
		printf("\n");
		Cdumpestack();
	}
#endif

	if (ProgFaulty!=0)  return ;

	if (CCset!=0 && CCest==0) {
		/**/
		/* if condition already set then we just have to invert it */

#if((Target==MIPS)||(Target==SPARC)||(Target==PENTIUM))
		CondCode=CinvertCC(CondCode);

#else
		CondCode=(CondCode&0xF00)|Falsecc [CondCode&0xFF-(GT)];

#endif
		/**/
	} else {
		/**/
		Depth++;
		if (Elevel<1)  Mabort(71);	/* ELogNeg requires an operand */
		if ((Stk [Elevel].Type!=RealType)&&(Stk [Elevel].Type!=MisRealType)) {
			estklit(0);
			eop(IEQ);
			/* We have to compare with a     */
		} else {
			if (Stk [Elevel].Size==4) 	/* real 0.0, to allow 0.5 and so */{
				nzero= 0.0;	/* on to be evaluated as TRUE,   */
				estkrconst(4,(int)&nzero)	/* and thus !FALSE               */;
			} else {
				lzero= 0.0;
				estkrconst(8,(int)&lzero);
			}
			eop(REQ);
		}
		Depth--;
		/**/
	}
}	/* ELogNeg   */
/***/
#if Language==CCOMP
void eLogStk(int Option,int Label) {
	/*************************************************************************/
	/** This routine handles the exit sequence from conditional jumping     **/
	/** code. Option 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)                **/
	/*************************************************************************/
	float nzero;
	double lzero;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("ELogStk");
		printf("Option=%d Label=%d\n",Option,Label);
		Cdumpestack();
	}
#endif

	if (ProgFaulty!=0)  return ;

	if (Option==0) {
		Depth++;
		if ((CCset==0)||(CCest!=0)) {
			if (Elevel<1)  Mabort(72);	/* ELogStk requires an operand */
			if ((Stk [Elevel].Type!=RealType)&&(Stk [Elevel].Type!=MisRealType)) {
				estklit(0);
				eop(INE);
				/* We have to compare with a  */
			} else {
				if (Stk [Elevel].Size==4) 	/*  real 0.0, to allow 0.5    */{
					nzero= 0.0;	/* and so on to be evaluated  */
					estkrconst(4,(int)&nzero)	/* as TRUE                    */;
				} else {
					lzero= 0.0;
					estkrconst(8,(int)&lzero);
				}
				eop(RNE);
			}
		}
		Depth--;
	}
	CLogStk(Option,Label);
}	/* ELogStk     */
/***/

#endif
#if(Target!=RS6)
/***/
void eqccontrol(int Mode,int Size) {
	/**************************************************************************/
	/** C and C++: E-machine interface for Questionmark colon constructs.    **/
	/** Handles allocation of result registers for such constructs.          **/
	/**************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EQCcontrol");
		printf("Mode=%d Size=%d\n",Mode,Size);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Mode!=1)&&(CCset!=0)&&(CCest==0))  Cestablishlogical();
	CQCcontrol(Mode,Size);
};	/* EQCcontrol                                                              */
/***/

#endif
/***/
/* %if Language=CCOMP */
;
#endif
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void epsave(int *Base) {
	/*************************************************************************/
	/** Saves the base address held in (Etos)                               **/
	/*************************************************************************/
	int I;
	struct Stkfmt S;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Epsave");
		printf("\n");
	}
#endif
	if (ProgFaulty!=0) {
		*Base=0;
		return ;
	}
	if (Elevel<1)  Mabort(64);	/* Epsave requires operand */
	memset(&S,0,sizeof( struct Stkfmt));
	I=*Base;	/* Epsave: Base must be positive */
	if (I<=0)  Mabort(70);
	S.Form=DirVal;
	S.Base=STACK;
	S.Offset=I+PARAMOffset;
	S.Size=ADDRESSSIZE;
	Cpushoperand(&S);
	Depth++;
	eop(ESTORE);
	Depth--;
	*Base=I;
}	/* Epsave    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eprestore(int Base) {
	/*************************************************************************/
	/** Restores the saved base address into (Etos)                         **/
	/*************************************************************************/
	struct Stkfmt S;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eprestore");
		printf("%2d\n",Base);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	memset(&S,0,sizeof( struct Stkfmt));
	S.Form=DirAddr;
	S.Base=STACK;
	S.Offset=Base+PARAMOffset;
	S.Size=ADDRESSSIZE;
	Cpushoperand(&S);
}	/* Eprestore   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void evsave(int *Base) {
	/*************************************************************************/
	/** Saves the value held in (Etos)                                      **/
	/*************************************************************************/
	int I,Reg;
	struct Stkfmt S;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Evsave");
		printf("\n");
	}
#endif
	if (ProgFaulty!=0) {
		*Base=0;
		return ;
	}
	if (Elevel<1)  Mabort(65);	/* Evsave requires operand */
	memset(&Stk [Elevel],0,sizeof( struct Stkfmt));
	Stk [Elevel].Form=RegVal;
	Stk [Elevel].Reg=Reg;
	Stk [Elevel].Size=ADDRESSSIZE;
	memset(&S,0,sizeof( struct Stkfmt));
	I=NewTemp(4);
	S.Form=DirVal;
	S.Base=STACK;
	S.Offset=I;
	S.Size=ADDRESSSIZE;
	Cpushoperand(&Stk [Elevel]);
	Cpushoperand(&S);
	Depth++;
	eop(ESTORE);
	Depth--;
	*Base=I;
}	/* Evsave      */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void evrestore(int Base) {
	/*************************************************************************/
	/** Pushes the saved value as (Etos)                                    **/
	/*************************************************************************/
	struct Stkfmt S;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Evrestore");
		printf("%2d\n",Base);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	memset(&S,0,sizeof( struct Stkfmt));
	S.Form=DirVal;
	S.Base=STACK;
	S.Offset=Base;
	S.Size=ADDRESSSIZE;
	Cpushoperand(&S);
}	/* Evrestore   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**                 **********************/
/**                 *  Labels, Jumps    **/
/**                 **********************/
/***/
/***/
void elabel(int Id) {
	/*************************************************************************/
	/** register a label                                                    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Elabel");
		printf("%5d\n",Id);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Elevel>0)&&(Language!=FORTRAN)&&(Language!=CCOMP)&&(Language!=PSAL))  Mabort(66);
	Mlabel(Id);
}	/* Elabel   */
void eonetimeLabel(int Id) {
	/*************************************************************************/
	/** register a label that is jumped to exactly once                     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EonetimeLabel");
		printf("%5d\n",Id);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Elevel>0)&&(Language!=FORTRAN)&&(Language!=CCOMP)&&(Language!=PSAL))  Mabort(66);

#if(Target==RS6)
	MonetimeLabel(Id);

#else
	Mlabel(Id);

#endif
}	/* Elabel   */
/***/
/***/
void efrlabel(int Id,int Usecount) {
	/*************************************************************************/
	/** register a label that has been used for a forward ref               **/
	/** Usecount is number of unfilled jumps (normally one)                 **/
	/** This gives code generator a chance to merge environments if like    **/
	/** RS6000 it has a large register set                                  **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EfrLabel");
		printf("%5d Uses=%d\n",Id,Usecount);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if ((Elevel>0)&&(Language!=FORTRAN)&&(Language!=CCOMP)&&(Language!=PSAL))  Mabort(66);
	Mfrlabel(Id,Usecount);
}	/* EfrLabel */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eplabel(int Id) {
	/*************************************************************************/
	/** register a private label                                            **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eplabel");
		printf("%5d\n",Id);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mplabel(Id);
}	/* Eplabel  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void euchecklab(int Labid) {
	Unasslab=Labid;
}	/* Euchecklab  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eboundlab(int Labid) {
	Boundlab=Labid;
}	/* Eboundlab   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ejump(int Opcode,int Labelid) {
	/*************************************************************************/
	/** generate specified conditional or unconditional jump                **/
	/*************************************************************************/
	int ClearRegs;
	struct Stkfmt Zero;
	Zero=Litzero;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ejump");
		printf("%s L%5d\n",Opname(Opcode),Labelid);
		Cdumpestack();
	}
#endif

	if (ProgFaulty!=0)  return ;

	if (Opcode==CJFALSE) {
		Opcode=JFALSE;
		ClearRegs=1;
	} else if (Opcode==CJTRUE) {
		Opcode=JTRUE;
		ClearRegs=1;
	} else {
		ClearRegs=0;
	};

	if (CCset!=0 && CCest==0) {
		if (Opcode==JINTZ)  Opcode=JFALSE;
		if (Opcode==JINTNZ)  Opcode=JTRUE;
		if (Opcode<JTRUE)  Cestablishlogical();
	}
	switch (Opcode) {
		/***/
	default:
		Mabort(56);
		/***/
	case JIGT:
	case JILT:
	case JIEQ:
	case JINE:
	case JIGE:
	case JILE:
		if (Elevel<2)  LowEstack(Opcode,2);
		Elevel-=2;
		Cjumpcond(Icompare|(Opcode-JIGT),&Stk [Elevel+1],&Stk [Elevel+2],Labelid);
		return ;
		/***/
	case JUGT:
	case JULT:
	case JUEQ:
	case JUNE:
	case JUGE:
	case JULE:
		if (Elevel<2)  LowEstack(Opcode,2);
		Elevel-=2;
		Cjumpcond(UIcompare|(Opcode-JUGT),&Stk [Elevel+1],&Stk [Elevel+2],Labelid);
		return ;
		/***/
	case JINTGZ:
	case JINTLZ:
	case JINTZ:
	case JINTNZ:
	case JINTGEZ:
	case JINTLEZ:
		if ((CCavailable==Negative)||(Stk [Elevel].Size>4)) {
			Elevel+=1;
			Stk [Elevel]=Zero;
			Stk[Elevel].Size=Stk[Elevel-1].Size;
			Opcode+=JIGT-JINTGZ;
			{
				Depth++;
				ejump(Opcode,Labelid);
				Depth--;
				return;
			}
		}
		if (Elevel<1)  LowEstack(Opcode,1);
		Elevel-=1;
		Ctestval(Icompare,&Stk [Elevel+1]);
		Cjump((CCfield|Icompare)|(Opcode-JINTGZ),Labelid,0);
		return ;
		/***/
	case JUGTZ:
	case JULTZ:
	case JUEQZ:
	case JUNEZ:
	case JUGEZ:
	case JULEZ:
		if ((CCavailable==Negative)||(Stk [Elevel].Size>4)) {
			Elevel+=1;
			Stk [Elevel]=Zero;
			Stk[Elevel].Size=Stk[Elevel-1].Size;
			Opcode+=JUGT-JUGTZ;
			{
				Depth++;
				ejump(Opcode,Labelid);
				Depth--;
				return;
			}
		}
		if (Elevel<1)  LowEstack(Opcode,1);
		Elevel-=1;
		Ctestval(UIcompare,&Stk [Elevel+1]);
		Cjump((CCfield|UIcompare)|(Opcode-JUGTZ),Labelid,0);
		return ;
		/***/
	case JUMP:
		Cjump(Icompare|ALWAYS,Labelid,0)	/*unconditional*/;
		return ;
		/***/
	case JRGT:
	case JRLT:
	case JREQ:
	case JRNE:
	case JRGE:
	case JRLE:
		if (Elevel<2)  LowEstack(Opcode,2);
		Elevel-=2;
		Cjumpcond(Rcompare|(Opcode-JRGT),&Stk [Elevel+1],&Stk [Elevel+2],Labelid);
		return ;
		/***/
	case JRGZ:
	case JRLZ:
	case JRZ:
	case JRNZ:
	case JRGEZ:
	case JRLEZ:

#if(CCavailable==Negative)
		Zero.Size=Stk [Elevel].Size;
		Zero.Form=Flitval;
		Elevel+=1;
		Stk [Elevel]=Zero;
		Opcode+=JRGT-JRGZ;
		{
			Depth++;
			ejump(Opcode,Labelid);
			Depth--;
			return;
		};

#endif
		if (Elevel<1)  LowEstack(Opcode,1);
		Elevel-=1;
		Ctestval(Rcompare,&Stk [Elevel+1]);
		Cjump((CCfield|Rcompare)|(Opcode-JRGZ),Labelid,0);
		return ;
		/***/
	case JFALSE:
		if ((CCset==0)||(CCest!=0)) {
			if (Elevel<1)  LowEstack(Opcode,1);
			Elevel-=1;
			if (ClearRegs!=0)  freeregs();
			if (Stk [Elevel+1].Form==LitVal) {
				if (Stk [Elevel+1].Intvalue==0) {
					Cjump(Icompare|ALWAYS,Labelid,0);
				} else {
					Cjump(Icompare|NEVER,Labelid,0);
				}
			} else {
				Zero.Size=Stk [Elevel+1].Size;
				Cjumpcond(Icompare|EQ,&Stk [Elevel+1],&Zero,Labelid);
			}
		} else {
			if (ClearRegs!=0)  freeregs();
			Creversedjump(ereadcc(),Labelid,0);
		}
		return ;
		/***/
	case JTRUE:
		if ((CCset==0)||(CCest!=0)) {
			if (Elevel<1)  LowEstack(Opcode,1);
			Elevel-=1;
			if (ClearRegs!=0)  freeregs();
			if (Stk [Elevel+1].Form==LitVal) {
				if (Stk [Elevel+1].Intvalue!=0) {
					Cjump(Icompare|ALWAYS,Labelid,0);
				} else {
					Cjump(Icompare|NEVER,Labelid,0);
				}
			} else {
				Zero.Size=Stk [Elevel+1].Size;
				Cjumpcond(Icompare|NE,&Stk [Elevel+1],&Zero,Labelid);
			}
		} else {
			if (ClearRegs!=0)  freeregs();
			Cjump(ereadcc(),Labelid,0);
		}
		return ;
		/***/
	}	/* end switch */
}	/* Ejump     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/

#if(Language==FORTRAN)
/***/
void etwjump(int Opcode,int Lab1,int Lab2,int Lab3) {
	/*************************************************************************/
	/** generate the code for a FORTRAN three-way jump                      **/
	/** opcode = ITWB or RTWB for integer or real expression on Estack      **/
	/** Lab1,Lab2,Lab3 are the labels to jump to if Etos <0,=0,>0           **/
	/**  - if Labi <= 0 that jump is not required                           **/
	/*************************************************************************/
	int Type,Form,Ival,Lab,L1flags,L2flags,CondForm;
	double Lrval;
	float Rval;
	struct Stkfmt Zero;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("ETWjump");
		printf("%s ->  %d,%d,%d\n",Opname(Opcode),Lab1,Lab2,Lab3);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel<1)  LowEstack(Opcode,1);
	L1flags=0;
	L2flags=0;
	if (Lab2>0)  L2flags=2;
	if (Lab1>0)  L1flags=2;
	Zero=Litzero;
	Form=Stk [Elevel].Form;
	Elevel-=1;
	if (Opcode==ITWB) {
		Type=Icompare;
		if (Form==LitVal) {
			Ival=Stk [Elevel+1].Intvalue;
			if (Ival<0) {
				if (Lab1>0) {
					Lab=Lab1;
					goto jumpalways;
				}
			} else {
				if (Ival==0) {
					if (Lab2>0) {
						Lab=Lab2;
						goto jumpalways;
					}
				} else {
					if (Lab3>0) {
						Lab=Lab3;
						goto jumpalways;
					}
				}
			}
			return ;	/*jump never*/
		}
		CondForm=Icompare;
		/* Opcode=RTWB */
	} else {
		Type=Rcompare;
		if (Form==Flitval) {
			if (Stk [Elevel+1].Size==4) 	/*REAL*4*/{
				Rval=Stk [Elevel+1].Rval;
				if (Rval<0) {
					if (Lab1>0) {
						Lab=Lab1;
						goto jumpalways;
					}
				} else {
					if (Rval==0) {
						if (Lab2>0) {
							Lab=Lab2;
							goto jumpalways;
						}
					} else {
						if (Lab3>0) {
							Lab=Lab3;
							goto jumpalways;
						}
					}
				}
				return ;	/*jump never*/
				/*REAL*8*/
			} else {
				Lrval=Stk [Elevel+1].Rlval;
				if (Lrval<0) {
					if (Lab1>0) {
						Lab=Lab1;
						goto jumpalways;
					}
				} else {
					if (Lrval==0) {
						if (Lab2>0) {
							Lab=Lab2;
							goto jumpalways;
						}
					} else {
						if (Lab3>0) {
							Lab=Lab3;
							goto jumpalways;
						}
					}
				}
				return ;	/*jump never*/
			}
		}
		CondForm=Rcompare;
		Zero.Form=Flitval;
		Zero.Size=Stk [Elevel+1].Size;
	}

#if(CCavailable==Positive)
	Ctestval(CondForm,&Stk [Elevel+1]	/*set CC for typed value*/);
	if (Lab3>0)  Cjump((CCfield|Type)|GT,Lab3,L2flags|L1flags);
	if (Opcode==ITWB) {
		if (Lab2>0) {
			/*    = 0                                                                    */
			Cjump((CCfield|Type)|EQ,Lab2,L1flags);
		}
		if (Lab1>0)  Cjump((CCfield|Type)|LT,Lab1,0);	/*    < 0                      */
	} else {
		if (Lab1>0) {
			/*    < 0                                                                    */
			Cjump((CCfield|Type)|LT,Lab1,L2flags);
		}
		if (Lab2>0)  Cjump((CCfield|Type)|EQ,Lab2,0);	/* fp = less likely */
		/*    = 0 */
	}
	return ;

#else
	Elevel+=1;
	eop(EVAL);
	if (Lab3>0) {
		if ((Lab2>0)||(Lab1>0))  eop(DUPL);
		Cjumpcond(CondForm|GT,&Stk [Elevel],&Zero,Lab3);
		Elevel-=1;
	}
	if (Lab1>0) {
		if (Lab2>0)  eop(DUPL);
		Cjumpcond(CondForm|LT,&Stk [Elevel],&Zero,Lab1);
		Elevel-=1;
	}
	if (Lab2>0) {
		Cjumpcond(CondForm|EQ,&Stk [Elevel],&Zero,Lab2);
		Elevel-=1;
	}
	return ;

#endif

jumpalways:

	Cjump(Type|ALWAYS,Lab,0);
}	/* ETWjump                                                                 */
/***/
/* %if Language=FORTRAN */

#endif
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
static int safedifference(int upper,int lower) {
	/*************************************************************************/
	/**    Computes range for switches returns hugh if overflow             **/
	/**    Needed for C who can switch from -maxint to +maxint              **/
	/*************************************************************************/
	double ru,rl,rd;
	ru=(double)upper;
	rl=(double)lower;
	rd=ru-rl;
	if (rd>0x7FFFFFF0)  return 0x7FFFFFF0;
	return upper-lower;	/*exact and cant overflow                               */
}
/***/
void eswitch(int Lower,int Upper,int Switchid,int Errlabid,int *SSTad) {
	/*************************************************************************/
	/** define a switch Switchid to be indexed in the range (Lower:Upper)   **/
	/** space may be claimed from SST for the switch table                  **/
	/*************************************************************************/
	int i;


#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eswitch");
		printf(" %d:%d  Id=%d Errs->%d\n",Lower,Upper,Switchid,Errlabid);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();

#if(Language==CCOMP)
	{
	int range,actentries;
	/**/
	/* For C upper&lower define range but errlabid has actual no of entries      */
	/* Since there is no error lab in C It justfalls thro                        */
	/* Hence can deduce whether to use sparse or dense mechanisms                */
	/**/
	if (Elevel<1)  LowEstack(JUMP,1);
	Elevel-=1;
	range=safedifference(Upper,Lower)+1;
	actentries=Errlabid;
	if ((actentries<=3)||((range/actentries)>8))  range=-actentries;	/*negative range will force SPARSE*/
	Mfswitch(Lower,range,Switchid,Switchid,&Stk [Elevel+1]);
	/*define and jump     */

	}
#else
	if (Lower>Upper) 	/*switch off Switch Bound Check*/{
		i=Lower;
		Lower=Upper;
		Upper=i;
		Errlabid=-1;
	}
	Mswitch(0,Lower,(Upper-Lower)+1,Switchid,Errlabid);

#endif
}	/* Eswitch     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void efswitch(int Lower,int Upper,int Switchid,int Errlabid,int *SSTad) {
	/*************************************************************************/
	/** define a switch Switchid to be indexed in the range (Lower:Upper)   **/
	/** and jump to it: if Errlabid is not set to minus 1, perform range    **/
	/** checking.                                                           **/
	/** space may be claimed from SST for the switch table                  **/
	/*************************************************************************/
	int diff;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Efswitch");
		printf(" %d:%d  Id=%d Errs->%d\n",Lower,Upper,Switchid,Errlabid);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	if (Elevel<1)  LowEstack(JUMP,1);
	Elevel-=1;

	/* Form difference between Upper and Lower ensuring that we do not */
	/* generate an overflow.                                           */
	diff=safedifference(Upper,Lower);
	Mfswitch(Lower,diff+1,Switchid,Errlabid,&Stk [Elevel+1]);
}	/* Efswitch    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eswitchjump(int Switchid) {
	/*************************************************************************/
	/** jump to Switchid( (Etos) )                                          **/
	/** if (Etos) is outside the bounds defined for Switchid then error     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eswitchjump");
		printf("%5d\n",Switchid);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel<1)  LowEstack(JUMP,1);
	Elevel-=1;
	Mswitchjump(Switchid,&Stk [Elevel+1]);
}	/* Eswitchjump */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void efswitchjump2(int Switchid) {
	/*************************************************************************/
	/** jump to Switchid( (Etos) ) - dont do range checking before jumping  **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Efswitchjump2");
		printf("%5d\n",Switchid);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel<1)  LowEstack(JUMP,1);
	Elevel-=1;
	Cfswitchjump(Switchid,&Stk [Elevel+1]);
}	/* Efswitchjump2*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eswitchentry(int Switchid,int Entry) {
	/*************************************************************************/
	/** define the current code address as Switchid(Entry)                  **/
	/*************************************************************************/

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eswitchentry");
		printf("%5d %d\n",Switchid,Entry);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mswitchentry(Switchid,Entry);
}	/* Eswitchentry */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eswitchdef(int Switchid) {
	/*************************************************************************/
	/** define the current code address as Switchid(*) - the default        **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eswitchdef");
		printf("%5d\n",Switchid);
	}
#endif
}	/* Eswitchdef  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eswitchlabel(int Switchid,int Entry,int Labelid) {
	/*************************************************************************/
	/** define Labelid as Switchid(Entry)                                   **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eswitchlabel");
		printf("%5d Entry=%d Lba=%d\n",Switchid,Entry,Labelid);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mswitchlabel(Switchid,Entry,Labelid);
}	/* Eswitchlabel*/
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecasejump(int MinLab,int MaxLab,int ErrLab,int Entries,int CaseId,int *SSTad) {
	/*************************************************************************/
	/** Claim space for case-table for the range [MinLab..MaxLab] and plant **/
	/** code to jump into the table.                                        **/
	/*************************************************************************/
	int diff;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EcaseJump");
		printf("id=%d Min=%d Max=%d Entries=%d Default=%d\n",CaseId,
			MinLab,MaxLab,Entries,ErrLab);
		Cdumpestack();
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (Elevel<1)  LowEstack(JUMP,1);
	Elevel-=1;

	/* Form difference between MaxLab and Minlab ensuring that we do not */
	/* generate an overflow.                                             */
	diff=safedifference(MaxLab,MinLab);
	if ((Language==PASCAL)||(Language==MODULA)||(Entries<=1)||(Entries>(diff+1)))  Entries=diff+1;
	Mfswitch(MinLab,Entries,CaseId,ErrLab,&Stk [Elevel+1]);
}	/* EcaseJump   */
/***/
void ecaseentry(int Entry,int LabelId,int CaseId) {
	/*************************************************************************/
	/** Enter the code-address for case-table Entry associated with the     **/
	/** case-label LabelId of case-statement CaseId.                        **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("EcaseEntry");
		printf("Id=%d Entry %d -> Lab %d\n",CaseId,Entry,LabelId);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mswitchlabel(CaseId,Entry,LabelId);
}	/* EcaseEntry   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eglabel(int Labid,int Level,int Offset) {
	/*************************************************************************/
	/** Define a global label                                               **/
	/** notes: 1. this was once called EstmtLabel                           **/
	/**        2. This calls Elabel irrespective of whether the Language is **/
	/**           PASCAL-I or PASCAL-E (which calls Elabel for itself).     **/
	/**           This presents a common interface for the two strains.     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eglabel");
		printf("Lab %d %d %d\n",Labid,Level,Offset);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Depth++;
	elabel(Labid);
	Depth--;
	Maddrlabel(Labid,GLA,Offset);

#if((Target==MIPS)||(Target==PENTIUM))
	Cglabelcode();	/* Do anything which msut be done on reentry */

	;
#endif
}	/* Eglabel     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void egjump(int Level,int Offset) {
	/**************************************************************************/
	/** Jump to a label in a global stack-frame. The label address is held   **/
	/** at GLA + Offset                                                      **/
	/**************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Egjump");
		printf("%5d %5d\n",Level,Offset);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Cgjump(Level,Offset);
}	/* Egjump      */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**                ********************************/
/**                * Data initialisation, fixups **/
/**                ********************************/
/***/
/***/
void ed1(int area,int Disp,int Val) {
	/*************************************************************************/
	/** intialise an 8-bit location                                         **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int LowArea;

	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ed1");
		printf(" %s +%d   %x\n",egivename(area),Disp,Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;
	LowArea=area&0xFF;
	if (area>=FirstUserArea) {
		AreaBase [LowArea].AreaProps=AreaBase [LowArea].AreaProps|INITIALISED;
		area=AreaBase [LowArea].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pd(area,Disp,Val);
#endif
}	/* Ed1    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ed2(int area,int Disp,int Val) {
	/*************************************************************************/
	/** intialise a 16-bit location                                         **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int LowArea;

	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ed2");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
		printf(" %s +%d   %x\n",egivename(area),Disp,Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;
	LowArea=area&0xFF;
	if (area>=FirstUserArea) {
		AreaBase [LowArea].AreaProps=AreaBase [LowArea].AreaProps|INITIALISED;
		area=AreaBase [LowArea].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pd2(area,Disp,Val);
#endif
}	/* Ed2    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ed4(int area,int Disp,int Val) {
	/*************************************************************************/
	/** intialise a 32-bit location                                         **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int LowArea;

	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ed4");
		printf(" %s +%d   %x\n",egivename(area),Disp,Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;
	LowArea=area&0xFF;
	if (area>=FirstUserArea) {
		AreaBase [LowArea].AreaProps=AreaBase [LowArea].AreaProps|INITIALISED;
		area=AreaBase [LowArea].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pd4(area,Disp,Val);
#endif
}	/* Ed4    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edbytes(int area,int Disp,int len,int ad) {
	/*************************************************************************/
	/** intialise a block of data                                           **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int LowArea;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edbytes");
		printf(" Area: %d Offset=%x ",area,Disp);
		if ((ad&3)==0) {
			if (len==4)  printf("%x",(*(int  *)(ad)));
			if (len>=8) {
				printf("%x %x",(*(int  *)(ad)),(*(int  *)(ad+4)));
			}
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;
	if (area==10) {
		;
		imp_stop();
	}	/* should not be allocated any more            */
	LowArea=area&0xFF;
	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
	if (area>=FirstUserArea) {
		AreaBase [LowArea].AreaProps=AreaBase [LowArea].AreaProps|INITIALISED;
		area=AreaBase [LowArea].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pdbytes(area,Disp,len, (char *)ad);
#endif
}	/* Edbytes     */
/***/
int egetbytes(int Area,int Offset,int Len) {
	/*************************************************************************/
	/** locates the initialisation defined at displacement Offset within    **/
	/** area Area covering Len bytes                                        **/
	/**                                                                     **/
	/** returns 0 if the facility is unavilable or if no initialisation has **/
	/** been received for the specified location - otherwise returns the    **/
	/** address at which initialisation has been stored                     **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Egetbytes");
		printf("\n");
	}
#endif
	if ((OutputASSEMBLER==Positive)||(ProgFaulty!=0)) {
		return 0;
	} else {
		if (Area==GLA)  Offset+=GLAoffset;
		if (Area==CNST)  Offset+=CNSTOffset;
		return pgetbytes(Area,Offset,Len);
	}
}	/* Egetbytes */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edpattern(int area,int Disp,int ncopies,int len,int ad) {
	/*************************************************************************/
	/** initialise using a 1,2,4 or 8 byte pattern                          **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int LowArea;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edpattern");
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;
	LowArea=area&0xFF;
	AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
	if (area>=FirstUserArea) {
		AreaBase [LowArea].AreaProps=AreaBase [LowArea].AreaProps|INITIALISED;
		area=AreaBase [LowArea].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pdpattern(area,Disp,ncopies,len,ad);
#endif
}	/*Edpattern    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void edbits(int area,int Disp,int Bitoffset,int Numbits,int Val) {
	/*************************************************************************/
	/** initialise a bit field presumed a word at area & disp               **/
	/** Note:                                                               **/
	/**    Disp is not necessarily word aligned eg array of 3byte structs   **/
	/**    If a byte is initialised more than once Put ensures the last     **/
	/**      is used.                                                       **/
	/**    CCOMP has peculiarities do not emit zero bytes                   **/
	/*************************************************************************/
	int Mask1,Mask2,i,j,Orgval;
	struct AreaInfoFmt *AreaBase;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Edbits");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
		printf("%s +%d Bitoff=%d Nb=%d, Val=%d\n",egivename(area),
			Disp,Bitoffset,Numbits,Val);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Orgval=Val;
	if (area==GLA)  Disp+=GLAoffset;
	if (area==CNST)  Disp+=CNSTOffset;

#if(TargetEndian==BIG)
	i=(32-Bitoffset)-Numbits;

#else
	i=Bitoffset;

#endif
	Mask1=Bmaskval [Numbits-1];
	Val=(Val&Mask1)<<i;
	Mask2=(Mask1<<i)^(-1);
	if ((area==Bitarea)&&(Disp==Bitdisp)) 	/*add to existing init*/{
		Bitval=(Bitval&Mask2)|Val;
		/* new bit initialisation */
	} else {
		if (Val==0)  return ;
		Bitarea=area;
		Bitdisp=Disp;
		Bitval=Val;
	}
	/**/
	/* now put out Bitval avoiding any assumptions about alignment and ignoring  */
	/* zero bytes for CCOMP and to help put                                      */
	/**/

#if(OutputASSEMBLER!=Positive)
	for (i=0; i<=3; i++) {
		j=(*(unsigned char  *)((int)&Bitval+i));
		if (j!=0)  pd(Bitarea,Bitdisp+i,j);
	};

#endif
}	/* Edbits      */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void efix(int area,int disp,int tgtarea,int tgtdisp) {
	/*************************************************************************/
	/** relocate area+disp to tgtarea+tgtdisp  (all are byte addresses)     **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;

	/*      Area=Area&X'FFF';! in case 'byte' marker had been set (historicand now highly dangerous!)*/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Efix");
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
		printf("%s +%d",egivename(area),disp);
		if (tgtarea>=0) {
			AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)tgtarea>>8]);
			printf(" => %s +%d",AreaBase [tgtarea&0xFF].AreaName,tgtdisp);
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area==GLA)  disp+=GLAoffset;
	if (area==CNST)  disp+=CNSTOffset;
	if ((tgtarea==CODE)&&(tgtdisp==0x80000000)) {
		/* int junk;  */
		/* fix to current address which is not known till procend                    */
		/* so insert a marker and finish off later                                   */
		/*        junk=Mnotecodefix(area,offset,0)                                   */
		return ;
	}
	if (tgtarea==GLA)  tgtdisp+=GLAoffset;
	if (tgtarea==CNST)  tgtdisp+=CNSTOffset;
	/**/
	/* we can safely record the fixup for all Languages except C  C++            */
	/* where array bases are pointers and can be changes subsequently            */
	/**/

#if(Language!=CCOMP)
	crecordfixup(area,disp,tgtarea,tgtdisp);
#endif
	if (tgtarea>=FirstUserArea) {
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)tgtarea>>8]);
		tgtarea=AreaBase [tgtarea&0xFF].AreaId;
	}
	if (area>=FirstUserArea) {
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
		AreaBase [area&0xFF].AreaProps=AreaBase [area&0xFF].AreaProps|INITIALISED;
		area=AreaBase [area&0xFF].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pd4(area,disp,0)	/* Contents not ignored on Solaris! */;
#endif

#if(OutputASSEMBLER!=Positive)
	pfix(area,disp,tgtarea,tgtdisp);
#endif

	/* This now only applies to the 386-486 which is no longer even in           */
	/* the standard list of targets !                                            */
	/*         %IF tgtdisp#0 %THEN pd4(area,disp,tgtdisp)                        */
	/*         pfix(area,disp,tgtarea,0)                                         */
	/*      %FINISH                                                              */

}	/* Efix        */
/***/
void efiller(int area,int pattern) {
	/*************************************************************************/
	/** nominate an area to be pre-filled with a given bit pattern          **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;

	pattern&=0xFFFFFF;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Efiller");
		printf("Area=%2d pattern=%x\n",area,pattern);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (area>=FirstUserArea) {
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)area>>8]);
		area=AreaBase [area&0xFF].AreaId;
	}

#if(OutputASSEMBLER!=Positive)
	pfiller(area,pattern);
#endif
}	/* Efiller     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**                 **********************/
/**                 * Procedure call    **/
/**                 **********************/
/***/
/***/

#if(!((Language==CCOMP)&&(LanguageVariant==USLC)))
int ecxname(int type,char * Xref) {
	/**************************************************************************/
	/** generate an external reference, returning an Id for future reference **/
	/**************************************************************************/
	int x;
	struct AreaInfoFmt *AreaBase;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("ecxname");
		printf("%s type=%x\n",Xref,type);
	}
#endif
	if (ProgFaulty!=0)  return 1;

	if ((Language!=FORTRAN)&&((type&0x80000000)!=0)&&((type&0x7FFFFFFF)>=FirstUserArea)) {
		type&=0x7FFFFFFF;

#if(OutputASSEMBLER!=Positive)
		x=pxname(0,Xref);
#endif
		if (AreaInfoBases [(unsigned)type>>8]==0) {
			AreaInfoBases [(unsigned)type>>8]=(int)BMalloc(AreaInfoFmtSize<<8,1,MAEXTERNALNAMEAREA);
		}
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)type>>8]);
		AreaBase [type&0xFF].AreaId=x;
		imp_strjam(AreaBase [type&0xFF].AreaName,Xref,31);
		AreaBase [type&0xFF].AreaProps=0;
		return 0;
	} else {
		return Mgetprockey(type,Xref);
	}
}	/* ecxname      */
int exname(int type, int maxlen, char * impstring){
	/**************************************************************************/
	/* Version of exname for front ends using impstrings                      */
	/**************************************************************************/
	char S [256];
	strcpy(S,eimpstringtoc(impstring));
	return ecxname(type,S);
}	/* exname */


#else
#define exname extname
int ecxtname(int type,char * Xref) {
	/**************************************************************************/
	/** generate an external reference, returning an Id for future reference **/
	/**************************************************************************/
	int x;
	struct AreaInfoFmt *AreaBase;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("exname");
		printf("%s type=%x\n",Xref,type);
	}
#endif
	if (ProgFaulty!=0)  return 1;

	if (((type&0x80000000)!=0)&&((type&0x7FFFFFFF)>=FirstUserArea)) {
		type&=0x7FFFFFFF;

#if(OutputASSEMBLER!=Positive)
		x=pxname(0,Xref);
#endif
		if (AreaInfoBases [(unsigned)type>>8]==0) {
			AreaInfoBases [(unsigned)type>>8]=BMalloc(AreaInfoFmtSize<<8,1,MAEXTERNALNAMEAREA);
		}
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)type>>8]);
		AreaBase [type&0xFF].AreaId=x;
		imp_strjam(AreaBase [type&0xFF].AreaName,Xref,31);
		AreaBase [type&0xFF].AreaProps=0;
		return 0;
	} else {
		return Mgetprockey(0,Xref);
	}
}	/* exname      */
/* USL C version with different external name to avoid clash */

int extname(int type,int maxlen,char *  impstring) {
	/**************************************************************************/
	/** version for front ends that use IMPstrings                           **/
	/**************************************************************************/
	char s [256] ;
	strcpy(s,eimpstringtoc(impstring));
	return ecxtname(type,s);
}	/*ECXname*/
/***/
#endif
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eprecall2(int Id,int Aparamprops) {
	/*************************************************************************/
	/** called prior to planting parameters to a procedure call             **/
	/*************************************************************************/
	int i,n;
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eprecall2");
		printf("%3d ",Id);
		n=(*(int  *)(Aparamprops));
		for (i=0; i<=n+1; i++) {
			printf(" %x",(*(int  *)(Aparamprops+(4*i))));
			if ((i&7)==7)  printf("\n");
			else printf(" ");
		}
		printf("\n");
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mprecall(Aparamprops);
}	/* Eprecall2   */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
#if (Target==PENTIUM)
void etrampcall(int Id,int Extlev,int Numpars,int Paramsize) {
	/*************************************************************************/
	/** call the procedure defined by Id                                    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Etrampcall");
		printf("Id=%d Xlev=%d Pars=%d Parsize=%d\n",Id,Extlev,Numpars,Paramsize);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	if (Elevel==0) LowEstack(0,1);
	Elevel--;
	Mtrampcall(Id,Extlev,Numpars,Paramsize,0);
}	/* Etrampcall      */

void ecall3(int Id,int Extlev,int Numpars,int Paramsize,int cprops) {
	/*************************************************************************/
	/** call the procedure defined by Id                                    **/
	/** cprops defines call 2**0 set call does not return                   **/
	/**                     2**1 set call is non standard                   **/
	/** Other props added in Mprocs or cprops                               **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ecall3");
		printf("Id=%d Xlev=%d Pars=%d Parsize=%d props=%x\n",
			Id,Extlev,Numpars,Paramsize,cprops);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
		Mcall(Id,Extlev,Numpars,Paramsize,cprops);
}	/* ecall3 */
#endif
void ecall2(int Id,int Extlev,int Numpars,int Paramsize) {
	/*************************************************************************/
	/** call the procedure defined by Id                                    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ecall2");
		printf("Id=%d Xlev=%d Pars=%d Parsize=%d\n",Id,Extlev,Numpars,Paramsize);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Mcall(Id,Extlev,Numpars,Paramsize,0);
}	/* Ecall2      */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecall(int Id,int Numpars,int Paramsize) {
	/*************************************************************************/
	/** call the procedure defined by Id                                    **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Ecall");
		printf("Id=%d Pars=%d Parsize=%d\n",Id,Numpars,Paramsize);
	}
#endif
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0)  Cestablishlogical();
	Mcall(Id,1,Numpars,Paramsize,0);
}	/* Ecall       */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eprocref(int Id,int Level) {
	/*************************************************************************/
	/** obtain a pointer to a procedure for use as a parameter              **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eprocref");
		printf("Id=%d Level=%d\n",Id,Level);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Mgetprocref(Id,Level);
}	/* Eprocref    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eprocenv(int Level) {
	/*************************************************************************/
	/** obtain a pointer to a procedure environment for use as a parameter  **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		printf("Eprocenv   Level = %d\n",Level);
	}
#endif
	if (ProgFaulty!=0)  return ;
	Level++;	/* to obtain nesting level for block                               */
	if (Level>FirstDisplayLevel) {
		estkaddr(STACK,-(((Level-FirstDisplayLevel)+1)<<2),0,4);
	} else estklit(0);
}	/* Eprocenv    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
int ecprocptr(int Area,int Offset,char * S,int Id) {
	/*************************************************************************/
	/** establish a pointer to a procedure at Offset in Area                **/
	/*************************************************************************/
	struct AreaInfoFmt *AreaBase;
	int res;
	if (ProgFaulty!=0)  return 0;
	if (Area>=FirstUserArea) {
		/*      Area=Area&X'FFF';! in case 'byte' marker had been set (historicand now highly dangerous!)*/
		AreaBase=(struct AreaInfoFmt *)(AreaInfoBases [(unsigned)Area>>8]);
		AreaBase [Area&0xFF].AreaProps=AreaBase [Area&0xFF].AreaProps|INITIALISED;
		Area=AreaBase [Area&0xFF].AreaId;
	}
	res=Msetprocref(Area,Offset,S,Id);
#if(increports!=0)
	if (Report!=0) {
		printf("Eprocptr %s + %d ==> %s (Id=%d)\n",egivename(Area),Offset,S,Id);
		printf("Eprocptr returns %d\n",res);
	}
#endif

	return res;
}	/* Eprocptr    */
/***/
int eprocptr(int Area,int Offset,int mlen,char *impstring,int Id) {
	return ecprocptr(Area,Offset,eimpstringtoc(impstring),Id);
}
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**               ***********************************/
/**               * Procedure definition and entry **/
/**               ***********************************/
/***/
/***/
int ecnextproc2(char * S,int flags) {
	/*************************************************************************/
	/** result is an Id to be used for a procedure first encountered as an  **/
	/** internal spec                                                       **/
	/*************************************************************************/
	int answer;
	answer=Mgetprockey(flags|4	/*internal*/,S);
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Enextproc");
		printf(": returning %2d for %s - flags=%x\n",answer,S,flags);
	}
#endif
	if (answer>highestproc)  highestproc=answer;
	return answer;
}	/* Ecnextproc     */

int enextproc2(int maxlen, char * impstring,int flags){
	/*************************************************************************/
	/* Version of enextproc2 accepting imp strings                           */
	/*************************************************************************/
	char S [256];
	strcpy(S,eimpstringtoc(impstring));
	return ecnextproc2(S,flags);
}	/* enextrproc2 */

int enextproc() {
	/*************************************************************************/
	/** result is an Id to be used for a procedure first encountered as an  **/
	/** internal spec                                                       **/
	/*************************************************************************/
	char S [4] ;

#if(increports!=0)
	if (Report!=0) {
		checkrecur("Enextproc");
		printf("\n");
	}
#endif
	strcpy(S,"");
	return ecnextproc2(S,4	/*internal*/);
}	/* Enextproc     */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eproclevel(int Level) {
	/*************************************************************************/
	/** record static nesting level of the current procedure                **/
	/*************************************************************************/
#if(increports!=0)
	if (Report!=0) {
		checkrecur("Eproclevel");
		printf("%4d\n",Level);
	}
#endif
	Proclevel=Level;
}	/* Eproclevel  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecproc2(char * Name,int Props,int Aparamprops,int *Id) {
	/*************************************************************************/
	/** define the start of a procedure body                                **/
	/** if Id > 0 this is the Id returned by a previous call of Enextproc   **/
	/**                                                                     **/
	/**    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             **/
	/**    2**8     Used by Mtidyend for Pfix calls                         **/
	/**    2**9     Set if this procedure returns an aggregate              **/
	/**    2**10    Set if there are no pointers or aliases to locals       **/
	/**    2**11    Set if this  proc is to be called from .init            **/
	/**    2**12    Set if this  proc is to be called from .fini            **/
	/**    2**13    Set if proc contains calls with unknown control flow    **/
	/**    2**16-2**23   Byte giving nesting level of procedure             **/
	/**    The level bits, if zero, mean the next textual level but         **/
	/**    enable PASCAL to define the level without using Eproclevel which **/
	/**    is no longer needed.                                             **/
	/*************************************************************************/
	int i,n;

#if(increports!=0)
	if (GlobECodeReport!=0) {
		checkrecur("Ecproc2 ");
		printf("%s  Props=%x Id=%d  ",Name,Props,*Id);
		if (Aparamprops>0) {
			n=(*(int  *)(Aparamprops));

#if(LanguageVariant==USLC)
			n+=2;
#endif
			for (i=0; i<=n+1; i++) {
				printf("%8X",(*(int  *)(Aparamprops+(4*i))));
				if ((i&7)==7)  printf("\n");
				else printf(" ");
				;
			}
		}
		printf("\n");
	}
#endif
	strcpy(parprefix,Name);
	if (ProgFaulty!=0)  return ;
	i=((unsigned)Props>>16)&255;	/* Level or zero                               */
	if (i!=0)  Proclevel=i;
	else {

#if((Language!=PASCAL)&&(Language!=MODULA))
		Proclevel++;
#endif
	}
	/**/
	/* Id should not be <=0 for internal procs since Enextproc should have been used*/
	/* insert a call here in case FEs are careless since it becomes important on AIX*/
	/**/
	if ((*Id<=0)&&((Props&1)==0))  *Id=ecnextproc2(Name,4	/*Internal*/);
	if (*Id>0) {
		Mnoteentry(Name,*Id);
	} else {
		*Id=Mgetprockey(0,Name);
	}
	if (*Id>highestproc)  highestproc=*Id;
	/***/
	Mstartproc(*Id,Props&0xFFFF,Proclevel,Aparamprops);
	/***/
	Report=0;
	if (MInTraceRegion()!=0)  Report=GlobECodeReport;
	/***/
	if ((Language==CCOMP)&&(increports!=0)&&(Report!=0)) {
		printf("   RegClaimMask= %x  %x\n",RegClaimMaskB,RegClaimMaskA);
	}

}	/* Ecproc2        */
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/


void eproc2(int maxlen,char * impstring, int Props, int Aparamprops, int *Id){
	/*************************************************************************/
	/* Version of eproc2 accepting an IMP string                             */
	/*************************************************************************/
	char S [256];
	strcpy(S,eimpstringtoc(impstring));
	ecproc2(S,Props,Aparamprops,Id);
}	/* eproc2  */

int eprocend(int Localsize,int Diagdisp,int Astacklen) {
	/*************************************************************************/
	/** called at procedure end                                             **/
	/** Localsize is the total stack-frame requirement (excluding red tape) **/
	/** Astacklen is no longer required                                     **/
	/** stack-frame size of the enclosing procedure                         **/
	/*************************************************************************/
	int framesize;
	if (Report!=0) {
		checkrecur("Eprocend");
		printf("Level=%d Locals=%d Diags=%d\n",Proclevel,Localsize,Diagdisp);
	}
	if (ProgFaulty!=0)  return 0;
	framesize=Mtidyproc(Proclevel,Localsize,Diagdisp);
	Proclevel--;
	Report=0;
	if (MInTraceRegion()!=0)  Report=GlobECodeReport;
	return framesize;
}	/* Eprocend    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eentry2(int Procindex,int Aparamprops,int Localsize,int Diagdisp,
	int maxle, char * impstring) {
	/*************************************************************************/
	/** defines a side entry within the current procedure (used by FORTRAN) **/
	/** Aparamprops is address of compiler-provided parameter info table.   **/
	/** Localsize is the total stack-frame requirement (excluding red tape) **/
	/** Version only accepts IMP strings                                    **/
	/*************************************************************************/
	char Name [255];
	int Id;

	strcpy(Name,eimpstringtoc(impstring));
	if (Report!=0) {
		checkrecur("Eentry2");
		printf(" %s %5d %5d %5d \n",Name,Procindex,Localsize,Diagdisp);
	}
	if (ProgFaulty!=0)  return ;
	Id=Mgetprockey(0,Name);
	if (Id>highestproc)  highestproc=Id;
	Msideentry(Id,Procindex,Aparamprops,Localsize,Diagdisp);
}	/* Eentry2     */
/***/
void ecentry3(char * Name,int Aparamprops,int *Id) {
	/***************************************************************************/
	/** defines a side entry within the current procedure (used by FORTRAN90) **/
	/** Aparamprops is address of compiler-provided parameter info table.     **/
	/** if Id > 0 this is the Id returned by a previous call of Enextproc2    **/
	/** or exname                                                             **/
	/***************************************************************************/

	if (Report!=0) {
		checkrecur("Ecentry3");
		printf("%s Id=%d\n",Name,*Id);
	}
	if (ProgFaulty!=0)  return ;
	if (*Id<=0) {
		*Id=Mgetprockey(0,Name);
	}
	if (*Id>highestproc)  highestproc=*Id;
	Msideentry(*Id,1,Aparamprops,0,0);
	/*      %IF Target=SPARC %THEN Lprof labelseen= 1                            */
}	/* Ecentry3     */

void eentry3(int maxlen, char * impstring, int Aparamprops, int *Id){
	/***************************************************************************/
	/* Version of eentry3 for IMP front ends calls ecentry3                    */
	/***************************************************************************/
	char S [255];
	strcpy(S,eimpstringtoc(impstring));
	ecentry3(S,Aparamprops,Id);
}	/* eentry3*/

/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**               **********************************/
/**               * Data definition and reference **/
/**               **********************************/
/***/
/***/
void ecdataentry(int Area,int Offset,int Length,char * Name) {
	/*************************************************************************/
	/** defines a data entry Name starting at Offset in Area                **/
	/*************************************************************************/
	if (Report!=0) {
		checkrecur("Ecdataentry");
		printf("%s Area=%d Offset=%d Length=%d\n",Name,Area,Offset,Length);
	}
	if (ProgFaulty!=0)  return ;
	if ((Area<0)||(Area>=MaxAreas))  AreasOverflow();
	if (Area==GLA)  Offset+=GLAoffset;
	if (Area==CNST)  Offset+=CNSTOffset;

#if(OutputASSEMBLER!=Positive)
	pdataentry(Name,Area,Length,Offset);
#endif
}	/* Ecdataentry  */
/***/
void edataentry(int Area,int Offset,int Length,int maxne, char * impstring) {
	/*************************************************************************/
	/** version of edataentry for front ends using IMPstrings               **/
	/*************************************************************************/
	char s [256] ;
	strcpy(s,eimpstringtoc(impstring));
	ecdataentry(Area,Offset,Length,s);
}
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ecdataref(int Area,int Offset,int Length,char * Name) {
	/*************************************************************************/
	/** requests a data ref to Name (with at least Length)at Offset in Area **/
	/*************************************************************************/
	int Id;

	if (Report!=0) {
		checkrecur("Ecdataref");
		printf("%s Area=%d Offset=%d Len=%d\n",Name,Area,Offset,Length);
	}
	if (ProgFaulty!=0)  return ;
	if ((Area<0)||(Area>=MaxAreas))  AreasOverflow();
	if (Area==GLA)  Offset+=GLAoffset;
	if (Area==CNST)  Offset+=CNSTOffset;

#if(OutputASSEMBLER!=Positive)
	Id=pxname(2	/*Data*/,Name);
#endif

#if(OutputASSEMBLER!=Positive)
	pdxref(Area,Offset,Id);
#endif
}	/* Ecdataref    */


void edataref(int Area,int Offset, int Length, int maxlen, char * impstring){
	/*************************************************************************/
	/* Version of edatref for front ends using IMPstrings                    */
	/*************************************************************************/
	char S [256];
	strcpy(S,eimpstringtoc(impstring));
	ecdataref(Area,Offset,Length,S);
}	/* edataref */

/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
/***/
/**                  *********************/
/**                  * Ecode operations **/
/**                  *********************/
/***/
void eop(int opcode) {
	/*************************************************************************/
	/** opcodes with general applicability                                  **/
	/*************************************************************************/
	struct Stkfmt *Estktos,*Estktosm1;
#if(Language==CCOMP)
	static const int Uopst [3+1] = {
				IADDST,ISUBST,IMULTST,
				IDIVST		};
	static const int Ropst [9+1] = {
				RADD,RSUB,RMULT,RDIV,
				ISHLL,ISHRL,0,0,
				0,ISHRA		};
#endif
	/***/
	static const unsigned char MinElevel [792+1] = {
				0,2,2,2,2,1,1,2,	2,2,1,2,2,2,2,2,
				2,2,2,2,2,2,1,0,	2,2,2,2,2,2,1,1,
				1,1,1,1,1,0,0,0,	0,0,0,1,1,0,2,1,
				1,0,0,2,2,2,2,3,	3,3,2,3,0,0,3,3,
		/*64*/		3,3,3,3,2,1,0,0,	0,0,0,0,0,2,2,2,
				2,2,2,2,2,2,2,2,	2,2,2,2,2,2,1,1,
				1,1,1,1,2,2,2,2,	2,2,0,0,2,2,2,2,
				0,2,2,2,2,1,1,0,	0,0,0,0,0,0,0,0,
		/*128*/		0,0,2,2,2,2,2,2,	2,2,2,2,2,2,1,1,
				2,2,2,2,2,2,2,2,	2,2,2,2,1,1,1,1,
				1,1,1,0,0,0,0,0,	0,0,0,0,0,0,0,0,
				0,1,0,0,0,0,0,0,	2,2,1,1,0,0,1,1,
		/*192*/		1,1,3,3,2,2,0,1,	1,0,3,1,1,2,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,
		/*256*/		0,4,4,4,4,3,3,3,	3,0,1,1,2,2,2,2,
				2,2,2,2,2,2,2,3,	2,1,4,4,4,5,3,4,
				2,3,2,2,2,2,1,2,	2,0,2,0,0,0,2,2,
				1,3,1,0,0,0,0,0,	0,0,0,0,0,0,0,0,
		/*320*/		0,0,0,0,0,0,0,0,	0,0,0,0,0,0,0,0,
				0,3,3,3,3,2,3,2,	3,3,2,3,0,2,2,4,
				3,3,5,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,
		/*384*/		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,0,	0,0,0,0,0,0,0,0,
		/*448*/		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,0,	0,0,0,0,0,0,0,0,
		/*512*/		2,0,0,0,0,0,0,0,	0,0,0,0,0,2,2,2,
				0,0,2,2,2,2,2,2,	2,2,2,2,2,2,0,0,
				2,4,3,2,0,0,0,0,	2,2,0,0,0,0,0,0,
				2,2,2,2,3,2,1,1,	0,0,0,0,0,0,0,0,
		/*576*/		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,1,0,0,0,0,0,0,
				0,0,0,1,0,0,0,0,	0,1,0,0,0,0,4,3,
				4,0,4,3,4,3,0,0,	0,0,1,1,1,0,0,0,
		/*640*/		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,0,	0,0,0,0,0,0,0,0,
		/*704*/		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,0,	0,0,0,0,0,0,0,0,
		/*768*/		3,3,2,2,1,2,3,4,	2,2,2,0,2,2,2,2,
				2,2,1,1,1,2,0,0,	1		};


	int Bytes,I,j,Reg,Form;

	if (Report!=0) {
		checkrecur("EOP");
		printf("%s\n",Opname(opcode));
		Cdumpestack();
	}
	if (ProgFaulty!=0)  return ;
	if (CCset!=0 && CCest==0) {
		if (!((CHKRNG<=opcode)&&(opcode<=CHKROVF))) {
			Cestablishlogical();
			if (Report!=0) {
				checkrecur("LOGICAL ESTABLISHED");
				printf("\n");
			}
		}
	}
	j=MinElevel [opcode];
	if ((j>0)&&(Elevel<j))  LowEstack(opcode,j);
	Estktos=&Stk [Elevel];
	if (j>1)  Estktosm1=&Stk [Elevel-1];
	Depth++;
	switch (opcode) {
		/***/
	default:
		UnsupportedOpcode(opcode);
		goto wayout;
		/***/
	case HALT:
	case IPUSH:
	case IPOP:
		UnsupportedOpcode(opcode);
wayout:
		Depth--;
		return ;
		/***/
	case IGT:
	case ILT:
	case IEQ:
	case INE:
	case IGE:
	case ILE:
	case UGT:
	case ULT:
	case UEQ:
	case UNE:
	case UGE:
	case ULE:

#if(Target==RS6)
		Elevel-=2;
		CIntBinaryOp(opcode,Estktosm1,Estktos,3	/*avoid cc0 & cc1*/);
		goto wayout;
		;
#endif
		goto Binop;
	case IAND:
	case IOR:
	case IXOR:
		if (Estktos->Form==LitVal && Estktosm1->Form==LitVal) {
			if (opcode==IAND)  {
				Estktosm1->Intvalue=Estktosm1->Intvalue&Estktos->Intvalue;
				Estktosm1->Modintval=Estktosm1->Modintval&Estktos->Modintval;
			}
			if (opcode==IOR)  {
				Estktosm1->Intvalue=Estktosm1->Intvalue|Estktos->Intvalue;
				Estktosm1->Modintval=Estktosm1->Modintval|Estktos->Modintval;
			}
			if (opcode==IXOR)  {
				Estktosm1->Intvalue=Estktosm1->Intvalue^Estktos->Intvalue;
				Estktosm1->Modintval=Estktosm1->Modintval^Estktos->Modintval;
			}
			Elevel-=1;
			goto wayout;
		}
		/**/
		if (Estktos->Form==LitVal && Estktos->Intvalue==-1 &&
		   (Estktos->Modintval==-1 || Estktos->Size==4)) {
			if (opcode==IAND) {
				Elevel-=1;
				goto wayout;
			}
			if (opcode==IOR) {
				eop(EXCH);
				eop(DISCARD);
				goto wayout;
			}
		}
		/**/
		if (Estktos->Form==LitVal && Estktos->Intvalue==0 &&
		   Estktos->Modintval==0) {
			if (opcode==IOR || opcode==IXOR) {
				Elevel-=1;
				goto wayout;
			}
			eop(EXCH);
			eop(DISCARD);
			goto wayout;
		}
		/**/
		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==-1 &&
		   (Estktosm1->Modintval==-1 || Estktosm1->Size==4)) {
			if (opcode==IOR) {
				eop(DISCARD);
				goto wayout;
			}
			if (opcode==IAND) {
				eop(EXCH);
				eop(DISCARD);
				goto wayout;
			}
		}
		/**/
		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==0 &&
		   Estktosm1->Modintval==0) {
			if ((opcode==IOR)||(opcode==IXOR)) {
				eop(EXCH);
				eop(DISCARD);
				goto wayout;
			} else {
				eop(DISCARD);
				goto wayout;
			}
		}
		goto Binop;
	case IADD:
	case UADD:
		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==0 &&
		   Estktosm1->Modintval==0) {
			eop(EXCH);
			eop(DISCARD);
			goto wayout;
		}
	case ISUB:
	case USUB:
		if (Estktos->Form==LitVal && Estktos->Intvalue==0 &&
		   Estktos->Modintval==0) {
			Elevel-=1;
			goto wayout;
		}
		goto Binop;
	case IMULT:
	case UMULT:
		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==0 &&
		   Estktosm1->Modintval==0) {
			eop(DISCARD);
			goto wayout;
		}
		/**/
		if (Estktos->Form==LitVal && Estktos->Intvalue==0 &&
		   Estktos->Modintval==0) {
			eop(EXCH);
			eop(DISCARD);
			goto wayout;
		}

		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==1 &&
		   Estktosm1->Modintval==0) {
			eop(EXCH);
			eop(DISCARD);
			goto wayout;
		}

		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==-1 &&
		   (Estktosm1->Size==4 || Estktosm1->Modintval==-1)) {
			eop(EXCH);
			eop(DISCARD);
			eop(INEG);
			goto wayout;
		}
		/**/
		if (Estktos->Form==LitVal && Estktos->Intvalue==-1 &&
		   (Estktos->Size==4 || Estktos->Modintval==-1)) {
			eop(DISCARD);
			eop(INEG);
			goto wayout;
		}
	case IDIV:
	case UDIV:
		if (Estktos->Form==LitVal && Estktos->Intvalue==1 &&
		   Estktos->Modintval==0) {
			Elevel-=1;
			goto wayout;
		}
		goto Binop;
	case IREM:
	case UREM:
		if (Estktos->Form==LitVal && Estktos->Intvalue==1 &&
		   Estktos->Modintval==0) {
			Estktos->Intvalue=0;
			eop(EXCH);
			eop(DISCARD);
			goto wayout;
		}
Binop:
		Elevel-=2;
		CIntBinaryOp(opcode,Estktosm1,Estktos,ModifyCC);
		goto wayout;
		/***/
	case TMASK:

#if((Target==PENTIUM)||(Target==M88K))
		Elevel-=2;
		Ctestmaskbits(Estktosm1,Estktos,ModifyCC);
		goto wayout;

#else
		eop(IAND); goto wayout;

#endif
		/***/
	case INEG:
	case IABS:
	case INOT:
	case BNOT:
		if (Estktos->Form==LitVal && Estktos->Intvalue!=0x80000000 &&
			Estktos->Size<=4) {
			if (opcode==INEG)  Estktos->Intvalue=-Estktos->Intvalue;
			if (opcode==INOT)  Estktos->Intvalue=Estktos->Intvalue^(-1);
			if (opcode==IABS)  Estktos->Intvalue=abs(Estktos->Intvalue);
			if (opcode==BNOT)  Estktos->Intvalue=Estktos->Intvalue^1;
			goto wayout;
		}
		Elevel-=1;
		CIntUnaryOp(opcode,Estktos);
		goto wayout;
		/***/
		/***/
	case IADDST:
	case ISUBST:
	case IMULTST:
	case UDIVST:
	case IDIVST:
	case IREMST:
	case UREMST:
	case IANDST:
	case IORST:
	case IXORST:
		/**/
		/* before assigning check out lower part of Estack (if any) for duplicates   */
		/**/
		if (Elevel>2)  MCurrentvalue(&Stk [Elevel-1],Elevel-2);
		if ((Stk [Elevel-1].Form&31)==Regvar) {
			Elevel-=2;
			CregSTop(Regop [opcode-IADDST],ECdupflag,&Stk [Elevel+1],&Stk [Elevel+2]);
		} else {
			/* stk is operand over store location                       */
			eop(EXCH);
			eop(DUPL);
			epromote(3);	/* now operand over storeloc(twice)    */
			eop(Regop [opcode-IADDST]);
			eop(EXCH);
			eop(ESTORE+ECdupflag);
		}
		ECdupflag=0;
		goto wayout;
		/***/
	case INEGST:
	case INOTST:
		eop(DUPL);
		Elevel-=1;
		opcode-=INEGST-INEG;
		CIntUnaryOp(opcode,&Stk [Elevel+1]);
		epromote(2);
		eop(ESTORE+ECdupflag);
		ECdupflag=0;
		goto wayout;
		/***/
		/***/
	case ISHLL:
	case ISHLA:
	case ISHRL:
	case ISHRA:
		if (Estktos->Form==LitVal && Estktosm1->Form==LitVal &&
		   Estktosm1->Size==4) {
			if (opcode==ISHLL || opcode==ISHLA) {
				Estktosm1->Intvalue=Estktosm1->Intvalue<<(Estktos->Intvalue&31);
				Elevel-=1;
				goto wayout;
			}
			if (opcode==ISHRL || (opcode==ISHRA && Estktosm1->Intvalue>=0)) {
				Estktosm1->Intvalue=(unsigned)Estktosm1->Intvalue>>(Estktos->Intvalue&31);
				Elevel-=1;
				goto wayout;
			}
			for (I=1; I<=(Estktos->Intvalue&31); I++)  Estktosm1->Intvalue=((unsigned)Estktosm1->Intvalue>>1)|0x80000000;
			Elevel-=1;
			goto wayout;
		}
		/**/
		if (Estktos->Form==LitVal && Estktos->Intvalue==0) {
			Elevel-=1;
			goto wayout;
		}
		/**/
		if (Estktosm1->Form==LitVal && Estktosm1->Intvalue==0) {
			eop(DISCARD);
			goto wayout;
		}
		Elevel-=2;
		Cshift(opcode-ISHLL,Estktosm1,Estktos);
		goto wayout;
		/***/
	case RETURN:
		Creturn();
		goto wayout;
		/***/
		/***/
	case EXCH:
		epromote(2);
		goto wayout;
		/***/
	case DUPL:
		Cduplicate();
		goto wayout;
		/***/
	case DISCARD:
		Cdiscardopnd(Estktos);
		Elevel-=1;
		goto wayout;
		/***/
	case INDEX1:
	case INDEX2:
	case INDEX4:
	case INDEX8:
		Elevel-=1;	/* NB This upsets the Estktos mappings           */
		Cnoteindex(opcode-INDEX1,&Stk [Elevel],&Stk [Elevel+1]);
		goto wayout;
		/***/
	case INDEX:
#if(target==M88K)
		if ((targetvariant==M88110)&&(Estktos->Form==LitVal)&&(Estktos->Intvalue==16)) {
			Cdiscardopnd(Estktos);
			Elevel-=1;
			I=4;
		} else {
			Elevel-=2;
			CIntBinaryOp(IMULT,Estktosm1,Estktos,0);
			I=0;
		}
#else
		Elevel-=2;
		CIntBinaryOp(IMULT,Estktosm1,Estktos,0);
		I=0;
#endif
		Elevel-=1;
		Cnoteindex(I,&Stk [Elevel],&Stk [Elevel+1]);
		goto wayout;
		/***/
	case CHK:
		Elevel-=3;
		Cboundcheck(&Stk [Elevel+1],Estktosm1,Estktos,Boundlab);
		goto wayout;
		/***/
	case CPBGT:
	case CPBLT:
	case CPBEQ:
	case CPBNE:
	case CPBGE:
	case CPBLE:
		Elevel-=3;
		Ccomparebytes(opcode-CPBGT,Estktos,&Stk [Elevel+1],Estktosm1);
		goto wayout;
		/***/
	case MVB:
		/* move etos bytes between two addresses                    */
		Elevel-=3;
		Ccopybytes(Estktos,&Stk [Elevel+1],Estktosm1,1);
		goto wayout;
		/***/
	case MVW:
		/* move etos (4byte) words between two addresses            */
		Elevel-=3;
		Ccopybytes(Estktos,&Stk [Elevel+1],Estktosm1,4);
		goto wayout;
		/***/
	case RMULT:
		Bytes=Estktos->Size;
		if ((Estktos->Form==Flitval)&&(((Bytes==4)&&(Estktos->Rval== 2.0))||((Bytes==8)&&(Estktos->Rlval==
		    2.0)))) {
			eop(DISCARD);
			eop(DUPL);
			opcode=RADD;
		} else if ((Estktosm1->Form==Flitval)&&(((Bytes==4)&&(Estktosm1->Rval== 2.0))||((Bytes==8)&&(Estktosm1
		    ->Rlval== 2.0)))) {
			eop(EXCH);
			eop(DISCARD);
			eop(DUPL);
			opcode=RADD;
		};

	case RADD:
	case RSUB:
	case RDIV:
		/***/
	case RGT:
	case RLT:
	case REQ:
	case RNE:
	case RGE:
	case RLE:
		Elevel-=2;
		CRealBinaryOp(opcode,Estktosm1,Estktos);
		goto wayout;
		/***/
	case EMCHIP:
		Elevel-=2;
		CRealUnaryOp(opcode,0xFFFFFF00|Estktos->Intvalue,Estktosm1);
		goto wayout;
	case RNEG:
	case RABS:
		Elevel-=1;
		CRealUnaryOp(opcode,-1,Estktos);
		goto wayout;
		/***/
	case CVTSBI:
		/* Signed byte to integer                                   */

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertSBI(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTUI:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertUI(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTIU:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertIU(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case UCVTII:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertUU(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTII:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertII(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTRR:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertRR(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case TNCRI:
	case RNDRI:
	case EFLOOR:
		Elevel-=2;
		ConvertRI(Estktosm1,Estktos->Intvalue,opcode-TNCRI);
		goto wayout;
		/***/
	case TNCRU:
		Elevel-=2;
		ConvertRU(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTIR:

#if(Language==CCOMP)
#endif
		Elevel-=2;
		ConvertIR(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case CVTUR:
		Elevel-=2;
		ConvertUR(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case TNCRR:
	case RNDRR:
		Elevel-=1;
		ConvertRIR(Estktos,opcode-TNCRR);
		goto wayout;
		/***/
	case CVTRU:
		Elevel-=2;
		ConvertRU(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case UCHECK:
		Form=Estktos->Form&31;
		if ((Form==LitVal)||(Form==ConstVal)||(Form==RegVal)||(Form==FregVal)||(Form==RegAddr)||(Form==RegModAddr
		    )||(Form==Regvar)||(Form==Fregvar)||(Form==Flitval))  goto wayout;
		Elevel-=1;
		Cunasscheck(Estktos,Unasslab);
		goto wayout;
		/***/
	case ESTORE:
	case EDUPSTORE:
		Elevel-=2;
		if (Elevel>0)  MCurrentvalue(Estktos,Elevel);
		if ((Language!=CCOMP)&&(Estktos->Form==DirVal)&&(Estktos->Size==4)&&(Estktos->Base==GLA)) {
			CDiscardFixup(GLA,Estktos->Offset);
		}
		Reg=Cstoreop(Estktos,Estktosm1,opcode-ESTORE);
		goto wayout;
		/***/
	case PUSHADDR:
		Caddress(&Stk [Elevel]);
	case PUSHVAL:
		Elevel-=1;
		Cpushparam(&Stk [Elevel+1]);
		goto wayout;
		/***/
	case EVAL:
	case EVALADDR:
		Elevel-=1;
		Cevaluate(Estktos,1);
		goto wayout;
		/***/
	case EADDRESS:
	case EADDRITEM:
		Caddress(&Stk [Elevel]);
		Stk [Elevel].Size=ADDRESSSIZE;
		goto wayout;
		/***/
	case EPOWER:
	case EPOWERI:
		if (Estktos->Form!=LitVal)  Mabort(58);
		CCset=0;
		Elevel-=1;
		j=Estktos->Intvalue;
		if ((j<=2)&&(Estktosm1->Form==LitVal)&&(((0<Estktosm1->Intvalue)&&(Estktosm1->Intvalue<=10))||(((1<=j
		    )&&(j<=2))&&((-10<=Estktosm1->Intvalue)&&(Estktosm1->Intvalue<0))))) {
			Elevel-=1;
			{
				/****************************************************************/
				/** Optimise simple exponents here for all machines            **/
				/****************************************************************/
				int val,op;
				static float one= 1.0;
				static double lone= 1.0;
				val=Estktosm1->Intvalue;
				if (j==0)  op=IMULT;
				else op=RMULT;
				;
				switch (abs(val)) {
				case 8:
					eop(DUPL);
					eop(op);
				case 4:
					eop(DUPL); 
					eop(op);
				case 2:
					eop(DUPL); 
					eop(op);
					goto bend;
				case 6:
					eop(DUPL); 
					eop(op);
				case 3:
					eop(DUPL); 
					eop(DUPL); 
					eop(op);
					eop(op);
					goto bend;
				case 10:
					eop(DUPL); 
					eop(op);
				case 5:
					eop(DUPL); 
					eop(DUPL); 
					eop(op);
					eop(DUPL); 
					eop(op); 
					eop(op);
					goto bend;
				case 7:
					eop(DUPL); 
					eop(DUPL); 
					eop(op);
					eop(DUPL); 
					eop(DUPL); 
					eop(op);
					eop(op); 
					eop(op);
					goto bend;
				case 9:
					eop(DUPL); 
					eop(DUPL); 
					eop(op);
					eop(DUPL); 
					eop(op); 
					eop(DUPL);
					eop(op); 
					eop(op);
				case 1:
bend:
					if (val<0) {
						if (j==1)  estkrconst(4,(int)&one);
						else estkrconst(8,(int)&lone);
						;
						eop(EXCH);
						eop(RDIV);
					}
				}
			}
		} else if (j==0 && Stk[Elevel-1].Form==LitVal &&
			Stk[Elevel-1].Intvalue==2) {
			if (Stk[Elevel].Form==LitVal) {
				I=Stk[Elevel].Intvalue;
				Elevel-=2;
				if (I>=0) {
					estklit(1<<I);
				} else {
					estklit(0);
				}
			} else {
				Stk[Elevel-1].Intvalue=1;
				eop(DUPL);
				edemote(3);
				estklit(0);
				edemote(4);
				eop(ISHLA);
				eop(EXCH);
				estklit(0);
				eop(ILT);
				eop(EIMERGE1);
			}
		} else {
			Mexpcall(j);
		}
		goto wayout;
		/***/
	case EINTRES:
		Elevel-=1;
		Cnoteresult(IntType,Estktos);
		goto wayout;
		/***/
	case EREALRES:
		Elevel-=1;
		Cnoteresult(RealType,Estktos);
		goto wayout;
		/***/
	case ESIZE:
		Elevel-=1;
		Stk [Elevel].Size=Stk [Elevel+1].Intvalue;
		goto wayout;
		/***/
	case ARGPROC:
		/**/
		/* This is the Ecode Version 4 definition of calling formal procedures.      */
		/**/
		/* (Etos)      The number of bytes of parameters stacked. Only needed on 2900*/
		/*             and some UNIX machines. Always a literal constant.            */
		/**/
		/* (Etos-1)    A descriptor in the parameter area holding information about the*/
		/*             actual procedure parameter. The contents of are both architecture*/
		/*             and language-dependent.                                       */
		/**/
		/*             (1) SPARC                                                     */
		/**/
		/*                 FORTRAN: The entry-point address.                         */
		/*                 PASCAL:  The entry-point address + environment pointer    */
		/*                          in adjacent words.                               */
		/*                 MODULA:  The entry-point address.                         */
		/*                 C:       The entry-point address.                         */
		/*                 IMP:     Should follow PASCAL.                            */
		/**/
		/*             (2) M88K                                                      */
		/**/
		/*                 FORTRAN: A pointer to a word-pair holding the entry-      */
		/*                          point address and a nil environment.             */
		/*                 PASCAL:  The entry-point address + environment pointer    */
		/*                          in adjacent words.                               */
		/*                 MODULA:  The entry-point address.                         */
		/*                 C:       The entry-point address.                         */
		/*                 IMP:     Should follow PASCAL.                            */
		/**/
		/*             Further modifications may be necessary to handle dynamic linking.*/
		/**/
		Elevel-=2;
		Cargproc(Estktosm1,Estktos->Intvalue);
		goto wayout;
		/***/
	case PUSHBYTES:
		if (Estktos->Form!=LitVal)  Mabort(69);	/* PUSHBYTES needs literal op */
		Elevel-=2;
		Cpushbytes(Estktos->Intvalue,Estktosm1);
		goto wayout;
		/***/
	case SFA:

#if(Target==MIPS)
		{
			extern void Cautostackop( int ,struct Stkfmt *);
			Cautostackop(SFA,NULL);
		}
		goto wayout;
		;
#endif
	case EAUXSF:
		Cgetauxsf();
		goto wayout;
		/***/
	case ASF:

#if(Target==MIPS)
		{
			extern void Cautostackop( int ,struct Stkfmt *);
			Elevel-=1;
			Cautostackop(ASF,Estktos);
		}
		goto wayout;
		;
#endif
	case EAUXADD:
		Elevel-=1;
		Cadjustauxsf(Estktos);
		goto wayout;
		/***/
	case EAUXRES:
		Elevel-=1;
		Cresetauxsf(Estktos);
		goto wayout;
		/***/
	case EZERO:
		/* As Efill but zero implied       */
		estklit(0);	/* and drop through    */
		/*      epromote(2);                      ! gets args in correct order       */
		/* The above epromote is clearly in conflict with the descriptioms of        */
		/* EZERO and EFILL but has been present fir a long time. Imp only            */
		/* uses EZERO when record by value are actually stacked and I presume no     */
		/* one else ever uses it (pds)      */
	case EFILL:
		Elevel-=3;
		Cfillbytes(&Stk [Elevel+1],&Stk [Elevel+2],&Stk [Elevel+3]);
		goto wayout;
		/***/
	case EOLDLNB:
		/* Stack previous frame pointer    */
		Cstkoldframe();
		goto wayout;
		/***/
	case ECDUP:
		/* 'Orrible Frig till C improves   */
		/* It means in effect after the next IADDST (etc)                            */
		/* Fetch back or leave the result stacked also                               */
		/* C can obtain the same effect without loss of speed                        */
		/* by using the Estack version of the Operation                              */
		/* and following by an Edupstore.   */
		ECdupflag=1;
		goto wayout;

		/**/
		/* The following two ops are needed to support 64 bit integers               */
		/**/

#if((Target==MIPS)||(Target==SPARC)||(Target==PENTIUM))
	case EMAKED:
		Elevel-=2;
		Cmakedouble(Estktos,Estktosm1);
		goto wayout;
	case ESPLITD:
		Elevel-=1;
		Csplitdouble(Estktos);
		goto wayout;
		;
#endif
		/**/
		/* the Following section of code is for FORTRAN only. All the OPs are here unless*/
		/* They are not supported in this implementation                             */
		/***/
	case CXADD:
	case CXSUB:
	case CXMULT:
	case CXDIV:

#if(((Language==FORTRAN)&&(Directcomplex==0))||(Language==PASCAL)||(Language==MODULA))
		Elevel-=4;
		opcode&=0xFF;
		Flags=Stk [Elevel+4].Intvalue;
Cxop:
		Cxoperation(opcode,Flags,&Stk [Elevel+1],&Stk [Elevel+2],&Stk [Elevel+3]);
		;
#endif
		goto wayout;
		/***/
	case CXNEG:
	case CXASGN:
	case CXEQ:
	case CXNE:

#if(((Language==FORTRAN)&&(Directcomplex==0))||(Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		opcode&=0xFF;
		Flags=Stk [Elevel+3].Intvalue;
		goto Cxop;
		Elevel-=3;
		opcode=10;
		Flags=Stk [Elevel+3].Intvalue;
		goto Cxop;
		Elevel-=4;
		opcode=11;
		Flags=Stk [Elevel+4].Intvalue;
		goto Cxop;
		;
#endif
		/***/
	case ECMPLX1:
		/* Set Complex at ((Elevel-2)) to ((elevel-1),0)                            */
		/* Flags in Etos give precision 0=32bits                                     */

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

		;
#endif
		/***/
	case ECMPLX2:
		/* Set Complex at ((Elevel-3)) to the pair                                  */
		/* ((Etos-2),(Etos-1)).  Etos as for ecmplx1.                                */

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

		;
#endif
		/***/
	case ECONJG:

#if(((Language==FORTRAN)&&(Directcomplex==0))||(Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		opcode=9;
		Flags=Stk [Elevel+3].Intvalue;
		goto Cxop;
		;
#endif
		/***/
	case DCXADD:
	case DCXSUB:
	case DCXMULT:
	case DCXDIV:
	case DCXEQ:
	case DCXNE:
	case DECMPLX2:

#if((Language==FORTRAN)&&(Directcomplex==1))
		Elevel-=3;
		Flags=Stk [Elevel+3].Intvalue;
		DCXOperation(opcode,Flags,&Stk [Elevel+1],&Stk [Elevel+2]);
		goto wayout;
#endif	/*%if Language=FORTRAN %and Directcomplex=1*/
		/***/
	case DCXASGN:

#if((Language==FORTRAN)&&(Directcomplex==1))
		Elevel-=3;
		Flags=Stk [Elevel+3].Intvalue;
		DCXOperation(opcode,Flags,&Stk [Elevel+2],&Stk [Elevel+1]);
		goto wayout;
#endif	/*%if Language=FORTRAN %and Directcomplex=1*/
		/***/
	case DCXNEG:
	case DCXCVT:
	case DECMPLX1:
	case DECONJG:

#if((Language==FORTRAN)&&(Directcomplex==1))
		Elevel-=2;
		Flags=Stk [Elevel+2].Intvalue;
		DCXOperation(opcode,Flags,&Stk [Elevel+1],	/*not used*/&Stk [Elevel+2]);
		goto wayout;
#endif	/*%if Language=FORTRAN %and Directcomplex=1*/
		/***/
	case DCXUCHECK:

#if((Language==FORTRAN)&&(Directcomplex==1))
		Elevel-=2;
		Ccmplxunasscheck(&Stk [Elevel+1],Unasslab);
		goto wayout;
#endif	/*%if Language=FORTRAN %and Directcomplex=1*/

	case DCXMERGE:

#if((Language==FORTRAN)&&(Directcomplex==1))
		Elevel-=4;
		DCXCmerge(Estktos->Intvalue,Estktosm1,&Stk [Elevel+1],&Stk [Elevel+2]);
#endif	/*%if Language=FORTRAN %and Directcomplex=1*/
		goto wayout;

		/***/
	case PSEUDONOP:
		/* plant a nop                     */

#if(Language==FORTRAN)
		Cgeneratenop();
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
	case EM1EXP:

#if(Language==FORTRAN)
		Elevel-=1;
		Cminus1exp(Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EINCR:

#if(Language==FORTRAN)
		eop(IADDST);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EDECR:

#if(Language==FORTRAN)
		eop(ISUBST);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EISIGN:

#if(Language==FORTRAN)
		Elevel-=2;
		Csign(IntType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ESIGN:

#if(Language==FORTRAN)
		Elevel-=2;
		Csign(RealType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIMOD:

#if(Language==FORTRAN)
		Elevel-=2;
		Cmod(IntType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ERMOD:

#if(Language==FORTRAN)
		Elevel-=2;
		Cmod(RealType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIDIM:
		/* res =etos-etos-1. If r<0 %THEN r=0                                       */

#if(Language==FORTRAN)
		Elevel-=2;
		Cdim(IntType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ERDIM:
		/* Result=(etos-etos-1) %IF <0 %THEN =0                                     */

#if(Language==FORTRAN)
		Elevel-=2;
		Cdim(RealType,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;

		/***/
	case EIMERGE1:

		Elevel-=3;
		Cmerge1(IntType,Estktos,&Stk [Elevel+1],Estktosm1);
		goto wayout;
		/***/
	case ERMERGE1:

		Elevel-=3;
		Cmerge1(RealType,Estktos,&Stk [Elevel+1],Estktosm1);
		goto wayout;
	case EMERGE2:

#if(Language==FORTRAN)
		Elevel-=5;
		Cmerge2(Estktos,&Stk [Elevel+2],&Stk [Elevel+1],Estktosm1,&Stk [Elevel+3]);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIMIN:
		/* result = the lower of etos and etos-1                                    */
	case ERMIN:
		/* result = the lower of etos and etos-1                                    */
	case EIMAX:
		/* result = the higher of etos and etos-1                                   */
	case ERMAX:
		/* result = the higher of etos and etos-1                                   */

#if(Language==FORTRAN)
		Elevel-=2;
		Cminmax(opcode-EIMIN,Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EDMULT:

#if(Language==FORTRAN)
		Elevel-=2;
		Cdmult(Estktosm1,Estktos);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ECHAR:
		/* Store char(Etos) into etos-1    */

#if(Language==FORTRAN)
		estklit(1);
		eop(CVTII);
		epromote(2);
		erefer(0,1);
		eop(ESTORE);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EICHAR:
		/* Pick up byte and expand to int  */

#if(Language==FORTRAN)
		erefer(0,(UintType<<24)|1);
		estklit(4);
		eop(CVTUI);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EINDEXCHAR:

#if(Language==FORTRAN)
		if (Stk [Elevel-3].Form==LitVal)  Caddress(&Stk [Elevel-3]);
		if (Stk [Elevel-1].Form==LitVal)  Caddress(&Stk [Elevel-1]);
		/*for Unix compatibility call requires A1,A2,L1,L2*/
		epromote(3);
		epromote(2);
		CCset=0;
		Mspcall(F77index);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ECONCAT:

#if(Language==FORTRAN)
		CCset=0;
		Mspcall(F77concat);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EASGNCHAR:

#if(Language==FORTRAN)
		Elevel-=4;
		Cdocharop(opcode,&Stk [Elevel+1],&Stk [Elevel+2],&Stk [Elevel+3],&Stk [Elevel+4],0);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ECOMPCHAR:

#if(Language==FORTRAN)
		Elevel-=5;
		Cdocharop(opcode,&Stk [Elevel+1],&Stk [Elevel+2],&Stk [Elevel+3],&Stk [Elevel+4],Stk [Elevel+5].Intvalue
		    );
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EISHFT:
		/* General shift +ve=left -ve=right                                         */

#if(Language==FORTRAN)
		Cbitops(BitWordShift);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIBTEST:

#if(Language==FORTRAN)
		Cbitops(BitTest);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIBSET:

#if(Language==FORTRAN)
		Cbitops(BitSet);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIBCLR:

#if(Language==FORTRAN)
		Cbitops(BitClear);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EIBITS:

#if(Language==FORTRAN)
		if ((Estktos->Form==LitVal)&&(Estktos->Intvalue==0)) {
			Bytes=Stk [Elevel-2].Size;
			Cdiscardopnd(Estktosm1);
			Cdiscardopnd(&Stk [Elevel-2]);
			Elevel-=3;
			estklit(0);
			Stk[Elevel].Size=Bytes;
			goto wayout;
		}
		Cbitops(BitFieldExtract);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EISHFTC:

#if(Language==FORTRAN)
		Cbitops(BitFieldRotate);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case PROCARG:

#if(Language==FORTRAN)
		Elevel-=1;
		eprocref(Estktos->Intvalue,0);
		eop(PUSHVAL);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case ARGPROCCALL:
		/* bytes of params over pointer    */

#if(Language==FORTRAN)
		eop(ARGPROC);	/* can use standard method                                    */
		/* following redefinition of ARGPROC                                         */
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case NOTEIORES:

#if(Language==FORTRAN)

#if(Target==PENTIUM)
		CnoteIOres();
#endif	/*needs saved*/

		/*other targets require no special attention - stays in result reg*/
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case STKIORES:

#if(Language==FORTRAN)

#if(Target==PENTIUM)
		CstkIOres();

#else
		estkresult(0,1,4);

#endif
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case CALLTPLATE:
		goto wayout;
		/***/
	case EFDVACC:
		/* Running total opern. Reg to be preserved and restacked                   */

#if(Language==FORTRAN)
		/**/
		/* Initially:    ETos is X          */
		/*               Etos-1 = Y         */
		/*               Etos-2 = Z         */
		/* After the operation              */
		/*               Etos   = Y         */
		/*               Etos-1 = Z+Y*X     */
		/**/
		/* On RISC machines there seems no point in calling bespoke routines         */
		/* only on VME where there is a suitable instruction does a                  */
		/* bespoke routine have potential benefits                                   */
		/**/

#if(Target==VMEPLI)
		Elevel-=1;
		Cfdvacc(Estktos);

#else
		eop(EXCH);
		eop(DUPL);	/* leaving Y,Y,X,Z                                   */
		epromote(3);
		eop(EXCH);	/* leaving Y,X,Y,Z                                 */
		eop(IMULT);
		epromote(3);	/* leaving Z,Y*X,Y                                */
		eop(IADD);
		eop(EXCH);	/* leaving Y,Z+Y*X                                   */

#endif
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EFNOTEVR:

#if(Language==FORTRAN)
		eop(EINTRES);
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;
		/***/
	case EFSETVR:

#if(Language==FORTRAN)
		Cstkvr();
		/* %if Language=FORTRAN */
		;
#endif
		goto wayout;

		/**/
		/* The following section of code is for PASCAL. All the PASCAL specials      */
		/* are here unless they are not supported in this simple implementation      */
		/**/
	case UNMOD:
	case INMOD:
	case IMDIV:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CIntBinaryOp(opcode,Estktosm1,Estktos,0);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETI:
	case SETU:
	case SETD:
	case SETSD:

#if((Language==PASCAL)||(Language==MODULA))
		Stk [Elevel].Type=UintType;
		Stk [Elevel-1].Type=UintType;
		Stk [Elevel-2].Type=UintType;
		Bytes=Stk [Elevel].Size;
		if (Bytes<=4) {
			if (opcode==SETD)  eop(INOT);
			Stk [Elevel].Size=Bytes;
			if (opcode==SETU)  opcode=IOR;
			else if (opcode==SETSD)  opcode=IXOR;
			else opcode=IAND;
			;
			eop(opcode);
		} else {
			estklit(Bytes);
			Elevel-=3;
			CSetBinaryOp(opcode,&Stk [Elevel+1],&Stk [Elevel+2],&Stk [Elevel+3]);
		}
		Stk [Elevel].Size=Bytes;
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETEQ:
	case SETNE:

#if((Language==PASCAL)||(Language==MODULA))
		Bytes=Estktos->Size;
		if (Bytes<=4) {
			eop((UEQ-SETEQ)+opcode);
		} else {
			Caddress(Estktosm1);
			Caddress(Estktos);
			estklit(Bytes);
			eop((CPBEQ-SETEQ)+opcode);
		}
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETIN:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CSetMemberOp(Estktosm1,Estktos);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETLE:

#if((Language==PASCAL)||(Language==MODULA))
		eop(DUPL);
		epromote(3);
		eop(SETU);
#endif	/*%if Language=PASCAL %or Language=MODULA*/
		eop(SETEQ);
		goto wayout;

	case SETSING:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		Bytes=Estktos->Intvalue;
		CSetBinaryOp(opcode,Estktosm1,Estktosm1,Estktos);
		Stk [Elevel].Size=Bytes;
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETRANGE:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		Bytes=Estktos->Intvalue;
		CSetBinaryOp(opcode,&Stk [Elevel+1],Estktosm1,Estktos);
		Stk [Elevel].Size=Bytes;
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETINCL:
	case SETEXCL:

#if((Language==PASCAL)||(Language==MODULA))
		if (Estktos->Size<=4) {
			if (Estktosm1->Form==LitVal) {
				Estktosm1->Intvalue=1<<Estktosm1->Intvalue;
				if (opcode==SETEXCL)  Estktosm1->Intvalue=~Estktosm1->Intvalue;
				eop(EXCH);
			} else {
				eop(EXCH);
				estklit(1);
				eop(EXCH);
				eop(ISHLL);
				if (opcode==SETEXCL)  eop(INOT);
			}
			if (opcode==SETINCL)  eop(IORST);
			else eop(IANDST);
			;
			return ;
		}
		Elevel-=2;
		CSetBitOp(opcode,Estktosm1,Estktos);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UPBITII:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CBitFieldOp(ExtractII);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UPBITUU:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CBitFieldOp(ExtractUU);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UPBITIU:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CBitFieldOp(ExtractIU);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UPBITUI:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CBitFieldOp(ExtractUI);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case INDEXBITS:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		CIndexpf(Estktos->Intvalue,&Stk [Elevel+1],Estktosm1);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SAVEBITREF:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		CSaveBitRef(Estktos,Estktosm1);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case RESTBITREF:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=1;
		CRestBitRef(Estktos);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case BITADDR:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=1;
		CBitAddr(Estktos);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case ISQR:

#if((Language==PASCAL)||(Language==MODULA))
		eop(DUPL);
		eop(IMULT);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case RSQR:

#if((Language==PASCAL)||(Language==MODULA))
		eop(DUPL);
		eop(RMULT);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKIOVF:

#if((Language==PASCAL)||(Language==MODULA))
		JumpPredictFlag=1;
		Elevel-=1;
		Cjump(Icompare|OVERFLOWcc,Stk [Elevel+1].Intvalue,0);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKUOVF:

#if((Language==PASCAL)||(Language==MODULA))
		JumpPredictFlag=1;
		Elevel-=1;
		Cjump(UIcompare|OVERFLOWcc,Stk [Elevel+1].Intvalue,0);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKROVF:

#if((Language==PASCAL)||(Language==MODULA))
		/* this is done by hardware */
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case TRAPOVF:

#if((Language==PASCAL)||(Language==MODULA))
		CSetFPUTraps();
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKRNG:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=4;
		CCheckRange(Icompare,&Stk [Elevel+1],&Stk [Elevel+2],Estktosm1,Estktos->Intvalue);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UCHKRNG:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=4;
		CCheckRange(UIcompare,&Stk [Elevel+1],&Stk [Elevel+2],Estktosm1,Estktos->Intvalue);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case RCHKRNG:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=4;
		CCheckRange(Rcompare,&Stk [Elevel+1],&Stk [Elevel+2],Estktosm1,Estktos->Intvalue);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKSETRNG:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=4;
		CCheckSetRange(&Stk [Elevel+1],Stk [Elevel+2].Intvalue,Estktosm1->Intvalue,Estktos->Intvalue);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case CHKXX:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		CCheckXX(Icompare|(Estktos->Intvalue&7),&Stk [Elevel+1],Estktosm1,(unsigned)Estktos->Intvalue>>3);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case UCHKXX:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		CCheckXX(UIcompare|(Estktos->Intvalue&7),&Stk [Elevel+1],Estktosm1,(unsigned)Estktos->Intvalue>>3)
		    ;
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case RCHKXX:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=3;
		CCheckXX(Rcompare|(Estktos->Intvalue&7),&Stk [Elevel+1],Estktosm1,(unsigned)Estktos->Intvalue>>3);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SAVESTK:
	case RECOVERSTK:

#if((Language==PASCAL)||(Language==MODULA))
		/* nops for SPARC since window structure mechanism does equivalent           */
		Elevel-=1;

#if(Target==M88K)
		CStackPtrOp(opcode,Estktos);
#endif
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case BAND:

#if((Language==PASCAL)||(Language==MODULA))
		eop(IAND);
		estklit(1);
		eop(ESIZE);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case BOR:

#if((Language==PASCAL)||(Language==MODULA))
		eop(IOR);
		estklit(1);
		eop(ESIZE);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case STRTOCH:
	case STRPLUS:
	case STRMOVE:
	case PUSHSTR:

#if((Language==PASCAL)||(Language==MODULA))
		CStringOp(opcode);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

	case SETOPTION:

#if((Language==PASCAL)||(Language==MODULA))
		Elevel-=2;
		MAdjustOptions(Estktosm1->Intvalue,Estktos->Intvalue);
		goto wayout;
#endif	/*%if Language=PASCAL %or Language=MODULA*/

		/***/
		/***/
		/** This section covers all the C and C++ specials supported in this generator*/
		/***/
		/***/
		/***/
	case ECSTORE:

#if(Language==CCOMP)
		/**/
		/* This is an attempt by C to redefine MVB without using addresses. It was not*/
		/* originally envisaged that front ends would stack multi word items as itemas*/
		/* It is possible to implement this efficienctly by using  Addrss and MVB    */
		/* However there is a frig for FORTRAN in address to enable a result in a reg*/
		/* to be passed by reference. Must stop C falling over this Frig by a counterfrig*/
		/* To clean this area up :-         */
		/*    1) FORTRAN should allocate temps for refernce expressions(Like IMP&PASCAL)*/
		/*    2) C should abandon this and use MVB                                   */
		/**/
		I=Estktos->Size;
		if (Estktosm1->Size!=I)  Mabort(36);	/* inconsistant sizes */
		if ((Estktos->Form&31)!=RegVal)  Caddress(Estktosm1);
		Caddress(Estktos);
		estklit(I);
		eop(MVB);
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case ECPROCCALL:
		/* Call a procedure via a C pointer                                         */

#if(Language==CCOMP)
		/* However C has dereferenced the the pointer                                */
		/* os that it is the first word of the 4                                     */
		/* Not a pointer to the 4           */
		/* No provision for environment is made                                      */
		/* C can and should use the standard mechanism                               */
		if (Stk [Elevel].Size==0)  Stk [Elevel].Size=4;
		if ((Stk [Elevel].Form&31)==IndRegVal) {
			Stk [Elevel].Form=RegVal;
		} else {
			Caddress(Estktos);	/* Now a pointer to 4 words (cde,GLA,ep&env)             */
		}
		estklit(0);	/* Dummy environment means external proc                        */
		estklit(0);	/* Dummy bytes of params(not needed on EMAS)                    */
		eop(ARGPROC);	/* Now the normal mechanism applies                           */
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case EPUSHSTR:
		/* as PUSHBYTES but must be aligned (is on IBM)                             */

#if(Language==CCOMP)
		/* Designed to push a Structure as value parameter                           */
		/* IMP does the same means of       */
		/* SFA,ASF N and MVB aligning as REQD                                        */
		/* Instrn should be generalised or abandonned                                */
		Caddress(Estktosm1);
		eop(PUSHBYTES);
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case ELDBITS:
		/* Extract a bit field             */

#if(Language==CCOMP)

#if(Language==CCOMP)
#endif
		Elevel-=3;
		CLDBits(&Stk [Elevel+1],Stk [Elevel+2].Intvalue,Stk [Elevel+3].Intvalue);
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case ESTBITS:
		/* Store a bit field               */

#if(Language==CCOMP)
		{
		int BStart,NBits,DestLabel,Flags,Arthop;
		Elevel-=2;
		BStart=Stk [Elevel+1].Intvalue;
		NBits=Stk [Elevel+2].Intvalue;
		eop(DUPL);
		epromote(3);
		epromote(2);
		Elevel-=2;
		CSTBits(&Stk [Elevel+1],&Stk [Elevel+2],BStart,NBits,ECdupflag);
		if (ECdupflag!=0)  epromote(3); else epromote(2);
		ECdupflag=0;
		eop(ESTORE);
		}
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
		/**/
		/* The following register to store operations are entirely reasonable and    */
		/* should be moved into the standard set. The use of ECdupflag remains a     */
		/* horrible expedient which should be phased out as soon as possible.        */
		/**/
	case UADDST:
	case USUBST:

#if((Language==CCOMP)||(Language==PASCAL)||(Language==MODULA))
		if (Elevel>2)  MCurrentvalue(&Stk [Elevel-1],Elevel-2);
		if ((Stk [Elevel-1].Form&31)==Regvar) {
			Elevel-=2;
			CregSTop(Regop [opcode-UADDST],ECdupflag,&Stk [Elevel+1],&Stk [Elevel+2]);
		} else {
			epromote(2);
			eop(DUPL);
			epromote(3);
			eop((UADD+opcode)-UADDST);
			epromote(2);
			eop(ESTORE+ECdupflag);
		}
		ECdupflag=0;
		;
#endif
		goto wayout;

	case UMULTST:

#if((Language==CCOMP)||(Language==PASCAL)||(Language==MODULA))
		eop(Uopst [opcode-UADDST]);
		goto wayout;
		/* %if Language=CCOMP %or Language=PASCAL %or Language=MODULA */
		;
#endif
		/***/
		/***/
	case ISHLST:
	case ISHRST:
	case ISHRAST:

#if(Language==CCOMP)
		if ((Language==CCOMP)&&((Stk [Elevel-1].Form&31)==RegVal)) {
			Mabort(57);
		} else {
			/**/
			/* Check out lower reaches of Estack for any DUPLicates                      */
			/**/
			if (Elevel>2)  MCurrentvalue(&Stk [Elevel-1],Elevel-2);
			if ((Stk [Elevel-1].Form&31)==Regvar) {
				Elevel-=2;
				if (opcode==ISHLST)  opcode=ISHLL;
				if (opcode==ISHRST)  opcode=ISHRL;
				if (opcode==ISHRAST)  opcode=ISHRA;
				CregSTop(opcode,ECdupflag,&Stk [Elevel+1],&Stk [Elevel+2]);
			} else {
				epromote(2);
				eop(DUPL);
				epromote(3);
				eop(Ropst [opcode-RADDST]);
				epromote(2);
				eop(ESTORE+ECdupflag);
			}
			ECdupflag=0;
		};
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case RADDST:
	case RSUBST:
	case RMULTST:
	case RDIVST:

#if(Language==CCOMP)
		/**/
		/* Check out lower reaches of Estack for any DUPLicates                      */
		/**/
		if (Elevel>2)  MCurrentvalue(&Stk [Elevel-1],Elevel-2);
		if ((Stk [Elevel-1].Form&31)==Fregvar) {
			Elevel-=2;
			CFregSTop(Ropst [opcode-RADDST],ECdupflag,&Stk [Elevel+1],&Stk [Elevel+2]);
		} else {
			epromote(2);
			eop(DUPL);
			epromote(3);
			eop(Ropst [opcode-RADDST]);
			epromote(2);
			eop(ESTORE+ECdupflag);
		}
		ECdupflag=0;
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
		/**/
		/* It is sometimes necessary to force an evaluation to contain possible side */
		/* effects in expressions.          */
		/**/
	case CEVAL:

#if(Language==CCOMP)
		if (Elevel>1)  MCurrentvalue(&Stk [Elevel],Elevel-1);
#endif	/* if Language=ccomp */
		goto wayout;
		/**/
		/* The next two operations are unnecessary. They exactly duplicate the       */
		/* Estack manipulation routines "EPROMOTE" and EDEMOTE" in the standard set. */
		/* These two operations should be phased out.                                */
		/**/
	case ECSAVE:

#if(Language==CCOMP)
		eop(DUPL);
		I=Elevel-1;
		while (I>0) {
			epromote(Elevel);
			I--;
		}
		Numcsave++;
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case ECRESTORE:

#if(Language==CCOMP)
		epromote((Elevel-Numcsave)+1);
		Numcsave--;
#endif	/* if Language=ccomp */
		goto wayout;
		/***/
	case CDUPADD:
	case CDUPSUB:

#if(Language==CCOMP)
		{
			if (ECdupflag!=0)  Mabort(57);
			/**/
			/* Check out lower reaches of Estack for any duplicates                      */
			/**/
			if (Elevel>3)  MCurrentvalue(&Stk [Elevel],Elevel-3);
			if (opcode==CDUPADD)  Arthop=IADD;
			else Arthop=ISUB;
			;
			if ((Stk [Elevel].Form&31)==Regvar) {
				/*************************************************/
				/* We are incrementing or decrementing a RegVar **/
				/*************************************************/
				Elevel-=2;
				CregSTop(Arthop,0,&Stk [Elevel+2],&Stk [Elevel+1]);
			} else {
				/*************************************************/
				/* We are incrementing or decrementing a        **/
				/* non-RegVar. (ETos-2) holds a RegVal copy of  **/
				/* the value to be inc/dec.                     **/
				/* if estack is A/B/C %THEN do A=B+C            **/
				/* and then push C again                        **/
				/*************************************************/

#if((Target==M88K)&&(LanguageVariant==USLC))
				/* we use old method until M88K eop(DUPL) improves */
				Elevel-=2;
				CStoreETOS();
				Elevel+=2;
				epromote(3);
				epromote(3);
				eop(Arthop);
				epromote(2);
				eop(ESTORE);
				CRestoreETOS();

#else
				epromote(3);
				eop(DUPL);	/* now have c,c,a,b                                */
				epromote(4);	/* now have b,c,c,a   */
				eop(Arthop);	/* now have (b+c),c,a */
				epromote(3);	/* now have a,(b+c),c */
				eop(ESTORE);	/* now just have c left (qef)                                  */

#endif
			}
		};
		/* %if Language=CCOMP */

#endif
		goto wayout;
		/***/
	}
}	/* Eop    */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void ef77op(int Opcode) {
	/*************************************************************************/
	/** opcodes specifically defined for use by FORTRAN                     **/
	/*************************************************************************/
	eop(Opcode);
}	/* Ef77op  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
/***/
void epasop(int Opcode) {
	/*************************************************************************/
	/** opcodes specifically defined for use by PASCAL and MODULA-2         **/
	/*************************************************************************/
	eop(Opcode);
}	/* EPasop  */
/***/
/**/
/* Copyright (c) 1989 Edinburgh Portable Compilers Ltd.  All Rights Reserved.*/
/**/
/***/
void eccop(int Opcode) {
	/*************************************************************************/
	/** opcodes specifically defined for use by C and C++                   **/
	/*************************************************************************/
	eop(Opcode);
}	/* Eccop   */
/***/
void eparallel(int OpIndex,int Label,int Area,int Offset,int Size) {
	/*************************************************************************/
	/** Index = 98 generate start of forked section                         **/
	/** Index = 97 generate instructions to savelast private variables      **/
	/** Index = 96 generate leave and return code for end of parallel region**/
	/*************************************************************************/
	int i;
	int props,aparamprops,pid;
	char pname [64] ;
	int ap [5+1];
	if (Report!=0) {
		printf("Eparallel Op=%d Lab=%d area=%d Off=%d Size=%d\n",
		    OpIndex,Label,Area,Offset,Size);
		Cdumpestack();
	}
	if (ProgFaulty!=0)  return ;
	switch (OpIndex) {
	case 98:

		props=0x24;
		ap [0]=2;
		ap [1]=8;
		ap [2]=0;
		ap [3]=0;
		ap [4]=0x4;
		ap [5]=0x4;
		aparamprops=(int)&ap [0];
		parfork++;
		/*       pname="k_pf".itos(parfork) */
	
		i=sprintf(pname,"%s_k_pf%d",parprefix,parfork);
		pid=0;
		/*       Eproc2(pname,props,aparamprops,pid)                                 */
		ecentry3(pname,aparamprops,&pid);
		i=Msetprocref(Area,Offset,pname,pid);
		return ;
		/***/
	case 97:

		return ;
		/***/
	case 96:

		eop(RETURN);
		/*      i=eprocend(Label,0,0)        */
		return ;
	case 95: 	/* kaps data sync */
		Cgeneratenop();
		return ;
	}
}	/* eparallel   */