



		    attach_audit.pl1                11/04/82  1918.6rew 11/04/82  1605.2       55413



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


/* format: style2,ind3 */
attach_audit:
ata:
   proc;

/*  This module turns on auditing for the calling process. IF
   no arguments are given, it generates default switchnames, and audit_
   is set up with no arguments.

   Written  1/1/79  by  Lindsey L. Spratt
   Modified:
   11/26/79  by  Lindsey L. Spratt to implement the -modes control argument.
06/05/81  by  Lindsey Spratt: Changed error message for non-zero code when
	    trying to attach audit_ to the old switch to give the attach
	    description being attempted.  Changed the error code from
	    bad_arg to badopt when more than one mode string is specified.
09/09/81 by Lindsey Spratt: Added a check of arguments being placed in the
	  attach description "ad".  This allows more elegant error reporting
	  than the "argerr" produced by audit_. This fixes bug 9.
11/12/81 by Lindsey Spratt: Made all error messages start with a newline.
	  Changed the argument index variable from "i" to "arg_idx".
*/

/*  Automatic  */

      dcl	    nargs		       fixed bin;
      dcl	    arg_idx	       fixed bin;
      dcl	    tp		       ptr;
      dcl	    tc		       fixed bin;
      dcl	    (code, code1)	       fixed bin (35);
      dcl	    ad		       char (128) varying;
      dcl	    mode_string	       char (256) varying init ("");
      dcl	    old_modes	       char (256) init ("");
      dcl	    (old_switch, new_switch)
			       char (32);
      dcl	    (old_iocb, new_iocb)   ptr;
      dcl	    (have_old_iocb, have_new_iocb)
			       bit (1);
      dcl	    time		       char (16);

/*  Based  */

      dcl	    targ		       char (tc) based (tp);

/* Builtins */

      dcl	    clock		       builtin;
      dcl	    codeptr	       builtin;
      dcl	    rtrim		       builtin;
      dcl	    substr	       builtin;

/* Constant */

      dcl	    MYNAME	       char (12) init ("attach_audit") internal static options (constant);

/*  Entries  */

      dcl	    date_time_	       entry (fixed bin (71), char (*));
      dcl	    cu_$arg_count	       entry (fixed bin);
      dcl	    cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin, fixed bin (35));
      dcl	    com_err_	       entry options (variable);


/* External */

      dcl	    error_table_$badopt    fixed bin (35) ext;


      have_old_iocb = "0"b;
      have_new_iocb = "0"b;

      ad = " ";
      call cu_$arg_count (nargs);


      do arg_idx = 1 to nargs;
         call cu_$arg_ptr (arg_idx, tp, tc, code);
         if code ^= 0
         then
	  do;
	     call com_err_ (code, MYNAME, "^/Unable to get argument ^d.", arg_idx);
	     return;
	  end;

         if index (targ, "-") = 1
         then if targ = "-modes"
	    then if mode_string = ""
	         then
		  do;
		     arg_idx = arg_idx + 1;
		     call cu_$arg_ptr (arg_idx, tp, tc, code);
		     if code ^= 0
		     then
		        do;
			 call com_err_ (code, MYNAME, "^/No mode string followed the -modes control argument.");
			 return;
		        end;
		     mode_string = targ;
		  end;
	         else
		  do;
		     call com_err_ (error_table_$badopt, MYNAME, "^/Only one mode string may be given.");
		     return;
		  end;
	    else if targ = "-pn" | targ = "-pathname" | targ = "-tc" | targ = "-truncate"
	    then ad = ad || targ || " ";
	    else
	       do;
		call com_err_ (error_table_$badopt, MYNAME, "^/^a is not a known control argument.", targ);
		return;
	       end;
         else if arg_idx = 1
         then
	  do;
	     old_switch = targ;
	     call iox_$look_iocb (old_switch, old_iocb, code);
	     if code ^= 0
	     then
	        do;
		 call com_err_ (code, MYNAME, "^/Unable to find the switch named ^a.", old_switch);
		 return;
	        end;
	     have_old_iocb = "1"b;
	  end;
         else if arg_idx ^= 2
         then ad = ad || targ || " ";
         else if have_old_iocb
         then
	  do;
	     new_switch = targ;
	     call iox_$find_iocb (new_switch, new_iocb, code);
	     if code ^= 0
	     then
	        do;
		 call com_err_ (code, MYNAME, "^/Unable to find or create the new switch named ^a.", new_switch);
		 return;
	        end;
	     have_new_iocb = "1"b;
	  end;
         else ad = ad || targ || " ";
      end;

      if ^have_new_iocb
      then
         do;
	  call date_time_ (clock, time);
	  new_switch = "audit_i/o." || substr (time, 11, 6);
	  call iox_$find_iocb (new_switch, new_iocb, code);
	  if code ^= 0
	  then
	     do;
	        call
		 com_err_ (code, MYNAME, "^/Unable to find or create the new switch with default switchname ^a.",
		 new_switch);
	        return;
	     end;
         end;

      if ^have_old_iocb
      then
         do;
	  old_switch = "user_i/o";
	  call iox_$look_iocb (old_switch, old_iocb, code);
	  if code ^= 0
	  then
	     do;
	        call com_err_ (code, MYNAME, "^/Unable to find the switch to be audited ^a.", old_switch);
	        return;
	     end;
         end;

      ad = "audit_ " || rtrim (new_switch) || " " || ad;

      call iox_$move_attach (old_iocb, new_iocb, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, MYNAME, "^/Unable to move attachment from ^a to ^a", old_switch, new_switch);
	  return;
         end;

      call iox_$attach_ptr (old_iocb, (ad), codeptr (attach_audit), code);
      if code ^= 0
      then
         do;
	  call iox_$detach_iocb (old_iocb, code1);
	  call iox_$move_attach (new_iocb, old_iocb, code1);
	  call
	     com_err_ (code, MYNAME, "^/Unable to attach audit_ to switch ^a, using the attach description ""^a"".",
	     old_switch, ad);
	  return;
         end;
      call iox_$modes (old_iocb, (mode_string), old_modes, code);
      return;

/*  Include  */

%include iox_dcls;
   end;




		    audit_.pl1                      05/10/89  0953.5rew 05/10/89  0948.4      522621



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(89-04-06,Vu), approve(89-04-06,MCR8095), audit(89-04-25,Lee),
     install(89-05-10,MR12.3-1040):
     - output modes are returned even if the input modes string contains only
       audit modes (ie. audit_input).
     - The following builtin functions: after, before, empty, max, rtrim are
       now declared explicitly.
                                                   END HISTORY COMMENTS */


/* format: style2,ind3 */
audit_:
audit_attach:
   proc (p_iocb_ptr, p_option_array, p_com_err_sw, p_code);


/* This program is the main driver for the "audit" module. It has entries
   for attachment (which also opens), for reading, writing, and detachment (which also precedes
   it with a close). The following I/O system calls are provided for this module:

   attach (open)	audit_$audit_attach
   close		audit_$audit_close
   detach		audit_$audit_detach
   get_chars	audit_$audit_get_chars
   get_line	audit_$audit_get_line
   put_chars	audit_$audit_put_chars
   control	audit_$audit_control
   modes		audit_$audit_modes

   Last Modified:

   12/01/78  Written by Lindsey L. Spratt  (from existing code by J. Stern, S. Webber, and R. Bratt)
   11/26/79  by  Lindsey L. Spratt  to support prompting in the editor.
   05/20/80  by  Lindsey L. Spratt  to fix -tc option and assume "audit" suffix.
   12/22/80  by  Lindsey L. Spratt: Change all mode string references from 256
	       char string to 512.
03/20/81  by  Lindsey L. Spratt:  remove "audit_editor_prompt_terminator="
	    mode.  Set default editor_prompt_string to 
	    "audit editor^[(^d)^]:^2x".
08/05/81 by Lindsey Spratt: Changed modes entry to use the mode_string_$parse
	  and mode_string_$delete entries to manipulate the mode strings.
	  Changed all calls to iox entries to be calls instead of function
	  references.  Changed from using the iocbx.incl.pl1 file to
	  iocb.incl.pl1.  Changed entry sequences to be calls instead of
	  functions, i.e. the returns (fixed bin(35)) was replaced by
	  including "p_code" in the entry parameters.
10/29/81 by Lindsey Spratt: Fixed conversion of ll= and pl= to only be
	  invoked if the respective strings are actually present to be
	  converted.  Also, added rtrimming of the unrecognized_modes string
	  in the calls of the before and after builtins.
	       Added initialization of the blk pointers
	  audit_file_header_ptr, temp_seg_ptr, work_area, audit_fcb,
	  begin_ptr, and audit_ptr.  Added checks for null pointers and
	  non-zero error codes to the detach entry.
11/12/81 by Lindsey Spratt:  Changed to call hcs_$assign_linkage as a
	  subroutine  instead of a function.
06/01/82 by Lindsey Spratt:  Was not honoring the maximum length of the audit
	  file when "adjusting" during the audit_detach operation, the
	  current_component and (audit_index - 1) were being used instead of
	  the max_component and max_index (set by the audit_file_size mode).
	  The audit_detach entry now checks the audit_file_header.filled
	  flag to determine if it should use the max component and index
	  (file_limit = "1"b) or the current_component and audit_index (file_limit =
	  "0"b).
06/03/82 by Lindsey Spratt:  Changed the setting of the bit count in 
            audit_detach to be the value of audit_index*9, instead of
            audit_index*9-9.
06/08/82 by Lindsey Spratt:  Removed the code which always set
	  audit_file_header.max_index to sys_info$max_seg_size*4 whenever
	  attaching to an audit file.  The max_index and max_componenet
	  values of the audit_file_header are now only set when initializing
	  an empty audit file and when setting the audit_file_size mode.
	  This makes max_index a reliable indicator of whether the "current"
	  audit file is supposed to be circular or not.  The setting of the
	  file_limit flag in blk.current_flags in audit_attach relies on
	  this fact.
06/09/82 by Lindsey Spratt: Added an any_other handler to audit_detach.
	  Changed detach logic to not use the bit-count-setting feature of
	  msf_manager_$adjust when adjusting the audit file, instead an
	  explicit set_bc_seg is done (when appropriate) to the final
	  component of the audit file.  All preceding components will have
	  had their bit counts correctly set by the "next_component"
	  operation of insert_line.
10/13/82 by Lindsey Spratt:  Moved setting of safety_sw off into the
	  audit_close entry.  This makes it possible for the standard
	  process epilogue handler to cause audit files to have their safety
	  switches turned off.  Previously, this was done in the
	  audit_detach entry, which does not get invoked during process
	  termination.
02/10/83 by Lindsey Spratt:  Fixed audit_line to set
	  audit_file_header.max_component to be the highest used component
	  number in the non-file_limit (non-circular file) case.
	  display_audit_file/audit_file_position_ relies on the
	  max_component to know where the audit file ends (in some
	  circumstances).  Fixed insert_line to set
	  audit_file_header.max_index to equal audit_file_header.audit_index
	  when working with a non-file_limit audit file.
03/02/83 by Lindsey Spratt:  More fixes to make all portions of code respect
	  the protocol that for "unlimited" (or non-circular) files
	  afh.max_index always equals afh.audit_index and afh.max_component
	  always equals afh.current_component.  For circular files,
	  afh.max_index is > afh.audit_index when afh.max_component =
	  afh.current_component, and afh.max_component is always >=
	  afh.current_component.  Also, fixed audit_suspend mode to have no
	  effect when audit is already suspended.
   */

/* Parameters */

      dcl	    (p_newmodes, p_oldmodes)
			       char (*);
      dcl	    p_real_order	       char (*);
      dcl	    p_code	       fixed bin (35);
      dcl	    (p_iocb_ptr, buff_ptr, p_info_ptr)
			       ptr;
      dcl	    (actual_len, buff_len) fixed bin (21);
      dcl	    p_option_array	       (*) char (*) var;
      dcl	    p_com_err_sw	       bit (1) aligned;
      dcl	    ptype		       fixed bin;
      dcl	    n		       fixed bin (21);
      dcl	    p_buff_ptr	       ptr;
      dcl	    (p_buff_len, p_actual_len)
			       fixed bin (21);

/* Entries */

      dcl	    cpu_time_and_paging_   entry (fixed bin, fixed bin (71), fixed bin);
      dcl	    get_temp_segment_      entry (char (*), ptr, fixed bin (35));
      dcl	    release_temp_segment_  entry (char (*), ptr, fixed bin (35));
      dcl	    decode_clock_value_    entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin (71), fixed bin,
			       char (3) aligned);
      dcl	    audit_editor	       entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (35));
      dcl	    audit_editor$set_last_return_line_position
			       entry (ptr);
      dcl	    audit_file_position_$last
			       entry (ptr, ptr, fixed bin (35));
      dcl	    com_err_	       entry options (variable);
      dcl	    sub_err_	       entry options (variable);
      dcl	    expand_pathname_$add_suffix
			       entry (char (*), char (*), char (*), char (*), fixed bin (35));
      dcl	    ioa_$ioa_switch	       entry options (variable);
      dcl	    ioa_$ioa_switch_nnl    entry options (variable);
      dcl	    date_time_	       entry (fixed bin (71), char (*));
      dcl	    user_info_$homedir     entry (char (*));
      dcl	    hcs_$set_bc_seg	       entry (ptr, fixed bin (24), fixed bin (35));
      dcl	    hcs_$set_safety_sw_seg entry (ptr, bit (1), fixed bin (35));
      dcl	    hcs_$status_mins       entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
      dcl	    hcs_$set_ips_mask      entry (fixed bin, fixed bin);
      dcl	    hcs_$assign_linkage    entry (fixed bin, ptr, fixed bin (35));
      dcl	    abbrev_$expanded_line  entry (ptr, fixed bin, ptr, fixed bin, ptr, fixed bin);
      dcl	    msf_manager_$open      entry (char (*), char (*), ptr, fixed bin (35));
      dcl	    msf_manager_$get_ptr   entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
      dcl	    msf_manager_$adjust    entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35));
      dcl	    msf_manager_$close     entry (ptr);

      dcl	    mode_string_$parse     entry (char (*), ptr, ptr, fixed bin (35));
      dcl	    mode_string_$delete    entry (ptr, (*) char (*), char (*), fixed bin (35));
      dcl	    mode_string_$combine   entry (ptr, ptr, char (*), fixed bin (35));

/* Constants */

      dcl	    any_other	       condition;

/* Static Variables */

      dcl	    SUFFIX	       char (32) varying init ("audit") internal static options (constant);
      dcl	    sio_open_desc	       char (20) varying init ("stream_input_output") static options (constant);
      dcl	    myname	       char (6) static options (constant) init ("audit_");
      dcl	    NL		       char (1) aligned static options (constant) init ("
");
      dcl	    AUDIT_MODE_NAMES       (12) char (32)
			       init ("audit_suspend", "audit_input", "audit_output", "audit_edit", "audit_trace",
			       "audit_use_editor_prompt", "audit_editor_prompt_string", "audit_epstr",
			       "audit_file_size", "audit_meter", "audit_transparent", "audit_trigger")
			       internal static options (constant);

/* Based */

      dcl	    mode_str	       char (512) varying based;
      dcl	    aut_input_string       char (actual_len) based (buff_ptr);
      dcl	    param_output_string    char (p_buff_len) based (p_buff_ptr);
      dcl	    param_input_string     char (p_actual_len) based (p_buff_ptr);

/* Automatic Variables */

      dcl	    out_ptr	       ptr;
      dcl	    type		       fixed bin (2);
      dcl	    bit_count24	       fixed bin (24);
      dcl	    mode_idx	       fixed bin (17);
      dcl	    records	       fixed bin;
      dcl	    newmodes	       char (64) varying;
      dcl	    unrecognized_modes     char (512);
      dcl	    order		       char (32);
      dcl	    (audited_iocb, blkptr, auditing_iocb)
			       ptr;
      dcl	    device	       char (32);
      dcl	    i		       fixed bin;
      dcl	    (tc, mask)	       fixed bin;
      dcl	    ename		       char (32);
      dcl	    time		       char (8);
      dcl	    dirname	       char (168);
      dcl	    tactual_len	       fixed bin (21);
      dcl	    extend	       bit (1);
      dcl	    request	       char (1);
      dcl	    set_last_return_line_position
			       bit (1) init ("0"b);
      dcl	    ab_buf	       char (512);
      dcl	    ab_len	       fixed bin;
      dcl	    temp_area	       area (2048);

/* External Variables */

      dcl	    sys_info$max_seg_size  fixed bin (24) ext;
      dcl	    error_table_$bad_mode_value
			       fixed bin (35) ext;
      dcl	    error_table_$bad_mode_syntax
			       fixed bin (35) ext;
      dcl	    error_table_$long_record
			       fixed bin (35) ext;
      dcl	    error_table_$empty_file
			       fixed bin (35) ext;
      dcl	    error_table_$noarg     fixed bin (35) ext;
      dcl	    error_table_$unimplemented_version
			       fixed bin (35) ext;
      dcl	    error_table_$not_detached
			       fixed bin (35) ext;
      dcl	    error_table_$noentry   fixed bin (35) ext;
      dcl	    error_table_$bad_arg   fixed bin (35) ext;

/* Builtins */

      dcl	    string	       builtin;
      dcl	    currentsize	       builtin;
      dcl	    clock		       builtin;
      dcl	    mod		       builtin;
      dcl	    (substr, addr, null, divide, hbound, index, length, size)
			       builtin;
      dcl     (after, before, empty, max, rtrim)
                                     builtin;


/*  */

/* attach --- subroutine to attach and open the audit module */



/* Look at option array and collect data */

      ename = "";
      audited_iocb = p_iocb_ptr;
      extend = "1"b;
      if hbound (p_option_array, 1) < 1
      then
         do;
	  if p_com_err_sw
	  then call com_err_ (error_table_$bad_arg, (myname), "No device name given.");
	  p_code = error_table_$bad_arg;
	  return;
         end;
      device = p_option_array (1);			/* device name must be first option */
      call iox_$find_iocb (device, auditing_iocb, p_code);
      if p_code ^= 0
      then
         do;
	  if p_com_err_sw
	  then call com_err_ (p_code, (myname), "^a", device);
	  return;
         end;
      do i = 2 to hbound (p_option_array, 1);		/* now search the options */
         if p_option_array (i) = "-tc" | p_option_array (i) = "-truncate"
         then extend = "0"b;
         else if p_option_array (i) = "-pn" | p_option_array (i) = "-pathname"
         then
	  do;
	     i = i + 1;
	     if i > hbound (p_option_array, 1)
	     then
	        do;
		 if p_com_err_sw
		 then call
		         com_err_ (error_table_$noarg, (myname),
		         "^/A pathname must be given with the the -pathname control argument.");
		 p_code = error_table_$noarg;
		 return;
	        end;
	     call expand_pathname_$add_suffix ((p_option_array (i)), (SUFFIX), dirname, ename, p_code);
	     if p_code ^= 0
	     then
	        do;
		 if p_com_err_sw
		 then call com_err_ (p_code, (myname), "^a", p_option_array (i));
		 return;
	        end;
	  end;
         else
	  do;
	     if p_com_err_sw
	     then call com_err_ (error_table_$bad_arg, (myname), "^/Unsupported option ^a.", p_option_array (i));
	     p_code = error_table_$bad_arg;
	     return;
	  end;
      end;
      if ename = ""
      then
         do;
	  call date_time_ (clock, time);		/* get time for default file name */
	  ename = time || ".audit";
	  call user_info_$homedir (dirname);		/* get default dirname */
         end;
      call hcs_$set_ips_mask (0, mask);			/* enter critical code */
      if audited_iocb -> iocb.attach_descrip_ptr ^= null ()
      then
         do;
	  call hcs_$set_ips_mask (mask, 0);
	  if p_com_err_sw
	  then call com_err_ (error_table_$not_detached, (myname));
	  p_code = error_table_$not_detached;
	  return;
         end;
      call hcs_$assign_linkage (size (blk), blkptr, p_code);
      if blkptr = null ()
      then
         do;					/* can't get storage for data */
	  call hcs_$set_ips_mask (mask, 0);
	  if p_com_err_sw
	  then call com_err_ (p_code, (myname));
	  return;
         end;
      audited_iocb -> iocb.attach_descrip_ptr = addr (blk.attach);
      audited_iocb -> iocb.attach_data_ptr = blkptr;
      audited_iocb -> iocb.detach_iocb = audit_detach;
      audited_iocb -> iocb.open = iox_$err_no_operation;
      audited_iocb -> iocb.close = audit_close;		/* Now fill in some stuff in the block */
      tc = index (device, " ");
      if tc = 0
      then tc = length (device);
      blk.attach = "audit_ " || substr (device, 1, tc);
      do i = 2 to hbound (p_option_array, 1);
         blk.attach = blk.attach || " ";
         blk.attach = blk.attach || p_option_array (i);
      end;
      blk.auditing_iocb = auditing_iocb;		/* fill in target iocb pointer */
      blk.default_iocb = audited_iocb;


/* Now the code to open the stream as well */

      blk.dirname = dirname;
      blk.ename = ename;
      blk.audit_file_header_ptr = null;
      blk.audit_fcb = null;
      blk.audit_ptr = null;
      blk.begin_ptr = null;
      blk.temp_seg_ptr = null;
      blk.work_space = null;
      audited_iocb -> iocb.get_line = audit_get_line;
      audited_iocb -> iocb.control = audit_control;
      audited_iocb -> iocb.put_chars = audit_put_chars;
      audited_iocb -> iocb.get_chars = audit_get_chars;
      audited_iocb -> iocb.open_descrip_ptr = addr (sio_open_desc);
      audited_iocb -> iocb.open_data_ptr = blkptr;
      audited_iocb -> iocb.modes = audit_modes;
      audited_iocb -> iocb.position = audit_position;

      call msf_manager_$open (blk.dirname, blk.ename, blk.audit_fcb, p_code);
      if p_code ^= 0
      then if p_code = error_table_$noentry
	 then
	    do;
	       call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
	       if p_code ^= 0
	       then
		do;
		   call hcs_$set_ips_mask (mask, 0);
		   if p_com_err_sw
		   then call
			 com_err_ (p_code, (myname),
			 "While attempting to get a pointer to component 0 of the audit file.");
		   return;
		end;
INIT_AUDIT_FILE:
	       audit_file_header_ptr = blk.audit_ptr;
	       blk.audit_file_header_ptr = blk.audit_ptr;
	       audit_file_header.last_entry_length = impossible_audit_entry_length;
	       audit_file_header.filled = "0"b;
	       audit_file_header.current_component = 0;
	       audit_file_header.unused1 = "0"b;
	       audit_file_header.pad2 = 0;
	       audit_file_header.begin_component = 0;
	       audit_file_header.begin_index =
		(4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
	       blk.begin_ptr = blk.audit_ptr;
	       audit_file_header.version = audit_file_header_version_1;
	       audit_file_header.last_entry_length = -1;
	       call truncate_audit_file;
	       audit_file_header.max_component = audit_file_header.current_component;
	       audit_file_header.max_index = audit_file_header.audit_index;
	    end;
	 else
	    do;
	       call hcs_$set_ips_mask (mask, 0);
	       if p_com_err_sw
	       then call
		     com_err_ (p_code, (myname), "While attempting to open audit file ^a^[>^]^a .", blk.dirname,
		     blk.dirname ^= ">", blk.ename);
	       return;
	    end;
      else if extend
      then
         do;
	  call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, audit_file_header_ptr, bit_count24, p_code);
	  if p_code ^= 0
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call com_err_ (p_code, (myname), "While attempting to get pointer to component 0 of audit file.");
	        return;
	     end;
	  if audit_file_header.version = 0
	  then
	     do;
	        blk.audit_ptr = audit_file_header_ptr;
	        go to INIT_AUDIT_FILE;
	     end;
	  else if audit_file_header.version ^= audit_file_header_version_1
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call com_err_ (p_code, (myname));
	        p_code = error_table_$unimplemented_version;
	        return;
	     end;
	  call
	     msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.current_component, "1"b, blk.audit_ptr, bit_count24,
	     p_code);
	  if p_code ^= 0
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call com_err_ (p_code, (myname), "While attempting to get pointer to audit file.");
	        return;
	     end;
	  call
	     msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.begin_component, "1"b, blk.begin_ptr, bit_count24,
	     p_code);
	  if p_code ^= 0
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call
		      com_err_ (p_code, (myname), "While attempting to get pointer  to component ^d of audit file.",
		      audit_file_header.begin_component);
	        return;
	     end;
	  blk.current_flags.file_limit =
	     audit_file_header.max_index > audit_file_header.audit_index
	     | audit_file_header.max_component > audit_file_header.current_component;
         end;
      else
         do;
	  call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
	  if p_code ^= 0
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call
		      com_err_ (p_code, (myname), "While attempting to get pointer to component ^d of audit file.",
		      audit_file_header.current_component);
	        return;
	     end;
	  audit_file_header_ptr = blk.audit_ptr;
	  blk.audit_file_header_ptr = blk.audit_ptr;
	  audit_file_header.current_component = 0;
	  call
	     msf_manager_$adjust (blk.audit_fcb, 0,
	     ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b, p_code);
	  if p_code ^= 0
	  then
	     do;
	        call hcs_$set_ips_mask (mask, 0);
	        if p_com_err_sw
	        then call com_err_ (p_code, (myname), "While attempting to adjust audit file.");
	        return;
	     end;
	  call truncate_audit_file;
	  audit_file_header.begin_index = audit_file_header.audit_index;
	  audit_file_header.begin_component = 0;
	  audit_file_header.max_component = audit_file_header.current_component;
	  audit_file_header.max_index = audit_file_header.audit_index;
	  audit_file_header.filled = "0"b;
	  blk.begin_ptr = blk.audit_ptr;
         end;
      blk.audit_file_header_ptr = audit_file_header_ptr;
      blk.current_flags.read_audit = "1"b;
      blk.current_flags.write_audit = "1"b;
      blk.trigger = "!";
      blk.current_flags.edit = "1"b;
      blk.current_flags.use_editor_prompt = "1"b;
      blk.editor_prompt_string = "audit editor^[(^d)^]:^2x";

      blk.work_space = null;
      blk.work_space_len = 0;

      call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "1"b, p_code);
						/* The audit_file_header_ptr always points at component 0 of the audit file, the safety switch on comp 0 is on when audit is attached and off when audit isn't attached. */

      call get_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code);
      if p_code ^= 0
      then
         do;
	  call hcs_$set_ips_mask (mask, 0);
	  if p_com_err_sw
	  then call com_err_ (p_code, (myname), "While attempting to get temp seg.");
	  return;
         end;					/* Now propagate through all appropriate IOCB's */
      call iox_$propagate (audited_iocb);
      call hcs_$set_ips_mask (mask, 0);
      p_code = 0;
      return;


