



		    heap_manager_.pl1               11/20/86  1359.7rew 11/20/86  1145.9      142686



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(86-06-24,DGHowe), approve(86-06-24,MCR7395), audit(86-11-14,Zwick),
     install(86-11-20,MR12.0-1222):
     implemented heap_manager_
                                                   END HISTORY COMMENTS */


/* format: ind3,ifthen,^inddcls,^elsestmt,indbegin,comcol68 */


/* this series of routines handle the heap acessed via *heap links
   (type 5 class 6).

   push_heap_level    : pushes a new heap level with a clean heap area.
		    chains previous heap levels together.
   pop_heap_level     : releases the current heap level and resets the
		    heap to the previous level.
   get_heap_level     : gets the current execution level from the current
		    heap header.
   get_heap_header	  : gets a pointer to the heap header at the passed
		    execution level
   get_heap_area	  : get a pointer to the heap area at the passed level
   create_heap_for_set_ext_var 
   		  : creates a heap level 0. This entrypoint is for the
		    use of set_ext_variable_ only.

*/


heap_manager_: procedure;

/* parameters */

dcl     a_exe_level		 fixed bin (17) parameter;	       /* execution level */
dcl     a_heap_area_ptr	 pointer parameter;		       /* ptr to heap area */
dcl     a_heap_header_ptr	 pointer parameter;		       /* ptr to heap header */
dcl     a_code		 fixed bin (35) parameter;	       /* system error code */

dcl     a_sb		 pointer parameter;		       /* pointer to stack header */
dcl     a_ring_no		 fixed bin parameter;	       /* ring number of faulting ring */

/* automatic */

dcl     done		 bit (1) automatic;		       /* specifes a loop end condition */
dcl     heap_p		 pointer automatic;		       /* temp ptr to heap header*/
dcl     heap_area_p		 pointer automatic;		       /* temp ptr to heap area*/
dcl     heap_header_ptr	 pointer automatic;		       /* ptr to heap header */
dcl     ring_no		 fixed bin automatic;	       /* is our validation level */
dcl     temp_ptr		 pointer automatic;		       /* a temp ptr */


/* conditions */

dcl     cleanup		 condition;


/* external routines */

dcl     cu_$level_get	 entry (fixed bin);
dcl     define_area_	 entry (ptr, fixed bin (35));
dcl     release_area_	 entry (ptr);

/* external variables */

dcl     (
        error_table_$no_heap_defined,
        error_table_$invalid_heap,
        error_table_$null_info_ptr
        )			 ext fixed bin (35);


dcl     sys_info$max_seg_size	 fixed bin (19) ext;


/* builtins */

dcl     (addr, char, ltrim, null, unspec) builtin;

/**/


/* return if heap_manager_ is called
*/

      return;

/**/

/* push heap level creates a new heap chaining the previous levels heap
   in the list of heaps

     parameters
     a_sb        ptr to stack header (Input)
     a_exe_level new execution level (Output)
     a_code      system error code (Output)

*/

push_heap_level: entry (a_sb, a_exe_level, a_code);


/* initialize required area pointers to null so we can tell when
   they have been set validly
*/

      a_code = 0;
      heap_p = null ();
      a_exe_level = -1;

      if a_sb = null () then
         do;
	  a_code = error_table_$null_info_ptr;
	  return;
         end;

      heap_header_ptr = a_sb -> stack_header.heap_header_ptr;


/* get our ring number so that the heap area has a unique suffix identifying
   the owning ring
*/

      call cu_$level_get (ring_no);



/* set up a cleanup handler so that if we are interupted we can release 
   the areas and reset the heap environment
*/

      on condition (cleanup)
         begin;

