ftp.nice.ch/pub/next/unix/developer/pcn.2.0.s.tar.gz#/src/runtime/boot.c

This is boot.c in view mode; [Download] [Up]

/*
All PCN Software is provided under the following disclaimer:

NO WARRANTY.  The software was created in the course of a research
endeavor. It is not a commercial package.  The present version is
still in development, and is distributed "AS IS, WITH ALL DEFECTS."
By using the software, each user agrees to assume all responsibility
for any and all such use.  The authors, California Institute of
Technology, and Argonne National Laboratory are not aware that the
software or the use thereof infringe any proprietary right belonging
to a third party.  However, NO WARRANTY, CONDITION, OR REPRESENTATION
OF ANY KIND, EXPRESS OR IMPLIED, is made about the software, including
without limitation any warranty of title, noninfringement,
merchantability, or fitness for a particular purpose, by the authors
or their affiliated institutions.

NO CONSEQUENTIAL DAMAGES.  Independent of the foregoing disclaimer
of warranties, each person that uses the software thereby agrees, that
NEITHER CALIFORNIA INSTITUTE OF TECHNOLOGY, ARGONNE NATIONAL
LABORATORY, NOR THE AUTHORS OR THEIR AFFILIATED INSTITUTIONS SHALL BE
LIABLE FOR ANY INCIDENTAL OR CONSEQUENTIAL DAMAGES IN CONNECTION WITH
THE USE OF THE SOFTWARE, INCLUDING WITHOUT LIMITATION LOST PROFITS OR
INJURY TO BUSINESS, WHETHER OR NOT CALIFORNIA INSTITUTE OF TECHNOLOGY,
ARGONNE NATIONAL LABORATORY, AND THE AUTHORS AND THEIR AFFILIATED
INSTITUTIONS KNOW OR HAVE REASON TO KNOW OF THE POSSIBILITY OF SUCH
DAMAGES.

INDEMNITY.  Each person that uses the software thereby agrees, to
indemnify and defend California Institute of Technology, Argonne
National Laboratory and the authors and their affiliated institutions,
or any of them, against any loss, expense, claim, damage, or liability
of any kind arising from or connected with their respective uses of
the software, and to hold them or any of them harmless from any of the
same, WHETHER OR NOT ARISING IN WHOLE OR IN PART FROM THE NEGLIGENCE
OR GROSS NEGLIGENCE OF CALIFORNIA INSTITUTE OF TECHNOLOGY, ARGONNE
NATIONAL LABORATORY OR ANY OF THE AUTHORS OR THEIR AFFILIATED
INSTITUTIONS.

SUPPORT. Each person that uses this software understands that the software
is not supported by the authors or by their affiliated institutions.
*/


/*
 * 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.
 *
 * boot.c - boot file
 */

#define	DEFINE_GLOBALS	1
#include "pcn.h"

static void init_variables();
static cell_t *boot_arg();
static void abort_pcn();


/*
 * int _p_pcn_main(int argc, char *argv[])
 *
 * Entry point into the pcn emulator.
 *
 * main() is created by pcncc, which calls this _p_pcn_main() function.
 * The reason that this is done is so that the main() routine can be
 * compiled by a C++ (or GNU's g++) compiler, which will allow
 * initialization of C++ classes and any constructors/destructors to
 * function properly.
 */
int _p_pcn_main(argc, argv)
int argc;
char *argv[];
{
    init_variables();

#ifdef PCN_HOST    
    argc = _p_read_args(argc, argv);
#endif /* PCN_HOST */
    
#ifdef PARALLEL
    
#ifdef PCN_HOST
    if (_p_use_logfile)
    {
	if (mkdir("Logs", 0777) == -1)
	{
	    if (errno != EEXIST)
	    {
		printf("Couldn't create log directory\n");
		exit(1);
	    }
	}
    }
#endif /* PCN_HOST */
    _p_sr_init_node(argc, argv);
    
#else  /* PARALLEL */
    
    _p_my_id = _p_host_id = 0;
    _p_nodes = 1;
    _p_host = TRUE;
    _p_init_node(argc, argv);
    
#endif /* PARALLEL */
    
    return(0);
} /* _p_pcn_main() */


