WebSVN – tendra.SVN – Diff – /trunk/src/installers/680x0/common/scan2.c

+/*
+ * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ *    this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ * 3. Neither the name of The TenDRA Project nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific, prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * $Id$
+ */
 /*
     		 Crown Copyright (c) 1996
     This TenDRA(r) Computer Program is subject to Copyright
     owned by the United Kingdom Secretary of State for Defence
 #ifndef tdf3
 #include "68k_globals.h"
 #include "special_exps.h"
 #endif
-void scan2 PROTO_S ( ( bool, exp, exp ) ) ;
+void scan2(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 assexp(I, P, V)	if (I) setson(P, V); else setbro(P, V)
-#define  contexp( I, P )	( ( I ) ? son ( P ) : bro ( P ) )
+#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
+static void
-    PROTO_N ( (e,pe,spe,sha) )
-    PROTO_T ( exp e X exp pe X int spe X shape sha )
+make_bitfield_offset(exp e, exp pe, int spe, shape sha)
 {
-  exp omul;
+	exp omul;
-  exp val8;
+	exp val8;
-  if (name(e) == val_tag){
+	if (name(e) == val_tag) {
-    no(e) *= 8;
+		no(e)*= 8;
-    return;
+		return;
-  }
+	}
-  omul = getexp (sha, bro(e), (int)(last (e)), e, nilexp, 0, 0, offset_mult_tag);
+	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);
+	val8 = getexp(slongsh, omul, 1, nilexp, nilexp, 0, 8, val_tag);
-  clearlast(e);
+	clearlast(e);
-  setbro(e, val8);
+	setbro(e, val8);
-  if(spe) {
+	if (spe) {
-    son(pe) = omul;
+		son(pe) = omul;
-  }
-  else{
+	} else{
-    bro(pe) = omul;
+		bro(pe) = omul;
-  }
+	}
-  return;
+	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
+static void
-    PROTO_N ( ( sto, to, sx, x ) )
-    PROTO_T ( bool sto X exp to X bool sx X exp x )
+cca(bool sto, exp to, bool sx, exp x)
+{
-   exp d, a, id, tg;
+	exp d, a, id, tg;
-   d = contexp (sx, x);
+	d = contexp(sx, x);
 #ifndef tdf3
-   if (name(d)==caller_tag) {	/* position sensitive */
+	if (name(d)==caller_tag) {	/* position sensitive */
-      cca (sto, to, 1, d);
+		cca(sto, to, 1, d);
-      return;
+		return;
-   }
+	}
 #endif
-   d = contexp ( sx, x ) ;
+	d = contexp(sx, x);
-   a = contexp ( sto, to ) ;
+	a = contexp(sto, to);
-   id = getexp ( sh ( a ), bro ( a ), last(a), d, nilexp, 0, L1, ident_tag ) ;
+	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 ) ;
+	tg = getexp(sh(d), bro(d), last(d), id, nilexp, 0, L0, name_tag);
-   pt ( id ) = tg ;
+	pt(id) = tg;
-   clearlast ( d ) ;
+	clearlast(d);
-   if ( d != a ) {
+	if (d != a) {
-      bro ( d ) = a ;
+		bro(d) = a;
-      bro ( a ) = id ;
+		bro(a) = id;
-      setlast ( a ) ;
+		setlast(a);
-      assexp ( sto, to, id ) ;
+		assexp(sto, to, id);
-      assexp ( sx, x, tg ) ;
+		assexp(sx, x, tg);
-   } else {
+	} else {
-      bro ( d ) = tg ;
+		bro(d) = tg;
-      bro ( tg ) = id ;
+		bro(tg) = id;
-      setlast ( tg ) ;
+		setlast(tg);
-      clearlast ( d ) ;
+		clearlast(d);
-      assexp ( sto, to, id ) ;
+		assexp(sto, to, id);
-   }
+	}
-   return ;
+	return;
+}
 /*
     INSERT AN IDENTITY DECLARATION IN A BRO-LIST
     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
+static void
-    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 )
+cc(bool sto, exp to, bool se, exp e, bool(*doit)(exp, int), int count)
+{
-  exp ec = contexp ( se, e ) ;
+	exp ec = contexp(se, e);
-  if ( last ( ec ) ) {
+	if (last(ec)) {
-    if ( doit ( ec, count ) ) {
+		if (doit(ec, count)) {
-      cca ( sto, to, se, e ) ;
+			cca(sto, to, se, e);
-      ec = contexp ( sto, to ) ;
+			ec = contexp(sto, to);
-      scan2 ( 1, ec, son ( ec ) ) ;
+			scan2(1, ec, son(ec));
-    } else {
+		} else {
-      scan2 ( sto, to, ec ) ;
+			scan2(sto, to, ec);
-    }
+		}
-  } else {
+	} else {
-    cc ( sto, to, 0, ec, doit, count + 1 ) ;
+		cc(sto, to, 0, ec, doit, count + 1);
-    ec = contexp ( se, e ) ;
+		ec = contexp(se, e);
-    if ( doit ( ec, count ) ) {
+		if (doit(ec, count)) {
-      cca ( sto, to, se, e ) ;
+			cca(sto, to, se, e);
-      ec = contexp ( sto, to ) ;
+			ec = contexp(sto, to);
-      scan2 ( 1, ec, son ( ec ) ) ;
+			scan2(1, ec, son(ec));
-    } else {
+		} else {
-      scan2 ( sto, to, ec ) ;
+			scan2(sto, to, ec);
-    }
+		}
-  }
+	}
-  return ;
+	return;
+}
 /*
     INSERT AN IDENTITY DECLARATION
     This routine is the same as cca, but forces the declaration into
     a register.
 */
