This is utils.c in view mode; [Download] [Up]
/*
* PCN Abstract Machine Emulator
* Authors: Steve Tuecke and Ian Foster
* Argonne National Laboratory
*
* Please see the DISCLAIMER file in the top level directory of the
* distribution regarding the provisions under which this software
* is distributed.
*
* utils.c - Various utilities: Error reporting, print stats, display terms
*/
#include "pcn.h"
/*
* _p_do_exit()
*
* Calling this will cause an orderly exit of the parallel program.
* It will exit with that passed exit_code.
*/
void _p_do_exit(exit_code)
int_t exit_code;
{
#ifdef PARALLEL
if (_p_host)
{
_p_host_handle_exit(exit_code);
}
else
{
_p_node_handle_exit(exit_code, TRUE);
}
#else /* PARALLEL */
#ifdef GAUGE
/* Take a final profile snapshot, and coalesce the node profiles */
_p_host_final_profile();
#endif /* GAUGE */
#ifdef UPSHOT
/* Dump the upshot log */
_p_write_upshot_log();
#endif
_p_shutdown_pcn();
exit((int) exit_code);
#endif /* PARALLEL */
} /* _p_do_exit() */
/*
* exit_from_*()
*
* These are wrappers around _p_do_exit() that can be called from
* various places (PCN, C, and Fortran).
*/
void exit_from_pcn(exit_code)
int_t *exit_code;
{
_p_do_exit(*exit_code);
}
void exit_from_c(exit_code)
int exit_code;
{
_p_do_exit((int_t) exit_code);
}
void EXIT_FROM_FORTRAN_(exit_code)
int *exit_code;
{
_p_do_exit((int_t) *exit_code);
}
void EXIT_FROM_FORTRAN(exit_code)
int *exit_code;
{
_p_do_exit((int_t) *exit_code);
}
void exit_from_fortran_(exit_code)
int *exit_code;
{
_p_do_exit((int_t) *exit_code);
}
void exit_from_fortran(exit_code)
int *exit_code;
{
_p_do_exit((int_t) *exit_code);
}
/*
* _p_size_with_trailer()
*
* For the data structure pointed to by 'target', return how
* many cells this data structure requires, including the trailer cell.
*/
u_int_t _p_size_with_trailer(tag, size)
u_int_t tag;
u_int_t size;
{
u_int_t i;
switch(tag)
{
case UNDEF_TAG:
i = UndefSizeWithTrailer();
break;
case TUPLE_TAG:
i = TupleSizeWithTrailer(size);
break;
case INT_TAG:
i = IntSizeWithTrailer(size);
break;
case STRING_TAG:
i = StringSizeWithTrailer(size);
break;
case DOUBLE_TAG:
i = DoubleSizeWithTrailer(size);
break;
case RREF_TAG:
#ifdef PARALLEL
i = RrefSizeWithTrailer();
#else
_p_fatal_error("_p_size_with_trailer(): Illegal remote reference tag found");
#endif
break;
default:
_p_fatal_error("_p_size_with_trailer(): Illegal tag found");
break;
}
return (i);
} /* _p_size_with_trailer() */
/*
* _p_size_without_trailer()
*
* For the data structure pointed to by 'target', return how
* many cells this data structure requires, excluding the trailer cell.
*/
u_int_t _p_size_without_trailer(tag, size)
u_int_t tag;
u_int_t size;
{
u_int_t i;
switch(tag)
{
case UNDEF_TAG:
i = UndefSizeWithoutTrailer();
break;
case TUPLE_TAG:
i = TupleSizeWithoutTrailer(size);
break;
case INT_TAG:
i = IntSizeWithoutTrailer(size);
break;
case STRING_TAG:
i = StringSizeWithoutTrailer(size);
break;
case DOUBLE_TAG:
i = DoubleSizeWithoutTrailer(size);
break;
case RREF_TAG:
#ifdef PARALLEL
i = RrefSizeWithoutTrailer();
#else
_p_fatal_error("_p_size_without_trailer(): Illegal remote reference tag found");
#endif
break;
default:
_p_fatal_error("_p_size_without_trailer(): Illegal tag found");
break;
}
return (i);
} /* _p_size_without_trailer() */
/*
* _p_hash_index_for_procedure_name()
*
* This procedure uses the 'module_name', 'proc_name' (strings), and
* 'table_size' (pointer to integer) to return the appropriate
* hash table index for this procedure name in 'hash_index'.
*/
void _p_em_hash_index_for_procedure_name(module_name, proc_name, table_size,
hash_index)
char_t *module_name;
char_t *proc_name;
int_t *table_size;
int_t *hash_index;
{
u_int_t y = 0;
int_t i;
while ((i = (int_t) (*module_name++)) != 0)
{
y <<= 1;
y += i;
}
while ((i = (int_t) (*proc_name++)) != 0)
{
y <<= 1;
y += i;
}
*hash_index = (int_t) (y % *table_size);
} /* _p_hash_index_for_procedure_name() */
/*
* _p_hash_string()
*
* This procedure takes 'string' and the hash 'table_size'
* and returns the appropriate hash table index for
* this string name in 'table_index'.
*/
void _p_hash_string(string, table_size, table_index)
char_t *string;
int_t *table_size;
int_t *table_index;
{
u_int_t y = 0;
int_t i;
while ((i = (int_t) (*string++)) != 0)
{
y <<= 1;
y += i;
}
*table_index = (int_t) y;
} /* _p_hash_string() */
/*
* _p_proc_lookup()
*
* Lookup the passed procedure (module_name and proc_name) in
* the export table and return a pointer to that procedure's
* proc_header.
*
* Return NULL if it is not found, else a pointer to the procecure's header.
*/
proc_header_t *_p_proc_lookup(module_name, proc_name)
char *module_name;
char *proc_name;
{
int_t hash_index;
proc_header_t *proc_header;
_p_em_hash_index_for_procedure_name(module_name, proc_name,
&_p_exported_table_size,
&hash_index);
for (proc_header = _p_exported_table[hash_index];
proc_header != (proc_header_t *) NULL;
proc_header = proc_header->next)
{
if ( strcmp(module_name, proc_header->module_name) == 0
&& strcmp(proc_name, proc_header->proc_name) == 0)
{
break;
}
}
#ifdef DYNAMIC_PAM_LOADING
if (proc_header == (proc_header_t *) NULL)
{
/*
* Also search the non-exported list when dynamic loading is
* available, so that we can always find procedures that we're
* loading over.
*/
for (proc_header = _p_exported_table[_p_exported_table_size];
proc_header != (proc_header_t *) NULL;
proc_header = proc_header->next)
{
if ( strcmp(module_name, proc_header->module_name) == 0
&& strcmp(proc_name, proc_header->proc_name) == 0)
{
break;
}
}
}
#endif
return (proc_header);
} /* _p_proc_lookup() */
/*
* process_susp_queue()
*
* Process the suspension queue, 'susp_queue'.
* Put any process records onto the active queue.
* Send off value messages for (most) value notes in the queue.
*
* In uniprocessor version, process_susp_queue() doesn't have
* to deal with value notes, so it can just be concatenated to the
* end of the active queue.
*
* If 'check_value_return' is TRUE, then do not send off a value
* message for value notes that points at 'value_return_irt' and
* 'value_return_node'. Why would be want to do this? To cancel
* an outstanding read request. Suppose node 0 has a rref to
* an undef on node 1. Now suppose that a process on
* node 0 does a data check on that rref -- this will cause
* node 0 to allocate an irt for a return value message which
* points to the rref, and then generate a read
* message to node 1, which will queue up a value note
* with that read request. Now suppose a second process on node 0
* defines a term to that rref. This will cause a define message
* to be sent to node 1 with the term. But when node 1 processes
* that define message, it will find the value note back to the
* original rref on node 0 which is no longer there. Therefore,
* node 1 does not want to generate a value message back to node 0
* with the term, but instead just want to cancel the irt that was
* allocated on node 0 for the read request. The 'value_return_*'
* variables allow us to catch this situation -- they are
* the irt and node associated with the read request that was
* previously generated on the rref that was subsequently defined.
*
* If 'check_value_return' is FALSE, then always send off value
* messages for value notes in the queue.
*/
static void process_susp_queue(susp_queue, new_value,
check_value_return, value_return_irt,
value_return_node)
proc_record_t *susp_queue;
cell_t *new_value;
bool_t check_value_return;
u_int_t value_return_irt, value_return_node;
{
#ifdef PARALLEL
u_int_t node;
u_int_t location;
cell_t **cancel_list_entry;
if (_p_multiprocessing)
{
proc_record_t *first_pr = susp_queue;
proc_record_t *this_pr = first_pr->next;
proc_record_t *next_pr;
first_pr->next = (proc_record_t *) NULL;
while (this_pr != (proc_record_t *) NULL)
{
next_pr = this_pr->next;
if (IsValueNote(this_pr))
{
node = ((value_note_t *) this_pr)->node;
location = ((value_note_t *) this_pr)->location;
if (check_value_return
&& value_return_irt == location
&& value_return_node == node )
{
/*
* If this value note is back to the rref
* that generated this define in the first
* place, then do not send off a value
* message. Instead, queue this value
* note on the appropriate cancel list
* so that it will get cancelled during the next gc.
*/
cancel_list_entry = _p_cancel_lists + node;
((value_note_t *)this_pr)->next
= (value_note_t *) *cancel_list_entry;
*cancel_list_entry = (cell_t *) this_pr;
_p_cancels++;
}
else
{
/*
* Else send off a value message for this value note
*/
_p_send_value(((value_note_t *) this_pr)->node,
((value_note_t *) this_pr)->location,
new_value);
_p_free_value_note(this_pr);
}
}
else
{
EnqueueProcess(this_pr, _p_active_qf, _p_active_qb);
}
this_pr = next_pr;
}
}
else
{
#endif /* PARALLEL */
if (_p_active_qf == (proc_record_t *) NULL)
_p_active_qf = susp_queue->next;
else
_p_active_qb->next = susp_queue->next;
_p_active_qb = susp_queue;
susp_queue->next = (proc_record_t *) NULL;
#ifdef PARALLEL
}
#endif /* PARALLEL */
} /* process_susp_queue() */
/*
* _p_define()
*
* Define the undefined variable 'to' to be the same as 'from'.
*
* If 'send_define_for_rref' is TRUE and if 'to' is a rref, then
* a define message will be generated for this rref, which
* will have the side effect of cancelling the irt entry that
* this rref points to. But if 'send_define_to_rref'
* is FALSE and if 'to' is a rref, then we need
* to queue up the rref on the appropriate _p_cancel_lists
* entry so that a cancel message will get sent for this rref later.
*
* Normally this should be called with 'send_define_for_rref'
* set to TRUE. The exception to this is when
* a value message arrives for this rref, we do not want to
* generate an extraneous define message, since we know that
* the thing that this rref points to is what generated the value
* message in the first place -- so that define message that
* would normally be generated here would be extraneous.
*
* If there is a suspension queue hung of this undef or rref, then
* pass 'check_value_return', 'value_return_irt', and 'value_return_node'
* through to process_susp_queue() -- see that procedure's comment
* for an explanation of how these variables are used.
*
* Return: TRUE if the definition was succesfull,
* FALSE if 'to' is already defined
*/
bool_t _p_define(to, from, send_define_for_rref,
check_value_return, value_return_irt, value_return_node)
cell_t *to, *from;
bool_t send_define_for_rref;
bool_t check_value_return;
u_int_t value_return_irt, value_return_node;
{
u_int_t tag = ((data_header_t *) to)->tag;
if (tag == UNDEF_TAG || tag == RREF_TAG)
{
if (SuspensionsAt(to))
{
proc_record_t *susp_queue = SuspendedProcs(to);
process_susp_queue(susp_queue, from,
check_value_return, value_return_irt,
value_return_node);
}
*((cell_t **) to) = from;
if (tag == UNDEF_TAG)
{
/*
* Zero out the second cell of the undef so that it
* does not cause any gc problems.
*/
*(to + 1) = 0;
}
#ifdef PARALLEL
else if (tag == RREF_TAG)
{
if (send_define_for_rref)
{
int_t j;
_p_send_define((rref_t *) to, from);
/*
* Zero out the rest of this rref so that it
* does not cause any gc problems.
*/
for (j = RrefSizeWithTrailer() - 1; j > 0; j--)
*(++to) = (cell_t) 0;
}
else
{
/*
* Put this rref on the cancel list, so that a cancel
* message will be sent to the appropriate node during
* the next GC.
*
* Note: This relies on the specific layout of rref_t.
*/
cell_t **cancel_list_entry
= _p_cancel_lists + ((rref_t *)to)->node;
*(to + 1) = 0;
*((cell_t **)(to + 4)) = *cancel_list_entry;
*cancel_list_entry = (to + 1);
_p_cancels++;
}
}
#endif /* PARALLEL */
return (TRUE);
}
else
{
return (FALSE);
}
} /* _p_define() */
/*
* _p_bad_define()
*
* Print a "Bad define" message. The 'where' argument should be a string
* of the procedure from which _p_bad_define was called.
*/
void _p_bad_define(where)
char *where;
{
fprintf(_p_stdout,
"(%lu,%lu) Warning: Node %lu: %s: left-hand side of definition already defined in %s:%s\n",
(unsigned long) _p_my_id, (unsigned long) _p_reduction,
(unsigned long) _p_my_id, where,
_p_current_proc->proc->module_name,
_p_current_proc->proc->proc_name);
} /* _p_bad_define() */
/*
* _p_print_banner()
*
* Print out the PCN banner to _p_stdout.
*/
void _p_print_banner()
{
fprintf(_p_stdout,
"PCN%s: Version %s%s; Node %lu; %lu node%s, %lu heap.\n",
PDB_BANNER_STR, VERSION_STR, _p_user_banner,
(unsigned long) _p_my_id,
(unsigned long) _p_nodes, (_p_nodes == 1 ? "" : "s"),
(unsigned long) _p_heap_size);
fprintf(_p_stdout, "(See the file: %s)\n", DISCLAIMER_FILE);
fflush(_p_stdout);
} /* _p_print_banner() */
#ifdef PCN_RENAME_TO_LINK
int _p_rename_to_link(oldname, newname)
char *oldname, *newname;
{
int rc;
if ((rc = link((char *) oldname, (char *) newname)) == 0)
{
rc = unlink((char *) oldname);
}
return (rc);
} /* _p_rename_to_link() */
#endif /* PCN_RENAME_TO_LINK */
#ifdef DEBUG
static char *invalid_function = "invalid foreign function";
/*
* _p_foreign_lookup()
*
* Look up the pointer to the function (func) in the name foreign functions
* array, and return a pointer to the string of the function's name.
*/
char *_p_foreign_lookup(func)
u_int_t func;
{
int i;
for (i = 0; i < _p_foreign_table_size; i++)
{
if (func == (u_int_t) _p_foreign_table[i].foreign_ptr)
return (_p_foreign_table[i].foreign_name);
}
return (invalid_function);
} /* _p_foreign_lookup() */
#endif /* DEBUG */
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.