analyze_device_stat_.pl1 09/12/83 1115.8rew 09/12/83 1000.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 02/02/88 1711.7r w 02/02/88 1535.6 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 02/02/88 1711.7rew 02/02/88 1534.1 297333 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1988 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " 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. " HISTORY COMMENTS: " 1) change(87-05-10,Gilcrease), approve(87-07-31,MCR7686), " audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): " Implement eor -nb (line-numbers) option. " END HISTORY COMMENTS " " 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 temp savex2 store x2 tempd dec_ln converted to decimal line-number tempd edited_ln edited line-number char (8) temp el spaces or a + sign for continued line " 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 " insert an edited line-number before each generated print-image " line converted from the input string ldq lb|pci.modes canq pci.line_nbrs,du -number? tze continue btd (pr),(pr) convert line-number to decimal desc9a lb|pci.line_count,4 desc9ns dec_ln,8 mvne (pr),(),(pr) edit converted number desc9ns dec_ln,8 desc9a mop_ctl,1 desc9a edited_ln,8 ldq lb|pci.flags if not eol, then canq pci.eol,du append a + to edited line-number tnz plug_040 else spaces ldq pls_sign append a + sign stq el ldq lb|pci.flags canq pci.eof,du if eol but no eof, tze *+3 append spaces, else a + plug_040: ldq spaces spaces stq el append spaces or + tsx7 reset_eof reset eof switch spribp save_bp save input ptr eppbp edited_ln edited line number lda 10,du pretend 10 non-blank chars stx2 savex2 store x2 eax2 0 no blanks tsx7 call_send_chars output the pattern ldx2 savex2 restore eppbp save_bp,* registers tsx7 reset_eol reset end-of-line flag continue: 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 tsx7 set_eol set eol 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 ldq lb|pci.modes if line_nbrs, don't count canq pci.line_nbrs,du any consecutive NLs tze tct_nls no stz bltally tra load_tally tct_nls: tct (pr,rl) look for consecutive NLs desc9a bp|0,al arg nltable arg bltally load_tally: 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 tsx7 set_eol set eol 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 check_eof ldq lb|pci.modes if -nb canq pci.line_nbrs,du then see if increment tze increment ldq lb|pci.flags if eol flag, canq pci.eol,du then increment tze check_eof no eol flag increment: aos lb|pci.line_count count one line check_eof: szn inrem no characters remain, eof tnz lca characters remain tsx7 set_eof set eof switch lca: 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 " " set/reset flags for eor -number set_eol: lda pci.eol,du eol flag orsa lb|pci.flags set bit tra 0,x7 return reset_eol: lda pci.eol,du eol flag ana lb|pci.flags ersa lb|pci.flags reset bit tra 0,x7 return set_eof: lda pci.eof,du eof bit orsa lb|pci.flags tra 0,x7 reset_eof: lda pci.eof,du eof bit ana lb|pci.flags ersa lb|pci.flags tra 0,x7 " " 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 " mop_ctl: vfd 5/4,4/8 mvzb / 8-characters spaces: oct 040040040040 spaces pls_sign: oct 053040040040 a + sign " 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/04/83 1054.1rew 11/04/83 1046.4 40599 " ****************************************************** " * * " * * " * 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) " Modified 8 July 1983 by E. N. Kittlitz for eurc_nobk flags. " Modified 83-20-24 by E. N. Kittlitz to eliminate eurc_nobk flag on Top page echo due to eurc prom change. 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/04/83 1054.1rew 11/04/83 1046.4 15300 " *********************************************************** " * * " * 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. " " Modified 83-10-20 E. N. Kittlitz for parition of urmpc/eurc support. 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 dispatch_write tra ios_$no_entry "abort tra prtdim_order$prtdim_order tra ios_$no_entry "resetread tra dispatch_resetwrite "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 dispatch_write: epp2 ap|2,* "1st argument pointer epp2 pr2|0,* "sdb pointer lda pr2|sdb.flags ana flags.eurc,du tze prtdim_write$prtdim_write tra prtdim_eurc_write$prtdim_eurc_write dispatch_resetwrite: epp2 ap|2,* "1st argument pointer epp2 pr2|0,* "sdb pointer lda pr2|sdb.flags ana flags.eurc,du tze prtdim_write$prtdim_resetwrite tra prtdim_eurc_write$prtdim_resetwrite include prt_sdb end  prtdim_attach.pl1 02/02/88 1711.7r w 02/02/88 1535.6 120843 /****^ ****************************************************** * * * Copyright (c) 1986 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * ****************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-09,Farley), approve(85-09-09,MCR6979), audit(86-03-08,CLJones), install(86-07-18,MR12.0-1098): Support IMU. 2) change(86-06-04,Hartogs), approve(86-06-04,MCR7383), audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098): Changed to use version constant in rcp_printer_info.incl.pl1. END HISTORY COMMENTS */ /* format: style4 */ /* 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 */ /* Modified September 1983 by E. N. Kittlitz for multi-record IDCWs */ /* Modified October 1983 by E. N. Kittlitz for eurc/urmpc partitioning */ /* Modified January 1985 by Paul Farley for UR-DAI&UR-PDSI IPCs to look like eurc. */ prtdim_attach: /* attach a printer */ procedure (stream_name, prt, device, mode, iostatus, sdb_ptr); dcl stream_name char (*); /* name of IO stream */ dcl prt char (*); /* name of DIM being attached */ dcl device char (*); /* printer device name */ dcl mode char (*); /* attachment mode */ dcl iostatus bit (72) aligned; /* IOS status */ dcl i fixed bin; dcl area_ptr ptr; /* pointer to system free area */ dcl listen_based_area area ((16374)) based (area_ptr); /* area in which to allocate sdb */ dcl wksp_max fixed bin (19); /* max size of IOI workspace buffer */ dcl time_max fixed bin (52); /* max time for IOI connect to complete */ dcl rcp_state fixed bin; /* state variable from check_attach */ dcl rcode fixed bin (35); /* error code */ dcl char_cnt fixed bin (18); dcl 1 ipc_message aligned like event_call_info; dcl 1 rcp_info like printer_info aligned auto; /* automatic copy of RCP info structure */ dcl CR char (1) init (" ") int static options (constant); dcl get_system_free_area_ entry (ptr); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl rcp_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35)); dcl rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (52), fixed bin, fixed bin (35)); dcl init_printer_$reset entry (ptr); dcl ioi_$set_status entry (fixed bin, fixed bin (18), fixed bin (8), fixed bin (35)); dcl ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35)); dcl rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35)); dcl prt_conv_ entry (ptr, fixed bin (18), ptr, fixed bin (18), ptr); dcl prtdim_util$init entry (ptr, fixed bin (35)); dcl prtdim_eurc_util$init entry (ptr, fixed bin (35)); dcl prtdim_eurc_util$initialize_workspace entry (ptr); dcl prtdim_util$load_vfc entry (ptr, fixed bin (35)); dcl prtdim_eurc_util$load_vfc entry (ptr, fixed bin (35)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl config_$find entry (char (4) aligned, ptr); dcl config_$find_periph entry (char (4) aligned, ptr); dcl error_table_$bigarg fixed bin (35) ext static; dcl error_table_$ionmat fixed bin (35) ext; dcl error_table_$no_room_for_dsb fixed bin (35) ext; dcl error_table_$no_operation fixed bin (35) ext; dcl config_deck$ ext; dcl (addr, addrel, null, ptr, rel, substr, unspec) builtin; %page; 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 */ sdb.name = device; /* Put attached device name in sdb */ sdb.stream_name = stream_name; /* record the name of this attachment */ call ipc_$create_ev_chn (sdb.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 = substr (sdb.name, 1, 4); /* Set device name in structure. */ printer_info_ptr = addr (rcp_info); /* Get pointer to RCP info for printer. */ rcp_info.version_num = PRINTER_INFO_VERSION_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 = substr (sdb.name, 1, 8); /* Set device name. */ call rcp_$attach ("printer", printer_info_ptr, sdb.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 set_mpc_type; if ^sdb.flags.eurc then wksp_max = 1024; /* old URMPC dim */ else wksp_max = min (2048, wksp_max); /* biggest we'll ever want */ sdb.data_end = wksp_max; /* first approximation of circular dataspace end */ call ioi_$workspace (prt_info.devx, sdb.wsegp, (wksp_max), rcode); /* To wire down space for DCW list */ if rcode ^= 0 then go to free; /* Check error code */ if sdb.flags.eurc then do; /* fancy dim, more initializing */ sdb.max_dcw_size = 65; /* should calculate what prt_conv_ would do */ if wksp_max < 2048 then sdb.max_dcws, sdb.n_dcws = 32; /* about 2 seconds/buffer at 1000LPM */ else sdb.max_dcws, sdb.n_dcws = 62; /* 1 less than idcw max */ sdb.max_buffers, sdb.n_buffers = 3; prt_bufferp = addr (prt_buffers (0)); sdb.data_end = sdb.data_end - size (null () -> istat); call ioi_$set_status (prt_info.devx, (sdb.data_end), 1, rcode); if rcode ^= 0 then go to free; sdb.status_ptr = ptr (wsegp, sdb.data_end); sdb.data_end = sdb.data_end - 1; /* keep one word for prtdim_eurc_util$finish_abort */ sdb.data_begin, sdb.bgin, sdb.stop = size (prt_buffers); sdb.b_begin, sdb.b_stop = 0; call prtdim_eurc_util$init (sdb_ptr, rcode); /* Initialize printer information. */ if rcode ^= 0 then go to free; /* If unable to initialize printer ... */ pcip = addr (sdb.conv_info); call prt_conv_ (addr (CR), 1, wsegp, char_cnt, pcip); /* for prtdim_eurc_util$finish_abort */ if char_cnt > 4 then do; /* we only have 1 word to spare for this */ rcode = error_table_$bigarg; go to free; end; sdb.null_line_data = wseg (0); /* remember it, always */ dcwp = addr (sdb.null_line_dcw); /* make the 'null' dcw */ string (dcw) = ""b; dcw.address = bit (sdb.data_end); /* 1 word between end of data and ioi status area */ dcw.tally = bit (bin (1, 12), 12); /* 1 word, that is to say 1 */ call init_printer_$reset (pcip); /* clear any line/page count caused by above */ if mode ^= "save_vfc" then do; call prtdim_eurc_util$load_vfc (sdb_ptr, rcode); if rcode = error_table_$no_operation then rcode = 0; else if rcode ^= 0 then go to free; /* load error */ end; end; /* EURC */ else do; sdb.data_begin, sdb.bgin, sdb.stop = 0; 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; end; idcwp = addr (prt_info.print_idcw); /* Get pointer to IDCW for printing. */ if sdb.flags.eurc then idcw.control = "00"b; /* no continue or marker in IDCW. */ else idcw.control = "10"b; /* continue */ sdb.prev = 0; /* Initialize DCW list pointers. */ sdb.wait_flag = "0"b; /* Reset waiting for special flag. */ sdb.running = "0"b; /* Indicate channel not running. */ sdb.marker_count = 0; /* Clear the marker status counter. */ sdb.paper_low = "0"b; /* Reset paper low flag. */ sdb.error_count = 0; /* Clear the error counter. */ sdb.reload_vfc_train_after_special = "0"b; /* Reset request to reload VFC/train after a special */ sdb.chars_printed = 0; sdb.aborting = "0"b; sdb.version = 1; if sdb.flags.eurc then call prtdim_eurc_util$initialize_workspace (sdb_ptr); /* setup buffer headers, etc. */ return; /* All finished. */ %page; 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 timer_manager_$reset_alarm_wakeup (sdb.evchan); call ipc_$delete_ev_chn (sdb.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; %page; /* determine the type of MPC through which we are talking. */ set_mpc_type: proc; call config_$find_periph (substr (sdb.name, 1, 4), prph_prt_cardp); if prph_prt_cardp = null then return; /* oh, well */ mpc_cardp = null; do while ("1"b); call config_$find ("mpc", mpc_cardp); /* next MPC card */ if mpc_cardp = null then do; /* If no MPC card found for this device, assume that it is connected to a IPC controller, that works like the EURC. */ sdb.flags.eurc = "1"b; return; end; if mpc_card.port (1).iom = prph_prt_card.iom & /* an eurc only has one port... */ mpc_card.port (1).chan <= prph_prt_card.chan & prph_prt_card.chan < mpc_card.port (1).chan + mpc_card.port (1).nchan then do; do i = 1 to hbound (eurc_model_numbers, 1); if mpc_card.model = eurc_model_numbers (i) then do; sdb.flags.eurc = "1"b; return; end; /* it's an eurc */ end; /* checking model number */ return; end; /* channel belongs to this MPC */ end; /* while "1"b */ end set_mpc_type; /* format: off */ %page; %include config_mpc_card; %page; %include config_prph_prt_card; %page; %include eurc_model_numbers; %page; %include event_call_info; %page; %include ioi_stat; %page; %include iom_dcw; %page; %include iom_pcw; %page; %include prt_sdb; %page; %include prt_info; %page; %include prt_conv_info; %page; %include rcp_printer_info; end prtdim_attach;  prtdim_changemode.pl1 10/28/88 1414.7r w 10/28/88 1256.6 129942 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* 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 */ /* Modified: 25 June 1984 by C. Marker changed so that the left margin must be to the left of the right margin or an error code is returned. */ /****^ HISTORY COMMENTS: 1) change(87-05-11,Gilcrease), approve(87-07-31,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Added the line numbers (line_nbrs) mode. END HISTORY COMMENTS */ /* 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 save_rmarg fixed bin static; dcl BOOLEAN_MODE_NAMES (-3:9) 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", "line_nbrs", "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 error_table_$inconsistent 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,^[^;^^^]line_nbrs,^[^;^^^]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, pci.line_nbrs, 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): /* line_nbrs */ pci.line_nbrs = mode_value.boolean_value; if pci.line_nbrs then do; /* set */ save_rmarg = pci.rmarg; pci.rmarg = min (pci.rmarg - 10, pci.phys_line_length -10 ); pci.line_count = 1; pci.eol = "1"b; pci.eof = "0"b; end; else do; pci.rmarg = save_rmarg; end; go to SET_NEXT_MODE; SET_BOOLEAN_MODE (8): /* 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 (9): /* 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 */ if pci.lmarg >= pci.rmarg then do; /* left margin must be to left of right margin */ code = error_table_$inconsistent; if length (P_old_modes) > 0 then /* only return something if there's some room */ call ioa_$rsnnl ("ll=^d,indent=^d.", P_old_modes, old_modes_lth, pci.rmarg, pci.lmarg); goto ERROR_RETURN; end; 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_eurc_util.pl1 02/02/88 1711.7r w 02/02/88 1541.5 86850 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* format: style4 */ /* PRTDIM_UTIL - Utility Functions for the Multics printer DIM. coded 6/12/75 by Noel I. Morris */ /* modified for new DIM buffer strategy, 9/2/83, E. N. Kittlitz */ /* copied to prtdim_eurc_util for eurc/urmpc partitioning, 83-10-20, E. N. Kittlitz */ prtdim_eurc_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 */ dcl load_proc entry (ptr, ptr, entry, fixed bin (35)) variable; /* procedure to load train or VFC image */ dcl save_buffer (100) fixed bin (35); /* holding buffer for workspace */ dcl wseg_low (100) fixed bin (35) based (sdb.wsegp); /* for saving and restoring workspace */ dcl 1 l_event_call_info aligned like event_call_info; dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl init_printer_ entry (ptr, ptr, entry, fixed bin (35)); dcl init_printer_$load_image entry (ptr, ptr, entry, fixed bin (35)); dcl init_printer_$load_vfc entry (ptr, ptr, entry, fixed bin (35)); dcl analyze_device_stat_ entry (char (*) aligned, ptr, bit (72) aligned, bit (18) aligned); dcl analyze_system_fault_ entry (char (*) aligned, bit (72) aligned); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl error_table_$net_timeout fixed bin (35) ext; dcl error_table_$no_operation fixed bin (35) ext; dcl error_table_$io_no_permission fixed bin (35) ext static; dcl prt_status_table_$prt_status_table_ ext; dcl (addr, addrel, bit, rel, string) builtin; %page; pip = addr (sdb.info); /* Get pointer to printer info. */ pcip = addr (sdb.conv_info); /* Get pointer to conversion info. */ if sdb.aborting then do; rcode = error_table_$io_no_permission; return; end; 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; %page; prtdim_eurc_util$load_image: entry (sdb_ptr, rcode); if sdb.aborting then do; rcode = error_table_$io_no_permission; return; end; load_proc = init_printer_$load_image; /* Set procedure pointer. */ go to load_join; /* Join common code. */ prtdim_eurc_util$load_vfc: entry (sdb_ptr, rcode); if sdb.aborting then do; rcode = error_table_$io_no_permission; return; end; 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_low; /* Save the contents of the workspace. */ call load_proc (pip, pcip, sync_io, rcode); /* Call out to load the train or VFC image. */ wseg_low = 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; %page; /* finish_abort tries to quiesce the printer and obtain a known (idle) state. It does this by changing all print IDCWs to be reset-status (terminates). It also patches all DCWs to be 1 word IOTDs, with the target being the last word of data space. That word contains a null line (i.e. the prt_conv_ equivalent of a carriage return. As a result, if the printer is running, it should stop pretty fast. After we have a terminate status, or our patience runs out, we try to do a reset status. */ prtdim_eurc_util$finish_abort: entry (sdb_ptr); dcl stop_tries fixed bin; dcl wait_count fixed bin; dcl abort_status bit (1) aligned; pip = addr (sdb.info); /* Get pointer to printer info. */ pcip = addr (sdb.conv_info); /* Get pointer to conversion info. */ do stop_tries = 1 to 2; prt_buffers (*).ddcw (*) = sdb.null_line_dcw;/* clobber dcws to null line */ prt_buffers (*).idcw = prt_info.term_idcw; if sdb.running then do wait_count = 1 to 10 while (sdb.running); /* max of 63 lines at 10LPS should fit */ call timer_manager_$sleep (1, "11"b); /* 1 second */ isp = sdb.status_ptr; statp = addr (istat.iom_stat); if istat.st & ^status.marker then /* looks stopped to me, Ma */ sdb.running = "0"b; end; /* wait_count */ sdb.running = "0"b; /* well, lie about it */ call sync_io (prt_info.term_idcw, "00"b, null (), 0, abort_status); /* see if it is */ if ^abort_status then do; /* seems to have worked */ call prtdim_eurc_util$initialize_workspace (sdb_ptr); sdb.aborting = "0"b; return; end; else sdb.running = "1"b; /* try again */ end; /* tries */ return; %page; prtdim_eurc_util$initialize_workspace: entry (sdb_ptr); dcl i fixed bin; unspec (wseg) = ""b; do i = 0 to sdb.max_buffers - 1; prt_buffers (i).busy = ""b; prt_buffers (i).number = i; prt_buffers (i).dcw_count = 0; end; wseg (sdb.data_end) = sdb.null_line_data; /* that's it there, officer */ return; %page; sync_io: proc (i, rw, d, l, e); /* internal proc to do synchronous I/O */ dcl i bit (36) aligned; /* IDCW */ dcl rw bit (2) aligned; /* RW bits */ dcl d ptr; /* pointer to data */ dcl l fixed bin (12); /* length of data */ dcl e bit (1) aligned; /* error flag */ dcl b bit (18) aligned; /* status flags */ dcl dp ptr; /* pointer to place for data */ dcl ecode fixed bin (35); /* internal error code */ dcl timer_rang bit (1) aligned; dcl l_timer_message char (8) based; dcl sdata (l) fixed bin based; /* for copying data */ if sdb.running then do; e = "1"b; return; end; idcwp = sdb.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 ipc_$drain_chn (sdb.evchan, ecode); /* no leftover nonsense */ if ecode ^= 0 then do; /* shouldn't happen */ e = "1"b; go to sync_io_return; end; call ioi_$connect (prt_info.devx, 0, ecode); /* Fire up the IOM. */ if ecode ^= 0 then do; /* might be if we are aborting */ e = "1"b; go to sync_io_return; end; %page; timed_sync_wait: call timer_manager_$alarm_wakeup (30, "11"b, sdb.evchan); /* 30 seconds, more than enough... */ sync_wait: call ipc_$block (addr (sdb.ev_list), addr (l_event_call_info), ecode); call timer_manager_$reset_alarm_wakeup (sdb.evchan); /* be sure it won't happen */ if ecode ^= 0 then do; /* Wait for I/O to complete. */ e = "1"b; go to sync_io_return; end; imp = addr (l_event_call_info.message); /* get pointer to ioi event message */ if imp -> l_timer_message = "alarm___" then timer_rang = "1"b; else do; timer_rang = "0"b; if imess.st & /* IPC message looks like valid ioi wakeup */ bin (imess.level) = IO_SPECIAL_INTERRUPT_LEVEL then go to redo_sync; /* if this is a special interupt */ end; isp = sdb.status_ptr; if istat.st then do; /* if status is present */ if istat.time_out then do; /* if timeout occured */ e = "1"b; /* error occured */ ecode = error_table_$net_timeout; /* caused by time out */ go to sync_io_return; end; temp_iom_stat = istat.iom_stat; /* copy status to double word */ if istat.level = IO_TERMINATE_INTERRUPT_LEVEL then do; /* If termination ... */ if istat.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 istat.level = IO_SYSTEM_FAULT_INTERRUPT_LEVEL then /* If system fault ... */ call analyze_system_fault_ (prt_info.devname, temp_iom_stat); if istat.er then go to sync_wait; /* If error, wait for special. */ end; else do; /* no status found */ if timer_rang then do; e = "1"b; go to sync_io_return; end; go to timed_sync_wait; /* bogus wakeup, but someone's alive. let's wait some more */ end; if rw & "10"b then /* If reading ... */ d -> sdata = dp -> sdata; /* Copy the data. */ e = "0"b; /* Clear the error switch. */ sync_io_return: sdb.status_ptr -> istat.st = "0"b; /* flush workspace status */ return; /* Return to caller. */ end sync_io; /* format: off */ %page; %include event_call_info; %page; %include interrupt_levels; %page; %include ioi_stat; %page; %include iom_dcw; %page; %include iom_pcw; %page; %include iom_stat; %page; %include prt_sdb; %page; %include prt_info; %page; %include prt_conv_info; end prtdim_eurc_util$init;  prtdim_eurc_write.pl1 02/02/88 1711.7r w 02/02/88 1541.6 251118 /* ****************************************************** * * * * * 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) */ /* Modified September 1983 by E. N. Kittlitz. Rewritten for multi-record IDCWs, no chaining or markers */ /* Modified 83-10-20 by E. N. Kittlitz for eurc/urmpc partitioning */ /* Modified 83-11-01 by E. N. Kittlitz for quit protection. Note that quit is the most likely IPS in the daemon environement which could result in further I/O to the attachment. The older prtdim and the new prtdim_eurc_util do not have IPS/quit-only protection. */ /* format: style4 */ prtdim_eurc_write: procedure (arg_sdb_ptr, wkspptr, offset, nelem, nelemt, iostatus); dcl arg_sdb_ptr ptr; /* pointer to stream data block */ dcl wkspptr ptr; /* pointer to caller's data */ dcl offset fixed bin (24); /* offset into caller data */ dcl nelem fixed bin (24); /* number of elements to transmit */ dcl nelemt fixed bin (24); /* number of elements actually transmitted */ dcl iostatus bit (72) aligned; /* IOS status */ dcl rcode fixed bin (35); /* error code */ dcl cur_page fixed bin; /* current page number */ dcl linep ptr; /* pointer to place for data */ dcl lth fixed bin (18); /* remaining length of input */ dcl inptr ptr; /* pointer to rest of input */ dcl errmess char (256) var; /* error message on bad status */ dcl n_dcws fixed bin; dcl unclean bit (1) aligned; /* true if critical operation in progress */ dcl quit_pending bit (1) aligned; 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 1 l_event_call_info aligned like event_call_info; 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 automagic bit (1) aligned init ("0"b); 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 */ dcl TIMEOUT fixed bin (71) init (180000000) int static options (constant); /* allow for any polling plus up to 63 lines */ dcl based_word bit (36) aligned based; dcl wksp char (1) based unal; /* used for getting pointer to input string */ dcl prt_conv_ entry (ptr, fixed bin (18), ptr, fixed bin (18), ptr); dcl ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)); dcl ioi_$get_special_status entry (fixed bin, bit (1) aligned, bit (36) aligned, fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl analyze_device_stat_$rs entry (char (*) var, ptr, bit (72) aligned, bit (18) aligned); dcl analyze_system_fault_ entry (char (*) aligned, bit (72) aligned); dcl prtdim_eurc_util$finish_abort entry (ptr); dcl prtdim_eurc_util$load_image entry (ptr, fixed bin (35)); dcl prtdim_eurc_util$load_vfc entry (ptr, fixed bin (35)); dcl com_err_ entry options (variable); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl prt_status_table_$prt_status_table_ ext; dcl error_table_$data_loss fixed bin (35) ext static; dcl error_table_$net_timeout ext fixed bin (35); dcl error_table_$request_pending fixed bin (35) ext static; dcl (addr, addrel, bin, bit, clock, divide, mod, null, rel, stackbaseptr, stackframeptr, stacq, string, substr, unspec, wordno) builtin; dcl (cleanup, quit) condition; %page; unclean = "1"b; /* pretty unsophisto, huh? */ 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. */ isp = null; statp = null; imp = null; rcode = 0; /* Clear the error code. */ call set_status (0, iostatus); /* initialize status */ nelemt = 0; /* Zero elements transmitted. */ quit_pending = ""b; on cleanup call tidy_up; on quit call process_quit; if sdb.aborting then do; /* this shouldn't happen */ call finish_abort; /* foo! no i/o */ go to write_returns; end; last_iom_stat = ""b; /* start clean on each write */ same_err_stat_count = 0; lth = nelem; /* Get initial length of input string. */ inptr = addr (substr (wkspptr -> wksp, offset + 1, 1)); /* Get pointer to input string. */ n_dcws = 0; prt_bufferp = null; do while (lth > 0); /* Loop until all elements transmitted. */ if quit_pending then do; /* someone hit QUIT */ if n_dcws > 0 then call close_buffer; /* stop any work in progress */ if sdb.running then call wait_io; /* wait for device to quiesce */ quit_pending = "0"b; /* flag QUIT resignalled */ revert quit; /* suspend handler */ signal quit; /* resignal */ on quit call process_quit; /* re-establish handler */ if rcode ^= 0 then go to write_returns; /* from wait_io */ end; if n_dcws >= sdb.n_dcws then call close_buffer; cur_page = pci.page_count; /* Remember current page count. */ if prt_bufferp = null then call get_buffer (prt_bufferp, linep); else do; linep = get_line_space (); if linep = null then call close_buffer; end; if prt_bufferp ^= null then call set_io; else call wait_io; if rcode ^= 0 then go to write_returns; 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; if n_dcws > 0 then call close_buffer; sdb.stop_counter = 0; /* If time to stop ... */ call set_status (error_table_$request_pending, iostatus); go to write_returns; end; end; end; if n_dcws > 0 then call close_buffer; write_returns: revert quit; /* no more protection needed */ if quit_pending then do; /* any QUITs at last minute? */ quit_pending = "0"b; /* be tidy */ signal quit; /* resignal */ end; sdb.chars_printed = sdb.chars_printed + nelem - lth; /* boost the number done */ if rcode = 0 then do; /* no nasty problems */ if ^sdb.running & prt_buffers (sdb.b_begin).busy then /* something to print */ call start_io; /* try to start printer */ if rcode ^= 0 then call set_status (rcode, iostatus); /* preserve status of request_pending unless error */ end; else call set_status (rcode, iostatus); return; %page; /* close buffer plops in the IDCW */ close_buffer: proc; dcl i fixed bin; dcl prevb fixed bin; if n_dcws > sdb.max_dcws | n_dcws <= 0 then call abort ("close_buffer: n_dcws is outrageous"); if prt_buffer.busy then call abort ("closing busy buffer"); idcwp = addr (prt_buffer.idcw); unspec (idcw) = prt_info.print_idcw; idcw.chan_cmd = "06"b3; /* multi-record */ idcw.count = bit (bin (n_dcws, 6), 6); prt_buffer.dcw_count = n_dcws; prt_buffer.data_ends = sdb.stop; do i = n_dcws + 1 to hbound (prt_buffer.ddcw, 1); prt_buffer.ddcw (i) = sdb.null_line_dcw; end; n_dcws = 0; if sdb.b_stop = prt_buffer.number then do; if sdb.b_stop ^= sdb.b_begin then call abort ("close buffer not first"); end; else do; if prt_buffer.number ^= mod (sdb.b_stop + 1, sdb.n_buffers) then call abort ("close buffer circular buffer error"); sdb.b_stop = prt_buffer.number; end; prt_buffer.busy = "1"b; prt_bufferp = null; end close_buffer; %page; /* buffer management is not a strict circular buffer because we don't want to waste a buffer entry just for circular buffer discipline. So... Note that the code is capable of coping with 1 - N buffers. */ get_buffer: proc (a_bufferp, a_linep); dcl a_bufferp ptr; dcl a_linep ptr; dcl n fixed bin; a_bufferp = null; a_linep = get_line_space (); if a_linep = null then return; /* no line space, why bother */ n = mod (sdb.b_stop + 1, sdb.n_buffers); if prt_buffers (sdb.b_stop).busy then /* some busy buffers */ if prt_buffers (n).busy then return; /* no free buffer */ else a_bufferp = addr (prt_buffers (n)); /* use next buffer */ else if sdb.b_stop ^= sdb.b_begin then /* check that we're really idle */ call abort ("get_buffer stop^=begin, stop ^busy"); else do; a_bufferp = addr (prt_buffers (sdb.b_stop)); /* idle, use this one */ end; do n = sdb.b_begin to sdb.b_stop; if ^prt_buffers (n).busy then if n = sdb.b_begin & sdb.b_begin = sdb.b_stop then ; else call abort ("get buffer circular error"); end; end get_buffer; %page; /* try to get data space in the data portion of the workspace. This is managed as a circular buffer. */ get_line_space: proc returns (ptr); if sdb.stop >= sdb.bgin then do; /* not wrapped, maybe empty */ if sdb.stop + sdb.max_dcw_size > sdb.data_end then /* no room at top end */ if sdb.data_begin + sdb.max_dcw_size >= sdb.bgin then /* no room at beginning */ return (null); else do; /* wrap around */ if sdb.stop = sdb.bgin then /* if empty */ sdb.bgin = sdb.data_end; /* keep it empty */ sdb.stop = sdb.data_begin; /* wrap stop location */ end; else ; /* use top end */ end; /* sdb.stop > sdb.bgin */ else if sdb.stop + sdb.max_dcw_size >= sdb.bgin then /* crash into old stuff */ return (null); return (addr (wseg (sdb.stop))); /* where to put it */ end get_line_space; %page; /* handle the QUIT condition */ process_quit: proc; dcl continue_to_signal_ entry (fixed bin (35)); if sdb.wait_flag then /* no i/o in progress, blast it through */ call continue_to_signal_ ((0)); else quit_pending = "1"b; end process_quit; %page; /* convert the input to something acceptable to printer, build the dcw */ set_io: proc; dcl word_cnt fixed bin (18); dcl char_cnt fixed bin (18); call prt_conv_ (inptr, lth, linep, char_cnt, pcip); /* Perform code conversion. */ word_cnt = divide (char_cnt + 3, 4, 18, 0); /* Compute number of words to write. */ if word_cnt > sdb.max_dcw_size then /* oh dear */ call abort ("prt_conv_ output exceeded max DCW size"); nelemt = nelem - lth; /* Update the number of elements xmitted. */ if sdb.noprint then return; /* Just return if print suppressed. */ n_dcws = n_dcws + 1; dcwp = addr (prt_buffer.ddcw (n_dcws)); string (dcw) = "0"b; /* Clear the DCW. */ dcw.address = rel (linep); /* Set address to point to data. */ dcw.tally = bit (bin (word_cnt, 12)); /* Set tally of DCW. */ sdb.stop = sdb.stop + word_cnt; /* admit we used it */ return; end set_io; %page; /* make the printer listen to us */ start_io: proc; if ^sdb.wait_flag then if prt_buffers (sdb.b_begin).busy then do; if sdb.running then call abort ("start_io called with device running"); call ioi_$connect (prt_info.devx, fixed (rel (addr (prt_buffers (sdb.b_begin).idcw))), rcode); /* Fire up the device. */ if rcode = 0 then do; sdb.alarm_time = clock () + TIMEOUT; call timer_manager_$alarm_wakeup ((sdb.alarm_time), "00"b, sdb.evchan); sdb.running = "1"b; /* Indicate device now running. */ end; else call abort ("connect failed " || ltrim (char (rcode))); end; else call abort ("start_io called with nothing to do"); return; end start_io; %page; /* wait for I/O in progress. */ wait_io: proc; /* need buffer space - keep device busy */ if ^sdb.running then do; /* If printer not running ... */ call start_io; /* Get it in motion. */ if rcode ^= 0 then return; end; call ipc_$block (addr (sdb.ev_list), addr (l_event_call_info), rcode); if rcode ^= 0 then /* Wait for I/O completion. */ return; call stat_check; /* Examine status and set flags. */ return; end wait_io; %page; /* Printer status check entry. */ stat_check: proc; dcl dcws_done fixed bin; dcl flags bit (18) aligned; dcl i fixed bin; dcl residue fixed bin; dcl pp ptr; dcl l_idcwp ptr; dcl l_prt_bufferp ptr; dcl er bit (1) aligned; dcl level fixed bin; dcl time_out bit (1) aligned; dcl run bit (1) aligned; dcl offset fixed bin (18) unsigned; dcl st bit (1) aligned; dcl timer_rang bit (1) aligned; dcl special_flag bit (1) aligned; dcl temp_iom_stat bit (72) aligned; /* temp area for iom status */ dcl l_timer_message char (8) based (imp); dcl 1 l_idcw aligned like idcw based (l_idcwp); dcl 1 l_prt_buffer aligned like prt_buffer based (l_prt_bufferp); dcl 1 l_istat aligned like istat; isp = null; statp = null; imp = addr (l_event_call_info.message); /* get pointer to ioi message */ if l_timer_message = "alarm___" then do; /* check for timer ringing */ if clock () >= sdb.alarm_time & sdb.alarm_time ^= 0 then timer_rang = "1"b; /* real alarm */ else return; /* bogus timer */ end; else timer_rang = "0"b; if sdb.wait_flag then do; /* check for SPECIAL */ sdb.alarm_time = 0; call timer_manager_$reset_alarm_wakeup (sdb.evchan); /* no more alarms */ call ioi_$get_special_status (prt_info.devx, special_flag, (""b), rcode); if ^special_flag | rcode ^= 0 then do; /* still not ready? */ if rcode = 0 then do; /* if no error, set another alarm timer */ sdb.alarm_time = clock () + TIMEOUT; call timer_manager_$alarm_wakeup ((sdb.alarm_time), "00"b, sdb.evchan); end; return; end; sdb.alarm_time = 0; sdb.wait_flag = "0"b; /* not waiting any more */ if sdb.reload_vfc_train_after_special then do; /* whatever required operator intervention ... */ call prtdim_eurc_util$load_image (sdb_ptr, (0)); /* ... also destroyed the train and VFC images */ call prtdim_eurc_util$load_vfc (sdb_ptr, (0)); sdb.reload_vfc_train_after_special = "0"b; end; imp = null; return; end; imp = null; l_istat = sdb.status_ptr -> istat; flags = "0"b; /* Clear flags. */ residue = -1; st = l_istat.st; /* put all this crap in local variables */ level = bin (l_istat.level); /* ... */ er = l_istat.er; /* ... */ run = l_istat.run; /* ... */ time_out = l_istat.time_out; /* ... */ offset = bin (l_istat.offset); /* ... */ temp_iom_stat = l_istat.iom_stat; /* ... */ if run then call abort ("run status returned"); if ^st then do; /* foo */ statp = null; if timer_rang then /* blow out */ call abort ("Completion of I/O was never indicated."); else return; /* wait some more */ end; sdb.status_ptr -> istat.st = "0"b; sdb.running = "0"b; sdb.alarm_time = 0; call timer_manager_$reset_alarm_wakeup (sdb.evchan); /* no more alarms */ if time_out then do; /* if caused by time out */ call com_err_ (0, prt_info.devname, "IOI signalled device timeout."); rcode = error_table_$net_timeout; /* indicate error */ return; end; statp = addr (temp_iom_stat); l_prt_bufferp = addr (prt_buffers (sdb.b_begin)); /* status must be on b_begin buffer */ if ^l_prt_buffer.busy then call abort ("stat_check found begin buffer ^busy"); l_idcwp = addr (l_prt_buffer.idcw); if offset < bin (rel (l_idcwp)) /* check status offset */ /* | offset > bin (rel (addr (l_prt_buffer.ddcw (l_prt_buffer.dcw_count)))) /* EURC sometimes goes too high */ then call abort ("invalid status offset"); residue = bin (status.rcount); if er then do; /* If error occurred ... */ if level = IO_SYSTEM_FAULT_INTERRUPT_LEVEL 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; call abort ("system fault"); end; else do; /* If terminate ... */ call analyze_device_stat_$rs (errmess, addr (prt_status_table_$prt_status_table_), temp_iom_stat, flags); if status.channel_stat ^= ""b | status.central_stat ^= ""b then call abort ((errmess)); 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_eurc_util$load_image (sdb_ptr, rcode); if rcode ^= 0 then do; statp = null; return; end; end; if flags & vfc_flag then do; /* If VFC image destroyed ... */ call prtdim_eurc_util$load_vfc (sdb_ptr, rcode); if rcode ^= 0 then do; statp = null; return; end; end; end; if sdb.wait_flag then do; sdb.alarm_time = clock + TIMEOUT; call timer_manager_$alarm_wakeup ((sdb.alarm_time), "00"b, sdb.evchan); 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. */ if residue > l_prt_buffer.dcw_count | residue > sdb.max_dcws then call abort ("residue exceeds dcw count or max dcws"); if flags & backup_flag then /* think you want to back up ? */ if ((flags & eurc_no_backup_flag) = ""b) | ^sdb.flags.eurc then /* no eurc special case or not eurc */ residue = residue + 1; if residue > l_prt_buffer.dcw_count | residue > sdb.max_dcws then call abort ("adjusted residue exceeds dcw count or max dcws"); if ^er | residue <= 0 then do; /* terminated this buffer, too */ if l_prt_buffer.data_ends <= 0 | l_prt_buffer.dcw_count <= 0 then call abort ("last buffer bad data_ends/dcw_count"); sdb.bgin = l_prt_buffer.data_ends; /* only update bgin when whole buffer is done */ l_prt_buffer.busy = "0"b; l_prt_buffer.ddcw (*) = sdb.null_line_dcw; l_prt_buffer.idcw = "777777000014"b3; l_prt_buffer.data_ends = 0; l_prt_buffer.dcw_count = 0; if sdb.b_begin ^= sdb.b_stop then sdb.b_begin = mod (sdb.b_begin + 1, sdb.n_buffers); l_prt_bufferp = null; end; else do; if l_prt_buffer.data_ends <= 0 | l_prt_buffer.dcw_count <= 0 then call abort ("processing error buffer - bad data_ends/dcw_count"); dcws_done = l_prt_buffer.dcw_count - residue; do i = 1 to hbound (l_prt_buffer.ddcw, 1); /* fix up dcws */ if i <= residue then /* this dcw or trailing slot will be used in next connect */ l_prt_buffer.ddcw (i) = l_prt_buffer.ddcw (i + dcws_done); else l_prt_buffer.ddcw (i) = sdb.null_line_dcw; end; l_idcw.count = bit (bin (residue, 6), 6); l_prt_buffer.dcw_count = residue; l_prt_bufferp = null; end; /* er */ statp = null; return; end stat_check; %page; /* entry to wait out current I/O and scrap unprinted info */ prtdim_resetwrite: entry (arg_sdb_ptr, iostatus); unclean = "1"b; iostatus = "0"b; sdb_ptr = arg_sdb_ptr; pip = addr (sdb.info); pcip = addr (sdb.conv_info); isp = null; statp = null; imp = null; rcode = 0; quit_pending = ""b; on cleanup call tidy_up; on quit call process_quit; if sdb.aborting then do; /* wants to throw away the world, be nice */ call prtdim_eurc_util$finish_abort (sdb_ptr); if sdb.aborting then do; call set_status (error_table_$data_loss, iostatus); go to resetwrite_returns; /* still a mess */ end; iostatus = ""b; sdb.wait_flag = "0"b; end; do while (sdb.running); /* Wait for printer to stop. */ call wait_io; /* stop */ if quit_pending then do; /* any defered QUIT? */ quit_pending = "0"b; revert quit; signal quit; on quit call process_quit; end; if rcode ^= 0 then do; /* from wait_io, not disturbed by QUIT hack */ call set_status (rcode, iostatus); go to resetwrite_returns; end; end; sdb.bgin, sdb.stop = sdb.data_begin; /* Reset all indices. */ prt_buffers (*).busy = "0"b; sdb.b_stop, sdb.b_begin = 0; resetwrite_returns: revert quit; if quit_pending then do; quit_pending = "0"b; signal quit; end; return; /* Output all scrapped. */ %page; /* entry to await all pending unprinted information */ runout: entry (arg_sdb_ptr, iostatus); unclean = "1"b; iostatus = "0"b; sdb_ptr = arg_sdb_ptr; pip = addr (sdb.info); pcip = addr (sdb.conv_info); isp = null; statp = null; imp = null; rcode = 0; quit_pending = ""b; on cleanup call tidy_up; on quit call process_quit; if sdb.aborting then do; /* shouldn't happen */ call finish_abort; go to runout_returns; end; do while (prt_buffers (sdb.b_begin).busy); /* as long as there's stuff to do */ call wait_io; /* Start printer and wait for completion. */ if quit_pending then do; /* process quit first */ quit_pending = "0"b; revert quit; signal quit; on quit call process_quit; end; if rcode ^= 0 then do; call set_status (rcode, iostatus); go to runout_returns; end; end; call ipc_$drain_chn (sdb.evchan, (0)); /* ioi has nothing left to say */ runout_returns: revert quit; if quit_pending then do; quit_pending = "0"b; signal quit; end; return; /* Output all flushed. */ %page; abort: proc (a_message); dcl a_message char (132); dcl sub_err_ entry () options (variable); call dump (a_message); sdb.aborting = "1"b; call com_err_ (0, prt_info.devname, "***** Unexpected status or program error."); call com_err_ (0, prt_info.devname, "***** ^a.", a_message); call com_err_ (0, prt_info.devname, "***** Data has been lost."); call finish_abort; /* try to clean it up now */ call sub_err_ (error_table_$data_loss, "prtdim_eurc_write", ACTION_CANT_RESTART, null (), (0), "Unexpected status or program error."); end abort; dump: proc (a_message); dcl a_message char (*); dcl copy_length fixed bin (19); dcl name char (30) varying; dcl d_stackp ptr; dcl d_wsegp ptr; dcl code fixed bin (35); dcl sb ptr; dcl 1 bumf aligned based, 2 version fixed bin (71), 2 time fixed bin (71), 2 sp ptr, 2 message char (128); dcl copy_seg (copy_length * 4) char unaligned based; dcl hcs_$get_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); dcl unique_chars_ entry (bit (*)) returns (char (15)); name = "prtdim." || unique_chars_ (""b) || "." || prt_info.devname; call hcs_$make_seg (">dumps>printer_dumps", name || ".s", "", RW_ACCESS_BIN, d_stackp, code); if code ^= 0 then return; call com_err_ (0, prt_info.devname, "***** creating dump ^a (^a), sp=^o.", name, a_message, fixed (rel (stackframeptr ()))); sb = stackbaseptr (); copy_length = fixed (rel (sb -> stack_header.stack_end_ptr)); d_stackp -> copy_seg = sb -> copy_seg; call terminate_file_ (d_stackp, copy_length * 36, TERM_FILE_TRUNC_BC_TERM, (0)); call hcs_$make_seg (">dumps>printer_dumps", name || ".w", "", RW_ACCESS_BIN, d_wsegp, code); if code ^= 0 then return; copy_length = 1024 * (divide (fixed (rel (sdb.status_ptr)), 1024, 17, 0) + 1); d_wsegp -> copy_seg = sdb.wsegp -> copy_seg; d_wsegp = addrel (d_wsegp, copy_length); d_wsegp -> bumf.version = 1; d_wsegp -> time = clock (); d_wsegp -> bumf.sp = stackframeptr (); d_wsegp -> bumf.message = a_message; d_wsegp = addrel (d_wsegp, size (bumf)); copy_length = size (sdb); d_wsegp -> copy_seg = sdb_ptr -> copy_seg; d_wsegp = addrel (d_wsegp, copy_length); call terminate_file_ (d_wsegp, fixed (rel (d_wsegp)) * 36, TERM_FILE_TRUNC_BC_TERM, (0)); end dump; finish_abort: proc; dcl old_wait_flag bit (1) aligned; old_wait_flag = sdb.wait_flag; call prtdim_resetwrite (sdb_ptr, iostatus); sdb.wait_flag = old_wait_flag; call set_status (error_table_$data_loss, iostatus); end finish_abort; set_status: proc (a_code, a_iostatus); dcl a_code fixed bin (35); dcl a_iostatus bit (72) aligned; substr (a_iostatus, 1, 36) = unspec (a_code); substr (a_iostatus, 41, 1) = "1"b; end set_status; tidy_up: proc; if ^unclean | sdb.aborting then return; /* if nothing to worry about or already cleaning up */ sdb.aborting = "1"b; call finish_abort; /* try to quiesce device now */ end tidy_up; /* format: off */ %page; %include access_mode_values; %page; %include event_call_info; %page; %include interrupt_levels; %page; %include ioi_stat; %page; %include iom_dcw; %page; %include iom_pcw; %page; %include iom_stat; %page; %include prt_conv_info; %page; %include prt_info; %page; %include prt_sdb; %page; %include stack_header; %page; %include status_flags; %page; %include sub_err_flags; %page; %include terminate_file; end prtdim_eurc_write;  prtdim_order.pl1 10/28/88 1414.7r w 10/28/88 1256.6 84672 /* *********************************************************** * * * 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. modified 83-10-21 by E. N. Kittlitz for eurc/urmpc partitioning. */ 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_eurc_write$runout entry (ptr, bit (72) aligned), prtdim_write$prtdim_resetwrite entry (ptr, bit (72) aligned), prtdim_eurc_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)), prtdim_eurc_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 */ if sdb.flags.eurc then call prtdim_eurc_util$load_vfc (sdb_ptr, code); else 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 if sdb.flags.eurc then call prtdim_eurc_write$runout (sdb_ptr, iostatus); else 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 if sdb.flags.eurc then call prtdim_eurc_write$prtdim_resetwrite (sdb_ptr, iostatus); else 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 02/02/88 1711.7r w 02/02/88 1535.7 56790 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* PRTDIM_UTIL - Utility Functions for the Multics printer DIM. coded 6/12/75 by Noel I. Morris */ /* Modified 83-10-21 by E. N. Kittlitz for eurc/urmpc partitioning */ 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_low (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_low; /* Save the contents of the workspace. */ call load_proc (pip, pcip, sync_io, rcode); /* Call out to load the train or VFC image. */ wseg_low = 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 02/02/88 1711.7r w 02/02/88 1535.7 147726 /* *********************************************************** * * * 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) */ /* Modified 83-10-10 for urmpc/eurc partitioning, E. N. Kittlitz */ 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 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