/*
 *  void init_variables()
 *
 *  Initialize all global variables.
 */
static void init_variables()
{
#ifdef DEBUG
    _p_global_dl = DEBUG;
    _p_em_dl = EM_DL;
    _p_gc_dl = GC_DL;
    _p_par_dl = PAR_DL;
    _p_start_em_debug = 0;
#if defined(PARALLEL) && defined(PCN_HOST)
    _p_n_global_dl = DEBUG;;
    _p_n_em_dl = EM_DL;
    _p_n_gc_dl = GC_DL;
    _p_n_par_dl = PAR_DL;
    _p_n_start_em_debug = 0;
    _p_debug_node = -1;
#endif /* PARALLEL && PCN_HOST */
#endif /* DEBUG */

    _p_stdout = stdout;
    _p_use_logfile = FALSE;
    strcpy(_p_boot_mod, _p_d_boot_mod);
    strcpy(_p_boot_proc, _p_d_boot_proc);
    strcpy(_p_main_mod, _p_d_main_mod);
    strcpy(_p_main_proc, _p_d_main_proc);
#ifdef PARALLEL
    _p_nodes = ((_p_d_nodes < 0) ? DEFAULT_NODES : _p_d_nodes);
#else
    _p_nodes = 1;
#endif /* PARALLEL */
    
    _p_heap_size = ((_p_d_heap_size < 0)
		    ? DEFAULT_HEAP_SIZE
		    : _p_d_heap_size);
    _p_heap_inc_proximity = ((_p_d_heap_inc_proximity < 0)
			     ? DEFAULT_HEAP_INC_PROXIMITY
			     : _p_d_heap_inc_proximity);
    _p_heap_increment = ((_p_d_heap_increment < 0)
			 ? DEFAULT_HEAP_INCREMENT
			 : _p_d_heap_increment);
    _p_heap_free_after_gc = ((_p_d_heap_free_after_gc < 0)
			     ? DEFAULT_HEAP_FREE_AFTER_GC
			     : _p_d_heap_free_after_gc);
    _p_heap_lowat = ((_p_d_heap_lowat < 0)
		     ? DEFAULT_HEAP_LOWAT
		     : _p_d_heap_lowat);
    _p_heap_hiwat = ((_p_d_heap_hiwat < 0)
		     ? DEFAULT_HEAP_HIWAT
		     : _p_d_heap_hiwat);
    _p_gc_slack = ((_p_d_gc_slack < 0)
		   ? DEFAULT_GC_SLACK
		   : _p_d_gc_slack);
    _p_irt_initial_size = ((_p_d_irt_initial_size == 0)
			   ? DEFAULT_IRT_INITIAL_SIZE
			   : _p_d_irt_initial_size);
    _p_irt_increment = ((_p_d_irt_increment == 0)
			? DEFAULT_IRT_INCREMENT
			: _p_d_irt_increment);
    _p_gsq_interval = ((_p_d_gsq_interval < 0)
		       ? DEFAULT_GSQ_INTERVAL
		       : _p_d_gsq_interval);
    
    _p_print_array_size = PRINT_ARRAY_SIZE_DEFAULT;
    _p_print_tuple_depth = PRINT_TUPLE_DEPTH_DEFAULT;
    _p_print_tuple_width = PRINT_TUPLE_WIDTH_DEFAULT;

    _p_reduction = 0;
    
    _p_vt_debug_level = 0;
    
#ifdef PDB
    _pdb_enter_immediately = FALSE;
    _pdb_gc_after_foreign = FALSE;
#endif /* PDB */

#ifdef GAUGE
    _p_gauge == FALSE;
    _p_gauge_file[0] = '\0';
    _p_tmp_dir[0] = '\0';
#endif /* GAUGE */
    
#ifdef UPSHOT
    _p_upshot == FALSE;
    _p_upshot_file[0] = '\0';
    _p_upshot_log_size = -1;
#endif /* UPSHOT */

    /*
     * Force references to the proper variables.  This will cause
     * ld to fail if the pcnt file was compiled with on version
     * (i.e., pdb and/or profile) is being linked with a different
     * version of the runtime system.
     */
#ifdef PDB
    _p_compiled_with_pdb = 1;
#else
    _p_not_compiled_with_pdb = 1;
#endif
#ifdef PCN_PROFILE
    _p_compiled_with_profile = 1;
#else
    _p_not_compiled_with_profile =1;
#endif

} /* init_variables() */