audit_detach:
   entry (p_iocb_ptr, p_code);
      p_code = 0;
      call hcs_$set_ips_mask (0, mask);
      blkptr = p_iocb_ptr -> iocb.attach_data_ptr;
      p_iocb_ptr -> iocb.open_descrip_ptr = null ();
      p_iocb_ptr -> iocb.open_data_ptr = null ();
      p_iocb_ptr -> iocb.attach_descrip_ptr, p_iocb_ptr -> iocb.attach_data_ptr = null ();
      p_iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached;
      p_iocb_ptr -> iocb.open = iox_$err_not_attached;
      call iox_$propagate (p_iocb_ptr);

      on any_other
         begin;
	  call force_audit_suspension;
	  goto RETURN;
         end;

      if blkptr = null
      then return;
      else if blk.audit_file_header_ptr ^= null
      then
         do;
	  audit_file_header_ptr = blk.audit_file_header_ptr;
	  if ^(blk.current_flags.file_limit
	     & (audit_file_header.begin_component > audit_file_header.current_component
	     | (audit_file_header.begin_component = audit_file_header.current_component
	     & audit_file_header.begin_index >= audit_file_header.audit_index)))
	  then
	     do;
	        call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code);
	        if p_code ^= 0
	        then goto RETURN;

/* Can't use the bit count setting feature of msf_manager_$adjust because it 
will attempt to set the bit counts of the preceding components to max_length,
which is not the correct value.  In any event, their bit counts have already 
been set. */

	        call
		 msf_manager_$adjust (blk.audit_fcb, audit_file_header.current_component,
		 9 * audit_file_header.audit_index, "011"b, p_code);
	        if p_code ^= 0
	        then goto RETURN;
	     end;
         end;
      if blk.temp_seg_ptr ^= null
      then
         do;
	  call release_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code);
	  if p_code ^= 0
	  then goto RETURN;
         end;

      if blk.audit_fcb ^= null
      then call msf_manager_$close (blk.audit_fcb);
RETURN:
      revert any_other;
      call hcs_$set_ips_mask (mask, 0);
      return;

audit_close:
   entry (p_iocb_ptr, p_code);

      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = p_iocb_ptr -> iocb.attach_data_ptr;
      if blk.audit_file_header_ptr ^= null
      then call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "0"b, p_code);
						/* The audit_file_header_ptr always points to the base of component 0 in the audit file. The safety switch on component 0 is on when audit is attached and off when it isn't.*/
      call hcs_$set_ips_mask (0, mask);
      audited_iocb -> iocb.open_descrip_ptr = null ();
      audited_iocb -> iocb.detach_iocb = audit_detach;
      call iox_$propagate (audited_iocb);
      call hcs_$set_ips_mask (mask, 0);
      p_code = 0;
      return;

/*  */

/* The following are dummy entries that pass on the given request */

audit_get_chars:
   entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code);
      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      auditing_iocb = blk.auditing_iocb;
      call iox_$get_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code);
      if p_code ^= 0
      then return;
      if blk.current_flags.read_audit
      then call audit_line ("IC", param_input_string);
      p_code = 0;
      return;

audit_modes:
   entry (p_iocb_ptr, p_newmodes, p_oldmodes, p_code);
      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      auditing_iocb = blk.auditing_iocb;
      audit_file_header_ptr = blk.audit_file_header_ptr;
      if blk.current_flags.trace
      then call audit_line ("TM", rtrim (p_newmodes) || NL);
      unrecognized_modes = "";
      if length (rtrim (p_newmodes)) = 0
      then
         do;
	  call iox_$modes (blk.auditing_iocb, p_newmodes, p_oldmodes, p_code);
	  return;
         end;

      call mode_string_$parse (p_newmodes, addr (temp_area), mode_string_info_ptr, p_code);
      if p_code ^= 0
      then return;

      if mode_string_info.version ^= mode_string_info_version_2
      then call
	    sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0,
	    "^/Unable to use the mode_string_info structure.  Expecting version ^d, 
received version ^d.", mode_string_info_version_2, mode_string_info.version);
      if mode_string_info.number > 0
      then if mode_string_info.modes (1).version ^= mode_value_version_3
	 then call
	         sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0,
	         "^/Unable to use the mode_value structure. Expecting version ^d, 
received version ^d.", mode_value_version_3, mode_string_info.modes (1).version);

MODE_LOOP:
      do mode_idx = 1 to mode_string_info.number;
         newmodes = mode_string_info.modes (mode_idx).mode_name;
         if index (newmodes, "audit_") = 1
         then if newmodes = "audit_suspend"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else if mode_string_info.modes (mode_idx).boolean_value
	         then
		  do;
		     if ^blk.suspend
		     then call suspend_auditing ("", null);
		  end;
	         else
		  do;
		     string (blk.current_flags) = string (blk.saved_flags);
		     blk.suspend = "0"b;
		  end;

	    else if blk.suspend
	    then call
		  ioa_$ioa_switch (auditing_iocb,
		  "audit_: auditing suspended, no audit_ modes operations allowed except ^^audit_suspend");
	    else if newmodes = "audit_input"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.read_audit = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_transparent"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else if mode_string_info.modes (mode_idx).flags.boolean_value
	         then blk.default_iocb = auditing_iocb;
	         else blk.default_iocb = audited_iocb;

	    else if newmodes = "audit_file_size"
	    then if mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else if mode_string_info.modes (mode_idx).flags.char_valuep
	         then if mode_string_info.modes (mode_idx).char_value = "unlimited"
		    then
		       do;
			blk.begin_ptr = audit_file_header_ptr;
			audit_file_header.begin_component = 0;
			audit_file_header.begin_index =
			   size (audit_file_header) * 4 + 7 - mod (size (audit_file_header) * 4 + 7, 8);
			audit_file_header.max_index = audit_file_header.audit_index;
			audit_file_header.max_component = audit_file_header.current_component;
			audit_file_header.filled = "0"b;
			blk.current_flags.file_limit = "0"b;
		       end;
		    else
		       do;
			p_code = error_table_$bad_mode_value;
			return;
		       end;

	         else
		  do;
		     records = mode_string_info.modes (mode_idx).numeric_value;
		     if records <= 0
		     then
		        do;
			 p_code = error_table_$bad_mode_value;
			 return;
		        end;
		     audit_file_header.max_component = divide (records, 256, 17, 0);
		     audit_file_header.max_index = 4096 * (records - audit_file_header.max_component * 256);
		     blk.current_flags.file_limit = "1"b;
		  end;

	    else if newmodes = "audit_output"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.write_audit = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_edit"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.edit = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_trace"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.trace = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_meter"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.meter = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_trigger"
	    then if ^mode_string_info.modes (mode_idx).flags.char_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.trigger = mode_string_info.modes (mode_idx).char_value;
	    else if newmodes = "audit_use_editor_prompt"
	    then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.current_flags.use_editor_prompt = mode_string_info.modes (mode_idx).flags.boolean_value;
	    else if newmodes = "audit_editor_prompt_string" | newmodes = "audit_epstr"
	    then if ^mode_string_info.modes (mode_idx).flags.char_valuep
	         then
		  do;
		     p_code = error_table_$bad_mode_syntax;
		     return;
		  end;
	         else blk.editor_prompt_string = mode_string_info.modes (mode_idx).char_value;
      end MODE_LOOP;
      call mode_string_$delete (mode_string_info_ptr, AUDIT_MODE_NAMES, unrecognized_modes, p_code);
      if unrecognized_modes ^= "" & unrecognized_modes ^= "."
      then
         do;

	  /*** It is necessary to convert ll=NN and pl=NN, which mode_string_ produces, 
into llNN and plNN, which is the only form the tty_ dim currently understands.
Hopefully, any other io module under audit_ which gets ll=  and pl= modes will
also understand the other forms.
*/
	  if index (unrecognized_modes, "ll=") > 0
	  then unrecognized_modes =
		before (rtrim (unrecognized_modes), "ll=") || "ll" || after (rtrim (unrecognized_modes), "ll=");
	  if index (unrecognized_modes, "pl=") > 0
	  then unrecognized_modes =
		before (rtrim (unrecognized_modes), "pl=") || "pl" || after (rtrim (unrecognized_modes), "pl=");

	  call iox_$modes (blk.auditing_iocb, (unrecognized_modes), p_oldmodes, p_code);
         end;

/**** vp: tr phx19369 , display old modes when input modes are only audit modes ****/

         else call iox_$modes (blk.auditing_iocb, "", p_oldmodes, p_code);

      return;



audit_get_line:
   entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code);
      dcl	    file_char_array	       (0:sys_info$max_seg_size * 4) char (1) based (buff_ptr);
      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      auditing_iocb = blk.auditing_iocb;
      buff_ptr = p_buff_ptr;
      buff_len = p_buff_len;
GET_LINE:
      if blk.work_space ^= null
      then
         do;					/* set up input_string on temp_seg. */
	  buff_ptr = blk.work_space;
	  actual_len = blk.work_space_len;
	  buff_len = sys_info$max_seg_size * 4;		/* if input_string bigger than p_string, fill p_string and return long_record */
						/* if input_string smaller than p_string, fill p_string and return. */
	  if actual_len > p_buff_len
	  then
	     do;
	        p_actual_len = p_buff_len;
	        param_input_string = substr (aut_input_string, 1, p_buff_len);
	        blk.work_space = addr (file_char_array (p_buff_len));
	        blk.work_space_len = actual_len - p_buff_len;
	        p_code = error_table_$long_record;
	        return;
	     end;
	  else
	     do;
	        p_actual_len = actual_len;
	        param_input_string = aut_input_string;
	        blk.work_space = null;
	        blk.work_space_len = 0;
	        p_code = 0;
	        return;
	     end;
         end;

      else
         do;
	  call iox_$get_line (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code);
	  if p_code ^= 0
	  then if p_code = error_table_$long_record
	       then
		do;
		   blk.work_space = blk.temp_seg_ptr;
		   blk.work_space_len = sys_info$max_seg_size * 4;
		   buff_len = blk.work_space_len;
		   buff_ptr = blk.work_space;
		   actual_len = p_buff_len;
		   substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, p_actual_len);
		   buff_ptr = addr (file_char_array (actual_len));
		   buff_len = buff_len - actual_len;
		   call iox_$get_line (auditing_iocb, buff_ptr, buff_len, actual_len, p_code);
		   if p_code ^= 0
		   then return;
		   buff_ptr = blk.temp_seg_ptr;
		   actual_len = actual_len + p_actual_len;
		   buff_len = blk.work_space_len;
		   blk.work_space_len = actual_len;
		end;
	       else return;

	  else actual_len = p_actual_len;
MORE_GET_LINE:
	  if ^(blk.current_flags.edit & (actual_len > 2))
	  then
	     do;
	        if blk.current_flags.read_audit
	        then call audit_line ("IL", aut_input_string);
	     end;
	  else if (substr (aut_input_string, actual_len - 2, 1) = blk.trigger)
	  then
	     do;
	        request = substr (aut_input_string, actual_len - 1, 1);
	        if request = "."
	        then
		 do;
		    if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
		    then call audit_line ("IL", aut_input_string);
		    call
		       ioa_$ioa_switch (blk.default_iocb, "audit ^[input^]^[/^]^[output^]",
		       blk.current_flags.read_audit, blk.current_flags.read_audit & blk.current_flags.write_audit,
		       blk.current_flags.write_audit);
		    substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
		    actual_len = actual_len - 2;
		 end;
	        else if request = "?"
	        then
		 do;
		    if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
		    then call audit_line ("IL", aut_input_string);
		    call ioa_$ioa_switch (blk.default_iocb, "REQUESTS:");
		    call ioa_$ioa_switch (blk.default_iocb, "^a. -> who am I", blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^a? -> what can I do", blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^ae -> enter editor", blk.trigger);
		    call
		       ioa_$ioa_switch (blk.default_iocb, "^aE -> enter editor, process input line as edit requests",
		       blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^aa -> abbrev expand input line", blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^ar -> replay input line", blk.trigger);
		    call
		       ioa_$ioa_switch (blk.default_iocb, "^at -> transparent input line (do not log)", blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^ad -> delete line", blk.trigger);
		    call ioa_$ioa_switch (blk.default_iocb, "^an -> no operation", blk.trigger);
		    call
		       ioa_$ioa_switch (blk.default_iocb, "NOTE:  above requests recognized only in audit_edit mode");
		    substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
		    actual_len = actual_len - 2;
		 end;
	        else if request = "r"
	        then
		 do;
		    call ioa_$ioa_switch_nnl (blk.default_iocb, "^a", substr (aut_input_string, 1, actual_len - 3));
		    call
		       iox_$get_line (auditing_iocb, addr (file_char_array (actual_len - 3)),
		       buff_len - actual_len + 3, tactual_len, p_code);
		    if p_code ^= 0
		    then if p_code ^= error_table_$long_record
		         then return;
		         else if blk.work_space ^= null
		         then return;
		         else
			  do;
			     blk.work_space = blk.temp_seg_ptr;
			     blk.work_space_len = sys_info$max_seg_size * 4;
			     buff_ptr = blk.temp_seg_ptr;
			     buff_len = blk.work_space_len;
			     actual_len = tactual_len + actual_len - 3;
			     substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, actual_len);

			     buff_ptr = addr (file_char_array (actual_len));
			     buff_len = buff_len - actual_len;
			     call iox_$get_line (default_iocb, buff_ptr, buff_len, tactual_len, p_code);
			     if p_code ^= 0
			     then return;
			     buff_ptr = blk.temp_seg_ptr;
			     buff_len = blk.work_space_len;
			     actual_len = actual_len + tactual_len;
			     blk.work_space_len = actual_len;
			  end;
		    else actual_len = actual_len + tactual_len - 3;
		    goto MORE_GET_LINE;
		 end;
	        else if request = "e" | request = "E"
	        then
		 do;
		    if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
		    then call audit_line ("IL", aut_input_string);
		    blk.work_space = null;
		    call audit_editor (buff_ptr, buff_len, actual_len, audited_iocb, p_code);
		    if p_code ^= 0
		    then if p_code = error_table_$empty_file
		         then call ioa_$ioa_switch (blk.default_iocb, "audit_: Can't edit, the audit file is empty.");
		         else call ioa_$ioa_switch (blk.default_iocb, "audit_: Error attempting to use editor.");
		    else
		       do;
			set_last_return_line_position = "1"b;
			if blk.current_flags.read_audit
			then call audit_line ("EL", aut_input_string);
		       end;
		 end;
	        else if request = "a"
	        then
		 do;
		    if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
		    then call audit_line ("IL", aut_input_string);
		    substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
		    actual_len = actual_len - 2;
		    call abbrev_$expanded_line (buff_ptr, (actual_len), addr (ab_buf), 512, out_ptr, ab_len);
		    if ab_len > 512
		    then if ab_len > buff_len
		         then
			  do;
			     buff_ptr = blk.temp_seg_ptr;
			     buff_len = ab_len;
			     actual_len = ab_len;
			     buff_ptr -> aut_input_string = out_ptr -> aut_input_string;
			     free out_ptr -> aut_input_string;
			  end;
		         else
			  do;
			     buff_len = ab_len;
			     actual_len = ab_len;
			     buff_ptr -> aut_input_string = out_ptr -> aut_input_string;
			     free out_ptr -> aut_input_string;
			  end;
		    else if ab_len > buff_len
		    then
		       do;
			buff_ptr = blk.temp_seg_ptr;
			buff_len = ab_len;
			actual_len = ab_len;
			aut_input_string = substr (ab_buf, 1, ab_len);
		       end;
		    else
		       do;
			actual_len = ab_len;
			substr (aut_input_string, 1, ab_len) = substr (ab_buf, 1, ab_len);
		       end;
		 end;
	        else if request = "d"
	        then
		 do;
		    blk.work_space = null;
		    blk.work_space_len = 0;
		    buff_ptr = p_buff_ptr;
		    buff_len = p_buff_len;
		    actual_len = 0;
		    goto GET_LINE;
		 end;
	        else if request = "n"
	        then
		 do;
		    if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
		    then call audit_line ("IL", aut_input_string);
		    actual_len = actual_len - 2;
		    substr (aut_input_string, actual_len, 1) = NL;
		 end;
	        else if request = "t"
	        then
		 do;
		    actual_len = actual_len - 2;
		    substr (aut_input_string, actual_len, 1) = NL;
		 end;
	        else if blk.current_flags.read_audit
	        then call audit_line ("IL", aut_input_string);
	     end;
	  else if blk.current_flags.read_audit
	  then call audit_line ("IL", aut_input_string);

	  if actual_len > p_buff_len
	  then
	     do;
	        p_actual_len = p_buff_len;
	        param_input_string = substr (aut_input_string, 1, p_buff_len);
	        blk.work_space = addr (file_char_array (p_buff_len));
	        blk.work_space_len = actual_len - p_buff_len;
	        p_code = error_table_$long_record;
	        return;
	     end;
	  else
	     do;
	        p_actual_len = actual_len;
	        param_input_string = substr (aut_input_string, 1, actual_len);
	        blk.work_space = null;
	        blk.work_space_len = 0;
	        p_code = 0;
	        return;
	     end;
	  p_code = 0;
	  return;
         end;


