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

This is load_file.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.
 *
 * load_file.c - Dynamically load .pam files into the running emulator
 */

#include "pcn.h"

#ifdef DYNAMIC_PAM_LOADING    

#include "pcno.h"

static	char_t	error_buffer[1024];

static	char_t *	load_pam_fp();
static	proc_header_t *	get_proc_header();
static	char_t *	load_procedure_subsects();
static	char_t *	read_pcno_integers();
static	char_t *	read_pcno_string();
static	char_t *	load_string_list();
static	void		free_string_list();
static	list_t *	alloc_list_entry();
static	void		massage_string_list();


#define TEST_FTELL(Ftell_Value, Stream, Location) \
    if ((Ftell_Value = ftell(Stream)) < 0) \
    { \
	sprintf(error_buffer, "Failed ftell() at location %d", Location); \
	return (error_buffer); \
    }

#define TEST_FSEEK(Stream, Offset, Whence, Location) \
    if (fseek(Stream, (long) (Offset), (int) Whence) != 0) \
    { \
	sprintf(error_buffer, "Failed fseek() at location %d", Location); \
	return (error_buffer); \
    }
    
#define TEST_READ_PCNO_INTEGERS(Stream, Into, Start, Size) \
    if (read_pcno_integers(Stream, Into, Start, Size) != (char_t *) NULL) \
    { \
	return (error_buffer); \
    }

#define TEST_READ_PCNO_STRING(Stream, Into, Size) \
    if ((eb = read_pcno_string(Stream, Into, Size)) != (char_t *) NULL) \
    { \
	return (eb); \
    }

#define TEST_LOAD_STRING_LIST(Stream, N_Entries, Group_Size, String_List) \
    if ((eb = load_string_list(Stream, N_Entries, Group_Size, String_List)) != (char_t *) NULL) \
    { \
	return (eb); \
    }


/*
 * _p_load_pam_file_init()
 *
 * Initialize any global variables used for dynamic .pam file loading.
 */
void _p_load_pam_file_init()
{
} /* _p_load_pam_file_init() */


/*
 * _p_load_pam_file()
 *
 * Load the pam file with the path 'filename' into the emulator.
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
char_t *_p_load_pam_file(filename)
char_t *filename;
{
    FILE *fp;
    char_t *eb;
    cell_t *save_heap_ptr;
    
    if ((fp = fopen(filename, "r")) == (FILE *) NULL)
    {
	sprintf(error_buffer, "Could not open file for reading");
	return (error_buffer);
    }
    
    eb = load_pam_fp(fp);

    fclose(fp);
    
    return (eb);

} /* _p_load_pam_file() */


