head_sheet_.pl1                 10/28/88  1405.4rew 10/28/88  1232.4      267255



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

/* format: style4 */

/* format: off */

/* HEAD_SHEET_ - This program prints the IO Daemon header page.
   THVV */

/* Modified in March 1975 by J. C. Whitmore for chopping and access isolation */
/* Modified in December 1975 by M. A. Braida to state when a request has been
   continued and to enable a separator page to be printed on other than the first copy */
/* Modified in Sept. 1977 by J. C. Whitmore to add the set_page_length and separator entries */
/* Modified by J. C. Whitmore, 4/78, for new dprint_msg format */
/* Modified by C. Hornig, 6/79, to take prt_ctl out of static */
/* Modified by J. C. Whitmore, 5/80,  for dest and head garbage bug for short page length */
/* Modified by GA Texada 04/01/81 to increase the size of sysdir to 168 so test entry point  can be called with impunity */
/* Modified: 20 November 1981 by G. Palter as part of fixing the following bugs from the I/O daemon error list:
      0012: phx09251 phx03749 phx04015
         "-no_endpage" does not really work.  When the daemon prints what should be the last line of the "logical" page
         (line 3 of a real page), it issues a form-feed to get to the next line which is the top of the next "logical"
         page.  However, if the paper info or printer alignment (for remotes) is incorrect, this form-feed will cause
         extra blank paper.  The daemon should never print a form-feed in this mode except when one appears in the user's
         print file
      0032: phx11372
         When running an I/O daemon in test mode with the coordinator and driverin the same process, printing a single
         request, exiting the I/O daemon, re-entering the I/O daemon, and printing another request will cause the
         head/tail sheets of the first request to be printed surrounding the file specified in the second request */
/* Modified: November 1983 by C. Marker added support for no_separator */


/****^  HISTORY COMMENTS:
  1) change(88-06-03,Brunelle), approve(88-06-03,MCR7911),
     audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199):
     The print_head_sheet and print_separator entrypoints were upgraded to
     handle a null a_prt_ctl_ptr argument by using the default_ctl values.
     The declarations were reorganized.
                                                   END HISTORY COMMENTS */


/* format: on */

head_sheet_:
     proc (a_stream, a_ordatap, a_code);

/* Parameters */

dcl  a_code fixed bin (35) parameter;			/* Return error code */
dcl  a_message char (*) parameter;			/* optional message for head sheet */
dcl  a_ordatap ptr parameter;				/* ptr to output_request_data */
dcl  a_prt_ctl_ptr pointer parameter;			/* pointer to prt_ctl */
dcl  a_stream char (*) parameter;			/* print stream. */
dcl  a_switch pointer parameter;			/* IOCB ptr for same */

/* External Procedures & Variables */

dcl  convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var);
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  ioa_$rsnnl entry options (variable);
dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  bigletter_ entry (char (*), entry);
dcl  bigletter_$five entry (char (*), entry);
dcl  iox_$find_iocb entry (char (*), pointer, fixed bin (35));
dcl  iox_$put_chars entry (pointer, pointer, fixed bin (21), fixed bin (35));
dcl  iox_$modes entry (pointer, char (*), char (*), fixed bin (35));
dcl  system_info_$installation_id entry (char (*) aligned);

/* Builtins */

dcl  (addr, null, substr, length, divide, index, min, char, max, ptr, copy, rtrim, ltrim, unspec) builtin;

/* Internal Static */