audit_put_chars:
   entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_code);
      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      auditing_iocb = blk.auditing_iocb;
      call iox_$put_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_code);
      if p_code ^= 0
      then return;
      if blk.current_flags.write_audit
      then call audit_line ("OC", param_output_string);
      p_code = 0;
      return;


audit_position:
   entry (p_iocb_ptr, ptype, n, p_code);
      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      auditing_iocb = blk.auditing_iocb;
      call iox_$position (auditing_iocb, ptype, n, p_code);
      return;


audit_control:
   entry (p_iocb_ptr, p_real_order, p_info_ptr, p_code);

      audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
      blkptr = audited_iocb -> iocb.attach_data_ptr;
      audit_file_header_ptr = blk.audit_file_header_ptr;
      if blk.current_flags.trace
      then call audit_line ("TC", p_real_order || NL);
      order = p_real_order;
      if substr (order, 1, 6) = "audit_"
      then
         do;
	  order = substr (order, 7);
	  if order = "truncate"
	  then
	     do;
	        audit_file_header.current_component = 0;
	        call
		 msf_manager_$adjust (blk.audit_fcb, 0,
		 ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b,
		 p_code);
	        call truncate_audit_file;
	        audit_file_header.begin_index = audit_file_header.audit_index;
	        audit_file_header.begin_component = 0;
	        audit_file_header.filled = "0"b;
	        blk.begin_ptr = blk.audit_ptr;
	     end;
	  else if order = "modes"
	  then
	     do;
	        p_info_ptr -> mode_str = mode_string (p_code);
	     end;
	  else
	     do;
	        call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
	        return;
	     end;
         end;
      else if order = "io_call"
      then if p_info_ptr -> io_call_info.order_name = "audit_modes"
	 then
	    do;
	       call p_info_ptr -> io_call_info.report ("audit modes: ^a", mode_string (p_code));
	       return;
	    end;
	 else
	    do;
	       call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
	       return;
	    end;
      else if order = "resetread" | order = "abort"
      then
         do;
	  blk.work_space = null;
	  blk.work_space_len = 0;
	  call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
	  return;
         end;
      else
         do;
	  call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
	  return;
         end;
      p_code = 0;
      return;

/*  */

audit_line:
   proc (p_tag, p_string);
      dcl	    1 position	       like position_template;
      dcl	    1 previous_position    like position_template;
      dcl	    1 position_info	       like position_info_template;
      dcl	    bytes_required	       fixed bin (24);
      dcl	    max_entry_size	       fixed bin (24);
      dcl	    room_for_insertion     fixed bin (24);
      dcl	    trim_entry	       bit (1) init ("0"b);
      dcl	    p_tag		       char (*);
      dcl	    p_string	       char (*);

      call hcs_$set_ips_mask (0, mask);

      on any_other
         begin;
	  call force_audit_suspension;
	  goto RETURN;
         end;

      audit_file_header_ptr = blk.audit_file_header_ptr;
      position.aep = null;
      bytes_required = length (p_string) + 7 - mod (length (p_string) + 7, 8) + (4 * size (audit_entry));

      call set_max_entry_size;
      if bytes_required > max_entry_size
      then
         do;
	  bytes_required = max_entry_size;
	  trim_entry = "1"b;
         end;

      call get_room_for_insertion;
      do while (bytes_required > room_for_insertion);
         call adjust_indices;
         call get_room_for_insertion;
      end;

      call set_position_info;

      call insert (p_tag, p_string);
      if set_last_return_line_position
      then
         do;
	  set_last_return_line_position = "0"b;
	  call audit_editor$set_last_return_line_position (addr (position));
         end;

RETURN:
      revert any_other;
      call hcs_$set_ips_mask (mask, 0);
      return;

set_max_entry_size:
   proc;
      if ^blk.current_flags.file_limit
      then max_entry_size = sys_info$max_seg_size * 4;
      else if audit_file_header.max_component > 1
      then max_entry_size = sys_info$max_seg_size * 4;
      else if audit_file_header.max_component = 1
      then max_entry_size =
	    max (audit_file_header.max_index,
	    sys_info$max_seg_size * 4
	    - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)));
      else max_entry_size =
	    audit_file_header.max_index
	    - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8));
   end;

get_room_for_insertion:
   proc;
      if ^blk.current_flags.file_limit
      then room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index;
      else if (audit_file_header.begin_component = audit_file_header.current_component)
	    & (audit_file_header.begin_index >= audit_file_header.audit_index) & audit_file_header.filled
      then room_for_insertion = audit_file_header.begin_index - audit_file_header.audit_index;
      else if audit_file_header.current_component = audit_file_header.max_component
      then room_for_insertion = audit_file_header.max_index - audit_file_header.audit_index;
      else room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index;
   end;

adjust_indices:
   proc;
      if ^blk.current_flags.file_limit
      then call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr);
      else if audit_file_header.begin_component = audit_file_header.current_component
	    & audit_file_header.begin_index >= audit_file_header.audit_index & audit_file_header.filled
      then
         do;
	  position.aep = addr (blk.begin_ptr -> file_char_array (audit_file_header.begin_index));
	  call hcs_$status_mins (blk.begin_ptr, type, bit_count24, p_code);
	  if audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7
	     - mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8) >= divide (bit_count24, 9, 24, 0)
	  then call next_component (audit_file_header.begin_component, audit_file_header.begin_index, blk.begin_ptr);
	  else audit_file_header.begin_index =
		audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7
		- mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8);
         end;
      else call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr);
   end;

next_component:
   proc (p_component_number, p_component_index, p_component_ptr);
      dcl	    p_component_number     fixed bin (17);
      dcl	    p_component_index      fixed bin (24);
      dcl	    p_component_ptr	       ptr;

      call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code);
      if p_component_number = audit_file_header.max_component & blk.current_flags.file_limit
      then
         do;
	  p_component_number = 0;
	  p_component_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
	  p_component_ptr = audit_file_header_ptr;
	  audit_file_header.filled = "1"b;
         end;
      else
         do;
	  p_component_number = p_component_number + 1;
	  if ^blk.current_flags.file_limit
	  then audit_file_header.max_component = p_component_number;
	  p_component_index = 0;
	  call msf_manager_$get_ptr (blk.audit_fcb, p_component_number, "1"b, p_component_ptr, bit_count24, p_code);
         end;
   end;

set_position_info:
   proc;
      position_info.last_entry_length = audit_file_header.last_entry_length;
      position_info.max_component = audit_file_header.max_component;
      position_info.max_index = audit_file_header.max_index;
      position_info.begin_component = audit_file_header.begin_component;
      position_info.begin_index = audit_file_header.begin_index;
      position_info.current_component = audit_file_header.current_component;
      position_info.audit_index = audit_file_header.audit_index;
      position_info.audit_fcb = blk.audit_fcb;
      position_info.audit_ptr = blk.audit_ptr;
      position_info.default_search_tag = "";
      position_info.any_tag = "1"b;
      position_info.dirname = blk.dirname;
      position_info.ename = blk.ename;
      position_info.file_limit = audit_file_header.filled;
      position.char_index = audit_file_header.audit_index;
      position.component_number = audit_file_header.current_component;
      position.component_ptr = blk.audit_ptr;
      if position.component_number = audit_file_header.max_component & blk.current_flags.file_limit
      then position.component_max_char_index = audit_file_header.max_index;
      else position.component_max_char_index = sys_info$max_seg_size * 4;
      position.search_tag = "";
      position.entry_number = 0;
   end;

insert:
   proc (p_tag, p_string);
      dcl	    p_string	       char (*);
      dcl	    p_tag		       char (*);
      dcl	    virtual_time	       fixed bin (71);
      dcl	    paging	       fixed bin;
      dcl	    dev_paging	       fixed bin;
      dcl	    month		       fixed bin;
      dcl	    day		       fixed bin;
      dcl	    year		       fixed bin;
      dcl	    dow		       fixed bin;
      dcl	    zone		       char (3) aligned;
      dcl	    file_char_array	       (0:sys_info$max_seg_size * 4) char (1) unaligned based (blk.audit_ptr);
      position.aep = addr (file_char_array (audit_file_header.audit_index));

      if blk.current_flags.meter
      then
         do;
	  call cpu_time_and_paging_ (paging, virtual_time, dev_paging);
	  previous_position = position;
	  call audit_file_position_$last (addr (previous_position), addr (position_info), p_code);
	  if p_code = 0
	  then
	     do;
	        previous_position.aep -> audit_entry.virtual_time = virtual_time - blk.virtual_time;
	        previous_position.aep -> audit_entry.paging = paging - blk.paging;
	     end;

	  call decode_clock_value_ (clock, day, month, year, position.aep -> audit_entry.time, dow, zone);
	  blk.virtual_time = virtual_time;
	  blk.paging = paging;
         end;
      else position.aep -> audit_entry.time = -1;

      position.aep -> audit_entry.last_entry_length = audit_file_header.last_entry_length;
      if trim_entry
      then p_string = substr (p_string, 1, bytes_required - (4 * size (position.aep -> audit_entry)));
      position.aep -> audit_entry.entry_length = length (p_string);
      position.aep -> audit_entry.tag = p_tag;
      position.aep -> audit_entry.string = p_string;
      position.aep -> audit_entry.virtual_time = -1;
      position.aep -> audit_entry.paging = -1;
      audit_file_header.last_entry_length = position.aep -> audit_entry.entry_length;
      audit_file_header.audit_index = audit_file_header.audit_index + 4 * currentsize (position.aep -> audit_entry);
      audit_file_header.audit_index = audit_file_header.audit_index + 7 - mod (audit_file_header.audit_index + 7, 8);
      if ^blk.current_flags.file_limit
      then audit_file_header.max_index = audit_file_header.audit_index;
      return;
   end;

   end audit_line;

/*  */

force_audit_suspension:
   proc;
      dcl	    1 info	       aligned,
%include cond_info;

      dcl	    find_condition_info_   entry (ptr, ptr, fixed bin (35));

      call find_condition_info_ (null (), addr (info), p_code);
      call suspend_auditing (info.condition_name, info.loc_ptr);
   end force_audit_suspension;

suspend_auditing:
   proc (condition, p_ptr);
      dcl	    condition	       char (32) varying;
      dcl	    p_ptr		       ptr;
      if blk.suspend
      then return;
      blk.suspend = "1"b;
      string (blk.saved_flags) = string (blk.current_flags);
      string (blk.current_flags) = "0"b;
      if condition ^= ""
      then call ioa_$ioa_switch (p_iocb_ptr, "audit_: ^a on audit file by ^p, auditing suspended.", condition, p_ptr);
      return;
   end suspend_auditing;

mode_string:
   proc (p_code) returns (char (512) varying);
      dcl	    p_code	       fixed bin (35);
      dcl	    modes		       char (512);
      dcl	    mode_idx	       fixed bin (17);

      audit_file_header_ptr = blk.audit_file_header_ptr;
      modes = "";
      number_of_modes = 10;
      alloc mode_string_info in (temp_area);
      mode_string_info.version = mode_string_info_version_2;
MODE_LOOP:
      do mode_idx = 1 to hbound (mode_string_info.modes, 1);
         mode_value_ptr = addr (mode_string_info.modes (mode_idx));
         mode_value.flags = "0"b;
         mode_value.boolean_value = "0"b;
         mode_value.char_value = "";
         mode_value.numeric_value = 0;
         goto MODE (mode_idx);

MODE (1):
         mode_value.mode_name = "audit_input";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.read_audit;
         goto NEXT_MODE;

MODE (2):
         mode_value.mode_name = "audit_output";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.write_audit;
         goto NEXT_MODE;

MODE (3):
         mode_value.mode_name = "audit_edit";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.edit;
         goto NEXT_MODE;

MODE (4):
         mode_value.mode_name = "audit_trace";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.trace;
         goto NEXT_MODE;

MODE (5):
         mode_value.mode_name = "audit_meter";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.meter;
         goto NEXT_MODE;

MODE (6):
         mode_value.mode_name = "audit_transparent";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = (blk.default_iocb = blk.auditing_iocb);
         goto NEXT_MODE;

MODE (7):
         mode_value.mode_name = "audit_trigger";
         mode_value.flags.char_valuep = "1"b;
         mode_value.char_value = blk.trigger;
         goto NEXT_MODE;

MODE (8):
         mode_value.mode_name = "audit_file_size";
         if blk.current_flags.file_limit
         then
	  do;
	     mode_value.flags.numeric_valuep = "1"b;
	     mode_value.numeric_value =
	        (audit_file_header.max_component * 256) + divide (audit_file_header.max_index, 4096, 17, 0);
	  end;
         else
	  do;
	     mode_value.flags.char_valuep = "1"b;
	     mode_value.char_value = "unlimited";
	  end;
         goto NEXT_MODE;

MODE (9):
         mode_value.mode_name = "audit_use_editor_prompt";
         mode_value.flags.boolean_valuep = "1"b;
         mode_value.boolean_value = blk.current_flags.use_editor_prompt;
         goto NEXT_MODE;

MODE (10):
         mode_value.mode_name = "audit_editor_prompt_string";
         mode_value.flags.char_valuep = "1"b;
         mode_value.char_value = blk.editor_prompt_string;
         goto NEXT_MODE;

NEXT_MODE:
      end MODE_LOOP;

      call mode_string_$combine (mode_string_info_ptr, null, modes, p_code);

      return (modes);

   end mode_string;

truncate_audit_file:
   proc;

/* This program always sets up afh and blk.audit_ptr for
   afh.current_component = 0.
*/

      audit_file_header_ptr = blk.audit_file_header_ptr;
      call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
      if p_code ^= 0
      then
         do;
	  call com_err_ (p_code, "audit_");
	  return;
         end;
      audit_file_header.audit_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
      audit_file_header.last_entry_length = impossible_audit_entry_length;
   end truncate_audit_file;

/*  */

%include audit_block;
%page;
%include audit_entry;
%page;
%include audit_file_header;
%page;
%include audit_position;
%page;
%include io_call_info;
%page;
%include iocb;
%page;
%include iox_dcls;
%page;
%include mode_string_info;
   end;




		    audit_editor.pl1                06/03/83  0951.3rew 06/03/83  0829.0      370746



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


/* format: style2 */
audit_editor:
     proc (p_buff_ptr, p_buff_len, p_actual_len, p_audited_iocb, p_code);

/* The audit_editor procedure is bound in with audit_, and is not
   an externally available entry. INput is in param_buffer (defined by p_buff_ptr,
   p_buff_len, and p_actual_len). param_buffer is also used for output from the
   editor.  If the string to be output is too large for the param_buffer as
   defined on entry, i.e. if p_buff_len is too small, param_buffer is
   redefined on the audit_ temp_seg pointed to by blk.temp_seg_ptr. To preserve
   "recursiveness" of audit_editor and audit_get_line(in audit_), the audit_editor
   uses a temp_seg  in calls to iox_$get_line as its input buffer. Also, to avoid
   edit buffer size problems, edit_buffer is based on a temp_seg.
   The requests supported by audit_editor are in the parse_request internal
   procedure, the addressing syntax is enforced by decode_address.

   12/08/78 Written by Lindsey L. Spratt
   Modified:
   11/26/79  by  Lindsey L. Spratt  to add prompting.
12/11/79  by  Lindsey L. Spratt to modify prompting, add "=" request, add short
names for requests (remove "." prefix).
03/20/81  by  Lindsey L. Spratt:  Remove blk.editor_prompt_terminator, use
	    blk.editor_prompt_string as an ioa_ control string.
*/


/* Parameter */

	dcl     p_buff_ptr		 ptr;
	dcl     p_buff_len		 fixed bin (21);
	dcl     p_actual_len	 fixed bin (21);
	dcl     p_audited_iocb	 ptr;
	dcl     p_code		 fixed bin (35);

/* Automatic */

	dcl     1 position_info	 like position_info_template;
	dcl     1 saved_audit_file_header
				 like audit_file_header;
	dcl     1 aut_last_return_line,
		2 not_in_string	 bit (1),
		2 string		 char (512) varying,
		2 position	 like position_template;
	dcl     1 current_position	 like position_template;
	dcl     1 begin_position	 like position_template;
	dcl     1 end_position	 like position_template;
	dcl     idx_of_first_non_white_space_char
				 fixed bin (35);
	dcl     level		 fixed bin;
	dcl     request_index	 fixed bin;
	dcl     code		 fixed bin (35);
	dcl     areap		 ptr;
	dcl     new_edit_buffer_ptr	 ptr;
	dcl     default_iocb	 ptr;
	dcl     request_line_length	 fixed bin;
	dcl     request_line_ptr	 ptr;
	dcl     no_last_return_line	 bit (1);
	dcl     edit_buffer_ptr	 ptr;
	dcl     string_delimiter	 char (1);
	dcl     auditing_iocb	 ptr;
	dcl     blkptr		 ptr;
	dcl     warn_user_on_bad_request
				 bit (1);
	dcl     (edit_buffer_length, new_edit_buffer_length)
				 fixed bin;
	dcl     (max_edit_buffer_length, max_request_line_length)
				 fixed bin;
	dcl     temp_seg_ptr	 (3) ptr;

/* Based */
	dcl     area		 area (2048) based (areap);
	dcl     request_line	 char (request_line_length) based (request_line_ptr);
	dcl     edit_buffer		 char (edit_buffer_length) based (edit_buffer_ptr);
	dcl     param_buffer	 char (p_actual_len) based (p_buff_ptr);
	dcl     new_edit_buffer	 char (new_edit_buffer_length) based (new_edit_buffer_ptr);

/* Builtin */

	dcl     null		 builtin;
	dcl     (addr, addrel, allocation, bin, hbound, index, length, ltrim, rtrim, search, substr, verify)
				 builtin;

/* Condition */

	dcl     cleanup		 condition;



/* Controlled */

	dcl     1 con_last_return_line controlled,
		2 not_in_string	 bit (1),
		2 string		 char (512) varying,
		2 position	 like position_template;

/* Entry */

	dcl     audit_file_position_$move_number
				 entry (ptr, bit (1), bit (1), bit (1), fixed bin, ptr, fixed bin (35));
	dcl     audit_file_position_$forward_search
				 entry (ptr, char (*) varying, ptr, fixed bin (35));
	dcl     audit_file_position_$backward_search
				 entry (ptr, char (*) varying, ptr, fixed bin (35));
	dcl     audit_file_position_$next
				 entry (ptr, ptr, fixed bin (35));
	dcl     audit_file_position_$previous
				 entry (ptr, ptr, fixed bin (35));
	dcl     audit_file_position_$last
				 entry (ptr, ptr, fixed bin (35));
	dcl     audit_file_position_$set_count
				 entry (ptr, ptr, fixed bin (35));

	dcl     get_temp_segments_	 entry (char (*), (*) ptr, fixed bin (35));
	dcl     release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
	dcl     get_system_free_area_	 entry () returns (ptr);
	dcl     iox_$get_line	 entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     ioa_$ioa_switch	 entry options (variable);
	dcl     ioa_$ioa_switch_nnl	 entry options (variable);
	dcl     cu_$cp		 entry (ptr, fixed bin, fixed bin (35));
	dcl     abbrev_$expanded_line	 entry (ptr, fixed bin, ptr, fixed bin, ptr, fixed bin);
	dcl     search_file_	 entry (ptr, fixed bin, fixed bin, ptr, fixed bin, fixed bin, fixed bin,
				 fixed bin, fixed bin (35));

/* External */

	dcl     sys_info$max_seg_size	 fixed bin (35) ext;
	dcl     error_table_$empty_file
				 fixed bin (35) ext;
	dcl     error_table_$no_stmt_delim
				 fixed bin (35) ext;
	dcl     error_table_$end_of_info
				 fixed bin (35) ext;

