


		    file_monitor_.pl1               11/15/82  1903.3rew 11/15/82  1524.0       71721


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


file_monitor_: proc;

	return;					/* not a legal entry point */


/* FILE_MONITOR_ -- handles interface with ANSI tape DIM. Opens and closes files
   on the tape as required.
   0) Created 12/5/74 by Janice B. Phillipps
   1) Revised 7/10/75 by J.Phillipps for new IO Daemon.
   2) Modified 1/31/78 by J. C. Whitmore for new printer features and prtdim/spooldim merge.
*/


%include spooling_info;

dcl  terminal_sw fixed bin,				/* switch set when tape will be taken down */
     cnst fixed bin init (1),
     a_fnbr fixed bin,
     fnbr fixed bin,
     tm_sw fixed bin;				/* parameter for terminal_sw */

dcl  command_question condition;
dcl  attach_description char (256) varying;
dcl  comment_string char (80) var;			/* comment field for the attach description */

dcl  ctr fixed bin init (1);

dcl  spooling_question_handler_ entry (ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
dcl  iox_$attach_iocb entry (ptr, char (*), fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));

dcl  spool_static_$debug fixed bin ext;

dcl  error_table_$dev_nt_assnd fixed bin (35) ext;
dcl  error_table_$fatal_error fixed bin (35) ext;

dcl  a_sip ptr,
     number pic "zzzzz9",
     line_length pic "zzzzz9",
     vols char (128) aligned varying,
     a_vols char (*),
    (i, ii, j, k) fixed bin,				/* indicies */
     code fixed bin (35),
     scode fixed bin (35);

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


attach:	entry (a_sip, a_vols, a_fnbr, code);

	sip = a_sip;				/* local ptr */
	fnbr = a_fnbr;
	vols = a_vols;
	code = 0;
	i, ii, j, k = 0;

	if spooling_info.version ^= spooling_info_version_4 then do;
	     code = error_table_$fatal_error;
	     return;
	end;

/* if tape_ansi_ asks for something */

	on command_question call spooling_question_handler_ (sip, scode);

	if spooling_info.fst_call then do;		/* 1st time thru set up vol list */
	     spooling_info.filenumber = 0;		/* initialize */
	     spooling_info.filesetid = spooling_info.volids (1); /* establish the file set identifier */
	     spooling_info.fst_call = "0"b;		/* reset */
	end;

	if spooling_info.filesetid = "" then do;
	     code = error_table_$dev_nt_assnd;
	     return;
	end;

	if spooling_info.nvols > 1 then do;		/* pass tape_ansi_ all mbrs of fileset */
	     vols = "";
	     do i = 2 to spooling_info.nvols;
		vols = vols || " " || spooling_info.volids (i);
	     end;
	     vols = vols || " " || a_vols;
	end;

	if fnbr > 0 then				/* was the file number given? */
	     spooling_info.filenumber = fnbr;
	else spooling_info.filenumber = spooling_info.filenumber + 1; /* otherwise use the next file in sequence */

	number = fixed (spooling_info.filenumber);	/* convert file index to character string */
	i = verify (number, " ");			/* mark first non-blank */
	spooling_info.static_number = substr (number, i);

	line_length = fixed (spooling_info.phys_line_length) + 5; /* convert to character string */
	j = verify (line_length, " ");		/* mark first non-blank */

	comment_string = "";			/* clear the comment field */
	if ^spooling_info.vol_mount then		/* when mounting the volume, give comment */
	     if spooling_info.comment ^= "" then
		comment_string = " -comment " || rtrim (spooling_info.comment);

	if spooling_info.flgs.io_sw then do;		/* setup for write */
	     attach_description = "tape_ansi_ " || spooling_info.filesetid || " " || vols || comment_string
		|| " -create -name FILE" || substr (number, i)
		|| " -number " || substr (number, i)
		|| " -record " || substr (line_length, j)
		|| " -block "|| spooling_info.block_lnth
		|| " -density " || spooling_info.density
		|| " -format db -retain all -force -mode ascii";
	end;
	else do;					/* setup to read the tape */
	     attach_description = "tape_ansi_ " || spooling_info.filesetid || " " || vols || comment_string
		|| " -number " || substr (number, i)
		|| " -retain all -mode ascii";
	end;

	if spool_static_$debug = 1 then
	     call ioa_ ("file_monitor_: attach description is^/^a", attach_description);

	call attach_and_open (scode);			/* internal proc to do the attachment */
	if scode = 0 then
	     spooling_info.flgs.vol_mount = "1"b;	/* volume up now */
	code = scode;

	return;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
detach:	entry (a_sip, tm_sw, code);

	sip = a_sip;
	terminal_sw = tm_sw;			/* = 1 if wont count file in file count */
	code = 0;
	scode = 0;

	on command_question call spooling_question_handler_ (sip, scode);

	if terminal_sw = 1 then
	     call iox_$control (spooling_info.iocbp, "retain_none", addr (cnst), code);

	call close_and_detach (scode);
	if scode = 0 & terminal_sw = 1 then do;
	     spooling_info.flgs.vol_mount = "0"b;	/* volume no longer mounted */
	     spooling_info.filesetid = "";
	end;
	code = scode;

	return;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
cleanup:	entry (a_sip, a_vols, code);

	sip = a_sip;
	vols = a_vols;
	scode, code = 0;

	if spooling_info.flgs.vol_mount then do;

	     call ioa_ ("^/Taking tape volume down.^/");

	     attach_description = "tape_ansi_ " || spooling_info.filesetid
		|| " -retain none -number 1";

	     if spool_static_$debug = 1 then
		call ioa_ ("file_monitor_$cleanup: attach desc: ^a", attach_description);

/* attach/detach sequence here required by ansi dim to take down volume */

	     call attach_and_open (scode);
	     call iox_$control (spooling_info.iocbp, "retain_none", addr (cnst), code); /* in case already attached */
	     call close_and_detach (scode);		/* dont increment file count */
	     if scode = 0 then do;			/* if it was good, mark it as done */
		spooling_info.flgs.vol_mount = "0"b;	/* volume no longer up */
		spooling_info.filesetid = "";
	     end;
	end;
	code = scode;
	return;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
attach_and_open: proc (rcode);			/* internal proc to do attach thru tape dim */

dcl  rcode fixed bin (35);
dcl  scode fixed bin (35);
dcl  open_mode fixed bin;

	     if spooling_info.iocbp = null then do;
		call iox_$attach_ioname ((spooling_info.switch_name), spooling_info.iocbp, (attach_description), rcode);
	     end;
	     else call iox_$attach_iocb (spooling_info.iocbp, (attach_description), rcode);

	     if spooling_info.flgs.io_sw then open_mode = 5; /* sequential output not extending */
	     else open_mode = 4;			/* sequential input */

	     call iox_$open (spooling_info.iocbp, open_mode, "0"b, scode); /* open I/O switch */

	     if scode = 0 then rcode = 0;		/* if open worked, all is well */
	     else if rcode = 0 then rcode = scode;	/* if attach worked, give open error */

	     return;

	end attach_and_open;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
close_and_detach: proc (rcode);

/* close and detach the current io switch */

dcl  rcode fixed bin (35);

	     call iox_$close (spooling_info.iocbp, rcode);
	     call iox_$detach_iocb (spooling_info.iocbp, rcode);

	     return;

	end close_and_detach;

     end file_monitor_;
   



		    get_spooling_data_.pl1          10/03/89  1010.9rew 10/03/89  0953.9      160560


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


/****^  HISTORY COMMENTS:
  1) change(89-06-15,Brunelle), approve(89-09-18,MCR8129),
     audit(89-09-29,Beattie), install(89-10-03,MR12.3-1083):
     Change parse_command_ call, which was replaced in MR12.2, with
     iodd_parse_$command.
                                                   END HISTORY COMMENTS */


get_spooling_data_: proc;

	return;

/* GET_SPOOLING_DATA_ -- the operator interface for the Multics Spooling IO Module.
   This routine reads from "user_input" and parses for: tape volume-ids,
   optional density, optional spooling line-length, and optional spooling limits  (lines and files).
   There is an entry point for updating the spooling volume list and
   an entry point for updating the spooling limits.

   0)  Created 10/74 by Janice B. Phillipps as part of the Multics Spooling DIM.
   1)  Updated 7/75 by J.Phillipps for new printer dim.
   2)  Updated 10/75 by J.Phillipps to add optional density specification.
   3)  Re-written 1/31/78 by J. C. Whitmore while adding new printer features to spooldim.
*/

%include spooling_info;
dcl (addr, length, substr, convert, rtrim, string, translate) builtin;
dcl  conversion condition;

dcl  a_sip ptr,
     arg_no fixed bin,
     code fixed bin (35),
     comment char (64),
     density char (4) aligned,
     ec fixed bin (35),
     file_limit fixed bin (21),
     i fixed bin,
     init_flg bit (1) aligned,
     input_line char (120) aligned,
     input_lnth fixed bin,				/* length of input line (nelemt) */
     key fixed bin,
     line_limit fixed bin (21),
     number fixed bin,
     nxt_vol_flg bit (1) aligned,
     op_msg char (80),
     opt char (*),
     renew_flg bit (1) aligned,
     temp_arg char (64),
     try_again bit (1) aligned;

dcl 1 arg_list aligned,
    2 max_args fixed bin init (20),			/* don't expect more than 20 tokens per line */
    2 nargs fixed bin,
    2 arg (20) char (64) var;				/* array of tokens from input line */

dcl 1 flags unaligned,				/* control flags */
   (2 error_flag,
    2 vol_flag,
    2 files_flag,
    2 lines_flag,
    2 den_flag,
    2 int_flag,
    2 comm_flag) bit (1) unal;

dcl  vol_id (3) char (8) var;
dcl  n_vols fixed bin;

dcl  error_table_$device_end fixed bin (35) ext static;
dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$fatal_error fixed bin (35) ext static;

dcl  ioa_ entry options (variable);
dcl  iodd_parse_$command entry (char(*), ptr, fixed bin(35));
dcl  iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
dcl  iox_$user_input ext ptr;


initial:	entry (a_sip, opt, code);

	sip = a_sip;
	opt = "";

	call init (code);				/* set things up */
	if code ^= 0 then return;			/* wrong info version */

	spooling_info.line_limit = 0;
	spooling_info.file_limit = 0;
	spooling_info.density = "";
	spooling_info.block_lnth = "";
	spooling_info.spool_file_limit_sw = 0;
	spooling_info.spool_line_limit_sw = 0;
	spooling_info.nvols = 0;
	spooling_info.volids (*) = "";		/* initialize the volume list */

	init_flg = "1"b;				/* initial entry flag */
	nxt_vol_flg = "0"b;				/* next volume entry flag */
	renew_flg = "0"b;				/* renew limits entry flag */

	if spooling_info.flgs.io_sw then
	     op_msg = "Enter volids and optional tape data or limits:";
	else op_msg = "Enter volid and optional limits:";
join:
	call ioa_ (op_msg);