/* we have to have a cleanup handler here in case we get caught between
   the setting of exe_level and the return. If we get caught while in
   create_heap, it will do all of the work cleaning up and will set heap_p
   to null so we won't do our cleanup. If on the other hand we do get caught
   prior to our return we have to cleanup everything. Even though we
   can guarantee everything will be valid in this case we check it out anyway.
*/

	  if heap_p ^= null () then
	     do;
	        if (a_sb -> stack_header.heap_header_ptr ^= null ()) &
		   (heap_p = a_sb -> stack_header.heap_header_ptr) then
		 a_sb -> stack_header.heap_header_ptr = heap_header_ptr;
	        if heap_p -> heap_header.area_ptr ^= null () then
		 call release_area_ (heap_p -> heap_header.area_ptr);
	     end;

/* because we have done the cleanup we set the returned exe_level to 
   what we were passed so that if a cleanup handler exists at a previous
   level ie. main_ it will be able to tell that everything is cleaned
   up. ie. If the a_exe_level is the same on return as it was when we
   were called then nothing has been allocated and its cleanup handler
   should not have to cleanup the heap.
*/
	  a_exe_level = -1;

         end;


/* either generate a heap level exe_level + 1 or 1. level 0 is left for
   set_ext_variable_
*/

      if heap_header_ptr = null () then
         call create_heap (a_sb, ring_no, 1, heap_header_ptr, heap_p,
	    a_code);

      else
         call create_heap (a_sb, ring_no,
	    (heap_header_ptr -> heap_header.execution_level + 1),
	    heap_header_ptr, heap_p, a_code);

/* set the return execution level */

      if a_code = 0 then
         a_exe_level = heap_p -> heap_header.execution_level;

      return;

/**/
/* pop heap level releases the current heap level and resets the heap
   to the previous level.

     parameters
     a_sb        ptr to stack header (Input)
     a_code      system error code (Output)
*/

pop_heap_level: entry (a_sb, a_code);

      a_code = 0;

      if a_sb = null () then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      heap_p = a_sb -> stack_header.heap_header_ptr;
      if heap_p = null () then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      if (heap_p -> heap_header.version ^= heap_header_version_1) then
         do;
	  a_code = error_table_$invalid_heap;
	  return;
         end;

      heap_area_p = heap_p -> heap_header.area_ptr;


/* set up cleanup handler so that we can reset the environment if we 
   get interrupted
*/

      on condition (cleanup)
         begin;

/* heap_p is set prior to the condition handler to non null. If 
   heap_p is equal to the sb heap_header we have not unthreaded it 
   from the heap_header list. if heap_area_p is not null then
   we have not released the area.
*/

	  if heap_p = a_sb -> stack_header.heap_header_ptr then
	     a_sb -> stack_header.heap_header_ptr =
		heap_p -> heap_header.previous_heap_ptr;

	  if heap_area_p ^= null () then
	     call release_area_ (heap_area_p);

         end;

/* unthread our heap level from the heap list */

      a_sb -> stack_header.heap_header_ptr = heap_p -> heap_header.previous_heap_ptr;


/* Free the heap.  The routine release_area_ will also delete the segments
   it created for the heap.  The heap header and variable table are
   allocated within the heap area and are destroyed along with the heap.
*/

      if heap_area_p ^= null () then
         call release_area_ (heap_area_p);

      return;

/**/
/* get heap level returns the current execution level from the current
   heap header

     parameters
     a_sb         ptr to stack header (Input)
     a_exe_level  execution level (Output)
     a_code       system error code (Output)

*/

get_heap_level: entry (a_sb) returns (fixed bin (17));

      if a_sb = null () then
         return (-1);

      heap_header_ptr = a_sb -> stack_header.heap_header_ptr;
      if heap_header_ptr = null () then
         return (-1);

      if (heap_header_ptr -> heap_header.version ^=
	 heap_header_version_1) then
         return (-1);

      return (heap_header_ptr -> heap_header.execution_level);

/**/

/* get heap header returns a pointer to the heap header at the passed 
   execution level

     parameters
     a_exe_level         execution level (Input)
     a_sb		     ptr to stack header (Input)
     a_heap_header_ptr   ptr to heap header (Output)
     a_code	     system error code (Output)

*/

