



		    analyze_device_stat_.pl1        11/15/82  1855.6rew 11/15/82  1520.9       77517



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* ANALYZE_DEVICE_STAT_ - Procedure to analyze status from peripheral device.
   coded 12/1/74 by Noel I. Morris	*/
/*	Modified January 1976 by Larry Johnson to add rsnnl entry. */
/*	Modified 4/79 by R.J.C. Kissel to handle major status 0. */


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


/* format: style3,ind3,initlm3,dclind6,idind32 */
analyze_device_stat_:
   proc (name, tablep, stat, flags);			/* procedure to analyze device status */

dcl   name		        char (*),		/* device name */
      tablep		        ptr,		/* pointer to status interpretation table */
      stat		        bit (72) aligned,	/* IOM status */
      flags		        bit (18) aligned;	/* status information flags */

dcl   majstat		        bit (4) aligned,	/* major status */
      substat		        bit (6) aligned,	/* substatus */
      cstat		        bit (3) aligned,	/* central or channel status */
      imaj		        fixed bin (4),	/* major status as integer */
      i			        fixed bin,		/* iteration variable */
      message		        char (256) var,	/* status interpretation message */
      line		        char (60) aligned,	/* for calls to ioa_ */
      line_lth		        fixed bin,		/* length of line */
      srel		        bit (18) aligned,	/* rel pointer to substatus info block */
      sp			        ptr,		/* ITS pointer to substatus info block */
      mask		        bit (6) aligned,	/* mask for substatus */
      comp		        bit (6) aligned,	/* comparison bits for substatus */
      nnl_sw		        bit (1) init ("0"b),	/* set if entered thru rsnnl entry */
      print_flag		        bit (1) aligned;	/* flag indicating if line was printed */

dcl   1 stable		        (0:15) based (tablep) aligned,
						/* major status table */
      ( 2 offset		        bit (18),		/* offset of substatus information */
        2 count		        fixed bin (17)
        )			        unal;		/* count of recognizable substatuses */

dcl   1 sinfo		        based (sp) aligned,	/* substatus information block */
        2 maj		        char (24),		/* name of major status */
        2 sub		        (stable (imaj).count),/* substatus information */
	3 control		        char (6),		/* used to generate mask and comparison */
	3 flags		        bit (18),		/* action flags */
	3 desc		        char (32);		/* description of substatus */

dcl   com_err_		        entry options (variable),
      ioa_$rsnnl		        entry options (variable);

dcl   (addr, bin, bit, null, ptr, substr, translate)
			        builtin;

%include iom_stat;
%include status_flags;

      call rs (message, tablep, stat, flags);		/* Call to get string to print. */

      call com_err_ (0, name, "^/^a", message);		/* Print out the message. */

      return;

rsnnl:
   entry (mess, tablep, stat, flags);			/* entry to return string without tabs and newlines */

      nnl_sw = "1"b;				/* remember entry from here */

rs:
   entry (mess, tablep, stat, flags);			/* entry to return string */

dcl   mess		        char (*) var;	/* message is returned into this string */


      statp = addr (stat);				/* Get pointer to status info. */
      mess = "";					/* Initialize message string. */
      flags = "0"b;					/* Reset flag bits. */

      majstat = status.major;				/* Extract major status. */
      substat = status.sub;				/* And substatus. */
      imaj = bin (majstat, 4);			/* Get major status as integer. */

      if tablep = null
      then
         do;					/* If no status table. */
	  call ioa_$rsnnl ("Major status = ^o, substatus = ^2.3b", line, line_lth, imaj, substat);
	  call report (line);
	  flags = flags | report_flag | halt_flag;
	  return;
         end;

      srel = stable (imaj).offset;			/* Get offset of info for this major status. */

/* Only print major and sub status if they are non-zero, or if there is no other status to print. */

      if majstat | substat | ((status.central_stat | status.channel_stat | status.power) = "0"b)
      then
         do;
	  if srel
	  then
	     do;					/* If information exists ... */
	        sp = ptr (tablep, srel);		/* Generate pointer to substatus info. */
	        call report (sinfo.maj);		/* Report the major status. */

	        print_flag = "0"b;			/* Reset the flag. */
	        do i = 1 to stable (imaj).count;	/* Look through the substatuses. */
		 mask = bit (translate (sinfo.sub (i).control, "10", "0X"), 6);
						/* Make 1's out of 0's and 1's, 0's out of X's. */
		 comp = bit (translate (sinfo.sub (i).control, "0", "X"), 6);
						/* Make X's into 0's. */
		 if (substat & mask) = comp
		 then
		    do;				/* Did we get this status? */
		       print_flag = "1"b;		/* Turn on print flag. */
		       call report (sinfo.sub (i).desc);/* Report the substatus. */
		       flags = flags | sinfo.sub (i).flags;
						/* Return the flags. */
		       if flags & init_flag
		       then
			do;			/* If initiate bit should be checked ... */
			   if status.initiate
			   then /* And it is ON ... */
			        flags = flags | backup_flag;
			end;
		    end;				/* Indicate retry of previous operation. */
	        end;

	        if ^print_flag
	        then
		 do;				/* Be sure to print unrecognized substatus. */
		    call ioa_$rsnnl ("Substatus = ^2.3b", line, line_lth, substat);
		    call report (line);
		    flags = flags | report_flag | halt_flag;
		 end;
	     end;
	  else
	     do;					/* Unrecognized major status ... */
	        call ioa_$rsnnl ("Major status = ^o, substatus = ^2.3b", line, line_lth, imaj, substat);
	        call report (line);
	        flags = flags | report_flag | halt_flag;
	     end;
         end;

      if status.central_stat
      then
         do;					/* Check for IOM central status */
	  cstat = status.central_stat;		/* Extract the central status. */

	  if cstat = "001"b
	  then line = "LPW tally runout";
	  else if cstat = "010"b
	  then line = "2 sequential TDCW's";
	  else if cstat = "011"b
	  then line = "Boundary violation";
	  else if cstat = "101"b
	  then line = "IDCW in restricted mode";
	  else if cstat = "110"b
	  then line = "Character position/size discrepancy during list service";
	  else if cstat = "111"b
	  then line = "Parity error on I/O bus, data _f_r_o_m channel";

	  call report (line);			/* Print out the central status. */
	  flags = flags | report_flag | backup_flag | halt_flag;
         end;					/* Set appropriate flags. */

      if status.channel_stat
      then
         do;					/* Check for IOM channel status */
	  cstat = status.channel_stat;		/* Extract the channel status. */

	  if cstat = "001"b
	  then line = "Attempt to connect while busy";
	  else if cstat = "010"b
	  then line = "Illegal channel command in PCW";
	  else if cstat = "011"b
	  then line = "Incorrect DCW during list service";
	  else if cstat = "100"b
	  then line = "Incomplete instruction sequence";
	  else if cstat = "110"b
	  then line = "Parity error on peripheral interface";
	  else if cstat = "111"b
	  then line = "Parity error on I/O bus, data _t_o channel";

	  call report (line);			/* Print out the channel status. */
	  flags = flags | report_flag | backup_flag | halt_flag;
         end;					/* Set appropriate flags. */

      if status.power
      then
         do;					/* If peripheral absent or power off ... */
	  call report ("Device disconnected or power off");
	  flags = flags | report_flag | backup_flag | halt_flag;
         end;

      return;

report:
   proc (message);					/* internal proc to print error message */

dcl   message		        char (*) aligned;	/* error message */


      if message = ""
      then return;

      if ^nnl_sw
      then mess = mess || "	***** ";			/* Insert asterisks. */

      mess = mess || rtrim (message);			/* Add message to output line. */

      if ^nnl_sw
      then mess = mess || ".
";			/* Add period and newline. */
      else mess = mess || ". ";

   end report;

   end analyze_device_stat_;




		    analyze_system_fault_.pl1       11/30/82  1556.7rew 11/30/82  1330.1       56907



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


/* Procedure to analyze IOM system fault status. */
/* Coded 10/31/74 by Noel I. Morris */
/* Modified 1 July 1982 by Chris Jones to add rsnnl entry. */

/* format: style4,delnl,insnl,indattr,ifthen,declareind10,dclind10 */
analyze_system_fault_:
     proc (p_devname, p_fword);

dcl	p_description	   char (*) varying parameter;/* English description of fault */
dcl	p_devname		   char (*) parameter;	/* device name */
dcl	p_fword		   bit (36) aligned parameter;/* system fault word */

dcl	fword		   bit (36) aligned;	/* copy of faultword */
dcl	message		   char (64) var;		/* error message */
dcl	rs_sw		   bit (1) aligned;		/* whether we return a description or output it */

dcl	com_err_		   entry options (variable);

dcl	(addr, substr)	   builtin;

	rs_sw = "0"b;				/* don't return the message, just output it */
	goto COMMON;

rsnnl:
     entry (p_fword, p_description);

	rs_sw = "1"b;

