/* ***************************************************************** * * * * * Copyright, (C) Honeywell Information Systems Inc., 1980. * * * * * ***************************************************************** */ &expand comp_dev_writer &+ &comment Check for a valid device class &;&+ &ext devclass=undefined&; &if &[index -printer-diablo-video-bitmap- "-&devclass-"]=0&then &error 3,device class must be printer|diablo|video|bitmap, not "&devclass"&; &fi&+ &comment Preset all externals so that *.pl1.xdw doesnt need to specify all the ones it doesnt need &;&+ &int no_code=/**** NO CODE */&; &ext art_proc=&no_code&; &ext cleanup=&no_code&; &ext dcls=&no_code&; &ext display=&no_code&; &ext epilogue=&no_code&; &ext file_init=&no_code&; &ext foot_proc=&no_code&; &ext image_init=&no_code&; &ext justifying=no&; &ext line_finish=&no_code&; &ext line_init=&no_code&+&; &ext machines=terminals&; &ext notes&; &ext other_procs=&no_code&; &ext page_finish=&no_code&; &ext put=&no_code&; &ext page_init=&no_code&; &ext PLOT&; &ext unPLTcr&; &ext plot=&no_code&; &ext tab_x=&no_code&; &ext process_text=&no_code&; &ext set_font=&no_code&; &ext SET_HMI&; &ext set_media=&no_code&; &ext set_ps=&no_code&; &ext unPLOT&; /* compose support routine to write output to &device &machines (class &devclass) */ /* PREFACE /* This program handles length and distance values in "picture elements" /* (pixels). These are the native units in the machine and, sooner or later, /* all internal length and distance values have to be converted to pixels to /* actually get device output. In some cases the vertical and horizontal /* pixels are not of the same size, i.e. a Diablo-type typewriter has /* 60/inch horizontally and 48/inch vertically. /* All values which are fixed bin (31) are in millipoints. /* Debugging tools--- /* There are several switches that control debugging output from a writer-- /* shared.bug_mode db_sw dt_sw lg_sw /* debug_sw detail_sw long_sw /* shared.bug_mode is set via the family of -db arguments. It means that all /* of compose is being debugged. /* db_sw, dt_sw, lg_sw (static) are set by the entries dbn, dtn, and lgn */ /* respectively. They are reset by the entries dbf, dtf, and lgf. */ /* These switches interact with each other. In order to reduce the amount of */ /* code executed when not debugging, these interactions are distilled into */ /* automatic switches, debug_sw, detail_sw, and long_sw with this logic. */ /* debug_sw = (shared.bug_mode | db_sw); */ /* detail_sw = debug_sw && dt_sw; */ /* long_sw = debug_sw && lg_sw; */ /* debug_sw controls these outputs-- */ /* -- entry and exit notification */ /* -- an interpretation of each line of the input structure before it is */ /* acted upon. */ /* -- gap count error notification */ /* detail_sw controls these outputs-- */ &if &devclass=diablo &then /* -- (preface) indication */ &fi /* -- justification calculations */ /* -- device control (DCxx) display */ /* -- plot trace */ /* -- put_ trace */ /* -- set_font trace */ /* -- set_media trace */ &if &devclass=diablo &then /* -- overstrike processing notification */ &fi /* long_sw controls these outputs-- */ /* -- shows the justified text line */ /* -- shows detailed Multics/device translation (simple) */ ¬es /* format: style2,ind2,ll79,dclind4,idind15,comcol41,linecom */ &device&._writer_: proc (func, code); /* PARAMETERS */ dcl func fixed bin; /* function code */ /* 0 = build a page */ /* 1 = initialize a page */ /* 2 = initialize a file */ /* 3 = clean up */ /* 4 = prepare epilogue */ dcl code fixed bin (35); /* error code */ /* LOCAL STORAGE */ dcl auto_lead fixed bin (31); /* automatic baseline advance */ dcl BAD_CHAR char (1) static options (constant) init ("ÿ"); /* list of bad font chars */ dcl bad_chrs char (128) var static; dcl char_ndx fixed bin; /* index into font table */ dcl col_width fixed bin (31); /* calculated column width */ dcl debug_str char (1020) var; dcl debug_sw bit (1); dcl detail_sw bit (1); dcl dev_stat_ptr ptr static init (null ()); dcl EM_width fixed bin (31); /* width of EM */ dcl EN_width fixed bin (31); /* width of EN */ dcl fcdevfnt fixed bin; /* device font needed by a char */ dcl fcwidth fixed bin (31); /* font char width */ dcl first_line bit (1) static; dcl first_page bit (1) aligned static init ("0"b); dcl font_in fixed bin; /* current font */ dcl font_size fixed bin (31); /* point size in current font */ dcl fonts_done bit (36); /* which fonts have been processed */ dcl fonts_needed bit (36); /* which fonts have been requested */ &if &[index -bitmap- "-&devclass-"] = 0 &then &. dcl hot_chars char (35) static options (constant) init (" þÿ"); &fi &. dcl (i, j, jj, k, ll) fixed bin; dcl ichr fixed bin; /* index to current text character */ dcl ilin fixed bin static;/* page image line counter */ dcl just_line char (1020) var; /* the justified line */ dcl lineinfoptr ptr; /* -> info structure for image line */ dcl line_window_size /* # of window lines per output line */ fixed bin; dcl Lmarg fixed bin (31); /* left margin */ dcl loctxt char (1020) var; /* max rev leading allowed */ dcl long_sw bit (1); dcl max_level fixed bin; dcl max_revlead fixed bin (31) static; dcl font_media (36) fixed bin; /* media needed by the fonts */ dcl media_size fixed bin (31); /* point size in media */ dcl medselstr char (32) var; /* emitted medsel string */ dcl need_font fixed bin; /* needed font */ dcl need_devfnt fixed bin; /* device font for needed font */ dcl need_size fixed bin (31); /* needed size */ dcl NULs char (4) var static options (constant) init (""); dcl pref_sw bit (1); /* effective preface switch */ dcl quad bit (6); /* alignment flags */ dcl runout fixed bin; /* # NLs for page runout */ dcl SHIFT_OP bit (1) static options (constant) init ("0"b); /* device status info */ dcl stat_blk (100) fixed bin (35) static init ((100) 0); /* The developer of a device writer */ /* may use this block (by defining a */ /* based overlay) to hold any */ /* necessary device status info. */ /* Note that the first word is */ /* initialized to -1 for each page, */ /* thus any overlay should keep it */ /* fixed bin (35) and assure that */ /* all special device modes are */ /* reset at the end of each page. */ dcl text_sw bit (1); dcl text_width fixed bin (31); /* local text width */ dcl tchr char (1); /* local text char */ dcl THIN_width fixed bin (31); /* width of THIN */ dcl tstr_ptr ptr; /* text string */ dcl 1 tstr aligned based (tstr_ptr), 2 open bit (1) unal, /* line has something */ 2 white bit (1) unal, /* line is white */ 2 MBZ bit (16) unal, 2 devfnt fixed bin unal, /* starting device font for line */ 2 last_cr fixed bin unal, /* position of last CR or NL */ 2 font fixed bin unal, /* font being processed */ 2 xpos fixed bin (31), /* X position */ 2 ypos fixed bin (31), /* Y position */ 2 w fixed bin (31), /* width of str */ 2 str_ptr ptr; dcl tstr_line char (2048) var based (tstr.str_ptr); dcl txtlen fixed bin; /* length of txtstr */ dcl unstart fixed bin (31); /* start of underscore */ dcl unstring bit (1) static; /* underscoring is active */ dcl VECTOR_OP bit (1) static options (constant) init ("1"b); dcl window_area_ptr /* points to current window area seg */ ptr static init (null); dcl window_bottom fixed bin static init (0); dcl window_level fixed bin; dcl window_ptr ptr static init (null); dcl 1 window (window_top:window_bottom) aligned like tstr based (window_ptr); dcl window_top fixed bin static init (0); dcl word char (4090) var; /* word accumulator */ dcl wrdwidth fixed bin (31); /* word width in MPTS */ dcl Xmov fixed bin (31); /* horizontal CTL movement */ dcl Xmptstrk fixed bin (31); /* horizontal mpt -> stroke conv */ dcl Xpixel fixed bin (31); /* horizontal pixel size */ dcl Xpos fixed bin (31); /* current horizontal position */ dcl Xspc fixed bin (31); /* horizontal movement */ dcl Xmpts fixed bin (31); /* temp horiz value */ dcl Yinit fixed bin (31); /* initial page depth */ dcl Ymov fixed bin (31); /* vertical CTL movement */ dcl Ypixel fixed bin (31); /* vertical pixel size */ dcl Ypos fixed bin (31); /* current vertical position */ dcl Yspc fixed bin (31); /* vertical movement */ dcl Ympts fixed bin (31); /* temp vert value */ dcl (addr, bin, divide, fixed, index, length, max, min, mod, null, pointer, size, string, substr, unspec) builtin; dcl (cleanup, comp_abort, null_font_char, overlength_line, zero_font_index) condition; dcl error_table_$fatal_error fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl comp_error_table_$limitation fixed bin (35) ext static; dcl comp_error_table_$program_error fixed bin (35) ext static; dcl ioa_$rs entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl translator_temp_$get_segment entry (char (*) aligned, ptr, fixed bin (35)); dcl translator_temp_$release_all_segments entry (ptr, fixed bin (35)); /**** &&dcls FOR &device */ &dcls&+ /**** END &device */ %page; code = 0; /* clear error code */ if func = 3 /* clean up */ then do; /**** &&cleanup FOR &device */ &cleanup&+ /**** END &device */ return; end; if func = 1 /* new page */ then do; init: entry; /* called by pco */ stat_blk (*) = 0; stat_blk (1) = -1; dev_stat_ptr = addr (stat_blk); return; end; if func = 2 /* new input file */ then do; myself: /* check structure versions */ const.outproc_ptr = codeptr (myself); if shared.version ^= shared_version | option.version ^= option_version | page.version ^= page_version | comp_dvid.version ^= comp_dvid_version then do; code = error_table_$unimplemented_version; if db_sw then do; call ioa_ (" shared.version=^i", shared.version); call ioa_ (" shared_version=^i", shared_version); call ioa_ (" option.version=^i", option.version); call ioa_ (" option_version=^i", option_version); call ioa_ (" page.version=^i", page.version); call ioa_ (" page_version=^i", page_version); call ioa_ (" dvid.version=^i", comp_dvid.version); call ioa_ (" dvid_version=^i", comp_dvid_version); end; return; end; bad_chrs = ""; unstring = "0"b; first_page = "1"b; /**** &&file_init FOR &device */ &file_init&+ /**** END &device */ return; end; /**/ /* set debug switches */ debug_sw, detail_sw, long_sw, pref_sw, text_sw = "0"b; debug_sw = (shared.bug_mode | db_sw); detail_sw = debug_sw && dt_sw; long_sw = debug_sw && lg_sw; text_sw = debug_sw && tx_sw; pref_sw = debug_sw && pf_sw; if func = 4 /* prepare epilogue */ then do; page_record_ptr = addr (page_image.text_ptr -> record.page_record); unspec (page_record) = "0"b; /**** &&epilogue FOR &device */ &epilogue&+ /**** END &device */ return; end; /* func = 0 build page */ line_window_size = divide (12000, comp_dvt.min_lead, 17, 0); window_top = -line_window_size; window_bottom = divide (page.parms.length, comp_dvt.min_lead, 17, 0); if debug_sw then call ioa_ ("&device&._writer_(^a): (pag=^a lct=^d lvl=^d:^d)", option.device, page.hdr.pageno, page_image.count, window_top, window_bottom); if page_image.count = 0 then do; call comp_report_ (4, 0, "No output lines on page " || page.hdr.pageno, addr (ctl.info), ""); return; end; on cleanup call release_window; /**/ /* preset local stuff */ auto_lead, font_in, need_devfnt, media_size, font_size, Xpos, Ypos, Yinit, font_media (*) = 0; Xpixel = comp_dvt.min_WS; Ypixel = comp_dvt.min_lead; page_record_ptr = addr (page_image.text_ptr -> record.page_record); /**** &&page_init FOR &device */ &page_init&+ /**** END DEVICE &device */ rescan_page: /* (re)starting page */ /* get storage for output image */ call translator_temp_$get_segment ("compose", window_area_ptr, ercd); if ercd ^= 0 then do; call com_err_ (ercd, "compose", "Defining an output window area."); signal cleanup; return; end; Xspc, Yspc = 0; window_ptr = allocate (window_area_ptr, (window_bottom - window_top + 1) * size (tstr)); unspec (window) = "0"b; window.str_ptr = null; unspec (page_record) = "0"b; first_line = "1"b; window_level, max_level = 0; tstr_ptr = addr (window (0)); if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_line = ""; tstr.devfnt = 0; &if &[index -diablo- "-&devclass-"] ^= 0 &then&. if pref_sw then call ioa_ ("^5x(preface)"); &fi&. /**** &&image_init FOR &device */ &image_init /**** END &device */ if debug_sw then call ioa_ (":iln fn/ln ch/gp lmarg rmarg width depth" || " lead s med fnt sz"); %page; image_loop: do ilin = 1 to page_image.count; /* for all given image lines */ debug_sw, detail_sw, long_sw, text_sw = "0"b; fonts_done, fonts_needed ="0"b; Lmarg, col_width, text_width = 0; if (shared.bug_mode | db_sw) then if ilin >= db_line then do; debug_sw = "1"b; if dt_sw then detail_sw = "1"b; else detail_sw = "0"b; if lg_sw then long_sw = "1"b; else long_sw = "0"b; if tx_sw then text_sw = "1"b; else text_sw = "0"b; end; /**/ /* set text pointer */ txtstrptr = page_image.line (ilin).ptr; loctxt = txtstr; /* copy txtstr */ txtlen = length (txtstr); /* and record length */ trim_font: /* trim trailing font change */ if txtlen > 7 then if substr (loctxt, txtlen - 7, 2) = "À" then do; txtlen = txtlen - 8; goto trim_font; end; lineinfoptr = addr (page_image.line (ilin).info); quad = page_image.line (ilin).quad; if debug_sw then call blat; Yspc = divide (page_image.line (ilin).depth, Ypixel, 31, 0) - Ypos - Yinit; if ilin > 1 then Yspc = Yspc - auto_lead; /* account for the "free" amount */ need_font = page_image.line (ilin).lfnt; need_size = page_image.line (ilin).lsize; if txtlen > 0 then do; if font_in ^= need_font then call set_font (need_font, need_size); if page_image.line (ilin).lmarg > 0 then Lmarg = divide (page_image.line (ilin).lmarg, Xmptstrk, 31, 0); if page_image.line (ilin).net > 0 then col_width = divide (page_image.line (ilin).net, Xmptstrk, 31, 0); if page_image.line (ilin).width > 0 then text_width = divide (page_image.line (ilin).width, Xmptstrk, 31, 0); /**** &&line_init FOR &device */ &line_init&+ /**** END &device */ if quad = quadr | quad = quadc then /* if setting right */ do; /* or center */ Xspc = col_width - text_width; if quad = quadc /* if centering, take half */ then Xspc = round (divide (max (Xspc, 0), 2, 31, 1), 0); Lmarg = Lmarg + Xspc; end; /**/ /* if justifying and device doesnt */ if quad = just && ^comp_dvt.justifying /* and there are some gaps */ && page_image.line (ilin).gaps > 0 then call pad_block; rescan_line: if detail_sw then call ioa_ ("^5x(rescan_line: Lmarg=^f lvl=^d)", show (Lmarg * Xmptstrk, 12000), window_level); word = ""; /* clear word accumulator */ wrdwidth = 0; if Yspc ^= 0 then call plot (SHIFT_OP, 0, Ypos + Yspc); Yspc = 0; /* initial movement */ Xspc = Lmarg - Xpos; if font_in ^= page_image.line (ilin).lfnt | font_size ^= page_image.line (ilin).lsize then call set_font (page_image.line (ilin).lfnt, page_image.line (ilin).lsize); char_loop: /* process each character */ do ichr = 1 to txtlen; tchr = substr (loctxt, ichr, 1); if tchr ^= DC1 /* do any font chars */ then font_char: do; char_ndx = rank (tchr); /* fnttbl index for text char */ /* -> replacement */ repl_str_ptr = fnttbl.replptr (char_ndx); /* if there's no replacement */ if repl_str_ptr = null () then do; /* if not already reported */ if index (bad_chrs, tchr) = 0 then do; /* add to bad chars and report */ bad_chrs = bad_chrs || tchr; call comp_report_$ctlstr (2, comp_error_table_$program_error, lineinfoptr, loctxt, "Font ^a, no replacement for ""^a"" (\^.3b)", fnttbl.entry.name, tchr, unspec (tchr)); if abrt_sw /* abort if desired */ then signal null_font_char; end; goto end_chars; /* skip rest of line */ end; /**/ /* copy fnttbl data */ fcdevfnt = fnttbl.devfnt (char_ndx); /* white space? */ if fnttbl.white (char_ndx) then do; if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; fcwidth = fnttbl.units (char_ndx); Xspc = Xspc + fcwidth; if text_sw && ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^1a"" WS)", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b)); end; /**/ &if &[index -diablo-bitmap- "-&devclass-"] ^= 0 &then &. /* if cant put char */ else if fcdevfnt ^= tstr.devfnt && tstr.devfnt ^= 0 then do; if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; /**/ /* ..treat like whitespace */ fcwidth = fnttbl.units (char_ndx); Xspc = Xspc + fcwidth; if text_sw && ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^a"" ^^font)", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc + wrdwidth) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b)); end; &fi&. else /* not white space */ do; /* emit any accumulated motion */ if Yspc ^= 0 | (Xspc ^= 0 && txtlen ^= 0) then call plot (SHIFT_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; &if &devclass = diablo &then&+ &. /* any PLOTs or unPLOTs? */ if index (replstr, PLOT) > 0 | index (replstr, unPLOT) > 0 then do; i = 1; /* beginning of repl string */ /* if it doesnt start with unPLOT */ /* if index (replstr, unPLOT) ^= 1 /* then if dev_stat.plotting /* then /* do; /* call put_str ((unPLOT), 0); /* dev_stat.plotting = "0"b; /* end; /* else; /**/ /* /* scan the replstr */ do while (i <= repl_str.len); j = index (substr (replstr, i), PLOT); if j > 0 /* found a PLOT */ then do; /* enter PLOT mode */ dev_stat.plotting = "1"b; i = i + j + PLOTlen - 1; j = 0; end; else /* no PLOT, look for unPLOT */ do; j = index (substr (replstr, i), unPLOT); if j > 0 /* found an unPLOT */ then do; /* leave PLOT mode */ dev_stat.plotting = "0"b; i = i + j + unPLOTlen - 1; j = 0; end; /**/ /* neither, exit loop */ else i = repl_str.len + 1; end; end; end; &fi if tstr.devfnt = 0 then call set_media (font_in, fcdevfnt); /**** &&process_text FOR &device */ &process_text /**** END &device */ word = word || replstr; fcwidth = fnttbl.units (char_ndx); wrdwidth = wrdwidth + fcwidth; if text_sw && ^pref_sw then call ioa_ ("^5x(text: ^d ^i ^f ^f ""^a"" -> ""^a^va"")", fcdevfnt, fcwidth, show (fcwidth * Xmptstrk, 12000), show ((Xpos + Xspc + wrdwidth) * Xmptstrk, 12000), comp_util_$display ((tchr), 0, "0"b), comp_util_$display (replstr, 0, "0"b), repl_str.len - length (rtrim (replstr)), " "); end; end font_char; else ctl_char: do; /* its a DC1 control string */ if word ^= "" /* flush current word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; DCxx_p = /* set control string overlay ptr */ addr (substr (loctxt, ichr, 1)); /* for device/writer controls */ if dcxx.ctl.type = "000"b then do; (nostrg): if long_sw then call ioa_ ("^5x(CTL: ^[wait^]^[unstrt^]^[unstop^]" || " ^a^[ Xpos=^f^;^s^])", (dcfs.type = type_wait), (dcfs.type = type_unstart), (dcfs.type = type_unstop), comp_util_$display ((substr (loctxt, ichr, dcxx.leng + 3)), 0, "0"b), (dcfs.type = type_unstart) | (dcfs.type = type_unstop), show ((Xpos + Xspc) * Xmptstrk, 12000)); &if &[index -bitmap- "-&devclass-"] = 0 &then /* a midpage wait? */ if dcfs.type = type_wait then do; /* any accumulated motion? */ if Xspc ^= 0 then call plot (SHIFT_OP, Xpos + Xspc, Ypos); Xspc = 0; /**/ /* user will give NL */ Yspc = Yspc - divide (12000, Ypixel, 31, 0); page_record.halt4 = "1"b; page_record.nextref = "0"b; page_record_ptr = addr (page_record.nextref); page_record.leng, tstr.last_cr = 0; unspec (page_record.sws) = "0"b; page_record.in_use = "1"b; &if &devclass = diablo &then page_record.pwheel = need_wheel; &fi&+ end; /**/ &fi&+ /* start underscore? */ if dcfs.type = type_unstart then do; unstart = max (Xpos + Xspc, Lmarg); unstring = "1"b; end; /**/ /* stop underscore? */ if dcfs.type = type_unstop then do; /* underscoring active? */ if unstring && tstr_line ^= "" && ^(page_image.line (ilin).cbar | page_image.line (ilin).mrgtxt) then do; call put_uns; unstring = "0"b; end; end; end; /**/ /* a font change? */ else if dcfs.type = type_font then do; if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: font ^a)", comp_util_$display (debug_str, 0, "0"b)); end; need_font = dcfs.f; need_size = dcfs.p; call set_font (need_font, need_size); end; /**/ /* a literal? */ else if dcfs.type = type_lit then do; call put_str (substr (loctxt, ichr + 3, dcxx.leng), 0); if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: literal ^a)", comp_util_$display (debug_str, 0, "0"b)); end; end; else /* its either a shift or a vector */ do; /* fetch a short X */ if (dcxx.Xctl = "01"b) then Xmpts = dcshort_val.v1; /* fetch a long X */ else if (dcxx.Xctl = "10"b) then Xmpts = dclong_val.v1; else Xmpts = 0; /* no X movement */ if (dcxx.Xctl ^= "00"b) then /* if X is given */ do; /* then Y is in v2 */ /* fetch a short Y */ if (dcxx.Yctl = "01"b) then Ympts = dcshort_val.v2; /* fetch a long Y */ else if (dcxx.Yctl = "10"b) then Ympts = dclong_val.v2; else Ympts = 0; end; else /* no X was given */ do; /* fetch a short Y */ if (dcxx.Yctl = "01"b) then Ympts = dcshort_val.v1; /* fetch a long Y */ else if (dcxx.Yctl = "10"b) then Ympts = dclong_val.v1; else Ympts = 0; end; /**/ /* shift */ if dcxx.type = "100"b then do; if font_in = 0 then call set_font (need_font, need_size); Xmov = sign (Xmpts) * round (divide (abs (Xmpts) - 4, Xmptstrk, 31, 1), 0); Xspc = Xspc + Xmov; Ymov = sign (Ympts) * divide (abs (Ympts), Ypixel, 17, 0); Yspc = Yspc + Ymov; if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: shift ^f ^f (^f ^f) ^a)", show (Xmpts, 12000), show (Ympts, 12000), show (Xspc * Xmptstrk, 12000), show (Yspc,12000), comp_util_$display (debug_str, 0, "0"b)); end; end; else do; /* not shift, it must be vector */ if Xspc ^= 0 | Xmpts > 0 then if font_in ^= need_font | font_size ^= need_size then call set_font (need_font, need_size); /* need to position first? */ if Xspc ^= 0 | Yspc ^= 0 then call plot (SHIFT_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; Xspc = divide (Xmpts, Xmptstrk, 31, 0); Yspc = divide (Ympts, Ypixel, 31, 0); if long_sw then do; (nostrg): debug_str = substr (loctxt, ichr, dcxx.leng + 3); call ioa_ ("^5x(CTL: vector ^f ^f ^a)", show (Xmpts, 12000), show (Ympts, 12000), comp_util_$display (debug_str, 0, "0"b)); end; call plot (VECTOR_OP, Xpos + Xspc, Ypos + Yspc); Xspc, Yspc = 0; end; end; /**/ /* move to last ctl char */ ichr = ichr + dcxx.leng + 2; end ctl_char; /* end of control sequence loop */ end_chars: end char_loop; if word ^= "" /* flush last word */ then do; call put_str (word, wrdwidth); wrdwidth = 0; tstr.white = "0"b; end; if unstring /* underscoring active? */ && ^(page_image.line (ilin).cbar | page_image.line (ilin).mrgtxt) then call put_uns; /**** &&line_finish FOR &device */ &line_finish /**** END &device */ if detail_sw then do; call ioa_ ("^5x(line_finish: tstr lvl=^d ^[^^^]opn Y=^f X=^f ln=^d)", window_level, ^(tstr.open), show (Ypos * Ypixel, 12000), show (Xpos * Xmptstrk, 12000), length (tstr_line)); if tstr.open then call ioa_ ("""^a^va""", comp_util_$display (rtrim (tstr_line), 0, "0"b), length (tstr_line) - length (rtrim (tstr_line)), " "); end; end; end image_loop; finish_page: if detail_sw then call ioa_ ("^5x(finish_page:)"); /* add any trailing lead */ if page_image.line (page_image.count).white then call plot (SHIFT_OP, 0, Ypos + divide (page_image.line (page_image.count).lead, Ypixel, 31, 0)); call put_; /* flush output image */ call release_window; /* discard image just put */ if ^option.galley_opt then do; if comp_dvt.endpage ^= "0"b /* if FF is defined, then */ then /* replace last NL with it */ substr (page_record.text, page_record.leng, 1) = byte (bin (comp_dvt.endpage)); /* else run out the page with NLs */ else if Ypos < divide (page.parms.length, Ypixel, 31, 0) then do; runout = divide (page.parms.length, 12000, 31, 0) - 1 - divide (Ypos, line_window_size, 31, 0) - bin (option.stop_opt); page_record.leng = page_record.leng + runout; substr (page_record.text, page_record.leng - runout + 1, runout) = copy (NL, runout); end; /**/ /**** &&page_finish FOR &device */ &page_finish /**** END &device */ end; page_record.nextref = "0"b; /* show nothing follows */ return_: if debug_sw then call ioa_ (" (&device&._writer_)"); return; %page; footproc: entry (footref, ptr); /* PARAMETERS */ /* actual reference string */ dcl footref (3) char (*) var; dcl ptr ptr; /* -> comp_dvt */ /* &&foot_proc for &device */ &foot_proc&+ if (shared.bug_mode | db_sw) then do; call ioa_ ("&device&._writer_$footproc: ^a", comp_util_$display (footref (1) || footref (2) || footref (3), 0, "0"b)); end; return; %page; /* This routine returns a printable interpretation of a native device string */ dcl &device&._writer_$display entry (char (*) var, fixed bin (24), bit (1)) returns (char (*) var); display: entry (dtext, dlen, noerr) returns (char (*) var); /* PARAMETERS */ dcl dtext char (*) var; /* string to be displayed */ dcl dlen fixed bin (24); /* chars scanned by this call */ dcl noerr bit (1); /* 1= dont print error messages */ /* LOCAL STORAGE */ dcl ch char (1); /* extracted text char */ dcl ct fixed bin; /* number of duplicate chars */ dcl dstr char (1020) var; /* working string */ dcl rtn_str char (16384) var;/* return string */ if dev_stat_ptr = null () then dev_stat_ptr = addr (stat_blk); if stat_blk (1) ^= -1 /* check status block */ then do; stat_blk (*) = 0; stat_blk (1) = -1; end; rtn_str = ""; /* clear return string */ ct = 0; &if &devclass = diablo &then&. if dev_stat.plotting then goto device_display; &fi&. ch = substr (dtext, 1, 1); /* extract a char */ if ch = THIN then do; ct = verify (dtext, THIN); /* how many? */ if ct = 0 /* all the rest */ then ct = length (dtext); else ct = ct - 1; if ct > 1 /* if more than one */ then call ioa_$rsnnl ("", dstr, 0, ct); else dstr = ""; rtn_str = rtn_str || dstr; end; else if ch = DEVIT then do; ct = verify (dtext, DEVIT); /* how many? */ if ct = 0 /* all the rest */ then ct = length (dtext); else ct = ct - 1; if ct > 1 /* if more than one */ then call ioa_$rsnnl ("", dstr, 0, ct); else dstr = ""; rtn_str = rtn_str || dstr; end; else do; device_display: /* &&display FOR DEVICE &device */ &display /**/ /* END DEVICE &device */ end; disp_ret: dlen = ct; return (rtn_str); /* end of display */ %page; artproc: entry (); /**/ /* &&art_proc for &device */ &art_proc&+ return; %page; blat: proc; dcl blatstr char (1020) var; call ioa_$nnl (":^3d^3d/^d^12t^4d/^i^18t^5(^8f^)" || " ^[I^]^[O^]^[L^]^[C^]^[R^]^[J^]^[L^]^60t^3i ^6a ^f^/^4x", ilin, page_image.line (ilin).fileno, page_image.line (ilin).lineno, txtlen, page_image.line (ilin).gaps, show (page_image.line (ilin).lmarg, 12000), show (page_image.line (ilin).rmarg, 12000), show (page_image.line (ilin).width, 12000), show (page_image.line (ilin).depth, 12000), show (page_image.line (ilin).lead, 12000), quad && quadi, quad && quado, quad && quadl, quad && quadc, quad && quadr, quad && just, (quad = "0"b), page_image.line (ilin).lfnt, fnttbldata.ptr (page_image.line (ilin).lfnt) -> fnttbl.entry.name, show (fnttbldata.ptr (page_image.line (ilin).lfnt) -> fnttbl.entry.size, 1000), txtlen); blatstr = comp_util_$display (substr (loctxt, 1, txtlen), 0, "0"b); call ioa_ ("""^a^va""", blatstr, length (blatstr) - length (rtrim (blatstr)), " "); end blat; %page; release_window: proc; call translator_temp_$release_all_segments (window_area_ptr, 0); end release_window; %page; move_tstr: /* move tstr ptr to new window level */ proc (incr); /* PARAMETERS */ dcl incr fixed bin (31); /* amount to move */ if detail_sw then call ioa_ ("^-(move_tstr: ^d -> ^d)", window_level, window_level + incr); window_level = window_level + incr; max_level = max (max_level, window_level); tstr_ptr = addr (window (window_level)); tstr.ypos, Ypos = Ypos + incr; Xpos = tstr.xpos; tstr.open = "1"b; if tstr.str_ptr = null then tstr.str_ptr = allocate (window_area_ptr, 1024); end move_tstr; %page; show: proc (datum, scale) returns (fixed dec (11, 3)); dcl datum fixed bin (31); dcl scale fixed bin (31); return (round (dec (round (divide (datum, scale, 31, 11), 10), 11, 4), 3)); end show; %page; plot: proc (PLOT_OP, new_xpos, new_ypos); /* This routine moves the current position to (new_xpos,new_ypos), */ /* plotting or shifting according to the value of PLOT_OP. */ /* PARAMETERS */ dcl PLOT_OP bit (1); /* 0-shift; 1-vector */ dcl new_xpos fixed bin (31); /* needed horizontal position */ dcl new_ypos fixed bin (31); /* needed vertical position */ /* LOCAL STORAGE */ dcl copystr char (2048) var; dcl exit_str char (32) var; dcl old_xpos fixed bin (31); dcl old_ypos fixed bin (31); dcl penctl char (6) var; /* pen control string */ dcl pltstr char (4090) var; dcl pltwidth fixed bin (31); dcl xii fixed bin; /* working value */ dcl xmove fixed bin (31); /* X movement */ dcl ymove fixed bin (31); /* Y movement */ if new_xpos = Xpos && new_ypos = Ypos then return; xmove, ymove, pltwidth = 0; pltstr = ""; old_xpos = Xpos; /* case a VSFT changes Xpos */ old_ypos = Ypos; xmove = new_xpos - Xpos; ymove = new_ypos - Ypos; if detail_sw then call ioa_ ("^5xplot: (^[V^;S^] ^f/^f -> ^f/^f = ^f/^f)", PLOT_OP, show (Xpos * Xmptstrk, 12000), show (Ypos * Ypixel, 12000), show (new_xpos * Xmptstrk, 12000), show (new_ypos * Ypixel, 12000), show (xmove * Xmptstrk, 12000), show (ymove * Ypixel, 12000)); if ^PLOT_OP /* if a SHIFT is wanted */ then do; if ymove ^= 0 /* any Y movement? */ then do; if window_level + ymove < window_top | window_level + ymove > window_bottom then do; call comp_report_$ctlstr (2, comp_error_table_$program_error, lineinfoptr, loctxt, "Attempt to place a line off page ^a at line ^d.", page.hdr.pageno, window_level); signal comp_abort; end; call move_tstr (ymove); ymove = 0; xmove = new_xpos - Xpos; end; penctl = PENUP; /* init for pen up */ end; /**/ /* else a VECTOR is wanted */ else penctl = PENDOWN; /* init for pen down */ /**** &&plot FOR &device */ &plot&+ /**** END &device */ plot_return: if length (pltstr) > 0 then call put_str (pltstr, pltwidth); /* Xpos, tstr.xpos = new_xpos;*/ if detail_sw then call ioa_ ("^-(plot: ^f/^f lvl=^d ^[^^^]opn^[ W^])", show (Xpos * Xmptstrk, 12000), show (Ypos * Ypixel, 12000), window_level, ^tstr.open, tstr.white); /* Xplt, Yplt = 0; /* motion used */ end plot; &if &justifying = no &then %page; pad_block: proc; /**/ /* these two values in fixed dec so round off doesnt affect pad placement. */ /* dcl /* ( igap, /* gap counter for padding */ /* padeach /* padding interval */ /* ) fixed dec (11, 3);*/ dcl ( igap, /* gap counter for padding */ padeach /* padding interval */ ) fixed bin; dcl gaps fixed bin; /* gap count for line */ dcl jl_ptr ptr; /* pointer to the justified line */ dcl just_line char (1020) var; /* pads per gap */ dcl pads (page_image.line (ilin).gaps) fixed bin; dcl padsize fixed bin; /* pad space in pixels */ dcl 1 pad_ctl like dclong_val; /* for inserting pads */ dcl pad_ctl_ptr ptr; dcl pad_string char (7) based (pad_ctl_ptr); dcl SP_DC1 char (2) int static options (constant) init (" "); just_line = ""; /* clear the justified line */ jl_ptr = addr (just_line); /* and set pointer for the overlay */ if font_in ^= need_font then call set_font (need_font, need_size); if col_width < 0 then col_width = divide (page_image.line (ilin).net, Xmptstrk, 31, 0); if text_width > 0 then text_width = divide (page_image.line (ilin).width, Xmptstrk, 31, 0); if Xpixel ^= EN_width /* set up pad_ctl string */ then do; pad_ctl.mark = DC1; pad_ctl.type = type_slx; pad_ctl.leng = dclong1_len; pad_ctl.v2 = 0; pad_ctl_ptr = addr (pad_ctl); end; gaps = page_image.line (ilin).gaps; padsize = max (0, col_width - text_width); /* fill in common amount */ pads = fnttbl.units (rank (STROKE)) * divide ( divide (padsize, gaps, 17, 0), fnttbl.units (rank (STROKE)), 17, 0); /* then get the leftover amount */ padsize = padsize - pads (1) * gaps; if long_sw then call ioa_$nnl ("^5x(pad_block: l/w/r=^f/^f/^f gp=^i pd=^i+^i", show (Lmarg * Xmptstrk, 12000), show (text_width * Xmptstrk, 12000), show (page_image.line (ilin).rmarg, 12000), gaps, pads (1), padsize); do while (padsize > 0); /* use up any leftovers */ padeach = /* pad interval */ max (round (divide (gaps * fnttbl.units (rank (STROKE)), padsize, 17, 1), 0), 1); igap = max (round (divide (gaps * fnttbl.units (rank (STROKE)), 2 * padsize, 17, 1), 0), 1); do igap = igap to gaps by padeach while (padsize > 0); pads (igap) = pads (igap) + fnttbl.units (rank (STROKE)); padsize = padsize - fnttbl.units (rank (STROKE)); end; end; if long_sw then call ioa_ ("^(,^i^))", pads); ichr = verify (loctxt, " "); /* start at front of text */ if ichr > 1 then just_line = just_line || copy (EN, ichr - 1); do j = 1 to gaps; try_again: /* find word boundary */ k = search (substr (loctxt, ichr, txtlen - ichr + 1), SP_DC1) - 1; if k < 0 /* MGOD! gap count is too large */ then do; if detail_sw then do; call ioa_$nnl ("gap=^i ", gaps); call blat; end; goto gap_exit; end; /**/ /* copy word */ just_line = just_line || substr (loctxt, ichr, k); ichr = ichr + k; /* step over "word" */ /* did we find a control? */ if substr (loctxt, ichr, 1) = DC1 then do; /* set pointer */ DCxx_p = addr (substr (loctxt, ichr)); k = dcxx.leng + 3; /* and control string length */ /* copy ctl str */ just_line = just_line || substr (loctxt, ichr, k); ichr = ichr + k; goto try_again; end; ichr = ichr + 1; /* skip the wordspace */ if Xpixel = EN_width /* now, any excess count */ then just_line = just_line || copy (" ", pads (j)); else do; pad_ctl.v1 = pads (j) * Xmptstrk; just_line = just_line || pad_string; end; end; gap_exit: k = txtlen - ichr + 1; /* length of the last word */ /* move the last word */ just_line = just_line || substr (loctxt, ichr, k); loctxt = just_line; /* switch to the justified line */ txtlen = length (just_line); if long_sw then call ioa_ ("^a", comp_util_$display (just_line, 0, "0"b)); end pad_block; &fi %page; put_: proc; dcl level fixed bin; dcl level_skip fixed bin; if detail_sw then call ioa_ ("^5x(put: maxlvl=^d)", max_level); level_skip = 0; if first_line then do level = window_top to -1 /* discard leading null lines */ while (^window (level).open); end; else level = window_top; &if &devclass = diablo &then dev_stat.plotting = "0"b; &fi&. do level = level to max_level; tstr_ptr = addr (window (level)); /**/ if tstr.str_ptr = null then do; tstr.str_ptr = allocate (window_area_ptr, 1024); tstr_line = ""; end; /**/ /* &&put FOR DEVICE &device */ &put /**/ /* END DEVICE &device */ if detail_sw then call ioa_ ("^7x(lvl=^d ^d+^d=^d ""^a"")", level, page_record.leng, length (tstr_line), page_record.leng + length (tstr_line), comp_util_$display (tstr_line, 0, "0"b)); level = level + level_skip; tstr.last_cr = 0; page_record.leng = page_record.leng + length (tstr_line); substr (page_record.text, page_record.leng - length (tstr_line) + 1, length (tstr_line)) = tstr_line; end; if page_record.leng > 0 then page_record.in_use = "1"b; Ypos = tstr.ypos; end put_; %page; put_str: proc (string, width); dcl string char (4090) var; /* string to put */ dcl width fixed bin (31); /* string width */ dcl (i, j) fixed bin; dcl new_len fixed bin; dcl old_len fixed bin; dcl pos fixed bin (31); /* current position */ if tstr.devfnt ^= need_devfnt then call set_media (font_in, need_devfnt); old_len = length (tstr_line) - tstr.last_cr; new_len = old_len + length (string); &if &devclass = bitmap &then if new_len > MAX_STR && substr (string, length (string), 1) ^= NL &else if new_len > MAX_STR &fi&+ then do; &if &devclass = bitmap &then if long_sw then do; debug_str = comp_util_$display (CR || medselstr, 0, "0"b); call ioa_ ("^-(overlay: lvl=^d X=^f^f=0 ^d+^d=^d ""^a^va"")", window_level, show (Xpos * Xmptstrk, 12000), show (-Xpos * Xmptstrk, 12000), old_len, length (CR || medselstr), old_len + length (CR || medselstr), debug_str, length (debug_str) - length (rtrim (debug_str)), " "); end; tstr_line = tstr_line || CR || medselstr; tstr.last_cr = length (tstr_line); Xpos = 0; call plot (SHIFT_OP, tstr.xpos, Ypos); old_len = length (tstr_line) - tstr.last_cr; new_len = old_len + length (string); &fi&+ end; &comment &if &devclass = bitmap &then&. else if substr (string, length (string), 1) = NL then tstr.last_cr = length (tstr_line); &fi&+&; if detail_sw then do; debug_str = comp_util_$display (string, 0, "0"b); call ioa_ ( "^5x(put_str: lvl=^d X=^f+^f=^f ^d+^d=^d^[(^d)^;^s^] ""^a^va"")", window_level, show (Xpos * Xmptstrk, 12000), show (width * Xmptstrk, 12000), show ((Xpos + width) * Xmptstrk, 12000), old_len, length (string), new_len, (tstr.last_cr > 0), length (tstr_line) + length (string), debug_str, length (debug_str) - length (rtrim (debug_str)), " "); end; tstr_line = tstr_line || string; Xpos, tstr.xpos = Xpos + width; string = ""; width = 0; tstr.open = "1"b; end put_str; %page; put_uns: proc; dcl Y_offs fixed bin (31); /* baseline offset */ dcl unslen fixed bin (31);/* length of underscore */ Y_offs = 0; unslen = Xpos + Xspc - unstart; if unslen > 0 then do; if detail_sw then call ioa_ ("^5x(put_uns: ^f)", show (unslen * Xmptstrk, 12000)); &if &devclass = bitmap &then&+ Xspc = unstart; call put_str (CR || medselstr, -tstr.xpos); Xpos, tstr.xpos = 0; &else Xspc = Xspc - unslen; /* go to start */ &fi&+ &if &devclass = diablo &then&+ Xspc = max (Xspc - 3, -(Xpos + Xspc)); Y_offs = 3; &fi&+ call plot (SHIFT_OP, Xpos + Xspc, Ypos + Y_offs); Xspc, Yspc = 0; /**/ /* put the underscore */ call plot (VECTOR_OP, Xpos + unslen, Ypos); &if &devclass = diablo &then&+ call plot (SHIFT_OP, Xpos + 3600, Ypos - 3000); &fi&+ unstart = Lmarg; if detail_sw then call ioa_ ("^-(put_uns)"); end; end put_uns; %page; set_font: proc (new_font, new_size); /* PARAMETERS */ dcl new_font fixed bin; /* desired font index */ dcl new_size fixed bin (31); /* desired pointsize */ dcl chng bit (1); chng = (font_in ^= new_font | font_size ^= new_size); if chng then do; if detail_sw then do; if font_in = 0 then call ioa_$nnl ("^5x(set_font: 0 - 0. -->"); else call ioa_$nnl ("^5x(set_font: ^i ^a ^f -->", font_in, fnttbldata.ptr (font_in) -> fnttbl.entry.name, show (font_size, 1000)); end; font_in = new_font; end; fnttbl_ptr = fnttbldata.ptr (font_in); substr (fonts_needed, font_in, 1) = "1"b; need_devfnt = fnttbl.devfnt (32); /**** &&set_font FOR &device */ &set_font /**** END &device */ if siztbl.ct = 1 then font_size, new_size = siztbl.size (1); else font_size = new_size; Xmptstrk = divide (font_size, fnttbl.rel_units, 31, 0); EM_width = divide (font_size * fnttbl.units (rank (EM)), fnttbl.rel_units, 31, 10); EN_width = divide (font_size * fnttbl.units (rank (EN)), fnttbl.rel_units, 31, 10); THIN_width = divide (font_size * fnttbl.units (rank (THIN)), fnttbl.rel_units, 31, 10); if (detail_sw | long_sw) && chng then do; call ioa_ (" ^i ^a ^f Xscl=^d)", new_font, fnttbldata.ptr (new_font) -> fnttbl.entry.name, show (font_size, 1000), Xmptstrk); if long_sw then call ioa_ ("^-(HUGE=^d EM=^d EN=^d THK=^d MED=^d " || "THN=^d HAIR=^d STRK=^d)", fnttbl.units (rank (HUGE)), fnttbl.units (rank (EM)),fnttbl.units (rank (EN)), fnttbl.units (rank (THICK)),fnttbl.units (rank (MEDIUM)), fnttbl.units (rank (THIN)),fnttbl.units (rank (DEVIT)), fnttbl.units (rank (STROKE))); end; end set_font; %page; set_media: proc (media_font, new_devfnt); /* PARAMETERS */ dcl media_font fixed bin; /* font needing the media */ dcl new_devfnt fixed bin; /* wanted device font */ /* LOCAL STORAGE */ dcl chng bit (1); /* 1= media or size has to change */ dcl med_chng bit (1); /* 1= media has to change */ dcl size_chng bit (1); /* 1= size has to change */ dcl temp_r bit (18); med_chng = tstr.devfnt ^= new_devfnt; size_chng = media_size ^= font_size; chng = med_chng | size_chng; if detail_sw && chng then call ioa_$nnl ("^5x(set_media: siz=^f med=^d --> siz=^f med=^d ", show (media_size, 1000), tstr.devfnt, show (font_size, 1000), new_devfnt); /**** &&set_media FOR &device */ &set_media /**** END &device */ /**** &&set_ps FOR &device */ &set_ps /**** END &device */ if detail_sw && chng then call ioa_ ("sel=""^a"")", comp_util_$display ((medsel (new_devfnt)), 0, "0"b)); &if &devclass = bitmap &then&+ /* is it a superior font? */ if substr (sup_media, media_font, 1) then call move_tstr (-1); /**/ /* is it a inferior font? */ else if substr (inf_media, media_font, 1) then call move_tstr (1); &fi&. /* if not in media needed */ if med_chng /* ...change to it */ then do; tstr.devfnt = new_devfnt; tstr.font = media_font; end; &if &devclass = bitmap &then&. if length (tstr_line) > 2 && med_chng then do; tstr.last_cr = length (tstr_line); call put_str (CR || medselstr, -Xpos); end; else if length (tstr_line) <= 2 then do; tstr_line = ""; tstr.last_cr = 0; call put_str ((medselstr), 0); end; if chng then Xpos, tstr.xpos = 0; &fi end set_media; /* device &device "other_procs" */ &other_procs&+ dcl db_sw bit (1) aligned static init ("0"b); dbn: entry;db_sw = "1"b;goto db_join; dbf: entry;db_sw = "0"b;return; dcl tx_sw bit (1) aligned static init ("0"b); txn: entry; tx_sw = "1"b; goto db_join; txf: entry; tx_sw = "0"b; return; dcl lg_sw bit (1) aligned static init ("0"b); lgn: entry; lg_sw = "1"b; goto db_join; lgf: entry; lg_sw = "0"b; return; dcl pf_sw bit (1) aligned static init ("0"b); pfn: entry; pf_sw = "1"b; return; pff: entry; pf_sw = "0"b; return; dcl abrt_sw bit (1) aligned static init ("0"b); abrtn: entry; abrt_sw = "1"b; return; abrtf: entry; abrt_sw = "0"b; return; dcl dt_sw bit (1) aligned static init ("0"b); dtn: entry;dt_sw = "1"b;goto db_join; dtf: entry;dt_sw = "0"b;return; alln: entry; db_sw, dt_sw, lg_sw = "1"b; db_join: dcl db_line fixed bin static init (0); dcl com_err_ entry options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl arg char (argl) based (argp); dcl argl fixed bin; dcl argp ptr; dcl ercd fixed bin (35); dcl error_table_$noarg fixed bin (35) ext static; db_line = 0; call cu_$arg_ptr (1, argp, argl, ercd); if ercd ^= 0 then do; if ercd ^= error_table_$noarg then call com_err_ (ercd, "&device&._writer_"); return; end; db_line = convert (db_line, arg); return; allf: entry; db_sw, lg_sw, tx_sw, pf_sw, dt_sw, abrt_sw = "0"b; return; %page; /* This one include file contains all the compose includes necessary for an */ /* output writer */ % include comp_outproc; end &device&._writer_; &expend */ ----------------------------------------------------------- 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 */