



		    gcos_user.pl1                   11/19/82  1414.9rew 11/19/82  0930.9       92061



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */



/*

	Modified:	R.H. Morrison	November 1974
	Modified: S.C. Akers	November 1981  Rewrite to support
					     more versatile ctl_args
					     and multiple IDs.

					     Change ios_ calls to
					     command_query_.

*/
%page;
gcos_user: proc;

/*
*****							*****
*****	At  present, this is not a legal entry point.  As time	*****
*****	goes by, it will become a legal entry.			*****
*****							*****
*/

	call com_err_ (error_table_$bad_command_name, proc_id);
	goto gu_ret;

/* * * * * * * * * * * * * * * * * * * */

add:	entry;					/* Add an entry */

	call gu_add;
	goto gu_ret;

/* * * * * * * * * * * * * * * * * * * */

delete:	entry;					/* Delete an entry */

	call gu_delete;
	goto gu_ret;

/* * * * * * * * * * * * * * * * * * * */

init_table: entry;					/* Build a new table */

	call gu_init;
	goto gu_ret;

/* * * * * * * * * * * * * * * * * * * */

print:	entry;					/* Print entry info */

	call gu_print;
	goto gu_ret;

/* * * * * * * * * * * * * * * * * * * */

gu_ret: ;

	return;
%page;
get_acct_id: proc;					/* Prompts user for account ID */

	legal_arg = "0"b;

	do   while (^legal_arg);
	     call command_query_ (info_ptr, answer, proc_id, "GCOS Account ID?");
	     if length (answer) > 12
	      | length (answer) < 1
	     then call ioa_ ("Account ID must be 1 to 12 characters.");
	     else if verify (answer, valid_chars) ^= 0
		then call ioa_ ("Account ID can contain only the following characters:^/""^a""",
			       valid_chars);
		else do;
		     legal_arg = "1"b;
		     gcos_account_id = answer;
		     end;
	     end;

	return;

end get_acct_id;
%page;
get_person_id: proc;				/* Prompt user for person ID */

	legal_arg = "0"b;

	do   while (^legal_arg);
	     call command_query_ (info_ptr, answer, proc_id, "Multics Person Name?");
	     if length (answer) > 23
	      | length (answer) < 1
	     then call ioa_ ("Person Name must be 1 to 23 characters.");
	     else do;
		legal_arg = "1"b;
		m_person = answer;
		end;
	     end;

	return;

end get_person_id;
%page;
get_project_id: proc;				/* Prompt user for project ID */

	legal_arg = "0"b;

	do   while (^legal_arg);
	     call command_query_ (info_ptr, answer, proc_id, "Multics Project ID?");
	     if length (answer) > 9
	      | length (answer) < 1
	     then call ioa_ ("Project ID must be 1 to 9 characters.");
	     else do;
		legal_arg = "1"b;
		m_project = answer;
		end;
	     end;

	return;

end get_project_id;
%page;
gu_add: proc;					/* Add an entry to the GCOS user table */

	call initializer;
	call get_acct_id;
	call get_person_id;
	call get_project_id;

	temp_entry_ptr -> gute_gcos_account_id	= gcos_account_id;
	temp_entry_ptr -> gute_multics_person	= m_person;
	temp_entry_ptr -> gute_multics_project	= m_project;
	temp_entry_ptr -> gute_ctl_filler	= 0;

	call gcos_user_$add (temp_entry_ptr, gut_code);
	if gut_code = 0
	then call ioa_ ("^a added to table", gcos_account_id);
	else call gu_error (gut);

	return;

end gu_add;
%page;
gu_delete: proc;					/* Delete an entry from the GCOS user table */

	call initializer;
	call cu_$arg_count (count);

	if count = 0
	then do;
	     gut_code = error_table_$noarg;
	     call gu_error (et);
	     end;
	else do i = 1 to count;
	     call cu_$arg_ptr (i, ptr, cc, gut_code);
	     if gut_code ^= 0
	     then do;
		call gu_error (et);
		end;
	     else do;
		gcos_account_id = arg;
		call gcos_user_$find_entry (gcos_account_id, gut_index, gutep, gut_code);

		if gut_code ^= 0
		then do;
		     if gut_code = 1
		      | gut_code = 9
		     then do;
			call com_err_ (0, proc_id,
				     """^a"" ^a", gcos_account_id,
				     gut_et (gut_code));
			end;
		     else call gu_error (gut);
		     end;

		else do;
		     call gcos_user_$delete (gcos_account_id, gut_index, gut_code);
		     if gut_code ^= 0
		     then call com_err_ (0, proc_id,
				     """^a"" ^a", gcos_account_id,
				     gut_et (gut_code));
		     end;
		end;
	     end;

	return;