/* Static */

	dcl     static_level	 fixed bin internal static init (0);
	dcl     NL		 char (1) internal static options (constant) init ("
");


/* Increment the count of the recursive invocations of the editor. */

	static_level = static_level + 1;
	level = static_level;

/* Push the last_return_line stack if its depth is less than
   the current level of recursion. The no_last_return_line switch is
   "1"b if there was no last_return_line at this level of recursion. */

	if allocation (con_last_return_line) < level
	then do;
		no_last_return_line = "1"b;
		allocate con_last_return_line;
	     end;
	else no_last_return_line = "0"b;
	on condition (cleanup)
	     begin;
		do while (allocation (con_last_return_line) >= level);
		     free con_last_return_line;
		end;
		static_level = level - 1;
	     end;

/* Put the contents of the last_return_line of this level in
   automatic storage, to insure reference to the correct value,
   regardless of additional recursion. */

	aut_last_return_line = con_last_return_line;
	warn_user_on_bad_request = "0"b;
	max_request_line_length = sys_info$max_seg_size * 4;
	max_edit_buffer_length = sys_info$max_seg_size * 4;
	position_info.any_tag = "0"b;
	current_position.component_number = -1;
	current_position.component_max_char_index = -1;
	current_position.component_ptr = null;
	current_position.char_index = -1;
	current_position.aep = null;

	areap = get_system_free_area_ ();
	call get_temp_segments_ ("audit_editor", temp_seg_ptr, code);
	if code ^= 0
	then do;
		p_code = code;
		return;
	     end;
	edit_buffer_ptr = temp_seg_ptr (1);
	new_edit_buffer_ptr = temp_seg_ptr (2);
	request_line_ptr = temp_seg_ptr (3);

/* Get the attached data, in blk, which describes various things about
   the audit file.  Make a snapshot of this data to protect against the result
   of further auditing while in the editor. */

	blkptr = p_audited_iocb -> iocb.attach_data_ptr;
	audit_file_header_ptr = blk.audit_file_header_ptr;
	saved_audit_file_header = audit_file_header;
	position_info.max_index = audit_file_header.max_index;
	position_info.begin_component = audit_file_header.begin_component;
	position_info.begin_index = audit_file_header.begin_index;
	position_info.file_limit = audit_file_header.filled;
	position_info.default_search_tag = "I";
	position_info.max_component = audit_file_header.max_component;
	position_info.current_component = audit_file_header.current_component;
	position_info.audit_fcb = blk.audit_fcb;
	position_info.dirname = blk.dirname;
	position_info.ename = blk.ename;
	position_info.audit_index = audit_file_header.audit_index;
	position_info.audit_ptr = blk.audit_ptr;
	position_info.last_entry_length = audit_file_header.last_entry_length;
	auditing_iocb = blk.auditing_iocb;
	default_iocb = blk.default_iocb;

/* Set up request_line, edit_buffer, current_position, begin_position,
   and end_position. */

	if p_actual_len = 3
	then do;					/* Editor triggered with line containing only editor request */
						/* sequence. Set edit_line to the input line preceding the */
						/* trigger sequence, get request_line from default_iocb. */
		call audit_file_position_$last (addr (current_position), addr (position_info), code);
		if code ^= 0
		then if code = error_table_$empty_file
		     then do;
			     call ioa_$ioa_switch (default_iocb, "Empty audit file.");
			     param_buffer = "";
			     p_actual_len = 0;
			     p_code = 0;
			     call finish;
			     return;
			end;
		     else do;
			     p_code = code;
			     call finish;
			     return;
			end;
		if default_iocb ^= auditing_iocb
		then do;
			call audit_file_position_$previous (addr (current_position), addr (position_info), code);
			if code ^= 0
			then do;
				p_code = code;
				call finish;
				return;
			     end;
		     end;
		begin_position, end_position = current_position;
		call replace_buffer_with_entry (current_position);
		if blk.current_flags.use_editor_prompt
		then call put_prompt;
		call iox_$get_line (default_iocb, request_line_ptr, 512, request_line_length, code);
		if code ^= 0
		then do;
			p_code = code;
			call finish;
			return;
		     end;
	     end;
	else if substr (param_buffer, p_actual_len - 1, 1) = "E"
	then do;					/* Editor triggered with line containing requests. Prepare to */
						/* warn user if part of the supplied request_line */
						/* fails. Set edit_line to most recent input line. */
		warn_user_on_bad_request = "1"b;
		request_line_length = p_actual_len - 2;
		request_line = substr (param_buffer, 1, p_actual_len - 3) || NL;
		call audit_file_position_$last (addr (current_position), addr (position_info), code);
		if code ^= 0
		then if code = error_table_$empty_file
		     then do;
			     call ioa_$ioa_switch (default_iocb, "Empty audit file.");
			     p_code = 1;
			     call finish;
			     p_code = 0;
			     return;
			end;
		     else do;
			     p_code = code;
			     call finish;
			     return;
			end;
		if default_iocb ^= auditing_iocb
		then do;
			call audit_file_position_$previous (addr (current_position), addr (position_info), code);
			if code ^= 0
			then do;
				p_code = code;
				call finish;
				return;
			     end;
		     end;
		call replace_buffer_with_entry (current_position);
		begin_position, end_position = current_position;
	     end;
	else do;					/* Set edit_line to the characters preceding the  trigger */
						/* sequence. Get the request_line from default_iocb. */
		edit_buffer_length = p_actual_len - 2;
		edit_buffer = substr (param_buffer, 1, p_actual_len - 3) || NL;
		call audit_file_position_$last (addr (current_position), addr (position_info), code);
		begin_position, end_position = current_position;
		if blk.current_flags.use_editor_prompt
		then call put_prompt;
		call iox_$get_line (default_iocb, request_line_ptr, 512, request_line_length, code);
		if code ^= 0
		then do;
			p_code = code;
			call finish;
			return;
		     end;
	     end;

/* Loop through the requests, getting new request_line's as necessary. */

	do while ("1"b);
	     begin_position, end_position = current_position;
	     code = 0;
	     call parse_request (request_index);	/* Get the label index of first request on request_line */
	     if request_index > 0			/* All non-zero indexes are valid requests. */
	     then goto LAB (request_index);
	     else if warn_user_on_bad_request
	     then do;				/* Print a station id since an error has occurred in processing. */
		     warn_user_on_bad_request = "0"b;
		     goto LAB (1);
		end;
	     else goto NEXT_REQUEST;			/* Zero index indicates no valid request found. */

/* Each label is an editor request call followed by a transfer to NEXT_REQUEST
   or a return. */

LAB (1):
	     call whoami;
	     goto NEXT_REQUEST;

LAB (2):
	     call colon;				/* Turns on the no_default_tag switch. */
	     goto NEXT_REQUEST;

LAB (3):
	     call print;				/* Print the lines between begin_index and end_index. */
	     goto NEXT_REQUEST;

LAB (4):
	     call substitute (code);			/* Substitute rep_str for reg_exp in edit_line. */
	     goto NEXT_REQUEST;			/* rep_str and reg_exp are parsed from
						   request_line by substitute. */

LAB (5):
	     p_code = 1;				/* Quit from the editor.  */
	     call finish;
	     p_code = 0;
	     return;

LAB (6):
	     call command_processor_escape;
	     goto NEXT_REQUEST;

LAB (7):
LAB (18):
	     call return_edit_line (code);		/* Return edit_line to audit_. */
	     if code = 0
	     then do;
		     p_code = 0;
		     call finish;
		     return;
		end;
	     else goto NEXT_REQUEST;

LAB (8):
LAB (19):
	     call get_last_line_returned;		/* Put the last line returned by */
	     goto NEXT_REQUEST;			/* the audit_editor in edit_line, and set position to its
						   location in the audit file. */

LAB (9):
LAB (20):
	     call return_newline;			/* Return a newline to audit_. */
	     p_code = 1;
	     call finish;
	     p_code = 0;
	     return;

LAB (10):
LAB (21):
	     call set_default_search_tag (position_info.default_search_tag, code);
						/* Set the default tag used in searching */
	     goto NEXT_REQUEST;			/* to tag_str, which is gotten from request_line. */

LAB (11):
LAB (22):
	     call audit_on;				/* Turn on auditting of the editor. */
	     goto NEXT_REQUEST;

LAB (12):
LAB (23):
	     call audit_off;			/* Turn off auditting of the editor. */
	     goto NEXT_REQUEST;

LAB (13):
LAB (24):
	     call print_type;			/* Print the type(tag) of the current entry */
	     goto NEXT_REQUEST;			/* (in edit_line). */

LAB (14):
LAB (25):
	     call execute_edit_line;			/* Execute (pass to the comand processor)  edit_line */
	     goto NEXT_REQUEST;			/* and continue processing editor requests. */

LAB (15):
LAB (26):
	     call abbrev_expand_edit_line;		/* Expand, using the abbrev processor, the  */
	     goto NEXT_REQUEST;			/* contents of edit_line, and replace edit_line with
						   the expanded version. */

LAB (16):
LAB (27):
	     call list_requests;
	     goto NEXT_REQUEST;

LAB (17):
	     call print_entry_number;
	     goto NEXT_REQUEST;			/* If the request line length is 0, a new line is gotten from the user.
						   In any case, the beginning of the loop is returned to. */

NEXT_REQUEST:
	     if code ^= 0
	     then do;
		     code = 0;
		     request_line_length = 0;
		     request_line = "";
		     if warn_user_on_bad_request
		     then do;
			     warn_user_on_bad_request = "0"b;
			     goto LAB (1);
			end;
		end;
	     if request_line_length < 2
	     then do;
		     position_info.any_tag = "0"b;
		     if blk.current_flags.use_editor_prompt
		     then call put_prompt;
		     call iox_$get_line (default_iocb, request_line_ptr, max_request_line_length, request_line_length,
			code);
		     if code ^= 0
		     then do;
			     p_code = code;
			     call finish;
			     return;
			end;
		     else warn_user_on_bad_request = "0"b;
		end;
	end;
	return;					/* End the main procedure, audit_editor. */

set_last_return_line_position:
     entry (p_position_ptr);
	dcl     1 p_position	 like position_template based (p_position_ptr);
	dcl     p_position_ptr	 ptr;
	con_last_return_line.position = p_position;
	return;					/* End set_last_return_line_position. */

/* The 14 following procedures are the various editor requests.
   After them are the procedures for parsing the request line,
   then the procedures for position control. */


whoami:
     proc;					/* Station identification. */
	call ioa_$ioa_switch (default_iocb, "audit editor ^v(at level ^d ^)", level - 1, level);
     end;

colon:
     proc;					/* Defeat entry type specificity in address searches. */
	position_info.any_tag = "1"b;
     end;

print:
     proc;					/* Print entries in the audit file from  */
	dcl     code		 fixed bin (35);

	code = 0;					/* begin position to end position. */
	if begin_position.aep = end_position.aep
	then call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer);
	else do;
		current_position = begin_position;
		begin_position = end_position;
		do while (current_position.aep ^= end_position.aep);
		     call replace_buffer_with_entry (current_position);
		     call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer);
		     call audit_file_position_$next (addr (current_position), addr (position_info), code);
		     if code = error_table_$end_of_info
		     then do;
			     call ioa_$ioa_switch (default_iocb, "EOF");
						/* There is no next entry. */
			     return;
			end;
		end;
		if code = 0
		then do;
			call replace_buffer_with_entry (current_position);
						/* The entry at end_position has yet to be printed. */
			call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer);
		     end;
	     end;
     end;

substitute:
     proc (p_code);
	dcl     (code, p_code)	 fixed bin (35);
	dcl     reg_exp		 char (512) varying based (reg_exp_ptr);
	dcl     rep_str		 char (512) varying;
	dcl     char_after_last_match	 fixed bin;
	dcl     match_index		 fixed bin;
	dcl     match_begin		 fixed bin;
	dcl     match_end		 fixed bin;
	dcl     start_next_search	 fixed bin;
	dcl     slash_amp_index	 fixed bin;
	dcl     reg_exp_ptr		 ptr;

	alloc reg_exp in (area);

	call get_string (reg_exp, "1"b, code);		/* Get the string to be replaced, a qedx
						   regular expression, from the request line. */
	if code ^= 0
	then do;
		p_code = code;
		free reg_exp in (area);
		return;
	     end;

	call get_string (rep_str, "0"b, code);		/* Get the replacement string from the request line. */
	if code ^= 0
	then do;
		p_code = code;
		free reg_exp in (area);
		return;
	     end;

	new_edit_buffer_length = 0;
	char_after_last_match = 1;

	do match_index = 1 by 1 while (char_after_last_match <= edit_buffer_length);
						/* Search edit_line for reg_exp. */
	     call search_file_ (addrel (reg_exp_ptr, 1), 1, length (reg_exp), edit_buffer_ptr, char_after_last_match,
		edit_buffer_length, match_begin, match_end, code);
	     if code ^= 0
	     then do;				/* No match for reg_exp was found, starting at  */
						/* char_after_last_match. */
		     if match_index > 1
		     then do;			/* At least one match has been found, so update */
						/*  the edit_line and return. */
			     if new_edit_buffer_length + 1 >= char_after_last_match
			     then do;
				     edit_buffer_length =
					new_edit_buffer_length + edit_buffer_length - char_after_last_match + 1;
				     edit_buffer =
					new_edit_buffer
					||
					substr (edit_buffer, char_after_last_match,
					edit_buffer_length - new_edit_buffer_length);
				end;
			     else do;
				     substr (edit_buffer, 1,
					edit_buffer_length + new_edit_buffer_length - char_after_last_match + 1)
					= new_edit_buffer || substr (edit_buffer, char_after_last_match);
				     edit_buffer_length =
					new_edit_buffer_length + edit_buffer_length - char_after_last_match + 1;
				end;
			     p_code = 0;
			     free reg_exp in (area);
			     return;
			end;
		     if code = 1
		     then call ioa_$ioa_switch (default_iocb, "Substitution failed.");
		     free reg_exp in (area);
		     p_code = code;
		     return;
		end;

/* If the match starts after char_after_last_match, then append the part
   of the edit_line between char_after_last_match and match_begin to the new_edit_line. */

	     if match_begin > char_after_last_match
	     then do;
		     new_edit_buffer_length = new_edit_buffer_length + match_begin - char_after_last_match;
		     new_edit_buffer =
			substr (new_edit_buffer, 1, new_edit_buffer_length - match_begin + char_after_last_match)
			|| substr (edit_buffer, char_after_last_match, match_begin - char_after_last_match);
		end;

/* Having found a match, rep_str indicates what characters are to be
   appended to the growing new_edit_line, instead of the characters in edit_line
   between match_begin and match_end.  Any unescaped ampersand (&) in
   rep_str is replaced by the matched string in edit_line. An escape is
   the two character sequence "\c".  The following loop searches for escapes
   and unescaped ampersands in rep_str. */


	     start_next_search = 1;

	     if rep_str = ""
	     then do;
		     new_edit_buffer_length = new_edit_buffer_length + length (rep_str) - start_next_search + 1;
		     new_edit_buffer =
			substr (new_edit_buffer, 1,
			new_edit_buffer_length - (length (rep_str) - start_next_search + 1))
			|| substr (rep_str, start_next_search);
		end;
	     else do while (start_next_search <= length (rep_str));
		     slash_amp_index = search (substr (rep_str, start_next_search), "\&");
		     if slash_amp_index = 0
		     then do;
			     new_edit_buffer_length =
				new_edit_buffer_length + length (rep_str) - start_next_search + 1;
			     new_edit_buffer =
				substr (new_edit_buffer, 1,
				new_edit_buffer_length - (length (rep_str) - start_next_search + 1))
				|| substr (rep_str, start_next_search);
			     start_next_search = length (rep_str) + 1;
			end;
		     else if substr (rep_str, start_next_search + slash_amp_index - 1, 1) = "&"
		     then do;
			     new_edit_buffer_length = new_edit_buffer_length + slash_amp_index - 1;
			     new_edit_buffer =
				substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index + 1)
				|| substr (rep_str, start_next_search, slash_amp_index - 1);
			     start_next_search = start_next_search + slash_amp_index;
			     if match_end >= match_begin
			     then do;
				     new_edit_buffer_length =
					new_edit_buffer_length + match_end - match_begin + 1;
				     new_edit_buffer =
					substr (new_edit_buffer, 1,
					new_edit_buffer_length - match_end + match_begin - 1)
					|| substr (edit_buffer, match_begin, match_end - match_begin + 1);
				end;
			end;
		     else if start_next_search + slash_amp_index > length (rep_str)
		     then do;
			     new_edit_buffer_length =
				new_edit_buffer_length + length (rep_str) - start_next_search + 1;
			     new_edit_buffer =
				substr (new_edit_buffer, 1,
				new_edit_buffer_length - length (rep_str) + start_next_search - 1)
				|| substr (rep_str, start_next_search);
			     start_next_search = length (rep_str) + 1;
			end;
		     else if substr (rep_str, start_next_search + slash_amp_index, 1) ^= "c"
		     then do;
			     new_edit_buffer_length = new_edit_buffer_length + slash_amp_index;
			     new_edit_buffer =
				substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index)
				|| substr (rep_str, start_next_search, slash_amp_index);
			     start_next_search = start_next_search + slash_amp_index;
			end;
		     else if start_next_search + slash_amp_index = length (rep_str)
		     then do;
			     new_edit_buffer_length =
				new_edit_buffer_length + length (rep_str) - start_next_search + 1;
			     new_edit_buffer = substr (rep_str, start_next_search);
			     start_next_search = length (rep_str) + 1;
			end;
		     else do;
			     new_edit_buffer_length = new_edit_buffer_length + slash_amp_index;
			     new_edit_buffer =
				substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index)
				|| substr (rep_str, start_next_search, slash_amp_index - 1)
				|| substr (rep_str, start_next_search + slash_amp_index + 1, 1);
			     start_next_search = start_next_search + slash_amp_index + 2;
			end;
		end;

	     if match_end < match_begin
	     then do;
		     new_edit_buffer_length = new_edit_buffer_length + 1;
		     new_edit_buffer =
			substr (new_edit_buffer, 1, new_edit_buffer_length - 1)
			|| substr (edit_buffer, match_begin, 1);
		     char_after_last_match = match_begin + 1;
		end;
	     else char_after_last_match = match_end + 1;
	     reg_exp = "";				/* A null reg_exp will cause search_file_ to use
						   the last non_null value of reg_exp. */
	end;

	free reg_exp in (area);
	edit_buffer_length = new_edit_buffer_length;
	edit_buffer = new_edit_buffer;
     end;


command_processor_escape:
     proc;
	call cu_$cp (request_line_ptr, request_line_length, code);
	request_line = "";
	request_line_length = 0;
     end;


return_edit_line:
     proc (p_code);
	dcl     p_code		 fixed bin (35);

	if request_line_length > 1
	then do;
		if substr (request_line, 1, request_line_length - 1) ^= ""
		then do;
			edit_buffer_length = request_line_length;
			edit_buffer = request_line;
			request_line_length = 0;
			request_line = "";
		     end;
	     end;


	if edit_buffer_length <= 512
	then do;
		aut_last_return_line.string = edit_buffer;
		aut_last_return_line.not_in_string = "0"b;
	     end;
	else do;
		aut_last_return_line.string = "";
		aut_last_return_line.not_in_string = "1"b;
	     end;
	p_code = 0;
     end;


get_last_line_returned:
     proc;
	if no_last_return_line
	then call ioa_$ioa_switch (default_iocb, "No previously returned line known.");
	else do;
		current_position = aut_last_return_line.position;
		begin_position = current_position;
		end_position = current_position;
		if aut_last_return_line.not_in_string
		then call replace_buffer_with_entry (current_position);
		else do;
			edit_buffer_length = length (aut_last_return_line.string);
			edit_buffer = aut_last_return_line.string;
		     end;
	     end;
     end;


return_newline:
     proc;
	p_actual_len = 1;
	param_buffer = NL;
     end;


set_default_search_tag:
     proc (p_default_search_tag, p_code);
	dcl     default_search_tag	 char (32) varying;
	dcl     p_default_search_tag	 char (*) varying;
	dcl     (p_code, code)	 fixed bin (35);

	call get_string (default_search_tag, "1"b, code);
	if code ^= 0
	then do;
		p_code = code;
		return;
	     end;
	if length (default_search_tag) > 2
	then do;
		call ioa_$ioa_switch (default_iocb, "Tag too long. ^a", default_search_tag);
		p_code = 1;
		return;
	     end;
	p_default_search_tag = default_search_tag;
	return;
     end;


audit_on:
     proc;
	default_iocb = p_audited_iocb;
     end;

audit_off:
     proc;
	default_iocb = auditing_iocb;
     end;

print_type:
     proc;
	call ioa_$ioa_switch (default_iocb, "^a", current_position.aep -> audit_entry.tag);
     end;

execute_edit_line:
     proc;
	call cu_$cp (addr (edit_buffer), length (rtrim (edit_buffer)), code);
     end;

abbrev_expand_edit_line:
     proc;
	dcl     out		 char (abline_len) based (outp);
	dcl     outp		 ptr,
	        abline_len		 fixed bin;
	dcl     abline		 char (512);

	call abbrev_$expanded_line (edit_buffer_ptr, edit_buffer_length, addr (abline), max_edit_buffer_length, outp,
	     abline_len);
	if abline_len > max_edit_buffer_length
	then do;
		call ioa_$ioa_switch (default_iocb, "Expanded line too long. ^/^a", out);
		request_line = "";
		request_line_length = 0;
		return;
	     end;
	edit_buffer_length = abline_len;
	edit_buffer = out;
     end;

list_requests:
     proc;
	call ioa_$ioa_switch (default_iocb, "^5x.        ->  who am I?");
	call ioa_$ioa_switch (default_iocb, "^5x:        ->  defeat default search tag");
	call ioa_$ioa_switch (default_iocb, "^5xp        ->  print");
	call ioa_$ioa_switch (default_iocb, "^5xs        ->  substitute");
	call ioa_$ioa_switch (default_iocb, "^5xq        ->  quit");
	call ioa_$ioa_switch (default_iocb, "^5x..       ->  command escape");
	call ioa_$ioa_switch (default_iocb, "^5x.r       ->  return edit buffer");
	call ioa_$ioa_switch (default_iocb, "^5x.l       ->  get last returned line");
	call ioa_$ioa_switch (default_iocb, "^5x.n       ->  return newline");
	call ioa_$ioa_switch (default_iocb, "^5x.d       ->  set default tag");
	call ioa_$ioa_switch (default_iocb, "^5x.on      ->  audit editting");
	call ioa_$ioa_switch (default_iocb, "^5x.off     ->  don't audit editting");
	call ioa_$ioa_switch (default_iocb, "^5x.type    ->  print tag of entry in buffer");
	call ioa_$ioa_switch (default_iocb, "^5x.exec    ->  execute edit buffer with call to command processor");
	call ioa_$ioa_switch (default_iocb, "^5x.expand  ->  expand abbrevs in edit buffer");
	call ioa_$ioa_switch (default_iocb, "^5x.?       ->  print this list");
     end;
