Rev 2 | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Copyright (c) 1993 Open Software Foundation, Inc.
All Rights Reserved
Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appears in all
copies and that both the copyright notice and this permission
notice appear in supporting documentation.
OSF DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING
ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE.
IN NO EVENT SHALL OSF BE LIABLE FOR ANY SPECIAL, INDIRECT, OR
CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
LOSS OF USE, DATA OR PROFITS, WHETHER IN ACTION OF CONTRACT,
NEGLIGENCE, OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*/
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
/**********************************************************************
$Author: release $
$Date: 1998/02/04 15:48:44 $
$Revision: 1.2 $
$Log: eval.c,v $
* Revision 1.2 1998/02/04 15:48:44 release
* Added OSF copyright message.
*
* Revision 1.1.1.1 1998/01/17 15:55:56 release
* First version to be checked into rolling release.
*
* Revision 1.3 1996/10/14 17:31:42 pwe
* include called callees in env_size
*
* Revision 1.2 1996/10/04 16:00:31 pwe
* add banners and mod for PWE ownership
*
**********************************************************************/
/*****************************************************************
eval.c
The main procedure defined here is evaluated which outputs
assembler for data. The parameters are an evaluated exp and an index
into the table of externals (or 0 meaning anonymous).
*****************************************************************/
#include "config.h"
#include <ctype.h>
#include "memtdf.h"
#include "codegen.h"
#include "geninst.h"
#include "myassert.h"
#include "maxminmacs.h"
#include "flpttypes.h"
#include "flpt.h"
#include "machine.h"
#include "translat.h"
#include "comment.h"
#include "eval.h"
#include "frames.h"
#include "f64.h"
extern FILE *as_file;
long correct_shape PROTO_S ((long, int));
/* various pieces of info for outputting data depending on shape */
static mm scmm = {127, -128, "\t.byte\t%ld\n"};
static mm uscmm = {255, 0, "\t.byte\t%ld\n"};
static mm shmm = {0x7fff, 0xffff8000, "\t.short\t%ld\n"};
static mm ushmm = {0xffff, 0, "\t.short\t%ld\n"};
static mm swmm = {0x7fffffff, 0x80000000, "\t.long\t%ld\n"};
static mm uswmm = {0xffffffff, 0, "\t.long\t%ld\n"};
/* number for anonymous label in data space - L.Dnnn */
int next_data_lab PROTO_Z ()
{
static int data_lab = 100;
return ++data_lab;
}
/*************************************************************
maxmin
finds the data size from the range of an integer shape
**************************************************************/
mm maxmin PROTO_N ((s)) PROTO_T (shape s)
{
switch (name(s))
{
case scharhd:
return scmm;
case ucharhd:
return uscmm;
case swordhd:
return shmm;
case uwordhd:
return ushmm;
case slonghd:
return swmm;
case ulonghd:
return uswmm;
default:
return uswmm;
}
}
/**************************************************************
outlab
outputs the label parameter if non negative else interprets it
to be an index into the externals and outputs the identifier.
**************************************************************/
void outlab PROTO_N ((l)) PROTO_T (int l)
{
fprintf(as_file, "%s", ext_name(l));
}
/* translate time evaluate integer exp 'e' */
long evalexp PROTO_N ((e)) PROTO_T (exp e)
{
switch (name(e))
{
case null_tag:case top_tag:
return 0;
case val_tag:
{
/* offsets appear as bits, but are converted to bytes if alignment
is not bits */
if (name(sh(e)) == offsethd && al2(sh(e)) >= 8)
{
return (no(e)>>3);
}
return no(e);
}
case env_size_tag :
{
exp tg = son(son(e));
procrec *pr = &procrecs[no(son(tg))];
return ((pr->frame_size)>>3) + pr->max_callee_bytes;
}
case offset_add_tag : {
return (evalexp(son(e)) + evalexp(bro(son(e))));
}
case offset_max_tag : {
return (max(evalexp(son(e)),evalexp(bro(son(e)))));
}
case offset_pad_tag : {
return (rounder(evalexp(son(e)),shape_align(sh(e))));
}
case offset_mult_tag : {
return (evalexp(son(e))*evalexp(bro(son(e))));
}
case offset_div_tag :
case offset_div_by_int_tag : {
return (evalexp(son(e))/evalexp(bro(son(e))));
}
case offset_subtract_tag : {
return (evalexp(son(e))-evalexp(bro(son(e))));
}
case offset_negate_tag : {
return (- evalexp(son(e)));
}
case chvar_tag:
{
return correct_shape(evalexp(son(e)),name(sh(e)));
}
case bitf_to_int_tag:
{
return evalexp(son(e));
}
case int_to_bitf_tag:
{
ash a;
unsigned long w = evalexp(son(e));
a = ashof(sh(e));
if (a.ashalign != 1)
{
fail("should be align 1");
}
if (a.ashsize != 32)
{
w &= ((1 << a.ashsize) - 1);
}
return w;
}
case not_tag:
{
return correct_shape(~evalexp(son(e)),name(sh(e)));
}
case and_tag:
{
return (evalexp(son(e)) & evalexp(bro(son(e))));
}
case or_tag:
{
return (evalexp(son(e)) | evalexp(bro(son(e))));
}
case xor_tag:
{
return (evalexp(son(e)) ^ evalexp(bro(son(e))));
}
case shr_tag:
{
bool sgned = is_signed(sh(e));
long sl;
unsigned long ul;
if (sgned)
{
sl = (long)correct_shape(evalexp(son(e)),name(sh(e)));
return ( sl >> evalexp(bro(son(e))) );
}
else
{
ul = (unsigned long)correct_shape(evalexp(son(e)),name(sh(e)));
return ( ul >> evalexp(bro(son(e))) );
}
}
case shl_tag:
{
return correct_shape(evalexp(son(e))<<evalexp(bro(son(e))),name(sh(e)));
}
case concatnof_tag:
{
unsigned long w_lhs = evalexp(son(e));
unsigned long w_rhs = evalexp(bro(son(e)));
ash ash_lhs, ash_rhs;
ash_lhs = ashof(sh(son(e)));
ash_rhs = ashof(sh(bro(son(e))));
ASSERT(ash_lhs.ashalign==1 && ash_lhs.ashsize<=32);
ASSERT(ash_rhs.ashalign==1 && ash_rhs.ashsize<=32);
ASSERT(ash_lhs.ashsize+ash_rhs.ashsize<=32);
FULLCOMMENT4("evalexp() concatnof_tag: lhs,rhs=%#x,%#x ash(rhs)=%d,%d",
w_lhs, w_rhs, ash_rhs.ashalign, ash_rhs.ashsize);
if (ash_rhs.ashsize == 32)
{
/* avoid illegal shift by 32 */
ASSERT(w_lhs==0);
return w_rhs;
}
return (w_lhs << ash_rhs.ashsize) | w_rhs;
}
case clear_tag:
{
ash a;
a = ashof(sh(e));
FULLCOMMENT2("evalexp() clearshape_tag: ash=%d,%d", a.ashalign, a.ashsize);
if (a.ashsize > 32)
fail("clear for more than 32 bits");
return 0;
}
case env_offset_tag:
case general_env_offset_tag:
{
return frame_offset(son(e));
}
default:
COMMENT1("tag not in evalexp: %d", name(e));
fail("tag not in evalexp");
return 0;
}
/*NOTREACHED*/
}
struct concbittypet {
int bitposn;
int value_size;
unsigned long value;
};
typedef struct concbittypet concbittype;
static concbittype emptyconcbit PROTO_N ((bitposn)) PROTO_T (int bitposn)
{
concbittype start;
start.bitposn = bitposn;
start.value_size = 0;
start.value = 0;
return start;
}
static void outconcbit PROTO_N ((c)) PROTO_T (concbittype c)
{
unsigned long w = c.value;
int bytes = (c.value_size + 7) / 8;
int i;
COMMENT2("outconcbit: bits=%d w=%#lx", c.value_size, w);
if (c.value_size==0)
return; /* avoid .byte with no data */
ASSERT(c.value_size<=32);
/* to left end of word */
if (c.value_size != 32)
w = w << (32-c.value_size);
/* POWER assembler only permits .long for 32-bit aligned values */
/* output enough bytes */
fprintf(as_file, "\t.byte\t");
for (i = 0; i < bytes; i++)
{
if (i != 0)
fprintf(as_file, ",");
fprintf(as_file, "%#lx", (w >> 24) & 255);
w = w << 8;
}
fprintf(as_file, "\n");
ASSERT(w == 0);
}
/*
Output a unary representation of the number val. val should be
less than or equal to 31 as it represent the number of bits
in a bitfield which does not occupy a whole machine word.
*/
long unary PROTO_N ((val)) PROTO_T (int val)
{
int loop;
long result=0;
ASSERT(val <=31);
for(loop=0;loop<val;++loop)
{
result <<=1;
result |= 1;
}
return result;
}
static concbittype addconcbitaux PROTO_N ((w,size,before)) PROTO_T (unsigned long w X int size X concbittype before)
{
int wordbitposn; /* 0..32 bit position in current word,
* 0 only at start of bit sequence */
if (before.value_size==32 || (before.value_size != 0 && (before.bitposn&31)==0))
{
ASSERT((before.bitposn&31)==0);
wordbitposn = 32;
}
else
{
wordbitposn = (before.bitposn&31);
}
FULLCOMMENT2("addconcbitaux() sz=%d w=%d",
size, w);
FULLCOMMENT4("\tbefore=%d(%d) %#x:%d",
before.bitposn, wordbitposn, before.value, before.value_size);
#if 0
ASSERT(size>0); /* no longer have to handle zero for C */
#endif
ASSERT(size<=32);
ASSERT(before.value_size<=32);
ASSERT(wordbitposn==0 || before.value_size<=wordbitposn);
if (
(size == 0 && (wordbitposn != 0 || before.value_size != 0))
||
(wordbitposn + size > 32)
)
{
/*
* C zero size bitfield, align to word boundary; or
* would go over word boundary, so output before and padding.
*/
int pad_bits = 32 - wordbitposn;
#if 1
ASSERT(pad_bits==0); /* padding should now be explicit */
before.value_size += pad_bits;
before.value <<= pad_bits;
#endif
outconcbit(before);
/* clear before, as it has been output */
before.bitposn += pad_bits;
before.value_size = 0;
before.value = 0;
/* should be at word boundary */
ASSERT((before.bitposn&31)==0);
}
if (size == 0)
return before;
/* add to before */
before.bitposn += size;
before.value_size += size;
if (size == 32)
before.value = w;
else
before.value = (before.value << size) | (w & unary(size));
FULLCOMMENT4("\t after=%d(%d) %#x:%d",
before.bitposn, wordbitposn, before.value, before.value_size);
ASSERT(before.value_size<=32);
return before;
}
static concbittype evalconcbitaux PROTO_N ((e,before)) PROTO_T (exp e X concbittype before)
{
switch (name(e))
{
case concatnof_tag:
{
concbittype lhs, rhs;
lhs = evalconcbitaux(son(e), before);
rhs = evalconcbitaux(bro(son(e)), lhs);
return rhs;
}
default:
{
ASSERT(shape_align(sh(e))==1);
return addconcbitaux(evalexp(e), shape_size(sh(e)), before);
}
}
}
static void evalconcbit PROTO_N ((e,bitposn)) PROTO_T (exp e X int bitposn)
{
concbittype start;
start = emptyconcbit(bitposn);
outconcbit(evalconcbitaux(e, start));
}
static void set_align PROTO_N ((al)) PROTO_T (int al)
{
/* output .align if needed */
switch (al)
{
case 0:
case 1:
case 8:
break;
case 16:
fprintf(as_file, "\t.align\t1\n");
break;
case 32:
fprintf(as_file, "\t.align\t2\n");
break;
case 64:
fprintf(as_file, "\t.align\t3\n");
break;
default:
fail("unexpected alignment");
}
}
static void evalone PROTO_N ((e,bitposn)) PROTO_T (exp e X int bitposn)
{
ash a;
a = ashof(sh(e));
COMMENT4("evalone: name(e)=%d, bitposn=%d, ash=%d,%d", name(e),
bitposn, a.ashsize, a.ashalign);
COMMENT1("evalone no(e)=%d",no(e));
set_align(a.ashalign);
/* align bitposn */
if (a.ashalign != 0)
{
bitposn = (bitposn / a.ashalign) * a.ashalign;
}
/* generate data initialiser for e */
switch (name(e))
{
case string_tag:
{
long char_size = props(e); /* bits width of each output char */
long strsize = shape_size(sh(e)) / char_size;
unsigned char *st = (unsigned char *)nostr(e);
int i;
if (char_size != 8 )
{
/* wide chars, generate a .XXX line for each */
for (i = 0; i <strsize; i++)
{
unsigned int c;
char *directive;
switch(char_size)
{
case 16:
c = ((unsigned short *)st)[i];
directive = ".short";
break;
case 32:
c = ((unsigned int *)st)[i];
directive = ".long";
break;
/* +++ case 64 ??? */
default:
fail("unexpected wide char data width");
}
fprintf(as_file, "\t%s\t%#x\n", directive, c);
}
return;
}
/* output as ascii where possible for the human reader */
while (strsize > 0)
{
int c = *st;
if (c >= 32 && c < 127)
{
fprintf(as_file, "\t.byte\t\"");
for (i = 0; strsize > 0 && i < 48 && c >= 32 && c < 127; i++)
{
if (c != '"')
putc(c, as_file);
else
fprintf(as_file, "\"\""); /* " represented as "" */
st++;
strsize--;
c = *st;
}
fprintf(as_file, "\"\n");
}
else
{
fprintf(as_file, "\t.byte\t");
for (i = 0; strsize > 0 && i < 16 && !(c >= 32 && c < 127); i++)
{
if (i != 0)
fprintf(as_file, ",");
fprintf(as_file, "%d", c);
st++;
strsize--;
c = *st;
}
fprintf(as_file, "\n");
}
}
return;
}
case real_tag:
{
flt *f = flptnos + no(e);
r2l v;
if (a.ashsize==32)
{
v=real2longs_IEEE(f,0);
fprintf(as_file,"\t.long\t");
fprintf(as_file,"%ld",(long)v.i1);
}
else if (a.ashsize==64)
{
v=real2longs_IEEE(f,1);
fprintf(as_file,"\t.long\t");
fprintf(as_file,"%ld",(long)v.i2);
fprintf(as_file,",");
fprintf(as_file,"%ld",(long)v.i1);
}
else
{
v=real2longs_IEEE(f,2);
fprintf(as_file,"\t.long\t");
fprintf(as_file,"%ld",(long)v.i4);
fprintf(as_file,",");
fprintf(as_file,"%ld",(long)v.i3);
fprintf(as_file,",") ;
fprintf(as_file,"%ld",(long)v.i2);
fprintf(as_file,",");
fprintf(as_file,"%ld",(long)v.i1);
}
fprintf(as_file, "\n") ;
return;
}
case null_tag:case top_tag:
no(e) = 0;
/* FALLTHROUGH */
case val_tag:
{
char *asdata;
FULLCOMMENT1("evalone() val_tag: %d", val_tag);
/* allow 64 bit integers */
if (shape_size(sh(e))>32)
{
flt64 temp;
int ov;
if (isbigval(e))
{
temp = flt_to_f64(no(e), 0, &ov);
}
else
{
temp.big = (is_signed(sh(e)) && no(e)<0)?-1:0;
temp.small = no(e);
}
fprintf(as_file,"\t.long\t%ld\n",(long)temp.small);
fprintf(as_file,"\t.long\t%ld\n",(long)temp.big);
return;
}
/* allow for bitfields */
if (a.ashalign == 1)
{
evalconcbit(e, bitposn);
return;
}
if (a.ashalign <= 8)
{
asdata = ".byte";
}
else if (a.ashalign <= 16)
{
asdata = ".short";
}
else
{
asdata = ".long";
}
fprintf(as_file, "\t%s\t%ld\n", asdata, evalexp(e));
return;
}
case name_tag:
{
dec *globdec = brog(son(e));
char *nm = globdec->dec_u.dec_val.dec_id;
ASSERT(isglob(son(e)));
/* no() is offset */
if (no(e) == 0)
{
fprintf(as_file, "\t.long\t%s\n", nm);
}
else
{
fprintf(as_file, "\t.long\t%s+%ld\n", nm, (long)(no(e)/8));
}
return;
}
case compound_tag:
{
/*
* There is a lot of history in the following code, dating from
* when tuples were without specified offsets for each field.
* Really, this code should be totally rewritten.
*/
int maxalign = a.ashalign;
exp off = son(e);
exp tup = bro(off);
ash tupa;
concbittype remainderbits;
long last_offset = 0;
long last_align = 0;
tupa = ashof(sh(tup));
remainderbits = emptyconcbit(bitposn);
/* output elements of aggregate recursively */
while (1)
{
int gap = no(off) - remainderbits.bitposn;
COMMENT4("evalone compound_tag: gap=%d off=%d ash=%d,%d",
gap, no(off), tupa.ashsize, tupa.ashalign);
/* check that component's alignment matches offset in struct */
ASSERT((no(off)/tupa.ashalign)*tupa.ashalign <= no(off));
/* and is no greater that struct's alignment */
ASSERT(tupa.ashalign<=maxalign);
if (no(off) < last_offset)
fail("eval compound_tag: not ascending order");
if (last_align <= 1 || tupa.ashalign <= 1 || gap >= tupa.ashalign)
{
/* gap can be bigger than 32, but addconcbitaux can only handle <= 32 */
while (gap > 0)
{
remainderbits = addconcbitaux(0, 1, remainderbits);
gap--;
}
}
else
{
/* alignment will handle gap */
remainderbits.bitposn = ((remainderbits.bitposn + (tupa.ashalign-1)) / tupa.ashalign) * tupa.ashalign;
}
last_offset = no(off);
last_align = tupa.ashalign;
ASSERT(remainderbits.bitposn - bitposn == no(off));
/* consecutive bitfields must be collected together for .byte */
if (tupa.ashalign == 1)
{
remainderbits = evalconcbitaux(tup, remainderbits);
}
else
{
/* output final bits from any previous field */
outconcbit(remainderbits);
remainderbits = emptyconcbit(remainderbits.bitposn);
evalone(tup, remainderbits.bitposn);
remainderbits.bitposn += tupa.ashsize;
}
if (last(tup))
{
/* output final bits from any previous field */
long databits = no(off) + tupa.ashsize;
long trailing_bytes = (a.ashsize-databits) / 8;
outconcbit(remainderbits);
ASSERT(a.ashsize >= databits);
/* pad out trailing unitialised space, eg union */
if (a.ashsize > databits && trailing_bytes > 0)
{
fprintf(as_file, "\t.space\t%d\n", (int)trailing_bytes);
}
return;
}
off = bro(bro(off));
ASSERT(!last(off));
tup = bro(off);
tupa = ashof(sh(tup));
}
/*NOTREACHED*/
}
case nof_tag:
{
exp s = son(e);
for (;;)
{
evalone(s, bitposn);
if (last(s))
return;
s = bro(s);
}
/*NOTREACED*/
}
case ncopies_tag:
{
int n = no(e);
ash copya;
int bitsize;
int i;
COMMENT1("ncopies_tag: n=%d", n);
while (name(son(e)) == ncopies_tag)
{
e = son(e);
n *= no(e);
}
e = son(e);
copya = ashof(sh(e));
if (copya.ashalign != 0)
bitsize = (copya.ashsize / copya.ashalign) * copya.ashalign;
else
bitsize = 0; /* probably never happen! */
for (i = 0; i < n; i++)
{
COMMENT3("ncopies_tag: i=%d n=%d bitposn=%d", i, n, bitposn);
evalone(e, bitposn);
bitposn += bitsize;
}
return;
}
case concatnof_tag:
{
COMMENT2("concatnof_tag: ashalign=%d, ashsize=%d", a.ashalign, a.ashsize);
/* allow for bitfields */
if (a.ashalign == 1)
{
evalconcbit(e, bitposn);
}
else
{
ash a;
a = ashof(sh(son(e)));
evalone(son(e), bitposn);
bitposn += a.ashsize;
a = ashof(sh(bro(son(e))));
if (a.ashalign != 0)
bitposn = (bitposn / a.ashalign) * a.ashalign;
evalone(bro(son(e)), bitposn);
}
return;
}
case clear_tag:
{
/* allow for bitfields */
if (a.ashalign == 1)
{
evalconcbit(e, bitposn);
return;
}
fprintf(as_file, "\t.space\t%ld\n", (a.ashsize + 7) >> 3);
return;
}
case not_tag:
case and_tag:
case or_tag:
case shl_tag:
case shr_tag:
case bitf_to_int_tag:
case int_to_bitf_tag:
case chvar_tag:
case env_offset_tag:case env_size_tag:
case general_env_offset_tag:
case offset_add_tag : case offset_max_tag :
case offset_pad_tag : case offset_mult_tag : case offset_div_tag :
case offset_div_by_int_tag : case offset_subtract_tag :
case offset_negate_tag:
{
fprintf(as_file, "\t.long\t%ld\n", evalexp(e));
return;
}
case minptr_tag:
{
exp p1 = son(e);
exp p2 = bro(p1);
if (name(p1)==name_tag && name(p2)==name_tag)
{
long n = no(p1)-no(p2);
char *n1 = brog(son(p1))->dec_u.dec_val.dec_id ;
char *n2 = brog(son(p2))->dec_u.dec_val.dec_id ;
fprintf(as_file,"\t.long\t(%s-%s)",n1,n2);
if(n<0)
{
fprintf(as_file,"%ld",n);
}
else if (n>0)
{
fprintf(as_file,"+%ld",n);
}
fprintf(as_file,"\n");
}
return;
}
default:
COMMENT1("tag not in evaluated: %d", name(e));
fail("illegal constant");
} /* end switch */
}
/*
* Outputs data initialisers for the evaluated exp.
* The result is the instore "address" of the constant.
* A negative l implies that this is the initialisation of a global variable.
*/
instore evaluated PROTO_N ((e,l)) PROTO_T (exp e X int l)
{
int lab = (l == 0) ? next_data_lab() : (l < 0) ? l : -l;
instore isa;
ash a;
char *extname = ext_name(lab);
a = ashof(sh(e));
isa.adval = 0;
isa.b.offset = 0;
isa.b.base = lab;
ASSERT(name(e) != clear_tag); /* +++ history */
if (name(e) == clear_tag) /* uninitialised global */
{
long byte_size = (a.ashsize + 7) >> 3;
bool temp = (l == 0 || (extname[0] == local_prefix[0] && extname[1] == local_prefix[1]));
if (temp)
{
fprintf(as_file, "\t.lcomm\t");
}
else
{
fprintf(as_file, "\t.comm\t");
}
outlab(lab);
fprintf(as_file, ",%ld\n", byte_size);
return isa;
}
{
/* align at least to word for speed of access */
/* if size greater than 4 bytes, align on double boundry for speed */
if (a.ashalign > 32 || a.ashsize > 32)
fprintf(as_file, "\t.align\t3\n");
else
fprintf(as_file, "\t.align\t2\n");
fprintf(as_file, "%s:\n", extname);
evalone(e, 0);
/* evalone does not always output .space to finish off up to size, so protect next one */
set_align(a.ashalign);
}
return isa;
}
instore evaluated_const PROTO_N ((e)) PROTO_T (exp e)
{
instore isa;
int lab;
char *id;
/* +++ to share consts */
/* generate read only data */
fprintf(as_file, "\t.csect\t[RO]\n");
isa = evaluated(e, 0);
lab = isa.b.base;
id = ext_name(lab);
/* generate .toc entry */
fprintf(as_file, "\t.toc\n");
fprintf(as_file, "T.%s:\n\t.tc\t%s[TC],%s\n", id, id, id);
/* reset to default text segment */
fprintf(as_file, "\t.csect\t[PR]\n");
return isa;
}
long correct_shape PROTO_N ((n,shpe)) PROTO_T (long n X int shpe)
{
switch(shpe)
{
case scharhd:
n = n<<24;
n = n>>24;
return n;
case ucharhd:
n = n & 0xff;
return n;
case swordhd:
n = n<<16;
n = n>>16;
return n;
case uwordhd:
n = n & 0xffff;
return n;
case slonghd:
case ulonghd:
return n;
}
fail("Unknown shape in correct_shape");
return 0;
}