/*
 * load_pam_fp()
 *
 * Load the opened pam file, with file pointer 'fp'.
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
static char_t *load_pam_fp(fp)
FILE *fp;
{
    pcno_header_t pcno_header;
    pcno_module_segment_t pcno_module_header;
    pcno_procedure_t pcno_proc_header;
    long current_segment, current_section;
    u_int_t segment_number, section_number;
    list_t *list_entry;
    char_t *module_name, *proc_name;
    proc_header_t *proc_header;
    char_t *eb;
#ifdef GAUGE
    int_t *counters, *timers;
#endif /* GAUGE */
    
    /*
     * Read in and check the PCNO header for validity
     */
    TEST_READ_PCNO_INTEGERS(fp, &pcno_header, 0, PCNO_HEADER_SIZE);
    if (pcno_header.magic != PCNO_MAGIC)
    {
	sprintf(error_buffer, "Bad PCNO magic number");
	return (error_buffer);
    }
    if (pcno_header.version != PCNO_VERSION)
    {
	sprintf(error_buffer,
		"Bad PCNO version number (expected %lu, got %lu)",
		(unsigned long) PCNO_MAGIC,
		(unsigned long) pcno_header.version);
	return (error_buffer);
    }

    /*
     * Iterate over the segments, reading in any module segments we find.
     */
    TEST_FTELL(current_segment, fp, 1);
    for (segment_number = 0;
	 segment_number < pcno_header.n_segments;
	 segment_number++)
    {
	TEST_READ_PCNO_INTEGERS(fp, &pcno_module_header,0,PCNO_BLOCK_HDR_SIZE);
	if (pcno_module_header.type == PCNO_SEG_MODULE)
	{
	    /*
	     * This is a module segment, so read it in.
	     */
	    TEST_READ_PCNO_INTEGERS(fp, &pcno_module_header, 2,
				    (PCNO_SEG_MODULE_HDR_SIZE
				     - PCNO_BLOCK_HDR_SIZE) );
	    TEST_READ_PCNO_STRING(fp, &module_name,
				  (pcno_module_header.section_offset
				   - (PCNO_SEG_MODULE_HDR_SIZE
				      * PCNO_WORD_SIZE)) );
	    pcno_module_header.name = module_name;
	    
	    /*
	     * Iterate over the segments, reading them in as we go.
	     */
	    TEST_FTELL(current_section, fp, 1);
	    for (section_number = 0;
		 section_number < pcno_module_header.n_sections;
		 section_number++)
	    {
		TEST_READ_PCNO_INTEGERS(fp, &pcno_proc_header, 0,
					PCNO_BLOCK_HDR_SIZE);
		if (pcno_proc_header.type == PCNO_MODSECT_PROCEDURE)
		{
		    /*
		     * This is a procedure section, so read it in.
		     */
		    TEST_READ_PCNO_INTEGERS(fp, &pcno_proc_header, 2,
					    (PCNO_MODSECT_PROCEDURE_HDR_SIZE
					     - PCNO_BLOCK_HDR_SIZE) );
		    TEST_READ_PCNO_STRING(fp, &proc_name,
					  (pcno_proc_header.subsect_offset
					   - (PCNO_MODSECT_PROCEDURE_HDR_SIZE
					      * PCNO_WORD_SIZE)) );
		    pcno_proc_header.name = proc_name;

		    /*
		     * Setup the proc_header for this new procedure.
		     */
		    proc_header = get_proc_header(module_name, proc_name);
		    proc_header->arity = pcno_proc_header.arity;
		    proc_header->code = (code_t *) NULL;
#ifdef GAUGE
		    proc_header->n_counters = pcno_proc_header.n_counters;
		    if ((proc_header->counters = (int_t *) malloc(sizeof(int_t) * proc_header->n_counters))
			== (int_t *) NULL)
		    {
			_p_malloc_error();
		    }
		    proc_header->n_timers = pcno_proc_header.n_timers;
		    if ((proc_header->timers = (int_t *) malloc(sizeof(int_t) * 2 * proc_header->n_timers))
			== (int_t *) NULL)
		    {
			_p_malloc_error();
		    }
		    proc_header->idle_timer = proc_header->timers;
		    proc_header->model = (char_t **) NULL;
#endif /* GAUGE */
#ifdef PDB			
		    proc_header->debugable = 0;
		    proc_header->debug = 0;
		    proc_header->break_num = 0;
		    proc_header->exported = pcno_proc_header.exported;
#endif /* PDB */
		    
		    /*
		     * Load in all of the procedure subsections
		     */
		    eb = load_procedure_subsects(fp, proc_header,
						 pcno_proc_header.n_subsects);
		    if (eb != (char_t *) NULL)
		    {
			return (eb);
		    }
		    
		    free(proc_name);
		}

		/*
		 * Position the file for reading the next section
		 */
		current_section += pcno_proc_header.size;
		TEST_FSEEK(fp, current_section, 0, 2);
	    }
	    free(module_name);
	}

	/*
	 * Position the file for reading the next segment
	 */
	current_segment += pcno_module_header.size;
	TEST_FSEEK(fp, current_segment, 0, 2);
    }
    
    return ((char_t *) NULL);
} /* load_pam_fp() */


/*
 * get_proc_header()
 *
 * Return the proc_header for the passed procedures.  If it does not
 * exist, then create one.
 */