get_heap_header: entry (a_sb, a_exe_level, a_heap_header_ptr, a_code);

      a_code = 0;
      a_heap_header_ptr = null ();

      if a_sb = null () then
         do;
	  a_code = error_table_$null_info_ptr;
	  return;
         end;

      heap_header_ptr = a_sb -> stack_header.heap_header_ptr;

      if heap_header_ptr = null () then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      if (heap_header_ptr -> heap_header.version ^=
	 heap_header_version_1) then
         do;
	  a_code = error_table_$invalid_heap;
	  return;
         end;

      if (heap_header_ptr -> heap_header.execution_level < a_exe_level) |
	 (a_exe_level < -1) then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      if a_exe_level = -1 then
         do;					       /* if exe_level = -1 then use current level */
	  a_heap_header_ptr = heap_header_ptr;
	  return;
         end;

      temp_ptr = heap_header_ptr;
      done = "0"b;
      do while (^done);

         if (temp_ptr = null ()) then
	  done = "1"b;

         else if (a_exe_level = temp_ptr -> heap_header.execution_level) then
	  done = "1"b;

         else
	  temp_ptr = temp_ptr -> heap_header.previous_heap_ptr;
      end;

      if temp_ptr = null () then
         a_code = error_table_$no_heap_defined;

      else
         a_heap_header_ptr = temp_ptr;

      return;
						       /**/

/* get heap area returns a pointer to the heap area at the passed 
   execution level. The pointer returned points to an area of 
   max_segsize - 50


     parameters
     a_exe_level       execution level (Input)
     a_sb		   ptr to stack header (Input)
     a_heap_area_ptr   ptr to heap area (Output)
     a_code	   system error code (Output)

*/

get_heap_area: entry (a_sb, a_exe_level, a_heap_area_ptr, a_code);

      a_code = 0;
      a_heap_area_ptr = null ();


      if a_sb = null () then
         do;
	  a_code = error_table_$null_info_ptr;
	  return;
         end;

      heap_header_ptr = a_sb -> stack_header.heap_header_ptr;
      if heap_header_ptr = null () then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      if (heap_header_ptr -> heap_header.version ^=
	 heap_header_version_1) then
         do;
	  a_code = error_table_$invalid_heap;
	  return;
         end;

      if (a_exe_level > heap_header_ptr -> heap_header.execution_level) |
	 (a_exe_level < -1) then
         do;
	  a_code = error_table_$no_heap_defined;
	  return;
         end;

      if a_exe_level = -1 then
         do;					       /* if exe_level = -1 then use current level */
	  a_heap_area_ptr = heap_header_ptr -> heap_header.area_ptr;
	  return;
         end;

      temp_ptr = heap_header_ptr;
      done = "0"b;
      do while (^done);

         if (temp_ptr = null ()) then
	  done = "1"b;

         else if (a_exe_level = temp_ptr -> heap_header.execution_level) then
	  done = "1"b;

         else
	  temp_ptr = temp_ptr -> heap_header.previous_heap_ptr;
      end;

      if temp_ptr = null () then
         a_code = error_table_$no_heap_defined;

      else
         a_heap_area_ptr = temp_ptr -> heap_header.area_ptr;

      return;

/**/

/* create_heap_for_set_ext_var
   creates a heap level 0 for set_ext_variable_. This heap is used for
   programs that don't have a main_ as defined for C.

   parameters
   a_sb               a pointer to the stack of the calling routine
   a_ring_no          the ring number of the calling routine. ie of the 
		  faulting ring from set_ext_var. (Input)
   a_heap_header_ptr  a pointer to the heap_header. (Output)
   a_code		  an error_code. (Output)
*/

create_heap_for_set_ext_var: entry (a_sb, a_ring_no, a_heap_header_ptr, a_code);

      if a_sb = null () then
         do;
	  a_code = error_table_$null_info_ptr;
	  return;
         end;


      call create_heap (a_sb, a_ring_no, 0, null (), a_heap_header_ptr, a_code);

      return;