COMMON:
	fword = p_fword;
	statp = addr (fword);			/* Get pointer to system fault word. */

	if ^rs_sw then
	     call com_err_ (0, p_devname, "IOM system fault on channel ^2.3b.", substr (faultword.channel, 4));


	if (faultword.serv_req & "11100"b) = "00000"b then
	     message = "Invalid";
	else if faultword.serv_req = "00110"b then
	     message = "First list";
	else if (faultword.serv_req & "11110"b) = "00100"b then
	     message = "Second list";
	else if faultword.serv_req = "00111"b then
	     message = "Backup list";
	else if (faultword.serv_req & "11100"b) = "01000"b then
	     message = "Status";
	else if (faultword.serv_req & "11100"b) = "01100"b then
	     message = "Program interrupt";
	else if faultword.serv_req = "10000"b then
	     message = "Indirect single precision data load";
	else if faultword.serv_req = "10001"b then
	     message = "Indirect double precision data load";
	else if faultword.serv_req = "10100"b then
	     message = "Indirect single precision data store";
	else if faultword.serv_req = "10101"b then
	     message = "Indirect double precision data store";
	else if faultword.serv_req = "11000"b then
	     message = "Direct single precision data load";
	else if faultword.serv_req = "11001"b then
	     message = "Direct double precision data load";
	else if faultword.serv_req = "11010"b then
	     message = "Direct read clear";
	else if faultword.serv_req = "11100"b then
	     message = "Direct single precision data store";
	else if faultword.serv_req = "11101"b then
	     message = "Direct double precision data store";

	if rs_sw then
	     p_description = "System fault during """ || message || """ service.";
	else call com_err_ (0, p_devname, "Operation was ""^a service"".", message);


	if faultword.controller_fault = "0010"b then
	     message = "Non-existent address";
	else if faultword.controller_fault = "0011"b then
	     message = "Fault on condition";
	else if faultword.controller_fault = "0101"b then
	     message = "Data parity, store to SC";
	else if faultword.controller_fault = "0110"b then
	     message = "Data parity in store";
	else if faultword.controller_fault = "0111"b then
	     message = "Data parity, store to SC and in store";
	else if faultword.controller_fault = "1000"b then
	     message = "Not control port";
	else if faultword.controller_fault = "1001"b then
	     message = "Port not enabled";
	else if faultword.controller_fault = "1010"b then
	     message = "Illegal instruction";
	else if faultword.controller_fault = "1011"b then
	     message = "Store not ready";
	else if faultword.controller_fault = "1100"b then
	     message = "ZAC parity, active module to SC";
	else if faultword.controller_fault = "1101"b then
	     message = "Data parity, active module to SC";
	else if faultword.controller_fault = "1110"b then
	     message = "ZAC parity, SC to store";
	else if faultword.controller_fault = "1111"b then
	     message = "Data parity, SC to store";

	if faultword.controller_fault then do;
	     if rs_sw then
		p_description = p_description || "  System controller fault was """ || message || """.";
	     else call com_err_ (0, p_devname, "System controller fault was ""^a"".", message);
	end;

	if faultword.io_fault = "000001"b then
	     message = "Illegal channel number";
	else if faultword.io_fault = "000010"b then
	     message = "Illegal service request";
	else if faultword.io_fault = "000011"b then
	     message = "Parity error reading from scratchpad";
	else if faultword.io_fault = "000100"b then
	     message = "Attempt to cross 256K boundary";
	else if faultword.io_fault = "000101"b then
	     message = "Tally runout on connect channel LPW";
	else if faultword.io_fault = "000110"b then
	     message = "Attempt to connect to illegal PCW";
	else if faultword.io_fault = "000111"b then
	     message = "IDCW found when DCW or TDCW expected";
	else if faultword.io_fault = "001000"b then
	     message = "Illegal character position";
	else if faultword.io_fault = "001001"b then
	     message = "No memory response";
	else if faultword.io_fault = "001010"b then
	     message = "Parity error accessing SC";
	else if faultword.io_fault = "001011"b then
	     message = "Illegal connect channel LPW tally";
	else if faultword.io_fault = "001100"b then
	     message = "Attempt to use REL bit in Multics mode";
	else if faultword.io_fault = "001101"b then
	     message = "Attempt to use mod64 DCW in GCOS mode";
	else if faultword.io_fault = "001110"b then
	     message = "LPW extension bit ON in standard GCOS mode";
	else if faultword.io_fault = "001111"b then
	     message = "No memory port selected";

	if faultword.io_fault then do;
	     if rs_sw then
		p_description = p_description || "  I/O fault was """ || message || """.";
	     else call com_err_ (0, p_devname, "I/O fault was ""^a"".", message);
	end;

	return;
%page;
%include iom_stat;

     end analyze_system_fault_;




		    init_printer_.pl1               11/15/82  1855.6rew 11/15/82  1453.0       81171



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



/* Printer initialization routine:  initializes a newly-attached printer; it also is used to reset the printer's line and
   page counters and printer modes when required by the I/O daemon */

/* Created: 21 October 1974 by Noel I. Morris */
/* Modified: 10 March 1977 by Noel I. Morris */
/* Modified: 12 September 1980 by G. Palter to reset pci.flags (new member of structure) */
/* Modified: 26 November 1981 as part of the fix to entry 0035 (phx11995) from the io_daemon error list:
      If a print file contains the sequence "ESC c" which is the start of the skip to logical channel printer escape
      sequence, the I/O daemon will scan without printing all subsequent print data looking for the ETX character which
      terminates the sequence even though non-numeric characters are encountered before the ETX.  (This sequence consists
      of "ESC c" followed by a number from 1 to 16 followed by the ETX).  The daemon continues looking for the ETX across
      requests causing an unknown amount of printed output to be lost */


init_printer_:
     procedure (pip, pcip, iop, rcode);

dcl  iop entry (bit (36) aligned, bit (2) aligned, ptr, fixed bin (12), bit (1) aligned),
						/* procedure to do I/O */
     rcode fixed bin (35);				/* error code */
						/* 1 => bad configuration data */
						/* 2 => unable to read detailed status */
						/* 3 => unable to load train image */
						/* 4 => unable to load VFC image */
						/* 5 => printer does not need train or VFC image */

dcl  i fixed bin,					/* iteration index */
     reset_idcw bit (36) aligned,			/* to build a reset status idcw */
     errsw bit (1) aligned;				/* I/O procedure error indicator */

dcl  printer_images_$n_images fixed bin ext,
     printer_images_$image_numbers (10) fixed bin ext,
     printer_images_$image_base ext,
     printer_images_$image_offsets (10) fixed bin (18) ext,
     printer_images_$image_lengths (10) fixed bin (12) ext,
     pr2_conv_$pr2_conv_ ext,
     pr3_conv_$pr3_conv_ ext;

dcl (addr, addrel, bin, bit, null, size, string) builtin;




% include prt_info;

% include printer_types;




% include prt_conv_info;




% include iom_pcw;




	rcode = 0;				/* Clear error code. */

	do i = 1 to nmodels;			/* Search for model number. */
	     if prt_info.model = models (i) then go to model_found;
	end;

	rcode = 1;				/* Unable to find legitimate model number. */
	return;


model_found:
	prt_info.type = types (i);			/* Extract printer type. */
	if prt_info.line_length = -1 then		/* If line size not supplied ... */
	     prt_info.line_length = default_line_length;	/* Use default line length. */

	if pcip ^= null () then			/* If conversion info structure provided ... */
	     if prt_info.type = 1 then		/* If BCD type printer ... */
		pci.cv_proc = addr (pr2_conv_$pr2_conv_); /* Set conversion procedure. */
	     else					/* If ASCII type printer ... */
	     pci.cv_proc = addr (pr3_conv_$pr3_conv_);


	prt_info.print_idcw = make_idcw (WRITE (prt_info.type));
						/* Initialize IDCW to print line. */

	prt_info.term_idcw = make_idcw ("100000"b);	/* Initialize IDCW to stop printer. */
	idcwp = addr (prt_info.term_idcw);		/* Get pointer to IDCW. */
	idcw.chan_cmd = "000010"b;			/* Make it non-data transfer operation. */
	idcw.count = bit (bin (1, 6));

	if pcip ^= null () then do;			/* If conversion structure provided ... */
	     pci.phys_line_length = prt_info.line_length; /* Set physical line limitation. */
	     pci.phys_page_length = default_page_length + 6; /* Set length of physical page. */
	     pci.lpi = default_lpi;			/* Set number of lines per inch. */

	     call reset (pcip);			/* Reset line counters and modes. */

	     pci.level = 0;				/* Reset conversion info just once. */
	     pci.pos = 0;
	     pci.line = 1;
	     pci.slew_residue = 0;
	     pci.label_nelem = 0;
	     pci.temp = "0"b;
	end;




	if READ_STATUS (prt_info.type) then do;		/* If detailed status to be read ... */

/*	     call iop (make_idcw (READ_STATUS (type)), "10"b, addr (printerstatus), size (printerstatus),
   /*		errsw);
   /*	     if errsw then do;
   /*		rcode = 2;			/* unable to read status */
/*		return;
   /*	     end;
*/
	end;

/* Do a reset status operation to clear out any old status from previous user. */

	reset_idcw = make_idcw ("100000"b);		/* Build skelton idcw */
	idcwp = addr (reset_idcw);			/* get base of it */
	idcw.chan_cmd = "000010"b;			/* make it non-data transfer */
	idcw.count = "000001"b;
	call iop (reset_idcw, "00"b, null, 0, errsw);
	if errsw then do;
	     rcode = 2;
	     return;
	end;


	call load_image (pip, pcip, iop, rcode);	/* Make call to load train image. */
	if rcode = 5 then rcode = 0;			/* this model can't do it, that's OK */

/*	make a separate call to load the VFC image */

	return;




load_image: entry (pip, pcip, iop, rcode);

	rcode = 0;				/* Clear the error code. */

	if LOAD_IMAGE (prt_info.type) then do;		/* If image must be loaded ... */
	     do i = 1 to printer_images_$n_images;	/* Search for appropriate image. */
		if prt_info.train = printer_images_$image_numbers (i) then
		     go to image_found;
	     end;

	     rcode = 1;				/* Image not found. */
	     return;

image_found:
	     call iop (make_idcw (LOAD_IMAGE (prt_info.type)), "01"b,
		addrel (addr (printer_images_$image_base), printer_images_$image_offsets (i)),
		printer_images_$image_lengths (i),
		errsw);
	     if errsw then
		rcode = 3;			/* unable to load train image */
	end;

	else					/* This model printer does not have train image. */
	rcode = 5;

	return;




load_vfc:	entry (pip, pcip, iop, rcode);

dcl 1 vfc_image aligned,				/* print VFC image */
   (2 lpi fixed bin (8),				/* lines per inch */
    2 image_length fixed bin (8),			/* number of lines represented by image */
    2 toip,					/* top of inside page info */
      3 line fixed bin (8),				/* line number */
      3 pattern bit (9),				/* VFC pattern */
    2 boip,					/* bottom of inside page info */
      3 line fixed bin (8),				/* line number */
      3 pattern bit (9),				/* VFC pattern */
    2 toop,					/* top of outside page info */
      3 line fixed bin (8),				/* line number */
      3 pattern bit (9),				/* VFC pattern */
    2 boop,					/* bottom of outside page info */
      3 line fixed bin (8),				/* line number */
      3 pattern bit (9),				/* VFC pattern */
    2 pad bit (18)) unal;				/* fill out last word */

dcl (toip_pattern init ("113"b3),			/* top of inside page pattern */
     toop_pattern init ("111"b3),			/* top of outside page pattern */
     bop_pattern init ("060"b3))			/* bottom of page pattern */
     bit (9) static options (constant);

	rcode = 0;				/* Clear the error code. */

	if LOAD_VFC (prt_info.type) then do;		/* If VFC image must be loaded ... */
	     vfc_image.lpi = pci.lpi;			/* Fill in the VFC image. */
	     vfc_image.image_length = 2 * pci.phys_page_length;
	     vfc_image.toip.line = 4;
	     vfc_image.toip.pattern = toip_pattern;
	     vfc_image.boip.line = pci.phys_page_length - 2;
	     vfc_image.boip.pattern = bop_pattern;
	     vfc_image.toop.line = pci.phys_page_length + 4;
	     vfc_image.toop.pattern = toop_pattern;
	     vfc_image.boop.line = 2 * pci.phys_page_length - 2;
	     vfc_image.boop.pattern = bop_pattern;
	     vfc_image.pad = "0"b;

	     call iop (make_idcw (LOAD_VFC (prt_info.type)), "01"b, addr (vfc_image), size (vfc_image), errsw);
	     if errsw then
		rcode = 4;			/* unable to load VFC image */
	end;

	else					/* This model printer does not support VFC image. */
	rcode = 5;

	return;




make_idcw: proc (cmd) returns (bit (36) aligned);		/* interal proc to make IDCW */

dcl  cmd bit (6) aligned;				/* command code */

dcl 1 i like idcw aligned auto;			/* automatic copy of IDCW */


	     string (i) = "0"b;			/* Clear IDCW. */
	     i.command = cmd;			/* Copy command code. */
	     i.device = "000001"b;			/* Set device code. */
	     i.code = "111"b;			/* Set IDCW ID bits. */

	     return (string (i));			/* Return completed IDCW. */


	end make_idcw;




reset:	entry (pcip);				/* Entry to reset counters and modes. */


	pci.lmarg = 0;
	pci.rmarg = pci.phys_line_length;
	pci.page_length = pci.phys_page_length - pci.lpi;
	pci.sheets_per_page = 1;
	pci.line_count = 0;
	pci.page_count = 0;
	pci.func = 0;
	pci.modes = "0"b;
	pci.flags = "0"b;
	pci.top_label_line = "";
	pci.bot_label_line = "";
	pci.top_label_length = 0;
	pci.bot_label_length = 0;
	pci.esc_state = 0;
	pci.esc_num = 0;

	return;



     end init_printer_;




		    pr2_conv_.alm                   11/15/82  1855.6rew 11/15/82  1453.0       69228



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
" PR2_CONV_ - Conversion for PRT202 series printer
"	coded 10/24/74 by Noel I. Morris


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


" This module perform the necessary conversion for printing
" on the PRT202 line printers.
"
" The manner in which this procedure is utilized at described in detail
" in the listing of prt_conv_.


	name	pr2_conv_

	segdef	pr2_conv_


	temp	char,case




pr2_conv_:
	tra	pr2_send_init
	tra	pr2_send_chars
	tra	pr2_send_slew_pattern
	tra	pr2_send_slew_count

" 

pr2_send_init:
	stz	case		initial case is upper case

	tra	sb|0		return to caller

" 

pr2_send_chars:
	eax7	0,au		save character count in X7

	eaa	0,2		white space count in AU
	eax2	0		clear count in X2
	lrl	18+3		get low-order 3 bits
	qrl	36-3		in QL
	tze	nosmall		if zero, don't have to insert spaces

	mlr	(),(pr,rl),fill(20)	insert up to 7 blanks
	desc6a	*,0		..
	desc6a	bb|0,ql		..

nosmall:	eax6	0,ql		X6 is output offset

spaceloop:
	eaq	0,al		count of 8 space multiples in QU
	tmoz	nospace		exit loop when finished
	sba	15,dl		can do 15 X 8 spaces at a time
	tmoz	*+2		if more than that many,
	ldq	15,dl		just do 15 this time
	orq	hs_chars		insert skip character and bit
	stq	char		and save

	mlr	(pr),(pr,x6)	move to output string
	desc6a	char(1),2		..
	desc6a	bb|0,2		..

	eax6	2,6		step output offset 2 characters
	tra	spaceloop		and loop

" 

nospace:	ldx4	case		case in X4
	eax5	0		X5 is input offset

charloop:
	mrl	(pr,x5),(pr),fill(0)  get a character
	desc9a	bp|0,1		..
	desc9a	char,4		..

	lda	char		character in AL
xlate:	xec	casetable,4	perform translation
	sta	char		store BCD character

	mlr	(pr),(pr,x6)	copy character into output
	desc6a	char(5),1		..
	desc6a	bb|0,1		..

	eax5	1,5		step input and output offsets
	eax6	1,6		..

	eax7	-1,7		decrease character count
	tnz	charloop		and loop

	stx4	case		save case
	a9bd	bp|0,5		step input pointer
	a6bd	bb|0,6		step output pointer
	tra	sb|0		and return to caller


caseshift:
	erx4	1,du		toggle the case

	mlr	(),(pr,x6),fill(77)	insert two escape characters
	desc6a	*,0		..
	desc6a	bb|0,2		..

	eax6	2,6		step output offset 2 characters
	tra	xlate		now, try translation again


casetable:
	xec	upper_case_table-32,al
	xec	lower_case_table-32,al


" 

pr2_send_slew_pattern:
	ora	=o20,dl		insert correct bit
	lrl	12		place pattern in Q(6-11)

send_slew:
	orq	esc_char		insert escpae character
	stq	char		store completed slew characters

	mlr	(pr),(pr)		move slew character to output
	desc6a	char,2		..
	desc6a	bb|0,2		..

	ldq	2*6+8,dl		step output pointer
	abd	bb|0,ql		round to next 9-bit character

	tra	sb|0		return



pr2_send_slew_count:
	eaq	0,al		place count in QU
	sba	15,dl		can only slew 15 lines at a time
	tmoz	*+2		if more than that many,
	ldq	15,du		start with 15
	qls	6		count in Q(6-11)
	tra	send_slew		join common code

" 

hs_chars:	vfd	o6/,o6/77,o6/40
esc_char:	vfd	o6/77

" 

" Conversion Table for Upper Case Characters.

upper_case_table:
	lda	=o20,dl		040	Space
	tra	caseshift		041	!
	lda	=o76,dl		042	"
	lda	=o13,dl		043	#
	lda	=o53,dl		044	$
	lda	=o74,dl		045	%
	lda	=o32,dl		046	&
	lda	=o57,dl		047	'
	lda	=o35,dl		050	(
	lda	=o55,dl		051	)
	lda	=o54,dl		052	*
	lda	=o60,dl		053	+
	lda	=o73,dl		054	,
	lda	=o52,dl		055	-
	lda	=o33,dl		056	.
	lda	=o61,dl		057	/
	lda	=o00,dl		060	0
	lda	=o01,dl		061	1
	lda	=o02,dl		062	2
	lda	=o03,dl		063	3
	lda	=o04,dl		064	4
	lda	=o05,dl		065	5
	lda	=o06,dl		066	6
	lda	=o07,dl		067	7
	lda	=o10,dl		070	8
	lda	=o11,dl		071	9
	lda	=o15,dl		072	:
	lda	=o56,dl		073	;
	lda	=o36,dl		074	<
	lda	=o75,dl		075	=
	lda	=o16,dl		076	>
	tra	caseshift		077	?

	lda	=o14,dl		100	@
	lda	=o21,dl		101	A
	lda	=o22,dl		102	B
	lda	=o23,dl		103	C
	lda	=o24,dl		104	D
	lda	=o25,dl		105	E
	lda	=o26,dl		106	F
	lda	=o27,dl		107	G
	lda	=o30,dl		110	H
	lda	=o31,dl		111	I
	lda	=o41,dl		112	J
	lda	=o42,dl		113	K
	lda	=o43,dl		114	L
	lda	=o44,dl		115	M
	lda	=o45,dl		116	N
	lda	=o46,dl		117	O
	lda	=o47,dl		120	P
	lda	=o50,dl		121	Q
	lda	=o51,dl		122	R
	lda	=o62,dl		123	S
	lda	=o63,dl		124	T
	lda	=o64,dl		125	U
	lda	=o65,dl		126	V
	lda	=o66,dl		127	W
	lda	=o67,dl		130	X
	lda	=o70,dl		131	Y
	lda	=o71,dl		132	Z
	lda	=o12,dl		133	[
	lda	=o72,dl		134	\
	lda	=o34,dl		135	]
	lda	=o40,dl		136	^
	tra	caseshift		137	_

	lda	=o37,dl		140	`
	tra	caseshift		141	a
	tra	caseshift		142	b
	tra	caseshift		143	c
	tra	caseshift		144	d
	tra	caseshift		145	e
	tra	caseshift		146	f
	tra	caseshift		147	g
	tra	caseshift		150	h
	tra	caseshift		151	i
	tra	caseshift		152	j
	tra	caseshift		153	k
	tra	caseshift		154	l
	tra	caseshift		155	m
	tra	caseshift		156	n
	tra	caseshift		157	o
	tra	caseshift		160	p
	tra	caseshift		161	q
	tra	caseshift		162	r
	tra	caseshift		163	s
	tra	caseshift		164	t
	tra	caseshift		165	u
	tra	caseshift		166	v
	tra	caseshift		167	w
	tra	caseshift		170	x
	tra	caseshift		171	y
	tra	caseshift		172	z
	tra	caseshift		173	{
	tra	caseshift		174	|
	tra	caseshift		175	}
	tra	caseshift		176	~


" 

" Conversion Table for Lower Case Characters.

lower_case_table:
	lda	=o20,dl		040	Space
	lda	=o74,dl		041	!
	lda	=o76,dl		042	"
	lda	=o13,dl		043	#
	lda	=o53,dl		044	$
	tra	caseshift		045	%
	tra	caseshift		046	&
	lda	=o57,dl		047	'
	lda	=o35,dl		050	(
	lda	=o55,dl		051	)
	lda	=o54,dl		052	*
	lda	=o60,dl		053	+
	lda	=o73,dl		054	,
	tra	caseshift		055	-
	lda	=o33,dl		056	.
	lda	=o61,dl		057	/
	lda	=o00,dl		060	0
	lda	=o01,dl		061	1
	lda	=o02,dl		062	2
	lda	=o03,dl		063	3
	lda	=o04,dl		064	4
	lda	=o05,dl		065	5
	lda	=o06,dl		066	6
	lda	=o07,dl		067	7
	lda	=o10,dl		070	8
	lda	=o11,dl		071	9
	lda	=o15,dl		072	:
	lda	=o56,dl		073	;
	lda	=o36,dl		074	<
	lda	=o75,dl		075	=
	lda	=o16,dl		076	>
	lda	=o14,dl		077	?

	tra	caseshift		100	@
	tra	caseshift		101	A
	tra	caseshift		102	B
	tra	caseshift		103	C
	tra	caseshift		104	D
	tra	caseshift		105	E
	tra	caseshift		106	F
	tra	caseshift		107	G
	tra	caseshift		110	H
	tra	caseshift		111	I
	tra	caseshift		112	J
	tra	caseshift		113	K
	tra	caseshift		114	L
	tra	caseshift		115	M
	tra	caseshift		116	N
	tra	caseshift		117	O
	tra	caseshift		120	P
	tra	caseshift		121	Q
	tra	caseshift		122	R
	tra	caseshift		123	S
	tra	caseshift		124	T
	tra	caseshift		125	U
	tra	caseshift		126	V
	tra	caseshift		127	W
	tra	caseshift		130	X
	tra	caseshift		131	Y
	tra	caseshift		132	Z
	tra	caseshift		133	[
	tra	caseshift		134	\
	tra	caseshift		135	]
	lda	=o40,dl		136	^
	lda	=o52,dl		137	_

	lda	=o37,dl		140	`
	lda	=o21,dl		141	a
	lda	=o22,dl		142	b
	lda	=o23,dl		143	c
	lda	=o24,dl		144	d
	lda	=o25,dl		145	e
	lda	=o26,dl		146	f
	lda	=o27,dl		147	g
	lda	=o30,dl		150	h
	lda	=o31,dl		151	i
	lda	=o41,dl		152	j
	lda	=o42,dl		153	k
	lda	=o43,dl		154	l
	lda	=o44,dl		155	m
	lda	=o45,dl		156	n
	lda	=o46,dl		157	o
	lda	=o47,dl		160	p
	lda	=o50,dl		161	q
	lda	=o51,dl		162	r
	lda	=o62,dl		163	s
	lda	=o63,dl		164	t
	lda	=o64,dl		165	u
	lda	=o65,dl		166	v
	lda	=o66,dl		167	w
	lda	=o67,dl		170	x
	lda	=o70,dl		171	y
	lda	=o71,dl		172	z
	lda	=o12,dl		173	{
	lda	=o32,dl		174	|
	lda	=o34,dl		175	}
	lda	=o72,dl		176	~




	end




		    pr3_conv_.alm                   11/15/82  1855.6rew 11/15/82  1453.0       22284



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
" PR3_CONV_ - Conversion for PRT300 and PRU1200 series printer
"	coded 10/24/74 by Noel I. Morris


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


" This module perform the necessary conversion for printing
" on the PRT300 and PRU1200 line printers.
"
" The manner in which this procedure is utilized is described in detail
" in the listing of prt_conv_.


	name	pr3_conv_

	segdef	pr3_conv_


	temp	char



pr3_conv_:
	tra	sb|0
	tra	pr3_send_chars
	tra	pr3_send_slew_pattern
	tra	pr3_send_slew_count

" 

pr3_send_chars:

spaceloop:
	eaq	0,2		white space count in QU
	tmoz	nospace		skip if no white space
	sbx2	127,du		can take only 127 at a time
	tmoz	*+2		if > 127
	ldq	127,du		take only 127
	orq	hs_char		insert skip character
	stq	char		and save

	mlr	(pr),(pr)		move to output string
	desc9a	char,2		..
	desc9a	bb|0,2		..

	ldq	2,dl		step output pointer
	a9bd	bb|0,ql		..
	tra	spaceloop		loop

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

" 

pr3_send_slew_pattern:
	als	18		move pattern to AU
	ora	ff_char		insert FF character
	sta	char		save characters

send_slew:
	mlr	(pr),(pr),fill(0)	pad last word with zeroes
	desc9a	char,2		..
	desc9a	bb|0,2+3		..

	ldq	2,dl		increment output pointer
	a9bd	bb|0,ql		..

	tra	sb|0		return to caller



pr3_send_slew_count:
	eaq	0,al		line count in QU
	sbla	127,dl		can only do 127 at a time
	tmoz	*+2		if > 127,
	ldq	127,du		do only 127 this time
	orq	vt_char		insert VT character
	stq	char		and save characters
	tra	send_slew		join common code

" 

vt_char:	vfd	o9/013
ff_char:	vfd	o9/014
hs_char:	vfd	o9/037




	end




		    printer_images_.alm             11/15/82  1855.6rew 11/15/82  1453.0       29016



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
" Printer chain and train images


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


	name	printer_images_

	segdef	n_images
	segdef	image_numbers
	segdef	image_lengths
	segdef	image_offsets
	segdef	image_base



" To get a pointer to a train image:
"	do i = 1 to printer_images$n_images while (x ^= printer_images$image_numbers (i));
"	end;
"	tp = addrel (addr (printer_images$image_base), printer_images$image_offsets (i));
"


" 

n_images:	dec	4		" Number of chain/belt images


image_numbers:
	dec	1		" Project MAC image for PRT3xx
	dec	2		" Group 2 chain for PRT3xx
	dec	3		" Group 8 chain for PRT3xx
	dec	600		" Part # 600 (OCR-B ASCII) belt for PRU1200/1600


image_lengths:
	vfd	36/image_1_l
	vfd	36/image_2_l
	vfd	36/image_3_l
	vfd	36/image_4_l


image_offsets:
	zero	0,image_1-image_base
	zero	0,image_2-image_base
	zero	0,image_3-image_base
	zero	0,image_4-image_base


" 

image_base:


" Image for MAC ASCII chain.

image_1:
	aci	'0123456789bcdfuvestaghijklmnopwrqxyz$="&.|{}%0#@'
	aci	'JAKEDCSTBWGHMIORPNFLVZXY\`QU(/*)!^_~<>[]+-.,:;''?'
	aci	'0123456789bcdfuvestaghijklmnopwrqxyz$="&.|{}%0#@'
	aci	'JAKEDCSTBWGHMIORPNFLVZXY\`QU(/*)!^_~<>[]+-.,:;''?'
	aci	'0123456789bcdfuvestaghijklmnopwrqxyz$="&.|{}%0#@'
	aci	'JAKEDCSTBWGHMIORPNFLVZXY\`QU(/*)!^_~<>[]+-.,:;''?'

	equ	image_1_l,*-image_1


" 

" Image for Group 002 type chain.

image_2:
	aci	'0123JAKE.|{}456789bcestaghijBWGHMIORklmnopwrdfuv'
	aci	'DCSTPNFL:;''?\`QU!^_~VZXY0123PNFL:;''?456789bcesta'
	aci	'ghijJAKEMIORklmnopwrdfuvDCST+-.,qxyz%0#@$="&(/*)'
	aci	'0123+-.,qxyz456789bcestaghijPNFL:;''?klmnopwrdfuv'
	aci	'DCSTBWGHMIOR\`QU!^_~VZXY0123BWGHMIOR456789bcesta'
	aci	'ghij+-.,qxyzklmnopwrdfuvDCSTJAKE<>[]%0#@$="&(/*)'

	equ	image_2_l,*-image_2


" 

" Image for Group 008 type chain.

image_3:
	aci	'0123456789ACRIFLMNOPDUST+-.EBZ,/JKQ*VWXY(GH):;&?'
	aci	'!^_~<>[]$="''%=#@ |{}\`abcdefghijklmnopqrstuvwxyz'
	aci	'0123456789ACRIFLMNOPDUST+-.EBZ,/JKQ*VWXY(GH):;&?'
	aci	'!^_~<>[]$="''%=#@ |{}\`abcdefghijklmnopqrstuvwxyz'
	aci	'0123456789ACRIFLMNOPDUST+-.EBZ,/JKQ*VWXY(GH):;&?'
	aci	'!^_~<>[]$="''%=#@ |{}\`abcdefghijklmnopqrstuvwxyz'

	equ	image_3_l,*-image_3


" 

" Image for Part # 600 ASCII belt.

image_4:
	aci	'BDFGHJgS0ACEINORLTabcdefKhijklmM0PQUVWXYZ:;?!%7xynoprstw0z12'
	aci	'3456#89.,()@$=&/''\^_0"<>[]gS~ACEINOR{Tabcdef0hijklm}|`-*+quv'
	aci	'BDFGHJ7x0noprstwLz123456K89.,()M0PQUVWXYZ:;?!%gSyACEINOR0Tab'
	aci	'cdef#hijklm@$=&/''\^_0"<>[]7x~noprstw{z123456089.,()}|`-*+quv'

	equ	image_4_l,*-image_4



	end




		    prt_conv_.alm                   11/15/82  1855.6rew 11/15/82  1453.1      274131



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


" Code conversion module for line printers

" Created:  24 October 1974 by N. Morris
" Modified: 6 June 1975 by N. Morris and D. Hunt to support printing page labels
" Modified: 29 March 1977 by N. Morris to incorporate DCC improvements
" Modified: 18 September 1980 by G. Palter to ignore a FF character immediately
"      after a generated FF is output at page overflow time
" Modified: 17 November 1981 by G. Palter to fix several bugs from the io_daemon error list:
"      0005: phx08986
"	In prt_conv_, the dispatch entry for the NUL character is incorrect causing it to
"	be treated as an ordinary control character rather than always being ignored.
"      0006: phx08986
"	Enabling pci.ctl_char mode causes prt_conv_ to go into a loop which eventually
"	can cause fatal process errors. 
"      0012: phx09251 phx03749 phx04015
"	-no_endpage does not really work.  When the daemon prints what should be the last
"	line of the logical page (line 3 of a real page), it issues a form-feed to get to
"	the next line which is the top of the next logical page.  However, if the paper
"	info or printer alignment (for remotes) is incorrect, this form-feed will cause
"	extra blank paper.  The daemon should never print a form-feed in this mode except
"	when one appears in the user's print file.
"      0031: phx10074
"	When given a very, very long input line (>131071 characters) with no embedded
"	whitespace, prt_conv_ will place too many characters into the caller's output
"	buffer overwriting whatever comes after the buffer.  This problem will normally
"	cause the driver to take a fatal process error and may also destroy data trusted
"	by the coordinator.
"      0035: phx11995
"         If a print file contains the sequence "ESC c" which is the start of the skip to
"         logical channel printer escape sequence, the I/O daemon will scan without printing
"         all subsequent print data looking for the ETX character which terminates the
"         sequence even though non-numeric characters are encountered before the ETX.  (This
"         sequence consists of "ESC c" followed by a number from 1 to 16 followed by the
"         ETX).  The daemon continues looking for the ETX across requests causing an unknown
"         amount of printed output to be lost.

" 
" This module scans character strings containing lines to be printed
" on a line printer.  It produces printer line images, taking into
" account overstrikes, lines that are too long, etc.
"
" Calling sequence:
"	call prt_conv_ (wksp, nelem, outstr, outlen, p);
"
" Where:
"	wksp	is a pointer to the input string
"	nelem	is the number of characters in the input string
"	outstr	is a pointer to a character string long enough to hold a line image
"	outlen	is the length (in 9-bit chars) of the converted output
"	p	is a pointer to the info structure described below
"
" The following registers are used by this program:
"	bp	pointer to input string
"	bb	pointer to output string
"	lp	pointer to tab table
"	lb	pointer to info structure
"	ab	pointer to conversion procedure
"	sb	return from conversion procedure call
"	X1	count of characters remaining in output line
"	X2	count of white space skipped in output
"	X7	return from internal calls
"
" Note:
"	The actual transmittal of converted print lines to the output buffer
"	is not done by this routine.  Four entries must be provided in
"	an output conversion procedure.  The output procedure is found
"	by using a pointer provided in the info structure.  The entries
"	and their calling sequences are described below.  They must reside
"	at locations 0, 1, 2, and 3 of the output procedure, and they
"	are called using a TSPSB instruction.  The output procedure shares
"	the stack frame belonging to prt_conv_.  The first 20(8) words
"	of automatic storage are reserved for use by the output procedure.
"
"	cv_send_init (location 0 of the output procedure) is called before
"	any conversion is performed.  At this time, a carriage control
"	character (or any other necessary control character) can be
"	inserted at the beginning of the output line.  In addition,
"	any stack variables used by the output procedure can be
"	initialized.
"
"	cv_send_chars (location 1) is called each time white space
"	followed by characters is to be added to the output line.
"	bp will point to the characters to be output.  The number
"	of characters to output will be found in AU.  X2 will contain
"	the amount of white space to be inserted before the output
"	characters.  cv_send_chars is expected to modify bp and bb
"	to point after the characters input and output respectively.
"	It is expected to set X2 to zero after inserting the appropriate
"	white space.
"
"	cv_send_slew_pattern (location 2) is called at the end of a line
"	to cause a slew to a VFU tape pattern.  The pattern is supplied
"	in the A register.  Currently, only 3 patterns are generated:
"	slew to top of page, top of inside page, and top of outside page.
"	cv_send_slew_pattern is expected to modify bb to point
"	after the last character to be output.
"
"	cv_send_slew_count (location 3) is called at the end of a line
"	to cause a given number of lines to be slewed.  The number is
"	supplied in the A register.  If the requested number of lines
"	cannot be slewed in one printer operation, the remaining line
"	count should be returned in the A.  Otherwise, the A should be
"	set to zero.  cv_send_slew_count is expected to modify bb to
"	point after the last character to be output.
"
"	A cell in the conversion control structure (pci.temp)
"	is reserved for use the the output procedure.  This cell may
"	be used to save variables between successive calls to  prt_conv_.
"
" 

	name	prt_conv_

	entry	prt_conv_


	temp8	conv_stor(2)	reserved for use by conversion procedure
	tempd	save_bp		for saving bp
	temp	overstrike	overstrike encountered flag
	temp	overflow		line overflow encountered flag
	temp	endline		end of line char encountered flag
	temp	labelsw		label being processed flag
	temp	inrem		-count of charaters remaining in input
	temp	cur_level		current overstrike level
	temp	outoff		output pointer offset
	temp	savpos		saved position for long lines
	temp	savfunc		saved function code for labels
	temp	char		character temporary
	temp	tctally		tally from tct instruction
	temp	sctally		tally from scd instruction
	temp	bltally		tally from tct for blanks
	temp	count		character count
	temp	numb		count of blanks
	temp	numc		non-blank character count
	temp	instr		temporary for modified SCM instruction
	temp	save_a_temp


" 

	equ	cv_send_init,0		entry in cv_proc to initialize conversion
	equ	cv_send_chars,1		entry in cv_proc to output characters
	equ	cv_send_slew_pattern,2	entry in cv_proc to slew to pattern
	equ	cv_send_slew_count,3	entry in cv_proc to slew by count

	include	prt_conv_info


" 
" Conversion Initialization.

prt_conv_:push

	epplb	ap|10,*		lb -> info structure
	epplb	lb|0,*		..

	stz	labelsw		clear label flag
	lda	lb|pci.label_nelem	any label being processed?
	tnz	do_label		if so, process label

	eppbp	ap|2,*		bp -> input string
	eppbp	bp|0,*		..
	lda	ap|4,*		get length of input string
	tra	do_input		and continue

do_label:	eppbp	lb|pci.label_wksp,*	bp -> label
	stc2	labelsw		set flag

do_input:	neg	0		negate remaining length
	sta	inrem		save -remaining length of input string

	eppbb	ap|6,*		bb -> output string
	eppbb	bb|0,*		..
	stz	outoff		clear word
	sarbb	outoff		save pointer offset for computation later

	stz	cur_level		clear current level
	stz	overstrike	clear overstrike flag
	stz	overflow		clear line overflow flag
	stz	endline		clear end of line flag
	stz	savfunc		clear saved function code

	ldac	lb|pci.pos	get previous position of incomplete line
	sta	savpos		save in case it's needed later
	tnz	*+2		if zero,
	lda	lb|pci.lmarg	use left margin
	eax2	0,al		set initial white space
	neg	0		negate
	ada	lb|pci.rmarg	compute characters remaining on line
	eax1	0,al		in X1

	eppab	lb|pci.cv_proc,*	ab -> conversion proc
	tspsb	ab|cv_send_init	initialize conversion proc

	ldac	lb|pci.slew_residue	any more lines to slew?
	tpnz	slew_more		if so, go do them

	szn	labelsw		doing label?
	tnz	loop		if so, don't look at ESC processing
	lda	lb|pci.esc_state	get state of ESC processing
	tnz	resume_esc-1,al*	if ESC processing, go back to proper place

" 
" Main Character Processing Loop.

loop:	tsx7	scan		scan input characters
	sta	count		save count

	cmpx1	count		too many characters for line?
	tpl	*+3		if so,
	stx1	count		take as many as will fit
	stc1	overflow		set line overflow switch

	lda	count		character count in AU
	tze	zerc		if no characters, skip following
	szn	lb|pci.level	at zero overstrike level?
	tnz	skip		if not, don't output anything

	arl	18		length in AL
loop2:	ldq	0,dl		clear Q (offset from bp)

loop1:	cmpa	2,dl		if 2 or fewer characters
	tmoz	twoleft		don't bother looking for blanks

	scd	(pr,rl,ql),(du)	search for blanks
	desc9a	bp|0,al		..
	aci	"  "		..
	arg	sctally		..

	adq	sctally		add offset of start of blanks
	sba	sctally		subtract from length in A
	ttn	noblanks		if no blanks, just output line

	tct	(pr,rl,ql)	now search for non-blanks
	desc9a	bp|0,al		..
	arg	bltable		..
	arg	bltally		..

	lxl7	bltally		get count of blanks in X7
	stx7	numb		save blank count
	cmpx7	2,du		only 2?
	tpnz	outfore		if more than 2, output text before blanks
	sba	2,dl		decrease length by 2
	adq	2,dl		and bump offset past blanks
	ttf	loop1		continue if we're not at end of string
	tra	endblanks		output everything

outfore:	sta	numc		save remaining length
	lls	36+18		blank offset is non-blank count
	tze	*+2		don't output zero characters
	tsx7	call_send_chars	output the non-blanks

	adx2	numb		add to white space count
	lda	bltally		get count of blanks
	a9bd	bp|0,al		bump bp past blanks
	ana	=o77777777	mask tally
	neg	0		negate
	ada	numc		subtract from remaining length
	tnz	loop2		if more characters, continue search
	tra	add		if not, bump pointers

" 

skip:	adx2	count		add these characters to white space count
	a9bd	bp|0,au		and step input pointer over them
	tra	add		now add to indices and continue

twoleft:	stq	numc		save offset
	ada	numc		add to remaining length to get count
	tra	outaft		and output characters

noblanks:	adq	1,dl		SCD examined n-1 characters
endblanks:lls	36		character count in A

outaft:	als	18		count in AU
	tsx7	call_send_chars	output text

add:	lda	count		get count of characters
	arl	18		in AL
	asa	inrem		decrement -count of characters remaining
	sbx1	count		decrement space left on output line

zerc:	szn	overflow		did line overflow?
	tnz	endout		if so, stop here

null:	lda	tctally		get character type code
	arl	27		in AL
	tra	dispatch,al	dispatch on it


dispatch:	tra	loop		0: normal character
	tra	bs		1: backspace
	tra	ht		2: horizontal tab
	tra	nl		3: new line
	tra	cr		4: carriage return
	tra	vt		5: vertical tab
	tra	ff		6: form feed
	tra	ignore		7: non-printable character
	tra	ignored		8: ASCII null character
	tra	esc		9: ESC character

" 
" Non-graphic Character Processor.

ignore:	lda	lb|pci.modes	get conversion flags
	cana	pci.ctl_char,du	output control characters?
	tnz	ctl_char		if so, do it
	cana	pci.non_edited,du	edited mode?
	tze	ignored		if edited, ignore this character

	eax1	-4,1		is there enough space left on line?
	tpl	ignore1		if so, continue
	eax1	0		set remaining space to 0
	tra	endout		and force new line

ignore1:	mlr	(pr),(pr)		grab the character
	desc9a	bp|0,1		..
	desc9a	char,1		..

	ldq	char		character in Q(0-8)
	lda	0,dl		clear the A
	lls	3		take character 3 bits at a time
	als	6		with 6 bits of zeroes in between
	lls	3		..
	als	6		..
	lls	3		..
	ora	=a\000		make into legal ASCII
	sta	char		and save

	spribp	save_bp		save input pointer
	eppbp	char		make bp pointer to characters to output
	lda	4,du		set AU to count of 4
	tsx7	call_send_chars	and output the chars
	eppbp	save_bp,*		now restore bp

ignored:	tsx7	stepin1		step input pointer over character
	tra	loop		and continue

ctl_char:	lda	1,du		emit single character
	tsx7	call_send_chars	..
	aos	inrem		.. one less input character now 
	tra	loop		.. and continue

" 
" ESC Character Processor.

esc:	lda	lb|pci.modes	get mode flags
	cana	pci.esc,du	in ESC processing mode?
	tze	ignore		if not, ignore this character

	stz	lb|pci.esc_num	initialize number
	aos	lb|pci.esc_state	set state to 1
	tsx7	stepin1		step to character following ESC
	tze	endin		check for end of input

esc1:	mrl	(pr),(pr),fill(0)	grab the next character
	desc9a	bp|0,1
	desc9a	char,4

	scm	(),(pr)		examine table of ESC functions
	desc9a	esc_functions,1
	desc9a	char(3),1
	arg	sctally
	ttn	bad_esc		if not found, ignore ESC sequence

	aos	lb|pci.esc_state	set state to 2
	lda	sctally		get function code
	als	18		in AU
	stca	lb|pci.esc_state,70	save in state variable

	tsx7	stepin1		step over character
	tze	endin		..

esc2:	mrl	(pr),(pr),fill(0)	grab a character
	desc9a	bp|0,1
	desc9a	char,4

	lda	char		character in A
	cmpa	=o003,dl		ETX?
	tze	esc3		if so, stop gathering digits

	cmpa	=o060,dl		check that it's a numeric character
	tmi	bad_esc		... nope
	cmpa	=o071,dl		...
	tpl	bad_esc		... nope

	ana	=o17,dl		mask to make it a digit
	sta	char		and store
	ldq	lb|pci.esc_num	get number
	mpy	10,dl		insert new digit
	adq	char		..
	stq	lb|pci.esc_num	..

	tsx7	stepin1		step input pointer
	tze	endin		..
	tra	esc2		continue gathering digits

esc3:	tsx7	stepin1		step over ETX

	ldac	lb|pci.esc_state	get and clear state variable
	tra	esc_proc,au*	dispatch on function code

bad_esc:	stz	lb|pci.esc_state	restate state variable
	tra	loop		go back to normal character processing

" 

esc_functions:
	aci	"c"

esc_proc:	arg	skip_to_channel

resume_esc:
	arg	esc1
	arg	esc2
	arg	resume_channel_skip

" 
" Skip to Logical Forms Image Channel.

skip_to_channel:
	lda	lb|pci.esc_num	get number
	sba	1,dl		minus 1
	ldq	=o777000,du	character with all ones in Q
	cana	=o10,dl		if channel <= 8
	tnz	*+2		..
	erq	=o400000,du	test for high-order bit zero
	stq	char		save character for testing

	ana	=o7,dl		take number 0 mod 8
	ldq	=o200000,du	get bit in Q
	qrl	0,al		shift to position
	erq	=o377000,du	complement to make SCM mask
	orq	scm_inst		OR mask into SCM instruction
	stq	instr		save instruction

	lda	lb|pci.line	get current line number in A
	ldq	lb|pci.phys_page_length  remaining lines in Q
	sbq	lb|pci.line	..
	tmi	nl1		this shouldn't happen

scan_lfi:	lls	1		compute character count and offset
	xec	instr		do the SCM
	desc9a	lb|pci.form_stops,ql
	desc9a	char,1
	arg	sctally
	ttf	channel_found	tra if we found channel

	cmpa	0,dl		second scan?
	tze	nl1		if so, cannot find channel
	lda	0,dl		scan first part of image now
	ldq	lb|pci.line	only up to current line
	tra	scan_lfi		..

channel_found:
	ada	sctally		add line offset of discovered channel
	arl	1		compute target line number
	ada	1,dl		..
	cmpa	lb|pci.line	are we too far?
	tpnz	slew_to_line	if not, move paper to there

	cmpa	1,dl		going to top of page?
	tze	ff1		do it
	sta	lb|pci.esc_num	save target line number
	lda	3,dl		set state of 3
	sta	lb|pci.esc_state	..
	tra	ff1		emit FF before slewing to correct line
"		(needn't set ignore_next_ff because this operation isn't done)

resume_channel_skip:
	lda	lb|pci.esc_num	get target line
	stz	lb|pci.esc_state	clear ESC state variable
	tra	slew_to_line	perform slew

scm_inst:	scm	(pr,al,rl),(pr)	SCM for finding logical channel stop

" 
" Backspace Processor.

bs:	aos	cur_level		bump current overstrike level
	lda	cur_level		get in in A
	cmpa	lb|pci.level	is level higher than before?
	tmoz	*+2		if so,
	stc1	overstrike	set overstrike flag

	tsx7	stepin1		step input pointer over BS character
	tsx7	scan		scan more input
	tze	null		if no characters skipped, process special

	eax2	-1,2		decrease count of white space

	lda	cur_level		get current level again
	cmpa	lb|pci.level	is it same?
	tnz	nobs		if not, don't output character

	lda	1,du		output 1 character
	tsx7	call_send_chars	..

	aos	inrem		decrement count of characters remaining
	tra	bsahead		and continue

nobs:	eax2	1,2		count this as white space
	tsx7	stepin1		step over this character

bsahead:	lda	tctally		get tally word from scan
	cmpa	=o001000000001	is character followed by another BS?
	tze	bs		if so, handle next BS
	stz	cur_level		if not, set level back to zero
	tra	loop		and continue

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" Horizontal Tab Processor.

ht:	tsx7	stepin1		step over HT character

	eaa	0,1		Get count of white space remaining
	neg	0		..
	lrs	18+36
	adq	lb|pci.rmarg	add right margin
	sbq	lb|pci.lmarg	now have number of chars from left mrgin
	div	10,dl		Compute tab motion
	sba	10,dl		Compute no of chars to go
	als	18
	sta	numb
	sbx2	numb		increase white space count
	adx1	numb		decrease count of room remaining
	tmi	endout		exit if output line has overflowed
	tra	loop		and continue

" 
" Newline Processor

nl:	tsx7	stepin1		step over NL
	stc2	endline		set end of line flag
	szn	overstrike	check for overstrike
	tnz	strike		..

nl0:	szn	labelsw		processing a label?
	tnz	endlabel		if so, finish up with label

	ldac	lb|pci.func	get function code
	sta	savfunc		save it temporarily
	tra	functbl,al	dispatch on it

functbl:	tra	nl1		0: normal new line
	tra	ff2		1: change NL to FF
	tra	toip		2: change NL to top of inside page
	tra	eop		3: change NL to end of page
	tra	toop		4: change NL to top of outside page


nl1:	ldx7	lb|pci.modes	page overflow suppression mode?
	canx7	pci.overflow_off,du
	tze	nl2		... no

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
" Handle a newline character in -no_endpage mode

	lda	lb|pci.phys_page_length  ... yes
	sba	lb|pci.line	compute lines left on real page

	tsx7	compute_slew_count	see how much we can slew
	tsx6	count_page	... it decided we should eject: just count the page
	tra	slew_by_count	do the slewing

count_page:			" count a page eject
	sta	save_a_temp
	tsx7	bump_page		count going to the next page
	lda	1,dl		1 - slew_count -> pci.line: slew_by_count label will
	sba	save_a_temp	... add the slew_count back causing pci.line to be
	sta	lb|pci.line	... normalized to 1
	lda	save_a_temp
	tra	0,x6


" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
" Handle a newline character when not in -no_endpage mode

nl2:	lda	lb|pci.page_length	compute lines left on logical page
	sba	lb|pci.line	...
	
	tsx7	compute_slew_count	see how much we can slew
	tra	ff2		... it decided we should eject
	tra	slew_by_count	... do the slewing


" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
" Compute the number of lines we can slew on this page: check for consecutive newlines and
"   page overflow;" if a page overflow is not detected, skip return

compute_slew_count:
	sta	numb		save count of lines left on page
	tmoz	cslret		... no more lines: eject the page

	lca	inrem		get count of remaining input chars
	tmoz	cslret		... end of input -- send one NL

	cmpa	numb		possibly more NLs than would fit on the page?
	tmoz	*+2		... no
	lda	numb		... yes: just check for enough to finish the page

	tct	(pr,rl)		look for consecutive NLs
	desc9a	bp|0,al
	arg	nltable
	arg	bltally

	lda	bltally		get result of the verify (input, NL)
	ana	=o77777777	
	tze	cslret		... no consecutive NLs: skip just one

	a9bd	bp|0,al		move past the NLs we are processing now
	asa	inrem		... and note we've done them

cslret:	cmpa	numb		rest of page taken up by NLs?
	tze	*+2		... yes: let caller handle it
	eax7	1,x7		... no: skip return

	ada	1,dl		account for original NL
	tra	0,x7

" 
" Special Function Processors.

toip:	tsx7	bump_page		bump counters to new page

	lda	1,dl		set line number back to 1
	sta	lb|pci.line	..

	lda	toip_pattern,dl	get slew pattern character
	tra	slew_to_pattern	and go do slewing

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

toop:	tsx7	bump_page		bump counters to new page

	lda	1,dl		set line number back to 1
	sta	lb|pci.line	..

	lda	toop_pattern,dl	get slew pattern character
	tra	slew_to_pattern	and do it

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

eop:	tsx7	check_bot_label	see if bottom label should be printed

	ldq	lb|pci.phys_page_length  get paper length
	mpy	lb|pci.sheets_per_page  times number of sheets per page
	lls	36		in A
	sba	4,dl		go 4 lines back
	tra	slew_to_line	will slew to this position

"
" Form Feed Processor.

ff:	tsx7	stepin1		step over FF
	stc2	endline		set end of line flag
	szn	overstrike	check for overstrike
	tnz	strike		..

	ldx7	lb|pci.modes	is single spacing forced?
	canx7	pci.single_space,du  ..
	tnz	nl1		if so, force NL

	canx7	pci.ignore_next_ff,du (pci.modes and pci.flags in same halfword)
	tze	ff1		do the FF if not suppressed

	lda	pci.ignore_next_ff,du
	ana	lb|pci.flags	clear the flags so two FFs
	ersa	lb|pci.flags	...  in a row work properly
	tra	loop		and continue processing (nothing has been output here)

ff1:	tsx7	check_bot_label	see if bottom label should be printed
	tsx7	check_top_label	likewise for top label

	tsx7	bump_page		bump counters to next page
	lda	1,dl		set line # back to 1
	sta	lb|pci.line	..

	lda	ff_pattern,dl	get slew pattern for FF
	tra	slew_to_pattern	and do it

ff2:	lda	pci.ignore_next_ff,du
	orsa	lb|pci.flags	this FF suppresses next one
	tra	ff1

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" Vertical Tab Processor.

vt:	tsx7	stepin1		step over VT
	stc2	endline		set end of line flag
	szn	overstrike	check for overstrike
	tnz	strike		..

	ldx7	lb|pci.modes	is single spacing forced?
	canx7	pci.single_space,du  ..
	tnz	nl1		if so, force NL

	ldq	lb|pci.line	bump line # to next vertical tab stop
	adq	9,dl		..
	div	10,dl		..
	mpy	10,dl		..
	adq	1,dl		..
	lls	36		place in A

	cmpa	lb|pci.page_length	check for page overflow
	tpl	ff1		if overflow, generate FF instead
	tra	slew_to_line	slew to desired line

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" Process Carriage Return.

cr:	tsx7	stepin1		step over CR
	stc2	endline		set end of line flag
	szn	overstrike	check for overstrike
	tnz	strike		..

cr1:	lda	0,dl		space zero lines
	tra	slew_by_count	..

" 
" Label Processors.

check_bot_label:
	lda	lb|pci.page_length	are we past bottom label?
	ada	2,dl		..
	cmpa	lb|pci.line	..
	tmoz	0,7		if so, just return

	ldq	lb|pci.bot_label_length	get length of bottom label
	tze	0,7		return if no label

	eppsb	lb|pci.bot_label_line	sb -> label_line
	tra	setlabel		set up for bottom label


check_top_label:
	ldq	lb|pci.phys_page_length  are we in position for top?
	mpy	lb|pci.sheets_per_page  ..
	lls	36		..
	sba	1,dl		..
	cmpa	lb|pci.line	..
	tmoz	0,7		if not, just return

	ldq	lb|pci.top_label_length	get length of top label
	tze	0,7		return if no label

	eppsb	lb|pci.top_label_line	sb -> label_line
	tra	setlabel		set up for top label


setlabel:	stq	lb|pci.label_nelem	save length of label
	sprisb	lb|pci.label_wksp	save pointer to label

	ldqc	lb|pci.pos	save line position
	stq	lb|pci.sav_pos	..

	ldq	savfunc		get saved function code
	stq	lb|pci.func	and restore it

	sznc	endline		end of line char encountered?
	tze	slew_to_line	if not, go do label

" N.B.:	The following code causes the caller to believe that we have not
"	processed all the input yet.  This prevents him from prematurely
"	returning before prt_conv_ has emitted the label.

	lcq	1,dl		reverse pointer and length
	a9bd	bp|0,ql		..
	asq	inrem		..
	stcq	lb|pci.sav_pos,70	set flag in saved position
	tra	slew_to_line	now slew to correct position

" 
" Overstrike Processor.

strike:	aos	lb|pci.level	bump level up by 1
	lda	savpos		get saved position
	sta	lb|pci.pos	and restore it
	lda	0,dl		slew zero lines
	tspsb	ab|cv_send_slew_count  ..
	lda	pci.ignore_next_ff,du
	ana	lb|pci.flags
	ersa	lb|pci.flags	next user's FF is for real

	tra	exit1		and exit

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" End of Input Processor.

endin:	szn	overstrike	check for overstrike
	tnz	strike		..

	szn	labelsw		label processing?
	tnz	endlabel		if so, handle end of label

	eaa	0,1		get # of spaces remaining on line
	arl	18		in AL
	neg	0		subtract from length of line
	ada	lb|pci.rmarg	..
	sta	lb|pci.pos	and save current position

	tra	cr1		force a carriage return

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" End of Label Processor.

endlabel:	stz	labelsw		turn off label flag
	stz	endline	clear end of line char switch
	stz	lb|pci.label_nelem	zero characters remaining in label

	lda	lb|pci.sav_pos	restore saved line position
	ana	=o777777,dl	..
	sta	lb|pci.pos	..

	eppbp	ap|2,*		set bp -> user's data
	eppbp	bp|0,*		..
	lca	ap|4,*		and get user's character length
	sta	inrem		..

	szn	lb|pci.sav_pos	test for retained last character
	tpl	*+3		if we backed up
	tsx7	stepin1		step over character previously backed over
	stc2	endline		and set flag again

	tra	nl0		go back and process newline char

" 
" Line Overflow Processor.

endout:	szn	overstrike	check for overstrike
	tnz	strike		..

	szn	labelsw		overflow while processing a label?
	tnz	endlabel		if so, force end of label

	ldx7	lb|pci.modes	using truncate mode?
	canx7	pci.truncate,du	..
	tze	endout1		if not, skip following code

truncl:	tsx7	scan		scan some more input
	a9bd	bp|0,au		bump input pointer
	arl	18		and decrement remaining characters
	asa	inrem		..

	lda	tctally		get tally from TCT
	arl	27		character type code in AL
	tra	tdisp,al		dispatch on it


tdisp:	tra	truncl		0: normal character
	tra	endskip		1: backspace
	tra	endskip		2: horizontal tab
	tra	nl		3: new line
	tra	cr		4: carriage return
	tra	vt		5: vertical tab
	tra	ff		6: form feed
	tra	endskip		7: non-printable character
	tra	endskip		8: ASCII null character


endskip:	tsx7	stepin1		step over character
	tra	truncl		and loop, discarding characters

endout1:	eaa	0,1		count of characters remaining in AU
	ars	18		either zero or negative
	neg	0		negate to get indentation on next line
	ada	lb|pci.lmarg	add left margin
	sta	lb|pci.pos	and set position for next call

	tra	nl1		force a new line

"
" Pattern Slew Processor.

slew_to_pattern:
	tspsb	ab|cv_send_slew_pattern  perform slew to VFU pattern
	tra	exit		and exit

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" Count Slew Processor.

slew_to_line:
	sba	lb|pci.line	compute number of lines to slew
	tpl	*+2		make sure it is positive
	lda	0,dl		if negative, make it zero

slew_by_count:
	asa	lb|pci.line	bump current line number
slew_more:tspsb	ab|cv_send_slew_count  slew desired number of lines
	sta	lb|pci.slew_residue	save residue
	lda	pci.ignore_next_ff,du
	ana	lb|pci.flags
	ersa	lb|pci.flags
	tra	exit		and exit

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" End of Line Processor.

exit:	stz	lb|pci.level	set level back to zero
	szn	lb|pci.slew_residue
	tpnz	*+2
	aos	lb|pci.line_count	count one line

	lca	inrem		remaining count of input chars
	szn	labelsw		processing a label?
	tnz	exlabel		if so, don't return pointer and length

	spribp	ap|2,*		return new input pointer
	sta	ap|4,*		and new remaining length
	tra	exit1		..

exlabel:	spribp	lb|pci.label_wksp	save pointer to label
	sta	lb|pci.label_nelem	save remaining length of label

exit1:	sarbb	count		save bb temporarily
	lda	count		get it in A
	sbla	outoff		subtract original offset
	arl	16		number of characters transmitted in AL
	sta	ap|8,*		and return it

	epbpsb	sp|0		restore sb
	return

" 
" Miscellaneous Subroutines.

scan:	lca	inrem		get count of input characters remaining
	tmoz	endin		if zero, input exhausted

	cmpa	131071,dl		use 18-bit arithmetic in many places
	tmoz	*+2		...
	lda	131071,dl		... so never scan too many characters

	tct	(pr,rl)		scan the input
	desc9a	bp|0,al		..
	arg	tctable		..
	arg	tctally		..

	lda	tctally		tally in A
	als	18		place in AU

	tra	0,7		return to caller

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

stepin1:	lda	1,dl		step input pointer by 1
	a9bd	bp|0,al		..
	aos	inrem		and decrement -characters remaining

	tra	0,7		return to caller

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

call_send_chars:			" send chars and reset ignore_next_ff
	tspsb	ab|cv_send_chars	send them
	sta	save_a_temp
	lda	pci.ignore_next_ff,du
	ana	lb|pci.flags
	ersa	lb|pci.flags	reset the flag
	lda	save_a_temp

	tra	0,7		return to caller

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

bump_page:ldq	lb|pci.line	get line #
	adq	lb|pci.phys_page_length  normalize to next page
	sbq	1,dl		..
	div	lb|pci.phys_page_length  compute number of pages
	asq	lb|pci.page_count	and add to page counter

	tra	0,7		return to caller

" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

" Slew Patterns.

	bool	ff_pattern,0	slew pattern for FF
	bool	toip_pattern,13	slew pattern for top inside page
	bool	toop_pattern,11	slew pattern for top outside page

" 
" Character Type Table

tctable:	vfd	9/8,9/7,9/7,9/7,9/7,9/7,9/7,9/7    " 000 - 007
	vfd	9/1,9/2,9/3,9/5,9/6,9/4,9/7,9/7    " 010 - 017
	vfd	9/7,9/7,9/7,9/7,9/7,9/7,9/7,9/7    " 020 - 027
	vfd	9/7,9/7,9/7,9/9,9/7,9/7,9/7,9/7    " 030 - 037

	dup	11			     " 040 - 167
	vfd	9/0,9/0,9/0,9/0,9/0,9/0,9/0,9/0
	dupend

	vfd	9/0,9/0,9/0,9/0,9/0,9/0,9/0,9/8    " 170 - 177

	dup	64-16			     " 200 - 777
	vfd	9/7,9/7,9/7,9/7,9/7,9/7,9/7,9/7
	dupend

" 
" Blank Search Table / Non-blank Verify Table

bltable:	dup	4			     " 000 - 037
	vfd	9/1,9/1,9/1,9/1,9/1,9/1,9/1,9/1
	dupend

	vfd	9/0,9/1,9/1,9/1,9/1,9/1,9/1,9/1    " 040 - 047

	dup	64-4-1			     " 050 - 777
	vfd	9/1,9/1,9/1,9/1,9/1,9/1,9/1,9/1
	dupend

" 
" Newline Search Table

nltable:	vfd	9/1,9/1,9/1,9/1,9/1,9/1,9/1,9/1    " 000 - 007
	vfd	9/1,9/1,9/0,9/1,9/1,9/1,9/1,9/1    " 010 - 017

	dup	64-2			     " 020 - 777
	vfd	9/1,9/1,9/1,9/1,9/1,9/1,9/1,9/1
	dupend

	end




		    prt_status_table_.alm           11/15/82  1855.6rew 11/15/82  1534.9       39357



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


" I/O status table for the line printer

" Created:  1 December 1974 by Noel I. Morris
" Modified: 23 June 1975 by Noel I. Morris
" Modified: April 1979 by R.J.C. Kissel to add major status 0
" Modified: 7 August 1980 by Art Beattie to halt IO after alert before/after printing
"       started errors 
" Modified: June 1981 by Rich Coppola to correct definitions for status 11/2 (MPC
"       attention/DAI) and status 12/3 (MPC data alert/Sum check)
" Modified: 26 November 1981 by G. Palter to fix two bugs from the io_daemon error list:
"      0013: phx02414, phx09537
"	On a local printer, the I/O daemon does not distinguish between the "stacker
"	alert" condition and the "out of paper" condition -- the fix for this bug is
"	simply to change the message for status 3/1 as it is raised for both conditions
"	and not just for out of paper as was thought
"      0028: phx04610
"	A power fault on a local printer will reset the VFC to the default state (6
"	lines/inch).  The entry in prt_status_table_ for "power fault" does not indicate
"	that the VFC and train image are lost -- the fix for this bug is to add a new flag
"	which is used by the printer DIM to indicate a VFC and image reload should be done
"	after the operator readies the printer (the next special interrupt)


	name	prt_status_table_

	include	status_table

	bool	paper_low,000001
	bool	train_image,000002
	bool	vfc_image,000004
	bool	slew_error,000010
	bool	power_fault,000020

" 

	status_table	prt,(1,1,1,1,0,1,0,0,0,0,1,1,0,1,0,0)

" 

	status_entry	1,(Ready)

	substat_entry	1,000000,,(Normal)
	substat_entry	1,000001,,(Print one line)
	substat_entry	1,000010,,(Forward space)
	substat_entry	1,000011,,(Forward to top)
	substat_entry	1,000100,,(Invalid line)
	substat_entry	1,000101,,(Reverse rewind)
	substat_entry	1,000110,,(Backspace)
	substat_entry	1,000111,,(Backspace top)

" 

	status_entry	2,(Device Busy)

" 

	status_entry	3,(Device Attention)

	substat_entry	3,000000,bk+rp+hlt+power_fault,(Power fault)
	substat_entry	3,00XXX1,bk+rp+hlt,(Stacker alert or out of paper)
	substat_entry	3,XXXX1X,in+rp+hlt,(Manual halt)
	substat_entry	3,XXX1XX,in+rp+hlt,(VFU alert)
	substat_entry	3,XX1XXX,in+rp+hlt,(Check alert)
	substat_entry	3,X1XXXX,in+rp+hlt+power_fault,(Power fault)
	substat_entry	3,1XXXXX,in+rp+hlt,(Feed failure)

" 

	status_entry	4,(Device Data Alert)

	substat_entry	4,000000,bk+rp+train_image,(Invalid character code)
	substat_entry	4,XXX0X1,bk+rp,(Transfer timing alert)
	substat_entry	4,XX1XXX,paper_low,(Paper low)
	substat_entry	4,X1XXXX,bk+rp+hlt+slew_error,(Paper motion alert)
	substat_entry	4,1XXXXX,bk,(Top page echo)
	substat_entry	4,0XX01X,bk+rp+hlt,(Alert before printing started)
	substat_entry	4,XXX10X,bk+rp+hlt,(Alert after printing started)

" 

	status_entry	6,(Command Reject)

	substat_entry	6,000000,bk+rp+vfc_image,(No VFC image loaded)
	substat_entry	6,XX0XX1,bk+rp+hlt,(Invalid command)
	substat_entry	6,XX0X1X,bk+rp+hlt,(Invalid device code)
	substat_entry	6,XX01XX,bk+rp,(IDCW parity error)
	substat_entry	6,XX1XXX,bk+rp+train_image,(No train image loaded)
	substat_entry	6,X10XXX,bk+rp+hlt,(Slew error after last operation)
	substat_entry	6,1X0XXX,bk,(Top page echo on last slew)

" 

	status_entry	11,(MPC Attention)

	substat_entry	11,000001,in+rp+hlt,(IAI error)
	substat_entry	11,000010,in+rp+hlt,(DAI error)
	substat_entry	11,000100,in+rp+hlt,(DA Transfer error)

" 

	status_entry	12,(MPC Data Alert)

	substat_entry	12,000001,bk+rp,(Transmission parity error)
	substat_entry	12,000011,bk+rp+hlt,(Sum check error)
	substat_entry	12,000101,bk+rp+hlt,(DAI error)
	substat_entry	12,000110,rp+hlt,(PSI data overflow)

" 

	status_entry	14,(MPC Command Reject)

	substat_entry	14,000001,bk+rp+hlt,(Illegal procedure)
	substat_entry	14,000010,bk+rp+hlt,(Illegal logical channel)
	substat_entry	14,001000,bk+rp+hlt,(Device reserved)

	end




		    prtdim.alm                      11/15/82  1855.6rew 11/15/82  1534.9       11790



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

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

	tra	<prtdim_attach>|[prtdim_attach]
	tra	<prtdim_attach>|[prtdim_detach]
	tra	<ios_>|[no_entry]	"read
	tra	<prtdim_write>|[prtdim_write]
	tra	<ios_>|[no_entry]	"abort
	tra	<prtdim_order>|[prtdim_order]
	tra	<ios_>|[no_entry]	"resetread
	tra	<prtdim_write>|[prtdim_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_changemode>|[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




		    prtdim_attach.pl1               11/15/82  1855.6rew 11/15/82  1521.1       76680



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



/* PRTDIM_ATTACH - Attach/Detach module for the printer DIM.
   coded 10/30/74 by Noel I. Morris	*/
/* Modified: 27 November 1981 by G. Palter to clear new reload_vfc_train_when_ready flag */


prtdim_attach:					/* attach a printer */
     procedure (stream_name, prt, device, mode, iostatus, sdb_ptr);

dcl  stream_name char (*),				/* name of IO stream */
     prt char (*),					/* name of DIM being attached */
     device char (*),				/* printer device name */
     mode char (*),					/* attachment mode */
     iostatus bit (72) aligned;			/* IOS status */

dcl  area_ptr ptr,					/* pointer to system free area */
     listen_based_area area ((16374)) based (area_ptr),	/* area in which to allocate sdb */
     wksp_max fixed bin (19),				/* max size of IOI workspace buffer */
     time_max fixed bin (52),				/* max time for IOI connect to complete */
     rcp_state fixed bin,				/* state variable from check_attach */
     rcode fixed bin (35);				/* error code */

dcl  get_system_free_area_ entry (ptr),
     ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)),
     ipc_$block entry (ptr, ptr, fixed bin (35)),
     ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)),
     convert_ipc_code_ entry (fixed bin (35)),
     rcp_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35)),
     rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (52),
     fixed bin, fixed bin (35)),
     ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35)),
     rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35)),
     prtdim_util$init entry (ptr, fixed bin (35)),
     prtdim_util$load_vfc entry (ptr, fixed bin (35));



/*  */

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

dcl 1 rcp_info like printer_info aligned auto;		/* automatic copy of RCP info structure */

dcl 1 ipc_message aligned,
    2 chname fixed bin (71),				/* Chan over which message arrived */
    2 message fixed bin (71),				/* 2-word event message */
    2 sender bit (36),				/* Sending process */
    2 origin,					/* Origin of event message */
      3 devsignal bit (18),				/* 1 = device signal */
      3 ring bit (18),				/* Senders ring number */
    2 channel_index fixed bin;

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


/*  */

% include prt_sdb;


/*  */

% include rcp_printer_info;

% include prt_info;


/*  */

% include prt_conv_info;

/*  */

% include iom_pcw;

/*  */

	iostatus = "0"b;				/* Clear returned status. */
	if sdb_ptr ^= null () then do;		/* Check for multiple attachments */
	     substr (iostatus, 1, 36) = unspec (error_table_$ionmat); /* If multiple attachment return code */
	     go to exit;
	end;					/* End sdb_ptr not null do group */

	call get_system_free_area_ (area_ptr);		/* Get ptr to area in listen_ before alloc */
	allocate sdb in (listen_based_area) set (sdb_ptr); /* Create stream data block */
	if sdb_ptr = null then do;			/* If this - then no room for sdb */
	     substr (iostatus, 1, 36) = unspec (error_table_$no_room_for_dsb); /* Send message */
	     go to exit;				/* Exit */
	end;					/* End sdb_ptr null do group */

	sdb.areap = area_ptr;			/* Save pointer to free area. */

	outer_module_name = prt;			/* Put name this outer module in sdb */
	device_name_list_ptr = addr (sdb.device_name);	/* Set pointer */
	next_device_ptr = null;			/* Only one device allowed */
	name_size = 32;				/* Set name size */
	name = device;				/* Put attached device name in sdb */
	sdb.stream_name = stream_name;		/* record the name of this attachment */

	call ipc_$create_ev_chn (evchan, rcode);	/* Create event channel so that the supervisor
						   knows who to wake when we are blocked */
	if rcode ^= 0 then do;
	     call convert_ipc_code_ (rcode);
	     go to free1;
	end;
	ev_list.count = 1;				/* Set count in event list. */

	pip = addr (sdb.info);			/* Get pointer to printer info. */
	prt_info.devname = name;			/* Set device name in structure. */

	printer_info_ptr = addr (rcp_info);		/* Get pointer to RCP info for printer. */
	rcp_info.version_num = 1;			/* Set up the RCP info structure. */
	rcp_info.usage_time = 0;			/* Don't know how long we'll use printer. */
	rcp_info.wait_time = 0;			/* We are not willing to wait. */
	rcp_info.system_flag = "0"b;			/* Not system process. */
	rcp_info.device_name = name;			/* Set device name. */

	call rcp_$attach ("printer", printer_info_ptr, evchan, "", rcp_id, rcode);
	if rcode ^= 0 then go to free;		/* Attempt to attach the printer. */

check:	call rcp_$check_attach (rcp_id, printer_info_ptr, "", prt_info.devx, wksp_max, time_max,
	     rcp_state, rcode);			/* Check on progress of attachment. */
	if rcode ^= 0 then go to free;

	go to attach_state (rcp_state);		/* Dispatch on state variable. */

attach_state (1):					/* Short wait needed */
	call ipc_$block (addr (sdb.ev_list), addr (ipc_message), rcode);
	if rcode ^= 0 then do;			/* Wait for attachment to complete. */
	     call convert_ipc_code_ (rcode);
	     go to free;
	end;
	go to check;				/* Perform check again. */

attach_state (2):					/* long wait */
attach_state (3):					/* error occurrence */
	go to free;				/* This is an error condition. */

attach_state (0):					/* Successful attachment */
	prt_info.model = rcp_info.model;		/* Extract info from RCP info structure. */
	prt_info.train = rcp_info.print_train;
	prt_info.line_length = rcp_info.line_length;

	call ioi_$workspace (prt_info.devx, wsegp, 1024, rcode); /* To wire down space for DCW list */
	if rcode ^= 0 then go to free;		/* Check error code */

	call prtdim_util$init (sdb_ptr, rcode);		/* Initialize printer information. */
	if rcode ^= 0 then go to free;		/* If unable to initialize printer ... */

	if mode ^= "save_vfc" then do;		/* are we to load a vfc now? */
	     call prtdim_util$load_vfc (sdb_ptr, rcode);	/* data is in  sdb.conv_info */
	     if rcode = error_table_$no_operation then rcode = 0;
	     else if rcode ^= 0 then go to free;	/* load error */
	end;

	idcwp = addr (prt_info.print_idcw);		/* Get pointer to IDCW for printing. */
	idcw.control = "10"b;			/* Set continue bit in IDCW. */

	stop, bgin, prev = 0;			/* Initialize DCW list pointers. */
	wait_flag = "0"b;				/* Reset waiting for special flag. */
	running = "0"b;				/* Indicate channel not running. */
	marker_count = 0;				/* Clear the marker status counter. */
	paper_low = "0"b;				/* Reset paper low flag. */
	error_count = 0;				/* Clear the error counter. */
	reload_vfc_train_after_special = "0"b;		/* Reset request to reload VFC/train after a special */
	chars_printed = 0;

	return;					/* All finished. */

/*  */

free:
free1:	substr (iostatus, 1, 36) = unspec (rcode);	/* Return error code. */

	go to detach;				/* try to clean up, but retain this error code */
						/* Drop into normal detach code. */


prtdim_detach: entry (sdb_ptr, device, mode, iostatus);	/* Detach entry point */

	iostatus = "0"b;				/* clear the status code */

detach:	call ipc_$delete_ev_chn (evchan, rcode);	/* Delete event channel */
	if rcode ^= 0 then if substr (iostatus, 1, 36) = "0"b then do;
		call convert_ipc_code_ (rcode);
		substr (iostatus, 1, 36) = unspec (rcode);
	     end;

	pip = addr (sdb.info);			/* Get pointer to info structure. */

	call rcp_$detach (rcp_id, "0"b, error_count, "", rcode);
	if rcode ^= 0 then				/* Attempt to detach the device. */
	     if substr (iostatus, 1, 36) = "0"b then	/* report error if none exists */
		substr (iostatus, 1, 36) = unspec (rcode); /* Put error code in return status */

	area_ptr = sdb.areap;			/* Get pointer to area. */
	free sdb in (listen_based_area);		/* Free-up allocated sdb */

exit:	substr (iostatus, 52, 1) = "1"b;		/* Set ioname detached bit */
	substr (iostatus, 41, 1) = "1"b;		/* Set transaction terminated bit */
	return;




     end prtdim_attach;




		    prtdim_changemode.pl1           11/15/82  1855.6rew 11/15/82  1453.1      117756



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



/* Change/return modes for the printer DIM */

/* Created:  28 October 1974 by Noel I. Morris */
/* Modified: 15 March 1977 by Noel I. Morris */
/* Modified: September 1979 by D. Vinograd to add the remote_printer_modes_ entry */
/* Modified: Februrary 1979 by J. Whitmore to fix order dependent if statement bug and check ranges of modes */
/* Rewritten: 9 December 1981 by G. Palter to convert to mode_string_ and add "ctl_char" mode */
/* Modified: 9 August 1982 by G. Palter to not append a newline to the returned old modes string */
/* Modified: 26 August 1982 by G. Palter to make indent=N work */

/* format: style4,delnl,insnl,ifthenstmt,ifthen */


prtdim_changemode:
     procedure (P_sdb_ptr, P_new_modes, P_old_modes, P_iostatus);


/* Parameters */

dcl  P_new_modes character (*) parameter;		/* new modes to be set (if any) */
dcl  P_old_modes character (*) parameter;		/* set to modes in effect prior to change */

dcl  P_sdb_ptr pointer parameter;			/* prtdim_changemode: -> the stream's SDB (data block) */
dcl  P_iostatus bit (72) aligned;			/* prtdim_changemode: set to ios_ status */

dcl  P_iocb_ptr pointer parameter;			/* remote_printer_modes_: -> switch's I/O control block */
dcl  P_code fixed binary (35) parameter;		/* remote_printer_modes_: set to system status code */


/* Local copies of parameters */

dcl  code fixed binary (35);


/* Remaining declarations */

dcl  ios_interface bit (1) aligned;			/* ON => caller used ios_; OFF => caller used iox_ */

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

dcl  (single_page_bit, print_bit) bit (1) aligned;	/* copies to build old modes string */
dcl  stop_every_value fixed binary;
dcl  old_modes_lth fixed binary (21);			/* used to construct old modes string */
dcl  i fixed binary (21);

dcl  (mode_idx, array_idx, idx) fixed binary;
dcl  legal_mode bit (1) aligned;

/* format: off */
dcl  BOOLEAN_MODE_NAMES (-3:8) character (32) static options (constant) initial (
	"in",	     "indent",     "stop",	     "default",	/* -2,-1,0: special cased boolean modes */
	"noskip",	     "single",	"non_edited",  "truncate",	"esc",
	"ctl_char",    "1pg",	"print");

dcl  NUMERIC_MODE_NAMES (1:5) character (32) static options (constant) initial (
	"stop",	     "in",	"indent",	     "ll",	"pl");

dcl  NUMERIC_MODE_RANGES (1:5, 2) fixed binary static options (constant) initial (
	0,	9999,				/* stop:   0 through 9999 */
	0,	 250,				/* in:     0 through  250 */
	0,	 250,				/* indent: 0 through  250 */
	2,	 250,				/* ll:	 2 through  250 */
	2,	 127);				/* pl:	 2 through  127 */
/* format: on */

dcl  error_table_$bad_mode fixed binary (35) external;

dcl  get_system_free_area_ entry () returns (pointer);
dcl  ioa_$rsnnl entry () options (variable);
dcl  mode_string_$parse entry (character (*), pointer, pointer, fixed binary (35));

dcl  (addr, divide, hbound, index, lbound, length, min, null, reverse, rtrim, substr, unspec) builtin;

dcl  cleanup condition;

/**/

/* prtdim_changemode: entry (P_sdb_ptr, P_new_modes, P_old_modes, P_iostatus); */

	ios_interface = "1"b;			/* ios_ calling sequence */

	P_iostatus = ""b;				/* clear returned status */
	substr (P_iostatus, 41, 1) = "1"b;		/* set transaction terminated bit */

	sdb_ptr = P_sdb_ptr;
	adp = null ();				/* iox_ attach description isn't used here */

	pcip = addr (sdb.conv_info);			/* get pointer to conversion info */
	go to COMMON;


/* Change/return modes for a remote printer/teleprinter */

remote_printer_modes_:
     entry (P_iocb_ptr, P_new_modes, P_old_modes, P_code);

	ios_interface = "0"b;			/* iox_ calling sequence */

	P_code = 0;				/* clear return code */

	sdb_ptr = null ();				/* no ios_ stream data block */
	adp = P_iocb_ptr -> iocb.attach_data_ptr;

	pcip = addr (ad.remote_pci);


/* Setup */

COMMON:
	system_area_ptr = get_system_free_area_ ();
	mode_string_info_ptr = null ();		/* for cleanup handler */

	on condition (cleanup)
	     begin;
		if mode_string_info_ptr ^= null () then free mode_string_info in (system_area);
	     end;


/* Build the current mode string and return it to the caller */

	if ios_interface then do;			/* get modes in the attach data ... */
	     single_page_bit = sdb.single_page;
	     print_bit = ^sdb.noprint;
	     stop_every_value = sdb.stop_every;
	end;
	else do;					/* ... for either local or remote printer */
	     single_page_bit = ad.single_page;
	     print_bit = ^ad.noprint;
	     stop_every_value = ad.stop_every;
	end;

	if length (P_old_modes) > 0 then do;		/* only return something if there's some room */
	     call ioa_$rsnnl (
		"^[^;^^^]noskip,^[^;^^^]single,^[^;^^^]non_edited,^[^;^^^]truncate,^[^;^^^]esc,^[^;^^^]ctl_char,^[^;^^^]1pg,^[^;^^^]print,stop=^d,ll=^d,indent=^d,pl=^d."
		, P_old_modes, old_modes_lth, pci.overflow_off, pci.single_space, pci.non_edited, pci.truncate,
		pci.esc, pci.ctl_char, single_page_bit, print_bit, stop_every_value, pci.rmarg, pci.lmarg,
		pci.page_length);
	     if old_modes_lth > length (P_old_modes) then do;
						/* mode string is too long: truncate at nearest mode */
		i = index (reverse (P_old_modes), ","); /* look for the last comma */
		if (i > 0) then			/* returning some modes: turn last "," into a "." */
		     substr (P_old_modes, (length (P_old_modes) - i + 1)) = ".";
		else P_old_modes = "";		/* nothing fits */
	     end;
	end;


/* Process the new modes (if any) */

	if length (rtrim (P_new_modes)) ^= 0 then do;	/* there are new modes ... */

	     call mode_string_$parse (P_new_modes, system_area_ptr, mode_string_info_ptr, code);
	     if code ^= 0 then go to ERROR_RETURN;


/* Validate that all modes are recognized and have valid values */

	     do mode_idx = 1 to mode_string_info.number;
		mode_value_ptr = addr (mode_string_info.modes (mode_idx));
		if mode_value.char_valuep then	/* ... no mode may be a character value */
		     go to BAD_MODE_VALUE;
		else if mode_value.boolean_valuep then do;
		     legal_mode = "0"b;		/* assume it's not valid */
		     do idx = lbound (BOOLEAN_MODE_NAMES, 1) to hbound (BOOLEAN_MODE_NAMES, 1) while (^legal_mode);
			if mode_value.mode_name = BOOLEAN_MODE_NAMES (idx) then legal_mode = "1"b;
		     end;
		     if ^legal_mode then go to BAD_MODE_VALUE;
		     if (mode_value.mode_name = "default") & (^mode_value.boolean_value) then go to BAD_MODE_VALUE;
						/* default mode can not be negated... */
		     if (mode_value.mode_name = "stop") & (mode_value.boolean_value) then go to BAD_MODE_VALUE;
						/* "^stop" is accepted as a synonym of "stop=0" */
		     if (mode_value.mode_name = "in") & (mode_value.boolean_value) then go to BAD_MODE_VALUE;
						/* "^in" is accepted as a synonym of "in=0" */
		     if (mode_value.mode_name = "indent") & (mode_value.boolean_value) then go to BAD_MODE_VALUE;
						/* "^indent" is accepted as a synonym of "indent=0" */
		end;
		else /* if mode_value.numeric_valuep then */ do;
						/* must be a numeric mode */
		     legal_mode = "0"b;		/* assume it's not valid */
		     do idx = lbound (NUMERIC_MODE_NAMES, 1) to hbound (NUMERIC_MODE_NAMES, 1) while (^legal_mode);
			if mode_value.mode_name = NUMERIC_MODE_NAMES (idx) then legal_mode = "1"b;
		     end;
		     if ^legal_mode then go to BAD_MODE_VALUE;
		     idx = idx - 1;			/* that's the nature of PL/I */
		     if (mode_value.numeric_value < NUMERIC_MODE_RANGES (idx, 1))
			| (mode_value.numeric_value > NUMERIC_MODE_RANGES (idx, 2)) then
			go to BAD_MODE_VALUE;
		end;
	     end;


/* Modes are valid: update the I/O switch's data structures to relect the new modes */

	     do mode_idx = 1 to mode_string_info.number;
		mode_value_ptr = addr (mode_string_info.modes (mode_idx));
		if mode_value.boolean_valuep then do;
		     legal_mode = "0"b;
		     do idx = lbound (BOOLEAN_MODE_NAMES, 1) to hbound (BOOLEAN_MODE_NAMES, 1) while (^legal_mode);
			if mode_value.mode_name = BOOLEAN_MODE_NAMES (idx) then do;
			     legal_mode = "1"b;
			     array_idx = idx;
			end;
		     end;
		     if legal_mode then
			go to SET_BOOLEAN_MODE (array_idx);
		     else go to BAD_MODE_VALUE;	/* shouldn't happen, but... */
		end;
		else /* if mode_value.numeric_valuep then */ do;
		     legal_mode = "0"b;
		     do idx = lbound (NUMERIC_MODE_NAMES, 1) to hbound (NUMERIC_MODE_NAMES, 1) while (^legal_mode);
			if mode_value.mode_name = NUMERIC_MODE_NAMES (idx) then do;
			     legal_mode = "1"b;
			     array_idx = idx;
			end;
		     end;
		     if legal_mode then		/* go set it */
			go to SET_NUMERIC_MODE (array_idx);
		     else go to BAD_MODE_VALUE;	/* shouldn't happen, but ... */
		end;
		go to BAD_MODE_VALUE;		/* should never get here */

SET_BOOLEAN_MODE (0):				/* default */
		if ^mode_value.boolean_value then go to BAD_MODE_VALUE;
						/* was already tested, but ... */
		pci.modes = ""b;			/* reset all modes */
		if ios_interface then do;
		     sdb.mode = ""b;
		     sdb.stop_every = 0;
		end;
		else do;
		     ad.output_modes = ""b;
		     ad.stop_every = 0;
		end;
		pci.top_label_length, pci.bot_label_length = 0;
						/* flush any labels */
		pci.rmarg = pci.phys_line_length;	/* reset line and page lengths also */
		pci.lmarg = 0;
		pci.page_length = pci.phys_page_length - pci.lpi;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (1):				/* noskip */
		pci.overflow_off = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (2):				/* single */
		pci.single_space = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (3):				/* non_edited */
		pci.non_edited = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (4):				/* truncate */
		pci.truncate = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (5):				/* esc */
		pci.esc = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (6):				/* ctl_char */
		pci.ctl_char = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (7):				/* 1pg */
		if ios_interface then
		     sdb.single_page = mode_value.boolean_value;
		else ad.single_page = mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (8):				/* print: sets the noprint switch which is the inverse */
		if ios_interface then
		     sdb.noprint = ^mode_value.boolean_value;
		else ad.noprint = ^mode_value.boolean_value;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (-1):				/* "^stop" is equivalent to "stop=0" */
		mode_value.numeric_value = 0;
SET_NUMERIC_MODE (1):				/* stop */
		if ios_interface then do;
		     sdb.stop_every = mode_value.numeric_value;
		     sdb.stop_counter = 0;
		end;
		else do;
		     ad.stop_every = mode_value.numeric_value;
		     ad.stop_counter = 0;
		end;
		go to SET_NEXT_MODE;

SET_BOOLEAN_MODE (-3):				/* "^indent" is equivalent to "indent=0" */
SET_BOOLEAN_MODE (-2):				/* "^in" is equivalent to "in=0" */
		mode_value.numeric_value = 0;
SET_NUMERIC_MODE (2):				/* in */
SET_NUMERIC_MODE (3):				/* indent */
		pci.lmarg = mode_value.numeric_value;
		go to SET_NEXT_MODE;

SET_NUMERIC_MODE (4):				/* ll */
		pci.rmarg = mode_value.numeric_value;
		go to SET_NEXT_MODE;

SET_NUMERIC_MODE (5):				/* pl */
		pci.page_length = mode_value.numeric_value;
		go to SET_NEXT_MODE;

SET_NEXT_MODE:
	     end;

	     free mode_string_info in (system_area);	/* no longer need this data structure */
	     mode_string_info_ptr = null ();
	end;


/* Insure consistency in the prt_conv_info data structure given the new mode settings */

	pci.rmarg = min (pci.rmarg, pci.phys_line_length);/* insure that line is not too long */
	pci.lmarg = min (pci.lmarg, pci.rmarg);		/* left margin must be to left of right margin */

	if pci.overflow_off then do;
	     pci.top_label_length,			/* "noskip" and page labels are inconsistent */
		pci.bot_label_length = 0;
	     pci.sheets_per_page = 1;			/* one sheet per page in noskip mode */
	     pci.page_length = pci.phys_page_length - pci.lpi;
						/* reset logical page length */
	end;

	else					/* if "^noskip" mode ... */
	     pci.sheets_per_page =
		divide (pci.page_length + pci.lpi - 1 + pci.phys_page_length, pci.phys_page_length, 17, 0);
						/* compute physical sheets of paper per page */

	return;


/* Error returns */

BAD_MODE_VALUE:
	code = error_table_$bad_mode;


ERROR_RETURN:
	if mode_string_info_ptr ^= null () then free mode_string_info in (system_area);

	if ios_interface then
	     substr (P_iostatus, 1, 36) = unspec (code);
	else P_code = code;

	return;

/**/

%include prt_sdb;
%page;
%include prt_info;
%page;
%include prt_conv_info;
%page;
%include remote_attach_data;
%page;
%include iocb;
%page;
%include mode_string_info;

     end prtdim_changemode;




		    prtdim_order.pl1                11/15/82  1855.6rew 11/15/82  1521.2       79893



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


prtdim_order: proc (sdb_ptr, request, orderp, iostatus);

/* PRTDIM_ORDER - This is the order call processor for the printer DIM.
   coded 10/29/74 by Noel I. Morris
   modified 3/15/77 by Noel I. Morris
   modified 9/77 by D. Vinograd to add the remote_printer_control_ entry
   modified 6/78 by J. C. Whitmore to add the get_error_count order.
*/


dcl  request char (*),				/* order request */
     a_iocbp ptr,					/* iocb ptr */
     iostatus bit (72) aligned;			/* IOS status bits */

dcl  nelemt fixed bin,				/* for calling ios_ write */
     iocbp ptr,					/* as it says */
     code fixed bin (35),				/* error code */
     a_code fixed bin (35),				/* error code parameter */
     entry fixed bin,				/* entry flag */
     i fixed bin;					/* iteration variable */

dcl  ios fixed bin static options (constant) init (1);	/* entry type */
dcl  iox fixed bin static options (constant) init (2);

dcl  NL char (1) static init ("
");

dcl  VT_or_FF char (2) static init ("");		/* "013" concatenated with "014" */

dcl  error_table_$bad_arg fixed bin (35) ext;
dcl  error_table_$no_operation fixed bin (35) ext;
dcl  error_table_$undefined_order_request fixed bin (35) ext;
dcl  error_table_$inconsistent fixed bin (35) ext;

dcl  ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned),
     prtdim_write$runout entry (ptr, bit (72) aligned),
     prtdim_write$prtdim_resetwrite entry (ptr, bit (72) aligned),
     prtdim_changemode entry (ptr, char (*), char (*), bit (72) aligned),
     prtdim_changemode$remote_printer_modes_ entry (ptr, char (*), char (*), fixed bin (35)),
     prtdim_util$load_vfc entry (ptr, fixed bin (35)),
     init_printer_$reset entry (ptr);

dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35));

dcl (addr, divide, hbound, length, null, reverse, search, substr, unspec, verify) builtin;



% include prt_sdb;
% include prt_info;
% include prt_conv_info;
% include prt_order_info;
% include iocb;
% include remote_attach_data;


	entry = ios;
	iostatus = "0"b;				/* Clear status bits. */
	substr (iostatus, 41, 1) = "1"b;		/* Set transaction terminated bit. */

	pcip = addr (sdb.conv_info);			/* Get pointer to print conversion info. */
	goto common;

remote_printer_control_: entry (a_iocbp, request, orderp, a_code);

	entry = iox;
	a_code = 0;
	iocbp = a_iocbp;
	adp = iocbp -> iocb.attach_data_ptr;
	pcip = addr (ad.remote_pci);

common:

	if request = "inside_page" then		/* Space to top of inside page. */
	     call write_nl (2);

	else if request = "outside_page" then		/* Space to top of outside page */
	     call write_nl (4);

	else if request = "end_of_page" then		/* Position at end of page, below bottom label */
	     call write_nl (3);

	else if request = "page_labels" then do;	/* set page top and bottom labels */
	     if orderp = null () then do;		/* If null, reset labels. */
		pci.top_label_length,
		     pci.bot_label_length = 0;
	     end;

	     else if pci.overflow_off then do;		/* Cannot have labels with overflow off. */
		if entry = ios then
		     substr (iostatus, 1, 36) = unspec (error_table_$inconsistent);
		else a_code = error_table_$inconsistent;
	     end;

	     else do;				/* Set the labels. */
		pci.top_label_line = page_labels.top_label;
		call set_label (pci.top_label_line, pci.top_label_length);

		pci.bot_label_line = page_labels.bottom_label;
		call set_label (pci.bot_label_line, pci.bot_label_length);
	     end;
	end;

	else if request = "reset" then do;		/* Reset modes and counts. */
	     call init_printer_$reset (pcip);
	     if entry = ios then do;
		sdb.mode = "0"b;			/* Clear special printing modes. */
		sdb.stop_every = 0;			/* Reset page stop count. */
		sdb.chars_printed = 0;		/* reset the input char count */
	     end;
	     else do;
		ad.output_modes = "0"b;
		ad.stop_every = 0;
		ad.chars_printed = 0;
	     end;
	end;

	else if request = "get_count" then do;		/* Get lengths and counts. */
	     counts.line = pci.line;
	     counts.page_length = pci.page_length;
	     counts.lmarg = pci.lmarg;
	     counts.rmarg = pci.rmarg;
	     counts.line_count = pci.line_count;
	     counts.page_count = pci.page_count * pci.sheets_per_page;
	end;

	else if request = "get_position" then do;	/* give paper and file position data */
	     position_data.line_number = pci.line;	/* which line we are printing */
	     position_data.page_number = pci.page_count * pci.sheets_per_page; /* which  phys page number */
	     position_data.total_lines = pci.line_count;	/* lines printed since "reset" order */
	     if entry = ios then
		position_data.total_chars = sdb.chars_printed; /* input chars processed since "reset" order */
	     else position_data.total_chars = ad.chars_printed;
	end;

	else if request = "set_position" then do;	/* Set new position counters */
	     pci.line_count = position_data.total_lines;
	     pci.page_count = divide (position_data.page_number, pci.sheets_per_page, 17);
	     if entry = ios then
		sdb.chars_printed = position_data.total_chars;
	     else ad.chars_printed = position_data.total_chars;
	end;

	else if request = "channel_stops" then		/* Set logical channel stops. */
	     do i = 1 to hbound (pci.form_stops, 1);
	     pci.form_stops (i).lbits = "0"b || substr (channel_stops (i), 1, 8);
	     pci.form_stops (i).rbits = "1"b || substr (channel_stops (i), 9, 8);
	end;

	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:		if entry = ios then
		     substr (iostatus, 1, 36) = unspec (error_table_$bad_arg);
		else a_code = 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;

	     if entry = ios then do;
		call prtdim_changemode (sdb_ptr, "", (""), iostatus); /* make modes conform */
		call prtdim_util$load_vfc (sdb_ptr, code);
		if code ^= 0 then
		     substr (iostatus, 1, 36) = unspec (code);
	     end;
	     else do;				/* for the iox case */
		call prtdim_changemode$remote_printer_modes_ (a_iocbp, "", (""), a_code); /* make modes conform */
		a_code = error_table_$no_operation;
	     end;
	end;

	else if request = "runout" then do;		/* Flush remaining output from print buffers. */
	     if entry = ios then
		call prtdim_write$runout (sdb_ptr, iostatus);
	     else a_code = error_table_$no_operation;
	end;

	else if request = "get_error_count" then do;
	     if entry = ios then
		ret_error_count = sdb.error_count;	/* only defined for printer dim */
	     else ret_error_count = 0;		/* no errors for iox */
	end;

	else if request = "resetwrite" then do;
	     if entry = ios then
		call prtdim_write$prtdim_resetwrite (sdb_ptr, iostatus);
	     else a_code = error_table_$no_operation;
	end;

	else do;
	     if entry = ios then
		substr (iostatus, 1, 36) = unspec (error_table_$undefined_order_request);
	     else a_code = error_table_$undefined_order_request;
	end;

	return;



write_nl:	proc (f);

dcl  f fixed bin;					/* function code */

	     pci.func = f;				/* Set correct function code. */
	     if entry = ios then
		call ios_$write (sdb.stream_name, addr (NL), 0, length (NL), nelemt, iostatus);
	     else call iox_$put_chars (iocbp, addr (NL), 1, a_code);
	     pci.func = 0;				/* Make sure function code reset. */

	     return;


	end write_nl;




set_label: proc (line, lth);

dcl  line char (136) aligned,				/* label line */
     lth fixed bin;					/* label length */


	     if line = "" then lth = 0;		/* If line is all blank, length is zero. */

	     else if search (line, VT_or_FF) ^= 0 then do; /* Do not allow VT or FF. */
		lth = 0;				/* Set length to zero. */
		if entry = ios then
		     substr (iostatus, 1, 36) = unspec (error_table_$bad_arg);
		else a_code = error_table_$bad_arg;
	     end;

	     else do;
		lth = 136 + 1 - verify (reverse (line), " ");
	     end;

	     return;


	end set_label;




     end prtdim_order;




		    prtdim_util.pl1                 11/15/82  1855.6rew 11/15/82  1521.4       56079



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* PRTDIM_UTIL - Utility Functions for the Multics rinter DIM.
   coded 6/12/75 by Noel I. Morris			*/


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


prtdim_util$init: proc (sdb_ptr, rcode);

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

dcl  temp_iom_stat bit (72) aligned,			/* temp area to hold iom status */
     load_proc entry (ptr, ptr, entry, fixed bin (35)) variable, /* procedure to load train or VFC image */
     save_buffer (100) fixed bin (35),			/* holding buffer for workspace */
     wseg (100) fixed bin (35) based (wsegp),		/* for saving and restoring workspace */
     ecode fixed bin (35);				/* internal error code */

dcl  ipc_$block entry (ptr, ptr, fixed bin (35)),
     ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)),
     init_printer_ entry (ptr, ptr, entry, fixed bin (35)),
     init_printer_$load_image entry (ptr, ptr, entry, fixed bin (35)),
     init_printer_$load_vfc entry (ptr, ptr, entry, fixed bin (35)),
     analyze_device_stat_ entry (char (*) aligned, ptr, bit (72) aligned, bit (18) aligned),
     analyze_system_fault_ entry (char (*) aligned, bit (72) aligned);

dcl  error_table_$net_timeout fixed bin (35) ext,
     error_table_$no_operation fixed bin (35) ext,
     prt_status_table_$prt_status_table_ ext;

dcl 1 ipc_message aligned,				/* structure for receiving ipc_ message */
    2 chname fixed bin (71),
    2 message fixed bin (71),
    2 sender bit (36),
    2 origin,
      3 devsignal bit (18),
      3 ring bit (18),
    2 channel_index fixed bin;

dcl (addr, addrel, bit, rel, string) builtin;


/*  */


% include prt_sdb;

% include prt_info;


/*  */

% include prt_conv_info;


/*  */

% include iom_pcw;

% include iom_dcw;

/*  */

% include ioi_stat;


/*  */

	pip = addr (sdb.info);			/* Get pointer to printer info. */
	pcip = addr (sdb.conv_info);			/* Get pointer to conversion info. */

	call init_printer_ (pip, pcip, sync_io, rcode);	/* Initialize the printer information. */

	sdb.stop_every,
	     sdb.stop_counter = 0;			/* Initialize page stop counters. */
	sdb.mode = "0"b;				/* Clear all mode bits. */

	return;


/*  */

load_image: entry (sdb_ptr, rcode);


	load_proc = init_printer_$load_image;		/* Set procedure pointer. */
	go to load_join;				/* Join common code. */




load_vfc:	entry (sdb_ptr, rcode);


	load_proc = init_printer_$load_vfc;		/* Set procedure pointer. */

load_join:
	pip = addr (sdb.info);			/* Get pointer to printer info. */
	pcip = addr (sdb.conv_info);			/* Get pointer to conversion info. */

	save_buffer = wseg;				/* Save the contents of the workspace. */

	call load_proc (pip, pcip, sync_io, rcode);	/* Call out to load the train or VFC image. */

	wseg = save_buffer;				/* Restore the workspace. */

	if rcode = 5 then				/* If invalid operation for thi model ... */
	     rcode = error_table_$no_operation;		/* Reflect appropriate error code. */

	return;


/*  */

sync_io:	proc (i, rw, d, l, e);			/* internal proc to do synchronous I/O */

dcl  i bit (36) aligned,				/* IDCW */
     rw bit (2) aligned,				/* RW bits */
     d ptr,					/* pointer to data */
     l fixed bin (12),				/* length of data */
     e bit (1) aligned;				/* error flag */

dcl  sdata (l) fixed bin based,			/* for copying data */
     dp ptr,					/* pointer to place for data */
     b bit (18) aligned;				/* status flags */


	     idcwp = wsegp;				/* Get pointer to place for IDCW. */
	     string (idcw) = i;			/* Copy the IDCW. */

	     dcwp = addrel (idcwp, 1);		/* Get pointer to data xfer DCW. */
	     dp = addrel (dcwp, 1);			/* Get pointer to place for data. */

	     string (dcw) = "0"b;			/* Clear the DCW. */
	     dcw.address = rel (dp);			/* Insert address. */
	     dcw.tally = bit (l);			/* And tally. */

	     if rw & "01"b then			/* If writing ... */
		dp -> sdata = d -> sdata;		/* Copy the data in workspace segment. */

redo_sync:
	     call ioi_$connect (prt_info.devx, 0, ecode); /* Fire up the IOM. */
	     if ecode ^= 0 then do;			/* This should not happen. */
		e = "1"b;
		return;
	     end;


/*  */

sync_wait:
	     call ipc_$block (addr (sdb.ev_list), addr (ipc_message), ecode);
	     if ecode ^= 0 then do;			/* Wait for I/O to complete. */
		e = "1"b;
		return;
	     end;

	     imp = addr (ipc_message.message);		/* get pointer to ioi event message */
	     if imess.level = "111"b then go to redo_sync; /* if this is a special interupt */

	     if imess.st then do;			/* if status is present */
		if imess.time_out then do;		/* if timeout occured */
		     e = "1"b;			/* error occured */
		     ecode = error_table_$net_timeout;	/* caused by time out */
		     return;
		end;

		temp_iom_stat = imess.status;		/* copy status to double word */
		if imess.level = "011"b then do;	/* If termination ... */
		     if imess.er then		/* If error ... */
			call analyze_device_stat_ (prt_info.devname, addr (prt_status_table_$prt_status_table_),
			temp_iom_stat, b);
		end;				/* Analyze the status. */

		else if imess.level = "001"b then	/* If system fault ... */
		     call analyze_system_fault_ (prt_info.devname, temp_iom_stat);

		if imess.er then go to sync_wait;	/* If error, wait for special. */
	     end;
	     else go to sync_wait;			/* If no status, try for more. */

	     if rw & "10"b then			/* If reading ... */
		d -> sdata = dp -> sdata;		/* Copy the data. */

	     e = "0"b;				/* Clear the error switch. */

	     return;				/* Return to caller. */


	end sync_io;




     end prtdim_util$init;




		    prtdim_write.pl1                11/15/82  1855.6rew 11/15/82  1521.5      147834



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



/* Printer DIM write module: responsible for actually sending print lines to the line printer and handling statuses
   returned from the printer by IOI */

/* Created:  31 October 1974 by Noel I. Morris */
/* Modified: 16 March 1977 by Noel I. Morris */
/* Modified: June 1978 by J. C. Whitmore to suppress multiple error messages */
/* Modified: 7 August 1980 by Art Beattie to send error messages every N times and wait */
/* Modified: 27 November 1981 by G. Palter to fix entry number 0028 (phx04610) on the io_daemon error list:
      A power fault on a local printer will reset the VFC to the default state (6 lines/inch).  The entry in
      prt_status_table_ for "power fault" does not indicate that the VFC and train image are lost -- the fix for this bug
      is to add a new flag which is used by the printer DIM to indicate a VFC and image reload should be done after the
      operator readies the printer (the next special interrupt) */


prtdim_write:
     procedure (arg_sdb_ptr, wkspptr, offset, nelem, nelemt, iostatus);

dcl  arg_sdb_ptr ptr,				/* pointer to stream data block */
     wkspptr ptr,					/* pointer to caller's data */
     offset fixed bin (24),				/* offset into caller data */
     nelem fixed bin (24),				/* number of elements to transmit */
     nelemt fixed bin (24),				/* number of elements actually transmitted */
     iostatus bit (72) aligned;			/* IOS status */

dcl  rcode fixed bin (35),				/* error code */
     cur_page fixed bin,				/* current page number */
     lp ptr,					/* pointer to next DCW block */
     prev_lp ptr,					/* pointer to last DCW block */
     dp ptr,					/* pointer to place for data */
     lth fixed bin (18),				/* remaining length of input */
     inptr ptr,					/* pointer to rest of input */
     char_cnt fixed bin (18),				/* count of characters in output */
     word_cnt fixed bin (18),				/* count of words in output */
     temp_iom_stat bit (72) aligned,			/* temp area for iom status */
     errmess char (256) var,				/* error message on bad status */
     tra bit (36) aligned;				/* prototype TDCW */

dcl  last_iom_stat bit (72) aligned;			/* last status an error msg was printed for */
dcl  max_err_stat_count fixed bin init (10) int static options (constant); /* max no. of errors between reporting */
dcl  same_err_stat_count fixed bin;			/* counter for the same error status from printer */

dcl (paper_low_flag init ("000000000000000001"b),		/* status flag for paper low */
     image_flag init ("000000000000000010"b),		/* status flag for destroyed train image */
     vfc_flag init ("000000000000000100"b),		/* status flag for destroyed VFC image */
     slew_error init ("000000000000001000"b),		/* status flag for slew error on prev slew */
     power_fault_flag init ("000000000000010000"b))	/* status flag for power fault */
     bit (18) aligned static options (constant);

dcl  dev_stat_bits bit (72) aligned int static options (constant) /* bits used by analyze_device_stat_ */
     init ("377700770000"b3 || (12) "0"b3);		/* bit string in octal to mask all but */
						/* power, maj, sub, channel and central status bits */
%page;
dcl  prt_conv_ entry (ptr, fixed bin (18), ptr, fixed bin (18), ptr),
     ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)),
     ipc_$block entry (ptr, ptr, fixed bin (35)),
     convert_ipc_code_ entry (fixed bin (35)),
     analyze_device_stat_$rs entry (char (*) var, ptr, bit (72) aligned, bit (18) aligned),
     analyze_system_fault_ entry (char (*) aligned, bit (72) aligned),
     prtdim_util$load_image entry (ptr, fixed bin (35)),
     prtdim_util$load_vfc entry (ptr, fixed bin (35)),
     com_err_ entry options (variable);

dcl  prt_status_table_$prt_status_table_ ext;

dcl  wseg (0:1023) bit (36) aligned based (wsegp);	/* the IOI buffer segment */

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

dcl  error_table_$net_timeout ext fixed bin (35);
dcl  error_table_$request_pending fixed bin (35) ext static;

dcl 1 dcws aligned based (lp),			/* DCW/data block */
    2 idcw bit (36),				/* instruction DCW */
    2 ddcw bit (36),				/* data xfer DCW */
    2 tdcw bit (36),				/* Transfer DCW or terminate DCW */
    2 data;					/* data follows the DCW's */

dcl 1 ipc_message aligned,
    2 chname fixed bin (71),				/* Chan over which message arrived */
    2 message fixed bin (71),				/* 2-word event message */
    2 sender bit (36),				/* Sending process */
    2 origin,					/* Origin of event message */
      3 devsignal bit (18),				/* 1 = device signal */
      3 ring bit (18),				/* Senders ring number */
    2 channel_index fixed bin;

dcl (addr, addrel, bin, bit, divide, rel, string, substr, unspec) builtin;
%page;
% include prt_sdb;
%page;
% include prt_info;
%page;
% include prt_conv_info;


% include ioi_stat;
% include status_flags;

% include iom_pcw;
% include iom_dcw;
%page;
	iostatus = "0"b;				/* Clear IOS status. */

	sdb_ptr = arg_sdb_ptr;			/* Copy pointer to stream data block. */
	pip = addr (sdb.info);			/* Get pointer to printer info structure. */
	pcip = addr (sdb.conv_info);			/* Get pointer to conversion info structure. */
	last_iom_stat = ""b;			/* start clean on each write */
	same_err_stat_count = 0;

	rcode = 0;				/* Clear the error code. */
	nelemt = 0;				/* Zero elements transmitted. */
	lth = nelem;				/* Get initial length of input string. */
	inptr = addr (substr (wkspptr -> wksp, offset+1, 1)); /* Get pointer to input string. */

	do while (lth > 0);				/* Loop until all elements transmitted. */
	     cur_page = pci.page_count;		/* Remember current page count. */

	     if sdb.stop > sdb.bgin then		/* If adding to end of workspace segment ... */
		call set_io;			/* Add some more. */
	     else if sdb.stop + 68 < sdb.bgin then	/* If adding to beginning of workspace segment ... */
		call set_io;
	     else if sdb.prev = sdb.bgin then		/* If cold starting ... */
		call set_io;

	     else					/* Cannot add more lines.  Wait for I/O completion. */
	     call wait_io;

	     if rcode ^= 0 then do;
		substr (iostatus, 1, 36) = unspec (rcode);
		substr (iostatus, 41, 1) = "1"b;
		sdb.chars_printed = sdb.chars_printed + nelem - lth; /* boost the number done */
		return;
	     end;

	     if cur_page ^= pci.page_count then do;	/* If going to a new page ... */
		sdb.stop_counter = sdb.stop_counter + 1; /* Bump the page stop counter. */

		if sdb.single_page | (sdb.stop_every ^= 0 & sdb.stop_counter >= sdb.stop_every) then do;
		     sdb.stop_counter = 0;		/* If time to stop ... */
		     sdb.chars_printed = sdb.chars_printed + nelem - lth; /* boost the number done */
		     substr (iostatus, 1, 36) = unspec (error_table_$request_pending);
		     return;
		end;
	     end;
	end;

	sdb.chars_printed = sdb.chars_printed + nelem - lth; /* boost the number done */
	return;
%page;
set_io:	proc;					/* procedure to set new DCW and data block */


	     lp = addr (wseg (sdb.stop));		/* Get ptr to place for next DCW block. */
	     dp = addr (lp -> dcws.data);		/* Get pointer to place for data. */

	     call prt_conv_ (inptr, lth, dp, char_cnt, pcip); /* Perform code conversion. */
	     word_cnt = divide (char_cnt + 3, 4, 18, 0);	/* Compute number of words to write. */
	     nelemt = nelem - lth;			/* Update the number of elements xmitted. */

	     if sdb.noprint then return;		/* Just return if print suppressed. */

	     dcws.tdcw = prt_info.term_idcw;		/* Set terminator at end of block. */

	     dcwp = addr (dcws.ddcw);			/* Get pointer to data transfer DCW. */
	     string (dcw) = "0"b;			/* Clear the DCW. */
	     dcw.address = rel (dp);			/* Set address to point to data. */
	     dcw.tally = bit (bin (word_cnt, 12));	/* Set tally of DCW. */

	     dcws.idcw = prt_info.print_idcw;		/* Set the IDCW to print line. */

	     if sdb.running then do;			/* If channel is running ... */
		sdb.marker_count = sdb.marker_count + word_cnt; /* Bump the marker count. */
		if sdb.marker_count > 512 then do;	/* If workspace segment more than half filled ... */
		     idcwp = addr (dcws.idcw);	/* Get pointer to IDCW for printing line. */
		     idcw.control = "11"b;		/* Set marker bits in IDCW. */
		     sdb.marker_count = 0;		/* Reset the count. */
		end;
	     end;

	     if sdb.prev ^= sdb.stop then do;		/* If previous line queued ... */
		tdcwp = addr (tra);			/* Get pointer to prototype TDCW. */
		tra = "0"b;			/* Clear it. */
		tdcw.address = bit (bin (sdb.stop, 18)); /* Set target of transfer. */
		tdcw.type = "10"b;			/* Identify as TDCW. */

		prev_lp = addr (wseg (sdb.prev));	/* Get pointer to previous line. */
		prev_lp -> dcws.tdcw = tra;		/* Copy into list. */
	     end;

	     sdb.prev = sdb.stop;			/* Save index to this line. */
	     sdb.stop = sdb.stop + word_cnt + 3;	/* Get offset of first word past current block. */
	     if sdb.stop + 68 >= 1024 then sdb.stop = 0;	/* Lap if buffer size exceeded. */

	     if ^sdb.running then call start_io;	/* If channel stopped, start it up again. */

	     return;


	end set_io;
%page;
start_io:	proc;					/* procedure to start up printer */

	     if ^sdb.wait_flag then if sdb.prev ^= sdb.stop then do; /* If not waiting for special and something to do ... */
		     sdb.marker_count = 0;		/*  Reset marker count. */
		     sdb.running = "1"b;		/* Indicate device now running. */

		     call ioi_$connect (prt_info.devx, sdb.bgin, rcode); /* Fire up the device. */

		end;

	     return;


	end start_io;



wait_io:	proc;					/* procedure to wait for I/O completion */


	     if ^sdb.running then			/* If printer not running ... */
		call start_io;			/* Get it in motion. */

	     call ipc_$block (addr (sdb.ev_list), addr (ipc_message), rcode);
	     if rcode ^= 0 then do;			/* Wait for I/O completion. */
		call convert_ipc_code_ (rcode);
		return;
	     end;

	     call stat_check;			/* Examine status and set flags. */

	     return;


	end wait_io;
%page;
stat_check: proc;					/* Printer status check entry  -  a la Dijkstra */

dcl  flags bit (18) aligned,
     found_dcw bit (1) aligned,
     lx fixed bin (18);

	     flags = "0"b;				/* Clear flags. */

	     imp = addr (ipc_message.message);		/* get pointer to ioi message */
	     if imess.level = "111"b then do;		/* if a special interupt... */
		sdb.wait_flag = "0"b;		/* not waiting any more */
		if sdb.reload_vfc_train_after_special then do;	/* whatever required operator intervention ... */
		     call prtdim_util$load_image (sdb_ptr, (0));	/* ... also destroyed the train and VFC images */
		     call prtdim_util$load_vfc (sdb_ptr, (0));
		     sdb.reload_vfc_train_after_special = "0"b;
		end;
		return;
	     end;

	     if imess.st then do;			/* if status present */
		if imess.time_out then do;		/* if caused by time out */
		     rcode = error_table_$net_timeout;	/* indicate error */
		     sdb.running = "0"b;		/* not running any more */
		     return;
		end;

		if bin (imess.level) <= 5 then do;	/* If terminate, marker, or system fault ... */
		     temp_iom_stat = imess.status;	/* copy status to double word */
		     lx = bin (imess.offset);		/* Copy list index for this status */

		     if imess.er then do;		/* If error occurred ... */
			if imess.level = "001"b then do; /* If system fault ... */
			     call analyze_system_fault_ (prt_info.devname, temp_iom_stat);
			     sdb.wait_flag = "1"b;	/* Wait for operator intervention. */
			     sdb.error_count = sdb.error_count + 1;
			end;
			else do;			/* If terminate ... */
			     call analyze_device_stat_$rs (errmess, addr (prt_status_table_$prt_status_table_),
				temp_iom_stat, flags);

			     if flags & paper_low_flag then
				if pci.overflow_off then /* If in overflow_off mode ... */
				     flags = flags | report_flag | halt_flag;
						/* Stop now to avoid printing on perf. */
				else if ^sdb.paper_low then do; /* Report paper low only once. */
				     sdb.paper_low = "1"b;
				     flags = flags | report_flag;
				end;

			     if flags & power_fault_flag then	/* power fault: VFC/train images no longer valid */
				sdb.reload_vfc_train_after_special = "1"b;

			     if flags & report_flag then do; /* If error should be reported ... */
				sdb.error_count = sdb.error_count + 1;

				if (temp_iom_stat & dev_stat_bits) ^= last_iom_stat then do; /* if not reported */
				     last_iom_stat = (temp_iom_stat & dev_stat_bits); /* save for next error */
				     same_err_stat_count = 1;
				     call com_err_ (0, prt_info.devname, errmess);
				end;
				else do;
				     same_err_stat_count = same_err_stat_count + 1;
						/* Allow only a resonable amount of unreported */
						/* errors to occur.  Then report again. */
						/* Also want to report again if need to wait. */
				     if same_err_stat_count >= max_err_stat_count | (flags&halt_flag) ^= "0"b
				     then do;
					sdb.wait_flag = "1"b;
					call com_err_ (0, prt_info.devname, errmess);
				     end;
				end;
			     end;
			     sdb.wait_flag = ((flags & halt_flag) ^= "0"b) | sdb.wait_flag;
						/* Decide if operator intervention required. */

			     if flags & image_flag then do; /* If train image destroyed ... */
				call prtdim_util$load_image (sdb_ptr, rcode);
				if rcode ^= 0 then return;
			     end;

			     if flags & vfc_flag then do; /* If VFC image destroyed ... */
				call prtdim_util$load_vfc (sdb_ptr, rcode);
				if rcode ^= 0 then return;
			     end;
			end;

			if sdb.wait_flag then do;
			     same_err_stat_count = 0;
			     call com_err_ (0, prt_info.devname, "***** OPERATOR INTERVENTION REQUIRED^/");
			end;

		     end;

		     else				/* If no error ... */
		     sdb.paper_low = "0"b;		/* Reset paper low flag. */

		     idcwp = addr (wseg (lx));	/* Get pointer to last DCW processed. */
		     found_dcw = "0"b;		/* Clear flag. */

		     if flags & backup_flag then do while (idcw.code ^= "111"b);
			lx = lx - 1;		/* Back up to last print IDCW. */
			idcwp = addrel (idcwp, -1);
		     end;

		     else if bin (imess.level) <= 3 then /* If termination status ... */
			do while (^found_dcw);	/* Search for terminate IDCW or TDCW. */
			if string (idcw) = prt_info.term_idcw then do;
			     lx, sdb.prev = sdb.stop; /* If end of list, reset. */
			     found_dcw = "1"b;
			end;
			else if idcw.code = "111"b then do; /* If at print IDCW ... */
			     found_dcw = "1"b;	/* Stay at this point. */
			end;
			else if idcwp -> tdcw.type = "10"b then do;
			     lx = bin (idcwp -> tdcw.address, 18);
			     found_dcw = "1"b;	/* If TDCW, follow the thread. */
			end;
			else do;			/* Must be IOTD DCW. */
			     lx = lx + 1;		/* Step to third DCW slot. */
			     idcwp = addrel (idcwp, 1);
			end;
		     end;
		     else;			/* Don't do anything for marker status. */

		     sdb.bgin = lx;			/* Set new starting point. */
		     sdb.running = imess.run;		/* Set running flag. */
		end;

	     end;

	     return;

	end stat_check;
%page;
prtdim_resetwrite: entry (arg_sdb_ptr, iostatus);		/* entry to scrap unprinted information */


	iostatus = "0"b;

	sdb_ptr = arg_sdb_ptr;
	pip = addr (sdb.info);
	pcip = addr (sdb.conv_info);

	rcode = 0;

	do while (sdb.running);			/* Wait for printer to stop. */
	     call wait_io;
	     if rcode ^= 0 then do;
		substr (iostatus, 1, 36) = unspec (rcode);
		return;
	     end;
	end;

	sdb.prev,
	     sdb.bgin,
	     sdb.stop = 0;				/* Reset all indices. */

	return;					/* Output all scrapped. */
%page;
runout:	entry (arg_sdb_ptr, iostatus);		/* entry to disgorge unprinted information */


	iostatus = "0"b;

	sdb_ptr = arg_sdb_ptr;
	pip = addr (sdb.info);
	pcip = addr (sdb.conv_info);

	rcode = 0;

	do while (sdb.prev ^= sdb.stop);		/* Force connects until all caught up. */
	     call wait_io;				/* Start printer and wait for completion. */
	     if rcode ^= 0 then do;
		substr (iostatus, 1, 36) = unspec (rcode);
		return;
	     end;
	end;

	return;					/* Output all flushed. */



     end prtdim_write;





		    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