read:	input_line = "";				/* clear any junk */

	call iox_$get_line (iox_$user_input, addr (input_line), 120, input_lnth, ec); /* read operator's input  */

	call iodd_parse_$command (substr (input_line, 1, input_lnth), addr (arg_list), ec);
	if ec ^= 0 then do;
	     if ec = error_table_$noarg then go to read;	/* null line */
	     call report ("Error in  command line.");
	     go to join;
	end;

	if arg (1) = "detach" then do;
	     if nargs ^= 1 then do;
		call report ("Invalid detach command.");
		go to join;
	     end;
	     opt = "det";				/* tell caller to detach tape */
	     code = error_table_$device_end;		/* all done */
	     return;
	end;

	if arg (1) = "help" then do;			/* operator is confused */
	     call ioa_ ("Options:  -vol <tape_numbers (3)> -fl <limit> -ln <limit> -den <density> -int or ""detach""");
	     go to join;
	end;

	on conversion begin;
	     call report ("Argument conversion error.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	key = 1;					/* next key to process is the first one */

next_key:

	if key > nargs then go to finish;		/* go see what happened */

	if arg (key) = "-volid" | arg (key) = "-vol" then go to volume_key;
	if arg (key) = "-files" | arg (key) = "-fl" then go to files_key;
	if arg (key) = "-lines" | arg (key) = "-ln" then go to lines_key;
	if arg (key) = "-density" | arg (key) = "-den" then go to density_key;
	if arg (key) = "-interchange" | arg (key) = "-int" then go to interchange_key;
	if arg (key) = "-comment" | arg (key) = "-com" then go to comment_key;

	error_flag = "1"b;				/* be sure to verify final values */
	call ioa_ ("*** Unrecognized keyword: ^a^/Keyword ignored.", arg (key));

	do key = key + 1 to nargs;
	     if substr (arg (key), 1, 1) = "-" then go to next_key;
	end;

	go to finish;				/* no more keywords */


volume_key:

	number = 0;				/* init the arg count */
	arg_no = key + 1;				/* the first arg for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-"); /* find all values */
	     number = number + 1;			/* increment the arg counter */
	end;

	if renew_flg then do;			/* just want limits */
	     call report ("The -volid keyword is invalid when looking for limits.");
	     go to next_key;
	end;

	if number = 0 then do;			/* we must have at least one volume name */
	     error_flag = "1"b;			/* give the summary */
	     call report ("Volume id has been omitted.");
	     go to next_key;
	end;

	if number > 3 then do;			/* too many volume names */
	     call report ("Only 3 volume ids can be entered.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	do i = arg_no to key -1;			/* check out each volid given as args */
	     if length (arg (i)) ^= 6 then do;
		call report ("Bad volume id: " || arg (i) || " Each must have six characters.");
		error_flag = "1"b;
		go to next_key;
	     end;
	end;
	vol_id (*) = "";				/* clear the old values */
	n_vols = 0;				/* clear the vol counter */

	do i = arg_no to key - 1;			/* pick up the new vol ids */
	     n_vols = n_vols + 1;			/* increment the count (index) */
	     vol_id (n_vols) = arg (i);		/* copy the volid */
	end;

	vol_flag = "1"b;				/* got some good volume ids */
	go to next_key;

files_key:					/* set file count for spooling limits */

	number = 0;				/* check the number of values for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-");
	     number = number + 1;			/* count the limits given */
	     temp_arg = arg (key);			/* save the limit value */
	end;

	if number = 0 then do;			/* must have some limit given */
	     call report ("Unspecified file limit count.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	if number > 1 then do;			/* we can only use one limit value, which? */
	     call report ("Only one file limit can be accepted.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	if temp_arg = "reset" then do;
	     file_limit = -1;			/* in case he wants to change his mind */
	end;
	else do;
	     file_limit = convert (file_limit, temp_arg);
	     if file_limit < 0 | file_limit > 999999 then do;
		error_flag = "1"b;
		call report ("Bad file limit.");
		go to next_key;
	     end;
	end;
	files_flag = "1"b;				/* report a change if needed */
	go to next_key;

lines_key:					/* set line count for spooling limits */

	number = 0;				/* check the number of values for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-");
	     number = number + 1;			/* count the limits given */
	     temp_arg = arg (key);			/* save the limit value */
	end;

	if number = 0 then do;			/* must have some limit given */
	     call report ("Unspecified line limit count.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	if number > 1 then do;			/* we can only use one limit value, which? */
	     call report ("Only one line limit can be accepted.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	if temp_arg = "reset" then do;
	     line_limit = -1;			/* in case he wants to change his mind */
	end;
	else do;
	     line_limit = convert (line_limit, temp_arg);
	     if line_limit < 0 | line_limit > 999999 then do;
		error_flag = "1"b;
		call report ("Bad line limit.");
		go to next_key;
	     end;
	end;
	lines_flag = "1"b;				/* report a change if needed */
	go to next_key;

density_key:					/* set density */

	number = 0;				/* check the number of values for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-");
	     number = number + 1;			/* count the values given */
	     temp_arg = arg (key);			/* save the value */
	end;

	if spooling_info.io_sw = "0"b then do;		/* not for reading */
not_input:     call report ("The -density and -interchange keywords are not allowed on input.");
	     go to next_key;
	end;
	if spooling_info.density ^= "" | spooling_info.vol_mount then do;
	     call report ("Cannot change density once file set is attached");
	     go to next_key;
	end;
	if number = 0 then do;
	     call report ("Unspecified recording density.");
	     error_flag = "1"b;			/* a real goof */
	     go to next_key;
	end;
	if number > 1 then do;
	     call report ("Only one density setting may be accepted.");
	     error_flag = "1"b;
	     go to next_key;
	end;
	if ^(temp_arg = "800" | temp_arg = "1600") then do; /* must be a legal value */
	     call report ("Density must be either 800 or 1600 .");
	     error_flag = "1"b;
	     go to next_key;
	end;
	density = substr (temp_arg, 1, length (density)); /* save the new value */
	den_flag = "1"b;				/* mark density as set  */
	int_flag = "0"b;				/* cancel interchange if set */
	go to next_key;

interchange_key:					/* set interchange density and block size */

	number = 0;				/* check the number of values for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-");
	     number = number + 1;			/* count the values given */
	end;

	if spooling_info.io_sw = "0"b then go to not_input; /* illegal */

	if spooling_info.density ^= "" | spooling_info.vol_mount then do;
	     call report ("Interchange cannot be specified after volume is attached.");
	     go to next_key;
	end;
	if number ^= 0 then do;
	     call report ("Interchange keyword does not allow arguemnts.");
	     error_flag = "1"b;
	     go to next_key;
	end;
	int_flag = "1"b;				/* mark interchange as set */
	density = "800";				/* force the interchange value */
	den_flag = "0"b;				/* reset  value from density key */
	go to next_key;

comment_key:

	number = 0;				/* check the number of values for this key */

	do key = key + 1 to nargs while (substr (arg (key), 1, 1) ^= "-");
	     number = number + 1;			/* count the limits given */
	     temp_arg = arg (key);			/* save the comment */
	end;

	if number = 0 then do;
	     call report ("Comment field is missing.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	if number > 1 then do;
	     call report ("Multiple comments found.  Use quotes if comment includes spaces.");
	     error_flag = "1"b;
	     go to next_key;
	end;

	comment = translate (rtrim (temp_arg), "_", " 	"); /* make all spaces underscore */
	comm_flag = "1"b;
	go to next_key;


finish:						/* now we see what was set, and maybe return to the caller */

	try_again = "0"b;				/* see if there was an error in lack of data */

	if (nxt_vol_flg | init_flg) & ^vol_flag then do;
	     call report ("No volume id given.");
	     try_again = "1"b;
	end;

	if spooling_info.spool_file_limit_sw = 1 & ^files_flag then do; /* do we need a new file limit? */
	     call report ("A new file limit must be given.");
	     try_again = "1"b;
	end;

	if spooling_info.spool_line_limit_sw = 1 & ^lines_flag then do; /* do we need a new line limit? */
	     call report ("A new line limit must be given.");
	     try_again = "1"b;
	end;

	if ^(lines_flag | files_flag) then
	     if init_flg & ^(error_flag | try_again) then do; /* tell op no limits */
		call ioa_ ("No file or line limits have been set.");
		go to ask;			/* make him verify */
	     end;

	if try_again then go to join;			/* did we pass the tests? */

	if error_flag then do;			/* if any error occured, show the values we will use */

	     if vol_flag then
		call ioa_ ("Volume ids: ^a ^a ^a", vol_id (1), vol_id (2), vol_id (3));

	     if files_flag then
		if file_limit = -1 then call ioa_ ("File limit will be reset.");
		else call ioa_ ("File limit ^d will be added to current limit of ^d",
		     file_limit, spooling_info.file_limit);

	     if lines_flag then
		if line_limit = -1 then call ioa_ ("Line limit will be reset.");
		else call ioa_ ("Line limit ^d will be added to current limit of ^d",
		     line_limit, spooling_info.line_limit);

	     if den_flag then
		call ioa_ ("Density: ^a", density);

	     if int_flag then
		call ioa_ ("Interchange:  density = 800,  block size = 2048");

	     if comm_flag then
		call ioa_ ("Comment: ^a", comment);

	     if init_flg & ^(lines_flag | files_flag) then
		call ioa_ ("No file or line limits have been set.");

ask:	     call ioa_ ("Are these parameters correct?");

	     input_line = "";
	     call iox_$get_line (iox_$user_input, addr (input_line), 120, input_lnth, ec);
	     input_line = substr (input_line, 1, input_lnth -1); /* drop the new_line char */
	     if input_line = "no" then go to join;
	     if input_line ^= "yes" then do;
		call ioa_ ("Please answer yes or no.");
		go to ask;
	     end;
	end;


/*	All OK  -  use the values for real now */

	if vol_flag then do;
	     do i = 1 to 3;
		spooling_info.volids (i) = vol_id (i);
	     end;
	     spooling_info.nvols = n_vols;
	end;

	if lines_flag then do;
	     if line_limit = -1 then spooling_info.line_limit = 0;
	     else spooling_info.line_limit = spooling_info.line_limit + line_limit;
	     spooling_info.spool_line_limit_sw = 0;
	end;

	if files_flag then do;
	     if file_limit = -1 then spooling_info.file_limit = 0;
	     else spooling_info.file_limit = spooling_info.file_limit + file_limit;
	     spooling_info.spool_file_limit_sw = 0;
	end;

	if den_flag then do;			/* sets density and block size */
	     spooling_info.density = density;
	     spooling_info.block_lnth = "8192";
	end;

	if int_flag then do;
	     spooling_info.density = "800";
	     spooling_info.block_lnth = "2048";
	end;

	if comm_flag then spooling_info.comment = comment;

	if spooling_info.block_lnth = "" then
	     spooling_info.block_lnth = "8192";		/* default is biggest possible */

	if spooling_info.density = "" then
	     spooling_info.density = "1600";		/* default density  */

	return;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
report:	proc (message);

dcl  message char (*);

	     call ioa_ ("*** ^a", message);		/* simple format for now */
	     return;

	end report;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
init:	proc (ec);

dcl  ec fixed bin (35);

	     if spooling_info.version ^= spooling_info_version_4 then do; /* right structure? */
		ec = error_table_$fatal_error;
		call report ("Fatal_error. Incorrect version of info structure.");
		return;
	     end;
	     ec = 0;				/* all well otherwise */
	     file_limit = 0;
	     line_limit = 0;
	     density = "1600";
	     n_vols = 0;
	     vol_id (*) = "";
	     comment = "";
	     string (flags) = ""b;

	     return;

	end init;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
next_volume: entry (a_sip, opt, code);			/* entry to get next volume id to spool onto */

	sip = a_sip;
	opt = "";

	call init (code);
	if code ^= 0 then return;

	spooling_info.volids (*) = "";
	nxt_vol_flg = "1"b;				/* make sure get volid or detach */
	renew_flg = "0"b;				/* wont reset spooling limits */
	init_flg = "0"b;				/* initial entry flag turned off */

	call ioa_ ("End of spooling volume list;");

	op_msg = "Enter more volids or ""detach"":";

	go to join;

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  - */
renew_limits: entry (a_sip, opt, code);

	sip = a_sip;
	opt = "";

	call init (code);
	if code ^= 0 then return;

	nxt_vol_flg = "0"b;				/* wont change volume list */
	renew_flg = "1"b;				/* will renew limits */
	init_flg = "0"b;				/* initial entry flag turned off */

	call ioa_ ("^/Reached specified spooling limits;");

	call ioa_ ("^/^-Current file limit is ^d ^/^-Current line limit is ^d",
	     spooling_info.file_limit, spooling_info.line_limit);

	call ioa_ ("^/^-Current file count is ^d ^/^-Current line count is ^d^/",
	     spooling_info.spooling_file_count, spooling_info.spooling_line_count);

	op_msg = "Enter new file and/or line limits, or ""detach"":";

	go to join;

     end get_spooling_data_;



		    print_spooling_tape.pl1         11/15/82  1903.3rew 11/15/82  1524.2       93033


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


print_spooling_tape: pst: proc;

/* PRINT_SPOOLING_TAPE --  routine to attach a printer thru  the printer DIM
   and print a spooling tape.
   0)  Created 1/5/75 by Janice B. Phillipps
   1)  Updated 7/21/75 by J.Phillipps for new printer DIM.
   2) Modified 1/78 by J. C. Whitmore for new printer features and prtdim/spooldim merge
*/


%include spooling_info;
%include status;

dcl (addr, null, convert, string) builtin;

dcl (cleanup, conversion) condition;


dcl 1 counts aligned,				/* structure used in "get_count" call */
    2 line fixed bin,				/* line number */
    2 page_length fixed bin,				/* length of page */
    2 lmarg fixed bin,				/* left margin indentation */
    2 rmarg fixed bin,				/* line length */
    2 line_count fixed bin,				/* count of lines printed */
    2 page_count fixed bin;				/* count of pages printed */

dcl  al fixed bin,
     ap ptr,
     areap ptr,
     arg1 char (8) aligned,
     bptr ptr,
     code fixed bin (35),
     db_flg bit (1) aligned,
     dev_id char (4) aligned,
     ec fixed bin,
     fnbr fixed bin,				/* number of file to start printing from */
     fnbr_flg bit (1) aligned,
     i fixed bin,
     narg fixed bin,
     nargs fixed bin,
     opt char (3) aligned,
     output_dim char (7) aligned,
     retry_sw bit (1) aligned init ("1"b),
     scode fixed bin (35),
     statp ptr,
     status bit (72) aligned;

dcl  arg char (al) based (ap) aligned,
     listen_area area ((16374)) based (areap),
     device_name char (al) unaligned based (ap),
     dim_name char (al) unaligned based (ap),

     file_number char (al) unaligned based (ap);


dcl 1 basics aligned based (bptr),
    2 areap ptr,
    2 info like spooling_info aligned;

dcl  error_table_$no_file ext fixed bin (35);
dcl  error_table_$fatal_error ext fixed bin (35);

dcl  spool_static_$debug ext fixed bin;

dcl  cu_$arg_count entry (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin);
dcl  com_err_ entry options (variable);
dcl  file_monitor_$attach entry (ptr, char (*) aligned, fixed bin, fixed bin (35));
dcl  file_monitor_$cleanup entry (ptr, char (*) aligned, fixed bin (35));
dcl  file_monitor_$detach entry (ptr, fixed bin, fixed bin (35));
dcl  get_spooling_data_$initial entry (ptr, char (*) aligned, fixed bin (35));
dcl  get_spooling_data_$renew_limits entry (ptr, char (*) aligned, fixed bin (35));
dcl  get_system_free_area_ entry (ptr);
dcl  ioa_ entry options (variable);
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  unspool_ entry (ptr, fixed bin (35));


	code = 0;
	db_flg = "0"b;
	fnbr_flg = "0"b;
	scode = 0;
	status = (72)"0"b;				/* clear return status */
	statp = addr (status);
	call get_system_free_area_ (areap);		/* get ptr to area in listen_ */
	allocate basics in (listen_area) set (bptr);	/* create block */
	if bptr = null then do;
	     call com_err_ (0, "print_spooling_tape", "Unable to allocate spooling info structure.");
	     return;
	end;
	bptr -> basics.areap = areap;			/* save ptr to free area */
	sip = addr (bptr -> basics.info);		/* get pointer to spooling_data */

	call cu_$arg_count (nargs);
	if nargs < 2 then do;
	     call ioa_ ("Usage is:   print_spooling_tape prtdim device -options-");
	     go to free_storage;
	end;

	call cu_$arg_ptr (1, ap, al, ec);
	if ec ^= 0 then do;
err:	     call com_err_ (ec, "print_spooling_tape", "Error while processing arguments.");
	     go to free_storage;
	end;

/* 1st argument is the IO Module name to use */
	arg1 = ap -> dim_name;
	output_dim = arg1;

/* 2nd argument is device/stream name */
	call cu_$arg_ptr (2, ap, al, ec);		/* usually arg is ptrb */
	if ec ^= 0 then go to err;
	arg1 = ap -> device_name;
	dev_id = arg1;				/* device name to attach to */

	on conversion go to err;			/* in case op types a letter, or ... */

	if nargs = 2 then go to default;		/* no options */

	do narg = 3 repeat (narg+1) while (narg <= nargs);
	     call cu_$arg_ptr (narg, ap, al, ec);
	     if ec ^= 0 then go to err;

	     if arg = "-nbr" | arg = "-number" then do;
		narg = narg + 1;
		call cu_$arg_ptr (narg, ap, al, ec);
		if ec ^= 0 then go to err;
		arg1 = ap -> file_number;
		fnbr = convert (i, arg1);
		fnbr_flg = "1"b;
	     end;
	     else if arg = "-db" | arg = "-debug" then db_flg = "1"b;
	     else go to err;
	end;

default:
	if ^fnbr_flg then fnbr = 1;

	call ioa_ ("^/Printing will begin with FILE ^d.^/", fnbr);

	if db_flg then spool_static_$debug = 1;
	else spool_static_$debug = 0;

	spooling_info.iocbp = null;			/* in case the cleaner_up is called */

	on cleanup begin;
	     call cleaner_up;
	     free basics in (listen_area);
	end;

	call ios_$attach ("printer_output", output_dim, dev_id, "", status);
	if statp -> stat.fbpart ^= 0 then do;
	     call com_err_ (statp -> stat.fbpart, "print_spooling_tape",
		" Could not attach device: ^a", dev_id);
	     go to free_storage;			/* streams not attached yet */
	end;

	call ios_$changemode ("printer_output", "noskip,", "", status); /* want control of the printer here */
	if statp -> stat.fbpart ^= 0 then
	     call com_err_ (statp -> stat.fbpart, "print_spooling_tape", "Could not set printer modes.");

	spooling_info.version = spooling_info_version_4;	/* the current version */
	spooling_info.switch_name = "spool_input";	/* device is the switch attached to tape_ansi_ */
	string (spooling_info.flgs) = ""b;
	spooling_info.flgs.fst_call = "1"b;		/* mark as the first attachment */

	spooling_info.filesetid = "";			/* no previous ANSI file-set being processed */
	spooling_info.spooling_line_count = 0;
	spooling_info.spooling_file_count = 0;
	spooling_info.phys_line_length = 136;		/* this is the default for the spooling dim */
	spooling_info.phys_page_length = 66;		/* assume 11 inch paper at 6 lpi */
	spooling_info.flgs.io_sw = "0"b;		/* set up to read tape */
	counts.line_count = 0;			/* initialize */
	counts.page_count = 0;

	call get_spooling_data_$initial (sip, opt, code); /* get spooling limits and volids  */
	if opt = "det" | code ^= 0 then do;
	     call cleaner_up;			/* release devices */
	     go to free_storage;
	end;

	spooling_info.filenumber = fnbr;		/* start at the given file */

repeat:
	call file_monitor_$attach (sip, "", spooling_info.filenumber, code); /* attach and open file on ansi tape */
	if code = error_table_$no_file then do;		/* thats all for this volume */
	     call ioa_ ("^/Reached end of data for current fileset.");
	     call cleaner_up;
	     go to free_storage;
	end;

	else if code ^= 0 then do;			/* got a problem trying to attach the tape file */
	     if retry_sw then do;
		call com_err_ (code, "print_spooling_tape",
		     "Error while calling file_monitor_$attach; ^/ Will try attachment and opening once more.");
		retry_sw = "0"b;			/* reset */
		go to repeat;
	     end;
	     call cleaner_up;
	     go to free_storage;
	end;

	call ioa_ ("Printing FILE ^d", spooling_info.filenumber);

	call ios_$order ("printer_output", "reset", null (), status); /* clear the counts */
	call ios_$changemode ("printer_output", "noskip,", "", status); /* set noskip mode after reset */

	call unspool_ (sip, code);			/* format the input for the printer DIM */
	if code ^= 0 then
	     if code = error_table_$fatal_error then do;
		call cleaner_up;
		go to free_storage;
	     end;
	     else call com_err_ (code, "print_spooling_tape", "^/Processing of tape will continue.");

	call ios_$order ("printer_output", "runout", null (), status);

	call ios_$order ("printer_output", "get_count", addr (counts), status);

/*	update the file number and limit counts */

	spooling_info.filenumber = spooling_info.filenumber + 1; /* ready for the next file */
	spooling_info.spooling_line_count = spooling_info.spooling_line_count + counts.line_count;
	spooling_info.spooling_file_count = spooling_info.spooling_file_count + 1; /* one more file done */

	call file_monitor_$detach (sip, 0, scode);	/* close the current file on the tape */
	if code ^= 0 then do;			/* trouble ... give up */
	     call com_err_ (code, "print_spooling_tape", "Error while calling to detach tape file.");
	     call cleaner_up;
	end;

/*	now check to see if we have hit any limits */

	if spooling_info.file_limit ^= 0 then
	     if spooling_info.file_limit <= spooling_info.spooling_file_count then do;
		spooling_info.spool_file_limit_sw = 1;
	     end;
	if spooling_info.line_limit ^= 0 then
	     if spooling_info.line_limit <= spooling_info.spooling_line_count then do;
		spooling_info.spool_line_limit_sw = 1;
	     end;

	if spooling_info.spool_file_limit_sw = 1 | spooling_info.spool_line_limit_sw = 1 then do;
	     opt = "";
	     call get_spooling_data_$renew_limits (sip, opt, code);
	     if opt = "det" then do;			/* going to detach spooler */
		call cleaner_up;
		go to free_storage;
	     end;
	end;

	go to repeat;				/* on to the next file on the tape */

free_storage:

	free basics in (listen_area);

	return;


/* - - - - - - - - - - - - - - - - - - - - - - - */
cleaner_up: proc;

	     call file_monitor_$cleanup (sip, "", code);	/* take down volume */

	     call ios_$order ("printer_output", "runout", null (), status);

	     call ios_$detach ("printer_output", "", "", status); /* detach printer */

	     call ioa_ ("Printer detached.^/Processing of tape ended.^/");
	     call ioa_ ("Spooling file count is ^d", spooling_info.spooling_file_count);
	     call ioa_ ("Spooling line count is ^d", spooling_info.spooling_line_count);

	     return;

	end cleaner_up;

     end print_spooling_tape;
   



		    spool_conv_.alm                 02/02/88  1703.1r w 02/02/88  1538.3       27702


" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
" SPOOL_CONV - Conversion for for producing spooled output tape
"	coded 11/4/74 by Noel I. Morris

" 1) Version -- for new Printer DIM.

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


" This module perform the necessary conversion for printing
" from spooled output tape.
"
" The manner in which this procedure is utilized is described in detail
" in the listing of prt_conv_.
"
" This procedure is responsible for placing a carriage control character
" at the beginning of each output line.


	name	spool_conv_

	segdef	spool_conv_


spool_conv_:
	tra	spool_send_init
	tra	spool_send_chars
	tra	spool_send_slew_pattern
	tra	spool_send_slew_count

" 

	include	prt_conv_info


" 

spool_send_init:
	szn	lb|pci.temp	was there a previous slew?
	tnz	icc		yes, insert carriage control character

	lda	=a    "		first time, use carriage control of blank
	sta	lb|pci.temp	..

icc:	mlr	(pr),(pr)		move carriage control into output
	desc9a	lb|pci.temp,1	..
	desc9a	bb|0,1		..

	ldq	1,dl		step output pointer over carriage control
	a9bd	bb|0,ql		..

	tra	sb|0		return

" 

spool_send_chars:
	eax2	0,2		set indicators from X2
	tmoz	nospace		if no white space, skip following

	mlr	(),(pr,rl),fill(040)  insert blanks into output
	desc9a	*,0		..
	desc9a	bb|0,x2		..

	a9bd	bb|0,2		step output pointer over blanks
	eax2	0		set white space count back to zero

nospace:	mlr	(pr,rl),(pr,rl)	copy characters into output
	desc9a	bp|0,au		..
	desc9a	bb|0,au		..

	a9bd	bp|0,au		step input and output pointers
	a9bd	bb|0,au		..
	eax2	0		make sure X2 now zero
	tra	sb|0		return to caller

" 

spool_send_slew_pattern:
	eax7	0		initialize for search
	rpt	nslew/2,2,tze	search for slew characters
	cmpa	slew,7		..
	ldq	-1,7		get correct carriage control

stslew:	stq	lb|pci.temp	save for next line
	tra	sb|0		return to caller


slew:
	vfd	27/,o9/0		FF
	aci	"1   "
	vfd	27/,o9/013	top of inside page
	aci	"7   "
	vfd	27/,o9/011	top of outside page
	aci	"8   "

	equ	nslew,*-slew


spool_send_slew_count:
	eaq	0,al		line count in QU
	sbla	3,dl		can slew at most 3 lines at a time
	tmoz	*+2		if more than 3 lines,
          ldq       3,du                do only 3 to start
	ldq	slewn,qu		get correct carriage control
	tra	stslew		and store it for later


slewn:
	aci	"+   "		supress space
	aci	"    "		one space
	aci	"0   "		two space
	aci	"-   "		three space


	end
  



		    spool_driver_.pl1               10/28/88  1407.6rew 10/28/88  1232.3      384444


/****^  ***********************************************************
        *                                                         *
        * 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,ifthen */

/* format: off */

/* Spooling driver control module for the I/O daemon */

/* Created:  14 July 1975 by Janice B. Phillipps */
/* Modified: June 1976 by J. Phillipps to change modes declaration from char(128) to char(256), to initialize
      ordata.output_mode variable to null each time user line modes are parsed, and to correct one instance of request not
      being deleted from dprint queue */
/* Modified: January 1978 by J. C. Whitmore for new printer features and general clean up */
/* Modified: May 1978 by J. C. Whitmore for new dprint_msg format */
/* Modified: August 1978 by J. C. Whitmore for auto defer -> ll < phys_ll &  init xfr rate/limit */
/* 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 by C. Marker, 02/23/85, 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 dprint_msg version 4.
  2) change(88-08-19,Brunelle), approve(88-08-19,MCR7911),
     audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199):
     Upgraded to version 5 iod tables.
  3) change(88-08-29,Farley), approve(88-08-19,MCR7911),
     audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199):
     Updated for version 5 dprint_msg.
                                                   END HISTORY COMMENTS */


/* format: on */


spool_driver_:
     procedure ();

	return;

dcl  (addr, clock, null, substr, length, verify, divide, reverse, convert, max, mod, rtrim, string) builtin;

dcl  (cleanup, command_question, resume, conversion) condition;

dcl  date_string char (24),
     ec fixed bin (35),
     i fixed bin,					/* index variable */
     net fixed bin,
     opt char (3),
     rcode fixed bin (35),
     io_stat bit (72) aligned;			/* ios_ status code */

dcl  omode char (256) aligned;
dcl  p2 ptr;

dcl  whoami char (24) int static options (constant) init ("spool_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  header fixed bin int static options (constant) init (1);
dcl  trailer fixed bin int static options (constant) init (2);
dcl  err_msg fixed bin int static options (constant) init (3);
dcl  demount_tape fixed bin init (1) int static options (constant);

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

dcl  1 counts_data like counts;

dcl  1 spooling_data aligned,
       2 siptr ptr,
       2 line_length fixed bin;

dcl  stream char (32) aligned internal static;		/* stream for writing to printer */
dcl  static_sip ptr int static init (null);		/* static version of spooling info ptr */
dcl  p ptr internal static;
dcl  time fixed bin (71) internal static init (1);
dcl  no_restart_label label int static;

dcl  1 st aligned based (addr (io_stat)),		/* breakdown of status code */
       2 code fixed bin (35),
       2 flags bit (36);

dcl  space_ht_bs char (3) int static;			/* horiz carriage control chars */
dcl  nl_vt_ff char (3) int static;			/* vert carriage control chars, init nl || vt || ff */
dcl  BS char (1) int static options (constant) init ("");	/* the backspace char */
dcl  SP char (1) int static options (constant) init (" ");	/* the space character */
dcl  HT char (1) int static options (constant) init ("	");
						/* the horiz tab character */
dcl  NL char (1) int static options (constant) init ("
");						/* the new-line character */
dcl  VT char (1) int static options (constant) init ("");						/* the vertical tab character */
dcl  FF char (1) int static options (constant) init ("");						/* the form feed character */

dcl  spool_static_$norestart ext;
dcl  spool_static_$file_attch ext;
dcl  spool_static_$debug ext;
dcl  spool_static_$tally_printed ext;

dcl  error_table_$fatal_error fixed bin (35) ext static;
dcl  error_table_$action_not_performed fixed bin (35) ext static;

dcl  iox_$find_iocb entry (char (*) aligned, ptr, fixed bin (35));
dcl  convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  get_spooling_data_$renew_limits entry (ptr, char (*), fixed bin (35));
dcl  get_spooling_data_$initial entry (ptr, char (*), fixed bin (35));
dcl  head_sheet_$print_head_sheet entry (ptr, ptr, ptr, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  iodd_listen_ entry (ptr);
dcl  iodd_msg_ entry options (variable);
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_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
dcl  output_request_ entry (char (*) aligned, fixed bin, ptr, entry, fixed bin (35));
dcl  output_request_$error_during_request entry (char (*));
dcl  output_request_$set_single_copy entry ();
dcl  spooling_question_handler_ entry (ptr, fixed bin (35));
dcl  tail_sheet_$print_tail_sheet entry (ptr, ptr, ptr, fixed bin (35));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2) aligned);
dcl  write_sample_prt_banner_ entry (char (*), ptr, ptr, fixed bin (35));

/**/

init:
     entry (arg_p);

dcl  arg_p ptr;

	stat_p = arg_p;				/* pts to argument string */
	p = iodd_static.driver_ptr;			/* get pointer to driver_status seg */
	p -> driver_status.dev_ctl_ptr, prt_ctl_ptr = addr (static_ctl);
						/* use static device control */

	if iodd_static.attach_type ^= 1 then do;	/* this driver needs to look like printer driver */
						/* expects an IOM channel */
	     call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		"This driver requires a prph statement in iod_tables.");
	     return;				/* back to iodd_ */
	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 spool driver.");
	     return;
	end;

	if iodd_static.ctl_term.attached then do;	/* can't use a control terminal */
	     call iodd_msg_ (error, master, error_table_$fatal_error, whoami,
		"The spool driver cannot run with a control terminal.");
	     return;
	end;

	if ^iodd_static.test_entry then spool_static_$debug = 0;
						/* reset if not testing */

	spool_static_$norestart = 0;
	spool_static_$file_attch = 0;
	spool_static_$tally_printed = 0;

	iodd_static.device_dim = "spooldim_";		/* the only dim used by this driver */

	iodd_static.dev_io_stream, stream = "printer_output";
						/* record the stream name */
	p -> driver_status.dev_out_stream = stream;
	iodd_static.dev_in_stream = "Undefined_stream";	/* just to avoid un-initialized variables */

	call ios_$attach (stream, iodd_static.device_dim, iodd_static.attach_name, "", io_stat);
	if st.code ^= 0 then do;
	     call iodd_msg_ (error, master, st.code, whoami, "Unable to attach spooldim_ to ^a",
		iodd_static.attach_name);
	     return;
	end;

	call ios_$order (stream, "get_info_ptr", addr (spooling_data), io_stat);
	if st.code ^= 0 then do;
	     call iodd_msg_ (error, master, st.code, whoami, "Unable to get ptr to spooling_info.");
	     go to clean_out;
	end;

	static_sip, sip = spooling_data.siptr;		/* get the ptr once and for all */

	if spooling_info.version ^= spooling_info_version_4 then do;
	     call iodd_msg_ (error, master, 0, whoami, "Fatal error: Wrong version of spooling info structure.");
	     go to clean_out;
	end;


/* Get ready to clean up after a no_coord or re_init condition */

	on cleanup
	     begin;				/* they will try to transfer back to iodd_ by go to */
		if spool_static_$debug = 1 then call ioa_ ("spool_driver_: cleanup.");
		if spool_static_$tally_printed = 0 then call ios_$order (stream, "print_tally", null, io_stat);
		call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat);
	     end;


	call iox_$find_iocb (p -> driver_status.dev_out_stream, p -> 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;

	string (prt_ctl.flags) = ""b;			/* insure any unimplemented flags are off */

	if p -> driver_status.rqti_ptr ^= null then do;	/* if there is an rqti seg, use it */

	     prt_rqtip = p -> 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 special 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.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 = 132;		/* assume the non-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.no_auto_print = "0"b;		/* print without requesting operator attn */
	     prt_ctl.banner_type = 1;			/* use normal head/tail sheets */
	     prt_ctl.banner_bars = 0;			/* means nothing for now */
	     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 ios_$order (p -> driver_status.dev_out_stream, "channel_stops", addr (prt_ctl.channel_stops), io_stat);
	if st.code ^= 0 then do;
	     call iodd_msg_ (error, master, st.code, whoami, "Fatal error: Unable to perform channel_stops order.");
	     go to clean_out;			/* fatal error */
	end;

	call get_spooling_data_$initial (sip, opt, ec);
	if opt = "det" | ec ^= 0 then do;		/* actually both tests are the same */
	     call iodd_msg_ (normal, master, 0, "", "The spool driver is terminating.");
	     go to clean_out;
	end;

	p -> driver_status.attached = "1"b;
	p -> driver_status.ready = "1"b;
	p -> driver_status.busy = "0"b;
	p -> driver_status.request_pending = (36)"0"b;
	p -> driver_status.elem_size = 9;		/* output is in characters - 9 bits each */
	p -> driver_status.message_type = 1;		/* we only want dprint requests */
	p -> driver_status.bit_rate_est = 0;		/* no rate defined yet */
	p -> driver_status.defer_time_limit = 0;	/* make operator specify */

	iodd_static.slave_hold = "1"b;		/* ask for a command */

	nl_vt_ff = NL || VT || FF;			/* vert carriage control */
	space_ht_bs = SP || HT || BS;			/* horiz carriage control */

	if prt_ctl.phys_line_length > 132 then		/* this is probably an error */
	     call iodd_msg_ (error, master, 0, "",
		"^/Warning: Current line length is ^d.  The target device may only allow 132.",
		prt_ctl.phys_line_length);

	call date_time_ (clock (), date_string);	/* get set for ready message */
	call iodd_msg_ (normal, both, 0, "", "^/Spool driver ready at ^16a^/", date_string);

	call iodd_listen_ (stat_p);

clean_out:
	call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat);
	return;

/**/

/* This entry is called by iodd_listen_ when a request for the spool driver has been received from the coordinator
   Validation is done here for correct and expected dprint request format.  This module calls output_request_, giving it
   the element size and stream name to use, and output_request_ checks user's access to data.  The stream to be used was
   set for this driver module in the init entry.  The print_banner argument to output_request_ defines the procedure that
   must be called before and after each dprint request is processed (each copy) to open or close the file on the ANSI tape
*/

request:
     entry ();

          p = iodd_static.driver_ptr;			/* make it general although it will always be the same */
	p2 = addr (p -> driver_status.descriptor);
	dmp = addr (p -> driver_status.message);	/* get ptr to message */
	prt_ctl_ptr = p -> driver_status.dev_ctl_ptr;	/* get current ctl structure */

	no_restart_label = kill_driver;		/* in case of error from higher block */

	if spool_static_$norestart = 1 then do;		/* something bad happened */
kill_driver:
	     call iodd_msg_ (error, master, 0, "", "Spool driver is logging out.");
	     iodd_static.current_devices = 0;		/* disable the go cmd */
	     iodd_static.runout_requests = "1"b;
	     iodd_static.logout_pending = "1"b;		/* ready for auto logout */
	     p -> driver_status.attached = "0"b;	/* disable the ready cmd */
	     p -> driver_status.ready = "0"b;		/* don't ask for another request */
	     iodd_static.step = "0"b;			/* disable step mode */
	     iodd_static.master_hold = "0"b;
	     iodd_static.slave_hold = "0"b;
	     return;
	end;

	if dmp -> queue_msg_hdr.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 dmp -> queue_msg_hdr.message_type ^= p -> driver_status.message_type then do;
	     call iodd_msg_ (log, both, 0, "",		/* log the error */
		"Incorrect message type for this driver.^/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,
		dmp -> queue_msg_hdr.ename);
	     p2 -> request_descriptor.cancelled = "1"b;	/* don't want this 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_3 & dprint_msg.version ^= dprint_msg_version_4
	     & dprint_msg.version ^= dprint_msg_version_5 then do;
						/* other trouble? */
	     call iodd_msg_ (log, 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,
		dmp -> queue_msg_hdr.ename);
	     p2 -> request_descriptor.keep_in_queue = "1"b;
	     go to be_nice;
	end;
	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,
		dmp -> queue_msg_hdr.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 output_request_ (stream, p -> driver_status.elem_size, stat_p, print_banner, rcode);
	if rcode ^= 0 then iodd_static.slave_hold = "1"b; /* ask for a command */

	if spool_static_$norestart = 1 then go to kill_driver;
						/* in case something happened */


/* Now check the limits */

	sip = static_sip;				/* set the auto ref ptr */

	if sip -> spooling_info.line_limit ^= 0 then do;
	     if sip -> spooling_info.spooling_line_count >= sip -> spooling_info.line_limit then
		sip -> spooling_info.spool_line_limit_sw = 1;
	end;
	if sip -> spooling_info.file_limit ^= 0 then do;
	     if sip -> spooling_info.spooling_file_count >= sip -> spooling_info.file_limit then
		sip -> spooling_info.spool_file_limit_sw = 1;
	end;

	opt = "";					/* clear the operator option string */

	if sip -> spooling_info.spool_file_limit_sw = 1 | sip -> spooling_info.spool_line_limit_sw = 1 then
	     call get_spooling_data_$renew_limits (sip, opt, ec);


/* Now close the file according to operators instructions */

	if opt = "det" then do;
	     call ios_$detach (stream, "", "", io_stat);
	     go to kill_driver;			/* drop this for ever */
	end;

	return;

/**/

print_banner:
     entry (a_stream, banner_type, data_ptr, code);

dcl  a_stream char (*);				/* stream to write banners on. we can ignore it here */
						/* because it is equal to "stream" from output_request_ call */

dcl  banner_type fixed bin;				/* banner_type of banner to be written  */
						/* 1 = header 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 */
dcl  error_msg char (256) var based (data_ptr);

	p = iodd_static.driver_ptr;			/* get driver_status pointer */
	prt_ctl_ptr = p -> driver_status.dev_ctl_ptr;	/* and control structure */
	dmp = addr (p -> driver_status.message);	/* get pointer to message */
	ordatap = data_ptr;				/* set default ptr for output_request_data */

	if spool_static_$norestart = 1 then		/* got to stop */
	     go to no_restart_label;			/* make it a clean kill! */

	on command_question
	     begin;				/* handles tape_ansi_ querries */
		sip = static_sip;
		call spooling_question_handler_ (sip, ec);
						/* answer the question */
		if ec ^= 0 then do;
		     call iodd_msg_ (error, master, ec, whoami, "Unrecoverable error, reinit the driver.");
		     iodd_static.master_hold = "1"b;
		     p -> driver_status.busy = "0"b;	/* try the same request again */
		     signal resume;
		end;
	     end;


/* Call to attach thru tape_ansi_, head sheet comming up */

	sip = static_sip;				/* make spooling info references easy */


	if banner_type = header then do;

/* Heading banner for printer wanted */

	     if spool_static_$file_attch = 1 then	/* check if some file attached and/or open already */
		call ios_$order (stream, "file_close", null (), io_stat);
						/* call to close ansi tape file */

	     call ios_$order (stream, "file_open", null (), io_stat);
						/* call to open ansi tape file */
	     if st.code ^= 0 then do;			/* have to terminate */
		call iodd_msg_ (error, master, st.code, whoami, "Unable to open tape file.");
		code = st.code;			/* spooling_dim_order_ has taken tape down */
		call ios_$order (stream, "print_tally", null (), io_stat);
		spool_static_$norestart = 1;		/* want driver to logout or start new fileset */
		return;
	     end;

	     spool_static_$file_attch = 1;		/* a ansi tape file attached and open */
	     if spool_static_$debug = 1 then call ioa_ ("spool_driver_: ANSI file opened.");

	     call ios_$order (stream, "reset", null (), io_stat);
						/* get modes to a known format */
	     call ios_$order (stream, "inside_page", null (), io_stat);
						/* and page position */

	     if st.code ^= 0 then do;			/* trouble trying to write: give up */
		code = st.code;
		call ios_$order (stream, "file_close", addr (demount_tape), io_stat);
						/* close and drop tape */
		spool_static_$norestart = 1;
		return;
	     end;

	     call head_sheet_$print_head_sheet (p -> driver_status.dev_out_iocbp, prt_ctl_ptr, data_ptr, code);

	     call ios_$order (stream, "get_count", addr (counts_data), io_stat);
						/* get count of lines for spooling tallies */
	     sip -> spooling_info.spooling_line_count =
		sip -> spooling_info.spooling_line_count + counts_data.line_count;
						/* line count for head sheet */

	     call ios_$order (stream, "end_of_page", null (), io_stat);
						/* get ready for user data */
	     call ios_$order (stream, "reset", null (), io_stat);
						/* don't charge for advertizing */

	     call set_line_mode;			/* set indentation and line length before the first label */
	     call set_page_labels (stream, ec);

	     call ios_$write (stream, addr (FF), 0, 1, i, io_stat);
						/* start a fresh page and print any labels */

	     call set_user_output_modes;		/* only now can we set the page length */
	     return;
	end;


	if banner_type = trailer then do;

/* A tail sheet 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 */

	     call ios_$order (stream, "get_count", addr (counts_data), io_stat);
						/* save request line count */
	     sip -> spooling_info.spooling_line_count =
		sip -> spooling_info.spooling_line_count + counts_data.line_count;

	     call ios_$order (stream, "end_of_page", null (), io_stat);
						/* used to be bottom inside page  */
	     call ios_$order (stream, "reset", null (), io_stat);
						/* Don't use user's modes for tailsheet */
	     call ios_$order (stream, "outside_page", null (), io_stat);
						/* top outside page for tail sheet */

	     call tail_sheet_$print_tail_sheet (p -> driver_status.dev_out_iocbp, prt_ctl_ptr, data_ptr, code);

	     call ios_$order (stream, "get_count", addr (counts_data), io_stat);

	     sip -> spooling_info.spooling_line_count =
		sip -> spooling_info.spooling_line_count + counts_data.line_count;

	     sip -> spooling_info.spooling_file_count = sip -> spooling_info.spooling_file_count + 1;

	     call ios_$order (stream, "file_close", null (), io_stat);

	     if spool_static_$debug = 1 then call ioa_ ("spool_driver_: tape file closed.");
	     spool_static_$file_attch = 0;		/* turn off file open indicator */
	     return;
	end;


	if banner_type = err_msg then do;

/* Put out an error message */

	     call ios_$changemode (stream, "default", omode, io_stat);
						/* use known modes for errors */
	     call ios_$write (stream, data_ptr, 4, length (error_msg), net, io_stat);
						/* skip the first 4 chars(length) */
	     call ios_$changemode (stream, omode, "", io_stat);
						/* put it back for more output */
	     code = 0;				/* don't cause trouble during recovery */
	     return;
	end;


/* All other banner types are undefined */

	code = error_table_$action_not_performed;

	return;

/**/

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);
dcl  value char (32);				/* temporary char string */


	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 */
	p = iodd_static.driver_ptr;			/* make this ready for command use */
	prt_ctl_ptr = p -> driver_status.dev_ctl_ptr;
	c_code, ec = 0;				/* say we handled it for now */


	if command = "help" then do;
	     call iodd_msg_ (normal, source, 0, "", "^/** Commands for the spool 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, autoprint)");
	     call iodd_msg_ (normal, source, 0, "", "sample_hs [<minor_dev>]");
	     call iodd_msg_ (normal, source, 0, "", "single");
	     if test_entry then call iodd_msg_ (normal, source, 0, "", "time [<sleep_time>]");
	     call iodd_msg_ (normal, source, 0, "", "debug_on");
	     call iodd_msg_ (normal, source, 0, "", "debug_off");
	     go to end_cmd;
	end;

	if command = "debug_on" then do;
	     if ^iodd_static.test_entry then go to cmd_error;
	     spool_static_$debug = 1;
	     go to end_cmd;
	end;

	if command = "debug_off" then do;
	     if ^iodd_static.test_entry then go to cmd_error;
	     spool_static_$debug = 0;
	     go to end_cmd;
	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 p -> 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 = 0 then opr_msg = "double";
		else if prt_ctl.banner_bars = 1 then opr_msg = "single";
		else if prt_ctl.banner_bars = 2 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 = 0;
	     else if arg (i) = "single" then prt_ctl.banner_bars = 1;
	     else if arg (i) = "none" then prt_ctl.banner_bars = 2;
	     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 = "banner_type" | command = "bannertype" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if p -> 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 = 0 then opr_msg = "none";
		else if prt_ctl.banner_type = 1 then opr_msg = "standard";
		else if prt_ctl.banner_type = 2 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 = 1;
	     else if arg (i) = "none" then prt_ctl.banner_type = 0;
	     else if arg (i) = "brief" then prt_ctl.banner_type = 2;
	     else do;
		call iodd_msg_ (normal, source, 0, "", "Banner type ^a is not defined.");
		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 (p -> driver_status.dev_out_stream, "single.", omode, io_stat);
						/* set mode */
		call output_request_$set_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 p -> 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 = "prt_control" | command = "prtcontrol" then do;
	     if arg_list.n_tokens > 1 then		/* some arg given */
		if p -> 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",
		     ^prt_ctl.force_nep, ^prt_ctl.force_esc);
	     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 call iodd_msg_ (normal, source, 0, "", "Undefined argument: ^a", arg (i));
		end;
	     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 p -> 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 spool_static_$file_attch = 1 then	/* check if some file attached and/or open already */
		call ios_$order (stream, "file_close", null (), io_stat);
						/* call to close ansi tape file */

	     call ios_$order (stream, "file_open", null (), io_stat);
						/* call to open ansi tape file */
	     if st.code ^= 0 then do;			/* have to terminate */
		call iodd_msg_ (error, master, st.code, whoami, "Unable to open tape file.");
		go to cmd_error;
	     end;
	     spool_static_$file_attch = 1;		/* a ansi tape file attached and open */

	     call ios_$order (p -> driver_status.dev_out_stream, "reset", null, io_stat);
						/* clear everything */
	     call ios_$order (p -> driver_status.dev_out_stream, "inside_page", null, io_stat);

	     call write_sample_prt_banner_ ("head_sheet", p -> driver_status.dev_out_iocbp, prt_ctl_ptr, ec);

	     call ios_$order (p -> driver_status.dev_out_stream, "end_of_page", null, io_stat);
	     call ios_$order (p -> driver_status.dev_out_stream, "runout", null, io_stat);
						/* be sure it prints */

	     call ios_$order (stream, "file_close", null, io_stat);
	     spool_static_$file_attch = 0;

	     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;

/**/

default_handler:
     entry (cond_ptr);

dcl  cond_ptr ptr;					/* pointer to the condition info structure */

dcl  condition char (32);				/* fixed string for the call */

dcl  1 cond_info aligned based (cond_ptr),		/* this is the level one declaration */
%include cond_info;

	condition = condition_name;

	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.... */

/**/

set_user_output_modes:
     procedure ();

dcl  nm char (128) var;
dcl  om char (128) aligned;
dcl  i fixed bin;
dcl  v char (12) var;

	nm = rtrim (ordata.output_mode);		/* zero length if blank */
	if length (nm) > 0 then nm = nm || ",";		/* separate from new modes */
	if dprint_msg.esc | prt_ctl.force_esc then nm = nm || "esc,";
	if dprint_msg.control.nep | prt_ctl.force_nep then nm = nm || "noskip,";
	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;
	     v = convert_binary_integer_$decimal_string (dprint_msg.page_lth);
	     nm = nm || "pl" || v || ",";
	end;
	i = length (nm);
	if i > 0 then do;
	     ordata.output_mode = nm;			/* save and put in fixed string */
	     substr (ordata.output_mode, i, 1) = " ";
	     call ios_$changemode (stream, ordata.output_mode, om, io_stat);
	     if st.code ^= 0 then ordata.output_mode = "";/* record mode only if set */
	end;

	return;


set_line_mode:
     entry;

	ordata.output_mode, nm = "";			/* clear the string */
	if dprint_msg.line_lth > 1 then do;
	     v = convert_binary_integer_$decimal_string (dprint_msg.line_lth);
	     nm = nm || "ll" || v || ",";
	end;
	if dprint_msg.lmargin > 1 then do;
	     v = convert_binary_integer_$decimal_string (dprint_msg.lmargin);
	     nm = nm || "in" || v || ",";
	end;
	i = length (nm);
	if i > 0 then do;
	     ordata.output_mode = nm;			/* save and put in fixed string */
	     substr (ordata.output_mode, i, 1) = " ";	/* make the end of the string clean */
	     call ios_$changemode (stream, ordata.output_mode, om, io_stat);
	     if st.code ^= 0 then ordata.output_mode = "";/* record mode only if set */
	end;

     end set_user_output_modes;

/**/

/* Establish top and bottom page label printing on the stream */

set_page_labels:
     procedure (stream, ec);

dcl  stream char (*) aligned;				/* stream to order labels on */
dcl  ec fixed bin (35);				/* error code ... for the future */
dcl  temp_label char (136);				/* temporary for cleaning the label */
dcl  translate builtin;
dcl  1 page_labels aligned,				/* structure for the order call */
       2 top_label char (136),
       2 bottom_label char (136);
dcl  len fixed bin;
dcl  ind fixed bin;
dcl  field fixed bin;				/* print field for centering */
dcl  set_labels bit (1);				/* will be set if there are labels */

	ec = 0;					/* start clean */
	set_labels = "0"b;

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

	if dprint_msg.line_lth < 1 then
	     field = prt_ctl.phys_line_length;		/* check printable field */
	else field = dprint_msg.line_lth;		/* believe what user asked for */

	if dprint_msg.lmargin > 0 then do;
	     field = field - dprint_msg.lmargin;	/* shorten by indentation */
	     ind = dprint_msg.lmargin;
	end;
	else ind = 1;				/* be sure we start in col 1 */

	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_labels = "1"b;			/* we will have to make the order call */
	     len = length (temp_label) + 1 - verify (reverse (temp_label), " ");
						/* how long is  the label */
	     if (field > len) & dprint_msg.control.center_top_label then do;
		len = divide (field - len, 2, 17, 0) + ind;
						/* calculate the starting position */
		substr (page_labels.top_label, len) = temp_label;
						/* drop it in the right position */
	     end;
	     else page_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_labels = "1"b;
	     len = length (temp_label) + 1 - verify (reverse (temp_label), " ");
	     if (field > len) & dprint_msg.control.center_bottom_label then do;
		len = divide (field - len, 2, 17, 0) + ind;
		substr (page_labels.bottom_label, len) = temp_label;
	     end;
	     else page_labels.bottom_label = temp_label;
	end;
	if set_labels then do;			/* only make the call if we need to */
	     call ios_$order (stream, "page_labels", addr (page_labels), io_stat);
	     ec = st.code;				/* for the future */
	end;

	return;

     end set_page_labels;

/**/

set_paper_info:
     procedure (source, code);

dcl  code fixed bin (35);
dcl  source fixed bin;

	code = 0;

	call ios_$order (p -> driver_status.dev_out_stream, "paper_info", addr (prt_ctl.paper_info), io_stat);
	if st.code ^= 0 then do;
	     call iodd_msg_ (normal, source, st.code, whoami, "Unable to perform paper_info order.");
	     code = st.code;
	     return;
	end;

	call iodd_msg_ (normal, source, 0, "",
	     "^/Tape will be formatted for ^d lines per physical page, at ^d lines/inch.^/", prt_ctl.phys_page_length,
	     prt_ctl.lines_per_inch);

	return;

     end set_paper_info;
%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 mseg_message_info;
%page; %include output_request_data;
%page; %include prt_ctl;
%page; %include prt_order_info;
%page; %include prt_rqti;
%page; %include queue_msg_hdr;
%page; %include request_descriptor;
%page; %include spooling_info;

     end spool_driver_;



		    spool_static_.alm               11/15/82  1903.3rew 11/15/82  1535.1        9720


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

	" Setup static storage for  Spooler
	"
	" Written 4/8/75  for the Spooling Facility
	"

	name 	spool_static_

	use 	foo	" specify location counter
	join	/link/foo	" stash vars in linkage

	segdef  	file_attch
	segdef 	norestart
	segdef 	tally_printed
          segdef    debug
	segdef	info_ptr

	file_attch:	vfd 36/0  "file open somewhere indicator
	norestart:	vfd 36/0  "dont restart spooling indicator
	tally_printed:	vfd 36/0  "already printed spooling tallies once
          debug:              vfd 36/0  "in debug mode, please.
	info_ptr:		vfd 72/0	"ptr to spooling_info

	end



		    spooldim_.alm                   11/15/82  1903.3rew 11/15/82  1535.1       12033


" ***********************************************************
" *                                                         *
" * 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 spooling_dim outer module.

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

	tra	<spooling_dim_xtatch_>|[attach]
	tra	<spooling_dim_xtatch_>|[detach]
	tra	<ios_>|[no_entry]	"read
	tra	<spooling_dim_write_>|[spooling_dim_write_]
	tra	<ios_>|[no_entry]	"abort
	tra	<spooling_dim_order_>|[spooling_dim_order_]
	tra	<ios_>|[no_entry]	"resetread
	tra	<ios_>|[no_entry]	"resetwrite
	tra	<ios_>|[no_entry]	"setsize
	tra	<ios_>|[no_entry]	"getsize (it's 9 tho)
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<ios_>|[no_entry]
	tra	<prtdim_>|[prtdim_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
   



		    spooling_dim_order_.pl1         02/02/88  1703.1r w 02/02/88  1541.5       47736


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


spooling_dim_order_: proc (a_sdbp, request, orderp, status);

/* SPOOLING_DIM_ORDER_ -- handles spooling DIM order calls.
   0)  Created 12/5/75 by Janice B. Phillipps
   1)  Updated 7/21/75  by J.Phillipps for label processing of new printer dim.
   2) Modified 1/31/78 by J. C. Whitmore to merge spool dim and printer dim order procs.
*/


%include status;
%include prt_sdb;
%include prt_info;
%include spooling_info;
%include prt_conv_info;
%include prt_order_info;


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

dcl  command_question condition;

dcl  a_sdbp ptr,
     constant fixed bin init (1),
     code fixed bin (35),
     retain_code fixed bin,
     opt char (3) init (""),
     request char (*),				/* order request */
     statp ptr,
     status bit (72) aligned;				/* IOS status bits */

dcl  demount_code fixed bin based (orderp);

dcl 1 spooling_data based (orderp) aligned,		/* structure used in the "get line length" call */
    2 siptr ptr,					/* ptr to info structure */
    2 line_length fixed bin;

dcl  spool_static_$tally_printed fixed bin ext;		/* turned on when print spool tallies */

dcl  error_table_$dev_nt_assnd fixed bin (35) ext;
dcl  error_table_$not_open fixed bin (35) ext;
dcl  error_table_$bad_arg fixed bin (35) ext;
dcl  error_table_$uninitialized_volume fixed bin (35) ext;
dcl  error_table_$no_file fixed bin (35) ext;
dcl  error_table_$not_attached fixed bin (35) ext;


dcl  file_monitor_$attach entry (ptr, char (*) aligned, fixed bin, fixed bin (35));
dcl  file_monitor_$cleanup entry (ptr, char (*) aligned, fixed bin (35));
dcl  file_monitor_$detach entry (ptr, fixed bin, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  prtdim_$prtdim_changemode entry (ptr, char (*), char (*), bit (72) aligned);
dcl  prtdim_$prtdim_order entry (ptr, char (*), ptr, bit (72) aligned);
dcl  spooling_question_handler_ entry (ptr, fixed bin (35));

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

	status = (72)"0"b;				/* Clear status bits. */
	sdb_ptr = a_sdbp;
	statp = addr (status);
	statp -> stat.ios.bit41_trans_term = "1"b;	/* Set transaction terminated bit. */
	sip = addr (sdb.spool_info);			/* ptr to spool_info structure */
	pcip = addr (sdb.conv_info);			/* Get pointer to print conversion info. */
	code = 0;

	on command_question call spooling_question_handler_ (sip, code);

	if request = "runout" then return;		/* just a formality for this mod */

	else if request = "resetwrite" then return;	/* again a formality, keep from prtdim_order */

	else if request = "paper_info" then do;		/* Set new physical paper characteristics. */
	     if paper_info.lines_per_inch ^= 6 &	/* Check for either 6 lpi or 8 lpi. */
	     paper_info.lines_per_inch ^= 8 then do;
bad_arg:		substr (status, 1, 36) = unspec (error_table_$bad_arg);
		return;
	     end;
	     if paper_info.phys_page_length < 10 | paper_info.phys_page_length > 127 then go to bad_arg;
	     if paper_info.phys_line_length < 10 | paper_info.phys_line_length > 255 then go to bad_arg;

	     pci.phys_page_length = paper_info.phys_page_length;
	     pci.phys_line_length = paper_info.phys_line_length;
	     pci.lpi = paper_info.lines_per_inch;
	     spooling_info.phys_page_length = pci.phys_page_length;
	     spooling_info.phys_line_length = pci.phys_line_length;

	     call prtdim_$prtdim_changemode (sdb_ptr, "", (""), status); /* make modes conform */
	end;

	else if request = "file_open" then do;		/* request to open file thru tape_ansi_ IO Module */
	     call file_monitor_$attach (sip, "", 0, code); /* call to attach and open tape file */
	     if code ^= 0 then do;
		call file_monitor_$cleanup (sip, "", code);
		stat.fbpart = error_table_$dev_nt_assnd;
	     end;
	end;

	else if request = "demount_tape" then do;	/* request to demount tape thru tape_ansi_ IO Module */
	     call file_monitor_$cleanup (sip, "", code);
	     statp -> stat.fbpart = code;
	end;

	else if request = "file_close" then do;
	     if orderp = null then retain_code = 0;	/* no demount unless asked */
	     else retain_code = demount_code;

	     call file_monitor_$detach (sip, retain_code, code); /* close and detach file */
	     statp -> stat.fbpart = code;
	end;

	else if request = "print_tally" then do;
	     call ioa_ ("^/^-Spooling file count is ^d", spooling_info.spooling_file_count);
	     call ioa_ ("^-Spooling line count is ^d^/", spooling_info.spooling_line_count);
	     spool_static_$tally_printed = 1;
	end;

	else if request = "get_info_ptr" then do;
	     spooling_data.siptr = sip;		/* set ptr to info structure */
	end;


	else do;					/* otherwise pass on the order to prtdim_ */
	     call prtdim_$prtdim_order (sdb_ptr, request, orderp, status);
	end;

	return;

     end spooling_dim_order_;



		    spooling_dim_write_.pl1         02/02/88  1703.1r w 02/02/88  1541.5       54189


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


spooling_dim_write_: proc (a_sdbp, wkspptr, offset, nelem, nelemt, status);

/* SPOOLING_DIM_WRITE_ -- called each time a dprint request is to be spooled out onto tape.
   The spooling tape is written via the tape_ansi_ IO Module.
   0)  Created 12/4/74 by Janice B. Phillipps
   1)  Updated for new prtdim_ and new IO Driver design 7/21/75 by J.Phillipps.
   2) Modified 1/31/78 by J. C. Whitmore for prtdim-spoolingdim merge.
*/

%include prt_sdb;
%include prt_info;
%include spooling_info;
%include prt_conv_info;
%include status;

dcl (addr, substr, null) builtin;

dcl (command_question, quit) condition;

dcl  a_sdbp ptr,
     bp ptr,					/* ptr to buffer of converted output (from prt_conv_) */
     buf_len21 fixed bin (21),
     char_cnt fixed bin (18),				/* count of characters in output */
     code fixed bin (35),
     inp ptr,					/* ptr to of input for ptr_conv. Bit offset keeps track of pos */
     iocbp ptr,					/* ptr to ansi dim control block */
     lnth fixed bin (18),				/* length of input from output_request */
     nelem fixed bin,
     nelemt fixed bin,
     offset fixed bin,
     offst fixed bin,
     statp ptr,					/* ptr to status string */
     status bit (72) aligned,
     wkspptr ptr;

dcl  wksp char (1) based unal;			/* used for getting pointer to input string */

dcl  spool_static_$norestart fixed bin ext;		/* ext switch set when spooling is to terminate */
dcl  spool_static_$file_attch fixed bin ext;
dcl  spool_static_$debug fixed bin ext;

dcl  error_table_$tape_error fixed bin (35) ext;
dcl  error_table_$fatal_error fixed bin (35) ext;
dcl  error_table_$no_operation fixed bin (35) ext;
dcl  error_table_$eov_on_write fixed bin (35) ext;
dcl  error_table_$not_open fixed bin (35) ext;
dcl  error_table_$dev_nt_assnd fixed bin (35) ext;
dcl  error_table_$device_end fixed bin (35) ext;


dcl  com_err_ entry options (variable);
dcl  ioa_ entry options (variable);
dcl  iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  prt_conv_ entry (ptr, fixed bin (18), ptr, fixed bin (18), ptr);
dcl  spooling_dim_order_ entry (ptr, char (*) aligned, ptr, bit (72) aligned);
dcl  spooling_question_handler_ entry (ptr, fixed bin (35));


/* - - - - - - - - - - - - - - - - - - - - -  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  - - - */
	sdb_ptr = a_sdbp;				/* ptr to stream data block */
	statp = addr (status);			/* ptr to overlay of ios status string */
	sip = addr (sdb.spool_info);			/* ptr to spooling control structure */
	pcip = addr (sdb.conv_info);			/* ptr to spooling conversion structure */
	status = (72)"0"b;
	code = 0;

	if spooling_info.version ^= spooling_info_version_4 then do;
	     stat.fbpart = error_table_$fatal_error;
	     return;
	end;

	on command_question begin;			/* tape_ansi_ asks a lot of questions */
	     call spooling_question_handler_ (sip, code);
	     if code ^= 0 then do;
		spool_static_$norestart = 1;		/* this will stop everything */
		if spool_static_$file_attch = 1 then
		     call ioa_ ("spooling_dim_write_: Last print request may not be fully processed.");
		stat.fbpart = error_table_$device_end;
		go to finish;
	     end;
	end;

	lnth = nelem;				/* length of a line of current request  */
	char_cnt = 0;				/* length of spooled line returned from prt_conv_ */
	offst = offset;				/* offset from input ptr */
	inp = addr (substr (wkspptr -> wksp, offset + 1, 1)); /* ptr to line to write */
	nelemt = 0;				/* initial number of elements returned is zero */

	iocbp = sip -> spooling_info.iocbp;		/* io control block ptr */
	if iocbp = null | spooling_info.vol_mount = "0"b then do;
	     stat.fbpart = error_table_$dev_nt_assnd;
	     return;
	end;
	bp = sdb_ptr -> sdb.buffer_ptr;		/* ptr to output buffer */

	if spool_static_$norestart = 1 then do;
	     stat.fbpart = error_table_$device_end;
	     return;
	end;

/* Now code convert user's dprint request line by line */

	do while (lnth > 0);			/* loop until all elements transmitted */
	     call prt_conv_ (inp, lnth, (bp), char_cnt, pcip); /* do code conversion */
	     nelemt = nelem - lnth;			/* undate number of chars transmitted */
	     buf_len21 = char_cnt;

	     call iox_$write_record (iocbp, bp, buf_len21, code); /* call to put line out on tape */
	     if code ^= 0 then do;			/* process errors */
		if code = error_table_$no_operation then do; /* tape put up without ring */
		     spool_static_$norestart = 1;	/* thats all this time */
		     if spool_static_$debug = 1 then
			call ioa_ ("spooling_dim_write_: tape mounted without ring and trying to write.");
		     stat.fbpart = code;
		end;
		else if code = error_table_$tape_error then do; /* unrecoverable error */
		     call spooling_dim_order_ (sdb_ptr, "demount_tape", null (), status);
		     spool_static_$norestart = 1;
		     stat.fbpart = error_table_$dev_nt_assnd;
		end;
		else do;
		     stat.fbpart = code;
		     if code = error_table_$not_open then
			call ioa_ ("Trying to write when file not open.");
		     else if code = error_table_$eov_on_write then /* hit end of tape */
			call ioa_ ("Hit end of tape mark while writing.");
		     else do;
			call com_err_ (code, "spooling_dim_write_", "error writing file: detaching current file.");
			call spooling_dim_order_ (sdb_ptr, "file_close", null (), status); /* close and detach file */
		     end;
		end;
		go to finish;
	     end;
	end;

finish:	sdb.chars_printed = sdb.chars_printed + nelem - lnth; /* bump the total count */

	return;


     end spooling_dim_write_;
   



		    spooling_dim_xtatch_.pl1        02/02/88  1703.1r w 02/02/88  1541.5       60669


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


/* SPOOLING_DIM_XTATCH_ -- handles the attach and detach functions for Multics Spooling IO Module.
   0) Created by Janice B. Phillipps 11/1/74.
   1) Updated 7/10/75 by J.Phillipps for new IO driver design.
   2) Modified 1/25/78 by J. C. Whitmore for new printer features and printer dim integration
*/
spooling_dim_xtatch_: proc;

%include status;
%include prt_sdb;
%include prt_conv_info;
%include prt_info;
%include spooling_info;

dcl (addr, null, length, rtrim, string) builtin;

dcl  code fixed bin (35),
     ioname char (*),				/* parameter (input) - stream attached */
     ioname2 char (*),				/* parameter (input) - printer name */
     mode char (*),					/* parameter (input) - attachment mode */
     device char (32),				/* temp for device name */
     status bit (72) aligned,				/* parameter (output) - status return */
     type char (*) aligned;				/* parameter (input) - dim name */

dcl  listen_area area ((16374)) based (areap),
     areap ptr;

dcl  data_buf char (164) aligned based;			/* output buffer for write entry */

dcl  spool_conv_$spool_conv_ ext;
dcl  spool_static_$tally_printed fixed bin ext;		/* tally printing flag initial zero */
dcl  spool_static_$debug fixed bin ext;
dcl  spool_static_$file_attch fixed bin ext;
dcl  spool_static_$norestart fixed bin ext;

dcl  error_table_$no_room_for_dsb ext fixed bin (35);
dcl  error_table_$ionmat fixed bin (35) ext;


dcl  file_monitor_$cleanup entry (ptr, char (*), fixed bin (35));
dcl  get_spooling_data_$initial entry (ptr, char (*) aligned, fixed bin (35));
dcl  get_system_free_area_ entry (ptr);
dcl  spooling_dim_order_ entry (ptr, char (*) aligned, ptr, bit (72) aligned);


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
attach:	entry (ioname, type, ioname2, mode, status, sdb_ptr);


	status = (72)"0"b;				/* clear return ios status */
	if sdb_ptr ^= null () then do;
	     stat.fbpart = error_table_$ionmat;		/* if multiple attachment return code */
	     go to exit;
	end;

	call get_system_free_area_ (areap);		/* get ptr to area in listen_ before alloc */
	allocate sdb in (listen_area) set (sdb_ptr);	/* create stream data block */
	if sdb_ptr = null then do;
no_dsb:	     stat.fbpart = error_table_$no_room_for_dsb;	/* woops. */
	     go to exit;
	end;
	sdb.buffer_ptr = null;
	allocate data_buf in (listen_area) set (sdb.buffer_ptr);
	if sdb.buffer_ptr = null then do;
	     free sdb in (listen_area);		/* we have to have both, else no attach */
	     go to no_dsb;				/* drop it */
	end;

	sdb.buffer_ptr -> data_buf = "";		/* initialize to blank chars */

/* Fill in stream data block  */

	device = ioname2;				/* see what we are to attach to */
	if device = "" then device = "tape_spool_out";	/* be sure we have a name */

	sdb.areap = areap;				/* save ptr to free area */
	sdb.outer_module_name = "spooldim_";		/* name of this IO module */
	sdb.device_name_list_ptr = addr (sdb.device_name); /* set ptr */
	sdb.next_device_ptr = null;			/* only one device allowed */
	sdb.stream_name = ioname;			/* name of this attachment */
	sdb.device_name.name = device;		/* put attached device name in  sdb */
	sdb.name_size = length (rtrim (sdb.device_name.name));

	sip = addr (sdb.spool_info);			/* get ptr to spooling info data base */

/*	initialize the structure as was done by initial attributes before 1/25/78 */

	spooling_info.version = spooling_info_version_4;	/* the current version */
	spooling_info.switch_name = sdb.device_name.name; /* device is the switch attached to tape_ansi_ */
	spooling_info.iocbp = null;			/* the switch is not attached yet */
	string (spooling_info.flgs) = ""b;
	spooling_info.flgs.fst_call = "1"b;		/* mark as the first attachment */

	spooling_info.flgs.io_sw = "1"b;		/* mount tape with write ring */
	spooling_info.filesetid = "";			/* no previous ANSI file-set being processed */
	spooling_info.filenumber = 0;
	spooling_info.spooling_line_count = 0;
	spooling_info.spooling_file_count = 0;
	spooling_info.phys_line_length = 132;		/* this is the default for the spooling dim */
	spooling_info.phys_page_length = 66;		/* assume 11 inch paper at 6 lpi */

	pcip = addr (sdb.conv_info);			/* get ptr to code conversion info */

/* Fill in conversion info -- to be used by prt_conv_ and spool_conv_ */

	pci.cv_proc = addr (spool_conv_$spool_conv_);	/* formatting output proc */
	pci.phys_line_length = spooling_info.phys_line_length; /* sets wrapping column */
	pci.phys_page_length = spooling_info.phys_page_length;
	pci.lpi = 6;				/* the default lines per inch value */
	pci.level = 0;				/* overstrike level */
	pci.pos = 0;				/* print position at end of incomplete line */
	pci.line = 1;				/* current line number */
	pci.slew_residue = 0;			/* number of lines remaining to be slewed */
	pci.label_wksp = null ();			/* pointer to label being processed */
	pci.label_nelem = 0;			/* characters remaining in label */
	pci.sav_pos = 0;				/* position saved during label processing */
	pci.esc_state = 0;
	pci.esc_num = 0;
	pci.temp = "0"b;				/* conversion proc temporary */

	call spooling_dim_order_ (sdb_ptr, "reset", null, status); /* initialize prt_conv_ info */

	return;


detach:	entry (sdb_ptr, ioname2, mode, status);

	status = (72)"0"b;				/* clear return status */
	sip = addr (sdb.spool_info);			/* get ptr to spooling spool_info data base */

	if spooling_info.flgs.vol_mount then
	     call file_monitor_$cleanup (sip, "", code);	/* drop tape if it is up */

	areap = sdb.areap;				/* ptr to area */
	free sdb.buffer_ptr -> data_buf in (listen_area);
	free sdb in (listen_area);			/* free up allocated stream data block */

exit:	stat.ios.bit41_trans_term = "1"b;		/* set transaction terminated bit */
	stat.ios.bit52_ion_detached = "1"b;		/* set detach bit */


	return;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
debug_on:	entry;					/* turns debug on */

	spool_static_$debug = 1;
	return;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
debug_off: entry;					/* turns debug off */

	spool_static_$debug = 0;
	return;


     end spooling_dim_xtatch_;
   



		    spooling_question_handler_.pl1  11/15/82  1903.3rew 11/15/82  1524.5       54522


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


spooling_question_handler_: proc (a_sip, code);


/* SPOOLING_QUESTION_HANDLER_ -- Command question handler for Spooling IO Module / tape_ansi_ interface.
   Answers questions asked by ANSI tape IO Module.
   Created by J. Phillipps 1/20/75   */


dcl  a_sip ptr,
     cip ptr,
     code fixed bin (35),
     cqp ptr,
     opt char (4) aligned,
     rcode fixed bin (35),
     max_answer fixed bin,
     sp ptr,					/* ptr to stack frame when condition occ. */
     status bit (72) aligned,
     answer char (6) aligned varying;

dcl (addr, null, length) builtin;


dcl  get_spooling_data_$next_volume entry (ptr, char (*) aligned, fixed bin (35)),
     find_condition_info_ entry (ptr, ptr, fixed bin (35)),
     ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned);

dcl  error_table_$no_next_volume ext fixed bin (35),
     error_table_$uninitialized_volume ext fixed bin (35),
     error_table_$signaller_fault fixed bin (35) ext,
     error_table_$fatal_error fixed bin (35) ext,
     error_table_$file_aborted ext fixed bin (35);

dcl  spool_static_$norestart fixed bin ext;


dcl  answer_string char (max_answer) based aligned;


dcl 1 command_question_info based (cqp) aligned,
    2 length fixed bin,				/* length in words of this structure */
    2 version fixed bin init (3),			/* version number of this structure */
    2 action_flags aligned,				/* tell handler how to proceed */
      3 cant_restart bit (1) unal,			/* caller doesn't ever want to be returned to */
      3 default_restart bit (1) unal,			/* caller can be returned to with no further action */
      3 pad bit (34) unal,
    2 info_string char (256) var,			/* may contain printable message */
    2 status_code fixed bin (35),			/* if^=0, code interpretable by com_err_ */
    2 query_code fixed bin (35),
    2 question_sw bit (1) unaligned,
    2 yes_or_no_sw bit (1) unaligned,
    2 preset_sw bit (1) unaligned,
    2 answer_sw bit (1) unaligned,
    2 name_ptr ptr,
    2 name_lnth fixed bin,
    2 question_ptr ptr,
    2 question_lth fixed bin,
    2 max_question_lth fixed bin,
    2 answer_ptr ptr,
    2 answer_lth fixed bin,
    2 max_answer_lth fixed bin;


dcl 1 cond_info_ aligned,
%include cond_info;

%include spooling_info;


/*   */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
     sip = a_sip;					/* ptr to spooling control structure */
	code = 0;
	rcode = 0;

	if spooling_info.version ^= spooling_info_version_4 then do;
	     code = error_table_$fatal_error;
	     return;
	end;

	answer = "";				/* initialize answer string */
	sp = null ();				/* use most recent condition frame */
	cip = addr (cond_info_);			/* ptr to condition info structure */
	cond_info_.version = 1;
	call find_condition_info_ (sp, cip, rcode);	/* get condition info */
	cqp = cond_info_.infoptr;			/* set ptr to command_question structure */
	if cqp = null then do;
	     code = error_table_$signaller_fault;	/* bad .. cannot continue */
	     return;
	end;


	cqp -> command_question_info.preset_sw = "1"b;	/* we will give the answer */
	cqp -> command_question_info.question_sw = "0"b;	/* dont print question -- log it */
	cqp -> command_question_info.answer_sw = "0"b;	/* don't print answer */
	cqp -> command_question_info.yes_or_no_sw = "1"b; /* we answer yes or no */

	max_answer = cqp -> command_question_info.max_answer_lth; /* define answer length */

/* get_spooling_data_ types: "Reached end of volume list."
   "Enter more volids or ""detach""".
   If the operator types ""detach"" or there are no volume ids in the volume list,
   processing will be terminated. The tape_ansi_ asks the question (which is suppressed by this routine)
   "Do you want to terminate processing?"
   The variable "string" is set to yes if the operator types  detach or if the volume list remains exhausted. */

	if cqp -> command_question_info.status_code = error_table_$no_next_volume then do;
	     call get_spooling_data_$next_volume (sip, opt, rcode);
	     if rcode ^= 0 then do;
		answer = "yes";			/* will terminate processing */
		spool_static_$norestart = 1;
	     end;
	     else answer = "no";			/* dont want to terminate processing */
	     code = rcode;
	end;

	else if cqp -> command_question_info.status_code = 0 then do; /* ready to supply next volume */
	     answer = sip -> spooling_info.volids (1);	/* return volid */
	     cqp -> command_question_info.yes_or_no_sw = "0"b;
	end;

/* abort_file in tape_ansi_ types:

   "Unrecoverable error writing file lables. Do you want to delete defective file xxxxxx?"
   This routine always answers yes so as to preserve standard ANSI tape format.  */

	else if cqp -> command_question_info.status_code = error_table_$file_aborted then do;
	     answer = "yes";			/* want to delete the defective section of file set */
	     spooling_info.filenumber = spooling_info.filenumber - 1; /* set file number back one */
	end;

/* Other questions asked by tape_ansi_ are

   from initialize_permitA:
   "Volume xxxxxx requires initialization. Do you want to initialize it?"
   "Volume xxxxxx requires re-initialization, but contains an unexpired file. Do you want to re-initialize it?"

   from volume_query:
   "Do you want to overwrite the unexpired file xxxxx?"
   All of these questions are answered yes */


	else do;
	     answer = "yes";
	end;
	cqp -> command_question_info.answer_lth = length (answer);
	command_question_info.answer_ptr -> answer_string = answer;

	return;


     end spooling_question_handler_;
  



		    unspool_.pl1                    11/15/82  1903.3rew 11/15/82  1524.7       66330


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


unspool_: proc (a_sip, code);


/* UNSPOOL_ -- called each time a file is to be taken from spooling tape and formatted
   for input to the Multics printer DIM -- be printed by a PRT300 or similar printer.
   0) Created 1/5/75  by Janice B. Phillipps  as part of the Multics spooling facility.
   1) Updated by J.Phillipps 7/75 for new printer dim
   2 Modified by J. C. Whitmore 1/78 for new printer features and prtdim/spooldim merge
*/

%include spooling_info;
%include status;


dcl  command_question condition;
dcl  slew_strng char (nelem) based (slewp);

dcl  strng char (plnth + 1) based;

dcl 1 buffer aligned,				/* buffer for reading in lines */
    2 cc char (1) unaligned,
    2 input_record char (165) unaligned,
    2 output_record char (165) aligned;

dcl (addr, substr, null) builtin;

dcl  a_sip ptr,
     bbp ptr,
     buf_len21 fixed bin (21),
     code fixed bin (35),
     init_flg bit (1) unaligned,
     inp ptr,
     iocbp ptr,					/* ptr to ansi dim control block */
     lnth fixed bin,
     nelem fixed bin,
     nelemt fixed bin,
     order char (18) varying,
     plnth fixed bin,
     slewp ptr,
     statp ptr,					/* ptr to status string */
     status bit (72) aligned,
     term_flg bit (1) unaligned;

dcl  spool_static_$debug ext;
dcl  error_table_$end_of_info fixed bin (35) ext;
dcl  error_table_$fatal_error fixed bin (35) ext;


dcl  com_err_ entry options (variable);
dcl  ioa_ entry options (variable);
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  iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin, fixed bin (35));
dcl  spooling_question_handler_ entry (ptr, fixed bin (35));

dcl 1 slew_table aligned internal static,
    2 space_one_line char (1) aligned,
    2 space_two_lines char (2) unaligned,
    2 space_three_lines char (3) unaligned,
    2 form_feed char (1) unaligned,
    2 carriage_return char (1) unaligned;


dcl  first bit (1) internal static init ("1"b);
dcl  CR char (1) aligned internal static init ("");
dcl  NL char (1) aligned internal static init ("
");
dcl  PR char (14) aligned internal static init ("printer_output");
dcl  FF char (1) aligned internal static init ("");

	sip = a_sip;
	statp = addr (status);
	status = (72)"0"b;
	code = 0;

	if spooling_info.version ^= spooling_info_version_4 then do;
	     code = error_table_$fatal_error;
	     return;
	end;

	on command_question call spooling_question_handler_ (sip, code);

	lnth = 0;					/* length of each lrec read from spooling tape */
	buf_len21 = sip -> spooling_info.phys_line_length + 1; /* should be 137 */
	nelemt = 0;				/* initial number of elements is zero */
	nelem = 0;				/* initialize */

	if first = "1"b then do;
	     slew_table.space_one_line = NL;
	     slew_table.space_two_lines = NL || NL;
	     slew_table.space_three_lines = NL || NL || NL;
	     slew_table.carriage_return = CR;
	     slew_table.form_feed = FF;
	     first = "0"b;
	end;

	iocbp = sip -> spooling_info.iocbp;		/* pick up iocb ptr for reading records from tape */
	bbp = addr (buffer);			/* pts to place to read in records from tape */


/* read from the file on the tape, one line at a time, and convert the carriage control characters for
   correct printing on the printer */

	init_flg = "1"b;
	term_flg = "0"b;
	inp = addr (buffer.output_record);

read:	buffer.cc = "";
	buffer.input_record = "";

	call iox_$read_record (iocbp, bbp, buf_len21, lnth, code); /* read a record from spooling tape */
	if code = 0 then do;
	     call convert (code);			/* if read ok, do code conversion and write line */
	     if code ^= 0 then return;		/* OOPS! */
	     go to read;
	end;

	if code = error_table_$end_of_info then do;	/* end of this spooled file */
	     code = 0;
	     term_flg = "1"b;			/* set up to terminate processing this file */
	     call convert (code);
	end;
	else do;
	     if spool_static_$debug = 1 then call ioa_ ("unspool: error reading record -- ^a", bbp -> strng);
	     code = error_table_$fatal_error;		/* thats all for this file */
	end;

	return;

convert:	proc (ec);

dcl  ec fixed bin (35);

/* little procedure for mapping ASA printer carriage control characters to "pre-slew" characters  */
/* code converts one logical record (printed line) per call */

	     order = "";				/* initialize */
	     if term_flg = "0"b then do;

		if buffer.cc = " " then do;		/* new line */
		     slewp = addr (slew_table.space_one_line);
		     nelem = 1;
		end;
		else if buffer.cc = "0" then do;	/* double space */
		     slewp = addr (slew_table.space_two_lines);
		     nelem = 2;
		end;
		else if buffer.cc = "-" then do;	/* triple space */
		     slewp = addr (slew_table.space_three_lines);
		     nelem = 3;
		end;
		else if buffer.cc = "1" then do;	/* form feed */
		     slewp = addr (slew_table.form_feed);
		     nelem = 1;
		end;
		else if buffer.cc = "+" then do;	/* carriage return */
		     slewp = addr (slew_table.carriage_return);
		     nelem = 1;
		end;
		else if buffer.cc = "7" then do;	/* space to top inside page */
		     order = "inside_page";
		     slewp = addr (slew_table.carriage_return);
		     nelem = 1;
		end;
		else if buffer.cc = "8" then do;	/*  space to top outside page  */
		     order = "outside_page";
		     slewp = addr (slew_table.carriage_return);
		     nelem = 1;
		end;
		if init_flg = "1"b then do;		/* 1st time thru just put out slew */
		     init_flg = "0"b;

		     if order ^= "" then
			call ios_$order (PR, (order), null (), status);

		     call ios_$write (PR, slewp, 0, nelem, nelemt, status);
		     if statp -> stat.fbpart ^= 0 then do;
			ec = statp -> stat.fbpart;
			call com_err_ (ec, "unspool_", "unspool_$convert: problem writing slew.");
		     end;
		     if lnth = 1 then buffer.output_record = ""; /* only slew one line */
		     else buffer.output_record = buffer.input_record;
		     plnth = lnth - 1;		/* save the length of the print line */
		     return;
		end;
	     end;
	     else do;				/* this is the last time around for this file */
		slewp = addr (slew_table.space_one_line);
		nelem = 1;
	     end;

/*	add the current slew char to the last print line and write */

	     buffer.output_record = substr (buffer.output_record, 1, plnth) || slew_strng;

	     call ios_$write (PR, inp, 0, plnth + nelem, nelemt, status);
	     if statp -> stat.fbpart ^= 0 then do;
		ec = statp -> stat.fbpart;
		call com_err_ (ec, "unspool_", "unspool_$convert: Writing: ^a", inp -> strng);
		return;
	     end;

	     plnth = lnth - 1;			/* save line length for next output */
	     buffer.output_record = buffer.input_record;	/* copy in the new line, then get the next slew */
	     if order ^= "" then
		call ios_$order (PR, (order), null (), status);

	     return;

	end convert;

     end unspool_;


		    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