static proc_header_t *get_proc_header(module_name, proc_name)
char_t *module_name;
char_t *proc_name;
{
    proc_header_t *proc_header;
    list_t *list_entry;
    
    proc_header = _p_proc_lookup(module_name, proc_name);
    if (proc_header == (proc_header_t *) NULL)
    {
	int_t hash_index, hash_head;
	if ( (proc_header = (proc_header_t *) malloc(sizeof(proc_header_t)))
	    == (proc_header_t *) NULL)
	{
	    _p_malloc_error();
	}
	if (((proc_header->module_name=(char_t *)malloc(strlen(module_name)+1))
	     == (char_t *) NULL)
	    || ((proc_header->proc_name =(char_t *)malloc(strlen(proc_name)+1))
		== (char_t *) NULL) )
	{
	    _p_malloc_error();
	}
	strcpy(proc_header->module_name, module_name);
	strcpy(proc_header->proc_name, proc_name);
	
	_p_em_hash_index_for_procedure_name(module_name, proc_name,
					    &_p_exported_table_size,
					    &hash_index);
	proc_header->next = _p_exported_table[hash_index];
	_p_exported_table[hash_index] = proc_header;
    }

    return (proc_header);
} /* get_proc_header() */


/*
 * load_procedure_subsects()
 *
 * Load in all of the relevant procedure subsections from 'fp' and
 * change 'proc_header' appropriately.  It is assumed that 'fp' is
 * positioned at the start of the first subsection.  It does not
 * guarantee anything about the position of 'fp' when it is done.
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
static char_t *load_procedure_subsects(fp, proc_header, n_subsects)
FILE *fp;
proc_header_t *proc_header;
u_int_t n_subsects;
{
    pcno_code_t code_header;
    pcno_block_header_t block_header;
    proc_header_t **pcall_table = (proc_header_t **) NULL;
    u_int_t *fcall_table = (u_int_t *) NULL;
    cell_t **double_table = (cell_t **) NULL;
    cell_t **string_table = (cell_t **) NULL;
    cell_t **int_table = (cell_t **) NULL;
    char_t **string_list, *s;
    long current_subsect;
    u_int_t subsect_number;
    u_int_t n_entries, group_size, i, j, k;
    char_t *eb;
    bool_t found;
    static_double_value_t *double_value;
    static_string_value_t *string_value;
    static_int_value_t *int_value;
    cell_t *program_counter;
    cell_t *end_of_code;
    instruction_t *instr;
    char_t *module_name, *proc_name;

    code_header.code_array = (code_t *) NULL;
    
    TEST_FTELL(current_subsect, fp, 10);
    for (subsect_number = 0;
	 subsect_number < n_subsects;
	 subsect_number++)
    {
	TEST_READ_PCNO_INTEGERS(fp, &block_header, 0, PCNO_BLOCK_HDR_SIZE);
	switch (block_header.type)
	{
	case PCNO_PROC_CODE:
	    code_header.type = block_header.type;
	    code_header.size = block_header.size;
	    TEST_READ_PCNO_INTEGERS(fp, &code_header, 2,
				    (PCNO_PROC_CODE_HDR_SIZE
				     - PCNO_BLOCK_HDR_SIZE) );
	    i = code_header.code_size / PCNO_WORD_SIZE;
	    if ((code_header.code_array = (code_t *) malloc (i * CELL_SIZE))
		== (code_t *) NULL)
	    {
		_p_malloc_error();
	    }
	    TEST_READ_PCNO_INTEGERS(fp, code_header.code_array, 0, i);
	    break;
	    
	case PCNO_PROC_PCALL_TABLE:
	    TEST_LOAD_STRING_LIST(fp, &n_entries, &group_size, &string_list);
	    if ((pcall_table = (proc_header_t **) malloc(n_entries * sizeof(proc_header_t *))) == (proc_header_t **) NULL)
	    {
		_p_malloc_error();
	    }
	    for (i = 0, j = 0; i < n_entries; i++, j += 2)
	    {
		
		module_name = string_list[j];
		if (module_name[0] == '\0')
		    module_name = proc_header->module_name;
		proc_name = string_list[j + 1];
		pcall_table[i] = get_proc_header(module_name, proc_name);
	    }
	    free_string_list(n_entries, group_size, string_list);
	    break;
	    
	case PCNO_PROC_FCALL_TABLE:
	    TEST_LOAD_STRING_LIST(fp, &n_entries, &group_size, &string_list);
	    if ((fcall_table = (u_int_t *) malloc(n_entries * sizeof(u_int_t))) == (u_int_t *) NULL)
	    {
		_p_malloc_error();
	    }
	    for (i = 0; i < n_entries; i++)
	    {
		s = string_list[i];;
#ifdef STRIP_TRAILING_UNDERSCORE
		j = strlen(s) - 1;
		if (s[j] == '_')
		{
		    s[j] = '\0';
		}
#endif		
		found = FALSE;
		for (j = 0; j < _p_foreign_table_size && !found; j++)
		{
		    if (strcmp(_p_foreign_table[j].foreign_name, s) == 0)
		    {
			found = TRUE;
			fcall_table[i]
			    = (u_int_t) _p_foreign_table[j].foreign_ptr;
		    }
		}
		if (!found)
		{
		    sprintf(error_buffer,
			    "Could not resolve call to foreign procedure %s() from PCN procedure %s:%s()",
			    s, proc_header->module_name,
			    proc_header->proc_name);
		    return (error_buffer);
		}
	    }
	    free_string_list(n_entries, group_size, string_list);
	    break;
	    
	case PCNO_PROC_DOUBLE_TABLE:
	    TEST_LOAD_STRING_LIST(fp, &n_entries, &group_size, &string_list);
	    if ((double_table = (cell_t **) malloc(n_entries * sizeof(cell_t *))) == (cell_t **) NULL)
	    {
		_p_malloc_error();
	    }
	    for (i = 0; i < n_entries; i++)
	    {
		if ((double_value = (static_double_value_t *)
		     malloc(sizeof(static_double_value_t)
#ifdef PCN_ALIGN_DOUBLES					
			    + DOUBLE_WORD_SIZE
#endif
			    )) == (static_double_value_t *) NULL)
		{
		    _p_malloc_error();
		}
		AlignDoubleOnEvenWord((static_double_value_t *),
				      double_value, j);
		double_value->n_cells = 1 + CELLS_PER_DOUBLE;
		double_value->h.tag = DOUBLE_TAG;
		double_value->h.mark = 0;
		double_value->h.size = 1;
		double_value->d = atof(string_list[i]);
		double_table[i] = (cell_t *) double_value;
	    }
	    free_string_list(n_entries, group_size, string_list);
	    break;
	    
	case PCNO_PROC_STRING_TABLE:
	    TEST_LOAD_STRING_LIST(fp, &n_entries, &group_size, &string_list);
	    massage_string_list(string_list, n_entries * group_size);
	    if ((string_table = (cell_t **) malloc(n_entries * sizeof(cell_t *))) == (cell_t **) NULL)
	    {
		_p_malloc_error();
	    }
	    for (i = 0; i < n_entries; i++)
	    {
		j = strlen(string_list[i]) + 1;
		k = StringSizeToCells(j);
		if ((string_value = (static_string_value_t *)
		     malloc(sizeof(static_string_value_t) + (k * CELL_SIZE)))
		    == (static_string_value_t *) NULL)
		{
		    _p_malloc_error();
		}
		string_value->n_cells = 1 + k;
		string_value->h.tag = STRING_TAG;
		string_value->h.mark = 0;
		string_value->h.size = j;
		strcpy(string_value->str, string_list[i]);
		string_table[i] = (cell_t *) string_value;
	    }
	    free_string_list(n_entries, group_size, string_list);
	    break;
	    
	case PCNO_PROC_INT_TABLE:
	    TEST_LOAD_STRING_LIST(fp, &n_entries, &group_size, &string_list);
	    if ((int_table = (cell_t **) malloc(n_entries * sizeof(cell_t *))) == (cell_t **) NULL)
	    {
		_p_malloc_error();
	    }
	    for (i = 0; i < n_entries; i++)
	    {
		if ((int_value = (static_int_value_t *)
		     malloc(sizeof(static_int_value_t)))
		     == (static_int_value_t *) NULL)
		{
		    _p_malloc_error();
		}
		int_value->n_cells = 2;
		int_value->h.tag = INT_TAG;
		int_value->h.mark = 0;
		int_value->h.size = 1;
		int_value->i = (int_t) atol(string_list[i]);
		int_table[i] = (cell_t *) int_value;
	    }
	    free_string_list(n_entries, group_size, string_list);
	    break;
	    
	default:
	    /* Ignore this subsection */
	    break;
	}
	
	current_subsect += block_header.size;
	TEST_FSEEK(fp, current_subsect, 0, 11);
    }

    /*
     * Now scan though the procedure's code...
     */
    if (code_header.code_array == (code_t *) NULL)
    {
	sprintf(error_buffer,
		"Did not find code for procedure %s:%s()",
		proc_header->module_name, proc_header->proc_name);
	return (error_buffer);
    }

    program_counter = (cell_t *) code_header.code_array;
    end_of_code = program_counter + (code_header.code_size/PCNO_WORD_SIZE);
    while(program_counter < end_of_code)
    {
	instr = (instruction_t *) program_counter;
	switch(instr->I_OPCODE)
	{
	case I_FORK:
	    if (pcall_table == (proc_header_t **) NULL)
	    {
		sprintf(error_buffer,
			"Instruction scan of %s:%s(): Expected non-empty PCN call table",
			proc_header->module_name, proc_header->proc_name);
		return (error_buffer);
	    }
	    i = (u_int_t) instr->I_FORK_PROC;
	    instr->I_FORK_PROC = (cell_t *) pcall_table[i];
	    program_counter += SIZE_FORK;
	    break;

	case I_RECURSE:
	    if (pcall_table == (proc_header_t **) NULL)
	    {
		sprintf(error_buffer,
			"Instruction scan of %s:%s(): Expected non-empty PCN call table",
			proc_header->module_name, proc_header->proc_name);
		return (error_buffer);
	    }
	    i = (u_int_t) instr->I_RECURSE_PROC;
	    instr->I_RECURSE_PROC = (cell_t *) pcall_table[i];
#ifdef GAUGE	    
	    i = (u_int_t) instr->I_RECURSE_COUNTER;
	    instr->I_RECURSE_COUNTER = proc_header->counters + i;
#endif /* GAUGE	*/
	    program_counter += SIZE_RECURSE;
	    break;

	case I_HALT:
#ifdef GAUGE	    
	    i = (u_int_t) instr->I_HALT_COUNTER;
	    instr->I_HALT_COUNTER = proc_header->counters + i;
#endif /* GAUGE	*/
	    program_counter += SIZE_HALT;
	    break;

	case I_DEFAULT:
#ifdef GAUGE	    
	    i = (u_int_t) instr->I_DEFAULT_COUNTER;
	    instr->I_DEFAULT_COUNTER = proc_header->counters + i;
#endif /* GAUGE	*/
	    program_counter += SIZE_DEFAULT;
	    break;

	case I_TRY:
	    i = (u_int_t) instr->I_TRY_LOCATION;
	    instr->I_TRY_LOCATION = ((cell_t *) code_header.code_array) + i;
	    program_counter += SIZE_TRY;
	    break;

	case I_RUN:
	    program_counter += SIZE_RUN;
	    break;
	    
	case I_BUILD_STATIC:
	    program_counter += SIZE_BUILD_STATIC;
	    break;
	    
	case I_BUILD_DYNAMIC:
	    program_counter += SIZE_BUILD_DYNAMIC;
	    break;
	    
	case I_BUILD_DEF:
	    program_counter += SIZE_BUILD_DEF;
	    break;
	    
	case I_PUT_DATA:
	    i = (u_int_t) instr->I_PUT_DATA_PTR;
	    switch (instr->I_PUT_DATA_TAG)
	    {
	    case INT_TAG:
		if (int_table == (cell_t **) NULL)
		{
		    sprintf(error_buffer,
			    "%s:%s(): Expected non-empty integer constant table",
			    proc_header->module_name, proc_header->proc_name);
		    return (error_buffer);
		}
		instr->I_PUT_DATA_PTR = int_table[i];
		break;
		
	    case STRING_TAG:
		if (string_table == (cell_t **) NULL)
		{
		    sprintf(error_buffer,
			    "%s:%s(): Expected non-empty string constant table",
			    proc_header->module_name, proc_header->proc_name);
		    return (error_buffer);
		}
		instr->I_PUT_DATA_PTR = string_table[i];
		break;
		
	    case DOUBLE_TAG:
		if (double_table == (cell_t **) NULL)
		{
		    sprintf(error_buffer,
			    "%s:%s(): Expected non-empty double constant table",
			    proc_header->module_name, proc_header->proc_name);
		    return (error_buffer);
		}
		instr->I_PUT_DATA_PTR = double_table[i];
		break;
		
	    default:
		sprintf(error_buffer,
			"Instruction scan of %s:%s(): Found illegal tag in put_data instruction",
			proc_header->module_name, proc_header->proc_name);
		return (error_buffer);
		break;
	    }
	    program_counter += SIZE_PUT_DATA;
	    break;

	case I_PUT_VALUE:
	    program_counter += SIZE_PUT_VALUE;
	    break;
	    
	case I_COPY:
	    program_counter += SIZE_COPY;
	    break;
	    
	case I_GET_TUPLE:
	    program_counter += SIZE_GET_TUPLE;
	    break;
	    
	case I_EQUAL:
	    program_counter += SIZE_EQUAL;
	    break;
	    
	case I_NEQ:
	    program_counter += SIZE_NEQ;
	    break;
	    
	case I_TYPE:
	    program_counter += SIZE_TYPE;
	    break;
	    
	case I_LE:
	    program_counter += SIZE_LE;
	    break;
	    
	case I_LT:
	    program_counter += SIZE_LT;
	    break;
	    
	case I_DATA:
	    program_counter += SIZE_DATA;
	    break;
	    
	case I_UNKNOWN:
	    program_counter += SIZE_UNKNOWN;
	    break;
	    
	case I_DEFINE:
	    program_counter += SIZE_DEFINE;
	    break;
	    
	case I_GET_ELEMENT:
	    program_counter += SIZE_GET_ELEMENT;
	    break;
	    
	case I_PUT_ELEMENT:
	    program_counter += SIZE_PUT_ELEMENT;
	    break;
	    
	case I_ADD:
	    program_counter += SIZE_ADD;
	    break;
	    
	case I_SUB:
	    program_counter += SIZE_SUB;
	    break;
	    
	case I_MUL:
	    program_counter += SIZE_MUL;
	    break;
	    
	case I_DIV:
	    program_counter += SIZE_DIV;
	    break;
	    
	case I_MOD:
	    program_counter += SIZE_MOD;
	    break;
	    
	case I_LENGTH:
	    program_counter += SIZE_LENGTH;
	    break;
	    
	case I_COPY_MUT:
#ifdef GAUGE
	    i = (u_int_t) instr->I_COPY_MUT_COUNTER;
	    instr->I_COPY_MUT_COUNTER = proc_header->counters + i;
#endif /* GAUGE	*/
	    program_counter += SIZE_COPY_MUT;
	    break;
	    
	case I_PUT_FOREIGN:
	    program_counter += SIZE_PUT_FOREIGN;
	    break;
	    
	case I_CALL_FOREIGN:
	    if (fcall_table == (u_int_t *) NULL)
	    {
		sprintf(error_buffer,
			"Instruction scan of %s:%s(): Expected non-empty foreign call table",
			proc_header->module_name, proc_header->proc_name);
		return (error_buffer);
	    }
	    i = (u_int_t) instr->I_CALL_FOREIGN_FOR;
	    instr->I_CALL_FOREIGN_FOR = (cell_t *) fcall_table[i];
#ifdef GAUGE
	    i = (u_int_t) instr->I_CALL_FOREIGN_TIMER;
	    instr->I_CALL_FOREIGN_TIMER = proc_header->timers + (i * 2);
#endif /* GAUGE */
	    program_counter += SIZE_CALL_FOREIGN;
	    break;

	case I_EXIT:
	    program_counter += SIZE_EXIT;
	    break;
	    
	case I_PRINT_TERM:
	    program_counter += SIZE_PRINT_TERM;
	    break;
	    
	default:
	    sprintf(error_buffer,
		    "Instruction scan of %s:%s(): Found illegal instruction",
		    proc_header->module_name,
		    proc_header->proc_name);
	    return (error_buffer);
	    break;
	}
    }

    proc_header->code = code_header.code_array;
    
    if (pcall_table != (proc_header_t **) NULL)
	free(pcall_table);
    if (fcall_table != (u_int_t *) NULL)
	free(fcall_table);
    if (double_table != (cell_t **) NULL)
	free(double_table);
    if (string_table != (cell_t **) NULL)
	free(string_table);
    if (int_table != (cell_t **) NULL)
	free(int_table);
    return ((char_t *) NULL);
} /* load_procedure_subsects() */