#ifdef PARALLEL
/*
 * void distribute_params()
 *
 * Send the various parameters to the nodes.
 */
static void distribute_params()
{
    /*
     * Pass all parameters, including the DEBUG parameters, so that
     * emulator compiled without debugging will work with ones compiled
     * with debugging.
     */
    typedef struct {
	int_t use_logfile;
	int_t heap_size;
	int_t heap_inc_proximity;
	int_t heap_increment;
	int_t heap_free_after_gc;
	int_t heap_lowat;
	int_t heap_hiwat;
	int_t gc_slack;
	int_t gsq_interval;
	int_t vt_debug_level;
	int_t global_dl;
	int_t em_dl;
	int_t gc_dl;
	int_t par_dl;
	int_t start_em_debug;
	char  boot_mod[MAX_SYMBOL_LENGTH];
	char  boot_proc[MAX_SYMBOL_LENGTH];
	char  initial_load_pam_files[INITIAL_LOAD_PAM_FILES_LENGTH];
	int_t gauge;
	char  gauge_tmp_file[MAX_PATH_LENGTH];
	char  tmp_dir[MAX_PATH_LENGTH];
	int_t upshot;
	char  upshot_file[MAX_PATH_LENGTH];
	int_t upshot_log_size;
    } params_t;
#define PARAMS_SIZE	sizeof(params_t)+16

#if defined(PCN_HOST) && defined(PCN_NODE)    
    if (_p_host)
    {
#endif /* PCN_HOST && PCN_NODE */
#ifdef PCN_HOST	
	params_t *p, *p_save;
	int_t i, params_size;
	
	params_size = sizeof(params_t) / sizeof(cell_t);
	for (i = 1; i < _p_nodes; i++)
	{
	    p = p_save = (params_t *) _p_alloc_msg_buffer(params_size);
	    p->use_logfile = _p_use_logfile;
	    p->heap_size = _p_heap_size;
	    p->heap_inc_proximity = _p_heap_inc_proximity;
	    p->heap_increment = _p_heap_increment;
	    p->heap_free_after_gc = _p_heap_free_after_gc;
	    p->heap_lowat = _p_heap_lowat;
	    p->heap_hiwat = _p_heap_hiwat;
	    p->gc_slack = _p_gc_slack;
	    p->gsq_interval = _p_gsq_interval;
	    p->vt_debug_level = _p_vt_debug_level;
#ifdef DEBUG
	    if (_p_debug_node < 0 || i == _p_debug_node)
	    {
		p->global_dl = _p_n_global_dl;
		p->em_dl = _p_n_em_dl;
		p->gc_dl = _p_n_gc_dl;
		p->par_dl = _p_n_par_dl;
		p->start_em_debug = _p_n_start_em_debug;
	    }
	    else
	    {
		p->global_dl = _p_global_dl;
		p->em_dl = _p_em_dl;
		p->gc_dl = _p_gc_dl;
		p->par_dl = _p_par_dl;
		p->start_em_debug = _p_start_em_debug;
	    }
#else  /* DEBUG */
	    /* We need to pass these, in case the node has debugging on */
	    p->global_dl = 0;
	    p->em_dl = 0;
	    p->gc_dl = 0;
	    p->par_dl = 0;
	    p->start_em_debug = 0;
#endif /* DEBUG */
	    strcpy(p->boot_mod, _p_boot_mod);
	    strcpy(p->boot_proc, _p_boot_proc);
#ifdef DYNAMIC_PAM_LOADING    
	    strcpy(p->initial_load_pam_files, _p_initial_load_pam_files);
#else  /* DYNAMIC_PAM_LOADING */
	    *p->initial_load_pam_files = '\0';
#endif /* DYNAMIC_PAM_LOADING */
#ifdef GAUGE
	    p->gauge = _p_gauge;
	    strcpy(p->gauge_tmp_file, _p_gauge_tmp_file);
	    strcpy(p->tmp_dir, _p_tmp_dir);
#else  /* GAUGE */
	    p->gauge = 0;
	    *p->gauge_tmp_file = '\0';
	    *p->tmp_dir = '\0';
#endif /* GAUGE */
#ifdef UPSHOT
	    p->upshot = _p_upshot;
	    strcpy(p->upshot_file, _p_upshot_file);
	    p->upshot_log_size = _p_upshot_log_size;
#else  /* UPSHOT */
	    p->upshot = 0;
	    *p->upshot_file = '\0';
	    p->upshot_log_size = 0;
#endif /* UPSHOT */
	    
	    _p_msg_send(p_save, i, params_size, MSG_PARAMS);
	}
#endif /* PCN_HOST */
#if defined(PCN_HOST) && defined(PCN_NODE)    
    }
    else
    {
#endif /* PCN_HOST && PCN_NODE */
#ifdef PCN_NODE
	char buf[PARAMS_SIZE];
	params_t *p;
	int_t node, size, type;

	/*
	 * Need to fake a heap, so that the _p_msg_receive() will work
	 */
	_p_heap_ptr = (cell_t *) buf;
	_p_heap_hard_top = _p_heap_ptr + PARAMS_SIZE;

	_p_msg_receive(&node, &size, &type, RCV_PARAMS);
	if (type != MSG_PARAMS)
	    _p_fatal_error("Expected message with parameters");

	p = (params_t *) _p_heap_ptr;
	_p_use_logfile = p->use_logfile;
	_p_heap_size   = p->heap_size;
	_p_heap_inc_proximity = p->heap_inc_proximity;
	_p_heap_increment = p->heap_increment;
	_p_heap_free_after_gc = p->heap_free_after_gc;
	_p_heap_lowat = p->heap_lowat;
	_p_heap_hiwat = p->heap_hiwat;
	_p_gc_slack = p->gc_slack;
	_p_gsq_interval = p->gsq_interval;
	_p_vt_debug_level = p->vt_debug_level;
#ifdef DEBUG
	_p_global_dl = p->global_dl;
	_p_em_dl = p->em_dl;
	_p_gc_dl = p->gc_dl;
	_p_par_dl = p->par_dl; 
	_p_start_em_debug = p->start_em_debug;
#endif /* DEBUG */
	strcpy(_p_boot_mod, p->boot_mod);
	strcpy(_p_boot_proc, p->boot_proc);
#ifdef DYNAMIC_PAM_LOADING    
	strcpy(_p_initial_load_pam_files, p->initial_load_pam_files);
#endif /* DYNAMIC_PAM_LOADING */
#ifdef GAUGE
	_p_gauge = p->gauge;
	strcpy(_p_gauge_tmp_file, p->gauge_tmp_file);
	strcpy(_p_tmp_dir, p->tmp_dir);
#endif /* GAUGE */	
#ifdef UPSHOT
	_p_upshot = p->upshot;
	strcpy(_p_upshot_file, p->upshot_file);
	_p_upshot_log_size = p->upshot_log_size;
#endif /* UPSHOT */	
	
#endif /* PCN_NODE */
#if defined(PCN_HOST) && defined(PCN_NODE)    
    }
#endif /* PCN_HOST && PCN_NODE */
	
#ifdef DEBUG
    if (_p_global_dl >= 1)
    {
	fprintf(_p_stdout, "(%lu) parameters: heap_size=%ld, heap_inc_proximity=%ld\n            heap_increment=%ld, heap_free_after_gc=%ld, heap_lowat=%ld,\n            heap_hiwat=%ld, gc_slack=%ld, use_logfile=%ld\n            global_dl=%ld, em_dl=%ld, gc_dl=%ld, par_dl=%ld, start_em_debug=%ld\n            boot_mod=%s, boot_proc=%s\n",
		(unsigned long) _p_my_id, (long) _p_heap_size,
		(long) _p_heap_inc_proximity, (long) _p_heap_increment,
		(long) _p_heap_free_after_gc, (long) _p_heap_lowat,
		(long) _p_heap_hiwat, (long) _p_gc_slack,
		(long) _p_use_logfile, (long) _p_global_dl,
		(long) _p_em_dl, (long) _p_gc_dl, (long) _p_par_dl,
		(long) _p_start_em_debug, _p_boot_mod, _p_boot_proc);
	fflush(_p_stdout);
    }
#endif /* DEBUG */
} /* distribute_params() */
#endif /* PARALLEL */