/**/
/* Internal Procedures */
/* create_heap
   allocates a heap via define_area_ and sets up the heap header.
*/

create_heap: procedure (sb, ring_no, exe_level, current_heap_header_ptr, new_heap_header_ptr, error_code);

/* parameters */

dcl     sb		 pointer parameter;		       /* Input */
dcl     ring_no		 fixed bin parameter;	       /* Input */
dcl     exe_level		 fixed bin (17) parameter;	       /* Input */
dcl     current_heap_header_ptr pointer parameter;	       /* Input */
dcl     new_heap_header_ptr	 pointer parameter;		       /* Output */
dcl     error_code		 fixed bin (35) parameter;	       /* Output */

/* structures */

dcl     1 new_area		 like area_info automatic;

/* based */

dcl     area_block		 area based;



/* initialize the area info */

      unspec (new_area.control) = ""b;
      new_area.control.extend = "1"b;
      new_area.control.zero_on_alloc = "1"b;
      new_area.control.system = "1"b;
      new_area.areap = null ();

/* the owner field is placed as a suffix on the area name.  The heap level
   and owning ring are placed in the owner string so that the heap segments
   and their owners may be identified by the segment name.
*/

      new_area.owner = "Heap_" || ltrim (char (exe_level)) ||
	 "r" || ltrim (char (ring_no));

      new_area.areap = null ();
      new_area.version = area_info_version_1;
      new_area.size = sys_info$max_seg_size - 50;


/* set up a cleanup handler so that if we are interupted we can release 
   the areas and reset the heap environment
*/

      on condition (cleanup)
         begin;

/* if stack is not set then we have not completed initializing the heap.
   if new_heap_header_ptr is set we have allocated the heap and
   possibly have chained it in with the heap header list.  If the
   heap area is set we have at least allocated the heap.  The heap
   area would be allocated via the call to define_area.
*/
	  if new_heap_header_ptr ^= null () then
	     do;
	        if (a_sb -> stack_header.heap_header_ptr ^= null ()) &
		   (new_heap_header_ptr = a_sb -> stack_header.heap_header_ptr) then
		 a_sb -> stack_header.heap_header_ptr = current_heap_header_ptr;

/* set new_heap_header_ptr to null so that the previous level can tell
   that everything is cleaned up.
*/

	        new_heap_header_ptr = null ();

	     end;

/* check and see if area needs to be dumped */

	  if new_area.areap ^= null () then
	     call release_area_ (new_area.areap);
         end;


/* set up an area where the heap can reside. use define area to specify it 
   as extensible and zero on alloc.
*/

      call define_area_ (addr (new_area), error_code);
      if error_code ^= 0 then
         return;


/* allocate and set up the heap header for this heap level in the heap
   area.
*/

      allocate heap_header in (new_area.areap -> area_block) set (new_heap_header_ptr);

      new_heap_header_ptr -> heap_header.area_ptr = new_area.areap;
      new_heap_header_ptr -> heap_header.version = heap_header_version_1;
      new_heap_header_ptr -> heap_header.heap_name_list_ptr = null ();
      new_heap_header_ptr -> heap_header.previous_heap_ptr = current_heap_header_ptr;
      new_heap_header_ptr -> heap_header.execution_level = exe_level;

/* thread the new heap header into the heap header list */

      sb -> stack_header.heap_header_ptr = new_heap_header_ptr;


   end create_heap;
%page;
/* Include Files */
%include system_link_names;
%page;

%include system_link_init_info;
%page;

%include stack_header;
%page;

%include area_info;

   end heap_manager_;




		    list_heap_variables.pl1         11/20/86  1359.7rew 11/20/86  1145.6       98001



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-06-24,DGHowe), approve(86-06-24,MCR7426), audit(86-11-12,Zwick),
     install(86-11-20,MR12.0-1222):
     implemented list_heap_variables.
                                                   END HISTORY COMMENTS */

/* format: style3,^indnoniterdo */

/* list heap variables ... this routine lists the heap variables at
   the specified level or at the current level.
*/