/*
 * read_pcno_integers()
 *
 * Read in 'size' integers from the PCNO file pointed to by 'fp'
 * and put them into the integer array 'into' starting at location
 * 'start'.
 *
 * This routine needs to do conversions between the external PCNO
 * format and in the internal integer format.  This includes both
 * byte ordering (big endian to whatever) and word size (4 bytes
 * integers to whatever).
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
static char_t *read_pcno_integers(fp, into, start, size)
FILE *fp;
u_int_t *into;
u_int_t start;
u_int_t size;
{
    char_t buf[PCNO_WORD_SIZE];
    u_int_t *i, *end;
    char_t *eb;

    for (i = into + start, end = i + size; i < end; i++)
    {
	if (fread(buf, PCNO_WORD_SIZE, 1, fp) != 1)
	{
	    sprintf(error_buffer, "Failed fread() in read_pcno_integers.");
	    return (error_buffer);
	}
        *i = ((int_t) (  (((u_int_t) *((unsigned char *) (buf))) << 24)
		       | (((u_int_t) *(((unsigned char *) (buf)) + 1)) << 16)
		       | (((u_int_t) *(((unsigned char *) (buf)) + 2)) << 8)
		       | (((u_int_t) *(((unsigned char *) (buf)) + 3))) ));
    }

    return ((char_t *) NULL);
} /* read_pcno_integers() */