/*
 * cell_t *boot_arg()
 *
 * Create the boot arguments on the heap.
 * Return:  Pointer to the boot argument tuple.
 */
static cell_t *boot_arg(argc, argv)
int argc;
char *argv[];
{
    cell_t *b_arg;
    cell_t *osp;
    cell_t *my_stream;
    int_t i;

    /*
     * Boot arg = {
     *		MyId,
     *		NumProcs,
     *		InputStreams,
     *		OutputStreams,
     *		MainModule,
     *		MainProc,
     *		argc,
     *		argv,
     *		vt_debug_level
     * }
     */
    
    BuildTuple((cell_t *), b_arg, 9);

#ifdef DEBUG    
    if (_p_global_dl >= 9)
        fprintf(_p_stdout, "\t*b_arg=0x%lx\n", (unsigned long) *b_arg);
#endif /* DEBUG */    

    /* boot arg 0 = MyId */
    BuildInt((cell_t), *_p_structure_ptr++, _p_my_id);

    /* boot arg 1 = NumProcs */
    BuildInt((cell_t), *_p_structure_ptr++, _p_nodes);

    /* Now the InputStreams and OutputStreams */
#ifdef PARALLEL	    
    if (_p_multiprocessing)
    {
	cell_t *cp1;
	irt_t *irt_entry;

	/*
	 * The first _p_nodes entries of the IRT, except for the
	 * _p_my_id'th entry, have been reserved for the input streams.
	 */
	osp = _p_structure_ptr + 1;
	BuildUndef((cell_t *), my_stream);

	/* boot arg 2 = input streams */
	for (i = 0; i < _p_nodes; i++)
	{
	    BuildTuple((cell_t), *_p_structure_ptr, 2);
	    if (i != _p_my_id)
	    {
		BuildRref((cell_t), *_p_structure_ptr++, INIT_WEIGHT, _p_my_id, i);
	    }
	    else
	    {
		*((cell_t **) _p_structure_ptr++) = my_stream;
	    }
	}
	BuildEmptyList((cell_t), *_p_structure_ptr);

	/* boot arg 3 = output streams */
	_p_structure_ptr = osp;
	osp = _p_structure_ptr + 1;
	for (i = 0; i < _p_nodes; i++)
	{
	    BuildTuple((cell_t), *_p_structure_ptr, 2);
	    if (i != _p_my_id)
	    {
		irt_entry = IrtAddress(i);
		irt_entry->weight = INIT_WEIGHT;
		BuildUndef((cell_t *), cp1);
		irt_entry->u.ptr = *((cell_t **) _p_structure_ptr++) = cp1;
	    }
	    else
	    {
		*((cell_t **) _p_structure_ptr++) = my_stream;
	    }
	}
	BuildEmptyList((cell_t), *_p_structure_ptr);
	
	_p_structure_ptr = osp;
    }
    else
    {
#endif /* PARALLEL */
	/* Build a local stream */
	osp = _p_structure_ptr + 1;
	BuildUndef((cell_t *), my_stream);

	/* boot arg 2 = input streams */
	BuildTuple((cell_t), *_p_structure_ptr, 2);
	*((cell_t **) _p_structure_ptr++) = my_stream;
	BuildEmptyList((cell_t), *_p_structure_ptr);
	_p_structure_ptr = osp;

	/* boot arg 3 = output streams */
	osp = _p_structure_ptr + 1;
	BuildTuple((cell_t), *_p_structure_ptr, 2);
	*((cell_t **) _p_structure_ptr++) = my_stream;
	BuildEmptyList((cell_t), *_p_structure_ptr);
	_p_structure_ptr = osp;
#ifdef PARALLEL	    
    }
#endif /* PARALLEL */

#ifdef PARALLEL    
    if (_p_host)
    {
#endif /* PARALLEL */
	/* boot arg 4 = MainModule  */
	BuildString((cell_t), *_p_structure_ptr++, _p_main_mod,
		    strlen(_p_main_mod));
	
	/* boot arg 5 = MainProc  */
	BuildString((cell_t), *_p_structure_ptr++, _p_main_proc,
		    strlen(_p_main_proc));

	/* boot arg 6 = argc */
	BuildInt((cell_t), *_p_structure_ptr++, argc);
	
	/* boot arg 7 = argv */
	osp = _p_structure_ptr + 1;
	for (i = 0; i < argc; i++)
	{
	    BuildTuple((cell_t), *_p_structure_ptr, 2);
	    BuildString((cell_t), *_p_structure_ptr++, argv[i],
			strlen(argv[i]));
	}
	
	
	BuildEmptyList((cell_t), *_p_structure_ptr);
	_p_structure_ptr = osp;
#ifdef PARALLEL    
    }
    else
    {
	/* boot arg 4 = MainModule  */
	BuildString((cell_t), *_p_structure_ptr++, "", 0);
	
	/* boot arg 5 = MainProc  */
	BuildString((cell_t), *_p_structure_ptr++, "", 0);

	/* boot arg 6 = argc */
	BuildInt((cell_t), *_p_structure_ptr++, 0);
	
	/* boot arg 7 = argv */
	BuildEmptyList((cell_t), *_p_structure_ptr++);
    }
#endif /* PARALLEL */
    
    /* boot arg 8 = vt_debug_level */
    BuildInt((cell_t), *_p_structure_ptr++, MAX(0,_p_vt_debug_level));
    
#ifdef DEBUG
    if (_p_global_dl >= 1)
    {
	fprintf(_p_stdout, "(%lu) Boot args: ", (unsigned long) _p_my_id);
	_p_print_term(_p_stdout, b_arg);
	fprintf(_p_stdout, "\n");
	fflush(_p_stdout);
    }
#endif /* DEBUG */
    
    return (b_arg);
} /* boot_arg() */