end gu_delete;
%page;
gu_error: proc (which_error);					/* Prints error messages */

dcl  which_error	fixed bin parm;


	if gut_code <= gut_et_count
	 & which_error = gut
	then call com_err_ (0, proc_id, gut_et (gut_code));
	else call com_err_ (gut_code, proc_id);

	return;

end gu_error;
%page;
gu_init: proc;

	call initializer;
	call gcos_user_$init_table (gut_code);
	if gut_code ^= 0
	then call gu_error (gut);

	return;

end gu_init;
%page;
gu_print: proc;					/* Print requested user information */

	call initializer;
	call cu_$arg_count (count);

	if count = 0
	then call com_err_ (error_table_$noarg, proc_id);
	else do;
	     call cu_$arg_ptr (1, ptr, cc, gut_code);
	     if gut_code ^= 0
	     then call gu_error (et);

	     else do;

		if arg = "-header"
		 | arg = "-hdr"
		then do;
		     call print_gut_header;
		     if count > 1
		     then do;
			call cu_$arg_ptr (2, ptr, cc, gut_code);
			if gut_code ^= 0
			then call gu_error (et);

			else do;
			     if arg = "-gcos_account_id"
			      | arg = "-gaid"
			     then do;
				if count < 3
				then do;
				     gut_code = error_table_$noarg;
				     call gu_error (et);
				     end;
				else call print_entry_info (3);
				end;
			     end;
			end;
		     end;

		else if arg = "-gcos_account_id"
		      | arg = "-gaid"
		     then do;
			if count < 2
			then do;
			     gut_code = error_table_$noarg;
			     call gu_error (et);
			     end;
			else call print_entry_info (2);
			end;

		else call com_err_ (error_table_$badopt, proc_id,
				"^/""^a""", arg);
		end;
	     end;

	return;

end gu_print;
%page;
initializer: proc;

	buff_ptr = addr (buffer);			/* Initialize pointers */
	temp_entry_ptr = addr (temp_entry);
	info_ptr = addr (query_info);

	query_info.version = query_info_version_5;	/* Initialize query info */
	query_info.switches.yes_or_no_sw = "0"b;
	query_info.switches.suppress_name_sw = "1"b;
	query_info.switches.cp_escape_control = "10"b;
	query_info.switches.suppress_spacing = "0"b;
	query_info.status_code = 0;

	return;

end initializer;
%page;
print_entry_info: proc (starting_arg);				/* Prints information about
						   GCOS user table entries */

dcl  starting_arg fixed bin parm;

	do   i = starting_arg to count;
	     call cu_$arg_ptr (i, ptr, cc, gut_code);
	     if gut_code ^= 0
	     then call gu_error (et);
	     else do;
		if cc > 12
		then do;
		     call com_err_ (error_table_$bigarg, proc_id, arg);
		     end;

		else do;
		     if arg = "-hdr"
		     then call print_gut_header;
		     else do;
			gcos_account_id = arg;
			call gcos_user_$find_entry (gcos_account_id,
					        gut_index,
					        gutep, gut_code);

			if gut_code ^= 0
			then do;
			     if gut_code ^= 1
			     then call gu_error (gut);
			     call com_err_ (0, proc_id, "^a:""^a""", gut_et (1), gcos_account_id);
			     end;
			else do;

			     call ioa_ ("^/gut_entry:");
			     call ioa_ ("gute_gcos_account_id^1-^a",
				       gutep -> gute_gcos_account_id);
			     call ioa_ ("gute_multics_person^2-^a",
				       gutep -> gute_multics_person);
			     call ioa_ ("gute_multics_project^1-^a^/",
				       gutep -> gute_multics_project);
			     end;
			end;
		     end;
		end;
	     end;

	return;

end print_entry_info;
%page;
print_gut_header: proc;				/* Print header info from GCOS user table */

	gut_code = 0;

	if gutp = null
	then do;
	     call gcos_user_$get_table_ptr (gutp, gut_code);
	     if gut_code ^= 0
	     then call gu_error (gut);
	     end;
	if gut_code = 0
	then do;

	     call date_time_ (gut_last_update, date);
	     call ioa_ ("^/gut_header:");
	     call ioa_ ("gut_version_no^2-^d", gut_version_no);
	     call ioa_ ("gut_hdr_len^2-^d", gut_hdr_len);
	     call ioa_ ("gut_global_ctl_len^2-^d", gut_global_ctl_len);
	     call ioa_ ("gut_entry_len^2-^d", gut_entry_len);
	     call ioa_ ("gut_last_update^2-^a", date);
	     call ioa_ ("gut_updater_id^2-^a", gut_updater_id);
	     call ioa_ ("gut_max_count^2-^d", gut_max_count);
	     call ioa_ ("gut_active_count^2-^d^/", gut_active_count);
	     
	     end;

	return;