print_entry_number:
     proc;
	if current_position.entry_number = 0 | (current_position.search_tag ^= position_info.default_search_tag)
	     | position_info.any_tag
	then call audit_file_position_$set_count (addr (current_position), addr (position_info), code);
	call ioa_$ioa_switch (default_iocb, "^d", current_position.entry_number);
     end;						/* End of print_entry_number.*/

put_prompt:
     proc;
	call ioa_$ioa_switch_nnl (default_iocb, blk.editor_prompt_string, (level > 1), level);
     end;						/* End of put_prompt.*/


/* The next group of procedures are concerned primarily with parsing the
   request line. */

parse_request:
     proc (p_index) recursive;
	dcl     (p_index, index)	 fixed bin;
	dcl     request_name_length	 fixed bin;
	dcl     request		 (27) char (12) varying static options (constant)
				 init (".", ":", "p", "s", "q", "..", ".r", ".l", ".n", ".d", ".on", ".off",
				 ".type", ".exec", ".expand", ".?", "=", "r", "l", "n", "d", "on", "off", "type",
				 "exec", "expand", "?");

	p_index = 0;
	if request_line_length < 2
	then do;					/* The request line is too short to contain any requests */
		p_index = 0;
		return;
	     end;
	else if (request_line_length = 2) & substr (request_line, 1, 1) = "."
	then do;					/* the "." (station id) request is only recognized when */
						/* immediately followed by a newline. */
		request_line_length = 0;
		request_line = "";
		p_index = 1;
		return;
	     end;
	else do;					/* This sets p_index to an appropriate request label */
						/* index if the request line begins with a recognizable */
						/* If no recognizable request begins the line, */
						/* p_index is set to 0. */
		call request_check;

		if p_index = 0
		then do;				/* The beginning of the request line is assumed */
						/* to be an address and is interpreted accordingly */
			call decode_address (code);
			if code ^= 0
			then do;
				if code = 1
				then call unrecognized_request;
				return;
			     end;
			else if request_line_length < 2
			then do;
				p_index = 3;	/* The request line contained only an address */
				begin_position = end_position;
						/* so the default is to print the current position. */
				return;
			     end;
			else do;			/* An address was gotten from the request line, */
						/* now the trailing request is gotten. */
				call request_check;
				if index > hbound (request, 1)
						/* No matching request found for beginning of request */
						/* line, so complain and return. */
				then call unrecognized_request;
				else p_index = index;
				return;
			     end;
		     end;
	     end;

request_check:
     proc;

/* The array request is looped through to find a match for the beginning
   of the request line. The loop starts at 2 because request(1), ".",
   is handled as a special case above. */

	do index = 2 to hbound (request, 1);
	     request_name_length = length (request (index));
	     if request_line_length >= request_name_length + 1
	     then if substr (request_line, 1, request_name_length) = request (index)
		then do;
			substr (request_line, 1, request_line_length - request_name_length) =
			     substr (request_line, request_name_length + 1);
			request_line_length = request_line_length - request_name_length;
			idx_of_first_non_white_space_char = verify (request_line, " 	");
			if idx_of_first_non_white_space_char > 1
						/* Leading white space exists and needs to be stripped off. */
			then do;
				substr (request_line, 1,
				     request_line_length - idx_of_first_non_white_space_char + 1) =
				     substr (request_line, idx_of_first_non_white_space_char,
				     request_line_length - idx_of_first_non_white_space_char + 1);
				request_line_length = request_line_length - idx_of_first_non_white_space_char + 1;
			     end;
			p_index = index;
			return;
		     end;
	end;
     end;

unrecognized_request:
     proc;
	call ioa_$ioa_switch (default_iocb, "audit editor: Unrecognized request. ^a",
	     substr (request_line, 1, request_line_length));
	request_line_length = 0;
	request_line = "";
	p_index = 0;
     end;
     end;



decode_address:
     proc (p_code);
	dcl     (code, p_code)	 fixed bin (35);
	dcl     (number, non_number_index)
				 fixed bin;
	dcl     forward		 bit (1);
	dcl     ch		 char (1);
	dcl     have_begin_position	 bit (1);
	dcl     match_string	 char (256) varying;
	dcl     continue		 bit (1);
	dcl     (abs_addr, add_addr, subtract_addr)
				 bit (1);
	dcl     1 new_current_position like position_template;
	dcl     1 new_begin_position	 like position_template;
	dcl     1 new_end_position	 like position_template;

	if index ("0123456789/<$,+-", substr (request_line, 1, 1)) = 0
	then do;
		p_code = 1;
		return;
	     end;
	forward = "1"b;
	abs_addr = "1"b;
	add_addr = "0"b;
	subtract_addr = "0"b;
	have_begin_position = "0"b;
	continue = "1"b;
	new_current_position = current_position;

	do while (request_line_length > 0 & continue);
	     substr (request_line, 1, length (ltrim (request_line))) = ltrim (request_line);
	     request_line_length = length (ltrim (request_line));
						/* Find position in request_line of leftmost non-numeric character. */
	     non_number_index = verify (request_line, "0123456789");
	     if non_number_index > 1
	     then do;				/* Convert the character representation of the number tofixed bin. */
		     number = bin (substr (request_line, 1, non_number_index - 1));
		     substr (request_line, 1, request_line_length - non_number_index + 1) =
			substr (request_line, non_number_index);
		     request_line_length = request_line_length - non_number_index + 1;
		     code = 0;
		     call audit_file_position_$move_number (addr (new_current_position), abs_addr, add_addr,
			subtract_addr, number, addr (position_info), code);
		     if code ^= 0
		     then if code = error_table_$end_of_info
			then code = 0;
			else do;
				request_line_length = 0;
				request_line = "";
				p_code = code;
				return;
			     end;
		end;
	     ch = substr (request_line, 1, 1);

/*  Process the next, and necessarily non-numeric, item
   on the request_line. */

	     if ch = "/"
	     then do;				/* Beginning of regular expression. */


		     call get_string (match_string, "1"b, code);
		     if code ^= 0
		     then do;
			     p_code = code;
			     return;
			end;

		     if forward
		     then call audit_file_position_$forward_search (addr (new_current_position), match_string,
			     addr (position_info), code);
		     else call audit_file_position_$backward_search (addr (new_current_position), match_string,
			     addr (position_info), code);
		     if code ^= 0
		     then do;
			     p_code = code;
			     call ioa_$ioa_switch (default_iocb, "Search failed. ^a", match_string);
			     request_line_length = 0;
			     request_line = "";
			     return;
			end;
		     forward = "1"b;
		     abs_addr = "0"b;
		end;
	     else if ch = "<"
	     then do;
		     forward = "0"b;
		     substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
		     request_line_length = request_line_length - 1;
		end;
	     else if ch = "$"
	     then if ^abs_addr
		then do;
			call ioa_$ioa_switch (default_iocb, "Syntax error in address.");
			request_line_length = 0;
			request_line = "";
			p_code = 1;
			return;
		     end;
		else do;
			call audit_file_position_$last (addr (new_current_position), addr (position_info), code);
			abs_addr = "0"b;
			substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
			request_line_length = request_line_length - 1;
		     end;
	     else if ch = "," | ch = ";"
	     then if have_begin_position
		then do;
			call ioa_$ioa_switch (default_iocb, "Syntax error in address.");
			request_line_length = 0;
			request_line = "";
			p_code = 1;
			return;
		     end;
		else do;
			new_begin_position = new_current_position;
			if ch = ","
			then new_current_position = current_position;
			have_begin_position = "1"b;
			substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
			request_line_length = request_line_length - 1;
			abs_addr = "1"b;
		     end;
	     else if ch = "+"
	     then do;
		     abs_addr = "0"b;
		     subtract_addr = "0"b;
		     add_addr = "1"b;
		     substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
		     request_line_length = request_line_length - 1;
		end;
	     else if ch = "-"
	     then do;
		     abs_addr = "0"b;
		     add_addr = "0"b;
		     subtract_addr = "1"b;
		     substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
		     request_line_length = request_line_length - 1;
		end;
	     else do;
		     continue = "0"b;
		end;

	end;
	new_end_position = new_current_position;
	if ^have_begin_position
	then new_begin_position = new_current_position;
	begin_position = new_begin_position;
	current_position = new_current_position;
	end_position = new_end_position;
	call replace_buffer_with_entry (current_position);
	p_code = 0;
     end;

get_string:
     proc (p_string, p_beginning_delim, p_code);
	dcl     (code, p_code)	 fixed bin (35);
	dcl     p_string		 char (*) varying;
	dcl     str		 char (512) varying;
	dcl     p_beginning_delim	 bit (1);
	dcl     search_string	 char (2);
	dcl     search_index	 fixed bin;

	if p_beginning_delim
	then do;					/* The string is supposed to begin with a delimiter,
						   so get it. */
		string_delimiter = substr (request_line, 1, 1);
		substr (request_line, 1, request_line_length - 1) = substr (request_line, 2);
		request_line_length = request_line_length - 1;
	     end;

	code = 2;
	str = "";
	search_string = "\" || string_delimiter;

	do while (request_line_length > 0 & code = 2);
	     search_index = search (request_line, search_string);
	     if search_index = 0
	     then call missing_delim;
	     else if substr (request_line, search_index, 1) = string_delimiter
	     then call add_rest_of_str;
	     else if search_index = request_line_length
	     then call missing_delim;
	     else if substr (request_line, search_index + 1, 1) ^= "c"
	     then call add_char_to_str;
	     else if search_index + 2 = request_line_length
	     then do;
		     str = str || substr (request_line, 1, search_index - 1)
			|| substr (request_line, search_index + 2, 1);
		     if blk.current_flags.use_editor_prompt
		     then call put_prompt;

		     call iox_$get_line (default_iocb, request_line_ptr, max_request_line_length, request_line_length,
			code);
		     if code = 0
		     then code = 2;
		end;
	     else if substr (request_line, search_index + 2, 1) = string_delimiter
	     then do;
		     str = str || substr (request_line, 1, search_index - 1) || string_delimiter;
		     substr (request_line, 1, request_line_length - (search_index + 2)) =
			substr (request_line, search_index + 3);
		     request_line_length = request_line_length - (search_index + 2);
		end;
	     else call add_char_to_str;
	end;

	if code = 2
	then call missing_delim;
	p_code = code;
	p_string = str;
	return;

missing_delim:
     proc;
	call ioa_$ioa_switch (default_iocb, "Missing delimiter. ^a", string_delimiter);
	request_line_length = 0;
	request_line = "";
	code = error_table_$no_stmt_delim;
	str = "";
     end;

add_rest_of_str:
     proc;
	str = str || substr (request_line, 1, search_index - 1);
	substr (request_line, 1, request_line_length - search_index) = substr (request_line, search_index + 1);
	request_line_length = request_line_length - search_index;
	code = 0;
     end;

add_char_to_str:
     proc;
	str = str || substr (request_line, 1, search_index);
	substr (request_line, 1, request_line_length - search_index) = substr (request_line, search_index + 1);
	request_line_length = request_line_length - search_index;
     end;
     end;



replace_buffer_with_entry:
     proc (position);
	dcl     1 position		 like position_template;

	edit_buffer_length = position.aep -> audit_entry.entry_length;
	edit_buffer = substr (position.aep -> audit_entry.string, 1, position.aep -> audit_entry.entry_length);
     end;

finish:
     proc;
	if p_code ^= 0
	then do;
		p_actual_len = 0;
		param_buffer = "";
	     end;
	else if edit_buffer_length > p_buff_len
	then do;
		p_buff_ptr = blk.temp_seg_ptr;
		blk.work_space = p_buff_ptr;
		blk.work_space_len = edit_buffer_length;
		p_buff_len = sys_info$max_seg_size * 4;
		p_actual_len = edit_buffer_length;
		param_buffer = edit_buffer;
	     end;

	else do;
		p_actual_len = edit_buffer_length;
		param_buffer = edit_buffer;
	     end;

	if allocation (con_last_return_line) > level
	then free con_last_return_line;
	static_level = level - 1;
	con_last_return_line.string = aut_last_return_line.string;
	con_last_return_line.not_in_string = aut_last_return_line.not_in_string;

	call release_temp_segments_ ("audit_editor", temp_seg_ptr, code);
	if code ^= 0
	then p_code = code;
     end;						/* Include */

%include iocbx;
%include audit_position;
%include audit_entry;
%include audit_block;
%include audit_file_header;
     end;




		    audit_file_position_.pl1        09/15/88  1342.7rew 09/15/88  1341.2      267516



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(88-08-02,TLNguyen), approve(88-08-02,MCR7939),
     audit(88-09-14,Parisek), install(88-09-15,MR12.2-1110):
     a. Return error_table_$bad_file when the audit file contains gargage
        or nothing other than the header.
     b. Remove the external entry named find_valid_entry because pcref
        shows it has no caller and is virtually useless anyway.
                                                   END HISTORY COMMENTS */


/* format: style2,ind3 */
audit_file_position_:
   proc;
      return;					/* Not a valid entry. */

/* The entries in this procedure are all of the entries used for getting
   around in the audit file.  The position_info structure is used to specify
   various things about the state of the audit file which some of theses
   procedures need to know.  The entries are:

move_number - move a specified number of entries either relative to the
   current position or from the beginning of the file.

move_time - move to a specified time, relative to the current entry or an
   absolute time.

forward_search - search forward through the audit file for an entry which
   contains a match for the specified regular expression (qedx style).

backward_search - search backward through the audit file for and entry which
   contains a match for the specified regular expression.

next	  - move to the next entry.
   
previous	  - move to the previous entry.

first	  - move to the first entry in the file.

last	  - move to the last entry in the file.

count_last - count to the last entry in the file.  Unlike "last", this entry
   sets the entry_number in the position structure.

set_count	  - set the count in the position structure to be the count up to
   the current entry, given the class id of the current entry.  The "any
   entry" flag in the position info structure is ignored by this entry.


12/08/78 Written by Lindsey L. Spratt

Modified:
   12/08/79 by Lindsey Spratt: Add the count_last and set_count entries.
   10/26/80 by Lindsey Spratt: Change spurious error code
	     incompatible_operations to be "inconsistent". Changed set_count
	     to set the class_identifier in the position structure to "" if
	     the "any entry" bit is on in the position_info structure.
06/02/82 by Lindsey Spratt: Change go_to_first and go_to_last internal
	  procedures to  set the component_max_char_index correctly when the
	  audit file is circular.
	       Also, changed "move_number" from being a synonym label for
	  audit_file_position_ to being a separate entrypoint label.  
06/03/82 by Lindsey Spratt: Fixed bug in setting of last entry position when
	  the file is circular.
06/04/82 by Lindsey Spratt: Fixed problem in go_to_previous_entry which was
	  generating a size or subscriptrange error.  msf_manager_$get_ptr
	  returns the bit count of the component when the component was
	  first initiated for the "current" opening of the MSF, not the
	  current bit count as one might expect.  The fix is to do an
	  explicit hcs_$status_mins to determine the bit count.
06/08/82 by Lindsey Spratt: Fixed go_to_last to behave correctly when the
	  position_info.audit_index = 0, meaning the "last" entry is at the
	  end of the "previous" component.  This comes up when updating the
	  metering info is being done by audit_ (in insert_line) and the
	  entry being inserted is to large to fit in the current component,
	  hence the new entry is being placed at index 0 of the "next"
	  component (which is now the  current component) and the  last
	  entry is at the end of the previous component.
10/13/82 by Lindsey Spratt:  Added limits to all loops.  The limit is somewhat
	  arbitrarily set to by assuming that an audit file won't have more
	  than 1000 components, each of 255 pages, each page having no more
	  than 128 audit entries.  These loop limits are to prevent any
	  infinite looping, no matter how damaged the audit file may be.
	  Added explicit subscriptrange condition enabling for setting the
	  position.aep pointer by indexing into file_char_array by
	  position.char_index.
03/16/83 by Lindsey Spratt:  Updated the search_file_ entry declaration to fix
	  a size condition.
*/

      dcl	    (p_position_ptr, p_position_info_ptr)
			       ptr;
      dcl	    (time, p_time)	       fixed bin (71);
      dcl	    1 p_position	       based (p_position_ptr) like position_template;
      dcl	    1 position	       like position_template;
      dcl	    1 position_info	       based (p_position_info_ptr) like position_info_template;
      dcl	    error_table_$bad_file  fixed bin (35) ext static;
      dcl	    error_table_$empty_file
			       fixed bin (35) ext;
      dcl	    error_table_$end_of_info
			       fixed bin (35) ext;
      dcl	    error_table_$nomatch   fixed bin (35) ext;
      dcl	    (p_abs, p_add, p_subtract)
			       bit (1);
      dcl	    add		       bit (1);
      dcl	    (p_number, number)     fixed bin;
      dcl	    entry_idx	       fixed bin (35);
      dcl	    entry_number	       fixed bin;
      dcl	    (code, p_code)	       fixed bin (35);
      dcl	    type		       fixed bin (2);
      dcl	    MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
			       init (3.264e7) /* 1000 components * 255 pages/component * 128 entries/page */
			       fixed bin (35) internal static options (constant);
      dcl	    error_table_$inconsistent
			       fixed bin (35) ext;
      dcl	    search_file_	       entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21),
			       fixed bin (21), fixed bin (21), fixed bin (35));
      dcl	    hcs_$status_mins       entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
      dcl	    msf_manager_$get_ptr   entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));

/* Builtin */

      dcl	    (abs, addr, addrel, bin, currentsize, divide, length, mod, size, substr)
			       builtin;

move_number:
   entry (p_position_ptr, p_abs, p_add, p_subtract, p_number, p_position_info_ptr, p_code);

      position = p_position;
      p_code, code = 0;


/* An exclusive or  is done over the input switches to check that one and
   only one is "1"b and the other two are "0"b. */

      if (bin (p_abs) + bin (p_add) + bin (p_subtract)) ^= 1
      then
         do;
	  p_code = error_table_$inconsistent;
	  return;
         end;
      else if p_abs
      then
         do;
	  if (position.entry_number = 0 | position.search_tag ^= position_info.default_search_tag)
	  then
	     do;
	        call go_to_first_entry (position, code);
	        number = p_number - 1;
	        add = "1"b;
	     end;
	  else
	     do;
	        number = p_number - position.entry_number;
	        if number < 0
	        then
		 do;
		    add = "0"b;
		    number = abs (number);
		 end;
	        else add = "1"b;
	     end;
         end;
      else
         do;
	  add = p_add;
	  number = p_number;
         end;


      if add
      then
         do entry_number = 1 to number while (code = 0);
	  call go_to_next_entry (position, code);
         end;
      else
         do entry_number = 1 to number while (code = 0);
	  call go_to_previous_entry (position, code);
         end;
      if code ^= 0
      then if code ^= error_table_$end_of_info
	 then
	    do;
	       p_code = code;
	       return;
	    end;
      p_code = code;
      p_position = position;
      return;



move_time:
   entry (p_position_ptr, p_abs, p_add, p_subtract, p_time, p_position_info_ptr, p_code);
      position = p_position;
      p_code, code = 0;

      if (bin (p_abs) + bin (p_add) + bin (p_subtract)) ^= 1
      then
         do;
	  p_code = error_table_$inconsistent;
	  return;
         end;
      else if p_abs
      then
         do;
	  call go_to_first_entry (position, code);
	  time = p_time;
	  add = "1"b;
         end;
      else if p_add
      then
         do;
	  time = position.aep -> audit_entry.time + p_time;
	  add = "1"b;
         end;
      else
         do;
	  time = position.aep -> audit_entry.time - p_time;
	  if time < 0
	  then time = 0;
	  add = "0"b;
         end;

      if add
      then
         do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
	  while (position.aep -> audit_entry.time < time & code = 0);
	  call go_to_next_entry (position, code);
         end;
      else
         do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
	  while (position.aep -> audit_entry.time > time & code = 0);
	  call go_to_previous_entry (position, code);
         end;

      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then code = error_table_$bad_file;

      if code ^= 0
      then if code ^= error_table_$end_of_info
	 then
	    do;
	       p_code = code;
	       return;
	    end;
      p_code = code;
      p_position = position;

      return;


forward_search:
   entry (p_position_ptr, p_match_str, p_position_info_ptr, p_code);
      dcl	    (p_match_str, match_str)
			       char (256) varying;
      dcl	    (forward, continue)    bit (1) init ("1"b);
      dcl	    (match_begin, match_end)
			       fixed bin(21);
      dcl	    do_first_entry	       bit (1);

      goto START;

backward_search:
   entry (p_position_ptr, p_match_str, p_position_info_ptr, p_code);

      forward = "0"b;

