Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Crown Copyright (c) 1996
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.
*/
/*
VERSION INFORMATION
===================
--------------------------------------------------------------------------
$Header: /u/g/release/CVSROOT/Source/src/installers/680x0/common/scan2.c,v 1.1.1.1 1998/01/17 15:55:50 release Exp $
--------------------------------------------------------------------------
$Log: scan2.c,v $
* Revision 1.1.1.1 1998/01/17 15:55:50 release
* First version to be checked into rolling release.
*
Revision 1.1.1.1 1997/10/13 12:42:57 ma
First version.
Revision 1.4 1997/09/25 06:45:31 ma
All general_proc tests passed
Revision 1.3 1997/06/24 10:56:09 ma
Added changes for "Plumhall Patch"
Revision 1.2 1997/04/20 11:30:38 ma
Introduced gcproc.c & general_proc.[ch].
Added cases for apply_general_proc next to apply_proc in all files.
Revision 1.1.1.1 1997/03/14 07:50:17 ma
Imported from DRA
* Revision 1.1.1.1 1996/09/20 10:56:58 john
*
* Revision 1.3 1996/07/30 16:32:16 john
* Added offset conversion
*
* Revision 1.2 1996/07/05 14:26:12 john
* Changes for spec 3.1
*
* Revision 1.1.1.1 1996/03/26 15:45:17 john
*
* Revision 1.5 94/11/16 10:37:51 10:37:51 ra (Robert Andrews)
* Added support for integer absolute.
*
* Revision 1.4 94/06/29 14:25:38 14:25:38 ra (Robert Andrews)
* Added div0, rem0, max and min for TDF 3.0.
*
* Revision 1.3 94/02/21 16:03:43 16:03:43 ra (Robert Andrews)
* The long argument to ap_argsc is better as an int.
*
* Revision 1.2 93/04/19 13:36:21 13:36:21 ra (Robert Andrews)
* offset_pad_exp has disappeared in March93 spec.
*
* Revision 1.1 93/02/22 17:16:39 17:16:39 ra (Robert Andrews)
* Initial revision
*
--------------------------------------------------------------------------
*/
/*
SCAN2
Scans through the program and puts all the arguments of operations
into a suitable 68000 operand form.
*/
#include "config.h"
#include "common_types.h"
#include "exp.h"
#include "expmacs.h"
#include "exptypes.h"
#include "shapemacs.h"
#include "tags.h"
#include "install_fns.h"
#ifndef tdf3
#include "68k_globals.h"
#include "special_exps.h"
#endif
void scan2 PROTO_S ( ( bool, exp, exp ) ) ;
/*
MACROS TO SET OR GET THE SON OR BRO
*/
#define assexp( I, P, V ) if ( I ) setson ( P, V ) ; else setbro ( P, V )
#define contexp( I, P ) ( ( I ) ? son ( P ) : bro ( P ) )
/*
Transform a non-bit offset into a bit offset.
(borrowed from trans386)
*/
static void make_bitfield_offset
PROTO_N ( (e,pe,spe,sha) )
PROTO_T ( exp e X exp pe X int spe X shape sha )
{
exp omul;
exp val8;
if (name(e) == val_tag){
no(e) *= 8;
return;
}
omul = getexp (sha, bro(e), (int)(last (e)), e, nilexp, 0, 0, offset_mult_tag);
val8 = getexp (slongsh, omul, 1, nilexp, nilexp, 0, 8, val_tag);
clearlast(e);
setbro(e, val8);
if(spe) {
son(pe) = omul;
}
else{
bro(pe) = omul;
}
return;
}
/*
INSERT AN IDENTITY DECLARATION
This routine inserts an identity declaration of x at to and replaces
x by a use of this identity.
*/
static void cca
PROTO_N ( ( sto, to, sx, x ) )
PROTO_T ( bool sto X exp to X bool sx X exp x )
{
exp d, a, id, tg;
d = contexp (sx, x);
#ifndef tdf3
if (name(d)==caller_tag) { /* position sensitive */
cca (sto, to, 1, d);
return;
}
#endif
d = contexp ( sx, x ) ;
a = contexp ( sto, to ) ;
id = getexp ( sh ( a ), bro ( a ), last(a), d, nilexp, 0, L1, ident_tag ) ;
tg = getexp ( sh ( d ), bro ( d ), last(d), id, nilexp, 0, L0, name_tag ) ;
pt ( id ) = tg ;
clearlast ( d ) ;
if ( d != a ) {
bro ( d ) = a ;
bro ( a ) = id ;
setlast ( a ) ;
assexp ( sto, to, id ) ;
assexp ( sx, x, tg ) ;
} else {
bro ( d ) = tg ;
bro ( tg ) = id ;
setlast ( tg ) ;
clearlast ( d ) ;
assexp ( sto, to, id ) ;
}
return ;
}
/*
INSERT AN IDENTITY DECLARATION IN A BRO-LIST
Keeping the same to, cc scans along the bro list e, applying cca to
introduce an identity declaration when doit is 1. It keeps count as
the index position along the list in order to pass it to doit. If it
uses cca it scans the resulting declaration, using the same to. If it
doesn't, it scans the list element, still using the same to. This keeps
all operations in the same order.
*/
static void cc
PROTO_N ( ( sto, to, se, e, doit, count ) )
PROTO_T ( bool sto X exp to X bool se X exp e X
bool ( *doit ) PROTO_S ( ( exp, int ) ) X int count )
{
exp ec = contexp ( se, e ) ;
if ( last ( ec ) ) {
if ( doit ( ec, count ) ) {
cca ( sto, to, se, e ) ;
ec = contexp ( sto, to ) ;
scan2 ( 1, ec, son ( ec ) ) ;
} else {
scan2 ( sto, to, ec ) ;
}
} else {
cc ( sto, to, 0, ec, doit, count + 1 ) ;
ec = contexp ( se, e ) ;
if ( doit ( ec, count ) ) {
cca ( sto, to, se, e ) ;
ec = contexp ( sto, to ) ;
scan2 ( 1, ec, son ( ec ) ) ;
} else {
scan2 ( sto, to, ec ) ;
}
}
return ;
}
/*
INSERT AN IDENTITY DECLARATION
This routine is the same as cca, but forces the declaration into
a register.
*/
static void ccp
PROTO_N ( ( sto, to, sx, x ) )
PROTO_T ( bool sto X exp to X bool sx X exp x )
{
exp xc = contexp ( sx, x ) ;
exp toc ;
if ( name ( xc ) != name_tag || !isusereg ( son ( xc ) ) ) {
cca ( sto, to, sx, x ) ;
toc = contexp ( sto, to ) ;
setusereg ( toc ) ;
scan2 ( 1, toc, son ( toc ) ) ;
}
return ;
}
/*
IS THE EXP e AN OPERAND?
*/
static bool is_opnd
PROTO_N ( ( e ) )
PROTO_T ( exp e )
{
switch ( name ( e ) ) {
case name_tag : {
exp s = son ( e ) ;
return ( !isvar ( s ) && (son(son(e))!=nilexp) && !isparam ( son ( son ( e ) ) ) ) ;
}
case val_tag :
case real_tag :
case env_size_tag :
case general_proc_tag:
case proc_tag :
case cont_tag :
case string_tag :
case null_tag : {
return ( 1 ) ;
}
}
return ( 0 ) ;
}
/*
CHECK THE POINTER ARGUMENT OF AN ADDPTR
*/
static void ap_arg1
PROTO_N ( ( sto, to, sa, a, b ) )
PROTO_T ( bool sto X exp to X bool sa X exp a X bool b )
{
exp ac = contexp ( sa, a ) ;
if ( !b && name ( ac ) == cont_tag && name ( son ( ac ) ) == name_tag &&
isvar ( son ( son ( ac ) ) ) ) return ;
if ( !b && name ( ac ) == name_tag ) return ;
/* The pointer has to go into a register */
ccp ( sto, to, sa, a ) ;
return ;
}
/*
CHECK THE INTEGER ARGUMENT OF AN ADDPTR
*/
static void ap_argsc
PROTO_N ( ( sto, to, se, e, sz, b ) )
PROTO_T ( bool sto X exp to X bool se X exp e X int sz X bool b )
{
exp ec = contexp ( se, e ) ;
exp p = son ( ec ) ;
exp a = bro ( p ) ;
exp temp ;
/* Check for multiplication by constant scale factor */
if ( name ( a ) == offset_mult_tag &&
name ( bro ( son ( a ) ) ) == val_tag ) {
long k = no ( bro ( son ( a ) ) ) ;
if ( ( k == 8 || k == 16 || k == 32 || k == 64 ) && k == sz ) {
ccp ( sto, to, 1, a ) ;
ap_arg1 ( sto, to, 1, ec, b ) ;
return ;
}
}
if ( sz == 8 ) {
ccp ( sto, to, 0, son ( ec ) ) ;
ap_arg1 ( sto, to, 1, ec, b ) ;
return ;
}
if ( b ) {
ccp ( sto, to, se, e ) ;
return ;
}
cca ( sto, to, se, e ) ;
temp = contexp ( sto, to ) ;
scan2 ( 1, temp, son ( temp ) ) ;
return ;
}
/*
CHECK THE ARGUMENT OF A CONT OR THE DESTINATION OF AN ASSIGN
*/
static void cont_arg
PROTO_N ( ( sto, to, e, sa ) )
PROTO_T ( bool sto X exp to X exp e X shape sa )
{
unsigned char n = name ( son ( e ) ) ;
if ( n == name_tag ) return ;
if ( n == cont_tag ) {
exp s = son ( son ( e ) ) ;
if ( name ( s ) == name_tag &&
( isvar ( son ( s ) ) || isglob ( son ( s ) ) ||
isusereg ( son ( s ) ) ) ) return ;
if ( name ( s ) == reff_tag &&
name ( son ( s ) ) == name_tag &&
( isvar ( son ( son ( s ) ) ) || isglob ( son ( son ( s ) ) ) ||
isusereg ( son ( son ( s ) ) ) ) ) return ;
ccp ( sto, to, 1, e ) ;
return ;
}
if ( n == reff_tag ) {
exp s = son ( e ) ;
if ( name ( son ( s ) ) == name_tag &&
isusereg ( son ( son ( s ) ) ) ) return ;
if ( name ( son ( s ) ) == addptr_tag ) {
ap_argsc ( sto, to, 1, s, shape_size ( sa ), 1 ) ;
return ;
}
ccp ( sto, to, 1, s ) ;
return ;
}
if ( n == addptr_tag ) {
ap_argsc ( sto, to, 1, e, shape_size ( sa ), 0 ) ;
return ;
}
ccp ( sto, to, 1, e ) ;
return ;
}
/*
DOIT ROUTINE, IS t NOT AN OPERAND?
*/
static bool notopnd
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
return ( i >= 0 && !is_opnd ( t ) ) ;
}
#ifndef tdf3
static int scan_for_alloca PROTO_S ( ( exp ) ) ;
static int scan_alloc_args
PROTO_N ( (s) )
PROTO_T ( exp s )
{
if (scan_for_alloca(s))
return 1;
if (last(s))
return 0;
return scan_alloc_args(bro(s));
}
static int scan_for_alloca
PROTO_N ( (t) )
PROTO_T ( exp t )
{
switch (name(t)) {
case local_free_all_tag:
case local_free_tag:
case last_local_tag:
case alloca_tag:
case make_lv_tag:
return 1;
case case_tag:
return scan_for_alloca(son(t));
case labst_tag:
return scan_for_alloca(bro(son(t)));
case env_offset_tag:
case string_tag:
case name_tag:
return 0;
case apply_general_tag:
if call_is_untidy(t)
return 1;
return scan_alloc_args(son(t));
default:
if (son(t) == nilexp)
return 0;
return scan_alloc_args(son(t));
};
}
static bool no_alloca
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
UNUSED ( i ) ;
return ( scan_for_alloca ( t ) ) ;
}
#endif
/*
APPLY cc, DOING IT WITH OPERANDS
*/
static void all_opnd
PROTO_N ( ( sto, to, e ) )
PROTO_T ( bool sto X exp to X exp e )
{
#if 0
if(!last(bro(son(e)))) {
/* Operation has more than two parameters. Make it diadic */
exp opn = getexp(sh(e),e,0,bro(son(e)),nilexp,0,0,name(e));
exp nd = getexp(sh(e),bro(e),last(e),opn,nilexp,0,1,ident_tag);
exp id = getexp(sh(e),e,1,nd,nilexp,0,0,name_tag);
pt(nd) = id;
bro(son(e)) = id;
setlast(e);
bro(e) = nd;
while (!last(bro(son(e)))) {
bro(son(e)) = bro(bro(son(e)));
}
bro(bro(son(e))) = opn;
e = nd;
scan2(sto,e,e);
}
#endif
cc ( sto, to, 1, e, notopnd, 1 ) ;
return ;
}
/*
IS e ASSIGNABLE?
*/
static bool is_assable
PROTO_N ( ( e ) )
PROTO_T ( exp e )
{
long sz ;
unsigned char n = name ( e ) ;
if ( is_a ( n ) ) return ( 1 ) ;
if ( n != apply_tag && n != apply_general_tag ) return ( 0 ) ;
n = name ( sh ( e ) ) ;
sz = shape_size ( sh ( e ) ) ;
return ( n <= ulonghd || ( n == ptrhd && sz == 32 ) ) ;
}
/*
DOIT ROUTINE, IS t NOT ASSIGNABLE?
*/
static bool notass
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
return ( i >= 0 && !is_assable ( t ) ) ;
}
/*
APPLY cc, DOING IT WITH ASSIGNABLES
*/
static void all_assable
PROTO_N ( ( sto, to, e ) )
PROTO_T ( bool sto X exp to X exp e )
{
cc ( sto, to, 1, e, notass, 1 ) ;
return ;
}
/*
IS e DIRECTLY ADDRESSABLE?
*/
static bool is_direct
PROTO_N ( ( e ) )
PROTO_T ( exp e )
{
unsigned char s = name ( e ) ;
return ( ( s == name_tag && !isglob ( son ( e ) ) &&
!isvar ( son ( e ) ) ) ||
( s == cont_tag && name ( son ( e ) ) == name_tag &&
!isglob ( son ( son ( e ) ) ) &&
isvar ( son ( son ( e ) ) ) ) ) ;
}
/*
IS e INDIRECTLY ADDRESSABLE?
*/
static bool is_indable
PROTO_N ( ( e ) )
PROTO_T ( exp e )
{
unsigned char s = name ( e ) ;
if ( s == name_tag ) return ( 1 ) ;
if ( s == cont_tag ) {
unsigned char t = name ( son ( e ) ) ;
return ( ( t == name_tag && isvar ( son ( son ( e ) ) ) ) ||
( t == cont_tag && name ( son ( son ( e ) ) ) == name_tag &&
isvar ( son ( son ( son ( e ) ) ) ) ) ||
( t == reff_tag && is_direct ( son ( son ( e ) ) ) ) ) ;
}
return ( ( s == reff_tag && is_direct ( son ( e ) ) ) ||
s == addptr_tag ) ;
}
#ifndef tdf3
/*
MAKES son ( e ) INDIRECTLY ADDRESSABLE
*/
static void indable_son
PROTO_N ( ( sto, to, e ) )
PROTO_T ( bool sto X exp to X exp e )
{
if (!is_indable (son (e))) {
exp ec;
cca (sto, to, 1, e);
ec = contexp (sto, to);
scan2 (1, ec, son (ec));
}
else
scan2 (sto, to, son (e));
return;
}
#endif
/*
APPLY scan2 TO A BRO LIST
*/
static void scanargs
PROTO_N ( ( st, e ) )
PROTO_T ( bool st X exp e )
{
exp t = e ;
exp temp ;
while ( temp = contexp ( st, t ), scan2 ( st, t, temp ),
temp = contexp ( st, t ), !last ( temp ) ) {
t = contexp ( st, t ) ;
st = 0 ;
}
return ;
}
/*
DOIT ROUTINE FOR APPLY
*/
#if 0
static bool apdo
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
/* The first argument needs special treatment */
if ( i == 1 ) return ( !is_indable ( t ) ) ;
return ( 0 ) ;
}
#endif
/*
DOIT ROUTINE FOR PLUS
*/
static bool plusdo
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
/* Can't negate first argument */
if ( i == 1 ) return ( !is_opnd ( t ) ) ;
/* But can negate the rest */
if ( name ( t ) == neg_tag ) return ( 0 ) ;
return ( !is_opnd ( t ) ) ;
}
/*
DOIT ROUTINE FOR MULT
*/
static bool multdo
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
return ( i >= 0 && !is_o ( name ( t ) ) ) ;
}
/*
DOIT ROUTINE FOR AND
*/
static bool anddo
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
#if 0
/* Can't negate first argument */
if ( i == 1 ) return ( !is_o ( name ( t ) ) ) ;
/* But can negate the rest */
if ( name ( t ) == not_tag ) return ( 0 ) ;
#endif
return ( !is_o ( name ( t ) ) ) ;
}
/*
DOIT ROUTINE FOR XOR
*/
static bool notado
PROTO_N ( ( t, i ) )
PROTO_T ( exp t X int i )
{
return ( i >= 0 && !is_o ( name ( t ) ) ) ;
}
/*
MAIN SCAN ROUTINE
*/
void scan2
PROTO_N ( ( sto, to, e ) )
PROTO_T ( bool sto X exp to X exp e )
{
switch ( name ( e ) ) {
case cond_tag :
case rep_tag :
case compound_tag :
#ifdef rscope_tag
case rscope_tag :
#endif
case solve_tag :
case concatnof_tag :
case nof_tag :
case diagnose_tag :
#ifndef tdf3
case caller_tag: {
if (son(e) == nilexp) /* empty make_nof */
return ;
scanargs (1, e);
return ;
};
#else
{
scanargs ( 1, e ) ;
return ;
}
#endif
case labst_tag : {
scan2 ( 0, son ( e ), bro ( son ( e ) ) ) ;
return ;
}
case ident_tag : {
scan2 ( 0, son ( e ), bro ( son ( e ) ) ) ;
scan2 ( 1, e, son ( e ) ) ;
return ;
}
case seq_tag : {
scanargs ( 1, son ( e ) ) ;
scan2 ( 0, son ( e ), bro ( son ( e ) ) ) ;
return ;
}
#if 0
case diag_tag :
case cscope_tag :
case fscope_tag : {
scanargs ( 1, e ) ;
return ;
}
#endif
case local_free_tag :
case long_jump_tag :
case ncopies_tag : {
all_assable ( sto, to, e ) ;
return ;
}
case alloca_tag : {
all_opnd ( sto, to, e ) ;
return ;
}
#ifndef tdf3
case set_stack_limit_tag: {
exp lim = get_stack_limit();
setbro (lim, son(e));
setson (e, lim);
setname (e, ass_tag);
scan2 (sto, to, e);
return ;
};
#endif
case offset_add_tag :
case offset_subtract_tag : {
if((al2(sh(son(e))) == 1) && (al2(sh(bro(son(e)))) != 1)){
make_bitfield_offset(bro(son(e)),son(e),0,sh(e));
}
if((al2(sh(son(e))) != 1) && (al2(sh(bro(son(e)))) == 1)){
make_bitfield_offset(son(e),e,1,sh(e));
}
}
case test_tag :
case absbool_tag :
case testbit_tag :
case make_stack_limit_tag:
case minus_tag :
case subptr_tag :
case div0_tag :
case div1_tag :
case div2_tag :
case shl_tag :
case shr_tag :
case rem0_tag :
case mod_tag :
case rem2_tag :
case round_tag :
case max_tag :
case offset_max_tag :
case min_tag :
case offset_div_by_int_tag :
case offset_negate_tag :
case offset_pad_tag :
case minptr_tag :
case fplus_tag :
case fminus_tag :
case fmult_tag :
case fdiv_tag :
case fneg_tag :
case fabs_tag :
case chfl_tag :
case float_tag :
case offset_mult_tag :
case offset_div_tag :
case movecont_tag : {
all_opnd ( sto, to, e ) ;
return ;
}
case not_tag :
case neg_tag :
case abs_tag :
case chvar_tag : {
all_opnd ( sto, to, e ) ;
return ;
}
case bitf_to_int_tag :
case int_to_bitf_tag : {
all_opnd ( sto, to, e ) ;
return ;
}
case ass_tag :
case assvol_tag : {
exp toc ;
/* Change assvol into ass */
if ( name ( e ) == assvol_tag ) setname ( e, ass_tag ) ;
if ( !is_assable ( bro ( son ( e ) ) ) ) {
cca ( sto, to, 0, son ( e ) ) ;
toc = contexp ( sto, to ) ;
scan2 ( 1, toc, son ( toc ) ) ;
} else {
scan2 ( sto, to, bro ( son ( e ) ) ) ;
}
cont_arg ( sto, to, e, sh ( bro ( son ( e ) ) ) ) ;
return ;
}
#ifndef tdf3
case tail_call_tag: {
exp cees = bro(son(e));
cur_proc_has_tail_call = 1;
cur_proc_use_same_callees = (name(cees) == same_callees_tag);
if (son(cees) != nilexp)
cc (sto, to, 1, cees, no_alloca, 1);
indable_son (sto, to, e);
return ;
};
case apply_general_tag : {
exp cees = bro(bro(son(e)));
exp p_post = cees; /* bro(p_post) is postlude */
cur_proc_use_same_callees = (name(cees) == same_callees_tag);
while (name(bro(p_post)) == ident_tag && name(son(bro(p_post))) == caller_name_tag)
p_post = son(bro(p_post));
scan2 (0, p_post, bro(p_post));
if (son(cees) != nilexp)
scanargs (1, cees);
if (no(bro(son(e))) != 0)
scanargs (1, bro(son(e)));
if ( !is_indable ( son(e) ) ) {
exp ec ;
cca ( sto, to, 1, e ) ;
ec = contexp ( sto, to ) ;
scan2 ( 1, ec, son ( ec ) ) ;
} else {
scan2 ( sto, to, son ( e ) ) ;
}
return ;
}
#endif
case apply_tag : {
scanargs ( 1, e ) ;
/* Fall through */
}
case goto_lv_tag : {
if ( !is_indable ( son ( e ) ) ) {
exp ec ;
cca ( sto, to, 1, e ) ;
ec = contexp ( sto, to ) ;
scan2 ( 1, ec, son ( ec ) ) ;
} else {
scan2 ( sto, to, son ( e ) ) ;
}
return ;
}
#ifndef tdf3
case untidy_return_tag:
#endif
case res_tag : {
long sz ;
if ( name ( son ( e ) ) == apply_tag
|| name ( son ( e ) ) == apply_general_tag )
{
scan2 ( sto, to, son ( e ) ) ;
return ;
}
sz = shape_size ( sh ( son ( e ) ) ) ;
if ( sz <= 64 ) {
all_assable ( sto, to, e ) ;
return ;
}
all_opnd ( sto, to, e ) ;
return ;
}
case case_tag : {
exp toc ;
if ( !is_opnd ( son ( e ) ) ) {
cca ( sto, to, 1, e ) ;
toc = contexp ( sto, to ) ;
scan2 ( 1, toc, son ( toc ) ) ;
} else {
scan2 ( sto, to, son ( e ) ) ;
}
return ;
}
case plus_tag : {
if ( name ( son ( e ) ) == neg_tag &&
name ( bro ( son ( e ) ) ) == val_tag ) {
scan2 ( sto, to, son ( e ) ) ;
return ;
}
cc ( sto, to, 1, e, plusdo, 1 ) ;
return ;
}
case addptr_tag : {
exp a = bro ( son ( e ) ) ;
if ( name ( a ) == offset_mult_tag &&
name ( bro ( son ( a ) ) ) == val_tag ) {
long k = no ( bro ( son ( a ) ) ) / 8 ;
if ( k == 1 || k == 2 || k == 4 || k == 8 ) {
ccp ( sto, to, 1, a ) ;
ap_arg1 ( sto, to, 1, e, 0 ) ;
return ;
}
}
ccp ( sto, to, 0, son ( e ) ) ;
ap_arg1 ( sto, to, 1, e, 0 ) ;
return ;
}
case mult_tag : {
cc ( sto, to, 1, e, multdo, 1 ) ;
return ;
}
case and_tag : {
cc ( sto, to, 1, e, anddo, 1 ) ;
return ;
}
case or_tag :
case xor_tag : {
cc ( sto, to, 1, e, notado, 1 ) ;
return ;
}
case cont_tag :
case contvol_tag : {
/* Change contvol into cont */
if ( name ( e ) == contvol_tag ) setname ( e, cont_tag ) ;
cont_arg ( sto, to, e, sh ( e ) ) ;
return ;
}
case field_tag : {
if ( !is_o ( name ( son ( e ) ) ) || name ( e ) == cont_tag ) {
exp temp ;
cca ( sto, to, 1, e ) ;
temp = contexp ( sto, to ) ;
scan2 ( 1, temp, son ( temp ) ) ;
} else {
scan2 ( sto, to, son ( e ) ) ;
}
return ;
}
case reff_tag : {
exp s = son ( e ) ;
if ( name ( s ) == name_tag ||
( name ( s ) == cont_tag &&
name ( son ( s ) ) == name_tag ) ) return ;
ccp ( sto, to, 1, e ) ;
return ;
}
case general_proc_tag:
case proc_tag : {
scan2 ( 1, e, son ( e ) ) ;
return ;
}
#if 0
case val_tag :{
if(name(sh(e)) == offsethd && al2(sh(e))>=8){
no(e) = no(e)>>3;
}
return;
}
#endif
default : return ;
}
}