end print_gut_header;
%page;
dcl
     proc_id char (9) init ("gcos_user"),
     gcos_pswd char (12),
     m_person char (22),
     m_project char (9),
     date_time_ entry (fixed bin (71), char (*)),
     count fixed bin,
     gut_index fixed bin;

dcl  i fixed bin,
     gut_code fixed bin (35),
     ptr ptr,
     cc fixed bin,
     arg char (cc) based (ptr),
     gcos_account_id char (12),
     date char (24),
     valid_chars char (37) init (".0123456789abcdefghijklmnopqrstuvwxyz");

dcl  answer char (132) varying,
     legal_arg bit (1),
     info_ptr ptr;

dcl  buff_ptr ptr,
     buffer char (32);

dcl  (gut init(1),
      et  init(2)
     )		fixed bin internal static options (constant);

dcl  temp_entry_ptr ptr,
     temp_entry (32) fixed bin;			/* "32" MUST be changed if "gut_entry_len" is changed */

dcl (
     com_err_ entry options (variable),
     command_query_ entry options(variable),
     cu_$arg_count entry (fixed bin),
     cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
     gcos_user_$add entry (ptr, fixed bin (35)),
     gcos_user_$delete entry (char (12), fixed bin, fixed bin (35)),
     gcos_user_$find_entry entry (char (12), fixed bin, ptr, fixed bin (35)),
     gcos_user_$get_table_ptr entry (ptr, fixed bin (35)),
     gcos_user_$init_table entry (fixed bin (35)),
     ioa_ entry() options(variable)

    )	external;

dcl (addr, null, substr, verify) builtin;

dcl (error_table_$noarg,
     error_table_$bigarg,
     error_table_$badopt,
     error_table_$bad_command_name) fixed bin (35) external;
%page;
%include gcos_user_table_;
%page;
%include gut_error_table_;
%page;
%include query_info;

/* * * * * * * * * * * * * * * * * * * */

end gcos_user;
   



		    gcos_user_.pl1                  11/19/82  1414.9rew 11/19/82  0931.0       74025



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */



/* ********************************************************************
   *							*
   *	Modified by	R.H. Morrison	November 1974	*
   *							*
   ******************************************************************** */


gcos_user_: proc;

dcl  gcos_daemon_stat_$root_dir char (168) aligned ext;	/* directory containing gu table */
dcl  gcos_daemon_stat_$root_dir_len ext fixed bin;
	dcl
	(addr, index, null, substr) builtin,
	(i, j) fixed bin,
	(entry_gcos_account_id, insert_gcos_account_id) char (12),
	proc_id char (10) init ("gcos_user_"),
	bitcount fixed bin (24) init (0),
	clock_ entry () returns (fixed bin (71)),
	hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)),
	hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)),
	person char (22),
	project char (9),
	(error_table_$segknown) fixed bin (35) external,

	gut_index fixed bin,
	gut_code fixed bin (35),

	user_info_$whoami entry (char (*), char (*), char (*)),
	buffer char (32);

dcl  a_ptr ptr,
     a_index fixed bin,
     a_gaid char (12),
     a_code fixed bin (35);

dcl  fe_entry_sw bit (1) init ("0"b),
     fe_user_no fixed bin;

dcl  true bit (1) init ("1"b),
     false bit (1) init ("0"b);


%include gcos_user_table_;

/* argument processing */

/* * * * * * * * * * * * * * * * * * * */

add:	entry (a_ptr, a_code);

	if gutp = null then do;
	     call get_table_ (gutp, a_code);
	     if a_code ^= 0 then go to bad_gut_code;
	end;

	insert_gcos_account_id = a_ptr -> gute_gcos_account_id;

	if gut_active_count = 0 then do;
append:	     gut_active_count = gut_active_count + 1;
	     addr (gut_entry (gut_active_count)) -> gcos_user_table_entry_ =
	     a_ptr -> gcos_user_table_entry_;

	     go to gu_ret;
	end;

	else do i = 1 to gut_active_count;
	     entry_gcos_account_id = addr (gut_entry (i)) -> gute_gcos_account_id;
	     if entry_gcos_account_id > insert_gcos_account_id then go to insert;

	     if entry_gcos_account_id = insert_gcos_account_id then do;
		a_code = 5;
		go to bad_gut_code;
	     end;
	end;

	if gut_active_count < gut_max_count then go to append;
	else do;
	     a_code = 4;
	     go to bad_gut_code;
	end;