list_heap_variables:
lhv:
     proc;

/* automatic */

dcl	arg_ptr		pointer automatic;		/* ptr to the current arg */
dcl	arg_list_ptr	pointer automatic;		/* ptr to our arg list */
dcl	arg_length	fixed bin automatic;	/* length of current arg */
dcl	code		fixed bin (35) automatic;	/* an error code */
dcl	exe_level		fixed bin (17) automatic;	/* the current execution level */
dcl	finish		fixed bin (17) automatic;	/* the last exe level to be printed */
dcl	heap_header_ptr	pointer automatic;		/* ptr to the current heap header */
dcl	hdrsw		bit (1) aligned automatic;	/* -he or -nhe specified */
dcl	i		fixed bin automatic;	/* an indexing var */
dcl	lgsw		bit (1) aligned automatic;	/* -lg specified */
dcl	num_of_args	fixed bin automatic;	/* total args on command line */
dcl	nnames		fixed bin automatic;	/* number of ext vars to be printed */
dcl	nprinted		fixed bin automatic;	/* number of names printed */
dcl	node_ptr		pointer automatic;		/* ptr to variable_node ptr */
dcl	start		fixed bin (17) automatic;	/* the exe level to start at */

/* constants */

dcl	ME		char (19) aligned init ("list_heap_variables") static options (constant);
dcl	LONG_HEADER	char (69) static options (constant)
			init ("^/NAME^-^-         SEGMENT OFFSET   SIZE       ALLOCATED   INIT_PTR^/");
dcl	SHORT_HEADER	char (42) static options (constant) init ("^/NAME^-^-         SEGMENT OFFSET   SIZE^/");

dcl	IOA_CONTROL	(0:3) char (30) var static options (constant) init ("^30a ^3o ^6o ^8d ^16a ^p",
						/* SHORT NAME -lg */
			"^a^/^31x^3o ^6o ^8d ^16a ^p",/* LONG NAME -lg */
			"^30a ^3o ^6o ^8d",		/* SHORT NAME -bf */
			"^a^/^31x^3o ^6o ^8d");	/* LONG NAME -bf */

/* builtins */

dcl	(addr, baseno, bin, convert, fixed, hbound, lbound, null, rel, stackbaseptr, substr, verify)
			builtin;

/* external entries */

dcl	(com_err_, ioa_)	entry options (variable);
dcl	cu_$arg_count	entry () returns (fixed bin);
dcl	cu_$arg_ptr_rel	entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr);
dcl	cu_$arg_list_ptr	entry () returns (ptr);
dcl	date_time_	entry (fixed bin (71), char (*));
dcl	hcs_$fs_get_path_name
			entry (ptr, char (*), fixed, char (*), fixed (35));
dcl	heap_manager_$get_heap_header
			entry (pointer, fixed bin (17), pointer, fixed bin (35));
dcl	heap_manager_$get_heap_level
			entry (pointer) returns (fixed bin (17));


/* external variables */

dcl	error_table_$badopt ext fixed bin (35);

/* based */

dcl	arg		char (arg_length) based (arg_ptr);

/* structs */

dcl	1 list		aligned based,
	  2 array		dim (0:num_of_args),
	    3 name	char (256),
	    3 nsize	fixed bin (17) aligned,
	    3 flags,
	      4 found	bit (1) unal,
	      4 pad	bit (35) unal;

/**/

/* find out if there are any external variables */

	hdrsw = "1"b;
	lgsw = "0"b;
	start, finish = -1;
	nnames = 0;
	nprinted = 0;
	sb = stackbaseptr ();

	arg_list_ptr = cu_$arg_list_ptr ();
	num_of_args = cu_$arg_count ();

	begin;