/*
 * void _p_init_node(argc, argv)
 *
 * Initialize the node, and run the emulator.
 */
void _p_init_node(argc, argv)
int argc;
char *argv[];
{
    cell_t *b_arg;
    proc_record_t *proc_record;
    int_t i;
    int_t usable_heap_size;

#ifdef PARALLEL    
    if (_p_nodes > 1)
	_p_multiprocessing = TRUE;
    else
#endif /* PARALLEL */	
	_p_multiprocessing = FALSE;

    _p_init_machine_dep();

#ifdef GAUGE
    _p_init_gauge_tmp_file();
#endif /* GAUGE */

#ifdef PARALLEL
    if (_p_multiprocessing)
	distribute_params();
#endif /* PARALLEL */
	    
    /* Set _p_stdout */
#ifdef PARALLEL    
    if (_p_use_logfile && !_p_host)
    {
	char buf[MAX_PATH_LENGTH];
	sprintf(buf, "Logs/node%lu", (unsigned long) _p_my_id);
	if ((_p_stdout = fopen(buf, "w+")) == (FILE *) NULL)
	    _p_fatal_error("Couldn't create log file");
    }
    else
    {
#endif /* PARALLEL */	
	_p_stdout = stdout;
#ifdef PARALLEL    
    }
#endif /* PARALLEL */	

    /* Print out version message */
    if (_p_use_logfile)
    {
	_p_print_banner();
    }

    /*
     * Set the various _p_heap* arguments to valid values.
     */
    if (_p_heap_size <= CANCEL_SIZE)
    {
	char buf[256];
	sprintf(buf, "Heap size must be > %lu.\n    Use the -heap_size flag to set the heap size.",
		(unsigned long) CANCEL_SIZE);
	_p_fatal_error(buf);
    }
    usable_heap_size = _p_heap_size - CANCEL_SIZE;
    if (_p_heap_inc_proximity == 0
	|| _p_heap_inc_proximity >= usable_heap_size)
	_p_heap_inc_proximity = (usable_heap_size / INC_PROXIMITY_DIVISOR) + 1;
    if (_p_heap_increment == 0)
	_p_heap_increment = _p_heap_size;
    if (_p_heap_hiwat < _p_heap_size)
	_p_heap_hiwat = _p_heap_size;
    if (_p_gc_slack == 0 || _p_gc_slack >= usable_heap_size)
	_p_gc_slack = (usable_heap_size / GC_SLACK_DIVISOR) + 1;

    /*
     * Initialize the heap and process records
     */
    if ( ( (_p_heap_bottom =
	    (cell_t *) malloc((size_t) ((_p_heap_size * CELL_SIZE)
#ifdef PCN_ALIGN_DOUBLES					
					+ DOUBLE_WORD_SIZE
#endif
					))) == (cell_t *) NULL) )
    {
	_p_malloc_error();
    }
    AlignDoubleOnOddWord((cell_t *), _p_heap_bottom, _p_heap_bottom_pad);
    
    _p_heap_cancel_top = _p_heap_real_top = _p_heap_bottom + _p_heap_size;
    CalcHeapTops();
    _p_heap_ptr = _p_heap_bottom;

    _p_init_proc_record_pool();

#ifdef PARALLEL
    if (_p_multiprocessing)
    {
	/*
	 * Allocate room for the rref cancel list heads.
	 */
	if ( ( (_p_cancel_lists =
		(cell_t **) malloc((size_t) (_p_nodes * sizeof(cell_t *))))
	      == (cell_t **) NULL) )
	{
	    _p_malloc_error();
	}
	ZeroOutMemory(_p_cancel_lists, (_p_nodes * sizeof(cell_t *)));
	_p_cancels = 0;

	_p_init_irt();
    }
#endif

#ifdef PDB
    _pdb_init();
#endif /* PDB */

#ifdef DYNAMIC_PAM_LOADING    
    _p_load_pam_file_init();
#endif /* DYNAMIC_PAM_LOADING */
    
#ifdef GAUGE    
    _p_init_gauge();
#endif /* GAUGE */

#ifdef UPSHOT    
    _p_init_upshot();
#endif /* UPSHOT */

    _p_active_qf = _p_active_qb = _p_globsusp_qf = _p_globsusp_qb
	= _p_current_proc = (proc_record_t *) NULL;
    _p_gc_ref_stack_top = 0;
    _p_first_unused_register = DEFAULT_FIRST_UNUSED_REGISTER;
    for (i = 0; i < NUM_A_REGS; i++)
	_p_a_reg[i] = (cell_t) 0;

#ifdef PARALLEL    
#if ASYNC_MSG == 0
    _p_msg_skip = MSG_SKIP_POLL;
#endif
#endif /* PARALLEL */
    

    /* Set up the boot argument */
    b_arg = boot_arg(argc, argv);

    /*
     * Find the boot module and procedure (by default, boot:boot()),
     * and put it on the process queue
     */
    proc_record = _p_alloc_proc_record(3);
    if ((proc_record->proc = _p_proc_lookup(_p_boot_mod, _p_boot_proc))
	== (proc_header_t *) NULL)
    {
	char errbuf[1024];
	sprintf(errbuf, "Could not find boot procedure: %s:%s()",
		_p_boot_mod, _p_boot_proc);
	_p_fatal_error(errbuf);
    }
#ifdef PDB
    proc_record->instance = _pdb_get_next_instance();
    proc_record->reduction = 0;
    proc_record->called_by = (proc_header_t *) NULL;
#endif /* PDB */	    
    proc_record->args[0] = b_arg;
    BuildEmptyList((cell_t *), proc_record->args[1]);
    BuildUndef((cell_t *), proc_record->args[2]);
    EnqueueProcess(proc_record, _p_active_qf, _p_active_qb);
    PDB_EnqueueProcess(proc_record);

#ifdef PARALLEL    
    /* Call the send/receive post-initialization routine */
    _p_sr_node_initialized();
#endif /* PARALLEL */
    
#ifdef DYNAMIC_PAM_LOADING
    if (_p_initial_load_pam_files[0] != '\0')
    {
	bool_t done;
	char_t *s1, *s2;
	char_t *eb;

	for (s1 = _p_initial_load_pam_files, done = 0; !done; )
	{
	    s2 = strchr(s1, ':');
	    if (s2)
		*s2++ = '\0';
	    else
		done = 1;
	    
	    if ((eb = _p_load_pam_file(s1)) != (char_t *) NULL)
	    {
		fprintf(_p_stdout,
			"Warning: Failed to dynamically load the file %s: %s\n",
			s1, eb);
	    }
	    s1 = s2;
	}
    }
#endif /* DYNAMIC_PAM_LOADING */

    /* Call the main emulator loop */
    _p_emulate();

    _p_shutdown_pcn();

#ifdef PARALLEL
    if (_p_multiprocessing)
    {
	if (_p_host)
	    _p_host_handle_exit();
	else
	    _p_fatal_error("Node exited the emulator with exit instruction (it shouldn't!)");
    }
#endif /* PARALLEL */
} /* _p_init_node() */