dcl  NL char (1) int static options (constant) init ("
");						/* the next initialized char will list funny, carriage return */
dcl  CR char (1) int static options (constant) init ("
");

dcl  FF char (1) aligned int static options (constant) init ("");
dcl  big_letters bit (1) int static;			/* ON if will use big bigletters */
dcl  copy_offset fixed bin int static;			/* where to put the copy number data for copy 2, 3,... */
dcl  default_ctl_not_set bit (1) int static init ("1"b);	/* initialize when first used */
dcl  head_field fixed bin int static;			/* this is the default */
dcl  hs_ptr ptr int static init (null);			/* ptr to page buffer for the head sheet */
dcl  installation char (32) aligned int static;		/* Local installation ID */
dcl  last_request_no fixed bin int static;		/* request number of the last request */
dcl  lead_cp_space fixed bin int static;		/* how many spaces to put in front of copy... */
dcl  line_length fixed bin int static init (136);		/* line length for formatting, default is 136 */
dcl  line_no fixed bin int static;			/* current line we are working on */
dcl  med_letters bit (1) int static;			/* ON if wull use medium bigletters */
dcl  mode char (256) int static;			/* string for printer changemode call */
dcl  n_letters fixed bin int static;			/* number if big, med, or small letters that fit on line */
dcl  n_nl fixed bin int static;			/* 2 or 3 NL chars before a Big Letter line */
dcl  no_pad_blanks fixed bin int static;		/* field separator for continued/restarted message */
dcl  page_length fixed bin int static init (69);		/* page length */
dcl  page_size fixed bin int static;			/* number of chars per head sheet face */
dcl  sep_ptr ptr int static init (null);		/* ptr to separator chars (base of template seg) */
dcl  sep_size fixed bin int static;			/* number of chars in the separator */
dcl  static_ctl_not_set bit (1) int static init ("1"b);	/* initialize on first call */
dcl  sysdir char (168) int static init (">daemon_dir_dir>io_daemon_dir");
dcl  type_field fixed bin int static;			/* length of the request_type/device_name fields */
dcl  xl fixed bin int static;				/* the length of xxbar, including NL */
dcl  xxbar char (204) var int static;

dcl  1 static_ctl aligned like prt_ctl int static;	/* the active set of parameters */

dcl  1 default_ctl aligned like prt_ctl int static;	/* the default parameters for old type entries */

/* Automatic */

dcl  (i, j, l, n, l2) fixed bin;
dcl  l1 fixed bin (21);
dcl  iocbp pointer;
dcl  bitct fixed bin (24);
dcl  copyx char (22) aligned;
dcl  change_static bit (1);
dcl  dest char (64) aligned;
dcl  h1_len fixed bin;				/* the length of hline_1 */
dcl  h3_len fixed bin;				/* and hline_3 */
dcl  head char (64) aligned;
dcl  hline_1 char (204);				/* space for the 1st header line */
dcl  hline_3 char (204);				/* space for the 3rd line */
dcl  letter_size fixed bin;
dcl  level_str char (32) aligned;
dcl  message char (200) var;
dcl  next_char fixed bin;
dcl  notep ptr;
dcl  omode char (256);
dcl  personl fixed bin;
dcl  proji fixed bin;
dcl  projl fixed bin;
dcl  request_type char (32) aligned;
dcl  restrt_cnt_msg char (30) aligned;
dcl  separator_only bit (1);
dcl  temp char (280) aligned;
dcl  xcode fixed bin (35);

/* Based */

dcl  buf char (16000) based (hs_ptr);			/* string that makes up the head sheet text */
%page;

/* head_sheet_: entry (a_stream, a_ordatap, a_code);  */

/* locate the iocb to use based on input stream name */
	call iox_$find_iocb (a_stream, iocbp, a_code);
	if a_code ^= 0 then
	     return;

/* use our default ctl for printer control.  initialize if necessary */
	if default_ctl_not_set then
	     call init_default_prt_ctl;
	prt_ctl_ptr = addr (default_ctl);

	go to common;

print_head_sheet:
     entry (a_switch, a_prt_ctl_ptr, a_ordatap, a_code);

	iocbp = a_switch;

/* if passed a null pointer to prt_ctl use our own default.  initialize if necessary */
	if a_prt_ctl_ptr ^= null then
	     prt_ctl_ptr = a_prt_ctl_ptr;
	else do;
	     if default_ctl_not_set then
		call init_default_prt_ctl;
	     prt_ctl_ptr = addr (default_ctl);
	end;

common:
	a_code = 0;				/* no errors yet */
	ordatap = a_ordatap;			/* define output_request_data for proc */

	call check_static_ctl (prt_ctl_ptr, change_static, separator_only);

	if prt_ctl.banner_type = NO_BANNERS & ^separator_only then
	     return;				/* no head sheet text */

	if change_static then do;
	     call init_template_and_static (a_prt_ctl_ptr, a_code);
						/* set up field definitions */
	     if a_code ^= 0 then
		return;
	end;

	if separator_only then do;
	     message = "";				/* no words above the separator bars */
	     go to write_separator;
	end;

	dmp = ordata.dpmp;
	a_code = 0;				/* this is the initial value */

	next_char = 1;				/* start building at the first char */
	line_no = 0;				/* we have no lines yet */

	if ^ordata.continued then			/* the continued flag may mean restarting this request */
	     if ordata.request_no = last_request_no then do; /* this is simple, the head sheet is the same */
		if ordata.copies > 1 & copy_offset > 0 then do; /* for multi copy just change the number */
		     if ordata.no_separator then
			call ioa_$rsnnl ("^d copies", copyx, n, ordata.copies);
		     else call ioa_$rsnnl ("copy ^d of ^d", copyx, n, ordata.copy_no, ordata.copies);
		     substr (buf, copy_offset, 15) = copyx; /* insert the new copy number */
		end;
		go to print_it;
	     end;

	last_request_no = ordata.request_no;		/* next time we will check against this one */

/* LINE 1 - request no, requestor, header option, dest option, request no     */

	call ioa_$rsnnl ("^7d^5x^24a ^va^2x^24a^4x^7d", hline_1, h1_len,
						/* make the 1st line */
	     ordata.request_no, char (ordata.requestor, 24), head_field, char (dprint_msg.heading, head_field),
						/* use char to truncate field..ioa_ bug */
	     dprint_msg.destination, ordata.request_no);

	h1_len = min (static_ctl.phys_line_length, h1_len);
						/* get ready to truncate */
	substr (buf, next_char, h1_len + 2) = substr (hline_1, 1, h1_len) || NL || NL;
						/* copy in the first two lines */
	next_char = next_char + h1_len + 2;		/* keep the index of good chars */
	line_no = line_no + 2;			/* we now have two header lines, count them */

/* LINE 3 - path name      */

	call ioa_$rsnnl ("^vx^a", hline_3, h3_len, lead_cp_space, ordata.full_path);
						/* this is header line 3 */

	h3_len = min (h3_len, static_ctl.phys_line_length);
						/* get ready to truncate */
	substr (buf, next_char, h3_len + 2) = substr (hline_3, 1, h3_len) || NL || NL;
	next_char = next_char + h3_len + 2;
	line_no = line_no + 2;

/* LINE 5 - Just a bar made of ----- */

	substr (buf, next_char, xl) = xxbar;		/* put in the  --------------------NL */
	next_char = next_char + xl;
	line_no = line_no + 1;

/* LINE 6 - copies if more than 1 and whether the request was restarted or continued */

	if ordata.copies = 1 then
	     copyx = "";
	else if ordata.no_separator then
	     call ioa_$rsnnl ("^d copies", copyx, j, ordata.copies);
	else call ioa_$rsnnl ("copy ^d of ^d", copyx, j, ordata.copy_no, ordata.copies);

	if ordata.control_flags.continued then		/* continued takes precedence over restarted */
	     call ioa_$rsnnl ("continued from request ^d", restrt_cnt_msg, n, ordata.contd_no);
	else if ordata.control_flags.restarted then	/* restarted request */
	     call ioa_$rsnnl ("restarted from request ^d", restrt_cnt_msg, n, ordata.restart_no);
	else restrt_cnt_msg = "";			/* neither continued nor restarted */
						/* SAVE THE CHAR COUNT "n" for the insertion operation */
	if copyx = "" & restrt_cnt_msg = "" then do;	/* for blank data skip line */
	     substr (buf, next_char, 1) = NL;
	     next_char = next_char + 1;
	     copy_offset = 0;			/* say there is no copy number field */
	end;
	else do;					/* non-blank, so put in the copy field for sure */
	     substr (buf, next_char, lead_cp_space + 15) = copy (" ", lead_cp_space) || copyx;
						/* if blank, OK */
	     copy_offset = next_char + lead_cp_space;	/* this is for copy number 2, 3, ... */
	     next_char = copy_offset + 15;
	     if restrt_cnt_msg = "" then do;
		substr (buf, next_char, 1) = NL;	/* terminate the line */
		next_char = next_char + 1;
	     end;
	     else do;
		substr (buf, next_char, no_pad_blanks + 31) =
		     copy (" ", no_pad_blanks) || substr (restrt_cnt_msg, 1, n) || NL;
		next_char = next_char + no_pad_blanks + n + 1;
	     end;
	end;
	line_no = line_no + 1;			/* there was one line either way */

/* LINE 7, 8, and 9 */

	substr (buf, next_char, xl + n_nl) = xxbar || copy (NL, n_nl);
						/* closing  ----- and 1 or 2 more NL */
	next_char = next_char + xl + n_nl;
	line_no = line_no + n_nl + 1;

/* 	find person and project (for defaults) */

	personl = index (ordata.requestor, ".") - 1;
	proji = personl + 2;
	projl = index (substr (ordata.requestor, proji), ".") - 1;

/* LINES 10 to 18 are made by bigletter_ */

	if dprint_msg.destination = "" then
	     dest = substr (ordata.requestor, proji, projl);
	else dest = dprint_msg.destination;

	if big_letters then				/* for normal banners use large bigletters */
	     call bigletter_ (substr (dest, 1, n_letters), wout);
						/* Write banner destination */
	else if med_letters then
	     call bigletter_$five (substr (dest, 1, n_letters), wout);
						/* smaller letters for smaller banners */
	else call wout (addr (dest), min (n_letters, length (rtrim (dest))));
						/* for very short head sheets .... */

/* LINE 19 and 20 */

	substr (buf, next_char, xl + 1) = NL || xxbar;
	next_char = next_char + xl + 1;
	line_no = line_no + 2;

/* LINE 21 -  date, device and installation id  */

	if ordata.request_type = "printer" then
	     request_type = "";			/* don't mention normal type */
	else request_type = ordata.request_type;

	call ioa_$rsnnl ("^24a^6x^va^4x^va^6x^a", temp, n, ordata.date_time_start_request, type_field,
	     char (request_type, type_field), type_field, char (ordata.device_name, type_field), installation);

	n = min (static_ctl.phys_line_length, n);
	substr (buf, next_char, n + 1) = substr (temp, 1, n) || NL;
	next_char = next_char + n + 1;
	line_no = line_no + 1;

/* LINE 22, 23, and 24  -----------------NL NL NL */

	substr (buf, next_char, xl + n_nl) = xxbar || copy (NL, n_nl);
	next_char = next_char + xl + n_nl;
	line_no = line_no + n_nl + 1;			/* add on the correct number of NL's */

/* LINE 25 to 33 -  big letter line for heading (defaults to requestor's name) */

	if dprint_msg.heading = "" then
	     head = substr (ordata.requestor, 1, personl);
	else do;
	     head = dprint_msg.heading;
	     if substr (head, 1, 5) = " for " then
		head = substr (head, 6);
	end;

/* Write banner heading */
	if big_letters then
	     call bigletter_ (substr (head, 1, n_letters), wout);
	else if med_letters then			/* small for short banner pl */
	     call bigletter_$five (substr (head, 1, n_letters), wout);
	else call wout (addr (head), min (n_letters, length (rtrim (head))));
						/* for very short head sheets .... */

/* LINES 34 to the bottom of the page  may be blank or will have the ACCESS CLASS banner */

	if ordata.access_class_string ^= "" then do;

/* LINES 34 and 35  NL------------NL */

	     substr (buf, next_char, xl + 1) = NL || xxbar;
	     next_char = next_char + xl + 1;
	     line_no = line_no + 2;

/* LINES 36 and possibly 37 are the access class in small letters */

	     l1 = length (rtrim (ordata.access_class_string));
						/* how long is the string */
	     temp = ordata.access_class_string;		/* let's make this easier to read */
	     n = min (l1, static_ctl.phys_line_length);	/* first line is small letters, how many?  */

	     substr (buf, next_char, n + 1) = substr (temp, 1, n) || NL;
	     next_char = next_char + n + 1;
	     line_no = line_no + 1;

	     if l1 > static_ctl.phys_line_length then do; /* is there more to write? */
		temp = substr (temp, n + 1);		/* see what is left */
		l1 = length (rtrim (temp));
		if l1 > static_ctl.phys_line_length then
		     substr (temp, static_ctl.phys_line_length, 1) = "?";
						/* if too long, mark as truncated */
		n = min (l1, static_ctl.phys_line_length);
		substr (buf, next_char, n + 1) = substr (temp, 1, n) || NL;
		next_char = next_char + n + 1;
		line_no = line_no + 1;
	     end;

/* LINE 37 (or 38 for a two line access class ) is again  -----------NL */

	     substr (buf, next_char, xl + n_nl) = xxbar || copy (NL, n_nl);
						/* add two more NL's before the bigletters */
	     next_char = next_char + xl + n_nl;
	     line_no = line_no + n_nl + 1;		/* add on the correct number of NL's */

/* LINE 41 (or 42) starts the access class level in big letters */

	     level_str = substr (ordata.access_class_string, 1, 32);
						/* get the level name */
	     l2 = index (level_str, ",") - 1;		/* find component separator */
	     if l2 < 1 then
		l2 = length (rtrim (level_str));	/* only one component */
	     temp = "";				/* clear for easy centering */
	     substr (temp, max (1, divide (n_letters - l2, 2, 17) + 1), l2) = substr (level_str, 1, l2);

	     if big_letters then
		call bigletter_ (substr (temp, 1, n_letters), wout);
						/* omit partial letters */
	     else if med_letters then
		call bigletter_$five (substr (temp, 1, n_letters), wout);

/*	don't put out any smaller letters...its already there */

	end;

/* END the head sheet page with the same lines as on 1 and 2  */

	n = page_length - line_no - 3;		/* how many blank lines to 3 from the bottom */

	substr (buf, next_char, n) = copy (NL, n);	/* put in the correct number */
	next_char = next_char + n;
	line_no = line_no + n;

	substr (buf, next_char, h3_len + 2) = substr (hline_3, 1, h3_len) || NL || NL;
						/* put in the pathname */
	next_char = next_char + h3_len + 2;
	line_no = line_no + 2;

	substr (buf, next_char, h1_len + 1) = substr (hline_1, 1, h1_len) || NL;
						/* and the BOTTOM line */
	page_size = next_char + h1_len;		/* offset of last char of the head_sheet */

print_it:
	if ordata.separator then do;
	     l1 = page_size + sep_size;		/* write enough chars to cover the separator */
	     substr (buf, page_size + 1, sep_size) = substr (sep_ptr -> buf, 1, sep_size);
						/* copy in the separator */
	end;
	else do;					/* on successive copies, don't print the separator */
	     l1 = page_size + 1;			/* just write the head_sheet */
	     substr (buf, page_size + 1, 1) = FF;	/* and make the last char be a form feed */
	end;

	call iox_$modes (iocbp, mode, omode, xcode);

	call iox_$put_chars (iocbp, hs_ptr, l1, a_code);
	if a_code ^= 0 then
	     return;


/* Advertising page follows. */

	call hcs_$initiate_count (sysdir, "printer_notice", "", bitct, 0, notep, xcode);
	if notep ^= null then
	     if bitct > 0 then do;
		call iox_$modes (iocbp, "default", (""), xcode);
		call iox_$put_chars (iocbp, notep, divide (bitct, 9, 21, 0), xcode);
		call hcs_$terminate_noname (notep, xcode);
	     end;

	call iox_$modes (iocbp, omode, (""), xcode);

	a_code = 0;

	return;
%page;

/* ------- SET CTL ENTRY ------- */

set_ctl:
     entry (a_prt_ctl_ptr, a_code);

/* This entry is used to get data on how the head sheet is to be aligned and
   how banner bars are to be printed */

	a_code = 0;

	prt_ctl_ptr = a_prt_ctl_ptr;			/* copy ptr to make code easier to read */

	if prt_ctl.banner_bars < 0 | prt_ctl.banner_bars > 2
						/* legal type? */
	     | prt_ctl.banner_type < 0 | prt_ctl.banner_type > 2 then do;
ctl_err:
	     a_code = error_table_$action_not_performed;
	     return;
	end;

	if prt_ctl.phys_line_length < 10 | prt_ctl.phys_line_length > 200 then
	     go to ctl_err;

	if prt_ctl.lines_per_inch ^= 6 & prt_ctl.lines_per_inch ^= 8 then
	     go to ctl_err;

	if prt_ctl.phys_page_length < prt_ctl.lines_per_inch + 1 | prt_ctl.phys_page_length > 258 then
	     go to ctl_err;

	default_ctl = prt_ctl;			/* get the new default values */

	default_ctl_not_set = "0"b;			/* it is now initialized */

	return;



/* ------- SEPARATOR ENTRY ------- */

separator:
     entry (a_stream, a_message, a_code);

/* this entry will print a fake head sheet with the message centered just
   above the separator bars */

/* locate the iocb to use based on input stream name */
	call iox_$find_iocb (a_stream, iocbp, a_code);
	if a_code ^= 0 then
	     return;

/* use our default ctl for printer control.  initialize if necessary */
	if default_ctl_not_set then
	     call init_default_prt_ctl;

	go to separator_common;

print_separator:
     entry (a_switch, a_prt_ctl_ptr, a_message, a_code);

	iocbp = a_switch;

/* if passed a null pointer to prt_ctl use our own default.  initialize if necessary */
	if a_prt_ctl_ptr ^= null then
	     prt_ctl_ptr = a_prt_ctl_ptr;
	else do;
	     if default_ctl_not_set then
		call init_default_prt_ctl;
	     prt_ctl_ptr = addr (default_ctl);
	end;

separator_common:
	a_code = 0;
	ordatap = null;				/* this is not a real request for head_sheet */

	call check_static_ctl (prt_ctl_ptr, change_static, separator_only);

	if change_static then do;
	     call init_template_and_static (prt_ctl_ptr, a_code);
						/* set up field definitions */
	     if a_code ^= 0 then
		return;
	end;

	message = ltrim (rtrim (a_message));		/* copy and clean the message */

write_separator:					/* head_sheet entries come here too!! */

	last_request_no = -1;			/* mark last head sheet as destroyed */
	copy_offset = 0;

	line_no = 0;				/* no lines yet */
	next_char = 1;				/* start at the begining */

	if page_length > 7 then do;
	     n = page_length - 7;			/* number of lines to 7 from the bottom */
	     substr (buf, 1, n) = copy (NL, n);		/* skip to that point */
	     next_char = n + 1;
	     line_no = n;

/* if the message is real, center it using small bigletters */

	     if message ^= "" then do;

		temp = ltrim (message);		/* strip leading spaces */
		i = length (rtrim (temp));		/* real message length */
		head = "";			/* clear the heading */
		n = divide (static_ctl.phys_line_length, 7, 17);
						/* our own version of n_letters */
		substr (head, max (1, divide (n - i, 2, 17) + 1)) = substr (temp, 1, n);

		call bigletter_$five (substr (head, 1, n), wout);
						/* write the big message */

	     end;
	end;

	n = page_length - line_no;			/* how far to the separator field */
	substr (buf, next_char, n) = copy (NL, n);	/* space down to it */
	next_char = next_char + n;
	substr (buf, next_char, sep_size) = substr (sep_ptr -> buf, 1, sep_size);
						/* add the separator */

	l1 = next_char + sep_size - 1;		/* number of chars to write out */

	call iox_$modes (iocbp, mode, omode, xcode);

	call iox_$put_chars (iocbp, hs_ptr, l1, a_code);
	if a_code ^= 0 then
	     return;

	call iox_$modes (iocbp, omode, (""), xcode);

	return;


/* ------- TEST ENTRY ------- */

test:
     entry (a_sys_dir);

dcl  a_sys_dir char (*);

	sysdir = a_sys_dir;				/* for testing the new notice mechanism */
	return;


/* ------- INIT ENTRY ------- */

init:
     entry ();

	last_request_no = 0;
	return;
%page;

init_template_and_static:
     proc (ctlp, code);

/* this internal proc will create the buffer and set all the internal static values */

dcl  code fixed bin (35);
dcl  ctlp ptr;

	code = 0;					/* start clean */
	static_ctl = ctlp -> prt_ctl;			/* copy new control values */
	static_ctl_not_set = "0"b;			/* it is now initialized */

	line_length = max (82, static_ctl.phys_line_length);
	page_length = static_ctl.phys_page_length - static_ctl.lines_per_inch;
	if sep_ptr = null then do;			/* initialize buffer seg in process dir */
	     call hcs_$make_seg ("", "head_sheet_.template", "", 01010b, sep_ptr, code);
	     if sep_ptr = null then
		return;				/* if it didn't work, return code to caller */
	end;
	call hcs_$truncate_seg (sep_ptr, 0, code);
	if code ^= 0 then
	     return;
	l = divide (static_ctl.lines_per_inch - 4, 2, 17, 0);
						/* number of new lines before and after sep */
	substr (sep_ptr -> buf, 1, l) = copy (NL, l);	/* won't be more than two */
	n = l + 1;				/* n will be the next char in the string */
	do i = 1 to 4;				/* make 4 separator lines */
	     if static_ctl.banner_bars = NORMAL_BANNER_BARS then do; /* this is the double bar case */
		substr (sep_ptr -> buf, n, static_ctl.phys_line_length + 1) =
		     copy ("Z", static_ctl.phys_line_length) || CR;
						/* a row of ZZZs */
		n = n + static_ctl.phys_line_length + 1;/* update the length */
	     end;
	     if static_ctl.banner_bars = NO_BANNER_BARS then do;
		substr (sep_ptr -> buf, n, 1) = NL;	/* no bar...just a new line */
		n = n + 1;
	     end;
	     else do;				/* this is for the single or double bar case */
		substr (sep_ptr -> buf, n, static_ctl.phys_line_length + 1) =
		     copy ("N", static_ctl.phys_line_length) || NL;
						/* last a row of NNNs */
		n = n + static_ctl.phys_line_length + 1;
	     end;
	end;
	substr (sep_ptr -> buf, n - 1, 1) = FF;		/* get to top of next page after separator */
	sep_size = n - 1;				/* this is how much to print */

	i = divide (sep_size + 3, 4, 17, 0);		/* find number of words to hold separator */
	hs_ptr = ptr (sep_ptr, i + 1);		/* start the head sheet 1 word later */

	if page_length > 51 & static_ctl.banner_type ^= BRIEF_BANNERS then do;
	     big_letters = "1"b;			/* use the Biggest letters */
	     n_nl = 2;				/* put 2 NL's after each xxbar */
	     letter_size = 10;			/* 10 print positions per letter */
	end;
	else if page_length > 37 then do;
	     med_letters = "1"b;			/* use the medium size letters */
	     big_letters = "0"b;
	     letter_size = 7;			/* 7 print positions for these letters */
	     n_nl = 1;				/* put only 1 NL after each xxbar */
	end;
	else do;					/* for very short head sheets, we go 1 line */
	     big_letters = "0"b;
	     med_letters = "0"b;
	     n_nl = 1;				/* still 1 NL after each xxbar */
	     letter_size = 1;			/* this is straight text */
	end;
	copy_offset = 0;				/* don't try to insert a copy number */
	last_request_no = -1;			/* say there was no last request */
	if static_ctl.banner_type ^= BRIEF_BANNERS then
	     xxbar = copy ("-", static_ctl.phys_line_length) || NL;
						/* this is one line of "---------" */
	else xxbar = NL;
	xl = length (xxbar);			/* how long it was */
	head_field = line_length - 74;		/* field width for heading on top and bottom */
	type_field = divide (line_length - 72, 2, 17);	/* field width for device and request type */
	no_pad_blanks = max (3, min (39, static_ctl.phys_line_length - 65));
						/* field separator for continued/restarted message */
	lead_cp_space = max (0, min (20, no_pad_blanks - 3));
						/* num spaces before "copy n..." */
	n_letters = divide (static_ctl.phys_line_length, letter_size, 17);
						/* number of big letters per line  */
	call system_info_$installation_id (installation);
	mode = "in0,noskip,truncate,ll" || convert_binary_integer_$decimal_string (static_ctl.phys_line_length);
						/* be ready to truncate */

	return;

     end init_template_and_static;

/* ------------------------------------------------------- */

wout:
     proc (strp, lth);

dcl  strp ptr;
dcl  lth fixed bin;
dcl  bcs char (lth) based (strp);
dcl  i fixed bin;
dcl  temp char (204) aligned;

	temp = bcs;				/* copy to a clean string */
	i = length (rtrim (temp));			/* see how long it actually is */
	substr (buf, next_char, i + 1) = substr (temp, 1, i) || NL;
	next_char = next_char + i + 1;
	line_no = line_no + 1;			/* mark the line as last printed */

	return;

     end wout;
%page;

init_default_prt_ctl:
     proc;

	unspec (default_ctl) = "0"b;			/* clear everything */

	default_ctl.phys_line_length = 136;
	default_ctl.phys_page_length = 66;
	default_ctl.lines_per_inch = 6;
	default_ctl.banner_bars = NORMAL_BANNER_BARS;
	default_ctl.banner_type = NORMAL_BANNERS;

	default_ctl_not_set = "0"b;			/* once per process */

	return;

     end init_default_prt_ctl;




check_static_ctl:
     proc (ctlp, change_static, separator_only);

dcl  ctlp ptr;
dcl  change_static bit (1);
dcl  separator_only bit (1);


	change_static, separator_only = "0"b;		/* clear to the normal case */

	if static_ctl_not_set then
	     change_static = "1"b;			/* nothing to check against */
	if ordatap ^= null then do;			/* look for separator only case */
	     if ordata.separator & ctlp -> prt_ctl.banner_type = NO_BANNERS then
		if ctlp -> prt_ctl.banner_bars ^= NO_BANNER_BARS then
		     separator_only = "1"b;
	end;

	if change_static then
	     return;				/* don't check against static values first time */

	if ctlp -> prt_ctl.phys_line_length ^= static_ctl.phys_line_length then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.phys_page_length ^= static_ctl.phys_page_length then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.lines_per_inch ^= static_ctl.lines_per_inch then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.banner_type ^= static_ctl.banner_type then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.banner_bars ^= static_ctl.banner_bars then
	     change_static = "1"b;

	return;

     end check_static_ctl;
%page; %include dprint_msg;
%page; %include output_request_data;
%page; %include prt_ctl;
%page; %include queue_msg_hdr;

     end head_sheet_;




		    tail_sheet_.pl1                 10/28/88  1405.4rew 10/28/88  1238.8      239085



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


/* format: style4 */

/* format: off */

/* TAIL_SHEET_ - make distribution and filing page for IO Daemon output.
   This page is always printed on the outside. It contains the accounting information too.

   THVV */

/* Modified in December 1975 by M. A. Braida to state when a request has been continued */
/* Modified June 1976 by J. L. Homan to accommodate charging by line count instead of block count. */
/* Modified August 1977 by J. C. Whitmore to add variable page length */
/* Modified by J. C. Whitmore, 4/78, for new dprint_msg_format and ordata info for price msg */
/* Modified by J. C. Whitmore, 8/78, for new info from ordata in price block */
/* Modified by C. Hornig, 6/79, to add print_tail_sheet entry */
/* Modified by R. McDonald May 1980 to include page charges on tail sheet (UNCA) */
/* Modified by E. N. Kittlitz June 1981 for UNCA page charges */
/* Modified: 25 November 1981 by G. Palter as part of fixing the following bug from the I/O daemon error list:
      0032: phx11372
         When running an I/O daemon in test mode with the coordinator and driverin the same process, printing a single
         request, exiting the I/O daemon, re-entering the I/O daemon, and printing another request will cause the
         head/tail sheets of the first request to be printed surrounding the file specified in the second request */
/* Modified 15 February 1982 by E. N. Kittlitz for ordata.rs_unavailable flag. */
/* Modified: November 1983 by C. Marker Added support for no_separator */
/* Modified: August 1984 by JAFalksen converted to use default date format */


/****^  HISTORY COMMENTS:
  1) change(87-05-10,Gilcrease), approve(87-08-17,MCR7686),
     audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
     eor -nb change; corrected stringsize error.
  2) change(88-06-03,Brunelle), approve(88-06-03,MCR7911),
     audit(88-10-18,Wallman), install(88-10-28,MR12.2-1199):
     The print_tail_sheet entrypoint was upgraded to handle a null
     a_prt_ctl_ptr argument by using the default_ctl values.  The declarations
     were reorganized.
                                                   END HISTORY COMMENTS */

/* format: on */

tail_sheet_:
     proc (a_stream, a_ordatap, a_code);

/* Parameters */

dcl  a_code fixed bin (35) parameter;			/* return error code */
dcl  a_ordatap ptr parameter;				/* ptr to output_request_data */
dcl  a_prt_ctl_ptr pointer parameter;			/* ptr to prt_ctl */
dcl  a_stream char (*) parameter;			/* Output streamname */
dcl  a_switch pointer parameter;			/* IOCB ptr for same */

/* External Procedures & Variables  */

dcl  bigletter_$five entry (char (*) aligned, entry);
dcl  convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var);
dcl  date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var);
dcl  error_table_$action_not_performed fixed bin (35) ext;
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35));
dcl  ioa_$rsnnl entry options (variable);
dcl  iox_$find_iocb entry (char (*), pointer, fixed bin (35));
dcl  iox_$modes entry (pointer, char (*), char (*), fixed bin (35));
dcl  iox_$put_chars entry (pointer, pointer, fixed bin (21), fixed bin (35));
dcl  system_info_$max_rs_number entry (fixed bin);
dcl  system_info_$rs_name entry (fixed bin, char (*), fixed bin (35));