-static void ccp
+static void
-    PROTO_N ( ( sto, to, sx, x ) )
-    PROTO_T ( bool sto X exp to X bool sx X exp x )
+ccp(bool sto, exp to, bool sx, exp x)
+{
-    exp xc = contexp ( sx, x ) ;
+	exp xc = contexp(sx, x);
-    exp toc ;
+	exp toc;
-    if ( name ( xc ) != name_tag || !isusereg ( son ( xc ) ) ) {
+	if (name(xc)!= name_tag || !isusereg(son(xc))) {
-	cca ( sto, to, sx, x ) ;
+		cca(sto, to, sx, x);
-	toc = contexp ( sto, to ) ;
+		toc = contexp(sto, to);
-	setusereg ( toc ) ;
+		setusereg(toc);
-	scan2 ( 1, toc, son ( toc ) ) ;
+		scan2(1, toc, son(toc));
-    }
+	}
-    return ;
+	return;
+}
 /*
     IS THE EXP e AN OPERAND?
 */
-static bool is_opnd
+static bool
-    PROTO_N ( ( e ) )
-    PROTO_T ( exp e )
+is_opnd(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 )
+{
+	switch (name(e)) {
+	case name_tag: {
-    exp ac = contexp ( sa, a ) ;
+		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(bool sto, exp to, bool sa, exp a, bool b)
+{
+	exp ac = contexp(sa, a);
-    if ( !b && name ( ac ) == cont_tag && name ( son ( ac ) ) == name_tag &&
+	if (!b && name(ac) == cont_tag && name(son(ac)) == name_tag &&
-	 isvar ( son ( son ( ac ) ) ) ) return ;
+	    isvar(son(son(ac)))) {
+		return;
+	}
-    if ( !b && name ( ac ) == name_tag ) return ;
+	if (!b && name(ac) == name_tag) {
+		return;
+	}
-    /* The pointer has to go into a register */
+	/* The pointer has to go into a register */
-    ccp ( sto, to, sa, a ) ;
+	ccp(sto, to, sa, a);
-    return ;
+	return;
+}
 /*
     CHECK THE INTEGER ARGUMENT OF AN ADDPTR
 */
-static void ap_argsc
+static void
-    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 )
+ap_argsc(bool sto, exp to, bool se, exp e, int sz, bool b)
 {
-    exp ec = contexp ( se, e ) ;
+	exp ec = contexp(se, e);
-    exp p = son ( ec ) ;
+	exp p = son(ec);
-    exp a = bro ( p ) ;
+	exp a = bro(p);
-    exp temp ;
+	exp temp;
-    /* Check for multiplication by constant scale factor */
+	/* Check for multiplication by constant scale factor */
-    if ( name ( a ) == offset_mult_tag &&
-	 name ( bro ( son ( a ) ) ) == val_tag ) {
+	if (name(a) == offset_mult_tag && name(bro(son(a))) == val_tag) {
-	long k = no ( bro ( son ( a ) ) ) ;
+		long k = no(bro(son(a)));
-	if ( ( k == 8 || k == 16 || k == 32 || k == 64 ) && k == sz ) {
+		if ((k == 8 || k == 16 || k == 32 || k == 64) && k == sz) {
-	    ccp ( sto, to, 1, a ) ;
+			ccp(sto, to, 1, a);
-	    ap_arg1 ( sto, to, 1, ec, b ) ;
+			ap_arg1(sto, to, 1, ec, b);
-	    return ;
+			return;
-	}
+		}
-    }
+	}
-    if ( sz == 8 ) {
+	if (sz == 8) {
-	ccp ( sto, to, 0, son ( ec ) ) ;
+		ccp(sto, to, 0, son(ec));
-	ap_arg1 ( sto, to, 1, ec, b ) ;
+		ap_arg1(sto, to, 1, ec, b);
-	return ;
+		return;
-    }
+	}
-    if ( b ) {
+	if (b) {
-	ccp ( sto, to, se, e ) ;
+		ccp(sto, to, se, e);
-	return ;
+		return;
-    }
+	}
-    cca ( sto, to, se, e ) ;
+	cca(sto, to, se, e);
-    temp = contexp ( sto, to ) ;
+	temp = contexp(sto, to);
-    scan2 ( 1, temp, son ( temp ) ) ;
+	scan2(1, temp, son(temp));
-    return ;
+	return;
 }
 /*
     CHECK THE ARGUMENT OF A CONT OR THE DESTINATION OF AN ASSIGN
 */
-static void cont_arg
+static void
-    PROTO_N ( ( sto, to, e, sa ) )
-    PROTO_T ( bool sto X exp to X exp e X shape sa )
+cont_arg(bool sto, exp to, exp e, shape sa)
+{
-    unsigned char n = name ( son ( e ) ) ;
+	unsigned char n = name(son(e));
-    if ( n == name_tag ) return ;
+	if (n == name_tag) {
+		return;
+	}
-    if ( n == cont_tag ) {
+	if (n == cont_tag) {
-	exp s = son ( son ( e ) ) ;
+		exp s = son(son(e));
-	if ( name ( s ) == name_tag &&
+		if (name(s) == name_tag &&
-	     ( isvar ( son ( s ) ) || isglob ( son ( s ) ) ||
+		    (isvar(son(s)) || isglob(son(s)) || isusereg(son(s)))) {
-	       isusereg ( son ( s ) ) ) ) return ;
+			return;
+		}
-	if ( name ( s ) == reff_tag &&
-	    name ( son ( s ) ) == name_tag &&
+		if (name(s) == reff_tag && name(son(s)) == name_tag &&
-	    ( isvar ( son ( son ( s ) ) ) || isglob ( son ( son ( s ) ) ) ||
+		    (isvar(son(son(s))) || isglob(son(son(s))) ||
-	      isusereg ( son ( son ( s ) ) ) ) ) return ;
+		     isusereg(son(son(s))))) {
+			return;
+		}
-	ccp ( sto, to, 1, e ) ;
+		ccp(sto, to, 1, e);
-	return ;
+		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;
-    }
+		}
-    if ( n == reff_tag ) {
-	exp s = son ( e ) ;
+		ccp(sto, to, 1, s);
-	if ( name ( son ( s ) ) == name_tag &&
-	     isusereg ( son ( son ( s ) ) ) ) return ;
+		return;
+	}
-	if ( name ( son ( s ) ) == addptr_tag ) {
+	if (n == addptr_tag) {
-	    ap_argsc ( sto, to, 1, s, shape_size ( sa ), 1 ) ;
+		ap_argsc(sto, to, 1, e, shape_size(sa), 0);
-	    return ;
+		return;
+	}
-	ccp ( sto, to, 1, s ) ;
+	ccp(sto, to, 1, e);
-	return ;
-    }
-    if ( n == addptr_tag ) {
-	ap_argsc ( sto, to, 1, e, shape_size ( sa ), 0 ) ;
-	return ;
+	return;
-    }
-    ccp ( sto, to, 1, e ) ;
-    return ;
+}
 /*
     DOIT ROUTINE, IS t NOT AN OPERAND?
 */
-static bool notopnd
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+notopnd(exp t, int i)
 {
-    return ( i >= 0 && !is_opnd ( t ) ) ;
+	return (i >= 0 && !is_opnd(t));
 }
 #ifndef tdf3
-static int scan_for_alloca PROTO_S ( ( exp ) ) ;
+static int scan_for_alloca(exp);
-static int scan_alloc_args
+static int
-    PROTO_N ( (s) )
-    PROTO_T ( exp s )
+scan_alloc_args(exp s)
 {
-  if (scan_for_alloca(s))
+	if (scan_for_alloca(s)) {
-    return 1;
+		return 1;
+	}
-  if (last(s))
+	if (last(s)) {
-    return 0;
+		return 0;
+	}
-  return scan_alloc_args(bro(s));
+	return scan_alloc_args(bro(s));
 }
-static int scan_for_alloca
+static int
-    PROTO_N ( (t) )
-    PROTO_T ( exp t )
+scan_for_alloca(exp t)
 {
-   switch (name(t)) {
+	switch (name(t)) {
-   case local_free_all_tag:
+	case local_free_all_tag:
-   case local_free_tag:
+	case local_free_tag:
-   case last_local_tag:
+	case last_local_tag:
-   case alloca_tag:
+	case alloca_tag:
-   case make_lv_tag:
+	case make_lv_tag:
-      return 1;
+		return 1;
-   case case_tag:
+	case case_tag:
-      return scan_for_alloca(son(t));
+		return scan_for_alloca(son(t));
-   case labst_tag:
+	case labst_tag:
-      return scan_for_alloca(bro(son(t)));
+		return scan_for_alloca(bro(son(t)));
-   case env_offset_tag:
+	case env_offset_tag:
-   case string_tag:
+	case string_tag:
-   case name_tag:
+	case name_tag:
-      return 0;
+		return 0;
-   case apply_general_tag:
+	case apply_general_tag:
-      if call_is_untidy(t)
+		if call_is_untidy(t) {
-      return 1;
+			return 1;
+		}
-      return scan_alloc_args(son(t));
+		return scan_alloc_args(son(t));
-   default:
+	default:
-      if (son(t) == nilexp)
+		if (son(t) == nilexp) {
-      return 0;
+			return 0;
+		}
-      return scan_alloc_args(son(t));
+		return scan_alloc_args(son(t));
-   };
+	}
 }
-static bool no_alloca
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+no_alloca(exp t, int i)
 {
-    UNUSED ( i ) ;
+	UNUSED(i);
-    return ( scan_for_alloca ( t ) ) ;
+	return (scan_for_alloca(t));
 }
 #endif
 /*
     APPLY cc, DOING IT WITH OPERANDS
 */
-static void all_opnd
+static void
-    PROTO_N ( ( sto, to, e ) )
-    PROTO_T ( bool sto X exp to X exp e )
+all_opnd(bool sto, exp to, exp e)
+{
 #if 0
-  if(!last(bro(son(e)))) {
+	if (!last(bro(son(e)))) {
-    /* Operation has more than two parameters.  Make it diadic */
+		/* 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 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 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);
+		exp id = getexp(sh(e), e, 1, nd, nilexp, 0, 0, name_tag);
-    pt(nd) = id;
+		pt(nd) = id;
-    bro(son(e)) = id;
+		bro(son(e)) = id;
-    setlast(e);
+		setlast(e);
-    bro(e) = nd;
+		bro(e) = nd;
-    while (!last(bro(son(e)))) {
+		while (!last(bro(son(e)))) {
-      bro(son(e)) = bro(bro(son(e)));
+			bro(son(e)) = bro(bro(son(e)));
-    }
+		}
-    bro(bro(son(e))) = opn;
+		bro(bro(son(e))) = opn;
-    e = nd;
+		e = nd;
-    scan2(sto,e,e);
+		scan2(sto, e, e);
-  }
+	}
 #endif
-  cc ( sto, to, 1, e, notopnd, 1 ) ;
+	cc(sto, to, 1, e, notopnd, 1);
-  return ;
+	return;
 }
 /*
     IS e ASSIGNABLE?
 */
-static bool is_assable
+static bool
-    PROTO_N ( ( e ) )
-    PROTO_T ( exp e )
+is_assable(exp e)
 {
-    long sz ;
+	long sz;
-    unsigned char n = name ( e ) ;
+	unsigned char n = name(e);
-    if ( is_a ( n ) ) return ( 1 ) ;
+	if (is_a(n)) {
+		return (1);
+	}
-    if ( n != apply_tag && n != apply_general_tag ) return ( 0 ) ;
+	if (n != apply_tag && n != apply_general_tag) {
+		return (0);
+	}
-    n = name ( sh ( e ) ) ;
+	n = name(sh(e));
-    sz = shape_size ( sh ( e ) ) ;
+	sz = shape_size(sh(e));
-    return ( n <= ulonghd || ( n == ptrhd && sz == 32 ) ) ;
+	return (n <= ulonghd || (n == ptrhd && sz == 32));
 }
 /*
     DOIT ROUTINE, IS t NOT ASSIGNABLE?
 */
-static bool notass
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+notass(exp t, 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 (i >= 0 && !is_assable(t));
-    return ;
+}
 /*
-    IS e DIRECTLY ADDRESSABLE?
+    APPLY cc, DOING IT WITH ASSIGNABLES
 */
-static bool is_direct
+static void
-    PROTO_N ( ( e ) )
-    PROTO_T ( exp e )
+all_assable(bool sto, exp to, exp e)
+{
-    unsigned char s = name ( e ) ;
+	cc(sto, to, 1, e, notass, 1);
-    return ( ( s == name_tag && !isglob ( son ( e ) ) &&
-	       !isvar ( son ( e ) ) ) ||
+	return;
-	     ( s == cont_tag && name ( son ( e ) ) == name_tag &&
-	       !isglob ( son ( son ( e ) ) ) &&
-	       isvar ( son ( son ( e ) ) ) ) ) ;
+}
 /*
-    IS e INDIRECTLY ADDRESSABLE?
+    IS e DIRECTLY ADDRESSABLE?
 */
-static bool is_indable
+static bool
-    PROTO_N ( ( e ) )
-    PROTO_T ( exp e )
+is_direct(exp e)
+{
-    unsigned char s = name ( 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 ) ) ) ) ||
+    return ((s == name_tag && !isglob(son(e)) && !isvar(son(e))) ||
-		 ( t == cont_tag && name ( son ( son ( e ) ) ) == name_tag &&
+	    (s == cont_tag && name(son(e)) == name_tag &&
-		   isvar ( son ( son ( son ( e ) ) ) ) ) ||
+	     !isglob(son(son(e))) && isvar(son(son(e)))));
-		 ( t == reff_tag && is_direct ( son ( son ( e ) ) ) ) ) ;
-    }
+}
+/*
+    IS e INDIRECTLY ADDRESSABLE?
+*/
+static bool
+is_indable(exp e)
+{
+	unsigned char s = name(e);
+	if (s == name_tag) {
+		return (1);
+	}
+	if (s == cont_tag) {
+		unsigned char t = name(son(e));
-    return ( ( s == reff_tag && is_direct ( son ( e ) ) ) ||
+		return ((t == name_tag && isvar(son(son(e)))) ||
+			(t == cont_tag && name(son(son(e))) == name_tag &&
-	     s == addptr_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
+static void
-    PROTO_N ( ( sto, to, e ) )
-    PROTO_T ( bool sto X exp to X exp e )
+indable_son(bool sto, exp to, 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 )
+{
+	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(bool st, exp e)
+{
-    exp t = e ;
+	exp t = e;
-    exp temp ;
+	exp temp;
-    while ( temp = contexp ( st, t ), scan2 ( st, t, temp ),
+	while (temp = contexp(st, t), scan2(st, t, temp),
-	    temp = contexp ( st, t ), !last ( temp ) ) {
+	       temp = contexp(st, t), !last(temp)) {
-	t = contexp ( st, t ) ;
+		t = contexp(st, t);
-	st = 0 ;
+		st = 0;
-    }
+	}
-    return ;
+	return;
+}
 /*
     DOIT ROUTINE FOR APPLY
 */
 #if 0
-static bool apdo
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+apdo(exp t, int i)
+{
-    /* The first argument needs special treatment */
+	/* The first argument needs special treatment */
+	if (i == 1) {
-    if ( i == 1 ) return ( !is_indable ( t ) ) ;
+		return (!is_indable(t));
+	}
-    return ( 0 ) ;
+	return (0);
+}
 #endif
 /*
     DOIT ROUTINE FOR PLUS
 */
-static bool plusdo
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+plusdo(exp t, int i)
+{
-    /* Can't negate first argument */
+	/* Can't negate first argument */
+	if (i == 1) {
-    if ( i == 1 ) return ( !is_opnd ( t ) ) ;
+		return (!is_opnd(t));
+	}
-    /* But can negate the rest */
+	/* But can negate the rest */
-    if ( name ( t ) == neg_tag ) return ( 0 ) ;
+	if (name(t) == neg_tag) {
+		return (0);
+	}
-    return ( !is_opnd ( t ) ) ;
+	return (!is_opnd(t));
+}
 /*
     DOIT ROUTINE FOR MULT
 */
-static bool multdo
+static bool
-    PROTO_N ( ( t, i ) )
-    PROTO_T ( exp t X int i )
+multdo(exp t, int i)
 {
-    return ( i >= 0 && !is_o ( name ( t ) ) ) ;
+	return (i >= 0 && !is_o(name(t)));
 }
 /*
     DOIT ROUTINE FOR AND
 */
-static bool anddo
+static bool
+anddo(exp t, 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)));
+}
+/*
-    PROTO_N ( ( t, i ) )
+    DOIT ROUTINE FOR XOR
+*/
+static bool
-    PROTO_T ( exp t X int i )
+notado(exp t, 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 ) ) ) ;
+	return (i >= 0 && !is_o(name(t)));
+}
 /*
     MAIN SCAN ROUTINE
 */