dcl	1 name_list	like list automatic;


	     call process_args (addr (name_list));
	     if start = -1
	     then do;
		call com_err_ (0, ME, "There are no heaps allocated.");
		goto EXIT;
	     end;

	     do exe_level = start to finish;
		call heap_manager_$get_heap_header (sb, exe_level, heap_header_ptr, code);
		if code ^= 0
		then do;
		     call com_err_ (0, ME, "The heap does not exist at level ^d.", exe_level);
		     goto NEXT_LEVEL;
		end;


		call print_each_level (heap_header_ptr, exe_level, addr (name_list));

		if nnames > 0 then do;
		     if nprinted < nnames then do;
			call ioa_ ("^/The following variables were not found:");
			do i = 1 to nnames;
			     if ^name_list.array (i).flags.found then
				call ioa_ ("^a",
				     substr (name_list.array (i).name,
				     1, name_list.array (i).nsize));
			end;
		     end;
		     nprinted = 0;

/* reset the found switches */

		     do i = 1 to nnames;
			name_list.array (i).flags.found = "0"b;
		     end;
		end;

NEXT_LEVEL:
	     end;


	end;


EXIT:
	return;

/**/
/* Internal entry points */

/* print each level
   goes through a passed heap level and prints out information concerning
   the heap variables at that level
*/

print_each_level:
     proc (heap_header_ptr, exe_level, name_list_ptr);


dcl	heap_header_ptr	pointer parameter;
dcl	exe_level		fixed bin parameter;
dcl	name_list_ptr	pointer parameter;

dcl	entryname		char (32) automatic;
dcl	code		fixed bin (35) automatic;
dcl	table_ptr		pointer automatic;
dcl	i		fixed bin automatic;



/* get the heap area name and print out some info about the heap */

	entryname = "???";
	call hcs_$fs_get_path_name (heap_header_ptr -> heap_header.area_ptr, "", (0), entryname, code);
	if code ^= 0
	then do;
	     call com_err_ (code, ME,
		"Cannot get name of heap area segment ^p at level ^d.",
		heap_header_ptr, exe_level);
	     return;
	end;

	call ioa_ ("^/^/Heap level ^d, allocation area at ^p ^/ (^a in process directory).",
	     heap_header_ptr -> heap_header.execution_level, heap_header_ptr -> heap_header.area_ptr, entryname);



/* check and see if there any variables at this level */

	table_ptr = heap_header_ptr -> heap_header.heap_name_list_ptr;
	if table_ptr = null
	then do;
no_variables:
	     call ioa_ ("There are no heap variables at level ^d.", exe_level);
	     return;
	end;


	if (table_ptr -> variable_table_header.cur_num_of_variables < 1)
	then goto no_variables;


/* print out a header if required */

	if hdrsw
	then do;
	     if lgsw
	     then call ioa_ (LONG_HEADER);

	     else call ioa_ (SHORT_HEADER);
	end;



/* loop through system name list, printing info for desired variables */


	do i = lbound (table_ptr -> variable_table_header.hash_table, 1)
	     to hbound (table_ptr -> variable_table_header.hash_table, 1);

	     do node_ptr = table_ptr -> variable_table_header.hash_table (i)
		repeat node_ptr -> variable_node.forward_thread while (node_ptr ^= null);

		if nnames = 0
		then call print_it (node_ptr);

		else if name_on_list (node_ptr, name_list_ptr)
		then do;
		     call print_it (node_ptr);
		     nprinted = nprinted + 1;
		     if nprinted = nnames
		     then return;
		end;
	     end;
	end;


     end print_each_level;

/**/

/* name_on_list
   checks and sees if the passed variable is on the name list specified
   on the command line
*/

name_on_list:
     proc (node_ptr, name_list_ptr) returns (bit (1));

dcl	node_ptr		pointer parameter;
dcl	name_list_ptr	pointer parameter;

dcl	j		fixed bin automatic;
dcl	1 name_list	like list aligned based (name_list_ptr);


	do j = 1 to nnames;
	     if ^name_list.array (j).flags.found
	     then do;
		if name_list.array (j).name = node_ptr -> variable_node.name
		then do;
		     name_list.array (j).flags.found = "1"b;
		     return ("1"b);
		end;
	     end;
	end;

	return ("0"b);

     end name_on_list;