START:
      p_code, code = 0;
      position = p_position;
      match_str = p_match_str;

      do_first_entry = "1"b;
      do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
         while ((continue & (position.aep ^= p_position.aep)) | do_first_entry);
         do_first_entry = "0"b;
         if forward
         then call go_to_next_entry (position, code);
         else call go_to_previous_entry (position, code);
         if code ^= 0
         then if code = error_table_$end_of_info
	    then
	       do;
		code = 0;
		if forward
		then call go_to_first_entry (position, code);
		else call go_to_last_entry (position, code);
		if code ^= 0
		then continue = "0"b;
	       end;
	    else
	       do;
		p_code = code;
		return;
	       end;
         call
	  search_file_ (addrel (addr (match_str), 1), 1, length (match_str), addr (position.aep -> audit_entry.string),
	  1, (position.aep -> audit_entry.entry_length), match_begin, match_end, code);
         if code ^= 1
         then continue = "0"b;
         else match_str = "";
      end;
      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then code = error_table_$bad_file;

      if code = 0
      then p_position = position;
      else if code = 1
      then code = error_table_$nomatch;

      p_code = code;
      return;


next:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      call go_to_next_entry (p_position, p_code);
      return;

previous:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      call go_to_previous_entry (p_position, p_code);
      return;

first:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      call go_to_first_entry (p_position, p_code);
      return;

last:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      call go_to_last_entry (p_position, p_code);
      return;

count_last:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      call go_to_first_entry (p_position, p_code);
      if p_code ^= 0
      then return;
      do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (p_code = 0);
         call go_to_next_entry (p_position, p_code);
      end;
      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then p_code = error_table_$bad_file;

      if p_code = error_table_$end_of_info
      then p_code = 0;
      return;


set_count:
   entry (p_position_ptr, p_position_info_ptr, p_code);
      p_code, code = 0;
      position = p_position;
      call go_to_first_entry (position, p_code);
      if p_code ^= 0
      then return;
      do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (position.aep ^= p_position.aep);
         call go_to_next_entry (position, p_code);
      end;
      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then
         do;
	  p_code = error_table_$bad_file;
	  return;
         end;

      p_position = position;
      if position_info.any_tag
      then p_position.search_tag = "";
      return;
%page;
go_to_next_entry:
   proc (p_position, p_code);
      dcl	    entry_idx	       fixed bin (35);
      dcl	    1 p_position	       like position_template;
      dcl	    1 position	       like position_template;
      dcl	    1 last_position	       like position_template;
      dcl	    (code, p_code)	       fixed bin (35);
      dcl	    bit_count24	       fixed bin (24);
      dcl	    file_char_array	       (0:position.component_max_char_index) char (1) based (position.component_ptr);
      dcl	    tag_match	       bit (1);
      p_code, code = 0;
      tag_match = "0"b;
      position = p_position;
      last_position = p_position;
      call go_to_last_entry (last_position, code);

      if (position.component_number = last_position.component_number) & (position.char_index = last_position.char_index)
      then
         do;
	  p_code = error_table_$end_of_info;
	  return;
         end;

      do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
         while
         ((position.component_number ^= last_position.component_number | position.char_index ^= last_position.char_index)
         & ^tag_match);
         position.char_index =
	  position.char_index + (currentsize (position.aep -> audit_entry) * 4) + 7
	  - mod ((currentsize (position.aep -> audit_entry) * 4) + 7, 8);

         if position.char_index >= position.component_max_char_index
         then if position.component_number = position_info.max_component
	    then
	       do;
		if position_info.max_component ^= 0
		then
		   do;
		      position.component_number = 0;
		      position.component_ptr = position_info.audit_ptr;
		      if position_info.current_component = 0
		      then position.component_max_char_index = position_info.audit_index;
		      else
		         do;
			  call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
			  if code ^= 0
			  then
			     do;
			        p_code = code;
			        return;
			     end;
			  call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
			  if code ^= 0
			  then
			     do;
			        p_code = code;
			        return;
			     end;
			  position.component_max_char_index = divide (bit_count24, 9, 24, 0);
			  position.component_max_char_index =
			     position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
		         end;
		   end;
		else position.component_max_char_index = position_info.audit_index - 1;
		position.char_index =
		   (size (audit_file_header) * 4) + 7 - mod ((size (audit_file_header) * 4) + 7, 8);
	       end;
	    else
	       do;
		position.component_number = position.component_number + 1;
		if position.component_number = position_info.current_component
		then
		   do;
		      position.char_index = 0;
		      position.component_ptr = position_info.audit_ptr;
		      position.component_max_char_index = position_info.audit_index - 1;
		   end;
		else if position.component_number = position_info.max_component
		then
		   do;
		      position.char_index = 0;
		      call
		         msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b,
		         position.component_ptr, bit_count24, code);
		      position.component_max_char_index = position_info.max_index;
		   end;
		else
		   do;
		      position.char_index = 0;
		      call
		         msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b,
		         position.component_ptr, bit_count24, code);
		      if code ^= 0
		      then
		         do;
			  p_code = code;
			  return;
		         end;
		      position.component_max_char_index = divide (bit_count24, 9, 24, 0);
		      position.component_max_char_index =
		         position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
		   end;
	       end;
(subscriptrange):
         position.aep = addr (file_char_array (position.char_index));
         call validate_entry (position, p_code);
         if p_code ^= 0
         then return;
         if position_info.any_tag
         then tag_match = "1"b;
         else call set_tag_match (position.aep, position_info.default_search_tag, tag_match);
      end;
      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then
         do;
	  p_code = error_table_$bad_file;
	  return;
         end;

      if tag_match
      then
         do;
	  if (position.entry_number ^= 0 & position.search_tag = position_info.default_search_tag)
	  then position.entry_number = position.entry_number + 1;
	  else
	     do;
	        position.entry_number = 0;
	        position.search_tag = "";
	     end;
	  p_position = position;
	  p_code = 0;
         end;
      else p_code = error_table_$end_of_info;
   end go_to_next_entry;
%page;
go_to_previous_entry:
   proc (p_position, p_code);
      dcl	    tag_match	       bit (1);
      dcl	    entry_idx	       fixed bin (35);
      dcl	    1 position	       like position_template;
      dcl	    1 p_position	       like position_template;
      dcl	    (code, p_code)	       fixed bin (35);
      dcl	    bit_count24	       fixed bin (24);
      dcl	    file_char_array	       (0:position.component_max_char_index) char (1) based (position.component_ptr);
      p_code, code = 0;
      tag_match = "0"b;
      position = p_position;

      if (position.component_number = position_info.begin_component) & (position.char_index = position_info.begin_index)
      then
         do;
	  p_code = error_table_$end_of_info;
	  return;
         end;

      do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
         while
         ((position.component_number ^= position_info.begin_component | position.char_index ^= position_info.begin_index)
         & ^tag_match);

         position.char_index =
	  position.char_index
	  - (position.aep -> audit_entry.last_entry_length + 7
	  - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4));

/* Check if the char_index has crossed a component boundary.  If so reset char_index
   component_number, component_ptr, and component_max_char_index appropriately.
*/

         if position.component_number = 0
	  & position.char_index < ((size (audit_file_header) * 4) + 7 - mod ((size (audit_file_header) * 4) + 7, 8))
						/* The beginning of the zero-th component is after the header. */
         then
	  do;
	     if position_info.file_limit
	     then
	        do;
		 if position_info.max_component ^= position.component_number
		 then
		    do;
		       position.component_number = position_info.max_component;
		       call
			msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b,
			position.component_ptr, bit_count24, code);
		       if code ^= 0
		       then
			do;
			   p_code = code;
			   return;
			end;
		    end;
		 call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
		 if code ^= 0
		 then
		    do;
		       p_code = code;
		       return;
		    end;
		 position.component_max_char_index = divide (bit_count24, 9, 24, 0);
		 position.component_max_char_index =
		    position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
	        end;

	     else
	        do;
		 position.component_number = position_info.current_component;
		 position.component_max_char_index = position_info.audit_index - 1;
		 position.component_ptr = position_info.audit_ptr;
	        end;
	     position.char_index =
	        position.component_max_char_index
	        - (position.aep -> audit_entry.last_entry_length + 7
	        - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4));
	  end;
         else if position.char_index < 0
         then
	  do;
	     position.component_number = position.component_number - 1;
	     call
	        msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr,
	        bit_count24, code);
	     if code ^= 0
	     then
	        do;
		 p_code = code;
		 return;
	        end;
	     call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
	     if code ^= 0
	     then
	        do;
		 p_code = code;
		 return;
	        end;
	     position.component_max_char_index = divide (bit_count24, 9, 24, 0);
	     position.component_max_char_index =
	        position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
	     position.char_index =
	        position.component_max_char_index
	        - (position.aep -> audit_entry.last_entry_length + 7
	        - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4));
	  end;
(subscriptrange):
         position.aep = addr (file_char_array (position.char_index));
         call validate_entry (position, p_code);
         if p_code ^= 0
         then return;
         if position_info.any_tag
         then tag_match = "1"b;
         else call set_tag_match (position.aep, position_info.default_search_tag, tag_match);
      end;
      if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE
      then
         do;
	  p_code = error_table_$bad_file;
	  return;
         end;

      if tag_match
      then
         do;
	  if (position.entry_number ^= 0 & position.search_tag = position_info.default_search_tag)
	  then position.entry_number = position.entry_number - 1;
	  else
	     do;
	        position.entry_number = 0;
	        position.search_tag = "";
	     end;

	  p_position = position;
	  p_code = 0;
         end;

      else p_code = error_table_$end_of_info;
   end go_to_previous_entry;
%page;
go_to_last_entry:
   proc (p_position, p_code);
      dcl	    1 p_position	       like position_template;
      dcl	    1 position	       like position_template;
      dcl	    file_char_array	       (0:position.component_max_char_index) char (1) based (position.component_ptr);
      dcl	    bit_count24	       fixed bin (24);
      dcl	    tag_match	       bit (1);
      dcl	    (p_code, code)	       fixed bin (35);

/* The last_entry_length is initialized by audit_attach (called by the command
attach_audit) to the value impossible_audit_entry_length.  This value is
declared in the audit_entry.incl.pl1 include file.
*/
      p_code, code = 0;
      if position_info.last_entry_length = impossible_audit_entry_length
      then
         do;
	  p_code = error_table_$empty_file;
	  return;
         end;
      if position_info.audit_index = (size (audit_file_header) * 4) + 7 - mod (size (audit_file_header) * 4 + 7, 8)
         & position_info.file_limit
      then
         do;
	  position.component_number = position_info.max_component;
	  call
	     msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr,
	     bit_count24, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
         end;
      else if position_info.audit_index = 0
      then
         do;
	  position.component_number = position_info.current_component - 1;
	  call
	     msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr,
	     bit_count24, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
         end;
      else
         do;
	  position.component_number = position_info.current_component;
	  position.component_ptr = position_info.audit_ptr;
         end;

      if (position_info.audit_index = 0
         | (position_info.file_limit
         & (position_info.begin_component > position_info.current_component
         | (position_info.begin_component = position_info.current_component
         & position_info.begin_index > position_info.audit_index))))
      then
         do;
	  call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
	  position.component_max_char_index = divide (bit_count24, 9, 24, 0);
	  position.component_max_char_index =
	     position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
         end;
      else position.component_max_char_index = position_info.audit_index;

      if (position_info.audit_index = 0
         | (position_info.file_limit
         & position_info.audit_index = (size (audit_file_header) * 4) + 7 - mod (size (audit_file_header) * 4 + 7, 8)))
      then position.char_index =
	    position.component_max_char_index
	    - (position_info.last_entry_length + 7 - mod (position_info.last_entry_length + 7, 8)
	    + audit_entry_header_length);
      else position.char_index =
	    position_info.audit_index
	    - (position_info.last_entry_length + 7 - mod (position_info.last_entry_length + 7, 8)
	    + audit_entry_header_length);

(subscriptrange):
      position.aep = addr (file_char_array (position.char_index));
      position.entry_number = 0;
      position.search_tag = "";
      call validate_entry (position, p_code);
      if p_code ^= 0
      then return;

      if position_info.any_tag
      then tag_match = "1"b;
      else call set_tag_match (position.aep, position_info.default_search_tag, tag_match);
      if ^tag_match
      then
         do;
	  call go_to_previous_entry (position, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
         end;
      p_code = 0;
      p_position = position;
   end go_to_last_entry;
%page;
go_to_first_entry:
   proc (p_position, p_code);
      dcl	    1 p_position	       like position_template;
      dcl	    1 position	       like position_template;
      dcl	    (p_code, code)	       fixed bin (35);
      dcl	    tag_match	       bit (1);
      dcl	    bit_count24	       fixed bin (24);
      dcl	    file_char_array	       (0:position.component_max_char_index) char (1) based (position.component_ptr);
      p_code, code = 0;
      position = p_position;

      if position_info.last_entry_length < 0
      then
         do;
	  p_code = error_table_$empty_file;
	  return;
         end;

      if position.component_number ^= position_info.begin_component
      then
         do;
	  position.component_number = position_info.begin_component;
	  position.char_index = position_info.begin_index;

	  if position_info.current_component = position_info.begin_component
	     & position_info.begin_index < position_info.audit_index
	  then position.component_ptr = position_info.audit_ptr;
	  else
	     do;
	        call
		 msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b,
		 position.component_ptr, bit_count24, code);
	        if code ^= 0
	        then
		 do;
		    p_code = code;
		    return;
		 end;
	     end;
         end;

      else position.char_index = position_info.begin_index;

      if (position_info.file_limit
         & (position_info.begin_component > position_info.current_component
         | (position_info.begin_component = 0 & position_info.begin_index >= position_info.audit_index)))
         | (^position_info.file_limit & position_info.current_component > 0)
      then
         do;
	  call hcs_$status_mins (position.component_ptr, type, bit_count24, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
	  position.component_max_char_index = divide (bit_count24, 9, 24, 0);
	  position.component_max_char_index =
	     position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8);
         end;
      else position.component_max_char_index = position_info.audit_index;

(subscriptrange):
      position.aep = addr (file_char_array (position.char_index));
      call validate_entry (position, p_code);
      if p_code ^= 0
      then return;
      if position_info.any_tag
      then tag_match = "1"b;
      else call set_tag_match (position.aep, position_info.default_search_tag, tag_match);

      if ^tag_match
      then
         do;
	  call go_to_next_entry (position, p_code);
	  if p_code ^= 0
	  then return;
         end;

      position.entry_number = 1;
      position.search_tag = position_info.default_search_tag;
      p_position = position;
      p_code = 0;
   end go_to_first_entry;
%page;
set_tag_match:
   proc (p_ptr, p_search_tag, p_tag_match);
      dcl	    p_ptr		       ptr;
      dcl	    p_search_tag	       char (32) varying;
      dcl	    p_tag_match	       bit (1);

      p_tag_match = (substr (p_ptr -> audit_entry.tag, 1, length (p_search_tag)) = p_search_tag);
   end set_tag_match;

validate_entry:
   proc (p_position, p_code);
                                                             /* parameters */
      dcl	    1 p_position	       like position_template; /* input */
      dcl	    p_code	       fixed bin (35);         /* input/output */

/* begin coding */
      p_code = 0;

      if p_position.aep -> audit_entry.tag = ""
      then p_code = error_table_$bad_file;

      return;

   end validate_entry;
%page;
%include audit_entry;
%include audit_position;
%include audit_file_header;
   end audit_file_position_;




		    detach_audit.pl1                12/09/83  1014.2rew 12/09/83  0951.9       34749



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* format: style2,ind3 */
detach_audit:
dta:
   proc;

/*  This module turns off auditing for the calling process.  The single parameter
   is the switchname of the switch attached via the audit_ module that is to be detached.

Modified:
11/12/81 by Lindsey Spratt: changed the variable "whoami" to "MYNAME", making
	  it an internal constant as well.
10/13/82 by Lindsey Spratt:  Changed to destroy the new_iocb, which is no
	  longer needed after the move_attach.  Also, removed the
	  set_safety_sw, as this is done by iox_$close.  Changed to
	  use error_table_$badopt when too many args are given, rather than
	  a 0 error code.
*/

/*  Automatic  */

      dcl	    nargs		       fixed bin;
      dcl	    tc		       fixed bin;
      dcl	    tp		       ptr;
      dcl	    blkptr	       ptr;
      dcl	    old_iocb	       ptr;
      dcl	    new_iocb	       ptr;
      dcl	    code		       fixed bin (35);

/*  Based  */

      dcl	    targ		       char (tc) based (tp);

/* Constant */

      dcl	    MYNAME	       char (12) init ("detach_audit") internal static options (constant);

/* Entries  */

      dcl	    audit_$audit_close     entry;
      dcl	    cu_$arg_count	       entry (fixed bin);
      dcl	    cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin, fixed bin (35));
      dcl	    ioa_$ioa_switch	       entry options (variable);
      dcl	    iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));
      dcl	    iox_$move_attach       entry (ptr, ptr, fixed bin (35));
      dcl	    iox_$detach_iocb       entry (ptr, fixed bin (35));
      dcl	    iox_$destroy_iocb      entry (ptr, fixed bin (35));
      dcl	    iox_$close	       entry (ptr, fixed bin (35));
      dcl	    com_err_	       entry options (variable);

/* External */

      dcl	    error_table_$badopt    fixed bin (35) ext;

      call cu_$arg_count (nargs);
      if nargs > 1
      then
         do;
	  call com_err_ (error_table_$badopt, MYNAME, "Too many arguments.^/Usage: detach_audit {switchname}");
	  return;
         end;
      else if nargs = 1
      then call cu_$arg_ptr (1, tp, tc, code);
      else
         do;
	  tc = 8;
	  alloc targ;
	  targ = "user_i/o";
         end;
      call iox_$look_iocb ((targ), old_iocb, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, MYNAME, "while looking for ^a", targ);
	  return;
         end;

      if old_iocb -> iocb.close ^= audit_$audit_close
      then
         do;
	  call com_err_ (0, MYNAME, "^a not attached via audit_", targ);
	  return;
         end;

      blkptr = old_iocb -> iocb.attach_data_ptr;
      new_iocb = blkptr -> blk.auditing_iocb;

      call iox_$close (old_iocb, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, MYNAME, "while closing ^a switch", targ);
	  return;
         end;

      call iox_$detach_iocb (old_iocb, code);
      if code ^= 0
      then
         do;
	  call ioa_$ioa_switch (new_iocb, "Couldn't detach ^a", targ);
	  return;
         end;


      call iox_$move_attach (new_iocb, old_iocb, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, MYNAME, "while moving attachment from ^a to ^a", new_iocb -> iocb.name, targ);
	  return;
         end;

      call iox_$destroy_iocb (new_iocb, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, MYNAME, "Unable to destroy the auditing iocb.  Auditing was successfully 
detached for switch ""^a"", however.", targ);
         end;

      return;

/*  Include  */

%include iocb;
%include audit_block;

   end;




		    display_audit_file.pl1          09/26/88  1315.4rew 09/26/88  1313.6      430173



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1988                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(88-08-02,TLNguyen), approve(88-08-02,MCR7939),
     audit(88-09-14,Parisek), install(88-09-15,MR12.2-1110):
     The display_audit_file command will display an appropriate error message
     when a nonstandard pathname is specified for -ouput_file.
  2) change(88-09-23,TLNguyen), approve(88-09-23,MCR7939),
     audit(88-09-23,Parisek), install(88-09-26,MR12.2-1120):
     Move lines of code such that expand_pathname_ is called first to get the
     output_file_dir and output_file_entry.  Then call check_star_name_ given
     the output_file_entry, whose length is less or equal to 32 chars.
                                                   END HISTORY COMMENTS */


/* format: style2,ind3 */
display_audit_file:
daf:
   proc;

/* This command produces formatted output from an audit file produced by the
   audit_ I/O module.  The entries of the audit file which are displayed are
   chosen by determining the lowest and highest numbered entries which may be
   displayed as indicated by the positioning control arguments (-from, -to,
   -next, -last); then ascertaining which entries within this range have the
   correct string and class characteristics (as indicated by the -match,
   -exclude, and -class control arguments).  The format of the output is
   determined by the -reverse, -line_length, -metering, -entry_numbers, and
   -class_identifiers control arguments.  Additional format control is
   provided by the -append_nl, -no_append_nl, -insert_nl, and -no_insert_nl
   control arguments.  The output may be directed to an output file by the
   -output_file control argument.

   Written  1/1/79  by  Lindsey L. Spratt
   Modified:
   11/26/79  by  Lindsey Spratt: Use myname variable in calls to com_err_,
			   to correct error reporting of duplicate args.
   12/12/79  by  Lindsey Spratt: Add -insert_nl, -no_insert_nl, -append_nl,
			   -no_append_nl. Also fixed a bug in wrap_line
			   on printing long lines which don't end in a
			   new line.
   05/01/80  by  Lindsey Spratt: Spaces were being inserted at the beginning of
			   each line of output, this was removed for
			   "headerless" and "unwrapped" display.  The
			   ".audit" suffix is now assumed if not
			   supplied.
   10/27/80  by  Lindsey Spratt: The -output_file control argument was added.
	       The various ioa_ calls were changed to ioa_$ioa_switch calls
	       to use the newly added output_iocb_ptr. The simplest nnl
	       output case was modified to prevent ioa_ from stripping
	       trailing whitespace.
09/09/81 by Lindsey Spratt: Added checks for non-zero codes after the attach
	  and open calls for setting up the output file.  This fixes bug 22.
	  Also, made the argument to -class case insensitive and added some
	  code to validate that the argument does identify a class, bug 20.
            Improved the unrecognized control argument error message, bug 18.
11/12/81 by Lindsey Spratt: Fixed spelling in an error message.  Changed class
	  validation to use an internal static constant array of valid
	  classes, VALID_AUDIT_CLASS.
10/13/82 by Lindsey Spratt:  Fixed bug where all of the "strings" were being
	  placed in one long list, as opposed to separate lists for the
	  -match, -exclude and -class control args.  Added check to prevent
	  the specification of the audit file as the output file.
10/15/82 by Lindsey Spratt:  Added check of position entry number arguments to
	  prevent size conditions.  Added -str as a short name for -string.
	  Added check for arguments following control arguments which
	  require them.  Changed -fm to produce an error message if the
	  position specified is beyond the end of the file, rather than just
	  selecting the last line of the file.
*/