insert:	call move_entry_ (i, i+1, a_code);
	if a_code ^= 0 then go to bad_gut_code;

	addr (gut_entry (i)) -> gcos_user_table_entry_ = a_ptr -> gcos_user_table_entry_;
	go to gu_ret;

/* * * * * * * * * * * * * * * * * * * */

gu_ret:	
	bitcount = 36 * (gut_hdr_len + (gut_active_count * gut_entry_len));
	call hcs_$set_bc_seg (gutp, bitcount, a_code);

bad_gut_code:
gu_return:

	return;

/* * * * * * * * * * * * * * * * * * * */

move_entry_: proc (from_index, to_index, gut_code);

dcl (from_index, to_index) fixed bin,
     gut_code fixed bin (35),
     gut_index fixed bin,
     delta fixed bin,
     temp_count fixed bin;

	     temp_count = gut_active_count;
	     delta = to_index - from_index;

	     if from_index > to_index then do;
		do gut_index = from_index to temp_count;
		     gut_entry (to_index) = gut_entry (gut_index);
		     to_index = to_index + 1;
		end;
		gut_code = 0;
	     end;

	     else do;
		if gut_active_count + delta > gut_max_count then do;
		     gut_code = 4;
		     go to me_ret;
		end;

		do gut_index = (temp_count + delta) to to_index by -1;
						/* to_index = from_index + delta */
		     gut_entry (gut_index) = gut_entry (temp_count);
		     temp_count = temp_count - 1;
		end;

		gut_code = 0;
	     end;

	     gut_active_count = gut_active_count + delta;

me_ret:	     
	     return;
	end move_entry_;

/* * * * * * * * * * * * * * * * * * * */

get_table_: proc (gutp, gut_code);

dcl  gutp ptr,
     gut_code fixed bin (35);

	     gutp = null;
	     call hcs_$initiate_count (substr (gcos_daemon_stat_$root_dir, 1, gcos_daemon_stat_$root_dir_len),
	     "gcos_user_table_", "",
	     bitcount, 0, gutp, gut_code);
	     if (gut_code = 0 | gut_code = error_table_$segknown) then do;
		if bitcount ^= 0 then do;
		     call validate_table_ (gut_code);
		     if gut_code ^= 0 then gutp = null;
		end;
		else gut_code = 0;
	     end;

gt_ret:	     
	     return;
	end get_table_;

/* * * * * * * * * * * * * * * * * * * */

validate_table_: proc (gut_code);

dcl  gut_code fixed bin (35);

	     if bitcount = (gut_hdr_len + (gut_active_count * gut_entry_len)) * 36 then do;
		gut_code = 0;
		go to vt_ret;
	     end;
	     else gut_code = 3;

vt_ret:	     
	     return;
	end validate_table_;

/* * * * * * * * * * * * * * * * * * * */

init_table: entry (a_code);

	call get_table_ (gutp, gut_code);		/* force "get" for latest bitcount */
	if gut_code ^= 0 then do;
	     a_code = gut_code;
	     go to bad_gut_code;
	end;

	if bitcount ^= 0 then do;
	     a_code = 10;
	     go to bad_gut_code;
	end;

	gut_version_no = 1;
	gut_hdr_len = 128;				/* includes global_ctl_len */
	gut_global_ctl_len = 64;
	gut_entry_len = 32;
	gut_last_update = clock_ ();

	call user_info_$whoami (person, project, buffer);

	i = index (person, " ");
	if i = 0 then i = 22;
	else i = i - 1;
	j = index (project, " ");
	if j = 0 then j = 9;
	else j = j - 1;
	gut_updater_id = substr (person, 1, i) || "." || substr (project, 1, j);

	gut_max_count = 1000;
	gut_active_count = 0;
	gut_first_entry_index = 0;
	gut_last_entry_index = 0;

	gut_filler = 0;
	gut_global_ctl_filler = 0;
	a_code = 0;
	go to gu_ret;

/* * * * * * * * * * * * * * * * * * * */

find_entry: entry (a_gaid, a_index, a_ptr, a_code);	/* should be changed to eliminate parameter dependence */

	fe_entry_sw = true;

	if gutp = null then do;
	     call get_table_ (gutp, gut_code);
	     if gut_code ^= 0 then do;
		a_code = gut_code;
fe_not_found:	
		a_ptr = null;
		a_index = 0;
		go to fe_ret;
	     end;
	end;

