Select Git revision
-
Martin Stjernholm authored
the compiler bark on more cyclic reference cases, but it's necessary to ensure indexed programs aren't (completely or partially) empty in pass 2, which can lead to very strange compilation errors. Also cleaned up some compiler error messages a little. Rev: src/las.c:1.434 Rev: src/program.c:1.748
Martin Stjernholm authoredthe compiler bark on more cyclic reference cases, but it's necessary to ensure indexed programs aren't (completely or partially) empty in pass 2, which can lead to very strange compilation errors. Also cleaned up some compiler error messages a little. Rev: src/las.c:1.434 Rev: src/program.c:1.748
las.c 128.45 KiB
/*
|| This file is part of Pike. For copyright information see COPYRIGHT.
|| Pike is distributed under GPL, LGPL and MPL. See the file COPYING
|| for more information.
|| $Id: las.c,v 1.434 2008/08/17 16:22:41 mast Exp $
*/
#include "global.h"
#include "interpret.h"
#include "las.h"
#include "array.h"
#include "object.h"
#include "stralloc.h"
#include "dynamic_buffer.h"
#include "lex.h"
#include "pike_types.h"
#include "constants.h"
#include "mapping.h"
#include "multiset.h"
#include "pike_error.h"
#include "docode.h"
#include "main.h"
#include "pike_memory.h"
#include "operators.h"
#include "callback.h"
#include "pike_macros.h"
#include "peep.h"
#include "builtin_functions.h"
#include "cyclic.h"
#include "opcodes.h"
#include "pikecode.h"
#include "gc.h"
#include "pike_compiler.h"
#include "block_alloc.h"
/* Define this if you want the optimizer to be paranoid about aliasing
* effects to to indexing.
*/
/* #define PARANOID_INDEXING */
/* #define NEW_ARG_CHECK */
static node *eval(node *);
static void optimize(node *n);
static node *localopt(node *n);
int cumulative_parse_error=0;
extern char *get_type_name(int);
#define MAX_GLOBAL 2048
/* #define yywarning my_yyerror */
int car_is_node(node *n)
{
if (!_CAR(n)) return 0;
switch(n->token)
{
case F_EXTERNAL:
case F_GET_SET:
case F_IDENTIFIER:
case F_TRAMPOLINE:
case F_CONSTANT:
case F_LOCAL:
case F_THIS:
case F_VERSION:
return 0;
default:
return 1; }
}
int cdr_is_node(node *n)
{
if (!_CDR(n)) return 0;
switch(n->token)
{
case F_EXTERNAL:
case F_GET_SET:
case F_IDENTIFIER:
case F_TRAMPOLINE:
case F_CONSTANT:
case F_LOCAL:
case F_THIS:
case F_VERSION:
return 0;
default:
return 1;
}
}
int node_is_leaf(node *n)
{
switch(n->token)
{
case F_EXTERNAL:
case F_GET_SET:
case F_IDENTIFIER:
case F_TRAMPOLINE:
case F_CONSTANT:
case F_LOCAL:
case F_VERSION:
return 1;
}
return 0;
}
#ifdef PIKE_DEBUG
void check_tree(node *n, int depth)
{
node *orig_n = n;
node *parent;
if(!d_flag) return;
if (!n) return;
parent = n->parent;
n->parent = NULL;
while(n) {
if(n->token==USHRT_MAX)
Pike_fatal("Free node in tree.\n");
switch(n->token)
{
case F_EXTERNAL:
case F_GET_SET:
if(n->type)
{
int parent_id = n->u.integer.a;
int id_no = n->u.integer.b;
struct program_state *state = Pike_compiler;
while (state && (state->new_program->id != parent_id)) {
state = state->previous;
}
if (state && id_no != IDREF_MAGIC_THIS) {
struct identifier *id = ID_FROM_INT(state->new_program, id_no); if (id) {
#if 0
#ifdef PIKE_DEBUG
/* FIXME: This test crashes on valid code because the type of the
* identifier can change in pass 2 - Hubbe
*/
if(id->type != n->type)
{
fputs("Type of external node "
"is not matching its identifier.\nid->type: ",stderr);
simple_describe_type(id->type);
fputs("\nn->type : ", stderr);
simple_describe_type(n->type);
fputc('\n', stderr);
Pike_fatal("Type of external node is not matching its identifier.\n");
}
#endif
#endif
}
}
}
}
if(d_flag<2) break;
#ifdef PIKE_DEBUG
if(!(depth & 1023))
{
node *q;
for(q=n->parent;q;q=q->parent)
if(q->parent==n)
Pike_fatal("Cyclic node structure found.\n");
}
#endif
if(car_is_node(n))
{
/* Update parent for CAR */
CAR(n)->parent = n;
depth++;
n = CAR(n);
continue;
}
if(cdr_is_node(n))
{
/* Update parent for CDR */
CDR(n)->parent = n;
depth++;
n = CDR(n);
continue;
}
while(n->parent &&
(!cdr_is_node(n->parent) || (CDR(n->parent) == n))) {
/* Backtrack */
n = n->parent;
depth--;
}
if (n->parent && cdr_is_node(n->parent)) {
/* Jump to the sibling */
CDR(n->parent)->parent = n->parent;
n = CDR(n->parent);
continue;
}
break;
}
if (n != orig_n) {
fputs("check_tree() lost track.\n", stderr);
d_flag = 0;
fputs("n:", stderr);
print_tree(n);
fputs("orig_n:", stderr);
print_tree(orig_n);
Pike_fatal("check_tree() lost track.\n");
}
n->parent = parent;
}
#endif
/* FIXME: Ought to use parent pointer to avoid recursion. */
INT32 count_args(node *n)
{
int a,b;
check_tree(n,0);
fatal_check_c_stack(16384);
if(!n) return 0;
switch(n->token)
{
case F_COMMA_EXPR:
case F_VAL_LVAL:
case F_ARG_LIST:
a=count_args(CAR(n));
if(a==-1) return -1;
b=count_args(CDR(n));
if(b==-1) return -1;
return a+b;
case F_CAST:
if(n->type == void_type_string)
return 0;
else
return count_args(CAR(n));
case F_SOFT_CAST:
return count_args(CAR(n));
case F_CASE:
case F_CASE_RANGE:
case F_FOR:
case F_DO:
case F_LOOP:
case F_INC_LOOP:
case F_DEC_LOOP:
case F_DEC_NEQ_LOOP:
case F_INC_NEQ_LOOP:
case F_BREAK:
case F_RETURN:
case F_CONTINUE:
case F_FOREACH:
return 0;
case '?':
{
int tmp1,tmp2;
tmp1=count_args(CADR(n));
tmp2=count_args(CDDR(n));
if(tmp1==-1 || tmp2==-1) return -1;
if(tmp1 < tmp2) return tmp1;
return tmp2;
}
case F_PUSH_ARRAY:
return -1;
case F_APPLY:
if(CAR(n)->token == F_CONSTANT &&
CAR(n)->u.sval.type == T_FUNCTION &&
CAR(n)->u.sval.subtype == FUNCTION_BUILTIN &&
n->type == void_type_string)
return 0;
return 1;
case F_RANGE_FROM_BEG:
case F_RANGE_FROM_END:
return 1;
case F_RANGE_OPEN:
return 0;
default:
if(n->type == void_type_string) return 0;
return 1;
}
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
struct pike_type *find_return_type(node *n)
{
struct pike_type *a, *b;
check_tree(n,0);
fatal_check_c_stack(16384);
if(!n) return 0;
optimize(n);
if (n->token == F_RETURN) {
if (CAR(n)) {
if (CAR(n)->type) {
copy_pike_type(a, CAR(n)->type);
} else {
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fputs("Return with untyped argument.\n", stderr);
print_tree(n);
}
#endif /* PIKE_DEBUG */
copy_pike_type(a, mixed_type_string);
}
} else {
copy_pike_type(a, zero_type_string);
}
return a;
}
if(!(n->tree_info & OPT_RETURN)) return 0;
if(car_is_node(n))
a=find_return_type(CAR(n));
else
a=0;
if(cdr_is_node(n))
b=find_return_type(CDR(n));
else
b=0;
if(a)
{
if(b) {
if (a != b) {
struct pike_type *res = or_pike_types(a, b, 1);
free_type(a); free_type(b);
return res;
}
free_type(b);
}
return a;
}
return b;
}
int check_tailrecursion(void)
{
int e;
if (Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPE_USED) {
/* There might be a lambda around that has references to the old context
* in which case we can't reuse it with a tail-recursive call.
*/
return 0;
}
if(debug_options & NO_TAILRECURSION) return 0;
for(e=0;e<Pike_compiler->compiler_frame->max_number_of_locals;e++)
{
if(!pike_type_allow_premature_toss(
Pike_compiler->compiler_frame->variable[e].type))
return 0;
}
return 1;
}
static int check_node_type(node *n, struct pike_type *t, const char *msg)
{
if (pike_types_le(n->type, t)) return 1;
if (!match_types(n->type, t)) {
yytype_report(REPORT_ERROR, NULL, 0, t, NULL, 0, n->type, 0, msg);
return 0;
}
if (THIS_COMPILATION->lex.pragmas & ID_STRICT_TYPES) {
yytype_report(REPORT_WARNING, NULL, 0, t, NULL, 0, n->type, 0, msg);
}
if (runtime_options & RUNTIME_CHECK_TYPES) {
node *p = n->parent;
if (CAR(p) == n) {
(_CAR(p) = mksoftcastnode(t, n))->parent = p;
} else if (CDR(p) == n) {
(_CDR(p) = mksoftcastnode(t, n))->parent = p;
} else {
yywarning("Failed to find place to insert soft cast.");
}
}
return 1;
}
#undef BLOCK_ALLOC_NEXT
#define BLOCK_ALLOC_NEXT u.node.a
#undef PRE_INIT_BLOCK
#define PRE_INIT_BLOCK(NODE) do { \
NODE->token = USHRT_MAX; \
} while (0)
BLOCK_ALLOC_FILL_PAGES(node_s, 2)
#define NODES (sizeof (((struct node_s_block *) NULL)->x) / sizeof (struct node_s))
#undef BLOCK_ALLOC_NEXT
#define BLOCK_ALLOC_NEXT next
void free_all_nodes(void)
{
if(!Pike_compiler->previous) {
node *tmp;
struct node_s_block *tmp2;
size_t e=0;
#ifndef PIKE_DEBUG
if(cumulative_parse_error)
{
#endif
for(tmp2=node_s_blocks;tmp2;tmp2=tmp2->next) e+=tmp2->used;
if(e)
{
size_t e2=e;
struct node_s_block *nextblk;
for(tmp2=node_s_blocks;tmp2;tmp2=nextblk)
{
int n = tmp2->used;
nextblk = tmp2->next;
/* We want to be able to access the token field of all
* the blocks...
*/
PIKE_MEM_RW(tmp2->x);
for(e=0;n && e<NODES;e++)
{
if (tmp2->x[e].token != USHRT_MAX)
{
tmp=tmp2->x+e;
#ifdef PIKE_DEBUG
if(!cumulative_parse_error)
{
fprintf(stderr,"Free node at %p, (%s:%d) (token=%d).\n",
(void *)tmp, tmp->current_file->str, tmp->line_number,
tmp->token);
debug_malloc_dump_references(tmp,0,2,0);
if(tmp->token==F_CONSTANT)
print_tree(tmp);
}
/* else */
#endif
{
/* Free the node and be happy */
/* Make sure we don't free any nodes twice */
if(car_is_node(tmp)) _CAR(tmp)=0;
if(cdr_is_node(tmp)) _CDR(tmp)=0;
#ifdef PIKE_DEBUG
if (l_flag > 3) {
fprintf(stderr, "Freeing node that had %d refs.\n",
tmp->refs);
}
#endif /* PIKE_DEBUG */
/* Force the node to be freed. */
tmp->refs = 1;
debug_malloc_touch(tmp->type);
free_node(tmp);
--n;
}
}
}
}
#ifdef PIKE_DEBUG
if(!cumulative_parse_error)
Pike_fatal("Failed to free %"PRINTSIZET"d nodes when compiling!\n",e2);
#endif
}
#ifndef PIKE_DEBUG
}
#endif free_all_node_s_blocks();
cumulative_parse_error=0;
}
}
void debug_free_node(node *n)
{
if(!n) return;
if (sub_ref(n)) {
#ifdef PIKE_DEBUG
if(l_flag>9)
print_tree(n);
#endif /* PIKE_DEBUG */
return;
}
n->parent = NULL;
do {
#ifdef PIKE_DEBUG
if(l_flag>9)
print_tree(n);
#endif /* PIKE_DEBUG */
debug_malloc_touch(n);
#ifdef PIKE_DEBUG
if (n->refs) {
Pike_fatal("Node with refs left about to be killed: %8p\n", n);
}
#endif /* PIKE_DEBUG */
switch(n->token)
{
case USHRT_MAX:
Pike_fatal("Freeing node again!\n");
break;
case F_CONSTANT:
free_svalue(&(n->u.sval));
break;
}
if (car_is_node(n)) {
/* Free CAR */
if (sub_ref(_CAR(n))) {
_CAR(n) = NULL;
} else {
_CAR(n)->parent = n;
n = _CAR(n);
_CAR(n->parent) = NULL;
continue;
}
}
if (cdr_is_node(n)) {
/* Free CDR */
if (sub_ref(_CDR(n))) {
_CDR(n) = NULL;
} else {
_CDR(n)->parent = n;
n = _CDR(n);
_CDR(n->parent) = NULL;
continue;
}
}
backtrack:
while (n->parent && !cdr_is_node(n->parent)) { /* Kill the node and backtrack */
node *dead = n;
#ifdef PIKE_DEBUG
if (dead->refs) {
print_tree(dead);
Pike_fatal("Killed node %p (%d) still has refs: %d\n",
dead, dead->token, dead->refs);
}
#endif /* PIKE_DEBUG */
n = n->parent;
if(dead->type) free_type(dead->type);
if(dead->name) free_string(dead->name);
if(dead->current_file) free_string(dead->current_file);
dead->token=USHRT_MAX;
really_free_node_s(dead);
}
if (n->parent && cdr_is_node(n->parent)) {
/* Kill node and jump to the sibling. */
node *dead = n;
#ifdef PIKE_DEBUG
if (dead->refs) {
Pike_fatal("Killed node %p still has refs: %d\n", dead, dead->refs);
}
#endif /* PIKE_DEBUG */
n = n->parent;
if(dead->type) free_type(dead->type);
if(dead->name) free_string(dead->name);
if(dead->current_file) free_string(dead->current_file);
dead->token=USHRT_MAX;
really_free_node_s(dead);
if (sub_ref(_CDR(n))) {
_CDR(n) = NULL;
goto backtrack;
} else {
_CDR(n)->parent = n;
n = _CDR(n);
_CDR(n->parent) = NULL;
continue;
}
}
/* Kill root node. */
#ifdef PIKE_DEBUG
if (n->refs) {
Pike_fatal("Killed node %p still has refs: %d\n", n, n->refs);
}
#endif /* PIKE_DEBUG */
if(n->type) free_type(n->type);
if(n->name) free_string(n->name);
if(n->current_file) free_string(n->current_file);
n->token=USHRT_MAX;
really_free_node_s(n);
break;
} while (n->parent);
}
/* here starts routines to make nodes */
static node *debug_mkemptynode(void)
{
node *res=alloc_node_s();
CHECK_COMPILER();
#ifdef __CHECKER__
MEMSET(res, 0, sizeof(node));
#endif /* __CHECKER__ */
res->refs = 0;
add_ref(res); /* For DMALLOC... */
res->token=0;
res->line_number=THIS_COMPILATION->lex.current_line;
copy_shared_string(res->current_file, THIS_COMPILATION->lex.current_file);
res->type=0;
res->name=0;
res->node_info=0;
res->tree_info=0;
res->parent=0;
return res;
}
#define mkemptynode() dmalloc_touch(node *, debug_mkemptynode())
static int is_automap_arg_list(node *n)
{
if(!n) return 0;
switch(n->token)
{
default: return 0;
case F_ARG_LIST:
return is_automap_arg_list(CAR(n)) ||
is_automap_arg_list(CDR(n));
case F_AUTO_MAP_MARKER: return 1;
}
}
node *debug_mknode(int token, node *a, node *b)
{
node *res;
switch(token)
{
case F_APPLY:
if(is_automap_arg_list(b))
token=F_AUTO_MAP;
break;
case F_INDEX:
switch((is_automap_arg_list(a) << 1) |
is_automap_arg_list(b))
{
case 1:
res=mkefuncallnode("rows",mknode(F_ARG_LIST,a,copy_node(CAR(b))));
free_node(b);
return res;
case 2:
res=mkefuncallnode("column",mknode(F_ARG_LIST,copy_node(CAR(a)),b));
free_node(a);
return res;
case 3:
return mkefuncallnode("`[]",mknode(F_ARG_LIST,a,b));
}
break;
#ifdef PIKE_DEBUG
case F_CAST: case F_SOFT_CAST:
Pike_fatal("Attempt to create a cast-node with mknode()!\n");
case F_CONSTANT:
Pike_fatal("Attempt to create an F_CONSTANT-node with mknode()!\n");
case F_LOCAL:
Pike_fatal("Attempt to create an F_LOCAL-node with mknode()!\n");
case F_IDENTIFIER:
Pike_fatal("Attempt to create an F_IDENTIFIER-node with mknode()!\n");
case F_TRAMPOLINE:
Pike_fatal("Attempt to create an F_TRAMPOLINE-node with mknode()!\n");
case F_EXTERNAL:
Pike_fatal("Attempt to create an F_EXTERNAL-node with mknode()!\n");
case F_GET_SET:
Pike_fatal("Attempt to create an F_GET_SET-node with mknode()!\n");
#endif /* PIKE_DEBUG */
}
check_tree(a,0);
check_tree(b,0);
res = mkemptynode();
_CAR(res) = dmalloc_touch(node *, a);
_CDR(res) = dmalloc_touch(node *, b);
if(a) {
a->parent = res;
}
if(b) {
b->parent = res;
}
res->token = token;
res->type = 0;
switch(token)
{
case F_CATCH:
res->node_info |= OPT_SIDE_EFFECT;
if (a) {
res->tree_info |= a->tree_info & ~OPT_BREAK;
}
break;
case F_AUTO_MAP:
case F_APPLY:
{
unsigned INT16 opt_flags = OPT_SIDE_EFFECT | OPT_EXTERNAL_DEPEND;
struct identifier *i = NULL;
if (a) {
switch(a->token) {
case F_CONSTANT:
switch(a->u.sval.type)
{
case T_FUNCTION:
if (a->u.sval.subtype == FUNCTION_BUILTIN)
{
opt_flags = a->u.sval.u.efun->flags;
} else if (a->u.sval.u.object->prog) {
i = ID_FROM_INT(a->u.sval.u.object->prog, a->u.sval.subtype);
} else {
yyerror("Calling function in destructed module.");
}
break;
case T_PROGRAM:
if(a->u.sval.u.program->flags & PROGRAM_CONSTANT) {
opt_flags=0;
}
if (a->u.sval.u.program->flags & PROGRAM_USES_PARENT) {
yyerror("Can not clone program without parent context."); }
break;
}
break;
case F_EXTERNAL:
case F_GET_SET:
if (a->u.integer.b != IDREF_MAGIC_THIS) {
struct program_state *state = Pike_compiler;
int program_id = a->u.integer.a;
while (state && (state->new_program->id != program_id)) {
state = state->previous;
}
if (state) {
i = ID_FROM_INT(state->new_program, a->u.integer.b);
} else {
yyerror("Parent has left.");
}
}
break;
case F_LOCAL:
/* FIXME: Should lookup functions in the local scope. */
default:
res->tree_info |= a->tree_info;
}
if (i && IDENTIFIER_IS_FUNCTION(i->identifier_flags)) {
res->node_info |= i->opt_flags;
} else {
res->node_info |= opt_flags;
}
} else {
res->node_info |= opt_flags;
}
res->node_info |= OPT_APPLY;
if(b) res->tree_info |= b->tree_info;
}
break;
case F_POP_VALUE:
copy_pike_type(res->type, void_type_string);
if(a) res->tree_info |= a->tree_info;
if(b) res->tree_info |= b->tree_info;
break;
case F_MAGIC_SET_INDEX:
res->node_info |= OPT_ASSIGNMENT;
/* FALL_THROUGH */
case F_MAGIC_INDEX:
case F_MAGIC_INDICES:
case F_MAGIC_VALUES:
{
int e;
struct program_state *state = Pike_compiler;
res->node_info |= OPT_EXTERNAL_DEPEND;
if (!b) break; /* Paranoia; probably compiler error. */
for(e=0;e<b->u.sval.u.integer;e++)
{
state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
state=state->previous;
}
break;
}
case F_UNDEFINED:
res->node_info |= OPT_EXTERNAL_DEPEND | OPT_SIDE_EFFECT;
break;
case F_RETURN:
res->node_info |= OPT_RETURN; break;
case F_BREAK:
res->node_info |= OPT_BREAK;
break;
case F_CONTINUE:
res->node_info |= OPT_CONTINUE;
break;
case F_DEFAULT:
case F_CASE:
case F_CASE_RANGE:
res->node_info |= OPT_CASE;
break;
case F_INC_LOOP:
case F_INC_NEQ_LOOP:
case F_DEC_LOOP:
case F_DEC_NEQ_LOOP:
res->node_info |= OPT_ASSIGNMENT;
if (a) {
res->tree_info |= a->tree_info;
}
if (b) {
res->tree_info |= (b->tree_info & ~(OPT_BREAK|OPT_CONTINUE));
}
break;
case F_SSCANF:
if(!b || count_args(b) == 0) break;
res->node_info |= OPT_ASSIGNMENT;
break;
case F_APPEND_ARRAY:
case F_MULTI_ASSIGN:
case F_ASSIGN:
case F_MOD_EQ:
case F_AND_EQ:
case F_MULT_EQ:
case F_ADD_EQ:
case F_SUB_EQ:
case F_DIV_EQ:
case F_LSH_EQ:
case F_RSH_EQ:
case F_XOR_EQ:
case F_OR_EQ:
res->node_info |= OPT_ASSIGNMENT;
if (a) {
res->tree_info |= a->tree_info;
}
if (b) {
res->tree_info |= b->tree_info;
}
break;
case F_INC:
case F_DEC:
case F_POST_INC:
case F_POST_DEC:
res->node_info |= OPT_ASSIGNMENT;
if (a) {
res->tree_info |= a->tree_info;
}
break;
case ':':
case F_RANGE_FROM_BEG:
case F_RANGE_FROM_END:
case F_RANGE_OPEN: res->node_info |= OPT_FLAG_NODE;
break;
default:
if(a) res->tree_info |= a->tree_info;
if(b) res->tree_info |= b->tree_info;
}
/* We try to optimize most things, but argument lists are hard... */
if((token != F_ARG_LIST) && (a || b))
res->node_info |= OPT_TRY_OPTIMIZE;
res->tree_info |= res->node_info;
#ifdef PIKE_DEBUG
if(d_flag > 3)
verify_shared_strings_tables();
#endif
check_tree(res,0);
#ifdef PIKE_DEBUG
if(d_flag > 3)
verify_shared_strings_tables();
#endif
return res;
}
node *debug_mkstrnode(struct pike_string *str)
{
node *res = mkemptynode();
res->token = F_CONSTANT;
res->u.sval.type = T_STRING;
#ifdef __CHECKER__
res->u.sval.subtype = 0;
#endif
copy_shared_string(res->u.sval.u.string, str);
res->type = get_type_of_svalue(&res->u.sval);
res->tree_info = OPT_SAFE;
return res;
}
node *debug_mkintnode(INT_TYPE nr)
{
node *res = mkemptynode();
res->token = F_CONSTANT;
res->u.sval.type = T_INT;
res->u.sval.subtype = NUMBER_NUMBER;
res->u.sval.u.integer = nr;
res->type=get_type_of_svalue( & res->u.sval);
res->tree_info = OPT_SAFE;
return res;
}
node *debug_mknewintnode(INT_TYPE nr)
{
node *res = mkemptynode();
res->token = F_CONSTANT;
res->u.sval.type = T_INT;
res->u.sval.subtype = NUMBER_NUMBER;
res->u.sval.u.integer = nr;
res->type=get_type_of_svalue( & res->u.sval);
res->tree_info = OPT_SAFE;
return res;
}
node *debug_mkfloatnode(FLOAT_TYPE foo)
{ node *res = mkemptynode();
res->token = F_CONSTANT;
copy_pike_type(res->type, float_type_string);
res->u.sval.type = T_FLOAT;
#ifdef __CHECKER__
res->u.sval.subtype = 0;
#endif
res->u.sval.u.float_number = foo;
res->tree_info = OPT_SAFE;
return res;
}
node *debug_mkprgnode(struct program *p)
{
struct svalue s;
s.u.program=p;
s.type = T_PROGRAM;
#ifdef __CHECKER__
s.subtype = 0;
#endif
return mkconstantsvaluenode(&s);
}
node *debug_mkapplynode(node *func,node *args)
{
return mknode(F_APPLY, func, args);
}
node *debug_mkefuncallnode(char *function, node *args)
{
struct pike_string *name;
node *n;
/* Force resolving since we don't want to get tangled up in the
* placeholder object here. The problem is really that the
* placeholder purport itself to contain every identifier, which
* makes it hide the real ones in find_module_identifier. This
* kludge will fail if the class being placeholded actually contains
* these identifiers, but then again I think it's a bit odd in the
* first place to look up these efuns in the module being compiled.
* Wouldn't it be better if this function consulted
* compiler_handler->get_default_module? /mast */
int orig_flags;
SET_FORCE_RESOLVE(orig_flags);
name = findstring(function);
if(!name || !(n=find_module_identifier(name,0)))
{
UNSET_FORCE_RESOLVE(orig_flags);
my_yyerror("Internally used efun undefined: %s",function);
return mkintnode(0);
}
UNSET_FORCE_RESOLVE(orig_flags);
n = mkapplynode(n, args);
return n;
}
node *debug_mkopernode(char *oper_id, node *arg1, node *arg2)
{
if(arg1 && arg2)
arg1=mknode(F_ARG_LIST,arg1,arg2);
return mkefuncallnode(oper_id, arg1);
}
node *debug_mkversionnode(int major, int minor)
{
node *res = mkemptynode();
res->token = F_VERSION;
#ifdef __CHECKER__ _CDR(res) = 0;
#endif
res->u.integer.a = major;
res->u.integer.b = minor;
return res;
}
node *debug_mklocalnode(int var, int depth)
{
struct compiler_frame *f;
int e;
node *res = mkemptynode();
res->token = F_LOCAL;
f=Pike_compiler->compiler_frame;
for(e=0;e<depth;e++) f=f->previous;
copy_pike_type(res->type, f->variable[var].type);
res->node_info = OPT_NOT_CONST;
res->tree_info = res->node_info;
#ifdef __CHECKER__
_CDR(res) = 0;
#endif
res->u.integer.a = var;
if (depth < 0) {
/* First appearance of this variable.
* Add initialization code.
*/
res->node_info |= OPT_ASSIGNMENT;
res->u.integer.b = 0;
} else {
res->u.integer.b = depth;
}
return res;
}
node *debug_mkidentifiernode(int i)
{
#if 1
node *res = mkexternalnode(Pike_compiler->new_program, i);
check_tree(res,0);
return res;
#else
node *res = mkemptynode();
res->token = F_IDENTIFIER;
copy_shared_string(res->type, ID_FROM_INT(Pike_compiler->new_program, i)->type);
/* FIXME */
if(IDENTIFIER_IS_CONSTANT(ID_FROM_INT(Pike_compiler->new_program, i)->identifier_flags))
{
res->node_info = OPT_EXTERNAL_DEPEND;
}else{
res->node_info = OPT_NOT_CONST;
}
res->tree_info=res->node_info;
#ifdef __CHECKER__
_CDR(res) = 0;
#endif
res->u.id.number = i;
#ifdef SHARED_NODES
res->u.id.prog = Pike_compiler->new_program;
#endif /* SHARED_NODES */
check_tree(res,0);
return res;
#endif
}
node *debug_mktrampolinenode(int i, struct compiler_frame *frame)
{
struct compiler_frame *f;
node *res = mkemptynode();
res->token = F_TRAMPOLINE;
copy_pike_type(res->type, ID_FROM_INT(Pike_compiler->new_program, i)->type);
/* FIXME */
if(IDENTIFIER_IS_CONSTANT(ID_FROM_INT(Pike_compiler->new_program, i)->identifier_flags))
{
res->node_info = OPT_EXTERNAL_DEPEND;
}else{
res->node_info = OPT_NOT_CONST;
}
res->tree_info=res->node_info;
#ifdef __CHECKER__
_CDR(res) = 0;
#endif
res->u.trampoline.ident=i;
res->u.trampoline.frame=frame;
for(f=Pike_compiler->compiler_frame;f != frame;f=f->previous)
f->lexical_scope|=SCOPE_SCOPED;
f->lexical_scope|=SCOPE_SCOPE_USED;
#ifdef SHARED_NODES
res->u.trampoline.prog = Pike_compiler->new_program;
#endif /* SHARED_NODES */
check_tree(res,0);
return res;
}
node *debug_mkexternalnode(struct program *parent_prog, int i)
{
#if 0
return mkidentifiernode(add_ext_ref(Pike_compiler, parent_prog, i));
#else /* !0 */
struct program_state *state;
node *res = mkemptynode();
res->token = F_EXTERNAL;
if (i == IDREF_MAGIC_THIS) {
type_stack_mark();
push_object_type (0, parent_prog->id);
res->type = pop_unfinished_type();
res->node_info = OPT_NOT_CONST;
Pike_compiler->compiler_frame->opt_flags |= OPT_EXTERNAL_DEPEND;
}
else {
struct identifier *id = ID_FROM_INT(parent_prog, i);
#ifdef PIKE_DEBUG
if(d_flag)
{
check_type_string(id->type);
check_string(id->name);
}
#endif
/* Mark the identifier reference as used. */
PTR_FROM_INT(parent_prog, i)->id_flags |= ID_USED;
copy_pike_type(res->type, id->type);
/* FIXME */
if(IDENTIFIER_IS_CONSTANT(id->identifier_flags))
{ res->node_info = OPT_EXTERNAL_DEPEND;
}else{
res->node_info = OPT_NOT_CONST;
if (IDENTIFIER_IS_VARIABLE(id->identifier_flags) &&
(id->run_time_type == PIKE_T_GET_SET)) {
/* Special case of F_EXTERNAL for ease of detection. */
res->token = F_GET_SET;
}
}
if (i) {
Pike_compiler->compiler_frame->opt_flags |= OPT_EXTERNAL_DEPEND;
}
}
res->tree_info = res->node_info;
#ifdef __CHECKER__
_CDR(res) = 0;
#endif
res->u.integer.a = parent_prog->id;
res->u.integer.b = i;
/* Bzot-i-zot */
state = Pike_compiler;
while(parent_prog != state->new_program)
{
state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
state=state->previous;
}
return res;
#endif /* 0 */
}
node *debug_mkthisnode(struct program *parent_prog, int inherit_num)
{
struct program_state *state;
node *res;
#ifdef PIKE_DEBUG
if ((inherit_num < -1) || (inherit_num > 65535)) {
Pike_fatal("This is bad: %p, %d\n", parent_prog, inherit_num);
}
#endif /* PIKE_DEBUG */
res = mkemptynode();
res->token = F_THIS;
type_stack_mark();
if (inherit_num >= 0) {
push_object_type(1, parent_prog->inherits[inherit_num].prog->id);
} else {
push_object_type(0, parent_prog->id);
}
res->type = pop_unfinished_type();
res->tree_info = res->node_info = OPT_NOT_CONST;
#ifdef __CHECKER__
_CDR(res) = 0;
#endif
res->u.integer.a = parent_prog->id;
res->u.integer.b = inherit_num;
/* Bzot-i-zot */
state = Pike_compiler;
while(parent_prog != state->new_program)
{
state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
state=state->previous;
}
return res;}
node *debug_mkcastnode(struct pike_type *type, node *n)
{
node *res;
if(!n) return 0;
#ifdef PIKE_DEBUG
if (!type) {
Pike_fatal("Casting to no type!\n");
}
#endif /* PIKE_DEBUG */
if (type == void_type_string) return mknode(F_POP_VALUE, n, 0);
#if 0
/* It's not always safe to ignore the cast in this case. E.g. if n
* has type program, the value can contain a function style program
* pointer which the cast will turn into a real program
* reference. */
if(type==n->type) return n;
#endif
res = mkemptynode();
res->token = F_CAST;
/* FIXME: Consider strengthening the node type [bug 4435].
* E.g. the cast in the code
*
* mapping(string:string) m = (["a":"A", "b":"B"]);
* return (array)m;
*
* should have a result type of array(array(string)),
* rather than array(mixed).
*/
copy_pike_type(res->type, type);
if(match_types(object_type_string, type) ||
match_types(program_type_string, type))
res->node_info |= OPT_SIDE_EFFECT;
res->tree_info |= n->tree_info;
_CAR(res) = n;
_CDR(res) = mktypenode(type);
n->parent = res;
return res;
}
node *debug_mksoftcastnode(struct pike_type *type, node *n)
{
node *res;
struct pike_type *result_type = NULL;
if(!n) return 0;
#ifdef PIKE_DEBUG
if (!type) {
Pike_fatal("Soft cast to no type!\n");
}
#endif /* PIKE_DEBUG */
if (Pike_compiler->compiler_pass == 2) {
if (type == void_type_string) {
yywarning("Soft cast to void.");
return mknode(F_POP_VALUE, n, 0);
}
if(type==n->type) {
struct pike_string *t1 = describe_type(type);
yywarning("Soft cast to %S is a noop.", t1);
free_string(t1);
return n;
}
if (n->type) {
#ifdef NEW_ARG_CHECK
if (!(result_type = soft_cast(type, n->type, 0))) {
ref_push_type_value(n->type);
ref_push_type_value(type);
yytype_report(REPORT_ERROR,
NULL, 0, NULL,
NULL, 0, NULL,
2, "Soft cast of %O to %O isn't a valid cast.");
} else if (result_type == n->type) {
ref_push_type_value(n->type);
ref_push_type_value(type);
yytype_report(REPORT_WARNING,
NULL, 0, NULL,
NULL, 0, NULL,
2, "Soft cast of %O to %O is a noop.");
}
#else /* !NEW_ARG_CHECK */
if (!check_soft_cast(type, n->type)) {
ref_push_type_value(type);
ref_push_type_value(n->type);
yytype_report(REPORT_WARNING,
NULL, 0, NULL,
NULL, 0, NULL,
2, "Soft cast to %S isn't a restriction of %S.");
}
/* FIXME: check_soft_cast() is weaker than pike_types_le()
* The resulting type should probably be the and between the old
* and the new type.
*/
#endif
}
}
res = mkemptynode();
res->token = F_SOFT_CAST;
if (result_type) {
res->type = result_type;
} else {
copy_pike_type(res->type, type);
}
res->tree_info |= n->tree_info;
_CAR(res) = n;
_CDR(res) = mktypenode(type);
n->parent = res;
return res;
}
void resolv_constant(node *n)
{
struct identifier *i;
struct program *p;
INT32 numid;
check_tree(n,0);
if(!n)
{ push_int(0);
}else{
switch(n->token)
{
case F_CONSTANT:
push_svalue(& n->u.sval);
return;
case F_EXTERNAL:
case F_GET_SET:
if (n->u.integer.b == IDREF_MAGIC_THIS) {
yyerror ("Expected constant, got reference to this");
push_int (0);
return;
}
else {
struct program_state *state = Pike_compiler;
while (state && (state->new_program->id != n->u.integer.a)) {
state = state->previous;
}
if(!state)
{
yyerror("Failed to resolve external constant.");
push_int(0);
return;
}
p = state->new_program;
numid=n->u.integer.b;
}
break;
case F_IDENTIFIER:
p=Pike_compiler->new_program;
numid=n->u.id.number;
break;
case F_LOCAL:
/* FIXME: Ought to have the name of the identifier in the message. */
yyerror("Expected constant, got local variable.");
push_int(0);
return;
case F_GLOBAL:
/* FIXME: Ought to have the name of the identifier in the message. */
yyerror("Expected constant, got global variable.");
push_int(0);
return;
case F_UNDEFINED:
if(Pike_compiler->compiler_pass==2) {
/* FIXME: Ought to have the name of the identifier in the message. */
yyerror("Expected constant, got undefined identifier.");
}
push_int(0);
return;
default:
{
if(is_const(n))
{
ptrdiff_t args=eval_low(n,1);
if(args==1) return;
if(args!=-1)
{
if(!args)
{
yyerror("Expected constant, got void expression.");
}else{ yyerror("Possible internal error!!!");
pop_n_elems(DO_NOT_WARN(args-1));
return;
}
} else {
yyerror("Failed to evaluate constant expression.");
}
} else {
yyerror("Expected constant expression.");
}
push_int(0);
return;
}
}
i=ID_FROM_INT(p, numid);
/* Warning:
* This code doesn't produce function pointers for class constants,
* which can be harmful...
* /Hubbe
*/
if(IDENTIFIER_IS_CONSTANT(i->identifier_flags))
{
if(i->func.offset != -1)
{
push_svalue(&PROG_FROM_INT(p, numid)->constants[i->func.offset].sval);
}else{
if(Pike_compiler->compiler_pass!=1)
yyerror("Constant is not defined yet.");
push_int(0);
}
}else{
my_yyerror("Identifier %S is not a constant", i->name);
push_int(0);
}
}
}
/* Leaves a function or object on the stack */
void resolv_class(node *n)
{
check_tree(n,0);
resolv_constant(n);
switch(Pike_sp[-1].type)
{
case T_OBJECT:
if(!Pike_sp[-1].u.object->prog)
{
pop_stack();
push_int(0);
}else{
f_object_program(1);
}
break;
default:
if (Pike_compiler->compiler_pass!=1)
yyerror("Illegal program identifier");
pop_stack();
push_int(0);
case T_FUNCTION:
case T_PROGRAM:
break;
}
}
/* This one always leaves a program if possible */void resolv_program(node *n)
{
check_tree(n,0);
resolv_class(n);
switch(Pike_sp[-1].type)
{
case T_FUNCTION:
if(program_from_function(Pike_sp-1))
break;
default:
if (Pike_compiler->compiler_pass!=1)
yyerror("Illegal program identifier");
pop_stack();
push_int(0);
case T_PROGRAM:
break;
}
}
node *index_node(node *n, char *node_name, struct pike_string *id)
{
node *ret;
JMP_BUF tmp;
check_tree(n,0);
if (!is_const(n) && !TEST_COMPAT(7, 6)) {
/* Index dynamically. */
return mknode(F_INDEX, copy_node(n), mkstrnode(id));
}
if(SETJMP(tmp))
{
if (node_name) {
handle_compile_exception ("Couldn't index module %s.", node_name);
} else {
handle_compile_exception ("Couldn't index module.");
}
}else{
resolv_constant(n);
switch(Pike_sp[-1].type)
{
case T_INT:
if (!Pike_sp[-1].u.integer) {
if(!Pike_compiler->num_parse_error) {
if (node_name) {
my_yyerror("Failed to index module %s with '%S'. "
"(Module doesn't exist?)",
node_name, id);
} else {
my_yyerror("Failed to index module with '%S'. "
"(Module doesn't exist?)",
id);
}
}
break;
}
/* Fall through. */
case T_FLOAT:
case T_STRING:
case T_ARRAY:
if (node_name) {
my_yyerror("Failed to index module %s, got %s. (Not a module?)",
node_name, get_name_of_type (Pike_sp[-1].type));
} else {
my_yyerror("Failed to index a module, got %s. (Not a module?)", get_name_of_type (Pike_sp[-1].type));
}
pop_stack();
push_int(0);
break;
case T_OBJECT:
case T_PROGRAM:
if(!(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE))
{
struct program *p;
if(Pike_sp[-1].type == T_OBJECT)
p=Pike_sp[-1].u.object->prog;
else
p=Pike_sp[-1].u.program;
if(p && !(p->flags & PROGRAM_PASS_1_DONE))
{
if(report_compiler_dependency(p))
{
pop_stack();
#if 0
fprintf(stderr, "Placeholder deployed for %p when indexing ", p);
print_tree(n);
fprintf(stderr, "with %s\n", id->str);
#endif
ref_push_object(placeholder_object);
break;
}
}
}
default:
{
ptrdiff_t c;
DECLARE_CYCLIC();
c = PTR_TO_INT(BEGIN_CYCLIC(Pike_sp[-1].u.refs, id));
if(c>1)
{
my_yyerror("Recursive module dependency when indexing with '%S'.", id);
pop_stack();
push_int(0);
}else{
volatile int exception = 0;
SET_CYCLIC_RET(c+1);
ref_push_string(id);
{
JMP_BUF recovery;
STACK_LEVEL_START(2);
if (SETJMP_SP(recovery, 2)) {
if (node_name) {
handle_compile_exception ("Error looking up '%S' in module %s.",
id, node_name);
} else {
handle_compile_exception ("Error looking up '%S' in module.",
id);
}
push_undefined();
exception = 1;
} else {
f_index(2);
}
STACK_LEVEL_DONE(1);
UNSETJMP(recovery);
}
if(Pike_sp[-1].type == T_INT &&
!Pike_sp[-1].u.integer &&
Pike_sp[-1].subtype==NUMBER_UNDEFINED)
{ if(Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE)
{
if (!exception) {
struct compilation *c = THIS_COMPILATION;
if (node_name) {
my_yyerror("Index '%S' not present in module %s.",
id, node_name);
} else {
my_yyerror("Index '%S' not present in module.", id);
}
resolv_constant(n);
low_yyreport(REPORT_ERROR, NULL, 0, parser_system_string,
1, "Indexed module was: %O.");
}
}else if (!(Pike_compiler->flags & COMPILATION_FORCE_RESOLVE)) {
/* Hope it's there in pass 2 */
pop_stack();
#if 0
fprintf(stderr, "Placeholder deployed when indexing ");
print_tree(n);
fprintf(stderr, "with %s\n", id->str);
#endif
ref_push_object(placeholder_object);
}
}
else if (Pike_compiler->new_program->flags & PROGRAM_PASS_1_DONE) {
if (((Pike_sp[-1].type == T_OBJECT &&
Pike_sp[-1].u.object == placeholder_object) ||
(Pike_sp[-1].type == T_PROGRAM &&
Pike_sp[-1].u.program == placeholder_program)) &&
/* Ugly special case: We must be able to get
* predef::__placeholder_object. */
(!node_name || strcmp (node_name, "predef"))) {
if (node_name)
my_yyerror("Got placeholder %s when indexing "
"module %s with '%S'. (Resolver problem.)",
get_name_of_type (Pike_sp[-1].type),
node_name, id);
else
my_yyerror("Got placeholder %s when indexing "
"module with '%S'. (Resolver problem.)",
get_name_of_type (Pike_sp[-1].type),
id);
}
}
else {
/* If we get a program that hasn't gone through pass 1 yet
* then we have to register a dependency now in our pass 1
* so that our pass 2 gets delayed. Otherwise the other
* program might still be just as unfinished when we come
* back here in pass 2. */
struct program *p = NULL;
if (Pike_sp[-1].type == T_PROGRAM)
p = Pike_sp[-1].u.program;
else if (Pike_sp[-1].type == T_OBJECT ||
(Pike_sp[-1].type == T_FUNCTION &&
Pike_sp[-1].subtype != FUNCTION_BUILTIN))
p = Pike_sp[-1].u.object->prog;
if (p && !(p->flags & PROGRAM_PASS_1_DONE))
report_compiler_dependency (p);
}
}
END_CYCLIC();
}
}
}
UNSETJMP(tmp);
ret=mkconstantsvaluenode(Pike_sp-1); pop_stack();
return ret;
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
int node_is_eq(node *a,node *b)
{
check_tree(a,0);
check_tree(b,0);
if(a == b) return 1;
if(!a || !b) return 0;
if(a->token != b->token) return 0;
fatal_check_c_stack(16384);
switch(a->token)
{
case F_TRAMPOLINE: /* FIXME, the context has to be the same! */
#ifdef SHARED_NODES
if(a->u.trampoline.prog != b->u.trampoline.prog)
return 0;
#endif
return a->u.trampoline.ident == b->u.trampoline.ident &&
a->u.trampoline.frame == b->u.trampoline.frame;
case F_EXTERNAL:
case F_GET_SET:
case F_LOCAL:
return a->u.integer.a == b->u.integer.a &&
a->u.integer.b == b->u.integer.b;
case F_IDENTIFIER:
return a->u.id.number == b->u.id.number;
case F_CAST:
case F_SOFT_CAST:
return a->type == b->type && node_is_eq(CAR(a), CAR(b));
case F_CONSTANT:
return is_equal(&(a->u.sval), &(b->u.sval));
default:
if( a->type != b->type ) return 0;
if(car_is_node(a) && !node_is_eq(CAR(a), CAR(b))) return 0;
if(cdr_is_node(a) && !node_is_eq(CDR(a), CDR(b))) return 0;
return 1;
}
}
node *debug_mktypenode(struct pike_type *t)
{
node *res = mkemptynode();
res->token = F_CONSTANT;
copy_pike_type(res->u.sval.u.type, t);
res->u.sval.type = T_TYPE;
/* FIXME: Should be type(val) */
type_stack_mark();
push_finished_type(t);
push_type(T_TYPE);
res->type = pop_unfinished_type();
return res;
}
node *low_mkconstantsvaluenode(const struct svalue *s)
{
node *res = mkemptynode();
res->token = F_CONSTANT;
assign_svalue_no_free(& res->u.sval, s); if(s->type == T_OBJECT ||
(s->type==T_FUNCTION && s->subtype!=FUNCTION_BUILTIN))
{
if(!(s->u.object->prog && (s->u.object->prog->flags & PROGRAM_CONSTANT)))
res->node_info|=OPT_EXTERNAL_DEPEND;
}
res->type = get_type_of_svalue(s);
res->tree_info |= OPT_SAFE;
return res;
}
node *debug_mkconstantsvaluenode(const struct svalue *s)
{
return low_mkconstantsvaluenode(s);
}
node *debug_mkliteralsvaluenode(const struct svalue *s)
{
node *res = low_mkconstantsvaluenode(s);
if(s->type!=T_STRING && s->type!=T_INT && s->type!=T_FLOAT)
res->node_info|=OPT_EXTERNAL_DEPEND;
return res;
}
node *debug_mksvaluenode(struct svalue *s)
{
switch(s->type)
{
case T_ARRAY:
return make_node_from_array(s->u.array);
case T_MULTISET:
return make_node_from_multiset(s->u.multiset);
case T_MAPPING:
return make_node_from_mapping(s->u.mapping);
case T_OBJECT:
#ifdef PIKE_DEBUG
if (s->u.object->prog == placeholder_program &&
Pike_compiler->compiler_pass == 2)
Pike_fatal("Got placeholder object in second pass.\n");
#endif
if(s->u.object == Pike_compiler->fake_object)
{
return mkefuncallnode("this_object", 0);
}
if(s->u.object->next == s->u.object)
{
int x=0;
node *n=mkefuncallnode("this_object", 0);
#ifndef PARENT_INFO
struct object *o;
for(o=Pike_compiler->fake_object;o!=s->u.object;o=o->parent)
{
n=mkefuncallnode("function_object",
mkefuncallnode("object_program",n));
}
#else
struct program_state *state=Pike_compiler;;
for(;state->fake_object!=s->u.object;state=state->previous)
{
state->new_program->flags |= PROGRAM_USES_PARENT | PROGRAM_NEEDS_PARENT;
n=mkefuncallnode("function_object",
mkefuncallnode("object_program",n));
}
#endif
return n; }
break;
case T_FUNCTION:
{
if(s->subtype != FUNCTION_BUILTIN)
{
if(s->u.object == Pike_compiler->fake_object)
return mkidentifiernode(s->subtype);
if(s->u.object->next == s->u.object)
{
return mkexternalnode(s->u.object->prog, s->subtype);
}
/* yyerror("Non-constant function pointer! (should not happen!)"); */
}
}
}
return mkconstantsvaluenode(s);
}
/* these routines operates on parsetrees and are mostly used by the
* optimizer
*/
/* FIXME: Ought to use parent pointer to avoid recursion.
* In the SHARED_NODES case there's no need of course.
*/
node *copy_node(node *n)
{
node *b;
debug_malloc_touch(n);
debug_malloc_touch(n->type);
#if 0
/* The following needs to be node type specific. */
debug_malloc_touch(n->u.node.a);
debug_malloc_touch(n->u.node.b);
#endif
check_tree(n,0);
if(!n) return n;
switch(n->token)
{
case F_LOCAL:
case F_IDENTIFIER:
case F_TRAMPOLINE:
b=mknewintnode(0);
if(b->type) free_type(b->type);
*b=*n;
copy_pike_type(b->type, n->type);
return b;
default:
add_ref(n);
return n;
}
if(n->name)
{
if(b->name) free_string(b->name);
add_ref(b->name=n->name);
}
/* FIXME: Should b->name be kept if n->name is NULL?
* /grubba 1999-09-22
*/
b->line_number = n->line_number;
b->node_info = n->node_info;
b->tree_info = n->tree_info; return b;
}
int is_const(node *n)
{
if(!n) return 1;
return !(n->tree_info & (OPT_SIDE_EFFECT |
OPT_NOT_CONST |
OPT_ASSIGNMENT |
OPT_CASE |
OPT_CONTINUE |
OPT_BREAK |
OPT_RETURN
));
}
int node_is_tossable(node *n)
{
if (!(n->tree_info & (OPT_SIDE_EFFECT |
OPT_ASSIGNMENT |
OPT_CASE |
OPT_CONTINUE |
OPT_BREAK |
OPT_RETURN
))) {
ptrdiff_t args;
if (n->tree_info & (OPT_NOT_CONST|OPT_SAFE))
return 1;
args = eval_low (n, 0);
if (args == -1) {
n->tree_info |= OPT_SIDE_EFFECT; /* A constant that throws. */
return 0;
}
else {
pop_n_elems (args);
n->tree_info |= OPT_SAFE;
return 1;
}
}
return 0;
}
/* this one supposes that the value is optimized */
int node_is_true(node *n)
{
if(!n) return 0;
switch(n->token)
{
case F_CONSTANT: return !SAFE_IS_ZERO(& n->u.sval);
default: return 0;
}
}
/* this one supposes that the value is optimized */
int node_is_false(node *n)
{
if(!n) return 0;
switch(n->token)
{
case F_CONSTANT: return SAFE_IS_ZERO(& n->u.sval);
default: return 0;
}
}
int node_may_overload(node *n, int lfun)
{
if(!n) return 0;
if(!n->type) return 1;
return type_may_overload(n->type, lfun);
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
node **last_cmd(node **a)
{
node **n;
if(!a || !*a) return (node **)NULL;
fatal_check_c_stack(16384);
if(((*a)->token == F_CAST) ||
((*a)->token == F_SOFT_CAST) ||
((*a)->token == F_POP_VALUE)) return last_cmd(&_CAR(*a));
if(((*a)->token != F_ARG_LIST) &&
((*a)->token != F_COMMA_EXPR)) return a;
if(CDR(*a))
{
if(CDR(*a)->token != F_CAST &&
CDR(*a)->token != F_SOFT_CAST &&
CDR(*a)->token != F_POP_VALUE &&
CDR(*a)->token != F_ARG_LIST &&
CDR(*a)->token != F_COMMA_EXPR)
return &_CDR(*a);
if((n=last_cmd(&_CDR(*a))))
return n;
}
if(CAR(*a))
{
if(CAR(*a)->token != F_CAST &&
CAR(*a)->token != F_SOFT_CAST &&
CAR(*a)->token != F_POP_VALUE &&
CAR(*a)->token != F_ARG_LIST &&
CAR(*a)->token != F_COMMA_EXPR)
return &_CAR(*a);
if((n=last_cmd(&_CAR(*a))))
return n;
}
return 0;
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
static node **low_get_arg(node **a,int *nr)
{
node **n;
if (!a[0]) return NULL;
if(a[0]->token != F_ARG_LIST)
{
if(!(*nr)--)
return a;
else
return NULL;
}
fatal_check_c_stack(16384);
if(CAR(*a))
if((n=low_get_arg(&_CAR(*a),nr)))
return n;
if(CDR(*a))
if((n=low_get_arg(&_CDR(*a),nr)))
return n;
return 0;
}
node **my_get_arg(node **a,int n) { return low_get_arg(a,&n); }
node **is_call_to(node *n, c_fun f)
{
switch(n->token) {
case F_AUTO_MAP:
case F_APPLY:
if(CAR(n) &&
CAR(n)->token == F_CONSTANT &&
CAR(n)->u.sval.type == T_FUNCTION &&
CAR(n)->u.sval.subtype == FUNCTION_BUILTIN &&
CAR(n)->u.sval.u.efun->function == f)
return &_CDR(n);
}
return 0;
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
static void low_print_tree(node *foo,int needlval)
{
if(!foo) return;
if(l_flag>9)
{
fprintf(stderr, "/*%x*/",foo->tree_info);
}
fatal_check_c_stack(16384);
switch(l_flag > 99 ? -1 : foo->token)
{
case USHRT_MAX:
fputs("FREED_NODE", stderr);
break;
case F_LOCAL:
if(needlval) fputc('&', stderr);
if(foo->u.integer.b)
{
fprintf(stderr, "$<%ld>%ld",(long)foo->u.integer.b,(long)foo->u.integer.a);
}else{
fprintf(stderr, "$%ld",(long)foo->u.integer.a);
}
break;
case '?':
fputc('(', stderr);
low_print_tree(_CAR(foo),0);
fputs(")?(", stderr);
if (_CDR(foo)) {
low_print_tree(_CADR(foo),0);
fputs("):(", stderr);
low_print_tree(_CDDR(foo),0);
} else {
fputs("0:0", stderr);
}
fputc(')', stderr);
break;
case F_IDENTIFIER:
if(needlval) fputc('&', stderr);
if (Pike_compiler->new_program) {
fprintf(stderr, "id(%s)",ID_FROM_INT(Pike_compiler->new_program, foo->u.id.number)->name->str);
} else {
fputs("unknown identifier", stderr);
}
break;
case F_EXTERNAL:
case F_GET_SET:
if(needlval) fputc('&', stderr);
{
struct program_state *state = Pike_compiler;
char *name = "?";
int program_id = foo->u.integer.a; int level = 0;
int id_no = foo->u.integer.b;
while(state && (state->new_program->id != program_id)) {
state = state->previous;
level++;
}
if (id_no == IDREF_MAGIC_THIS)
name = "this";
else if (state) {
struct identifier *id = ID_FROM_INT(state->new_program, id_no);
if (id && id->name) {
name = id->name->str;
}
}
fprintf(stderr, "ext(%d:%s)", level, name);
}
break;
case F_TRAMPOLINE:
if (Pike_compiler->new_program) {
fprintf(stderr, "trampoline<%s>",
ID_FROM_INT(Pike_compiler->new_program, foo->u.trampoline.ident)->name->str);
} else {
fputs("trampoline<unknown identifier>", stderr);
}
break;
case F_ASSIGN:
low_print_tree(_CDR(foo),1);
fputc('=', stderr);
low_print_tree(_CAR(foo),0);
break;
case F_POP_VALUE:
fputc('{', stderr);
low_print_tree(_CAR(foo), 0);
fputc('}', stderr);
break;
case F_CAST:
{
dynamic_buffer save_buf;
char *s;
init_buf(&save_buf);
my_describe_type(foo->type);
s=simple_free_buf(&save_buf);
fprintf(stderr, "(%s){",s);
free(s);
low_print_tree(_CAR(foo),0);
fputc('}', stderr);
break;
}
case F_SOFT_CAST:
{
dynamic_buffer save_buf;
char *s;
init_buf(&save_buf);
my_describe_type(foo->type);
s=simple_free_buf(&save_buf);
fprintf(stderr, "[%s(", s);
free(s);
low_print_tree(_CDR(foo), 0);
fprintf(stderr, ")]{");
low_print_tree(_CAR(foo),0);
fputc('}', stderr);
break;
}
case F_COMMA_EXPR: low_print_tree(_CAR(foo),0);
if(_CAR(foo) && _CDR(foo))
{
if(_CAR(foo)->type == void_type_string &&
_CDR(foo)->type == void_type_string)
fputs(";\n", stderr);
else
fputs(",\n", stderr);
}
low_print_tree(_CDR(foo),needlval);
return;
case F_ARG_LIST:
low_print_tree(_CAR(foo),0);
if(_CAR(foo) && _CDR(foo))
{
if(_CAR(foo)->type == void_type_string &&
_CDR(foo)->type == void_type_string)
fputs(";\n", stderr);
else
fputc(',', stderr);
}
low_print_tree(_CDR(foo),needlval);
return;
case F_ARRAY_LVALUE:
fputc('[', stderr);
low_print_tree(_CAR(foo),1);
fputc(']', stderr);
break;
case F_LVALUE_LIST:
low_print_tree(_CAR(foo),1);
if(_CAR(foo) && _CDR(foo)) fputc(',', stderr);
low_print_tree(_CDR(foo),1);
return;
case F_CONSTANT:
{
dynamic_buffer save_buf;
char *s;
init_buf(&save_buf);
describe_svalue(& foo->u.sval, 0, 0);
s=simple_free_buf(&save_buf);
fprintf(stderr, "const(%s)",s);
free(s);
break;
}
case F_VAL_LVAL:
low_print_tree(_CAR(foo),0);
fputs(",&", stderr);
low_print_tree(_CDR(foo),0);
return;
case F_AUTO_MAP:
fputs("__automap__ ", stderr);
low_print_tree(_CAR(foo),0);
fputc('(', stderr);
low_print_tree(_CDR(foo),0);
fputc(')', stderr);
return;
case F_AUTO_MAP_MARKER:
low_print_tree(_CAR(foo),0);
fputs("[*]", stderr);
return;
case F_APPLY:
low_print_tree(_CAR(foo),0);
fputc('(', stderr);
low_print_tree(_CDR(foo),0); fputc(')', stderr);
return;
case F_NORMAL_STMT_LABEL:
case F_CUSTOM_STMT_LABEL:
fprintf(stderr, "%s:", _CAR(foo)->u.sval.u.string->str);
low_print_tree(_CDR(foo),0);
return;
case F_LOOP:
fputs("loop(", stderr);
if(car_is_node(foo)) low_print_tree(_CAR(foo),0);
fputs(",{", stderr);
if(cdr_is_node(foo)) low_print_tree(_CDR(foo),0);
fputs("})", stderr);
return;
default:
if(!car_is_node(foo) && !cdr_is_node(foo))
{
fputs(get_token_name(foo->token), stderr);
return;
}
if(foo->token<256)
{
fputc(foo->token, stderr);
}else{
fputs(get_token_name(foo->token), stderr);
}
fputc('(', stderr);
if(car_is_node(foo)) low_print_tree(_CAR(foo),0);
if(car_is_node(foo) && cdr_is_node(foo))
fputc(',', stderr);
if(cdr_is_node(foo)) low_print_tree(_CDR(foo),0);
fputc(')', stderr);
return;
}
}
void print_tree(node *n)
{
check_tree(n,0);
low_print_tree(n,0);
fputc('\n', stderr);
}
/* The following routines need much better commenting. */
/* They also needed to support lexical scoping and external variables.
* /grubba 2000-08-27
*/
/*
* Known bugs:
* * Aliasing is not handled.
* * Called functions are assumed not to use lexical scoping.
*/
#if MAX_LOCAL > MAX_GLOBAL
#define MAX_VAR MAX_LOCAL
#else /* MAX_LOCAL <= MAX_GLOBAL */
#define MAX_VAR MAX_GLOBAL
#endif /* MAX_LOCAL > MAX_GLOBAL */
/* FIXME: Should perhaps use BLOCK_ALLOC for struct scope_info? */
struct scope_info
{
struct scope_info *next;
int scope_id;
char vars[MAX_VAR];};
struct used_vars
{
int err;
int ext_flags;
/* Note that the locals and externals linked lists are sorted on scope_id. */
struct scope_info *locals; /* Lexical scopes. scope_id == depth */
struct scope_info *externals; /* External scopes. scope_id == program_id */
};
#define VAR_BLOCKED 0
#define VAR_UNUSED 1
#define VAR_USED 3
/* FIXME: Shouldn't the following two functions be named "*_or_vars"? */
/* Perform a merge into a.
* Note that b is freed.
*/
static void low_and_vars(struct scope_info **a, struct scope_info *b)
{
while (*a && b) {
if ((*a)->scope_id < b->scope_id) {
a = &((*a)->next);
} else if ((*a)->scope_id > b->scope_id) {
struct scope_info *tmp = *a;
*a = b;
b = b->next;
(*a)->next = tmp;
} else {
struct scope_info *tmp = b;
int e;
for (e = 0; e < MAX_VAR; e++) {
(*a)->vars[e] |= b->vars[e];
}
a = &((*a)->next);
b = b->next;
free(tmp);
}
}
if (!*a) {
*a = b;
}
}
/* NOTE: The second argument will be freed. */
static void do_and_vars(struct used_vars *a,struct used_vars *b)
{
low_and_vars(&(a->locals), b->locals);
low_and_vars(&(a->externals), b->externals);
a->err |= b->err;
a->ext_flags |= b->ext_flags;
free(b);
}
/* Makes a copy of a.
* Note: Can throw errors on out of memory.
*/
static struct used_vars *copy_vars(struct used_vars *a)
{
struct used_vars *ret;
struct scope_info *src;
struct scope_info **dst;
ret=(struct used_vars *)xalloc(sizeof(struct used_vars));
src = a->locals;
dst = &(ret->locals);
*dst = NULL;
while (src) { *dst = malloc(sizeof(struct scope_info));
if (!*dst) {
src = ret->locals;
while(src) {
struct scope_info *tmp = src->next;
free(src);
src = tmp;
}
free(ret);
Pike_error("Out of memory in copy_vars.\n");
return NULL; /* Make sure that the optimizer knows we exit here. */
}
MEMCPY(*dst, src, sizeof(struct scope_info));
src = src->next;
dst = &((*dst)->next);
*dst = NULL;
}
src = a->externals;
dst = &(ret->externals);
*dst = NULL;
while (src) {
*dst = malloc(sizeof(struct scope_info));
if (!*dst) {
src = ret->locals;
while(src) {
struct scope_info *tmp = src->next;
free(src);
src = tmp;
}
src = ret->externals;
while(src) {
struct scope_info *tmp = src->next;
free(src);
src = tmp;
}
free(ret);
Pike_error("Out of memory in copy_vars.\n");
return NULL; /* Make sure that the optimizer knows we exit here. */
}
MEMCPY(*dst, src, sizeof(struct scope_info));
src = src->next;
dst = &((*dst)->next);
*dst = NULL;
}
ret->err = a->err;
ret->ext_flags = a->ext_flags;
return ret;
}
/* Find the insertion point for the variable a:scope_id:num.
* Allocates a new scope if needed.
* Can throw errors on out of memory.
*/
char *find_q(struct scope_info **a, int num, int scope_id)
{
struct scope_info *new;
#ifdef PIKE_DEBUG
if (l_flag > 3) {
fprintf(stderr, "find_q %d:%d\n", scope_id, num);
}
#endif /* PIKE_DEBUG */
while (*a && ((*a)->scope_id < scope_id)) {
a = &((*a)->next);
}
if ((*a) && ((*a)->scope_id == scope_id)) {
#ifdef PIKE_DEBUG
if (l_flag > 4) {
fputs("scope found.\n", stderr); }
#endif /* PIKE_DEBUG */
return (*a)->vars + num;
}
#ifdef PIKE_DEBUG
if (l_flag > 4) {
fputs("Creating new scope.\n", stderr);
}
#endif /* PIKE_DEBUG */
new = (struct scope_info *)xalloc(sizeof(struct scope_info));
MEMSET(new, VAR_UNUSED, sizeof(struct scope_info));
new->next = *a;
new->scope_id = scope_id;
*a = new;
return new->vars + num;
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
/* Find the variables that are used in the tree n. */
/* noblock: Don't mark unused variables that are written to as blocked.
* overwrite: n is an lvalue that is overwritten.
*/
static int find_used_variables(node *n,
struct used_vars *p,
int noblock,
int overwrite)
{
struct used_vars *a;
char *q;
if(!n) return 0;
fatal_check_c_stack(16384);
switch(n->token)
{
case F_LOCAL:
q = find_q(&(p->locals), n->u.integer.a, n->u.integer.b);
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "local %d:%d is ",
n->u.integer.b, n->u.integer.a);
}
#endif /* PIKE_DEBUG */
goto set_pointer;
case F_EXTERNAL:
case F_GET_SET:
q = find_q(&(p->externals), n->u.integer.b, n->u.integer.a);
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "external %d:%d is ",
n->u.integer.a, n->u.integer.b);
}
#endif /* PIKE_DEBUG */
goto set_pointer;
case F_IDENTIFIER:
q = find_q(&(p->externals), n->u.id.number,
Pike_compiler->new_program->id);
if(n->u.id.number > MAX_GLOBAL)
{
p->err=1;
return 0;
}
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "external %d:%d is ",
Pike_compiler->new_program->id, n->u.id.number);
}#endif /* PIKE_DEBUG */
set_pointer:
if(overwrite)
{
if(*q == VAR_UNUSED && !noblock) {
*q = VAR_BLOCKED;
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fputs("blocked\n", stderr);
}
} else {
if (l_flag > 2) {
fputs("overwritten\n", stderr);
}
#endif /* PIKE_DEBUG */
}
}
else
{
if(*q == VAR_UNUSED) {
*q = VAR_USED;
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fputs("used\n", stderr);
}
} else {
if (l_flag > 2) {
fputs("kept\n", stderr);
}
#endif /* PIKE_DEBUG */
}
}
break;
case F_ARROW:
case F_INDEX:
#ifdef PARANOID_INDEXING
/* Be paranoid, and assume aliasing. */
p->ext_flags = VAR_USED;
#endif /* PARANOID_INDEXING */
if(car_is_node(n)) find_used_variables(CAR(n),p,noblock,0);
if(cdr_is_node(n)) find_used_variables(CDR(n),p,noblock,0);
break;
case F_ASSIGN:
find_used_variables(CAR(n),p,noblock,0);
find_used_variables(CDR(n),p,noblock,1);
break;
case '?':
find_used_variables(CAR(n),p,noblock,0);
a=copy_vars(p);
find_used_variables(CADR(n),a,noblock,0);
find_used_variables(CDDR(n),p,noblock,0);
do_and_vars(p, a);
break;
case F_INC_NEQ_LOOP:
case F_DEC_NEQ_LOOP:
case F_INC_LOOP:
case F_DEC_LOOP:
case F_LOOP:
case F_FOREACH:
case F_FOR:
find_used_variables(CAR(n),p,noblock,0);
a=copy_vars(p);
find_used_variables(CDR(n),a,noblock,0);
do_and_vars(p, a);
break;
case F_SWITCH:
find_used_variables(CAR(n),p,noblock,0);
a=copy_vars(p);
find_used_variables(CDR(n),a,1,0);
do_and_vars(p, a);
break;
case F_DO:
a=copy_vars(p);
find_used_variables(CAR(n),a,noblock,0);
do_and_vars(p, a);
find_used_variables(CDR(n),p,noblock,0);
break;
default:
if(car_is_node(n)) find_used_variables(CAR(n),p,noblock,0);
if(cdr_is_node(n)) find_used_variables(CDR(n),p,noblock,0);
}
return 0;
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
/* no subtility needed */
static void find_written_vars(node *n,
struct used_vars *p,
int lvalue)
{
if(!n) return;
fatal_check_c_stack(16384);
switch(n->token)
{
case F_LOCAL:
if(lvalue) {
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "local %d:%d is written\n",
n->u.integer.b, n->u.integer.a);
}
#endif /* PIKE_DEBUG */
*find_q(&(p->locals), n->u.integer.a, n->u.integer.b) = VAR_USED;
}
break;
case F_EXTERNAL:
case F_GET_SET:
if(lvalue) {
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "external %d:%d is written\n",
n->u.integer.a, n->u.integer.b);
}
#endif /* PIKE_DEBUG */
*find_q(&(p->externals), n->u.integer.b, n->u.integer.a) = VAR_USED;
}
break;
case F_IDENTIFIER:
if(lvalue)
{
if(n->u.id.number >= MAX_VAR)
{
p->err=1;
return;
}
#ifdef PIKE_DEBUG
if (l_flag > 2) {
fprintf(stderr, "external %d:%d is written\n", Pike_compiler->new_program->id, n->u.id.number);
}
#endif /* PIKE_DEBUG */
*find_q(&(p->externals), n->u.id.number,
Pike_compiler->new_program->id) = VAR_USED;
}
break;
case F_APPLY:
case F_AUTO_MAP:
if(n->tree_info & OPT_SIDE_EFFECT) {
p->ext_flags = VAR_USED;
}
find_written_vars(CAR(n), p, 0);
find_written_vars(CDR(n), p, 0);
break;
case F_AUTO_MAP_MARKER:
find_written_vars(CAR(n), p, lvalue);
break;
case F_INDEX:
case F_ARROW:
#ifdef PARANOID_INDEXING
/* Be paranoid and assume aliasing. */
if (lvalue)
p->ext_flags = VAR_USED;
find_written_vars(CAR(n), p, 0);
#else /* !PARAONID_INDEXING */
/* Propagate the change to the indexed value.
* Note: This is sensitive to aliasing effects.
*/
find_written_vars(CAR(n), p, lvalue);
#endif /* PARANOID_INDEXING */
find_written_vars(CDR(n), p, 0);
break;
case F_SOFT_CAST:
find_written_vars(CAR(n), p, lvalue);
break;
case F_INC:
case F_DEC:
case F_POST_INC:
case F_POST_DEC:
find_written_vars(CAR(n), p, 1);
break;
case F_ASSIGN:
find_written_vars(CAR(n), p, 0);
find_written_vars(CDR(n), p, 1);
break;
case F_AND_EQ:
case F_OR_EQ:
case F_XOR_EQ:
case F_LSH_EQ:
case F_RSH_EQ:
case F_ADD_EQ:
case F_SUB_EQ:
case F_MULT_EQ:
case F_MOD_EQ:
case F_DIV_EQ:
find_written_vars(CAR(n), p, 1);
find_written_vars(CDR(n), p, 0);
break;
case F_SSCANF:
find_written_vars(CAR(n), p, 0);
/* FIXME: Marks arg 2 as written for now. */
find_written_vars(CDR(n), p, 1);
break;
case F_ARRAY_LVALUE:
find_written_vars(CAR(n), p, 1);
break;
case F_LVALUE_LIST:
find_written_vars(CAR(n), p, 1);
find_written_vars(CDR(n), p, 1);
break;
case F_VAL_LVAL:
find_written_vars(CAR(n), p, 0);
find_written_vars(CDR(n), p, 1);
break;
default:
if(car_is_node(n)) find_written_vars(CAR(n), p, 0);
if(cdr_is_node(n)) find_written_vars(CDR(n), p, 0);
}
}
void free_vars(struct used_vars *a)
{
struct scope_info *tmp;
tmp = a->locals;
while(tmp) {
struct scope_info *next = tmp->next;
free(tmp);
tmp = next;
}
tmp = a->externals;
while(tmp) {
struct scope_info *next = tmp->next;
free(tmp);
tmp = next;
}
}
/* return 1 if A depends on B */
static int depend_p2(node *a, node *b)
{
struct used_vars aa, bb;
int e;
ONERROR free_aa;
ONERROR free_bb;
if(!a || !b || is_const(a)) return 0;
aa.err = 0;
bb.err = 0;
aa.ext_flags = 0;
bb.ext_flags = 0;
aa.locals = NULL;
bb.locals = NULL;
aa.externals = NULL;
bb.externals = NULL;
SET_ONERROR(free_aa, free_vars, &aa);
SET_ONERROR(free_bb, free_vars, &bb);
/* A depends on B if A uses stuff that is written to by B. */
find_used_variables(a, &aa, 0, 0);
find_written_vars(b, &bb, 0);
#ifdef PIKE_DEBUG
if (l_flag > 2) { struct scope_info *aaa = aa.locals;
while (aaa) {
fputs("Used locals:\n", stderr);
for (e = 0; e < MAX_VAR; e++) {
if (aaa->vars[e] == VAR_USED) {
fprintf(stderr, "\t%d:%d\n", aaa->scope_id, e);
}
}
aaa = aaa->next;
}
aaa = bb.locals;
while (aaa) {
fputs("Written locals:\n", stderr);
for (e = 0; e < MAX_VAR; e++) {
if (aaa->vars[e] != VAR_UNUSED) {
fprintf(stderr, "\t%d:%d\n", aaa->scope_id, e);
}
}
aaa = aaa->next;
}
}
#endif /* PIKE_DEBUG */
UNSET_ONERROR(free_bb);
UNSET_ONERROR(free_aa);
/* If there was an error or
* If A has external dependencies due to indexing, we won't
* investigate further.
*/
if(aa.err || bb.err || aa.ext_flags == VAR_USED) {
free_vars(&aa);
free_vars(&bb);
return 1;
}
/* Check for overlap in locals. */
{
struct scope_info *aaa = aa.locals;
struct scope_info *bbb = bb.locals;
while (aaa) {
while (bbb && (bbb->scope_id < aaa->scope_id)) {
bbb = bbb->next;
}
if (!bbb) break;
if (bbb->scope_id == aaa->scope_id) {
for (e = 0; e < MAX_VAR; e++) {
if ((aaa->vars[e] == VAR_USED) &&
(bbb->vars[e] != VAR_UNUSED)) {
free_vars(&aa);
free_vars(&bb);
return 1;
}
}
}
aaa = aaa->next;
}
}
if (bb.ext_flags == VAR_USED) {
/* B has side effects.
*
* A is dependant if A uses any externals at all.
*/
/* No need to look closer at b */
struct scope_info *aaa = aa.externals;
/* FIXME: Probably only needed to check if aaa is NULL or not. */
while (aaa) {
for (e = 0; e < MAX_VAR; e++) {
if (aaa->vars[e] == VAR_USED) {
free_vars(&aa);
free_vars(&bb);
return 1;
}
}
aaa = aaa->next;
}
} else {
/* Otherwise check for overlaps. */
struct scope_info *aaa = aa.externals;
struct scope_info *bbb = bb.externals;
while (aaa) {
while (bbb && (bbb->scope_id < aaa->scope_id)) {
bbb = bbb->next;
}
if (!bbb) break;
if (bbb->scope_id == aaa->scope_id) {
for (e = 0; e < MAX_VAR; e++) {
if ((aaa->vars[e] == VAR_USED) &&
(bbb->vars[e] != VAR_UNUSED)) {
free_vars(&aa);
free_vars(&bb);
return 1;
}
}
}
aaa = aaa->next;
}
}
free_vars(&aa);
free_vars(&bb);
return 0;
}
static int depend_p3(node *a,node *b)
{
if(!b) return 0;
#if 0
if(!(b->tree_info & OPT_SIDE_EFFECT) &&
(b->tree_info & OPT_EXTERNAL_DEPEND))
return 1;
#endif
if((a->tree_info & OPT_EXTERNAL_DEPEND)) return 1;
return depend_p2(a,b);
}
#ifdef PIKE_DEBUG
static int depend_p(node *a,node *b)
{
if(l_flag > 3)
{
fputs("Checking if: ", stderr);
print_tree(a);
fputs("Depends on: ", stderr);
print_tree(b);
if(depend_p3(a,b))
{
fputs("The answer is (drumroll) : yes\n", stderr);
return 1;
}else{
fputs("The answer is (drumroll) : no\n", stderr);
return 0;
} }
return depend_p3(a,b);
}
#else
#define depend_p depend_p3
#endif
/* Check if n depends on the lvalue lval */
static int depend2_p(node *n, node *lval)
{
node *tmp;
int ret;
/* Make a temporary node (lval = 0), so that we can use depend_p(). */
ADD_NODE_REF2(lval,
tmp = mknode(F_ASSIGN, mkintnode(0), lval));
ret = depend_p(n, tmp);
free_node(tmp);
return ret;
}
static int function_type_max=0;
/* FIXME: Ought to use parent pointer to avoid recursion. */
static void low_build_function_type(node *n)
{
if(!n) return;
if(function_type_max++ > 999)
{
reset_type_stack();
push_type(T_MIXED);
push_type(T_VOID);
push_type(T_OR); /* return type is void or mixed */
push_type(T_MIXED);
push_type(T_VOID);
push_type(T_OR); /* varargs */
push_type(T_MANY);
return;
}
switch(n->token)
{
case F_COMMA_EXPR:
case F_ARG_LIST:
fatal_check_c_stack(16384);
low_build_function_type(CDR(n));
low_build_function_type(CAR(n));
break;
case F_PUSH_ARRAY:
{
struct pike_type *so_far;
struct pike_type *arg_type;
struct pike_type *tmp;
so_far = pop_type();
copy_pike_type(arg_type, void_type_string);
/* Convert fun(a,b,c...:d) to fun(a|b|c|void...:d)
*/
while(so_far->type == T_FUNCTION) {
tmp = or_pike_types(arg_type, so_far->car, 1);
free_type(arg_type);
arg_type = tmp;
copy_pike_type(tmp, so_far->cdr); free_type(so_far);
so_far = tmp;
}
tmp = or_pike_types(arg_type, so_far->car, 1);
free_type(arg_type);
arg_type = tmp;
push_finished_type(so_far->cdr); /* Return type */
free_type(so_far);
so_far = index_type(CAR(n)->type, int_type_string, n);
tmp = or_pike_types(arg_type, so_far, 1);
push_finished_type(tmp);
if (tmp == mixed_type_string) {
/* Ensure "or void"... */
push_type(T_VOID);
push_type(T_OR);
}
free_type(arg_type);
free_type(so_far);
free_type(tmp);
push_type(T_MANY);
}
return;
default:
if(n->type)
{
if(n->type == void_type_string) return;
push_finished_type(n->type);
}else{
push_type(T_MIXED);
}
push_type(T_FUNCTION);
}
}
static struct pike_string *get_name_of_function(node *n)
{
struct pike_string *name = NULL;
if (!n) {
MAKE_CONST_STRING(name, "NULL");
return name;
}
switch(n->token)
{
#if 0 /* FIXME */
case F_TRAMPOLINE:
#endif
case F_IDENTIFIER:
name = ID_FROM_INT(Pike_compiler->new_program, n->u.id.number)->name;
break;
case F_ARROW:
case F_INDEX:
if(CDR(n)->token == F_CONSTANT &&
CDR(n)->u.sval.type == T_STRING)
{
name = CDR(n)->u.sval.u.string;
}else{
MAKE_CONST_STRING(name, "dynamically resolved function");
}
break;
case F_CONSTANT:
switch(n->u.sval.type)
{
case T_FUNCTION: if(n->u.sval.subtype == FUNCTION_BUILTIN)
{
name = n->u.sval.u.efun->name;
}else{
name = ID_FROM_INT(n->u.sval.u.object->prog, n->u.sval.subtype)->name;
}
break;
case T_ARRAY:
MAKE_CONST_STRING(name, "array call");
break;
case T_PROGRAM:
MAKE_CONST_STRING(name, "clone call");
break;
default:
MAKE_CONST_STRING(name, "`() (function call)");
break;
}
break;
case F_EXTERNAL:
case F_GET_SET:
{
int id_no = n->u.integer.b;
if (id_no == IDREF_MAGIC_THIS) {
MAKE_CONST_STRING(name, "this"); /* Should perhaps qualify it. */
} else {
int program_id = n->u.integer.a;
struct program_state *state = Pike_compiler;
while (state && (state->new_program->id != program_id)) {
state = state->previous;
}
if (state) {
struct identifier *id = ID_FROM_INT(state->new_program, id_no);
if (id && id->name) {
name = id->name;
#if 0
#ifdef PIKE_DEBUG
/* FIXME: This test crashes on valid code because the type of the
* identifier can change in pass 2 -Hubbe
*/
if(id->type != f)
{
printf("Type of external node is not matching it's identifier.\nid->type: ");
simple_describe_type(id->type);
printf("\nf : ");
simple_describe_type(f);
printf("\n");
Pike_fatal("Type of external node is not matching it's identifier.\n");
}
#endif
#endif
}
}
if (!name) {
MAKE_CONST_STRING(name, "external symbol");
}
}
}
break;
case F_CAST:
case F_SOFT_CAST:
name = get_name_of_function(CAR(n)); break;
case F_TRAMPOLINE:
MAKE_CONST_STRING(name, "trampoline function");
break;
case F_LOCAL:
MAKE_CONST_STRING(name, "local variable");
break;
case F_APPLY:
if ((CAR(n)->token == F_CONSTANT) &&
(CAR(n)->u.sval.type == T_FUNCTION) &&
(CAR(n)->u.sval.subtype == FUNCTION_BUILTIN) &&
(CAR(n)->u.sval.u.efun->function == debug_f_aggregate)) {
if (CDR(n)) {
n = CDR(n);
while (n && (n->token == F_ARG_LIST)) n = CAR(n);
if (n) {
/* FIXME: Should really join the names of all the args. */
name = get_name_of_function(n);
} else {
MAKE_CONST_STRING(name, "dynamic array");
}
} else {
MAKE_CONST_STRING(name, "empty array");
}
} else {
MAKE_CONST_STRING(name, "returned value");
}
break;
default:
/* fprintf(stderr, "Node token: %s(%d)\n",
get_f_name(n->token), n->token); */
MAKE_CONST_STRING(name, "unknown function");
}
#ifdef PIKE_DEBUG
if (!name) {
Pike_fatal("Failed to get name of function.\n");
}
#endif
return name;
}
void fix_type_field(node *n)
{
struct compilation *c = THIS_COMPILATION;
struct pike_type *type_a, *type_b;
struct pike_type *old_type;
if (n->type && !(n->node_info & OPT_TYPE_NOT_FIXED))
return; /* assume it is correct */
old_type = n->type;
n->type = 0;
n->node_info &= ~OPT_TYPE_NOT_FIXED;
switch(n->token)
{
case F_SOFT_CAST:
if (CAR(n) && CAR(n)->type) {
#ifdef NEW_ARG_CHECK
struct pike_type *soft_type = NULL;
if (CDR(n) && (CDR(n)->token == F_CONSTANT) &&
(CDR(n)->u.sval.type == T_TYPE)) {
soft_type = CDR(n)->u.sval.u.type;
if ((n->type = soft_cast(soft_type, CAR(n)->type, 0))) {
/* Success. */
break; }
ref_push_type_value(CAR(n)->type);
ref_push_type_value(soft_type);
yytype_report(REPORT_ERROR, NULL, 0, NULL, NULL, 0, NULL,
2, "Soft cast of %O to %O isn't a valid cast.");
} else {
yytype_report(REPORT_ERROR, NULL, 0, type_type_string,
NULL, 0, CDR(n)->type, 0,
"Soft cast with non-type.");
}
/* Failure: Fall through to the old code. */
#else /* !NEW_ARG_CHECK */
if (!check_soft_cast(old_type, CAR(n)->type)) {
ref_push_type_value(old_type);
ref_push_type_value(CAR(n)->type);
yytype_report(REPORT_ERROR, NULL, 0, NULL, NULL, 0, NULL,
2, "Soft cast to %S isn't a restriction of %S.",
t1, t2);
}
/* FIXME: check_soft_cast() is weaker than pike_types_le()
* The resulting type should probably be the AND between the old
* and the new type.
*/
#endif /* NEW_ARG_CHECK */
}
/* FALL_THROUGH */
case F_CAST:
/* Type-field is correct by definition. */
copy_pike_type(n->type, old_type);
break;
case F_LAND:
case F_LOR:
if (!CAR(n) || CAR(n)->type == void_type_string) {
yyerror("Conditional uses void expression.");
copy_pike_type(n->type, mixed_type_string);
break;
}
if(!match_types(CAR(n)->type, mixed_type_string))
yyerror("Bad conditional expression.");
if (!CDR(n) || CDR(n)->type == void_type_string)
copy_pike_type(n->type, void_type_string);
else if(n->token == F_LAND || CAR(n)->type == CDR(n)->type)
{
copy_pike_type(n->type, CDR(n)->type);
}else{
n->type = or_pike_types(CAR(n)->type, CDR(n)->type, 0);
}
break;
case F_APPEND_ARRAY:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Assigning a void expression.");
copy_pike_type(n->type, void_type_string);
} else if (!CDR(n)) {
copy_pike_type(n->type, CAR(n)->type);
} else {
struct pike_type *tmp;
/* Ensure that the type-fields are up to date. */
fix_type_field(CAR(n));
fix_type_field(CDR(n));
type_stack_mark();
push_finished_type(CDR(n)->type);
push_type(T_ARRAY);
n->type = and_pike_types(CAR(n)->type, tmp = pop_unfinished_type());
free_type(tmp);
}
break;
case F_ASSIGN:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Assigning a void expression.");
copy_pike_type(n->type, void_type_string);
} else if (!CDR(n)) {
copy_pike_type(n->type, CAR(n)->type);
} else {
/* Ensure that the type-fields are up to date. */
fix_type_field(CAR(n));
fix_type_field(CDR(n));
#if 0
/* This test isn't sufficient, see below. */
check_node_type(CAR(n), CDR(n)->type, "Bad type in assignment.");
#else /* !0 */
if (!pike_types_le(CAR(n)->type, CDR(n)->type)) {
/* a["b"]=c and a->b=c can be valid when a is an array.
*
* FIXME: Exactly what case is the problem?
* /grubba 2005-02-15
*
* Example:
* array tmp = ({([]),([])});
* tmp->foo = 7; // Multi-assign.
* /grubba 2007-04-27
*/
if (((CDR(n)->token != F_INDEX && CDR(n)->token != F_ARROW) ||
!((TEST_COMPAT (7, 6) && /* Bug compatibility. */
match_types(array_type_string, CDR(n)->type)) ||
match_types(array_type_string, CADR(n)->type))) &&
!match_types(CDR(n)->type,CAR(n)->type)) {
yytype_report(REPORT_ERROR, NULL, 0, CDR(n)->type,
NULL, 0, CAR(n)->type,
0, "Bad type in assignment.");
} else {
if (c->lex.pragmas & ID_STRICT_TYPES) {
struct pike_string *t1 = describe_type(CAR(n)->type);
struct pike_string *t2 = describe_type(CDR(n)->type);
#ifdef PIKE_DEBUG
if (l_flag > 0) {
fputs("Warning: Invalid assignment: ", stderr);
print_tree(n);
}
#endif /* PIKE_DEBUG */
yywarning("An expression of type %S cannot be assigned to "
"a variable of type %S.", t1, t2);
free_string(t2);
free_string(t1);
}
if (runtime_options & RUNTIME_CHECK_TYPES) {
_CAR(n) = mksoftcastnode(CDR(n)->type, CAR(n));
}
}
}
#endif /* 0 */
n->type = and_pike_types(CAR(n)->type, CDR(n)->type);
}
break;
case F_ARRAY_LVALUE:
{
node *lval_list;
if (!(lval_list = CAR(n))) {
copy_pike_type(n->type, mixed_type_string);
} else {
struct pike_type *t;
node *n2;
if (lval_list->token == F_LVALUE_LIST) {
n2 = CAR(lval_list);
} else { n2 = lval_list;
}
if (n2) {
copy_pike_type(t, n2->type);
} else {
copy_pike_type(t, zero_type_string);
}
while ((n2 != lval_list) && (lval_list = CDR(lval_list))) {
if (lval_list->token == F_LVALUE_LIST) {
n2 = CAR(lval_list);
} else {
n2 = lval_list;
}
if (n2) {
struct pike_type *tmp = or_pike_types(t, n2->type, 1);
free_type(t);
t = tmp;
}
}
type_stack_mark();
push_finished_type(t);
push_type(T_ARRAY);
free_type(t);
n->type = pop_unfinished_type();
}
}
break;
case F_INDEX:
case F_ARROW:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Indexing a void expression.");
/* The optimizer converts this to an expression returning 0. */
copy_pike_type(n->type, zero_type_string);
} else if (CDR(n)) {
int valid;
type_a=CAR(n)->type;
type_b=CDR(n)->type;
if((valid = check_indexing(type_a, type_b, n)) <= 0)
if(!Pike_compiler->catch_level)
yytype_report((!valid)?REPORT_ERROR:REPORT_WARNING,
NULL, 0, NULL, NULL, 0, type_b,
0, "Indexing on illegal type.");
n->type = index_type(type_a, type_b, n);
} else {
copy_pike_type(n->type, mixed_type_string);
}
break;
case F_RANGE:
if (!CAR(n)) {
/* Unlikely to occur, and if it does, it has probably
* already been complained about.
*/
copy_pike_type(n->type, mixed_type_string);
}
else {
node *low = CADR (n), *high = CDDR (n);
n->type = range_type(CAR(n)->type,
low->token == F_RANGE_OPEN ? NULL : CAR (low)->type,
high->token == F_RANGE_OPEN ? NULL : CAR (high)->type);
}
break;
case F_PUSH_ARRAY:
if (CAR(n)) {
struct pike_type *array_type;
MAKE_CONSTANT_TYPE(array_type, tArr(tZero));
if (!pike_types_le(array_type, CAR(n)->type)) { yytype_report(REPORT_ERROR, NULL, 0, array_type,
NULL, 0, CAR(n)->type,
0, "Bad argument to splice operator.");
}
free_type(array_type);
/* FIXME: The type field of the splice operator is not yet utilized.
*
* It probably ought to be something similar to MANY(..., VOID).
*/
n->type = index_type(CAR(n)->type, int_type_string, n);
} else {
copy_pike_type(n->type, mixed_type_string);
}
break;
case F_AUTO_MAP_MARKER:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Indexing a void expression.");
/* The optimizer converts this to an expression returning 0. */
copy_pike_type(n->type, zero_type_string);
} else {
type_a=CAR(n)->type;
if(!match_types(type_a, array_type_string))
if(!Pike_compiler->catch_level)
yytype_report(REPORT_ERROR,
NULL, 0, array_type_string,
NULL, 0, type_a,
0, "[*] on non-array.");
n->type=index_type(type_a, int_type_string, n);
}
break;
case F_AUTO_MAP:
case F_APPLY:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Calling a void expression.");
} else {
struct pike_type *f; /* Expected type. */
struct pike_type *s; /* Actual type */
struct pike_string *name = NULL;
#ifndef NEW_ARG_CHECK
char *alternate_name = NULL;
#endif
INT32 args;
#ifdef NEW_ARG_CHECK
args = 0;
name = get_name_of_function(CAR(n));
#ifdef PIKE_DEBUG
if (l_flag>2)
safe_pike_fprintf (stderr, "Checking call to %S at %S:%d.\n", name,
n->current_file, n->line_number);
#endif /* PIKE_DEBUG */
/* NOTE: new_check_call() steals a reference from f! */
copy_pike_type(f, CAR(n)->type);
f = debug_malloc_pass(new_check_call(name, f, CDR(n), &args, 0));
if (!f) {
/* Errors have been generated. */
copy_pike_type(n->type, mixed_type_string);
break;
}
if ((n->type = new_get_return_type(dmalloc_touch(struct pike_type *, f),
0))) {
/* Type/argument-check OK. */ debug_malloc_touch(n->type);
free_type(f);
if(n->token == F_AUTO_MAP)
{
push_finished_type(n->type);
push_type(T_ARRAY);
free_type(n->type);
n->type = pop_type();
}
break;
}
/* Too few arguments or similar. */
copy_pike_type(n->type, mixed_type_string);
if ((s = get_first_arg_type(dmalloc_touch(struct pike_type *, f), 0))) {
yytype_report(REPORT_ERROR, NULL, 0, s,
NULL, 0, NULL,
0, "Too few arguments to %S (got %d).",
name, args);
free_type(s);
yytype_report(REPORT_ERROR, NULL, 0, NULL,
NULL, 0, CAR(n)->type,
0, "Function type:");
} else {
yytype_report(REPORT_ERROR, NULL, 0, function_type_string,
NULL, 0, f,
0, "Attempt to call a non function value %S.",
name);
}
free_type(f);
break;
#else /* !NEW_ARG_CHECK */
if (!match_types(CAR(n)->type, function_type_string) &&
!match_types(CAR(n)->type, array_type_string)) {
yytype_report(REPORT_ERROR, NULL, 0, function_type_string,
NULL, 0, CAR(n)->type,
0, "Calling non function value.");
copy_pike_type(n->type, mixed_type_string);
/* print_tree(n); */
break;
}
push_type(T_MIXED); /* match any return type */
push_type(T_VOID); /* even void */
push_type(T_OR);
push_type(T_VOID); /* not varargs */
push_type(T_MANY);
function_type_max=0;
low_build_function_type(CDR(n));
s = pop_type();
f = CAR(n)->type?CAR(n)->type:mixed_type_string;
n->type = check_call(s, f,
(c->lex.pragmas & ID_STRICT_TYPES) &&
!(n->node_info & OPT_WEAK_TYPE));
args = count_arguments(s);
max_args = count_arguments(f);
if(max_args<0) max_args = 0x7fffffff;
if (n->type) {
/* Type/argument-check OK. */
free_type(s);
if(n->token == F_AUTO_MAP)
{ push_finished_type(n->type);
push_type(T_ARRAY);
free_type(n->type);
n->type = pop_type();
}
break;
}
switch(CAR(n)->token)
{
#if 0 /* FIXME */
case F_TRAMPOLINE:
#endif
case F_IDENTIFIER:
name=ID_FROM_INT(Pike_compiler->new_program, CAR(n)->u.id.number)->name;
break;
case F_ARROW:
case F_INDEX:
if(CDAR(n)->token == F_CONSTANT &&
CDAR(n)->u.sval.type == T_STRING)
{
name=CDAR(n)->u.sval.u.string;
}else{
alternate_name="dynamically resolved function";
}
break;
case F_CONSTANT:
switch(CAR(n)->u.sval.type)
{
case T_FUNCTION:
if(CAR(n)->u.sval.subtype == FUNCTION_BUILTIN)
{
name=CAR(n)->u.sval.u.efun->name;
}else{
name=ID_FROM_INT(CAR(n)->u.sval.u.object->prog,
CAR(n)->u.sval.subtype)->name;
}
break;
case T_ARRAY:
alternate_name="array call";
break;
case T_PROGRAM:
alternate_name="clone call";
break;
default:
alternate_name="`() (function call)";
break;
}
break;
case F_EXTERNAL:
case F_GET_SET:
{
int id_no = CAR(n)->u.integer.b;
if (id_no == IDREF_MAGIC_THIS)
alternate_name = "this"; /* Should perhaps qualify it. */
else {
int program_id = CAR(n)->u.integer.a;
struct program_state *state = Pike_compiler;
alternate_name="external symbol";
while (state && (state->new_program->id != program_id)) {
state = state->previous;
}
if (state) {
struct identifier *id = ID_FROM_INT(state->new_program, id_no);
if (id && id->name) {
name = id->name;
#if 0
#ifdef PIKE_DEBUG
/* FIXME: This test crashes on valid code because the type of the
* identifier can change in pass 2 -Hubbe
*/
if(id->type != f)
{
printf("Type of external node is not matching it's identifier.\nid->type: ");
simple_describe_type(id->type);
printf("\nf : ");
simple_describe_type(f);
printf("\n");
Pike_fatal("Type of external node is not matching it's identifier.\n");
}
#endif
#endif
}
}
}
}
break;
default:
alternate_name="unknown function";
}
if(max_args < args)
{
if(TEST_COMPAT(0,6))
{
free_type(s);
copy_pike_type(n->type, mixed_type_string);
break;
}
if (name) {
my_yyerror("Too many arguments to %S.", name);
} else {
my_yyerror("Too many arguments to %s.", alternate_name);
}
}
else if(max_correct_args == args)
{
if (name) {
my_yyerror("Too few arguments to %S.", name);
} else {
my_yyerror("Too few arguments to %s.", alternate_name);
}
} else if (name) {
my_yyerror("Bad argument %d to %S.", max_correct_args+1, name);
} else {
my_yyerror("Bad argument %d to %s.",
max_correct_args+1, alternate_name);
}
yytype_error(NULL, f, s, 0);
/* print_tree(n); */
free_type(s);
#endif /* NEW_ARG_CHECK */
} copy_pike_type(n->type, mixed_type_string);
break;
case '?':
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("Conditional expression is void.");
} else if(!match_types(CAR(n)->type, mixed_type_string))
yyerror("Bad conditional expression.");
if(!CDR(n) || !CADR(n) || !CDDR(n) ||
CADR(n)->type == void_type_string ||
CDDR(n)->type == void_type_string)
{
copy_pike_type(n->type, void_type_string);
break;
}
if(CADR(n)->type == CDDR(n)->type)
{
copy_pike_type(n->type, CADR(n)->type);
break;
}
n->type = or_pike_types(CADR(n)->type, CDDR(n)->type, 0);
break;
case F_AND_EQ:
case F_OR_EQ:
case F_XOR_EQ:
case F_LSH_EQ:
case F_RSH_EQ:
case F_ADD_EQ:
case F_SUB_EQ:
case F_MULT_EQ:
case F_MOD_EQ:
case F_DIV_EQ:
if (CAR(n)) {
struct pike_string *op_string = NULL;
struct pike_type *call_type;
node *op_node;
/* Go via var = OP(var, expr);
*
* FIXME: To restrict the type further:
* type = typeof(OP(var, expr)) AND typeof(var);
*/
switch(n->token) {
case F_AND_EQ:
MAKE_CONST_STRING(op_string, "`&");
break;
case F_OR_EQ:
MAKE_CONST_STRING(op_string, "`|");
break;
case F_XOR_EQ:
MAKE_CONST_STRING(op_string, "`^");
break;
case F_LSH_EQ:
MAKE_CONST_STRING(op_string, "`<<");
break;
case F_RSH_EQ:
MAKE_CONST_STRING(op_string, "`>>");
break;
case F_ADD_EQ:
MAKE_CONST_STRING(op_string, "`+");
break;
case F_SUB_EQ:
MAKE_CONST_STRING(op_string, "`-");
break;
case F_MULT_EQ:
MAKE_CONST_STRING(op_string, "`*"); break;
case F_MOD_EQ:
MAKE_CONST_STRING(op_string, "`%");
break;
case F_DIV_EQ:
MAKE_CONST_STRING(op_string, "`/");
break;
default:
Pike_fatal("fix_type_field(): Unhandled token: %d\n", n->token);
break;
}
if (!(op_node = find_module_identifier(op_string, 0))) {
my_yyerror("Internally used efun undefined for token %d: %S",
n->token, op_string);
copy_pike_type(n->type, mixed_type_string);
break;
}
if (!op_node->type) {
fix_type_field(op_node);
}
push_finished_type(CAR(n)->type);
push_type(T_VOID);
push_type(T_MANY);
push_finished_type(CDR(n)?CDR(n)->type:mixed_type_string);
push_type(T_FUNCTION);
push_finished_type(CAR(n)->type);
push_type(T_FUNCTION);
call_type = pop_type();
n->type = check_call(call_type,
op_node->type ? op_node->type : mixed_type_string,
(c->lex.pragmas & ID_STRICT_TYPES) &&
!(op_node->node_info & OPT_WEAK_TYPE));
if (n->type) {
/* Type check ok. */
free_node(op_node);
free_type(call_type);
break;
}
yytype_report(REPORT_ERROR, NULL, 0,
op_node->type ? op_node->type : mixed_type_string,
NULL, 0, call_type,
0, "Bad arguments to %S.", op_string);
free_node(op_node);
free_type(call_type);
}
copy_pike_type(n->type, mixed_type_string);
break;
case F_INC:
case F_DEC:
case F_POST_INC:
case F_POST_DEC:
if (CAR(n)) {
/* The expression gets the type from the variable. */
/* FIXME: Ought to strip non-applicable subtypes from the type. */
copy_pike_type(n->type, CAR(n)->type);
} else {
copy_pike_type(n->type, mixed_type_string);
}
break;
case F_RETURN:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yywarning("Returning a void expression. Converted to zero.");
if (!CAR(n)) {
_CAR(n) = mkintnode(0); copy_pike_type(n->type, CAR(n)->type);
} else {
_CAR(n) = mknode(F_COMMA_EXPR, CAR(n), mkintnode(0));
copy_pike_type(n->type, CDAR(n)->type);
}
break;
} else if(Pike_compiler->compiler_frame &&
Pike_compiler->compiler_frame->current_return_type) {
if ((Pike_compiler->compiler_frame->current_return_type !=
void_type_string) ||
(CAR(n)->token != F_CONSTANT) ||
!SAFE_IS_ZERO(& CAR(n)->u.sval)) {
check_node_type(CAR(n),
Pike_compiler->compiler_frame->current_return_type,
"Wrong return type.");
}
}
copy_pike_type(n->type, void_type_string);
break;
case F_CASE_RANGE:
if (CDR(n) && CAR(n) && !TEST_COMPAT(0,6)) {
/* case 1 .. 2: */
if (!match_types(CAR(n)->type, CDR(n)->type)) {
if (!match_types(CAR(n)->type, int_type_string) ||
!match_types(CDR(n)->type, int_type_string)) {
yytype_report(REPORT_ERROR,
NULL, 0, CAR(n)->type,
NULL, 0, CDR(n)->type,
0, "Type mismatch in case range.");
}
} else if ((c->lex.pragmas & ID_STRICT_TYPES) &&
(CAR(n)->type != CDR(n)->type)) {
/* The type should be the same for both CAR & CDR. */
if (!pike_types_le(CDR(n)->type, CAR(n)->type)) {
/* Note that zero should be handled as int(0..0) here. */
if (!(CAR(n)->type == zero_type_string) ||
!(pike_types_le(CDR(n)->type, int_type_string))) {
yytype_report(REPORT_ERROR,
NULL, 0, CAR(n)->type,
NULL, 0, CDR(n)->type,
0, "Type mismatch in case range.");
}
} else if (!pike_types_le(CAR(n)->type, CDR(n)->type)) {
if (!(CDR(n)->type == zero_type_string) ||
!(pike_types_le(CAR(n)->type, int_type_string))) {
yytype_report(REPORT_WARNING,
NULL, 0, CAR(n)->type,
NULL, 0, CDR(n)->type,
0, "Type mismatch in case range.");
}
}
}
}
/* FALL_THROUGH */
case F_CASE:
case F_INC_LOOP:
case F_DEC_LOOP:
case F_DEC_NEQ_LOOP:
case F_INC_NEQ_LOOP:
case F_LOOP:
case F_CONTINUE:
case F_BREAK:
case F_DEFAULT:
case F_POP_VALUE:
copy_pike_type(n->type, void_type_string);
break;
case F_DO:
if (!CDR(n) || (CDR(n)->type == void_type_string)) { yyerror("do - while(): Conditional expression is void.");
} else if(!match_types(CDR(n)->type, mixed_type_string))
yyerror("Bad conditional expression do - while().");
copy_pike_type(n->type, void_type_string);
break;
case F_FOR:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("for(): Conditional expression is void.");
} else if(!match_types(CAR(n)->type, mixed_type_string))
yyerror("Bad conditional expression for().");
copy_pike_type(n->type, void_type_string);
break;
case F_SWITCH:
if (!CAR(n) || (CAR(n)->type == void_type_string)) {
yyerror("switch(): Conditional expression is void.");
} else if(!match_types(CAR(n)->type, mixed_type_string))
yyerror("Bad switch expression.");
copy_pike_type(n->type, void_type_string);
break;
case F_CONSTANT:
n->type = get_type_of_svalue(&n->u.sval);
break;
case F_FOREACH:
if (!CAR(n) || (CAR(n)->token != F_VAL_LVAL)) {
yyerror("foreach(): No expression to loop over.");
} else {
if (!CAAR(n) || pike_types_le(CAAR(n)->type, void_type_string)) {
yyerror("foreach(): Looping over a void expression.");
} else {
if(CDAR(n) && CDAR(n)->token == ':')
{
/* Check the iterator type */
struct pike_type *iterator_type;
struct pike_type *foreach_call_type;
MAKE_CONSTANT_TYPE(iterator_type,
tOr5(tArray, tStr, tObj,
tMapping, tMultiset));
if (!check_node_type(CAAR(n), iterator_type,
"Bad argument 1 to foreach()")) {
/* No use checking the index and value types if
* the iterator type is bad.
*/
free_type(iterator_type);
goto foreach_type_check_done;
}
free_type(iterator_type);
push_type(T_MIXED);
push_type(T_VOID);
push_type(T_MANY);
push_finished_type(CAAR(n)->type);
push_type(T_FUNCTION);
foreach_call_type = pop_type();
if (CADAR(n)) {
/* Check the index type */
struct pike_type *index_fun_type;
struct pike_type *index_type;
MAKE_CONSTANT_TYPE(index_fun_type,
tOr4(tFunc(tOr(tArray, tStr), tZero),
tFunc(tMap(tSetvar(0, tMix),
tMix), tVar(0)),
tFunc(tSet(tSetvar(1, tMix)),
tVar(1)),
tFunc(tObj, tZero))); index_type = check_call(foreach_call_type, index_fun_type, 0);
if (!index_type) {
/* Should not happen. */
yytype_report(REPORT_ERROR,
NULL, 0, NULL,
NULL, 0, NULL,
0, "Bad iterator type for index in foreach().");
} else {
if (!pike_types_le(index_type, CADAR(n)->type)) {
int level = REPORT_NOTICE;
if (!match_types(CADAR(n)->type, index_type)) {
level = REPORT_ERROR;
} else if (c->lex.pragmas & ID_STRICT_TYPES) {
level = REPORT_WARNING;
}
yytype_report(level,
NULL, 0, index_type,
NULL, 0, CADAR(n)->type,
0, "Type mismatch for index in foreach().");
}
free_type(index_type);
}
free_type(index_fun_type);
}
if (CDDAR(n)) {
/* Check the value type */
struct pike_type *value_fun_type;
struct pike_type *value_type;
MAKE_CONSTANT_TYPE(value_fun_type,
tOr5(tFunc(tArr(tSetvar(0, tMix)),
tVar(0)),
tFunc(tStr, tZero),
tFunc(tMap(tMix,tSetvar(1, tMix)),
tVar(1)),
tFunc(tMultiset, tInt1),
tFunc(tObj, tZero)));
value_type = check_call(foreach_call_type, value_fun_type, 0);
if (!value_type) {
/* Should not happen. */
yytype_report(REPORT_ERROR,
NULL, 0, NULL,
NULL, 0, NULL,
0, "Bad iterator type for value in foreach().");
} else {
if (!pike_types_le(value_type, CDDAR(n)->type)) {
int level = REPORT_NOTICE;
if (!match_types(CDDAR(n)->type, value_type)) {
level = REPORT_ERROR;
} else if (c->lex.pragmas & ID_STRICT_TYPES) {
level = REPORT_WARNING;
}
yytype_report(level,
NULL, 0, value_type,
NULL, 0, CDDAR(n)->type,
0, "Type mismatch for value in foreach().");
}
free_type(value_type);
}
free_type(value_fun_type);
}
free_type(foreach_call_type);
} else {
/* Old-style foreach */
struct pike_type *array_zero;
MAKE_CONSTANT_TYPE(array_zero, tArr(tZero));
if (!pike_types_le(array_zero, CAAR(n)->type)) {
yytype_report(REPORT_ERROR,
NULL, 0, array_zero,
NULL, 0, CAAR(n)->type, 0, "Bad argument 1 to foreach().");
} else {
if ((c->lex.pragmas & ID_STRICT_TYPES) &&
!pike_types_le(CAAR(n)->type, array_type_string)) {
yytype_report(REPORT_WARNING,
NULL, 0, CAAR(n)->type,
NULL, 0, array_type_string,
0,
"Argument 1 to foreach() is not always an array.");
}
if (!CDAR(n)) {
/* No loop variable. Will be converted to a counted loop
* by treeopt. */
} else if (pike_types_le(CDAR(n)->type, void_type_string)) {
yyerror("Bad argument 2 to foreach().");
} else {
struct pike_type *array_value_type;
type_stack_mark();
push_finished_type(CDAR(n)->type);
push_type(T_ARRAY);
array_value_type = pop_unfinished_type();
check_node_type(CAAR(n), array_value_type,
"Bad argument 1 to foreach().");
free_type(array_value_type);
}
}
free_type(array_zero);
}
}
}
foreach_type_check_done:
copy_pike_type(n->type, void_type_string);
break;
case F_SSCANF:
if (!CAR(n) || (CAR(n)->token != ':') ||
!CDAR(n) || (CDAR(n)->token != F_ARG_LIST) ||
!CADAR(n) || !CDDAR(n)) {
yyerror("Too few arguments to sscanf().");
MAKE_CONSTANT_TYPE(n->type, tIntPos);
} else {
struct pike_string *sscanf_name;
struct pike_type *sscanf_type;
node *args;
INT32 argno = 0;
if (CAAR(n)->u.sval.u.integer & SSCANF_FLAG_76_COMPAT) {
MAKE_CONST_STRING(sscanf_name, "sscanf_76");
add_ref(sscanf_type = sscanf_76_type_string);
} else {
MAKE_CONST_STRING(sscanf_name, "sscanf");
add_ref(sscanf_type = sscanf_type_string);
}
args = mknode(F_ARG_LIST, CDAR(n), CDR(n));
add_ref(CDAR(n));
if (CDR(n)) add_ref(CDR(n));
sscanf_type = new_check_call(sscanf_name, sscanf_type, args, &argno, 0);
free_node(args);
if (sscanf_type) {
if (!(n->type = new_get_return_type(sscanf_type, 0))) {
struct pike_type *expected;
if ((expected = get_first_arg_type(sscanf_type, 0))) {
yytype_report(REPORT_ERROR,
NULL, 0, expected,
NULL, 0, NULL,
0, "Too few arguments to %S (got %d).",
sscanf_name, argno);
free_type(expected); } else {
/* Most likely not reached. */
yytype_report(REPORT_ERROR,
NULL, 0, function_type_string,
NULL, 0, sscanf_type,
0, "Attempt to call a non function value %S.",
sscanf_name);
}
}
free_type(sscanf_type);
}
if (!n->type) {
MAKE_CONSTANT_TYPE(n->type, tIntPos);
}
}
break;
case F_UNDEFINED:
copy_pike_type(n->type, zero_type_string);
break;
case F_ARG_LIST:
if (n->parent) {
/* Propagate the changed type all the way up to the apply node. */
n->parent->node_info |= OPT_TYPE_NOT_FIXED;
}
/* FALL_THROUGH */
case F_COMMA_EXPR:
if(!CAR(n) || CAR(n)->type==void_type_string)
{
if(CDR(n))
copy_pike_type(n->type, CDR(n)->type);
else
copy_pike_type(n->type, void_type_string);
break;
}
if(!CDR(n) || CDR(n)->type == void_type_string)
{
if(CAR(n))
copy_pike_type(n->type, CAR(n)->type);
else
copy_pike_type(n->type, void_type_string);
break;
}
if (n->token == F_ARG_LIST) {
n->type = or_pike_types(CAR(n)->type, CDR(n)->type, 0);
} else {
copy_pike_type(n->type, CDR(n)->type);
}
break;
case F_MAGIC_INDEX:
/* FIXME: Could have a stricter type for ::`->(). */
/* FIXME: */
MAKE_CONSTANT_TYPE(n->type, tFunc(tMix tOr(tVoid,tInt),tMix));
break;
case F_MAGIC_SET_INDEX:
/* FIXME: Could have a stricter type for ::`->=(). */
/* FIXME: */
MAKE_CONSTANT_TYPE(n->type, tFunc(tMix tSetvar(0,tMix) tOr(tVoid,tInt), tVar(0)));
break;
case F_MAGIC_INDICES:
MAKE_CONSTANT_TYPE(n->type, tFunc(tOr(tVoid,tInt), tArr(tString)));
break;
case F_MAGIC_VALUES:
/* FIXME: Could have a stricter type for ::_values. */
MAKE_CONSTANT_TYPE(n->type, tFunc(tOr(tVoid,tInt), tArray));
break;
case F_CATCH:
/* FALL_THROUGH */
default:
copy_pike_type(n->type, mixed_type_string);
}
if (n->type != old_type) {
if (n->parent) {
n->parent->node_info |= OPT_TYPE_NOT_FIXED;
}
}
if (old_type) {
free_type(old_type);
}
#ifdef PIKE_DEBUG
check_type_string(n->type);
#endif /* PIKE_DEBUG */
}
static void zapp_try_optimize(node *n)
{
node *parent;
node *orig_n = n;
if(!n) return;
parent = n->parent;
n->parent = NULL;
while(1) {
n->node_info &= ~OPT_TRY_OPTIMIZE;
n->tree_info &= ~OPT_TRY_OPTIMIZE;
if (car_is_node(n)) {
CAR(n)->parent = n;
n = CAR(n);
continue;
}
if (cdr_is_node(n)) {
CDR(n)->parent = n;
n = CDR(n);
continue;
}
while (n->parent &&
(!cdr_is_node(n->parent) || (CDR(n->parent) == n))) {
n = n->parent;
}
if (n->parent && cdr_is_node(n->parent)) {
CDR(n->parent)->parent = n->parent;
n = CDR(n->parent);
continue;
}
break;
}
#ifdef PIKE_DEBUG
if (n != orig_n) {
Pike_fatal("zzap_try_optimize() lost track of parent.\n");
}
#endif /* PIKE_DEBUG */
n->parent = parent;
}
#if defined(SHARED_NODES)
/* FIXME: Ought to use parent pointer to avoid recursion. */
static void find_usage(node *n, unsigned char *usage,
unsigned char *switch_u,
const unsigned char *cont_u,
const unsigned char *break_u,
const unsigned char *catch_u)
{ if (!n)
return;
fatal_check_c_stack(16384);
switch(n->token) {
case F_ASSIGN:
if ((CDR(n)->token == F_LOCAL) && (!CDR(n)->u.integer.b)) {
usage[CDR(n)->u.integer.a] = 0;
} else if (CDR(n)->token == F_ARRAY_LVALUE) {
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
}
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
case F_SSCANF:
{
int i;
/* catch_usage is restored if sscanf throws an error. */
for (i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_u[i];
}
/* Only the first two arguments are evaluated. */
if (CAR(n) && CDAR(n)) {
find_usage(CDDAR(n), usage, switch_u, cont_u, break_u, catch_u);
find_usage(CADAR(n), usage, switch_u, cont_u, break_u, catch_u);
}
return;
}
case F_CATCH:
{
unsigned char catch_usage[MAX_LOCAL];
int i;
MEMCPY(catch_usage, usage, MAX_LOCAL);
find_usage(CAR(n), usage, switch_u, cont_u, catch_usage, catch_usage);
for(i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_usage[i];
}
return;
}
case F_AUTO_MAP:
case F_APPLY:
{
int i;
/* catch_usage is restored if the function throws an error. */
for (i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_u[i];
}
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case F_LVALUE_LIST:
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
if (CAR(n)) {
if ((CAR(n)->token == F_LOCAL) && (!CAR(n)->u.integer.b)) {
usage[CAR(n)->u.integer.a] = 0;
}
}
return;
case F_ARRAY_LVALUE:
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
case F_CONTINUE:
MEMCPY(usage, cont_u, MAX_LOCAL);
return;
case F_BREAK:
MEMCPY(usage, break_u, MAX_LOCAL);
return;
case F_DEFAULT:
case F_CASE:
case F_CASE_RANGE:
{
int i;
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
for(i = 0; i < MAX_LOCAL; i++) {
switch_u[i] |= usage[i];
}
return;
}
case F_SWITCH:
{
unsigned char break_usage[MAX_LOCAL];
unsigned char switch_usage[MAX_LOCAL];
int i;
MEMSET(switch_usage, 0, MAX_LOCAL);
MEMCPY(break_usage, usage, MAX_LOCAL);
find_usage(CDR(n), usage, switch_usage, cont_u, break_usage, catch_u);
for(i = 0; i < MAX_LOCAL; i++) {
usage[i] |= switch_usage[i];
}
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case F_RETURN:
MEMSET(usage, 0, MAX_LOCAL);
/* FIXME: The function arguments should be marked "used", since
* they are seen in backtraces.
*/
return;
case F_LOR:
case F_LAND:
{
unsigned char trail_usage[MAX_LOCAL];
int i;
MEMCPY(trail_usage, usage, MAX_LOCAL);
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
for(i=0; i < MAX_LOCAL; i++) {
usage[i] |= trail_usage[i];
}
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case '?':
{
unsigned char cadr_usage[MAX_LOCAL]; unsigned char cddr_usage[MAX_LOCAL];
int i;
MEMCPY(cadr_usage, usage, MAX_LOCAL);
MEMCPY(cddr_usage, usage, MAX_LOCAL);
find_usage(CADR(n), cadr_usage, switch_u, cont_u, break_u, catch_u);
find_usage(CDDR(n), cddr_usage, switch_u, cont_u, break_u, catch_u);
for (i=0; i < MAX_LOCAL; i++) {
usage[i] = cadr_usage[i] | cddr_usage[i];
}
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case F_DO:
{
unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
MEMCPY(break_usage, usage, MAX_LOCAL);
find_usage(CDR(n), usage, switch_u, cont_u, break_usage, catch_u);
MEMCPY(continue_usage, usage, MAX_LOCAL);
find_usage(CAR(n), usage, switch_u, break_usage, continue_usage,
catch_u);
return;
}
case F_FOR:
{
unsigned char loop_usage[MAX_LOCAL];
unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
int i;
MEMCPY(break_usage, usage, MAX_LOCAL);
/* for(;a;b) c; is handled like:
*
* if (a) { do { c; b; } while(a); }
*/
MEMSET(loop_usage, 0, MAX_LOCAL);
find_usage(CAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
if (CDR(n)) {
find_usage(CDDR(n), loop_usage, switch_u, cont_u, break_usage,
catch_u);
MEMCPY(continue_usage, loop_usage, MAX_LOCAL);
find_usage(CADR(n), loop_usage, switch_u, continue_usage, break_usage,
catch_u);
}
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= loop_usage[i];
}
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case F_FOREACH:
{
unsigned char loop_usage[MAX_LOCAL]; unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
int i;
MEMCPY(break_usage, usage, MAX_LOCAL);
/* Find the usage from the loop */
MEMSET(loop_usage, 0, MAX_LOCAL);
MEMCPY(continue_usage, usage, MAX_LOCAL);
find_usage(CDR(n), loop_usage, switch_u, continue_usage, break_usage,
catch_u);
if (CDAR(n)->token == F_LOCAL) {
if (!(CDAR(n)->u.integer.b)) {
loop_usage[CDAR(n)->u.integer.a] = 0;
}
} else if (CDAR(n)->token == F_LVALUE_LIST) {
find_usage(CDAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
}
for(i=0; i < MAX_LOCAL; i++) {
usage[i] |= loop_usage[i];
}
find_usage(CAAR(n), usage, switch_u, cont_u, break_u, catch_u);
return;
}
case F_LOCAL:
/* Use of local variable. */
if (!n->u.integer.b) {
/* Recently used, and used at all */
usage[n->u.integer.a] = 3;
}
return;
default:
if (cdr_is_node(n)) {
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
}
if (car_is_node(n)) {
find_usage(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
}
return;
}
}
/* Note: Always builds a new tree. */
static node *low_localopt(node *n,
unsigned char *usage,
unsigned char *switch_u,
const unsigned char *cont_u,
const unsigned char *break_u,
const unsigned char *catch_u)
{
node *car, *cdr;
if (!n)
return NULL;
switch(n->token) {
/* FIXME: Does not support F_LOOP yet. */
case F_ASSIGN:
if ((CDR(n)->token == F_LOCAL) && (!CDR(n)->u.integer.b)) {
/* Assignment of local variable */
if (!(usage[CDR(n)->u.integer.a] & 1)) {
/* Value isn't used. */
struct pike_type *ref_type; MAKE_CONSTANT_TYPE(ref_type, tOr(tComplex, tString));
if (!match_types(CDR(n)->type, ref_type)) {
/* The variable doesn't hold a refcounted value. */
free_type(ref_type);
return low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u);
}
free_type(ref_type);
}
usage[CDR(n)->u.integer.a] = 0;
cdr = CDR(n);
ADD_NODE_REF(cdr);
} else if (CDR(n)->token == F_ARRAY_LVALUE) {
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
} else {
cdr = CDR(n);
ADD_NODE_REF(cdr);
}
return mknode(F_ASSIGN, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u), cdr);
case F_SSCANF:
{
int i;
/* catch_usage is restored if sscanf throws an error. */
for (i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_u[i];
}
/* Only the first two arguments are evaluated. */
if (CAR(n) && CDAR(n)) {
cdr = low_localopt(CDDAR(n), usage, switch_u, cont_u, break_u, catch_u);
car = low_localopt(CADAR(n), usage, switch_u, cont_u, break_u, catch_u);
if (CDR(n)) {
ADD_NODE_REF(CDR(n));
}
return mknode(F_SSCANF, mknode(':', CAAR(n),
mknode(F_ARG_LIST, car, cdr)), CDR(n));
}
ADD_NODE_REF(n);
return n;
}
case F_CATCH:
{
unsigned char catch_usage[MAX_LOCAL];
int i;
MEMCPY(catch_usage, usage, MAX_LOCAL);
car = low_localopt(CAR(n), usage, switch_u, cont_u, catch_usage,
catch_usage);
for(i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_usage[i];
}
return mknode(F_CATCH, car, 0);
}
break;
case F_AUTO_MAP:
case F_APPLY:
{
int i;
/* catch_usage is restored if the function throws an error. */
for (i=0; i < MAX_LOCAL; i++) {
usage[i] |= catch_u[i];
}
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u); return mknode(n->token, car, cdr);
}
case F_LVALUE_LIST:
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
if (CAR(n)) {
if ((CAR(n)->token == F_LOCAL) && (!CAR(n)->u.integer.b)) {
/* Array assignment of local variable. */
if (!(usage[CDR(n)->u.integer.a] & 1)) {
/* Variable isn't used. */
/* FIXME: Warn? */
}
usage[CAR(n)->u.integer.a] = 0;
}
ADD_NODE_REF(CAR(n));
}
return mknode(F_LVALUE_LIST, CAR(n), cdr);
case F_ARRAY_LVALUE:
return mknode(F_ARRAY_LVALUE, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u), 0);
case F_CAST:
return mkcastnode(n->type, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u));
case F_SOFT_CAST:
return mksoftcastnode(n->type, low_localopt(CAR(n), usage, switch_u,
cont_u, break_u, catch_u));
case F_CONTINUE:
MEMCPY(usage, cont_u, MAX_LOCAL);
ADD_NODE_REF(n);
return n;
case F_BREAK:
MEMCPY(usage, break_u, MAX_LOCAL);
ADD_NODE_REF(n);
return n;
case F_DEFAULT:
case F_CASE:
case F_CASE_RANGE:
{
int i;
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
for(i = 0; i < MAX_LOCAL; i++) {
switch_u[i] |= usage[i];
}
return mknode(n->token, car, cdr);
}
case F_SWITCH:
{
unsigned char break_usage[MAX_LOCAL];
unsigned char switch_usage[MAX_LOCAL];
int i;
MEMSET(switch_usage, 0, MAX_LOCAL);
MEMCPY(break_usage, usage, MAX_LOCAL);
cdr = low_localopt(CDR(n), usage, switch_usage, cont_u, break_usage,
catch_u);
for(i = 0; i < MAX_LOCAL; i++) {
usage[i] |= switch_usage[i]; }
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return mknode(F_SWITCH, car, cdr);
}
case F_RETURN:
MEMSET(usage, 0, MAX_LOCAL);
/* FIXME: The function arguments should be marked "used", since
* they are seen in backtraces.
*/
return mknode(F_RETURN, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u), 0);
case F_LOR:
case F_LAND:
{
unsigned char trail_usage[MAX_LOCAL];
int i;
MEMCPY(trail_usage, usage, MAX_LOCAL);
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
for(i=0; i < MAX_LOCAL; i++) {
usage[i] |= trail_usage[i];
}
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return mknode(n->token, car, cdr);
}
case '?':
{
unsigned char cadr_usage[MAX_LOCAL];
unsigned char cddr_usage[MAX_LOCAL];
int i;
MEMCPY(cadr_usage, usage, MAX_LOCAL);
MEMCPY(cddr_usage, usage, MAX_LOCAL);
car = low_localopt(CADR(n), cadr_usage, switch_u, cont_u, break_u,
catch_u);
cdr = low_localopt(CDDR(n), cddr_usage, switch_u, cont_u, break_u,
catch_u);
for (i=0; i < MAX_LOCAL; i++) {
usage[i] = cadr_usage[i] | cddr_usage[i];
}
cdr = mknode(':', car, cdr);
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
return mknode('?', car, cdr);
}
case F_DO:
{
unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
int i;
MEMCPY(break_usage, usage, MAX_LOCAL);
/* Find the usage from the loop */
find_usage(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
MEMCPY(continue_usage, usage, MAX_LOCAL);
find_usage(CAR(n), usage, switch_u, continue_usage, break_usage,
catch_u);
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= break_usage[i];
}
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_usage,
catch_u);
MEMCPY(continue_usage, usage, MAX_LOCAL);
car = low_localopt(CAR(n), usage, switch_u, continue_usage, break_usage,
catch_u);
return mknode(F_DO, car, cdr);
}
case F_FOR:
{
unsigned char loop_usage[MAX_LOCAL];
unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
int i;
MEMCPY(break_usage, usage, MAX_LOCAL);
/*
* if (a A|B) {
* B
* do {
* B
* c;
* continue:
* D
* b;
* C
* } while (a A|B);
* A
* }
* break:
* A
*/
/* Find the usage from the loop. */
MEMSET(loop_usage, 0, MAX_LOCAL);
find_usage(CAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
if (CDR(n)) {
find_usage(CDDR(n), loop_usage, switch_u, cont_u, break_usage,
catch_u);
MEMCPY(continue_usage, loop_usage, MAX_LOCAL);
find_usage(CADR(n), loop_usage, switch_u, continue_usage, break_usage,
catch_u);
}
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= loop_usage[i];
}
/* The last thing to be evaluated is the conditional */
car = low_localopt(CAR(n), usage, switch_u, cont_u, break_u, catch_u);
if (CDR(n)) {
node *cadr, *cddr;
/* The incrementor */
cddr = low_localopt(CDDR(n), usage, switch_u, cont_u, break_usage,
catch_u);
MEMCPY(continue_usage, usage, MAX_LOCAL);
/* The body */
cadr = low_localopt(CADR(n), usage, switch_u, continue_usage,
break_usage, catch_u);
cdr = mknode(':', cadr, cddr);
} else {
cdr = 0;
}
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= break_usage[i];
}
/* The conditional is also the first thing to be evaluated. */
find_usage(car, usage, switch_u, cont_u, break_u, catch_u);
return mknode(F_FOR, car, cdr);
}
case F_FOREACH:
{
unsigned char loop_usage[MAX_LOCAL];
unsigned char break_usage[MAX_LOCAL];
unsigned char continue_usage[MAX_LOCAL];
int i;
MEMCPY(break_usage, usage, MAX_LOCAL);
/*
* D
* arr = copy_value(arr);
* int i = 0;
* A|B
* while (i < sizeof(arr)) {
* B
* loopvar = arr[i];
* C
* body;
* continue:
* A|B
* }
* break:
* A
*/
/* Find the usage from the loop */
MEMSET(loop_usage, 0, MAX_LOCAL);
MEMCPY(continue_usage, usage, MAX_LOCAL);
find_usage(CDR(n), loop_usage, switch_u, continue_usage, break_usage,
catch_u);
if (CDAR(n)->token == F_LOCAL) {
if (!(CDAR(n)->u.integer.b)) {
loop_usage[CDAR(n)->u.integer.a] = 0;
}
} else if (CDAR(n)->token == F_LVALUE_LIST) {
find_usage(CDAR(n), loop_usage, switch_u, cont_u, break_u, catch_u);
}
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= loop_usage[i];
}
MEMCPY(continue_usage, usage, MAX_LOCAL);
cdr = low_localopt(CDR(n), usage, switch_u, continue_usage, break_usage,
catch_u);
if (CDAR(n)->token == F_LOCAL) { if (!(CDAR(n)->u.integer.b)) {
usage[CDAR(n)->u.integer.a] = 0;
}
} else if (CDAR(n)->token == F_LVALUE_LIST) {
find_usage(CDAR(n), usage, switch_u, cont_u, break_u, catch_u);
}
for (i = 0; i < MAX_LOCAL; i++) {
usage[i] |= break_usage[i];
}
car = low_localopt(CAAR(n), usage, switch_u, cont_u, break_u, catch_u);
ADD_NODE_REF(CDAR(n));
return mknode(F_FOREACH, mknode(F_VAL_LVAL, car, CDAR(n)), cdr);
}
case F_LOCAL:
/* Use of local variable. */
if (!n->u.integer.b) {
/* Recently used, and used at all */
usage[n->u.integer.a] = 3;
}
ADD_NODE_REF(n);
return n;
default:
if (cdr_is_node(n)) {
cdr = low_localopt(CDR(n), usage, switch_u, cont_u, break_u, catch_u);
return mknode(n->token, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u),
cdr);
}
if (car_is_node(n)) {
ADD_NODE_REF(CDR(n));
return mknode(n->token, low_localopt(CAR(n), usage, switch_u, cont_u,
break_u, catch_u),
CDR(n));
}
ADD_NODE_REF(n);
return n;
}
}
static node *localopt(node *n)
{
unsigned char usage[MAX_LOCAL];
unsigned char b_usage[MAX_LOCAL];
unsigned char c_usage[MAX_LOCAL];
unsigned char s_usage[MAX_LOCAL];
unsigned char catch_usage[MAX_LOCAL];
node *n2;
MEMSET(usage, 0, MAX_LOCAL);
MEMSET(b_usage, 0, MAX_LOCAL);
MEMSET(c_usage, 0, MAX_LOCAL);
MEMSET(s_usage, 0, MAX_LOCAL);
MEMSET(catch_usage, 0, MAX_LOCAL);
n2 = low_localopt(n, usage, s_usage, c_usage, b_usage, catch_usage);
#ifdef PIKE_DEBUG
if (l_flag > 0) {
if ((n2 != n) || (l_flag > 4)) {
fputs("\nBefore localopt: ", stderr);
print_tree(n);
fputs("After localopt: ", stderr);
print_tree(n2);
}
}#endif /* PIKE_DEBUG */
free_node(n);
return n2;
}
#endif /* SHARED_NODES */
static void optimize(node *n)
{
node *tmp1, *tmp2, *tmp3;
struct compilation *c = THIS_COMPILATION;
struct pike_string *save_file =
dmalloc_touch(struct pike_string *, c->lex.current_file);
INT32 save_line = c->lex.current_line;
do
{
if(car_is_node(n) && !(CAR(n)->node_info & OPT_OPTIMIZED))
{
CAR(n)->parent = n;
n = CAR(n);
continue;
}
if(cdr_is_node(n) && !(CDR(n)->node_info & OPT_OPTIMIZED))
{
CDR(n)->parent = n;
n = CDR(n);
continue;
}
c->lex.current_line = n->line_number;
c->lex.current_file = dmalloc_touch(struct pike_string *, n->current_file);
n->tree_info = n->node_info;
if(car_is_node(n)) n->tree_info |= CAR(n)->tree_info;
if(cdr_is_node(n)) n->tree_info |= CDR(n)->tree_info;
if(!n->parent) break;
if(n->tree_info & (OPT_NOT_CONST|
OPT_SIDE_EFFECT|
OPT_EXTERNAL_DEPEND|
OPT_ASSIGNMENT|
OPT_RETURN|
OPT_FLAG_NODE))
{
if(car_is_node(n) &&
!(CAR(n)->tree_info & (OPT_NOT_CONST|
OPT_SIDE_EFFECT|
OPT_EXTERNAL_DEPEND|
OPT_ASSIGNMENT|
OPT_RETURN|
OPT_FLAG_NODE)) &&
(CAR(n)->tree_info & OPT_TRY_OPTIMIZE) &&
CAR(n)->token != F_VAL_LVAL)
{
_CAR(n) = eval(CAR(n));
if(CAR(n)) CAR(n)->parent = n;
zapp_try_optimize(CAR(n)); /* avoid infinite loops */
continue;
}
if(cdr_is_node(n) &&
!(CDR(n)->tree_info & (OPT_NOT_CONST|
OPT_SIDE_EFFECT|
OPT_EXTERNAL_DEPEND|
OPT_ASSIGNMENT|
OPT_RETURN|
OPT_FLAG_NODE)) &&
(CDR(n)->tree_info & OPT_TRY_OPTIMIZE))
{ _CDR(n) = eval(CDR(n));
if(CDR(n)) CDR(n)->parent = n;
zapp_try_optimize(CDR(n)); /* avoid infinite loops */
continue;
}
}
if (!n->type || (n->node_info & OPT_TYPE_NOT_FIXED)) {
fix_type_field(n);
}
debug_malloc_touch(n->type);
#ifdef PIKE_DEBUG
if(l_flag > 3 && n)
{
fprintf(stderr,"Optimizing (tree info=%04x):",n->tree_info);
print_tree(n);
}
#endif
switch(n->token)
{
#include "treeopt.h"
use_car:
ADD_NODE_REF2(CAR(n), tmp1 = CAR(n));
goto use_tmp1;
use_cdr:
ADD_NODE_REF2(CDR(n), tmp1 = CDR(n));
goto use_tmp1;
zap_node:
tmp1 = 0;
goto use_tmp1;
use_tmp1:
#ifdef PIKE_DEBUG
if (l_flag > 4) {
fputs("Optimized: ", stderr);
print_tree(n);
fputs("Result: ", stderr);
print_tree(tmp1);
}
#endif /* PIKE_DEBUG */
if(CAR(n->parent) == n)
_CAR(n->parent) = tmp1;
else
_CDR(n->parent) = tmp1;
if (!tmp1 || (tmp1->type != n->type)) {
n->parent->node_info |= OPT_TYPE_NOT_FIXED;
}
if(tmp1)
tmp1->parent = n->parent;
else
tmp1 = n->parent;
free_node(n);
n = tmp1;
#ifdef PIKE_DEBUG
if(l_flag > 3)
{
fputs("Result: ", stderr);
print_tree(n);
}
#endif
continue;
}
n->node_info |= OPT_OPTIMIZED;
n=n->parent;
}while(n);
c->lex.current_line = save_line;
c->lex.current_file = dmalloc_touch(struct pike_string *, save_file);
}
void optimize_node(node *n)
{
if(n &&
Pike_compiler->compiler_pass==2 &&
(n->node_info & OPT_TRY_OPTIMIZE))
{
optimize(n);
check_tree(n,0);
}
}
struct timer_oflo
{
INT32 counter;
int yes;
};
static void check_evaluation_time(struct callback *cb,void *tmp,void *ignored)
{
struct timer_oflo *foo=(struct timer_oflo *)tmp;
if(foo->counter-- < 0)
{
foo->yes=1;
pike_throw();
}
}
ptrdiff_t eval_low(node *n,int print_error)
{
unsigned INT16 num_strings, num_constants;
unsigned INT32 num_program;
size_t jump;
struct svalue *save_sp = Pike_sp;
ptrdiff_t ret;
struct program *prog = Pike_compiler->new_program;
#ifdef PIKE_USE_MACHINE_CODE
size_t num_relocations;
#endif /* PIKE_USE_MACHINE_CODE */
#ifdef PIKE_DEBUG
if(l_flag > 3 && n)
{
fprintf(stderr,"Evaluating (tree info=%x):",n->tree_info);
print_tree(n);
}
#endif
if(Pike_compiler->num_parse_error) {
return -1;
}
num_strings = prog->num_strings;
num_constants = prog->num_constants;
num_program = prog->num_program;
#ifdef PIKE_USE_MACHINE_CODE
num_relocations = prog->num_relocations;
#endif /* PIKE_USE_MACHINE_CODE */
jump = docode(dmalloc_touch(node *, n));
ret=-1; if(!Pike_compiler->num_parse_error)
{
struct callback *tmp_callback;
struct timer_oflo foo;
/* This is how long we try to optimize before giving up... */
foo.counter=10000;
foo.yes=0;
#ifdef PIKE_USE_MACHINE_CODE
make_area_executable ((char *) (prog->program + num_program),
(prog->num_program - num_program) *
sizeof (prog->program[0]));
#endif
tmp_callback=add_to_callback(&evaluator_callbacks,
check_evaluation_time,
(void *)&foo,0);
if(apply_low_safe_and_stupid(Pike_compiler->fake_object, jump))
{
/* Assume the node will throw errors at runtime too. */
n->tree_info |= OPT_SIDE_EFFECT;
n->node_info |= OPT_SIDE_EFFECT;
if(print_error)
/* Generate error message */
if(!Pike_compiler->catch_level)
handle_compile_exception("Error evaluating constant.");
else {
free_svalue(&throw_value);
mark_free_svalue (&throw_value);
}
else {
free_svalue(&throw_value);
mark_free_svalue (&throw_value);
}
}else{
if(foo.yes)
pop_n_elems(Pike_sp-save_sp);
else
ret=Pike_sp-save_sp;
n->tree_info |= OPT_SAFE;
}
remove_callback(tmp_callback);
}
while(prog->num_strings > num_strings)
{
prog->num_strings--;
free_string(prog->strings[prog->num_strings]);
}
while(prog->num_constants > num_constants)
{
struct program_constant *p_const;
prog->num_constants--;
p_const = prog->constants + prog->num_constants;
free_svalue(&p_const->sval);
#if 0
if (p_const->name) {
free_string(p_const->name);
p_const->name = NULL;
}
#endif /* 0 */
}
#ifdef PIKE_USE_MACHINE_CODE
prog->num_relocations = num_relocations;
#ifdef VALGRIND_DISCARD_TRANSLATIONS
/* We won't use this machine code any more... */
VALGRIND_DISCARD_TRANSLATIONS(prog->program + num_program,
(prog->num_program - num_program)*sizeof(PIKE_OPCODE_T));
#endif /* VALGRIND_DISCARD_TRANSLATIONS */
#endif /* PIKE_USE_MACHINE_CODE */
prog->num_program = num_program;
return ret;
}
static node *eval(node *n)
{
node *new;
ptrdiff_t args;
if(!is_const(n) || n->node_info & OPT_FLAG_NODE)
return n;
args=eval_low(n,0);
switch(args)
{
case -1:
return n;
break;
case 0:
if(Pike_compiler->catch_level) return n;
free_node(n);
n=0;
break;
case 1:
if(Pike_compiler->catch_level && SAFE_IS_ZERO(Pike_sp-1))
{
pop_stack();
return n;
}
if (n->token == F_SOFT_CAST) {
new = mksoftcastnode(n->type, mksvaluenode(Pike_sp-1));
} else {
new = mksvaluenode(Pike_sp-1);
if (n->type && (!new->type || ((n->type != new->type) &&
pike_types_le(n->type,new->type)))) {
if (new->type)
free_type(new->type);
copy_pike_type(new->type, n->type);
}
}
free_node(n);
n = new;
pop_stack();
break;
default:
if (n->token != F_SOFT_CAST) {
free_node(n);
n=NULL;
while(args--)
{
n=mknode(F_ARG_LIST,mksvaluenode(Pike_sp-1),n);
pop_stack();
}
} else {
node *nn = n; n = NULL;
while(args--)
{
n=mknode(F_ARG_LIST,mksvaluenode(Pike_sp-1),n);
pop_stack();
}
n = mksoftcastnode(nn->type, n);
free_node(nn);
}
}
return dmalloc_touch(node *, n);
}
INT32 last_function_opt_info;
/* FIXME: Ought to use parent pointer to avoid recursion. */
static int stupid_args(node *n, int expected,int vargs)
{
if(!n) return expected;
fatal_check_c_stack(16384);
switch(n->token)
{
case F_PUSH_ARRAY:
if(!vargs) return -1;
if(stupid_args(CAR(n), expected,vargs) == expected+1)
return 65535;
return -1;
case F_ARG_LIST:
expected=stupid_args(CAR(n), expected,vargs);
if(expected==-1) return -1;
return stupid_args(CDR(n), expected,vargs);
case F_LOCAL:
return (!n->u.integer.b && n->u.integer.a==expected) ? expected + 1 : -1;
default:
return -1;
}
}
/* FIXME: Ought to use parent pointer to avoid recursion. */
static int is_null_branch(node *n)
{
if(!n) return 1;
fatal_check_c_stack(16384);
if((n->token==F_CAST && n->type == void_type_string) ||
n->token == F_POP_VALUE)
return is_null_branch(CAR(n));
if(n->token==F_ARG_LIST)
return is_null_branch(CAR(n)) && is_null_branch(CDR(n));
return 0;
}
static struct svalue *is_stupid_func(node *n,
int args,
int vargs,
struct pike_type *type)
{
int tmp;
while(1)
{
if(!n) return 0;
if(n->token == F_ARG_LIST)
{
if(is_null_branch(CAR(n))) n=CDR(n);
else
n=CAR(n);
continue;
}
if((n->token == F_CAST && n->type == void_type_string) ||
n->token == F_POP_VALUE)
{
n=CAR(n);
continue;
}
break;
}
if(!n || n->token != F_RETURN) return 0;
n=CAR(n);
if(!n || n->token != F_APPLY) return 0;
tmp=stupid_args(CDR(n),0,vargs);
if(!(vargs?tmp==65535:tmp==args)) return 0;
n=CAR(n);
if(!n || n->token != F_CONSTANT) return 0;
if((count_arguments(n->type) < 0) == !vargs)
return 0;
if(minimum_arguments(type) < minimum_arguments(n->type))
return 0;
return &n->u.sval;
}
int dooptcode(struct pike_string *name,
node *n,
struct pike_type *type,
int modifiers)
{
union idptr tmp;
int args, vargs, ret;
struct svalue *foo;
CHECK_COMPILER();
optimize_node(n);
check_tree(n, 0);
#ifdef PIKE_DEBUG
if(a_flag > 1)
fprintf(stderr, "Doing function '%s' at %lx\n", name->str,
DO_NOT_WARN((unsigned long)PIKE_PC));
#endif
args=count_arguments(type);
if(args < 0)
{
args=~args;
vargs=IDENTIFIER_VARARGS;
}else{
vargs=0;
}
if(Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPED)
vargs|=IDENTIFIER_SCOPED;
if(Pike_compiler->compiler_frame->lexical_scope & SCOPE_SCOPE_USED)
vargs|=IDENTIFIER_SCOPE_USED;
#ifdef PIKE_DEBUG
if(a_flag > 5)
fprintf(stderr, "Extra identifier flags:0x%02x\n", vargs);
#endif
if(Pike_compiler->compiler_pass==1)
{
tmp.offset=-1;
#ifdef PIKE_DEBUG
if(a_flag > 4)
{
fputs("Making prototype (pass 1) for: ", stderr);
print_tree(n);
}
#endif
}else{
#if defined(SHARED_NODES) && 0
/* Try the local variable usage analyser. */
n = localopt(n);
/* Try optimizing some more. */
optimize(n);
#endif /* SHARED_NODES && 0 */
n = mknode(F_ARG_LIST, n, 0);
if((foo=is_stupid_func(n, args, vargs, type)))
{
if(foo->type == T_FUNCTION && foo->subtype==FUNCTION_BUILTIN)
{
tmp.c_fun=foo->u.efun->function;
if(tmp.c_fun != f_destruct &&
tmp.c_fun != f_this_object &&
tmp.c_fun != f_backtrace)
{
#ifdef PIKE_DEBUG
struct compilation *c = THIS_COMPILATION;
if(a_flag > 1)
fprintf(stderr,"%s:%d: IDENTIFIER OPTIMIZATION %s == %s\n",
c->lex.current_file->str,
c->lex.current_line,
name->str,
foo->u.efun->name->str);
#endif
ret=define_function(name,
type,
(unsigned INT16)modifiers,
(unsigned INT8)(IDENTIFIER_C_FUNCTION |
IDENTIFIER_HAS_BODY |
vargs),
&tmp,
foo->u.efun->flags);
free_node(n);
return ret;
}
}
}
tmp.offset=PIKE_PC;
Pike_compiler->compiler_frame->num_args=args;
#ifdef PIKE_DEBUG
if(a_flag > 2)
{
fputs("Coding: ", stderr);
print_tree(n);
}
#endif
if(!Pike_compiler->num_parse_error)
{ extern int remove_clear_locals;
remove_clear_locals=args;
if(vargs) remove_clear_locals++;
tmp.offset=do_code_block(n);
remove_clear_locals=0x7fffffff;
}
}
ret=define_function(name,
type,
(unsigned INT16)modifiers,
(unsigned INT8)(IDENTIFIER_PIKE_FUNCTION |
IDENTIFIER_HAS_BODY |
vargs),
Pike_compiler->num_parse_error?NULL:&tmp,
(unsigned INT16)
(Pike_compiler->compiler_frame->opt_flags));
#ifdef PIKE_DEBUG
if(a_flag > 1)
fprintf(stderr,"Identifer = %d\n",ret);
#endif
free_node(n);
return ret;
}