-void scan2
+void
-    PROTO_N ( ( sto, to, e ) )
-    PROTO_T ( bool sto X exp to X exp e )
+scan2(bool sto, exp to, exp e)
+{
-    switch ( name ( e ) ) {
+	switch (name(e)) {
-	case cond_tag :
+	case cond_tag:
-	case rep_tag :
+	case rep_tag:
-	case compound_tag :
+	case compound_tag:
 #ifdef rscope_tag
-	case rscope_tag :
+	case rscope_tag:
 #endif
-	case solve_tag :
+	case solve_tag:
-	case concatnof_tag :
+	case concatnof_tag:
-	case nof_tag :
+	case nof_tag:
-	case diagnose_tag :
+	case diagnose_tag:
 #ifndef tdf3
-     case caller_tag: {
+	case caller_tag:
-        if (son(e) == nilexp) /* empty make_nof */
+		if (son(e) == nilexp) {
+			/* empty make_nof */
-        return ;
+			return;
+		}
-        scanargs (1, e);
+		scanargs(1, e);
-        return ;
+		return;
-     };
 #else
+	}
-	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: {
+	case tail_call_tag: {
-          exp cees = bro(son(e));
+		exp cees = bro(son(e));
-          cur_proc_has_tail_call = 1;
+		cur_proc_has_tail_call = 1;
-          cur_proc_use_same_callees  = (name(cees) == same_callees_tag);
+		cur_proc_use_same_callees = (name(cees) == same_callees_tag);
-          if (son(cees) != nilexp)
+		if (son(cees) != nilexp) {
-          cc (sto, to, 1, cees, no_alloca, 1);
+			cc(sto, to, 1, cees, no_alloca, 1);
+		}
-          indable_son (sto, to, e);
+		indable_son(sto, to, e);
-          return ;
+		return;
-       };
+	}
-       case apply_general_tag : {
+	case apply_general_tag: {
-             exp cees = bro(bro(son(e)));
+		exp cees = bro(bro(son(e)));
-             exp p_post = cees;	/* bro(p_post) is postlude */
+		exp p_post = cees;	/* bro(p_post) is postlude */
-             cur_proc_use_same_callees  = (name(cees) == same_callees_tag);
+		cur_proc_use_same_callees = (name(cees) == same_callees_tag);
+		while (name(bro(p_post)) == ident_tag &&
-             while (name(bro(p_post)) == ident_tag && name(son(bro(p_post))) == caller_name_tag)
+		       name(son(bro(p_post))) == caller_name_tag) {
-             p_post = son(bro(p_post));
+			p_post = son(bro(p_post));
+		}
-             scan2 (0, p_post, bro(p_post));
+		scan2(0, p_post, bro(p_post));
-             if (son(cees) != nilexp)
+		if (son(cees) != nilexp) {
-             scanargs (1, cees);
+			scanargs(1, cees);
+		}
-             if (no(bro(son(e))) != 0)
+		if (no(bro(son(e))) != 0) {
-             scanargs (1, bro(son(e)));
+			scanargs(1, bro(son(e)));
+		}
-             if ( !is_indable ( son(e) ) ) {
+		if (!is_indable(son(e))) {
-		exp ec ;
+			exp ec;
-		cca ( sto, to, 1, e ) ;
+			cca(sto, to, 1, e);
-		ec = contexp ( sto, to ) ;
+			ec = contexp(sto, to);
-		scan2 ( 1, ec, son ( ec ) ) ;
+			scan2(1, ec, son(ec));
-             } else {
+		} else {
-		scan2 ( sto, to, son ( e ) ) ;
+			scan2(sto, to, son(e));
-             }
+		}
-             return ;
+		return;
-          }
+	}
 #endif
-	case apply_tag : {
+	case apply_tag:
-	    scanargs ( 1, e ) ;
+		scanargs(1, e);
-	    /* Fall through */
+		/* Fall through */
-	}
-	case goto_lv_tag : {
+	case goto_lv_tag:
-	    if ( !is_indable ( son ( e ) ) ) {
+		if (!is_indable(son(e))) {
-		exp ec ;
+			exp ec;
-		cca ( sto, to, 1, e ) ;
+			cca(sto, to, 1, e);
-		ec = contexp ( sto, to ) ;
+			ec = contexp(sto, to);
-		scan2 ( 1, ec, son ( ec ) ) ;
+			scan2(1, ec, son(ec));
-	    } else {
+		} else {
-		scan2 ( sto, to, son ( e ) ) ;
+			scan2(sto, to, son(e));
-	    }
+		}
-	    return ;
+		return;
-	}
 #ifndef tdf3
-        case untidy_return_tag:
+	case untidy_return_tag:
 #endif
-	case res_tag : {
+	case res_tag: {
-	    long sz ;
+		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 ( 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 ) {
+		if (sz <= 64) {
-		all_assable ( sto, to, e ) ;
+			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 ;
+			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 ) ;
+		all_opnd(sto, to, e);
-	    return ;
-	}
-	case mult_tag : {
-	    cc ( sto, to, 1, e, multdo, 1 ) ;
-	    return ;
+		return;
 	}
-	case and_tag : {
+	case case_tag: {
-	    cc ( sto, to, 1, e, anddo, 1 ) ;
-	    return ;
-	}
-	case or_tag :
-	case xor_tag : {
-	    cc ( sto, to, 1, e, notado, 1 ) ;
-	    return ;
+		exp toc;
-	}
-	case cont_tag :
-	case contvol_tag : {
+		if (!is_opnd(son(e))) {
-	    /* 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 ) ;
+			cca(sto, to, 1, e);
-		temp = contexp ( sto, to ) ;
+			toc = contexp(sto, to);
-		scan2 ( 1, temp, son ( temp ) ) ;
+			scan2(1, toc, son(toc));
-	    } else {
+		} else {
-		scan2 ( sto, to, son ( e ) ) ;
+			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 ;
+		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 : {
+	case proc_tag:
-	    scan2 ( 1, e, son ( e ) ) ;
+		scan2(1, e, son(e));
-	    return ;
+		return;
-	}
 #if 0
-	case val_tag :{
+	case val_tag:
-	  if(name(sh(e)) == offsethd && al2(sh(e))>=8){
+		if (name(sh(e)) == offsethd && al2(sh(e)) >= 8) {
-	    no(e) = no(e)>>3;
+			no(e) = no(e) >> 3;
-	  }
+		}
-	  return;
+		return;
-	}
 #endif
+	default:
-	default : return ;
+		return;
-    }
+	}
+}

Subversion Repositories tendra.SVN

(root)/trunk/src/installers/680x0/common/scan2.c – Rev 2 → 7