/* Builtins */

dcl  (addr, addrel, char, copy, divide, hbound, index, length, max, min, null, rtrim, size, unspec, substr) builtin;

/* Internal Static */

dcl  NL char (1) int static options (constant) init ("
");
dcl  static_ctl_not_set bit (1) int static init ("1"b);	/* initialize on first call */
dcl  default_ctl_not_set bit (1) int static init ("1"b);	/* initialize when first used */
dcl  mode char (256) int static;			/* mode string to provide output truncation */
dcl  ctr_len fixed bin int static;			/* how big is the center part, print positions */
dcl  path_field fixed bin int static;			/* how much room to allow for the pathname */
dcl  block_ind fixed bin int static;			/* how far to indent the charge block */
dcl  ts_ptr ptr int static init (null);			/* ptr to space for 60 lines of 132 + NL chars */
dcl  lh_ptr ptr int static init (null);			/* ptr to left array of vert letters */
dcl  rh_ptr ptr int static init (null);			/* ptr to right array of vert letters */
dcl  buf_ptr ptr int static init (null);		/* ptr to the tail sheet buffer */
dcl  page_size fixed bin (21) int static;		/* size of the complete tailsheet */
dcl  real_ll fixed bin int static init (136);		/* line length to be printed */
dcl  pl fixed bin int static init (60);			/* number of print lines on the tail sheet */
dcl  lpi fixed bin int static init (6);			/* number of lines per inch printed */
dcl  copy_offset fixed bin int static;			/* where "copy x of y" starts */
dcl  last_request_no fixed bin int static;		/* request number of the last tailsheet we made */
dcl  step fixed bin int static;			/* indicates how much vertical shrinkage to use */
dcl  vert_names bit (1) int static;
dcl  max_big_v fixed bin int static;
dcl  max_big_h fixed bin int static;
dcl  max_rs_number fixed bin int static init (-1);	/* maximum rate structure number */
dcl  rs_names (-1:9) char (32) static int init ((11) ("tail_sheet_ uninitialized"));

dcl  1 default_ctl aligned like prt_ctl int static;	/* the default parameters for old type entries */

dcl  1 static_ctl aligned like prt_ctl int static;	/* the active set of parameters */

/* Automatic */

dcl  (head, dest) char (64) aligned;
dcl  (i, j, n) fixed bin;				/* random index variables */
dcl  bottom_ctr char (204);
dcl  calc_line_charge float bin;			/* temporary storage for line charge */
dcl  calc_page_charge float bin;			/* temporary storage for  page charge */
dcl  change_static bit (1);
dcl  datstr char (64) var;
dcl  iocbp pointer;
dcl  letter_index fixed bin;
dcl  line_no fixed bin;				/* marker fir the current line number */
dcl  next_char fixed bin;				/* next free char in the tail sheet string (buf) */
dcl  omode char (256);				/* old mode string */
dcl  real_line_count fixed bin;			/* Actual line count taking -no_separator into account. */
dcl  real_page_count fixed bin;			/* Actual page count taking -no_separator into account. */
dcl  temp char (280);
dcl  temp1 char (200);

/* Based */

dcl  lh_part (pl) char (12) based (lh_ptr);		/* the array of left hand vertical letters */
dcl  rh_part (pl) char (12) based (rh_ptr);		/* the array of right hand vertical letters */
dcl  buf char (16000) based (buf_ptr);			/* the tailsheet buffer */
%page;

/* tail_sheet_:  proc (a_stream, a_ordatap, a_code);		*/

/* locate the iocb to use based on input stream name */
	call iox_$find_iocb (a_stream, iocbp, a_code);
	if a_code ^= 0 then
	     return;

/* use our default ctl for printer control.  initialize if necessary */
	if default_ctl_not_set then
	     call init_default_prt_ctl;

	goto common;

print_tail_sheet:
     entry (a_switch, a_prt_ctl_ptr, a_ordatap, a_code);

	iocbp = a_switch;

/* if passed a null pointer to prt_ctl use our own default.  initialize if necessary */
	if a_prt_ctl_ptr ^= null then
	     prt_ctl_ptr = a_prt_ctl_ptr;
	else do;
	     if default_ctl_not_set then
		call init_default_prt_ctl;
	     prt_ctl_ptr = addr (default_ctl);
	end;

common:	if prt_ctl.banner_type = NO_BANNERS then
	     return;				/* nothing to do - forget it */
						/* AND don't mess up and static values! */

	call check_static_ctl (prt_ctl_ptr, change_static);

	if change_static then do;
	     call init_template_and_static (prt_ctl_ptr, a_code);
						/* set up field definitions */
	     if a_code ^= 0 then
		return;
	end;

	a_code = 0;
	ordatap = a_ordatap;			/* define output_request_data for proc */
	dmp = ordata.dpmp;

	if pl < 11 then do;				/* if too small, make it blank */
	     page_size = pl + lpi - 3;
	     substr (buf, 1, page_size) = copy (NL, page_size);
						/* all new lines past the perforations */
	     go to print_it;
	end;

	if ^ordata.continued then			/* the continued flag may mean restarting this request */
	     if ordata.request_no = last_request_no then do; /* same as the last? */
		if copy_offset > 0 then do;		/* multiple copy field? */
		     if ordata.no_separator then
			call ioa_$rsnnl ("^2d copies", temp, n, ordata.copy_no);
		     else call ioa_$rsnnl ("Copy ^2d  of ^2d", temp, n, ordata.copy_no, ordata.copies);
		     substr (buf, copy_offset, n) = temp;
						/* just put in new copy number */
		end;
		go to print_it;			/* now print what is there */
	     end;

	last_request_no = ordata.request_no;		/* save the new request number */
	lh_part (*) = "";				/* clear out old vertical names */
	rh_part (*) = "";
	line_no = 1;				/* this is the next line to be formatted */
	next_char = 1;				/* this is where the next char should be put into buf */

	if vert_names then do;			/* make up vert sideways names if we should */
	     letter_index = 1;			/* start with the first line of the letters */
	     i = index (ordata.requestor, ".");
	     j = index (substr (ordata.requestor, i + 1), ".");
	     if dprint_msg.destination ^= "" then
		dest = dprint_msg.destination;	/* Get destination. */
	     else dest = substr (ordata.requestor, i + 1, j - 1);
						/* Default is project. */

	     if dprint_msg.heading = "" then
		head = substr (ordata.requestor, 1, i - 1);
	     else do;
		head = dprint_msg.heading;
		if substr (head, 1, 5) = " for " then
		     head = substr (head, 6);
	     end;

	     call bigletter_$five (substr (dest, 1, max_big_v), w_left);
						/* make the left column from the dest */

	     call bigletter_$five (substr (head, 1, max_big_v), w_right);
						/* head makes the right column */
	end;

/* LINE 1 - request number and pathname (use the same for the last line ) */

	call ioa_$rsnnl ("^d^10t ^a ^vt^d", temp, n, ordata.request_no, char (ordata.full_path, path_field),
	     ctr_len - 7, ordata.request_no);
	substr (bottom_ctr, 1, length (bottom_ctr)) = substr (temp, 1, length (bottom_ctr));
						/* save this for the last line */
	call make_line (temp);			/* this will write it into the buffer */

/* LINE 2 - blank in the center   */

	call make_line ("");

/* LINE 3 - copy x of y     or  blank   */
	if ordata.copies > 1 then do;
	     if ordata.no_separator then
		call ioa_$rsnnl ("^2d copies", temp, n, ordata.copy_no);
	     else call ioa_$rsnnl ("Copy ^2d  of ^2d", temp, n, ordata.copy_no, ordata.copies);
	     if vert_names then
		n = 20;
	     else n = 8;
	     copy_offset = next_char + n;		/* where the "C" will start in buf */
	end;
	else do;
	     temp = "";
	     copy_offset = 0;			/* don't try  to replace the copy string */
	end;

	call make_line ((8)" " || temp);		/* this starts 8 spaces into the center part */

/* LINE 4 - center is all blank */

	call make_line ("");

/* LINE 5 to 10 - a blank center plus the big entry name for long tail sheets  */

	if step < 3 then do;
	     call make_line ("");
	     call bigletter_$five (substr (dprint_msg.ename, 1, max_big_h), make_big_line);
	end;

/* LINES 11 to 21 - more blank centers depending on page length */

	if step = 1 then
	     n = 11;				/* 11 blanks for long pages */
	else if step = 2 then
	     n = 1;				/* 1 for medium size pages */
	else n = 0;				/* forget it for small ones */

	do i = 1 to n;
	     call make_line ("");
	end;

/* LINE 22 - this is the top of the charge block */

	call make_line (copy (" ", block_ind) || (64)"$");

/* LINE 23 - box with blank inside */

	call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");

/* LINE 24 - When was it requested */

	if step < 4 then do;			/* only for normal charge blocks */
	     datstr = date_time_$format ("date_time", dprint_msg.msg_time, "", "");
	     call ioa_$rsnnl ("$  Requested ^24a^26x$", temp, n, datstr);
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 25 - When it was dprinted */

	     call ioa_$rsnnl ("$  Output    ^24a^26x$", temp, n, ordata.date_time_start_request);
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 26 - Box blank */

	     call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");

/* LINE 27 - Output mode user specified */

	     if ordata.output_mode ^= "" then		/* print modes as user requested */
		call ioa_$rsnnl ("$  Output mode ^46a  $", temp, n, char (ordata.output_mode, 46));
	     else temp = "$" || (62)" " || "$";
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 28 - Request type queue and device */

	     call ioa_$rsnnl ("$  ^a queue ^d^12x^a^[  ** Priority ^d **^;^s^]", temp, n, ordata.request_type,
		ordata.queue, ordata.device_name, ordata.priority_request, ordata.charge_queue);
	     substr (temp, 62) = "  $";		/* trim off any extra */
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 29 - Box blank */

	     call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");

/* LINE 30 - number of pages and restart msg */

	     if ordata.saved then
		temp1 = "Request suspended by operator.";

	     else if ordata.control_flags.continued then	/* else if continued..tell user */
		call ioa_$rsnnl ("Continued from request ^d", temp1, n, ordata.contd_no);

	     else if ordata.control_flags.restarted then	/* else if control_flags.restarted..tell user */
		call ioa_$rsnnl ("Restarted from request ^d", temp1, n, ordata.restart_no);
	     else temp1 = "";
	     if temp1 ^= "" then do;
		call ioa_$rsnnl ("$  ^a", temp, n, temp1);
		substr (temp, 62) = "  $";
		call make_line (copy (" ", block_ind) || temp);
	     end;


	     if ordata.no_separator then
		real_page_count = ordata.page_count * ordata.copies;
	     else real_page_count = ordata.page_count;

/* calculate the page charge and put it out */
	     if ordata.charge > 0e0 then
		calc_page_charge = real_page_count * ordata.price_per_n_pages / ordata.n_pages_for_price;
	     else calc_page_charge = 0e0;
	     call ioa_$rsnnl ("$  ^d pages^[ at $^.2f per ^d pages ^52t^10.2f^;^3s^]", temp, n, real_page_count,
		(calc_page_charge > 0e0), ordata.price_per_n_pages, ordata.n_pages_for_price, calc_page_charge);
	     substr (temp, 62) = "  $";		/* trim the extra */
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 31 - Box blank */

	     call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");

/* LINE 32 - charge basis msg */

	     if ordata.no_separator then
		real_line_count = ordata.line_count * ordata.copies;
	     else real_line_count = ordata.line_count;

	     if ordata.charge > 0e0 then
		calc_line_charge = real_line_count * ordata.price_per_n_lines / ordata.n_lines_for_price;
	     else calc_line_charge = 0e0;
	     call ioa_$rsnnl ("$  ^d lines^[ at $^.2f per ^d lines ^52t^10.2f^;^3s^]", temp, n, real_line_count,
		(calc_line_charge > 0e0), ordata.price_per_n_lines, ordata.n_lines_for_price, calc_line_charge);
	     substr (temp, 62) = "  $";		/* again trim */
	     call make_line (copy (" ", block_ind) || temp);

/* LINE 33 - Box blank */

	     call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");
	end;

/* LINE 34 - charge to the user */

	call ioa_$rsnnl ("$  Charge to ^32a^6x^10.2f  $", temp, n, ordata.requestor, ordata.charge);
	call make_line (copy (" ", block_ind) || temp);

/* LINE 35 - Box blank or rate structure info */

	if max_rs_number = 0 | ordata.no_accounting then
	     call make_line (copy (" ", block_ind) || "$" || (62)" " || "$");
	else do;
	     call ioa_$rsnnl ("$    Rate structure ^[unknown, ^a used^;^a^].", temp, n, ordata.rs_unavailable,
		rs_names ((ordata.rs_number)));
	     substr (temp, 62) = "  $";
	     call make_line (copy (" ", block_ind) || temp);
	end;

/* LINE 36 - Bottom of the box */

	call make_line (copy (" ", block_ind) || (64)"$");

/* LINE 37 to 51 are for the ACCESS CLASS if it exists */

	if ordata.access_class_string ^= "" & step < 4 then do; /* do we have a printable access class */

/* LINE 37 to 40 - blank center */

	     if step = 1 then
		n = 4;
	     else if step = 2 then
		n = 2;
	     else n = 1;

	     do i = 1 to n;
		call make_line ("");
	     end;

/* LINE 41 and 42  access class in small letters */

	     i = length (rtrim (ordata.access_class_string));
	     if i > ctr_len then do;			/* break it if too long */
		call make_line (substr (ordata.access_class_string, 1, ctr_len));
		temp = substr (ordata.access_class_string, ctr_len + 1);
		i = length (rtrim (temp));
		if i > ctr_len then
		     substr (temp, ctr_len, 1) = "?";
		call make_line (substr (temp, 1, ctr_len));
	     end;
	     else do;				/* if it fits in the middle, center it */
		temp = "";			/* clear any junk */
		substr (temp, divide (ctr_len - i, 2, 17) + 1, i) = ordata.access_class_string;
		call make_line (temp);
	     end;

/* LINE 43 to 46 - more blank centers */

	     if step = 1 then
		n = 4;
	     else if step = 2 then
		n = 2;
	     else n = 0;

	     do i = 1 to n;
		call make_line ("");		/* put in the right number of blank lines */
	     end;

/* LINE 47 to 51 BIG access class */

	     if step < 3 then do;			/* only if the page length is large enough */
		i = index (ordata.access_class_string, ",") - 1;
						/* find the break char if any */
		if i < 0 then			/* no comma...find first non blank from right */
		     i = length (rtrim (ordata.access_class_string));
		temp = "";			/* start with blanks */
		substr (temp, max (1, divide (max_big_h - i, 2, 17) + 1), i) =
		     substr (ordata.access_class_string, 1, i);
		call bigletter_$five (substr (temp, 1, max_big_h), make_big_line);
	     end;
	end;

/* LINE 52 to the end of the page are now filled in */

	n = pl - line_no;				/* how many lines before the bottom */

	do i = 1 to n;
	     call make_line ("");			/* finish off the vertical columns on left and right */
	end;

/* BOTTOM LINE of printing for the tail sheet */

	call make_line (bottom_ctr);			/* it was taken from the first line */

/* Now feed past the perforations */

	substr (buf, next_char, lpi - 2) = copy (NL, lpi - 2);

	page_size = next_char + lpi - 3;		/* the final char count */

print_it:
	call iox_$modes (iocbp, mode, omode, a_code);

	call iox_$put_chars (iocbp, buf_ptr, page_size, a_code);

	call iox_$modes (iocbp, omode, (""), (0));

	return;
%page;

make_line:
     proc (center);

/* this proc takes the center part of the tailsheet and adds on the right and left columns */

dcl  center char (*);
dcl  line char (204);				/* line image buffer */
dcl  n fixed bin;					/* our own index variable */

	if vert_names then do;			/* add vert columns if supposed to */
	     line = lh_part (line_no);		/* left part is the first 12 chars */
	     substr (line, 13) = center;		/* center part starts in col 13 */
	     substr (line, ctr_len + 13) = rh_part (line_no);
						/* last 12 chars are the right column */
	end;
	else line = center;				/* otherwise just use the center */

	n = length (rtrim (line));
	n = min (n, real_ll) + 1;			/* truncate if need be */

	substr (buf, next_char, n) = substr (line, 1, n - 1) || NL;
	next_char = next_char + n;
	line_no = line_no + 1;			/* ready for the next line */
	return;

     end make_line;

/* ---------------------------------------- */

make_big_line:
     proc (p, len);

/* this is like make_line, but it is used by bigletter_ */

dcl  p ptr;					/* ptr to big line string */
dcl  len fixed bin;					/* length of big string */
dcl  center char (len) based (p);
dcl  line char (204);				/* line image buffer */
dcl  n fixed bin;					/* our own index variable */

	if vert_names then do;			/* add vert columns if supposed to */
	     line = lh_part (line_no);		/* left part is the first 12 chars */
	     substr (line, 13) = center;		/* center part starts in col 13 */
	     substr (line, ctr_len + 13) = rh_part (line_no);
						/* last 12 chars are the right column */
	end;
	else line = center;				/* otherwise just use the center */

	n = length (rtrim (line));
	n = min (n, real_ll) + 1;			/* truncate if need be */

	substr (buf, next_char, n) = substr (line, 1, n - 1) || NL;
	next_char = next_char + n;
	line_no = line_no + 1;			/* ready for the next line */
	return;

     end make_big_line;
%page;

w_left:
     proc (p, len);

/* this is the bigletter_ proc which makes left columns */

dcl  p ptr;
dcl  len fixed bin;
dcl  string char (len) based (p);
dcl  line char (256);
dcl  (i, i1, i2) fixed bin;

	line = string;				/* make the string big enough */
	do i = 1 to pl;
	     substr (lh_part (i), 6 - letter_index, 1) = substr (line, i, 1);
	end;
	letter_index = letter_index + 1;		/* advance to next letter col */
	if letter_index > 5 then
	     letter_index = 1;			/* auto reset */
	return;


w_right:
     entry (p, len);

/* this is like w_left but for the right hand column */


	line = string;

	i1 = letter_index + 7;			/* positions 8 to 12 in rh_part form the col */
	i2 = pl + 1;				/* make this easier to read and run */
	do i = pl to 1 by -1;			/* on right we go up */
	     substr (rh_part (i), i1, 1) = substr (line, i2 - i, 1);
	end;
	letter_index = letter_index + 1;
	if letter_index > 5 then
	     letter_index = 1;			/* auto reset */
	return;

     end w_left;
%page;

set_ctl:
     entry (a_prt_ctl_ptr, a_code);

/*  This entry is used to get data on how the tail sheet is to be formatted */

	a_code = 0;

	prt_ctl_ptr = a_prt_ctl_ptr;			/* copy ptr to make code easier to read */

	if prt_ctl.banner_bars < 0 | prt_ctl.banner_bars > 2
						/* legal type? */
	     | prt_ctl.banner_type < 0 | prt_ctl.banner_type > 2 then do;
ctl_err:
	     a_code = error_table_$action_not_performed;
	     return;
	end;

	if prt_ctl.phys_line_length < 10 | prt_ctl.phys_line_length > 200 then
	     go to ctl_err;

	if prt_ctl.lines_per_inch ^= 6 & prt_ctl.lines_per_inch ^= 8 then
	     go to ctl_err;

	if prt_ctl.phys_page_length < prt_ctl.lines_per_inch + 1 | prt_ctl.phys_page_length > 258 then
	     go to ctl_err;

	default_ctl = prt_ctl;			/* get the new default values */

	default_ctl_not_set = "0"b;			/* it is now initialized */

	return;



/* ------- INIT ENTRY ------- */

init:
     entry ();

	last_request_no = 0;
	return;
%page;

init_template_and_static:
     proc (ctlp, code);

dcl  ctlp ptr;
dcl  code fixed bin (35);

	code = 0;

	static_ctl = ctlp -> prt_ctl;			/* record the current (last) control data */
	static_ctl_not_set = "0"b;

	if ts_ptr = null then do;			/* be sure we have a ptr to the template */

	     call hcs_$make_seg ("", "tail_sheet_.template", "", 01010b, ts_ptr, code);
	     if ts_ptr = null then
		return;				/* didn't work, return error code */

	end;
	call hcs_$truncate_seg (ts_ptr, 0, code);	/* make it clean */
	if code ^= 0 then
	     return;

	real_ll = static_ctl.phys_line_length;		/* use short name variables for frequent values */
	lpi = static_ctl.lines_per_inch;
	pl = static_ctl.phys_page_length - lpi;		/* printable lines */

	lh_ptr = ts_ptr;				/* start with the left vert letters */
	rh_ptr = addrel (lh_ptr, size (lh_part) + 1);	/* then the right side */
	buf_ptr = addrel (rh_ptr, size (rh_part) + 1);	/* finally the full buffer */
	if (real_ll > 87) & (static_ctl.banner_type = NORMAL_BANNERS) then do; /* see if there is space for vertical letters */
	     vert_names = "1"b;
	     ctr_len = real_ll - 24;
	end;
	else do;
	     vert_names = "0"b;
	     ctr_len = real_ll;			/* put it all in the center */
	end;
	max_big_h = divide (ctr_len, 7, 17, 0);		/* number of horiz big letters */
	max_big_v = divide (pl, 7, 17, 0);		/* number of vertical letters */
	block_ind = max (0, divide (ctr_len - 64, 2, 17, 0));
						/* spaces before the charge block */
	if pl > 53 then
	     step = 1;				/* start block on line 22 */
	else if pl > 39 then
	     step = 2;				/* start block on line 12 */
	else if pl > 20 then
	     step = 3;				/* omit all big horiz letters */
	else step = 4;				/* only the charge data */
	last_request_no = -1;			/* can't use last tail sheet */
	copy_offset = 0;				/* don't insert a copy.... field for 2, 3, ... */
	path_field = ctr_len - 18;			/* space for pathname in small letters */
	mode = "in0,noskip,truncate,ll" || convert_binary_integer_$decimal_string (real_ll);

/* if we've never done it before, get all the rate_structure names.
   For RS numbers > max_rs_number, system_info_ will return a name
   of the form " INVALID_RS_n". */

	if max_rs_number < 0 then do;
	     call system_info_$max_rs_number (max_rs_number);
	     do i = 0 to hbound (rs_names (i), 1);
		call system_info_$rs_name (i, rs_names (i), (0));
	     end;
	end;

	return;

     end init_template_and_static;
%page;

init_default_prt_ctl:
     proc;

	unspec (default_ctl) = "0"b;			/* clear everything */

	default_ctl.phys_line_length = 136;
	default_ctl.phys_page_length = 66;
	default_ctl.lines_per_inch = 6;
	default_ctl.banner_bars = NORMAL_BANNER_BARS;
	default_ctl.banner_type = NORMAL_BANNERS;

	default_ctl_not_set = "0"b;			/* once per process */

	return;

     end init_default_prt_ctl;




check_static_ctl:
     proc (ctlp, change_static);

dcl  ctlp ptr;
dcl  change_static bit (1);


	change_static = "0"b;			/* clear to the normal case */

	if static_ctl_not_set then do;
	     change_static = "1"b;			/* nothing to check against */
	     return;
	end;

/* 	check for changed values of importance to this program */

	if ctlp -> prt_ctl.phys_line_length ^= static_ctl.phys_line_length then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.phys_page_length ^= static_ctl.phys_page_length then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.lines_per_inch ^= static_ctl.lines_per_inch then
	     change_static = "1"b;
	else if ctlp -> prt_ctl.banner_type ^= static_ctl.banner_type then
	     change_static = "1"b;

	return;

     end check_static_ctl;
%page; %include dprint_msg;
%page; %include output_request_data;
%page; %include prt_ctl;
%page; %include queue_msg_hdr;

     end tail_sheet_;







		    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