/* Automatic */

      dcl	    current_component_string
			       pic "zzzzzzzzzz9";
      dcl	    (match_begin, match_end)
			       fixed bin;
      dcl	    switchname	       char (32);
      dcl	    output_file_entry      char (32) init ("");
      dcl	    output_file_dir	       char (168) init ("");
      dcl	    pathname	       char (168) varying;
      dcl	    arg_number	       fixed bin (35);
      dcl	    bit_count	       fixed bin (24);
      dcl	    1 position_info	       like position_info_template;
      dcl	    1 position	       like position_template;
      dcl	    1 begin_position       like position_template;
      dcl	    1 end_position	       like position_template;
      dcl	    (iocb_ptr, area_ptr, arg_ptr, old_string_list_ptr, chain_ptr, string_list_ptr, match_string_list_ptr,
	    output_file_ptr, exclude_string_list_ptr, blkptr, match_class_string_list_ptr)
			       ptr init (null);
      dcl	    output_file_attach_description
			       char (256) varying;
      dcl	    output_iocb_ptr	       ptr;
      dcl	    code		       fixed bin (35);
      dcl	    arg_len	       fixed bin;
      dcl	    (nargs, argno, output_line_length)
			       fixed bin;
      dcl	    class_idx	       fixed bin;
      dcl     starname_type          fixed bin (2);

      dcl	    (have_begin, have_path, have_end, do_last_position, continuation, want_begin_addr, want_end_addr,
	    want_line_length, want_switchname, want_output_file, looking_for_string, found_string, string_sw,
	    have_switchname, have_displayed, display, control_argument, reverse, match, exclude, class,
	    processing_class_control_argument, class_identifiers, entry_numbers, metering, leader, insert_nl, header,
	    use_force_append_nl, use_force_insert_nl, force_insert_nl, force_append_nl, append_nl)
			       bit (1) init ("0"b);
      dcl	    1 begin_arg,
	      2 value	       char (32) varying,
	      2 value_is_string    bit (1),
	      2 abs	       bit (1),
	      2 add	       bit (1),
	      2 subtract	       bit (1);
      dcl	    1 end_arg	       like begin_arg;

/* Based */
      dcl	    arg		       based (arg_ptr) char (arg_len);
      dcl	    area		       area based (area_ptr);
      dcl	    1 string_list	       based (string_list_ptr),
	      2 next	       ptr,
	      2 string	       char (128) varying;


/* Builtin */
      dcl	    addr		       builtin;
      dcl     addrel                 builtin;
      dcl	    bin		       builtin;
      dcl     dim                    builtin;
      dcl	    divide                 builtin;
      dcl     fixed                  builtin;
      dcl     hbound                 builtin;
      dcl     index                  builtin;
      dcl	    length	       builtin;
      dcl     mod                    builtin;
      dcl	    null		       builtin;
      dcl     rtrim                  builtin;
      dcl     substr                 builtin;
      dcl	    translate	       builtin;
      dcl     verify                 builtin;

/* Condition */

      dcl	    cleanup	       condition;

/* Controlled */

/* Entry */
      dcl     check_star_name_       entry (char (*), bit (36) aligned, fixed bin (2), fixed bin (35));
      dcl	    cv_dec_check_	       entry (char (*), fixed bin (35)) returns (fixed bin (35));
      dcl	    get_line_length_$switch
			       entry (ptr, fixed bin (35)) returns (fixed bin (17));
      dcl	    unique_chars_	       entry (bit (*)) returns (char (15));
      dcl	    get_system_free_area_  entry () returns (ptr);
      dcl	    audit_file_position_$next
			       entry (ptr, ptr, fixed bin (35));
      dcl	    audit_file_position_$forward_search
			       entry (ptr, char (*) varying, ptr, fixed bin (35));
      dcl	    audit_file_position_$backward_search
			       entry (ptr, char (*) varying, ptr, fixed bin (35));
      dcl	    msf_manager_$open      entry (char (*), char (*), ptr, fixed bin (35));
      dcl	    msf_manager_$get_ptr   entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
      dcl	    cu_$arg_count	       entry (fixed bin, fixed bin (35));
      dcl	    cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin, fixed bin (35));
      dcl	    com_err_	       entry options (variable);
      dcl	    ioa_$ioa_switch	       entry options (variable);
      dcl	    ioa_$ioa_switch_nnl    entry options (variable);
      dcl     ioa_$rsnnl             entry options (variable);
      dcl	    audit_file_position_$move_number
			       entry (ptr, bit (1), bit (1), bit (1), fixed bin, ptr, fixed bin (35));
      dcl	    audit_file_position_$move_time
			       entry (ptr, bit (1), bit (1), bit (1), fixed bin (71), ptr, fixed bin (35));
      dcl	    audit_file_position_$previous
			       entry (ptr, ptr, fixed bin (35));
      dcl	    audit_file_position_$first
			       entry (ptr, ptr, fixed bin (35));
      dcl	    audit_file_position_$count_last
			       entry (ptr, ptr, fixed bin (35));
      dcl     pathname_              entry (char (*), char (*)) returns (char (168));
      dcl	    search_file_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin,
			       fixed bin (35));
      dcl	    expand_pathname_       entry (char (*), char (*), char (*), fixed bin (35));
      dcl	    expand_pathname_$add_suffix
			       entry (char (*), char (*), char (*), char (*), fixed bin (35));
      dcl	    hcs_$initiate	       entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr,
			       fixed bin (35));
      dcl	    hcs_$terminate_noname  entry (ptr, fixed bin (35));
      dcl	    current_entry_number   pic "zzzz9v";

/* External */

      dcl	    (
	    error_table_$unimplemented_version,
	    error_table_$noarg,
	    error_table_$bad_arg,
	    error_table_$nomatch,
	    error_table_$end_of_info,
	    error_table_$zero_length_seg,
	    error_table_$badopt
	    )		       fixed bin (35) ext;