/**/
/* print_it: prints out information concerning an individual heap
   variable.
*/
print_it:
     proc (node_ptr);

dcl	node_ptr		pointer parameter;

dcl	date		char (24) automatic;
dcl	init_ptr		pointer automatic;
dcl	variable_ptr	pointer automatic;


	variable_ptr = node_ptr -> variable_node.vbl_ptr;
	if lgsw
	then do;
	     call date_time_ (node_ptr -> variable_node.time_allocated, date);
	     init_ptr = node_ptr -> variable_node.init_ptr;

	     call ioa_ (IOA_CONTROL (bin ((node_ptr -> variable_node.name_size > 31), 1)),
		node_ptr -> variable_node.name, fixed (baseno (variable_ptr), 15), bin (rel (variable_ptr), 18),
		node_ptr -> variable_node.vbl_size, substr (date, 1, 16), init_ptr);
	end;

	else call ioa_ (IOA_CONTROL (bin ((node_ptr -> variable_node.name_size > 31), 1) + 2),
		node_ptr -> variable_node.name, fixed (baseno (variable_ptr), 15), bin (rel (variable_ptr), 18),
		node_ptr -> variable_node.vbl_size);
	return;

     end print_it;

/**/
/* process_args: goes through the command arguements and sets up a
   name list of variables to be found
*/

process_args:
     procedure (name_list_ptr);

dcl	name_list_ptr	pointer parameter;

dcl	i		fixed bin automatic;

dcl	1 name_list	like list aligned based (name_list_ptr);

	if num_of_args > 0
	then do i = 1 to num_of_args;
		call cu_$arg_ptr_rel (i, arg_ptr, arg_length, code, arg_list_ptr);
		if code ^= 0
		then do;
		     call com_err_ (code, ME, arg);
		     goto EXIT;
		end;

		else if index (arg, "-") = 1
		then do;

		     if (arg = "-long") | (arg = "-lg")
		     then lgsw = "1"b;

		     else if (arg = "-brief") | (arg = "-bf")
		     then lgsw = "0"b;

		     else if (arg = "-all") | (arg = "-a")
		     then do;
			start = 0;
			finish = heap_manager_$get_heap_level (sb);
		     end;

		     else if (arg = "-no_header") | (arg = "-nhe")
		     then hdrsw = "0"b;

		     else if (arg = "-header") | (arg = "-he")
		     then hdrsw = "1"b;

		     else if arg = "-to"
		     then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, arg_ptr, arg_length, code, arg_list_ptr);
			if (verify (arg, "0123456789") ^= 0) | (code ^= 0)
			then do;
			     call com_err_ (0, ME, "Numeric operand of -to is missing.");
			     goto EXIT;
			end;
			finish = convert (finish, arg);
		     end;

		     else if (arg = "-from") | (arg = "-fm")
		     then do;
			i = i + 1;
			call cu_$arg_ptr_rel (i, arg_ptr, arg_length, code, arg_list_ptr);
			if (verify (arg, "0123456789") ^= 0) | (code ^= 0)
			then do;
			     call com_err_ (0, ME, "Numeric argument of -from is missing.");
			     goto EXIT;
			end;
			start = convert (start, arg);
		     end;

		     else do;
			call com_err_ (error_table_$badopt, ME, arg);
			goto EXIT;
		     end;
		end;

		else do;
		     nnames = nnames + 1;
		     name_list.array (nnames).name = arg;
		     name_list.array (nnames).nsize = arg_length;
		     name_list.array (nnames).flags.found = "0"b;
		end;
	     end;


/* set start and finish to defalut values of current level if not 
   specified
*/

	if start = -1
	then do;
	     if finish = -1
	     then start = heap_manager_$get_heap_level (sb);
	     else start = 0;
	end;
	if finish = -1
	then finish = heap_manager_$get_heap_level (sb);

     end process_args;
%page;
/* Include Files */

%include system_link_names;
%page;

%include stack_header;


     end list_heap_variables;






		    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
