Warning: Attempt to read property "date" on null in /usr/local/www/websvn.planix.org/blame.php on line 247

Warning: Attempt to read property "msg" on null in /usr/local/www/websvn.planix.org/blame.php on line 247
WebSVN – tendra.SVN – Blame – /branches/algol60/src/installers/alpha/common/is_worth.c – Rev 2

Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1
/*
2
    		 Crown Copyright (c) 1997
3
 
4
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
12
 
13
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
15
 
16
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
19
 
20
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
22
        these conditions;
23
 
24
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
27
        it may be put.
28
*/
29
 
30
 
31
/* 	$Id: is_worth.c,v 1.1.1.1 1998/01/17 15:56:00 release Exp $	 */
32
 
33
#ifndef lint
34
static char vcid[] = "$Id: is_worth.c,v 1.1.1.1 1998/01/17 15:56:00 release Exp $";
35
#endif /* lint */
36
 
37
#include "config.h"
38
#include "common_types.h"
39
#include "tags.h"
40
#include "expmacs.h"
41
#include "exp.h"
42
#include "shapemacs.h"
43
#include "coder.h"
44
#include "is_worth.h"
45
 
46
#define true 1
47
#define false 0
48
 
49
int is_worth
50
    PROTO_N ( ( c ) )
51
    PROTO_T ( exp c )
52
{
53
  /* decide if constant c is worth declaring
54
     separately */
55
  unsigned char cnam = name (c);
56
  bool isflt = is_floating(name(sh(c)));
57
 
58
  if (name (sh (c)) == ptrhd && al1(sh(c))==1 )
59
    return 0;			/* ptr bits */
60
  if (cnam == real_tag) return true;
61
  if (cnam==cont_tag&&isflt&&(name(son(c))!=name_tag||isglob(son(son(c))))){
62
    return true;
63
  }
64
  if (cnam==cont_tag && name (son(c))==name_tag && isglob(son(son (c)))) { 
65
    return true;      
66
  }
67
  if (cnam == val_tag) {	/* it is sometimes worthwhile extracting
68
				   big constants from loops ... */
69
    int  n = no (c);
70
    exp dad;
71
    if (n == 0) {
72
      return false;
73
    }
74
    dad = father (c);
75
    if(dad == nilexp) return 0;	/* bug ? */
76
    switch (name (dad)) {
77
    case and_tag: {
78
      exp grandad = father (dad);
79
      if ((name (grandad) == test_tag && (n & (n - 1)) == 0 &&
80
	  (props (grandad) == 5 || props (grandad) == 6) &&
81
	  (name (bro (son (grandad))) == val_tag 
82
	   && no (bro (son (grandad))) == 0))|| ((name (son (grandad)) == 
83
					  val_tag && no (son (grandad)) == 0))){
84
	  /*  a & 2^n == 0 is transformed later to
85
	      shift and test negative */
86
	return 0;
87
      }
88
      /* else next case */
89
    }
90
    FALL_THROUGH
91
    case or_tag: 
92
    case xor_tag: 
93
    case test_tag:
94
      return (n < 0 || n >= 0xffff  ); /* short literal operands */
95
 
96
    case mult_tag: case offset_mult_tag: 
97
    {
98
      if (n <= 0x7fff && n > -0x8000)
99
	return 0;		/* short literal operands */
100
      /*a*2^n and a*2^(n+-1) are transformed later to shifts and adds
101
       */
102
      return ((n&(n-1))!=0 && (n&(n+1)) != 0 && ((n-1)&(n-2))!=0);
103
	}
104
    case div1_tag: 
105
    case div2_tag: 
106
    case rem2_tag: 
107
    {
108
      if (n <= 0x7fff && n > -0x8000)
109
	return 0 /* short literal operands */ ;
110
      /* a/2^n transformed later to shift */  
111
      return ((n & (n - 1)) != 0);
112
    }
113
    default: 
114
    {
115
      return (n > 0x7fff || n < -0x8000) /* short literal operands */ ;
116
    }
117
    }				/* end sw */
118
  }      
119
  return ((!is_o (cnam) && cnam != clear_tag) ||
120
	  /* ignore simple things unless ... */
121
	  (cnam == cont_tag && name (son (c)) == cont_tag &&
122
	   name (son (son (c))) == name_tag)
123
	  );
124
}