/* Constant */

      dcl	    myname	       char (18) internal static options (constant) init ("display_audit_file");
      dcl	    NL		       char (1) internal static options (constant) init ("
");
      dcl	    UPPERCASE_LETTERS      init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") internal static options (constant) char (26);
      dcl	    LOWERCASE_LETTERS      init ("abcdefghijklmnopqrstuvwxyz") internal static options (constant) char (26);
      dcl	    VALID_AUDIT_CLASS      (10) init ("I", "IL", "IC", "O", "OC", "E", "EL", "T", "TM", "TC") char (2)
			       varying internal static options (constant);

      header = "1"b;
      output_line_length = 0;
      old_string_list_ptr = null;
      area_ptr = get_system_free_area_ ();
      output_file_attach_description = "";
      output_iocb_ptr = iox_$user_output;
      want_output_file = "0"b;
      want_switchname = "0"b;
      looking_for_string = "0"b;
      found_string = "0"b;
      want_begin_addr = "0"b;
      want_end_addr = "0"b;
      want_line_length = "0"b;
      have_path = "0"b;
      have_begin = "0"b;
      have_end = "0"b;
      have_switchname = "0"b;
      match = "0"b;
      exclude = "0"b;
      class = "0"b;
      reverse = "0"b;
      entry_numbers = "0"b;
      class_identifiers = "0"b;
      metering = "0"b;
      leader = "0"b;
      insert_nl = "0"b;
      append_nl = "0"b;
      force_append_nl = "0"b;
      use_force_append_nl = "0"b;
      force_insert_nl = "0"b;
      use_force_insert_nl = "0"b;

      on cleanup call finish;

/*  Process the argument list. */

      call cu_$arg_count (nargs, code);
      if code ^= 0
      then
         do;
	  call com_err_ (code, myname);
	  call finish;
	  return;
         end;

      do argno = 1 to nargs;
         call cu_$arg_ptr (argno, arg_ptr, arg_len, code);
         if code ^= 0
         then
	  do;
	     call com_err_ (code, myname);
	     call finish;
	     return;
	  end;

         string_sw = "0"b;


/*  Determine whether the current arg is a control argument, or an
   argument.  The -string arg sets arg to the next argument in the argument list
   and forces its interpretation as a non-control argument  by
   turning control_argument off and forces its interpretation as a string by
   turning string_sw on.  Only -from, -last, -to, -next care about
   the string_sw.
*/

         if arg = "-string" | arg = "-str"
         then
	  do;
	     argno = argno + 1;
	     control_argument = "0"b;
	     call cu_$arg_ptr (argno, arg_ptr, arg_len, code);
	     if code ^= 0
	     then
	        do;
		 call com_err_ (code, myname);
		 call finish;
		 return;
	        end;
	     string_sw = "1"b;
	  end;
         else if substr (arg, 1, 1) = "-"
         then control_argument = "1"b;
         else control_argument = "0"b;


         if ^control_argument
         then if looking_for_string
	    then
	       do;				/* Get string for -match, -exclude, -class. */
		if old_string_list_ptr ^= null
		then old_string_list_ptr -> string_list.next = string_list_ptr;
		old_string_list_ptr = string_list_ptr;
		if processing_class_control_argument
		then
		   do;
		      string_list.string = translate (arg, UPPERCASE_LETTERS, LOWERCASE_LETTERS);
		      do class_idx = 1 to hbound (VALID_AUDIT_CLASS, 1)
		         while (string_list.string ^= VALID_AUDIT_CLASS (class_idx));
		      end;
		      if class_idx > hbound (VALID_AUDIT_CLASS, 1)
		      then
		         do;
			  call
			     com_err_ (error_table_$badopt, myname,
			     "^/^a is not a valid class specifier. Valid specifiers (any mixture of upper
and lower case) are: ^v(^a, ^)and ^a.", string_list.string, dim (VALID_AUDIT_CLASS, 1) - 1, VALID_AUDIT_CLASS);
			  return;
		         end;
		   end;
		else string_list.string = arg;
		found_string = "1"b;
		alloc string_list;
		string_list.next = null;
		string_list.string = "";
	       end;
	    else if want_switchname			/* Get switchname following -switch. */
	    then
	       do;
		switchname = arg;
		have_switchname = "1"b;
		want_switchname = "0"b;
	       end;
	    else if want_begin_addr			/* Get arg for -from or -last. */
	    then
	       do;
		have_begin = "1"b;
		want_begin_addr = "0"b;
		begin_arg.value = arg;
		begin_arg.value_is_string = string_sw;
	       end;
	    else if want_end_addr			/* Get arg for -to or -next. */
	    then
	       do;
		have_end = "1"b;
		want_end_addr = "0"b;
		end_arg.value = arg;
		end_arg.value_is_string = string_sw;
	       end;
	    else if want_line_length			/* Get line length following -line_length. */
	    then
	       do;
		want_line_length = "0"b;
		output_line_length = bin (arg);
		insert_nl = "1"b;
	       end;
	    else if want_output_file			/* Get path for output file. */
	    then
	       do;
		call expand_pathname_ (arg, output_file_dir, output_file_entry, code);
		if code ^= 0
		then
		   do;
		      call com_err_ (code, myname, "^/Unable to expand the pathname ""^a"".", arg);
		      call finish;
		      return;
		   end;

		want_output_file = "0"b;
		                                        /* validate an user 's entryname for -of */
		call check_star_name_ (output_file_entry, (CHECK_STAR_REJECT_WILD), starname_type, code);
		if code ^= 0
		then do;
		   call
		      com_err_ (code, myname, "^a", arg);
		      return;
		   end;
	                                                  /* good file name for -of */
		output_file_attach_description = "vfile_ " || arg;
		call
		   iox_$attach_name (unique_chars_ ("0"b) || ".daf", output_iocb_ptr,
		   (output_file_attach_description), null, code);
		if code ^= 0
		then
		   do;
		      call com_err_ (code, myname, "^/Unable to attach to the output file, ^a.", arg);
		      return;
		   end;
		call iox_$open (output_iocb_ptr, Stream_output, "0"b, code);
		if code ^= 0
		then
		   do;
		      call com_err_ (code, myname, "^/Unable to open the output file, ^a.", arg);
		      call iox_$detach_iocb (output_iocb_ptr, code);
		      return;
		   end;
	       end;
	    else if ^have_path			/* Get path for audit file. */
	    then
	       do;
		have_path = "1"b;
		call expand_pathname_$add_suffix (arg, "audit", position_info.dirname, position_info.ename, code);
		if code ^= 0
		then
		   do;
		      call com_err_ (code, myname, "^a", arg);
		      call finish;
		      return;
		   end;
	       end;
	    else
	       do;
		call com_err_ (error_table_$badopt, myname, "^/^a is not a known control argument.", arg);
		call finish;
		return;
	       end;


         else
	  do;

/*  Following is the basic control argument processing. */

	     call check_for_unfinished_control_argument (code);
	     if code ^= 0
	     then
	        do;
		 call finish;
		 return;
	        end;

	     if looking_for_string
	     then
	        do;
		 old_string_list_ptr = null;
		 processing_class_control_argument = "0"b;
		 looking_for_string = "0"b;
		 found_string = "0"b;
		 free string_list_ptr -> string_list;
		 string_list_ptr = null;
	        end;

	     if arg = "-from" | arg = "-fm"		/* -from */
	     then if have_begin
		then
		   do;
DUPARG:
		      call
		         com_err_ (error_table_$bad_arg, myname,
		         "^a may only be specified once per use of the command.", arg);
		      call finish;
		      return;
		   end;
		else
		   do;
		      want_begin_addr = "1"b;
		      begin_arg.abs = "1"b;
		      begin_arg.add = "0"b;
		      begin_arg.subtract = "0"b;
		   end;
	     else if arg = "-to"			/* -to */
	     then if have_end
		then goto DUPARG;
		else
		   do;
		      want_end_addr = "1"b;
		      end_arg.abs = "1"b;
		      end_arg.add = "0"b;
		      end_arg.subtract = "0"b;
		   end;
	     else if arg = "-next"			/* -next */
	     then if have_end
		then goto DUPARG;
		else
		   do;
		      want_end_addr = "1"b;
		      end_arg.abs = "0"b;
		      end_arg.add = "1"b;
		      end_arg.subtract = "0"b;
		   end;
	     else if arg = "-last"			/* -last */
	     then if have_begin
		then goto DUPARG;
		else
		   do;
		      want_begin_addr = "1"b;
		      begin_arg.abs = "0"b;
		      begin_arg.add = "0"b;
		      begin_arg.subtract = "1"b;
		   end;
	     else if arg = "-match"			/* -match */
	     then if match
		then goto DUPARG;
		else
		   do;
		      looking_for_string = "1"b;
		      match = "1"b;
		      found_string = "0"b;
		      alloc string_list in (area);
		      match_string_list_ptr = string_list_ptr;
		      string_list.string = "";
		      string_list.next = null;
		   end;
	     else if arg = "-exclude" | arg = "-ex"	/* -exclude */
	     then if exclude
		then goto DUPARG;
		else
		   do;
		      exclude = "1"b;
		      looking_for_string = "1"b;
		      found_string = "0"b;
		      alloc string_list in (area);
		      exclude_string_list_ptr = string_list_ptr;
		      string_list.string = "";
		      string_list.next = null;
		   end;
	     else if arg = "-class"			/* -class */
	     then if class
		then goto DUPARG;
		else
		   do;
		      processing_class_control_argument = "1"b;
		      looking_for_string = "1"b;
		      found_string = "0"b;
		      class = "1"b;
		      alloc string_list in (area);
		      match_class_string_list_ptr = string_list_ptr;
		      string_list.string = "";
		      string_list.next = null;
		   end;
	     else if arg = "-switch" | arg = "-sw"	/* -switch */
	     then want_switchname = "1"b;
	     else if arg = "-reverse" | arg = "-rv"	/* -reverse */
	     then reverse = "1"b;
	     else if arg = "-entry_numbers" | arg = "-etn"/* -entry_numbers */
	     then entry_numbers = "1"b;
	     else if arg = "-class_identifiers" | arg = "-cli"
						/* -class_identifiers */
	     then class_identifiers = "1"b;
	     else if arg = "-metering" | arg = "-mt"	/* -metering */
	     then metering = "1"b;
	     else if arg = "-no_header" | arg = "-nhe"	/* -no_header */
	     then header = "0"b;
	     else if arg = "-line_length" | arg = "-ll"	/* -line_length */
	     then want_line_length = "1"b;
	     else if arg = "-no_append_nl" | arg = "-nanl"
	     then
	        do;
		 force_append_nl = "0"b;
		 use_force_append_nl = "1"b;
	        end;
	     else if arg = "-append_nl" | arg = "-anl"
	     then
	        do;
		 force_append_nl = "1"b;
		 use_force_append_nl = "1"b;
	        end;
	     else if arg = "-no_insert_nl" | arg = "-ninl"
	     then
	        do;
		 force_insert_nl = "0"b;
		 use_force_insert_nl = "1"b;
	        end;
	     else if arg = "-insert_nl" | arg = "-inl"
	     then
	        do;
		 force_insert_nl = "1"b;
		 use_force_insert_nl = "1"b;
	        end;
	     else if arg = "-output_file" | arg = "-of"
	     then
	        do;
		 want_output_file = "1"b;
	        end;
	     else
	        do;
		 call com_err_ (error_table_$badopt, myname, "^/The control argument ""^a"" is not supported.", arg);
		 call finish;
		 return;
	        end;
	  end;
      end;					/* End of control argument processing. */
      call check_for_unfinished_control_argument (code);
      if code ^= 0
      then
         do;
	  call finish;
	  return;
         end;

      if output_line_length = 0			/* output_line_length wasn't set by -line_length. */
      then
         do;
	  output_line_length = get_line_length_$switch (output_iocb_ptr, code);
	  if code ^= 0
	  then output_line_length = 0;
         end;

/*  Set up the audit file to be displayed.  Initialize position_info
   (used by audit_file_position_ entries) in a fashion appropriate to whether
   or not the file is known to be currently in use.
*/

      if have_path
      then
         do;
	  call msf_manager_$open (position_info.dirname, position_info.ename, position_info.audit_fcb, code);
	  if code ^= 0
	  then
	     do;
	        call
		 com_err_ (code, myname, "^a^[>^]^a", position_info.dirname, position_info.dirname ^= ">",
		 position_info.ename);
	        call finish;
	        return;
	     end;
	  call msf_manager_$get_ptr (position_info.audit_fcb, 0, "1"b, audit_file_header_ptr, bit_count, code);
	  if code ^= 0
	  then
	     do;
	        call com_err_ (code, myname);
	        call finish;
	        return;
	     end;
	  if audit_file_header.version = 0
	  then
	     do;
	        call com_err_ (error_table_$zero_length_seg, myname);
	        call finish;
	        return;
	     end;
	  else if audit_file_header.version ^= audit_file_header_version_1
	  then
	     do;
	        call com_err_ (error_table_$unimplemented_version, myname);
	        call finish;
	        return;
	     end;
	  position_info.audit_index = audit_file_header.audit_index;
	  position_info.current_component = audit_file_header.current_component;
	  if position_info.current_component > 0
	  then
	     do;
	        call
		 msf_manager_$get_ptr (position_info.audit_fcb, position_info.current_component, "1"b,
		 position_info.audit_ptr, bit_count, code);
	        if code ^= 0
	        then
		 do;
		    current_component_string = position_info.current_component;
		    call com_err_ (code, myname, "^a>^a", pathname, current_component_string);
		    call finish;
		    return;
		 end;
	     end;
	  else position_info.audit_ptr = audit_file_header_ptr;
	  position_info.default_search_tag = "I";
	  position_info.any_tag = "1"b;
	  position_info.file_limit = audit_file_header.filled;
	  position_info.max_component = audit_file_header.max_component;
	  position_info.begin_component = audit_file_header.begin_component;
	  position_info.begin_index = audit_file_header.begin_index;
	  position_info.max_index = audit_file_header.max_index;
	  position_info.last_entry_length = audit_file_header.last_entry_length;
         end;
      else
         do;
	  call find_iocb (code);
	  if code ^= 0
	  then
	     do;
	        call com_err_ (code, myname);
	        call finish;
	        return;
	     end;
	  blkptr = iocb_ptr -> iocb.attach_data_ptr;
	  audit_file_header_ptr = blk.audit_file_header_ptr;
	  position_info.max_component = audit_file_header.max_component;
	  position_info.current_component = audit_file_header.current_component;
	  position_info.audit_fcb = blk.audit_fcb;
	  position_info.audit_index = audit_file_header.audit_index;
	  position_info.dirname = blk.dirname;
	  position_info.ename = blk.ename;
	  position_info.audit_ptr = blk.audit_ptr;
	  position_info.default_search_tag = "I";
	  position_info.any_tag = "1"b;
	  position_info.file_limit = audit_file_header.filled;
	  position_info.begin_component = audit_file_header.begin_component;
	  position_info.begin_index = audit_file_header.begin_index;
	  position_info.max_index = audit_file_header.max_index;
	  position_info.last_entry_length = audit_file_header.last_entry_length;
         end;


/* Compare the output_file to the audit_file, to ensure that they */
/* are not the same file. */

      if output_file_dir ^= ""
      then
         do;
	  call hcs_$initiate (output_file_dir, output_file_entry, "", 0, 0, output_file_ptr, code);
	  if output_file_ptr ^= null
	  then
	     do;
	        if output_file_ptr = audit_file_header_ptr
	        then
		 do;
		    call
		       com_err_ (error_table_$badopt, myname,
		       "^/The output file and the audit file may not be the same file, ^a^[>^]^a.", output_file_dir,
		       output_file_dir ^= ">", output_file_entry);
		    call finish;
		    return;
		 end;
	        call hcs_$terminate_noname (output_file_ptr, code);
	     end;
         end;

      if (entry_numbers | class_identifiers | metering)
      then leader = "1"b;

/*  If header is off, leave it off (and don't print a header). Otherwise, set
   header on if leader is on, off if leader is off.
*/

      if header
      then header = leader;

/* Make heuristic decision about whether or not to insert newlines and whether
or not to append newlines. Insert_nl is turned on if there is a leader and the
lines have a finite length (i.e., the output isn't going to a file).
*/

      if leader
      then if output_line_length ^= 0
	 then insert_nl, append_nl = "1"b;
	 else append_nl = "1"b;

/* If the user wants to force the state of either append_nl or insert_nl,
do so now.
*/

      if use_force_append_nl
      then append_nl = force_append_nl;
      if use_force_insert_nl
      then insert_nl = force_insert_nl;


/* Initialize begin_position and end_position to insure valid results if
   audit_file_position_$first or audit_file_position_$count_last is called.
*/

      begin_position.aep = null;
      begin_position.char_index = -1;
      begin_position.entry_number = -1;
      begin_position.search_tag = "";
      begin_position.component_ptr = null;
      begin_position.component_number = -1;
      begin_position.component_max_char_index = -1;

      end_position = begin_position;


/*  Find the appropriate values for begin_position and end_position.  The
   switches have_begin and have_end indicate, respecitvely, the setting of begin_arg
   and end_arg in the argument processing above.
*/

      if have_begin
      then
         do;
	  call audit_file_position_$count_last (addr (end_position), addr (position_info), code);
	  begin_position = end_position;
	  call get_position (begin_arg, begin_position, code);
	  if code ^= 0
	  then
	     do;
	        call com_err_ (code, myname, "Attempt to set beginning of display failed.");
	        call finish;
	        return;
	     end;
	  if have_end
	  then
	     do;
	        end_position = begin_position;
	        call get_position (end_arg, end_position, code);
	        if code ^= 0
	        then if code = error_table_$end_of_info
		   then code = 0;
		   else if code = error_table_$nomatch
		   then
		      do;
		         call com_err_ (0, myname, "^/No match was found searching for the end position.");
		         call finish;
		         return;
		      end;
		   else
		      do;
		         call com_err_ (0, myname, "^/Attempt to locate the last entry of the display failed.");
		         call finish;
		         return;
		      end;
	     end;
         end;
      else
         do;
	  call audit_file_position_$first (addr (begin_position), addr (position_info), code);
	  if code ^= 0
	  then
	     do;
	        call com_err_ (code, myname, "Could not get first position.  ^a", pathname_ (position_info.dirname, position_info.ename));
	        call finish;
	        return;
	     end;
	  end_position = begin_position;
	  if have_end
	  then
	     do;
	        call get_position (end_arg, end_position, code);
	        if code ^= 0
	        then if code = error_table_$end_of_info
		   then code = 0;
		   else if code = error_table_$nomatch
		   then
		      do;
		         call com_err_ (0, myname, "^/No match was found searching for the end position.");
		         call finish;
		         return;
		      end;
		   else
		      do;
		         call com_err_ (0, myname, "^/Attempt to locate the last entry of the display failed.");
		         call finish;
		         return;
		      end;
	     end;
	  else
	     do;
	        call audit_file_position_$count_last (addr (end_position), addr (position_info), code);
	        if code ^= 0
	        then
		 do;
		    call com_err_ (code, myname, "Attempt to set end of display failed.");
		    call finish;
		    return;
		 end;
	     end;
         end;

      if reverse
      then
         do;					/* Swap values of begin_position and end_position. */
	  position = end_position;
	  end_position = begin_position;
	  begin_position = position;
         end;

      position = begin_position;
      continuation = "0"b;

      if header
      then call
	    ioa_$ioa_switch (output_iocb_ptr, "^[entry ^]^[  time  cpu usage   paging ^]^[class ^]", entry_numbers,
	    metering, class_identifiers);

      if position.aep = end_position.aep
      then do_last_position = "1"b;
      else do_last_position = "0"b;
      have_displayed = "0"b;

/*  Continue processing entries as long as  position in the closed interval
   defined by begin_position and end_position.  Because of the reverse printing
   option, begin_position and end_position can be in any numeric relationship.
   Processing entries consists of  checking if the entry at "position"
   should be displayed by referring to the string_check and class_check procedures,
   if necessary, calling display_entry if the entry should be displayed,
   and advancing the position in the appropriate direction, if position is
   not end_position.
*/

      do while ((do_last_position | (position.aep ^= end_position.aep)) & code = 0);
         if match
         then
	  do;
	     call string_check ("1"b, position, display, code);
	     if code ^= 0
	     then
	        do;
		 call com_err_ (code, myname, "While checking for match.");
		 call finish;
		 return;
	        end;
	     if ^display
	     then goto NEXT_POSITION;
	  end;
         if exclude
         then
	  do;
	     call string_check ("0"b, position, display, code);
	     if code ^= 0
	     then
	        do;
		 call com_err_ (code, myname, "While checking for exclusion.");
		 call finish;
		 return;
	        end;
	     if ^display
	     then goto NEXT_POSITION;
	  end;
         if class
         then
	  do;
	     call class_check ("1"b, position, display);
	     if ^display
	     then goto NEXT_POSITION;
	  end;

         have_displayed = "1"b;
         call display_entry (position, continuation, append_nl, insert_nl, leader);
NEXT_POSITION:
         if ^do_last_position
         then if reverse
	    then call audit_file_position_$previous (addr (position), addr (position_info), code);
	    else call audit_file_position_$next (addr (position), addr (position_info), code);
         if (position.aep = end_position.aep)
         then do_last_position = ^do_last_position;
      end;

      if code ^= 0
      then
         do;
	  call com_err_ (code, myname);
	  call finish;
	  return;
         end;
      else if ^have_displayed
      then
         do;
	  call com_err_ (0, myname, "No entries were selected.");
	  call finish;
	  return;
         end;
      call finish;
      return;					/* Effective end of display_audit_file. */

get_position:
   proc (p_arg, p_position, p_code);

/* p_arg is set up by the control argument processing of -from, -last, -to,
   and -next. This procedure determines whether the positioning is to be done by string, time, or entry number.
   It does any necessary conversion of p_arg.value, then calls the appropriate
   audit_file_position_ entry. */

      dcl	    1 p_arg	       like begin_arg;
      dcl	    1 p_position	       like position_template;
      dcl	    1 position	       like position_template;
      dcl	    p_code	       fixed bin (35);
      dcl	    time_of_day	       pic "9999v.9";
      dcl	    hours		       fixed bin (17);
      dcl	    minutes	       fixed bin (9, 4);
      dcl	    arg_time_of_day	       fixed bin (71);
      dcl	    (value_is_string, value_is_time)
			       bit (1);

      p_code = 0;
      value_is_string = p_arg.value_is_string;
      value_is_time = "0"b;
      position = p_position;
      if ^value_is_string
      then if verify (p_arg.value, "0123456789.") ^= 0	/* Is p_arg.value a string? */
	 then value_is_string = "1"b;
	 else if index (p_arg.value, ".") ^= 0		/* Is p_arg.value a time? */
	 then if length (p_arg.value) > 1
	      then value_is_time = "1"b;
	      else value_is_string = "1"b;


      if value_is_string
      then
         do;
	  if p_arg.abs				/* p_arg.value is a string to be matched. */
	  then call audit_file_position_$forward_search (addr (position), p_arg.value, addr (position_info), p_code);
	  else if p_arg.add
	  then call audit_file_position_$forward_search (addr (position), p_arg.value, addr (position_info), p_code);
	  else call audit_file_position_$backward_search (addr (position), p_arg.value, addr (position_info), p_code);
         end;
      else if value_is_time
      then
         do;					/* p_arg.value is a time.  */
	  time_of_day = fixed (p_arg.value, 5, 1);
	  hours = time_of_day / 100;
	  minutes = time_of_day - hours * 100;
	  if (minutes >= 60) | (hours >= 24)
	  then
	     do;
	        p_code = error_table_$bad_arg;
	        return;
	     end;
	  arg_time_of_day = (hours * 3.6e9) + (minutes * 6e7);
	  call
	     audit_file_position_$move_time (addr (position), p_arg.abs, p_arg.add, p_arg.subtract, arg_time_of_day,
	     addr (position_info), p_code);
         end;
      else
         do;					/* p_arg.value is an entry_number. */
	  arg_number = cv_dec_check_ ((p_arg.value), p_code);
	  if p_code ^= 0
	  then return;
	  if arg_number > 2 ** 17
	  then p_code = error_table_$badopt;
	  else
	     do;
	        call
		 audit_file_position_$move_number (addr (position), p_arg.abs, p_arg.add, p_arg.subtract,
		 (arg_number), addr (position_info), p_code);
	     end;
         end;
      p_position = position;
   end;

string_check:
   proc (p_match, p_position, p_display, p_code);

/*  If the current entry contains a match for any of the regular expressions
   in the string_list indicated by p_match, then set p_display to p_match.
   Otherwise, set p_display to ^p_match.
*/

      dcl	    1 p_position	       like position_template;
      dcl	    (p_match, p_display)   bit (1);
      dcl	    chain_ptr	       ptr;
      dcl	    (p_code, code)	       fixed bin (35);

      p_code = 0;
      p_display = ^p_match;
      if p_match
      then chain_ptr = match_string_list_ptr;
      else chain_ptr = exclude_string_list_ptr;

      do while (chain_ptr ^= null);
         call
	  search_file_ (addrel (addr (chain_ptr -> string_list.string), 1), 1, length (chain_ptr -> string_list.string),
	  addr (p_position.aep -> audit_entry.string), 1, (p_position.aep -> audit_entry.entry_length), match_begin,
	  match_end, code);
         if code = 0
         then
	  do;
	     p_display = ^p_display;
	     return;
	  end;
         else if code ^= 1				/* code = 1 -> match not found. */
         then
	  do;
	     p_code = code;
	     return;
	  end;
         chain_ptr = chain_ptr -> string_list.next;
      end;
   end;


class_check:
   proc (p_match, p_position, p_display);

/*  If the class identifier of the current entry is in the  string_list
   indicated by p_match, then set p_display to p_match.  Otherwise, set
   p_display to ^p_match.
*/

      dcl	    1 p_position	       like position_template;
      dcl	    (p_match, p_display)   bit (1);

      p_display = ^p_match;
      if p_match
      then chain_ptr = match_class_string_list_ptr;
      else return;

      do while (chain_ptr ^= null);
         if substr (p_position.aep -> audit_entry.tag, 1, length (chain_ptr -> string_list.string))
	  = chain_ptr -> string_list.string
         then
	  do;
	     p_display = ^p_display;
	     return;
	  end;
         chain_ptr = chain_ptr -> string_list.next;
      end;
   end;


display_entry:
   proc (p_position, p_continuation, p_append_nl, p_insert_nl, p_leader);

/*  This controls the displaying of an entry.
   If p_continuation then place an asterisk in the first column of the
   entry field (as opposed to the leader field).
   If p_append_nl then add a newline and turn on p_continuation when
   the last character of the entry is not a newline.
   If p_insert_nl then use wrap_line to print the entry.
   If p_leader then use make_leader_string.
*/

      dcl	    (p_continuation, p_append_nl, p_insert_nl, p_leader)
			       bit (1);
      dcl	    leader_string	       char (80) varying;
      dcl	    1 p_position	       like position_template;

      if p_leader
      then call make_leader_string;

      if insert_nl
      then call wrap_line;
      else if append_nl
      then
         do;
	  call
	     ioa_$ioa_switch (output_iocb_ptr, "^[^a^x^;^s^]^[*^;^x^]^a", p_leader, leader_string, p_continuation,
	     substr (p_position.aep -> audit_entry.string, 1, p_position.aep -> audit_entry.entry_length));
	  if p_position.aep -> audit_entry.entry_length = 0
	  then p_continuation = "1"b;
	  else if substr (p_position.aep -> audit_entry.string, p_position.aep -> audit_entry.entry_length, 1) ^= NL
	  then p_continuation = "1"b;
	  else p_continuation = "0"b;
         end;
      else if p_leader
      then call
	    ioa_$ioa_switch_nnl (output_iocb_ptr, "^a^x^va", leader_string, p_position.aep -> audit_entry.entry_length,
	    p_position.aep -> audit_entry.string);
      else call
	    iox_$put_chars (output_iocb_ptr, addr (p_position.aep -> audit_entry.string),
	    (p_position.aep -> audit_entry.entry_length), code);

make_leader_string:
   proc;

/*  This constructs the leader according to the settings of three
   switches; entry_numbers, metering, and class_identifiers.
*/


      dcl	    time_of_day	       pic "9999v.9";
      dcl	    cpu_usage	       pic "zzz9v.999";
      dcl	    paging	       pic "zzzzz9v";
      dcl	    hours		       fixed bin (17);
      dcl	    minutes	       fixed bin (3, 1);
      dcl	    return_string	       char (32);
      dcl	    return_string_len      fixed bin;

      leader_string = "";
      if entry_numbers
      then
         do;
	  current_entry_number = position.entry_number;
	  leader_string = current_entry_number || " ";
         end;

      if metering
      then if p_position.aep -> audit_entry.time = -1
	 then
	    do;
	       call
		ioa_$rsnnl ("^vx*^vx*^vx*^vx", return_string, return_string_len,
		divide (length (time_of_day) + 1, 2, 17, 0),
		divide (length (cpu_usage) + 3 + length (time_of_day) + 1, 2, 17, 0),
		divide (length (cpu_usage) + 3 + length (paging) + 1, 2, 17, 0),
		divide (length (paging) + 1, 2, 17, 0));
	       leader_string = leader_string || substr (return_string, 1, return_string_len);
	    end;
	 else
	    do;
	       hours = divide (p_position.aep -> audit_entry.time, 3600000000, 17, 0);
	       minutes = mod (p_position.aep -> audit_entry.time, 3.6e9) / 6e7;
	       if hours > 24
	       then hours = 98;
	       time_of_day = hours * 100 + minutes;
	       if p_position.aep -> audit_entry.virtual_time / 1e6 > 9999
	       then cpu_usage = 9999;
	       else cpu_usage = p_position.aep -> audit_entry.virtual_time / 1e6;
	       if p_position.aep -> audit_entry.paging > 99999
	       then paging = 99999;
	       else paging = p_position.aep -> audit_entry.paging;
	       leader_string = leader_string || time_of_day || " " || cpu_usage || "   " || paging || " ";
	    end;

      if class_identifiers
      then leader_string = leader_string || " " || p_position.aep -> audit_entry.tag || "  ";
   end;

wrap_line:
   proc;

/*  wrap_line formats the output of an entry.  Newlines are inserted, and
   output is indented as necessary.
   Or, if the entry doesn't end in a newline.
   Indentation is necessary when the number
   of characters to the first newline (line_break) is greater than the output
   line length minus the length of the leader string minus 1 (allowable_entry_length).
*/

      dcl	    (allowable_entry_length, char_index, len, line_break)
			       fixed bin;
      char_index = 1;
      if p_leader
      then allowable_entry_length = output_line_length - length (leader_string) - 1;
      else allowable_entry_length = output_line_length - 1;
      continuation = p_continuation;
      char_index = 1;
      line_break = index (p_position.aep -> audit_entry.string, NL);

      if line_break > allowable_entry_length
      then
         do;					/* Insert a new_line.*/
	  len = allowable_entry_length;
	  call
	     ioa_$ioa_switch (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation,
	     substr (p_position.aep -> audit_entry.string, char_index, len));
	  continuation = "1"b;
         end;
      else if line_break > 0
      then
         do;					/* Print as is.*/
	  len = line_break;
	  call
	     ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation,
	     substr (p_position.aep -> audit_entry.string, char_index, len));
	  continuation = "0"b;
         end;
      else
         do;
	  if p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length
	  then len = allowable_entry_length;
	  else len = p_position.aep -> audit_entry.entry_length - char_index + 1;

	  if append_nl | p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length
	  then
	     do;
	        call
		 ioa_$ioa_switch (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation,
		 substr (p_position.aep -> audit_entry.string, char_index, len));
	        continuation = "1"b;
	     end;
	  else
	     do;
	        call
		 ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation,
		 substr (p_position.aep -> audit_entry.string, char_index, len));
	        continuation = "0"b;
	     end;
         end;
      char_index = char_index + len;

      do while (char_index < p_position.aep -> audit_entry.entry_length);
         line_break = index (substr (p_position.aep -> audit_entry.string, char_index), NL);

         if line_break > allowable_entry_length
         then
	  do;
	     len = allowable_entry_length;
	     call
	        ioa_$ioa_switch (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader, length (rtrim (leader_string)),
	        continuation, substr (p_position.aep -> audit_entry.string, char_index, len));
	     continuation = "1"b;
	  end;
         else if line_break > 0
         then
	  do;
	     len = line_break;
	     call
	        ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader,
	        length (rtrim (leader_string)), continuation,
	        substr (p_position.aep -> audit_entry.string, char_index, len));
	     continuation = "0"b;
	  end;
         else
	  do;
	     if p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length
	     then len = allowable_entry_length;
	     else len = p_position.aep -> audit_entry.entry_length - char_index + 1;
	     if append_nl | p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length
	     then
	        do;
		 call
		    ioa_$ioa_switch (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader,
		    length (rtrim (leader_string)), continuation,
		    substr (p_position.aep -> audit_entry.string, char_index, len));
		 continuation = "1"b;
	        end;
	     else
	        do;
		 call
		    ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader,
		    length (rtrim (leader_string)), continuation,
		    substr (p_position.aep -> audit_entry.string, char_index, len));
		 continuation = "0"b;
	        end;
	  end;
         char_index = char_index + len;
      end;
      p_continuation = continuation;
   end;
   end;

find_iocb:
   proc (p_code);

/*  Find an iocb for a switch currently using audit_. If a switchname was
   provided as an argument to daf, then use its iocb. Else, look at user_i/o
   to see if it is using audit_. If it isn't, walk through the attachments
   in order (using find_iocb_n) checking each for use of audit_. The first
   switch found using audit_ is returned.
*/

      dcl	    (code, p_code)	       fixed bin (35);
      dcl	    iox_$user_io	       ptr ext;
      dcl	    attach_description     char (32) varying based;
      dcl	    index		       fixed bin;
      dcl	    iox_$find_iocb_n       entry (fixed bin, ptr, fixed bin (35));
      dcl	    iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));


      code = 0;

      if have_switchname
      then
         do;
	  call iox_$look_iocb (switchname, iocb_ptr, code);
	  if code ^= 0
	  then
	     do;
	        p_code = code;
	        return;
	     end;
         end;
      else if substr (iox_$user_io -> iocb.attach_descrip_ptr -> attach_description, 1, 6) = "audit_"
      then iocb_ptr = iox_$user_io;

      else
         do;
	  index = 1;
	  call iox_$find_iocb_n (index, iocb_ptr, code);
	  do while (code = 0);
	     if iocb_ptr -> iocb.attach_data_ptr ^= null
	     then if substr (iocb_ptr -> iocb.attach_descrip_ptr -> attach_description, 1, 6) = "audit_"
		then return;
	     index = index + 1;
	     call iox_$find_iocb_n (index, iocb_ptr, code);
	  end;
         end;
      p_code = code;
   end;
%page;
check_for_unfinished_control_argument:
   proc (p_code);
      dcl	    p_code	       fixed bin (35);
      p_code = error_table_$noarg;
      if want_begin_addr
      then call
	    com_err_ (p_code, myname, "^/ The ^[-last^;-from^] control argument must be followed by an address.",
	    begin_arg.subtract);
      else if want_end_addr
      then call
	    com_err_ (p_code, myname, "^/The ^[-to^;-next^] control argument must be followed by an address.",
	    end_arg.abs);
      else if want_output_file
      then call com_err_ (p_code, myname, "^/The -output_file control argument must be followed by a pathname.");
      else if looking_for_string & ^found_string
      then call
	    com_err_ (p_code, myname,
	    "^/The ^[-class^;-match and -exclude^] control argument^[^;s^] must be followed by a ^[class identifier^;string^]."
	    , processing_class_control_argument, processing_class_control_argument, processing_class_control_argument);
      else if want_switchname
      then call com_err_ (p_code, myname, "^/The -switch control argument must be followed by a switch name.");
      else if want_line_length
      then call com_err_ (p_code, myname, "^/The -line_length control argument must be followed by a line length.");
      else p_code = 0;
   end check_for_unfinished_control_argument;
%page;
finish:
   proc;
      if output_iocb_ptr ^= iox_$user_output
      then
         do;
	  call iox_$close (output_iocb_ptr, code);
	  call iox_$detach_iocb (output_iocb_ptr, code);
         end;
   end finish;
%include audit_block;
%include iocbx;
%include iox_dcls;
%include iox_modes;
%include audit_position;
%include audit_entry;
%include audit_file_header;
%include check_star_name;
   end;






		    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