/*
 * read_pcno_string()
 *
 * Read 'size' bytes from 'fp' into a malloc'ed array, and set *into
 * to point to that malloc'ed array.
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
static char_t *read_pcno_string(fp, into, size)
FILE *fp;
char_t **into;
u_int_t size;
{
    if ((*into = (char_t *) malloc (size)) == (char_t *) NULL)
    {
	_p_malloc_error();
    }
    if (fread(*into, size, 1, fp) != 1)
    {
	sprintf(error_buffer, "Failed fread() in read_pcno_string.");
	return (error_buffer);
    }
    return ((char_t *) NULL);
} /* read_pcno_string() */


/*
 * load_string_list()
 *
 * Load the string list from 'fp'.
 * Fill in 'n_entries' and 'group_size' with the appropriate values from
 * the string list header.
 * Set 'string_list' to be an array of pointers to the strings
 * in the string list.
 *
 * Return:	A NULL char_t pointer if it loads successfully.
 *		A pointer to an error message string otherwise.
 */
static char_t *load_string_list(fp, n_entries, group_size, string_list)
FILE *fp;
u_int_t *n_entries;
u_int_t *group_size;
char_t ***string_list;
{
    u_int_t i, n_strings;
    u_int_t string_len;
    char_t *eb;

    TEST_READ_PCNO_INTEGERS(fp, n_entries, 0, 1);
    TEST_READ_PCNO_INTEGERS(fp, group_size, 0, 1);

    n_strings = *n_entries * *group_size;
    if ((*string_list = (char_t **) malloc (n_strings * sizeof(char_t *)))
	== (char_t **) NULL)
    {
	_p_malloc_error();
    }
    
    for (i = 0; i < n_strings; i++)
    {
	TEST_READ_PCNO_INTEGERS(fp, &string_len, 0, 1);
	TEST_READ_PCNO_STRING(fp, ((*string_list) + i), string_len);
    }
    
    return ((char_t *) NULL);
} /* load_string_list() */