void _p_shutdown_pcn()
{
    _p_shutdown_machine_dep();
    fflush(_p_stdout);
} /* _p_shutdown_pcn() */


static void abort_pcn()
{
    _p_abort_machine_dep();
    
#ifdef PARALLEL	    
    if (_p_multiprocessing)
    {
	_p_abort_nodes();
    }
#endif /* PARALLEL */
} /* _p_abort_pcn() */


/*
 * void _p_fatal_error(char *msg)
 *
 * Print the passed error message and abort out of the emulator.
 */
void _p_fatal_error(msg)
char *msg;
{
#ifdef DEBUG
    fprintf(_p_stdout, "(%lu) reduction %lu\n", (unsigned long) _p_my_id,
	    (unsigned long) _p_reduction);
#endif /* DEBUG */    
#ifdef PARALLEL	    
    if (msg != (char *) NULL)
	fprintf(_p_stdout, "Fatal error: Node %lu: %s\n",
		(unsigned long) _p_my_id, msg);
#else  /* PARALLEL */
    if (msg != (char *) NULL)
	fprintf(_p_stdout, "Fatal error: %s\n", msg);
#endif /* PARALLEL */

#ifdef PDB    
    if (_pdb_gc_after_foreign)
    {
	static bool_t we_have_been_here_before = FALSE;
	if (!we_have_been_here_before)
	{
	    char *s1;
	    we_have_been_here_before = TRUE;
	    s1 = _p_foreign_lookup(_pdb_last_called_foreign);
	    fprintf(_p_stdout,
		    "(%lu) Last foreign called before fatal error: %s\n",
		    (unsigned long) _p_my_id, s1);
	}
    }
#endif /* PDB */
    
    abort_pcn();
    exit(1);
} /* _p_fatal_error() */


/*
 * void _p_malloc_error()
 *
 * Abort out of the emulator due to a failed malloc.
 *
 * Use write() instead of fprintf() for malloc errors, because if the
 * error was caused by a failed malloc(), then fprintf() will
 * segmentation fault -- evidently, it uses malloc().
 */
void _p_malloc_error()
{
#define MALLOC_ERROR_MSG "Fatal error: Failed malloc\n"
    write(2, MALLOC_ERROR_MSG, strlen(MALLOC_ERROR_MSG));
    abort_pcn();
    exit(1);
} /* _p_malloc_error() */

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Marcel Waldvogel and Netfuture.ch.