



		    cv_prt_rqti.rd                  03/17/86  1521.3rew 03/17/86  1433.2      156249



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

/* format: style4,delnl,insnl,^ifthendo */

/* format: off */

/* Program to convert an ASCII file into a request info segment */

/* Created:  May 1977 by E. Donner */
/* Modified: June 1979 by C. Hornig to add banner_bars and banner_type: brief; */
/* Modified: December 1981 by G. Palter to add "prt_control: force_ctl_char;" and to fix entry number 0001 (phx06682) from
      the io_daemon error list: cv_prt_rqti prints a misleading error message when improper syntax appears in the
      "message" statement (and probably other statements also) */
/* Modified: November 1983 by C. Marker to add force_nsep */

/* format: on */

/*++

BEGIN
	/ driver_attributes :	/ LEX(2)					/ driver_attr\

	/ driver_wait_time : <legal_wait_time> ;
				/ [prt_rqti.driver_wait_time = wait_time] LEX(4)	/ BEGIN\
	/ driver_wait_time : <any-token> ;
				/ NEXT_STMT				/ BEGIN\

	/ banner_type : standard ;	/ [is_printer = "1"b; prt_rqti.banner_type = 1] LEX(4)
									/ BEGIN\
	/ banner_type : brief ;	/ [is_printer = "1"b; prt_rqti.banner_type = 2] LEX(4)
									/ BEGIN\
	/ banner_type : none ;	/ [is_printer = "1"b; prt_rqti.banner_type = 0] LEX(4)
									/ BEGIN\
	/ banner_type : <any-token> ;	/ LEX(2) ERROR(18) NEXT_STMT			/ BEGIN\
	/ banner_type : <any-token>	/ ERROR(4) NEXT_STMT			/ BEGIN\

	/ banner_bars : double ;	/ [is_printer = "1"b; prt_rqti.banner_bars = 0] LEX(4)
									/ BEGIN\
	/ banner_bars : single ;	/ [is_printer = "1"b; prt_rqti.banner_bars = 1] LEX(4)
									/ BEGIN\
	/ banner_bars : none ;	/ [is_printer = "1"b; prt_rqti.banner_bars = 2] LEX(4)
									/ BEGIN\
	/ banner_bars : <any-token> ;	/ LEX(2) ERROR(14) NEXT_STMT			/ BEGIN\
	/ banner_bars : <any-token>	/ ERROR(4) NEXT_STMT			/ BEGIN\

	/ prt_control :		/ [is_printer = "1"b] LEX(2)			/ process_control_flags\

	/ message : <quoted-string> ;
				/ LEX(2) [prt_rqti.opr_msg = token_value; is_printer = "1"b] LEX(2)
									/ BEGIN\
	/ message : <any-token> 	/ ERROR(4) NEXT_STMT			/ BEGIN\

	/ paper_length : <legal_paper_len> ;
				/ [prt_rqti.paper_length = paper_len; is_printer = "1"b] LEX(4)
									/ BEGIN\
	/ paper_length : <any-token> ;
				/ NEXT_STMT				/ BEGIN\

	/ paper_width : <legal_paper_wdth> ;
				/ [prt_rqti.paper_width = paper_wdth; is_printer = "1"b] LEX(4)
								          / BEGIN\
	/ paper_width : <any-token> ;	/ NEXT_STMT				/ BEGIN\

	/ lines_per_inch : <legal_lpi> ;
				/ [prt_rqti.lines_per_inch = lpi; is_printer = "1"b] LEX(4)
									/ BEGIN\
	/ lines_per_inch : <any-token> ;
				/ NEXT_STMT				/ BEGIN\

	/ line ( <legal_line_no> ) :	/ [is_printer = "1"b] LEX(5)			/ process_nos\
	/ line ( <any-token> ) :	/ NEXT_STMT				/ BEGIN\

	/ end ;			/					/ end\

	/ <any-token> :		/ ERROR(1) NEXT_STMT			/ BEGIN\
	/ <any-token>		/ ERROR(4) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

process_nos
	/ <legal_chn_no>		/ [substr(prt_rqti.channel_stops(line_no),chn_no,1)="1"b] LEX(1)
									/ get_punct\
	/ <any-token>		/ NEXT_STMT				/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

get_punct
	/ ,			/ LEX					/ process_nos\
	/ ;			/ LEX					/ BEGIN\
	/ <any-token>		/ ERROR(4) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

end	/			/					/ RETURN\

driver_attr
	/			/ [ind = 1; string (switches(0)) =""b; string (switches (1)) = ""b]
									/ \

driver_loop
	/ ;			/ LEX					/ assign_switches\
	/ ^			/ [ind = 1 - ind] LEX			/ \
	/ meter			/ [switches (ind).meter = "1"b] LEX		/ attpunct\
	/ auto_go			/ [switches (ind).auto_go = "1"b] LEX		/ attpunct\

	/ <any-token>		/ ERROR(15) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

attpunct
	/ ,			/ [ind = 1] LEX				/ driver_loop\
	/ ;			/ LEX					/ assign_switches\

	/ <any-token>		/ ERROR(4) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

assign_switches
	/			/ [string(prt_rqti.rqti_switches) = string(switches(1)) & ^string(switches(0))]
									/ BEGIN\

process_control_flags
	/			/ [ind = 1; string(flags(0)) = ""b; string(flags(1)) = ""b]
									/ \

flag_loop
	/ ;			/ LEX					/ assign_flags\

	/ ^			/ [ind = 1 - ind] LEX			/ \
	/ auto_print		/ [flags(ind).no_auto_print = "1"b] LEX		/ flagpunct\
	/ force_nep		/ [flags(ind).force_nep = "1"b] LEX		/ flagpunct\
	/ force_esc		/ [flags(ind).force_esc = "1"b] LEX		/ flagpunct\
	/ force_nsep		/ [flags(ind).force_nsep = "1"b] LEX		/ flagpunct\
	/ force_ctl_char		/ [flags(ind).force_ctl_char = "1"b] LEX	/ flagpunct\

	/ <any-token>		/ ERROR(16) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

flagpunct
	/ ,			/ [ind = 1] LEX				/ flag_loop\
	/ ;			/ LEX					/ assign_flags\

	/ <any-token>		/ ERROR(4) NEXT_STMT			/ BEGIN\
	/ <no-token>		/ ERROR(2)				/ end\

assign_flags
	/			/ [string(prt_rqti.prt_flags) = string(flags(1)) & ^string(flags(0))]
									/ BEGIN\

++*/

/**/

cv_prt_rqti:
     procedure () options (variable);

/* AUTOMATIC VARIABLES */

dcl  APstmt ptr;
dcl  APtoken ptr;
dcl  area_ptr ptr;
dcl  arg_length fixed bin;
dcl  arg_ptr ptr;
dcl  bitcount fixed bin (24);
dcl  chn_no fixed bin;
dcl  code fixed bin (35);
dcl  dname char (168);
dcl  ename char (32);
dcl  ind fixed bin;
dcl  is_printer bit (1) aligned;
dcl  len_ent fixed bin;
dcl  len_rqti fixed bin (18);
dcl  line_no fixed bin;
dcl  lpi fixed bin;
dcl  max_line_no fixed bin;
dcl  n_chars fixed bin (21);
dcl  paper_len fixed bin;
dcl  paper_wdth fixed bin;
dcl  rqti_name char (32);
dcl  sourcep ptr;
dcl  wait_time fixed bin;

dcl  1 flags (0:1) aligned like prt_rqti.prt_flags;
dcl  1 switches (0:1) aligned like rqti_header.rqti_switches;

/* BASED VARIABLES */

dcl  arg char (arg_length) based (arg_ptr);

/* BUILTINS */

dcl  (clock, collate, dimension, divide, length, null, rtrim, size, string, substr, unspec) builtin;

/* CONDITIONS */

dcl  cleanup condition;

/* EXTERNAL ENTRIES */

dcl  com_err_ entry options (variable);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  hcs_$delentry_seg entry (ptr, fixed bin (35));
dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl  hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35));
dcl  get_wdir_ entry returns (char (168) aligned);
dcl  lex_error_ entry options (variable);
dcl  lex_string_$init_lex_delims
	entry (char (*), char (*), char (*), char (*), char (*), bit (*), char (*) var, char (*) var, char (*) var,
	char (*) var);
dcl  lex_string_$lex
	entry (ptr, fixed bin (21), fixed bin, ptr, bit (*), char (*), char (*), char (*), char (*), char (*),
	char (*) var, char (*) var, char (*) var, char (*) var, ptr, ptr, fixed bin (35));
dcl  translator_temp_$get_segment entry (char (*), ptr, fixed bin (35));
dcl  translator_temp_$release_all_segments entry (ptr, fixed bin (35));

/* INTERNAL STATIC VARIABLES */

dcl  BREAKS char (128) varying;
dcl  IGBREAKS char (128) varying;
dcl  LEXCTL char (128) varying;
dcl  LEXDLM char (128) varying;
dcl  first_time bit (1) aligned init ("1"b);

/* CONSTANTS */

dcl  me char (11) static options (constant) init ("cv_prt_rqti");

/* EXTERNAL STATIC VARIABLES */

dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$entlong ext fixed bin (35);
dcl  error_table_$translation_failed ext fixed bin (35);

/**/

%include prt_rqti;

/**/

/* PROGRAM */

	call cu_$arg_ptr (1, arg_ptr, arg_length, code);
	if code ^= 0
	then do;
	     call com_err_ (code, me, "Usage: cv_prt_rqti pathname (-brief|-bf|-long|-lg");
	     return;
	end;

	call expand_pathname_$add_suffix (arg, "rqti", dname, ename, code);
	if code ^= 0
	then do;
error1:
	     call com_err_ (code, me, arg);
	     return;
	end;

	call cu_$arg_ptr (2, arg_ptr, arg_length, code);
	if code = 0
	then if (arg = "-bf") | (arg = "-brief")
	     then SERROR_CONTROL = "01"b;
	     else if (arg = "-lg") | (arg = "-long")
	     then SERROR_CONTROL = "10"b;
	     else do;
		code = error_table_$badopt;
		go to error1;
	     end;

	len_ent = length (rtrim (ename));

	sourcep = null;
	prt_rqtip = null;
	area_ptr = null;

	on cleanup call clean;

	call hcs_$initiate_count (dname, ename, "", bitcount, 1b, sourcep, code);
	if sourcep = null
	then do;
error2:
	     call com_err_ (code, me, "^a>^a", dname, ename);
	     return;
	end;

	n_chars = divide (bitcount + 8, 9, 22, 0);

	dname = get_wdir_ ();

	rqti_name = substr (ename, 1, len_ent - length (".rqti"));

	call hcs_$make_seg (dname, rqti_name, "", 1011b, prt_rqtip, code);
	if prt_rqtip = null
	then do;
error3:
	     call com_err_ (code, me, "^a>^a", dname, rqti_name);
	     call clean;
	     return;
	end;

	call hcs_$truncate_seg (prt_rqtip, 0, code);
	if code ^= 0
	then go to error3;

	unspec (prt_rqti) = "0"b;

	prt_rqti.time_created = clock ();
	prt_rqti.header_version = rqti_header_version_1;
	prt_rqti.driver_wait_time = 30;

	prt_rqti.version = prt_rqti_version_1;
	prt_rqti.opr_msg = "";
	prt_rqti.banner_type = 1;
	prt_rqti.banner_bars = 0;
	prt_rqti.banner_line = 1;
	prt_rqti.paper_length = 66;
	prt_rqti.paper_width = 136;
	prt_rqti.lines_per_inch = 6;
	prt_rqti.no_auto_print = "1"b;

	max_line_no = 0;

	if first_time				/* only needs to be done once/process */
	then do;
	     BREAKS = substr (collate (), 1, 8) || substr (collate (), 10, 24) || ":,()^";
	     IGBREAKS = substr (collate (), 1, 8) || substr (collate (), 10, 24);
	     call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, BREAKS, IGBREAKS, LEXDLM, LEXCTL);
	     first_time = "0"b;
	end;

	call translator_temp_$get_segment (me, area_ptr, code);
	if area_ptr = null
	then do;
	     call com_err_ (code, me, "Making temporary segment in process directory.");
	     call clean;
	     return;
	end;

	call lex_string_$lex (sourcep, n_chars, 0, area_ptr, "1000"b, """", """", "/*", "*/", ";", BREAKS, IGBREAKS,
	     LEXDLM, LEXCTL, APstmt, APtoken, code);
	if code ^= 0
	then do;
	     call com_err_ (code, me, ename);
	     call clean;
	     return;
	end;

	Pthis_token = APtoken;
	call SEMANTIC_ANALYSIS ();

	if is_printer = "1"b
	then do;

	     prt_rqti.type_code = 1;
	     prt_rqti.no_auto_print = ^prt_rqti.no_auto_print;

	     if (SERROR_PRINTED (10) = "0"b) & (max_line_no > prt_rqti.paper_length)
	     then call semant_error (9, max_line_no, prt_rqti.paper_length);

	     if (SERROR_PRINTED (18) = "0"b) & (prt_rqti.banner_type = 1)
	     then do;

		if (SERROR_PRINTED (11) = "0"b) & (prt_rqti.paper_width < 10)
		then call semant_error (5, 0, 0);

		if (SERROR_PRINTED (10) = "0"b) & (SERROR_PRINTED (12) = "0"b)
		     & (prt_rqti.paper_length < (24 + prt_rqti.lines_per_inch))
		then call semant_error (6, (24 + prt_rqti.lines_per_inch), prt_rqti.lines_per_inch);

	     end;
	end;

	if MERROR_SEVERITY > 1
	then do;
	     call com_err_ (error_table_$translation_failed, me, ename);
	     call hcs_$delentry_seg (prt_rqtip, code);
	     prt_rqtip = null;
	end;
	else do;
	     if prt_rqti.type_code = 0
	     then do;
		len_rqti = size (rqti_header);
		call hcs_$truncate_seg (prt_rqtip, len_rqti, code);
	     end;
	     else len_rqti = size (prt_rqti);
	     bitcount = 36 * len_rqti;
	     call hcs_$set_bc_seg (prt_rqtip, bitcount, code);
	     if code ^= 0
	     then call com_err_ (code, me, "Unable to set bitcount on ^a>^a to ^d", dname, rqti_name, bitcount);
	end;

	call clean;				/* terminate input & output segments */
	return;

/* clean up procedure */

clean:
     procedure;

	if sourcep ^= null
	then call hcs_$terminate_noname (sourcep, code);

	if prt_rqtip ^= null
	then call hcs_$terminate_noname (prt_rqtip, code);

	if area_ptr ^= null
	then call translator_temp_$release_all_segments (area_ptr, code);

     end clean;

/**/
legal_paper_len:
     proc returns (bit (1) aligned);

	paper_len = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (10, token_value);
	     return ("0"b);
	end;
	if (paper_len < 10) | (paper_len > 127)
	then do;
	     call statement_error (10, token_value);
	     return ("0"b);
	end;
	return ("1"b);

     end legal_paper_len;



legal_paper_wdth:
     proc returns (bit (1) aligned);

	paper_wdth = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (11, token_value);
	     return ("0"b);
	end;
	if (paper_wdth < 1) | (paper_wdth > 200)
	then do;
	     call statement_error (11, token_value);
	     return ("0"b);
	end;

	if (paper_wdth > 136)
	then call statement_error (7, token_value);
	return ("1"b);

     end legal_paper_wdth;



legal_lpi:
     proc returns (bit (1) aligned);

	lpi = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (12, token_value);
	     return ("0"b);
	end;

	if (lpi = 6) | (lpi = 8)
	then return ("1"b);

	call statement_error (12, token_value);
	return ("0"b);

     end legal_lpi;

legal_line_no:
     proc returns (bit (1) aligned);

	line_no = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (13, token_value);
	     return ("0"b);
	end;
	if (line_no < 1) | (line_no > 127)
	then do;
	     call statement_error (13, token_value);
	     return ("0"b);
	end;
	if line_no > max_line_no
	then max_line_no = line_no;

	return ("1"b);

     end legal_line_no;



legal_chn_no:
     proc returns (bit (1) aligned);

	chn_no = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (3, token_value);
	     return ("0"b);
	end;
	if (chn_no < 1) | (chn_no > 16)
	then do;
	     call statement_error (3, token_value);
	     return ("0"b);
	end;
	return ("1"b);

     end legal_chn_no;

legal_wait_time:
     proc returns (bit (1) aligned);

	wait_time = cv_dec_check_ (token_value, code);
	if code ^= 0
	then do;
	     call statement_error (17, token_value);
	     return ("0"b);
	end;
	if (wait_time < 30) | (wait_time > 300)
	then do;
	     call statement_error (17, token_value);
	     return ("0"b);
	end;
	return ("1"b);

     end legal_wait_time;

semant_error:
     proc (error_num, parm1, parm2);

dcl  error_num fixed bin;
dcl  parm1 fixed bin;
dcl  parm2 fixed bin;

	call lex_error_ (error_num, SERROR_PRINTED (error_num), (error_control_table.severity (error_num)),
	     MERROR_SEVERITY, null, null, SERROR_CONTROL, (error_control_table.message (error_num)),
	     (error_control_table.brief_message (error_num)), parm1, parm2);

     end semant_error;



statement_error:
     proc (error_num, string1);

dcl  error_num fixed bin;
dcl  string1 char (*);
dcl  stmt_ptr ptr;
dcl  token_ptr ptr;

	stmt_ptr = token.Pstmt;
	token_ptr = Pthis_token;

	call lex_error_ (error_num, SERROR_PRINTED (error_num), (error_control_table.severity (error_num)),
	     MERROR_SEVERITY, stmt_ptr, token_ptr, SERROR_CONTROL, (error_control_table.message (error_num)),
	     (error_control_table.brief_message (error_num)), string1);

     end statement_error;				/*						*/

/* ERROR MESSAGES */

dcl  1 error_control_table (18) aligned static options (constant),
       2 severity fixed bin unal init (/* 1 - 4 */ (4) 3,	/* 5 - 7 */
	  (3) 1,					/* 8 - 18 */
	  (11) 3),
       2 Soutput_stmt bit (1) unal init (/* 1 */ "1"b,	/* 2 */
	  "0"b,					/* 3 - 4 */
	  (2) (1)"1"b,				/* 5 - 6 */
	  (2) (1)"0"b,				/* 7 - 18 */
	  (12) (1)"1"b),
       2 message char (100) var init (/* 1 */ "Illegal keyword ""^a"".",
						/* 2 */
	  "Premature end of source segment encountered. Check for missing end statement.",
						/* 3 */
	  "Illegal channel number ""^a"".",		/* 4 */
	  "Syntax error in ""^a"" statement.",		/* 5 */
	  "Paper width should be at least 10 when using standard banners.",
						/* 6 */
	  "Paper length must be at least ""^d"" at ""^d"" lines per inch when using standard banners.",
						/* 7 */
	  "Paper width ""^a"" greater than standard printer platen of 136.",
						/* 8 */
	  "Unused",				/* 9 */
	  "Channel stop specified for line ""^d"" which is greater than paper length ""^d"".",
						/* 10 */
	  "Illegal paper length ""^a"".",		/* 11 */
	  "Illegal paper width ""^a"".",		/* 12 */
	  "Illegal lines per inch ""^a"".",		/* 13 */
	  "Illegal line number ""^a"".",		/* 14 */
	  "Illegal banner bars specifier ""^a"".",	/* 15 */
	  "Illegal driver attribute ""^a"".",		/* 16 */
	  "Illegal control attribute ""^a"".",		/* 17 */
	  "Illegal wait_time ""^a"".",		/* 18 */
	  "Illegal banner type ""^a""."),
       2 brief_message char (20) var init (/* 1 */ "^a",	/* 2 */
	  "Premature EOF.",				/* 3 - 4 */
	  (2) (1)"^a",				/* 5 */
	  "",					/* 6 */
	  "",					/* 7 */
	  "",					/* 8 */
	  "",					/* 9 */
	  "^d ^d",				/* 10 - 18 */
	  (9) (1)"^a");




		    display_prt_rqti.pl1            07/26/84  1434.6rew 07/26/84  1208.5       62892



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


/* format: style4,delnl,insnl,^ifthendo */

/* format: off */

/* Decodes and prints the contents of a binary data table segment produced by cv_rqti.  The format of the printed output
   corresponds exactly to the source language accepted by cv_rqti.  Thus, if output is directed to a file, the resulting
   file can be converted.  */

/* Created:  August 1977 by J. Whitmore */
/* Modified: June 1979 by C. Hornig to define the banner_bars keyword */
/* Modified: 30 November 1981 by G. Palter to recognize new force_ctl_char mode */
/* Modified: November 1983 by C. Marker to recognize force_nsep mode. */

/* format: on */

display_prt_rqti:
     procedure () options (variable);

dcl  arglen fixed bin;				/* length of arg */
dcl  argp ptr;					/* ptr to arg */
dcl  code fixed bin (35);				/* error code */
dcl  date char (24);				/* the date in ascii */
dcl  dir char (168);				/* directory pathname */
dcl  ent char (32);					/* entry name */
dcl  (i, j, k) fixed bin;				/* loop variables */
dcl  nargs fixed binary;
dcl  segp ptr;					/* ptr to compiled segment */
dcl  stops char (48) var;

dcl  arg char (arglen) based (argp);			/* command argument */
dcl  chan_id (16) char (3) int static options (constant)
	init (" 1,", " 2,", " 3,", " 4,", " 5,", " 6,", " 7,", " 8,", " 9,", "10,", "11,", "12,", "13,", "14,", "15,",
	"16,");
dcl  whoami char (24) int static options (constant) init ("display_prt_rqti");

dcl  (hbound, length, null, string, substr, rtrim) builtin;

dcl  cleanup condition;

dcl  (
     com_err_,
     com_err_$suppress_name
     ) entry () options (variable);
dcl  cu_$arg_count entry (fixed binary, fixed binary (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  expand_pathname_ entry (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  ioa_ entry () options (variable);
dcl  pathname_ entry (char (*), char (*)) returns (char (168));
dcl  requote_string_ entry (character (*)) returns (character (*));

/**/

	call cu_$arg_count (nargs, code);
	if code ^= 0
	then do;					/* not called as a command */
	     call com_err_ (code, whoami);
	     return;
	end;

	if nargs ^= 1
	then do;
	     call com_err_$suppress_name (0, whoami, "Usage: ^a path", whoami);
	     return;
	end;

	call cu_$arg_ptr (1, argp, arglen, code);	/* get pathname arg */
	if code ^= 0
	then do;
	     call com_err_ (code, whoami, "Fetching argument #1.");
	     return;
	end;

	call expand_pathname_ (argp -> arg, dir, ent, code);
						/* get dir and entry names */
	if code ^= 0
	then do;
	     call com_err_ (code, whoami, arg);
	     return;
	end;

	call hcs_$initiate (dir, ent, "", 0, 0, segp, code);
						/* get segment ptr */
	if segp = null ()
	then do;
	     call com_err_ (code, whoami, "^a>^a", dir, ent);
	     return;
	end;

	on condition (cleanup) call hcs_$terminate_noname (segp, (0));

	prt_rqtip = segp;				/* set up for automatic based references */

	call date_time_ (prt_rqti.header.time_created, date);
						/* keep compilation date handy */
	if prt_rqti.header.header_version ^= rqti_header_version_1
	then do;
	     call com_err_ (0, whoami, "Wrong header version number for ^a.  ^d (compilation date: ^a)",
		pathname_ (dir, ent), prt_rqti.header.header_version, date);
	     go to finish;
	end;
	if prt_rqti.type_code = 1
	then					/* check items for printer type only */
	     if prt_rqti.version ^= prt_rqti_version_1
	     then do;
		call com_err_ (0, whoami, "Wrong table version number for ^a.  ^d (compilation date: ^a)",
		     pathname_ (dir, ent), prt_rqti.version, date);
		go to finish;
	     end;

	call ioa_ ("/* Listing of^[ printer^;^] request type info table: ^a */
/* Table created on:  ^a */
/* Header version number:  ^d */
/* Table version number:  ^d */", (prt_rqti.type_code = 1), pathname_ (dir, ent), date, prt_rqti.header.header_version,
	     prt_rqti.version);			/* start with a little background information */

	call ioa_ ("^2//* Driver Info */^/");
	call ioa_ ("driver_attributes:^-^[^;^^^]meter, ^[^;^^^]auto_go;", prt_rqti.meter, prt_rqti.auto_go);
	call ioa_ ("driver_wait_time:^-^d;", prt_rqti.driver_wait_time);

	if prt_rqti.type_code = 1
	then do;					/*  if a printer type rqti display rest of information */
	     if prt_rqti.opr_msg ^= ""
	     then do;				/* print the message and comment only if defined */
		call ioa_ ("^2//* Message to the operator during driver initialization */^/");
		call ioa_ ("message:^/^a;", requote_string_ (rtrim (prt_rqti.opr_msg)));
	     end;

	     call ioa_ ("^2//* Banner Info */^/");
	     call ioa_ ("banner_type:^-^[none^;standard^;brief^;^d^];", (prt_rqti.banner_type + 1),
		prt_rqti.banner_type);
	     call ioa_ ("banner_bars:^-^[double^;single^;none^;^d^];", (prt_rqti.banner_bars + 1), prt_rqti.banner_bars)
		;

	     call ioa_ ("^2//* Control Flags for Printing */^/");
	     call ioa_ (
		"prt_control:^-^[^;^^^]auto_print, ^[^;^^^]force_nep, ^[^;^^^]force_esc, ^[^;^^^]force_ctl_char, ^[^;^^^]force_nsep;"
		, ^prt_rqti.no_auto_print, prt_rqti.force_nep, prt_rqti.force_esc, prt_rqti.force_ctl_char,
		prt_rqti.force_nsep);

	     call ioa_ ("^2//* Physical Paper Info */^/");
	     call ioa_ ("paper_width:^-^d;", prt_rqti.paper_width);
	     call ioa_ ("paper_length:^-^d;", prt_rqti.paper_length);
	     call ioa_ ("lines_per_inch:^4x^-^d;", prt_rqti.lines_per_inch);

	     if string (prt_rqti.channel_stops)
	     then do;				/* if there are any stops defined, print them */
		call ioa_ ("^2//* Logical Channel Stops */^/");
		do i = 1 to hbound (prt_rqti.channel_stops, 1);
						/* look at all the possible values */
		     if prt_rqti.channel_stops (i)
		     then do;			/* but only print the non-null stop data */
			stops = "";		/* clear the stops from the last line */
			do j = 1 to 16;		/* look at each channel for this line */
			     if substr (prt_rqti.channel_stops (i), j, 1)
			     then stops = stops || chan_id (j);
			end;
			k = length (rtrim (stops));	/* change last comma into a semi-colon */
			stops = substr (stops, 1, (k - 1)) || ";";
			call ioa_ ("line(^d):^5x^-^a", i, stops);
						/* print it */
		     end;
		end;
	     end;
	end;

	call ioa_ ("^/end;");


finish:
	call hcs_$terminate_noname (segp, code);

	return;
%page;

%include prt_rqti;

     end display_prt_rqti;




		    do_prt_request_.pl1             10/01/90  1537.2rew 10/01/90  1529.0      779976



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1990   *
        *                                                         *
        * 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 */

/* Procedure for printing I/O Daemon dprint requests */

/* format: off */

/* Adapted from output_request_ by J. C. Whitmore, Sept. 1977 */
/* Modified by J. C. Whitmore, 4/78, for new dprint message format and bug fix */
/* Modified by J. C. Whitmore, 7/78, for auto defer; cancel delete on device error; save current request */
/* Modified by J. C. Whitmore, 11/78, to add path to device error msg, notify user on deferring request, and
      fix req_status arg error msg */
/* Modified by J. C. Whitmore, 3/79, to correct the size of string variables for correct assignments */
/* Modified by J. C. Whitmore, 5/79, to use end-of-page order only when printing page labels */
/* Modified by C. Hornig, 6/79, to take prt_ctl information out of static */
/* Modified by J. C. Whitmore, 1/80, to limit the scope of system_privileges_ for send mail (V5.4) */
/* Modified 04/01/81 by GA Texada to 1) make labels work all the time
			       2) call head_sheet_$test when in a test environment */
/* Modified: 11 December 1981 by G. Palter to support force_ctl_char, remove the call to head_sheet_$test as it has been
      moved to iodd_ where it belongs,  and fix the following io_daemon error list entries:
         0003: phx06955 phx11428
	  When running an I/O daemon through remote_driver_ with the line specified as "user_i/o", the message printed
	  by the "restart" request is cutoff in the middle as it is printed immediately before a "resetwrite" control
	  order
         0010: phx09171
	  The module do_prt_request_ should issue a "runout" order after printing the tail sheet and before printing the
	  charge message; otherwise, the charge message may appear in the middle of the tail sheet on remote printers
	  with no attached console */
/* Modified: November 1983 by C. Marker added support for force_nsep and no_separator */
/* Modified: 25 June 1984 by C. Marker changed to notify the user when unable to set line modes. */
/* Modified: 22 February 1984 by C. Marker changed to check if the page labels are the same as the access class of the segment and call access_audit_gate_$log_obj_ptr_user if they are not.  Changed to use version 5 message segments. */


/****^  HISTORY COMMENTS:
  1) change(87-05-10,Gilcrease), approve(87-08-06,MCR7686),
     audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
     Implement -nb output.
  2) change(88-10-24,Brunelle), approve(88-10-24,MCR7911),
     audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199):
     Upgrade to support version 5 of I/O daemon tables.  Also support single &
     continuous forms paper; new head & tail sheet entry variables in
     iodd_static; forms processing control string for single sheet paper; etc.
  3) change(88-11-11,Brunelle), approve(88-11-11,MCR7911),
     audit(88-11-14,Wallman), install(88-11-14,MR12.2-1212):
     Correct problem of not suppressing trailing blank pages.
  4) change(90-09-10,Itani), approve(90-09-10,MCR8198),
     audit(90-09-21,WAAnderson), install(90-10-01,MR12.4-1034):
     Correct the problem of indenting centered labels.
                                                   END HISTORY COMMENTS */

/* format: on */

do_prt_request_: procedure (a_iocbp, a_stat_p, a_code);

/* Parameters */

dcl  a_iocbp ptr;					/* ptr to the io control block for iox_ */
dcl  a_stat_p ptr;					/* the value of stat_p from caller */
dcl  a_code fixed bin (35);				/* error code....used for driver_fatal_error */

/* Automatic */

dcl  access_class bit (72) aligned;			/* access class of user file */
dcl  auth bit (72) aligned;				/* authorization used to set banner access class */
dcl  auth_string char (680);				/* string form of auth */
dcl  char_count fixed bin (24);			/* total number of chars if the file */
dcl  chars_done fixed bin (24);			/* total chars printed between head & tail sheets */
dcl  chgsw bit (1);					/* indicate whether to charge */
dcl  ck_interval fixed bin;				/* number of lines between checkpoints */
dcl  ck_mode char (12) aligned;			/* mode string for prtdim to set checkpoints */
dcl  cmd_line char (80);				/* space for operator commands */
dcl  code fixed bin (35);
dcl  continuous_paper bit (1);			/* OFF is single sheet paper */
dcl  control bit (36) aligned;
dcl  copies_left fixed bin;				/* number if copies to be done this time thorugh */
dcl  ctl_msg_sent bit (1);
dcl  delete_msg char (32);
dcl  desc_ptr ptr;
dcl  dest char (24) aligned;
dcl  device_error bit (1);
dcl  ename char (32) aligned;				/* entry name of file for output */
dcl  err_mess char (200) var;
dcl  fcbp ptr;
dcl  force_ck_pt bit (1) aligned;
dcl  full_path char (168) aligned;
dcl  head char (64) aligned;				/* temp for the header */
dcl  header_done bit (1);				/* TRUE when header is printed */
dcl  how fixed bin;					/* code for how the segment should be printed */
dcl  i fixed bin;
dcl  iocbp ptr;
dcl  l fixed bin (24);
dcl  last_error_count fixed bin;			/* last printer error count read */
dcl  lg_msg char (100) aligned;
dcl  lg_sw bit (1) aligned;
dcl  line_mode char (32);				/* request modes for length & indentation */
dcl  mailname char (32) aligned;
dcl  max_comp fixed bin;
dcl  msg char (256) aligned;				/* space for operator messages */
dcl  n_sample_pages fixed bin;			/* count sample pages, to maintain alignment of paper */
dcl  nep_mode_set bit (1);				/* TRUE if request is being done in nep mode */
dcl  new_clock fixed bin (71);
dcl  new_cpu fixed bin (52);
dcl  new_pp fixed bin;
dcl  new_rate fixed bin (35);				/* new estimate of transmission rate */
dcl  new_waits fixed bin (35);
dcl  nt fixed bin (24);				/* number of elements processed on read */
dcl  old_clock fixed bin (71);
dcl  old_cpu fixed bin (52);
dcl  old_pp fixed bin;
dcl  old_rate fixed bin (35);
dcl  old_waits fixed bin (35);
dcl  omode char (256);				/* mode returned form dim */
dcl  paper_not_aligned bit (1) aligned;
dcl  pic picture "(11)-9";				/* dummy for fixed bin to char conversion */
dcl  printing bit (1);				/* TRUE when the actual printing is in progress */
dcl  restart_source fixed bin;			/* restart was from master or slave */
dcl  seconds fixed bin;
dcl  segp ptr;
dcl  set_page_labels bit (1);				/* TRUE - when we want to set labels */
dcl  short_msg char (8) aligned;
dcl  source fixed bin;				/* cmd source, master or slave */
dcl  start_char_offset fixed bin (24);			/* file offset at start of printing */
dcl  start_segp pointer;				/* pointer to first component if MSF otherwise to segment */
dcl  starting_page fixed bin (24);
dcl  stream char (32);				/* stream name for ios_ */
dcl  terminal (2) char (32);				/* streams for 1) master, or 2) slave */
dcl  time_est fixed bin;				/* estimated number of seconds to process request */
dcl  user_dir char (168) aligned;			/* directory containing users' segment */
dcl  val fixed bin;					/* for validation level */

%page;

/* Internal Static */

dcl  whoami char (32) int static options (constant) init ("do_prt_request_");
dcl  master fixed bin int static options (constant) init (1);
dcl  slave fixed bin int static options (constant) init (2);
dcl  (both, log) fixed bin int static options (constant) init (0);
dcl  normal fixed bin int static options (constant) init (1); /* normal streams for opr msgs */
dcl  error fixed bin int static options (constant) init (2);/* code for error streams */
dcl  tell_user bit (1) int static options (constant) init ("1"b); /* force error msg to user */
						/* go by user notify flag */

/* the following variables are for call to output_file */
dcl  PRINT fixed bin int static options (constant) init (1);
dcl  SAMPLE fixed bin int static options (constant) init (2);
dcl  SKIP fixed bin int static options (constant) init (3);
dcl  SAVE fixed bin int static options (constant) init (4);

dcl  factor float bin int static options (constant) init (0.75e0); /* smoothing factor for rate estimate */
dcl  stars char (40) int static options (constant) aligned init ((40)"*"); /* For error messages */

dcl  privileged bit (1) static init ("1"b);		/* TRUE if we can call phcs_ */
dcl  sys_priv bit (1) static init ("1"b);		/* TRUE if process cal call system_privilege_ */
dcl  first_call bit (1) static init ("1"b);		/* TRUE on first call */
dcl  fault_name char (32) aligned int static;
dcl  request_data_p ptr int static init (null);

dcl  err_label label int static;			/* point of return from condition handler */

dcl  bad_chars char (5) defined BAD_CHARS position (2);
dcl  nl_vt_ff char (3) defined BAD_CHARS position (4);	/* vert carriage control chars */
dcl  space_ht_bs char (3) defined BAD_CHARS position (1);	/* horiz carriage control chars */
dcl  VT char (1) defined BAD_CHARS position (5);		/* the vertical tab character */
dcl  FF char (1) defined BAD_CHARS position (6);		/* the form feed character */
						/* SP HT BS NL VT FF */
dcl  BAD_CHARS char (6) int static options (constant) init (" 	
");

/* External static */

dcl  access_operations_$io_daemon_set_page_labels bit (36) aligned external static;
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$ai_restricted ext static fixed bin (35);
dcl  error_table_$dirseg ext static fixed bin (35);
dcl  error_table_$eof_record fixed bin (35) ext static;
dcl  error_table_$improper_data_format fixed bin (35) ext static;
dcl  error_table_$moderr fixed bin (35) ext static;
dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$noentry fixed bin (35) ext static;
dcl  error_table_$out_of_bounds fixed bin (35) ext static;
dcl  error_table_$request_pending fixed bin (35) ext static;

%page;

/* External Entries */

dcl  access_audit_gate_$log_obj_ptr_user entry options (variable);
dcl  aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  clock_ ext entry returns (fixed bin (71));		/* gets clock time */
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35));
dcl  convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  convert_status_code_ entry (fixed bin (35), char (*) aligned, char (*) aligned);
dcl  cpu_time_and_paging_ entry (fixed bin (35), fixed bin (52), fixed bin);
dcl  cu_$level_get entry (fixed bin);
dcl  date_time_ entry (fixed bin (71), char (*) aligned);
dcl  hcs_$fs_get_mode ext entry (ptr, fixed bin (5), fixed bin (35));
dcl  hcs_$fs_get_path_name entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35));
dcl  hcs_$get_access_class entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin (35));
dcl  hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin (5), fixed bin (35));
dcl  hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (2), fixed bin (24), fixed bin (35));
dcl  io_daemon_account_ entry (entry, ptr);
dcl  ioa_$rsnnl entry options (variable);
dcl  iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35));
dcl  iodd_get_cmd_ entry (ptr, fixed bin, fixed bin (24), bit (36) aligned, char (*), fixed bin, fixed bin (35));
dcl  iodd_msg_ entry options (variable);
dcl  iodd_parse_$args entry (char (*) var, char (*)) returns (char (256) var);
dcl  iodd_parse_$command entry (char (*), ptr, fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$modes entry (ptr, char (*), char (*), fixed bin (35));
dcl  iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  msf_manager_$close entry (ptr);
dcl  msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
dcl  msf_manager_$open entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));
dcl  phcs_$deactivate entry (ptr, fixed bin (35));
dcl  phcs_$set_kst_attributes entry (fixed bin, ptr, fixed bin (35));
dcl  probe entry ();
dcl  read_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  send_mail_$access_class entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned, fixed bin (35));
dcl  sys_info$max_seg_size fixed bin (35) ext static;
dcl  system_privilege_$ipc_priv_off entry (fixed bin (35));
dcl  system_privilege_$ipc_priv_on entry (fixed bin (35));
dcl  system_privilege_$ring1_priv_off entry (fixed bin (35));
dcl  system_privilege_$ring1_priv_on entry (fixed bin (35));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2) aligned, fixed bin (71));
dcl  write_control_form_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));

%page;

/* Structures */

dcl  1 ksta like kst_attributes aligned internal static;

dcl  1 current aligned like print_driver_data.checkpoint;	/* this defines the current position in the file */

dcl  1 ck aligned,					/* The checkpoint history for the current file */
       2 last fixed bin,				/* The last entry in the chain */
       2 entry (10),				/* one entry for each checkpoint */
         3 forward fixed bin,				/* the forward thread */
         3 point like print_driver_data.checkpoint;	/* this is the checkpoint data */

dcl  1 position aligned like position_data;		/* see prt_order_info.incl.pl1 */
dcl  1 pg_labels aligned like page_labels;		/* see prt_order_info.incl.pl1 */
dcl  1 paper_info_data aligned like paper_info;		/* see prt_order_info.incl.pl1 */

dcl  1 static_ctl aligned int static like prt_ctl;	/* the default control values */

dcl  1 arg_list aligned,				/* for parsing command lines */
       2 max_tokens fixed bin,			/* the amount of space allocated */
       2 n_tokens fixed bin,				/* the number of tokens in the line */
       2 cmd char (64) var,				/* first token is the command */
       2 arg (3) char (64) var;			/* we allow three arguments max */

dcl  1 ctl_wait_list aligned int static,		/* we block on this list for ctl form sync */
       2 number fixed bin,				/* number of ipc channels */
       2 channel fixed bin (71);			/* this is the channel (only one) */


/* Builtins */

dcl  (addr, baseno, binary, bit, char, convert, divide, fixed, float,
     hbound, length, ltrim, min, mod, null, rtrim, string, substr, translate,
     unspec, verify) builtin;


/* Conditions */

dcl  (cleanup, linkage_error, daemon_again, daemon_again_slave, daemon_kill,
     daemon_defer, daemon_cancel, daemon_save, size, conversion, any_other)
	condition;

%page;

/* Copy arguments and initialize pointers and control switches */

	stat_p = a_stat_p;
	iocbp = a_iocbp;
	a_code = 0;				/* set to zero for now */
	chgsw = "0"b;				/* assume no charge yet */
	header_done = "0"b;				/* header not done yet */
	set_page_labels = "0"b;			/* start with no labels assumed */
	ck.last = 1;				/* use first checkpoint entry */
	arg_list.max_tokens = 4;			/* only 4 tokens allowed in command lines */

	terminal (master) = "user_output";		/* stream for master terminal output */
	terminal (slave) = iodd_static.slave_output;	/* check for active before use */
	last_error_count = -1;			/* set to undefined */
	printing = "0"b;				/* tell handler for daemon_save - not printing yet */
	continuous_paper = (iodd_static.paper_type = PAPER_TYPE_CONTINUOUS);

	if first_call then do;			/* init variables and see if we have phcs_ access */
	     call init_static_ctl ();
	     on linkage_error
		begin;
		privileged = "0"b;
		go to tough;
	     end;
	     string (ksta) = "0"b;			/*  make a null structure */
	     call phcs_$set_kst_attributes (binary (baseno (stat_p), 18), addr (ksta), (0));

/* This is a NOP - structure is 0. If we get here we are privileged */
	     ksta.set.tpd, ksta.value.tpd = "1"b;	/* Dont put on bulkstore just for lil ole me */
	     ksta.set.explicit_deactivate_ok, ksta.value.explicit_deactivate_ok = "1"b;
	     ksta.set.allow_write = "1"b;		/* Dont let me wreck user seg by accident */
	     ksta.set.tus, ksta.value.tus = "1"b;	/* Save a vtoc write */
tough:	     revert linkage_error;
	     first_call = "0"b;			/* First call initialization is done */
	end;
	if iodd_static.ctl_term.attached then do;	/* get ready to send message to ctl term */
	     ctl_wait_list.number = 1;
	     ctl_wait_list.channel = iodd_static.ctl_ev_chan;
	end;
	else ctl_wait_list.number = 0;		/* don't try to use this */

	driver_status_ptr = iodd_static.driver_ptr;	/* get ptr to the current driver status seg */
	evaluate_forms_info_output_ptr = driver_status.forms_validation_ptr;
	prt_ctl_ptr = driver_status.dev_ctl_ptr;	/* get print control information */
	if prt_ctl_ptr = null () then
	     prt_ctl_ptr = addr (static_ctl);		/* default values */
	desc_ptr = addr (driver_status.descriptor);	/* and to the request descriptor */
	mseg_message_info_ptr = desc_ptr;		/* first part of desciptor is mseg_message_info */
	dmp = addr (driver_status.message);		/* set dprint_msg default pointer */
	driver_data_p = addr (desc_ptr -> request_descriptor.driver_data); /* get ptr to printer_driver_data */
	request_data_p = addr (REQUEST);		/* for the single copy entry */
	fcbp, segp = null;				/* set up for cleanup handler */
	start_segp = null;
	stream = driver_status.dev_out_stream;		/* record the switch name for easy reference */

	on cleanup call clean_proc ();		/* establish a cleanup handler */

	err_label = abort_request;

/* Set up master structure used by this pgm. */

	string (REQUEST.control_flags) = ""b;		/* clear all the flags */
	REQUEST.requestor = mseg_message_info.sender_id;
	REQUEST.continued = desc_ptr -> request_descriptor.continued;
	REQUEST.restarted = desc_ptr -> request_descriptor.restarted;
	REQUEST.priority_request = desc_ptr -> request_descriptor.priority_request;
	REQUEST.separator = "1"b;			/* we always want a print separator first time */
	REQUEST.device_name = driver_status.dev_name_label;
	REQUEST.request_type = driver_status.req_type_label;
	REQUEST.queue = desc_ptr -> request_descriptor.q;
	REQUEST.charge_queue = desc_ptr -> request_descriptor.charge_q; /* coord may want a priority rate */
	REQUEST.request_no = desc_ptr -> request_descriptor.seq_id; /* coord assigned the number */
	REQUEST.restart_no = desc_ptr -> request_descriptor.prev_seq_id; /* previous number of request (0 = not restarted) */
	REQUEST.contd_no = desc_ptr -> request_descriptor.contd_seq_id; /* previous number of continued request (0 = not continued) */
	REQUEST.dpmp = dmp;
	if dprint_msg.delete_sw then
	     REQUEST.delete = 1;
	else REQUEST.delete = 0;
	REQUEST.line_nbrs = dprint_msg.line_nbrs;
	REQUEST.single_sheet = (iodd_static.paper_type = PAPER_TYPE_SINGLE);
	REQUEST.bit_count = 0;
	REQUEST.line_count = 0;
	REQUEST.page_count = 0;
	REQUEST.punsw = 0;				/* we are printing only */
	REQUEST.copies = dprint_msg.copies;
	REQUEST.no_separator = dprint_msg.no_separator | prt_ctl.force_nsep;
	if ^(REQUEST.continued | REQUEST.restarted) then
	     print_driver_data.copies_done = 0;		/* no copies assumed, unless continued or restarted */
						/* if none completed, it's not continued */
	else if print_driver_data.copies_done < 1 then
	     REQUEST.continued = "0"b;
	print_driver_data.copies_done = min (print_driver_data.copies_done, REQUEST.copies - 1); /* be sure we do at least one copy */
	copies_left = REQUEST.copies - print_driver_data.copies_done; /* might be partly done */
	REQUEST.copy_no = print_driver_data.copies_done + 1; /* we start with the next copy */
	REQUEST.notify = dprint_msg.notify;
	REQUEST.output_mode = "";			/* clear in case of error message */
	REQUEST.total_charge = 0e0;
	REQUEST.charge = 0e0;
	REQUEST.time_start_request = clock_ ();
	call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request);

	l = length (rtrim (REQUEST.requestor)) - 2;	/* get length of Person.Project */
	mailname = substr (REQUEST.requestor, 1, l);
	unspec (send_mail_info) = "0"b;
	send_mail_info.version = send_mail_info_version_2;
	send_mail_info.wakeup = "1"b;
	send_mail_info.always_add = "1"b;
	send_mail_info.sent_from = REQUEST.request_type;

/* get pathname of file for operator and error messages */

	user_dir = dprint_msg.dirname;
	ename = dprint_msg.ename;
	call ioa_$rsnnl ("^a^[>^]^a", full_path, l, user_dir, (user_dir ^= ">"), ename);

	REQUEST.full_path = translate (full_path, "", bad_chars); /* force a page fault - HARDWARE BUG WRITEAROUND */
	full_path = translate (full_path, "", bad_chars); /* remove bad chars for banner */
	dprint_msg.destination = translate (dprint_msg.destination, "", bad_chars);
	dprint_msg.heading = translate (dprint_msg.heading, "", bad_chars);
	REQUEST.full_path = full_path;		/* save the clean copy */

/*  record the processing of this request in the log  */

	head = dprint_msg.heading;
	if substr (head, 1, 5) = " for " then		/* see if dprint added something */
	     head = substr (head, 6);			/* if so get rid of it */
	if head ^= "" then
	     call ioa_$rsnnl ("(for ""^a"" ", msg, l, head);
	else do;
	     l = 1;				/* no heading, get ready for a dest msg */
	     msg = "(";
	end;

	dest = dprint_msg.destination;
	if dest ^= "" then
	     call ioa_$rsnnl ("^vaat ""^a"")", msg, l, (l), substr (msg, 1, l), dest);
	else if l = 1 then
	     msg = "";				/* no head or dest case */
	else substr (msg, l, 1) = ")";		/* heading only case */

	call iodd_msg_ (log, both, 0, "",		/* let the subr do the work */
	     "Request ^d ^a q^d:  ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a", REQUEST.request_no,
	     REQUEST.request_type, REQUEST.queue, full_path, (copies_left > 1), copies_left, REQUEST.priority_request,
	     REQUEST.charge_queue, REQUEST.requestor, msg);

/* Now we can print a header banner if an error occurs */

	err_mess = full_path;			/* let this sit here in case */

/* Find the access class to use for the banner */

	if aim_check_$greater (mseg_message_info.sender_authorization, driver_status.min_banner) then
	     auth = mseg_message_info.sender_authorization;
	else auth = driver_status.min_banner;		/* mark the output with auth */

	call convert_authorization_$to_string (auth, auth_string, code); /* get string form */
	if code ^= 0 then do;			/* oops....bad news */
	     call fatal_error (tell_user);		/* tell the operator, and user */
	     go to clean_out;			/* drop the request */
	end;

	l = length (rtrim (auth_string));		/* how long is the string */
	if l > 132 then do;				/* too long for normal output..check for short form */
	     call convert_authorization_$from_string (access_class, "system_high", code);
	     if code ^= 0 then do;			/* oops....bad news */
		call fatal_error (tell_user);		/* tell the operator, and user */
		go to clean_out;			/* drop the request */
	     end;
	     if aim_check_$equal (auth, access_class) then
		auth_string = "SYSTEM HIGH";		/* this is shorter */
	end;					/* save all we can for the label */
	REQUEST.access_class_string = char (auth_string, length (REQUEST.access_class_string));

/* check the requestor's access to the pathname he specified */

	val = mseg_message_info.sender_level;

	call check_user_access (user_dir, ename, code);	/* use the internal proc to do the work */
	if code ^= 0 then do;			/* oops....bad news */
	     call fatal_error (tell_user);		/* tell the operator, and user */
	     go to clean_out;			/* drop the request */
	end;

	call open_file (user_dir, ename, fcbp, max_comp, char_count, code); /* one call does a lot */
	if code ^= 0 then do;			/* oops....bad news */
	     call fatal_error (tell_user);		/* tell the operator, and user */
	     go to clean_out;			/* drop the request */
	end;

/* set up variables for recording checkpoints as we go through the file */

	ck_interval = 25;				/* define the interval for taking checkpoints */
	pic = ck_interval;				/* get the char form */
	ck_mode = "stop" || ltrim (pic);		/* express as the exact mode string */

/* set up the starting page and initialize each checkpoint */

	if (REQUEST.restarted | REQUEST.continued) & print_driver_data.checkpoint.page_no > 0 then
	     current = print_driver_data.checkpoint;	/* use the last checkpoint as the start */
	else do;
	     current.page_no = 1;			/* the current position is top of page 1 */
	     current.line_count = 0;
	     current.comp_no = 0;			/* start at the head of the file */
	     current.offset = 0;
	     current.file_offset = 0;
	end;

	starting_page = current.page_no;

	do i = 1 to hbound (ck.entry, 1);		/* init the checkpoints and set the threads */
	     ck.point (i) = current;			/* each checkpoint is current position for starters */
	     ck.entry (i).forward = i + 1;		/* each entry points to the next one */
	end;
	ck.entry (hbound (ck.entry, 1)).forward = 1;	/* the last entry points back to the start */

/* with the true total bitcount, we can make an estimate of the time needed to do the request */

	if driver_status.bit_rate_est > 0 then do;

	     chars_done = char_count * copies_left - current.file_offset; /* total is chars / copy * copies */
	     time_est = divide (chars_done * 9, driver_status.bit_rate_est, 17, 0);

	     if (driver_status.defer_time_limit > 0) &	/* if a limit is defined, check it */
		(time_est > driver_status.defer_time_limit + 6) then do; /* allow 6 sec fuzz */
						/* so estimate will look bigger than limit in msg */
		if REQUEST.priority_request then	/* priority requests go any way */
		     msg = "Defer time limit suspended for priority request.";
		else if REQUEST.restarted then	/* can't defer what is not in the queue */
		     msg = "Restarted request exceeds time limit but cannot be deferred.";
		else do;				/* drop this one */
		     desc_ptr -> request_descriptor.keep_in_queue = "1"b;
		     call iodd_msg_ (log, both, 0, "", "**Deferring request ^d. Printing time estimate: ^.1f mins.",
			REQUEST.request_no, float (time_est) / 60.0e0);
		     call ioa_$rsnnl ("Deferring request for ^a.^/Printing time estimate: ^.1f minutes.", msg, l,
			REQUEST.full_path, float (time_est) / 60.0e0);
		     call notify_user (substr (msg, 1, l));
		     go to clean_out;
		end;
	     end;
	     else msg = "";

	     if time_est > 60 | msg ^= "" then		/* tell operator if request will exceed 1 minute */
		call iodd_msg_ (log, slave, 0, "", "  Time estimate for request ^d:  ^.1f mins.^[^/^2x^a^]",
		     REQUEST.request_no, float (time_est) / 60.0e0, (msg ^= ""), msg);
	end;

	call check_labels (user_dir, ename, start_segp, code);
	if code ^= 0 then do;			/* oops....bad news */
	     call fatal_error (tell_user);		/* tell the operator, and user */
	     go to clean_out;			/* drop the request */
	end;

	call set_modes_and_labels;			/* set strings for later use */

	if starting_page > 1 | REQUEST.copy_no > 1 then
	     call iodd_msg_ (log, both, 0, "", "  Starting request ^d from page ^d of copy ^d of ^d.",
		REQUEST.request_no, starting_page, REQUEST.copy_no, REQUEST.copies);

/*  set up necessary condition handlers */

	on daemon_kill go to flush_request;		/* flush the current request */
	on daemon_cancel go to flush_request;		/* likewise,  the cancelled flag has been set */
	on daemon_defer go to defer_request;		/* for this one be nice (and quiet?) */
	on daemon_save
	     begin;				/* save the current request at the current position */
	     REQUEST.saved = "1"b;			/* get ready to mark tail sheet */
	     if printing then do;
		how = SAVE;
		call iox_$modes (iocbp, "1pg,print", (""), code); /* make the dim return at bottom of page */
	     end;
	end;
	on daemon_again
	     begin;				/* to restart the current request.... */
	     restart_source = master;			/* talking to the master terminal */
	     go to check_reprint_position;
	end;
	on daemon_again_slave
	     begin;				/* to restart the current request.... */
	     restart_source = slave;			/* talking to slave terminal */
	     go to check_reprint_position;
	end;

	iodd_static.request_in_progress = "1"b;		/* ready to accept kill, cancel etc. */
	control = "101"b;				/* for command lines, wait and prompt slave */
	paper_not_aligned = "0"b;			/* assume paper is aligned at top */
	force_ck_pt = "1"b;				/* and make sure that our counters agree with the dim */
	n_sample_pages = 0;				/* no samples yet for this request */

	call iox_$control (iocbp, "reset", null, code);	/* clear everything */

	if prt_ctl.no_auto_print then
	     go to ask;				/* need operator instructions? */
	else go to print_req;			/* no, sooo...let'er rip */


/* this is the point where we come to restart the current request */

restart_this_request:

	REQUEST.continued = "1"b;			/* make this look like a continuation */
	REQUEST.contd_no = REQUEST.request_no;		/* of this request */
	REQUEST.charge = 0e0;
	REQUEST.time_start_request = clock_ ();
	call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request);
	control = "101"b;				/* wait for input and prompt */
	err_mess = "";
	paper_not_aligned = "1"b;			/* add 1 page */
	if REQUEST.copy_no = 1 then
	     REQUEST.separator = "1"b;		/* always mark copy no 1 */
	call skip_to_page (starting_page, code);
	if code ^= 0 then
	     call iodd_msg_ (error, restart_source, code, whoami, "^/Error skiping to starting page.");

%page;

/* Get another command */

ask:
	on conversion
	     begin;
	     call iodd_msg_ (normal, source, 0, "", "Argument conversion error.  Try again.");
	     go to ask;
	end;

	on size
	     begin;
	     call iodd_msg_ (normal, source, 0, "", "Argument numerical size error.  Try again.");
	     go to ask;
	end;

	call iodd_get_cmd_ (addr (cmd_line), 80, nt, control, "request", source, code); /* get a cmd */
	if code ^= 0 then do;
	     call driver_fatal_error (code, "Unable to read operator command.");
	     go to clean_out;
	end;

	call iodd_parse_$command (substr (cmd_line, 1, nt), addr (arg_list), code); /* this was here, so use it */
	if code ^= 0 then do;
	     if code = error_table_$noarg then
		go to ask;			/* be nice about blank lines */
	     call iodd_msg_ (normal, source, 0, "", "Unable to parse command line ^a.", cmd_line);
	     go to ask;
	end;

	if cmd = "help" then do;
	     call iodd_msg_ (normal, source, 0, "", "Standard driver commands may be used, plus:^/");
	     call iodd_msg_ (normal, source, 0, "", "   sample [N]    -print a sample page");
	     call iodd_msg_ (normal, source, 0, "", "   print  [N]    -start normal printing");
	     call iodd_msg_ (normal, source, 0, "",
		"      Where N is an optional page number. (+N or -N is relative to current page)^/");
	     call iodd_msg_ (normal, source, 0, "", "   copy N        -set the current copy number to N");
	     call iodd_msg_ (normal, source, 0, "", "   req_status [-lg]  -print info about current request");
	     call iodd_msg_ (normal, source, 0, "", "");
	     go to ask;
	end;

	if source = master & iodd_static.test_entry then	/* when testing allow a call to db */
	     if cmd = "probe" then do;
		call iodd_msg_ (normal, source, 0, "", "Calling probe");
		call probe ();
		go to ask;
	     end;

	if cmd = "req_status" | cmd = "reqstatus" then do;
	     if n_tokens > 1 then
		if arg (1) = "-lg" | arg (1) = "-long" then
		     lg_sw = "1"b;
		else do;
		     call iodd_msg_ (normal, source, 0, "", "Undefined argument ""^a"".  Use ""-lg"" or none.",
			arg (1));
		     go to ask;
		end;
	     else lg_sw = "0"b;

	     call iodd_msg_ (normal, source, 0, "", "Request ^d: ^a^/^3xfile components :  ^d,   char count :  ^d",
		REQUEST.request_no, full_path, max_comp + 1, char_count);
	     if lg_sw then
		call iodd_msg_ (normal, source, 0, "", "Current file position:");
	     call iodd_msg_ (normal, source, 0, "", "^3xpage no:^12d^4xcurrent copy no: ^d", current.page_no,
		REQUEST.copy_no);
	     if lg_sw then do;
		call iodd_msg_ (normal, source, 0, "",
		     "^3xline count:^9d^/^3xcomp no:^12d^/^3xoffset:^13d^/^3xfile offset:^8d", current.line_count,
		     current.comp_no, current.offset, current.file_offset);
		call iox_$modes (iocbp, "", omode, code); /* get the current modes */
		call iodd_msg_ (normal, source, 0, "", "^/^3xprinter mode: ^a", omode);
		call iox_$control (iocbp, "get_position", addr (position), code);
		call iodd_msg_ (normal, source, 0, "", "^3xdim at:  page ^d  line ^d  line_count ^d",
		     position.page_number, position.line_number, position.total_lines);
	     end;
	     call iodd_msg_ (normal, source, 0, "", "");	/* a blank line before the command request */
	     go to ask;

	end;

	if cmd = "sample" then do;
	     if n_tokens > 1 then do;
		call get_page_no (arg (1), starting_page, code);
		if code ^= 0 then do;
		     call iodd_msg_ (normal, source, 0, "", "Invalid page number: ^a", arg (1));
		     go to ask;
		end;
	     end;
	     else starting_page = current.page_no;

/* if this is the first sample page, output a separator page if
   1. continuous paper and expecting banner bars or
   2. single sheet paper (at all times) */
	     if (n_sample_pages = 0) then do;
		if (continuous_paper & (prt_ctl.banner_bars = NORMAL_BANNER_BARS | prt_ctl.banner_bars = SINGLE_BANNER_BARS))
		     | ^continuous_paper then do;
		     call iox_$control (iocbp, "inside_page", null, code);
		     call iodd_static.print_head_separator (iocbp, prt_ctl_ptr, "sample pages", code);
		     call iox_$control (iocbp, "inside_page", null, code);

/* count pages generated for separator page */
		     if continuous_paper then
			n_sample_pages = 2;
		     else n_sample_pages = 1;
		     REQUEST.separator = "1"b;
		     force_ck_pt = "1"b;		/* don't count what we just printed */
		end;
	     end;

	     call set_up_page_labels;			/* set up printer dim to output any page labels needed */

	     call skip_to_page (starting_page, code);
	     if code ^= 0 then do;
		call iodd_msg_ (error, source, code, "", "^a^/Unable to skip to page.", err_mess);
		go to ask;
	     end;

	     call output_file (SAMPLE, 0, code);	/* write one page at the current position in the file */
	     if code ^= 0 then do;
		call iodd_msg_ (error, source, code, "", "^a^/Error while printing sample page.", err_mess);
	     end;

	     n_sample_pages = n_sample_pages + 1;	/* bump the count of sample pages */

	     go to ask;
	end;

	if cmd = "copy" then do;			/* enter copy number */
	     if n_tokens > 1 then do;			/* be sure we have a value */
		i = convert (i, arg (1));		/* convert to binary */
		if i < 1 | i > REQUEST.copies then do;
		     call iodd_msg_ (normal, source, 0, "", "Copy number must be in the range 1 to ^d.",
			REQUEST.copies);
		     go to ask;
		end;
		REQUEST.copy_no = i;
		go to ask;
	     end;
	     call iodd_msg_ (normal, source, 0, "", "Expected argument missing.");
	     go to ask;
	end;

	if cmd ^= "print" then do;			/* all other commands except print go to the std cp */
	     force_ck_pt = "1"b;			/* in case a sample head sheet was printed */
	     call iodd_command_processor_ (source, 3, substr (cmd_line, 1, nt), code);
	     if code = 1 | code = 2 then do;
		if code = 2 & cmd = "save" then
		     go to clean_out;		/* save at this level is OK, just drop */
		call iodd_msg_ (normal, source, 0, "", "Invalid command. Try again or type help for instructions.");
	     end;
	     call set_modes_and_labels;		/* in case the force modes were changed */
	     go to ask;
	end;

/* now we have received  the print command and are ready to print the entire file */

	if n_tokens > 1 then do;			/* was a page number specified? */
	     call get_page_no (arg (1), starting_page, code);
	     if code ^= 0 then do;
		call iodd_msg_ (normal, source, 0, "", "Invalid page number: ^a", arg (1));
		go to ask;
	     end;
	end;
	else starting_page = current.page_no;

	call skip_to_page (starting_page, code);	/* check it before the head banner is printed */
	if code ^= 0 then do;
	     call iodd_msg_ (error, source, code, "", "^a^/Unable to skip to page.", err_mess);
	     go to ask;
	end;

	if source = master then
	     iodd_static.master_hold = "0"b;
	else if iodd_static.master_hold then do;	/* respect the master here too */
	     call iodd_msg_ (normal, source, 0, "", "Driver is in hold by master terminal.");
	     go to ask;
	end;

print_req:
	REQUEST.cpu_time = 0;			/* reset the usage data */
	REQUEST.real_time = 0;
	REQUEST.page_waits = 0;
	REQUEST.pre_pages = 0;
	err_mess = "";				/* clear any residual junk */
	starting_page = current.page_no;		/* the page to start this copy on */

/* need to check for head sheet alignment on continuous forms? */
	if n_sample_pages > 0 & continuous_paper then do;
	     if mod (n_sample_pages, 2) = 0 then
		call iox_$put_chars (iocbp, addr (FF), 1, code); /* this is really for remote devices */
	end;

	call iox_$control (iocbp, "get_error_count", addr (last_error_count), code);
	if code ^= 0 then
	     last_error_count = -1;			/* well we tried */

/* Iff we are on single sheet paper, stop multiple blank pages by suppressing
   consecutive form feeds */
	if ^continuous_paper then
	     call iox_$control (iocbp, "ff_suppress_on", null, code);

	do while (REQUEST.copy_no <= REQUEST.copies);	/* once around for each copy */

	     call print_head_banner (code);
	     if code ^= 0 then do;
		call driver_fatal_error (code, "Attempting to print head banner.");
		go to clean_out;
	     end;

	     call set_up_page_labels;			/* set up printer dim to output any page labels */

	     n_sample_pages = 0;			/* now we have a real head sheet */
	     REQUEST.separator = "0"b;		/* we want separator bars only the first time */

/*	now get to the correct top of page location and start printing */
/*	assume that head_sheet and advertizing  (plus the FF above) will leave us at top inside page */
/*	This only applies for continuous forms.  */

	     if continuous_paper then do;
		i = mod (starting_page, 2);		/* see if we are starting on an even or odd page */
		if i = 0 then do;			/* if the paper is in the wrong position, align it */
		     call iox_$put_chars (iocbp, addr (FF), 1, code);
		end;
	     end;

/*	now, after all that paper motion, set the dim position to agree with the current position */

	     force_ck_pt = "1"b;			/* set the position */
	     paper_not_aligned = "0"b;		/* don't move the paper */

	     call skip_to_page (starting_page, code);	/* sync with the dim */
	     if code ^= 0 then do;
		call driver_fatal_error (code, "First page synchronization.");
		go to clean_out;
	     end;

	     if desc_ptr -> request_descriptor.saved then
		how = SAVE;
	     else how = PRINT;
	     start_char_offset = current.file_offset;	/* get ready to see how many chars were done per sec */

	     call iox_$control (iocbp, "runout", null, code); /* be sure head sheet is done before clock reading */

	     call cpu_time_and_paging_ (old_waits, old_cpu, old_pp); /* keep time and page waits for accounting */
	     old_clock = clock_ ();			/* time copy started */

	     printing = "1"b;			/* tell daemon_save handler we are printing */

/* check to see if the user wants raw output.  if so then turn it on */
	     if evaluate_forms_info_output_ptr ^= null then do;
		if evaluate_forms_info_output.special_length ^= 0 then do;
		     if iodd_parse_$args ("output_type=", (evaluate_forms_info_output.special_string)) = "raw" then do;
			call iox_$control (iocbp, "prt_conv_off", null (), (0));
			call iox_$modes (iocbp, "rawo", "", (0));
		     end;
		end;
	     end;

	     call output_file (how, 0, code);		/* this will do it */
						/* reset raw output if user has asked for it */
	     if evaluate_forms_info_output_ptr ^= null then do;
		if evaluate_forms_info_output.special_length ^= 0 then do;
		     if iodd_parse_$args ("output_type=", (evaluate_forms_info_output.special_string)) = "raw" then do;
			call iox_$control (iocbp, "prt_conv_on", null (), (0));
			call iox_$modes (iocbp, "^rawo", "", (0));
		     end;
		end;
	     end;

	     if code ^= 0 then do;
		if ^(desc_ptr -> request_descriptor.saved & code = error_table_$request_pending) then do; /* BAD */
		     call driver_fatal_error (code, (err_mess));
		     go to clean_out;
		end;
	     end;
	     else print_driver_data.page_no = 0;	/* copy done, checkpoint is no longer valid */

	     printing = "0"b;			/* the printing has been done */

	     call iox_$control (iocbp, "runout", null, code); /* be sure copy is done before counting it */

	     if ^desc_ptr -> request_descriptor.saved then/* if leaving this til later, don't charge now */
		if REQUEST.copies > print_driver_data.copies_charged then do;
		     chgsw = "1"b;			/* user honestly deserves these charges */
		     print_driver_data.copies_charged = print_driver_data.copies_charged + 1;
		end;
		else chgsw = "0"b;
	     else chgsw = "0"b;

	     call charge_for_work;			/* do the accounting so we can put price on tail */

	     if last_error_count = -1 then
		device_error = ""b;			/* no error data */
	     else do;
		call iox_$control (iocbp, "get_error_count", addr (i), code);
		if code ^= 0 | i > last_error_count then
		     device_error = "1"b;
		else device_error = "0"b;		/* we can figure the transfer rate */
	     end;

	     if ^(iodd_static.quit_during_request | device_error) then do; /* can we update the rate estimate? */
		old_rate = driver_status.bit_rate_est;	/* get the last value */
		chars_done = char_count - start_char_offset; /* chars printed in time interval */
		seconds = divide (REQUEST.real_time, 1000000, 17); /* see how many seconds have passed */
		if seconds < 1 then
		     new_rate = old_rate;		/* avoid divide by zero */
		else new_rate = divide (chars_done * 9, seconds, 17, 0); /* get bits/sec */
		if old_rate > 0 then		/* use first good rate to start the estimate */
		     new_rate = fixed (old_rate * factor + new_rate * (1e0 - factor));
						/* use exp smoothing */
		driver_status.bit_rate_est = new_rate;	/* put back new value */
	     end;

	     if REQUEST.saved then do;		/* mark the listing suspended */
		call ioa_$rsnnl ("Processing suspended at page ^d.", err_mess, l, REQUEST.page_count);
		call error_write (0, err_mess);
	     end;

	     call print_tail_banner (code);		/* this will put on the tail banner */
	     if code ^= 0 then do;			/* some type of error..don't do it again */
		call driver_fatal_error (code, "Attempting to write tail banner.");
		go to clean_out;
	     end;

	     if desc_ptr -> request_descriptor.saved then
		go to clean_out;			/* suspend this request and get the next */


	     print_driver_data.copies_done = print_driver_data.copies_done + 1;
	     REQUEST.copy_no = REQUEST.copy_no + 1;	/* get ready for next copy */
	     header_done = "0"b;			/* ready for a new header */
	     starting_page = 1;			/* start the next copy at the begining */

	end;					/* done with this copy...check for more in while loop */

/*	we are now done with the request...so clean up */

	call iox_$control (iocbp, "runout", null, code);	/* be sure all printing is out before charge message */

	call iodd_msg_ (log, both, 0, "", "  Charge for request ^d: $^.2f  (^d lines,  ^d pages^[ per copy)^;)^]",
	     REQUEST.request_no, REQUEST.total_charge, REQUEST.line_count, REQUEST.page_count, (copies_left > 1));

	if REQUEST.notify then do;
	     call ioa_$rsnnl ("printed ^a $^.2f queue ^d ^a ^d", msg, l, REQUEST.full_path, REQUEST.total_charge,
		REQUEST.queue, REQUEST.device_name, REQUEST.request_no);
	     call notify_user (substr (msg, 1, l));
	end;

clean_out:					/* get ready for the next users' request */
	if last_error_count > -1 then do;		/* if error count is defined */
	     call iox_$control (iocbp, "get_error_count", addr (i), code);
	     if code ^= 0 | i > last_error_count then	/* if errors are possible */
		if ^desc_ptr -> request_descriptor.dont_delete then do; /* and user not told about it */
		     if REQUEST.delete = 1 then do;	/* tell user we cancelled his delete request */
			desc_ptr -> request_descriptor.dont_delete = "1"b;
			call ioa_$rsnnl ("Device error during request ^d.  Segment ^a will not be deleted.", msg, l,
			     REQUEST.request_no, REQUEST.full_path);
			call notify_user (substr (msg, 1, l));
		     end;
		end;
	end;

	desc_ptr -> request_descriptor.finished = "1"b;	/* say we are done with it */
	iodd_static.request_in_progress = "0"b;		/* no more commands can be effective */
	call clean_proc ();				/* get junk out of the address space */
	call iox_$control (iocbp, "runout", null, code);	/* make device disgorge */

	return;

check_reprint_position:

/* on restart, we transfer back here to release the stack frame with the dim,
   so the slave can again write to the remote device and request a cmd */
	call restart_request (restart_source);		/* give the request position */
	go to restart_this_request;			/* now go back and restart the request */

%page;

/*  This is where the condition handlers "go to" when something has gone wrong */

flush_request:					/* kill and cancel handlers jump back here */
	msg = "Operator aborted listing";		/* message for kill and cancel */
	chgsw = "0"b;				/* can't charge */
	go to no_delete;

abort_request:					/* unclaimed signals transfer to here */
	chgsw = ""b;				/* assume we can't charge user */

	msg = """" || rtrim (fault_name) || """ condition occured"; /* format basic message */

	if fault_name = "seg_fault_error" &		/* user deleted seg, charge for what was done */
	     iodd_static.segptr ^= null then do;
	     chgsw = "1"b;
	     delete_msg = "";			/* forget to tell user we won't delete his seg */
	end;
	else do;
no_delete:
	     if REQUEST.delete ^= 0 then
		delete_msg = "; segment will not be deleted";
	     else delete_msg = "";
	end;

	call ioa_$rsnnl ("^a during processing of request^a.", err_mess, l, msg, delete_msg);

	code = 0;

	call fatal_error (tell_user);			/* this will clean things up a bit */

	go to clean_out;				/* now drop the request */


defer_request:					/* leave this in the queue for a while */
	err_mess = "Operator deferred request until a later time.";
	chgsw = ""b;

	code = 0;

	call fatal_error (tell_user);

	go to clean_out;

%page;

/* ======================================================================================= */
/* ==============================    INTERNAL PROCEDURES    ============================== */
/* ======================================================================================= */



fatal_error: procedure (notify);

dcl  notify bit (1);

	REQUEST.notify = REQUEST.notify | notify;	/* set notify flag by arg if off */

	if ^REQUEST.notify & ^header_done then
	     call print_head_banner ((0));		/* try to tell requestor */

	if header_done then
	     call charge_for_work;			/* update REQUEST data if possible */

	call error_write (code, err_mess);

	if header_done then
	     call print_tail_banner ((0));		/* finish it off */

	call iodd_msg_ (log, both, 0, "", "Processing of request ^d terminated.", REQUEST.request_no);

	desc_ptr -> request_descriptor.dont_delete = "1"b;/* make sure we don't delete user seg */

	return;					/* let the caller flush the request */

     end fatal_error;

/* ===================================== */

error_write: procedure (code, message);			/* for writing error messages to console &
						   request stream */
dcl  code fixed bin (35);
dcl  message char (*) varying;

	short_msg, lg_msg = "";			/* clear any junk */
	if code ^= 0 then
	     call convert_status_code_ (code, short_msg, lg_msg);

	call ioa_$rsnnl ("Request for ^a. ^a ^a", msg, l, REQUEST.full_path, lg_msg, message);

	if REQUEST.notify then			/* this lets us be quiet about save and defer */
	     call notify_user (substr (msg, 1, l));

	call iodd_msg_ (log, both, 0, "", "**Request ^d: ^a ^a", REQUEST.request_no, lg_msg, message);

	if header_done then do;			/* must not do a "reset" or line and page count is lost */
	     call ioa_$rsnnl ("^2/^a^a^/io_daemon: ^a ^a^/^a^a^2/", msg, l, VT, stars, lg_msg, message, stars, VT);
	     call iox_$modes (iocbp, "default", omode, code);
	     call iox_$put_chars (iocbp, addr (msg), l, code);
	     call iox_$modes (iocbp, omode, (""), code);
	end;
	return;

     end error_write;

%page;

notify_user: procedure (message);

dcl  message char (*) aligned;
dcl  (ipc_ind, r1_ind, ec) fixed bin (35);

	ipc_ind, r1_ind = -1;			/* set to non-zero to test call */

	if ^sys_priv then
	     go to send_it;				/* if they failed once, .... */

	on linkage_error
	     begin;
	     sys_priv = "0"b;			/* stop trying if we fail */
	     go to revert_handler;			/* send the message if possible */
	end;

	on any_other
	     begin;
	     if r1_ind = 0 then
		call system_privilege_$ring1_priv_off (r1_ind);
	     if ipc_ind = 0 then
		call system_privilege_$ipc_priv_off (ipc_ind);
	     r1_ind, ipc_ind = -1;
	     call continue_to_signal_ (ec);
	end;

	call system_privilege_$ring1_priv_on (r1_ind);

	call system_privilege_$ipc_priv_on (ipc_ind);

revert_handler:
	revert linkage_error;

send_it:
	call send_mail_$access_class (mailname, message, addr (send_mail_info), mseg_message_info.sender_authorization,
	     ec);

	if r1_ind = 0 then
	     call system_privilege_$ring1_priv_off (r1_ind);

	if ipc_ind = 0 then
	     call system_privilege_$ipc_priv_off (ipc_ind);

	return;

     end notify_user;

%page;

charge_for_work: procedure ();

/* Accounting section, done at end of processing each copy of output. */

	new_clock = clock_ ();
	call cpu_time_and_paging_ (new_waits, new_cpu, new_pp);

	position.line_number = 0;			/* for the tail banner proc */
	position.total_lines = 0;			/* Clear these items */
	position.page_number = 0;
	call iox_$control (iocbp, "get_position", addr (position), code);

	REQUEST.line_count = position.total_lines;
	if position.line_number = 1 then
	     REQUEST.page_count = position.page_number - 1; /* if file ended with FF */
	else REQUEST.page_count = position.page_number;
	REQUEST.cpu_time = new_cpu - old_cpu;
	REQUEST.real_time = new_clock - old_clock;	/* real time for this copy */
	REQUEST.page_waits = fixed (new_waits - old_waits, 35);
	REQUEST.pre_pages = fixed (new_pp - old_pp, 35);

	if chgsw then do;				/* charge him */
	     if driver_status.have_accounting then do;
		call io_daemon_account_ (driver_status.acct_entry, addr (REQUEST));
	     end;
	     else do;
		REQUEST.price_per_n_lines,		/* zap all charges to zero */
		     REQUEST.price_per_n_pages,
		     REQUEST.charge = 0e0;
		REQUEST.no_accounting = "1"b;		/* and flag it */
	     end;
	end;
	else REQUEST.charge = 0e0;			/* give user a break */

	REQUEST.total_charge = REQUEST.total_charge + REQUEST.charge;

	return;

     end charge_for_work;

/* ============================== */

driver_fatal_error: procedure (code, err_msg);


dcl  code fixed bin (35);
dcl  err_msg char (*);

	call iodd_msg_ (error, both, code, whoami, "^a ^a ^/ Driver returning to command level.", err_msg, err_mess);

	desc_ptr -> request_descriptor.dont_delete = "1"b;/* give a reprieve....in case */
	desc_ptr -> request_descriptor.keep_in_queue = "1"b;

	a_code = code;				/* report driver_fatal_error */

	return;

     end driver_fatal_error;

%page;

check_labels: procedure (user_dir, ename, segptr, code);

/* Internal procedure to check that the top and bottom labels are
   the access class of the segment. */

dcl  access_class bit (72) aligned;
dcl  code fixed bin (35);
dcl  ename char (*) aligned;
dcl  level fixed bin;
dcl  user_dir char (*) aligned;
dcl  segptr pointer;
dcl  sys_info$access_class_floor bit (72) aligned external static;


dcl  1 local_audit_user_info aligned like audit_user_info;
dcl  1 local_audit_eventflags aligned like audit_event_flags;

	code = 0;

	if dprint_msg.top_label ^= dprint_msg.bottom_label then do;
LOG_AUDIT_MESSAGE:
	     call cu_$level_get (level);
	     unspec (local_audit_user_info) = ""b;
	     local_audit_user_info.version = audit_user_info_version_1;
	     local_audit_user_info.user_id = mseg_message_info.sender_id;
	     local_audit_user_info.ring = mseg_message_info.sender_level;
	     local_audit_user_info.process_id = mseg_message_info.sender_process_id;
	     local_audit_user_info.authorization = mseg_message_info.sender_authorization;
	     local_audit_user_info.authorization_range (1) = sys_info$access_class_floor;
	     local_audit_user_info.authorization_range (2) = mseg_message_info.sender_max_authorization;
	     local_audit_user_info.audit_flags = mseg_message_info.sender_audit;

	     unspec (local_audit_eventflags) = ""b;
	     local_audit_eventflags.grant = "1"b;

	     call access_audit_gate_$log_obj_ptr_user ("do_prt_request_", level, unspec (local_audit_eventflags),
		access_operations_$io_daemon_set_page_labels, segptr, 0, null (), 0, addr (local_audit_user_info));

	     return;
	end;

	call hcs_$get_access_class (user_dir, ename, access_class, code);
	if code ^= 0 then
	     return;

	call convert_authorization_$from_string (authorization, rtrim (dprint_msg.top_label), code);
	if code ^= 0 then do;
	     code = 0;
	     goto LOG_AUDIT_MESSAGE;			/* This isn't an access class */
	end;

	if ^(aim_check_$equal (access_class, authorization)) then
	     goto LOG_AUDIT_MESSAGE;

	return;
     end check_labels;

check_user_access: procedure (user_dir, ename, ec);

/* Internal procedure to check that the requestor has at least "r" access to
   the specified segment */

dcl  user_dir char (*) aligned;
dcl  ename char (*) aligned;
dcl  code fixed bin (35);
dcl  ec fixed bin (35);
dcl  mode fixed bin (5);
dcl  access_class bit (72) aligned;

	call hcs_$get_user_effmode (user_dir, ename, REQUEST.requestor, val, mode, code);
	if code ^= 0 then do;
	     if code = error_table_$noentry then
		err_mess = "";			/* simple case, just say no entry */
	     else err_mess = "Unable to get user's mode.";
	     ec = code;
	     return;
	end;

	if (bit (mode, 5) & "01000"b) = "0"b then do;
	     err_mess = "User does not have read access.";
	     ec = error_table_$moderr;
	     return;
	end;

	call hcs_$get_access_class (user_dir, ename, access_class, code);
	if code ^= 0 then do;
	     err_mess = "Unable to get access class of segment.";
	     ec = code;
	     return;
	end;

	if ^read_allowed_ (mseg_message_info.sender_authorization, access_class) then do;
	     ec = error_table_$ai_restricted;
	     err_mess = "User not allowed to read segment.";
	     return;
	end;

	ec = 0;					/* ok, user passed the checks */

	return;

     end check_user_access;

%page;

open_file: procedure (user_dir, ename, fcbp, max_comp, char_count, code);

dcl  user_dir char (*) aligned;
dcl  ename char (*) aligned;
dcl  fcbp ptr;
dcl  max_comp fixed bin;
dcl  char_count fixed bin (24);
dcl  code fixed bin (35);

dcl  comp_dir char (168) aligned;
dcl  comp_name char (32) aligned;
dcl  type fixed bin (2);
dcl  dir fixed bin int static options (constant) init (2);
dcl  dir_len fixed bin;
dcl  bc fixed bin (24);
dcl  mode fixed bin (5);
dcl  mult_ind fixed bin;



	char_count = 0;				/* clear the count so we can accumulate file length */

	call hcs_$status_minf (user_dir, ename, 1, type, bc, code); /* see what kind of a thing it is */
	if code ^= 0 then do;
	     err_mess = char ("Driver cannot get status of file: " || full_path, length (err_mess));
	     return;
	end;

	if type = dir then				/* directory */
	     if bc < 1 then do;			/* it was a directory */
		code = error_table_$dirseg;
		return;
	     end;
	     else max_comp = bc - 1;			/* MSF - highest component is bitcount less one */
	else max_comp = 0;				/* SSF - highest component is 0 */

	call msf_manager_$open (user_dir, ename, fcbp, code);
	if code ^= 0 then do;
	     err_mess = "Unable to open file: " || full_path;
	     return;
	end;

	do mult_ind = 0 to max_comp;			/* now we look at each component */

	     call msf_manager_$get_ptr (fcbp, mult_ind, "0"b, segp, bc, code);
	     if code ^= 0 then do;			/* we failed, don't try to do partial files */
		call ioa_$rsnnl ("Unable to get pointer to file component: ^d.", err_mess, dir_len, mult_ind);
		return;
	     end;

	     if mult_ind = 0 then
		start_segp = segp;			/* this is the first component */

/*		we got a pointer to something...where is it */
/*		and does the requestor have access to it? */

	     call hcs_$fs_get_path_name (segp, comp_dir, dir_len, comp_name, code);
	     if code ^= 0 then do;
		err_mess = "Could not get file component pathname.";
		return;
	     end;

	     call check_user_access (comp_dir, comp_name, code);
	     if code ^= 0 then do;			/* he tried to pull a fast one and got caught */
		err_mess = err_mess || "  " || substr (comp_dir, 1, dir_len) || ">" || comp_name;

/* most of err_mess was set by check_user_access */
		return;
	     end;

	     if bc < 9 then do;			/* must be at least one char per component */
		code = error_table_$improper_data_format; /* choose a good error message */
		err_mess = "Zero length segment: " || substr (comp_dir, 1, dir_len) || ">" || comp_name;
		return;
	     end;

	     REQUEST.bit_count = REQUEST.bit_count + bc;	/* total the bits for accounting */

	     char_count = char_count + divide (bc, 9, 24, 0); /* get char count like output_file will */

	     call hcs_$fs_get_mode (segp, mode, code);	/*  make sure daemon has access  */
	     if code ^= 0 then do;
		err_mess = "Driver process does not have access to segment.";
		return;
	     end;
	     if (bit (mode, 5) & "01000"b) = "0"b then do;
		err_mess = "Driver process does not have read access to segment.";
		code = error_table_$moderr;		/* give some access violation code */
		return;
	     end;
	end;


/* Now we know that the file is there and that the requestor has the correct access to it.
   The continued operation of the driver now assumes that the file will remain the same
   until the driver is done.  That is, the access will not change, the number of components will not
   change, and the size of each component will not change.  */


     end open_file;

%page;

output_file: procedure (how, ending_page, ec);

dcl  how fixed bin;					/* how the file is to be output: sample print skip or save */
dcl  ending_page fixed bin (24);			/* where to stop when skipping */
dcl  ec fixed bin (35);				/* you guessed it, error code */

dcl  bc fixed bin (24);
dcl  max_el fixed bin (24);
dcl  modes char (64);				/* mode string */
dcl  n fixed bin;
dcl  nel fixed bin (24);				/* number of chars to be printed on write */
dcl  nelt fixed bin (24);				/* number of chars processed by dim on return */
dcl  next fixed bin;
dcl  code fixed bin (35);				/* iox_ status code, local version */

dcl  wp ptr;					/* working pointer into the segment */
dcl  char_pos (sys_info$max_seg_size * 4) char (1) based;	/* array of one char elements to get wp */
dcl  seg_string char (max_el) based (segp);

dcl  1 temp aligned like print_driver_data.checkpoint;	/* temporary values for current position */

dcl  1 save_position aligned like position_data;		/* temporary for position at start of sample */


	ec = 0;					/* clear the error code */

	temp = current;				/* we will start at the current position */

	if how = SAMPLE then do;			/* print 1 page and put all position counters back as found */
	     modes = "1pg,print," || ck_mode;		/* return after printing 1 page */
	     call iox_$control (iocbp, "get_position", addr (save_position), code); /* save dim position */
	     if code ^= 0 then do;
		err_mess = "From get_position order for sample.";
		ec = code;
		return;
	     end;
	end;
	else if how = SKIP then do;			/* process file to ending_page without printing,
						   but save checkpoints on the way */
	     n = ending_page - current.page_no;		/* see how close to the end we are */
	     if n < ck_interval then do;		/* if close, use a small interval */
		pic = n;				/* get the interval as ascii */
		modes = "stop" || ltrim (pic);	/* make a mode string for the dim */
	     end;
	     else modes = ck_mode;			/* if not close, use the normal interval */

	     modes = char ("^print,^1pg," || modes, length (modes)); /* it is transparant in either case */
	end;
	else if how = SAVE then
	     modes = "print,1pg," || ck_mode;		/* for save, go to bottom of even page */
	else modes = "print,^1pg," || ck_mode;		/* default assumes how = print */

	call iox_$control (iocbp, "runout", null, code);
	call iox_$modes (iocbp, modes, omode, code);	/* set the modes */
	if code ^= 0 then
	     call iodd_msg_ (error, both, code, whoami, "Changing mode during output init to: ^a^/  from: ^a", modes,
		omode);

	segp = null;				/* don't try to deactivate */

next_comp:					/* done with last component */
	if segp ^= null & privileged then
	     call phcs_$deactivate (segp, (0));		/* so try to deactivate the seg */

	call msf_manager_$get_ptr (fcbp, temp.comp_no, "0"b, segp, bc, ec); /* get ptr to seg */
	if segp = null then do;
	     err_mess = "Invalid seg ptr to component.";
	     return;
	end;

	if privileged then				/* .. do it (gently if possible) */
	     call phcs_$set_kst_attributes (binary (baseno (segp), 18), addr (ksta), (0));

	max_el = divide (bc, 9, 24, 0);		/* see now many elements to write out */

/* if this is last (or only) component of file, remove any trailing VT or FF chars */
	if temp.comp_no = max_comp then do;
	     max_el = length (rtrim (seg_string, nl_vt_ff));
	end;

write_out:
	nel = max_el - temp.offset;			/* see how much is left to do */
	iodd_static.segptr = segp;			/* tell signal handler what segment we are using */
	wp = addr (segp -> char_pos (temp.offset + 1));	/* get ptr to next character */

	call iox_$put_chars (iocbp, wp, nel, code);	/* This is the actual output of segment */
	iodd_static.segptr = null;			/* not referencing user seg now */
	if code ^= 0 then do;
	     if code ^= error_table_$request_pending then do; /* we only want one code */
		ec = code;
		err_mess = "IO error during output of file.";
		return;
	     end;

/* code = error_table_$request_pending.  do something about it */
	     if how = SAMPLE then do;			/* Yes, and for sample we are done printing */

sample_done:	call iox_$control (iocbp, "set_position", addr (save_position), code); /* restore position */
		if code ^= 0 then
		     call iodd_msg_ (error, both, code, whoami,
			"Unable to restore position, set_position order.");

/* current position data was not changed */

		modes = "^1pg," || ck_mode;		/* restore the default checkpoints */

		call iox_$modes (iocbp, modes, omode, code);
		if code ^= 0 then
		     call iodd_msg_ (error, both, code, whoami, "Changing mode from ^a^/to ^a", omode, modes);

		call iox_$control (iocbp, "runout", null, code); /* be sure it prints */

		return;
	     end;

/* hit checkpoint for save, skip or print */
	     call iox_$control (iocbp, "get_position", addr (position), code); /* see where we are */
	     if code ^= 0 then do;
		ec = code;
		err_mess = "Error on get_position order for checkpoint.";
		return;
	     end;

	     nelt = position.total_chars - temp.file_offset; /* num chars done */

	     if how = SKIP then do;			/* if skipping, check for end of file */
		if (nel = nelt) & (temp.comp_no = max_comp) then do; /* this is bad - hit EOF */
		     force_ck_pt = "1"b;		/* be sure we re-sync the dim */
		     ec = error_table_$eof_record;	/* report it as an error */
		     call ioa_$rsnnl ("EOF reached at end of page ^d.", err_mess, l,
			position.page_number - 1);
		     return;			/* the page count from the dim is one too high */
		end;
	     end;

/* record the current position of the dim */
	     temp.page_no = position.page_number;
	     temp.line_count = position.total_lines;
	     temp.offset = temp.offset + nelt;
	     temp.file_offset = position.total_chars;

	     current = temp;			/* say this is a real page position */
	     if how = PRINT | how = SAVE then
		print_driver_data.checkpoint = current; /* make things consistent */

	     if how = SAVE then do;			/* getting ready to suspend request */
		n = mod (temp.page_no, 2);		/* check for even page */
		if n = 1 then do;			/* odd number means we just finished an even page */
		     ec = error_table_$request_pending; /* pass back "not finished" */
		     return;
		end;
	     end;

	     if current.page_no >= (ck.point (ck.last).page_no + ck_interval) then do; /* worth saving it */

		next = ck.entry (ck.last).forward;	/* find index of next checkpoint entry */
		ck.point (next) = current;		/* save the current checkpoint */
		ck.last = next;			/* advance the index */
	     end;

	     if how = SKIP then do;			/* see if we have skipped enough */

		if current.page_no = ending_page then
		     return;			/* all done */

		if current.page_no > ending_page then do; /* OOPS - a counting error */
		     force_ck_pt = "1"b;		/* re-sync the dim */
		     ec = error_table_$out_of_bounds;	/* give an error code */
		     call ioa_$rsnnl ("Skipped over end page ^d, at ^d.", err_mess, l, ending_page,
			current.page_no);
		     return;
		end;

		n = ending_page - current.page_no;	/* see how far we need to go */

		if n < ck_interval then do;		/* if close, use a small interval */

		     pic = n;			/* make it ascii */
		     modes = "stop" || ltrim (pic);	/* make the mode string */

		     call iox_$modes (iocbp, modes, omode, code);
		     if code ^= 0 then
			call iodd_msg_ (error, both, code, whoami,
			     "Changing mode near end of skip to: ^a^/  from: ^a", modes, omode);
		end;
	     end;					/* end of skip mode checks */
	     if nelt < nel then
		go to write_out;			/* when more to do, do it */
	     else go to end_of_comp;			/* otherwise this component is done, get next one */
	end;					/* end of skip or print checkpoint processing */

	temp.file_offset = temp.file_offset + nel;	/* record last output from this component */

end_of_comp:					/* get set for the next component, or quit if done */
	if temp.comp_no = max_comp then		/* we are at real end of file */
	     if how = PRINT | how = SAVE then do;	/* this is good */
		if privileged & ((REQUEST.copy_no = REQUEST.copies) | (max_comp > 0)) then /* done for a while */
		     call phcs_$deactivate (segp, (0)); /* so let the pages go */
		segp = null;
		return;
	     end;
	     else if how = SKIP then do;
		ec = error_table_$eof_record;		/* tried to skip too far */
		call iox_$control (iocbp, "get_position", addr (position), code);
		if code ^= 0 then
		     call iodd_msg_ (error, both, code, whoami, "get_position order.");
		if position.line_number = 1 then
		     call ioa_$rsnnl ("EOF reached at end of page ^d.", err_mess, l, position.page_number - 1);
		else call ioa_$rsnnl ("EOF at page ^d, line ^d.", err_mess, l, position.page_number,
			position.line_number);
		force_ck_pt = "1"b;			/* tell caller we are out of sync */
		return;
	     end;
	     else do;				/* sample was the last partial page */
		call iox_$put_chars (iocbp, addr (FF), 1, code); /* align the page */
		go to sample_done;			/* let it go by */
	     end;

	temp.comp_no = temp.comp_no + 1;		/* go on to the next component */
	temp.offset = 0;				/* start at the begining */

	go to next_comp;				/* deactivate old and get new */

     end output_file;

%page;

restart_request: procedure (source);

/* internal procedure used to tell operator where the request was  */

dcl  source fixed bin;

dcl  code fixed bin (35);
dcl  pg_count_msg char (80);				/* message for last page processed */
dcl  restart_msg char (200);
dcl  i fixed bin;

	call iox_$control (iocbp, "resetwrite", null, code); /* clear any junk out of the buffers */

	call iox_$control (iocbp, "get_position", addr (position), code);
	if code ^= 0 then
	     starting_page = current.page_no;		/* last known page data */
	else starting_page = position.page_number - 5;	/* start back 5 pages unless otherwise instructed */

	if starting_page < 1 then			/* be sure of a good page number */
	     starting_page = 1;
	call ioa_$rsnnl ("Driver positioned at page ^d of the file.", pg_count_msg, i, starting_page);

	REQUEST.copy_no = min (REQUEST.copies, print_driver_data.copies_done + 1); /* assume this for now */

	call ioa_$rsnnl ("Restarting request ^d at copy number ^d of ^d", restart_msg, i, REQUEST.request_no,
	     REQUEST.copy_no, REQUEST.copies);
	call iodd_msg_ (normal, source, 0, "", "^a^/^a^/", restart_msg, pg_count_msg);

	return;

     end restart_request;

%page;

get_page_no: procedure (a_page, a_pgn, ec);

dcl  a_page char (*) var aligned;
dcl  a_pgn fixed bin (24);
dcl  ec fixed bin (35);

dcl  sign char (1);
dcl  start fixed bin;
dcl  pgn fixed bin (24);


	ec = 0;					/* initialize the return code */

	if a_page = "" then do;			/* for a null string, use the current position */
	     a_pgn = current.page_no;
	     return;
	end;

	sign = substr (a_page, 1, 1);			/* see if this is a relative page number */

	if sign = "+" | sign = "-" then
	     start = 2;
	else start = 1;				/* this is the start of the number part */

	on conversion go to pgn_err;
	pgn = convert (pgn, substr (a_page, start));	/* convert it to binary */

	if pgn < 1 then do;				/* make "--N" illegal */
pgn_err:
	     ec = 10;				/* and keep the numbers in range */
	     return;
	end;

	if sign = "+" then
	     a_pgn = current.page_no + pgn;		/* forward N pages */

	else if sign = "-" then
	     a_pgn = current.page_no - pgn;		/* back N pages */

	else a_pgn = pgn;				/* an absolute page number */

	if a_pgn < 1 then
	     a_pgn = 1;				/* can't go back past start  */

	return;

     end get_page_no;

%page;

skip_to_page: procedure (starting_pg, ec);

dcl  starting_pg fixed bin (24);
dcl  ec fixed bin (35);

dcl  target fixed bin (24);
dcl  i fixed bin;
dcl  pg fixed bin (24);
dcl  high_page fixed bin (24);
dcl  ind fixed bin;
dcl  next fixed bin;
dcl  code fixed bin (35);				/* local error code */


	ec = 0;					/* start clean */

	target = starting_pg;			/* copy arg so we don't change the logic by accident */

	call iox_$modes (iocbp, (REQUEST.output_mode), omode, code); /* must skip under users modes */
	if code ^= 0 then do;
	     ec = code;
	     err_mess = "Unable to set user modes for page skip.";
	     return;
	end;

	if paper_not_aligned & continuous_paper then do;	/* we need to re sync the world */
	     call iox_$put_chars (iocbp, addr (FF), 1, code); /* first a FF */
	     if code ^= 0 then do;
		ec = code;
		err_mess = "IO error writing form feed to the printer.";
		return;
	     end;
	     call iox_$control (iocbp, "runout", null, code); /* be sure it is written */
	     paper_not_aligned = "0"b;		/* we are aligned now */
	     force_ck_pt = "1"b;			/* don't count the page just written */
	end;


	if ^force_ck_pt then			/* can we believe the current position */
	     if target = current.page_no then
		return;				/* we are already there */

	high_page = 0;				/* highest page <_ target */
	ind = 0;					/* index of checkpoint for high_page */

	do i = 1 to hbound (ck.entry, 1);		/* look at all entries...may not be in order */

	     pg = ck.point (i).page_no;		/* get the page number */
	     if (pg <= target) & (pg > high_page) then do;/* see if it is highest <_ target */
		high_page = pg;
		ind = i;
	     end;
	end;

	if ind = 0 then do;				/* start at begining */

	     current.page_no, position.page_number = 1;	/* begining is at page 1 */
	     current.line_count, position.total_lines = 0;
	     current.comp_no = 0;			/* first MSF component */
	     current.offset = 0;			/* first char in the file */
	     current.file_offset, position.total_chars = 0;
	     next = ck.entry (ck.last).forward;		/* get index of next checkpoint */
	     ck.point (next) = current;		/* save the start as the next checkpoint */
	     ck.last = next;			/* advance the index */

	end;
	else do;					/* we found a valid checkpoint */

	     if ^force_ck_pt then
		if (high_page < current.page_no) & (target > current.page_no) then
		     go to forward;

	     current.page_no, position.page_number = ck.point (ind).page_no;
	     current.line_count, position.total_lines = ck.point (ind).line_count;
	     current.comp_no = ck.point (ind).comp_no;
	     current.offset = ck.point (ind).offset;
	     current.file_offset, position.total_chars = ck.point (ind).file_offset;
	     ck.last = ind;				/* move the checkpoint index to this entry */

	end;

	call iox_$control (iocbp, "runout", null, code);
	call iox_$modes (iocbp, "^print", omode, code);	/* don't move the paper */

	call iox_$put_chars (iocbp, addr (FF), 1, code);	/* make believe we wrote a FF */

	call iox_$modes (iocbp, "print", omode, code);	/* back to normal mode */

	call iox_$control (iocbp, "set_position", addr (position), code); /* set dim page and line positions */
	if code ^= 0 then do;			/* OOPS */
	     ec = code;
	     err_mess = "Unable to set position for checkpoint.";
	     return;
	end;

	force_ck_pt = "0"b;				/* we can believe the current position data now */

	if target = current.page_no then
	     return;				/* can't be less than current at this point */

forward:
	call output_file (SKIP, target, ec);		/* now go forward to the top of the target page */

	call iox_$control (iocbp, "runout", null, code);
	call iox_$modes (iocbp, "print", omode, code);	/* be sure we stay in print mode */

	return;

     end skip_to_page;

%page;

set_modes_and_labels: procedure ();

dcl  nm char (256) var;
dcl  i fixed bin;
dcl  v char (12) var;
dcl  ll fixed bin;					/* line length for this request */
dcl  ind fixed bin;					/* line indentation */
dcl  temp_label char (136);				/* temporary for cleaning the label */
dcl  len fixed bin;

/* since this request may have a different forms specification than the previous
   reset the paper size data based on this request */
	if ^continuous_paper then do;
	     if evaluate_forms_info_output_ptr ^= null then do;
		paper_info_data.phys_page_length = evaluate_forms_info_output.lines_per_page;
		paper_info_data.phys_line_length = evaluate_forms_info_output.chars_per_line;
		paper_info_data.lines_per_inch = evaluate_forms_info_output.lines_per_inch;
		call iox_$control (iocbp, "paper_info", addr (paper_info_data), code);
		if code ^= 0 then do;
		     call convert_status_code_ (code, short_msg, lg_msg);
		     call ioa_$rsnnl ("^a  while setting paper size info", msg, l, lg_msg);
		     call notify_user (substr (msg, 1, l));

/* something happened while setting paper size info */
		     call driver_fatal_error (code, "Changing paper size info.");
		     go to clean_out;
		end;
		call iox_$control (iocbp, "reset", null, code); /* reset everything based on the new page/line lengths */
	     end;
	end;

	nm = "";					/* clear the string */
	if dprint_msg.line_lth > 1 then do;
	     ll = min (dprint_msg.line_lth, prt_ctl.phys_line_length); /* save lth up to max for labels */
	     pic = ll;				/* convert to char form */
	     v = ltrim (rtrim (pic));			/* strip blanks */
	     nm = "ll" || v || ",";			/* make it into a mode string */
	end;
	else ll = prt_ctl.phys_line_length;

	if dprint_msg.lmargin > 1 then do;
	     ind = dprint_msg.lmargin;		/* save the value */
	     pic = ind;				/* convert */
	     v = ltrim (rtrim (pic));
	     nm = nm || "in" || v || ",";
	end;
	else ind = 0;				/* default is no indentation */

	i = length (nm);
	line_mode = nm;				/* save the ll and ind modes alone */
	if i > 0 then
	     substr (line_mode, i, 1) = "";		/* drop the last comma */

	if dprint_msg.control.nep | prt_ctl.force_nep then do;
	     nm = nm || "noskip,";
	     nep_mode_set = "1"b;			/* labels are not valid in noskip */
	     set_page_labels = "0"b;			/* so be sure we turn them off */
	end;
	else nep_mode_set = "0"b;			/* try for labels */
	if dprint_msg.control.single then
	     nm = nm || "single,";
	if dprint_msg.control.non_edited then
	     nm = nm || "non_edited,";
	if dprint_msg.control.truncate then
	     nm = nm || "truncate,";
	if dprint_msg.page_lth > 1 then do;
	     pic = dprint_msg.page_lth;
	     v = ltrim (rtrim (pic));
	     nm = nm || "pl" || v || ",";
	end;
	if dprint_msg.esc | prt_ctl.force_esc then
	     nm = nm || "esc,";			/* do we need slew control */
	if dprint_msg.control.line_nbrs then		/* line numbers? */
	     nm = nm || "line_nbrs,";
	if prt_ctl.force_ctl_char then
	     nm = nm || "ctl_char,";			/* pass control characters to the printer */
	i = length (nm);				/* get the string length */
	REQUEST.output_mode = nm;
	if i > 0 then
	     substr (REQUEST.output_mode, i, 1) = "";	/* clobber the last comma */

	pg_labels.top_label, pg_labels.bottom_label = " ";/* set leading blanks */

	if ^nep_mode_set then do;			/* only if labels can be used */

	     temp_label = translate (dprint_msg.top_label, " ", nl_vt_ff); /* remove naughty characters */
	     if verify (temp_label, space_ht_bs) > 0 then do; /* anything other than white space? */
		set_page_labels = "1"b;		/* set the labels in the main loop */
		len = length (rtrim (temp_label));	/* how long is  the label */
		if (ll > len) & dprint_msg.control.center_top_label then do;
		     len = divide (ll - len - ind, 2, 17, 0) - divide(ind, 2, 17, 0) + 1; /* calculate starting position (dim adds ind) */
		     substr (pg_labels.top_label, len) = temp_label; /* drop it in the right position */
		end;
		else pg_labels.top_label = temp_label;	/* put it in as given (almost) */
	     end;

	     temp_label = translate (dprint_msg.bottom_label, " ", nl_vt_ff); /* do it again for the bottom label */
	     if verify (temp_label, space_ht_bs) > 0 then do;
		set_page_labels = "1"b;
		len = length (rtrim (temp_label));
		if (ll > len) & dprint_msg.control.center_bottom_label then do;
		     len = divide (ll - len - ind, 2, 17, 0) - divide(ind, 2, 17, 0) + 1;
		     substr (pg_labels.bottom_label, len) = temp_label;
		end;
		else pg_labels.bottom_label = temp_label;
	     end;
	end;

	return;

     end set_modes_and_labels;

%page;

print_head_banner: procedure (code);

dcl  code fixed bin (35);				/* error code */
dcl  ec fixed bin (35);

	iodd_static.quit_during_request = "0"b;		/* reset for each copy */
	code = 0;					/* clear the code */

	if iodd_static.ctl_term.attached then do;	/* message to ctl term? */
	     call write_control_form_ (iodd_static.form_type, iodd_static.ctl_output, addr (REQUEST), ec);
	     if ec ^= 0 then do;
		if ec ^= error_table_$action_not_performed then do; /* this one is normal */
		     call iodd_msg_ (error, master, ec, whoami, "Writing message on control terminal.");
		     iodd_static.slave_hold = "1"b;	/* avoid automatic start */
		end;
		ctl_msg_sent = "0"b;		/* don't wait for bad message */
	     end;
	     else ctl_msg_sent = "1"b;		/* say all was well, so we can wait */
	     if ctl_wait_list.number = 1 & ctl_msg_sent then do; /* are we going to sync with the term? */
		call ipc_$drain_chn (ctl_wait_list.channel, ec);
		if ec ^= 0 then do;			/* avoid futher trouble, but not fatal */
		     ctl_wait_list.channel = 0;	/* stop trying */
		     ctl_wait_list.number = 0;
		     iodd_static.slave_hold = "1"b;
		     ctl_msg_sent = "0"b;		/* don't wait , no wakeup will come */
		     call convert_ipc_code_ (ec);
		     call iodd_msg_ (error, master, ec, whoami, "print_head_banner bad call to ipc_drain");
		end;
		else call timer_manager_$alarm_wakeup (driver_status.form_wait_time, "11"b, ctl_wait_list.channel);
	     end;
	end;
	else ctl_msg_sent = "0"b;			/* don't wait */

	call iox_$control (iocbp, "reset", null, code);	/* get to a known format */
	call iox_$control (iocbp, "inside_page", null, code); /* and page position */

	if ^REQUEST.no_separator | REQUEST.copy_no = 1 then do;
	     call iodd_static.print_head_sheet (iocbp, prt_ctl_ptr, addr (REQUEST), code); /* write head sheet */
	     if code = 0 then
		header_done = "1"b;			/* for the error routines */
	end;					/*	otherwise ignore the banner type and just align the paper */

	call iox_$control (iocbp, "reset", null, code);	/* don't charge for advertizing */
	return;

     end print_head_banner;

%page;

print_tail_banner: procedure (code);

dcl  code fixed bin (35);
dcl  ec fixed bin (35);
dcl  odd_page bit (1);

dcl  1 event_info aligned,				/* info returned from ipc_$block */
       2 chan fixed bin (71),
       2 message fixed bin (71),
       2 sender bit (36),
       2 origin fixed bin,
       2 wait_list_index fixed bin;

	code = 0;					/* clear the error code */
	odd_page = (mod (position.page_number, 2) = 1);	/* did we stop on an odd page? */

	if nep_mode_set & continuous_paper then do;	/* in nep mode, check paper position */
	     if position.line_number > (prt_ctl.phys_page_length - divide (prt_ctl.lines_per_inch, 2, 17))
		& odd_page then do;
		call iox_$put_chars (iocbp, addr (FF), 1, code); /* move ahead when partially printed */
		odd_page = ""b;			/* now proceed as though we finished on even page */
	     end;
	end;
	else if set_page_labels then			/* if we owe a bottom label on last page */
	     call iox_$control (iocbp, "end_of_page", null, code);

	call iox_$control (iocbp, "reset", null, code);	/* clear the counters and page labels */

/* for remotes, move to the right page */
	if ^odd_page & iodd_static.attach_type ^= ATTACH_TYPE_IOM & continuous_paper then
	     call iox_$put_chars (iocbp, addr (FF), 1, code); /* move ahead when partially printed */

	call iox_$control (iocbp, "outside_page", null, code);
	if ^REQUEST.no_separator | (REQUEST.copy_no = REQUEST.copies) then
	     call iodd_static.print_tail_sheet (iocbp, prt_ctl_ptr, addr (REQUEST), code);

	if ^iodd_static.quit_during_request &		/* on quit, don't wait for ctl term  */
	     ctl_msg_sent then do;			/* avoid premature blocking */
	     call ipc_$block (addr (ctl_wait_list), addr (event_info), ec); /* wait for form to finish */
	     if ec ^= 0 then do;
		call convert_ipc_code_ (ec);
		call iodd_msg_ (error, master, ec, whoami, "Attempting to block for ctl_term.");
		iodd_static.slave_hold = "1"b;	/* go to cmd level */
	     end;
	end;

	return;

     end print_tail_banner;

%page;

init_static_ctl: procedure ();

	string (static_ctl.flags) = ""b;

	static_ctl.banner_type = NORMAL_BANNERS;
	static_ctl.banner_bars = NORMAL_BANNER_BARS;
	static_ctl.banner_indent = 0;
	static_ctl.banner_line = 1;

	static_ctl.phys_line_length = 136;
	static_ctl.phys_page_length = 66;
	static_ctl.lines_per_inch = 6;

	string (static_ctl.channel_stops) = "0"b;	/* no channel stops defined here */

	return;

     end init_static_ctl;


clean_proc: procedure ();

	iodd_static.segptr = null;			/* tell signal handler we are done with it */

	if fcbp ^= null then do;
	     if segp ^= null then
		if privileged then
		     call phcs_$deactivate (segp, (0));
	     call msf_manager_$close (fcbp);
	end;

	segp, fcbp = null;				/* because this is used for several functions */

	return;

     end clean_proc;
%page;
set_up_page_labels: proc;

/* this routine will set up the printer to generate labels if they are needed */

/* if this is single sheet paper and there is a control string to initialize
   the printer send it out now.  This is needed since head_sheet_ and
   tail_sheet_ programs for the printer might alter the characteristics of the
   printer in order to output their forms */

	if ^continuous_paper then do;
	     if evaluate_forms_info_output_ptr ^= null then do;
		if evaluate_forms_info_output.escape_length ^= 0 then do;
		     call iox_$modes (iocbp, "rawo", "", code);
		     call iox_$control (iocbp, "prt_conv_off", null (), code);
		     call iox_$put_chars (iocbp, addr (evaluate_forms_info_output.escape_string),
			(evaluate_forms_info_output.escape_length), code);
		     call iox_$control (iocbp, "prt_conv_on", null (), code);
		     call iox_$modes (iocbp, "^rawo", "", code);
		end;
	     end;
	end;

	if set_page_labels then do;			/* only if we need page labels */
	     if (prt_ctl.banner_type = NO_BANNERS & prt_ctl.banner_bars = NO_BANNER_BARS)
		| (prt_ctl.banner_type = NO_BANNERS & ^REQUEST.separator)
		| (REQUEST.no_separator & ^(REQUEST.copy_no = 1)) then
		call iox_$put_chars (iocbp, addr (FF), 1, code);

/* move below page label position for this page */
	     call iox_$control (iocbp, "end_of_page", null, code);
	     call iox_$modes (iocbp, line_mode, omode, code);
	     if code ^= 0 then do;
		call convert_status_code_ (code, short_msg, lg_msg);
		call ioa_$rsnnl ("^a  while setting user line modes to: ^a^/  from: ^a", msg, l, lg_msg,
		     line_mode, omode);
		call notify_user (substr (msg, 1, l));

/* The user tried to put the left margin after the right margin. */
		call driver_fatal_error (code, "Changing to user line modes.");
		go to clean_out;
	     end;

	     call iox_$control (iocbp, "page_labels", addr (pg_labels), code);
	     if code ^= 0 then do;
		call driver_fatal_error (code, "Setting page_labels.");
		go to clean_out;
	     end;
	end;
	if (set_page_labels) |			/* get the top label out			*/
						/* regardless of anything else		*/
	     ^((prt_ctl.banner_type = NO_BANNERS & prt_ctl.banner_bars = NO_BANNER_BARS)
	     | (prt_ctl.banner_type = NO_BANNERS & ^REQUEST.separator)
	     | (REQUEST.no_separator & ^(REQUEST.copy_no = 1))) then /* if no labels then */
	     call iox_$put_chars (iocbp, addr (FF), 1, code); /* if not at top_inside_page, go there */

     end set_up_page_labels;
%page;

/* ======== OTHER EXTERNAL ENTRIES ========= */

error_during_request: entry (cond);			/* for coming back after signal */

dcl  cond char (*);

	fault_name = cond;
	go to err_label;


single_copy: entry ();

/* abort multiple copies on command */

	request_data_p -> ordata.copies = 1;		/* force copy limit to 1 */
	return;

%page; %include access_audit_user_info;
%page; %include access_audit_eventflags;
%page; %include dprint_msg;
%page; %include driver_status;
%page; %include iod_constants;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include kst_attributes;
%page; %include mseg_message_info;
%page; %include output_request_data;
%page; %include print_driver_data;
%page; %include prt_ctl;
%page; %include prt_order_info;
%page; %include queue_msg_hdr;
%page; %include request_descriptor;
%page; %include send_mail_info;
%page; %include system_forms_info;

     end do_prt_request_;




		    form_.alm                       11/15/82  1835.7rew 11/15/82  1533.8       10908



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

"	Outer Module Transfer Vector for the form_ outer module.

	entry	form_module
form_module:
	tra	*+1,6		go to proper transfer instruction

	tra	<form_dim_>|[form_attach]
	tra	<form_dim_>|[form_detach]
	tra	<form_dim_>|[form_read]
	tra	<form_dim_>|[form_write]
	tra	<form_dim_>|[form_abort]
	tra	<form_dim_>|[form_order]
	tra	<form_dim_>|[form_resetread]
	tra	<form_dim_>|[form_resetwrite]
	tra	<ios_>|[no_entry]
	tra	<form_dim_>|[form_getsize]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<form_dim_>|[form_changemode]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]

	end




		    form_dim_.pl1                   11/15/82  1835.7rew 11/15/82  1507.8      200745



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



form_dim_: procedure;

	return;					/* this is not a legal entry point */

/* Splicing dim to control the printing of forms on the IO daemon driver control terminal.
   This dim accepts a page length and line length as order calls and keeps track of the current line
   number on the terminal so that it can output enough line feeds to bring the form to the top of the
   page when a form feed character is written.  The read entry also updates the current line position. */

/* Originally coded by J. Whitmore, Jan 1975, based on an old ttydim */


dcl (sdb_p, sp, vp, p) ptr,				/* temporary storage */
    (k, i) fixed bin;

dcl 1 first_sdb int static aligned like sdb;		/* first allocation of an SDB */

dcl 1 sdb based (sdb_p) aligned,			/* one entry in list of stream data control blocks */
    2 dim_name char (32),				/* the name of this DIM */
    2 device_name_list ptr,				/* ptr to threaded list of device names for ios_ */
    2 next_device ptr,				/* this should be null..device_name_list points here */
    2 device_name_size fixed bin,			/* number of chars in device name */
    2 device_name char (32) unal,			/* stream or device attached to */
    2 n_attached fixed bin,				/* number of different streams using this SDB */
    2 active bit (1) unal,				/* "1" means this entry is active */
    2 aligned bit (1) unal,				/* "1" means paper is aligned on terminal */
    2 pad bit (34) unal,
    2 page_size fixed bin,				/* number of lines on the form */
    2 line_length fixed bin,				/* number of print positions per line */
    2 carg_pos fixed bin,				/* last known carriage position */
    2 line_no fixed bin,				/* current line on the page */
    2 nextp ptr;					/* pointer to next entry in sdb list */

dcl 1 st based (sp) aligned,				/* breakdown of I/O system status word */
    2 code fixed bin (35),				/* error status code (0 = OK) */
    2 comp bit (4) unaligned,				/* completion status, LI, LC, PI, PC */
    2 end bit (1) unaligned,				/* end-of-file */
    2 pad1 bit (4) unaligned,
    2 eod bit (1) unaligned,				/* end of physical data */
    2 pad2 bit (4) unaligned,
    2 abs bit (1) unaligned,
    2 det bit (1) unaligned,				/* detach flag */
    2 quit bit (1) unaligned,				/* quit flag */
    2 abort bit (1) unaligned,			/* abort flag */
    2 callx bit (18) unaligned;			/* rel pointer to last transaction */

dcl  hcs_$assign_linkage ext entry (fixed bin, ptr, fixed bin (35));

dcl  form_dim_$form_changemode entry (ptr, char (*), char (*), bit (72) aligned);

dcl  onechar char (1),				/* temp for compares */
     code fixed bin (35),
     init bit (1) int static init ("0"b),		/* sdb initialization flag */
     bel char (1) init (""),				/* a bel char */
     space char (1) int static init (" "),		/* a space char */
     spaces char (12) int static init ("           "),	/* string of spaces */
     nl char (1) int static init ("
"),
     ht char (1) int static init ("	"),
     bs char (1) int static init ("");

dcl (addr, null, mod, index, substr, search, length) builtin;

dcl  any_other condition;

dcl  error_table_$ionmat fixed bin (35) ext static;	/* code indicating stream already attached */

dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);

dcl  ios_$order entry (char (*), char (*), ptr, bit (72)aligned);
dcl  ios_$read entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
dcl  ios_$write entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
dcl  ios_$abort entry (char (*), bit (72) aligned, bit (72) aligned);
dcl  ios_$resetread entry (char (*), bit (72) aligned);
dcl  ios_$resetwrite entry (char (*), bit (72) aligned);
dcl  ios_$changemode entry (char (*), char (*), char (*), bit (72) aligned);

dcl  VT char (1) int static init ("");			/* a vertical tab character */

dcl  ff char (1) int static init ("");			/* form feed char */

form_attach: entry (from_stream, dim_name, to_stream, mode, status, sdb_ptr);

dcl  from_stream char (*),				/* stream name (e.g. user_i/o) */
     dim_name char (*),				/* IOSIM name used to get here */
     to_stream char (*),				/* stream we are attaching to */
     mode char (*),					/* attachment mode */
     status bit (72) aligned,				/* I/O system status code (returned) */
     sdb_ptr ptr;					/* device attachment pointer (returned) */

	status = "0"b;				/* clear status code */
	sp = addr (status);				/* pick up pointer to status code argument */
	if sdb_ptr ^= null then do;			/* this is a multiple attachment from the same source */
	     st.code = error_table_$ionmat;		/* no good, so return error code */
	     return;				/* return */
	end;
	sdb_p = addr (first_sdb);			/* get pointer to first entry in SDB list */
	if ^init then do;				/* be sure we initialize sdb first in the process */
	     sdb.active = "0"b;			/* not active yet */
	     sdb.nextp = null;			/* list ends here */
	     init = "1"b;				/* we are now initialized for sdb search */
	end;
	vp = null;				/* use vp to locate first vacant entry (if any) */
	do while (sdb_p ^= null);			/* search entire SDB list */
	     p = sdb_p;				/* keep track of last entry in temp ptr p */
	     if ^sdb.active then do;			/* is this entry an unused (vacant) entry? */
		if vp = null then vp = sdb_p;		/* record first vacant entry found in list */
	     end;
	     else if sdb.device_name = to_stream then do; /* not vacant, is stream already attached? */
		sdb_ptr = sdb_p;			/* if so, return attachment ptr to this entry */
		sdb.n_attached = sdb.n_attached + 1;	/* allow multiple sources */
		go to attrtn;			/* and return to caller */
	     end;
	     sdb_p = sdb.nextp;			/* get pointer to next entry (if any) in list */
	end;
	if vp = null then do;			/* if no vacant entry found in sdb list, */
	     call hcs_$assign_linkage (32, vp, code);	/* then we must allocate space for a new entry */
	     if code ^= 0 then go to atterr;
	     vp -> sdb.active = "0"b;			/* initialize new sdb list entry */
	     vp -> sdb.nextp = null;			/* indicate new entry is last entry in list */
	     p -> sdb.nextp = vp;			/* thread new entry into sdb list */
	end;
	sdb_p, sdb_ptr = vp;			/* set caller's attachment pointer */
	sdb.active = "1"b;				/* initialize remainder of sdb list entry */
	sdb.n_attached = 1;				/* this is the first source for this SDB */
	sdb.device_name = to_stream;			/* save stream we will do I/O on */
	sdb.dim_name = dim_name;			/* initialize name of DIM */
	sdb.device_name_list = addr (sdb.next_device);	/* get pointer to list of device names */
	sdb.next_device = null;			/* this is last entry in list */
	sdb.device_name_size = index (to_stream, " ") - 1; /* there should be a trailing space */
	if sdb.device_name_size < 1 then sdb.device_name_size = length (to_stream);
	sdb.page_size = 66;				/* default is 66 lines per page */
	sdb.line_length = 79;			/* assume 79 as a default */
	sdb.carg_pos = 1;				/* assume carrage in col 1 */
	sdb.line_no = 1;				/* assume top of page */
	sdb.aligned = "0"b;				/* but, that paper is not aligned */
						/* we can't assume that "to_stream" is attached yet, but */
	call ios_$changemode (sdb.device_name, "edited", "", status); /* set edited mode if possible */

attrtn:	if mode ^= "" then
	     call ios_$changemode (sdb.device_name, mode, "", status);
						/* if mode is specified then establish it */
	call set_line_length;			/* get ll from device or take default */
	status = "0"b;				/* all is well even if other stream not there */
	st.end = "1"b;				/* indicate stream at "end of file" */
	return;					/* and return to caller */

atterr:	st.code = code;				/* here on error, return status code to caller */
	st.det = "1"b;				/* indicate stream not attached */
	return;
						/*  */
form_write: entry (sdb_ptr, wp, offset, ne, net, status);	/* entry to write  */

dcl  wp ptr,					/* pointer to base of user's workspace */
     offset fixed bin,				/* character offset from wp */
     ne fixed bin,					/* number of elements (characters) to write (or read) */
     net fixed bin;					/* number of elements actually written (or read) */

dcl  source char (512) based (wp);			/* input buffer */

dcl  next_char fixed bin,				/* index of next unprocessed char from user */
     last_char fixed bin,				/* index of the last char to write */
     write_flag bit (1),				/* flag to write after nl unless space gets tight */
     out_pos fixed bin,				/* index of next available slot in out_buf */
     out_buf char (640);				/* output buffer built from user's workspace */

dcl  fold char (3) int static init ("
\*");						/* line folding char sequence nl||\||* */


	sdb_p = sdb_ptr;				/* get pointer to entry for this attachment */
	status = "0"b;				/* initialize status code to zero */
	sp = addr (status);				/* get pointer to status code argument */
	if ne = 0 then go to wrtn;			/* skip to return if nothing to write */
	net = 0;					/* initialize elements-written to zero */
	next_char = offset + 1;			/* index of first char to write */
	last_char = offset + ne;			/* index of last char to write */

outer_loop: do while (next_char <= last_char);		/* write all chars requested */

	     out_pos = 1;				/* start a new output string */
	     write_flag = "0"b;			/* indicate that we want to buffer */

inner_loop:    do while (^write_flag & (next_char <= last_char) & (out_pos < 638)); /* write in small blocks */
		onechar = substr (source, next_char, 1); /* get next input character */
		if onechar < space then do;		/* check for ctl char */

		     if onechar = nl then do;		/* it was a new line */
			substr (out_buf, out_pos, 1) = nl; /* put out and count */
			out_pos = out_pos + 1;	/* update output index */
			sdb.carg_pos = 1;		/* carriage now in column 1 */
			sdb.line_no = sdb.line_no + 1; /* count the line position on the form */
			if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */
			write_flag = "1"b;		/* if buffer full we will write */
		     end;

		     else if onechar = ff then do;	/* it was a form feed */
			if sdb.aligned then do;	/* if alignment set, go to top */
			     if ^((sdb.line_no = 1) & (sdb.carg_pos = 1)) then do; /* are we there? */
				do i = 1 to (sdb.page_size - sdb.line_no + 1); /* put out enough new lines */
				     substr (out_buf, out_pos, 1) = nl;
				     out_pos = out_pos + 1;
				end;
				sdb.carg_pos = 1;	/* carriage position is now 1 */
				sdb.line_no = 1;	/* now at top */
				write_flag = "1"b;	/* we can write if needed */
			     end;
			end;
			else do;
			     substr (out_buf, out_pos, 1) = ff; /* put it out when not aligned */
			     out_pos = out_pos + 1;
			end;
		     end;

		     else if onechar = VT then do;	/* it was a vertical tab */
			if sdb.aligned then do;	/* if alignment is set we simulate */
			     k = 10 - mod (sdb.line_no + 9, 10); /* how far to 1, 11, 21, 31, ... */
			     if sdb.line_no + k > sdb.page_size then /* but don't overflow a page */
				k = sdb.page_size - sdb.line_no + 1; /* go to top of form */

			     do i = 1 to k;

				substr (out_buf, out_pos, 1) = nl; /* write out "k" new lines */
				out_pos = out_pos + 1;

			     end;

			     sdb.carg_pos = 1;	/* back to column 1 */
			     sdb.line_no = sdb.line_no + k; /* update the line count */
			     if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* we didn't go past line 1 */
			     write_flag = "1"b;	/* this is a good time to write */

			end;
			else do;			/* not aligned, just put it out */

			     substr (out_buf, out_pos, 1) = VT;
			     out_pos = out_pos + 1;

			end;
		     end;

		     else if onechar = ht then do;	/* it was a tab */
			i = mod (sdb.carg_pos, 10);	/* locate position in tab field */
			if i = 0 then sdb.carg_pos = sdb.carg_pos + 1;
			else sdb.carg_pos = sdb.carg_pos + 11 - i; /* indicate new carriage position */
			if sdb.carg_pos <= sdb.line_length then do; /* check for end of carriage */
			     substr (out_buf, out_pos, 1) = ht; /* ok, put it out */
			     out_pos = out_pos + 1;
			end;
			else do;			/* must fold the line */
			     substr (out_buf, out_pos, 3) = fold; /* put in nl||\||c */
			     out_pos = out_pos + 3;
			     sdb.line_no = sdb.line_no + 1;
			     if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */
			     i = sdb.carg_pos - sdb.line_length - 1; /* how much overhang? */
			     if i > 0 then do;
				substr (out_buf, out_pos, i) = substr (spaces, 1, i); /* pad out */
				out_pos = out_pos + i;
			     end;
			     sdb.carg_pos = 3 + i;
			     write_flag = "1"b;	/* write if buffer full */
			end;
		     end;

		     else if onechar = bs then do;	/* it was a back space */
			substr (out_buf, out_pos, 1) = bs; /* put it out */
			out_pos = out_pos + 1;
			sdb.carg_pos = sdb.carg_pos - 1; /* back up the carriage position */
		     end;

		     else if onechar = bel then do;	/* it was a bel char, thats OK. */
			substr (out_buf, out_pos, 1) = bel;
			out_pos = out_pos + 1;	/* this will not move the carriage */
		     end;

/* 			otherwise drop the character */

		     next_char = next_char + 1;	/* either way, get ready for next char */

		end;

		else do;				/* printable char, so put it out */

		     substr (out_buf, out_pos, 1) = onechar;
		     out_pos = out_pos + 1;
		     sdb.carg_pos = sdb.carg_pos + 1;
		     next_char = next_char + 1;	/* move the source index */
		     if next_char <= last_char then	/* is the next char legal? */
			if sdb.carg_pos > sdb.line_length then do; /* may need to fold */
			     if substr (source, next_char, 1) ^= nl then do; /* fold if next char not nl */
				substr (out_buf, out_pos, 3) = fold; /* insert fold sequence */
				out_pos = out_pos + 3;
				sdb.carg_pos = 3;
				write_flag = "1"b;
				sdb.line_no = sdb.line_no + 1;
				if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* at the top */
			     end;

			     else do;		/* just put in new line */
				substr (out_buf, out_pos, 1) = nl;
				out_pos = out_pos + 1;
				sdb.line_no = sdb.line_no + 1;
				if sdb.line_no > sdb.page_size then sdb.line_no = 1;
				sdb.carg_pos = 1;
				next_char = next_char + 1; /* already checked it */
				write_flag = "1"b;
			     end;
			end;
		end;

		if out_pos < 512 then write_flag = "0"b; /* then write after nl if 512 chars buffered */

	     end;					/* end of inner do while loop */
	     call ios_$write (sdb.device_name, addr (out_buf), 0, out_pos - 1, i, status);
	     if st.code ^= 0 then do;			/* on error, throw it back to caller */
		net = i;				/* tell him how many written */
		return;
	     end;

	end outer_loop;
wrtn:	st.end = "1"b;				/* indicate stream at "end-of-file" */
	st.comp = "1110"b;				/* return I/O completion indicators */
	net = ne;					/* indicate that all elements were transferred */
	return;

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

form_read: entry (sdb_ptr, wp, offset, ne, net, status);	/* entry to read from attachment */

	sdb_p = sdb_ptr;				/* get pointer to entry for this attachment */
	status = "0"b;				/* initialize status code to zero */

	call ios_$read (sdb.device_name, wp, offset, ne, net, status); /* pass it on */
	if substr (source, offset + net, 1) = nl then do; /* adjust for manual nl's */
	     sdb.line_no = sdb.line_no + 1;		/* increment the line count */
	     if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of page? */
	     sdb.carg_pos = 1;			/* he had to give a nl char */
	end;

	return;					/* and return control to caller */

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

form_resetread: entry (sdb_ptr, stat2);			/* entry to reset read-ahead data */

dcl  stat2 bit (72) aligned;				/* I/O system status code (returned) */

	sdb_p = sdb_ptr;
	sdb.aligned = "0"b;				/* form alignment is gone */

	call ios_$resetread (sdb.device_name, stat2);	/* pass it along */

	return;

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

form_resetwrite: entry (sdb_ptr, stat2);		/* entry to reset write-behind buffers */

	sdb_p = sdb_ptr;
	sdb.aligned = "0"b;				/* form alignment is gone */

	call ios_$resetwrite (sdb.device_name, stat2);	/* pass it along for now */

	return;

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

form_abort: entry (sdb_ptr, stat2, stat3);		/* entry to reset read, write and quit condition */

dcl  stat3 bit (72) aligned;				/* I/O system status code (returned) */

	sdb_p = sdb_ptr;				/* get pointer to entry for this attachment */
	sdb.aligned = "0"b;				/* form alignment is gone */

	call ios_$abort (sdb.device_name, stat2, stat3);	/* call other DIM to do the work */

	return;					/* and return */

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

form_order: entry (sdb_ptr, request, argptr, stat4);	/* entry to issue attachment orders */

dcl  request char (*),				/* symbol attachment request order code */
     argptr ptr,					/* pointer to additional arguments (if any) */
     stat4 bit (72) aligned;				/* I/O system status code (returned) */

dcl 1 form aligned based (argptr),			/* structure for reading form data */
    2 page_size fixed bin,
    2 line_length fixed bin,
    2 line_no fixed bin,
    2 carg_pos fixed bin,
    2 aligned bit (1) unal,
    2 pad bit (35) unal;

dcl  error_table_$undefined_order_request fixed bin (35) ext static;

dcl 1 modes based (argptr),
    2 len fixed bin,
    2 string char (len);

dcl  argnum fixed bin based (argptr);

	on any_other go to order_err;			/* in case some fool gives a bad argptr */
	sdb_p = sdb_ptr;				/* get pointer to entry for this attachment */
	stat4 = "0"b;				/* initialize status code to zero */
	sp = addr (stat4);				/* get pointer to status code argument */

	if request = "page_length" then do;
	     if (argnum > 5) & (argnum < 133) then	/* a "page" may be from 6 to 132 lines long */
		sdb.page_size = argnum;		/* if in range save it */
	     else st.code = error_table_$undefined_order_request; /* out of range */
	     return;				/* we handled it, don't pass it along */
	end;

	else if request = "form_aligned" then do;	/* get ready to simulate form feeds */
	     sdb.aligned = "1"b;
	     sdb.line_no = 1;
	     sdb.carg_pos = 1;
	     return;
	end;

	else if request = "form_status" then do;	/* give back everything..in case */
	     form.page_size = sdb.page_size;
	     form.line_length = sdb.line_length;
	     form.line_no = sdb.line_no;
	     form.carg_pos = sdb.carg_pos;
	     form.aligned = sdb.aligned;
	     return;
	end;

passon:	call ios_$order (sdb.device_name, request, argptr, stat4); /* pass order call to other DIM */

	call set_line_length;			/* the "modes" order could change ll */

	return;					/* and return to caller */

order_err: st.code = error_table_$undefined_order_request;
	return;


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

form_changemode: entry (sdb_ptr, mode, omode, stat4);	/* entry to modify the attachment mode */

dcl  omode char (*);				/* returned mode prior to this call */

	sdb_p = sdb_ptr;				/* get pointer to SDB for this attachment */
	stat4 = "0"b;				/* initialize status to OK */
	sp = addr (stat4);				/* pick up pointer to status argument */
	call ios_$changemode (sdb.device_name, mode, omode, stat4); /* call other DIM to change modes */

	call set_line_length;			/* see if there is a new line length */

	return;


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

form_getsize: entry (sdb_ptr, size, stat3);		/* entry to return current element size */

dcl  size fixed bin;				/* current element size (returned) */

	size = 9;					/* element size for consoles is always 9 */
	stat3 = "0"b;
	return;					/* so return the constant 9 to the caller */

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

form_detach: entry (sdb_ptr, ch2, disposal, stat4);	/* entry to detach one input stream */

dcl (ch2, disposal) char (*);				/* these arguments ignored in this implementation */

	sdb_p = sdb_ptr;				/* get pointer to entry for this attachment */
	stat4 = "0"b;				/* initialize status code to zero */
	sp = addr (stat4);				/* get pointer to status code argument */
	st.det = "1"b;				/* set code to detach this ioname */
	sdb.n_attached = sdb.n_attached - 1;		/* count one less source */
	if sdb.n_attached < 1 then sdb.active = "0"b;	/* indicate sdb list entry no longer in use */
	return;					/* and return */

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

/* ** internal procedure to set internal line length ** */

set_line_length: proc;

dcl  ec fixed bin (35);
dcl  v char (12) var;
dcl  k fixed bin;
dcl  status bit (72) aligned;
dcl  get_line_length_$stream entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var);

	     k = get_line_length_$stream (sdb.device_name, ec); /* see what ll is set on output stream */
	     if ec ^= 0 then do;			/* it must not be there, take default */
		sdb.line_length = 79;
		return;
	     end;
	     if k < 11 | k > 132 then do;		/* must be a mistake, keep current value */
		v = convert_binary_integer_$decimal_string (sdb.line_length);
		v = "ll" || v;			/* make a mode string out of it */

		call ios_$changemode (sdb.device_name, (v), "", status); /* this is the best we can do */
		return;
	     end;

	     sdb.line_length = k;			/* record the new line length so we are in sync */

	     return;

	end set_line_length;

     end form_dim_;




		    io_daemon_account_.pl1          10/28/88  1403.5rew 10/28/88  1248.2       98334



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

/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199):
     Ancient History
     Modified in March 1975 by J. C. Whitmore for driver restructure
     Modified June 1976 by J. L. Homan to charge by line count instead of block count.
     Modified Sept. 1977 by J. C. Whitmore to pass ordatap to user accounting proc (MCR 2934)
     Modified by J. C. Whitmore, 5/78, to use new per rqt per queue price names
     Modified by J. C. Whitmore, 8/78, to separate the charge queue from the request queue
     Modified Feb 1980 by M. B. Armstrong to implement multiple rate structures. (UNCA)
     Modified by R. McDonald May 1980 to include page charges. (UNCA)
     Modified by E. N. Kittlitz June 1981 for UNCA page charges
     Modified by E. N. Kittlitz January 1982 to change null accounting pointer to
      indicate accounting: nothing; and use a valid pointer for accounting: system;
     Modified by C. Marker February 23, 1985 to use version 5 message segments
  2) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-18,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.  Changed to use entry variable to
     accounting routine, not pointer.
                                                   END HISTORY COMMENTS */

/* format: style4 */

io_daemon_account_: proc (account_entry, argp);

/* Accounting routine for I/O daemon, which will put appropriate a values in a
   dummy pdt entry and call the routine pointed to by account_entry.
*/

/* Parameters */

dcl  account_entry entry (char (*), char (*), ptr, fixed bin (35)) variable; /* entry variable to accounting routine */
dcl  argp ptr;

/* External Procedures & Variables */

dcl  continue_to_signal_ entry (fixed bin (35));
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$noentry fixed bin (35) ext static;
dcl  hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
dcl  iodd_msg_ entry options (variable);
dcl  iodd_stat_p ptr ext;				/* an easy way to get the value for stat_p */
dcl  search_sat_$rs_number entry (char (*), fixed bin, fixed bin (35));
dcl  system_info_$io_prices_rs entry (fixed bin, (4) float bin);
dcl  system_info_$max_rs_number entry (fixed bin);
dcl  system_info_$resource_price_rs entry (fixed bin, char (*) aligned, float bin, fixed bin (35));

dcl  (addr, before, after, null, hbound, unspec) builtin;

dcl  (any_other, cleanup) condition;

/* Internal Static */

dcl  both fixed bin int static options (constant) init (0);
dcl  default_prices (0:9, 4) float bin aligned int static;	/* one set for each rate structure for efficiency */
dcl  error fixed bin int static options (constant) init (2);
dcl  max_rs_number fixed bin static init (0);
dcl  not_initialized bit (1) aligned int static init ("1"b);
dcl  whoami char (32) int static options (constant) init ("io_daemon_account_");

dcl  1 lines_price (0:9) aligned int static,		/* ditto */
       2 driver (30),
         3 q (4) float bin;

dcl  1 pages_price (0:9) aligned int static,		/* one set for each rate structure for effieiency  */
       2 driver (30),
         3 q (4) float bin;

/* Automatic */

dcl  code fixed bin (35);
dcl  driver_index fixed bin;				/* index of logical driver in driver_ptr_list */
dcl  (i, j) fixed bin;
dcl  old_mask bit (36) aligned;
dcl  pdtp ptr;					/* this is just to make this thing compile */
dcl  pdtep ptr;
dcl  pers char (32);
dcl  proj char (12);
dcl  q fixed bin;
dcl  rs_number fixed bin;				/* rate structure number */

dcl  1 dummy aligned like user;			/* place to hold template user PDT entry */
%page;
	stat_p = iodd_stat_p;			/* just to be sure */
	pdtp = null;				/* makes compiler happy */

	if not_initialized then do;
	     call system_info_$max_rs_number (max_rs_number);
	     do j = 0 to hbound (lines_price, 1);	/* this should never be necessary any more */
		if j > max_rs_number then
		     rs_number = 0;
		else rs_number = j;
		call system_info_$io_prices_rs (rs_number, default_prices (j, *));
		do i = 1 to hbound (lines_price.driver, 2); /* set all lines prices to the default */
		     lines_price (j).driver (i).q (*) = default_prices (j, *);
		end;
	     end;
	     call iodd_msg_ (error, both, 0, whoami, "Initialization error.  Using io_prices rather than resource_prices.");
	     not_initialized = "0"b;
	end;

	ordatap = argp;
	ordata.charge = 0e0;			/* show no charge in case of error */
	q = ordata.charge_queue;			/* the driver_index and q define the price */
	driver_index = iodd_static.driver_ptr -> driver_status.list_index; /* see which driver this is */
	if driver_index < 1 | driver_index > iodd_static.assigned_devices then do; /* got clobbered? */
	     iodd_static.master_hold = "1"b;		/* force command level */
	     call iodd_msg_ (error, both, 0, whoami, "Invalid driver index. Check with administrator before continuing.");
	     return;
	end;

/* mask interrupts, and set default handler to unmask them */

	old_mask = ""b;				/* initialize the old mask to null */
	on any_other call unmask;
	on cleanup call unmask;
	call hcs_$set_ips_mask (""b, old_mask);		/* save the old mask and restore it later */

	pers = before (ordata.requestor, ".");		/* get person and project we will charge */
	proj = before (after (ordata.requestor, "."), ".");
	if pers = "anonymous" then pers = "*";		/* special case the anonymous user name */


	ordata.rs_unavailable, ordata.no_accounting = "0"b;
	if max_rs_number = 0 then
	     rs_number = 0;
	else do;
	     call search_sat_$rs_number ((proj), rs_number, code); /* get rate index */
	     if code ^= 0 then do;
		if code = error_table_$noentry then
		     call iodd_msg_ (error, both, code, whoami,
			"Trying to locate project ""^a"".  Default rates will be used.", proj);
		else call iodd_msg_ (error, both, code, whoami, "Accessing the sat.  Default rates will be used");
		rs_number = 0;
		ordata.rs_unavailable = "1"b;		/* remember that we faked this */
	     end;
	end;
	ordata.price_per_n_lines = lines_price (rs_number).driver (driver_index).q (q); /* how we computed the charge */
	ordata.rs_number = rs_number;			/* remember which rate_structure */
	ordata.n_lines_for_price = 1000;
	ordata.price_per_n_pages = pages_price (rs_number).driver (driver_index).q (q); /* how we conputed the charge */
	ordata.n_pages_for_price = 1000;

	ordata.charge = ordata.price_per_n_lines * ordata.line_count / ordata.n_lines_for_price;
	ordata.charge = ordata.charge + ordata.price_per_n_pages * ordata.page_count / ordata.n_pages_for_price;

/* put values in pdt template entry for updating */

	unspec (dummy) = ""b;			/* be sure there is no garbage */
	pdtep = addr (dummy);
	q = ordata.queue;				/* this is the queue request came from */
	user.iod (q).charge,
	     user.dollar_charge,
	     user.absolute_spent = ordata.charge;

	user.iod (q).pieces = 1;
	user.iod (q).lines = ordata.line_count;
	user.iod (q).pages = ordata.page_count;

	code = 0;					/* set to zero in case user proc just returns */

	call account_entry (pers, proj, pdtep, code);

	call unmask;				/* now we can allow ips signals */
	if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "From accounting for ^a.^a", pers, proj);
	return;

set_line_prices: entry (a_driver_index, qgtep, a_code);

dcl  a_code fixed bin (35);				/* error code */
dcl  a_driver_index fixed bin;

	a_code = 0;
	driver_index = a_driver_index;		/* copy the index */
	if driver_index < 0 | driver_index > hbound (lines_price.driver, 2) then do; /* out of range ? */
	     a_code = error_table_$action_not_performed;
	     return;
	end;

	if not_initialized | driver_index = 0 then do;
	     call system_info_$max_rs_number (max_rs_number);
	     stat_p = iodd_stat_p;			/* set this only once, we hope */
	     do j = 0 to hbound (lines_price, 1);
		if j > max_rs_number then rs_number = 0;/* use the default */
		else rs_number = j;
		call system_info_$io_prices_rs (rs_number, default_prices (j, *));
		do i = 1 to hbound (lines_price.driver, 2); /* set all lines prices to the default */
		     lines_price (j).driver (i).q (*) = default_prices (j, *);
		end;
	     end;
	     not_initialized = "0"b;
	     if driver_index = 0 then return;		/* don't assume index is good further on */
	end;

	lines_price (*).driver (driver_index).q (*) = 0.0e0; /* clear old prices */
	if qgtep = null | qgte.line_charge.queue (1) = ""
	then do rs_number = 0 to hbound (lines_price, 1); /* use default prices if there are no names */
	     lines_price (rs_number).driver (driver_index).q (*) = default_prices (rs_number, *);
	end;
	else do i = 1 to qgte.max_queues;		/* get the price for each possible queue */
	     do j = 0 to hbound (lines_price, 1);	/* all rates */
		if j > max_rs_number then rs_number = 0;/* use the default */
		else rs_number = j;
		call system_info_$resource_price_rs (rs_number, qgte.line_charge.queue (i),
		     lines_price (j).driver (driver_index).q (i), a_code);
		if a_code ^= 0 then return;
	     end;
	end;


	pages_price (*).driver (driver_index).q (*) = 0.0e0; /* clear old prices  */
	if qgtep = null | qgte.page_charge.queue (1) = "" then ; /*  uses zero default prices if there are no names  */
	else do i = 1 to qgte.max_queues;		/* get the price for each possible queue  */
	     do j = 0 to hbound (pages_price, 1);	/* all rates  */
		if j > max_rs_number then rs_number = 0;/* use the default */
		else rs_number = j;
		call system_info_$resource_price_rs (rs_number, qgte.page_charge.queue (i),
		     pages_price (j).driver (driver_index).q (i), a_code);
		if a_code ^= 0 then return;
	     end;
	end;

	return;


unmask: proc;

	if old_mask then do;			/* if the old mask had some bits on, restore it */
	     call hcs_$set_ips_mask (old_mask, (""b));
	     old_mask = ""b;
	end;

	call continue_to_signal_ ((0));		/* in case this was from a handler */

	return;

     end unmask;
%page; %include driver_status;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include mseg_message_info;
%page; %include output_request_data;
%page; %include pdt;
%page; %include q_group_tab;
%page; %include request_descriptor;
%page; %include user_attributes;

     end io_daemon_account_;




		    iod_command.pl1                 11/15/82  1835.7rew 11/15/82  1507.9       41553



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


/* Constructs a command line for execution by the I/O daemon command processor:  This Multics command is intended for use
   within I/O daemon extended commands (exec_coms) when it is necessary to issue actual I/O daemon commands.  For example,

      iod_command defer_time pica_10 30

   sets the automatic defer time for the "pica_10" minor device to 30 minutes */

/* Note: The "go" command may not be issued using this interface */

/* Created:  27 September 1981 by G. Palter */


iod_command:
     procedure () options (variable);


dcl  argument character (argument_lth) unaligned based (argument_ptr);
dcl  argument_lth fixed binary (21);
dcl  argument_ptr pointer;

dcl  system_area area based (system_area_ptr);
dcl  system_area_ptr pointer;

dcl  local_buffer character (512);

dcl  buffer character (buffer_lth) based (buffer_ptr);
dcl  buffer_lth fixed binary (21);
dcl  buffer_ptr pointer;

dcl  command_line character (command_line_lth) based (buffer_ptr);
dcl  command_line_lth fixed binary (21);

dcl  new_buffer character (new_buffer_lth) based (new_buffer_ptr);
dcl  new_buffer_lth fixed binary (21);
dcl  new_buffer_ptr pointer;

dcl (n_arguments, idx) fixed binary;

dcl  code fixed binary (35);

dcl  IOD_COMMAND character (32) static options (constant) initial ("iod_command");

dcl (MASTER		initial (1),		/* command line from the master console ... */
     RECURSIVE_COMMAND_LEVEL	initial (2))		/* ... being executed from within another command */
	fixed binary static options (constant);

dcl (com_err_, com_err_$suppress_name) entry () options (variable);
dcl  cu_$arg_count entry (fixed binary, fixed binary (35));
dcl  cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35));
dcl  get_system_free_area_ entry () returns (pointer);
dcl  iodd_command_processor_ entry (fixed binary, fixed binary, character (*), fixed binary (35));

dcl  cleanup condition;

dcl (addr, length, max, substr) builtin;

/*  */

/* iod_command: entry () options (variable); */

	call cu_$arg_count (n_arguments, code);
	     if code ^= 0 then do;			/* not called as a command */
		call com_err_ (code, IOD_COMMAND);
		return;
	     end;

	if n_arguments = 0 then do;
	     call com_err_$suppress_name (0, IOD_COMMAND, "Usage: ^a command_line", IOD_COMMAND);
	     return;
	end;

	command_line_lth = 0;

	buffer_ptr = addr (local_buffer);
	buffer_lth = length (local_buffer);

	system_area_ptr = get_system_free_area_ ();

	on condition (cleanup)
	     begin;
		if buffer_ptr ^= addr (local_buffer) then
		     free buffer in (system_area);
	     end;


/* Construct the command line: for consistency with other commands that take command lines as unquoted arguments, the
   individual words of the command line are not requoted */

	do idx = 1 to n_arguments;

	     call cu_$arg_ptr (idx, argument_ptr, argument_lth, code);
		if code ^= 0 then do;
		     call com_err_ (code, IOD_COMMAND, "Fetching argument #^d.", idx);
		     go to RETURN_FROM_IOD_COMMAND;
		end;

	     if (command_line_lth + argument_lth + 1) > buffer_lth
	     then do;				/* need to expand the buffer being constructed */
		new_buffer_lth = max ((buffer_lth + 512), (command_line_lth + argument_lth + 128));
		allocate new_buffer in (system_area) set (new_buffer_ptr);
		new_buffer = buffer;		/* copy what we have so far ... */
		if buffer_ptr ^= addr (local_buffer) then    /* current buffer was allocated */
		     free buffer in (system_area);
		buffer_ptr = new_buffer_ptr;		/* switch to new buffer */
		buffer_lth = new_buffer_lth;
	     end;

	     substr (buffer, (command_line_lth+1), (argument_lth+1)) = argument;

	     command_line_lth = command_line_lth + argument_lth + 1;
	end;

	command_line_lth = command_line_lth - 1;	/* added an extra trailing space */


/* Pass the command on for execution: let the I/O daemon environment handle all errors */

	call iodd_command_processor_ (MASTER, RECURSIVE_COMMAND_LEVEL, command_line, (0));


/* Clean up */

RETURN_FROM_IOD_COMMAND:
	if buffer_ptr ^= addr (local_buffer) then
	     free buffer in (system_area);

	return;

     end iod_command;




		    iodd_.pl1                       11/14/88  1105.6rew 11/14/88  1100.1      830529



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

/* format: style4 */

/* format: off */

iodd_: proc;

/* This is not the main entry point.  It is used to set the entry variable for
   the driver module default handler if that entry was not defined.  We have
   to be able to call something! */

	return;


iodd_init: entry (system_dir, testing);

/* This is the initialization procedure for all IO Daemon drivers.  It is
   called with two arguments: system_dir which defines the directory which
   will contain the common IO Daemon data bases; and testing, which indicates
   that the driver is being run in test mode.  This procedure determines from
   the site operator which device is to be used, establishes communication
   with the IO Coordinator, attaches the device control terminal if needed,
   and transfers to the driver control procedure specified in the iod_tables
   source file.

   The design was adapted from the original IO Daemon driver designed by
   Robert S. Coren in September 1973.  This design is provided to make the
   IO Daemon compatible with the Access Isolation Mechanism.

   Coded in January 1975 by J. C. Whitmore.

   Modified in November 1975 by M. A. Braida
   to initialize data for seg_fault_error check.   */
/* Modified Nov 1977 by J. C. Whitmore for new iodd_static data, initiation of rqti segs, and condition handling */
/* Modified Mar 1978 by J. C. Whitmore for upgrade and addition of per RQT accounting and rqti seg from iod_tables */
/* Modified by J. C. Whitmore, 7/78, to setup for new driver -> coord command strategy & "x" cmd */
/* Modified by J. C. Whitmore, 10/78, to extend number of RJE stations (version 3 iod_tables format) */
/* Modified by J. C. Whitmore, 11/78, to start using driver version numbers starting at 5.0 (5 major changes since MR 6.0) */
/* Modified by J. C. Whitmore, 3/79 (V-5.1),  for minor message and logic bug fixes */
/* Modified by J. C. Whitmore, 5/79 (V-5.2), to retry listen attachment 5 times before aborting */
/* Modified by C. Hornig, 8/79 (V-5.3), for multiple minor devices of the same generic type */
/* Modified by J. C. Whitmore, 10/79 (V-5.4), for daemon_idle default condition handler */
/* Modified by E. N. Kittlitz, 6/81 (V-5.5), for UNCA rate structures */
/* Modified:  November 1981 by G. Palter, V-5.6, to use read_password_ to get the station password if it is omitted from
   the station command, to not consider inability to set hangup_proc as fatal, to call head_sheet_$test when in a test
   environment, FILL IN THE BLANK, and fix the following bugs 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 January 1982 by E. N. Kittlitz (V-5.7) for accounting change.
      accounting:nothing; in the IODT will really do nothing in io_daemon_account_. */
/* Modified January 1983 by C. Marker  Added probe as a legal command in test mode. */
/* Modified 1984-08-17 by E. Swenson for Version 2 PNTs. */
/* Modified February 23, 1985 by C. Marker to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(85-02-14,Homan), approve(87-04-06,MCR7656),
     audit(87-06-13,Beattie), install(87-08-06,MR12.1-1068):
     Add support for logout_on_hangup.
  2) change(88-02-18,Brunelle), approve(88-06-02,MCR7911),
     audit(88-10-19,Wallman), install(88-11-08,MR12.2-1199):
     Upgraded to version 5 iod tables.  Add support for head/tail_sheet entry
     variables and paper_type variable.  Remove calls to head_sheet_$init &
     tail_sheet_$init.
  3) change(88-11-03,Brunelle), approve(88-11-03,MCR7911),
     audit(88-11-03,Wallman), install(88-11-08,MR12.2-1199):
     Corrected a pass-by-value problem which was causing control terminal i/o
     to go to the message coordinator.
  4) change(88-11-11,Brunelle), approve(88-11-03,PBF7911),
     audit(88-11-14,Wallman), install(88-11-14,MR12.2-1212):
     Add a 10 second wait in all non-IOM configurations to allow the
     answering service at both ends of the communications line to handle
     all the traffic generated when a re_init is signalled.
                                                   END HISTORY COMMENTS */


/* format: on */
%page;
/* ----------- ARGUMENTS ------------- */

dcl  system_dir char (*),				/* directory containing common data bases */
     testing bit (1) aligned;				/* test mode indicator */


/* --------EXTERNAL ENTRIES---------- */

dcl  aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  charge_user_ entry (char (*), char (*), ptr, fixed bin (35));
dcl  convert_dial_message_
	entry (fixed bin (71), char (*) aligned, char (*) aligned, fixed bin, 1 aligned like status_flags,
	fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry);
dcl  debug entry options (variable);
dcl  dial_manager_$allow_dials entry (ptr, fixed bin (35));
dcl  dial_manager_$privileged_attach entry (ptr, fixed bin (35));
dcl  dial_manager_$release_channel entry (ptr, fixed bin (35));
dcl  get_at_entry_ entry (char (*), char (*) aligned, char (*) aligned, char (*)) returns (fixed bin (35));
dcl  get_group_id_ entry () returns (char (32));
dcl  get_group_id_$tag_star entry () returns (char (32));
dcl  get_process_id_ entry () returns (bit (36));
dcl  get_authorization_ entry () returns (bit (72) aligned);
dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35));
dcl  hcs_$terminate_name entry (char (*), fixed bin (35));
dcl  hcs_$terminate_file entry (char (*), char (*) aligned, fixed bin (1), fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  hcs_$tty_index entry (char (*) aligned, fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  head_sheet_$print_head_sheet entry (ptr, ptr, ptr, fixed bin (35));
dcl  head_sheet_$print_separator entry (ptr, ptr, char (*), fixed bin (35));
dcl  head_sheet_$test entry (char (*));
dcl  ioa_$ioa_stream entry () options (variable);
dcl  ioa_$rsnnl entry () options (variable);
dcl  io_daemon_account_$set_line_prices entry (fixed bin, ptr, fixed bin (35));
dcl  iodd_command_processor_$init entry (ptr);
dcl  iodd_hangup_$iodd_hangup_ entry (ptr);
dcl  iodd_msg_ entry options (variable);
dcl  iodd_quit_handler_$init entry (ptr);
dcl  iodd_signal_handler_ entry;
dcl  iodd_signal_handler_$init entry (ptr);
dcl  ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
dcl  ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned);
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35));
dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35));
dcl  logout entry () options (variable);
dcl  message_segment_$add_file entry (char (*), char (*), ptr, fixed bin, bit (72) aligned, fixed bin (35));
dcl  iodd_parse_$command entry (char (*), ptr, fixed bin (35));
dcl  probe entry options (variable);
dcl  print_devices entry options (variable);		/* command for data in iod tables */
dcl  print_line_ids entry options (variable);		/*	"	"	*/
dcl  read_password_$switch entry (ptr, ptr, char (*), char (*), fixed bin (35));
dcl  scramble_ entry (char (8)) returns (char (8));
dcl  set_iod_val entry options (variable);
dcl  set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  tail_sheet_$print_tail_sheet entry (ptr, ptr, ptr, fixed bin (35));
dcl  timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry);
dcl  timer_manager_$reset_alarm_call entry (entry);
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));
dcl  validate_card_input_$station entry (char (*), char (*), char (*), fixed bin (35));
dcl  write_control_form_$init entry (ptr);


/* --------- AUTOMATIC ----------- */

dcl  code fixed bin (35);
dcl  dev_label char (32);
dcl  dev_class char (32);
dcl  queue_type char (32);				/* queue_type when we need to look for it */
dcl  request_type char (64);
dcl  table_time fixed bin (71);
dcl  first_arg char (32);
dcl  second_arg char (64);
dcl  dev_name char (32) aligned;
dcl  dim_name char (32) aligned;
dcl  (i, j) fixed bin;				/* index variables */
dcl  ig char (4);					/* dummy for get_at_entry_ call */
dcl  io_stat bit (72) aligned;
dcl  line char (120);
dcl  nchars fixed bin (21);
dcl  init_ev_chan fixed bin (71);
dcl  iodc_data_ptr ptr;
dcl  seg_name char (32);				/* temp for segment initialization */
dcl  question char (64);				/* question to ask operator */
dcl  use_default bit (1);				/* switch indicating that default device classes are used */
dcl  msgp ptr;					/* pointer to the event message */
dcl  message_id bit (72) aligned;			/* id if a message segment message */
dcl  driver_dir char (168);				/* path of driver major device directory */
dcl  rqt_name char (32);
dcl  rqt_string char (168) var;
dcl  rqti_dir char (168);				/* path of dir with rqti segs */
dcl  sys_dir char (168);				/* local copy of system directory path */
dcl  meter_dir char (168);				/* path of meter data segs directory */
dcl  entry_name char (32);				/* accounting proc entry point name */
dcl  entry_variable entry variable options (variable);
dcl  times fixed bin;				/* number of times the driver tries to find cord */
dcl  temp_dir char (168) varying;
dcl  temp_dir_entry char (256);
dcl  temp_password char (8);				/* temporary for password manipulation */
dcl  temp_ptr ptr;					/* random temporary pointer variable */
dcl  input_iocbp ptr;				/* iocb pointer for reading request type data */

dcl  1 st aligned based (addr (io_stat)),		/* breakout of an ios_ status code */
       2 code fixed bin (35) aligned,
       2 stat bit (36) aligned;

dcl  temp_label label variable;			/* for the fancy footwork needed to get a */
dcl  based_ptr ptr based;				/* referencing_dir pointer for the search rules */
dcl  ref_ptr ptr;
dcl  1 driver_message aligned like new_driver_msg;	/* allocate space for mseg message  structure */
%page;

/* ----------EXTERNAL STATIC ---------- */

dcl  iodd_stat_p ptr ext static;			/* external copy of stat_p */

dcl  error_table_$ionmat fixed bin (35) ext static;
dcl  error_table_$not_detached fixed bin (35) ext static;
dcl  error_table_$not_closed fixed bin (35) ext static;
dcl  error_table_$noentry fixed bin (35) ext static;
dcl  error_table_$ai_restricted fixed bin (35) ext static;
dcl  error_table_$user_not_found fixed bin (35) ext static;
dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$badopt fixed bin (35) ext static;
dcl  error_table_$no_ext_sym fixed bin (35) ext static;
dcl  error_table_$no_operation fixed bin (35) ext static;
dcl  error_table_$namedup fixed bin (35) ext static;


/* ----------- INTERNAL STATIC -------- */

dcl  io_daemon_driver_version char (8) int static options (constant) init ("5.7");
						/* current version of the driver */
dcl  null_stream char (32) int static init ("iodd_null_stream") options (constant);
dcl  bel_string char (40) aligned int static options (constant) init ((40)"");
dcl  stars char (50) aligned int static options (constant) init ((5)"**********");
dcl  error fixed bin int static options (constant) init (2);
dcl  normal fixed bin int static options (constant) init (1);
dcl  master fixed bin int static options (constant) init (1);
dcl  slave fixed bin int static options (constant) init (2);
dcl  both fixed bin int static options (constant) init (0);
dcl  id char (24) int static options (constant) init ("iodd_");
dcl  STATION_PW_PROMPT char (23) static options (constant) init ("Enter station password:");
dcl  try_10_times fixed bin int static options (constant) init (10);
dcl  try_0_times fixed bin int static options (constant) init (0);

dcl  1 real_iodd_static int static aligned like iodd_static;/* allocation of iodd_static */

dcl  NL char (1) int static options (constant) init ("
");

dcl  FF char (1) int static options (constant) init ("");

dcl  1 driver_list aligned int static,			/* this is where the driver_ptr_list is allocated */
       2 dummy (32) fixed bin (71);			/* be sure we reserve enough space for 30 drivers */


/* ----------- BUILTINS ------- */

dcl  (addr, after, before, bit, char, fixed, hbound, index, length, ltrim,
     null, ptr, rtrim, size, string, substr, unspec) builtin;
%page;

/* ---------- STRUCTURES & MISC INCLUDE FILES ---------- */

dcl  1 request_dev aligned,				/* major and minor devices to request from coord */
       2 major_name char (32),			/* name of the major device */
       2 major_index fixed bin,			/* device table index for it */
       2 n_minor fixed bin,				/* number of minor devices requested */
       2 minor (30) aligned,				/* save room for 30 minor devices */
         3 name char (32) unal,			/* minor device name...unal for the compiler */
         3 index fixed bin,				/* device table index for it */
         3 dev_class char (32),			/* expected dvc to be used */
         3 dvc_index fixed bin;			/* device class table index for the dvc */

dcl  1 event_info aligned,				/* ipc_ info from a wakeup */
       2 channel fixed bin (71),			/* event channel signaled */
       2 message fixed bin (71),			/* event message sent to us */
       2 sender bit (36),				/* sender's process id */
       2 origin,
         3 dev_signal bit (18) unal,			/* was this a process or device? */
         3 rings bit (18) unal,			/* what ring sent it? */
       2 wait_list_index fixed bin;			/* where was the channel in the wait list */

dcl  1 ev_chan_list aligned,				/* wait list for ipc_$block */
       2 number fixed bin,
       2 channel (32) fixed bin (71);

dcl  1 read_info aligned,				/* structure to be filled in by read_status order */
       2 ev_chan fixed bin (71),			/* event_channel the stream blocks on */
       2 input_pending bit (1);			/* 1 if the stream is waiting for us to read */

dcl  1 input aligned,				/* structure to hold arguments input by the operator */
       2 max fixed bin,				/* <the most tokens we ever expect */
       2 number fixed bin,				/* current number of tokens */
       2 arg (4) char (64) var;			/* text of each token */

dcl  1 status_flags aligned,				/* status structure for convert_dial_message_ */
       2 dialed_up bit (1) unal,			/* 1 = device has dialed the process */
       2 hung_up bit (1) unal,			/* 1 = device has hung up */
       2 control bit (1) unal,			/* 1 = accepted, rejected or number signal */
       2 stat_pad bit (33) unal;

dcl  1 release_arg aligned like dial_manager_arg;		/* for calls to dial_manager_$release_channel */
%page;

dcl  (quit, any_other, daemon_logout, daemon_slave_logout, program_interrupt, no_coord, seg_fault_error,
     daemon_new_device, command_error, alrm, daemon_idle) condition;
%page;

	stat_p = addr (real_iodd_static);		/* initialize the pointer used for all iodd_static references */
	sys_dir = system_dir;			/* copy the arguments */
	iodd_static.sys_dir_ptr = addr (sys_dir);	/* so we can publish the dir name */
	iodd_static.flags.test_entry = testing;
	iodd_stat_p = stat_p;			/* make it easier to create iodd procs */
	iodd_static.io_daemon_version = io_daemon_driver_version;
						/* publish the version number */
	rqti_dir = rtrim (sys_dir) || ">rqt_info_segs";	/* this is where we find rqti segs */
	meter_dir = rtrim (sys_dir) || ">meter_data";	/* this is where we find the meter data segs */
	list_ptr = addr (driver_list);
	driver_ptr_list.number = 0;
	iodd_static.auto_start_delay = 60;		/* ready for early quit, 60 sec for auto-start */
	iodd_static.timer_chan = 0;
	iodd_static.cmd_ack_chan = 0;

	iodd_static.re_init_label = re_init_driver;
	iodd_static.no_coord_label = no_coord_signal;

	call iodd_signal_handler_$init (stat_p);	/* initialize our general signal handler */

	on quit call early_quit;			/* setup some condition handlers */
	on daemon_logout go to driver_logout_label;
	on daemon_slave_logout go to driver_logout_label;
	on daemon_new_device go to start_new_device_cleanup;
						/* this is how we transfer back after new_device command */
	on daemon_idle
	     begin;
	end;					/* do nothing but grab the condition */
	on any_other call iodd_signal_handler_;		/* we don't want the standard default */
						/* handler to come to command level */

	call ios_$order ("user_i/o", "quit_enable", null (), io_stat); /* be sure quits are enabled */

	code = get_at_entry_ ("user_i/o", dim_name, dev_name, ig); /* this MUST work */

	if dim_name = "mrd_" then do;			/* separate the streams for message coord */
	     call ios_$attach ("error_i/o", "mrd_", dev_name, "", io_stat);
	     call ios_$attach ("log_i/o", "mrd_", dev_name, "", io_stat);
	end;
	else do;					/* use the same streams for consistency */
	     call ios_$attach ("error_i/o", "syn", "user_i/o", "", io_stat);
	     call ios_$attach ("log_i/o", "syn", "user_i/o", "", io_stat);
	end;

	call ios_$attach ("master_output", "syn", "user_i/o", "", io_stat);
	call ios_$attach ("master_input", "syn", "user_i/o", "", io_stat);
	call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
	call ios_$attach ("log_output", "syn", "log_i/o", "", io_stat);

	call iox_$look_iocb ("master_output", iodd_static.master_out, code);
	call iox_$look_iocb ("master_input", iodd_static.master_in, code);
	call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code);
	call iox_$look_iocb ("error_i/o", iodd_static.error_io, code);

	call iodd_msg_ (normal, master, 0, "", "^/IO Daemon Driver Version: ^a^[^/Driver running in test mode.^]^/",
	     iodd_static.io_daemon_version, iodd_static.test_entry);

	temp_label = out;				/* get a pointer to use with make_ptr for reference proc */
	ref_ptr = addr (temp_label) -> based_ptr;
%page;

	iodd_static.ctl_term.ctl_attach_name = "";	/* initialize ctl_term once here, then let */
	iodd_static.ctl_term.ctl_attach_type = 0;	/* it be handled dynamically */
	iodd_static.ctl_term.ctl_dial_chan = 0;
	iodd_static.ctl_term.ctl_ev_chan = 0;
	iodd_static.ctl_term.ctl_device = "";
	iodd_static.ctl_term.ctl_dev_dim = "";
	iodd_static.ctl_term.attached = "0"b;

new_device:					/* we come here after a new_device command (from the handler) */
	iodd_static.ctl_term.form_type = "undefined_form";/* use default unless operator changes */
	iodd_static.ctl_term.forms = "0"b;		/* don't simulate terminal FF unless asked */
	iodd_static.slave.active = "0"b;		/* be sure slave functions are dead */
	iodd_static.slave_ev_chan = 0;
	iodd_static.slave_in, iodd_static.slave_out = null;
	iodd_static.slave_input, iodd_static.slave_output = null_stream;
	iodd_static.slave.allow_quits = "0"b;
	iodd_static.slave.accept_input = "0"b;
	iodd_static.slave.print_errors = "0"b;
	iodd_static.slave.log_msg = "0"b;		/* must ask for log messages */
	iodd_static.slave.echo_cmd = "0"b;		/* no echoing of command lines */
	iodd_static.slave.priv1 = "0"b;		/* driver module defined privleges */
	iodd_static.slave.priv2 = "0"b;		/* " */
	iodd_static.slave.priv3 = "0"b;		/* " */
	iodd_static.re_init_in_progress = "0"b;		/* this is not a re_init */
	iodd_static.wakeup_time = 30;			/* default to 30 seconds between wakeups */
	iodd_static.recursion_flag = "0"b;		/* be sure these are off for testing */
	iodd_static.no_coord_flag = "0"b;
	iodd_static.initialized = "0"b;
	iodd_static.dummy_ptr = null;			/* in case it has been set */
	iodd_static.attach_type = 0;
	iodd_static.line_tab_idx = 0;
	iodd_static.major_device = "";

	if iodd_static.timer_chan ^= 0 then
	     call ipc_$delete_ev_chn (iodd_static.timer_chan, code);
	if iodd_static.cmd_ack_chan ^= 0 then
	     call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code);

	call ipc_$create_ev_chn (iodd_static.timer_chan, code); /* get an event channel for the timer */
	if code ^= 0 then do;			/* an error is very bad */
no_ipc:
	     call convert_ipc_code_ (code);
	     call iodd_msg_ (error, master, code, id, "Fatal error: Unable to create event channel.");
	     go to out;				/* not much else to do */
	end;

	call ipc_$create_ev_chn (iodd_static.cmd_ack_chan, code);
	if code ^= 0 then
	     go to no_ipc;

	call io_daemon_account_$set_line_prices (0, null, code); /* set up default prices */
%page;

/*	Get the device name and device class from the operator */

ask_for_dev:					/* for variable line, try new station */
	if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
	     go to get_tables;

	call iodd_msg_ (normal, master, 0, "", "Enter command or device/request_type:");
						/* ask for some input */
get_dev_id:
	call iox_$get_line (iodd_static.master_in, addr (line), 120, nchars, code);
	if code ^= 0 then do;
no_master:
	     call iodd_msg_ (error, master, code, id, "Fatal_error: Unable to read from master console.");
	     go to out;
	end;
	if nchars < 2 then
	     go to get_dev_id;			/* ignore null lines */

	input.max = 4;				/* most tokens allowed */
	call iodd_parse_$command (substr (line, 1, nchars), addr (input), code);
	if code ^= 0 then
	     if code = error_table_$noarg then
		go to get_dev_id;			/* line was all blank */
	     else do;
bad_line:
		call iodd_msg_ (normal, master, 0, "", "Invalid response.  Try again.");
		go to ask_for_dev;
	     end;
	if input.arg (1) = "quit" | input.arg (1) = "logout" then
	     go to out;				/* easy out */
	if input.arg (1) = "help" then do;
	     call iodd_msg_ (normal, master, 0, "", "Enter device name and optional request type, or any of:");
	     call iodd_msg_ (normal, master, 0, "", "logout, print_devices, listen <line_id>, print_line_ids");
	     go to ask_for_dev;
	end;
	if input.arg (1) = "print_line_ids" then do;
	     call print_line_ids ("-dir", rtrim (sys_dir));
	     go to ask_for_dev;
	end;
	if input.arg (1) = "print_devices" then do;	/* he forgot the device names */
	     call print_devices ("-dir", rtrim (sys_dir), "-an", before (get_group_id_$tag_star (), ".*"));
	     go to ask_for_dev;
	end;
	if length (input.arg (1)) > length (first_arg) then
	     go to bad_line;
	first_arg = input.arg (1);			/* save intact for reinit function */
	first_arg = before (first_arg, ".");		/* if major.minor, drop minor */
	if first_arg = "" then
	     go to bad_line;
	if input.number = 1 then			/* assume second arg is null if not given */
	     if first_arg = "listen" then
		go to bad_line;			/* requires an second arg */
	     else second_arg = "";
	else do;
	     if length (input.arg (2)) > length (second_arg) then
		go to bad_line;
	     second_arg = input.arg (2);		/* save the second_arg if not too big */
	end;

get_tables:

/* This label is put here so a reinit will work even if the working tables
   have changed.  Find the tables in iod_working_tables so we can validate the
   requested device and device class */

	seg_name = "iodc_data";			/* segment name for possible error msg */
	call init_seg (sys_dir, seg_name, iodc_data_ptr, try_10_times, code);
						/* use internal proc to initiate */
	if code ^= 0 then do;
fatal_init:
	     call iodd_msg_ (error, master, code, id, "^/Fatal error:  Unable to initiate ^a in ^a", seg_name, sys_dir);
	     if iodd_static.test_entry then
		call early_quit;			/* let the quit handler take it to */
	     go to out;				/* normally there is nothing to do but quit */
	end;

	seg_name = "iod_working_tables";		/* ....for error msg */
	call init_seg (sys_dir, seg_name, ithp, try_10_times, code);
	if code ^= 0 then
	     go to fatal_init;

	if iod_tables_hdr.version ^= IODT_VERSION_5 then do;
	     call iodd_msg_ (error, master, 0, id,
		"Fatal error: Incorrect version of iod_working_tables.");
	     go to out;				/* this is really bad!! */
	end;

/*	Set the pointers to each table within the iod_working_tables */

	iodd_static.ithp = ithp;
	iodd_static.ltp, ltp = ptr (ithp, iod_tables_hdr.line_tab_offset);
	iodd_static.idtp, idtp = ptr (ithp, iod_tables_hdr.device_tab_offset);
	iodd_static.mdtp, mdtp = ptr (ithp, iod_tables_hdr.minor_device_tab_offset);
	iodd_static.qgtp, qgtp = ptr (ithp, iod_tables_hdr.q_group_tab_offset);
	iodd_static.dev_class_ptr = ptr (ithp, iod_tables_hdr.dev_class_tab_offset);
	iodd_static.text_strings_ptr, text_strings_ptr = ptr (ithp, iod_tables_hdr.text_strings_offset);

/*	see if we have to wait for a remote station to dial up  */

	iodd_static.attach_type = 0;			/* start fresh, and avoid loop if tables change */

	if first_arg = "listen" then do;		/* YES, wait for a station */
						/* first validate the line_id given from master console */
	     iodd_static.line_tab_idx = 0;
	     do i = 1 to line_tab.n_lines while (iodd_static.line_tab_idx = 0);
		ltep = addr (line_tab.entries (i));	/* get entry pointer */
		if lte.line_id = second_arg then
		     iodd_static.line_tab_idx = i;
	     end;
	     if iodd_static.line_tab_idx = 0 then do;
		call iodd_msg_ (normal, master, 0, "", "No line table entry found for ^a", second_arg);
		go to ask_for_dev;
	     end;
	     call attach_and_listen (code);		/* attach line, wait for dialup, and validate the station id */
	     if code ^= 0 then
		go to new_device;			/* just to be sure */
	     request_type = "default";		/* try for default request types */
	     input_iocbp = iodd_static.slave_in;	/* if we need to ask for a request_type */
	end;
	else do;

/* this is the normal device and request type case */
/* search for the major device in the device table */
	     request_dev.major_index = 0;
	     do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0);
		idtep = addr (iod_device_tab.entries (i));
						/* use new ptr for easy reference */
		if idte.dev_id = first_arg then
		     request_dev.major_index = i;	/* record the index */
	     end;
	     if request_dev.major_index = 0 then do;	/* not found */
		call iodd_msg_ (normal, master, 0, "", "Device ""^a"" not found in device table.", first_arg);
		go to ask_for_dev;			/* let him try again....or quit */
	     end;
	     if idte.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
						/* can't use Line variable type here */
		call iodd_msg_ (normal, master, 0, "", "Specified device must be used with the ""listen"" command.");
		go to ask_for_dev;
	     end;
	     iodd_static.attach_type = idte.attach_type;
	     iodd_static.attach_name = idte.attach_name;	/* initialize major device info in static */
	     iodd_static.major_device, request_dev.major_name = first_arg;
	     request_type = second_arg;		/* keep first_arg and second_arg intact */
	     input_iocbp = iodd_static.master_in;	/* in case we have to ask for a request type */
	end;
%page;

/*	Find each associated minor device and save the index and default device class */

	request_dev.n_minor = 0;			/* indicate that none have been found yet */

/* look for all posible minor devices...up to the max */
	do i = idte.first_minor to idte.last_minor while (request_dev.n_minor < hbound (request_dev.minor, 1));
	     mdtep = addr (minor_device_tab.entries (i)); /* set pointer to table entry */
	     if mdte.major_index = request_dev.major_index then do;

/* we found one that belongs to the major dev */
		request_dev.n_minor = request_dev.n_minor + 1; /* count it */
		request_dev.minor.name (request_dev.n_minor) = mdte.dev_id; /* copy the minor device name */
		request_dev.minor.index (request_dev.n_minor) = i; /* save the minor index */
		request_dev.minor.dvc_index (request_dev.n_minor) = mdte.default_dev_class; /* save the default device class index */
	     end;
	end;					/* end of the table search */

	if (request_dev.n_minor > 0) & (i <= idte.last_minor) then /* see if we omitted a minor device */
	     call iodd_msg_ (normal, slave, 0, "", "Restriction: only the first ^d minor devices will be used",
		hbound (request_dev.minor, 1));

	if request_dev.n_minor = 0 then do;		/* OOPS...the table is garbage */
	     call iodd_msg_ (error, both, 0, id,
		"Fatal error: Inconsistent data in minor_device_tab. Re-init the coordinator.");
	     if iodd_static.test_entry then
		call early_quit;			/* give programmer a look */
	     go to out;				/* then give up */
	end;

/*	See if we should force the operator to give a device class */

	if request_type = "" then			/* if no optional device class was given, check n_minor */
	     if request_dev.n_minor = 1 then
		use_default = "1"b;			/* assume the default */
	     else use_default = "0"b;			/* force response for multiple devices */
	else if request_type = "default" then
	     use_default = "1"b;			/* operator overrides */
	else use_default = "0"b;			/* take the given class or ask if multiple */

/*	Now we check out each possible device class for the requested devices */

	if request_dev.n_minor > 1 | use_default then do; /* must check further for the request type(s) */
	     do i = 1 to request_dev.n_minor;		/* for multiple minor devices we must ask for each dvc */
		if ^use_default | request_dev.minor (i).dvc_index = 0 then do;
						/* no default? */
get_dvc:
		     if request_dev.minor (i).dvc_index = 0 then
			question = "Enter request type for minor device ""^a"":";
		     else question = "Enter request type (or ""default"") for minor device ""^a"":";
		     call iodd_msg_ (normal, slave, 0, "", question, request_dev.minor.name (i));
		     call iox_$control (input_iocbp, "runout", null, code);
						/* invoke remote runout spacing */
		     call iox_$get_line (input_iocbp, addr (line), 120, nchars, code);
		     if code ^= 0 then
			go to new_device;
		     if nchars < 2 then
			go to get_dvc;		/* ignore blank lines */

		     input.max = 4;			/* most tokens allowed */
		     call iodd_parse_$command (substr (line, 1, nchars), addr (input), code);
						/* see what he said */
		     if code ^= 0 then do;
			if code = error_table_$noarg then
			     go to get_dvc;		/* try again if line was blank */
			else do;
bad_dvc:
			     call iodd_msg_ (normal, slave, 0, "", "Invalid response.");
			     call iox_$control (input_iocbp, "resetread", null, code);
						/* try for a clean start */
			     request_dev.minor (i).dvc_index = 0;
						/* not sure if it is the default any more */
			     go to get_dvc;
			end;
		     end;
		     if length (input.arg (1)) > length (request_type) then
			go to bad_dvc;
		     request_type = input.arg (1);
		     if request_type = "quit" | request_type = "new_device" | request_type = "newdevice" then
			go to ask_for_dev;
		     if request_type = "default" then do; /* be sure there is a default */
			if request_dev.minor (i).dvc_index = 0 then do;
			     call iodd_msg_ (normal, slave, 0, "", "No default has been specified.");
			     go to get_dvc;
			end;
		     end;
		     else do;			/* have to search for the specified dvc */

			call find_device_class (request_type, j, dev_class, queue_type, code);
						/* use internal proc */
			if code ^= 0 then
			     go to bad_dvc;		/* let him try again...msg has been sent */

			request_dev.minor (i).dvc_index = j;
						/* store the returned index */
		     end;
		end;

/*		Now check to be sure it is legal for this process. */

		call validate_request (i, code);	/* use the internal proc */
		if code ^= 0 then
		     go to bad_dvc;			/* error has been printed already */
	     end;
	end;					/* end of dvc request loop for multiple minor devices */

	else do;					/* we have a single device and a given request_type arg */

	     call find_device_class (request_type, j, dev_class, queue_type, code);
	     if code ^= 0 then
		go to ask_for_dev;			/* the message has already been printed */

	     request_dev.minor (1).dvc_index = j;	/* store the dvc index returned */

	     call validate_request (1, code);		/* check it out */
	     if code ^= 0 then
		go to ask_for_dev;			/* if bad, start over */
	end;

/*	WHEW...Now request_dev contains all the information needed to communicate to the coordinator */
%page;

re_init_junction:

/* This is the point of entry for re-initialization of the driver after a
   "no-coord" or "re_init" signal.  We can proceed on the assumption that the
   same major and minor devices and device classes will be used. */

	iodd_static.major_device = request_dev.major_name;/* this gets cleared by kill_device, so reset in case */
	iodd_static.admin_ec_name = rtrim (request_dev.major_name) || "_admin.ec";
						/* define x cmd ec name */
	iodd_static.coord_proc_id = iodc_data.proc_id;	/* save coordinators process id */
	iodd_static.driver_proc_id = get_process_id_ ();	/* and the drivers */
	iodd_static.no_coord_flag = "1"b;		/* accept a no_coord signal now */
	iodd_static.recursion_flag = "0"b;		/* be sure this is reset for reinit */
	iodd_static.request_in_progress = "0"b;
	iodd_static.initialized = "0"b;
	iodd_static.master_hold = "0"b;
	iodd_static.slave_hold = "0"b;
	iodd_static.step = "0"b;
	iodd_static.quit_during_request = "0"b;
	iodd_static.logout_pending = "0"b;
	iodd_static.runout_requests = "0"b;
	iodd_static.quit_signaled = "0"b;
	iodd_static.auto_logout_interval = 0;		/* default to no auto logout, must be set by command */
	iodd_static.assigned_devices = 0;		/* no devices at this point */
	iodd_static.current_devices = 0;
	iodd_static.output_device = "Undefined";
	iodd_static.auto_start_delay = 60;		/* wait 60 seconds after quit before auto-start */
	if iodd_static.attach_type ^= ATTACH_TYPE_VARIABLE_LINE then do;
						/* assume attachment good for variable line */
	     iodd_static.slave_in, iodd_static.slave_out = null;
						/* for now */
	     iodd_static.slave.active = "0"b;		/* slave must be re-defined */
	     iodd_static.slave_ev_chan = 0;
	     iodd_static.slave.accept_input = "0"b;
	     iodd_static.slave.print_errors = "0"b;
	     iodd_static.slave_output = null_stream;	/* we are done with this now */
	     iodd_static.slave_input = null_stream;
	end;
	iodd_static.slave.log_msg = "0"b;		/* must ask for log messages */
	iodd_static.slave.echo_cmd = "0"b;		/* don't echo cmds by default */
	iodd_static.slave.allow_quits = "0"b;
	iodd_static.dev_io_stream = null_stream;
	iodd_static.dev_in_stream = null_stream;
	iodd_static.dev_out_stream = null_stream;
	iodd_static.driver_ptr = null ();
	iodd_static.driver_list_ptr,			/* be ready to publish the list */
	     list_ptr = addr (driver_list);

	iodd_static.chan_list_ptr = addr (ev_chan_list);	/* wait list for ipc_$block */
	iodd_static.segptr = null;			/* signal_handler cannot rely on segptr */

	call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* reset error_output */

	call ios_$detach ("broadcast_errors", "", "", io_stat); /* avoid multiple attachments for sure */

	call ios_$attach ("broadcast_errors", "broadcast_", "error_i/o", "", io_stat); /* put back error stream */

	iodd_static.master_output = "master_output";	/* incase they got clobbered */
	iodd_static.master_input = "master_input";	/* save the default stream names */
	iodd_static.log_stream = "log_output";

	call iox_$look_iocb ("master_output", iodd_static.master_out, code);
						/* reset the important iocb ptrs */
	call iox_$look_iocb ("master_input", iodd_static.master_in, code);
	call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code);
	call iox_$look_iocb ("error_i/o", iodd_static.error_io, code);

/*        check to see if the table has changed on us since we last looked */

	on seg_fault_error begin;
	     ithp = null;				/* indicate that we need to initiate */
	     go to get_tables;			/* and go back and get new indices */
	end;

	table_time = iod_tables_hdr.date_time_compiled;	/* reference through ptr to verify it */

	revert seg_fault_error;			/* don't special case the condition any longer */


/*	With all the static data initialized, get ready to request the devices */

	rqt_string = "";				/* build this as devices are initialized */
	driver_dir = rtrim (sys_dir) || ">" || request_dev.major_name;
	init_ev_chan = iodc_data.init_event_channel;	/* copy the coord's ipc chan */
	ev_chan_list.number = 2;			/* initially 2 channels in the wait list */
	ev_chan_list.channel (1) = 0;			/* this one is empty for now */
	ev_chan_list.channel (2) = iodd_static.timer_chan;/* timer is second priority */

	driver_ptr_list.number = 0;			/* assume that no driver status segs exist */

	new_driver_msg_p = addr (driver_message);	/* this is where we build the request */
	driver_message.lock_id = "0"b;		/* this will ensure that set_lock works */

	call set_lock_$lock (driver_message.lock_id, 0, code);
						/* store process lock id */
%page;

/* At this point we will loop through the requested minor devices, asking the
   IO coordinator to establish this process as the driver.  There is a lot of
   work to do for the initialization of each driver, so, the main loop will
   take a few pages of listing */

	if iodd_static.test_entry then
	     call iodd_msg_ (normal, master, 0, "", "Requesting devices from coordinator.");

	do i = 1 to request_dev.n_minor;		/* once around for each minor dev */

	     call ipc_$create_ev_chn (driver_message.wakeup_chan, code);
						/* get a channel for the coord to use */
	     if code ^= 0 then do;
		call convert_ipc_code_ (code);
		call iodd_msg_ (error, both, code, id, "Fatal error: Unable to create minor device event channel.");
		call kill_device;			/* drop any device assigned */
		go to out;			/* thats all she wrote! */
	     end;

	     ev_chan_list.channel (1) = driver_message.wakeup_chan;
						/* get ready to block for coord */
	     driver_message.device_index = request_dev.minor (i).index;
						/* fill in the rest of the request */
	     driver_message.dev_class_index = request_dev.minor (i).dvc_index;

	     call message_segment_$add_file (sys_dir, "coord_comm.ms", new_driver_msg_p, size (new_driver_msg) * 36,
		message_id, code);			/* send off the request */

	     if code ^= 0 then do;
		call iodd_msg_ (error, both, code, id,
		     "Fatal error: Unable to send new driver request to coord_comm.ms in ^a", sys_dir);
		call kill_device;			/* drop any we have */
		if iodd_static.test_entry then
		     call early_quit;		/* give programmer a look */
		go to out;			/* then bug out */
	     end;

	     unspec (event_message) = message_id;	/* give coord the message id in an event message */

	     call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code);
	     if code ^= 0 then
		signal no_coord;			/* on error assume the coord is gone */

/*	now block until the coordinator gives us the device (up to 5 min max) */

	     call ipc_$drain_chn (iodd_static.timer_chan, code);
						/* clear the timer...in case */
	     call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);
						/* start the clock */
	     call ipc_$block (addr (ev_chan_list), addr (event_info), code);
						/* and wait */
	     call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
						/* reset the clock */
	     if code ^= 0 then do;			/* bad news, and dumb code */
		call convert_ipc_code_ (code);
		call iodd_msg_ (error, both, code, id, "Fatal error: from  ipc_$block .");
		call kill_device;			/* flush any previous devices */
		if iodd_static.test_entry then
		     call early_quit;		/* take a peek, */
		go to out;			/* then forget it */
	     end;

/*	It was a legal wakeup, who sent it? */

	     if event_info.wait_list_index = 2 then do;	/* bad news if it was the timer */
		call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to new driver wakeup.");
		signal no_coord;			/* don't bother to flush devices */
	     end;

	     code = addr (event_info.message) -> ev_msg.code;
						/* see what the coord said */
	     if code ^= 0 then do;

		if request_dev.n_minor = 1 then
		     dev_label = request_dev.major_name;
		else dev_label = rtrim (request_dev.major_name) || "." || request_dev.minor (i).name;

		if code = 6 then do;		/* already assigned */
		     call iodd_msg_ (normal, both, 0, id, "Device ^a assigned to another process", dev_label);
		     go to ask_for_dev;		/* don't bother to flush */
		end;
		else if code = 7 then do;		/* already assigned to us, huh? */
		     call iodd_msg_ (normal, both, 0, id, "Device ^a already assigned to this process.", dev_label);
		end;				/* tell the operator, but, keep on truckin' */
		else do;				/* otherwise it is very bad */
		     call iodd_msg_ (error, both, 0, id, "Coordinator could not initialize ^a driver. Code = ^d",
			dev_label, code);
		     call kill_device;		/* we may have had some devices assigned */
		     go to ask_for_dev;		/* start all over again */
		end;

	     end;					/* when we pass here, we are almost home free */
%page;

/*	The coord gave the OK....so find the driver status segment */

	     call hcs_$initiate (driver_dir, request_dev.minor (i).name, "", 0, 1, driver_status_ptr, code);
	     if driver_status_ptr = null then do;
		call iodd_msg_ (error, both, code, id, "Unable to initiate driver status segment: ^a in ^a",
		     request_dev.minor (i).name, driver_dir);
		call kill_device;			/* drop it */
		go to ask_for_dev;			/* and start all over...UGH! */
	     end;

	     driver_ptr_list.number = driver_ptr_list.number + 1; /* add one to the list */
	     driver_ptr_list.stat_segp (driver_ptr_list.number) = driver_status_ptr; /* save the driver ptr */
	     driver_status.driver_chan = ev_chan_list.channel (1); /* and the event channel */
	     driver_status.last_wake_time = 0;		/* havn't asked for work yet */
	     driver_status.list_index = driver_ptr_list.number; /* for the future */
	     string (driver_status.status_flags) = "0"b;	/* clear the flags */
	     driver_status.dev_ctl_ptr = null;		/* don't leave uninitialized pointers around */

/*	Now find the accounting procedure we will use for this driver */
/*	It can be different for each minor device driver */

	     dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index));
	     qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index));

	     driver_status.generic_type = qgte.generic_type;
						/* record generic type for minor dev */

	     if return_string (qgte.accounting) = "nothing" then /* no accounting routine */
		driver_status.have_accounting = "0"b;	/* so indicate that */
	     else do;				/* otherwise it is more trouble */
		driver_status.have_accounting = "1"b;	/* so indicate that */
		if return_string (qgte.accounting) = "system" then /* use our special procedure */
		     driver_status.acct_entry = charge_user_;
		else do;
		     temp_dir_entry = return_string (qgte.accounting);

		     driver_status.acct_entry = cv_entry_ (temp_dir_entry, null (), code);
		     if code ^= 0 then do;
			if return_string (qgte.accounting) = "system" then
			     call iodd_msg_ (error, both, code, id,
				"Unable to get pointer to system accounting procedure: ^a", temp_dir_entry);
			else call iodd_msg_ (error, both, code, id, "Unable to get pointer to accounting procedure: ^a.",
				temp_dir_entry);
			call kill_device;
			go to ask_for_dev;		/* again */
		     end;
		end;
	     end;

/*	set up the line_charge prices for this logical driver */

	     call io_daemon_account_$set_line_prices (driver_ptr_list.number, qgtep, code);
	     if code ^= 0 then do;			/* OOPS */
		call iodd_msg_ (error, both, code, id, "Unable to set line charge prices for request type ^a.",
		     driver_status.req_type_label);
		call kill_device;
		go to ask_for_dev;
	     end;
%page;

/*	now see if there is a request type info seg specified for the driver */

	     entry_name = qgte.rqti_seg_name;		/* get the entry name from the iod_tables */
	     if entry_name ^= "" then do;		/* must find the rqti seg */
		call init_seg (rqti_dir, entry_name, driver_status.rqti_ptr, try_0_times, code);
						/* don't wait */
		if driver_status.rqti_ptr = null then do;
		     call iodd_msg_ (error, both, code, id, "Unable to find RQTI segment ^a.", entry_name);
		     call kill_device;
		     go to ask_for_dev;
		end;
	     end;
	     else driver_status.rqti_ptr = null;	/* be sure of no mistake */

	     rqt_name = before (rtrim (driver_status.req_type_label), ".");
						/* get the real request type name */

	     if index (rqt_string, rtrim (rqt_name)) = 0 then /* look for duplicates */
		rqt_string = rqt_string || " " || rtrim (rqt_name); /* add to the string */

/* associate minor device with rqt name for x command */
	     call set_iod_val (rtrim (driver_status.device_id), rtrim (rqt_name));

/*	Go back and look for the next minor device driver to be assigned */

	end;					/* That's all for the big loop */

/*	Time for final initialization */

	idtep = addr (iod_device_tab.entries (request_dev.major_index)); /* locate major device data */
	iodd_static.major_args = idte.args;

/* if user says single sheet then set it, else force to continuous forms */
	if idte.paper_type = PAPER_TYPE_SINGLE then
	     iodd_static.paper_type = idte.paper_type;
	else iodd_static.paper_type = PAPER_TYPE_CONTINUOUS;

	iodd_static.assigned_devices = driver_ptr_list.number; /* start with the first in the list */
	iodd_static.driver_ptr, driver_status_ptr = driver_ptr_list.stat_segp (1);
	iodd_static.output_device = iodd_static.driver_ptr -> driver_status.device_id;

/*	call the coord again and ask for the special command IPC channel (for drivers only) */

	event_message = 0;				/* clear the event message of trash */
	msgp = addr (event_message);			/* setup event message */
	msgp -> ev_msg.code = 5;			/* code 5: requesting cmd channel */
	msgp -> ev_msg.minor_dev_index =		/* name a minor device so coord can release */
	     driver_ptr_list.stat_segp (1) -> driver_status.dev_index;
	init_ev_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan;

/* get request chan */

	call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code);
	if code ^= 0 then
	     signal no_coord;			/* on error assume the coord is gone */

	call ipc_$drain_chn (iodd_static.timer_chan, code);
						/* clear the timer...in case */
	call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);

/* start the clock */

	ev_chan_list.channel (1) = driver_ptr_list.stat_segp (1) -> driver_status.driver_chan;

	call ipc_$block (addr (ev_chan_list), addr (event_info), code);
						/* and wait */

	call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
						/* reset the clock */
	if code ^= 0 then do;			/* bad news, and dumb code */
	     call convert_ipc_code_ (code);
	     call iodd_msg_ (error, both, code, id, "Fatal error: from  ipc_$block .");
	     call kill_device;			/* flush any previous devices */
	     if iodd_static.test_entry then
		call early_quit;			/* take a peek, */
	     go to out;				/* then forget it */
	end;

	if event_info.wait_list_index = 2 then do;	/* bad news if it was the timer */
	     call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to standard wakeup.");
	     signal no_coord;			/* don't bother to flush devices */
	end;

	iodd_static.coord_cmd_chan = event_info.message;	/* save the returned ev chan */

/*	Set the entry variables for calling the driver module */

	temp_dir = return_string (idte.driver_module);
	temp_dir_entry = temp_dir || "$init";
	iodd_static.driver_init = cv_entry_ (temp_dir_entry, null (), code);
	if code ^= 0 then do;
bad_entry:
	     call iodd_msg_ (error, both, code, id, "Unable to find driver module ""^a"".", temp_dir_entry);
	     call kill_device;
	     go to ask_for_dev;
	end;

	temp_dir_entry = temp_dir || "$request";
	iodd_static.driver_request = cv_entry_ (temp_dir_entry, null (), code);
	if code ^= 0 then
	     go to bad_entry;

	temp_dir_entry = temp_dir || "$command";
	iodd_static.driver_command = cv_entry_ (temp_dir_entry, null (), code);
	if code ^= 0 then
	     go to bad_entry;

	temp_dir_entry = temp_dir || "$default_handler";
	iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code);
	if code ^= 0 then do;
	     if code ^= error_table_$no_ext_sym then
		go to bad_entry;			/* we can handle one error only */
	     else do;
		temp_dir_entry = "iodd_$iodd_";
		iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code);
		if code ^= 0 then
		     go to bad_entry;		/* perish the thought! */
	     end;
	end;

/* set the entry variables for the head_sheet entries.  If not supplied in
   iod_tables, use default of head_sheet_ */

	temp_dir = return_string (idte.head_sheet);
	if temp_dir = "" then do;
	     iodd_static.print_head_sheet = head_sheet_$print_head_sheet;
	     iodd_static.print_head_separator = head_sheet_$print_separator;
	end;
	else do;
	     temp_dir_entry = temp_dir || "$print_head_sheet";
	     iodd_static.print_head_sheet = cv_entry_ (temp_dir_entry, null (), code);
	     if code ^= 0 then do;
bad_banner_entry:
		call iodd_msg_ (error, both, code, id, "Unable to find banner page module ""^a"".", temp_dir_entry);
		call kill_device;
		go to ask_for_dev;
	     end;

	     temp_dir_entry = temp_dir || "$print_separator";
	     iodd_static.print_head_separator = cv_entry_ (temp_dir_entry, null (), code);
	     if code ^= 0 then
		go to bad_banner_entry;
	end;

	if iodd_static.test_entry then do;		/* ... and that head sheet printer can find printer_notice */
	     if temp_dir = "" then
		call head_sheet_$test (sys_dir);
	     else do;
		temp_dir_entry = temp_dir || "$test";
		entry_variable = cv_entry_ (temp_dir_entry, null (), code);
		if code ^= 0 then
		     go to bad_banner_entry;
		call entry_variable (sys_dir);
	     end;
	end;

/* set the entry variables for the tail_sheet entries */
	temp_dir = return_string (idte.tail_sheet);
	if temp_dir = "" then
	     iodd_static.print_tail_sheet = tail_sheet_$print_tail_sheet;
	else do;
	     temp_dir_entry = temp_dir || "$print_tail_sheet";
	     iodd_static.print_tail_sheet = cv_entry_ (temp_dir_entry, null (), code);
	     if code ^= 0 then
		go to bad_banner_entry;
	end;

/*	Set up the wait list for blocking, except for the ctl_term entry */

	call iox_$control (iodd_static.master_in, "read_status", addr (read_info), code);
	if code ^= 0 then do;
	     call iodd_msg_ (error, both, code, id, "Attempting read_status control on master_input.");
	     call kill_device;
	     go to out;
	end;
	ev_chan_list.channel (1) = read_info.ev_chan;	/* save the master console event channel in first position */

	do i = 1 to driver_ptr_list.number;
	     ev_chan_list.channel (i + 2) = driver_ptr_list.stat_segp (i) -> driver_status.driver_chan;
	end;					/* leave the timer chan in position 2 for now */
	ev_chan_list.number = driver_ptr_list.number + 2;

	if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then /* for line variable, device is the slave */
	     ev_chan_list.channel (2) = iodd_static.slave_ev_chan; /* the slave is defined as station device */

/*	Check on the control terminal. If we have one, its ev_chan will go into position 2 after attachment */
/*	unless this is a line variable type device.  Then allow ctl term, but not as the slave. */

	if iodd_static.ctl_term.attached then do;	/* check to see if it is still dialed */
	     call check_for_dialup (code);

	     if code = 0 then
		go to set_ctl_streams;		/* if still there, finish attachments */

	     if code = 5 then do;			/* this signals we are changing ctl terminals */
		line = NL || "hangup terminal" || NL;
		call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat);
		call ios_$order (iodd_static.ctl_io, "runout", null, io_stat);
		call ipc_$decl_ev_wait_chn (iodd_static.ctl_dial_chan, code);

/* ready for dial_manager_ */

		release_arg.version = dial_manager_arg_version_2;
		release_arg.channel_name = iodd_static.ctl_device;
		release_arg.dial_channel = iodd_static.ctl_dial_chan;
		release_arg.dial_qualifier = "";

		call dial_manager_$release_channel (addr (release_arg), code);
		if code ^= 0 then
		     call ios_$order ((iodd_static.ctl_io), "hangup", null, io_stat);

/* do what we can to drop it */
		call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
						/* no longer needed */
	     end;
	     call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
						/* drop the dead terminal */
	     call ios_$detach (iodd_static.ctl_input, "", "", io_stat);
	     call ios_$detach (iodd_static.ctl_output, "", "", io_stat);
	     iodd_static.ctl_term.attached = "0"b;	/* all clear now */
	end;

	iodd_static.ctl_term.ctl_attach_name = idte.ctl_attach_name;
	iodd_static.ctl_term.ctl_attach_type = idte.ctl_attach_type;

	if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY | iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_DIAL then do;
	     call wait_for_dial (code);		/*  must ask answering service for terminal line or for dial */
	     if code ^= 0 then do;
		if code > 10 then
		     call iodd_msg_ (normal, master, code, id, "Unable to get dialed terminal.");
		else call iodd_msg_ (normal, master, 0, id, "Unable to get dialed terminal. code = ^d", code);
		call kill_device;
		go to ask_for_dev;
	     end;
	end;
	else if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_MC then do;
						/* we want the message coordinator */
	     iodd_static.ctl_dev_dim = "mrd_";
	     iodd_static.ctl_device = idte.ctl_attach_name;
						/* attach name was the device */
	end;
	else do;					/* otherwise, no ctl_term is required */
	     iodd_static.ctl_input = null_stream;	/* be sure all variables are cleared */
	     iodd_static.ctl_output = null_stream;
	     iodd_static.ctl_io = null_stream;
	     iodd_static.ctl_dev_dim = "Undefined";
	     iodd_static.ctl_dial_chan = 0;
	     iodd_static.ctl_ev_chan = 0;		/* this means the timer chan will be a dummy */
						/* in the event wait list...it avoids errors */
	     go to call_driver;			/* ready to pass this process along */
	end;

	call ios_$attach ("ctl_i/o", iodd_static.ctl_dev_dim, iodd_static.ctl_device, "", io_stat);
	if st.code ^= 0 then do;			/* couldn't attach? */
	     if st.code = error_table_$ionmat then
		go to set_ctl_streams;		/* already attached, ??? */
	     call iodd_msg_ (normal, master, st.code, id,
		"Attaching ""ctl_i/o"" to ""^a"" with  interface module ""^a"".", iodd_static.ctl_device,
		iodd_static.ctl_dev_dim);
	     call kill_device;
	     go to ask_for_dev;			/* might be better to ask operator what to do */
	end;

set_ctl_streams:					/* set the input, output, and error streams */
	iodd_static.ctl_term.attached = "1"b;		/* this must be true in all cases */
	iodd_static.ctl_io = "ctl_i/o";
	iodd_static.ctl_input = "ctl_input";
	iodd_static.ctl_output = "ctl_output";

	if iodd_static.ctl_term.forms then
	     dim_name = "form_";			/* use the paging dim for simulating forms */
	else dim_name = "syn";

	call ios_$attach ("ctl_input", dim_name, iodd_static.ctl_io, "", io_stat);
	if st.code ^= 0 then
	     if st.code ^= error_table_$ionmat then do;	/* let it ride if attached */
syn_err:
		call iodd_msg_ (normal, master, st.code, id, "Error attaching control terminal streams. Dim: ^a",
		     dim_name);
		go to start_new_device_cleanup;
	     end;

	call ios_$attach ("ctl_output", dim_name, iodd_static.ctl_io, "", io_stat);
	if st.code ^= 0 then
	     if st.code ^= error_table_$ionmat then
		go to syn_err;

/*	Put the control terminal event channel in the wait list */

	call ios_$order (iodd_static.ctl_io, "read_status", addr (read_info), io_stat);
	if st.code ^= 0 then do;			/* did someone lie?  this should always work */
	     call iodd_msg_ (normal, master, st.code, id, """read_status"" on stream ""^a"".", iodd_static.ctl_io);
	     go to start_new_device_cleanup;
	end;

	iodd_static.ctl_ev_chan = read_info.ev_chan;	/* save here for other uses */

	if ^iodd_static.slave.active then do;		/* if active, it was a line variable type */
						/* so don't make the control terminal the salve */
	     ev_chan_list.channel (2) = read_info.ev_chan;/* slave term is lower priority than master */
	     iodd_static.slave_ev_chan = read_info.ev_chan;

/*	Set the ctl_term as the slave device. */

	     iodd_static.slave_input = iodd_static.ctl_input;
	     iodd_static.slave_output = iodd_static.ctl_output;
	     iodd_static.slave.active = "1"b;

	     call iox_$look_iocb ((iodd_static.slave_output), iodd_static.slave_out, code);
	     if code ^= 0 then do;
slave_init_err:
		call iodd_msg_ (normal, master, code, id, "Unable to find slave iocbp.");
		go to start_new_device_cleanup;
	     end;

	     call iox_$look_iocb ((iodd_static.slave_input), iodd_static.slave_in, code);
	     if code ^= 0 then
		go to slave_init_err;

	     call ios_$order (iodd_static.ctl_io, "start", null (), io_stat);
	end;
%page;

call_driver:					/* call the init entry of the driver module */
	call set_iod_val ("device", rtrim (request_dev.major_name));
						/* set values for iod_val active function */
	call set_iod_val ("station_id", rtrim (request_dev.major_name));
	call set_iod_val ("channel", rtrim (iodd_static.attach_name));
	if iodd_static.assigned_devices > 1 then
	     request_type = "";			/* define request type if only one */
	else request_type = before (iodd_static.driver_ptr -> driver_status.req_type_label, ".");
	call set_iod_val ("request_type", rtrim (request_type));
	call set_iod_val ("rqt_string", (rqt_string));	/* define all the request types for iod_admin.ec */

	if ^iodd_static.slave.active then do;		/* set slave control modes if ctl term active */
	     iodd_static.slave.allow_quits = "0"b;
	     iodd_static.slave.accept_input = "0"b;
	     iodd_static.slave.print_errors = "0"b;
	end;
	else do;
	     dim_name = "broadcast_";
	     call ios_$attach ("broadcast_errors", dim_name, iodd_static.slave_output, "", io_stat);
	     if st.code ^= 0 then
		call iodd_msg_ (normal, both, st.code, id, "Unable to attach broadcast_errors to slave.");
	     else do;
		call ios_$attach ("error_output", "syn", "broadcast_errors", "", io_stat);
		if st.code ^= 0 then
		     call iodd_msg_ (normal, both, st.code, id,
			"Unable to attach error_output stream to broadcast_errors.");
	     end;

	     iodd_static.slave.allow_quits = "1"b;
	     iodd_static.slave.accept_input = "1"b;
	     iodd_static.slave.print_errors = "1"b;
	     if iodd_static.slave_output ^= iodd_static.ctl_output then
		iodd_static.slave.log_msg = "1"b;	/* send log msgs to slave if not the ctl terminal */
	end;

	if iodd_static.test_entry then		/* see if we are testing in one process */
	     if iodd_static.coord_proc_id = iodd_static.driver_proc_id then /* make them different for locking */
		iodd_static.driver_proc_id = bit (fixed (iodd_static.driver_proc_id, 35) + 100, 36);

	call iodd_command_processor_$init (stat_p);	/* be sure these related procs are initialized */
	call iodd_quit_handler_$init (stat_p);

	call write_control_form_$init (stat_p);

	iodd_static.initialized = "1"b;		/* tell the signal handler we are initialized */


	call iodd_static.driver_init (stat_p);		/* take it away */


/*	if we return, the driver was not able to initialize.  so try again */

	call iodd_msg_ (error, both, 0, id, "Unable to initialize driver.^/");

	go to start_new_device_cleanup;		/* let the handler do the work */
%page;

out:
	if iodd_static.test_entry then do;		/* make a clean return if testing */
	     if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
		call hangup_station;
	     call ipc_$delete_ev_chn (iodd_static.timer_chan, code);
	     call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code);
	     call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
	     call ipc_$delete_ev_chn (iodd_static.dial_ev_chan, code);
	     call ios_$attach ("error_output", "syn", "user_i/o", "", io_stat);

/* put it back where we found it */
	     call ios_$detach ("broadcast_errors", "", "", io_stat);
	     call ios_$order ("user_i/o", "start", null (), io_stat);

/* in case tty dim bug gives trouble */
	     return;				/* thereby going away */
	end;
	else call logout;				/* in normal mode must log out explicitly */

start_new_device_cleanup:

/* the transfer to here will invoke all cleanup handlers */
	call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
						/* put it back in case it was changed */

	if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
	     call hangup_station;

	call kill_device;				/* inform the coordinator that current device is gone */
	go to new_device;				/* now go back and start over */

driver_logout_label:
	if iodd_static.ctl_term.attached then do;	/* we may have a new ctl_term */
	     call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
						/* tell initializer */
	     line = NL || "hangup terminal" || NL;
	     call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat);
	     call ios_$order (iodd_static.ctl_io, "runout", null, io_stat);
	     call ios_$order (iodd_static.ctl_io, "hangup", null, io_stat);
						/* now free the tty chan */
	     call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
	end;
	call kill_device;				/* tell the coord if we can */
	call hangup_station;			/* this will tell iox_ we don't have the terminal */
	go to out;				/* this will correct for test mode */

re_init_driver:

/* this will invoke all cleanup handlers */
	call kill_device;
	if iodd_static.re_init_in_progress then		/* Only way to get here with this set... */
	     if iodd_static.logout_on_hangup then do;	/* is in case of a hangup */
		call iodd_msg_ (error, both, 0, id, "Driver logging out.  (hangup_on_logout in effect.)");
		goto out;
	     end;
	iodd_static.recursion_flag = "0"b;		/* clear incase of signal during attachment */
	iodd_static.re_init_in_progress = "0"b;		/* anyone who cares already knows */
	if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
						/* re-validate the station if line variable type */
	     if ^iodd_static.initialized then
		call hangup_station;		/* in case remote_driver_ couldn't hangup */
	     iodd_static.initialized = "0"b;
	     iodd_static.no_coord_flag = "0"b;
	     call timer_manager_$sleep (10, RELATIVE_SECONDS);	/* let answering service clean up */
	     go to get_tables;
	end;
	iodd_static.initialized = "0"b;
	if iodd_static.attach_type ^= ATTACH_TYPE_IOM then
	     call timer_manager_$sleep (10, RELATIVE_SECONDS);	/* let answering service clean up */
	if iodd_static.no_coord_flag then
	     go to re_init_junction;
	go to new_device;

no_coord_signal:

/* this will invoke all cleanup handlers then wait for a new coordinator */
	call kill_device;				/* this is to terminate the segs */
	iodd_static.recursion_flag = "0"b;
	iodd_static.initialized = "0"b;
	iodd_static.re_init_in_progress = "0"b;		/* all who care have seen this */

	call iodd_msg_ (error, master, 0, id, "Driver will await new coordinator.");
	times = 0;

check_proc_id:
	if iodc_data.proc_id ^= (36)"0"b then
	     if iodc_data.proc_id ^= iodd_static.coord_proc_id then
						/* see if there is a new process id */
		if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
		     go to get_tables;
		else go to re_init_junction;

/* 		not changed yet, wait 30 seconds and try again */

	times = times + 1;				/* record the number of times we sleep */
	if times > 10 then do;			/* only wait 5 minutes */

	     call iodd_msg_ (error, master, 0, id, "^a^/Waited too long for coordinator. Process logging out.^/^a^a",
		stars, stars, bel_string);
	     go to driver_logout_label;		/* nothing else left to do */

	end;
	call timer_manager_$sleep (30, RELATIVE_SECONDS);		/* sleep for 30 seconds, then... */
	go to check_proc_id;			/* try again */
%page;


/* ---------INTERNAL PROCEDURES ------------ */


early_quit: proc;

/* If we get a quit before regular handler is set up */


dcl  cmd char (80);
dcl  line char (32);
dcl  nc fixed bin (21);
dcl  stat bit (72) aligned;
dcl  give_start bit (1);

	give_start = "1"b;				/* give an auto start unless something happens */

	call ioa_$ioa_stream ("user_i/o", "^/Early ""quit""^/");

	call timer_manager_$alarm_call (iodd_static.auto_start_delay, RELATIVE_SECONDS, try_auto_start);

	on alrm call continue_to_signal_ (code);	/* let this go through */

	on any_other begin;
	     give_start = "0"b;			/* stop the auto start proc */
	     call timer_manager_$reset_alarm_call (try_auto_start);
						/* in case this frame goes away */
	     call continue_to_signal_ (code);
	end;

get_line:
	call ioa_$ioa_stream ("user_i/o", "Enter command(early quit):");
	call iox_$get_line (iodd_static.master_in, addr (cmd), 80, nc, code);
						/* get a command line */
	if give_start then do;			/* expecting to give an auto start? */
	     give_start = "0"b;			/* we got something, so cancel the auto_start */
	     call timer_manager_$reset_alarm_call (try_auto_start);
						/* don't use a bad frame */
	end;
	if code ^= 0 then
	     go to no_master;

	line = substr (cmd, 1, nc - 1);
	if line = "" then
	     go to get_line;			/* be nice about blank lines */

	if line = "start" then do;
auto_start:
	     call ios_$order ("user_i/o", "start", null, stat);
						/* be sure we don't lose a wakeup */
	     return;
	end;

	else if line = "new_device" then do;
	     go to start_new_device_cleanup;
	end;

	else if line = "logout" then do;
	     go to driver_logout_label;		/* assume he really means it */
	end;

	else if line = "return" then do;		/* return to the caller of iodd_$iodd_init */
	     if iodd_static.test_entry then
		go to out;
	end;

	else if line = "debug" then do;
	     if iodd_static.test_entry then do;
		call ioa_$ioa_stream ("user_i/o", "Calling debug");
						/* let him know what we are doing */
		call debug;
		go to get_line;
	     end;
	end;

	else if line = "probe" | line = "pb" then do;
	     if iodd_static.test_entry then do;
		call ioa_$ioa_stream ("user_i/o", "Calling probe");
						/* let him know what we are doing */
		call probe;
		go to get_line;
	     end;
	end;

	else if line = "pi" then do;
	     if iodd_static.test_entry then do;
		signal program_interrupt;
		go to get_line;			/* in case it returns */
	     end;
	end;

	else if line = "." | line = "hold" then
	     go to get_line;			/* we just cancelled the auto start */

	else if line = "help" then do;		/* tell what commands can be used */
	     call ioa_$ioa_stream ("user_i/o", "Commands at this level are: hold, start, new_device, logout");
	     if iodd_static.test_entry then
		call ioa_$ioa_stream ("user_i/o", "Test commands: debug, probe, return, pi");
	     go to get_line;
	end;

	call ioa_$ioa_stream ("user_i/o", "Invalid response: ""^a""  Type ""help"" for instructions.", line);
	go to get_line;

try_auto_start: proc;

	     if give_start then do;
		call ioa_$ioa_stream ("user_i/o", "Automatic start given.");
		go to auto_start;
	     end;
	     return;				/* otherwise forget it */

	end;

     end early_quit;
%page;


init_seg: proc (dir_name, seg_name, segp, num_times, ec);

/* Little procedure to initiate segments */

dcl  seg_name char (*);
dcl  segp ptr;
dcl  dir_name char (*);
dcl  num_times fixed bin;				/* number of times we should try to initiate */
dcl  ec fixed bin (35);
dcl  times fixed bin;

          times = 0;				/* haven't tried at all yet */
try_again:					/* be sure to set reference name */
	call hcs_$initiate (dir_name, seg_name, seg_name, 0, 1, segp, ec);
	if segp = null () then
	     if ec = error_table_$namedup then do;
		call hcs_$terminate_name (seg_name, ec);
		if ec = 0 then
		     go to try_again;
		return;				/* all attempts have failed */
	     end;
	     else if ec = error_table_$noentry then do;

/* wait a bit and try again (coordinator may create seg. when it comes up) */
		times = times + 1;			/* count the number of times we try */
		if times > num_times then
		     return;			/* after num_times give up */
		call timer_manager_$sleep (30, RELATIVE_SECONDS);
		go to try_again;
	     end;
	     else return;				/* unrecoverable error */
	ec = 0;
	return;
     end init_seg;
%page;

attach_and_listen: proc (code);

dcl  station_id char (32);
dcl  code fixed bin (35);
dcl  att_desc char (256);
dcl  tries fixed bin;
dcl  station_password char (8);
dcl  cmd_msg char (32);
dcl  err_msg char (80);
dcl  len fixed bin (21);

dcl  1 hangup_info aligned,				/* structure for the "hangup_proc" control order */
       2 entry entry,				/* entry to be called */
       2 data_ptr ptr,				/* pointer to be passed to entry */
       2 priority fixed bin;				/* ipc_ call chan priority */

	code = 0;
	tries = 0;				/* count the attach attempts, allow up to five */

/* make attach description */
	call ioa_$rsnnl ("remote_teleprinter_ " || return_string (lte.att_desc), att_desc, len, lte.chan_id);

attach_chan:
	tries = tries + 1;				/* increment the attempt count */
	if tries > 5 then do;			/* over 5, give up */
	     code = error_table_$no_operation;		/* be sure we abort this device */
	     call iodd_msg_ (error, master, 0, id, "All attach attempts failed.");
						/* sound beeper */
	     return;
	end;

	call iodd_msg_ (normal, master, 0, "", "Attaching line ""^a"" on channel (^a).", lte.line_id, lte.chan_id);

	call timer_manager_$sleep (5, RELATIVE_SECONDS);		/* pause to allow answering service to catch up */

	iodd_static.major_device = "";		/* no station defined at this point */
	iodd_static.attach_type = 0;			/* nothing really attached yet either */
	iodd_static.attach_name = "";
	request_dev.major_index = 0;
	request_dev.major_name = "";

	call iox_$attach_name ("teleprinter", iodd_static.slave_in, att_desc, null, code);
	if code ^= 0 then
	     if ^(code = error_table_$ionmat | code = error_table_$not_detached) then do;
						/* very bad */
		call iodd_msg_ (normal, master, code, id, "Unable to attach line.");
		call hangup_station;		/* just to be sure */
		go to attach_chan;			/* now try again */
	     end;

	call iox_$open (iodd_static.slave_in, Stream_input_output, ""b, code);
	if code ^= 0 then
	     if code ^= error_table_$not_closed then do;
		call iodd_msg_ (normal, master, code, id, "Unable to open line io switch.");
		call hangup_station;		/* just to be sure */
		go to attach_chan;			/* now try again */
	     end;

	iodd_static.slave.active = "1"b;		/* got a live one */
	iodd_static.slave.accept_input = "1"b;
	iodd_static.slave.print_errors = "1"b;
	iodd_static.slave_out = iodd_static.slave_in;	/* they are both the same */
	iodd_static.slave_input, iodd_static.slave_output = "teleprinter";
	iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE;
						/* tell all what we did */
	iodd_static.attach_name = lte.chan_id;

	call iox_$control (iodd_static.slave_in, "read_status", addr (read_info), code);
	if code ^= 0 then do;
	     call iodd_msg_ (normal, master, code, id, "Attempting read_status control operation.");
	     call hangup_station;
	     go to attach_chan;			/* now try again */
	end;

	iodd_static.slave_ev_chan = read_info.ev_chan;	/* save this for later */

	hangup_info.entry = iodd_hangup_$iodd_hangup_;	/* in case answering service detects a hangup */
	hangup_info.data_ptr = stat_p;
	hangup_info.priority = 1;

	call iox_$control (iodd_static.slave_in, "hangup_proc", addr (hangup_info), code);
	if code ^= 0 then
	     call iodd_msg_ (normal, master, code, id,
		"Warning: Could not establish handler for hangups from the device.");

	call iodd_msg_ (normal, master, 0, "", "Requesting station identifier on line ""^a"".", lte.line_id);

	call iox_$put_chars (iodd_static.slave_out, addr (FF), 1, code);
						/* start a new page */
	if code ^= 0 then
	     go to drop_station;

	tries = 0;				/* attempt counter is now used for station IDs */
	cmd_msg = "Enter station command:" || NL;
	go to ask_for_station;

clear_input_buffer:					/* flush all input buffers */
	call iox_$control (iodd_static.slave_in, "resetread", null, code);

ask_for_station:
	tries = tries + 1;				/* increment the count of station ids requested */
	if tries > 10 then
	     go to drop_station;			/* over the limit, hangup the intruder */

	call iox_$put_chars (iodd_static.slave_out, addr (cmd_msg), length (rtrim (cmd_msg)), code);
	if code ^= 0 then do;
drop_station:  call hangup_station;
	     call iodd_msg_ (normal, master, code, id, "Trouble initializing station.  Will re-attach line.");
	     tries = 0;				/* reset the attach counter for new station */
	     call timer_manager_$sleep (10, RELATIVE_SECONDS);	/* let the line settle or operator send quit */
	     go to attach_chan;
	end;

	call iox_$control (iodd_static.slave_out, "runout", null, code);
						/* force out the message */

/*	Look for the command line:  station <station_id> <station_password>	 */

	line = "";				/* clear the input buffer */
	call iox_$get_line (iodd_static.slave_in, addr (line), 80, len, code);
	if code ^= 0 then
	     go to drop_station;

	line = rtrim (line, " " || NL);		/* strip any new line chars */

	if index (line, "station") = 0 then
	     go to bad_cmd;

	station_id = before (ltrim (after (line, "station")), " ");

	if station_id = "" then do;
bad_cmd:	     call iodd_msg_ (normal, both, 0, "***", "Invalid station command.");
	     go to clear_input_buffer;
	end;

	station_password = before (ltrim (after (line, rtrim (station_id))), " ");
	if station_password = "" then			/* ... left off password: ask for it */
	     call read_password_$switch (iodd_static.slave_out, iodd_static.slave_in, STATION_PW_PROMPT,
		station_password, code);
	if station_password = "*" then		/* ... user really wants a blank password */
	     station_password = "";

	if station_password ^= "" then do;
	     temp_password = station_password;
	     station_password = scramble_ (temp_password);
	     temp_password = "";			/* Security */
	end;
	call validate_card_input_$station (station_id, station_password, err_msg, code);
	station_password = "";			/* Security */
	if code ^= 0 then do;
	     call iodd_msg_ (normal, both, 0, "***", "^a: ^a", err_msg, station_id);
	     go to clear_input_buffer;
	end;

/*	assume the station_id and major device are the same */

	request_dev.major_name, iodd_static.major_device = station_id;

	request_dev.major_index = 0;
	do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0);
	     idtep = addr (iod_device_tab.entries (i));	/* use new ptr for easy reference */
	     if idte.dev_id = request_dev.major_name then
		request_dev.major_index = i;		/* record the index */
	end;
	if request_dev.major_index = 0 then do;		/* not found */
	     call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" not defined in iod_tables.",
		request_dev.major_name);
	     go to clear_input_buffer;		/* let him try again....or quit */
	end;

	if substr (lte.maj_dev_list, request_dev.major_index, 1) ^= "1"b then do;
						/* OOPS */
	     call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" is not permitted to use Line ""^a"".", idte.dev_id,
		lte.line_id);
	     go to clear_input_buffer;
	end;

	call iodd_msg_ (normal, master, 0, "", "Driver initializing for station:  ^a", iodd_static.major_device);

	code = 0;					/* all was well, say so */

	return;

     end attach_and_listen;
%page;

find_device_class: proc (string, ind, dev_class, request_type, ec);

/* Internal procedure to search the queue group table and the device class
   table to find the device class index for the specified input string.
   The string is in the form of request_type.dev_class with the dev_class part
   being optional, thus assuming request_type.request_type.  */

dcl  string char (*);				/* input can be no more than 64 chars */
dcl  ind fixed bin;					/* the device class index - output */
dcl  dev_class char (32);				/* device class name used - output */
dcl  request_type char (32);				/* queue group name used - output */
dcl  ec fixed bin (35);				/* error code returned */
dcl  i fixed bin;					/* random fixed bin variable */
dcl  qgt_index fixed bin;				/* index of the queue group entry in the table */


	ec = 0;					/* clear the error code */

/* break it into two components, if there.  If only one component, make
   device_class the same as request_type */

	request_type = before (string, ".");
	dev_class = after (string, ".");
	if dev_class = "" then
	     dev_class = request_type;
	if request_type = "" then do;
	     ec = error_table_$badopt;		/* first char was ".", naughty */
	     call iodd_msg_ (normal, slave, 0, "", "Illegal form of request_type: ^a", string);
	     return;
	end;

/*	search the queue group table for the requested entry */
	do i = 1 to iodd_static.qgtp -> q_group_tab.n_q_groups;
	     if iodd_static.qgtp -> q_group_tab.entries (i).name = request_type then
		go to found_group;
	end;

	call iodd_msg_ (normal, slave, 0, "", "Request type ""^a"" not found in table.", request_type);
	ec = error_table_$badopt;
	return;

found_group:
	qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (i));
						/* for easy reference */
	qgt_index = i;				/* save the index for the next test */

/*	Now look in the device class table for the entry which matches the dev_class and request_type */
	do i = qgte.first_dev_class to qgte.last_dev_class;
	     dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (i));
	     if dcte.qgte_index = qgt_index then	/* must belong to the request_type */
		if dcte.id = dev_class then do;	/* and be the right name */
		     ind = i;			/* return the index of the entry */
		     return;
		end;
	end;

	ec = error_table_$badopt;			/* no entry found */
	call iodd_msg_ (normal, slave, 0, "", "Device class ""^a"" not found.", dev_class);
	return;

     end find_device_class;
%page;

validate_request: proc (ind, code);

/* Internal procedure to check that the device class index for the minor
   device in the request_dev structure specified by "ind" is valid for this
   process at its current access authorization.  The IO coordinator will make
   the same checks,  this check is made so we can properly respond to the
   operator at the right time if an error occurs. */

dcl  ind fixed bin;					/* minor device index in the request_dev structure */
dcl  code fixed bin (35);				/* error code to be returned */
dcl  ec fixed bin (35);				/* local error code */
dcl  i fixed bin;					/* index variables */
dcl  authorization bit (72) aligned;			/* access authorization of process */
dcl  dev_label char (32);				/* name for messages */
dcl  allowed_name char (24);				/* driver's name max of 22 char */
dcl  allowed_proj char (12);				/* driver's project...max of 9 char */
dcl  driver_name char (24);				/* driver's name max of 22 char */
dcl  driver_proj char (12);				/* driver's project...max of 9 char */
dcl  userid char (32);				/* copy of the required driver userid */

	i = ind;					/* copy the argument */
	if request_dev.n_minor = 1 then
	     dev_label = request_dev.major_name;
	else dev_label = char (rtrim (request_dev.major_name) || "." || request_dev.minor (i).name, length (dev_label));
	if request_dev.minor (i).dvc_index = 0 then do;
	     call iodd_msg_ (normal, both, 0, "", "No default request type has been assigned to device ""^a"".",
		dev_label);
	     code = error_table_$noentry;		/* indicate an error */
	     return;				/* nothing more we can check */
	end;

	dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index));

	ec = 0;					/* initialize the failure indicator */

/*	First check that this minor device is allowed for this device class */
	if ^(substr (dcte.device_list, request_dev.minor (i).index, 1)) then do;
						/* if the device bit is off...too bad */
	     call iodd_msg_ (normal, both, 0, "", "Device ""^a"" is not allowed for device class ""^a"".", dev_label,
		dcte.id);
	     ec = error_table_$noentry;		/* flag the error */
						/* then keep going to give all possible errors */
	end;

/*	Now check that the process access authorization is high enough to handle all requests */

	authorization = get_authorization_ ();		/* get current authorization */

	if ^aim_check_$greater_or_equal (authorization, dcte.max_access) then do;
						/* fail if authorization is not greater or equal */
						/* to highest request driver is to handle */
	     call iodd_msg_ (normal, both, 0, "",
		"Process access authorization is not sufficient for device class ""^a"".", dcte.id);
	     ec = error_table_$ai_restricted;		/* set the failure flag */
						/* this error should be error_table_$ai_restricted */

	end;

/*	Now check for the correct process group id of the driver */

	userid = get_group_id_ ();			/* get id of driver */
	driver_name = before (userid, ".");		/* and break into components */
	driver_proj = before (after (userid, "."), ".");

/* 		get ready to look at the q_group_tab entry */

	qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index));

	userid = qgte.driver_id;			/* get id of allowed drivers */
	allowed_name = before (userid, ".");		/* and break into components */
	allowed_proj = before (after (userid, "."), ".");

	if allowed_name ^= driver_name then		/* name must be equal or "*" to be accepted */
	     if allowed_name ^= "*" then
		go to name_err;			/* too bad for him */

	if allowed_proj ^= driver_proj then do;		/* project must match */
name_err:
	     call iodd_msg_ (normal, both, 0, "", "User ""^a.^a"" not authorized as driver for request type ""^a"".",
		driver_name, driver_proj, qgte.name);	/* tell the operator */
	     ec = error_table_$user_not_found;		/* indicate failure */
	end;

/*	If all was well give back the device class name */
	if ec = 0 then
	     request_dev.minor (i).dev_class = dcte.id;	/* save the dvc name */
	code = ec;				/* report any errors */

	return;


     end validate_request;
%page;

kill_device: proc;

/* internal procedure to tell the IO coordinator that the device and all
   minor devices which have been assigned to this process should be released */

dcl  coord_chan fixed bin (71);			/* place for copy of coord ev chan */
dcl  send bit (1);					/* flag to abort sending a wakeup */
dcl  recursion_flag bit (1);
dcl  i fixed bin;					/* local index variable */
dcl  (p, p1) ptr;					/* temp ptr for easy reading */
dcl  code fixed bin (35);

          recursion_flag = "0"b;

	on command_error ;
	on any_other begin;				/* in case driver_status is gone */
	     send = "0"b;				/* abort the wakeup */
	     if recursion_flag then
		go to forget_it;
	     recursion_flag = "1"b;
	     go to term_seg;			/* but try to clean up address space */
	end;

	if driver_ptr_list.number = 0 then do;		/* see if any have been assigned */
	     send = "0"b;				/* if not, abort wakeup */
	     go to term_seg;			/* try to terminate the parent dir */
	end;
	else send = "1"b;

	event_message = 0;				/* clear the event message of trash */
	msgp = addr (event_message);			/* setup event message */
	msgp -> ev_msg.code = 4;			/* code 4: we are about to logout */
	msgp -> ev_msg.minor_dev_index =		/* name a minor device so coord can release */
	     driver_ptr_list.stat_segp (1) -> driver_status.dev_index;
	coord_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan;

/* save this in temp because we must terminate status seg before using it */
term_seg:
	do i = 1 to driver_ptr_list.number;		/* first terminate all driver status segs */
	     p = driver_ptr_list.stat_segp (i);
	     if send then do;			/* can we still reference a driver status seg ? */
		call ipc_$delete_ev_chn (p -> driver_status.driver_chan, code);
		p1 = p -> driver_status.rqti_ptr;	/* get rqti ptr */
		if p1 ^= null then
		     call hcs_$terminate_noname (p1, code);
						/* try to terminate */
	     end;
	     call hcs_$terminate_noname (p, code);
	     if code ^= 0 then
		call iodd_msg_ (error, master, code, "kill_device",
		     "Warning: driver status segment may be initiated.");
	end;
	if iodd_static.major_device ^= "" then do;
	     call hcs_$terminate_file (sys_dir, iodd_static.major_device, 0, code);
	     if code ^= 0 then
		call iodd_msg_ (error, master, code, "kill_device",
		     "Warning: directory ^a in ^a may not be terminated.", iodd_static.major_device, sys_dir);
	end;
	iodd_static.major_device = "";		/* the device is gone */
	driver_ptr_list.number = 0;			/* assume all driver stat segs are gone */
	if send then				/* inform the coord only after all terminations are done */
	     call hcs_$wakeup (iodd_static.coord_proc_id, coord_chan, event_message, code);

/* forget error code....can't do anything about it */
forget_it:
	return;

     end kill_device;
%page;

hangup_station: proc;

dcl  ec fixed bin (35);


	if iodd_static.slave_out ^= null then do;	/* when defined, drop it */
	     call iox_$control (iodd_static.slave_out, "hangup", null, ec);
	     call iox_$close (iodd_static.slave_out, ec);
	     call iox_$detach_iocb (iodd_static.slave_out, ec);
	end;

	iodd_static.attach_name = "";
	iodd_static.slave_out, iodd_static.slave_in = null;
	iodd_static.slave.active = "0"b;		/* slave must be re-defined */
	iodd_static.slave.allow_quits = "0"b;
	iodd_static.slave.accept_input = "0"b;
	iodd_static.slave.print_errors = "0"b;
	iodd_static.slave.log_msg = "0"b;		/* must ask for log messages */
	iodd_static.slave.echo_cmd = "0"b;		/* don't echo cmds by default */
	iodd_static.slave.priv1 = "0"b;		/* driver module defined privleges */
	iodd_static.slave.priv2 = "0"b;		/* " */
	iodd_static.slave.priv3 = "0"b;		/* " */
	iodd_static.slave_output = null_stream;		/* we are done with this now */
	iodd_static.slave_input = null_stream;

	return;

     end hangup_station;
%page;

wait_for_dial: proc (ec);

/* Internal procedure to wait for a control terminal to be dialed to the driver
   process.  We have failed badly if a non-zero value is returned in "ec".  */

dcl  ec fixed bin (35);				/* error code */
dcl  n_dev fixed bin;				/* dummy for number of dialed dev arg */
dcl  1 dial_wait aligned,				/* wait list for dial wakeup */
       2 num fixed bin,
       2 chan fixed bin (71);

dcl  1 dial_arg aligned like dial_manager_arg;

	call ipc_$create_ev_chn (iodd_static.ctl_dial_chan, ec);
	if ec ^= 0 then
	     return;

	dial_wait.num = 1;				/* we will wait on one channel */
	dial_wait.chan = iodd_static.ctl_dial_chan;	/* this one */
	dial_arg.version = dial_manager_arg_version_2;	/* use the constant */
	dial_arg.dial_qualifier = char (iodd_static.ctl_attach_name, length (dial_arg.dial_qualifier));
	dial_arg.dial_channel = dial_wait.chan;
	dial_arg.channel_name = iodd_static.ctl_attach_name;
						/* this is the tty we want */

	dial_arg.dial_out_destination = "";
	dial_arg.reservation_string = "";
	if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY then do;
						/* 1 is priv attach, 2 is dial */

	     call dial_manager_$privileged_attach (addr (dial_arg), ec);
						/* ask for it */
	     if ec ^= 0 then
		return;				/* if all is well we will wait */
	     call iodd_msg_ (normal, both, 0, "",
		"^a driver waiting for control terminal channel ""^a"" to become active.", iodd_static.major_device,
		iodd_static.ctl_attach_name);		/* tell operator */
	end;
	else do;					/* this is the dial case */
	     call dial_manager_$allow_dials (addr (dial_arg), ec);
	     if ec ^= 0 then
		return;

	     call iodd_msg_ (normal, both, 0, "", "^a driver waiting for control terminal ""^a"" to dial.",
		iodd_static.major_device, iodd_static.ctl_term.ctl_attach_name);
						/* tell operator we are waiting */
	end;

wait:
	call ipc_$block (addr (dial_wait), addr (event_info), ec);
	if ec ^= 0 then
	     return;

	call convert_dial_message_ (event_info.message, dev_name, dim_name, n_dev, status_flags, ec);
	if ec ^= 0 then
	     return;

	if status_flags.hung_up then do;		/* someone sent a hangup?? */
	     call iodd_hangup_$iodd_hangup_ (addr (event_info));
	     go to wait;				/* in case it returns */
	end;
	if ^status_flags.dialed_up then
	     go to wait;				/* we wait until a "dial" is received */

	iodd_static.ctl_device = dev_name;		/* save the device name here */
	iodd_static.ctl_dev_dim = dim_name;		/* and the dim */

	call hcs_$make_ptr (ref_ptr, "iodd_hangup_", "iodd_hangup_", temp_ptr, ec);
						/* for ipc_ call chan */
	if ec ^= 0 then
	     return;

	call ipc_$decl_ev_call_chn (iodd_static.ctl_dial_chan, temp_ptr, stat_p, 1, ec);
	if ec ^= 0 then
	     return;

	call iodd_msg_ (normal, both, 0, "", "Control terminal accepted.");
	return;

     end wait_for_dial;
%page;

check_for_dialup: proc (ec);


/* This internal procedure checks to be sure the control terminal is in the
   dialed up state.  The driver can do I/O to the terminal only when it is in
   the dialed up state.  Otherwise com_err_ and ioa_ will signal "io_error"
   when trying to write on the control terminal.  That causes nasty things to
   happen.

   Due to insufficient data from the standard tty dim, we have to call the
   hardcore tty interface directly.  This should be a temporary measure
   until a new order call can be defined.   (JCW - Jan 1975)

   Note, due to the use of the hardcore tty interface, this procedure cannot
   be used for a control terminal attached through mrd_.
*/

dcl  ec fixed bin (35);				/* error code to be returned */
dcl  tw_index fixed bin;				/* device index of the tty channel */
dcl  state fixed bin;				/* device state that we are after */
						/* 1 = inactive  - this cannot happen (they say) */
						/* 2 = waiting   - terminal is not there */
						/* 5 = dialed up - on this state we can go */

	ec = 0;					/* start clean */

	if iodd_static.ctl_attach_name ^= idte.ctl_attach_name
	     | iodd_static.ctl_attach_type ^= idte.ctl_attach_type then do; /* same device? */
	     ec = 5;				/* the changing device code for caller */
	     return;
	end;

	if iodd_static.ctl_dev_dim = "mrd_" then
	     return;				/* this is never a problem */

	call hcs_$tty_index (iodd_static.ctl_device, tw_index, state, ec);
	if ec ^= 0 then
	     return;				/* let caller handle all errors */

	if state ^= 5 then
	     ec = 10;				/* if not dialed up, drop the terminal */

	return;

     end check_for_dialup;
%page;

return_string: proc (target) returns (char (*));

/* little procedure to return a string from text_strings.chars given the
   first char index and total number of chars in the string */

dcl  1 target unaligned like text_offset;

	if target.total_chars = 0 then
	     return ("");
	else return (
		substr (iodd_static.text_strings_ptr -> text_strings.chars,
		target.first_char, target.total_chars)
		);

     end return_string;
%page; %include device_class;
%page; %include dial_manager_arg;
%page; %include driver_ptr_list;
%page; %include driver_status;
%page; %include iod_constants;
%page; %include iod_device_tab;
%page; %include iod_event_message;
%page; %include iod_line_tab;
%page; %include iod_tables_hdr;
%page; %include iodc_data;
%page; %include iodd_static;
%page; %include iox_dcls;
%page; %include iox_modes;
%page; %include mseg_message_info;
%page; %include new_driver_msg;
%page; %include q_group_tab;
%page; %include request_descriptor;
%page; %include timer_manager_constants;

     end iodd_;




		    iodd_command_processor_.pl1     10/28/88  1403.5rew 10/28/88  1233.5      648405



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

/* format: style4,delnl,insnl,^ifthendo */

/* format: off */

iodd_command_processor_: proc (source, state, command_line, ec);

/* This procedure is called by an io_daemon driver when it's ready
   to process an operator command.  The validity of a command will depend
   on the source terminal and the state of the driver in processing requests.

   state = 0 means that there are no active devices.
   state = 1 means that we were called from iodd_listen_ with devices ready.
   state = 2 means that we were called while processing another command (or??)
   state = 3 means that we were called while processing a request (request command level).
   state = 4 means that we were called after a quit.
   state = 5 means that we were called from the signal handler (test mode)
*/


/* Originally coded as input_cmd_ in August 1973 by Robert S. Coren */
/* Modified and renamed in January 1975 by J. C. Whitmore for generalization and access isolation */
/* Modified in Dec 1975 by J. C. Whitmore for new restart functions & control terminal hangup before detach */
/* Modified in April 1976 by J. C. Whitmore to expand the dcl of ios_ mode variables to 256 */
/* Modified in August 1977 by J. C. Whitmore to extend input "state" and add new ctl_term options */
/* Modified in Nov 1977 by J. C. Whitmore to use iodd_msg_ and add new slave_term option */
/* Modified in May 1978 by J. C. Whitmore to add the x command and minor bug fixes */
/* Modified in July 1978 by J. C. Whitmore to add cmds: restart_q, auto_start_delay, defer, next, defer_time;
   to change the coord communication strategy; and to extend the save and restart commands */
/* Modified in August 1978 by J. C. Whitmore to add slave_term echo cmd and per device admin ec calls */
/* Modified 10/78 by J. C. Whitmore: go bug fix and status attach type 4 */
/* Modified 3/79 by J. C. Whitmore to support "-a" ctl arg to halt command */
/* Modified 6/81 by E. N. Kittlitz for new condition_info structures */
/* Modified January 1984 by C. Marker  Added probe as a legal command in test mode. */
/* Modified February 23, 1985 by C. Marker to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.  Status command fixed to handle long
     minor device names.
                                                   END HISTORY COMMENTS */


/* format: on */

/*	ARGUMENTS	*/

dcl  source fixed bin;
dcl  state fixed bin;
dcl  command_line char (*);
dcl  ec fixed bin (35);


/*	AUTOMATIC		*/

dcl  att_desc char (64);
dcl  code fixed bin (35);
dcl  command char (256) aligned;			/* for the x command line to the command processor */
dcl  change_data bit (1);				/* flag for ok to change info */
dcl  dr_ptr ptr;
dcl  desc_ptr ptr;
dcl  ec_name char (32);
dcl  segp ptr;
dcl  lg_sw bit (1) aligned;				/* long option switch as needed */
dcl  number fixed bin (35);
dcl  msgp ptr;
dcl  err_mess char (128);
dcl  error_flag bit (1);
dcl  message char (64);				/* general message string */
dcl  what char (16);
dcl  mode char (256);
dcl  omode char (256);
dcl  i fixed bin;
dcl  idx fixed bin;
dcl  len fixed bin;
dcl  tried_once bit (1);
dcl  person char (24);
dcl  project char (24);
dcl  restart_series fixed bin (35);
dcl  seq_id fixed bin (35);
dcl  series fixed bin (35);
dcl  series_sw bit (1);
dcl  device_id_length fixed bin;
dcl  req_type_label_length fixed bin;

dcl  io_stat bit (72) aligned;

dcl  1 st aligned based (addr (io_stat)),
       2 code fixed bin (35),
       2 junk bit (36);

dcl  1 arg_list aligned,				/* structure of parsed command line tokens */
       2 max_args fixed bin init (21),			/* the amount of storage we allocated */
       2 n fixed bin,
       2 cmd char (64) var,				/* first token is always the command */
       2 args (20) char (64) var;			/* up to 20 args per command */

dcl  1 ev_chan_list aligned,				/* IPC event list for coord communication */
       2 number fixed bin,				/* number of channels in list (we use 2) */
       2 pad fixed bin,
       2 chan (2) fixed bin (71);

dcl  1 event_info aligned,				/* info returned from ipc_$block */
       2 chan fixed bin (71),				/* channel wakeup came in on */
       2 msg fixed bin (71),				/* event message from sender */
       2 sender bit (36),				/* proc id of sender */
       2 origin fixed bin,				/* junk - ring, or device flag, or ? */
       2 wait_list_idx fixed bin;			/* index of chan in ev_chan_list */

dcl  1 option aligned,				/* control option bits for next command */
       2 dev bit (1) unal,
       2 q bit (1) unal,
       2 user bit (1) unal,
       2 id bit (1) unal,
       2 et bit (1) unal,
       2 pn bit (1) unal;

dcl  1 cond_info aligned like condition_info;

/*	BASED VARIABLES	*/

dcl  sys_dir char (168) aligned based;			/* string for the variable in iodd_'s static */
dcl  floating float bin based;			/* for the convert builtin */
dcl  fixed_bin fixed bin based;			/*   "  "  "  */
dcl  fixed_bin_35 fixed bin (35) based;			/*   "  "  "  */


/*	CONSTANTS		*/

dcl  master fixed bin int static init (1) options (constant);
						/* constant indicating the master device */
dcl  slave fixed bin int static init (2) options (constant);/* constant indicating the slave device */
dcl  both fixed bin int static init (0) options (constant); /* both the salve and master */
dcl  normal fixed bin int static init (1) options (constant);
dcl  whoami char (24) int static options (constant) init ("iodd_command_processor_");
dcl  null_cmd_level fixed bin int static options (constant) init (0);
						/* command level of state 0 */
dcl  listen_cmd_level fixed bin int static options (constant) init (1);
						/* command level of state 3 */
dcl  quit_cmd_level fixed bin int static options (constant) init (4);
						/* command level of state 4 */
dcl  signal_cmd_level fixed bin int static options (constant) init (5);
						/* command level of state 5 */
dcl  null_stream char (32) int static options (constant) init ("iodd_null_stream");
dcl  unknown_cmd_code fixed bin (35) int static options (constant) init (1239);
dcl  bad_chars char (5) int static options (constant) init ("([]);");
dcl  chn_type (4) char (8) int static options (constant) init ("iom ch", "tty ch", "dial id", "tty ch");


/*	ENTRIES		*/

dcl  continue_to_signal_ entry (fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  cu_$cp entry (ptr, fixed bin, fixed bin (35));
dcl  debug entry;
dcl  find_condition_info_ entry (ptr, ptr, fixed bin (35));
dcl  logout entry ();
dcl  hcs_$initiate entry (char (*) aligned, char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  iodd_msg_ entry options (variable);
dcl  (
     ioa_,
     ioa_$rsnnl
     ) entry options (variable);
dcl  ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*), bit (72) aligned);
dcl  ios_$order entry (char (*) aligned, char (*), ptr, bit (72) aligned);
dcl  ios_$changemode entry (char (*) aligned, char (*), char (*), bit (72) aligned);
dcl  iox_$attach_ptr entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iodd_parse_$command entry (char (*), ptr, fixed bin (35));
dcl  iodc_$command_level entry ();
dcl  message_segment_$add_file entry (char (*) aligned, char (*), ptr, fixed bin (24), bit (72) aligned, fixed bin (35));
dcl  probe entry ();
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));

/*	BUILTINS		*/

dcl  (addr, fixed, index, divide, stac, convert, null, substr, before, after, string, mod, rtrim, length, search,
     currentsize, unspec, float, verify) builtin;


/*	EXTERNAL  STATIC	*/

dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$noentry fixed bin (35) ext static;
dcl  error_table_$namedup fixed bin (35) ext static;
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$request_not_recognized fixed bin (35) ext static;

dcl  iox_$user_output ptr ext;
dcl  iox_$user_input ptr ext;
dcl  iox_$error_output ptr ext;


/*	CONDITIONS		*/

dcl  (conversion, no_coord, re_init, daemon_logout, daemon_slave_logout, daemon_again, daemon_cancel, daemon_kill,
     daemon_new_device, daemon_again_slave, program_interrupt, daemon_defer, resume, size) condition;

dcl  (any_other, cleanup, daemon_save) condition;

/* include file no longer declares version 5 */

dcl  cq_info_version_5 fixed bin int static init (5);

dcl  coord_msg (50) fixed bin (71) aligned;		/* this is the last dcl to make indent happy */
						/* must hold iodd_comm but PL/I will not allow */
						/* us to set the size to the size (iodd_comm) */

/*	START OF MAIN PROGRAM	*/


	comm_ptr = addr (coord_msg);			/* get ready for special commands */

	on conversion
	     begin;
	     call iodd_msg_ (normal, source, 0, "", "Argument conversion error. Try again.");
	     go to ignore;
	end;

	on size
	     begin;
	     call iodd_msg_ (normal, source, 0, "", "Argument numerical size error. Try again.");
	     go to ignore;
	end;

	call iodd_parse_$command (command_line, addr (arg_list), ec);
						/* see what he said */
	if ec ^= 0
	then do;
	     if ec = error_table_$noarg
	     then do;				/* just a blank line */
ignore:
		ec = 0;				/* don't force a reset read */
		return;
	     end;
	     err_mess = "Unable to parse command line.";
error:
	     call iodd_msg_ (normal, source, 0, "", "^a driver: ^a", iodd_static.major_device, err_mess);
	     return;
	end;

/* Now the command and all the arguments are in the arg_list structure */

/* find which command it is and branch to the correct label */


	if cmd = "."
	then go to ignore;				/* just ask for a command */

/*  The full list of commands is getting long, so start on the next page */

/* Here is the real list of commands for the standard driver */

/* All commands must be accepted without the undersocre character for remote devices. */


	if cmd = "auto_start_delay" | cmd = "autostartdelay"
	then go to auto_start_delay_command;
	if cmd = "cancel"
	then go to cancel_command;
	if cmd = "coord"
	then go to coord_command;
	if cmd = "ctl_term" | cmd = "ctlterm"
	then go to ctl_term_command;
	if cmd = "debug"
	then go to debug_command;
	if cmd = "defer"
	then go to defer_command;
	if cmd = "defer_time" | cmd = "defertime"
	then go to defer_time_command;
	if cmd = "go"
	then go to go_command;
	if cmd = "halt"
	then go to halt_command;
	if cmd = "help"
	then go to help_command;
	if cmd = "hold"
	then go to hold_command;
	if cmd = "inactive_limit" | cmd = "inactivelimit"
	then go to inactive_limit_command;
	if cmd = "kill"
	then go to kill_command;
	if cmd = "logout"
	then go to logout_command;
	if cmd = "master"
	then go to master_command;
	if cmd = "new_device" | cmd = "newdevice"
	then go to new_device_command;
	if cmd = "next"
	then go to next_command;
	if cmd = "pi"
	then go to pi_command;
	if cmd = "probe" | cmd = "pb"
	then go to probe_command;
	if cmd = "ready"
	then go to ready_command;
	if cmd = "reinit"
	then go to reinit_command;
	if cmd = "release" | cmd = "rl"
	then go to release_command;
	if cmd = "restart"
	then go to restart_command;
	if cmd = "restart_q" | cmd = "restartq"
	then go to restart_q_command;
	if cmd = "resume"
	then go to resume_command;
	if cmd = "return"
	then go to return_command;
	if cmd = "save"
	then go to save_command;
	if cmd = "slave"
	then go to slave_command;
	if cmd = "slave_term" | cmd = "slaveterm"
	then go to slave_term_command;
	if cmd = "start"
	then go to start_command;
	if cmd = "status"
	then go to status_command;
	if cmd = "step"
	then go to step_command;
	if cmd = "x"
	then go to x_command;

/*	The command is not implemented here.  See if the driver module wants it. */

	ec = unknown_cmd_code;			/* set to an unlikely value in case driver module just returns */
	err_mess = "Invalid command for driver - " || cmd;

pass_on:
	call iodd_static.driver_command (source, state, addr (arg_list), ec);

	if ec = unknown_cmd_code
	then go to error;				/* no one home...other errors were already reported */
	if ec = 1 | ec = 2
	then ec = 0;				/* driver module cannot force a continue */
	return;					/* clean return for a valid driver_module command */

/* **************************************************************************************** */

/*	This is where the real work starts.  One label for each command.  */


auto_start_delay_command:
	if arg_list.n > 1
	then do;					/* set the value */
	     number = convert (fixed_bin, args (1));	/* make it fixed bin */
	     if number < 30
	     then do;				/* this is the lower limit */
		call iodd_msg_ (normal, source, 0, "", "The lower limit for the delay time is 30 seconds.");
		return;
	     end;
	     iodd_static.auto_start_delay = number;
	end;

	call iodd_msg_ (normal, source, 0, "", "The auto start delay is:  ^d seconds.", iodd_static.auto_start_delay);
	return;


cancel_command:
	what = "cancel";				/* make next section common with the kill command */

cancel_or_kill:
	if source = slave
	then if iodd_static.master_hold
	     then do;
		err_mess = "Driver in hold by master terminal.";
		go to error;
	     end;

	if iodd_static.request_in_progress
	then do;					/* can only kill or cancel active request */
	     dr_ptr = iodd_static.driver_ptr;		/* find the current request number */
	     desc_ptr = addr (dr_ptr -> driver_status.descriptor);
	     desc_ptr -> request_descriptor.dont_delete = "1"b;
						/* cancel any delete option, just in case */
	     iodd_static.master_hold = "0"b;		/* already 0 if not the master */
	     iodd_static.slave_hold = "0"b;		/* both MBZ for next command level */
	     call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
	     if iodd_static.slave.active
	     then call iox_$control (iodd_static.slave_in, "start", null, ec);
	     if what = "cancel"
	     then do;
		desc_ptr -> request_descriptor.cancelled = "1"b;
						/* mark the request */
		signal daemon_cancel;		/* let the driver module clean out */
	     end;
	     else signal daemon_kill;			/* the other action */
	     return;
	end;

	err_mess = "No current request to " || what;
	go to error;


coord_command:					/* for calling coord command level when testing */
						/* coord and driver in one process */
	if iodd_static.test_entry
	then if source = master
	     then do;				/* only the master can do this */

		call iodc_$command_level ();		/* coord will do its own i/o */

		call iox_$control (iodd_static.master_in, "start", null, ec);
						/* just to be safe */

		return;
	     end;

	err_mess = "The coord command is for master terminal test mode only.";
	go to error;


ctl_term_command:
	if arg_list.n < 2
	then do;					/* must be one arg to the command */
	     err_mess = "Expected argument missing.";
	     go to error;
	end;

	if ^iodd_static.ctl_term.attached
	then do;					/* there must be one attached */
	     err_mess = "Control terminal not attached.";
	     go to error;
	end;

	if args (1) = "detach"
	then do;					/* drop the thing forever */
	     if source = master
	     then do;				/* if the master says so */
		call ios_$order (iodd_static.ctl_io, "hangup", null, io_stat);
						/* give back to answering service */
		if (iodd_static.slave_output = iodd_static.ctl_output) & iodd_static.slave.active
		then do;
		     iodd_static.slave.active = "0"b;	/* it was also the slave..drop it too */
		     call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
						/* don't forget this */
		     call ios_$detach ("broadcast_errors", iodd_static.slave_output, "", io_stat);
		     iodd_static.slave.allow_quits = "0"b;
		     iodd_static.slave.print_errors = "0"b;
		     iodd_static.slave.log_msg = "0"b;
		     iodd_static.slave.accept_input = "0"b;
		     iodd_static.slave_out = null;	/* cancel the iocb ptrs too */
		     iodd_static.slave_in = null;
		     iodd_static.slave_output = null_stream;
		     iodd_static.slave_input = null_stream;
		end;
		call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
		call ios_$detach (iodd_static.ctl_output, "", "", io_stat);
		call ios_$detach (iodd_static.ctl_input, "", "", io_stat);
		iodd_static.ctl_term.attached = "0"b;
		iodd_static.ctl_term.forms = "0"b;
		iodd_static.ctl_output = null_stream;
		iodd_static.ctl_input = null_stream;
		iodd_static.ctl_io = null_stream;
		return;
	     end;					/* all cleared out now */
	     err_mess = "Only the master terminal can detach the control terminal.";
	     go to error;

	end;

	if args (1) = "simulate"
	then do;					/* initiate terminal FF simulation */

	     if ^iodd_static.forms
	     then do;				/* be sure we are not already doing so */
		iodd_static.ctl_term.ctl_dev_dim = "form_";
						/* record the new dim name */
		call ios_$attach (iodd_static.ctl_output, "form_", iodd_static.ctl_io, "", io_stat);
						/* was using "syn" */
		call ios_$attach (iodd_static.ctl_input, "form_", iodd_static.ctl_io, "", io_stat);
		if st.code ^= 0
		then do;				/* errors??? */
		     ec = st.code;
		     call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold.");
		     iodd_static.master_hold = "1"b;
		     return;
		end;

		iodd_static.forms = "1"b;		/* this is the important part */

		call iodd_msg_ (normal, source, 0, "", "Forms will have to be aligned.");

		return;
	     end;

	     err_mess = "Already simulating forms.";	/* someone goofed */
	     go to error;
	end;

	if args (1) = "aligned"
	then do;

	     if iodd_static.forms
	     then do;				/* only when simulating */
		call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat);
		if st.code ^= 0
		then do;
		     ec = st.code;
		     call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold.");
		     iodd_static.master_hold = "1"b;
		end;
		return;
	     end;

	     err_mess = "Driver not simulating forms.";
	     go to error;
	end;

/*	The remaining functions of this command require an additional argument */

	if arg_list.n < 3
	then do;					/* one check for all command keywords */
	     err_mess = "Invalid ctl_term command request:" || substr (command_line, 9);
	     go to error;
	end;

	if args (1) = "form_type" | args (1) = "formtype"
	then do;

	     if args (2) = "default"
	     then do;				/* we can't really set the default here */
		iodd_static.form_type = "undefined_form";
						/* so do what we can and then... */
		go to pass_on;			/* see if the driver_module wants to change it */
	     end;

	     if args (2) = "none"
	     then iodd_static.form_type = "undefined";	/* special type to supress forms */
	     else iodd_static.form_type = args (2);	/* gobble it up...we'll check it later */

	     return;
	end;

	if args (1) = "modes"
	then do;					/* change the modes of the output stream */

	     mode = args (2);			/* copy them to fixed length string */
	     omode = "not returned";			/* just to make the message clear */

	     call ios_$changemode (iodd_static.ctl_output, mode, omode, io_stat);
	     if st.code ^= 0
	     then do;				/* OOPS */
		ec = st.code;			/* report the error */
		call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold.");
		iodd_static.master_hold = "1"b;
	     end;

	     call iodd_msg_ (normal, source, 0, "", "Mode was: ^a", omode);

	     return;
	end;

	if args (1) = "page_length" | args (1) = "pagelength"
	then do;
	     if ^iodd_static.forms
	     then do;				/* must be simulating paging */
		err_mess = "Driver not simulating forms.";
		go to error;
	     end;

	     i = convert (fixed_bin, args (2));

	     call ios_$order (iodd_static.ctl_output, "page_length", addr (i), io_stat);
	     if st.code ^= 0
	     then do;
		ec = st.code;
		call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold.");
		iodd_static.master_hold = "1"b;
	     end;

	     return;
	end;

	err_mess = "Undefined ctl_term request:" || substr (command_line, 9);
	go to error;


debug_command:
	if source = master
	then if iodd_static.test_entry
	     then do;

		call iodd_msg_ (normal, master, 0, "", "Calling debug");
						/* give reassuring message */
		call debug ();
		return;
	     end;

	err_mess = "The debug command is for master terminal test mode only.";
	go to error;


defer_command:
	if iodd_static.request_in_progress
	then do;
	     desc_ptr = addr (iodd_static.driver_ptr -> driver_status.descriptor);
	     if desc_ptr -> request_descriptor.restarted
	     then do;

		err_mess = "Request was restarted and is no longer in the queue. Use ""save"".";
		go to error;
	     end;
	     if source = slave
	     then if iodd_static.master_hold
		then do;				/* don't interrupt the master */
		     err_mess = "Driver in hold by master terminal.";
		     go to error;
		end;
	     desc_ptr -> request_descriptor.finished = "1"b;
	     desc_ptr -> request_descriptor.keep_in_queue = "1"b;
	     call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
	     if iodd_static.slave.active
	     then call iox_$control (iodd_static.slave_in, "start", null, ec);
	     signal daemon_defer;			/* tell the driver module (or subr ) */
	     return;
	end;
	err_mess = "No current request to defer.";
	go to error;


defer_time_command:
	if arg_list.n = 1
	then do;					/* command and no args */
	     if iodd_static.assigned_devices > 1
	     then do;				/* ambiguous */
		err_mess = "Multiple minor devices require a second argument - dev.";
		go to error;
	     end;
	     change_data = "0"b;			/* can only give current values */
	     dr_ptr = iodd_static.driver_ptr;		/* only one driver status seg */
	end;
	else if arg_list.n = 2
	then do;					/* one arg case dev or number */
	     if iodd_static.assigned_devices = 1 & verify (args (1), "1234567890.") = 0
	     then change_data = "1"b;			/* looks like a real number and its legal */
	     else change_data = "0"b;			/* must be a device id */

	     if ^change_data
	     then do;
		call find_minor_dev (args (1), dr_ptr, code);
		if code ^= 0
		then go to error;
	     end;
	     else do;
		what = args (1);			/* store the value to be converted */
		dr_ptr = iodd_static.driver_ptr;	/* must be current driver status seg */
	     end;
	end;
	else do;					/* 3 args case (don't look at any more) */
	     call find_minor_dev (args (1), dr_ptr, code);
	     if code ^= 0
	     then go to error;
	     change_data = "1"b;			/* there must be a time value */
	     what = args (2);			/* in the second argument */
	end;

	if ^change_data
	then do;					/* no data, just print current values */
	     if dr_ptr -> driver_status.defer_time_limit = 0
	     then message = "No auto defer time limit has been set.";
	     else call ioa_$rsnnl ("Auto defer time limit:  ^.1f minutes", message, i,
		     float (dr_ptr -> driver_status.defer_time_limit) / 60.0e0);

	     number = dr_ptr -> driver_status.bit_rate_est;
						/* get the xfr rate */

	     call iodd_msg_ (normal, source, 0, "",
		"^a^/Current transfer rate:  ^[^d bits/sec (^d chars/sec)^;undefined^s^s^]", message, (number > 0),
		number, divide (number, 9, 17));
	     return;				/* and we're done */
	end;

	number = fixed (convert (floating, what) * 60);	/* input is in minutes, store as seconds */
	if number < 10
	then number = 0;
	dr_ptr -> driver_status.defer_time_limit = number;

	call iodd_msg_ (normal, source, 0, "", "Changing auto defer time limit to:  ^[^.1f minutes^;no limit^s^]",
	     (number > 0), float (number) / 60.0e0);

	return;


go_command:					/* start processing requests */
	if state > listen_cmd_level
	then do;
	     err_mess = "The go command is not valid at this command level.";
	     go to error;
	end;

	if state = null_cmd_level & ^iodd_static.runout_requests
	then do;
	     err_mess = "No ready device.";
	     go to error;
	end;

	if source = slave & iodd_static.master_hold
	then do;
	     err_mess = "Driver in hold by master terminal.";
	     go to error;
	end;

	if arg_list.n = 1
	then iodd_static.requests_til_cmd = 0;
	else do;					/* operator wants to go for N requests */
	     if iodd_static.step
	     then do;
		err_mess = "The go command cannot recognize a number while in step mode.";
		go to error;
	     end;
	     i = convert (fixed_bin, args (1));		/* get the N as fixed bin */
	     if i < 1
	     then do;				/* a real value? */
		err_mess = "Invalid number of requests specified: " || args (1);
		go to error;
	     end;

	     iodd_static.requests_til_cmd = i;		/* OK, use the new value */
	end;

	iodd_static.master_hold = "0"b;
	iodd_static.slave_hold = "0"b;
	ec = 1;					/* give the "go" code */
	return;					/* let 'er rip */


halt_command:
	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if arg_list.n < 2
	then do;					/* no arguments */
	     if iodd_static.assigned_devices = 1
	     then call halt_all;			/* only legal for the one device case */
	     else do;				/* give error msg */
		err_mess = "Multiple minor devices require an argument.";
		go to error;
	     end;
	end;

	else do;					/* there were args ... check them */
	     if args (1) = "-all" | args (1) = "-a"
	     then call halt_all;			/* ctl arg must be first arg */
	     else do i = 1 to arg_list.n - 1;		/* only devices given ... search for them */

		call find_minor_dev (args (i), dr_ptr, code);
		if code = 0
		then do;
		     if dr_ptr -> driver_status.ready
		     then iodd_static.current_devices = iodd_static.current_devices - 1;
						/* reduce count */
		     dr_ptr -> driver_status.ready = "0"b;
						/* turn off the ready flag to stop driver */
		     if ^stac (addr (dr_ptr -> driver_status.request_pending), iodd_static.driver_proc_id)
		     then if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
			then do;
			     call iodd_msg_ (normal, source, 0, "", "Pending request for device ""^a""", args (i));
			     iodd_static.runout_requests = "1"b;
			end;
		end;
		else call iodd_msg_ (normal, source, 0, "", "Minor device ""^a"" not assigned.", args (i));
	     end;					/* look for next device arg */
	end;

	if iodd_static.runout_requests
	then do;					/* there was a pending request */
	     call iodd_msg_ (normal, source, 0, "", "Pending requests for halted devices will be processed.");
	     if state <= listen_cmd_level
	     then do;				/* avoid resetting after a quit */
		if source = master
		then iodd_static.master_hold = "0"b;	/* can we go? */
		if iodd_static.master_hold
		then do;
		     err_mess = "Driver in hold by master terminal.";
		     go to error;
		end;
		iodd_static.slave_hold = "0"b;	/* don't come back for another command until done */
		ec = 1;				/* do an automatic "go" from normal command level */
		return;
	     end;
	     return;
	end;

	if iodd_static.current_devices = 0
	then do;					/* nothing to run */
	     err_mess = "All devices are halted.";
	     go to error;
	end;
	return;


help_command:					/*	Put in a 1 line syntax description for each legal command */
	call iodd_msg_ (normal, source, 0, "", "^/** Standard Driver Commands **^/");
						/* title */

	call iodd_msg_ (normal, source, 0, "", "auto_start_delay [seconds]");
	call iodd_msg_ (normal, source, 0, "", "cancel");
	call iodd_msg_ (normal, source, 0, "", "ctl_term   <function>  [<function_value>]");
	call iodd_msg_ (normal, source, 0, "", "defer");
	call iodd_msg_ (normal, source, 0, "", "defer_time [dev] [mins]");
	call iodd_msg_ (normal, source, 0, "", "go [N]");
	call iodd_msg_ (normal, source, 0, "", "halt    (<dev1>...<devn>) | (-a|-all)");
	call iodd_msg_ (normal, source, 0, "", "hold");
	call iodd_msg_ (normal, source, 0, "", "inactive_limit [<minutes>]");
	call iodd_msg_ (normal, source, 0, "", "kill");
	call iodd_msg_ (normal, source, 0, "", "logout");
	call iodd_msg_ (normal, source, 0, "", "master  <message for master terminal>");
	call iodd_msg_ (normal, source, 0, "", "new_device");
	call iodd_msg_ (normal, source, 0, "", "next -user <pers.proj> -id ID -pn <path> -et <entry> -dev <dev>");
	call iodd_msg_ (normal, source, 0, "", "ready   (<dev1>...<devn>) | (-a|-all)");
	call iodd_msg_ (normal, source, 0, "", "reinit");
	call iodd_msg_ (normal, source, 0, "", "release | rl");
	call iodd_msg_ (normal, source, 0, "", "restart [<request_no> | -from <request_no>]");
	call iodd_msg_ (normal, source, 0, "", "restart_q [<minor_dev>]");
	call iodd_msg_ (normal, source, 0, "", "save    [<request_no> | -from <request_no>]");
	call iodd_msg_ (normal, source, 0, "", "slave   <message for slave terminal>");
	call iodd_msg_ (normal, source, 0, "", "slave_term <function>");
	call iodd_msg_ (normal, source, 0, "", "start");
	call iodd_msg_ (normal, source, 0, "", "status [-lg]");
	call iodd_msg_ (normal, source, 0, "", "step    [set|reset]");
	call iodd_msg_ (normal, source, 0, "", "x <site defined key> [<args>]");

	if iodd_static.test_entry
	then do;					/* only give the test commands in test mode */
	     call iodd_msg_ (normal, source, 0, "", "^/** Test Mode Commands **^/");
	     call iodd_msg_ (normal, source, 0, "", "coord");
	     call iodd_msg_ (normal, source, 0, "", "debug");
	     call iodd_msg_ (normal, source, 0, "", "probe");
	     call iodd_msg_ (normal, source, 0, "", "pi");
	     call iodd_msg_ (normal, source, 0, "", "resume");
	     call iodd_msg_ (normal, source, 0, "", "return");
	end;

	call driver_command (source, state, addr (arg_list), ec);

	call iodd_msg_ (normal, source, 0, "", "");	/* separate from command request */
	return;


hold_command:
	if source = slave
	then iodd_static.slave_hold = "1"b;		/* master hold will override */
	if source = master
	then iodd_static.master_hold = "1"b;
	return;


inactive_limit_command:
	if arg_list.n > 1
	then do;					/* new limit data? */
	     number = convert (fixed_bin, args (1));	/* get the value as fixed bin */
	     if number < 0 | number > 200
	     then do;
		err_mess = "Unreasonable inactivity time limit value: " || args (1) || " minutes";
		go to error;
	     end;

	     if number > 0
	     then do;				/* if not reseting, must be long enough for coord response */
		i = divide (2 * iodd_static.wakeup_time + 59, 60, 17);
						/* minutes for at least 2 wakeup intervals */
		if number < i
		then do;
		     call iodd_msg_ (normal, source, 0, "",
			"The minimum inactivity time limit for this driver is ^d minute^[s^], or zero to reset.", i,
			i > 1);
		     return;
		end;
	     end;

	     iodd_static.auto_logout_interval = number * 60;
						/* store as seconds for timer_manager_ */
	end;

	number = divide (iodd_static.auto_logout_interval, 60, 17);
						/* get current value as minutes */

	if number = 0
	then call iodd_msg_ (normal, source, 0, "", "Driver will not logout for inactivity.");
	else call iodd_msg_ (normal, source, 0, "",
		"Driver will automatically logout after ^d minute^[s^] of inactivity.", number, number > 1);

	return;


kill_command:
	what = "kill";				/* ready to make use of common code with cancel */

	go to cancel_or_kill;			/* see the cancel command */


logout_command:
	if source = master
	then iodd_static.master_hold = "0"b;

	if iodd_static.master_hold
	then do;
	     err_mess = "Cannot logout while driver in hold by master terminal.";
	     go to error;
	end;

	if arg_list.n > 1
	then if arg_list.args (1) ^= "-force"
	     then do;				/* recognize the obsolete arg */
		err_mess = "Invalid argument to logout command:  " || arg_list.args (1);
		go to error;
	     end;

	if source = slave
	then call iodd_msg_ (normal, master, 0, "", "Driver logout received from slave.");
	if iodd_static.slave.active
	then do;
	     call iodd_msg_ (normal, slave, 0, "", "^/Driver is logging out.^/");
	     call iox_$control (iodd_static.slave_out, "runout", null, ec);
	end;

	if (source = slave) & ^iodd_static.ctl_term.attached
						/* use special signal for remote slave */
	then signal daemon_slave_logout;		/* in case the driver module wants it */
	signal daemon_logout;			/* normal logout for the master or control terminal */
	return;					/* just to be tidy */


master_command:					/* slave wants to send master a message */
	if source = slave
	then do;
	     call iodd_msg_ (normal, master, 0, "From slave", substr (command_line, index (command_line, "master") + 6))
		;
	     return;
	end;
	call iodd_msg_ (normal, master, 0, "", "Invalid command for master terminal.");
						/* master talking to itself?? */
	return;


new_device_command:
	if source ^= master
	then do;					/* this one is restricted to the master */
	     err_mess = "The new_device command is valid from the master terminal only.";
	     go to error;
	end;

	if iodd_static.slave.active
	then call iodd_msg_ (normal, slave, 0, "", "^/Driver process changing to new device.^/");

	signal daemon_new_device;			/* if halt ran to completion, we are all set */
						/* if operator "QUIT" let it pass any way */
	return;

next_command:
	if iodd_static.assigned_devices = 1
	then number = 4;
	else number = 6;

	if arg_list.n < number + 1
	then do;
	     call ioa_$rsnnl ("Too few args. Specify -user <user> [-entry, -path or -id] <name> ^[-dev <minor_dev>^]",
		err_mess, len, (number = 6));
	     go to error;
	end;

	if mod (arg_list.n, 2) = 0
	then do;					/* must have command plus even number of args */
	     err_mess = "Arguments must be given in pairs.";
	     go to error;
	end;

	error_flag = ""b;
	string (option) = ""b;			/* clear the given option flags */
	coord_msg (*) = 0;				/* clear the message */
	iodd_comm.req_id = "";			/* set the char string which is optional */

	do idx = 1 to arg_list.n - 1 by 2;		/* go through the args */

	     if args (idx) = "-queue" | args (idx) = "-q"
	     then do;				/* OPTION = -queue */
		if option.q
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -queue control argument can only be given once.");
		end;
		else do;
		     option.q = "1"b;		/* mark it as given */
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     iodd_comm.queue_no = convert (fixed_bin, args (idx + 1));
		     if iodd_comm.queue_no < 1 | iodd_comm.queue_no > 4
		     then do;
			error_flag = "1"b;
			call iodd_msg_ (normal, source, 0, "", "Invalid queue number - ^a", args (idx + 1));
		     end;
		end;
	     end;
	     else if args (idx) = "-entry" | args (idx) = "-et"
	     then do;				/* OPTION = -entry */
		if option.pn
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -entry and -path control args are incomaptible.");
		end;
		else if option.et
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -entry control argument can only be given once.");
		end;
		else do;				/* OK to use it */
		     option.et = "1"b;		/* mark it */
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     iodd_comm.data_len = length (args (idx + 1));
		     iodd_comm.data = args (idx + 1);
		end;
	     end;
	     else if args (idx) = "-path" | args (idx) = "-pn"
	     then do;				/* OPTION = -path */
		if option.et
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -path and -entry control args are incompatible.");
		end;
		else if option.pn
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -path control argument can only be given once.");
		end;
		else do;				/* OK to use it */
		     option.pn = "1"b;		/* mark it */
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     iodd_comm.data_len = length (args (idx + 1));
		     iodd_comm.data = args (idx + 1);
		     if substr (args (idx + 1), 1, 1) ^= ">"
		     then do;
			error_flag = "1"b;
			call iodd_msg_ (normal, source, 0, "", "Full pathname must be given: ^a", args (idx + 1));
		     end;
		end;
	     end;
	     else if args (idx) = "-id"
	     then do;				/* OPTION = -id */
		if option.id
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -id control argument can only be given once.");
		end;
		else do;				/* OK to use it */
		     option.id = "1"b;		/* mark it as used */
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     iodd_comm.req_id = args (idx + 1);
		     if verify (iodd_comm.req_id, "0123456789. ") > 0
		     then do;
			error_flag = "1"b;
			call iodd_msg_ (normal, source, 0, "", "Invalid request id: ^a", iodd_comm.req_id);
		     end;
		end;
	     end;
	     else if args (idx) = "-user"
	     then do;				/* OPTION = -user */
		if option.user
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -user control argument can only be given once.");
		end;
		else do;				/* OK record the user name */
		     option.user = "1"b;
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     person = before (args (idx + 1), ".");
		     project = before (after (args (idx + 1), "."), ".");
						/* in case the tag was given */
		     if person = "" | project = ""
		     then do;			/* not nice */
			error_flag = "1"b;
			call iodd_msg_ (normal, source, 0, "", "The full person and project names must be given.");
		     end;
		     iodd_comm.user_id = rtrim (person) || "." || project;
		end;
	     end;
	     else if args (idx) = "-device" | args (idx) = "-dev"
	     then do;				/* OPTION = -device */
		if option.dev
		then do;
		     error_flag = "1"b;
		     call iodd_msg_ (normal, source, 0, "", "The -device control argument can only be given once.");
		end;
		else do;
		     option.dev = "1"b;
		     if substr (args (idx + 1), 1, 1) = "-"
		     then go to bad_order;		/* was it an option? */
		     call find_minor_dev (args (idx + 1), dr_ptr, code);
		     if code ^= 0
		     then do;
			error_flag = "1"b;
			call iodd_msg_ (normal, source, 0, "", err_mess);
		     end;
		     else iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index;
		end;
	     end;
	     else do;				/* OPTION = Not Defined Here */
		if substr (args (idx), 1, 1) = "-"
		then call iodd_msg_ (normal, source, 0, "", "Undefined control argument ^d", args (idx));
		else do;
bad_order:
		     call iodd_msg_ (normal, source, 0, "", "Arguments missing or out of sequence at: ^a", args (idx))
			;
		end;
		error_flag = "1"b;
		idx = idx - 1;			/* try to get back in sync */
	     end;
	end;

	if error_flag
	then return;				/* that's all */

	if ^option.dev
	then do;
	     if iodd_static.assigned_devices > 1
	     then do;
		err_mess = "For multiple minor devices, the -device control argument must be given.";
		go to error;
	     end;
	     option.dev = "1"b;			/* single device, we will assume it */
	     iodd_comm.minor_idx = iodd_static.driver_ptr -> driver_status.dev_index;
	end;

	error_flag = ^option.user | ^(option.et | option.pn | option.id);

	if error_flag
	then do;
	     err_mess = "Minimum args required are user and some request identifier.";
	     go to error;
	end;

/*	we should have a good request now */

	iodd_comm.type = next_req;			/* finish off the data */
	iodd_comm.type_ext = string (option);		/* show the given options to coord */

	err_mess = "";
	call send_coord_msg (code, number);
	if code ^= 0
	then call iodd_msg_ (normal, source, code, "", err_mess);
	else call iodd_msg_ (normal, source, 0, "", "Request found.");

	return;


probe_command:
	if source = master
	then if iodd_static.test_entry
	     then do;

		call iodd_msg_ (normal, master, 0, "", "Calling probe");
						/* give reassuring message */
		call probe ();
		return;
	     end;

	err_mess = "The probe command is for master terminal test mode only.";
	go to error;

pi_command:
	if iodd_static.test_entry
	then if source = master
	     then do;				/* very restricted */

		call iox_$control (iodd_static.master_in, "start", null, ec);
						/* play safe */
		signal program_interrupt;		/* back to debug .. we hope */

		return;
	     end;

	err_mess = "The pi command is only valid from the master terminal in test mode.";

	go to error;


ready_command:					/* put the devices in the ready state */
	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if arg_list.n < 2
	then do;					/* no arguments */
	     if iodd_static.assigned_devices = 1
	     then call ready_all;			/* only legal for the one device case */
	     else do;				/* give error msg */
		err_mess = "Multiple minor devices require an argument.";
		go to error;
	     end;
	end;
	else do;					/* there were args ... check them */
	     do i = 1 to arg_list.n - 1;		/* if we find "-all" we are done */
		if args (i) = "-a" | args (i) = "-all"
		then do;
		     call ready_all;
		     return;			/* that's all there is to it */
		end;
	     end;
	     do i = 1 to arg_list.n - 1;		/* only devices given ... search for them */

		call find_minor_dev (args (i), dr_ptr, code);
		if code = 0
		then do;
		     if dr_ptr -> driver_status.attached
		     then do;			/* can only ready attached devices */
			if ^dr_ptr -> driver_status.ready
			then do;
			     iodd_static.current_devices = iodd_static.current_devices + 1;
						/* increase count */
			     dr_ptr -> driver_status.ready = "1"b;
						/* turn on the ready flag to ready driver */
			end;
			if dr_ptr -> driver_status.request_pending
			then			/* check for driver pid */
			     if dr_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id
			     then dr_ptr -> driver_status.request_pending = (36)"0"b;
		     end;
		     else do;			/* not attached, check the count */
			if dr_ptr -> driver_status.ready
			then current_devices = current_devices - 1;
			dr_ptr -> driver_status.ready = "0"b;
						/* be sure it is not ready */
			call iodd_msg_ (normal, source, 0, "", "Device ""^a"" is not attached.", args (i));
		     end;
		end;
		else call iodd_msg_ (normal, source, 0, "", "Minor device ""^a"" not assigned.", args (i));
	     end;					/* look for next device arg */
	end;
	return;


reinit_command:					/* this will force the driver to re-initialize */
	if source = master
	then iodd_static.master_hold = "0"b;		/* always go for master */
	if iodd_static.master_hold
	then do;					/* protect the master */
	     err_mess = "Driver in hold by master terminal.";
	     go to error;
	end;

	signal re_init;				/* OK, here we go! */

	return;


release_command:
	if (state < signal_cmd_level) | (source = master)
	then do;
	     if source = master
	     then iodd_static.master_hold = "0"b;
	     if iodd_static.master_hold
	     then do;				/* don't interrupt the master */
		err_mess = "Driver in hold by master terminal.";
		go to error;
	     end;
	     if iodd_static.request_in_progress
	     then call iodd_msg_ (normal, source, 0, "", "Warning - Request in progress will be run again.");
	     iodd_static.driver_ptr -> driver_status.busy = "0"b;
						/* don't throw away a pending request */
	     iodd_static.slave_hold = "1"b;		/* force a command at normal level */
	     call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
	     if iodd_static.slave.active
	     then call iox_$control (iodd_static.slave_in, "start", null, ec);
	     signal resume;				/* go back to iodd_listen_ */
	     iodd_static.master_hold = "1"b;		/* OOPS, trouble. */
	     return;
	end;
	err_mess = "The release command is only valid from the master terminal at this command level.";
	go to error;


restart_command:
	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if source = slave
	then if iodd_static.master_hold
	     then do;				/* can't override the master */
		err_mess = "Command not valid while process is in hold by master terminal.";
		go to error;
	     end;

	if arg_list.n = 1
	then do;					/* no sequence number given */
	     if (state > listen_cmd_level) & iodd_static.request_in_progress
	     then do;
		iodd_static.master_hold = "0"b;	/* this must be the master or value is already 0 */
		iodd_static.slave_hold = "0"b;	/* be sure they are off for next command level */
		call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
		if iodd_static.slave.active
		then call iox_$control (iodd_static.slave_in, "start", null, ec);
		if source = master
		then signal daemon_again;		/* say it was the master */
		else signal daemon_again_slave;	/* otherwise it was the slave */
	     end;
	     else do;
		err_mess = "No current request to restart.";
		go to error;
	     end;
	     return;
	end;

	iodd_comm.type = restart;			/* mark the type so following can be used for save */

restart_or_save:
	if args (1) = "-from"
	then do;					/* this is a series request */
	     series_sw = "1"b;
	     seq_id = convert (fixed_bin_35, args (2));
	end;
	else do;					/* a single request */
	     seq_id = convert (fixed_bin_35, args (1));
	     series_sw = "0"b;
	end;

	iodd_comm.data_len = 0;			/* construct the command for the coord */
	iodd_comm.queue_no = 0;
	iodd_comm.user_id = "";			/* don't care, but initialize */
	iodd_comm.req_id = "";
	dr_ptr = iodd_static.driver_ptr;		/* need any minor device index, use current */
	iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index;
						/* say who we are */
	iodd_comm.dvc_idx = dr_ptr -> driver_status.maj_index;
	iodd_comm.request_no = seq_id;		/* pass on the request number */
	iodd_comm.type_ext = series_sw;		/* use type extension to indicate single/series */
	err_mess = "";				/* clear the message for the int proc */

	call send_coord_msg (code, number);		/* ship it */
	if code ^= 0
	then do;
	     if code = error_table_$namedup
	     then err_mess = "A restart is already in progress.";
	     else if code = error_table_$noentry
	     then err_mess = "Request number not found in saved list.";
	     else if code = error_table_$action_not_performed
	     then err_mess = "The specified request series is invalid for this driver.";
	     call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver", "^a", err_mess);
	     return;
	end;

	if ^series_sw | iodd_comm.type = save
	then return;

	if number ^= seq_id
	then call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver",
		"Series will be restarted from request ^d", number);

	restart_series = divide (seq_id, 10000, 35, 0);	/* get the series he restarted */

	do i = 1 to iodd_static.assigned_devices;	/* see if there is a pending request */
						/* of the same series */
	     dr_ptr = driver_ptr_list.stat_segp (i);	/* look at each driver_status seg */
	     desc_ptr = addr (dr_ptr -> driver_status.descriptor);
						/* and request descriptor */

	     series = desc_ptr -> request_descriptor.seq_id;
						/* get the seq no of this request */

	     series = divide (series, 10000, 35, 0);	/* strip out the series number */

	     if restart_series = series
	     then do;				/* if they match, we are done with the search */
		if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
		then do;				/* is it active? */
		     desc_ptr -> request_descriptor.finished = "1"b;
						/* mark it done so we can pass back */
		     if dr_ptr -> driver_status.ready
		     then dr_ptr -> driver_status.request_pending = (36)"0"b;
						/* clear the pending flag */
		     else dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id;
						/* or busy the driver */
		     if dr_ptr -> driver_status.busy
		     then do;			/* was driver processing the request? */
			iodd_static.slave_hold = "1"b;/* return to command level after aborting request */
			if iodd_static.request_in_progress
			then signal daemon_save;	/* try a normal save, or ... */
			signal resume;		/* send the current request back to the coord */
		     end;
		     else do;			/* we want to send a pending request back to the coord */
			dr_ptr -> driver_status.last_wake_time = 0;
						/* force driver to request new one */
			event_message = 0;		/* clear the message to the coord */
			msgp = addr (event_message);
			msgp -> ev_msg.code = 0;	/* code 0 means take back this request and wait */
			msgp -> ev_msg.minor_dev_index =
						/* tell which driver it was */
			     fixed (dr_ptr -> driver_status.dev_index, 17);

			call hcs_$wakeup (iodd_static.coord_proc_id, dr_ptr -> driver_status.coord_chan,
			     event_message, code);

			if code ^= 0
			then signal no_coord;	/* again, errors are bad news!! */
		     end;
		end;
		return;				/* we don't have to look at anything more */
	     end;
	end;					/* end of the loop for assigned devices */
	return;


restart_q_command:
	if iodd_static.assigned_devices > 1 & arg_list.n = 1
	then do;					/* device needed? */
	     err_mess = "Multiple minor devices require an argument.";
	     go to error;
	end;

	if arg_list.n > 1
	then do;					/* find the minor device index as requested */
	     call find_minor_dev (args (1), dr_ptr, code);
	     if code ^= 0
	     then go to error;			/* msg has been set */
	     iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index;
	     iodd_comm.dvc_idx = dr_ptr -> driver_status.maj_index;
	end;
	else do;
	     iodd_comm.minor_idx = iodd_static.driver_ptr -> driver_status.dev_index;
	     iodd_comm.dvc_idx = iodd_static.driver_ptr -> driver_status.maj_index;
	end;

/*	now complete the message */

	iodd_comm.type = restart_q;
	iodd_comm.type_ext = ""b;
	iodd_comm.request_no = 0;
	iodd_comm.queue_no = 0;			/* we restart all queues */
	iodd_comm.data_len = 0;			/* define a null char string */
	iodd_comm.req_id = "";
	iodd_comm.user_id = "";
	err_mess = "";

	call send_coord_msg (code, number);

	if code ^= 0
	then call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver", err_mess);

	else call iodd_msg_ (normal, source, 0, "", "Coord has restarted the queues.");


	return;


resume_command:
	if iodd_static.test_entry & (source = master)
	then do;
	     iodd_static.slave_hold = "1"b;		/* force a command at normal level */
	     call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
	     if iodd_static.slave.active
	     then call iox_$control (iodd_static.slave_in, "start", null, ec);
	     signal resume;				/* go back to iodd_listen_ */
	     iodd_static.master_hold = "1"b;		/* OOPS, trouble.  But, master did it */
	     return;
	end;

	err_mess = "The resume command is valid from the master terminal in test mode only.";

	go to error;


return_command:
	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if iodd_static.test_entry
	then if source = master
	     then do;
		driver_ptr_list.number = 0;		/* don't tell the coord we are going away */
		signal daemon_logout;
		iodd_static.master_hold = "1"b;	/* we won't get here, but.... */
		return;
	     end;

	err_mess = "The return command is only valid from the master terminal in test mode.";
	return;


save_command:					/* ask coord to save requests in our device class */
	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if arg_list.n > 1
	then do;					/* the N or -from N case */
	     iodd_comm.type = save;			/* mark the type of command */
	     go to restart_or_save;			/* use some common code with restart */
	end;
	if source = slave
	then if iodd_static.master_hold
	     then do;				/* can't override the master */
		err_mess = "Command not valid while process is in hold by master terminal.";
		go to error;
	     end;

	if (state > listen_cmd_level) & iodd_static.request_in_progress
	then do;
	     iodd_static.master_hold = "0"b;		/* this must be the master or value is already 0 */
	     iodd_static.slave_hold = "0"b;		/* be sure they are off for next command level */
	     call iox_$control (iodd_static.master_in, "start", null, ec);
						/* avoid lost wakeups */
	     if iodd_static.slave.active
	     then call iox_$control (iodd_static.slave_in, "start", null, ec);
	     desc_ptr = addr (iodd_static.driver_ptr -> driver_status.descriptor);
	     desc_ptr -> request_descriptor.saved = "1"b;
	     desc_ptr -> request_descriptor.finished = "1"b;
	     desc_ptr -> request_descriptor.cancelled = ""b;
						/* just to be sure */

	     signal daemon_save;			/* try for a clean finish of what was done */
	     ec = 2;				/* make like a start command was given */
	     return;
	end;
	else do;
	     err_mess = "No current request to save.";
	     go to error;
	end;

	return;


slave_command:
	if source = master
	then					/* slave can't send itself a message */
	     if iodd_static.slave.active
	     then do;
		call iodd_msg_ (normal, slave, 0, "", "From master: ^a",
		     substr (command_line, index (command_line, "slave") + 5));
		call iox_$control (iodd_static.slave_out, "runout", null, code);
		return;
	     end;
	     else do;
		err_mess = "Slave device is not active.";
		go to error;
	     end;

	err_mess = "Invalid command for slave terminal.";
	go to error;


slave_term_command:
	if ^iodd_static.slave.active
	then do;
	     err_mess = "Slave terminal is not active.";
	     go to error;
	end;

	if arg_list.n < 2
	then do;
	     err_mess = "Expected argument missing.";
	     go to error;
	end;

	if args (1) = "errors"
	then do;
	     iodd_static.slave.print_errors = "1"b;
	     call ios_$attach ("error_output", "syn", "broadcast_errors", "", io_stat);
	end;

	else if args (1) = "no_errors" | args (1) = "noerrors"
	then do;
	     iodd_static.slave.print_errors = "0"b;
	     call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
	end;

	else if args (1) = "commands"
	then do;
	     if source = slave
	     then do;
		call master_only ("slave_term " || args (1));
		return;
	     end;
	     iodd_static.accept_input = "1"b;
	     if state >= quit_cmd_level & ^iodd_static.slave.allow_quits
	     then call iodd_msg_ (normal, master, 0, "",
		     "This will not be effective at this level while quits are disabled.");
	end;

	else if args (1) = "no_commands" | args (1) = "nocommands"
	then do;
	     if source = slave
	     then do;
		call master_only ("slave_term " || args (1));
		return;
	     end;
	     iodd_static.accept_input = "0"b;
	     if state >= quit_cmd_level
	     then call iodd_msg_ (normal, master, 0, "",
		     "WARNING: The previous command input state may be restored after start.");
	end;

	else if args (1) = "quits"
	then do;
	     if source = slave
	     then do;
		call master_only ("slave_term " || args (1));
		return;
	     end;
	     iodd_static.allow_quits = "1"b;
	end;

	else if args (1) = "no_quits" | args (1) = "noquits"
	then do;
	     if source = slave
	     then do;
		call master_only ("slave_term " || args (1));
		return;
	     end;
	     iodd_static.allow_quits = "0"b;
	end;

	else if args (1) = "log"
	then do;
	     iodd_static.slave.log_msg = "1"b;
	end;

	else if args (1) = "no_log" | args (1) = "nolog"
	then do;
	     iodd_static.slave.log_msg = "0"b;
	end;

	else if args (1) = "echo"
	then do;
	     iodd_static.slave.echo_cmd = "1"b;
	end;

	else if args (1) = "no_echo" | args (1) = "noecho"
	then do;
	     iodd_static.slave.echo_cmd = "0"b;
	end;

	else if args (1) = "modes"
	then do;					/* see if he wants a changemode */
	     if arg_list.n < 3
	     then do;				/* just report current mode */
		mode = "";
		message = "Current_modes:";
	     end;
	     else do;
		mode = args (2);
		message = "Modes were:";
	     end;
	     omode = "not returned";			/* just to make the message clear */

	     call ios_$changemode (iodd_static.slave_output, mode, omode, io_stat);
	     if st.code ^= 0
	     then do;				/* OOPS */
		ec = st.code;			/* report the error */
		call iodd_msg_ (normal, both, ec, whoami);
	     end;
	     call iodd_msg_ (normal, source, 0, "", "^a ^a", message, omode);
	end;

	else do;					/* otherwise ...not implemented here */
	     ec = unknown_cmd_code;			/* see if driver module recognizes it */
	     err_mess = "Invalid function for slave_term command: " || args (1);
	     go to pass_on;				/* give it to the driver module for action */
	end;
	return;


start_command:
	if state > listen_cmd_level
	then do;					/* we use start after a quit */
	     iodd_static.slave_hold = "0"b;
	     if source = master
	     then iodd_static.master_hold = "0"b;
	     if iodd_static.master_hold
	     then do;
		err_mess = "Driver in hold by master terminal.";
		go to error;
	     end;
	     ec = 2;				/* this is the start code for the quit handler */
	     return;
	end;

	err_mess = "The ""start"" command is not valid at this level.";
	go to error;



status_command:
	if arg_list.n > 1
	then do;
	     if args (1) = "-long" | args (1) = "-lg"
	     then lg_sw = "1"b;			/* gave the long option */
	     else do;
		err_mess = "Invalid control argument: " || args (1);
		go to error;
	     end;
	end;
	else lg_sw = "0"b;

	list_ptr = iodd_static.driver_list_ptr;		/* make the reference easier */

	if iodd_static.step
	then message = "(step mode set)";
	else message = "";

	call iodd_msg_ (normal, source, 0, "", "^/IO Daemon Version: ^a^/Device:^2x^a^3x^a:^2x^a^3x^a",
	     iodd_static.io_daemon_version, iodd_static.major_device, chn_type (iodd_static.attach_type),
	     iodd_static.attach_name, message);

	if iodd_static.assigned_devices = 1
	then do;					/* different form for one device */
	     dr_ptr = iodd_static.driver_ptr;		/* use the current driver */
	     call iodd_msg_ (normal, source, 0, "", "Request type:  ^a", dr_ptr -> driver_status.req_type_label);
	     call get_driver_status (message);
	     call iodd_msg_ (normal, source, 0, "", "Status:^8x^a^/", message);
	     return;
	end;

/* determine length to generate legible display */
	device_id_length, req_type_label_length = 12;
	do i = 1 to iodd_static.assigned_devices;
	     dr_ptr = driver_ptr_list.stat_segp (i);
	     if dr_ptr -> driver_status.attached | lg_sw
	     then do;
		if length (rtrim (dr_ptr -> driver_status.device_id)) > device_id_length
		then device_id_length = length (rtrim (dr_ptr -> driver_status.device_id));
		if length (rtrim (dr_ptr -> driver_status.req_type_label)) > req_type_label_length
		then req_type_label_length = length (rtrim (dr_ptr -> driver_status.req_type_label));
	     end;
	end;
	call iodd_msg_ (normal, source, 0, "", "^/minor device^vx  request type^vx  status^/", device_id_length - 12,
	     req_type_label_length - 12);

	do i = 1 to iodd_static.assigned_devices;
	     dr_ptr = driver_ptr_list.stat_segp (i);
	     if dr_ptr -> driver_status.attached | lg_sw
	     then do;
		call get_driver_status (message);
		call iodd_msg_ (normal, source, 0, "", "^va  ^va  ^a", device_id_length,
		     dr_ptr -> driver_status.device_id, req_type_label_length, dr_ptr -> driver_status.req_type_label,
		     message);
	     end;
	end;

	call iodd_msg_ (normal, source, 0, "", "^/");	/* separate from command request */

	return;


step_command:
	if arg_list.n > 1
	then do;					/* an argument was given */
	     if args (1) = "set"
	     then iodd_static.step = "1"b;
	     else if args (1) = "reset"
	     then iodd_static.step = "0"b;
	     else do;				/* unknown arg */
		err_mess = "Valid arguments are set and reset.";
		go to error;
	     end;
	end;
	else iodd_static.step = "1"b;
	return;


x_command:
	if search (command_line, bad_chars) > 0
	then do;					/* trying to trick us? */
	     call iodd_msg_ (normal, source, 0, "", "Invalid characters in command line.");
	     ec = unknown_cmd_code;
	     return;
	end;

	on any_other call x_cmd_handler;		/* in case ec gets into trouble */
	on cleanup call reattach_master;

	if source = slave
	then do;					/* for slave, we must swap streams around */
	     call swap_user_io_streams (ec);
	     if ec ^= 0
	     then do;
		err_mess = "Unable to switch user io switches to salve.";
		call reattach_master;
		go to error;
	     end;
	end;
	else do;					/* for master, be sure slave doesn't get error messages */
	     att_desc = "syn_ error_i/o -inhibit close";
	     call iox_$detach_iocb (iox_$error_output, ec);
	     call iox_$attach_ptr (iox_$error_output, att_desc, null, ec);
	     if ec ^= 0
	     then do;
		err_mess = "Error switching error_output.";
		call reattach_master;		/* try like hell */
		go to error;
	     end;
	end;

	tried_once = "0"b;				/* get set for not finding <device>_admin.ec */
	ec_name = iodd_static.admin_ec_name;		/* get the first name */

once_more:
	call hcs_$initiate (iodd_static.sys_dir_ptr -> sys_dir, ec_name, "", 0, 1, segp, code);
	if segp = null
	then do;					/* not there */
	     if ^tried_once
	     then do;				/* look for iod_admin.ec */
		ec_name = "iod_admin.ec";
		tried_once = "1"b;			/* say we have tried once already */
		go to once_more;			/* try_again */
	     end;
	     ec = code;				/* too bad, give up */
	     err_mess = "Unable to find " || rtrim (iodd_static.admin_ec_name) || " or iod_admin.ec for this driver.";
	     call reattach_master;
	     go to error;
	end;

	if iodd_static.admin_ec_name ^= ec_name
	then do;					/* if we switched, tell operator */
	     call iodd_msg_ (normal, source, 0, "", "Using ^a for x command.", ec_name);
	     iodd_static.admin_ec_name = ec_name;	/* incase we had to switch */
	end;

	command =
	     "exec_com " || rtrim (iodd_static.sys_dir_ptr -> sys_dir) || ">" || rtrim (ec_name)
	     || substr (command_line, index (command_line, "x") + 1);
						/* be sure to leave in the leading space */

	call cu_$cp (addr (command), length (rtrim (command)), code);
	if code ^= 0
	then ec = unknown_cmd_code;			/* force a reset_read */

	call reattach_master;

	return;


/*      END OF DEFINED COMMANDS     */
/* ************************************ */

/* *********************************** */





init:
     entry (a_ptr);					/* initialize the static data */

dcl  a_ptr ptr;

	stat_p = a_ptr;				/* set the pointer to iodd_static */


	return;

/*	**** INTERNAL PROCEDURES ****		*/


halt_all:
     proc;					/* unready all devices assigned to the process */

dcl  i fixed bin;					/* don't destroy the one in the external proc */

	do i = 1 to iodd_static.assigned_devices;

	     dr_ptr = driver_ptr_list.stat_segp (i);
	     dr_ptr -> driver_status.ready = "0"b;	/* turn off the ready flag to stop driver */
	     if ^stac (addr (dr_ptr -> driver_status.request_pending), iodd_static.driver_proc_id)
	     then do;
		if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
		then iodd_static.runout_requests = "1"b;/* there was a pending request */
	     end;
	     iodd_static.current_devices = 0;		/* reset the count...all stopped */

	end;

     end halt_all;



ready_all:
     proc;					/* ready all attached minor devices */

dcl  i fixed bin;					/* save the variable in external proc */

	iodd_static.current_devices = 0;		/* clear the count */

	do i = 1 to iodd_static.assigned_devices;
	     dr_ptr = driver_ptr_list.stat_segp (i);	/* get driver ptr */
	     if dr_ptr -> driver_status.attached
	     then do;
		dr_ptr -> driver_status.ready = "1"b;
		iodd_static.current_devices = iodd_static.current_devices + 1;
						/* one more ready */
		if dr_ptr -> driver_status.request_pending
		then				/* if open to coord, leave it alone */
		     if dr_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id
		     then dr_ptr -> driver_status.request_pending = (36)"0"b;
	     end;
	     else do;
		dr_ptr -> driver_status.ready = "0"b;	/* just to be sure */
		dr_ptr -> driver_status.busy = "0"b;
	     end;
	end;

     end ready_all;


get_driver_status:
     proc (status);

/* internal procedure to set a string description of the driver status seg pointed */
/* to by dr_ptr. */

dcl  status char (*);
dcl  string char (32);
dcl  len fixed bin;
dcl  pending bit (1);

	if dr_ptr -> driver_status.ready
	then status = "ready";

	else if dr_ptr -> driver_status.attached
	then status = "halted";

	else status = "not attached";

	if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
	then do;					/* request there? */
	     desc_ptr = addr (dr_ptr -> driver_status.descriptor);
	     pending = ^((dr_ptr = iodd_static.driver_ptr) & iodd_static.request_in_progress);
	     seq_id = desc_ptr -> request_descriptor.seq_id;
	     call ioa_$rsnnl ("request ^d ^[pending^;in progress^]", string, len, seq_id, pending);
	     substr (status, 16) = string;
	end;

	return;

     end get_driver_status;


find_minor_dev:
     proc (dev_id, dr_ptr, code);

dcl  dev_id char (*) var;
dcl  dr_ptr ptr;
dcl  code fixed bin (35);
dcl  j fixed bin;


	code = 0;
	list_ptr = iodd_static.driver_list_ptr;
	do j = 1 to iodd_static.assigned_devices;
	     dr_ptr = driver_ptr_list.stat_segp (j);
	     if dr_ptr -> driver_status.device_id = dev_id
	     then return;				/* found the device */
	end;
	code = error_table_$noentry;
	err_mess = "Invalid minor device name: " || dev_id;
	return;

     end find_minor_dev;

master_only:
     proc (msg);

dcl  msg char (*);

	call iodd_msg_ (normal, source, 0, "", "^a driver:  Invalid function from the slave terminal.  ^a",
	     iodd_static.major_device, msg);

	ec = unknown_cmd_code;

	return;

     end master_only;



x_cmd_handler:
     proc;					/* any_other handler for the x command */

dcl  code fixed bin (35);				/* local error code */
dcl  type char (32);

	cond_info.version = 1;

	call find_condition_info_ (null, addr (cond_info), code);

	type = cond_info.condition_name;		/* for easy reference */
	if type = "cput"
	then do;
continue_signal:
	     call continue_to_signal_ (code);		/* this is harmless */
	     return;
	end;
	if type = "alrm"
	then go to continue_signal;
	if type = "finish"
	then go to continue_signal;
	if type = "command_error"
	then return;
	if type = "command_question"
	then do;
	     cq_info_ptr = cond_info.info_ptr;		/* get pointer to question info structure */
	     if command_question_info.version >= cq_info_version_5
	     then do;				/* if we can */
		command_question_info.question_iocbp = iox_$user_output;
						/* set the switches for Q and A */
		command_question_info.answer_iocbp = iox_$user_input;
		command_question_info.repeat_time = 120;/* ask every 2 minutes */
	     end;
	     return;
	end;
	if iodd_static.test_entry
	then if type = "mme2"
	     then go to continue_signal;
	     else if type = "program_interrupt"
	     then go to continue_signal;

	call ioa_ ("Error: ^a condition during the driver x command.  Command aborted.", type);

	call reattach_master;

	go to ignore;				/* go back to command level */

     end x_cmd_handler;

swap_user_io_streams:
     proc (code);

dcl  code fixed bin (35);

	code = 0;

	att_desc = "syn_ " || rtrim (iodd_static.slave_output) || " -inhibit close";

	call iox_$detach_iocb (iox_$user_output, code);
	if code ^= 0
	then return;

	call iox_$attach_ptr (iox_$user_output, att_desc, null, code);
	if code ^= 0
	then return;

	call iox_$detach_iocb (iox_$error_output, ec);
	if ec ^= 0
	then return;

	call iox_$attach_ptr (iox_$error_output, att_desc, null, ec);
	if ec ^= 0
	then return;

	att_desc = "syn_ " || rtrim (iodd_static.slave_input) || " -inhibit close ";

	call iox_$detach_iocb (iox_$user_input, code);
	if code ^= 0
	then return;

	call iox_$attach_ptr (iox_$user_input, att_desc, null, code);

	return;

     end swap_user_io_streams;

reattach_master:
     proc;

/*	reconnect the user_output, error_output and user_input switches to user_i/o */

dcl  code fixed bin (35);

	code = 0;

	att_desc = "syn_ user_i/o -inhibit close";

	call iox_$detach_iocb (iox_$user_output, code);
	if code ^= 0
	then go to fatal_error;

	call iox_$attach_ptr (iox_$user_output, att_desc, null, code);
	if code ^= 0
	then go to fatal_error;

	call iox_$detach_iocb (iox_$user_input, code);
	if code ^= 0
	then go to fatal_error;

	call iox_$attach_ptr (iox_$user_input, att_desc, null, code);
	if code ^= 0
	then go to fatal_error;

	if iodd_static.slave.active & iodd_static.slave.print_errors
	then att_desc = "syn_ broadcast_errors -inhibit close";
	else att_desc = "syn_ error_i/o -inhibit close";

	call iox_$detach_iocb (iox_$error_output, code);
	if code ^= 0
	then go to fatal_error;

	call iox_$attach_ptr (iox_$error_output, att_desc, null, code);
	if code = 0
	then return;

fatal_error:
	call iodd_msg_ (error, both, code, whoami, "Fatal error swapping user io streams.");

	if iodd_static.test_entry
	then do;
	     call iodd_msg_ (normal, master, 0, "", "Calling Probe - and hope for the best.");
	     call probe;
	     return;
	end;

	call logout;

	return;

     end reattach_master;

send_coord_msg:
     proc (code, number);

dcl  code fixed bin (35);
dcl  number fixed bin (35);
dcl  len fixed bin;
dcl  msg_id bit (72) aligned;

	iodd_comm.ack_chan = iodd_static.cmd_ack_chan;	/* this is how we expext to get confirmation */
	len = currentsize (iodd_comm);		/* get size of message */

	call message_segment_$add_file (iodd_static.sys_dir_ptr -> sys_dir, "coord_comm.ms", comm_ptr, len * 36, msg_id,
	     code);
	if code ^= 0
	then do;
	     err_mess = "unable to add command request to coord_comm.ms.";
	     return;
	end;

	call ipc_$drain_chn (iodd_static.cmd_ack_chan, code);
						/* clear any pending wakeups */
	call ipc_$drain_chn (iodd_static.timer_chan, code);
						/* especially this one */

	unspec (event_message) = msg_id;		/* give the message id to the coord in ev message */

	call hcs_$wakeup (iodd_static.coord_proc_id, iodd_static.coord_cmd_chan, event_message, code);
	if code ^= 0
	then go to bad_ipc;				/* errors are bad news */

/* set up a timer to be sure we don't block too long */

	call timer_manager_$alarm_wakeup (120, "11"b, iodd_static.timer_chan);
						/* allow coord two munutes */

	ev_chan_list.number = 2;			/* get ready to block */
	ev_chan_list.chan (1) = iodd_static.cmd_ack_chan; /* first priority is coord */
	ev_chan_list.chan (2) = iodd_static.timer_chan;	/* next is the timer */

	call ipc_$block (addr (ev_chan_list), addr (event_info), code);

	call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
						/* stop the timer, if possible */

	if code ^= 0
	then do;					/* very bad news */
bad_ipc:
	     call convert_ipc_code_ (code);
	     call iodd_msg_ (normal, both, code, whoami, "Fatal error.  Driver will reinitialize.");
	     signal re_init;
	end;

	if event_info.wait_list_idx = 1
	then do;					/* it was from the coord */
	     msgp = addr (event_info.msg);
	     code = msgp -> ack_msg.code;
	     number = msgp -> ack_msg.num;
	end;
	else do;					/* the timer went off, is ther a coord at all? */
	     code = error_table_$request_not_recognized;
	     err_mess = "Coordinator did not respond to command.";
	end;
	return;

     end send_coord_msg;
%page;
%include command_question_info;
%page;
%include condition_info;
%page;
%include condition_info_header;
%page;
%include driver_ptr_list;
%page;
%include driver_status;
%page;
%include iod_event_message;
%page;
%include iod_tables_hdr;
%page;
%include iodd_comm;
%page;
%include iodd_static;
%page;
%include mseg_message_info;
%page;
%include request_descriptor;

     end iodd_command_processor_;




		    iodd_get_cmd_.pl1               10/28/88  1403.5rew 10/28/88  1230.0       83367



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

iodd_get_cmd_: proc (a_wp, a_max_chars, a_chars_read, ctl, a_msg, a_source, a_code);

/* This is the procedure used by the io daemon to read a command line from
   either of the terminals which can give commands to the driver.

   It may wait for a command to be read, or it may return if no command
   was typed on either terminal as determined by the ctl (flags) arg.
*/

/* Coded in August 1977 by J. C. Whitmore */
/* Modified Mar 1978 by J. C. Whitmore for bug fix, clearing prompt slave flag */
/* Modified Aug 1978 by J. C. Whitmore to fix the ctl declaration and add slave echo */



/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
                                                   END HISTORY COMMENTS */


/*	ENTRIES		*/

	dcl     iodd_msg_		 entry options (variable);
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     convert_ipc_code_	 entry (fixed bin (35));
	dcl     ioa_$rs		 entry options (variable);
	dcl     iox_$get_line	 entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35));
	dcl     iox_$put_chars	 entry (ptr, ptr, fixed bin (24), fixed bin (35));
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     ios_$attach		 entry (char (*), char (*), char (*), char (*), bit (72) aligned);
	dcl     ipc_$block		 entry (ptr, ptr, fixed bin (35));
	dcl     ipc_$drain_chn	 entry (fixed bin (71), fixed bin (35));


/*	ARGUMENTS		*/

	dcl     a_wp		 ptr;		/* workspace pointer to input buffer */
	dcl     a_max_chars		 fixed bin (24);	/* sixe of the workspace */
	dcl     a_chars_read	 fixed bin (24);	/* number of chars actually read */
	dcl     a_msg		 char (*);	/* added message for Enter command(a_msg): */
	dcl     a_source		 fixed bin;	/* was the cmd from the master(1) or the slave(2) */
	dcl     a_code		 fixed bin (35);	/* you guessed it! error code */



/*	AUTOMATIC		*/

	dcl     code		 fixed bin (35);
	dcl     prompt_msg		 char (128);	/* command request message */
	dcl     msg_len		 fixed bin (24);
	dcl     quit_signaled	 bit (1);

	dcl     master		 fixed bin int static options (constant) init (1); /* constant  indicating input from master device */
	dcl     slave		 fixed bin int static options (constant) init (2); /* constant indicating input from slave */

	dcl     1 ctl		 aligned parameter,
		2 wait_for_input	 bit (1) unal,	/* true if we should wait for a cmd line */
		2 prompt_master	 bit (1) unal,	/* true if we should ask master for cmd */
		2 prompt_slave	 bit (1) unal,	/* true if we should ask slave for cmd */
		2 pad		 bit (33) unal;


	dcl     1 read_info		 aligned,		/* structure for ios_$order "read_status" */
		2 read_ev_chan	 fixed bin (71),
		2 input_ready	 bit (1) unal;

	dcl     1 event_info	 aligned,		/* info about a wakeup received */
		2 chan		 fixed bin (71),
		2 ev_msg		 fixed bin (71),
		2 sender		 bit (36),
		2 origin		 fixed bin,
		2 wait_list_index	 fixed bin;


	dcl     1 input_list	 aligned,		/* IPC wait list for operator input */
		2 number		 fixed bin,	/* number of entries in the list = 2 */
		2 channel		 (2) fixed bin (71);/* ipc event channels */


/*	CONDITIONS	*/

	dcl     (daemon_unclaimed, re_init, quit) condition;


/*	BUILTINS		*/

	dcl     (addr, null)	 builtin;


/*	BASED STRUCTURES AND INCLUDE FILES		*/


	dcl     chan_list_ptr	 ptr;		/* pointer to event channel list */

	dcl     1 ev_chan_list	 aligned based (chan_list_ptr), /* wait list for all drivers and consoles */
		2 number		 fixed bin,
		2 channel		 (12) fixed bin (71);


/*	EXT STATIC	*/

	dcl     iodd_stat_p		 ptr ext static;


%include iod_tables_hdr;
%include iodd_static;

	stat_p = iodd_stat_p;			/* get pointer to iodd_static */

	quit_signaled = "0"b;

	a_code = 0;
	a_chars_read = 0;

	chan_list_ptr = iodd_static.chan_list_ptr;	/* get pointer to list of event channels */
	input_list.number = 2;			/* two input devices, master and slave */
	input_list.channel (1) = ev_chan_list.channel (1);/* copy from the full list */
	input_list.channel (2) = ev_chan_list.channel (2);
	read_info.read_ev_chan = ev_chan_list.channel (1);/* in case the order fails first time */
	read_info.input_ready = "0"b;

	if ^iodd_static.slave.accept_input then do;
		ctl.prompt_master = "1"b;		/* no slave, so force the master flag */
	     end;
	ctl.prompt_slave = (ctl.prompt_slave | ^ctl.prompt_master); /* ask slave if not master */

	prompt_msg = "";				/* start clean */
	call ioa_$rs ("Enter command^[(^a)^]:", prompt_msg, msg_len, ^(a_msg = ""), a_msg); /* format the prompt message */

	on quit begin;				/* check for a quit */
		quit_signaled = "1"b;		/* tell main proc about it */
		call continue_to_signal_ ((0));	/* and pass it on */
	     end;

	go to read;

wait:	if ctl.prompt_slave & iodd_static.slave.accept_input then do;
		call iox_$put_chars (iodd_static.slave_out, addr (prompt_msg), msg_len, code);
		if code ^= 0 then ctl.prompt_master = "1"b; /* be sure we prompt someone */
		call iox_$control (iodd_static.slave_out, "runout", null, code);
		ctl.prompt_slave = "0"b;		/* don't repeat til needed */
	     end;

	if ctl.prompt_master then do;			/* do we ask for a command? */
		call iox_$put_chars (iodd_static.master_out, addr (prompt_msg), msg_len, code);
		ctl.prompt_master = "0"b;		/* don't ask again til necessary */
	     end;

	quit_signaled = "0"b;			/* watch for a quit while blocked */

	call ipc_$block (addr (input_list), addr (event_info), code); /* wait for a response */
	if code ^= 0 then do;
		call convert_ipc_code_ (code);	/* make it an error_table_code */
		call iodd_msg_ (2, master, code, "iodd_get_cmd_", "Fatal error: blocking for terminal input");
		if iodd_static.test_entry then signal daemon_unclaimed; /* give programmer a look */
		else signal re_init;
	     end;
	if quit_signaled then ctl.prompt_master, ctl.prompt_slave = "1"b; /* get a quit while blocked? */

read:	call iox_$control (iodd_static.master_in, "read_status", addr (read_info), code);

	input_list.channel (1), ev_chan_list.channel (1) = read_info.read_ev_chan; /* master will always prevail */

	if input_ready then do;

		call ipc_$drain_chn (input_list.channel (1), code); /* we only want new wakeups later */
		call ipc_$drain_chn (input_list.channel (2), code); /* for the slave too! */

		ctl.prompt_master = "1"b;		/* be sure we ask for more input */

		call iox_$get_line (iodd_static.master_in, a_wp, a_max_chars, a_chars_read, code);

		if a_chars_read = 0 then go to read;	/* not likely...., but... */

		a_code = code;
		a_source = master;
		return;

	     end;

/*	Now see if the slave has anything, if we can accept a cmd line  */

	if iodd_static.slave.accept_input then do;

		call iox_$control (iodd_static.slave_in, "read_status", addr (read_info), code);
		if code ^= 0 then go to bad_slave;
						/* redefine the slave event channel, may change */
		input_list.channel (2), ev_chan_list.channel (2) = read_ev_chan;

		if input_ready then do;

			call ipc_$drain_chn (input_list.channel (2), code); /* clear old wakeups */

			ctl.prompt_slave = "1"b;	/* be sure we ask for more later */

			call iox_$get_line (iodd_static.slave_in, a_wp, a_max_chars, a_chars_read, code);

			if code ^= 0 then do;	/* we can drop the slave on errors */
bad_slave:			iodd_static.slave.accept_input = "0"b;
				iodd_static.slave.print_errors = "0"b;
				iodd_static.slave.allow_quits = "0"b;
				iodd_static.slave.log_msg = "0"b;
				iodd_static.slave.echo_cmd = "0"b;
				call iox_$control (iodd_static.slave_out, "quit_disable", null, (0)); /* lets try */
				call ios_$attach ("error_output", "syn", "error_i/o", "", ("0"b)); /* just to be sure */
				call iodd_msg_ (2, master, code, "iodd_get_cmd_", "Slave input terminated.");
				call iox_$control (iodd_static.master_in, "resetread", null, code);
				ctl.prompt_master = "1"b; /* we must ask for guidance */
				ctl.wait_for_input = "1"b;
				ctl.prompt_slave = "1"b; /* in case we come back later */
				go to read;
			     end;

			if a_chars_read = 0 then go to read; /* possible due to g115 dim bug */

			a_code = code;
			a_source = slave;

			if iodd_static.slave.echo_cmd then do;
				call iox_$put_chars (iodd_static.slave_out, a_wp, (a_chars_read), code); /* echo cmd line */
				if code ^= 0 then go to bad_slave;
			     end;

			return;

		     end;
	     end;

	if ctl.wait_for_input then go to wait;		/* wakeup, but no input...go and wait */

	a_source = 0;				/* There was no input */
	a_chars_read = 0;
	a_code = 0;

	return;



     end iodd_get_cmd_;




		    iodd_hangup_.pl1                11/08/88  1425.7rew 11/08/88  1422.6       77238



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

/* format: style4,delnl,insnl,^ifthenstmt */

/* format: off */

/* I/O daemon handler for messages from the answering service concerning the channels attached to the daemon */

/* Created:  1975 by J. C. Whitmore */
/* Modified: July 1978 by J. C. Whitmore to convert to iodd_msg_ subroutine */
/* Modified: November 1978 by J. C. Whitmore to support attach_type 4: variable line type */
/* Modified: March 1979 by J. C. Whitmore for minor message fixes */
/* Modified: 18 December 1981 by G. Palter to treat any hangup as requiring the driver to be reinitialized as the only
      channels for which this procedure is defined to handle wakeups are of immediate concern to the driver; in
      particular, when the channel is attached via a dial preaccess request, it isn't possible to check its name against
      any values in iodd_static */

/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-11-08,MR12.2-1199):
     Upgraded to version 5 iod tables.
  2) change(88-11-03,Brunelle), approve(88-11-03,MCR7911),
     audit(88-11-08,Wallman), install(88-11-08,MR12.2-1199):
     Changed to allow "y" & "n" for yes/no answers.
                                                   END HISTORY COMMENTS */

/* format: on */


iodd_hangup_:
     procedure (arg_p);

dcl  arg_p ptr;

dcl  code fixed bin (35);
dcl  dev_name char (32);
dcl  dim_name char (32);
dcl  answer char (80) aligned;
dcl  master_state bit (1);				/* state of the master hold bit */
dcl  nelt fixed bin;
dcl  n_dialed fixed bin;

dcl  iodd_stat_p pointer external static;		/* external static pointer to iodd_static */

dcl  1 ev_info based (arg_p),
       2 channel fixed bin (71),
       2 message fixed bin (71),
       2 sender bit (36),				/* process id sending the wakeup */
       2 origin bit (36),				/* ring and device data..don't care */
       2 data_p ptr;				/* argument from call chan creation */

dcl  io_stat bit (72) aligned;			/* ios status code */

dcl  1 status_flags aligned,
       2 dialed_up bit (1) unal,
       2 hung_up bit (1) unal,
       2 control bit (1) unal,
       2 pad (33) bit (1) unal;

dcl  convert_dial_message_
	entry (fixed bin (71), char (*), char (*), fixed bin, 1 aligned like status_flags, fixed bin (35));
dcl  new_proc entry ();
dcl  iodd_msg_ entry options (variable);
dcl  ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned);
dcl  ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));

dcl  re_init condition;

dcl  (addr, null, substr) builtin;

dcl  master fixed bin int static options (constant) init (1);
dcl  stars char (40) int static options (constant) init ((40)"*");
dcl  bells char (40) int static options (constant) init ((40)"");
						/* 40 bells 007 octal */

/**/

	stat_p = iodd_stat_p;			/* get a pointer to iodd_static */

	master_state = iodd_static.master_hold;		/* save the state */
	iodd_static.master_hold = "1"b;		/* default to master hold set */

	call iox_$control (iodd_static.master_in, "resetread", null, code);
						/* unprocessed input is invalid */
	call iox_$control (iodd_static.master_in, "start", null, code);
						/* be sure not to lose a wakeup */

	call convert_dial_message_ (ev_info.message, dev_name, dim_name, n_dialed, status_flags, code);

	if code = 0 then do;

	     if status_flags.hung_up & dev_name = iodd_static.ctl_device then do;

/* The control terminal has hungup: ask the central site operator if he wishes to continue */

		if ^iodd_static.ctl_term.attached then do;
						/* ignore if control terminal not in use */
		     iodd_static.master_hold = master_state;
		     return;
		end;

		call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
		call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
		call ios_$detach ("broadcast_errors", iodd_static.ctl_output, "", io_stat);
		call ios_$detach (iodd_static.ctl_input, "", "", io_stat);
		call ios_$detach (iodd_static.ctl_output, "", "", io_stat);
		iodd_static.ctl_term.attached = "0"b;	/* control terminal is now detached ... */
		iodd_static.ctl_ev_chan = 0;

		if iodd_static.ctl_output = iodd_static.slave_output then do;
		     iodd_static.slave.active = "0"b;	/* control terminal was the slave terminal also */
		     iodd_static.allow_quits = "0"b;
		     iodd_static.slave.accept_input = "0"b;
		end;

		call iodd_msg_ (2, master, 0, "", "^/^a^/Control terminal hangup received.^/^a^a", stars, bells,
		     stars);

		call iodd_msg_ (1, master, 0, "", "^/Do you want to continue without control terminal?^/");
read:
		answer = "";			/* clear the string of crud */
		call iox_$get_line (iodd_static.master_in, addr (answer), 80, nelt, code);
		if code ^= 0
		then call new_proc ();		/* this is tooooo..bad to correct */
		call iox_$control (iodd_static.master_in, "start", null, code);
						/* send wakeup after each read */
		if substr (answer, 1, 3) = "yes" | substr (answer, 1, 1) = "y" then do;
		     iodd_static.forms = "0"b;	/* can't simulate forms */
		     iodd_static.master_hold = master_state;
		     return;			/* restore the state as we go on */
		end;
		if substr (answer, 1, 2) = "no" | substr (answer, 1, 1) = "n" then do;
		     signal re_init;		/* reinitialize to get the control terminal back */
		end;
		call iodd_msg_ (1, master, 0, "", "Please answer ""yes"" or ""no"".");
		call iox_$control (iodd_static.master_in, "resetread", null, code);
		go to read;
	     end;


	     else if status_flags.hung_up then do;

/* A channel other than the control terminal has hungup: assume it is the device's channel and reinitialize the driver */

		call iodd_msg_ (1, master, 0, "", "^a^/Hangup received for device ""^a"" on channel ""^a"".^/^a^a",
		     stars, iodd_static.major_device, dev_name, bells, stars);

		call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);

		if iodd_static.attach_type = 4 then do; /* variable line: detach it now as reinitialization won't */
		     call iox_$close (iodd_static.slave_out, code);
		     call iox_$detach_iocb (iodd_static.slave_out, code);
		     iodd_static.slave_out, iodd_static.slave_in = null;
		     iodd_static.slave.active = "0"b;	/* slave must be re-defined */
		     iodd_static.slave.allow_quits = "0"b;
		     iodd_static.slave.accept_input = "0"b;
		     iodd_static.slave.print_errors = "0"b;
		     iodd_static.slave.log_msg = "0"b;	/* must ask for log messages */
		     iodd_static.slave.echo_cmd = "0"b; /* don't echo cmds by default */
		     iodd_static.slave.priv1 = "0"b;	/* driver module defined privleges */
		     iodd_static.slave.priv2 = "0"b;	/* " */
		     iodd_static.slave.priv3 = "0"b;	/* " */
		     iodd_static.slave_output, iodd_static.slave_input = "Undefined_Stream";
		     iodd_static.attach_name = "";	/* no longer defined */
		end;

		if ^iodd_static.re_init_in_progress
		then signal re_init;
		return;
	     end;


	     else if status_flags.dialed_up then do;

/* A channel issued a dial request: ignore it */

		call iodd_msg_ (1, master, 0, "iodd_hangup_", "Dial received from device ""^a"".", dev_name);
		iodd_static.master_hold = master_state; /* not fatal, restore state and return */
		return;
	     end;


	     else do;
		call iodd_msg_ (1, master, 0, "iodd_hangup_",
		     "Dial control signal received. There are ^d dialed devices.", n_dialed);
		iodd_static.master_hold = master_state; /* this is also non-fatal */
		return;
	     end;
	end;

	call iodd_msg_ (2, master, code, "iodd_hangup_", "Unable to convert message from dial control.");

	return;
%page;
%include iod_tables_hdr;
%page;
%include iodd_static;

     end iodd_hangup_;




		    iodd_listen_.pl1                10/28/88  1403.5rew 10/28/88  1229.8      229437



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

/* format: style4,delnl,insnl,^ifthenstmt */

/* format: off */

/* This is the central I/O daemon driver procedure, which "listens" for operator input and for wakeups from the
   coordinator (in general, whichever happens first). It avoids going blocked for input (unless needed) by using the
   iodd_get_cmd_ subroutine.  It will listen for requests to be processed for each of the minor devices assigned to the
   process (if currently active) and service them in a round-robin fashion. This procedure will normally be called once
   per session, except in case of reinitialization */

/* Created:  September 1973 by Robert S. Coren */
/* Modified: January 1975 by J. C. Whitmore for generalization and access isolation */
/* Modified: October 1975 by J. C. Whitmore to check for active slave before printing message */
/* Modified: December 1975 by M. A. Braida to include default condition handler for restart from slave */
/* Modified: August 1977 by J. C. Whitmore to use iodd_get_cmd_ for reading command lines */
/* Modified: November 1977 by J. C. Whitmore to use iodd_msg_ for all operator messages */
/* Modified: July 1978 by J. C. Whitmore to support daemon_save condition and commands: next, go N */
/* Modified: November 1978 by J. C. Whitmore to implement inactivity logout */
/* Modified: October 1979 by J. C. Whitmore to signal when driver is idle */
/* Modified: 18 December 1981 by G. Palter to correct entry number 0033 (phx11367) on the io_daemon error list:
      When operating in test mode with the coordinator and a driver in the same process, if the operator types ahead the
      necessary commands to stop both the driver and coordinator while a request is running, the request will be finished
      normally but will remain in the queue and be reprocessed the next time that queue is run */
/* Modified: February 23, 1985 by C. Marker to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
                                                   END HISTORY COMMENTS */


/* format: on */


iodd_listen_:
     procedure ();


/* Entries */

dcl  clock_ entry () returns (fixed bin (71));
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  iodd_msg_ entry options (variable);
dcl  iodd_get_cmd_ entry (ptr, fixed bin, fixed bin, 1 aligned like ctl, char (*), fixed bin, fixed bin (35));
dcl  iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35));
dcl  iodd_quit_handler_ entry ();
dcl  iox_$look_iocb entry (char (*) aligned, ptr, fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
dcl  timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry);
dcl  timer_manager_$reset_alarm_call entry (entry);
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));


/* Automatic */

dcl  wakeup_code fixed bin;				/* action for coord on wakeup */
dcl  wakeup_count fixed bin;				/* how many coord request wakeups to send before block */
dcl  dr_ptr ptr;					/* general pointer to a driver status seg */
dcl  desc_ptr ptr;					/* pointer to the request descriptor */
dcl  i fixed bin;					/* do loop index */
dcl  code fixed bin (35);
dcl  line char (132);				/* input from terminal */
dcl  nchars fixed bin;				/* number of chars read */
dcl  must_tell_coord bit (1);
dcl  idle_msg_sent bit (1);

dcl  timer_channel fixed bin (71);			/* IPC channel to use for the timer */

dcl  1 ctl aligned,					/* control flags for iodd_get_cmd_ */
       2 wait_for_input bit (1) unal,			/* true if we should wait for a command */
       2 prompt_master bit (1) unal,			/* true if we want to ask master for a cmd */
       2 prompt_slave bit (1) unal,			/* true if we want to ask slave for a cmd */
       2 pad bit (33) unal;

dcl  state fixed bin;				/* state of command processing */
						/* 0 = not ready to handle requests */
						/* 1 = ready or processing requests */
						/* 2 & 3 are driver module defined cmd levels */
						/* 4 = handling a quit */
						/* 5 = unclaimed signal (test mode) */

dcl  source fixed bin;				/* which terminal gave the command line */
dcl  last_cmd fixed bin;				/* which source (master or slave) gave the last cmd line */
dcl  master_cmd bit (1);				/* true if master gave a cmd at this level */
dcl  slave_cmd bit (1);				/* true if slave gave a cmd at this level */

dcl  terminal (2) ptr;				/* iocb ptrs of the master and slave input devices */

dcl  free_devices fixed bin;				/* counter for round robin loop */
dcl  driver_index fixed bin;				/* ptr list index of current minor dev driver */
dcl  now fixed bin (71);				/* current clock_ time */

dcl  1 event_info aligned,				/* info about a wakeup received */
       2 chan fixed bin (71),
       2 ev_msg fixed bin (71),
       2 sender bit (36),
       2 origin fixed bin,
       2 wait_list_index fixed bin;

dcl  1 form_data aligned,				/* data from ctl_dim_ for form alignment */
       2 page_length fixed bin,			/* length of logical page */
       2 line_length fixed bin,			/* number of chars before folding line */
       2 line_no fixed bin,				/* current line on the page */
       2 carriage_pos fixed bin,			/* position of next char on the line */
       2 aligned bit (1) unal,			/* "1"b if we are simulating form feeds */
       2 pad bit (35) unal;


/* Constants */

dcl  null_cmd_level fixed bin int static options (constant) init (0);
dcl  listen_cmd_level fixed bin int static options (constant) init (1);
dcl  none fixed bin int static options (constant) init (0); /* constant for no terminal giving cmd */
dcl  master fixed bin int static options (constant) init (1);
						/* constant  indicating input from master device */
dcl  slave fixed bin int static options (constant) init (2);/* constant indicating input from slave */
dcl  both fixed bin int static options (constant) init (0); /* constant indicating both the master and slave */
dcl  normal fixed bin int static options (constant) init (1);
						/* normal iodd_msg_ messages */
dcl  error fixed bin int static options (constant) init (2);/* error messages for iodd_msg_ */
dcl  new_request fixed bin int static options (constant) init (1);
						/* coord code for new request - done with current */
dcl  request_done fixed bin int static options (constant) init (0);
						/* coord code to take back current request */


/* Conditions */

dcl  (quit, no_coord, daemon_again, daemon_again_slave, daemon_kill, daemon_cancel, daemon_unclaimed, daemon_save, resume,
     re_init, daemon_logout, daemon_slave_logout, daemon_idle, cleanup) condition;


/* Builtins */

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


/* Based structures */

dcl  chan_list_ptr ptr;				/* pointer to event channel list */

dcl  1 ev_chan_list aligned based (chan_list_ptr),	/* wait list for all drivers and consoles */
       2 number fixed bin,
       2 channel (12) fixed bin (71);


/* External static */

dcl  iodd_stat_p ptr external static;

/**/

	stat_p = iodd_stat_p;			/* set the pointer to iodd_static */
	list_ptr = iodd_static.driver_list_ptr;		/* establish the list of driver status segs */
	chan_list_ptr = iodd_static.chan_list_ptr;	/* get pointer to list of event channels */
	timer_channel = ev_chan_list.channel (3);	/* timer uses the first minor dev chan */

	call iox_$look_iocb (iodd_static.slave_input, iodd_static.slave_in, code);
	if code ^= 0
	then go to slave_err;
	call iox_$look_iocb (iodd_static.slave_output, iodd_static.slave_out, code);
						/* just checking */
	if code ^= 0 then do;
slave_err:
	     if iodd_static.slave.active
	     then					/* did we think there was a slave? */
		call iodd_msg_ (error, master, code, "iodd_listen_", "Slave functions terminated.");
	     iodd_static.slave.active = "0"b;
	     iodd_static.slave.accept_input = "0"b;
	     iodd_static.slave.print_errors = "0"b;
	     iodd_static.slave.allow_quits = "0"b;
	end;

	iodd_static.requests_til_cmd = 0;		/* set for free running mode */
	iodd_static.quit_during_request = "0"b;		/* make sure initialization is correct */
	iodd_static.request_in_progress = "0"b;
	iodd_static.recursion_flag = "0"b;
	iodd_static.re_init_in_progress = "0"b;		/* any re_init is now done */
	iodd_static.logout_pending = "0"b;
	iodd_static.auto_logout_pending = "0"b;
	iodd_static.runout_requests = "0"b;
	iodd_static.current_devices = 0;		/* we will check for ready devices */
	idle_msg_sent = "0"b;			/* init flag for idle condition handler */

	do i = 1 to iodd_static.assigned_devices;	/* check the data in driver status */
	     dr_ptr = driver_ptr_list.stat_segp (i);	/* next driver status ptr */
	     if ^dr_ptr -> driver_status.attached then do;/* not attached, can't be ready */
		dr_ptr -> driver_status.ready = "0"b;	/* correct the error */
		dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id;
						/* tell coord */
	     end;
	     else if dr_ptr -> driver_status.ready then do;
		iodd_static.current_devices = iodd_static.current_devices + 1;
						/* count it */
		dr_ptr -> driver_status.request_pending = (36)"0"b;
						/* tell coord */
	     end;
	     else dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id;
						/* not ready */
	     dr_ptr -> driver_status.busy = "0"b;	/* none busy yet */
	end;


/* Now set up the remaining condition handlers */

	on cleanup call timer_manager_$reset_alarm_call (trigger_auto_logout);

	on quit
	     begin;
	     call timer_manager_$reset_alarm_call (trigger_auto_logout);
	     iodd_static.auto_logout_pending = "0"b;
	     call iodd_quit_handler_;			/* to come to command level after quit */
	end;

	on resume go to resume_operation;		/* clean up after unclaimed signal */

	on daemon_save ;				/* make this a null condition */

	on daemon_again call iodd_msg_ (normal, master, 0, "", "No current request to ""restart"".");

	on daemon_again_slave call iodd_msg_ (normal, slave, 0, "", "No current request to ""restart"".");

	on daemon_cancel call iodd_msg_ (normal, both, 0, "iodd_listen_", "No current request to ""cancel"".");

	on daemon_kill call iodd_msg_ (normal, both, 0, "iodd_listen_", "No current request to ""kill"".");

	on daemon_idle call idle_proc;


	if iodd_static.slave.allow_quits
	then call iox_$control (iodd_static.slave_in, "quit_enable", null, code);

	terminal (master) = iodd_static.master_in;	/* internal copy of iocbp for easy logic */

	must_tell_coord = ""b;			/* clear the send wakeup flag */
	string (ctl) = ""b;				/* clear all control flags */
	driver_index = 0;				/* so we start with index of 1st driver */

/* Everything is initialized, start the listen function by checking for commands */

check_for_cmd:
	ctl.wait_for_input = (iodd_static.step | iodd_static.master_hold | iodd_static.slave_hold);
	ctl.prompt_master = "0"b;			/* normally the slave will give commands */
	ctl.prompt_slave = "1"b;
	master_cmd = "0"b;				/* no cmd from the master yet */
	slave_cmd = "0"b;				/* likewise for the slave */
	last_cmd = none;

	go to read;

wait:
	ctl.wait_for_input = "1"b;			/* say we must wait for input */

read:
	if iodd_static.current_devices > 0
	then state = listen_cmd_level;		/* get ready for iodd_command_processor_ */
	else state = null_cmd_level;

	call iodd_get_cmd_ (addr (line), 128, nchars, ctl, "", source, code);

	if must_tell_coord then do;			/* do we owe the coord a wakeup? */
	     if source = none then do;
		iodd_static.driver_ptr -> driver_status.last_wake_time = clock_ ();
		wakeup_code = new_request;		/* save an extra wakeup */
	     end;
	     else wakeup_code = request_done;		/* have a command, send this back and wait */
	     call wake_coord (wakeup_code);
	     must_tell_coord = ""b;
	end;

	if source = none
	then go to find_work;			/* no command, go look for a request */

	call timer_manager_$reset_alarm_call (trigger_auto_logout);
						/* this is some activity, cancel auto logout */
	iodd_static.auto_logout_pending = "0"b;

	idle_msg_sent = "0"b;			/* we want a new idle message after commands */

	if source = master then do;
	     if iodd_static.slave.active
	     then					/* don't let the slave interrupt the master */
		call iox_$control (iodd_static.slave_in, "quit_disable", null, (0));
	     master_cmd = "1"b;			/* if master gave a cmd */
	end;
	else slave_cmd = "1"b;			/* otherwise it was the slave */
	last_cmd = source;				/* who gave the last command? */
	ctl.wait_for_input = "0"b;			/* got some */

	call iodd_command_processor_ (source, state, substr (line, 1, nchars), code);

	if iodd_static.slave.allow_quits
	then					/* let slave get a chance */
	     call iox_$control (iodd_static.slave_in, "quit_enable", null, (0));

	terminal (slave) = iodd_static.slave_in;	/* reset this, it may change */
	if code = 1
	then go to read;				/* go for a request... but first check for more input */
	if code = 0 | code = 2
	then go to wait;				/* we want more input .. no errors */
	call iox_$control (terminal (source), "resetread", null, (0));
						/* clear input after bad command */
	go to wait;				/* and wait for correct input */

find_work:					/* ask coord for work if all is well */
	if iodd_static.forms
	then					/* be sure alignment is set when simulating forms */
	     if iodd_static.ctl_term.attached then do;	/* if the terminal is there */
		call iox_$control (iodd_static.slave_out, "form_status", addr (form_data), code);
		if code ^= 0 then do;		/* something was wrong */
		     iodd_static.forms = "0"b;	/* drop the forms */

		     call iodd_msg_ (normal, both, code, "iodd_listen_",
			"Control terminal form simulation terminated.");

		     ctl.prompt_master = "1"b;	/* force operator action */
		     ctl.prompt_slave = "1"b;		/* slave can also answer */
		     call iox_$control (iodd_static.master_in, "resetread", null, (0));
						/* but fresh answer */
		     call iox_$control (iodd_static.slave_in, "resetread", null, (0));
		     go to wait;
		end;
		if ^form_data.aligned then do;	/* dim says not aligned...so, */
		     call iodd_msg_ (normal, slave, 0, "", "Control forms not aligned.");
						/* tell someone */
		     go to wait;			/* must enable wakeups */
		end;
	     end;
	     else iodd_static.forms = "0"b;		/* not legal if no ctl term attached */



	if last_cmd = slave
	then					/* do we owe the master a courtesy msg? */
	     if master_cmd
	     then call iodd_msg_ (normal, master, 0, "", "^a driver continuing.", iodd_static.major_device);
	     else ;

	else if slave_cmd
	then if iodd_static.slave.active
	     then					/* be sure it wasn't detached by last command */
		call iodd_msg_ (normal, slave, 0, "", "^a driver continuing.", iodd_static.major_device);


	master_cmd = "0"b;
	slave_cmd = "0"b;

	call timer_manager_$reset_alarm_wakeup (timer_channel);
						/* clear out any pending timeouts */

	do i = 3 to ev_chan_list.number;		/* reset all wakeups from coord */
	     call ipc_$drain_chn (ev_chan_list.channel (i), code);
						/* can't afford to check code here */
	end;

/**/

/* This is the main loop for checking to see if the coordinator has given any requests to process.  We will go through the
   entire list of device drivers for this process and do any pending requests.  Start with the last driver to be checked
   (not necessarily the current driver) as indicated by the value of "driver_index".  If there is no request pending for
   an active driver, we will ask the coordinator for service if we have waited more than "wakeup_time" seconds with no
   word.  Otherwise, we will block for "wakeup_time" seconds to see if a request comes in or if a command arrives */

	free_devices = 0;				/* clear the count of inactive devices */
	wakeup_count = iodd_static.current_devices;	/* max number of wakeups to send before block */

	do while (free_devices < iodd_static.assigned_devices);
	     driver_index = driver_index + 1;		/* start with the next device */
	     if driver_index > iodd_static.assigned_devices
	     then driver_index = 1;
	     iodd_static.driver_ptr = driver_ptr_list.stat_segp (driver_index);
						/* set the current driver ptr */
	     iodd_static.output_device = driver_ptr -> driver_status.device_id;
						/* make things consistent */

	     if runout_requests then do;		/* trying to flush pending requests from halted dev */
		free_devices = free_devices + 1;	/* only go around once */
		if ^driver_ptr -> driver_status.ready
		then				/* check pending for non-ready devices */
		     if driver_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
		     then go to process_request;
	     end;
	     else if driver_ptr -> driver_status.request_pending then do;
						/* something waiting or driver inactive? */
		if driver_ptr -> driver_status.request_pending = iodd_static.coord_proc_id
		then go to process_request;		/* we found one that is valid */

		free_devices = free_devices + 1;	/* not the coord, must be free */
		driver_ptr -> driver_status.busy = "0"b;
		driver_ptr -> driver_status.ready = "0"b;
						/* just to be sure */
	     end;
	     else do;				/* device driver is ready with nothing to do */
		now = clock_ ();			/* see what time it is */
		if last_cmd = none
		then				/* in automatic mode */
		     if driver_ptr -> driver_status.last_wake_time + 1000000 * iodd_static.wakeup_time > now
		     then go to block_for_all_events;
		if wakeup_count <= 0
		then go to block_for_all_events;	/* when all are serviced, wait */

		call wake_coord (new_request);	/* request some service from the coord */

		driver_ptr -> driver_status.last_wake_time = now;
						/* record the time */
		free_devices = 0;			/* reset the count...we found one */
		driver_ptr -> driver_status.ready = "1"b;
						/* keep it straight in case driver module goofs */
		wakeup_count = wakeup_count - 1;	/* say we sent one */
	     end;
	end;					/* that's all for the main loop */
						/* if we fall through, there was nothing to do */
	if iodd_static.runout_requests then do;		/* if we expected to stop everything */
	     iodd_static.runout_requests = "0"b;	/* change back to normal mode */
	     if iodd_static.logout_pending
	     then signal daemon_logout;		/* this is a clean way back */
	end;
	else call iodd_msg_ (normal, both, 0, "", "No ready device or pending requests.");
	iodd_static.slave_hold = "1"b;		/* force the issue */
	iodd_static.logout_pending = "0"b;		/* cancel the flag in case */
	go to check_for_cmd;			/* get a command and enable wakeups */

/**/

block_for_all_events:				/* Here we wait for something to happen */
	if iodd_static.auto_logout_interval > 0
	then					/* are we watching for inactivity? */
	     call timer_manager_$alarm_call ((iodd_static.auto_logout_interval), "11"b, trigger_auto_logout);
	call timer_manager_$alarm_wakeup (iodd_static.wakeup_time, "11"b, timer_channel);
						/* simulate a coord wakeup after N seconds */
	call ipc_$block (chan_list_ptr, addr (event_info), code);
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);		/* get an error_table_ value */
	     call iodd_msg_ (error, master, code, "iodd_listen_", "Fatal error: main block point.");
	     if iodd_static.test_entry
	     then signal daemon_unclaimed;		/* let programmer peek */
	     else signal re_init;
	end;

	if event_info.wait_list_index < 3
	then go to read;				/* if it was a terminal, go look for input */

	driver_ptr = driver_ptr_list.stat_segp (event_info.wait_list_index - 2);
						/* set the current driver ptr */
	iodd_static.output_device = driver_ptr -> driver_status.device_id;
	if driver_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id
						/* really a request? */
	then if iodd_static.auto_logout_pending
	     then signal daemon_slave_logout;		/* No, are we to logout? */
	     else do;
		signal daemon_idle;			/* see if driver module wants to take action */
		go to check_for_cmd;		/* Nope! So poke around a bit */
	     end;



process_request:					/* We have a valid request from the coordinator   */
	idle_msg_sent = "0"b;			/* give message again when we are next idle */

	call timer_manager_$reset_alarm_call (trigger_auto_logout);
						/* this is some activity, cancel auto logout */
	iodd_static.auto_logout_pending = "0"b;
	driver_ptr -> driver_status.busy = "1"b;	/* be sure we tell the coord when done */

	call iodd_static.driver_request;		/* pass it off to the driver module for action */

	iodd_static.requests_til_cmd = iodd_static.requests_til_cmd - 1;
						/* decrement the go N value */

/**/

resume_operation:					/* pass it back to coord if done or "resume" signalled */
	if iodd_static.requests_til_cmd = 0
	then iodd_static.slave_hold = "1"b;		/* force cmd hold after N done */
	desc_ptr = addr (driver_ptr -> driver_status.descriptor);

	if iodd_static.driver_ptr -> driver_status.busy | desc_ptr -> request_descriptor.finished then do;
	     if driver_ptr -> driver_status.ready
	     then driver_ptr -> driver_status.request_pending = (36)"0"b;
						/* ready for next one */
	     else driver_ptr -> driver_status.request_pending = iodd_static.driver_proc_id;

	     desc_ptr -> request_descriptor.finished = "1"b;
						/* force the done flag */

	     if iodd_static.step
	     then wakeup_code = request_done;		/* step mode, ask for request later */
	     else if iodd_static.master_hold
	     then wakeup_code = request_done;		/* in hold, ask later */
	     else if iodd_static.slave_hold
	     then wakeup_code = request_done;
	     else if driver_ptr -> driver_status.ready
	     then wakeup_code = new_request;		/* we want more service */
	     else wakeup_code = request_done;		/*  we don't want another request right now */

	     if wakeup_code = new_request
	     then must_tell_coord = "1"b;		/* tell coord after checking for cmd */
	     else do;
		call wake_coord (wakeup_code);
		must_tell_coord = ""b;		/* we already told it */
	     end;
	     driver_ptr -> driver_status.busy = "0"b;	/* all done */
	end;
	iodd_static.request_in_progress, iodd_static.recursion_flag, iodd_static.quit_during_request,
	     iodd_static.quit_signaled = "0"b;
	iodd_static.segptr = null;			/* reset current segment pointer */
	go to check_for_cmd;			/* See if there is a command, or wait for step */

/**/

/* Send "ready/done" wakeup to coordinator */

wake_coord:
     procedure (wakeup_code);

dcl  ec fixed bin (35);				/* temp error code */
dcl  wakeup_code fixed bin;				/* what action is wanted */
						/* 1 = done and give me another */
						/* 0 = done and don't bug me */

	event_message = 0;
	addr (event_message) -> ev_msg.code = wakeup_code;
	addr (event_message) -> ev_msg.seq_id = 0;
	addr (event_message) -> ev_msg.minor_dev_index = driver_ptr -> driver_status.dev_index;

	call hcs_$wakeup (coord_proc_id, driver_ptr -> driver_status.coord_chan, event_message, code);

	if code ^= 0 then do;
	     ec = code;				/* if error_table_ code...report */
	     call convert_ipc_code_ (ec);
	     call iodd_msg_ (error, master, ec, "iodd_listen_", "Fatal error:  Unable to send wakeup to coord.");
	     if code = 1 | code = 3
	     then signal no_coord;
	     else signal re_init;			/* must be bad args */
	end;

	if iodd_static.test_entry			/* give coordinator (which may be us) a chance to wakeup */
	then call timer_manager_$sleep (1, "11"b);	/* 1 second should be enough */

	return;

     end wake_coord;

/**/

/* Handles the daemon_idle condition */

idle_proc:
     procedure ();

	if ^idle_msg_sent
	then					/* if not told already about idle condition... */
	     call iodd_msg_ (normal, slave, 0, "", "^a driver: No requests, driver is idle.", iodd_static.major_device);

	idle_msg_sent = "1"b;			/* don't repeat the message */

	call continue_to_signal_ (0);			/* let the driver module know about this */

	return;

     end idle_proc;



/* Sets the auto logout bit in iodd_static so the driver will logout after N minutes of inactivity, where N is defined by
   iodd_static.auto_logout_interval */

trigger_auto_logout:
     procedure ();

	iodd_static.auto_logout_pending = "1"b;

/* if no command or request is present after returning from the main block point, the driver will logout */

	return;

     end trigger_auto_logout;
%page;
%include driver_ptr_list;
%page;
%include driver_status;
%page;
%include iod_event_message;
%page;
%include iod_tables_hdr;
%page;
%include iodd_static;
%page;
%include mseg_message_info;
%page;
%include request_descriptor;

     end iodd_listen_;




		    iodd_misc_cmds.pl1              11/15/82  1835.7rew 11/15/82  1508.3       55683



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


iodd_misc_cmds: proc;

	return;					/* illegal entry point */

/* This is a procedure to collect several external commands for the driver's use */

/* written by J. C. Whitmore 9/78 */


dcl  normal fixed bin int static options (constant) init (1);
dcl  slave fixed bin int static options (constant) init (2);

dcl  iod_val_segp ptr int static init (null);
dcl  last_sender char (64) int static init ("");

dcl  ap ptr;
dcl  al fixed bin;
dcl  bchr char (al) unal based (ap);

dcl  answer char (168) varying;
dcl  bvcs char (al) varying based (ap);
dcl  count fixed bin;
dcl  ec fixed bin (35);
dcl  idx fixed bin;
dcl  not_af bit (1) init ("1"b);			/* default assumption is not an active function */
dcl  string char (168) aligned;
dcl  msg_pfx char (80);
dcl (first, last) fixed bin;

dcl (null, substr, length, rtrim) builtin;

dcl  active_fnc_err_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  cu_$arg_count entry (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cu_$af_arg_count entry (fixed bin, fixed bin (35));
dcl  cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  iodd_msg_ entry options (variable);

dcl  error_table_$wrong_no_of_args fixed bin (35) ext;
dcl  error_table_$not_act_fnc fixed bin (35) ext;

dcl 1 valueseg based (iod_val_segp) aligned,
    2 laste fixed bin,
    2 freep fixed bin,
    2 pad (6) fixed bin,
    2 arry (1000),
      3 name char (32),
      3 valu char (168),
      3 lth fixed bin,
      3 chain fixed bin;


/* === Entry for drivers to get messages via send_message === */

/* Usage:  accept_messages -pn <mailbox_path> -bf -call iod_driver_message			*/

iod_driver_message: entry (a_number, a_sender, a_time, a_message, a_mbx_seg);

dcl (a_number, a_sender, a_time, a_message, a_mbx_seg) char (*);


	if a_sender = last_sender then msg_pfx = "=";	/* same as last sender, be brief */
	else do;

/*	the sender is formatted like this:    Person.Project (sent from) at <aim_level>		*/
/*	we are most concerned with "sent from" since Person and Project of all drivers is usually equal. */

	     first = index (a_sender, "(");		/* look for start of "(sent from)" field */
	     if first = 0 then do;			/* not there, use the whole thing */
		first = 1;
		last = length (rtrim (a_sender));
	     end;
	     else do;				/* sent from is defined */
		first = first + 1;			/* want the char after the "(" */
		last = index (a_sender, ")");		/* look for the close */
		if last = 0 then last = length (rtrim (a_sender)); /* missing, take all */
		else last = last - 1;
	     end;

	     msg_pfx = "From " || substr (a_sender, first, last - first + 1); /* this is the first part */
	end;

	idx = length (rtrim (msg_pfx));		/* how much was defined */

	msg_pfx = substr (msg_pfx, 1, idx) || " (" || substr (a_time, 11, 6) || ")"; /* the last part */

	call iodd_msg_ (normal, slave, 0, msg_pfx, a_message);

	last_sender = a_sender;			/* save last sender's identity */

	return;

/* === Entry to return per process values from an active function == */

/* Usage:  [iod_val keyword]								*/
/* returns the value associated with the keyword which was last set by the set_iod_val entry.	*/
/* If no value has been set, the string "undefined!" is returned.				*/

iod_val:	entry;

	not_af = "0"b;				/* assume we were called as an active function */

	call cu_$af_arg_count (count, ec);
	if ec ^= 0 then
	     if ec = error_table_$not_act_fnc then do;
		not_af = "1"b;			/* not an active function */
		call cu_$arg_count (count);
	     end;
	     else go to error;

	if count ^= 1 then do;
	     ec = error_table_$wrong_no_of_args;
	     go to error;
	end;

	if iod_val_segp = null then do;
	     call get_temp_segment_ ("iod_val", iod_val_segp, ec);
	     if ec ^= 0 | iod_val_segp = null then do;
error:		if not_af then call com_err_ (ec, "iod_val");
		else call active_fnc_err_ (ec, "iod_val");
		return;
	     end;
	end;

	if not_af then call cu_$arg_ptr (1, ap, al, ec);
	else call cu_$af_arg_ptr (1, ap, al, ec);
	if ec ^= 0 then go to error;

	do idx = 1 to laste;
	     if chain (idx) = 0 then if name (idx) ^= "" then
		     if bchr = name (idx) then do;
			answer = substr (valu (idx), 1, lth (idx));
			go to give;
		     end;
	end;
	answer = "undefined!";
give:	if not_af then call ioa_ (answer);
	else do;
	     call cu_$af_return_arg (1, ap, al, ec);
	     if ec ^= 0 then go to error;
	     bvcs = answer;
	end;
	return;


/* === Entry to define keywords and set values for them (returned by iod_val entry) === */

/* Usage:  set_iod_val  keyword {new_value}			*/
/*   if new value is missing, keyword is "undefined!"		*/

set_iod_val: entry;

	if iod_val_segp = null then do;
	     call get_temp_segment_ ("iod_val", iod_val_segp, ec);
	     if ec ^= 0 | iod_val_segp = null then go to error;
	end;

	call cu_$arg_ptr (1, ap, al, ec);
	if ec ^= 0 then go to error;
	string = bchr;

	call cu_$arg_ptr (2, ap, al, ec);
	if ec ^= 0 then do;
	     do idx = 1 to laste;
		if string = name (idx) then do;
		     chain (idx) = freep;
		     freep = idx;
		     name (idx) = "";
		end;
	     end;
	     return;
	end;

	do idx = 1 to laste;
	     if chain (idx) = 0 then if name (idx) ^= "" then
		     if name (idx) = string then do;
			go to f1;
		     end;
	end;
	if freep = 0 then idx, laste = laste + 1;
	else do;
	     idx = freep;
	     freep = chain (idx);
	end;
	name (idx) = string;
f1:	valu (idx) = bchr;
	chain (idx) = 0;
	lth (idx) = al;

	return;

     end iodd_misc_cmds;




		    iodd_msg_.pl1                   10/28/88  1403.5rew 10/28/88  1233.2       69723



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

iodd_msg_: proc (a_sev, a_target, a_code, proc_name);

/* Procedure to print messages to the operator(s) of the IO Daemon driver.
   This is an alternative to com_err_ in that it has the same calling sequence
   starting with the code argument.  It does not signal any conditions.
   It will write to the log, the error output switch, or to the user output switch.

   a_sev = 0	write a log message
   a_sev = 1	write a normal operator message
   a_sev = 2	write an error message

   It will write to the master, the slave or both.

   a_target = 0	write to both the master and the slave
   a_target = 1	write to the master only
   a_target = 2	write to the slave (if not active, write to master)

   */

/* Originally coded Nov 1977 by J. C. Whitmore */
/* Modified by J. C. Whitmore, 11/79, to decode the error code parameter descriptor */



/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
                                                   END HISTORY COMMENTS */


	dcl     a_sev		 fixed bin;	/* severity:  0 = log, 1 = normal, 2 = error */
	dcl     a_target		 fixed bin;	/* 0 = master and slave, 1 = master, 2 = slave */
	dcl     a_code		 fixed bin (35);	/* error a_code for the message */
	dcl     proc_name		 char (*);	/* calling proc */

	dcl     log		 fixed bin int static options (constant) init (0);
	dcl     normal		 fixed bin int static options (constant) init (1);
	dcl     error		 fixed bin int static options (constant) init (2);
	dcl     master		 fixed bin int static options (constant) init (1);
	dcl     slave		 fixed bin int static options (constant) init (2);
	dcl     both		 fixed bin int static options (constant) init (0);
	dcl     NL		 char (1) int static options (constant) init ("
");

	dcl     aptr		 ptr;		/* arg list ptr */
	dcl     arg_count		 fixed bin;
	dcl     (ec, code)		 fixed bin (35);
	dcl     full_msg		 char (512) aligned;/* message buffer */
	dcl     proc_msg		 char (256) aligned;/* msg from ioa_$general_rs based on args */
	dcl     short		 char (8) aligned;	/* short error_table_ msg */
	dcl     long		 char (100) aligned;/* long error_table_ msg */
	dcl     target		 fixed bin;
	dcl     sev		 fixed bin;
	dcl     (lth, n, l)		 fixed bin;
	dcl     type		 fixed bin;
	dcl     packed		 bit (1) aligned;
	dcl     ndims		 fixed bin;
	dcl     prec		 fixed bin;
	dcl     scale		 fixed bin;
	dcl     arg_ptr		 ptr;


	dcl     based_code		 fixed bin (35) based;

	dcl     iodd_stat_p		 ptr ext static;

	dcl     convert_status_code_	 entry (fixed bin (35), char (*) aligned, char (*) aligned);
	dcl     decode_descriptor_	 ext entry (ptr, fixed bin, fixed bin, bit (1) aligned, fixed bin, fixed bin, fixed bin);
	dcl     cu_$arg_ptr		 ext entry (fixed bin, ptr, fixed bin, fixed bin (35));
	dcl     cu_$arg_list_ptr	 entry (ptr);
	dcl     cu_$arg_count	 entry (fixed bin);
	dcl     ioa_$general_rs	 entry options (variable);
	dcl     iox_$put_chars	 entry (ptr, ptr, fixed bin, fixed bin (35));

	dcl     (addr, substr, rtrim, length, bin) builtin;
%page;

	call cu_$arg_count (arg_count);		/* how many args passed? */
	if arg_count < 4 then return;			/* must be something or forget it */

	stat_p = iodd_stat_p;			/* copy the iodd_static ptr for easy ref */

	target = a_target;				/* copy the args */
	sev = a_sev;
	if ^(target = master | target = slave) then target = both; /* validate the args */
	if ^(sev = log | sev = error) then sev = normal;

	l = 1;					/* ready to build full message at char 1 */

	if proc_name ^= "" then do;
		n = length (rtrim (proc_name));	/* how long is it? */
		full_msg = substr (proc_name, 1, n) || ": "; /* insert name */
		l = l + n + 2;			/* bump the index */
	     end;

	call cu_$arg_list_ptr (aptr);
	call cu_$arg_ptr (3, arg_ptr, (0), ec);
	call decode_descriptor_ (aptr, 1, type, packed, ndims, prec, scale);

	if (type = real_fix_bin_1_dtype) & (packed = "0"b)
	then code = arg_ptr -> based_code;
	else do;
		intype = 2 * type + bin (packed, 1);

		if (type >= bit_dtype) & (type <= varying_char_dtype)
		then inclength = prec;
		else do;
			info.inscale = scale;
			info.inprec = prec;
		     end;
		outtype = 2 * real_fix_bin_1_dtype;
		outfo.outscale = 0;
		outfo.outprec = 35;
		call assign_ (addr (code), outtype, outscale_prec, arg_ptr, intype, inscale_prec);
	     end;

	if code ^= 0 then do;			/* will there be an error_table message? */
		short, long = "";			/* clear the strings */
		call convert_status_code_ (code, short, long);
		n = length (rtrim (long));		/* how long is it */
		substr (full_msg, l) = substr (long, 1, n) || NL; /* fill it in and start a new line */
		l = l + n + 1;			/* bump the index */
	     end;

	if arg_count > 4 then do;			/* is there an additional message from the proc? */
		call ioa_$general_rs (aptr, 5, 6, proc_msg, lth, "0"b, "0"b); /* format the msg */
		if lth > 0 then do;			/* is anything there */
			substr (full_msg, l) = substr (proc_msg, 1, lth) || NL; /* add in a new line */
			l = l + lth + 1;
		     end;
	     end;

	lth = l - 1;				/* this is the number of chars that were good */
	if lth < 1 then return;			/* just checking */

/*	now see who we will tell about it */

	if sev = log then do;			/* just a message for the log */

		if target = slave | target = both then
		     if iodd_static.slave.active & iodd_static.slave.log_msg then do; /* maybe to the slave */
			     call write_msg (iodd_static.slave_out, ec);
			     if ec ^= 0 then target = master; /* OOPS - tell the master */
			end;
		     else target = master;		/* if not possible, tell someone */

		if target = master | target = both then
		     call write_msg (iodd_static.log_iocbp, ec); /* send it to the iodd log */

	     end;

	else if sev = error then do;			/* it is an error message, sound the beeper */

		if target = slave | target = both then /* protect the slave */
		     if iodd_static.slave.active & iodd_static.slave.print_errors then do;
			     call write_msg (iodd_static.slave_out, ec);
			     if ec ^= 0 then target = master;
			end;
		     else target = master;

		if target = master | target = both then call write_msg (iodd_static.error_io, ec);
						/* avoid error_output due to broadcast */

	     end;

	else do;					/* the normal operator message case */

		if target = slave | target = both then
		     if iodd_static.slave.active then do;
			     call write_msg (iodd_static.slave_out, ec);
			     if ec ^= 0 then target = master;
			end;
		     else target = master;		/* be sure someone gets the message */

		if target = master | target = both then call write_msg (iodd_static.master_out, ec);

	     end;

	return;


write_msg: proc (iocbp, ec);

	dcl     ec		 fixed bin (35);
	dcl     iocbp		 ptr;


	call iox_$put_chars (iocbp, addr (full_msg), lth, ec);

	return;					/* if it didn't work...well we tried */

     end write_msg;
%page; %include desc_dcls;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include std_descriptor_types;

     end iodd_msg_;




		    iodd_parse_.pl1                 10/28/88  1404.4rew 10/28/88  1230.2       73548



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


/****^  HISTORY COMMENTS:
  1) change(88-06-13,Brunelle), approve(88-06-13,MCR7911),
     audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style4 */

/* This is a common procedure containing entrypoints to parse an input command
   line and to parse a major/minor arguments string */

iodd_parse_: proc;

/* no entry here */
	return;

/* Arguments */

/* Following two are for iodd_parse_$args */
dcl  key char (*) var parameter;			/* key string to look for */
dcl  arg_string char (*) parameter;			/* string to examine */

/* following three are for iodd_parse_$command */
dcl  command_line char (*) parameter;			/* command line to parse */
dcl  elements_ptr ptr parameter;			/* pointer to the structure we fill in */
dcl  ec fixed bin (35);				/* error code */

/* External Procedures & Variables */

dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$bigarg fixed bin (35) ext static;
dcl  error_table_$unbalanced_quotes ext fixed bin (35);

/* Builtins */

dcl  (addr, index, length, ltrim, rtrim, search, substr, verify) builtin;

/* Internal Static */

dcl  COMMA char (1) defined QUOTE_COMMA pos (2);
dcl  NEWLINE char (1) defined WHITESPACE pos (4);
dcl  SPACE_OR_TAB char (2) defined WHITESPACE pos (2);
dcl  QUOTE char (1) defined QUOTE_COMMA pos (1);
dcl  QUOTE_COMMA char (2) int static options (constant) init (""",");

/* whitespace - BS SP HT NL VT NP CR */
dcl  WHITESPACE char (7) static options (constant) init (" 	
");

/* Automatic */

dcl  break_char_index fixed bin;			/* location of break char following keyword string */
dcl  first char (1) based (addr (line));		/* first char of the line */
dcl  i fixed bin;					/* do index */
dcl  keyword_location fixed bin;			/* location of keyword within arg_string */
dcl  len fixed bin;					/* general index variable for length */
dcl  line char (128);				/* internal copy of the command line */
dcl  one_char char (1);				/* obvious */
dcl  start fixed bin;				/* starting position of the token */
dcl  string_offset fixed bin;
dcl  temp char (256) var;
dcl  value char (256) var;

dcl  1 elements aligned based (elements_ptr),		/* this is the structure we fill in */
       2 max_wanted fixed bin,			/* the number of tokens to look for */
       2 n fixed bin,				/* number of valid tokens */
       2 token (max_wanted) char (64) var;		/* save exact length with each */
%page;
args: entry (key, arg_string) returns (char (256) var);

/* this entry is a common argument parsing routine used by the I/O daemon
   driver processes on the system.  It was originally extracted from
   remote_driver_.pl1.

   Each of the drivers on the system use this routine to parse the data in
   their major and/or minor argument strings.  The format for data within the
   strings is

   <keyword> [optional space] <keyword value>[, <keyword> [optional space] <keyword value>]
*/

/* make gross pass to see if key exists in input string.  if not, get out quick */
	keyword_location = index (arg_string, key);
	if keyword_location = 0 then do;
	     return ("");
	end;

/* the keyword exists.  if it is 1st keyword or preceeded by whitespace, it is
   valid keyword; otherwise it is last part of another type of keyword and we
   must look further */

	if keyword_location > 1 then do;
try_again:     one_char = substr (arg_string, keyword_location - 1, 1);
	     if index (WHITESPACE, one_char) ^= 0 then	/* preceeded by whitespace */
		goto copy_to_temp_string;
	     if one_char = COMMA then			/* preceeded by a comma */
		goto copy_to_temp_string;

	     if keyword_location < length (arg_string) then do;
		string_offset = keyword_location + length (key);
		keyword_location = index (substr (arg_string, string_offset), key);
		if keyword_location ^= 0 then do;
		     keyword_location = keyword_location + string_offset - 1;
		     go to try_again;
		end;
	     end;
	     return ("");
	end;
	else do;

/* copy all of string following the keyword, removing leading and trailing whitespace */
copy_to_temp_string:
	     string_offset = keyword_location + length (key);
	     temp = rtrim (ltrim (substr (arg_string, string_offset), WHITESPACE), WHITESPACE);

	     if temp = "" then do;			/* all blanks */
		return ("");
	     end;

/* look for a break char to terminate end of return string.  If no break char
   is found, return value is rest of string so just return it as is */
	     break_char_index = search (temp, QUOTE_COMMA);
	     if break_char_index = 0 then do;
		return (temp);
	     end;

/* found some sort of break char, must process based on type of character it
   is.  If it is a comma, this terminates the end of the string to return so
   return everything up to the comma */
	     if substr (temp, break_char_index, 1) = COMMA then do;
		return (substr (temp, 1, break_char_index - 1));
	     end;

/* the break character was a start quote then we must look for an end quote */
/* copy everything up to the quote into return string */
	     value = substr (temp, 1, break_char_index - 1);

find_level_1:  if break_char_index = length (temp) then	/* quotes don't balance */
		return ("");
	     temp = substr (temp, break_char_index + 1);	/* skip starting quote */
	     break_char_index = search (temp, QUOTE);	/* look for closing quote */
						/* allow commas within quotes */
	     if break_char_index = 0 then do;		/* quotes do not balance */
		return ("");			/* so return nothing */
	     end;

/* copy everything up to the new quote */
	     value = value || substr (temp, 1, break_char_index - 1);

	     if break_char_index = length (temp) then	/* unbalanced quotes */
		return ("");
	     if substr (temp, break_char_index + 1, 1) = QUOTE then do; /* double quote? */
		value = value || QUOTE;		/* replace with a single quote */
		break_char_index = break_char_index + 1;/* move the index */
		go to find_level_1;			/* and search on */
	     end;
	end;

	temp = value;

	return (rtrim (temp));
%page;


command: entry (command_line, elements_ptr, ec);

/* entry to parse the command_line string into a structure containing one
   element per token up to the maximum requested */

	elements.n = 0;				/* initialize to none found */
	len = length (command_line);			/* how long is it? */
	if len > 127 then do;			/* if too long to leave trailing blank */
	     ec = error_table_$bigarg;		/* give a code */
	     return;				/* and quit now */
	end;
	line = command_line;			/* copy the string */
	i = index (line, NEWLINE);			/* see if there was a nl char */
	if i > 0 then line = substr (line, 1, i - 1);	/* and drop it and the rest */
	do i = 1 to max_wanted;			/* look for max_wanted tokens */
	     len = verify (line, SPACE_OR_TAB);		/* correct for leading spaces or tabs */
	     if len = 0 then go to tally;		/* nothing left so quit */
	     if len > 1 then line = substr (line, len);	/* left justify */
	     start = 1;				/* assume the first char is good */
	     if first = QUOTE then do;		/* different action for quoted string */
		start = 2;			/* so we will skip the quote later */
		len = index (substr (line, 2), QUOTE);	/* find the closing quote */
		if len = 0 then do;
		     ec = error_table_$unbalanced_quotes; /* too bad */
		     return;			/* return what we found */
		end;
	     end;
	     else len = search (line, SPACE_OR_TAB);	/* find end of token */
	     if len > 64 then do;			/* complain if too long */
		ec = error_table_$bigarg;
		return;				/* return what we found */
	     end;
	     elements.n = elements.n + 1;		/* add one more token to the list */
	     elements.token (elements.n) = substr (line, start, len - 1);
	     line = substr (line, len + start);		/* get ready for the next one...left shift */
	end;

tally:	if elements.n = 0 then			/* if none found, give an error */
	     ec = error_table_$noarg;
	else ec = 0;
	return;

     end iodd_parse_;




		    iodd_quit_handler_.pl1          10/28/88  1403.5rew 10/28/88  1233.0      109035



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

iodd_quit_handler_: proc;

/* This is the standard quit handler for the I/O daemon driver process */
/* Its primary function is to see who sent the quit by looking for input. */
/* We assume that the first to give a response is the one who QUIT, and will */
/* accept the next input line as a command to be passed to the I/O daemon */
/* command processor.  If all is well, we will return to where the */
/* Quit took place.  However, the command processor may signal a condition */
/* and never return.   */

/* Originally coded in Sept 1973 by Robert S. Coren */
/* Rewritten in Feb 1975 by J. C. Whitmore for the access isolation */
/*      mechanism and general restructuring of the driver process. */
/* Modified Dec 1975 by J. C. Whitmore to pass quit/signal state to command processor and */
/*    to avoid writing on the slave stream if detached. */
/* Modified Aug 1977 by J. C. Whitmore to use the iodd_get_cmd_ subroutine for reading cmd lines */
/* Modified Nov 1977 by J. C. Whitmore to use iodd_msg_ for operator messages */
/* Modified Mar 1978 by J. C. Whitmore to use parameter to set auto start delay time */
/* Modified Mar 1979 by J. C. Whitmore to give proc name in last error call */



/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
                                                   END HISTORY COMMENTS */


/*	ENTRIES		*/

	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     ioa_$rsnnl		 entry options (variable);
	dcl     iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35));
	dcl     iodd_msg_		 entry options (variable);
	dcl     iodd_get_cmd_	 entry (ptr, fixed bin, fixed bin, bit (36), char (*), fixed bin, fixed bin (35));
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry);
	dcl     timer_manager_$reset_alarm_call entry (entry);



/*	AUTOMATIC		*/

	dcl     code		 fixed bin (35);
	dcl     terminal		 (2) ptr;
	dcl     line		 char (132);	/* input from terminal */
	dcl     message		 char (64);	/* what to say after a quit */
	dcl     junk		 fixed bin;	/* length from ioa_$rsnnl */
	dcl     nchars		 fixed bin;	/* number of chars read */
	dcl     state		 fixed bin;	/* quit = 2, signal handler = 3  */

	dcl     control		 bit (36);	/* control flags for the get cmd subr */

	dcl     1 ctl		 based (addr (control)),
		2 wait_for_input	 bit (1),
		2 prompt_master	 bit (1),
		2 prompt_slave	 bit (1),
		2 pad		 bit (33);

	dcl     iodd_stat_p		 ptr ext static;	/* where stat_p is stored */

	dcl     none		 fixed bin int static options (constant) init (0);
	dcl     master		 fixed bin int static options (constant) init (1); /* constant  indicating input from master device */
	dcl     slave		 fixed bin int static options (constant) init (2); /* constant indicating input from slave */
	dcl     both		 fixed bin int static options (constant) init (0); /* constant for output to both master & salve */
	dcl     normal		 fixed bin int static options (constant) init (1);
	dcl     error		 fixed bin int static options (constant) init (2);
	dcl     id		 char (20) int static options (constant) init ("iodd_quit_handler_");
	dcl     quit_cmd_level	 fixed bin int static options (constant) init (4);
	dcl     signal_cmd_level	 fixed bin int static options (constant) init (5);
	dcl     master_cmd		 bit (1);		/* true if master gave a cmd at this level */
	dcl     slave_cmd		 bit (1);		/* true if the slave gave a cmd at this level */
	dcl     last_cmd		 fixed bin;	/* who gave the last cmd line */
	dcl     source		 fixed bin;	/* who gave the current command line */
	dcl     slave_input_state	 bit (1);		/* last setting of the slave accept input switch */

	dcl     1 form_data		 aligned,		/* data from ctl_dim_ for form alignment */
		2 page_length	 fixed bin,	/* length of logical page */
		2 line_length	 fixed bin,	/* number of chars before folding line */
		2 line_no		 fixed bin,	/* current line on the page */
		2 carriage_pos	 fixed bin,	/* position of next char on the line */
		2 aligned		 bit (1) unal,	/* "1"b if we are simulating form feeds */
		2 pad		 bit (35) unal;

/*	CONDITIONS		*/

	dcl     (cleanup, any_other, alrm) condition;


/*	BUILTINS		*/

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


/*	BASED STRUCTURES AND INCLUDE FILES		*/


%include iod_tables_hdr;
%include iodd_static;
%page;

	stat_p = iodd_stat_p;			/* copy ptr to iodd_static */

	control = "0"b;

	ctl.prompt_master = "0"b;			/* get ready to ask for help */
	ctl.prompt_slave = "1"b;
	if iodd_static.request_in_progress then iodd_static.quit_during_request = "1"b;
	if iodd_static.request_in_progress then
	     if iodd_static.assigned_devices > 1 then
		call ioa_$rsnnl ("* QUIT *  request in progress on device: ^a", message, junk,
		     iodd_static.output_device);
	     else call ioa_$rsnnl ("* QUIT *  request in progress", message, junk);
	else message = "* QUIT *";

	call iox_$control (iodd_static.master_in, "resetread", null, code); /* we want clean input */

	if iodd_static.slave.active & iodd_static.slave.accept_input & iodd_static.allow_quits then do;
		call iox_$control (iodd_static.slave_in, "resetread", null, code);
		source = both;			/* send message to both master and slave */
	     end;
	else source = master;

	call iodd_msg_ (normal, source, 0, "", message);

	call timer_manager_$alarm_call (iodd_static.auto_start_delay, "11"b, auto_start);
						/* set a timer to automatically restart */
						/* if no command is given within 60 seconds */
	on alrm call continue_to_signal_ (code);	/* let this go through */

	on any_other begin;
		last_cmd = master;			/* stop the auto start proc */
		call timer_manager_$reset_alarm_call (auto_start); /* in case this frame goes away */
		call continue_to_signal_ (code);
	     end;
	message = "quit";
	state = quit_cmd_level;			/* tell the command processor it was a quit */
	iodd_static.quit_signaled = "1"b;		/* set the flag for anyone who is watching */

join:	slave_input_state = iodd_static.slave.accept_input; /* in case of a cleanup */
	if ^iodd_static.slave.allow_quits then /* if no quits allowed, don't read the terminal */
	     iodd_static.slave.accept_input = "0"b;

	on cleanup begin;
		call timer_manager_$reset_alarm_call (auto_start); /* now we know the frame is gone */
		iodd_static.slave.accept_input = slave_input_state;
		if iodd_static.slave.active & iodd_static.allow_quits then
		     call iox_$control (iodd_static.slave_in, "quit_enable", null, (0));
	     end;

	master_cmd = "0"b;				/* no commands received yet */
	slave_cmd = "0"b;
	last_cmd = none;
	terminal (master) = iodd_static.master_in;	/* copy the iocb ptrs for easy use */
	terminal (slave) = iodd_static.slave_in;


wait:	ctl.wait_for_input = "1"b;			/* say to wait for a command */

read:	call iodd_get_cmd_ (addr (line), 128, nchars, control, rtrim (message), source, code);

	if source = master then
	     if iodd_static.slave.active then /* don't let the slave interrupt the master */
		call iox_$control (iodd_static.slave_in, "quit_disable", null, (0));

	if source = none then go to start;		/* last cmd was start, so let er roll */

	if source = master then master_cmd = "1"b;	/* if master gave the cmd */
	else slave_cmd = "1"b;			/* otherwise it was the slave */
	last_cmd = source;				/* who gave the last cmd */
	ctl.wait_for_input = "0"b;			/* gotsome input */

	call iodd_command_processor_ (source, state, substr (line, 1, nchars), code);

	if iodd_static.slave.allow_quits then do;	/* let slave get a chance */
		iodd_static.slave.accept_input = (iodd_static.slave.accept_input | slave_input_state);
		call iox_$control (iodd_static.slave_in, "quit_enable", null, (0));
	     end;
	else do;					/* not accepting input */
		if iodd_static.slave.accept_input then slave_input_state = "1"b; /* in case set */
		iodd_static.slave.accept_input = "0"b;	/* hold off for now */
	     end;

	if code = 2 then go to read;			/* let's roll...but first check for input */
	if code = 0 | code = 1 then go to wait;		/* we want more input...no errors */
	call iox_$control (terminal (source), "resetread", null, (0)); /* clear input after bad command */
	go to wait;				/* and wait for correct input */

start:
	call timer_manager_$reset_alarm_call (auto_start);/* just in case.... */

/*	We can continue from the point of interruption now, unless operator has forced a "hold" */

	if iodd_static.forms then /* check alignment if simulating forms */
	     if iodd_static.ctl_term.attached then do;	/* if the terminal is there */
		     call iox_$control (iodd_static.slave_out, "form_status", addr (form_data), code);
		     if code ^= 0 then do;		/* something was wrong */
			     iodd_static.forms = "0"b;/* drop the forms */
			     call iodd_msg_ (error, slave, code, id, "Control terminal form simulation terminated.");
			     ctl.prompt_master = "1"b;/* force operator action */
			     ctl.prompt_slave = "1"b; /* slave can answer */
			     call iox_$control (iodd_static.master_in, "resetread", null, (0));
			     call iox_$control (iodd_static.slave_in, "resetread", null, (0));
			     go to wait;
			end;
		     if ^form_data.aligned then do;	/* dim says not aligned...so, */
			     call iodd_msg_ (normal, slave, 0, "", "Control forms not aligned."); /* tell slave opr */
			     iodd_static.slave_hold = "1"b;
			     go to wait;
			end;
		end;
	     else iodd_static.forms = "0"b;		/* not legal if no ctl term attached */

	if last_cmd = slave then /* do we owe the master a courtesy message? */
	     if master_cmd then
		call iodd_msg_ (normal, master, 0, "", "^a driver continuing.", iodd_static.major_device);
	     else ;

	else if slave_cmd then /* do we owe the slave a courtesy message? */
	     if iodd_static.slave.active then /* be sure it wasn't detached since last prompt */
		call iodd_msg_ (normal, slave, 0, "", "^a driver continuing.", iodd_static.major_device);

	iodd_static.slave.accept_input = slave_input_state;

	call iox_$control (iodd_static.master_in, "start", null, (0)); /* be sure we don't lose a wakeup */

	if iodd_static.slave.active then do;
		call iox_$control (iodd_static.slave_in, "start", null, (0)); /* be sure we don't lose a wakeup */
	     end;

	return;					/* let'er roll */


command_level: entry;

/*  This entry is used by the signal handler in test mode to allow
   most commands to be used after the process has been initialized. */

          control = "0"b;
	ctl.prompt_master = "1"b;			/* only tell the master of the problem */
	ctl.prompt_slave = "0"b;
	message = "iodd signal";			/* new cmd level name */
	state = signal_cmd_level;			/* tell the command processor it was from an unclaimed signal */
	iodd_static.master_hold = "1"b;		/* force a response from the master */
	go to join;				/* now join the main procedure */

init: entry (aptr);

	dcl     aptr		 ptr;

	stat_p = aptr;				/* init the pointer for iodd_static */
	return;

auto_start: proc;

/* internal proc to automatically "start" after a quit if no commands are given in 60 seconds */

	if iodd_static.re_init_in_progress then return;

	if last_cmd = none then do;
		call iodd_msg_ (normal, both, 0, "", "Automatic Start Given");
		go to start;
	     end;
	else return;				/* wasn't that easy? */

     end auto_start;

     end iodd_quit_handler_;




		    iodd_signal_handler_.pl1        10/28/88  1403.5rew 10/28/88  1233.0       98397



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

iodd_signal_handler_: proc;

/* Unclaimed signal handler for I/O Daemon driver process. In "test"
   mode it will invoke the "debug" command; otherwise it will attempt
   to move on to whatever is to be done next.
*/

/* Coded September 1973 by Robert S. Coren */
/* Modified January 1975 by J. C. Whitmore to work with iodd_ */
/* Modified November 1975 by M. A. Braida to special case seg_fault_error on user's segment */
/* Modified Sept 1977 by J. C. Whitmore to not terminate driver status segs (now done by iodd_) */
/* Modified by J. C. Whitmore, 11/78, to use iodd_msg_ instead of ioa_ for messages */
/* Modified by J. C. Whitmore, 3/79, to correct a misplaced end statement */
/* Modified BIM 84-01-06 for default_restart, quiet_restart */
/* Modified by C. Marker, 02/23/85, to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
                                                   END HISTORY COMMENTS */


	dcl     bel_string		 char (40) aligned int static;
	dcl     stars		 char (50) aligned int static options (constant) init ((5)"**********");
	dcl     condition		 char (32);	/* fixed length string for condition name */
	dcl     io_stat		 bit (72) aligned;
	dcl     ec		 fixed bin (35);	/* error code */

	dcl     ios_$attach		 entry (char (*) aligned, char (*), char (*), char (*), bit (72) aligned);
	dcl     ios_$order		 entry (char (*), char (*), ptr, bit (72) aligned);
	dcl     iodd_msg_		 entry options (variable);
	dcl     new_proc		 entry ();
	dcl     iodd_quit_handler_$command_level entry ();
	dcl     debug		 entry;
	dcl     timer_manager_$sleep	 entry (fixed bin (71), bit (2) aligned);
	dcl     condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr);
	dcl     find_condition_info_	 entry (ptr, ptr, fixed bin (35));
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     get_system_free_area_	 entry (ptr);

	dcl     areap		 ptr;
	dcl     msgp		 ptr;
	dcl     msg_len		 fixed bin;
	dcl     err_message		 char (msg_len) based (msgp);
	dcl     sys_area		 area (262144) based (areap);

	dcl     id		 char (24) int static options (constant) init ("iodd_signal_handler_");
	dcl     master		 fixed bin int static options (constant) init (1);
	dcl     both		 fixed bin int static options (constant) init (0);
	dcl     error		 fixed bin int static options (constant) init (2);
	dcl     normal		 fixed bin int static options (constant) init (1);

	dcl     recursion_count	 fixed bin int static init (0); /* depth of signals */

	dcl     (null, fixed, addr, baseno) builtin;

	dcl     (resume, any_other, cleanup, daemon_again, daemon_new_device) condition;

%page;

	dcl     1 local_condition_info aligned like condition_info;

/*  */
	on cleanup call ios_$order ("user_i/o", "start", null, io_stat);

	local_condition_info.version = condition_info_version_1; /* version of the condition_info structure */

	call find_condition_info_ (null (), addr (local_condition_info), ec); /* get condition data */

	condition = local_condition_info.condition_name;	/* change to fixed string for the compiler */

	if condition = "alrm" then do;		/* pass these on...quits will never come here */
pass_on:		call continue_to_signal_ (ec);	/* pass the condition on to someone else */
		return;
	     end;
	condition_info_header_ptr = local_condition_info.info_ptr;
	if condition = "cput" then goto pass_on;
	if condition = "finish" then goto pass_on;
	if iodd_static.test_entry
	then if condition = "mme2" then go to pass_on;	/* to be able to use debug */
	     else if condition = "program_interrupt" then go to pass_on;
	if condition = "command_error" then return;
	if condition = "command_question" then return;
	if condition_info_header_ptr ^= null
	then if condition_info_header.quiet_restart |
		condition_info_header.default_restart
	     then go to pass_on;

	if condition = "daemon_new_device" then go to proc_dies; /* this procedure should never see this */

/*	that's all for the benign system conditions, time to be careful */

	if ^iodd_static.recursion_flag then recursion_count = 0; /* coming from known state? */

	iodd_static.recursion_flag = "1"b;		/* start watching for trouble */

	recursion_count = recursion_count + 1;		/* increment the counter */

	if recursion_count > 4 then call new_proc;	/* maximum trouble, calls for drastic action */

	if recursion_count = 3 then
	     call iodd_msg_ (error, both, 0, id, "recursive errors, driver may new_proc.");

	if condition = "no_coord" then /* for this condition.... */
	     if iodd_static.no_coord_flag then do;	/* be sure process is ready to accept */

/*		This condition is signalled if the coordinator process has gone away. We will attempt */
/*		to reinitialize, but not until the coordinator process id recorded in iodc_data */
/*		has changed (signifying the advent of a new coordinator). */

		     iodd_static.re_init_in_progress = "1"b; /* let others know what happened */

		     call iodd_msg_ (error, both, 0, id, """no_coord"" condition signalled.");

		     go to iodd_static.no_coord_label;	/* invoke all the cleanup handlers */

		end;

	if condition = "re_init" | condition = "resume" then do;
		on any_other signal daemon_new_device;

/*		This condition is signalled when the driver is in trouble.  We will attempt */
/*		to reinitialize the device specified by the operator without asking */
/*		him to input the device again. */

		iodd_static.re_init_in_progress = "1"b;
		call iodd_msg_ (error, both, 0, id, "Driver starting reinitialization");

		go to iodd_static.re_init_label;	/* first catch the cleanup handlers */
	     end;


	if condition = "io_error" then do;		/* in this case we have to be careful about */
						/* writing on the slave stream to avoid another error */
						/* the control terminal probably got hung up */
		call timer_manager_$sleep (5, "11"b);	/* give the hangup handler a chance */

		iodd_static.master_hold = "1"b;	/* force operator attention */

		if recursion_count > 3 then go to proc_dies; /* multiple times is too much */
		call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* only talk to the master */
		if iodd_static.slave.active | iodd_static.ctl_term.attached then do;
			iodd_static.forms = "0"b;	/* can't simulate forms now */
			iodd_static.slave.allow_quits = "0"b;
			iodd_static.slave.accept_input = "0"b;
			iodd_static.slave.print_errors = "0"b;

			call iodd_msg_ (error, both, 0, id,
			     "^/^a^/Condition ""io_error"" signalled.  Slave functions have been terminated.^/^a",
			     stars, stars);
		     end;

		if request_in_progress then do;	/* maybe we can continue */
			call iodd_msg_ (normal, both, 0, "", "Current request will be restarted.");
			signal daemon_again;	/* restart the request */
		     end;
	     end;

	if condition = "seg_fault_error" then do;	/* find out if current segment caused the condition */

		mcp = local_condition_info.mc_ptr;	/* set machine condition ptr */
		scup = addr (mc.scu);		/* find segment number in machine condition */
		if fixed (baseno (iodd_static.segptr), 17, 0) = fixed (scu.tpr.tsr, 17, 0) then
		     /* if the segment numbers are the same ... */
		     go to driver_default;		/* skip the long error message */
	     end;

	call get_system_free_area_ (areap);

	msgp = null;
	call condition_interpreter_ (areap, msgp, msg_len, 3, local_condition_info.mc_ptr, condition, local_condition_info.wc_ptr, local_condition_info.info_ptr);

	if msgp ^= null then do;
		call iodd_msg_ (error, both, 0, id, err_message);
		free msgp -> err_message in (sys_area);
	     end;
	else call iodd_msg_ (error, both, 0, id, "^a condition signalled.", condition);

	if condition = "stack"
	then go to proc_dies;			/* we will not attempt to deal with this */

	on resume go to continue;			/* to get around CP in test mode */

	if iodd_static.test_entry
	then do;					/* give programmer chance to find out what happened */
		if ^iodd_static.initialized then do;	/* be careful about blocking before init is done */
			call iodd_msg_ (error, master, 0, id, "Warning - initialization is not complete");
						/* some commands won't work */
			call iodd_msg_ (normal, master, 0, "", "Calling debug");
			call debug;		/* this should do the trick */
		     end;
		else call iodd_quit_handler_$command_level (); /* give programmer a shot */
		return;				/* assume problem was fixed, so start */
	     end;

continue:

	revert resume;				/* drop the handler...we may signal it */
	if recursion_count > 1 then
	     call iodd_msg_ (error, both, 0, id,
		"^a^/Condition ^a signalled while handling unclaimed signal.^/^a^a",
		stars, condition, stars, bel_string);

	if recursion_count > 2 then do;		/* after two conditions, give up */
proc_dies:
		on any_other call new_proc;		/* dont take chances, we are in trouble */

		call iodd_msg_ (error, both, 0, id, "New process will be created.");
		call new_proc ();
	     end;

driver_default:

	if iodd_static.initialized then do;		/* is there enough data to do more? */

		call driver_default_handler (addr (local_condition_info)); /* see if the driver module needs the condition */
						/* the driver module is responsible for cleaning up */
						/* any requests in progress */
		signal resume;			/* if we return, pass back to iodd_listen_ */
	     end;
	else do;					/* no data, tell someone and commit suicide */
		call iodd_msg_ (error, both, 0, id, "^a^/Condition ^a occured before full initialization.",
		     stars, condition);
		signal daemon_new_device;
	     end;
	go to proc_dies;				/* this should never happen, but .... */

init: entry (a_ptr);

	dcl     a_ptr		 ptr;

	stat_p = a_ptr;
	if iodd_static.test_entry then bel_string = "";	/* null for testing */
	else bel_string = (40)"";			/* 40 bells (007(8)) */

	return;
%page; %include condition_info;
%page; %include condition_info_header;
%page; %include driver_ptr_list;
%page; %include driver_status;
%page; %include iod_event_message;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include mc;
%page; %include mseg_message_info;
%page; %include request_descriptor;

     end iodd_signal_handler_;




		    output_request_.pl1             10/28/88  1403.5rew 10/28/88  1229.6      430488



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


output_request_: proc (a_stream_name, a_element_size, a_stat_p, a_banner_proc, a_code);

/* General procedure for doing output for an I/O daemon device driver */

/* Rewritten from old procedure "io_daemon" in August 1973 by Robert S. Coren */
/* Modified in March 1975 by J.C. Whitmore during driver restructuring */
/* Modified in December 1975 by M. A. Braida to include new restart capabilities and update the accounting mechanism */
/* modified 05/76 by THVV for set_kst_attributes & force deactivation */
/* Modified 06/76 by J. C. Whitmore to fix translate hardware bug */
/* Modified June 1976 by J. L. Homan to accommodate charging by line count instead of block count. */
/* modified July 1976 by THVV for message notification */
/* Modified Nov 1977 by J. C. Whitmore  for minor bug fixed and remote driver compatability */
/* Modified Mar 1978 by J. C. Whitmore for new dprint_msg format and driver upgrade */
/* Modified Aug 1978 by J. C. Whitmore for: auto defer by time estimate, separation of charge queue and request queue,
   no deletion if device error occurs, and further upgrade. */
/* Modified Nov 1978 by J. C. Whitmore to add path to device error msg and to notify user on deferring request */
/* Modified Mar 1979 by J. C. Whitmore to correct string size on some assignments */
/* Modified by J. C. Whitmore, 1/80, to limit the scope of system_privileges_ for send mail (V5.4) */
/* Modified: February 23, 1985 by C. Marker if the page labels are not the same as the access class of the segment a message will be logged.  Changed to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(87-05-10,Gilcrease), approve(87-07-31,MCR7686),
     audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
     Changed to implement line numbered output.
  2) change(88-06-03,Brunelle), approve(88-06-03,MCR7911),
     audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 I/O daemon tables.
                                                   END HISTORY COMMENTS */


	dcl     a_stream_name	 char (*);	/* stream to write the output on */
	dcl     a_element_size	 fixed bin;	/* number of bits in each stream element */
	dcl     a_stat_p		 ptr;		/* the value of stat_p from caller */
	dcl     a_banner_proc	 entry;		/* procedure to be called for head and tail banners */
	dcl     a_code		 fixed bin (35);	/* error code....used for driver_fatal_error */

/* AUTOMATIC */

	dcl     abort_msg		 char (256) var;	/* string for bad error messages */
	dcl     access_class	 bit (72) aligned;	/* access class of user file */
	dcl     auth		 bit (72) aligned;	/* authorization used to set banner access class */
	dcl     auth_string		 char (680);	/* string form of auth */
	dcl     banner_proc		 entry variable options (variable); /* proc to be called for messages */
	dcl     chgsw		 bit (1) aligned;	/* do we charge for this request/copy */
	dcl     code		 fixed bin (35);
	dcl     copies_left		 fixed bin;
	dcl     delete_msg		 char (32);
	dcl     desc_ptr		 ptr;
	dcl     dest		 char (24) aligned;
	dcl     device_error	 bit (1);
	dcl     dr_ptr		 ptr;		/* pointer to driver status segment */
	dcl     el_size		 fixed bin;
	dcl     ename		 char (32) aligned; /* entry name of file for output */
	dcl     err_mess		 char (200) var;
	dcl     fcbp		 ptr;
	dcl     full_path		 char (168) aligned;
	dcl     head		 char (64) aligned;
	dcl     header_sw		 bit (1);
	dcl     i			 fixed bin;	/* random variable */
	dcl     iocbp		 ptr;		/* iocb pointer for request stream */
	dcl     l			 fixed bin;
	dcl     last_error_count	 fixed bin;
	dcl     lg_msg		 char (100) aligned;
	dcl     mailname		 char (32) aligned;
	dcl     max_comp		 fixed bin;	/* highest msf component number */
	dcl     msg		 char (256) aligned;
	dcl     new_clock		 fixed bin (71);
	dcl     new_cpu		 fixed bin (52);
	dcl     new_pp		 fixed bin;
	dcl     new_rate		 fixed bin;
	dcl     new_waits		 fixed bin (35);
	dcl     nret		 fixed bin;
	dcl     old_clock		 fixed bin (71);
	dcl     oldmodes		 char (256);
	dcl     old_cpu		 fixed bin (52);
	dcl     old_pp		 fixed bin;
	dcl     old_rate		 fixed bin;
	dcl     old_waits		 fixed bin (35);
	dcl     pverb		 char (5) aligned;
	dcl     req_stream		 char (32);
	dcl     save_code		 fixed bin (35);
	dcl     seconds		 fixed bin;	/* number of seconds to do one copy */
	dcl     segp		 ptr;
	dcl     start_segp		 pointer;
	dcl     short_msg		 char (8) aligned;
	dcl     time_est		 fixed bin;	/* number of seconds estimated to do request */
	dcl     total_bits		 fixed bin (35);
	dcl     user_dir		 char (168) aligned;/* directory containing users' segment */
	dcl     val		 fixed bin;	/* for validation level */

/* INTERNAL STATIC */

	dcl     bad_chars		 char (4) int static;
	dcl     err_label		 label int static;	/* point of return from condition handler */
	dcl     fault_name		 char (32) aligned int static;
	dcl     first_call		 bit (1) static init ("1"b); /* TRUE on first call */
	dcl     privileged		 bit (1) static init ("1"b); /* TRUE if we can call phcs_ */
	dcl     sys_priv		 bit (1) static init ("1"b); /* True if process can call system_privilege_ */
	dcl     request_data_p	 ptr int static;	/* ptr to REQUEST for set_single_copy entrry */


/*	CONSTANTS 	*/

	dcl     both		 fixed bin int static options (constant) init (0);
	dcl     error		 fixed bin int static options (constant) init (2);
	dcl     error_msg		 fixed bin int static options (constant) init (3); /* value for print error message */
	dcl     factor		 float bin int static options (constant) init (0.75e0); /* smoothing factor for rate estimate */
	dcl     header		 fixed bin int static options (constant) init (1); /* value for header wanted */
	dcl     id		 char (24) int static options (constant) init ("output_request_");
	dcl     log		 fixed bin int static options (constant) init (0);
	dcl     master		 fixed bin int static options (constant) init (1);
	dcl     quiet		 bit (1) int static options (constant) init ("0"b);
	dcl     restart_source	 fixed bin int static init (1);
	dcl     slave		 fixed bin int static options (constant) init (2);
	dcl     stars		 char (40) int static options (constant) aligned init ((40)"*"); /* For error messages */
	dcl     tail		 fixed bin int static options (constant) init (2); /* value for tail wanted */
	dcl     tell_user		 bit (1) int static options (constant) init ("1"b);

	dcl     NL		 char (1) int static options (constant) init ("
");
	dcl     TAB		 char (1) int static options (constant) init ("	"); /* the tab character */
	dcl     VT		 char (1) int static options (constant) init ("");						/* the vertical  tab */
	dcl     FF		 char (1) int static options (constant) init ("");						/* and the form feed */

/* EXTERNAL STATIC */

	dcl     access_operations_$io_daemon_set_page_labels bit (36) aligned external static;

	dcl     error_table_$improper_data_format fixed bin (35) ext static;
	dcl     error_table_$noentry	 fixed bin (35) ext static;
	dcl     error_table_$moderr	 fixed bin (35) ext static;
	dcl     error_table_$dirseg	 ext static fixed bin (35);
	dcl     error_table_$ai_restricted ext static fixed bin (35);


/* EXTERNAL ENTRIES */

	dcl     access_audit_gate_$log_obj_ptr_user entry options (variable);
	dcl     aim_check_$equal	 entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
	dcl     aim_check_$greater	 entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
	dcl     clock_		 ext entry returns (fixed bin (71)); /* gets clock time */
	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35));
	dcl     convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35));
	dcl     convert_status_code_	 ext entry (fixed bin (35), char (8) aligned, char (100) aligned);
	dcl     cpu_time_and_paging_	 entry (fixed bin (35), fixed bin (52), fixed bin);
	dcl     cu_$level_get	 entry (fixed bin);
	dcl     cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35));
	dcl     date_time_		 entry (fixed bin (71), char (*) aligned);
	dcl     hcs_$fs_get_mode	 ext entry (ptr, fixed bin (5), fixed bin (35));
	dcl     hcs_$fs_get_path_name	 entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35));
	dcl     hcs_$get_access_class	 entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin (35));
	dcl     hcs_$get_user_effmode	 entry (char (*) aligned, char (*) aligned, char (*) aligned,
				 fixed bin, fixed bin (5), fixed bin (35));
	dcl     hcs_$status_minf	 entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (2), fixed bin (24), fixed bin (35));
	dcl     io_daemon_account_	 entry (entry, ptr);
	dcl     ioa_$ioa_stream	 entry options (variable);
	dcl     ioa_$rsnnl		 entry options (variable);
	dcl     iodd_msg_		 entry options (variable);
	dcl     iox_$control	 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     iox_$modes		 entry (ptr, char (*), char (*), fixed bin (35));
	dcl     iox_$get_line	 entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
	dcl     iox_$look_iocb	 entry (char (*), ptr, fixed bin (35));
	dcl     iox_$put_chars	 entry (ptr, ptr, fixed bin (24), fixed bin (35));
	dcl     msf_manager_$close	 entry (ptr);
	dcl     msf_manager_$get_ptr	 entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
	dcl     msf_manager_$open	 entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));
	dcl     phcs_$deactivate	 entry (ptr, fixed bin (35));
	dcl     phcs_$set_kst_attributes entry (fixed bin, ptr, fixed bin (35));
	dcl     read_allowed_	 entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
	dcl     send_mail_$access_class entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned, fixed bin (35));
	dcl     system_privilege_$ipc_priv_on entry (fixed bin (35));
	dcl     system_privilege_$ipc_priv_off entry (fixed bin (35));
	dcl     system_privilege_$ring1_priv_on entry (fixed bin (35));
	dcl     system_privilege_$ring1_priv_off entry (fixed bin (35));

/* STRUCTURES */

	dcl     1 ksta		 like kst_attributes aligned int static;

	dcl     1 counts_data	 aligned like counts;



/* BUILTINS */

	dcl     (addr, bit, divide, fixed, length, null, substr, ltrim, rtrim, translate) builtin;
	dcl     (baseno, binary, string, unspec, float, min, char) builtin;


/* CONDITIONS */

	dcl     (cleanup, linkage_error, daemon_again, daemon_again_slave, daemon_kill,
	        daemon_save, daemon_defer, daemon_cancel, any_other) condition;

/* output_request_: proc (a_stream_name,  a_element_size, a_stat_p, a_banner_proc, a_code);  MAIN ENTRY      */

/* copy arguments and initialize pointers and control switches */

	stat_p = a_stat_p;
	sdb_ptr = null ();
	banner_proc = a_banner_proc;			/* no charging yet */

	chgsw = "0"b;
	fcbp, segp, start_segp = null;
	req_stream = a_stream_name;
	el_size = a_element_size;
	a_code = 0;				/* set to zero for now */
	if first_call then do;			/* Conduct an experiment to see about phcs_ */
		bad_chars = TAB || NL || VT || FF;	/* define the bad chars for labels */
		on linkage_error begin;
			privileged = "0"b;
			go to tough;
		     end;
		string (ksta) = "0"b;
		call phcs_$set_kst_attributes (binary (baseno (stat_p), 18), addr (ksta), (0));
						/* This is a NOP - structure is 0 */
		ksta.set.tpd, ksta.value.tpd = "1"b;	/* Dont put on bulkstore just for lil ole me */
		ksta.set.explicit_deactivate_ok, ksta.value.explicit_deactivate_ok = "1"b;
		ksta.set.allow_write = "1"b;		/* Dont let me wreck user seg by accident */
		ksta.set.tus, ksta.value.tus = "1"b;	/* Save a vtoc write */
tough:		revert linkage_error;
		first_call = "0"b;			/* Now we know */
	     end;
	last_error_count = -1;			/* invalid error count, hasn't been set */

	dr_ptr = iodd_static.driver_ptr;		/* get ptr to the current driver status seg */
	desc_ptr = addr (dr_ptr -> driver_status.descriptor); /* and to the request descriptor */
	mseg_message_info_ptr = desc_ptr;		/* first part of desciptor is mseg_message_info */
	dmp = addr (dr_ptr -> driver_status.message);	/* set dprint_msg default pointer */
	request_data_p = addr (REQUEST);		/* get ready to handle "single copy" request */
	driver_data_p = addr (desc_ptr -> request_descriptor.driver_data); /* get ptr to printer_driver_data */
	orderp = addr (counts_data);			/* set auto ref ptr to counts structure */
	header_sw = ""b;

	call iox_$look_iocb (req_stream, iocbp, code);
	if code ^= 0 then do;
		call driver_fatal_error (code, "Unable to find iocb pointer for output stream.");
		go to clean_out;
	     end;

	on cleanup call clean_proc;			/* establish a cleanup handler */
	sdb_ptr = iocbp;
	err_label = abort_request;

/* Set up master structure used by this pgm. */

	string (REQUEST.control_flags) = ""b;		/* clear all the flags */
	REQUEST.requestor = mseg_message_info.sender_id;
	REQUEST.continued = desc_ptr -> request_descriptor.continued;
	REQUEST.restarted = desc_ptr -> request_descriptor.restarted;
	REQUEST.priority_request = desc_ptr -> request_descriptor.priority_request;
	REQUEST.separator = "1"b;			/* we always want a print separator first time */
	REQUEST.device_name = dr_ptr -> driver_status.dev_name_label;
	REQUEST.request_type = dr_ptr -> driver_status.req_type_label;
	REQUEST.queue = desc_ptr -> request_descriptor.q;
	REQUEST.charge_queue = desc_ptr -> request_descriptor.charge_q; /* coord may want a priority rate */
	REQUEST.request_no = desc_ptr -> request_descriptor.seq_id; /* coord assigned the number */
	REQUEST.restart_no = desc_ptr -> request_descriptor.prev_seq_id;
						/* previous number of request (0 = not restarted) */
	REQUEST.contd_no = desc_ptr -> request_descriptor.contd_seq_id;
						/* previous number of continued request (0 = not continued) */
	REQUEST.dpmp = dmp;
	if dprint_msg.delete_sw then REQUEST.delete = 1;
	else REQUEST.delete = 0;
	REQUEST.bit_count = 0;
	REQUEST.line_count = 0;
	REQUEST.page_count = 0;
	REQUEST.line_nbrs = dprint_msg.line_nbrs;
	REQUEST.copies = dprint_msg.copies;
	if ^(REQUEST.continued | REQUEST.restarted) then
	     print_driver_data.copies_done = 0;		/* no copies assumed, unless continued or restarted */
						/* if none completed, it's not continued */
	else if print_driver_data.copies_done < 1 then REQUEST.continued = "0"b;
	print_driver_data.copies_done = min (print_driver_data.copies_done, REQUEST.copies - 1);
						/* be sure we do at least one copy */
	copies_left = REQUEST.copies - print_driver_data.copies_done; /* might be partly done */
	REQUEST.copy_no = print_driver_data.copies_done + 1; /* we start with the next copy */
	REQUEST.notify = dprint_msg.notify;
	REQUEST.output_mode = "";			/* clear in case of error message */
	REQUEST.total_charge = 0e0;
	REQUEST.charge = 0e0;
	REQUEST.time_start_request = clock_ ();
	call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request);

	if dprint_msg.output_module = 1 then do;
		REQUEST.punsw = 0;
		pverb = "print";
	     end;
	else do;
		REQUEST.punsw = 1;
		pverb = "punch";
	     end;

	l = length (rtrim (REQUEST.requestor)) - 2;	/* get length of Person.Project */
	mailname = substr (REQUEST.requestor, 1, l);
	unspec (send_mail_info) = "0"b;
	send_mail_info.version = send_mail_info_version_2;
	send_mail_info.wakeup = "1"b;
	send_mail_info.always_add = "1"b;
	send_mail_info.sent_from = REQUEST.request_type;

/* get pathname of file for operator and error messages */

	user_dir = dprint_msg.dirname;
	ename = dprint_msg.ename;
	call ioa_$rsnnl ("^a^[>^]^a", full_path, l, user_dir, (user_dir ^= ">"), ename);

	REQUEST.full_path = translate (full_path, "", bad_chars); /* force a page fault - HARDWARE BUG WRITEAROUND */
	full_path = translate (full_path, "", bad_chars); /* remove bad chars for banner */
	dprint_msg.destination = translate (dprint_msg.destination, "", bad_chars);
	dprint_msg.heading = translate (dprint_msg.heading, "", bad_chars);
	REQUEST.full_path = full_path;		/* save the clean copy */

/*  record the processing of this request in the log  */

	head = dprint_msg.heading;
	if substr (head, 1, 5) = " for " then /* see if dprint added something */
	     head = substr (head, 6);			/* if so get rid of it */
	if head ^= "" then call ioa_$rsnnl ("(for ""^a"" ", msg, l, head);
	else do;
		l = 1;				/* no heading, get ready for a dest msg */
		msg = "(";
	     end;

	dest = dprint_msg.destination;
	if dest ^= "" then call ioa_$rsnnl ("^vaat ""^a"")", msg, l, (l), substr (msg, 1, l), dest);
	else if l = 1 then msg = "";			/* no head or dest case */
	else substr (msg, l, 1) = ")";		/* heading only case */

	call iodd_msg_ (log, both, 0, "",		/* let the subr do the work */
	     "Request ^d ^a q^d:  ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a",
	     REQUEST.request_no, REQUEST.request_type, REQUEST.queue, full_path, (copies_left > 1), copies_left,
	     REQUEST.priority_request, REQUEST.charge_queue, REQUEST.requestor, msg);

	err_mess = full_path;			/* let this sit here in case */

/* Find the access class to use for the banner */

	if aim_check_$greater (mseg_message_info.sender_authorization, dr_ptr -> driver_status.min_banner) then
	     auth = mseg_message_info.sender_authorization;
	else auth = dr_ptr -> driver_status.min_banner;	/* mark the output with auth */

	call convert_authorization_$to_string (auth, auth_string, code); /* get string form */
	if code ^= 0 then do;			/* oops....bad news */
		call fatal_error (tell_user);		/* tell the operator, and user */
		go to clean_out;			/* drop the request */
	     end;

	l = length (rtrim (auth_string));		/* how long is the string */
	if l > 132 then do;				/* when too long for one line */
		call convert_authorization_$from_string (access_class, "system_high", code);
		if code ^= 0 then do;		/* oops....bad news */
			call fatal_error (tell_user); /* tell the operator, and user */
			go to clean_out;		/* drop the request */
		     end;
		if aim_check_$equal (auth, access_class) then auth_string = "SYSTEM HIGH"; /* this is shorter */
	     end;

	REQUEST.access_class_string = char (auth_string, length (REQUEST.access_class_string));
						/* save all we can for the label */

/* check the requestor's access to the pathname he specified */

	val = mseg_message_info.sender_level;

	call check_user_access (user_dir, ename, code);	/* use the internal proc to do the work */
	if code ^= 0 then do;			/* oops....bad news */
		call fatal_error (tell_user);		/* tell the operator, and user */
		go to clean_out;			/* drop the request */
	     end;

	call open_file (user_dir, ename, fcbp, max_comp, code); /* one call does a lot */
	if code ^= 0 then do;			/* oops....bad news */
		call fatal_error (tell_user);		/* tell the operator, and user */
		go to clean_out;			/* drop the request */
	     end;

	on daemon_again begin;			/* to restart the current request.... */
		restart_source = master;		/* talking to the master terminal */
		go to check_reprint_copies;
	     end;
	on daemon_again_slave begin;			/* to restart the current request.... */
		restart_source = slave;		/* talking to slave terminal */
		go to check_reprint_copies;
	     end;
	on daemon_save begin;
		REQUEST.saved = "1"b;
		if ^header_sw then go to clean_out;
		else go to save_request;
	     end;
	on daemon_defer go to defer_request;		/* save it for later */
	on daemon_kill go to flush_request;		/* flush the current request */
	on daemon_cancel go to flush_request;		/* likewise,  the cancelled flag has been set */

	iodd_static.request_in_progress = "1"b;		/* ready to accept kill, cancel etc. */
						/* now we can restart this request if necessary */

/* with the true total bitcount, we can make an estimate of the time needed to do the request */

	if dr_ptr -> driver_status.bit_rate_est > 0 then do;
		total_bits = REQUEST.bit_count * copies_left; /* total is bits per copy times copies */
		time_est = divide (total_bits, dr_ptr -> driver_status.bit_rate_est, 17, 0);

		if (dr_ptr -> driver_status.defer_time_limit > 0) & /* if a limit is defined, check it */
		     (time_est > dr_ptr -> driver_status.defer_time_limit + 6) then do; /* allow 6 sec fuzz */
						/* so estimate will look bigger than limit in msg */
			if REQUEST.priority_request then /* priority requests go any way */
			     msg = "Defer time limit suspended for priority request.";
			else if REQUEST.restarted then /* can't defer what is not in the queue */
			     msg = "Restarted request exceeds time limit but cannot be deferred.";
			else do;			/* drop this one */
				desc_ptr -> request_descriptor.keep_in_queue = "1"b;
				call iodd_msg_ (log, both, 0, "",
				     "**Deferring request ^d. Time estimate: ^.1f mins.",
				     REQUEST.request_no, float (time_est) / 60.0e0);
				call ioa_$rsnnl ("Deferring request for ^a.^/Time estimate: ^.1f minutes.", msg, l,
				     REQUEST.full_path, float (time_est) / 60.0e0);
				call notify_user (substr (msg, 1, l));
				go to clean_out;
			     end;
		     end;
		else msg = "";

		if time_est > 60 | msg ^= "" then /* tell operator if request will exceed 1 minute */
		     call iodd_msg_ (log, slave, 0, "",
			"  Time estimate for request ^d:  ^.1f mins.^[^/^2x^a^]",
			REQUEST.request_no, float (time_est) / 60.0e0, (msg ^= ""), msg);
	     end;

	if REQUEST.copy_no > 1 then call iodd_msg_ (log, both, 0, "",
		"  Starting request ^d at copy ^d of ^d.", REQUEST.request_no, REQUEST.copy_no, REQUEST.copies);

	go to start_request;			/* begin the output of the request */

restart_this_request:

/* 	this is the point where we come to restart the current request */

	REQUEST.continued = "1"b;			/* make this look like a continuation */
	REQUEST.contd_no = REQUEST.request_no;		/* of this request */
	REQUEST.charge = 0e0;
	REQUEST.time_start_request = clock_ ();
	call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request);

start_request:

	REQUEST.cpu_time = 0;			/* reset the usage data */
	REQUEST.real_time = 0;
	REQUEST.page_waits = 0;
	REQUEST.pre_pages = 0;
	REQUEST.copy_no = print_driver_data.copies_done + 1; /* initialize copy-counter */

	call iox_$control (iocbp, "get_error_count", addr (last_error_count), code); /* start checking for errors */
	if code ^= 0 then last_error_count = -1;	/* value not defined */

	call check_labels (user_dir, ename, start_segp, code);
	if code ^= 0 then do;			/* oops....bad news */
		call fatal_error (tell_user);		/* tell the operator, and user */
		go to clean_out;			/* drop the request */
	     end;

	do while (REQUEST.copies >= REQUEST.copy_no);	/* once around for each copy */

	     call banner_proc (req_stream, header, addr (REQUEST), code); /* print header banner */
	     if code ^= 0 then do;			/* I/O error trying to print header */
		     call driver_fatal_error (code, "I/O ERROR -- trying to print header.");
		     go to clean_out;		/* abort this request completely */
		end;

	     REQUEST.separator = "0"b;		/* separator bar was for first banner only */
	     header_sw = "1"b;			/* header was ok, do tail */
	     call iox_$control (iocbp, "runout", null, code); /* be sure head sheet is done before clock reading */

	     call cpu_time_and_paging_ (old_waits, old_cpu, old_pp); /* keep time and page waits for accounting */
	     old_clock = clock_ ();			/* time copy started */

	     call output_file (code);			/* this will do it */
	     if code ^= 0 then do;
		     call driver_fatal_error (code, (err_mess));
		     go to clean_out;
		end;

	     call iox_$control (iocbp, "runout", null, code); /* be sure copy is done before counting it */

	     if ^desc_ptr -> request_descriptor.saved then /* if leaving this til later, don't charge now */
		if REQUEST.copies > print_driver_data.copies_charged then do;
			chgsw = "1"b;		/* user honestly deserves these charges */
			print_driver_data.copies_charged = print_driver_data.copies_charged + 1;
		     end;
		else chgsw = "0"b;
	     else chgsw = "0"b;

	     call charge_for_work;			/* do the accounting so we can put price on tail */

	     if last_error_count = -1 then device_error = ""b; /* no error data */
	     else do;
		     call iox_$control (iocbp, "get_error_count", addr (i), code);
		     if code ^= 0 | i > last_error_count then device_error = "1"b;
		     else device_error = "0"b;	/* we can figure the transfer rate */
		end;

	     if ^(iodd_static.quit_during_request | device_error) then do; /* can we update the rate estimate? */
		     old_rate = dr_ptr -> driver_status.bit_rate_est; /* get the last value */
		     seconds = divide (REQUEST.real_time, 1000000, 17); /* see how many seconds have passed */
		     if seconds < 1 then new_rate = old_rate; /* avoid divide by zero */
		     else new_rate = divide (REQUEST.bit_count, seconds, 17, 0); /* get bits/sec */
		     if old_rate > 0 then /* use first good rate to start the estimate */
			new_rate = fixed (old_rate * factor + new_rate * (1e0 - factor)); /* use exp smoothing */
		     dr_ptr -> driver_status.bit_rate_est = new_rate; /* put back new value */
		end;

	     call banner_proc (req_stream, tail, addr (REQUEST), code); /* this will put on the tail banner */
	     if code ^= 0 then do;			/* some type of error..don't do it again */
		     call driver_fatal_error (code, "I/O ERROR -- attempting to write tail banner.");
		     go to clean_out;
		end;

	     print_driver_data.copies_done = print_driver_data.copies_done + 1;
	     REQUEST.copy_no = REQUEST.copy_no + 1;	/* get ready for next copy */
	     header_sw = "0"b;
	end;					/* done with this copy...check for more in while loop */

	call iodd_msg_ (log, both, 0, "",
	     "  Charge for request ^d:  $^.2f,  ^[(^d lines,  ^d pages^;(^d cards^s^]^[ per copy)^;)^]",
	     REQUEST.request_no, REQUEST.total_charge, (REQUEST.punsw = 0),
	     REQUEST.line_count, REQUEST.page_count, (copies_left > 1));

	if REQUEST.notify then do;
		call ioa_$rsnnl ("^aed ^a $^.2f queue ^d ^a ^d", abort_msg, l,
		     pverb, REQUEST.full_path, REQUEST.total_charge,
		     REQUEST.queue, REQUEST.device_name, REQUEST.request_no);
		call notify_user (substr (abort_msg, 1, l));
	     end;

clean_out:					/* get ready for the next users' request */

	if last_error_count > -1 then do;		/* if error count is defined */
		call iox_$control (iocbp, "get_error_count", addr (i), code);
		if code ^= 0 | i > last_error_count then /* if errors are possible */
		     if ^desc_ptr -> request_descriptor.dont_delete then do; /* and user not told about it */
			     if REQUEST.delete = 1 then do; /* tell user we cancelled his delete request */
				     desc_ptr -> request_descriptor.dont_delete = "1"b;
				     call ioa_$rsnnl ("Device error during request ^d.  Segment ^a will not be deleted.",
					msg, l, REQUEST.request_no, REQUEST.full_path);
				     call notify_user (substr (msg, 1, l));
				end;
			end;
	     end;

	call clean_proc;				/* get junk out of the address space */

	desc_ptr -> request_descriptor.finished = "1"b;	/* mark it as done */
	iodd_static.request_in_progress = "0"b;		/* no more commands can be effective */
	call iox_$control (iocbp, "runout", null, code);	/* make device disgorge */
	return;


check_reprint_copies:				/* on restart, we transfer back here to release the */
						/* stack frame with the dim, so the slave can again write */
						/* to the remote device and ask a question */

	call restart_request (restart_source);		/* this will do the work */
						/* and ask the operator how many copies were good */

	go to restart_this_request;			/* now go back and restart the request */

/*  This is where the condition handlers "go to" when something has gone wrong */

flush_request:					/* kill and cancel handlers jump back here */

	msg = "Operator aborted output";		/* message for kill and cancel */
	chgsw = "0"b;				/* can't charge */
	go to no_delete;

abort_request:					/* unclaimed signals transfer to here */

	chgsw = ""b;				/* assume we can't charge user */

	msg = """" || rtrim (fault_name) || """ condition occured"; /* format basic message */

	if fault_name = "seg_fault_error" & /* user deleted seg, charge for what was done */
	     iodd_static.segptr ^= null then do;
		chgsw = "1"b;
		delete_msg = "";			/* forget to tell user we won't delete his seg */
	     end;
	else do;
no_delete:
		if REQUEST.delete ^= 0
		then delete_msg = "; segment will not be deleted";
		else delete_msg = "";
	     end;

	call ioa_$rsnnl ("^a during processing of ^a request^a.", err_mess, l,
	     msg, pverb, delete_msg);

	code = 0;

	call fatal_error (tell_user);			/* this will clean things up a bit */

	go to clean_out;				/* now drop the request */


defer_request:					/* leave this in the queue for a while */

	err_mess = "Operator deferred request until a later time.";
	chgsw = ""b;
	code = 0;

	call fatal_error (tell_user);

	go to clean_out;


save_request:

	err_mess = "Processing suspended by operator.";
	chgsw = "0"b;
	code = 0;

	call fatal_error (quiet);			/* abort gently */

	go to clean_out;

/* ======================================================================================= */
/* ==============================    INTERNAL PROCEDURES    ============================== */
/* ======================================================================================= */

fatal_error: proc (notify);

	dcl     notify		 bit (1);

	save_code = code;				/* hold this for now */
	REQUEST.notify = REQUEST.notify | notify;	/* set notify flag by arg if off */
	desc_ptr -> request_descriptor.dont_delete = "1"b;/* make sure we don't delete user seg */

	if ^REQUEST.notify & ^header_sw then do;	/* try to tell requestor */
		call banner_proc (req_stream, header, addr (REQUEST), code);
		if code = 0 then header_sw = "1"b;	/* all was well */
	     end;

	if header_sw then call charge_for_work;		/* update REQUEST data if possible */

	call error_write (save_code, err_mess);

	if header_sw then /* if we owe a tail banner, do it */
	     call banner_proc (req_stream, tail, addr (REQUEST), code);

	call iodd_msg_ (log, both, 0, "",
	     "Processing of request ^d terminated.", REQUEST.request_no);

	return;					/* let the caller flush the request */

     end fatal_error;

/* ===================================== */

error_write: proc (code, message);			/* for writing error messages to console &
						   request stream */
	dcl     code		 fixed bin (35);
	dcl     message		 char (*) varying;

	short_msg, lg_msg = "";			/* clear any junk */
	if code ^= 0 then call convert_status_code_ (code, short_msg, lg_msg);

	call ioa_$rsnnl ("Request for ^a. ^a ^a", msg, l, REQUEST.full_path, lg_msg, message);

	if REQUEST.notify then /* this lets us be quiet about save and defer */
	     call notify_user (substr (msg, 1, l));

	call iodd_msg_ (log, both, 0, "", "**Request ^d: ^a ^a", REQUEST.request_no, lg_msg, message);

	if header_sw then do;			/* must not do a "reset" or line and page count is lost */
		call ioa_$rsnnl ("^2/^a^a^/io_daemon: ^a ^a^/^a^a^2/", abort_msg, l, VT,
		     stars, lg_msg, message, stars, VT);
		call banner_proc (req_stream, error_msg, addr (abort_msg), code); /* put out error msg to media */
	     end;
	return;

     end error_write;

check_labels:
     procedure (user_dir, ename, segptr, code);

/* Internal procedure to check that the top and bottom labels are
   the access class of the segment. */

	dcl     access_class	 bit (72) aligned;
	dcl     code		 fixed bin (35);
	dcl     ename		 char (*) aligned;
	dcl     level		 fixed bin;
	dcl     user_dir		 char (*) aligned;
	dcl     segptr		 pointer;
	dcl     sys_info$access_class_floor bit (72) aligned external static;


	dcl     1 local_audit_user_info aligned like audit_user_info;
	dcl     1 local_audit_eventflags aligned like audit_event_flags;

	code = 0;

	if dprint_msg.top_label ^= dprint_msg.bottom_label then do;
LOG_AUDIT_MESSAGE:
		call cu_$level_get (level);
		unspec (local_audit_user_info) = ""b;
		local_audit_user_info.version = audit_user_info_version_1;
		local_audit_user_info.user_id = mseg_message_info.sender_id;
		local_audit_user_info.ring = mseg_message_info.sender_level;
		local_audit_user_info.process_id = mseg_message_info.sender_process_id;
		local_audit_user_info.authorization = mseg_message_info.sender_authorization;
		local_audit_user_info.authorization_range (1) = sys_info$access_class_floor;
		local_audit_user_info.authorization_range (2) = mseg_message_info.sender_max_authorization;
		local_audit_user_info.audit_flags = mseg_message_info.sender_audit;

		unspec (local_audit_eventflags) = ""b;
		local_audit_eventflags.grant = "1"b;

		call access_audit_gate_$log_obj_ptr_user ("output_request_",
		     level, unspec (local_audit_eventflags),
		     access_operations_$io_daemon_set_page_labels,
		     segptr, 0, null (), 0, addr (local_audit_user_info));

		return;
	     end;

	call hcs_$get_access_class (user_dir, ename, access_class, code);
	if code ^= 0 then return;

	call convert_authorization_$from_string (authorization, rtrim (dprint_msg.top_label), code);
	if code ^= 0 then do;
		code = 0;
		goto LOG_AUDIT_MESSAGE;		/* This isn't an access class */
	     end;

	if ^(aim_check_$equal (access_class, authorization)) then goto LOG_AUDIT_MESSAGE;

	return;
     end check_labels;

notify_user: proc (message);

	dcl     message		 char (*) aligned;
	dcl     (ipc_ind, r1_ind, ec)	 fixed bin (35);

	ipc_ind, r1_ind = -1;			/* set to non-zero to test call */

	if ^sys_priv then go to send_it;		/* if they failed once, .... */

	on linkage_error begin;
		sys_priv = "0"b;			/* stop trying if we fail */
		go to revert_handler;		/* send the message if possible */
	     end;

	on any_other begin;
		if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind);
		if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind);
		r1_ind, ipc_ind = -1;
		call continue_to_signal_ (ec);
	     end;

	call system_privilege_$ring1_priv_on (r1_ind);

	call system_privilege_$ipc_priv_on (ipc_ind);

revert_handler:

	revert linkage_error;

send_it:

	call send_mail_$access_class (mailname, message, addr (send_mail_info),
	     mseg_message_info.sender_authorization, ec);

	if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind);

	if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind);

	return;

     end notify_user;

charge_for_work: proc;

/* Accounting section, done at end of processing each copy of output. */

	counts.line_count = 0;			/* Clear these items so that if the order is unknown.. */
	counts.page_count = 0;			/* .. (like if card dim doesn't do them) we still go */
	counts.line = 0;
	call iox_$control (iocbp, "get_count", orderp, code);
	new_clock = clock_ ();
	call cpu_time_and_paging_ (new_waits, new_cpu, new_pp);

	if counts.line_count > 0 then
	     REQUEST.line_count = counts.line_count;
	else REQUEST.line_count = divide (REQUEST.bit_count + 699, 700, 24, 0); /* Use block count
						   if dim returns zero line count */
	if counts.line = 1 then REQUEST.page_count = counts.page_count - 1; /* if ending with a FF */
	else REQUEST.page_count = counts.page_count;
	REQUEST.cpu_time = new_cpu - old_cpu;
	REQUEST.real_time = new_clock - old_clock;
	REQUEST.page_waits = fixed (new_waits - old_waits, 35);
	REQUEST.pre_pages = fixed (new_pp - old_pp, 35);

	if chgsw then do;
		if dr_ptr -> driver_status.have_accounting then do;
			call io_daemon_account_ (dr_ptr -> driver_status.acct_entry, addr (REQUEST));
		     end;
		else do;
			REQUEST.price_per_n_lines,	/* zap all charges to zero */
			     REQUEST.price_per_n_pages,
			     REQUEST.charge = 0e0;
			REQUEST.no_accounting = "1"b; /* and flag it */
		     end;
	     end;
	else REQUEST.charge = 0e0;			/* reset any undefined values */

	REQUEST.total_charge = REQUEST.total_charge + REQUEST.charge;

	return;

     end charge_for_work;

check_user_access: proc (user_dir, ename, ec);

/* Internal procedure to check that the requestor has at least "r" access to
   the specified segment */

	dcl     user_dir		 char (*) aligned;
	dcl     ename		 char (*) aligned;
	dcl     code		 fixed bin (35);
	dcl     ec		 fixed bin (35);
	dcl     mode		 fixed bin (5);
	dcl     access_class	 bit (72) aligned;

	call hcs_$get_user_effmode (user_dir, ename, REQUEST.requestor, val, mode, code);
	if code ^= 0 then do;
		if code = error_table_$noentry then err_mess = ""; /* simple case, just say no entry */
		else err_mess = "Unable to get user's mode.";
		ec = code;
		return;
	     end;

	if (bit (mode, 5) & "01000"b) = "0"b then do;
		err_mess = "User does not have read access.";
		ec = error_table_$moderr;
		return;
	     end;

	call hcs_$get_access_class (user_dir, ename, access_class, code);
	if code ^= 0 then do;
		err_mess = "Unable to get access class of segment.";
		ec = code;
		return;
	     end;

	if ^read_allowed_ (mseg_message_info.sender_authorization, access_class) then do;
		ec = error_table_$ai_restricted;
		err_mess = "User not allowed to read segment.";
		return;
	     end;

	ec = 0;					/* ok, user passed the checks */

	return;

     end check_user_access;

open_file: proc (user_dir, ename, fcbp, max_comp, code);

	dcl     user_dir		 char (*) aligned;
	dcl     ename		 char (*) aligned;
	dcl     fcbp		 ptr;
	dcl     max_comp		 fixed bin;
	dcl     code		 fixed bin (35);

	dcl     comp_dir		 char (168) aligned;
	dcl     comp_name		 char (32) aligned;
	dcl     type		 fixed bin (2);
	dcl     dir		 fixed bin int static options (constant) init (2);
	dcl     dir_len		 fixed bin;
	dcl     bc		 fixed bin (24);
	dcl     mode		 fixed bin (5);
	dcl     mult_ind		 fixed bin;

	REQUEST.bit_count = 0;

	call hcs_$status_minf (user_dir, ename, 1, type, bc, code); /* see what kind of a thing it is */
	if code ^= 0 then do;
		err_mess = char ("Driver cannot get status of file: " || full_path, length (err_mess));
		return;
	     end;

	if type = dir then /* directory */
	     if bc < 1 then do;			/* it was a directory */
		     code = error_table_$dirseg;
		     return;
		end;
	     else max_comp = bc - 1;			/* MSF - highest component is bitcount less one */
	else max_comp = 0;				/* SSF - highest component is 0 */

	call msf_manager_$open (user_dir, ename, fcbp, code);
	if code ^= 0 then do;
		err_mess = "Unable to open file: " || full_path;
		return;
	     end;

	do mult_ind = 0 to max_comp;			/* now we look at each component */

	     call msf_manager_$get_ptr (fcbp, mult_ind, "0"b, segp, bc, code);
	     if code ^= 0 then do;			/* we failed, don't try to do partial files */
		     call ioa_$rsnnl ("Unable to get pointer to file component: ^d.", err_mess, dir_len, mult_ind);
		     return;
		end;

	     if mult_ind = 0 then start_segp = segp;	/* this is a pointer to the first component */

/*		we got a pointer to something...where is it */
/*		and does the requestor have access to it? */

	     call hcs_$fs_get_path_name (segp, comp_dir, dir_len, comp_name, code);
	     if code ^= 0 then do;
		     err_mess = "Could not get file component pathname.";
		     return;
		end;

	     call check_user_access (comp_dir, comp_name, code);
	     if code ^= 0 then do;			/* he tried to pull a fast one and got caught */
		     err_mess = err_mess || "  " || substr (comp_dir, 1, dir_len) || ">" || comp_name;
						/* most of err_mess was set by check_user_access */
		     return;
		end;

	     if bc < el_size then do;			/* must be at least one element per component */
		     code = error_table_$improper_data_format; /* choose a good error message */
		     err_mess = "Zero length segment: " || substr (comp_dir, 1, dir_len) || ">" || comp_name;
		     return;
		end;

	     REQUEST.bit_count = REQUEST.bit_count + bc;	/* total the bits for accounting */

	     call hcs_$fs_get_mode (segp, mode, code);	/*  make sure daemon has access  */
	     if code ^= 0 then do;
		     err_mess = "Driver process does not have access to segment.";
		     return;
		end;

	     if (bit (mode, 5) & "01000"b) = "0"b then do;
		     err_mess = "Driver process does not have read access to segment.";
		     code = error_table_$moderr;	/* give some access violation code */
		     return;
		end;
	end;


/* Now we know that the file is there and that the requestor has the correct access to it.
   The continued operation of the driver now assumes that the file will remain the same
   until the driver is done.  That is, the access will not change, the number of components will not
   change, and the size of each component will not change.  */


     end open_file;

output_file: proc (ec);

	dcl     ec		 fixed bin (35);	/* you guessed it, error code */

	dcl     bc		 fixed bin (24);
	dcl     comp_no		 fixed bin;	/* current msf component number */
	dcl     max_el		 fixed bin (24);


	ec = 0;					/* clear the error code */

	segp = null;				/* don't try to deactivate */
	comp_no = 0;				/* start at the begining of msf */
	oldmodes = "";
	if REQUEST.line_nbrs then do;
		call iox_$modes (iocbp, "line_nbrs", oldmodes, code);
		if code ^= 0 then do;
			err_mess = "Setting line_nbrs mode";
			return;
		     end;
	     end;

next_comp:					/* done with last component */

	if segp ^= null & privileged then
	     call phcs_$deactivate (segp, (0));		/* so try to deactivate the seg */

	call msf_manager_$get_ptr (fcbp, comp_no, "0"b, segp, bc, ec); /* get ptr to seg */
	if segp = null then do;
		err_mess = "Invalid seg ptr to component.";
		return;
	     end;

	if privileged then /* .. do it (gently if possible) */
	     call phcs_$set_kst_attributes (binary (baseno (segp), 18), addr (ksta), (0));

	iodd_static.segptr = segp;			/* tell signal handler what segment we are using */
	max_el = divide (bc + el_size - 1, el_size, 24, 0); /* see now many elements to write out */

	call iox_$put_chars (iocbp, segp, max_el, ec);	/* This is the actual output of segment */
	iodd_static.segptr = null;			/* not referencing user seg now */
	if ec ^= 0 then do;
		err_mess = "IO error during output of file.";
		return;
	     end;

	if comp_no < max_comp then do;		/* are we at real end of file */
		comp_no = comp_no + 1;		/* go on to the next component */
		go to next_comp;			/* deactivate old and get new */
	     end;

	if REQUEST.line_nbrs then
	     if oldmodes ^= "" then call iox_$modes (iocbp, oldmodes, "", (0));
	if privileged & (REQUEST.copies = REQUEST.copy_no | max_comp > 0) then
	     call phcs_$deactivate (segp, (0));		/* try to deactivate */
	segp = null;

	return;

     end output_file;


driver_fatal_error: proc (code, err_msg);

/* Internal procedure to print messages when there is an IO error on the output stream */

	dcl     code		 fixed bin (35);
	dcl     err_msg		 char (*);

	call iodd_msg_ (error, both, code, id,
	     "^a ^/Driver returning to command level.  Request is deferred.", err_msg);

	desc_ptr -> request_descriptor.dont_delete = "1"b;/* give a reprieve....in case */
	desc_ptr -> request_descriptor.keep_in_queue = "1"b; /* defer it if possible */

	a_code = code;				/* report driver_fatal_error */

	return;

     end driver_fatal_error;

restart_request: proc (source);

/* internal procedure used to question operator regarding the restart of current request */

	dcl     source		 fixed bin;

	dcl     answer		 char (120);
	dcl     cnt_msg		 char (24);	/* space to specify a continued request */
	dcl     copies_good		 fixed bin (35);	/* operator response to number of good copies */
	dcl     nelt		 fixed bin;
	dcl     input_iocbp		 ptr;
	dcl     output_stream	 char (32);
	dcl     code		 fixed bin (35);
	dcl     pg_count_msg	 char (30);	/* space to specify pages per copy */
	dcl     restrt_msg		 char (30);	/* space that the request is to be restarted */


/* set up input/output stream for the master terminal */

	if source = master then do;
		input_iocbp = iodd_static.master_in;
		output_stream = iodd_static.master_output;
	     end;

/* set up input/output stream for the slave terminal */

	else do;
		source = slave;			/* just to be sure */
		input_iocbp = iodd_static.slave.slave_in;
		output_stream = iodd_static.slave.slave_output;
	     end;


/* is there a need to query the operator? */

	if REQUEST.punsw = 1 | print_driver_data.copies_done = 0 | REQUEST.copies = 1 then do;

		restrt_msg = "";
		REQUEST.separator = "1"b;
		print_driver_data.copies_done = 0;

	     end;

	else do;					/* must query operator */

		if REQUEST.page_count > 0 then /* is there a non zero page count? */
		     call ioa_$rsnnl (" (^d pages each)", pg_count_msg, nret, REQUEST.page_count);
		else pg_count_msg = "";

		if REQUEST.continued then /* is this a continued request? */
		     cnt_msg = " (continued request)";
		else cnt_msg = "";

ask_how_many_good:					/* tell operator how many were done */
		call ioa_$ioa_stream (output_stream, "^d of ^d copies^a were done^a.  How many were good?",
		     print_driver_data.copies_done, REQUEST.copies, pg_count_msg, cnt_msg);
						/* now let's see what the operator tells us */
		answer = "";			/* first make the answer all blank */
		call iox_$get_line (input_iocbp, addr (answer), 10, nelt, code);
		if code ^= 0 then do;
			copies_good = 0;
			go to tell_operator;
		     end;

		answer = ltrim (rtrim (answer, NL || " ")); /* remove leading spaces and NL chars */

		copies_good = cv_dec_check_ (answer, code);

		if code ^= 0 then do;		/* was the answer a number? */
bad_no:			call ioa_$ioa_stream (output_stream, "Please specify a number between 0 and ^d",
			     print_driver_data.copies_done);
			go to ask_how_many_good;
		     end;

		if copies_good < 0 | copies_good > print_driver_data.copies_done then go to bad_no;

tell_operator:	print_driver_data.copies_done = copies_good; /* update the record of finished copies */

		if copies_good = 0 then REQUEST.separator = "1"b;

		call ioa_$rsnnl (" from copy number ^d", restrt_msg, nret, copies_good + 1);

	     end;

	call ioa_$ioa_stream (output_stream, "Restarting request^a.", restrt_msg);

	return;

     end restart_request;


clean_proc: proc;

	iodd_static.segptr = null;			/* tell signal handler we are done with it */

	if fcbp ^= null then do;
		if segp ^= null then
		     if privileged then call phcs_$deactivate (segp, (0));
		call msf_manager_$close (fcbp);
	     end;

	segp, fcbp = null;				/* because this is used for several functions */

	return;

     end clean_proc;



error_during_request: entry (cond);			/* for coming back after signal */

	dcl     cond		 char (*);

	fault_name = cond;

	go to err_label;



set_single_copy: entry;

/*  to abort multiple copies if the single command must be used */

	request_data_p -> ordata.copies = 1;		/* make it fall out of the loop after tail sheet */

	return;
%page; %include access_audit_eventflags;
%page; %include access_audit_user_info;
%page; %include dprint_msg;
%page; %include driver_status;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include kst_attributes;
%page; %include mseg_message_info;
%page; %include output_request_data;
%page; %include print_driver_data;
%page; %include prt_conv_info;
%page; %include prt_info;
%page; %include prt_order_info;
%page; %include prt_sdb;
%page; %include queue_msg_hdr;
%page; %include request_descriptor;
%page; %include send_mail_info;

     end output_request_;




		    printer_driver_.pl1             10/03/89  1000.4rew 10/03/89  0953.5      278010



/****^  ***********************************************************
        *                                                         *
        * 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,delnl,insnl,ifthenstmt,ifthen */

/* format: off */

/* I/O Daemon driver module for the printer with settable paper characteristics and logical channel stops */

/* Created:  September 1977 by J. C. Whitmore from the original version of printer_driver_ */
/* Modified: March 1978 by J. C. Whitmore for new dprint message format */
/* Modified: June 1979 by C. Hornig to initialize driver_status.dev_ctl_ptr */
/* Modified: 25 December 1981 by G. Palter to initialize prt_ctl.flags so that any unimplemented features will not be
      accidently left on (eg: force_ctl_char) */
/* Modified: November 1983 by C. Marker added support for force_nsep */
/* Modified: February 23, 1985 by C. Marker to use version 5 message segments */


/****^  HISTORY COMMENTS:
  1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686),
     audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
     Update for version 4 dprint_msg and allow previos version(s).
  2) change(88-06-03,Brunelle), approve(88-06-03,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 I/O daemon tables.
  3) change(88-08-29,Farley), approve(88-08-19,MCR7911),
     audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199):
     Updated for version 5 dprint_msg.
  4) change(89-06-15,Brunelle), approve(89-09-18,MCR8129),
     audit(89-09-29,Beattie), install(89-10-03,MR12.3-1083):
     Correct generation of major/minor_args_ptr when using offset into the I/O
     daemon tables string area.
                                                   END HISTORY COMMENTS */


/* format: on */


printer_driver_:
     procedure ();

	return;					/* this is not a legal entry */


/* Automatic variables */

dcl  date_string char (24);
dcl  ec fixed bin (35);				/* standard error code for calls */
dcl  ignore fixed bin (35);				/* error code to be ignored */
dcl  i fixed bin;					/* index variable */
dcl  major_args char (major_args_length) based (major_args_ptr);
dcl  major_args_ptr ptr;				/* ptr to major_args string */
dcl  major_args_length fixed bin;
dcl  omode char (256) aligned;
dcl  opr_msg char (160);				/* string for operator messages */
dcl  value char (32);				/* temporary char string */
dcl  p2 ptr;

dcl  io_stat bit (72) aligned;			/* ios_ status code */

dcl  1 st aligned based (addr (io_stat)),		/* breakdown of status code */
       2 code fixed bin (35),
       2 flags bit (36);


dcl  1 form_info aligned,
       2 page_length fixed bin,
       2 line_length fixed bin,
       2 line_no fixed bin,
       2 carriage_position fixed bin,
       2 aligned bit (1) unal,
       2 pad bit (35) unal;
%page;

/* External entries */

dcl  add_char_offset_ entry (ptr, fixed bin(21)) returns(ptr) reducible;
dcl  clock_ entry () returns (fixed bin (71));
dcl  com_err_ entry options (variable);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  iodd_listen_ entry (ptr);
dcl  iodd_msg_ entry options (variable);
dcl  iodd_parse_$args entry (char(*) var, char(*)) returns(char(256) var);
dcl  ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$changemode entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned);
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$find_iocb entry (char (*) aligned, ptr, fixed bin (35));
dcl  do_prt_request_ entry (ptr, ptr, fixed bin (35));
dcl  do_prt_request_$error_during_request entry (char (*));
dcl  do_prt_request_$single_copy entry ();
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2) aligned);
dcl  write_sample_form_ entry (char (*) aligned, char (*) aligned, fixed bin (35));
dcl  write_sample_prt_banner_ entry (char (*) aligned, ptr, ptr, fixed bin (35));
%page;

/* Internal static */

dcl  whoami char (24) int static options (constant) init ("printer_driver_");
dcl  master fixed bin int static options (constant) init (1);
dcl  slave fixed bin int static options (constant) init (2);
dcl  both fixed bin int static options (constant) init (0);
dcl  log fixed bin int static options (constant) init (0);
dcl  normal fixed bin int static options (constant) init (1);
dcl  error fixed bin int static options (constant) init (2);
dcl  initial_bit_rate fixed bin int static options (constant) init (7000);
						/* this is a starting value which is betweeen */
						/* the rates for the PRU-1200 and the PRT-301 */

dcl  stream (2) char (32) aligned int static;		/* streams for writing to terminals */
dcl  time fixed bin (71) int static init (1);

dcl  1 ctl aligned int static like prt_ctl;		/* here we hold the defaults used by do_prt_request_ */

/* Builtins */

dcl  (addr, null, substr, length, convert, max, string, mod) builtin;


/* Conditions */

dcl  (cleanup, conversion) condition;


/* External static -- error table entries */

dcl  error_table_$no_operation fixed bin (35) ext static;
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$fatal_error fixed bin (35) ext static;
%page;

init:
     entry (arg_p);

dcl  arg_p ptr;

	stat_p = arg_p;				/* put the arg into static for easy reference */
	driver_status_ptr = iodd_static.driver_ptr;	/* get pointer to driver_status seg */
	driver_status.dev_ctl_ptr, prt_ctl_ptr = addr (ctl);
	text_strings_ptr = iodd_static.text_strings_ptr;	/* get ptr to i/o daemon table text area */
						/* use static device control parameters */
	stream (1) = "user_output";			/* output stream for master terminal */
	stream (2) = iodd_static.slave_output;		/* check for active before use */

	if iodd_static.attach_type ^= ATTACH_TYPE_IOM then do; /* this driver expects an IOM channel */
	     call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		"This driver requires a printer attached through the IOM.");
	     return;				/* quit now */
	end;

	if iodd_static.assigned_devices > 1 then do;	/* be sure all is correct */
	     call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		"Multiple minor devices are not supported by the printer driver.");
	     return;
	end;

	if iodd_static.form_type = "undefined_form" then do;
	     iodd_static.form_type = "std_ctl_msg";	/* if set, keep over a re-init */
	     driver_status.form_wait_time = 5;		/* set this as a reasonable default */
	end;

/* locate the major args for the device in the iod_tables */
	major_args_ptr = add_char_offset_ (addr (text_strings.chars), iodd_static.major_args.first_char - 1);
	major_args_length = iodd_static.major_args.total_chars;

	iodd_static.device_dim = iodd_parse_$args ("dim=", major_args);
						/* see if there was a dim given */
	if iodd_static.device_dim = "" then		/* otherwise use our default */
	     iodd_static.device_dim = "prtdim_";	/* this is the default */

	iodd_static.dev_io_stream = "dev_i/o";		/* record the stream name */
	call ios_$attach (iodd_static.dev_io_stream, iodd_static.device_dim, iodd_static.attach_name, "save_vfc",
	     io_stat);
	if st.code ^= 0 then do;
	     call iodd_msg_ (error, master, st.code, whoami, "Fatal error: Unable to attach channel ^a",
		iodd_static.attach_name);
	     return;
	end;

	on cleanup
	     begin;				/* they will try to transfer back to iodd_ by go to */
	     call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat);
	end;

	iodd_static.dev_in_stream = "Daemon_null_stream"; /* just to avoid un-initialized variables */
	driver_status.dev_out_stream = "printer_output";	/* define the stream name for all time */

	call ios_$attach (driver_status.dev_out_stream, "syn", "dev_i/o", "", io_stat);
						/* stick to convention */
	if st.code ^= 0 then do;
	     call iodd_msg_ (error, master, st.code, whoami, "Fatal error: Unable to attach syn to dev_i/o.");
	     go to clean_out;
	end;

	call iox_$find_iocb (driver_status.dev_out_stream, driver_status.dev_out_iocbp, ec);
	if ec ^= 0 then do;
	     call iodd_msg_ (error, master, ec, whoami, "Fatal error: Unable to get iocbp for device stream.");
	     go to clean_out;			/* that's all we can do... */
	end;
%page;

	string (prt_ctl.flags) = ""b;
	if driver_status.rqti_ptr ^= null then do;	/* if there is an rqti seg, use it */

	     prt_rqtip = driver_status.rqti_ptr;	/* make the based references cleaner */
	     if prt_rqti.header.header_version ^= rqti_header_version_1 then do;
		call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		     "prt rqt info version ^d found (expected ^d)", prt_rqti.header.header_version,
		     rqti_header_version_1);
		go to clean_out;
	     end;

	     prt_ctl.meter = prt_rqti.header.meter;	/* do we save meters for this rqt? */
	     iodd_static.slave_hold = ^(prt_rqti.header.auto_go);
						/* set the initial hold state as requested */
	     iodd_static.wakeup_time = max (30, prt_rqti.header.driver_wait_time);
						/* seconds to wait for a request */
	     if prt_rqti.header.type_code = 0 then go to set_defaults;
						/* this is only a header */
	     else if prt_rqti.header.type_code ^= 1 then do;
		call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		     "Wrong rqt info seg type for printer.");
		go to clean_out;
	     end;

	     if prt_rqti.version ^= prt_rqti_version_1 then do;
						/* see if it is the right version */
		call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		     "Wrong version of prt_rqti. Found ^d (expected ^d)", prt_rqti.version, prt_rqti_version_1);
		go to clean_out;
	     end;

	     if prt_rqti.opr_msg ^= "" then call iodd_msg_ (normal, both, 0, "", "^/^a", prt_rqti.opr_msg);
						/* give operator instructions */

	     prt_ctl.phys_page_length = prt_rqti.paper_length;
						/* get paper data for prtdim */
	     prt_ctl.phys_line_length = prt_rqti.paper_width;
	     prt_ctl.lines_per_inch = prt_rqti.lines_per_inch;

	     prt_ctl.channel_stops (*) = prt_rqti.channel_stops (*);
						/* get VFU stops for prtdim */

	     prt_ctl.banner_type = prt_rqti.banner_type;	/* copy control info to writable storage */
	     prt_ctl.force_nep = prt_rqti.force_nep;
	     prt_ctl.force_esc = prt_rqti.force_esc;
	     prt_ctl.force_nsep = prt_rqti.force_nsep;
	     prt_ctl.no_auto_print = prt_rqti.no_auto_print;
	     prt_ctl.banner_bars = prt_rqti.banner_bars;
	     prt_ctl.banner_indent = prt_rqti.banner_indent;
	     prt_ctl.banner_line = prt_rqti.banner_line;
	end;
	else do;					/* no rqti seg, so set some defaults */
	     prt_ctl.meter = "0"b;			/* don't keep any meters */
	     iodd_static.slave_hold = "1"b;		/* be sure to ask for a start command */
	     iodd_static.wakeup_time = 30;		/* check every 30 seconds */
set_defaults:					/* set up the default paper data */
	     prt_ctl.phys_page_length = 66;		/* 11 inch paper at 6 lpi is 66 lines */
	     prt_ctl.phys_line_length = 136;		/* assume the standard printer paper */
	     prt_ctl.lines_per_inch = 6;		/* normal for good readibility */

	     string (prt_ctl.channel_stops) = "0"b;	/* no slew stops are defined */

	     prt_ctl.force_nep = "0"b;		/* let user have his way */
	     prt_ctl.force_esc = "0"b;
	     prt_ctl.force_nsep = "0"b;		/* allow printing of inner head and tail sheets */
	     prt_ctl.no_auto_print = "0"b;		/* print without requesting operator attn */
	     prt_ctl.banner_type = NORMAL_BANNERS;	/* use normal head/tail sheets */
	     prt_ctl.banner_bars = NORMAL_BANNER_BARS;	/* set for overprinting */
	     prt_ctl.banner_indent = 0;		/* again */
	     prt_ctl.banner_line = 1;			/* again */
	end;


/* Now set up the dim with the paper and channel stop data */

	call set_paper_info (slave, ec);
	if ec ^= 0 then go to clean_out;		/* message was printed by proc */

	call iox_$control (driver_status.dev_out_iocbp, "channel_stops", addr (prt_ctl.channel_stops), ec);
	if ec ^= 0 then do;
	     call iodd_msg_ (error, master, ec, whoami, "Fatal error: Unable to perform channel_stops order.");
	     go to clean_out;			/* fatal error */
	end;

	driver_status.generic_type = "printer";		/* this is the type of device we use */
	driver_status.attached = "1"b;
	driver_status.ready = "1"b;
	driver_status.busy = "0"b;
	driver_status.request_pending = (36)"0"b;
	driver_status.elem_size = 9;			/* printer output is in characters - 9 bits each */
	driver_status.message_type = 1;		/* we only want print requests */
	driver_status.bit_rate_est = initial_bit_rate;	/* no history on output rate yet */
	driver_status.defer_time_limit = 0;		/* make operator specify reject time_limit */

	iodd_static.current_devices = iodd_static.assigned_devices;
						/* make them equal */

	if iodd_static.ctl_term.attached then
	     call ios_$changemode (iodd_static.ctl_output, "^hndlquit", omode, io_stat);
						/* we reset read on quit */

	value = iodd_parse_$args ("form_type=", major_args);
						/* check on a ctl term form type */
	if value ^= "" then iodd_static.form_type = substr (value, 1, length (iodd_static.form_type));

	call date_time_ (clock_ (), date_string);	/* get set for ready message */

	call iodd_msg_ (normal, both, 0, "",		/* let the subr do the work */
	     "^/^a driver ready at ^16a^/", driver_status.dev_name_label, date_string);

	call iodd_listen_ (stat_p);

clean_out:
	call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat);

	return;
%page;

request:
     entry ();

/*  This is the entry which is called by the iodd_listen_ procedure when a request
   for this driver has been received from the coordinator.

   The purpose of the code for this entry of the printer driver is to validate
   that the request is one that we expect and can correctly interpret.
   Then we call do_prt_request_ to do all the work of access checking etc.
*/

	driver_status_ptr = iodd_static.driver_ptr;	/* make it general although it will always be the same */
	p2 = addr (driver_status.descriptor);		/* find request descriptor */
	dmp = addr (driver_status.message);		/* get ptr to message */
	prt_ctl_ptr = driver_status.dev_ctl_ptr;	/* only one for this driver */

	if dprint_msg.header.hdr_version ^= queue_msg_hdr_version_1 then do;
						/* trouble */
	     call iodd_msg_ (log, both, 0, "", "Invalid message header.  Cannot read request ^d.^d.",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q);
	     p2 -> request_descriptor.keep_in_queue = "1"b;
						/* save for conversion later */
	     go to be_nice;
	end;
	if dprint_msg.header.message_type ^= driver_status.message_type then do;
	     call iodd_msg_ (log, both, 0, "",		/* log the error */
		"Incorrect message type for printer.^/Request ^d.^d for ^a (segment ^a) not processed.",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q,
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename);
	     p2 -> request_descriptor.cancelled = "1"b;	/* we don't want this one back */
be_nice:
	     p2 -> request_descriptor.dont_delete = "1"b; /* save the user's data */
	     p2 -> request_descriptor.finished = "1"b;	/* mark it done */
	     return;				/* it wasn't for us after all */
	end;
	if dprint_msg.version ^= dprint_msg_version_5	/* Current version */
	     & dprint_msg.version ^= dprint_msg_version_4 /* Previous version */
	     & dprint_msg.version ^= dprint_msg_version_3 /* Previous version */
	then do;					/* other trouble? */
	     call iodd_msg_ (log, both, 0, "",
		"Wrong dprint message version found.^/Request ^d.^d for ^a (segment ^a) not processed",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q,
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename);
	     p2 -> request_descriptor.keep_in_queue = "1"b;
	     go to be_nice;
	end;
	if dprint_msg.version < dprint_msg_version_4 then /* Disallow line numbers before version 4 */
	     dprint_msg.control.line_nbrs = "0"b;
	if dprint_msg.line_lth > prt_ctl.phys_line_length then do;
						/* platten wide enough */
	     call iodd_msg_ (log, both, 0, "",
		"Request ^d.^d for ^a (segment ^a) deferred.^/Requires a device with line length of ^d.",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q,
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename, dprint_msg.line_lth);
	     p2 -> request_descriptor.keep_in_queue = "1"b;
						/* defer it */
	     go to be_nice;
	end;

	iodd_static.quit_during_request = "0"b;		/* start clean */

	call do_prt_request_ (driver_status.dev_out_iocbp, stat_p, ec);

	if ec ^= 0 then iodd_static.slave_hold = "1"b;	/* on errors go to command level */

	if iodd_static.test_entry then
	     if time > 1 then call timer_manager_$sleep (time, "11"b);
						/* pause if testing */

	return;
%page;

command:
     entry (source, state, arg_list_p, c_code);

dcl  source fixed bin;				/* 1 = master console, 2 = slave */
dcl  state fixed bin;				/* 0 = not quite ready to handle a request */
						/* 1 = drivers are ready */
						/* 2 = command entered after a quit */
dcl  arg_list_p ptr;				/* ptr to structure returned by parse_command_ */
dcl  c_code fixed bin (35);				/* error code: zero if command handled correctly */
dcl  save_code fixed bin (35);			/* saved value of c_code when called */
						/* error_table_ code for bad syntax or unknown command */

dcl  1 arg_list aligned based (arg_list_p),		/* parse_command_ structure */
       2 max_tokens fixed bin,			/* space allocated, do not change */
       2 n_tokens fixed bin,				/* number of tokens from command line (including cmd) */
       2 command char (64) var,			/* the first token is the command */
       2 arg (n_tokens - 1) char (64) var;		/* the other tokens are args to the command */

dcl  new_pl fixed bin;				/* temp for setting the phys page length */
dcl  new_ll fixed bin;				/* temp for the new phys line length */
dcl  new_lpi fixed bin;				/* and for the new lines per inch value */
dcl  not bit (1);


	stream (2) = iodd_static.slave_output;		/* in case it has changed */

	on conversion
	     begin;				/* handler for conversion errors */
	     call iodd_msg_ (normal, source, 0, "", "Argument conversion error. Try again.");
	     go to cmd_error;
	end;

	save_code = c_code;				/* save the called value */
	driver_status_ptr = iodd_static.driver_ptr;	/* make this ready for command use */
	prt_ctl_ptr = driver_status.dev_ctl_ptr;	/* this is the only one for this driver */
	c_code, ec = 0;				/* say we handled it for now */


	if command = "help" then do;
	     call iodd_msg_ (normal, source, 0, "", "^/** Commands for the printer driver **^/");
	     call iodd_msg_ (normal, source, 0, "", "banner_bars [<minor_dev>]  single | double | none");
	     call iodd_msg_ (normal, source, 0, "", "banner_type [<minor_dev>]  standard | brief | none");
	     call iodd_msg_ (normal, source, 0, "",
		"paper_info [<minor_dev>] [-ll <line_len>] [-pl <paper_len>] [-lpi <6 or 8>]");
	     call iodd_msg_ (normal, source, 0, "",
		"prt_control [<minor_dev>] [^]KEY ... (KEYs: force_nep, force_esc, force_nsep, autoprint)");
	     call iodd_msg_ (normal, source, 0, "", "sample_hs [<minor_dev>]");
	     call iodd_msg_ (normal, source, 0, "", "sample_form");
	     call iodd_msg_ (normal, source, 0, "", "single");
	     if test_entry then call iodd_msg_ (normal, source, 0, "", "time [<sleep_time>]");
	     go to end_cmd;
	end;

	if command = "ctl_term" | command = "ctlterm" then do;
						/* this was passed on by iodd_command_processor_ */
						/* to have us set the default form type */
	     iodd_static.form_type = "std_ctl_msg";	/* this is our default */
	     go to end_cmd;				/* the request entry will set the wait time */
	end;

	if command = "time" then
	     if ^iodd_static.test_entry then do;	/* refuse to recognize if not testing */
		ec = save_code;
		go to end_cmd;
	     end;
	     else do;
		if n_tokens > 1 then
		     time = convert (time, arg (1));
		else time = 1;			/* return to the default..full speed */
		go to end_cmd;
	     end;

	if command = "banner_bars" | command = "bannerbars" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if driver_status.device_id = arg (1) then
		     i = 2;			/* minor device, args can start at number 2 */
		else i = 1;			/* first arg was a value */
	     else i = 1;				/* no args at all */
	     if arg_list.n_tokens = i | arg (i) = "-print" then do;
						/* give value */
		if prt_ctl.banner_bars = NORMAL_BANNER_BARS then opr_msg = "double";
		else if prt_ctl.banner_bars = SINGLE_BANNER_BARS then opr_msg = "single";
		else if prt_ctl.banner_bars = NO_BANNER_BARS then opr_msg = "none";
		else opr_msg = "Undefined value";
		call iodd_msg_ (normal, source, 0, "", "Current value is:  ^a", opr_msg);
		go to end_cmd;
	     end;
	     if arg (i) = "double" then prt_ctl.banner_bars = NORMAL_BANNER_BARS;
	     else if arg (i) = "single" then prt_ctl.banner_bars = SINGLE_BANNER_BARS;
	     else if arg (i) = "none" then prt_ctl.banner_bars = NO_BANNER_BARS;
	     else do;
		call iodd_msg_ (normal, source, 0, "", "Undefined argument ^a.  Use single, double or none.", arg (1))
		     ;
		go to cmd_error;
	     end;

	     go to end_cmd;
	end;

	if command = "single" then do;		/* operator wants to single space FF and VT */
	     if iodd_static.request_in_progress then do;
		call ios_$changemode (driver_status.dev_out_stream, "single.", omode, io_stat);
						/* set mode */
		call do_prt_request_$single_copy ();	/* avoid same problem if another copy requested */
	     end;
	     else call iodd_msg_ (normal, source, 0, "", "No current request.");
	     go to end_cmd;
	end;

	if command = "paper_info" | command = "paperinfo" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if driver_status.device_id = arg (1) then
		     i = 2;			/* minor device, args can start at number 2 */
		else i = 1;			/* possibly first arg was a value */
	     else i = 1;				/* no args at all */
	     if n_tokens = i | arg (i) = "-print" then do;
		call iodd_msg_ (normal, source, 0, "",
		     "Physical paper width:  ^d characters ^/Physical paper length:  ^d lines (at ^d lines per inch)",
		     prt_ctl.phys_line_length, prt_ctl.phys_page_length, prt_ctl.lines_per_inch);
		go to end_cmd;
	     end;
	     if mod ((n_tokens - i), 2) = 1 then do;
		call iodd_msg_ (normal, source, 0, "",
		     "The paper_info command must have an even number of arguments.");
		go to cmd_error;			/* make him do it right */
	     end;
	     new_ll = prt_ctl.phys_line_length;		/* record the old values as the default */
	     new_pl = prt_ctl.phys_page_length;
	     new_lpi = prt_ctl.lines_per_inch;

	     do i = i to n_tokens - 1 by 2;		/* check the arg pairs */
		if arg (i) = "-ll" then new_ll = convert (new_ll, arg (i + 1));
		else if arg (i) = "-pl" then new_pl = convert (new_pl, arg (i + 1));
		else if arg (i) = "-lpi" then new_lpi = convert (new_lpi, arg (i + 1));
		else do;				/* bad control arg */
		     call iodd_msg_ (normal, source, 0, "", "Invalid control argument:  ^a", arg (i));
		     go to cmd_error;
		end;
	     end;
	     if new_ll < 10 | new_ll > 200 then do;	/* check the range */
		call iodd_msg_ (normal, source, 0, "", "Line length range is 10 to 200.");
		go to cmd_error;
	     end;

	     if ^(new_lpi = 6 | new_lpi = 8) then do;
		call iodd_msg_ (normal, source, 0, "", "Lines per inch must be 6 or 8.");
		go to cmd_error;
	     end;
	     if new_pl < 10 then do;
		call iodd_msg_ (normal, source, 0, "", "Minimum paper length is 10 lines.");
		go to cmd_error;
	     end;
	     if new_pl > 127 then do;
		call iodd_msg_ (normal, source, 0, "", "Maximum paper length is 127 lines.");
		go to cmd_error;
	     end;

	     prt_ctl.phys_line_length = new_ll;
	     prt_ctl.phys_page_length = new_pl;
	     prt_ctl.lines_per_inch = new_lpi;

	     call iodd_msg_ (normal, source, 0, "", "Changing to:  ll ^d, pl ^d at ^d lines per inch.",
		prt_ctl.phys_line_length, prt_ctl.phys_page_length, prt_ctl.lines_per_inch);

	     call set_paper_info (source, ec);

	     go to end_cmd;
	end;


	if command = "sample_form" | command = "sampleform" then do;
	     if iodd_static.ctl_term.attached then do;	/* be sure there is a place to write */
		if iodd_static.forms then do;		/* are we simulating FF? */
		     call ios_$order (iodd_static.ctl_output, "form_status", addr (form_info), io_stat);
		     if st.code ^= 0 then do;		/* OOPS.... */
			iodd_static.master_hold = "1"b;
						/* this is a problem for master terminal */
			call com_err_ (st.code, whoami,
			     "^/form_status order call.  Master terminal action required to continue.");
			go to cmd_error;
		     end;
		     if ^form_info.aligned then
			call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat);
						/* this will work */
		end;
		call write_sample_form_ (iodd_static.form_type, iodd_static.ctl_output, ec);
	     end;
	     else call iodd_msg_ (normal, source, 0, "", "Control terminal is not attached.");

	     go to end_cmd;
	end;

	if command = "prt_control" | command = "prtcontrol" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if driver_status.device_id = arg (1) then
		     i = 2;			/* minor device, args can start at number 2 */
		else i = 1;			/* possibly first arg was a value */
	     else i = 1;				/* no args at all */
	     if n_tokens = i | arg (i) = "-print" then do;/* give the values */
		call iodd_msg_ (normal, source, 0, "",
		     "Values are: ^[^^^]force_nep, ^[^^^]force_esc, ^[^^^]auto_print, ^[^^^]force_nsep",
		     ^prt_ctl.force_nep, ^prt_ctl.force_esc, prt_ctl.no_auto_print, prt_ctl.force_nsep);
	     end;
	     else do;
		do i = i to n_tokens - 1;		/* look at each argument */
		     not = (substr (arg (i), 1, 1) = "^");
						/* was first char a "^" */
		     if not then
			value = substr (arg (i), 2);
		     else value = arg (i);
		     if value = "force_nep" | value = "forcenep" then prt_ctl.force_nep = ^not;
		     else if value = "force_esc" | value = "forceesc" then prt_ctl.force_esc = ^not;
		     else if value = "force_nsep" | value = "forcensep" then prt_ctl.force_nsep = ^not;
		     else if value = "auto_print" | value = "autoprint" then prt_ctl.no_auto_print = not;
		     else call iodd_msg_ (normal, source, 0, "", "Undefined argument: ^a", arg (i));
		end;
	     end;
	     go to end_cmd;
	end;

	if command = "banner_type" | command = "bannertype" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if driver_status.device_id = arg (1) then
		     i = 2;			/* minor device, args can start at number 2 */
		else i = 1;			/* possibly first arg was a value */
	     else i = 1;				/* no args at all */
	     if n_tokens = i | arg (i) = "-print" then do;/* give the values */
		if prt_ctl.banner_type = NO_BANNERS then opr_msg = "none";
		else if prt_ctl.banner_type = NORMAL_BANNERS then opr_msg = "standard";
		else if prt_ctl.banner_type = BRIEF_BANNERS then opr_msg = "brief";
		else opr_msg = "Undefined value";
		call iodd_msg_ (normal, source, 0, "", "Current value is:  ^a", opr_msg);
		go to end_cmd;
	     end;

	     if arg (i) = "standard" then prt_ctl.banner_type = NORMAL_BANNERS;
	     else if arg (i) = "none" then prt_ctl.banner_type = NO_BANNERS;
	     else if arg (i) = "brief" then prt_ctl.banner_type = BRIEF_BANNERS;
	     else do;
		call iodd_msg_ (normal, source, 0, "", "Banner type ^a is not defined.", arg (i));
		go to cmd_error;
	     end;

	     go to end_cmd;
	end;

	if command = "sample_hs" | command = "samplehs" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if driver_status.device_id = arg (1) then
		     i = 2;			/* minor device, args can start at number 2 */
		else i = 1;			/* possibly first arg was a value */
	     else i = 1;				/* no args at all */

	     call iox_$control (driver_status.dev_out_iocbp, "reset", null, ignore);
						/* clear everything */
	     call iox_$control (driver_status.dev_out_iocbp, "inside_page", null, ignore);

	     call write_sample_prt_banner_ ("head_sheet", driver_status.dev_out_iocbp, prt_ctl_ptr, ec);

	     call iox_$control (driver_status.dev_out_iocbp, "end_of_page", null, ignore);
	     call iox_$control (driver_status.dev_out_iocbp, "runout", null, ignore);
						/* be sure it prints */

	     go to end_cmd;
	end;

/*	If we come past here, this command is illegal.  So make a clean return without changing anything. */

	c_code = save_code;				/* restore the original value */
	return;

end_cmd:
	c_code = ec;				/* pass back any defined errors */
	return;

cmd_error:
	c_code = error_table_$action_not_performed;	/* cause a resetread */
	return;
%page;

default_handler:
     entry (condition_info_ptr);

dcl  condition char (32);				/* fixed string for the call */

	condition = condition_info.condition_name;	/* this will indent funny */

	if iodd_static.request_in_progress then		/* try to avoid mistakes */
	     call do_prt_request_$error_during_request (condition);
						/* take it away */

	return;					/* do_prt_request_ should not return, but.... */
%page;

set_paper_info:
     procedure (source, code);

dcl  code fixed bin (35);
dcl  source fixed bin;

	code = 0;

	call iox_$control (driver_status.dev_out_iocbp, "paper_info", addr (prt_ctl.paper_info), code);
	if code ^= 0 then
	     if code = error_table_$no_operation then do; /* if dim couldn't, tell the operator */

		call iodd_msg_ (normal, source, 0, "",
		     "Mount VFU tape for ^d lines per page. ^/Set printer for ^d lines/inch.",
		     prt_ctl.phys_page_length, prt_ctl.lines_per_inch);

		iodd_static.slave_hold = "1"b;	/* be sure we let the op load VFU */
		code = 0;

	     end;
	     else do;				/* a real error */
		call iodd_msg_ (normal, source, code, whoami, "Unable to perform paper_info order.");
		return;
	     end;

	return;

     end set_paper_info;
%page; %include condition_info;
%page; %include dprint_msg;
%page; %include driver_status;
%page; %include iod_constants;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include mseg_message_info;
%page; %include prt_ctl;
%page; %include prt_order_info;
%page; %include prt_rqti;
%page; %include queue_msg_hdr;
%page; %include request_descriptor;

     end printer_driver_;




		    punch_driver_.pl1               10/01/90  1537.2rew 10/01/90  1530.0      221463



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

/* format: style4 */

punch_driver_: proc;

	return;					/* this is not a legal entry */


/* Standard punch device driver control module for the I/O daemon. */

/* Originally coded in March 1975 by J. C. Whitmore */
/* Modified November 1975 by M. A. Braida to print flip card header */
/* Modified by J. C. Whitmore, 4/78, for new dprint_msg format and general upgrade */
/* Modified by J. C. Whitmore, 7/78, to initialize for auto deferring of long requests */
/* Modified by J. C. Whitmore, 3/79, to correct string size on two assignments */
/* Modified by C. Marker, 02/23/85, to use version 5 message segments */


/****^  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):
      Update for version 4 dprint_msg, and allow previous version.
  2) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199):
     Upgrade for version 5 iod tables.
  3) change(88-08-29,Farley), approve(88-08-19,MCR7911),
     audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199):
     Updated for version 5 dprint_msg.
  4) change(90-08-30,Vu), approve(90-08-30,MCR8196), audit(90-09-12,Zimmerman),
     install(90-10-01,MR12.4-1034):
     Correct generation of major_args_ptr when using offset into the I/O daemon
     tables string area.
                                                   END HISTORY COMMENTS */


/*	AUTOMATIC VARIABLES */

dcl  date_string char (24);
dcl  ec fixed bin (35);
dcl  i fixed bin;					/* general index variable */
dcl  io_stat bit (72) aligned;			/* ios_ status code */
dcl  major_args char (major_args_length) based (major_args_ptr);
dcl  major_args_ptr ptr;				/* ptr to major_args string */
dcl  major_args_length fixed bin;
dcl  nelm fixed bin;
dcl  nelt fixed bin;
dcl  dest char (24);				/* temp for the destination */
dcl  head char (64) aligned;				/* temp for the heading */
dcl  banner_stream char (32) aligned;
dcl  access_class char (36) aligned;			/* temp for the first access class token */
dcl  p2 ptr;
dcl  retry_sw bit (1);

dcl  1 st aligned based (addr (io_stat)),		/* breakdown of status code */
       2 code fixed bin (35),
       2 flags bit (36);


/*	EXTERNAL ENTRIES    */

dcl  add_char_offset_ entry (ptr, fixed bin(21)) returns(ptr) reducible;
dcl  clock_ entry () returns (fixed bin (71));
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  ioa_$rsnnl entry options (variable);
dcl  iodd_listen_ entry (ptr);
dcl  iodd_msg_ entry options (variable);
dcl  iodd_parse_$args entry (char(*) var, char(*)) returns(char(256) var);
dcl  ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$changemode entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
dcl  ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned);
dcl  ios_$getsize entry (char (*) aligned, fixed bin, bit (72) aligned);
dcl  ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  output_request_ entry (char (*) aligned, fixed bin, ptr, entry, fixed bin (35));
dcl  output_request_$error_during_request entry (char (*));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2) aligned, fixed bin (71));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2) aligned);
dcl  write_control_form_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));
dcl  write_sample_form_ entry (char (*) aligned, char (*) aligned, fixed bin (35));


/*	INTERNAL STATIC   */

dcl  card_header char (512) aligned int static;		/* buffer for flip card head/tail */
dcl  xxbar char (22) aligned int static options (constant) init ((11)"
-");						/* string of "NL-"'s for flip cards */
dcl  ctl_msg_sent bit (1) int static init ("0"b);		/* flag set when msg sent ok */
dcl  time fixed bin (71) int static init (1);
dcl  alarm_channel fixed bin (71) int static;		/* channel used for time out checks */
dcl  meter_sw bit (1) int static;			/* TRUE - if we are to keep metering data (future) */
dcl  master fixed bin int static options (constant) init (1);
dcl  both fixed bin int static options (constant) init (0);
dcl  whoami char (24) int static options (constant) init ("punch_driver_");
dcl  initial_bit_rate fixed bin int static options (constant) init (1000); /* starting value for the bit rate estimate */

dcl  1 ctl_wait_list int static aligned,		/* ipc wait list for the form terminnal */
       2 number fixed bin,
       2 channel fixed bin (71);

dcl  1 event_info int static aligned,			/* info returned from ipc_$block */
       2 chan fixed bin (71),
       2 message fixed bin (71),
       2 sender bit (36),
       2 origin fixed bin,
       2 wait_list_index fixed bin;

dcl  1 form_info aligned int static,			/* data from the form paging dim */
       2 page_length fixed bin,			/* put in static to save stack space */
       2 line_length fixed bin,
       2 line_no fixed bin,
       2 carriage_position fixed bin,
       2 aligned bit (1) unal,			/* tells if the dim considers the forms alignedd */
       2 pad bit (35) unal;

dcl  1 sw (5) aligned int static,			/* format stream (switch) data structure */
       2 name char (32) init ("Undefined", "viipunch_output", "mcc_output", "raw_output", "flipper_output"),
       2 size fixed bin init (9, 1, 9, 960, 9),		/* element size for this format */
       2 dim char (32) init ("syn", "viipunch_", "mcc_", "raw_", "flipper_");
%page;

/*	BUILTINS    */

dcl  (addr, null, substr, before, after, length, rtrim) builtin;


/*	CONDITIONS   */

dcl  cleanup condition;


/*	EXTERNAL STATIC -- ERROR TABLE ENTRIES     */

dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$fatal_error fixed bin (35) ext static;
dcl  error_table_$ionmat fixed bin (35) ext static;
%page;

init: entry (arg_p);

dcl  arg_p ptr;

	stat_p = arg_p;				/* put the arg into static for easy reference */
	driver_status_ptr = iodd_static.driver_ptr;	/* get current driver status ptr */
	text_strings_ptr = iodd_static.text_strings_ptr;	/* get ptr to i/o daemon table text area */
	retry_sw = "1"b;				/* retry attachments once on error */

	if iodd_static.attach_type ^= ATTACH_TYPE_IOM then do;	/* this driver expects an IOM channel */
	     ec = error_table_$fatal_error;
	     call iodd_msg_ (2, master, ec, whoami, "This driver requires a punch attached through the IOM.");
	     return;				/* quit now */
	end;

	if iodd_static.assigned_devices > 1 then do;	/* be sure all is correct */
	     ec = error_table_$fatal_error;
	     call iodd_msg_ (2, master, ec, whoami, "Multiple minor devices are not supported by the punch driver.");
	     return;
	end;

/* locate the major args for the device in the iod_tables */
	major_args_ptr = add_char_offset_ (addr (text_strings.chars), (iodd_static.major_args.first_char - 1));
	major_args_length = iodd_static.major_args.total_chars;

	iodd_static.device_dim = iodd_parse_$args ("dim=", major_args); /* see if a dim was specified */
	if iodd_static.device_dim = "" then iodd_static.device_dim = "cpz"; /* no, use the default */
	iodd_static.dev_out_stream = "punch_output_stream";
	iodd_static.dev_io_stream = iodd_static.dev_out_stream; /* make them the same */
	iodd_static.dev_in_stream = "Undefined_Daemon_Stream"; /* avoid uninitialized variables */

attach:	call ios_$attach (iodd_static.dev_out_stream, iodd_static.device_dim, iodd_static.attach_name, "", io_stat);
	if st.code ^= 0 then do;
	     if st.code = error_table_$ionmat & retry_sw then do; /* can we try again */
retry:		retry_sw = "0"b;			/* yes, but only once */
		call detach_all;			/* clear the slate */
		go to attach;
	     end;
	     call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Unable to attach channel ^a",
		iodd_static.attach_name);
	     return;
	end;

	on cleanup call detach_all;			/* for reinit, no_coord, logout, new_device, etc... */

/*	set up the punch code formatting dims corresponding to the dprint_msg outer_module variable */

	do i = 2 to 5;				/* attach the defined format streams */
	     call ios_$attach (sw.name (i), sw.dim (i), iodd_static.dev_out_stream, "", io_stat);
	     if st.code ^= 0 then do;
		if st.code = error_table_$ionmat & retry_sw then go to retry; /* start_over */
		call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Unable to attach ^a to ^a.",
		     sw.name (i), iodd_static.dev_out_stream);
		go to clean_out;
	     end;
	end;

	do i = 2 to 4;				/* get the stream element sizes for 7punch, mcc and raw */
	     call ios_$getsize (sw.name (i), sw.size (i), io_stat);
	     if st.code ^= 0 then do;
		call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Invalid getsize call for dim ^a.", sw.dim (i));
		go to clean_out;
	     end;
	end;

	driver_status.elem_size = 1;
	driver_status.message_type = 2;		/* expected dprint message type */
	driver_status.attached = "1"b;
	driver_status.ready = "1"b;			/* issue an automatic "ready" command */
	driver_status.form_wait_time = 5;		/* set this as a reasonable default */
	driver_status.dev_out_stream = iodd_static.dev_out_stream; /* record this too */
	driver_status.bit_rate_est = initial_bit_rate;
	driver_status.defer_time_limit = 0;

	if iodd_static.ctl_term.attached then do;
	     ctl_wait_list.number = 1;
	     ctl_wait_list.channel = iodd_static.ctl_ev_chan;
	     alarm_channel = iodd_static.ctl_ev_chan;
	     call ios_$changemode (iodd_static.ctl_output, "^hndlquit", "", io_stat); /* we reset read on quit */
	end;
	else do;
	     ctl_wait_list.number = 0;		/* otherwise clear to avoid errors */
	     ctl_wait_list.channel = 0;
	     alarm_channel = 0;
	end;

	if driver_status.rqti_ptr ^= null then do;	/* see if there is any rqti data */
	     p2 = driver_status.rqti_ptr;		/* copy the pointer for easy reference */
	     if p2 -> rqti_header.header_version ^= rqti_header_version_1 then do;
		call iodd_msg_ (2, both, error_table_$fatal_error, whoami,
		     "RQTI header version ^d found (expected ^d).", p2 -> rqti_header.header_version,
		     rqti_header_version_1);
		go to clean_out;
	     end;
	     if ^(p2 -> rqti_header.type_code = 0 | p2 -> rqti_header.type_code = 2) then do;
		ec = error_table_$fatal_error;	/* allow header only or punch RQTI - no others */
		call iodd_msg_ (2, both, ec, whoami, "Incorrect RQTI segment format for punch.");
		go to clean_out;
	     end;
	     iodd_static.slave_hold = ^(p2 -> rqti_header.auto_go); /* get the auto go value */
	     iodd_static.wakeup_time = p2 -> rqti_header.driver_wait_time; /* and wait time */
	     meter_sw = p2 -> rqti_header.meter;	/* meters needed? (for the future) */
	end;
	else do;					/* use default values, no rqti seg */
	     iodd_static.slave_hold = "1"b;		/* ask for a go command */
	     iodd_static.wakeup_time = 120;		/* should wait 2 min before asking for work */
	     meter_sw = "0"b;			/* no metering  (future) */
	end;

	iodd_static.form_type = iodd_parse_$args ("form_type=", major_args); /* was form type given */
	if iodd_static.form_type = "" then iodd_static.form_type = "std_ctl_msg"; /* no, use standard default */

	call date_time_ (clock_ (), date_string);	/* get set for ready message */

	call iodd_msg_ (1, both, 0, "", "^/^a driver ready at ^16a^/", driver_status.dev_name_label, date_string);

	call iodd_listen_ (stat_p);			/* iodd_listen_ will never return */

clean_out:					/* this label is for error recovery */

	call detach_all;
	return;
%page;

request: entry;

/* This is the entry which is called by the iodd_listen_ procedure when a request
   for this driver has been received from the coordinator.

   The purpose of the code for this entry of the punch driver is to validate
   that the request is one that we expect and can correctly interpret.  Then we
   call output_request_ to do all the work of access checking etc.  The stream to
   be used is based on the outer module specified in the request.  */

	driver_status_ptr = iodd_static.driver_ptr;	/* make it general although it will always be the same */
	p2 = addr (driver_status.descriptor);		/* find the request descriptor */
	dmp = addr (driver_status.message);		/* get ptr to message */

	if dprint_msg.header.hdr_version ^= queue_msg_hdr_version_1 then do; /* trouble */
	     call iodd_msg_ (0, both, 0, "", "Invalid message header.  Cannot read request ^d.^d.",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q);
	     p2 -> request_descriptor.keep_in_queue = "1"b; /* save for conversion later */
	     go to be_nice;
	end;
	if dprint_msg.header.message_type ^= driver_status.message_type then do;
	     call iodd_msg_ (0, both, 0, "",		/* log the error */
		"Incorrect message type for punch.^/Request ^d.^d for ^a (segment ^a) not processed.",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, 
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename);
	     p2 -> request_descriptor.cancelled = "1"b;
be_nice:	     p2 -> request_descriptor.dont_delete = "1"b; /* save the user's data */
	     p2 -> request_descriptor.finished = "1"b;	/* mark it done */
	     return;				/* it wasn't for us after all */
	end;
	if dprint_msg.version ^= dprint_msg_version_3 	/* Previous version */
	& dprint_msg.version ^= dprint_msg_version_4	/* Previous version */
	& dprint_msg.version ^= dprint_msg_version_5	/* Current version */
	   then do;				/* other trouble? */
	     call iodd_msg_ (0, both, 0, "",
		"Wrong message version found.^/Request ^d.^d for ^a (segment ^a) not processed",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, 
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename);
	     p2 -> request_descriptor.keep_in_queue = "1"b;
	     go to be_nice;
	end;
	if dprint_msg.version < dprint_msg_version_4 then /* Disallow -line_nbrs before version 4 */
	     dprint_msg.control.line_nbrs = "0"b;

	i = dprint_msg.output_module;			/* get the user defined format */

	if i < 2 | i > 4 then do;			/* be sure it is defined */
	     call iodd_msg_ (0, both, 0, "",
		"Undefined punch format in user request.^/Request ^d.^d for ^a (segment ^a) not processed",
		p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, 
		p2 -> request_descriptor.mseg_message_info_copy.sender_id,
		dprint_msg.header.ename);
	     p2 -> request_descriptor.cancelled = "1"b;
	     go to be_nice;
	end;

	iodd_static.quit_during_request = "0"b;		/* start clean */
	ctl_msg_sent = "0"b;			/* initialize to no msg yet */

	call output_request_ (sw.name (i), sw.size (i), stat_p, print_banner, ec);
	if ec ^= 0 then
	     iodd_static.slave_hold = "1"b;		/* on errors go to command level */
	return;
%page;

print_banner: entry (a_stream, type, data_ptr, code);

dcl  a_stream char (*);				/* this would normally be the banner output stream */
						/* but we can only use the flip card stream */
dcl  type fixed bin;				/* type of banner to be written  */
						/* 1 = heading banner            */
						/* 2 = tail banner               */
						/* 3 = error message             */
dcl  data_ptr ptr;					/* pointer to output request data or  */
						/* to char(256) varying string error msg */
dcl  code fixed bin (35);				/* error code */

	banner_stream = sw.name (5);			/* we must use the flipper stream */

	if type = 1 then do;			/* heading banner for punch wanted */

	     iodd_static.quit_during_request = "0"b;	/* reset for each request */

	     if iodd_static.ctl_term.attached then do;	/* message to ctl term? */
		call write_control_form_ (iodd_static.form_type, iodd_static.ctl_output, data_ptr, ec);
		if ec ^= 0 then do;
		     if code ^= error_table_$action_not_performed then do; /* this is normal */
			call iodd_msg_ (2, master, ec, whoami, "Writing message on control terminal.");
			iodd_static.slave_hold = "1"b;/* avoid automatic start */
		     end;
		     ctl_msg_sent = "0"b;		/* don't wait for bad message */
		end;
		else ctl_msg_sent = "1"b;		/* say all was well, so we can wait */
		if ctl_wait_list.number = 1 & ctl_msg_sent then do; /* are we going to sync with the term? */
		     call ipc_$drain_chn (ctl_wait_list.channel, ec);
		     if ec ^= 0 then do;		/* avoid futher trouble, but not fatal */
			ctl_wait_list.channel = 0;	/* stop trying */
			ctl_wait_list.number = 0;
			iodd_static.slave_hold = "1"b;
			ctl_msg_sent = "0"b;	/* don't wait , no wakeup will come */
			call iodd_msg_ (2, master, 0, whoami, "print_banner bad call to ipc_drain ^d", ec);
		     end;
		     else call timer_manager_$alarm_wakeup (driver_status.form_wait_time, "11"b, alarm_channel);
		end;
	     end;
	     else ctl_msg_sent = "0"b;		/* don't wait */

	     dmp = addr (iodd_static.driver_ptr -> driver_status.message); /* get pointer to meessage */
	     ordatap = data_ptr;			/* set default ptr for output_request_data */

/*	PRINT THE FLIP CARDS HERE */

	     if dprint_msg.heading = "" then
		head = before (ordata.requestor, ".");	/* default to the person */
	     else head = dprint_msg.heading;

	     if dprint_msg.destination = "" then
		dest = before (after (ordata.requestor, "."), "."); /* default to project */
	     else dest = dprint_msg.destination;

	     access_class = before (ordata.access_class_string, ","); /* we want the first token, strip the rest */

/*	Now, format the flip card header. */

	     call ioa_$rsnnl ("^a^/^x^7a^x^2/^7d^2x^2/^3xCOPY^2x^2/^x^2d OF^2d^x^2/^x^8a^2/^x^8a^2/^x^7a^x^2/^x^7a^x^/",
		card_header, nelm,
		xxbar, "REQUEST", ordata.request_no, ordata.copy_no, ordata.copies,
		substr (ordata.date_time_start_request, 1, 8),
		substr (ordata.date_time_start_request, 11, 6), substr (dest, 1, 7),
		substr (dest, 8, 7));

	     call write_msg (card_header);		/* the first few cards */

	     call write_msg (ordata.requestor);

	     call write_msg (access_class);

	     call write_msg (ordata.full_path);

	     call write_msg (xxbar);			/* this closes out the header cards */

	     call ios_$order (banner_stream, "reset", null, io_stat); /* clear card count */
	end;

	else if type = 2 then do;			/* a trailing banner is wanted */

	     if iodd_static.test_entry then		/* be able to set a reasonable pace */
		if time > 1 then call timer_manager_$sleep (time, "11"b); /* simulate device */

/*	PUT IN A TAIL SEPARATOR HERE */

	     call ioa_$rsnnl ("^3xEND OF^6xDECK^3x^a", card_header, nelm, xxbar);

	     call write_msg (card_header);

	     if iodd_static.quit_during_request then	/* output was lost */
		ctl_msg_sent = "0"b;		/* cancel the flag */
	     else if ctl_msg_sent then do;		/* avoid premature blocking */
		ctl_msg_sent = "0"b;		/* ready for the next one */
		call ipc_$block (addr (ctl_wait_list), addr (event_info), ec); /* wait for form to finish */
	     end;
	end;

	else if type = 3 then do;			/* put out an error message */

	     card_header = xxbar || "ERROR DURING REQUEST  " || xxbar; /* just a general message */

	     call ios_$write (banner_stream, addr (card_header), 0, 66, nelt, io_stat);

	     code = 0;				/* don't cause trouble */
	end;

	else code = error_table_$action_not_performed;	/* all other banner types are undefined */

	return;

flip_err: code = st.code;				/* report the error */
	return;					/* and stop writing */
%page;

command: entry (source, state, arg_list_p, c_code);

dcl  source fixed bin;				/* 1 = master console, 2 = slave */
dcl  state fixed bin;				/* 0 = not quite ready to handle a request */
						/* 1 = drivers are ready */
						/* 2 = command entered after a quit */
dcl  arg_list_p ptr;				/* ptr to structure returned by parse_command_ */
dcl  c_code fixed bin (35);				/* error code: zero if command handled correctly */
						/* error_table_ code for bad syntax or unknown command */
dcl  1 arg_list aligned based (arg_list_p),		/* parse_command_ structure */
       2 max_tokens fixed bin,			/* space allocated, do not change */
       2 n_tokens fixed bin,				/* number of tokens from command line (including cmd) */
       2 command char (64) var,			/* the first token is the command */
       2 arg (n_tokens - 1) char (64) var;		/* the other tokens are args to the command */

	if command = "help" then do;
	     c_code = 0;
	     call iodd_msg_ (1, source, 0, "", "^/** Commands for the punch driver **^/");
	     call iodd_msg_ (1, source, 0, "", "sample_form");
	     if test_entry then
		call iodd_msg_ (1, source, 0, "", "time [<sleep_time>]");
	end;
	else if command = "ctl_term" then do;		/* this was passed on by iodd_command_processor_ */
	     iodd_static.driver_ptr -> driver_status.form_wait_time = 5; /* to have us set the default form type */
	     iodd_static.form_type = "std_ctl_msg";	/* this is our default */
	end;
	else if command = "time" then do;
	     if iodd_static.test_entry then do;		/* refuse to recognize if not testing */
		c_code = 0;			/* the command was good */
		if n_tokens > 1 then do;
		     time = cv_dec_check_ ((arg (1)), ec);
		     if ec ^= 0 then time = 10;
		end;
		else time = 1;			/* return to the default..full speed */
	     end;
	end;
	else if command = "sample_form" then do;
	     c_code = 0;				/* we'll handle everything here */
	     if iodd_static.ctl_term.attached then do;	/* be sure there is a place to write */
		if iodd_static.forms then do;		/* are we simulating FF? */
		     call ios_$order (iodd_static.ctl_output, "form_status", addr (form_info), io_stat);
		     if st.code ^= 0 then do;		/* OOPS.... */
			c_code = st.code;		/* pass it back */
			iodd_static.master_hold = "1"b; /* this is a problem for master terminal */
			call iodd_msg_ (1, both, st.code, whoami,
			     "^/form_status order call.  Master terminal action required to continue.");
			return;
		     end;
		     if ^form_info.aligned then
			call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat); /* this will work */
		end;
		call write_sample_form_ (iodd_static.form_type, iodd_static.ctl_output, c_code);
	     end;
	     else call iodd_msg_ (1, source, 0, "", "Control terminal is not attached.");
	end;
	return;					/* return any undefined commands without changing anything */
%page;

default_handler: entry (condition_info_ptr);

dcl  condition char (32);				/* fixed string for the call */

	condition = condition_info.condition_name;	/* this will indent funny */

	if iodd_static.request_in_progress then		/* try to avoid mistakes */

	     call output_request_$error_during_request (condition); /* take it away */

	return;					/* output_request_ should not return, but.... */
%page;

detach_all: proc;

/* cleanup proc to detach all possible streams we could have attached */

	call ios_$detach (iodd_static.dev_out_stream, "", "", io_stat);
	do i = 2 to 5;
	     call ios_$detach (sw.name (i), "", "", io_stat);
	end;
	return;

     end detach_all;



write_msg: proc (string);

dcl  string char (*) aligned;

	nelm = length (rtrim (string));
	if nelm > 0 then do;			/* write flip cards for non blank message */
	     call ios_$write (banner_stream, addr (string), 0, nelm, nelt, io_stat);
	     if st.code ^= 0 then go to flip_err;	/* trouble */
	end;
	return;

     end write_msg;
%page; %include condition_info;
%page; %include dprint_msg;
%page; %include driver_status;
%page; %include iod_constants;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include mseg_message_info;
%page; %include output_request_data;
%page; %include queue_msg_hdr;
%page; %include request_descriptor;
%page; %include rqti_header;

     end punch_driver_;




		    write_control_form_.pl1         10/28/88  1403.5rew 10/28/88  1232.4      112095



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

/* format: style4 */

write_control_form_: proc (a_type, a_stream, a_ordatap, a_code);

/* This is the program which acts as a transfer vector for printing control
   forms of different formats based on the a_type argument.  The a_stream is
   passed on to the actual program which knows the format to be used.

   The "write_sample_form_" entry generates a dummy set of data to pass on
   to the form writing program to check alignment.	*/

/* Originally coded in March 1975 by J. C. Whitmore */
/* Modified in Dec 1975 by J. C. Whitmore for new ordata structure info */
/* Modified in April 1976 by J. C. Whitmore to correct the declaration of iodd_ to named ext static */
/* Modified in August 1977 by J. C. Whitmore to special case the form names "head_sheet" and "tail_sheet" */
/* Modified in March 1978 by J. C. Whitmore for new dprint_msg format and new ordata info */
/* Modified by J. C. Whitmore, 8/78, for new output_request_data info */
/* Modified by J. C. Whitmore, 8/79, to add write_sample_prt_banner_ entry */
/* Modified by R. McDonald May 1980 to include page charges for printing. (UNCA) */
/* Modified by E. N. Kittlitz June 1981 for UNCA page charges */


/****^  HISTORY COMMENTS:
  1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686),
     audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
     Updated dprint_msg to version 4.
  2) change(88-02-18,Brunelle), approve(88-09-16,MCR7911),
     audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199):
     Added $init entrypoint to take ptr to iodd_static so we can use the
     head/tail sheet entry variables store there.  Change code to use entry
     variables in iodd_static if available.
  3) change(88-08-30,Farley), approve(88-09-16,MCR7911),
     audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199):
     Updated to use version 5 dprint_msg.
                                                   END HISTORY COMMENTS */


/* External Procedures & Variables */

dcl  cu_$ptr_call entry options (variable);
dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  ioa_$ioa_stream entry options (variable);
dcl  ioa_$rsnnl entry options (variable);
dcl  iodd_$ ext static;				/* so we can find the ref dir of make seg */
dcl  hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35));
dcl  iox_$look_iocb entry (char (*), ptr, fixed bin (35));

/* Parameters */

dcl  a_code fixed bin (35) parameter;			/* error code */
dcl  a_iocbp ptr parameter;				/* user-supplied iocb to output on */
dcl  a_ordatap ptr parameter;				/* user-supplied output request data to use */
dcl  a_prt_ctl_ptr ptr parameter;			/* user-supplied printer control info ptr */
dcl  a_static_ptr ptr parameter;			/* ptr to iodd_static */
dcl  a_stream char (*) parameter;			/* user-supplied stream to output on */
dcl  a_type char (*) parameter;			/* user-supplied type of control form to output */

/* Automatic */

dcl  copies_left fixed bin;				/* number of copies computed for control form output */
dcl  dest char (36);				/* for output */
dcl  head char (64);				/* for output */
dcl  iocbp ptr;					/* iocb ptr to output on. */
						/* if user passed stream name, we will locate the ptr */
dcl  iodd_static_ptr ptr int static init (null ());	/* ptr to drivers iodd_static */
dcl  l fixed bin;
dcl  last_type char (32) int static init ("");
dcl  len fixed bin;
dcl  oprmsg char (256);
dcl  prt_ctl_ptr ptr;				/* prt_ctl ptr to use */
						/* if user didn't pass one, define as null */
dcl  proc_name char (32);
dcl  proc_ptr ptr int static init (null);
dcl  searched bit (1);

dcl  1 request aligned int static like ordata;		/* the rest of the daemon info */
%page;

/* write_control_form_: proc (a_type, a_stream, a_ordatap, a_code);	Main entry	*/

	ordatap = a_ordatap;			/* copy the input data pointer */
	prt_ctl_ptr = null;

/* locate the iocb for the given stream */
	call iox_$look_iocb (a_stream, iocbp, a_code);
	if a_code ^= 0 then
	     return;

common_write: a_code = 0;				/* this is common to both entries */

	if a_type = "undefined" then do;		/* so we can bypass, if desired */
	     a_code = error_table_$action_not_performed;
	     return;
	end;
	if a_type = "std_ctl_msg" then do;		/* this is the default for the normal ctl term */
	     if ordata.separator then do;		/* one message per separator bar */
		copies_left = ordata.copies - ordata.copy_no + 1; /* number we will print */
		dmp = ordata.dpmp;			/* get the pointer to the dprint message */
		head = dprint_msg.heading;
		if substr (head, 1, 5) = " for " then	/* see if dprint added something */
		     head = substr (head, 6);		/* if so get rid of it */
		if head ^= "" then call ioa_$rsnnl ("(for ""^a"" ", oprmsg, l, head);
		else do;
		     l = 1;			/* no heading, get ready for a dest msg */
		     oprmsg = "(";
		end;
		dest = dprint_msg.destination;
		if dest ^= "" then call ioa_$rsnnl ("^vaat ""^a"")", oprmsg, l, (l), substr (oprmsg, 1, l), dest);
		else if l = 1 then oprmsg = "";	/* no head or dest case */
		else substr (oprmsg, l, 1) = ")";	/* heading only case */

		call ioa_$rsnnl ("Request ^d ^a q^d: ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a",
		     oprmsg, l, ordata.request_no, ordata.request_type, ordata.queue, ordata.full_path,
		     (copies_left > 1), copies_left, ordata.priority_request, ordata.charge_queue,
		     ordata.requestor, (oprmsg));

		call ioa_$ioa_stream (a_stream, "^a", oprmsg);
	     end;
	     return;
	end;
	if a_type = "head_sheet" then do;
	     call iodd_static_ptr -> iodd_static.print_head_sheet (iocbp, prt_ctl_ptr, ordatap, a_code);
	     return;
	end;
	if a_type = "tail_sheet" then do;
	     call iodd_static_ptr -> iodd_static.print_tail_sheet (iocbp, prt_ctl_ptr, ordatap, a_code);
	     return;
	end;
	if a_type = "separator" then do;
	     call iodd_static_ptr -> iodd_static.print_head_separator (iocbp, prt_ctl_ptr, "separator", a_code);
	     return;
	end;

/*	otherwise we will have to search for the module to call....must be in search path */

	searched = "0"b;				/* havn't searched for the proc name */
	if last_type ^= a_type then do;		/* try for some efficiency */

find:	     call ioa_$rsnnl ("write_^a_", proc_name, len, a_type); /* format to "write_type_" as module name */

	     call hcs_$make_ptr (addr (iodd_$), proc_name, proc_name, proc_ptr, a_code);
	     if a_code ^= 0 then do;			/* this is bad */
		last_type = "";			/* have to set the ptr after re-compile */
		return;
	     end;
	     last_type = a_type;			/* so we don't do this too often */
	     searched = "1"b;			/* we have tried searching */

	end;

	call cu_$ptr_call (proc_ptr, a_stream, ordatap, a_code);
	if a_code ^= 0 then if ^searched then go to find; /* possibly an error on the old pointer */

	return;					/* let the caller handle the error if any */




write_sample_prt_banner_: entry (a_type, a_iocbp, a_prt_ctl_ptr, a_code);

/* this entry is used to print sample head_sheets and tail_sheets */

	if a_type ^= "head_sheet" & a_type ^= "tail_sheet" then do;
not_done:	     a_code = error_table_$action_not_performed;
	     return;
	end;

	iocbp = a_iocbp;
	if iocbp = null then go to not_done;
	prt_ctl_ptr = a_prt_ctl_ptr;

	go to sample_common;


write_sample_form_: entry (a_type, a_stream, a_code);

dcl  init bit (1) int static init ("0"b);		/* initialization flag to avoid extra work */
dcl  (addr, string, null, substr) builtin;
dcl  clock_ entry () returns (fixed bin (71));
dcl  date_time_ entry (fixed bin (71), char (*) aligned);
dcl  alloc_dmp ptr int static init (null);

/* locate the iocb for the given stream */
	call iox_$look_iocb (a_stream, iocbp, a_code);
	if a_code ^= 0 then
	     return;
	prt_ctl_ptr = null;

sample_common:

	ordatap = addr (request);			/* we want the dummy data */
	if alloc_dmp = null then			/* need a copy of dprint_msg too */
	     allocate dprint_msg set (alloc_dmp);

	if ^init then do;				/* first time we set these values */

	     request.dpmp = alloc_dmp;		/* ptr to dummy message */
	     request.requestor = "Username.Project.x";
	     request.full_path = ">user_dir_dir>Project_name>Username>segment_name";
	     request.queue = 3;
	     request.charge_queue = 1;		/* charge at rate for queue 1 */
	     request.copies = 4;
	     request.copy_no = 1;
	     request.request_no = 999999;		/* highest possible request for a driver */
	     request.restart_no = 888888;		/* previous number which was restarted */
	     request.request_type = "request_type_name";	/* Hope this is general enough */
	     request.access_class_string = "-AIM--Field-, Category 2, Category 4";
	     request.punsw = 0;
	     request.delete = 1;
	     request.device_name = "device_name";
	     request.output_mode = "single,noskip,non_edited,ll132,pl60,in10.";
	     request.line_count = 4600;
	     request.page_count = 78;
	     request.cpu_time = 1000000;		/* 1 million microseconds */
	     request.real_time = 20000000;		/* 20 million microseconds */
	     request.page_waits = 3687;
	     request.pre_pages = 2017;
	     request.bit_count = 224745;
	     request.charge = 9.20;			/* $9.20 should be large enough */
	     request.price_per_n_lines = 2.00;		/* try for $2.00 per 1000 lines */
	     request.n_lines_for_price = 1000;		/* this is the per 1000 part */
	     request.price_per_n_pages = 8.00;		/* try for $8.00 per 1000 pages */
	     request.n_pages_for_price = 1000;		/* this is the per 1000 part */
	     request.total_charge = 9.20;
	     request.notify = "1"b;
	     request.continued = "0"b;
	     request.restarted = "1"b;		/* this will show a restarted request - if needed */
	     request.separator = "1"b;		/* indicates a message should be printed */
	     request.saved = "1"b;			/* say we suspended request */
	     request.priority_request = "1"b;		/* this one was high priority */
	     request.contd_no = 0;			/* not a continued request */


/* now for the actual dprint message */


	     dmp = alloc_dmp;			/* copy the ptr for auto based reference */

	     dprint_msg.msg_time = clock_ ();		/* just a legal value */
	     dprint_msg.dirname = ">user_dir_dir>Project_name>Username";
	     dprint_msg.ename = "segment_name";
	     dprint_msg.hdr_version = queue_msg_hdr_version_1;
	     dprint_msg.state = 0;
	     dprint_msg.orig_queue = 3;
	     string (dprint_msg.bit_flags) = ""b;
	     dprint_msg.version = dprint_msg_version_5;
	     dprint_msg.message_type = 1;		/* we are assuming a print request */
	     dprint_msg.copies = 4;
	     dprint_msg.delete_sw = "1"b;
	     dprint_msg.notify = "1"b;
	     dprint_msg.heading_lth = head_max_lth;
	     dprint_msg.top_label_lth = label_max_lth;
	     dprint_msg.bottom_label_lth = label_max_lth;
	     dprint_msg.chan_stop_path_lth = 0;
	     dprint_msg.heading = "-HEAD-BANNER-WITH-NO-BLANKS-WHICH-CAN-GO-ON-FOR-64-CHARS-------*";
	     dprint_msg.output_module = 1;
	     string (dprint_msg.control) = (36)"1"b;
	     dprint_msg.destination = "SAMPLE---DESTINATION";
	     dprint_msg.forms = "";
	     dprint_msg.forms_name_lth = 0;
	     dprint_msg.lmargin = 10;
	     dprint_msg.line_lth = 132;
	     dprint_msg.page_lth = 60;
	     dprint_msg.top_label = (3)"This will appear at the top and bottom of each page.          ";
	     dprint_msg.bottom_label = dprint_msg.top_label;

	     init = "1"b;				/* lets not do this again!! */

	end;

	request.time_start_request = clock_ ();
	call date_time_ (request.time_start_request, request.date_time_start_request);

	go to common_write;

/* entrypoint to save ptr to the drivers iodd_static structure */

init: entry (a_static_ptr);

	iodd_static_ptr = a_static_ptr;
	return;
%page; %include dprint_msg;
%page; %include iod_tables_hdr;
%page; %include iodd_static;
%page; %include output_request_data;
%page; %include queue_msg_hdr;

     end write_control_form_;




		    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