/*
 * free_string_list()
 *
 * Free up a string list that was created by load_string_list()
 */
static void free_string_list(n_entries, group_size, string_list)
u_int_t n_entries;
u_int_t group_size;
char_t **string_list;
{
    u_int_t i, end;
    for (i = 0, end = n_entries * group_size; i < end; i++)
	free(string_list[i]);
    free(string_list);
} /* free_string_list() */


/*
 * alloc_list_entry()
 *
 * malloc space for a list_t entry and put 'value' into the new entry
 */
static list_t *alloc_list_entry(value)
void *value;
{
    list_t *l;
    if ((l = (list_t *) malloc (sizeof(list_t))) == (list_t *) NULL)
    {
	_p_malloc_error();
    }
    l->value = value;
    return (l);
} /* alloc_list_entry() */


/*
 * massage_string_list()
 *
 * Go through the entries in the string list (a array of pointers
 * to malloc'ed strings) and replace each string with its equivalent
 * except that control sequences have been fixed.  For example,
 * if the original string has a "\n" in it, then replace it with
 * a string that actually has the '\n' character in place of
 * the "\n" (two characters).
 *
 * Normally, this conversion is done by the C compiler when linking
 * the pcnt file.  But since we are skipping the C compiler, we need
 * to do this ourself.
 */
