+/*
+ *
+ * Type of the result variable.
+ *
+ * result
+ * |
+ * +----------+------------+
+ * | |
+ * union of closures result_type
+ * |
+ * +------------------+---------------+
+ * | |
+ * closure1 ... closuerN
+ * | |
+ * +----+--+-+--------+-----+ +----+----+---+-----+
+ * | | | | | | | | |
+ * var1 var2 var3 ... varN result var1 var2 ... varN result
+ * |
+ * +--------+---------+
+ * | |
+ * union of closures result_type
+ * |
+ * +-----+-------------------+
+ * | |
+ * closure1 ... closureN
+ * | |
+ * +-----+---+----+----+ +----+---+----+-----+
+ * | | | | | | | |
+ * var1 var2 ... varN result var1 var2 ... varN result
+ */
+
+static int add_closure_type(struct compile_state *state,
+ struct triple *func, struct type *closure_type)
+{
+ struct type *type, *ctype, **next;
+ struct triple *var, *new_var;
+ int i;
+
+#if 0
+ FILE *fp = state->errout;
+ fprintf(fp, "original_type: ");
+ name_of(fp, fresult(state, func)->type);
+ fprintf(fp, "\n");
+#endif
+ /* find the original type */
+ var = fresult(state, func);
+ type = var->type;
+ if (type->elements != 2) {
+ internal_error(state, var, "bad return type");
+ }
+
+ /* Find the complete closure type and update it */
+ ctype = type->left->left;
+ next = &ctype->left;
+ while(((*next)->type & TYPE_MASK) == TYPE_OVERLAP) {
+ next = &(*next)->right;
+ }
+ *next = new_type(TYPE_OVERLAP, *next, dup_type(state, closure_type));
+ ctype->elements += 1;
+
+#if 0
+ fprintf(fp, "new_type: ");
+ name_of(fp, type);
+ fprintf(fp, "\n");
+ fprintf(fp, "ctype: %p %d bits: %d ",
+ ctype, ctype->elements, reg_size_of(state, ctype));
+ name_of(fp, ctype);
+ fprintf(fp, "\n");
+#endif
+
+ /* Regenerate the variable with the new type definition */
+ new_var = pre_triple(state, var, OP_ADECL, type, 0, 0);
+ new_var->id |= TRIPLE_FLAG_FLATTENED;
+ for(i = 0; i < new_var->lhs; i++) {
+ LHS(new_var, i)->id |= TRIPLE_FLAG_FLATTENED;
+ }
+
+ /* Point everyone at the new variable */
+ propogate_use(state, var, new_var);
+
+ /* Release the original variable */
+ for(i = 0; i < var->lhs; i++) {
+ release_triple(state, LHS(var, i));
+ }
+ release_triple(state, var);
+
+ /* Return the index of the added closure type */
+ return ctype->elements - 1;
+}
+
+static struct triple *closure_expr(struct compile_state *state,
+ struct triple *func, int closure_idx, int var_idx)
+{
+ return deref_index(state,
+ deref_index(state,
+ deref_index(state, fresult(state, func), 0),
+ closure_idx),
+ var_idx);
+}
+
+
+static void insert_triple_set(
+ struct triple_reg_set **head, struct triple *member)
+{
+ struct triple_reg_set *new;
+ new = xcmalloc(sizeof(*new), "triple_set");
+ new->member = member;
+ new->new = 0;
+ new->next = *head;
+ *head = new;
+}
+
+static int ordered_triple_set(
+ struct triple_reg_set **head, struct triple *member)
+{
+ struct triple_reg_set **ptr;
+ if (!member)
+ return 0;
+ ptr = head;
+ while(*ptr) {
+ if (member == (*ptr)->member) {
+ return 0;
+ }
+ /* keep the list ordered */
+ if (member->id < (*ptr)->member->id) {
+ break;
+ }
+ ptr = &(*ptr)->next;
+ }
+ insert_triple_set(ptr, member);
+ return 1;
+}
+
+
+static void free_closure_variables(struct compile_state *state,
+ struct triple_reg_set **enclose)
+{
+ struct triple_reg_set *entry, *next;
+ for(entry = *enclose; entry; entry = next) {
+ next = entry->next;
+ do_triple_unset(enclose, entry->member);
+ }
+}
+
+static int lookup_closure_index(struct compile_state *state,
+ struct triple *me, struct triple *val)
+{
+ struct triple *first, *ins, *next;
+ first = RHS(me, 0);
+ ins = next = first;
+ do {
+ struct triple *result;
+ struct triple *index0, *index1, *index2, *read, *write;
+ ins = next;
+ next = ins->next;
+ if (ins->op != OP_CALL) {
+ continue;
+ }
+ /* I am at a previous call point examine it closely */
+ if (ins->next->op != OP_LABEL) {
+ internal_error(state, ins, "call not followed by label");
+ }
+ /* Does this call does not enclose any variables? */
+ if ((ins->next->next->op != OP_INDEX) ||
+ (ins->next->next->u.cval != 0) ||
+ (result = MISC(ins->next->next, 0)) ||
+ (result->id & TRIPLE_FLAG_LOCAL)) {
+ continue;
+ }
+ index0 = ins->next->next;
+ /* The pattern is:
+ * 0 index result < 0 >
+ * 1 index 0 < ? >
+ * 2 index 1 < ? >
+ * 3 read 2
+ * 4 write 3 var
+ */
+ for(index0 = ins->next->next;
+ (index0->op == OP_INDEX) &&
+ (MISC(index0, 0) == result) &&
+ (index0->u.cval == 0) ;
+ index0 = write->next)
+ {
+ index1 = index0->next;
+ index2 = index1->next;
+ read = index2->next;
+ write = read->next;
+ if ((index0->op != OP_INDEX) ||
+ (index1->op != OP_INDEX) ||
+ (index2->op != OP_INDEX) ||
+ (read->op != OP_READ) ||
+ (write->op != OP_WRITE) ||
+ (MISC(index1, 0) != index0) ||
+ (MISC(index2, 0) != index1) ||
+ (RHS(read, 0) != index2) ||
+ (RHS(write, 0) != read)) {
+ internal_error(state, index0, "bad var read");
+ }
+ if (MISC(write, 0) == val) {
+ return index2->u.cval;
+ }
+ }
+ } while(next != first);
+ return -1;
+}
+
+static inline int enclose_triple(struct triple *ins)
+{
+ return (ins && ((ins->type->type & TYPE_MASK) != TYPE_VOID));
+}
+
+static void compute_closure_variables(struct compile_state *state,
+ struct triple *me, struct triple *fcall, struct triple_reg_set **enclose)
+{
+ struct triple_reg_set *set, *vars, **last_var;
+ struct basic_blocks bb;
+ struct reg_block *rb;
+ struct block *block;
+ struct triple *old_result, *first, *ins;
+ size_t count, idx;
+ unsigned long used_indicies;
+ int i, max_index;
+#define MAX_INDICIES (sizeof(used_indicies)*CHAR_BIT)
+#define ID_BITS(X) ((X) & (TRIPLE_FLAG_LOCAL -1))
+ struct {
+ unsigned id;
+ int index;
+ } *info;
+
+
+ /* Find the basic blocks of this function */
+ bb.func = me;
+ bb.first = RHS(me, 0);
+ old_result = 0;
+ if (!triple_is_ret(state, bb.first->prev)) {
+ bb.func = 0;
+ } else {
+ old_result = fresult(state, me);
+ }
+ analyze_basic_blocks(state, &bb);
+
+ /* Find which variables are currently alive in a given block */
+ rb = compute_variable_lifetimes(state, &bb);
+
+ /* Find the variables that are currently alive */
+ block = block_of_triple(state, fcall);
+ if (!block || (block->vertex <= 0) || (block->vertex > bb.last_vertex)) {
+ internal_error(state, fcall, "No reg block? block: %p", block);
+ }
+
+#if DEBUG_EXPLICIT_CLOSURES
+ print_live_variables(state, &bb, rb, state->dbgout);
+ fflush(state->dbgout);
+#endif
+
+ /* Count the number of triples in the function */
+ first = RHS(me, 0);
+ ins = first;
+ count = 0;
+ do {
+ count++;
+ ins = ins->next;
+ } while(ins != first);
+
+ /* Allocate some memory to temorary hold the id info */
+ info = xcmalloc(sizeof(*info) * (count +1), "info");
+
+ /* Mark the local function */
+ first = RHS(me, 0);
+ ins = first;
+ idx = 1;
+ do {
+ info[idx].id = ins->id;
+ ins->id = TRIPLE_FLAG_LOCAL | idx;
+ idx++;
+ ins = ins->next;
+ } while(ins != first);
+
+ /*
+ * Build the list of variables to enclose.
+ *
+ * A target it to put the same variable in the
+ * same slot for ever call of a given function.
+ * After coloring this removes all of the variable
+ * manipulation code.
+ *
+ * The list of variables to enclose is built ordered
+ * program order because except in corner cases this
+ * gives me the stability of assignment I need.
+ *
+ * To gurantee that stability I lookup the variables
+ * to see where they have been used before and
+ * I build my final list with the assigned indicies.
+ */
+ vars = 0;
+ if (enclose_triple(old_result)) {
+ ordered_triple_set(&vars, old_result);
+ }
+ for(set = rb[block->vertex].out; set; set = set->next) {
+ if (!enclose_triple(set->member)) {
+ continue;
+ }
+ if ((set->member == fcall) || (set->member == old_result)) {
+ continue;
+ }
+ if (!local_triple(state, me, set->member)) {
+ internal_error(state, set->member, "not local?");
+ }
+ ordered_triple_set(&vars, set->member);
+ }
+
+ /* Lookup the current indicies of the live varialbe */
+ used_indicies = 0;
+ max_index = -1;
+ for(set = vars; set ; set = set->next) {
+ struct triple *ins;
+ int index;
+ ins = set->member;
+ index = lookup_closure_index(state, me, ins);
+ info[ID_BITS(ins->id)].index = index;
+ if (index < 0) {
+ continue;
+ }
+ if (index >= MAX_INDICIES) {
+ internal_error(state, ins, "index unexpectedly large");
+ }
+ if (used_indicies & (1 << index)) {
+ internal_error(state, ins, "index previously used?");
+ }
+ /* Remember which indicies have been used */
+ used_indicies |= (1 << index);
+ if (index > max_index) {
+ max_index = index;
+ }
+ }
+
+ /* Walk through the live variables and make certain
+ * everything is assigned an index.
+ */
+ for(set = vars; set; set = set->next) {
+ struct triple *ins;
+ int index;
+ ins = set->member;
+ index = info[ID_BITS(ins->id)].index;
+ if (index >= 0) {
+ continue;
+ }
+ /* Find the lowest unused index value */
+ for(index = 0; index < MAX_INDICIES; index++) {
+ if (!(used_indicies & (1 << index))) {
+ break;
+ }
+ }
+ if (index == MAX_INDICIES) {
+ internal_error(state, ins, "no free indicies?");
+ }
+ info[ID_BITS(ins->id)].index = index;
+ /* Remember which indicies have been used */
+ used_indicies |= (1 << index);
+ if (index > max_index) {
+ max_index = index;
+ }
+ }
+
+ /* Build the return list of variables with positions matching
+ * their indicies.
+ */
+ *enclose = 0;
+ last_var = enclose;
+ for(i = 0; i <= max_index; i++) {
+ struct triple *var;
+ var = 0;
+ if (used_indicies & (1 << i)) {
+ for(set = vars; set; set = set->next) {
+ int index;
+ index = info[ID_BITS(set->member->id)].index;
+ if (index == i) {
+ var = set->member;
+ break;
+ }
+ }
+ if (!var) {
+ internal_error(state, me, "missing variable");
+ }
+ }
+ insert_triple_set(last_var, var);
+ last_var = &(*last_var)->next;
+ }
+
+#if DEBUG_EXPLICIT_CLOSURES
+ /* Print out the variables to be enclosed */
+ loc(state->dbgout, state, fcall);
+ fprintf(state->dbgout, "Alive: \n");
+ for(set = *enclose; set; set = set->next) {
+ display_triple(state->dbgout, set->member);
+ }
+ fflush(state->dbgout);
+#endif
+
+ /* Clear the marks */
+ ins = first;
+ do {
+ ins->id = info[ID_BITS(ins->id)].id;
+ ins = ins->next;
+ } while(ins != first);
+
+ /* Release the ordered list of live variables */
+ free_closure_variables(state, &vars);
+
+ /* Release the storage of the old ids */
+ xfree(info);
+
+ /* Release the variable lifetime information */
+ free_variable_lifetimes(state, &bb, rb);
+
+ /* Release the basic blocks of this function */
+ free_basic_blocks(state, &bb);
+}
+
+static void expand_function_call(
+ struct compile_state *state, struct triple *me, struct triple *fcall)