fe_local_entry:
	a_code = 0;
	do gut_index = 1 to gut_active_count;
	     a_ptr = addr (gut_entry (gut_index));
	     if a_ptr -> gute_gcos_account_id = a_gaid then go to fe_ret;
	end;

	a_code = 1;
	a_ptr = null;
	gut_index = 0;

fe_ret:	
	if fe_entry_sw then do;
	     a_index = gut_index;
	     fe_entry_sw = false;
	     go to gu_return;
	end;

	else go to fe_user (fe_user_no);

/* * * * * * * * * * * * * * * * * * * */

validate: entry (a_gaid, a_ptr, a_code);

	if gutp = null then do;
	     call get_table_ (gutp, gut_code);
	     if gut_code ^= 0 then do;
		a_code = gut_code;
		go to bad_gut_code;
	     end;
	end;

	fe_user_no = 1;
	go to fe_local_entry;

fe_user (1):
	if a_code ^= 0 then go to vd_reject;

	if a_gaid ^= a_ptr -> gute_gcos_account_id then do;
	     a_code = 2;
vd_reject:     
	     a_ptr = null;
	     go to bad_gut_code;
	end;

	a_code = 0;
	go to gu_ret;

/* * * * * * * * * * * * * * * * * * * */

delete:	entry (a_gaid, a_index, a_code);

	if gutp = null then do;
	     call get_table_ (gutp, gut_code);
	     if gut_code ^= 0 then do;
		a_code = gut_code;
		go to bad_gut_code;
	     end;
	end;

	if gut_active_count = 0 then do;
	     a_code = 7;
	     go to bad_gut_code;
	end;

	if addr (gut_entry (a_index)) -> gute_gcos_account_id ^= a_gaid then do;
	     a_code = 1;
	     go to bad_gut_code;
	end;

	if a_index = gut_active_count then do;
	     gut_active_count = gut_active_count - 1;	/* don't bother calling move_entry */
	     go to gu_ret;
	end;

	call move_entry_ (a_index + 1, a_index, gut_code);
	if gut_code ^= 0 then do;
	     a_code = gut_code;
	     go to bad_gut_code;
	end;

	go to gu_ret;

/* * * * * * * * * * * * * * * * * * * */

get_table_ptr: entry (a_ptr, a_code);

	if gutp = null then do;
	     call get_table_ (gutp, gut_code);
	     if gut_code ^= 0 then do;
		a_ptr = null;
		a_code = gut_code;
		go to bad_gut_code;
	     end;
	end;

	a_ptr = gutp;
	a_code = 0;
	go to gu_return;

/* * * * * * * * * * * * * * * * * * * */

     end gcos_user_;
   



		    yes_no_.pl1                     11/19/82  1414.9rew 11/19/82  0931.0       17100



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
yes_no_: proc (answer);

/* to accept the next line from "user_input" and test it for any legitimate yes/no response.
   Responses may be any of the following: yes, no, y or n. */

/* Bob May 12/20/72 */

dcl  answer char (*);

dcl  buffer char (8),				/* buffer for user_input */
     nelemt fixed bin,
     io_status bit (72) aligned,
     sp ptr,
     1 phake_io_status aligned based (sp),
     2 io_stat_1 bit (36),
     2 io_stat_2 bit (36),
     bp ptr,
     yes_mask char (3) based (bp),
     no_mask char (2) based (bp),
     y_n_mask char (1) based (bp);

dcl  yes char (3) init ("yes"),
     no char (2) init ("no"),
     y char (1) init ("y"),
     n char (1) init ("n");

dcl  ios_$read_ptr entry (ptr, fixed bin, fixed bin),
     ios_$resetread entry (char (*), bit (72) aligned),
     com_err_ entry options (variable),
     com_err_$suppress_name entry (fixed bin, char (*), char (*));

/* * * * * * * * * * * * * * * * * * * */

start:
	sp = addr (io_status);
	bp = addr (buffer);
	call ios_$read_ptr (bp, 8, nelemt);
	if nelemt = 2 then do;
	     if y_n_mask = y | y_n_mask = n then go to good;
	end;
	else if nelemt = 3 then do;
	     if no_mask = no then go to good;
	end;
	else if nelemt = 4 then do;
	     if yes_mask = yes then go to good;
	end;

bad:
	call com_err_$suppress_name (0, "yes_no_", "please answer:yes, no, y or n");
	call ios_$resetread ("user_input", io_status);
	if io_stat_1 ^= "0"b then do;
	     call com_err_ (fixed (io_stat_1, 35), "yes_no_");
	     go to bad;
	end;
	go to start;

good:
	answer = y_n_mask;
ret:	return;
     end yes_no_;



		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