static void massage_string_list(string_list, n_entries)
char_t **string_list;
u_int_t n_entries;
{
    u_int_t i;
    char_t *old_string, *o, *new_string, *n;
    u_int_t v;
    bool_t done;

    for (i = 0; i < n_entries; i++)
    {
	old_string = string_list[i];
	
	if ((new_string = (char_t *) malloc (strlen(old_string) + 1))
	    == (char_t *) NULL)
	{
	    _p_malloc_error();
	}

	o = old_string;
	n = new_string;

	while (*o != '\0')
	{
	    if (*o == '\\')
	    {
		switch (*(o + 1))
		{
		case 'n':
		    *n++ = '\n';
		    o += 2;
		    break;
		case 't':
		    *n++ = '\t';
		    o += 2;
		    break;
		case 'v':
		    *n++ = '\v';
		    o += 2;
		    break;
		case 'b':
		    *n++ = '\b';
		    o += 2;
		    break;
		case 'r':
		    *n++ = '\r';
		    o += 2;
		    break;
		case 'f':
		    *n++ = '\f';
		    o += 2;
		    break;
		case 'a':
		    *n++ = '\a';
		    o += 2;
		    break;
		case '\\':
		    *n++ = '\\';
		    o += 2;
		    break;
		case '\?':
		    *n++ = '\?';
		    o += 2;
		    break;
		case '\'':
		    *n++ = '\'';
		    o += 2;
		    break;
		case '\"':
		    *n++ = '\"';
		    o += 2;
		    break;
		case 'x':
		    /* hex constant : \x followed by 0 or more hex digits */
		    o += 2;
		    for (v = 0, done = FALSE; !done; )
		    {
			if (*o >= '0' && *o <= '9')
			{
			    v = 16 * v + (*o - '0');
			    o++;
			}
			else if (*o >= 'a' && *o <= 'f')
			{
			    v = 16 * v + (*o - 'a' + 10);
			    o++;
			}
			else if (*o >= 'A' && *o <= 'F')
			{
			    v = 16 * v + (*o - 'A' + 10);
			    o++;
			}
			else
			{
			    done = TRUE;
			}
		    }
		    *n++ = v;
		    break;
		default:
		    o++;
		    if (*o >= '0' && *o <= '7')
		    {
			/*
			 * octal constant :
			 *	\ followed by 1, 2, or 3 octal digits
			 */
			v = *o - '0';
			o++;
			if (*o >= '0' && *o <= '7')
			{
			    v = 8 * v + (*o - '0');
			    o++;
			    if (*o >= '0' && *o <= '7')
			    {
				v = 8 * v + (*o - '0');
				o++;
			    }
			}
		    }
		    else
		    {
			/* Unknown -- so leave the backslash in */
			*n++ = '\\';
			*n++ = *o++;
		    }
		    break;
		}
	    }
	    else
	    {
		*n++ = *o++;
	    }
	}

	*n = '\0';
	string_list[i] = new_string;
	free(old_string);
    }
} /* massage_string_list() */

#endif /* DYNAMIC_PAM_LOADING */

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