cv_prt_rqti.rd 03/17/86 1521.3rew 03/17/86 1433.2 156249 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ /* format: off */ /* Program to convert an ASCII file into a request info segment */ /* Created: May 1977 by E. Donner */ /* Modified: June 1979 by C. Hornig to add banner_bars and banner_type: brief; */ /* Modified: December 1981 by G. Palter to add "prt_control: force_ctl_char;" and to fix entry number 0001 (phx06682) from the io_daemon error list: cv_prt_rqti prints a misleading error message when improper syntax appears in the "message" statement (and probably other statements also) */ /* Modified: November 1983 by C. Marker to add force_nsep */ /* format: on */ /*++ BEGIN / driver_attributes : / LEX(2) / driver_attr\ / driver_wait_time : ; / [prt_rqti.driver_wait_time = wait_time] LEX(4) / BEGIN\ / driver_wait_time : ; / NEXT_STMT / BEGIN\ / banner_type : standard ; / [is_printer = "1"b; prt_rqti.banner_type = 1] LEX(4) / BEGIN\ / banner_type : brief ; / [is_printer = "1"b; prt_rqti.banner_type = 2] LEX(4) / BEGIN\ / banner_type : none ; / [is_printer = "1"b; prt_rqti.banner_type = 0] LEX(4) / BEGIN\ / banner_type : ; / LEX(2) ERROR(18) NEXT_STMT / BEGIN\ / banner_type : / ERROR(4) NEXT_STMT / BEGIN\ / banner_bars : double ; / [is_printer = "1"b; prt_rqti.banner_bars = 0] LEX(4) / BEGIN\ / banner_bars : single ; / [is_printer = "1"b; prt_rqti.banner_bars = 1] LEX(4) / BEGIN\ / banner_bars : none ; / [is_printer = "1"b; prt_rqti.banner_bars = 2] LEX(4) / BEGIN\ / banner_bars : ; / LEX(2) ERROR(14) NEXT_STMT / BEGIN\ / banner_bars : / ERROR(4) NEXT_STMT / BEGIN\ / prt_control : / [is_printer = "1"b] LEX(2) / process_control_flags\ / message : ; / LEX(2) [prt_rqti.opr_msg = token_value; is_printer = "1"b] LEX(2) / BEGIN\ / message : / ERROR(4) NEXT_STMT / BEGIN\ / paper_length : ; / [prt_rqti.paper_length = paper_len; is_printer = "1"b] LEX(4) / BEGIN\ / paper_length : ; / NEXT_STMT / BEGIN\ / paper_width : ; / [prt_rqti.paper_width = paper_wdth; is_printer = "1"b] LEX(4) / BEGIN\ / paper_width : ; / NEXT_STMT / BEGIN\ / lines_per_inch : ; / [prt_rqti.lines_per_inch = lpi; is_printer = "1"b] LEX(4) / BEGIN\ / lines_per_inch : ; / NEXT_STMT / BEGIN\ / line ( ) : / [is_printer = "1"b] LEX(5) / process_nos\ / line ( ) : / NEXT_STMT / BEGIN\ / end ; / / end\ / : / ERROR(1) NEXT_STMT / BEGIN\ / / ERROR(4) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ process_nos / / [substr(prt_rqti.channel_stops(line_no),chn_no,1)="1"b] LEX(1) / get_punct\ / / NEXT_STMT / BEGIN\ / / ERROR(2) / end\ get_punct / , / LEX / process_nos\ / ; / LEX / BEGIN\ / / ERROR(4) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ end / / / RETURN\ driver_attr / / [ind = 1; string (switches(0)) =""b; string (switches (1)) = ""b] / \ driver_loop / ; / LEX / assign_switches\ / ^ / [ind = 1 - ind] LEX / \ / meter / [switches (ind).meter = "1"b] LEX / attpunct\ / auto_go / [switches (ind).auto_go = "1"b] LEX / attpunct\ / / ERROR(15) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ attpunct / , / [ind = 1] LEX / driver_loop\ / ; / LEX / assign_switches\ / / ERROR(4) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ assign_switches / / [string(prt_rqti.rqti_switches) = string(switches(1)) & ^string(switches(0))] / BEGIN\ process_control_flags / / [ind = 1; string(flags(0)) = ""b; string(flags(1)) = ""b] / \ flag_loop / ; / LEX / assign_flags\ / ^ / [ind = 1 - ind] LEX / \ / auto_print / [flags(ind).no_auto_print = "1"b] LEX / flagpunct\ / force_nep / [flags(ind).force_nep = "1"b] LEX / flagpunct\ / force_esc / [flags(ind).force_esc = "1"b] LEX / flagpunct\ / force_nsep / [flags(ind).force_nsep = "1"b] LEX / flagpunct\ / force_ctl_char / [flags(ind).force_ctl_char = "1"b] LEX / flagpunct\ / / ERROR(16) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ flagpunct / , / [ind = 1] LEX / flag_loop\ / ; / LEX / assign_flags\ / / ERROR(4) NEXT_STMT / BEGIN\ / / ERROR(2) / end\ assign_flags / / [string(prt_rqti.prt_flags) = string(flags(1)) & ^string(flags(0))] / BEGIN\ ++*/ /* */ cv_prt_rqti: procedure () options (variable); /* AUTOMATIC VARIABLES */ dcl APstmt ptr; dcl APtoken ptr; dcl area_ptr ptr; dcl arg_length fixed bin; dcl arg_ptr ptr; dcl bitcount fixed bin (24); dcl chn_no fixed bin; dcl code fixed bin (35); dcl dname char (168); dcl ename char (32); dcl ind fixed bin; dcl is_printer bit (1) aligned; dcl len_ent fixed bin; dcl len_rqti fixed bin (18); dcl line_no fixed bin; dcl lpi fixed bin; dcl max_line_no fixed bin; dcl n_chars fixed bin (21); dcl paper_len fixed bin; dcl paper_wdth fixed bin; dcl rqti_name char (32); dcl sourcep ptr; dcl wait_time fixed bin; dcl 1 flags (0:1) aligned like prt_rqti.prt_flags; dcl 1 switches (0:1) aligned like rqti_header.rqti_switches; /* BASED VARIABLES */ dcl arg char (arg_length) based (arg_ptr); /* BUILTINS */ dcl (clock, collate, dimension, divide, length, null, rtrim, size, string, substr, unspec) builtin; /* CONDITIONS */ dcl cleanup condition; /* EXTERNAL ENTRIES */ dcl com_err_ entry options (variable); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl get_wdir_ entry returns (char (168) aligned); dcl lex_error_ entry options (variable); dcl lex_string_$init_lex_delims entry (char (*), char (*), char (*), char (*), char (*), bit (*), char (*) var, char (*) var, char (*) var, char (*) var); dcl lex_string_$lex entry (ptr, fixed bin (21), fixed bin, ptr, bit (*), char (*), char (*), char (*), char (*), char (*), char (*) var, char (*) var, char (*) var, char (*) var, ptr, ptr, fixed bin (35)); dcl translator_temp_$get_segment entry (char (*), ptr, fixed bin (35)); dcl translator_temp_$release_all_segments entry (ptr, fixed bin (35)); /* INTERNAL STATIC VARIABLES */ dcl BREAKS char (128) varying; dcl IGBREAKS char (128) varying; dcl LEXCTL char (128) varying; dcl LEXDLM char (128) varying; dcl first_time bit (1) aligned init ("1"b); /* CONSTANTS */ dcl me char (11) static options (constant) init ("cv_prt_rqti"); /* EXTERNAL STATIC VARIABLES */ dcl error_table_$badopt ext fixed bin (35); dcl error_table_$entlong ext fixed bin (35); dcl error_table_$translation_failed ext fixed bin (35); /* */ %include prt_rqti; /* */ /* PROGRAM */ call cu_$arg_ptr (1, arg_ptr, arg_length, code); if code ^= 0 then do; call com_err_ (code, me, "Usage: cv_prt_rqti pathname (-brief|-bf|-long|-lg"); return; end; call expand_pathname_$add_suffix (arg, "rqti", dname, ename, code); if code ^= 0 then do; error1: call com_err_ (code, me, arg); return; end; call cu_$arg_ptr (2, arg_ptr, arg_length, code); if code = 0 then if (arg = "-bf") | (arg = "-brief") then SERROR_CONTROL = "01"b; else if (arg = "-lg") | (arg = "-long") then SERROR_CONTROL = "10"b; else do; code = error_table_$badopt; go to error1; end; len_ent = length (rtrim (ename)); sourcep = null; prt_rqtip = null; area_ptr = null; on cleanup call clean; call hcs_$initiate_count (dname, ename, "", bitcount, 1b, sourcep, code); if sourcep = null then do; error2: call com_err_ (code, me, "^a>^a", dname, ename); return; end; n_chars = divide (bitcount + 8, 9, 22, 0); dname = get_wdir_ (); rqti_name = substr (ename, 1, len_ent - length (".rqti")); call hcs_$make_seg (dname, rqti_name, "", 1011b, prt_rqtip, code); if prt_rqtip = null then do; error3: call com_err_ (code, me, "^a>^a", dname, rqti_name); call clean; return; end; call hcs_$truncate_seg (prt_rqtip, 0, code); if code ^= 0 then go to error3; unspec (prt_rqti) = "0"b; prt_rqti.time_created = clock (); prt_rqti.header_version = rqti_header_version_1; prt_rqti.driver_wait_time = 30; prt_rqti.version = prt_rqti_version_1; prt_rqti.opr_msg = ""; prt_rqti.banner_type = 1; prt_rqti.banner_bars = 0; prt_rqti.banner_line = 1; prt_rqti.paper_length = 66; prt_rqti.paper_width = 136; prt_rqti.lines_per_inch = 6; prt_rqti.no_auto_print = "1"b; max_line_no = 0; if first_time /* only needs to be done once/process */ then do; BREAKS = substr (collate (), 1, 8) || substr (collate (), 10, 24) || ":,()^"; IGBREAKS = substr (collate (), 1, 8) || substr (collate (), 10, 24); call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, BREAKS, IGBREAKS, LEXDLM, LEXCTL); first_time = "0"b; end; call translator_temp_$get_segment (me, area_ptr, code); if area_ptr = null then do; call com_err_ (code, me, "Making temporary segment in process directory."); call clean; return; end; call lex_string_$lex (sourcep, n_chars, 0, area_ptr, "1000"b, """", """", "/*", "*/", ";", BREAKS, IGBREAKS, LEXDLM, LEXCTL, APstmt, APtoken, code); if code ^= 0 then do; call com_err_ (code, me, ename); call clean; return; end; Pthis_token = APtoken; call SEMANTIC_ANALYSIS (); if is_printer = "1"b then do; prt_rqti.type_code = 1; prt_rqti.no_auto_print = ^prt_rqti.no_auto_print; if (SERROR_PRINTED (10) = "0"b) & (max_line_no > prt_rqti.paper_length) then call semant_error (9, max_line_no, prt_rqti.paper_length); if (SERROR_PRINTED (18) = "0"b) & (prt_rqti.banner_type = 1) then do; if (SERROR_PRINTED (11) = "0"b) & (prt_rqti.paper_width < 10) then call semant_error (5, 0, 0); if (SERROR_PRINTED (10) = "0"b) & (SERROR_PRINTED (12) = "0"b) & (prt_rqti.paper_length < (24 + prt_rqti.lines_per_inch)) then call semant_error (6, (24 + prt_rqti.lines_per_inch), prt_rqti.lines_per_inch); end; end; if MERROR_SEVERITY > 1 then do; call com_err_ (error_table_$translation_failed, me, ename); call hcs_$delentry_seg (prt_rqtip, code); prt_rqtip = null; end; else do; if prt_rqti.type_code = 0 then do; len_rqti = size (rqti_header); call hcs_$truncate_seg (prt_rqtip, len_rqti, code); end; else len_rqti = size (prt_rqti); bitcount = 36 * len_rqti; call hcs_$set_bc_seg (prt_rqtip, bitcount, code); if code ^= 0 then call com_err_ (code, me, "Unable to set bitcount on ^a>^a to ^d", dname, rqti_name, bitcount); end; call clean; /* terminate input & output segments */ return; /* clean up procedure */ clean: procedure; if sourcep ^= null then call hcs_$terminate_noname (sourcep, code); if prt_rqtip ^= null then call hcs_$terminate_noname (prt_rqtip, code); if area_ptr ^= null then call translator_temp_$release_all_segments (area_ptr, code); end clean; /* */ legal_paper_len: proc returns (bit (1) aligned); paper_len = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (10, token_value); return ("0"b); end; if (paper_len < 10) | (paper_len > 127) then do; call statement_error (10, token_value); return ("0"b); end; return ("1"b); end legal_paper_len; legal_paper_wdth: proc returns (bit (1) aligned); paper_wdth = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (11, token_value); return ("0"b); end; if (paper_wdth < 1) | (paper_wdth > 200) then do; call statement_error (11, token_value); return ("0"b); end; if (paper_wdth > 136) then call statement_error (7, token_value); return ("1"b); end legal_paper_wdth; legal_lpi: proc returns (bit (1) aligned); lpi = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (12, token_value); return ("0"b); end; if (lpi = 6) | (lpi = 8) then return ("1"b); call statement_error (12, token_value); return ("0"b); end legal_lpi; legal_line_no: proc returns (bit (1) aligned); line_no = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (13, token_value); return ("0"b); end; if (line_no < 1) | (line_no > 127) then do; call statement_error (13, token_value); return ("0"b); end; if line_no > max_line_no then max_line_no = line_no; return ("1"b); end legal_line_no; legal_chn_no: proc returns (bit (1) aligned); chn_no = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (3, token_value); return ("0"b); end; if (chn_no < 1) | (chn_no > 16) then do; call statement_error (3, token_value); return ("0"b); end; return ("1"b); end legal_chn_no; legal_wait_time: proc returns (bit (1) aligned); wait_time = cv_dec_check_ (token_value, code); if code ^= 0 then do; call statement_error (17, token_value); return ("0"b); end; if (wait_time < 30) | (wait_time > 300) then do; call statement_error (17, token_value); return ("0"b); end; return ("1"b); end legal_wait_time; semant_error: proc (error_num, parm1, parm2); dcl error_num fixed bin; dcl parm1 fixed bin; dcl parm2 fixed bin; call lex_error_ (error_num, SERROR_PRINTED (error_num), (error_control_table.severity (error_num)), MERROR_SEVERITY, null, null, SERROR_CONTROL, (error_control_table.message (error_num)), (error_control_table.brief_message (error_num)), parm1, parm2); end semant_error; statement_error: proc (error_num, string1); dcl error_num fixed bin; dcl string1 char (*); dcl stmt_ptr ptr; dcl token_ptr ptr; stmt_ptr = token.Pstmt; token_ptr = Pthis_token; call lex_error_ (error_num, SERROR_PRINTED (error_num), (error_control_table.severity (error_num)), MERROR_SEVERITY, stmt_ptr, token_ptr, SERROR_CONTROL, (error_control_table.message (error_num)), (error_control_table.brief_message (error_num)), string1); end statement_error; /* */ /* ERROR MESSAGES */ dcl 1 error_control_table (18) aligned static options (constant), 2 severity fixed bin unal init (/* 1 - 4 */ (4) 3, /* 5 - 7 */ (3) 1, /* 8 - 18 */ (11) 3), 2 Soutput_stmt bit (1) unal init (/* 1 */ "1"b, /* 2 */ "0"b, /* 3 - 4 */ (2) (1)"1"b, /* 5 - 6 */ (2) (1)"0"b, /* 7 - 18 */ (12) (1)"1"b), 2 message char (100) var init (/* 1 */ "Illegal keyword ""^a"".", /* 2 */ "Premature end of source segment encountered. Check for missing end statement.", /* 3 */ "Illegal channel number ""^a"".", /* 4 */ "Syntax error in ""^a"" statement.", /* 5 */ "Paper width should be at least 10 when using standard banners.", /* 6 */ "Paper length must be at least ""^d"" at ""^d"" lines per inch when using standard banners.", /* 7 */ "Paper width ""^a"" greater than standard printer platen of 136.", /* 8 */ "Unused", /* 9 */ "Channel stop specified for line ""^d"" which is greater than paper length ""^d"".", /* 10 */ "Illegal paper length ""^a"".", /* 11 */ "Illegal paper width ""^a"".", /* 12 */ "Illegal lines per inch ""^a"".", /* 13 */ "Illegal line number ""^a"".", /* 14 */ "Illegal banner bars specifier ""^a"".", /* 15 */ "Illegal driver attribute ""^a"".", /* 16 */ "Illegal control attribute ""^a"".", /* 17 */ "Illegal wait_time ""^a"".", /* 18 */ "Illegal banner type ""^a""."), 2 brief_message char (20) var init (/* 1 */ "^a", /* 2 */ "Premature EOF.", /* 3 - 4 */ (2) (1)"^a", /* 5 */ "", /* 6 */ "", /* 7 */ "", /* 8 */ "", /* 9 */ "^d ^d", /* 10 - 18 */ (9) (1)"^a");  display_prt_rqti.pl1 07/26/84 1434.6rew 07/26/84 1208.5 62892 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ /* format: off */ /* Decodes and prints the contents of a binary data table segment produced by cv_rqti. The format of the printed output corresponds exactly to the source language accepted by cv_rqti. Thus, if output is directed to a file, the resulting file can be converted. */ /* Created: August 1977 by J. Whitmore */ /* Modified: June 1979 by C. Hornig to define the banner_bars keyword */ /* Modified: 30 November 1981 by G. Palter to recognize new force_ctl_char mode */ /* Modified: November 1983 by C. Marker to recognize force_nsep mode. */ /* format: on */ display_prt_rqti: procedure () options (variable); dcl arglen fixed bin; /* length of arg */ dcl argp ptr; /* ptr to arg */ dcl code fixed bin (35); /* error code */ dcl date char (24); /* the date in ascii */ dcl dir char (168); /* directory pathname */ dcl ent char (32); /* entry name */ dcl (i, j, k) fixed bin; /* loop variables */ dcl nargs fixed binary; dcl segp ptr; /* ptr to compiled segment */ dcl stops char (48) var; dcl arg char (arglen) based (argp); /* command argument */ dcl chan_id (16) char (3) int static options (constant) init (" 1,", " 2,", " 3,", " 4,", " 5,", " 6,", " 7,", " 8,", " 9,", "10,", "11,", "12,", "13,", "14,", "15,", "16,"); dcl whoami char (24) int static options (constant) init ("display_prt_rqti"); dcl (hbound, length, null, string, substr, rtrim) builtin; dcl cleanup condition; dcl ( com_err_, com_err_$suppress_name ) entry () options (variable); dcl cu_$arg_count entry (fixed binary, fixed binary (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl date_time_ entry (fixed bin (71), char (*)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl ioa_ entry () options (variable); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl requote_string_ entry (character (*)) returns (character (*)); /* */ call cu_$arg_count (nargs, code); if code ^= 0 then do; /* not called as a command */ call com_err_ (code, whoami); return; end; if nargs ^= 1 then do; call com_err_$suppress_name (0, whoami, "Usage: ^a path", whoami); return; end; call cu_$arg_ptr (1, argp, arglen, code); /* get pathname arg */ if code ^= 0 then do; call com_err_ (code, whoami, "Fetching argument #1."); return; end; call expand_pathname_ (argp -> arg, dir, ent, code); /* get dir and entry names */ if code ^= 0 then do; call com_err_ (code, whoami, arg); return; end; call hcs_$initiate (dir, ent, "", 0, 0, segp, code); /* get segment ptr */ if segp = null () then do; call com_err_ (code, whoami, "^a>^a", dir, ent); return; end; on condition (cleanup) call hcs_$terminate_noname (segp, (0)); prt_rqtip = segp; /* set up for automatic based references */ call date_time_ (prt_rqti.header.time_created, date); /* keep compilation date handy */ if prt_rqti.header.header_version ^= rqti_header_version_1 then do; call com_err_ (0, whoami, "Wrong header version number for ^a. ^d (compilation date: ^a)", pathname_ (dir, ent), prt_rqti.header.header_version, date); go to finish; end; if prt_rqti.type_code = 1 then /* check items for printer type only */ if prt_rqti.version ^= prt_rqti_version_1 then do; call com_err_ (0, whoami, "Wrong table version number for ^a. ^d (compilation date: ^a)", pathname_ (dir, ent), prt_rqti.version, date); go to finish; end; call ioa_ ("/* Listing of^[ printer^;^] request type info table: ^a */ /* Table created on: ^a */ /* Header version number: ^d */ /* Table version number: ^d */", (prt_rqti.type_code = 1), pathname_ (dir, ent), date, prt_rqti.header.header_version, prt_rqti.version); /* start with a little background information */ call ioa_ ("^2//* Driver Info */^/"); call ioa_ ("driver_attributes:^-^[^;^^^]meter, ^[^;^^^]auto_go;", prt_rqti.meter, prt_rqti.auto_go); call ioa_ ("driver_wait_time:^-^d;", prt_rqti.driver_wait_time); if prt_rqti.type_code = 1 then do; /* if a printer type rqti display rest of information */ if prt_rqti.opr_msg ^= "" then do; /* print the message and comment only if defined */ call ioa_ ("^2//* Message to the operator during driver initialization */^/"); call ioa_ ("message:^/^a;", requote_string_ (rtrim (prt_rqti.opr_msg))); end; call ioa_ ("^2//* Banner Info */^/"); call ioa_ ("banner_type:^-^[none^;standard^;brief^;^d^];", (prt_rqti.banner_type + 1), prt_rqti.banner_type); call ioa_ ("banner_bars:^-^[double^;single^;none^;^d^];", (prt_rqti.banner_bars + 1), prt_rqti.banner_bars) ; call ioa_ ("^2//* Control Flags for Printing */^/"); call ioa_ ( "prt_control:^-^[^;^^^]auto_print, ^[^;^^^]force_nep, ^[^;^^^]force_esc, ^[^;^^^]force_ctl_char, ^[^;^^^]force_nsep;" , ^prt_rqti.no_auto_print, prt_rqti.force_nep, prt_rqti.force_esc, prt_rqti.force_ctl_char, prt_rqti.force_nsep); call ioa_ ("^2//* Physical Paper Info */^/"); call ioa_ ("paper_width:^-^d;", prt_rqti.paper_width); call ioa_ ("paper_length:^-^d;", prt_rqti.paper_length); call ioa_ ("lines_per_inch:^4x^-^d;", prt_rqti.lines_per_inch); if string (prt_rqti.channel_stops) then do; /* if there are any stops defined, print them */ call ioa_ ("^2//* Logical Channel Stops */^/"); do i = 1 to hbound (prt_rqti.channel_stops, 1); /* look at all the possible values */ if prt_rqti.channel_stops (i) then do; /* but only print the non-null stop data */ stops = ""; /* clear the stops from the last line */ do j = 1 to 16; /* look at each channel for this line */ if substr (prt_rqti.channel_stops (i), j, 1) then stops = stops || chan_id (j); end; k = length (rtrim (stops)); /* change last comma into a semi-colon */ stops = substr (stops, 1, (k - 1)) || ";"; call ioa_ ("line(^d):^5x^-^a", i, stops); /* print it */ end; end; end; end; call ioa_ ("^/end;"); finish: call hcs_$terminate_noname (segp, code); return; %page; %include prt_rqti; end display_prt_rqti;  do_prt_request_.pl1 10/01/90 1537.2rew 10/01/90 1529.0 779976 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1990 * * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ /* Procedure for printing I/O Daemon dprint requests */ /* format: off */ /* Adapted from output_request_ by J. C. Whitmore, Sept. 1977 */ /* Modified by J. C. Whitmore, 4/78, for new dprint message format and bug fix */ /* Modified by J. C. Whitmore, 7/78, for auto defer; cancel delete on device error; save current request */ /* Modified by J. C. Whitmore, 11/78, to add path to device error msg, notify user on deferring request, and fix req_status arg error msg */ /* Modified by J. C. Whitmore, 3/79, to correct the size of string variables for correct assignments */ /* Modified by J. C. Whitmore, 5/79, to use end-of-page order only when printing page labels */ /* Modified by C. Hornig, 6/79, to take prt_ctl information out of static */ /* Modified by J. C. Whitmore, 1/80, to limit the scope of system_privileges_ for send mail (V5.4) */ /* Modified 04/01/81 by GA Texada to 1) make labels work all the time 2) call head_sheet_$test when in a test environment */ /* Modified: 11 December 1981 by G. Palter to support force_ctl_char, remove the call to head_sheet_$test as it has been moved to iodd_ where it belongs, and fix the following io_daemon error list entries: 0003: phx06955 phx11428 When running an I/O daemon through remote_driver_ with the line specified as "user_i/o", the message printed by the "restart" request is cutoff in the middle as it is printed immediately before a "resetwrite" control order 0010: phx09171 The module do_prt_request_ should issue a "runout" order after printing the tail sheet and before printing the charge message; otherwise, the charge message may appear in the middle of the tail sheet on remote printers with no attached console */ /* Modified: November 1983 by C. Marker added support for force_nsep and no_separator */ /* Modified: 25 June 1984 by C. Marker changed to notify the user when unable to set line modes. */ /* Modified: 22 February 1984 by C. Marker changed to check if the page labels are the same as the access class of the segment and call access_audit_gate_$log_obj_ptr_user if they are not. Changed to use version 5 message segments. */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-08-06,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Implement -nb output. 2) change(88-10-24,Brunelle), approve(88-10-24,MCR7911), audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199): Upgrade to support version 5 of I/O daemon tables. Also support single & continuous forms paper; new head & tail sheet entry variables in iodd_static; forms processing control string for single sheet paper; etc. 3) change(88-11-11,Brunelle), approve(88-11-11,MCR7911), audit(88-11-14,Wallman), install(88-11-14,MR12.2-1212): Correct problem of not suppressing trailing blank pages. 4) change(90-09-10,Itani), approve(90-09-10,MCR8198), audit(90-09-21,WAAnderson), install(90-10-01,MR12.4-1034): Correct the problem of indenting centered labels. END HISTORY COMMENTS */ /* format: on */ do_prt_request_: procedure (a_iocbp, a_stat_p, a_code); /* Parameters */ dcl a_iocbp ptr; /* ptr to the io control block for iox_ */ dcl a_stat_p ptr; /* the value of stat_p from caller */ dcl a_code fixed bin (35); /* error code....used for driver_fatal_error */ /* Automatic */ dcl access_class bit (72) aligned; /* access class of user file */ dcl auth bit (72) aligned; /* authorization used to set banner access class */ dcl auth_string char (680); /* string form of auth */ dcl char_count fixed bin (24); /* total number of chars if the file */ dcl chars_done fixed bin (24); /* total chars printed between head & tail sheets */ dcl chgsw bit (1); /* indicate whether to charge */ dcl ck_interval fixed bin; /* number of lines between checkpoints */ dcl ck_mode char (12) aligned; /* mode string for prtdim to set checkpoints */ dcl cmd_line char (80); /* space for operator commands */ dcl code fixed bin (35); dcl continuous_paper bit (1); /* OFF is single sheet paper */ dcl control bit (36) aligned; dcl copies_left fixed bin; /* number if copies to be done this time thorugh */ dcl ctl_msg_sent bit (1); dcl delete_msg char (32); dcl desc_ptr ptr; dcl dest char (24) aligned; dcl device_error bit (1); dcl ename char (32) aligned; /* entry name of file for output */ dcl err_mess char (200) var; dcl fcbp ptr; dcl force_ck_pt bit (1) aligned; dcl full_path char (168) aligned; dcl head char (64) aligned; /* temp for the header */ dcl header_done bit (1); /* TRUE when header is printed */ dcl how fixed bin; /* code for how the segment should be printed */ dcl i fixed bin; dcl iocbp ptr; dcl l fixed bin (24); dcl last_error_count fixed bin; /* last printer error count read */ dcl lg_msg char (100) aligned; dcl lg_sw bit (1) aligned; dcl line_mode char (32); /* request modes for length & indentation */ dcl mailname char (32) aligned; dcl max_comp fixed bin; dcl msg char (256) aligned; /* space for operator messages */ dcl n_sample_pages fixed bin; /* count sample pages, to maintain alignment of paper */ dcl nep_mode_set bit (1); /* TRUE if request is being done in nep mode */ dcl new_clock fixed bin (71); dcl new_cpu fixed bin (52); dcl new_pp fixed bin; dcl new_rate fixed bin (35); /* new estimate of transmission rate */ dcl new_waits fixed bin (35); dcl nt fixed bin (24); /* number of elements processed on read */ dcl old_clock fixed bin (71); dcl old_cpu fixed bin (52); dcl old_pp fixed bin; dcl old_rate fixed bin (35); dcl old_waits fixed bin (35); dcl omode char (256); /* mode returned form dim */ dcl paper_not_aligned bit (1) aligned; dcl pic picture "(11)-9"; /* dummy for fixed bin to char conversion */ dcl printing bit (1); /* TRUE when the actual printing is in progress */ dcl restart_source fixed bin; /* restart was from master or slave */ dcl seconds fixed bin; dcl segp ptr; dcl set_page_labels bit (1); /* TRUE - when we want to set labels */ dcl short_msg char (8) aligned; dcl source fixed bin; /* cmd source, master or slave */ dcl start_char_offset fixed bin (24); /* file offset at start of printing */ dcl start_segp pointer; /* pointer to first component if MSF otherwise to segment */ dcl starting_page fixed bin (24); dcl stream char (32); /* stream name for ios_ */ dcl terminal (2) char (32); /* streams for 1) master, or 2) slave */ dcl time_est fixed bin; /* estimated number of seconds to process request */ dcl user_dir char (168) aligned; /* directory containing users' segment */ dcl val fixed bin; /* for validation level */ %page; /* Internal Static */ dcl whoami char (32) int static options (constant) init ("do_prt_request_"); dcl master fixed bin int static options (constant) init (1); dcl slave fixed bin int static options (constant) init (2); dcl (both, log) fixed bin int static options (constant) init (0); dcl normal fixed bin int static options (constant) init (1); /* normal streams for opr msgs */ dcl error fixed bin int static options (constant) init (2);/* code for error streams */ dcl tell_user bit (1) int static options (constant) init ("1"b); /* force error msg to user */ /* go by user notify flag */ /* the following variables are for call to output_file */ dcl PRINT fixed bin int static options (constant) init (1); dcl SAMPLE fixed bin int static options (constant) init (2); dcl SKIP fixed bin int static options (constant) init (3); dcl SAVE fixed bin int static options (constant) init (4); dcl factor float bin int static options (constant) init (0.75e0); /* smoothing factor for rate estimate */ dcl stars char (40) int static options (constant) aligned init ((40)"*"); /* For error messages */ dcl privileged bit (1) static init ("1"b); /* TRUE if we can call phcs_ */ dcl sys_priv bit (1) static init ("1"b); /* TRUE if process cal call system_privilege_ */ dcl first_call bit (1) static init ("1"b); /* TRUE on first call */ dcl fault_name char (32) aligned int static; dcl request_data_p ptr int static init (null); dcl err_label label int static; /* point of return from condition handler */ dcl bad_chars char (5) defined BAD_CHARS position (2); dcl nl_vt_ff char (3) defined BAD_CHARS position (4); /* vert carriage control chars */ dcl space_ht_bs char (3) defined BAD_CHARS position (1); /* horiz carriage control chars */ dcl VT char (1) defined BAD_CHARS position (5); /* the vertical tab character */ dcl FF char (1) defined BAD_CHARS position (6); /* the form feed character */ /* SP HT BS NL VT FF */ dcl BAD_CHARS char (6) int static options (constant) init ("  "); /* External static */ dcl access_operations_$io_daemon_set_page_labels bit (36) aligned external static; dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$ai_restricted ext static fixed bin (35); dcl error_table_$dirseg ext static fixed bin (35); dcl error_table_$eof_record fixed bin (35) ext static; dcl error_table_$improper_data_format fixed bin (35) ext static; dcl error_table_$moderr fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$out_of_bounds fixed bin (35) ext static; dcl error_table_$request_pending fixed bin (35) ext static; %page; /* External Entries */ dcl access_audit_gate_$log_obj_ptr_user entry options (variable); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl clock_ ext entry returns (fixed bin (71)); /* gets clock time */ dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (*) aligned, char (*) aligned); dcl cpu_time_and_paging_ entry (fixed bin (35), fixed bin (52), fixed bin); dcl cu_$level_get entry (fixed bin); dcl date_time_ entry (fixed bin (71), char (*) aligned); dcl hcs_$fs_get_mode ext entry (ptr, fixed bin (5), fixed bin (35)); dcl hcs_$fs_get_path_name entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)); dcl hcs_$get_access_class entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin (35)); dcl hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin (5), fixed bin (35)); dcl hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (2), fixed bin (24), fixed bin (35)); dcl io_daemon_account_ entry (entry, ptr); dcl ioa_$rsnnl entry options (variable); dcl iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35)); dcl iodd_get_cmd_ entry (ptr, fixed bin, fixed bin (24), bit (36) aligned, char (*), fixed bin, fixed bin (35)); dcl iodd_msg_ entry options (variable); dcl iodd_parse_$args entry (char (*) var, char (*)) returns (char (256) var); dcl iodd_parse_$command entry (char (*), ptr, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); dcl iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl msf_manager_$close entry (ptr); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); dcl msf_manager_$open entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)); dcl phcs_$deactivate entry (ptr, fixed bin (35)); dcl phcs_$set_kst_attributes entry (fixed bin, ptr, fixed bin (35)); dcl probe entry (); dcl read_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl send_mail_$access_class entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned, fixed bin (35)); dcl sys_info$max_seg_size fixed bin (35) ext static; dcl system_privilege_$ipc_priv_off entry (fixed bin (35)); dcl system_privilege_$ipc_priv_on entry (fixed bin (35)); dcl system_privilege_$ring1_priv_off entry (fixed bin (35)); dcl system_privilege_$ring1_priv_on entry (fixed bin (35)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2) aligned, fixed bin (71)); dcl write_control_form_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)); %page; /* Structures */ dcl 1 ksta like kst_attributes aligned internal static; dcl 1 current aligned like print_driver_data.checkpoint; /* this defines the current position in the file */ dcl 1 ck aligned, /* The checkpoint history for the current file */ 2 last fixed bin, /* The last entry in the chain */ 2 entry (10), /* one entry for each checkpoint */ 3 forward fixed bin, /* the forward thread */ 3 point like print_driver_data.checkpoint; /* this is the checkpoint data */ dcl 1 position aligned like position_data; /* see prt_order_info.incl.pl1 */ dcl 1 pg_labels aligned like page_labels; /* see prt_order_info.incl.pl1 */ dcl 1 paper_info_data aligned like paper_info; /* see prt_order_info.incl.pl1 */ dcl 1 static_ctl aligned int static like prt_ctl; /* the default control values */ dcl 1 arg_list aligned, /* for parsing command lines */ 2 max_tokens fixed bin, /* the amount of space allocated */ 2 n_tokens fixed bin, /* the number of tokens in the line */ 2 cmd char (64) var, /* first token is the command */ 2 arg (3) char (64) var; /* we allow three arguments max */ dcl 1 ctl_wait_list aligned int static, /* we block on this list for ctl form sync */ 2 number fixed bin, /* number of ipc channels */ 2 channel fixed bin (71); /* this is the channel (only one) */ /* Builtins */ dcl (addr, baseno, binary, bit, char, convert, divide, fixed, float, hbound, length, ltrim, min, mod, null, rtrim, string, substr, translate, unspec, verify) builtin; /* Conditions */ dcl (cleanup, linkage_error, daemon_again, daemon_again_slave, daemon_kill, daemon_defer, daemon_cancel, daemon_save, size, conversion, any_other) condition; %page; /* Copy arguments and initialize pointers and control switches */ stat_p = a_stat_p; iocbp = a_iocbp; a_code = 0; /* set to zero for now */ chgsw = "0"b; /* assume no charge yet */ header_done = "0"b; /* header not done yet */ set_page_labels = "0"b; /* start with no labels assumed */ ck.last = 1; /* use first checkpoint entry */ arg_list.max_tokens = 4; /* only 4 tokens allowed in command lines */ terminal (master) = "user_output"; /* stream for master terminal output */ terminal (slave) = iodd_static.slave_output; /* check for active before use */ last_error_count = -1; /* set to undefined */ printing = "0"b; /* tell handler for daemon_save - not printing yet */ continuous_paper = (iodd_static.paper_type = PAPER_TYPE_CONTINUOUS); if first_call then do; /* init variables and see if we have phcs_ access */ call init_static_ctl (); on linkage_error begin; privileged = "0"b; go to tough; end; string (ksta) = "0"b; /* make a null structure */ call phcs_$set_kst_attributes (binary (baseno (stat_p), 18), addr (ksta), (0)); /* This is a NOP - structure is 0. If we get here we are privileged */ ksta.set.tpd, ksta.value.tpd = "1"b; /* Dont put on bulkstore just for lil ole me */ ksta.set.explicit_deactivate_ok, ksta.value.explicit_deactivate_ok = "1"b; ksta.set.allow_write = "1"b; /* Dont let me wreck user seg by accident */ ksta.set.tus, ksta.value.tus = "1"b; /* Save a vtoc write */ tough: revert linkage_error; first_call = "0"b; /* First call initialization is done */ end; if iodd_static.ctl_term.attached then do; /* get ready to send message to ctl term */ ctl_wait_list.number = 1; ctl_wait_list.channel = iodd_static.ctl_ev_chan; end; else ctl_wait_list.number = 0; /* don't try to use this */ driver_status_ptr = iodd_static.driver_ptr; /* get ptr to the current driver status seg */ evaluate_forms_info_output_ptr = driver_status.forms_validation_ptr; prt_ctl_ptr = driver_status.dev_ctl_ptr; /* get print control information */ if prt_ctl_ptr = null () then prt_ctl_ptr = addr (static_ctl); /* default values */ desc_ptr = addr (driver_status.descriptor); /* and to the request descriptor */ mseg_message_info_ptr = desc_ptr; /* first part of desciptor is mseg_message_info */ dmp = addr (driver_status.message); /* set dprint_msg default pointer */ driver_data_p = addr (desc_ptr -> request_descriptor.driver_data); /* get ptr to printer_driver_data */ request_data_p = addr (REQUEST); /* for the single copy entry */ fcbp, segp = null; /* set up for cleanup handler */ start_segp = null; stream = driver_status.dev_out_stream; /* record the switch name for easy reference */ on cleanup call clean_proc (); /* establish a cleanup handler */ err_label = abort_request; /* Set up master structure used by this pgm. */ string (REQUEST.control_flags) = ""b; /* clear all the flags */ REQUEST.requestor = mseg_message_info.sender_id; REQUEST.continued = desc_ptr -> request_descriptor.continued; REQUEST.restarted = desc_ptr -> request_descriptor.restarted; REQUEST.priority_request = desc_ptr -> request_descriptor.priority_request; REQUEST.separator = "1"b; /* we always want a print separator first time */ REQUEST.device_name = driver_status.dev_name_label; REQUEST.request_type = driver_status.req_type_label; REQUEST.queue = desc_ptr -> request_descriptor.q; REQUEST.charge_queue = desc_ptr -> request_descriptor.charge_q; /* coord may want a priority rate */ REQUEST.request_no = desc_ptr -> request_descriptor.seq_id; /* coord assigned the number */ REQUEST.restart_no = desc_ptr -> request_descriptor.prev_seq_id; /* previous number of request (0 = not restarted) */ REQUEST.contd_no = desc_ptr -> request_descriptor.contd_seq_id; /* previous number of continued request (0 = not continued) */ REQUEST.dpmp = dmp; if dprint_msg.delete_sw then REQUEST.delete = 1; else REQUEST.delete = 0; REQUEST.line_nbrs = dprint_msg.line_nbrs; REQUEST.single_sheet = (iodd_static.paper_type = PAPER_TYPE_SINGLE); REQUEST.bit_count = 0; REQUEST.line_count = 0; REQUEST.page_count = 0; REQUEST.punsw = 0; /* we are printing only */ REQUEST.copies = dprint_msg.copies; REQUEST.no_separator = dprint_msg.no_separator | prt_ctl.force_nsep; if ^(REQUEST.continued | REQUEST.restarted) then print_driver_data.copies_done = 0; /* no copies assumed, unless continued or restarted */ /* if none completed, it's not continued */ else if print_driver_data.copies_done < 1 then REQUEST.continued = "0"b; print_driver_data.copies_done = min (print_driver_data.copies_done, REQUEST.copies - 1); /* be sure we do at least one copy */ copies_left = REQUEST.copies - print_driver_data.copies_done; /* might be partly done */ REQUEST.copy_no = print_driver_data.copies_done + 1; /* we start with the next copy */ REQUEST.notify = dprint_msg.notify; REQUEST.output_mode = ""; /* clear in case of error message */ REQUEST.total_charge = 0e0; REQUEST.charge = 0e0; REQUEST.time_start_request = clock_ (); call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request); l = length (rtrim (REQUEST.requestor)) - 2; /* get length of Person.Project */ mailname = substr (REQUEST.requestor, 1, l); unspec (send_mail_info) = "0"b; send_mail_info.version = send_mail_info_version_2; send_mail_info.wakeup = "1"b; send_mail_info.always_add = "1"b; send_mail_info.sent_from = REQUEST.request_type; /* get pathname of file for operator and error messages */ user_dir = dprint_msg.dirname; ename = dprint_msg.ename; call ioa_$rsnnl ("^a^[>^]^a", full_path, l, user_dir, (user_dir ^= ">"), ename); REQUEST.full_path = translate (full_path, "", bad_chars); /* force a page fault - HARDWARE BUG WRITEAROUND */ full_path = translate (full_path, "", bad_chars); /* remove bad chars for banner */ dprint_msg.destination = translate (dprint_msg.destination, "", bad_chars); dprint_msg.heading = translate (dprint_msg.heading, "", bad_chars); REQUEST.full_path = full_path; /* save the clean copy */ /* record the processing of this request in the log */ head = dprint_msg.heading; if substr (head, 1, 5) = " for " then /* see if dprint added something */ head = substr (head, 6); /* if so get rid of it */ if head ^= "" then call ioa_$rsnnl ("(for ""^a"" ", msg, l, head); else do; l = 1; /* no heading, get ready for a dest msg */ msg = "("; end; dest = dprint_msg.destination; if dest ^= "" then call ioa_$rsnnl ("^vaat ""^a"")", msg, l, (l), substr (msg, 1, l), dest); else if l = 1 then msg = ""; /* no head or dest case */ else substr (msg, l, 1) = ")"; /* heading only case */ call iodd_msg_ (log, both, 0, "", /* let the subr do the work */ "Request ^d ^a q^d: ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a", REQUEST.request_no, REQUEST.request_type, REQUEST.queue, full_path, (copies_left > 1), copies_left, REQUEST.priority_request, REQUEST.charge_queue, REQUEST.requestor, msg); /* Now we can print a header banner if an error occurs */ err_mess = full_path; /* let this sit here in case */ /* Find the access class to use for the banner */ if aim_check_$greater (mseg_message_info.sender_authorization, driver_status.min_banner) then auth = mseg_message_info.sender_authorization; else auth = driver_status.min_banner; /* mark the output with auth */ call convert_authorization_$to_string (auth, auth_string, code); /* get string form */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; l = length (rtrim (auth_string)); /* how long is the string */ if l > 132 then do; /* too long for normal output..check for short form */ call convert_authorization_$from_string (access_class, "system_high", code); if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; if aim_check_$equal (auth, access_class) then auth_string = "SYSTEM HIGH"; /* this is shorter */ end; /* save all we can for the label */ REQUEST.access_class_string = char (auth_string, length (REQUEST.access_class_string)); /* check the requestor's access to the pathname he specified */ val = mseg_message_info.sender_level; call check_user_access (user_dir, ename, code); /* use the internal proc to do the work */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; call open_file (user_dir, ename, fcbp, max_comp, char_count, code); /* one call does a lot */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; /* set up variables for recording checkpoints as we go through the file */ ck_interval = 25; /* define the interval for taking checkpoints */ pic = ck_interval; /* get the char form */ ck_mode = "stop" || ltrim (pic); /* express as the exact mode string */ /* set up the starting page and initialize each checkpoint */ if (REQUEST.restarted | REQUEST.continued) & print_driver_data.checkpoint.page_no > 0 then current = print_driver_data.checkpoint; /* use the last checkpoint as the start */ else do; current.page_no = 1; /* the current position is top of page 1 */ current.line_count = 0; current.comp_no = 0; /* start at the head of the file */ current.offset = 0; current.file_offset = 0; end; starting_page = current.page_no; do i = 1 to hbound (ck.entry, 1); /* init the checkpoints and set the threads */ ck.point (i) = current; /* each checkpoint is current position for starters */ ck.entry (i).forward = i + 1; /* each entry points to the next one */ end; ck.entry (hbound (ck.entry, 1)).forward = 1; /* the last entry points back to the start */ /* with the true total bitcount, we can make an estimate of the time needed to do the request */ if driver_status.bit_rate_est > 0 then do; chars_done = char_count * copies_left - current.file_offset; /* total is chars / copy * copies */ time_est = divide (chars_done * 9, driver_status.bit_rate_est, 17, 0); if (driver_status.defer_time_limit > 0) & /* if a limit is defined, check it */ (time_est > driver_status.defer_time_limit + 6) then do; /* allow 6 sec fuzz */ /* so estimate will look bigger than limit in msg */ if REQUEST.priority_request then /* priority requests go any way */ msg = "Defer time limit suspended for priority request."; else if REQUEST.restarted then /* can't defer what is not in the queue */ msg = "Restarted request exceeds time limit but cannot be deferred."; else do; /* drop this one */ desc_ptr -> request_descriptor.keep_in_queue = "1"b; call iodd_msg_ (log, both, 0, "", "**Deferring request ^d. Printing time estimate: ^.1f mins.", REQUEST.request_no, float (time_est) / 60.0e0); call ioa_$rsnnl ("Deferring request for ^a.^/Printing time estimate: ^.1f minutes.", msg, l, REQUEST.full_path, float (time_est) / 60.0e0); call notify_user (substr (msg, 1, l)); go to clean_out; end; end; else msg = ""; if time_est > 60 | msg ^= "" then /* tell operator if request will exceed 1 minute */ call iodd_msg_ (log, slave, 0, "", " Time estimate for request ^d: ^.1f mins.^[^/^2x^a^]", REQUEST.request_no, float (time_est) / 60.0e0, (msg ^= ""), msg); end; call check_labels (user_dir, ename, start_segp, code); if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; call set_modes_and_labels; /* set strings for later use */ if starting_page > 1 | REQUEST.copy_no > 1 then call iodd_msg_ (log, both, 0, "", " Starting request ^d from page ^d of copy ^d of ^d.", REQUEST.request_no, starting_page, REQUEST.copy_no, REQUEST.copies); /* set up necessary condition handlers */ on daemon_kill go to flush_request; /* flush the current request */ on daemon_cancel go to flush_request; /* likewise, the cancelled flag has been set */ on daemon_defer go to defer_request; /* for this one be nice (and quiet?) */ on daemon_save begin; /* save the current request at the current position */ REQUEST.saved = "1"b; /* get ready to mark tail sheet */ if printing then do; how = SAVE; call iox_$modes (iocbp, "1pg,print", (""), code); /* make the dim return at bottom of page */ end; end; on daemon_again begin; /* to restart the current request.... */ restart_source = master; /* talking to the master terminal */ go to check_reprint_position; end; on daemon_again_slave begin; /* to restart the current request.... */ restart_source = slave; /* talking to slave terminal */ go to check_reprint_position; end; iodd_static.request_in_progress = "1"b; /* ready to accept kill, cancel etc. */ control = "101"b; /* for command lines, wait and prompt slave */ paper_not_aligned = "0"b; /* assume paper is aligned at top */ force_ck_pt = "1"b; /* and make sure that our counters agree with the dim */ n_sample_pages = 0; /* no samples yet for this request */ call iox_$control (iocbp, "reset", null, code); /* clear everything */ if prt_ctl.no_auto_print then go to ask; /* need operator instructions? */ else go to print_req; /* no, sooo...let'er rip */ /* this is the point where we come to restart the current request */ restart_this_request: REQUEST.continued = "1"b; /* make this look like a continuation */ REQUEST.contd_no = REQUEST.request_no; /* of this request */ REQUEST.charge = 0e0; REQUEST.time_start_request = clock_ (); call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request); control = "101"b; /* wait for input and prompt */ err_mess = ""; paper_not_aligned = "1"b; /* add 1 page */ if REQUEST.copy_no = 1 then REQUEST.separator = "1"b; /* always mark copy no 1 */ call skip_to_page (starting_page, code); if code ^= 0 then call iodd_msg_ (error, restart_source, code, whoami, "^/Error skiping to starting page."); %page; /* Get another command */ ask: on conversion begin; call iodd_msg_ (normal, source, 0, "", "Argument conversion error. Try again."); go to ask; end; on size begin; call iodd_msg_ (normal, source, 0, "", "Argument numerical size error. Try again."); go to ask; end; call iodd_get_cmd_ (addr (cmd_line), 80, nt, control, "request", source, code); /* get a cmd */ if code ^= 0 then do; call driver_fatal_error (code, "Unable to read operator command."); go to clean_out; end; call iodd_parse_$command (substr (cmd_line, 1, nt), addr (arg_list), code); /* this was here, so use it */ if code ^= 0 then do; if code = error_table_$noarg then go to ask; /* be nice about blank lines */ call iodd_msg_ (normal, source, 0, "", "Unable to parse command line ^a.", cmd_line); go to ask; end; if cmd = "help" then do; call iodd_msg_ (normal, source, 0, "", "Standard driver commands may be used, plus:^/"); call iodd_msg_ (normal, source, 0, "", " sample [N] -print a sample page"); call iodd_msg_ (normal, source, 0, "", " print [N] -start normal printing"); call iodd_msg_ (normal, source, 0, "", " Where N is an optional page number. (+N or -N is relative to current page)^/"); call iodd_msg_ (normal, source, 0, "", " copy N -set the current copy number to N"); call iodd_msg_ (normal, source, 0, "", " req_status [-lg] -print info about current request"); call iodd_msg_ (normal, source, 0, "", ""); go to ask; end; if source = master & iodd_static.test_entry then /* when testing allow a call to db */ if cmd = "probe" then do; call iodd_msg_ (normal, source, 0, "", "Calling probe"); call probe (); go to ask; end; if cmd = "req_status" | cmd = "reqstatus" then do; if n_tokens > 1 then if arg (1) = "-lg" | arg (1) = "-long" then lg_sw = "1"b; else do; call iodd_msg_ (normal, source, 0, "", "Undefined argument ""^a"". Use ""-lg"" or none.", arg (1)); go to ask; end; else lg_sw = "0"b; call iodd_msg_ (normal, source, 0, "", "Request ^d: ^a^/^3xfile components : ^d, char count : ^d", REQUEST.request_no, full_path, max_comp + 1, char_count); if lg_sw then call iodd_msg_ (normal, source, 0, "", "Current file position:"); call iodd_msg_ (normal, source, 0, "", "^3xpage no:^12d^4xcurrent copy no: ^d", current.page_no, REQUEST.copy_no); if lg_sw then do; call iodd_msg_ (normal, source, 0, "", "^3xline count:^9d^/^3xcomp no:^12d^/^3xoffset:^13d^/^3xfile offset:^8d", current.line_count, current.comp_no, current.offset, current.file_offset); call iox_$modes (iocbp, "", omode, code); /* get the current modes */ call iodd_msg_ (normal, source, 0, "", "^/^3xprinter mode: ^a", omode); call iox_$control (iocbp, "get_position", addr (position), code); call iodd_msg_ (normal, source, 0, "", "^3xdim at: page ^d line ^d line_count ^d", position.page_number, position.line_number, position.total_lines); end; call iodd_msg_ (normal, source, 0, "", ""); /* a blank line before the command request */ go to ask; end; if cmd = "sample" then do; if n_tokens > 1 then do; call get_page_no (arg (1), starting_page, code); if code ^= 0 then do; call iodd_msg_ (normal, source, 0, "", "Invalid page number: ^a", arg (1)); go to ask; end; end; else starting_page = current.page_no; /* if this is the first sample page, output a separator page if 1. continuous paper and expecting banner bars or 2. single sheet paper (at all times) */ if (n_sample_pages = 0) then do; if (continuous_paper & (prt_ctl.banner_bars = NORMAL_BANNER_BARS | prt_ctl.banner_bars = SINGLE_BANNER_BARS)) | ^continuous_paper then do; call iox_$control (iocbp, "inside_page", null, code); call iodd_static.print_head_separator (iocbp, prt_ctl_ptr, "sample pages", code); call iox_$control (iocbp, "inside_page", null, code); /* count pages generated for separator page */ if continuous_paper then n_sample_pages = 2; else n_sample_pages = 1; REQUEST.separator = "1"b; force_ck_pt = "1"b; /* don't count what we just printed */ end; end; call set_up_page_labels; /* set up printer dim to output any page labels needed */ call skip_to_page (starting_page, code); if code ^= 0 then do; call iodd_msg_ (error, source, code, "", "^a^/Unable to skip to page.", err_mess); go to ask; end; call output_file (SAMPLE, 0, code); /* write one page at the current position in the file */ if code ^= 0 then do; call iodd_msg_ (error, source, code, "", "^a^/Error while printing sample page.", err_mess); end; n_sample_pages = n_sample_pages + 1; /* bump the count of sample pages */ go to ask; end; if cmd = "copy" then do; /* enter copy number */ if n_tokens > 1 then do; /* be sure we have a value */ i = convert (i, arg (1)); /* convert to binary */ if i < 1 | i > REQUEST.copies then do; call iodd_msg_ (normal, source, 0, "", "Copy number must be in the range 1 to ^d.", REQUEST.copies); go to ask; end; REQUEST.copy_no = i; go to ask; end; call iodd_msg_ (normal, source, 0, "", "Expected argument missing."); go to ask; end; if cmd ^= "print" then do; /* all other commands except print go to the std cp */ force_ck_pt = "1"b; /* in case a sample head sheet was printed */ call iodd_command_processor_ (source, 3, substr (cmd_line, 1, nt), code); if code = 1 | code = 2 then do; if code = 2 & cmd = "save" then go to clean_out; /* save at this level is OK, just drop */ call iodd_msg_ (normal, source, 0, "", "Invalid command. Try again or type help for instructions."); end; call set_modes_and_labels; /* in case the force modes were changed */ go to ask; end; /* now we have received the print command and are ready to print the entire file */ if n_tokens > 1 then do; /* was a page number specified? */ call get_page_no (arg (1), starting_page, code); if code ^= 0 then do; call iodd_msg_ (normal, source, 0, "", "Invalid page number: ^a", arg (1)); go to ask; end; end; else starting_page = current.page_no; call skip_to_page (starting_page, code); /* check it before the head banner is printed */ if code ^= 0 then do; call iodd_msg_ (error, source, code, "", "^a^/Unable to skip to page.", err_mess); go to ask; end; if source = master then iodd_static.master_hold = "0"b; else if iodd_static.master_hold then do; /* respect the master here too */ call iodd_msg_ (normal, source, 0, "", "Driver is in hold by master terminal."); go to ask; end; print_req: REQUEST.cpu_time = 0; /* reset the usage data */ REQUEST.real_time = 0; REQUEST.page_waits = 0; REQUEST.pre_pages = 0; err_mess = ""; /* clear any residual junk */ starting_page = current.page_no; /* the page to start this copy on */ /* need to check for head sheet alignment on continuous forms? */ if n_sample_pages > 0 & continuous_paper then do; if mod (n_sample_pages, 2) = 0 then call iox_$put_chars (iocbp, addr (FF), 1, code); /* this is really for remote devices */ end; call iox_$control (iocbp, "get_error_count", addr (last_error_count), code); if code ^= 0 then last_error_count = -1; /* well we tried */ /* Iff we are on single sheet paper, stop multiple blank pages by suppressing consecutive form feeds */ if ^continuous_paper then call iox_$control (iocbp, "ff_suppress_on", null, code); do while (REQUEST.copy_no <= REQUEST.copies); /* once around for each copy */ call print_head_banner (code); if code ^= 0 then do; call driver_fatal_error (code, "Attempting to print head banner."); go to clean_out; end; call set_up_page_labels; /* set up printer dim to output any page labels */ n_sample_pages = 0; /* now we have a real head sheet */ REQUEST.separator = "0"b; /* we want separator bars only the first time */ /* now get to the correct top of page location and start printing */ /* assume that head_sheet and advertizing (plus the FF above) will leave us at top inside page */ /* This only applies for continuous forms. */ if continuous_paper then do; i = mod (starting_page, 2); /* see if we are starting on an even or odd page */ if i = 0 then do; /* if the paper is in the wrong position, align it */ call iox_$put_chars (iocbp, addr (FF), 1, code); end; end; /* now, after all that paper motion, set the dim position to agree with the current position */ force_ck_pt = "1"b; /* set the position */ paper_not_aligned = "0"b; /* don't move the paper */ call skip_to_page (starting_page, code); /* sync with the dim */ if code ^= 0 then do; call driver_fatal_error (code, "First page synchronization."); go to clean_out; end; if desc_ptr -> request_descriptor.saved then how = SAVE; else how = PRINT; start_char_offset = current.file_offset; /* get ready to see how many chars were done per sec */ call iox_$control (iocbp, "runout", null, code); /* be sure head sheet is done before clock reading */ call cpu_time_and_paging_ (old_waits, old_cpu, old_pp); /* keep time and page waits for accounting */ old_clock = clock_ (); /* time copy started */ printing = "1"b; /* tell daemon_save handler we are printing */ /* check to see if the user wants raw output. if so then turn it on */ if evaluate_forms_info_output_ptr ^= null then do; if evaluate_forms_info_output.special_length ^= 0 then do; if iodd_parse_$args ("output_type=", (evaluate_forms_info_output.special_string)) = "raw" then do; call iox_$control (iocbp, "prt_conv_off", null (), (0)); call iox_$modes (iocbp, "rawo", "", (0)); end; end; end; call output_file (how, 0, code); /* this will do it */ /* reset raw output if user has asked for it */ if evaluate_forms_info_output_ptr ^= null then do; if evaluate_forms_info_output.special_length ^= 0 then do; if iodd_parse_$args ("output_type=", (evaluate_forms_info_output.special_string)) = "raw" then do; call iox_$control (iocbp, "prt_conv_on", null (), (0)); call iox_$modes (iocbp, "^rawo", "", (0)); end; end; end; if code ^= 0 then do; if ^(desc_ptr -> request_descriptor.saved & code = error_table_$request_pending) then do; /* BAD */ call driver_fatal_error (code, (err_mess)); go to clean_out; end; end; else print_driver_data.page_no = 0; /* copy done, checkpoint is no longer valid */ printing = "0"b; /* the printing has been done */ call iox_$control (iocbp, "runout", null, code); /* be sure copy is done before counting it */ if ^desc_ptr -> request_descriptor.saved then/* if leaving this til later, don't charge now */ if REQUEST.copies > print_driver_data.copies_charged then do; chgsw = "1"b; /* user honestly deserves these charges */ print_driver_data.copies_charged = print_driver_data.copies_charged + 1; end; else chgsw = "0"b; else chgsw = "0"b; call charge_for_work; /* do the accounting so we can put price on tail */ if last_error_count = -1 then device_error = ""b; /* no error data */ else do; call iox_$control (iocbp, "get_error_count", addr (i), code); if code ^= 0 | i > last_error_count then device_error = "1"b; else device_error = "0"b; /* we can figure the transfer rate */ end; if ^(iodd_static.quit_during_request | device_error) then do; /* can we update the rate estimate? */ old_rate = driver_status.bit_rate_est; /* get the last value */ chars_done = char_count - start_char_offset; /* chars printed in time interval */ seconds = divide (REQUEST.real_time, 1000000, 17); /* see how many seconds have passed */ if seconds < 1 then new_rate = old_rate; /* avoid divide by zero */ else new_rate = divide (chars_done * 9, seconds, 17, 0); /* get bits/sec */ if old_rate > 0 then /* use first good rate to start the estimate */ new_rate = fixed (old_rate * factor + new_rate * (1e0 - factor)); /* use exp smoothing */ driver_status.bit_rate_est = new_rate; /* put back new value */ end; if REQUEST.saved then do; /* mark the listing suspended */ call ioa_$rsnnl ("Processing suspended at page ^d.", err_mess, l, REQUEST.page_count); call error_write (0, err_mess); end; call print_tail_banner (code); /* this will put on the tail banner */ if code ^= 0 then do; /* some type of error..don't do it again */ call driver_fatal_error (code, "Attempting to write tail banner."); go to clean_out; end; if desc_ptr -> request_descriptor.saved then go to clean_out; /* suspend this request and get the next */ print_driver_data.copies_done = print_driver_data.copies_done + 1; REQUEST.copy_no = REQUEST.copy_no + 1; /* get ready for next copy */ header_done = "0"b; /* ready for a new header */ starting_page = 1; /* start the next copy at the begining */ end; /* done with this copy...check for more in while loop */ /* we are now done with the request...so clean up */ call iox_$control (iocbp, "runout", null, code); /* be sure all printing is out before charge message */ call iodd_msg_ (log, both, 0, "", " Charge for request ^d: $^.2f (^d lines, ^d pages^[ per copy)^;)^]", REQUEST.request_no, REQUEST.total_charge, REQUEST.line_count, REQUEST.page_count, (copies_left > 1)); if REQUEST.notify then do; call ioa_$rsnnl ("printed ^a $^.2f queue ^d ^a ^d", msg, l, REQUEST.full_path, REQUEST.total_charge, REQUEST.queue, REQUEST.device_name, REQUEST.request_no); call notify_user (substr (msg, 1, l)); end; clean_out: /* get ready for the next users' request */ if last_error_count > -1 then do; /* if error count is defined */ call iox_$control (iocbp, "get_error_count", addr (i), code); if code ^= 0 | i > last_error_count then /* if errors are possible */ if ^desc_ptr -> request_descriptor.dont_delete then do; /* and user not told about it */ if REQUEST.delete = 1 then do; /* tell user we cancelled his delete request */ desc_ptr -> request_descriptor.dont_delete = "1"b; call ioa_$rsnnl ("Device error during request ^d. Segment ^a will not be deleted.", msg, l, REQUEST.request_no, REQUEST.full_path); call notify_user (substr (msg, 1, l)); end; end; end; desc_ptr -> request_descriptor.finished = "1"b; /* say we are done with it */ iodd_static.request_in_progress = "0"b; /* no more commands can be effective */ call clean_proc (); /* get junk out of the address space */ call iox_$control (iocbp, "runout", null, code); /* make device disgorge */ return; check_reprint_position: /* on restart, we transfer back here to release the stack frame with the dim, so the slave can again write to the remote device and request a cmd */ call restart_request (restart_source); /* give the request position */ go to restart_this_request; /* now go back and restart the request */ %page; /* This is where the condition handlers "go to" when something has gone wrong */ flush_request: /* kill and cancel handlers jump back here */ msg = "Operator aborted listing"; /* message for kill and cancel */ chgsw = "0"b; /* can't charge */ go to no_delete; abort_request: /* unclaimed signals transfer to here */ chgsw = ""b; /* assume we can't charge user */ msg = """" || rtrim (fault_name) || """ condition occured"; /* format basic message */ if fault_name = "seg_fault_error" & /* user deleted seg, charge for what was done */ iodd_static.segptr ^= null then do; chgsw = "1"b; delete_msg = ""; /* forget to tell user we won't delete his seg */ end; else do; no_delete: if REQUEST.delete ^= 0 then delete_msg = "; segment will not be deleted"; else delete_msg = ""; end; call ioa_$rsnnl ("^a during processing of request^a.", err_mess, l, msg, delete_msg); code = 0; call fatal_error (tell_user); /* this will clean things up a bit */ go to clean_out; /* now drop the request */ defer_request: /* leave this in the queue for a while */ err_mess = "Operator deferred request until a later time."; chgsw = ""b; code = 0; call fatal_error (tell_user); go to clean_out; %page; /* ======================================================================================= */ /* ============================== INTERNAL PROCEDURES ============================== */ /* ======================================================================================= */ fatal_error: procedure (notify); dcl notify bit (1); REQUEST.notify = REQUEST.notify | notify; /* set notify flag by arg if off */ if ^REQUEST.notify & ^header_done then call print_head_banner ((0)); /* try to tell requestor */ if header_done then call charge_for_work; /* update REQUEST data if possible */ call error_write (code, err_mess); if header_done then call print_tail_banner ((0)); /* finish it off */ call iodd_msg_ (log, both, 0, "", "Processing of request ^d terminated.", REQUEST.request_no); desc_ptr -> request_descriptor.dont_delete = "1"b;/* make sure we don't delete user seg */ return; /* let the caller flush the request */ end fatal_error; /* ===================================== */ error_write: procedure (code, message); /* for writing error messages to console & request stream */ dcl code fixed bin (35); dcl message char (*) varying; short_msg, lg_msg = ""; /* clear any junk */ if code ^= 0 then call convert_status_code_ (code, short_msg, lg_msg); call ioa_$rsnnl ("Request for ^a. ^a ^a", msg, l, REQUEST.full_path, lg_msg, message); if REQUEST.notify then /* this lets us be quiet about save and defer */ call notify_user (substr (msg, 1, l)); call iodd_msg_ (log, both, 0, "", "**Request ^d: ^a ^a", REQUEST.request_no, lg_msg, message); if header_done then do; /* must not do a "reset" or line and page count is lost */ call ioa_$rsnnl ("^2/^a^a^/io_daemon: ^a ^a^/^a^a^2/", msg, l, VT, stars, lg_msg, message, stars, VT); call iox_$modes (iocbp, "default", omode, code); call iox_$put_chars (iocbp, addr (msg), l, code); call iox_$modes (iocbp, omode, (""), code); end; return; end error_write; %page; notify_user: procedure (message); dcl message char (*) aligned; dcl (ipc_ind, r1_ind, ec) fixed bin (35); ipc_ind, r1_ind = -1; /* set to non-zero to test call */ if ^sys_priv then go to send_it; /* if they failed once, .... */ on linkage_error begin; sys_priv = "0"b; /* stop trying if we fail */ go to revert_handler; /* send the message if possible */ end; on any_other begin; if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind); if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind); r1_ind, ipc_ind = -1; call continue_to_signal_ (ec); end; call system_privilege_$ring1_priv_on (r1_ind); call system_privilege_$ipc_priv_on (ipc_ind); revert_handler: revert linkage_error; send_it: call send_mail_$access_class (mailname, message, addr (send_mail_info), mseg_message_info.sender_authorization, ec); if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind); if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind); return; end notify_user; %page; charge_for_work: procedure (); /* Accounting section, done at end of processing each copy of output. */ new_clock = clock_ (); call cpu_time_and_paging_ (new_waits, new_cpu, new_pp); position.line_number = 0; /* for the tail banner proc */ position.total_lines = 0; /* Clear these items */ position.page_number = 0; call iox_$control (iocbp, "get_position", addr (position), code); REQUEST.line_count = position.total_lines; if position.line_number = 1 then REQUEST.page_count = position.page_number - 1; /* if file ended with FF */ else REQUEST.page_count = position.page_number; REQUEST.cpu_time = new_cpu - old_cpu; REQUEST.real_time = new_clock - old_clock; /* real time for this copy */ REQUEST.page_waits = fixed (new_waits - old_waits, 35); REQUEST.pre_pages = fixed (new_pp - old_pp, 35); if chgsw then do; /* charge him */ if driver_status.have_accounting then do; call io_daemon_account_ (driver_status.acct_entry, addr (REQUEST)); end; else do; REQUEST.price_per_n_lines, /* zap all charges to zero */ REQUEST.price_per_n_pages, REQUEST.charge = 0e0; REQUEST.no_accounting = "1"b; /* and flag it */ end; end; else REQUEST.charge = 0e0; /* give user a break */ REQUEST.total_charge = REQUEST.total_charge + REQUEST.charge; return; end charge_for_work; /* ============================== */ driver_fatal_error: procedure (code, err_msg); dcl code fixed bin (35); dcl err_msg char (*); call iodd_msg_ (error, both, code, whoami, "^a ^a ^/ Driver returning to command level.", err_msg, err_mess); desc_ptr -> request_descriptor.dont_delete = "1"b;/* give a reprieve....in case */ desc_ptr -> request_descriptor.keep_in_queue = "1"b; a_code = code; /* report driver_fatal_error */ return; end driver_fatal_error; %page; check_labels: procedure (user_dir, ename, segptr, code); /* Internal procedure to check that the top and bottom labels are the access class of the segment. */ dcl access_class bit (72) aligned; dcl code fixed bin (35); dcl ename char (*) aligned; dcl level fixed bin; dcl user_dir char (*) aligned; dcl segptr pointer; dcl sys_info$access_class_floor bit (72) aligned external static; dcl 1 local_audit_user_info aligned like audit_user_info; dcl 1 local_audit_eventflags aligned like audit_event_flags; code = 0; if dprint_msg.top_label ^= dprint_msg.bottom_label then do; LOG_AUDIT_MESSAGE: call cu_$level_get (level); unspec (local_audit_user_info) = ""b; local_audit_user_info.version = audit_user_info_version_1; local_audit_user_info.user_id = mseg_message_info.sender_id; local_audit_user_info.ring = mseg_message_info.sender_level; local_audit_user_info.process_id = mseg_message_info.sender_process_id; local_audit_user_info.authorization = mseg_message_info.sender_authorization; local_audit_user_info.authorization_range (1) = sys_info$access_class_floor; local_audit_user_info.authorization_range (2) = mseg_message_info.sender_max_authorization; local_audit_user_info.audit_flags = mseg_message_info.sender_audit; unspec (local_audit_eventflags) = ""b; local_audit_eventflags.grant = "1"b; call access_audit_gate_$log_obj_ptr_user ("do_prt_request_", level, unspec (local_audit_eventflags), access_operations_$io_daemon_set_page_labels, segptr, 0, null (), 0, addr (local_audit_user_info)); return; end; call hcs_$get_access_class (user_dir, ename, access_class, code); if code ^= 0 then return; call convert_authorization_$from_string (authorization, rtrim (dprint_msg.top_label), code); if code ^= 0 then do; code = 0; goto LOG_AUDIT_MESSAGE; /* This isn't an access class */ end; if ^(aim_check_$equal (access_class, authorization)) then goto LOG_AUDIT_MESSAGE; return; end check_labels; check_user_access: procedure (user_dir, ename, ec); /* Internal procedure to check that the requestor has at least "r" access to the specified segment */ dcl user_dir char (*) aligned; dcl ename char (*) aligned; dcl code fixed bin (35); dcl ec fixed bin (35); dcl mode fixed bin (5); dcl access_class bit (72) aligned; call hcs_$get_user_effmode (user_dir, ename, REQUEST.requestor, val, mode, code); if code ^= 0 then do; if code = error_table_$noentry then err_mess = ""; /* simple case, just say no entry */ else err_mess = "Unable to get user's mode."; ec = code; return; end; if (bit (mode, 5) & "01000"b) = "0"b then do; err_mess = "User does not have read access."; ec = error_table_$moderr; return; end; call hcs_$get_access_class (user_dir, ename, access_class, code); if code ^= 0 then do; err_mess = "Unable to get access class of segment."; ec = code; return; end; if ^read_allowed_ (mseg_message_info.sender_authorization, access_class) then do; ec = error_table_$ai_restricted; err_mess = "User not allowed to read segment."; return; end; ec = 0; /* ok, user passed the checks */ return; end check_user_access; %page; open_file: procedure (user_dir, ename, fcbp, max_comp, char_count, code); dcl user_dir char (*) aligned; dcl ename char (*) aligned; dcl fcbp ptr; dcl max_comp fixed bin; dcl char_count fixed bin (24); dcl code fixed bin (35); dcl comp_dir char (168) aligned; dcl comp_name char (32) aligned; dcl type fixed bin (2); dcl dir fixed bin int static options (constant) init (2); dcl dir_len fixed bin; dcl bc fixed bin (24); dcl mode fixed bin (5); dcl mult_ind fixed bin; char_count = 0; /* clear the count so we can accumulate file length */ call hcs_$status_minf (user_dir, ename, 1, type, bc, code); /* see what kind of a thing it is */ if code ^= 0 then do; err_mess = char ("Driver cannot get status of file: " || full_path, length (err_mess)); return; end; if type = dir then /* directory */ if bc < 1 then do; /* it was a directory */ code = error_table_$dirseg; return; end; else max_comp = bc - 1; /* MSF - highest component is bitcount less one */ else max_comp = 0; /* SSF - highest component is 0 */ call msf_manager_$open (user_dir, ename, fcbp, code); if code ^= 0 then do; err_mess = "Unable to open file: " || full_path; return; end; do mult_ind = 0 to max_comp; /* now we look at each component */ call msf_manager_$get_ptr (fcbp, mult_ind, "0"b, segp, bc, code); if code ^= 0 then do; /* we failed, don't try to do partial files */ call ioa_$rsnnl ("Unable to get pointer to file component: ^d.", err_mess, dir_len, mult_ind); return; end; if mult_ind = 0 then start_segp = segp; /* this is the first component */ /* we got a pointer to something...where is it */ /* and does the requestor have access to it? */ call hcs_$fs_get_path_name (segp, comp_dir, dir_len, comp_name, code); if code ^= 0 then do; err_mess = "Could not get file component pathname."; return; end; call check_user_access (comp_dir, comp_name, code); if code ^= 0 then do; /* he tried to pull a fast one and got caught */ err_mess = err_mess || " " || substr (comp_dir, 1, dir_len) || ">" || comp_name; /* most of err_mess was set by check_user_access */ return; end; if bc < 9 then do; /* must be at least one char per component */ code = error_table_$improper_data_format; /* choose a good error message */ err_mess = "Zero length segment: " || substr (comp_dir, 1, dir_len) || ">" || comp_name; return; end; REQUEST.bit_count = REQUEST.bit_count + bc; /* total the bits for accounting */ char_count = char_count + divide (bc, 9, 24, 0); /* get char count like output_file will */ call hcs_$fs_get_mode (segp, mode, code); /* make sure daemon has access */ if code ^= 0 then do; err_mess = "Driver process does not have access to segment."; return; end; if (bit (mode, 5) & "01000"b) = "0"b then do; err_mess = "Driver process does not have read access to segment."; code = error_table_$moderr; /* give some access violation code */ return; end; end; /* Now we know that the file is there and that the requestor has the correct access to it. The continued operation of the driver now assumes that the file will remain the same until the driver is done. That is, the access will not change, the number of components will not change, and the size of each component will not change. */ end open_file; %page; output_file: procedure (how, ending_page, ec); dcl how fixed bin; /* how the file is to be output: sample print skip or save */ dcl ending_page fixed bin (24); /* where to stop when skipping */ dcl ec fixed bin (35); /* you guessed it, error code */ dcl bc fixed bin (24); dcl max_el fixed bin (24); dcl modes char (64); /* mode string */ dcl n fixed bin; dcl nel fixed bin (24); /* number of chars to be printed on write */ dcl nelt fixed bin (24); /* number of chars processed by dim on return */ dcl next fixed bin; dcl code fixed bin (35); /* iox_ status code, local version */ dcl wp ptr; /* working pointer into the segment */ dcl char_pos (sys_info$max_seg_size * 4) char (1) based; /* array of one char elements to get wp */ dcl seg_string char (max_el) based (segp); dcl 1 temp aligned like print_driver_data.checkpoint; /* temporary values for current position */ dcl 1 save_position aligned like position_data; /* temporary for position at start of sample */ ec = 0; /* clear the error code */ temp = current; /* we will start at the current position */ if how = SAMPLE then do; /* print 1 page and put all position counters back as found */ modes = "1pg,print," || ck_mode; /* return after printing 1 page */ call iox_$control (iocbp, "get_position", addr (save_position), code); /* save dim position */ if code ^= 0 then do; err_mess = "From get_position order for sample."; ec = code; return; end; end; else if how = SKIP then do; /* process file to ending_page without printing, but save checkpoints on the way */ n = ending_page - current.page_no; /* see how close to the end we are */ if n < ck_interval then do; /* if close, use a small interval */ pic = n; /* get the interval as ascii */ modes = "stop" || ltrim (pic); /* make a mode string for the dim */ end; else modes = ck_mode; /* if not close, use the normal interval */ modes = char ("^print,^1pg," || modes, length (modes)); /* it is transparant in either case */ end; else if how = SAVE then modes = "print,1pg," || ck_mode; /* for save, go to bottom of even page */ else modes = "print,^1pg," || ck_mode; /* default assumes how = print */ call iox_$control (iocbp, "runout", null, code); call iox_$modes (iocbp, modes, omode, code); /* set the modes */ if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "Changing mode during output init to: ^a^/ from: ^a", modes, omode); segp = null; /* don't try to deactivate */ next_comp: /* done with last component */ if segp ^= null & privileged then call phcs_$deactivate (segp, (0)); /* so try to deactivate the seg */ call msf_manager_$get_ptr (fcbp, temp.comp_no, "0"b, segp, bc, ec); /* get ptr to seg */ if segp = null then do; err_mess = "Invalid seg ptr to component."; return; end; if privileged then /* .. do it (gently if possible) */ call phcs_$set_kst_attributes (binary (baseno (segp), 18), addr (ksta), (0)); max_el = divide (bc, 9, 24, 0); /* see now many elements to write out */ /* if this is last (or only) component of file, remove any trailing VT or FF chars */ if temp.comp_no = max_comp then do; max_el = length (rtrim (seg_string, nl_vt_ff)); end; write_out: nel = max_el - temp.offset; /* see how much is left to do */ iodd_static.segptr = segp; /* tell signal handler what segment we are using */ wp = addr (segp -> char_pos (temp.offset + 1)); /* get ptr to next character */ call iox_$put_chars (iocbp, wp, nel, code); /* This is the actual output of segment */ iodd_static.segptr = null; /* not referencing user seg now */ if code ^= 0 then do; if code ^= error_table_$request_pending then do; /* we only want one code */ ec = code; err_mess = "IO error during output of file."; return; end; /* code = error_table_$request_pending. do something about it */ if how = SAMPLE then do; /* Yes, and for sample we are done printing */ sample_done: call iox_$control (iocbp, "set_position", addr (save_position), code); /* restore position */ if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "Unable to restore position, set_position order."); /* current position data was not changed */ modes = "^1pg," || ck_mode; /* restore the default checkpoints */ call iox_$modes (iocbp, modes, omode, code); if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "Changing mode from ^a^/to ^a", omode, modes); call iox_$control (iocbp, "runout", null, code); /* be sure it prints */ return; end; /* hit checkpoint for save, skip or print */ call iox_$control (iocbp, "get_position", addr (position), code); /* see where we are */ if code ^= 0 then do; ec = code; err_mess = "Error on get_position order for checkpoint."; return; end; nelt = position.total_chars - temp.file_offset; /* num chars done */ if how = SKIP then do; /* if skipping, check for end of file */ if (nel = nelt) & (temp.comp_no = max_comp) then do; /* this is bad - hit EOF */ force_ck_pt = "1"b; /* be sure we re-sync the dim */ ec = error_table_$eof_record; /* report it as an error */ call ioa_$rsnnl ("EOF reached at end of page ^d.", err_mess, l, position.page_number - 1); return; /* the page count from the dim is one too high */ end; end; /* record the current position of the dim */ temp.page_no = position.page_number; temp.line_count = position.total_lines; temp.offset = temp.offset + nelt; temp.file_offset = position.total_chars; current = temp; /* say this is a real page position */ if how = PRINT | how = SAVE then print_driver_data.checkpoint = current; /* make things consistent */ if how = SAVE then do; /* getting ready to suspend request */ n = mod (temp.page_no, 2); /* check for even page */ if n = 1 then do; /* odd number means we just finished an even page */ ec = error_table_$request_pending; /* pass back "not finished" */ return; end; end; if current.page_no >= (ck.point (ck.last).page_no + ck_interval) then do; /* worth saving it */ next = ck.entry (ck.last).forward; /* find index of next checkpoint entry */ ck.point (next) = current; /* save the current checkpoint */ ck.last = next; /* advance the index */ end; if how = SKIP then do; /* see if we have skipped enough */ if current.page_no = ending_page then return; /* all done */ if current.page_no > ending_page then do; /* OOPS - a counting error */ force_ck_pt = "1"b; /* re-sync the dim */ ec = error_table_$out_of_bounds; /* give an error code */ call ioa_$rsnnl ("Skipped over end page ^d, at ^d.", err_mess, l, ending_page, current.page_no); return; end; n = ending_page - current.page_no; /* see how far we need to go */ if n < ck_interval then do; /* if close, use a small interval */ pic = n; /* make it ascii */ modes = "stop" || ltrim (pic); /* make the mode string */ call iox_$modes (iocbp, modes, omode, code); if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "Changing mode near end of skip to: ^a^/ from: ^a", modes, omode); end; end; /* end of skip mode checks */ if nelt < nel then go to write_out; /* when more to do, do it */ else go to end_of_comp; /* otherwise this component is done, get next one */ end; /* end of skip or print checkpoint processing */ temp.file_offset = temp.file_offset + nel; /* record last output from this component */ end_of_comp: /* get set for the next component, or quit if done */ if temp.comp_no = max_comp then /* we are at real end of file */ if how = PRINT | how = SAVE then do; /* this is good */ if privileged & ((REQUEST.copy_no = REQUEST.copies) | (max_comp > 0)) then /* done for a while */ call phcs_$deactivate (segp, (0)); /* so let the pages go */ segp = null; return; end; else if how = SKIP then do; ec = error_table_$eof_record; /* tried to skip too far */ call iox_$control (iocbp, "get_position", addr (position), code); if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "get_position order."); if position.line_number = 1 then call ioa_$rsnnl ("EOF reached at end of page ^d.", err_mess, l, position.page_number - 1); else call ioa_$rsnnl ("EOF at page ^d, line ^d.", err_mess, l, position.page_number, position.line_number); force_ck_pt = "1"b; /* tell caller we are out of sync */ return; end; else do; /* sample was the last partial page */ call iox_$put_chars (iocbp, addr (FF), 1, code); /* align the page */ go to sample_done; /* let it go by */ end; temp.comp_no = temp.comp_no + 1; /* go on to the next component */ temp.offset = 0; /* start at the begining */ go to next_comp; /* deactivate old and get new */ end output_file; %page; restart_request: procedure (source); /* internal procedure used to tell operator where the request was */ dcl source fixed bin; dcl code fixed bin (35); dcl pg_count_msg char (80); /* message for last page processed */ dcl restart_msg char (200); dcl i fixed bin; call iox_$control (iocbp, "resetwrite", null, code); /* clear any junk out of the buffers */ call iox_$control (iocbp, "get_position", addr (position), code); if code ^= 0 then starting_page = current.page_no; /* last known page data */ else starting_page = position.page_number - 5; /* start back 5 pages unless otherwise instructed */ if starting_page < 1 then /* be sure of a good page number */ starting_page = 1; call ioa_$rsnnl ("Driver positioned at page ^d of the file.", pg_count_msg, i, starting_page); REQUEST.copy_no = min (REQUEST.copies, print_driver_data.copies_done + 1); /* assume this for now */ call ioa_$rsnnl ("Restarting request ^d at copy number ^d of ^d", restart_msg, i, REQUEST.request_no, REQUEST.copy_no, REQUEST.copies); call iodd_msg_ (normal, source, 0, "", "^a^/^a^/", restart_msg, pg_count_msg); return; end restart_request; %page; get_page_no: procedure (a_page, a_pgn, ec); dcl a_page char (*) var aligned; dcl a_pgn fixed bin (24); dcl ec fixed bin (35); dcl sign char (1); dcl start fixed bin; dcl pgn fixed bin (24); ec = 0; /* initialize the return code */ if a_page = "" then do; /* for a null string, use the current position */ a_pgn = current.page_no; return; end; sign = substr (a_page, 1, 1); /* see if this is a relative page number */ if sign = "+" | sign = "-" then start = 2; else start = 1; /* this is the start of the number part */ on conversion go to pgn_err; pgn = convert (pgn, substr (a_page, start)); /* convert it to binary */ if pgn < 1 then do; /* make "--N" illegal */ pgn_err: ec = 10; /* and keep the numbers in range */ return; end; if sign = "+" then a_pgn = current.page_no + pgn; /* forward N pages */ else if sign = "-" then a_pgn = current.page_no - pgn; /* back N pages */ else a_pgn = pgn; /* an absolute page number */ if a_pgn < 1 then a_pgn = 1; /* can't go back past start */ return; end get_page_no; %page; skip_to_page: procedure (starting_pg, ec); dcl starting_pg fixed bin (24); dcl ec fixed bin (35); dcl target fixed bin (24); dcl i fixed bin; dcl pg fixed bin (24); dcl high_page fixed bin (24); dcl ind fixed bin; dcl next fixed bin; dcl code fixed bin (35); /* local error code */ ec = 0; /* start clean */ target = starting_pg; /* copy arg so we don't change the logic by accident */ call iox_$modes (iocbp, (REQUEST.output_mode), omode, code); /* must skip under users modes */ if code ^= 0 then do; ec = code; err_mess = "Unable to set user modes for page skip."; return; end; if paper_not_aligned & continuous_paper then do; /* we need to re sync the world */ call iox_$put_chars (iocbp, addr (FF), 1, code); /* first a FF */ if code ^= 0 then do; ec = code; err_mess = "IO error writing form feed to the printer."; return; end; call iox_$control (iocbp, "runout", null, code); /* be sure it is written */ paper_not_aligned = "0"b; /* we are aligned now */ force_ck_pt = "1"b; /* don't count the page just written */ end; if ^force_ck_pt then /* can we believe the current position */ if target = current.page_no then return; /* we are already there */ high_page = 0; /* highest page <_ target */ ind = 0; /* index of checkpoint for high_page */ do i = 1 to hbound (ck.entry, 1); /* look at all entries...may not be in order */ pg = ck.point (i).page_no; /* get the page number */ if (pg <= target) & (pg > high_page) then do;/* see if it is highest <_ target */ high_page = pg; ind = i; end; end; if ind = 0 then do; /* start at begining */ current.page_no, position.page_number = 1; /* begining is at page 1 */ current.line_count, position.total_lines = 0; current.comp_no = 0; /* first MSF component */ current.offset = 0; /* first char in the file */ current.file_offset, position.total_chars = 0; next = ck.entry (ck.last).forward; /* get index of next checkpoint */ ck.point (next) = current; /* save the start as the next checkpoint */ ck.last = next; /* advance the index */ end; else do; /* we found a valid checkpoint */ if ^force_ck_pt then if (high_page < current.page_no) & (target > current.page_no) then go to forward; current.page_no, position.page_number = ck.point (ind).page_no; current.line_count, position.total_lines = ck.point (ind).line_count; current.comp_no = ck.point (ind).comp_no; current.offset = ck.point (ind).offset; current.file_offset, position.total_chars = ck.point (ind).file_offset; ck.last = ind; /* move the checkpoint index to this entry */ end; call iox_$control (iocbp, "runout", null, code); call iox_$modes (iocbp, "^print", omode, code); /* don't move the paper */ call iox_$put_chars (iocbp, addr (FF), 1, code); /* make believe we wrote a FF */ call iox_$modes (iocbp, "print", omode, code); /* back to normal mode */ call iox_$control (iocbp, "set_position", addr (position), code); /* set dim page and line positions */ if code ^= 0 then do; /* OOPS */ ec = code; err_mess = "Unable to set position for checkpoint."; return; end; force_ck_pt = "0"b; /* we can believe the current position data now */ if target = current.page_no then return; /* can't be less than current at this point */ forward: call output_file (SKIP, target, ec); /* now go forward to the top of the target page */ call iox_$control (iocbp, "runout", null, code); call iox_$modes (iocbp, "print", omode, code); /* be sure we stay in print mode */ return; end skip_to_page; %page; set_modes_and_labels: procedure (); dcl nm char (256) var; dcl i fixed bin; dcl v char (12) var; dcl ll fixed bin; /* line length for this request */ dcl ind fixed bin; /* line indentation */ dcl temp_label char (136); /* temporary for cleaning the label */ dcl len fixed bin; /* since this request may have a different forms specification than the previous reset the paper size data based on this request */ if ^continuous_paper then do; if evaluate_forms_info_output_ptr ^= null then do; paper_info_data.phys_page_length = evaluate_forms_info_output.lines_per_page; paper_info_data.phys_line_length = evaluate_forms_info_output.chars_per_line; paper_info_data.lines_per_inch = evaluate_forms_info_output.lines_per_inch; call iox_$control (iocbp, "paper_info", addr (paper_info_data), code); if code ^= 0 then do; call convert_status_code_ (code, short_msg, lg_msg); call ioa_$rsnnl ("^a while setting paper size info", msg, l, lg_msg); call notify_user (substr (msg, 1, l)); /* something happened while setting paper size info */ call driver_fatal_error (code, "Changing paper size info."); go to clean_out; end; call iox_$control (iocbp, "reset", null, code); /* reset everything based on the new page/line lengths */ end; end; nm = ""; /* clear the string */ if dprint_msg.line_lth > 1 then do; ll = min (dprint_msg.line_lth, prt_ctl.phys_line_length); /* save lth up to max for labels */ pic = ll; /* convert to char form */ v = ltrim (rtrim (pic)); /* strip blanks */ nm = "ll" || v || ","; /* make it into a mode string */ end; else ll = prt_ctl.phys_line_length; if dprint_msg.lmargin > 1 then do; ind = dprint_msg.lmargin; /* save the value */ pic = ind; /* convert */ v = ltrim (rtrim (pic)); nm = nm || "in" || v || ","; end; else ind = 0; /* default is no indentation */ i = length (nm); line_mode = nm; /* save the ll and ind modes alone */ if i > 0 then substr (line_mode, i, 1) = ""; /* drop the last comma */ if dprint_msg.control.nep | prt_ctl.force_nep then do; nm = nm || "noskip,"; nep_mode_set = "1"b; /* labels are not valid in noskip */ set_page_labels = "0"b; /* so be sure we turn them off */ end; else nep_mode_set = "0"b; /* try for labels */ if dprint_msg.control.single then nm = nm || "single,"; if dprint_msg.control.non_edited then nm = nm || "non_edited,"; if dprint_msg.control.truncate then nm = nm || "truncate,"; if dprint_msg.page_lth > 1 then do; pic = dprint_msg.page_lth; v = ltrim (rtrim (pic)); nm = nm || "pl" || v || ","; end; if dprint_msg.esc | prt_ctl.force_esc then nm = nm || "esc,"; /* do we need slew control */ if dprint_msg.control.line_nbrs then /* line numbers? */ nm = nm || "line_nbrs,"; if prt_ctl.force_ctl_char then nm = nm || "ctl_char,"; /* pass control characters to the printer */ i = length (nm); /* get the string length */ REQUEST.output_mode = nm; if i > 0 then substr (REQUEST.output_mode, i, 1) = ""; /* clobber the last comma */ pg_labels.top_label, pg_labels.bottom_label = " ";/* set leading blanks */ if ^nep_mode_set then do; /* only if labels can be used */ temp_label = translate (dprint_msg.top_label, " ", nl_vt_ff); /* remove naughty characters */ if verify (temp_label, space_ht_bs) > 0 then do; /* anything other than white space? */ set_page_labels = "1"b; /* set the labels in the main loop */ len = length (rtrim (temp_label)); /* how long is the label */ if (ll > len) & dprint_msg.control.center_top_label then do; len = divide (ll - len - ind, 2, 17, 0) - divide(ind, 2, 17, 0) + 1; /* calculate starting position (dim adds ind) */ substr (pg_labels.top_label, len) = temp_label; /* drop it in the right position */ end; else pg_labels.top_label = temp_label; /* put it in as given (almost) */ end; temp_label = translate (dprint_msg.bottom_label, " ", nl_vt_ff); /* do it again for the bottom label */ if verify (temp_label, space_ht_bs) > 0 then do; set_page_labels = "1"b; len = length (rtrim (temp_label)); if (ll > len) & dprint_msg.control.center_bottom_label then do; len = divide (ll - len - ind, 2, 17, 0) - divide(ind, 2, 17, 0) + 1; substr (pg_labels.bottom_label, len) = temp_label; end; else pg_labels.bottom_label = temp_label; end; end; return; end set_modes_and_labels; %page; print_head_banner: procedure (code); dcl code fixed bin (35); /* error code */ dcl ec fixed bin (35); iodd_static.quit_during_request = "0"b; /* reset for each copy */ code = 0; /* clear the code */ if iodd_static.ctl_term.attached then do; /* message to ctl term? */ call write_control_form_ (iodd_static.form_type, iodd_static.ctl_output, addr (REQUEST), ec); if ec ^= 0 then do; if ec ^= error_table_$action_not_performed then do; /* this one is normal */ call iodd_msg_ (error, master, ec, whoami, "Writing message on control terminal."); iodd_static.slave_hold = "1"b; /* avoid automatic start */ end; ctl_msg_sent = "0"b; /* don't wait for bad message */ end; else ctl_msg_sent = "1"b; /* say all was well, so we can wait */ if ctl_wait_list.number = 1 & ctl_msg_sent then do; /* are we going to sync with the term? */ call ipc_$drain_chn (ctl_wait_list.channel, ec); if ec ^= 0 then do; /* avoid futher trouble, but not fatal */ ctl_wait_list.channel = 0; /* stop trying */ ctl_wait_list.number = 0; iodd_static.slave_hold = "1"b; ctl_msg_sent = "0"b; /* don't wait , no wakeup will come */ call convert_ipc_code_ (ec); call iodd_msg_ (error, master, ec, whoami, "print_head_banner bad call to ipc_drain"); end; else call timer_manager_$alarm_wakeup (driver_status.form_wait_time, "11"b, ctl_wait_list.channel); end; end; else ctl_msg_sent = "0"b; /* don't wait */ call iox_$control (iocbp, "reset", null, code); /* get to a known format */ call iox_$control (iocbp, "inside_page", null, code); /* and page position */ if ^REQUEST.no_separator | REQUEST.copy_no = 1 then do; call iodd_static.print_head_sheet (iocbp, prt_ctl_ptr, addr (REQUEST), code); /* write head sheet */ if code = 0 then header_done = "1"b; /* for the error routines */ end; /* otherwise ignore the banner type and just align the paper */ call iox_$control (iocbp, "reset", null, code); /* don't charge for advertizing */ return; end print_head_banner; %page; print_tail_banner: procedure (code); dcl code fixed bin (35); dcl ec fixed bin (35); dcl odd_page bit (1); dcl 1 event_info aligned, /* info returned from ipc_$block */ 2 chan fixed bin (71), 2 message fixed bin (71), 2 sender bit (36), 2 origin fixed bin, 2 wait_list_index fixed bin; code = 0; /* clear the error code */ odd_page = (mod (position.page_number, 2) = 1); /* did we stop on an odd page? */ if nep_mode_set & continuous_paper then do; /* in nep mode, check paper position */ if position.line_number > (prt_ctl.phys_page_length - divide (prt_ctl.lines_per_inch, 2, 17)) & odd_page then do; call iox_$put_chars (iocbp, addr (FF), 1, code); /* move ahead when partially printed */ odd_page = ""b; /* now proceed as though we finished on even page */ end; end; else if set_page_labels then /* if we owe a bottom label on last page */ call iox_$control (iocbp, "end_of_page", null, code); call iox_$control (iocbp, "reset", null, code); /* clear the counters and page labels */ /* for remotes, move to the right page */ if ^odd_page & iodd_static.attach_type ^= ATTACH_TYPE_IOM & continuous_paper then call iox_$put_chars (iocbp, addr (FF), 1, code); /* move ahead when partially printed */ call iox_$control (iocbp, "outside_page", null, code); if ^REQUEST.no_separator | (REQUEST.copy_no = REQUEST.copies) then call iodd_static.print_tail_sheet (iocbp, prt_ctl_ptr, addr (REQUEST), code); if ^iodd_static.quit_during_request & /* on quit, don't wait for ctl term */ ctl_msg_sent then do; /* avoid premature blocking */ call ipc_$block (addr (ctl_wait_list), addr (event_info), ec); /* wait for form to finish */ if ec ^= 0 then do; call convert_ipc_code_ (ec); call iodd_msg_ (error, master, ec, whoami, "Attempting to block for ctl_term."); iodd_static.slave_hold = "1"b; /* go to cmd level */ end; end; return; end print_tail_banner; %page; init_static_ctl: procedure (); string (static_ctl.flags) = ""b; static_ctl.banner_type = NORMAL_BANNERS; static_ctl.banner_bars = NORMAL_BANNER_BARS; static_ctl.banner_indent = 0; static_ctl.banner_line = 1; static_ctl.phys_line_length = 136; static_ctl.phys_page_length = 66; static_ctl.lines_per_inch = 6; string (static_ctl.channel_stops) = "0"b; /* no channel stops defined here */ return; end init_static_ctl; clean_proc: procedure (); iodd_static.segptr = null; /* tell signal handler we are done with it */ if fcbp ^= null then do; if segp ^= null then if privileged then call phcs_$deactivate (segp, (0)); call msf_manager_$close (fcbp); end; segp, fcbp = null; /* because this is used for several functions */ return; end clean_proc; %page; set_up_page_labels: proc; /* this routine will set up the printer to generate labels if they are needed */ /* if this is single sheet paper and there is a control string to initialize the printer send it out now. This is needed since head_sheet_ and tail_sheet_ programs for the printer might alter the characteristics of the printer in order to output their forms */ if ^continuous_paper then do; if evaluate_forms_info_output_ptr ^= null then do; if evaluate_forms_info_output.escape_length ^= 0 then do; call iox_$modes (iocbp, "rawo", "", code); call iox_$control (iocbp, "prt_conv_off", null (), code); call iox_$put_chars (iocbp, addr (evaluate_forms_info_output.escape_string), (evaluate_forms_info_output.escape_length), code); call iox_$control (iocbp, "prt_conv_on", null (), code); call iox_$modes (iocbp, "^rawo", "", code); end; end; end; if set_page_labels then do; /* only if we need page labels */ if (prt_ctl.banner_type = NO_BANNERS & prt_ctl.banner_bars = NO_BANNER_BARS) | (prt_ctl.banner_type = NO_BANNERS & ^REQUEST.separator) | (REQUEST.no_separator & ^(REQUEST.copy_no = 1)) then call iox_$put_chars (iocbp, addr (FF), 1, code); /* move below page label position for this page */ call iox_$control (iocbp, "end_of_page", null, code); call iox_$modes (iocbp, line_mode, omode, code); if code ^= 0 then do; call convert_status_code_ (code, short_msg, lg_msg); call ioa_$rsnnl ("^a while setting user line modes to: ^a^/ from: ^a", msg, l, lg_msg, line_mode, omode); call notify_user (substr (msg, 1, l)); /* The user tried to put the left margin after the right margin. */ call driver_fatal_error (code, "Changing to user line modes."); go to clean_out; end; call iox_$control (iocbp, "page_labels", addr (pg_labels), code); if code ^= 0 then do; call driver_fatal_error (code, "Setting page_labels."); go to clean_out; end; end; if (set_page_labels) | /* get the top label out */ /* regardless of anything else */ ^((prt_ctl.banner_type = NO_BANNERS & prt_ctl.banner_bars = NO_BANNER_BARS) | (prt_ctl.banner_type = NO_BANNERS & ^REQUEST.separator) | (REQUEST.no_separator & ^(REQUEST.copy_no = 1))) then /* if no labels then */ call iox_$put_chars (iocbp, addr (FF), 1, code); /* if not at top_inside_page, go there */ end set_up_page_labels; %page; /* ======== OTHER EXTERNAL ENTRIES ========= */ error_during_request: entry (cond); /* for coming back after signal */ dcl cond char (*); fault_name = cond; go to err_label; single_copy: entry (); /* abort multiple copies on command */ request_data_p -> ordata.copies = 1; /* force copy limit to 1 */ return; %page; %include access_audit_user_info; %page; %include access_audit_eventflags; %page; %include dprint_msg; %page; %include driver_status; %page; %include iod_constants; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include kst_attributes; %page; %include mseg_message_info; %page; %include output_request_data; %page; %include print_driver_data; %page; %include prt_ctl; %page; %include prt_order_info; %page; %include queue_msg_hdr; %page; %include request_descriptor; %page; %include send_mail_info; %page; %include system_forms_info; end do_prt_request_;  form_.alm 11/15/82 1835.7rew 11/15/82 1533.8 10908 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " Outer Module Transfer Vector for the form_ outer module. entry form_module form_module: tra *+1,6 go to proper transfer instruction tra |[form_attach] tra |[form_detach] tra |[form_read] tra |[form_write] tra |[form_abort] tra |[form_order] tra |[form_resetread] tra |[form_resetwrite] tra |[no_entry] tra |[form_getsize] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[form_changemode] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] end  form_dim_.pl1 11/15/82 1835.7rew 11/15/82 1507.8 200745 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ form_dim_: procedure; return; /* this is not a legal entry point */ /* Splicing dim to control the printing of forms on the IO daemon driver control terminal. This dim accepts a page length and line length as order calls and keeps track of the current line number on the terminal so that it can output enough line feeds to bring the form to the top of the page when a form feed character is written. The read entry also updates the current line position. */ /* Originally coded by J. Whitmore, Jan 1975, based on an old ttydim */ dcl (sdb_p, sp, vp, p) ptr, /* temporary storage */ (k, i) fixed bin; dcl 1 first_sdb int static aligned like sdb; /* first allocation of an SDB */ dcl 1 sdb based (sdb_p) aligned, /* one entry in list of stream data control blocks */ 2 dim_name char (32), /* the name of this DIM */ 2 device_name_list ptr, /* ptr to threaded list of device names for ios_ */ 2 next_device ptr, /* this should be null..device_name_list points here */ 2 device_name_size fixed bin, /* number of chars in device name */ 2 device_name char (32) unal, /* stream or device attached to */ 2 n_attached fixed bin, /* number of different streams using this SDB */ 2 active bit (1) unal, /* "1" means this entry is active */ 2 aligned bit (1) unal, /* "1" means paper is aligned on terminal */ 2 pad bit (34) unal, 2 page_size fixed bin, /* number of lines on the form */ 2 line_length fixed bin, /* number of print positions per line */ 2 carg_pos fixed bin, /* last known carriage position */ 2 line_no fixed bin, /* current line on the page */ 2 nextp ptr; /* pointer to next entry in sdb list */ dcl 1 st based (sp) aligned, /* breakdown of I/O system status word */ 2 code fixed bin (35), /* error status code (0 = OK) */ 2 comp bit (4) unaligned, /* completion status, LI, LC, PI, PC */ 2 end bit (1) unaligned, /* end-of-file */ 2 pad1 bit (4) unaligned, 2 eod bit (1) unaligned, /* end of physical data */ 2 pad2 bit (4) unaligned, 2 abs bit (1) unaligned, 2 det bit (1) unaligned, /* detach flag */ 2 quit bit (1) unaligned, /* quit flag */ 2 abort bit (1) unaligned, /* abort flag */ 2 callx bit (18) unaligned; /* rel pointer to last transaction */ dcl hcs_$assign_linkage ext entry (fixed bin, ptr, fixed bin (35)); dcl form_dim_$form_changemode entry (ptr, char (*), char (*), bit (72) aligned); dcl onechar char (1), /* temp for compares */ code fixed bin (35), init bit (1) int static init ("0"b), /* sdb initialization flag */ bel char (1) init (""), /* a bel char */ space char (1) int static init (" "), /* a space char */ spaces char (12) int static init (" "), /* string of spaces */ nl char (1) int static init (" "), ht char (1) int static init (" "), bs char (1) int static init (""); dcl (addr, null, mod, index, substr, search, length) builtin; dcl any_other condition; dcl error_table_$ionmat fixed bin (35) ext static; /* code indicating stream already attached */ dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl ios_$order entry (char (*), char (*), ptr, bit (72)aligned); dcl ios_$read entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl ios_$write entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl ios_$abort entry (char (*), bit (72) aligned, bit (72) aligned); dcl ios_$resetread entry (char (*), bit (72) aligned); dcl ios_$resetwrite entry (char (*), bit (72) aligned); dcl ios_$changemode entry (char (*), char (*), char (*), bit (72) aligned); dcl VT char (1) int static init (" "); /* a vertical tab character */ dcl ff char (1) int static init (" "); /* form feed char */ form_attach: entry (from_stream, dim_name, to_stream, mode, status, sdb_ptr); dcl from_stream char (*), /* stream name (e.g. user_i/o) */ dim_name char (*), /* IOSIM name used to get here */ to_stream char (*), /* stream we are attaching to */ mode char (*), /* attachment mode */ status bit (72) aligned, /* I/O system status code (returned) */ sdb_ptr ptr; /* device attachment pointer (returned) */ status = "0"b; /* clear status code */ sp = addr (status); /* pick up pointer to status code argument */ if sdb_ptr ^= null then do; /* this is a multiple attachment from the same source */ st.code = error_table_$ionmat; /* no good, so return error code */ return; /* return */ end; sdb_p = addr (first_sdb); /* get pointer to first entry in SDB list */ if ^init then do; /* be sure we initialize sdb first in the process */ sdb.active = "0"b; /* not active yet */ sdb.nextp = null; /* list ends here */ init = "1"b; /* we are now initialized for sdb search */ end; vp = null; /* use vp to locate first vacant entry (if any) */ do while (sdb_p ^= null); /* search entire SDB list */ p = sdb_p; /* keep track of last entry in temp ptr p */ if ^sdb.active then do; /* is this entry an unused (vacant) entry? */ if vp = null then vp = sdb_p; /* record first vacant entry found in list */ end; else if sdb.device_name = to_stream then do; /* not vacant, is stream already attached? */ sdb_ptr = sdb_p; /* if so, return attachment ptr to this entry */ sdb.n_attached = sdb.n_attached + 1; /* allow multiple sources */ go to attrtn; /* and return to caller */ end; sdb_p = sdb.nextp; /* get pointer to next entry (if any) in list */ end; if vp = null then do; /* if no vacant entry found in sdb list, */ call hcs_$assign_linkage (32, vp, code); /* then we must allocate space for a new entry */ if code ^= 0 then go to atterr; vp -> sdb.active = "0"b; /* initialize new sdb list entry */ vp -> sdb.nextp = null; /* indicate new entry is last entry in list */ p -> sdb.nextp = vp; /* thread new entry into sdb list */ end; sdb_p, sdb_ptr = vp; /* set caller's attachment pointer */ sdb.active = "1"b; /* initialize remainder of sdb list entry */ sdb.n_attached = 1; /* this is the first source for this SDB */ sdb.device_name = to_stream; /* save stream we will do I/O on */ sdb.dim_name = dim_name; /* initialize name of DIM */ sdb.device_name_list = addr (sdb.next_device); /* get pointer to list of device names */ sdb.next_device = null; /* this is last entry in list */ sdb.device_name_size = index (to_stream, " ") - 1; /* there should be a trailing space */ if sdb.device_name_size < 1 then sdb.device_name_size = length (to_stream); sdb.page_size = 66; /* default is 66 lines per page */ sdb.line_length = 79; /* assume 79 as a default */ sdb.carg_pos = 1; /* assume carrage in col 1 */ sdb.line_no = 1; /* assume top of page */ sdb.aligned = "0"b; /* but, that paper is not aligned */ /* we can't assume that "to_stream" is attached yet, but */ call ios_$changemode (sdb.device_name, "edited", "", status); /* set edited mode if possible */ attrtn: if mode ^= "" then call ios_$changemode (sdb.device_name, mode, "", status); /* if mode is specified then establish it */ call set_line_length; /* get ll from device or take default */ status = "0"b; /* all is well even if other stream not there */ st.end = "1"b; /* indicate stream at "end of file" */ return; /* and return to caller */ atterr: st.code = code; /* here on error, return status code to caller */ st.det = "1"b; /* indicate stream not attached */ return; /* */ form_write: entry (sdb_ptr, wp, offset, ne, net, status); /* entry to write */ dcl wp ptr, /* pointer to base of user's workspace */ offset fixed bin, /* character offset from wp */ ne fixed bin, /* number of elements (characters) to write (or read) */ net fixed bin; /* number of elements actually written (or read) */ dcl source char (512) based (wp); /* input buffer */ dcl next_char fixed bin, /* index of next unprocessed char from user */ last_char fixed bin, /* index of the last char to write */ write_flag bit (1), /* flag to write after nl unless space gets tight */ out_pos fixed bin, /* index of next available slot in out_buf */ out_buf char (640); /* output buffer built from user's workspace */ dcl fold char (3) int static init (" \*"); /* line folding char sequence nl||\||* */ sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ status = "0"b; /* initialize status code to zero */ sp = addr (status); /* get pointer to status code argument */ if ne = 0 then go to wrtn; /* skip to return if nothing to write */ net = 0; /* initialize elements-written to zero */ next_char = offset + 1; /* index of first char to write */ last_char = offset + ne; /* index of last char to write */ outer_loop: do while (next_char <= last_char); /* write all chars requested */ out_pos = 1; /* start a new output string */ write_flag = "0"b; /* indicate that we want to buffer */ inner_loop: do while (^write_flag & (next_char <= last_char) & (out_pos < 638)); /* write in small blocks */ onechar = substr (source, next_char, 1); /* get next input character */ if onechar < space then do; /* check for ctl char */ if onechar = nl then do; /* it was a new line */ substr (out_buf, out_pos, 1) = nl; /* put out and count */ out_pos = out_pos + 1; /* update output index */ sdb.carg_pos = 1; /* carriage now in column 1 */ sdb.line_no = sdb.line_no + 1; /* count the line position on the form */ if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */ write_flag = "1"b; /* if buffer full we will write */ end; else if onechar = ff then do; /* it was a form feed */ if sdb.aligned then do; /* if alignment set, go to top */ if ^((sdb.line_no = 1) & (sdb.carg_pos = 1)) then do; /* are we there? */ do i = 1 to (sdb.page_size - sdb.line_no + 1); /* put out enough new lines */ substr (out_buf, out_pos, 1) = nl; out_pos = out_pos + 1; end; sdb.carg_pos = 1; /* carriage position is now 1 */ sdb.line_no = 1; /* now at top */ write_flag = "1"b; /* we can write if needed */ end; end; else do; substr (out_buf, out_pos, 1) = ff; /* put it out when not aligned */ out_pos = out_pos + 1; end; end; else if onechar = VT then do; /* it was a vertical tab */ if sdb.aligned then do; /* if alignment is set we simulate */ k = 10 - mod (sdb.line_no + 9, 10); /* how far to 1, 11, 21, 31, ... */ if sdb.line_no + k > sdb.page_size then /* but don't overflow a page */ k = sdb.page_size - sdb.line_no + 1; /* go to top of form */ do i = 1 to k; substr (out_buf, out_pos, 1) = nl; /* write out "k" new lines */ out_pos = out_pos + 1; end; sdb.carg_pos = 1; /* back to column 1 */ sdb.line_no = sdb.line_no + k; /* update the line count */ if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* we didn't go past line 1 */ write_flag = "1"b; /* this is a good time to write */ end; else do; /* not aligned, just put it out */ substr (out_buf, out_pos, 1) = VT; out_pos = out_pos + 1; end; end; else if onechar = ht then do; /* it was a tab */ i = mod (sdb.carg_pos, 10); /* locate position in tab field */ if i = 0 then sdb.carg_pos = sdb.carg_pos + 1; else sdb.carg_pos = sdb.carg_pos + 11 - i; /* indicate new carriage position */ if sdb.carg_pos <= sdb.line_length then do; /* check for end of carriage */ substr (out_buf, out_pos, 1) = ht; /* ok, put it out */ out_pos = out_pos + 1; end; else do; /* must fold the line */ substr (out_buf, out_pos, 3) = fold; /* put in nl||\||c */ out_pos = out_pos + 3; sdb.line_no = sdb.line_no + 1; if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of form */ i = sdb.carg_pos - sdb.line_length - 1; /* how much overhang? */ if i > 0 then do; substr (out_buf, out_pos, i) = substr (spaces, 1, i); /* pad out */ out_pos = out_pos + i; end; sdb.carg_pos = 3 + i; write_flag = "1"b; /* write if buffer full */ end; end; else if onechar = bs then do; /* it was a back space */ substr (out_buf, out_pos, 1) = bs; /* put it out */ out_pos = out_pos + 1; sdb.carg_pos = sdb.carg_pos - 1; /* back up the carriage position */ end; else if onechar = bel then do; /* it was a bel char, thats OK. */ substr (out_buf, out_pos, 1) = bel; out_pos = out_pos + 1; /* this will not move the carriage */ end; /* otherwise drop the character */ next_char = next_char + 1; /* either way, get ready for next char */ end; else do; /* printable char, so put it out */ substr (out_buf, out_pos, 1) = onechar; out_pos = out_pos + 1; sdb.carg_pos = sdb.carg_pos + 1; next_char = next_char + 1; /* move the source index */ if next_char <= last_char then /* is the next char legal? */ if sdb.carg_pos > sdb.line_length then do; /* may need to fold */ if substr (source, next_char, 1) ^= nl then do; /* fold if next char not nl */ substr (out_buf, out_pos, 3) = fold; /* insert fold sequence */ out_pos = out_pos + 3; sdb.carg_pos = 3; write_flag = "1"b; sdb.line_no = sdb.line_no + 1; if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* at the top */ end; else do; /* just put in new line */ substr (out_buf, out_pos, 1) = nl; out_pos = out_pos + 1; sdb.line_no = sdb.line_no + 1; if sdb.line_no > sdb.page_size then sdb.line_no = 1; sdb.carg_pos = 1; next_char = next_char + 1; /* already checked it */ write_flag = "1"b; end; end; end; if out_pos < 512 then write_flag = "0"b; /* then write after nl if 512 chars buffered */ end; /* end of inner do while loop */ call ios_$write (sdb.device_name, addr (out_buf), 0, out_pos - 1, i, status); if st.code ^= 0 then do; /* on error, throw it back to caller */ net = i; /* tell him how many written */ return; end; end outer_loop; wrtn: st.end = "1"b; /* indicate stream at "end-of-file" */ st.comp = "1110"b; /* return I/O completion indicators */ net = ne; /* indicate that all elements were transferred */ return; /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_read: entry (sdb_ptr, wp, offset, ne, net, status); /* entry to read from attachment */ sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ status = "0"b; /* initialize status code to zero */ call ios_$read (sdb.device_name, wp, offset, ne, net, status); /* pass it on */ if substr (source, offset + net, 1) = nl then do; /* adjust for manual nl's */ sdb.line_no = sdb.line_no + 1; /* increment the line count */ if sdb.line_no > sdb.page_size then sdb.line_no = 1; /* top of page? */ sdb.carg_pos = 1; /* he had to give a nl char */ end; return; /* and return control to caller */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_resetread: entry (sdb_ptr, stat2); /* entry to reset read-ahead data */ dcl stat2 bit (72) aligned; /* I/O system status code (returned) */ sdb_p = sdb_ptr; sdb.aligned = "0"b; /* form alignment is gone */ call ios_$resetread (sdb.device_name, stat2); /* pass it along */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_resetwrite: entry (sdb_ptr, stat2); /* entry to reset write-behind buffers */ sdb_p = sdb_ptr; sdb.aligned = "0"b; /* form alignment is gone */ call ios_$resetwrite (sdb.device_name, stat2); /* pass it along for now */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_abort: entry (sdb_ptr, stat2, stat3); /* entry to reset read, write and quit condition */ dcl stat3 bit (72) aligned; /* I/O system status code (returned) */ sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ sdb.aligned = "0"b; /* form alignment is gone */ call ios_$abort (sdb.device_name, stat2, stat3); /* call other DIM to do the work */ return; /* and return */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_order: entry (sdb_ptr, request, argptr, stat4); /* entry to issue attachment orders */ dcl request char (*), /* symbol attachment request order code */ argptr ptr, /* pointer to additional arguments (if any) */ stat4 bit (72) aligned; /* I/O system status code (returned) */ dcl 1 form aligned based (argptr), /* structure for reading form data */ 2 page_size fixed bin, 2 line_length fixed bin, 2 line_no fixed bin, 2 carg_pos fixed bin, 2 aligned bit (1) unal, 2 pad bit (35) unal; dcl error_table_$undefined_order_request fixed bin (35) ext static; dcl 1 modes based (argptr), 2 len fixed bin, 2 string char (len); dcl argnum fixed bin based (argptr); on any_other go to order_err; /* in case some fool gives a bad argptr */ sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ stat4 = "0"b; /* initialize status code to zero */ sp = addr (stat4); /* get pointer to status code argument */ if request = "page_length" then do; if (argnum > 5) & (argnum < 133) then /* a "page" may be from 6 to 132 lines long */ sdb.page_size = argnum; /* if in range save it */ else st.code = error_table_$undefined_order_request; /* out of range */ return; /* we handled it, don't pass it along */ end; else if request = "form_aligned" then do; /* get ready to simulate form feeds */ sdb.aligned = "1"b; sdb.line_no = 1; sdb.carg_pos = 1; return; end; else if request = "form_status" then do; /* give back everything..in case */ form.page_size = sdb.page_size; form.line_length = sdb.line_length; form.line_no = sdb.line_no; form.carg_pos = sdb.carg_pos; form.aligned = sdb.aligned; return; end; passon: call ios_$order (sdb.device_name, request, argptr, stat4); /* pass order call to other DIM */ call set_line_length; /* the "modes" order could change ll */ return; /* and return to caller */ order_err: st.code = error_table_$undefined_order_request; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_changemode: entry (sdb_ptr, mode, omode, stat4); /* entry to modify the attachment mode */ dcl omode char (*); /* returned mode prior to this call */ sdb_p = sdb_ptr; /* get pointer to SDB for this attachment */ stat4 = "0"b; /* initialize status to OK */ sp = addr (stat4); /* pick up pointer to status argument */ call ios_$changemode (sdb.device_name, mode, omode, stat4); /* call other DIM to change modes */ call set_line_length; /* see if there is a new line length */ return; /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_getsize: entry (sdb_ptr, size, stat3); /* entry to return current element size */ dcl size fixed bin; /* current element size (returned) */ size = 9; /* element size for consoles is always 9 */ stat3 = "0"b; return; /* so return the constant 9 to the caller */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ form_detach: entry (sdb_ptr, ch2, disposal, stat4); /* entry to detach one input stream */ dcl (ch2, disposal) char (*); /* these arguments ignored in this implementation */ sdb_p = sdb_ptr; /* get pointer to entry for this attachment */ stat4 = "0"b; /* initialize status code to zero */ sp = addr (stat4); /* get pointer to status code argument */ st.det = "1"b; /* set code to detach this ioname */ sdb.n_attached = sdb.n_attached - 1; /* count one less source */ if sdb.n_attached < 1 then sdb.active = "0"b; /* indicate sdb list entry no longer in use */ return; /* and return */ /* ********************************************************************** */ /* ** internal procedure to set internal line length ** */ set_line_length: proc; dcl ec fixed bin (35); dcl v char (12) var; dcl k fixed bin; dcl status bit (72) aligned; dcl get_line_length_$stream entry (char (*), fixed bin (35)) returns (fixed bin); dcl convert_binary_integer_$decimal_string entry (fixed bin) returns (char (12) var); k = get_line_length_$stream (sdb.device_name, ec); /* see what ll is set on output stream */ if ec ^= 0 then do; /* it must not be there, take default */ sdb.line_length = 79; return; end; if k < 11 | k > 132 then do; /* must be a mistake, keep current value */ v = convert_binary_integer_$decimal_string (sdb.line_length); v = "ll" || v; /* make a mode string out of it */ call ios_$changemode (sdb.device_name, (v), "", status); /* this is the best we can do */ return; end; sdb.line_length = k; /* record the new line length so we are in sync */ return; end set_line_length; end form_dim_;  io_daemon_account_.pl1 10/28/88 1403.5rew 10/28/88 1248.2 98334 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199): Ancient History Modified in March 1975 by J. C. Whitmore for driver restructure Modified June 1976 by J. L. Homan to charge by line count instead of block count. Modified Sept. 1977 by J. C. Whitmore to pass ordatap to user accounting proc (MCR 2934) Modified by J. C. Whitmore, 5/78, to use new per rqt per queue price names Modified by J. C. Whitmore, 8/78, to separate the charge queue from the request queue Modified Feb 1980 by M. B. Armstrong to implement multiple rate structures. (UNCA) Modified by R. McDonald May 1980 to include page charges. (UNCA) Modified by E. N. Kittlitz June 1981 for UNCA page charges Modified by E. N. Kittlitz January 1982 to change null accounting pointer to indicate accounting: nothing; and use a valid pointer for accounting: system; Modified by C. Marker February 23, 1985 to use version 5 message segments 2) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-18,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. Changed to use entry variable to accounting routine, not pointer. END HISTORY COMMENTS */ /* format: style4 */ io_daemon_account_: proc (account_entry, argp); /* Accounting routine for I/O daemon, which will put appropriate a values in a dummy pdt entry and call the routine pointed to by account_entry. */ /* Parameters */ dcl account_entry entry (char (*), char (*), ptr, fixed bin (35)) variable; /* entry variable to accounting routine */ dcl argp ptr; /* External Procedures & Variables */ dcl continue_to_signal_ entry (fixed bin (35)); dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl iodd_msg_ entry options (variable); dcl iodd_stat_p ptr ext; /* an easy way to get the value for stat_p */ dcl search_sat_$rs_number entry (char (*), fixed bin, fixed bin (35)); dcl system_info_$io_prices_rs entry (fixed bin, (4) float bin); dcl system_info_$max_rs_number entry (fixed bin); dcl system_info_$resource_price_rs entry (fixed bin, char (*) aligned, float bin, fixed bin (35)); dcl (addr, before, after, null, hbound, unspec) builtin; dcl (any_other, cleanup) condition; /* Internal Static */ dcl both fixed bin int static options (constant) init (0); dcl default_prices (0:9, 4) float bin aligned int static; /* one set for each rate structure for efficiency */ dcl error fixed bin int static options (constant) init (2); dcl max_rs_number fixed bin static init (0); dcl not_initialized bit (1) aligned int static init ("1"b); dcl whoami char (32) int static options (constant) init ("io_daemon_account_"); dcl 1 lines_price (0:9) aligned int static, /* ditto */ 2 driver (30), 3 q (4) float bin; dcl 1 pages_price (0:9) aligned int static, /* one set for each rate structure for effieiency */ 2 driver (30), 3 q (4) float bin; /* Automatic */ dcl code fixed bin (35); dcl driver_index fixed bin; /* index of logical driver in driver_ptr_list */ dcl (i, j) fixed bin; dcl old_mask bit (36) aligned; dcl pdtp ptr; /* this is just to make this thing compile */ dcl pdtep ptr; dcl pers char (32); dcl proj char (12); dcl q fixed bin; dcl rs_number fixed bin; /* rate structure number */ dcl 1 dummy aligned like user; /* place to hold template user PDT entry */ %page; stat_p = iodd_stat_p; /* just to be sure */ pdtp = null; /* makes compiler happy */ if not_initialized then do; call system_info_$max_rs_number (max_rs_number); do j = 0 to hbound (lines_price, 1); /* this should never be necessary any more */ if j > max_rs_number then rs_number = 0; else rs_number = j; call system_info_$io_prices_rs (rs_number, default_prices (j, *)); do i = 1 to hbound (lines_price.driver, 2); /* set all lines prices to the default */ lines_price (j).driver (i).q (*) = default_prices (j, *); end; end; call iodd_msg_ (error, both, 0, whoami, "Initialization error. Using io_prices rather than resource_prices."); not_initialized = "0"b; end; ordatap = argp; ordata.charge = 0e0; /* show no charge in case of error */ q = ordata.charge_queue; /* the driver_index and q define the price */ driver_index = iodd_static.driver_ptr -> driver_status.list_index; /* see which driver this is */ if driver_index < 1 | driver_index > iodd_static.assigned_devices then do; /* got clobbered? */ iodd_static.master_hold = "1"b; /* force command level */ call iodd_msg_ (error, both, 0, whoami, "Invalid driver index. Check with administrator before continuing."); return; end; /* mask interrupts, and set default handler to unmask them */ old_mask = ""b; /* initialize the old mask to null */ on any_other call unmask; on cleanup call unmask; call hcs_$set_ips_mask (""b, old_mask); /* save the old mask and restore it later */ pers = before (ordata.requestor, "."); /* get person and project we will charge */ proj = before (after (ordata.requestor, "."), "."); if pers = "anonymous" then pers = "*"; /* special case the anonymous user name */ ordata.rs_unavailable, ordata.no_accounting = "0"b; if max_rs_number = 0 then rs_number = 0; else do; call search_sat_$rs_number ((proj), rs_number, code); /* get rate index */ if code ^= 0 then do; if code = error_table_$noentry then call iodd_msg_ (error, both, code, whoami, "Trying to locate project ""^a"". Default rates will be used.", proj); else call iodd_msg_ (error, both, code, whoami, "Accessing the sat. Default rates will be used"); rs_number = 0; ordata.rs_unavailable = "1"b; /* remember that we faked this */ end; end; ordata.price_per_n_lines = lines_price (rs_number).driver (driver_index).q (q); /* how we computed the charge */ ordata.rs_number = rs_number; /* remember which rate_structure */ ordata.n_lines_for_price = 1000; ordata.price_per_n_pages = pages_price (rs_number).driver (driver_index).q (q); /* how we conputed the charge */ ordata.n_pages_for_price = 1000; ordata.charge = ordata.price_per_n_lines * ordata.line_count / ordata.n_lines_for_price; ordata.charge = ordata.charge + ordata.price_per_n_pages * ordata.page_count / ordata.n_pages_for_price; /* put values in pdt template entry for updating */ unspec (dummy) = ""b; /* be sure there is no garbage */ pdtep = addr (dummy); q = ordata.queue; /* this is the queue request came from */ user.iod (q).charge, user.dollar_charge, user.absolute_spent = ordata.charge; user.iod (q).pieces = 1; user.iod (q).lines = ordata.line_count; user.iod (q).pages = ordata.page_count; code = 0; /* set to zero in case user proc just returns */ call account_entry (pers, proj, pdtep, code); call unmask; /* now we can allow ips signals */ if code ^= 0 then call iodd_msg_ (error, both, code, whoami, "From accounting for ^a.^a", pers, proj); return; set_line_prices: entry (a_driver_index, qgtep, a_code); dcl a_code fixed bin (35); /* error code */ dcl a_driver_index fixed bin; a_code = 0; driver_index = a_driver_index; /* copy the index */ if driver_index < 0 | driver_index > hbound (lines_price.driver, 2) then do; /* out of range ? */ a_code = error_table_$action_not_performed; return; end; if not_initialized | driver_index = 0 then do; call system_info_$max_rs_number (max_rs_number); stat_p = iodd_stat_p; /* set this only once, we hope */ do j = 0 to hbound (lines_price, 1); if j > max_rs_number then rs_number = 0;/* use the default */ else rs_number = j; call system_info_$io_prices_rs (rs_number, default_prices (j, *)); do i = 1 to hbound (lines_price.driver, 2); /* set all lines prices to the default */ lines_price (j).driver (i).q (*) = default_prices (j, *); end; end; not_initialized = "0"b; if driver_index = 0 then return; /* don't assume index is good further on */ end; lines_price (*).driver (driver_index).q (*) = 0.0e0; /* clear old prices */ if qgtep = null | qgte.line_charge.queue (1) = "" then do rs_number = 0 to hbound (lines_price, 1); /* use default prices if there are no names */ lines_price (rs_number).driver (driver_index).q (*) = default_prices (rs_number, *); end; else do i = 1 to qgte.max_queues; /* get the price for each possible queue */ do j = 0 to hbound (lines_price, 1); /* all rates */ if j > max_rs_number then rs_number = 0;/* use the default */ else rs_number = j; call system_info_$resource_price_rs (rs_number, qgte.line_charge.queue (i), lines_price (j).driver (driver_index).q (i), a_code); if a_code ^= 0 then return; end; end; pages_price (*).driver (driver_index).q (*) = 0.0e0; /* clear old prices */ if qgtep = null | qgte.page_charge.queue (1) = "" then ; /* uses zero default prices if there are no names */ else do i = 1 to qgte.max_queues; /* get the price for each possible queue */ do j = 0 to hbound (pages_price, 1); /* all rates */ if j > max_rs_number then rs_number = 0;/* use the default */ else rs_number = j; call system_info_$resource_price_rs (rs_number, qgte.page_charge.queue (i), pages_price (j).driver (driver_index).q (i), a_code); if a_code ^= 0 then return; end; end; return; unmask: proc; if old_mask then do; /* if the old mask had some bits on, restore it */ call hcs_$set_ips_mask (old_mask, (""b)); old_mask = ""b; end; call continue_to_signal_ ((0)); /* in case this was from a handler */ return; end unmask; %page; %include driver_status; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include mseg_message_info; %page; %include output_request_data; %page; %include pdt; %page; %include q_group_tab; %page; %include request_descriptor; %page; %include user_attributes; end io_daemon_account_;  iod_command.pl1 11/15/82 1835.7rew 11/15/82 1507.9 41553 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Constructs a command line for execution by the I/O daemon command processor: This Multics command is intended for use within I/O daemon extended commands (exec_coms) when it is necessary to issue actual I/O daemon commands. For example, iod_command defer_time pica_10 30 sets the automatic defer time for the "pica_10" minor device to 30 minutes */ /* Note: The "go" command may not be issued using this interface */ /* Created: 27 September 1981 by G. Palter */ iod_command: procedure () options (variable); dcl argument character (argument_lth) unaligned based (argument_ptr); dcl argument_lth fixed binary (21); dcl argument_ptr pointer; dcl system_area area based (system_area_ptr); dcl system_area_ptr pointer; dcl local_buffer character (512); dcl buffer character (buffer_lth) based (buffer_ptr); dcl buffer_lth fixed binary (21); dcl buffer_ptr pointer; dcl command_line character (command_line_lth) based (buffer_ptr); dcl command_line_lth fixed binary (21); dcl new_buffer character (new_buffer_lth) based (new_buffer_ptr); dcl new_buffer_lth fixed binary (21); dcl new_buffer_ptr pointer; dcl (n_arguments, idx) fixed binary; dcl code fixed binary (35); dcl IOD_COMMAND character (32) static options (constant) initial ("iod_command"); dcl (MASTER initial (1), /* command line from the master console ... */ RECURSIVE_COMMAND_LEVEL initial (2)) /* ... being executed from within another command */ fixed binary static options (constant); dcl (com_err_, com_err_$suppress_name) entry () options (variable); dcl cu_$arg_count entry (fixed binary, fixed binary (35)); dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35)); dcl get_system_free_area_ entry () returns (pointer); dcl iodd_command_processor_ entry (fixed binary, fixed binary, character (*), fixed binary (35)); dcl cleanup condition; dcl (addr, length, max, substr) builtin; /* */ /* iod_command: entry () options (variable); */ call cu_$arg_count (n_arguments, code); if code ^= 0 then do; /* not called as a command */ call com_err_ (code, IOD_COMMAND); return; end; if n_arguments = 0 then do; call com_err_$suppress_name (0, IOD_COMMAND, "Usage: ^a command_line", IOD_COMMAND); return; end; command_line_lth = 0; buffer_ptr = addr (local_buffer); buffer_lth = length (local_buffer); system_area_ptr = get_system_free_area_ (); on condition (cleanup) begin; if buffer_ptr ^= addr (local_buffer) then free buffer in (system_area); end; /* Construct the command line: for consistency with other commands that take command lines as unquoted arguments, the individual words of the command line are not requoted */ do idx = 1 to n_arguments; call cu_$arg_ptr (idx, argument_ptr, argument_lth, code); if code ^= 0 then do; call com_err_ (code, IOD_COMMAND, "Fetching argument #^d.", idx); go to RETURN_FROM_IOD_COMMAND; end; if (command_line_lth + argument_lth + 1) > buffer_lth then do; /* need to expand the buffer being constructed */ new_buffer_lth = max ((buffer_lth + 512), (command_line_lth + argument_lth + 128)); allocate new_buffer in (system_area) set (new_buffer_ptr); new_buffer = buffer; /* copy what we have so far ... */ if buffer_ptr ^= addr (local_buffer) then /* current buffer was allocated */ free buffer in (system_area); buffer_ptr = new_buffer_ptr; /* switch to new buffer */ buffer_lth = new_buffer_lth; end; substr (buffer, (command_line_lth+1), (argument_lth+1)) = argument; command_line_lth = command_line_lth + argument_lth + 1; end; command_line_lth = command_line_lth - 1; /* added an extra trailing space */ /* Pass the command on for execution: let the I/O daemon environment handle all errors */ call iodd_command_processor_ (MASTER, RECURSIVE_COMMAND_LEVEL, command_line, (0)); /* Clean up */ RETURN_FROM_IOD_COMMAND: if buffer_ptr ^= addr (local_buffer) then free buffer in (system_area); return; end iod_command;  iodd_.pl1 11/14/88 1105.6rew 11/14/88 1100.1 830529 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ /* format: off */ iodd_: proc; /* This is not the main entry point. It is used to set the entry variable for the driver module default handler if that entry was not defined. We have to be able to call something! */ return; iodd_init: entry (system_dir, testing); /* This is the initialization procedure for all IO Daemon drivers. It is called with two arguments: system_dir which defines the directory which will contain the common IO Daemon data bases; and testing, which indicates that the driver is being run in test mode. This procedure determines from the site operator which device is to be used, establishes communication with the IO Coordinator, attaches the device control terminal if needed, and transfers to the driver control procedure specified in the iod_tables source file. The design was adapted from the original IO Daemon driver designed by Robert S. Coren in September 1973. This design is provided to make the IO Daemon compatible with the Access Isolation Mechanism. Coded in January 1975 by J. C. Whitmore. Modified in November 1975 by M. A. Braida to initialize data for seg_fault_error check. */ /* Modified Nov 1977 by J. C. Whitmore for new iodd_static data, initiation of rqti segs, and condition handling */ /* Modified Mar 1978 by J. C. Whitmore for upgrade and addition of per RQT accounting and rqti seg from iod_tables */ /* Modified by J. C. Whitmore, 7/78, to setup for new driver -> coord command strategy & "x" cmd */ /* Modified by J. C. Whitmore, 10/78, to extend number of RJE stations (version 3 iod_tables format) */ /* Modified by J. C. Whitmore, 11/78, to start using driver version numbers starting at 5.0 (5 major changes since MR 6.0) */ /* Modified by J. C. Whitmore, 3/79 (V-5.1), for minor message and logic bug fixes */ /* Modified by J. C. Whitmore, 5/79 (V-5.2), to retry listen attachment 5 times before aborting */ /* Modified by C. Hornig, 8/79 (V-5.3), for multiple minor devices of the same generic type */ /* Modified by J. C. Whitmore, 10/79 (V-5.4), for daemon_idle default condition handler */ /* Modified by E. N. Kittlitz, 6/81 (V-5.5), for UNCA rate structures */ /* Modified: November 1981 by G. Palter, V-5.6, to use read_password_ to get the station password if it is omitted from the station command, to not consider inability to set hangup_proc as fatal, to call head_sheet_$test when in a test environment, FILL IN THE BLANK, and fix the following bugs from the I/O daemon error list: 0032: phx11372 When running an I/O daemon in test mode with the coordinator and driverin the same process, printing a single request, exiting the I/O daemon, re-entering the I/O daemon, and printing another request will cause the head/tail sheets of the first request to be printed surrounding the file specified in the second request */ /* Modified January 1982 by E. N. Kittlitz (V-5.7) for accounting change. accounting:nothing; in the IODT will really do nothing in io_daemon_account_. */ /* Modified January 1983 by C. Marker Added probe as a legal command in test mode. */ /* Modified 1984-08-17 by E. Swenson for Version 2 PNTs. */ /* Modified February 23, 1985 by C. Marker to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(85-02-14,Homan), approve(87-04-06,MCR7656), audit(87-06-13,Beattie), install(87-08-06,MR12.1-1068): Add support for logout_on_hangup. 2) change(88-02-18,Brunelle), approve(88-06-02,MCR7911), audit(88-10-19,Wallman), install(88-11-08,MR12.2-1199): Upgraded to version 5 iod tables. Add support for head/tail_sheet entry variables and paper_type variable. Remove calls to head_sheet_$init & tail_sheet_$init. 3) change(88-11-03,Brunelle), approve(88-11-03,MCR7911), audit(88-11-03,Wallman), install(88-11-08,MR12.2-1199): Corrected a pass-by-value problem which was causing control terminal i/o to go to the message coordinator. 4) change(88-11-11,Brunelle), approve(88-11-03,PBF7911), audit(88-11-14,Wallman), install(88-11-14,MR12.2-1212): Add a 10 second wait in all non-IOM configurations to allow the answering service at both ends of the communications line to handle all the traffic generated when a re_init is signalled. END HISTORY COMMENTS */ /* format: on */ %page; /* ----------- ARGUMENTS ------------- */ dcl system_dir char (*), /* directory containing common data bases */ testing bit (1) aligned; /* test mode indicator */ /* --------EXTERNAL ENTRIES---------- */ dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl charge_user_ entry (char (*), char (*), ptr, fixed bin (35)); dcl convert_dial_message_ entry (fixed bin (71), char (*) aligned, char (*) aligned, fixed bin, 1 aligned like status_flags, fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl continue_to_signal_ entry (fixed bin (35)); dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); dcl debug entry options (variable); dcl dial_manager_$allow_dials entry (ptr, fixed bin (35)); dcl dial_manager_$privileged_attach entry (ptr, fixed bin (35)); dcl dial_manager_$release_channel entry (ptr, fixed bin (35)); dcl get_at_entry_ entry (char (*), char (*) aligned, char (*) aligned, char (*)) returns (fixed bin (35)); dcl get_group_id_ entry () returns (char (32)); dcl get_group_id_$tag_star entry () returns (char (32)); dcl get_process_id_ entry () returns (bit (36)); dcl get_authorization_ entry () returns (bit (72) aligned); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); dcl hcs_$terminate_name entry (char (*), fixed bin (35)); dcl hcs_$terminate_file entry (char (*), char (*) aligned, fixed bin (1), fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$tty_index entry (char (*) aligned, fixed bin, fixed bin, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl head_sheet_$print_head_sheet entry (ptr, ptr, ptr, fixed bin (35)); dcl head_sheet_$print_separator entry (ptr, ptr, char (*), fixed bin (35)); dcl head_sheet_$test entry (char (*)); dcl ioa_$ioa_stream entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl io_daemon_account_$set_line_prices entry (fixed bin, ptr, fixed bin (35)); dcl iodd_command_processor_$init entry (ptr); dcl iodd_hangup_$iodd_hangup_ entry (ptr); dcl iodd_msg_ entry options (variable); dcl iodd_quit_handler_$init entry (ptr); dcl iodd_signal_handler_ entry; dcl iodd_signal_handler_$init entry (ptr); dcl ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35)); dcl logout entry () options (variable); dcl message_segment_$add_file entry (char (*), char (*), ptr, fixed bin, bit (72) aligned, fixed bin (35)); dcl iodd_parse_$command entry (char (*), ptr, fixed bin (35)); dcl probe entry options (variable); dcl print_devices entry options (variable); /* command for data in iod tables */ dcl print_line_ids entry options (variable); /* " " */ dcl read_password_$switch entry (ptr, ptr, char (*), char (*), fixed bin (35)); dcl scramble_ entry (char (8)) returns (char (8)); dcl set_iod_val entry options (variable); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl tail_sheet_$print_tail_sheet entry (ptr, ptr, ptr, fixed bin (35)); dcl timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry); dcl timer_manager_$reset_alarm_call entry (entry); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl validate_card_input_$station entry (char (*), char (*), char (*), fixed bin (35)); dcl write_control_form_$init entry (ptr); /* --------- AUTOMATIC ----------- */ dcl code fixed bin (35); dcl dev_label char (32); dcl dev_class char (32); dcl queue_type char (32); /* queue_type when we need to look for it */ dcl request_type char (64); dcl table_time fixed bin (71); dcl first_arg char (32); dcl second_arg char (64); dcl dev_name char (32) aligned; dcl dim_name char (32) aligned; dcl (i, j) fixed bin; /* index variables */ dcl ig char (4); /* dummy for get_at_entry_ call */ dcl io_stat bit (72) aligned; dcl line char (120); dcl nchars fixed bin (21); dcl init_ev_chan fixed bin (71); dcl iodc_data_ptr ptr; dcl seg_name char (32); /* temp for segment initialization */ dcl question char (64); /* question to ask operator */ dcl use_default bit (1); /* switch indicating that default device classes are used */ dcl msgp ptr; /* pointer to the event message */ dcl message_id bit (72) aligned; /* id if a message segment message */ dcl driver_dir char (168); /* path of driver major device directory */ dcl rqt_name char (32); dcl rqt_string char (168) var; dcl rqti_dir char (168); /* path of dir with rqti segs */ dcl sys_dir char (168); /* local copy of system directory path */ dcl meter_dir char (168); /* path of meter data segs directory */ dcl entry_name char (32); /* accounting proc entry point name */ dcl entry_variable entry variable options (variable); dcl times fixed bin; /* number of times the driver tries to find cord */ dcl temp_dir char (168) varying; dcl temp_dir_entry char (256); dcl temp_password char (8); /* temporary for password manipulation */ dcl temp_ptr ptr; /* random temporary pointer variable */ dcl input_iocbp ptr; /* iocb pointer for reading request type data */ dcl 1 st aligned based (addr (io_stat)), /* breakout of an ios_ status code */ 2 code fixed bin (35) aligned, 2 stat bit (36) aligned; dcl temp_label label variable; /* for the fancy footwork needed to get a */ dcl based_ptr ptr based; /* referencing_dir pointer for the search rules */ dcl ref_ptr ptr; dcl 1 driver_message aligned like new_driver_msg; /* allocate space for mseg message structure */ %page; /* ----------EXTERNAL STATIC ---------- */ dcl iodd_stat_p ptr ext static; /* external copy of stat_p */ dcl error_table_$ionmat fixed bin (35) ext static; dcl error_table_$not_detached fixed bin (35) ext static; dcl error_table_$not_closed fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$ai_restricted fixed bin (35) ext static; dcl error_table_$user_not_found fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$badopt fixed bin (35) ext static; dcl error_table_$no_ext_sym fixed bin (35) ext static; dcl error_table_$no_operation fixed bin (35) ext static; dcl error_table_$namedup fixed bin (35) ext static; /* ----------- INTERNAL STATIC -------- */ dcl io_daemon_driver_version char (8) int static options (constant) init ("5.7"); /* current version of the driver */ dcl null_stream char (32) int static init ("iodd_null_stream") options (constant); dcl bel_string char (40) aligned int static options (constant) init ((40)""); dcl stars char (50) aligned int static options (constant) init ((5)"**********"); dcl error fixed bin int static options (constant) init (2); dcl normal fixed bin int static options (constant) init (1); dcl master fixed bin int static options (constant) init (1); dcl slave fixed bin int static options (constant) init (2); dcl both fixed bin int static options (constant) init (0); dcl id char (24) int static options (constant) init ("iodd_"); dcl STATION_PW_PROMPT char (23) static options (constant) init ("Enter station password:"); dcl try_10_times fixed bin int static options (constant) init (10); dcl try_0_times fixed bin int static options (constant) init (0); dcl 1 real_iodd_static int static aligned like iodd_static;/* allocation of iodd_static */ dcl NL char (1) int static options (constant) init (" "); dcl FF char (1) int static options (constant) init (" "); dcl 1 driver_list aligned int static, /* this is where the driver_ptr_list is allocated */ 2 dummy (32) fixed bin (71); /* be sure we reserve enough space for 30 drivers */ /* ----------- BUILTINS ------- */ dcl (addr, after, before, bit, char, fixed, hbound, index, length, ltrim, null, ptr, rtrim, size, string, substr, unspec) builtin; %page; /* ---------- STRUCTURES & MISC INCLUDE FILES ---------- */ dcl 1 request_dev aligned, /* major and minor devices to request from coord */ 2 major_name char (32), /* name of the major device */ 2 major_index fixed bin, /* device table index for it */ 2 n_minor fixed bin, /* number of minor devices requested */ 2 minor (30) aligned, /* save room for 30 minor devices */ 3 name char (32) unal, /* minor device name...unal for the compiler */ 3 index fixed bin, /* device table index for it */ 3 dev_class char (32), /* expected dvc to be used */ 3 dvc_index fixed bin; /* device class table index for the dvc */ dcl 1 event_info aligned, /* ipc_ info from a wakeup */ 2 channel fixed bin (71), /* event channel signaled */ 2 message fixed bin (71), /* event message sent to us */ 2 sender bit (36), /* sender's process id */ 2 origin, 3 dev_signal bit (18) unal, /* was this a process or device? */ 3 rings bit (18) unal, /* what ring sent it? */ 2 wait_list_index fixed bin; /* where was the channel in the wait list */ dcl 1 ev_chan_list aligned, /* wait list for ipc_$block */ 2 number fixed bin, 2 channel (32) fixed bin (71); dcl 1 read_info aligned, /* structure to be filled in by read_status order */ 2 ev_chan fixed bin (71), /* event_channel the stream blocks on */ 2 input_pending bit (1); /* 1 if the stream is waiting for us to read */ dcl 1 input aligned, /* structure to hold arguments input by the operator */ 2 max fixed bin, /* rqt_info_segs"; /* this is where we find rqti segs */ meter_dir = rtrim (sys_dir) || ">meter_data"; /* this is where we find the meter data segs */ list_ptr = addr (driver_list); driver_ptr_list.number = 0; iodd_static.auto_start_delay = 60; /* ready for early quit, 60 sec for auto-start */ iodd_static.timer_chan = 0; iodd_static.cmd_ack_chan = 0; iodd_static.re_init_label = re_init_driver; iodd_static.no_coord_label = no_coord_signal; call iodd_signal_handler_$init (stat_p); /* initialize our general signal handler */ on quit call early_quit; /* setup some condition handlers */ on daemon_logout go to driver_logout_label; on daemon_slave_logout go to driver_logout_label; on daemon_new_device go to start_new_device_cleanup; /* this is how we transfer back after new_device command */ on daemon_idle begin; end; /* do nothing but grab the condition */ on any_other call iodd_signal_handler_; /* we don't want the standard default */ /* handler to come to command level */ call ios_$order ("user_i/o", "quit_enable", null (), io_stat); /* be sure quits are enabled */ code = get_at_entry_ ("user_i/o", dim_name, dev_name, ig); /* this MUST work */ if dim_name = "mrd_" then do; /* separate the streams for message coord */ call ios_$attach ("error_i/o", "mrd_", dev_name, "", io_stat); call ios_$attach ("log_i/o", "mrd_", dev_name, "", io_stat); end; else do; /* use the same streams for consistency */ call ios_$attach ("error_i/o", "syn", "user_i/o", "", io_stat); call ios_$attach ("log_i/o", "syn", "user_i/o", "", io_stat); end; call ios_$attach ("master_output", "syn", "user_i/o", "", io_stat); call ios_$attach ("master_input", "syn", "user_i/o", "", io_stat); call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); call ios_$attach ("log_output", "syn", "log_i/o", "", io_stat); call iox_$look_iocb ("master_output", iodd_static.master_out, code); call iox_$look_iocb ("master_input", iodd_static.master_in, code); call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code); call iox_$look_iocb ("error_i/o", iodd_static.error_io, code); call iodd_msg_ (normal, master, 0, "", "^/IO Daemon Driver Version: ^a^[^/Driver running in test mode.^]^/", iodd_static.io_daemon_version, iodd_static.test_entry); temp_label = out; /* get a pointer to use with make_ptr for reference proc */ ref_ptr = addr (temp_label) -> based_ptr; %page; iodd_static.ctl_term.ctl_attach_name = ""; /* initialize ctl_term once here, then let */ iodd_static.ctl_term.ctl_attach_type = 0; /* it be handled dynamically */ iodd_static.ctl_term.ctl_dial_chan = 0; iodd_static.ctl_term.ctl_ev_chan = 0; iodd_static.ctl_term.ctl_device = ""; iodd_static.ctl_term.ctl_dev_dim = ""; iodd_static.ctl_term.attached = "0"b; new_device: /* we come here after a new_device command (from the handler) */ iodd_static.ctl_term.form_type = "undefined_form";/* use default unless operator changes */ iodd_static.ctl_term.forms = "0"b; /* don't simulate terminal FF unless asked */ iodd_static.slave.active = "0"b; /* be sure slave functions are dead */ iodd_static.slave_ev_chan = 0; iodd_static.slave_in, iodd_static.slave_out = null; iodd_static.slave_input, iodd_static.slave_output = null_stream; iodd_static.slave.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.log_msg = "0"b; /* must ask for log messages */ iodd_static.slave.echo_cmd = "0"b; /* no echoing of command lines */ iodd_static.slave.priv1 = "0"b; /* driver module defined privleges */ iodd_static.slave.priv2 = "0"b; /* " */ iodd_static.slave.priv3 = "0"b; /* " */ iodd_static.re_init_in_progress = "0"b; /* this is not a re_init */ iodd_static.wakeup_time = 30; /* default to 30 seconds between wakeups */ iodd_static.recursion_flag = "0"b; /* be sure these are off for testing */ iodd_static.no_coord_flag = "0"b; iodd_static.initialized = "0"b; iodd_static.dummy_ptr = null; /* in case it has been set */ iodd_static.attach_type = 0; iodd_static.line_tab_idx = 0; iodd_static.major_device = ""; if iodd_static.timer_chan ^= 0 then call ipc_$delete_ev_chn (iodd_static.timer_chan, code); if iodd_static.cmd_ack_chan ^= 0 then call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code); call ipc_$create_ev_chn (iodd_static.timer_chan, code); /* get an event channel for the timer */ if code ^= 0 then do; /* an error is very bad */ no_ipc: call convert_ipc_code_ (code); call iodd_msg_ (error, master, code, id, "Fatal error: Unable to create event channel."); go to out; /* not much else to do */ end; call ipc_$create_ev_chn (iodd_static.cmd_ack_chan, code); if code ^= 0 then go to no_ipc; call io_daemon_account_$set_line_prices (0, null, code); /* set up default prices */ %page; /* Get the device name and device class from the operator */ ask_for_dev: /* for variable line, try new station */ if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then go to get_tables; call iodd_msg_ (normal, master, 0, "", "Enter command or device/request_type:"); /* ask for some input */ get_dev_id: call iox_$get_line (iodd_static.master_in, addr (line), 120, nchars, code); if code ^= 0 then do; no_master: call iodd_msg_ (error, master, code, id, "Fatal_error: Unable to read from master console."); go to out; end; if nchars < 2 then go to get_dev_id; /* ignore null lines */ input.max = 4; /* most tokens allowed */ call iodd_parse_$command (substr (line, 1, nchars), addr (input), code); if code ^= 0 then if code = error_table_$noarg then go to get_dev_id; /* line was all blank */ else do; bad_line: call iodd_msg_ (normal, master, 0, "", "Invalid response. Try again."); go to ask_for_dev; end; if input.arg (1) = "quit" | input.arg (1) = "logout" then go to out; /* easy out */ if input.arg (1) = "help" then do; call iodd_msg_ (normal, master, 0, "", "Enter device name and optional request type, or any of:"); call iodd_msg_ (normal, master, 0, "", "logout, print_devices, listen , print_line_ids"); go to ask_for_dev; end; if input.arg (1) = "print_line_ids" then do; call print_line_ids ("-dir", rtrim (sys_dir)); go to ask_for_dev; end; if input.arg (1) = "print_devices" then do; /* he forgot the device names */ call print_devices ("-dir", rtrim (sys_dir), "-an", before (get_group_id_$tag_star (), ".*")); go to ask_for_dev; end; if length (input.arg (1)) > length (first_arg) then go to bad_line; first_arg = input.arg (1); /* save intact for reinit function */ first_arg = before (first_arg, "."); /* if major.minor, drop minor */ if first_arg = "" then go to bad_line; if input.number = 1 then /* assume second arg is null if not given */ if first_arg = "listen" then go to bad_line; /* requires an second arg */ else second_arg = ""; else do; if length (input.arg (2)) > length (second_arg) then go to bad_line; second_arg = input.arg (2); /* save the second_arg if not too big */ end; get_tables: /* This label is put here so a reinit will work even if the working tables have changed. Find the tables in iod_working_tables so we can validate the requested device and device class */ seg_name = "iodc_data"; /* segment name for possible error msg */ call init_seg (sys_dir, seg_name, iodc_data_ptr, try_10_times, code); /* use internal proc to initiate */ if code ^= 0 then do; fatal_init: call iodd_msg_ (error, master, code, id, "^/Fatal error: Unable to initiate ^a in ^a", seg_name, sys_dir); if iodd_static.test_entry then call early_quit; /* let the quit handler take it to */ go to out; /* normally there is nothing to do but quit */ end; seg_name = "iod_working_tables"; /* ....for error msg */ call init_seg (sys_dir, seg_name, ithp, try_10_times, code); if code ^= 0 then go to fatal_init; if iod_tables_hdr.version ^= IODT_VERSION_5 then do; call iodd_msg_ (error, master, 0, id, "Fatal error: Incorrect version of iod_working_tables."); go to out; /* this is really bad!! */ end; /* Set the pointers to each table within the iod_working_tables */ iodd_static.ithp = ithp; iodd_static.ltp, ltp = ptr (ithp, iod_tables_hdr.line_tab_offset); iodd_static.idtp, idtp = ptr (ithp, iod_tables_hdr.device_tab_offset); iodd_static.mdtp, mdtp = ptr (ithp, iod_tables_hdr.minor_device_tab_offset); iodd_static.qgtp, qgtp = ptr (ithp, iod_tables_hdr.q_group_tab_offset); iodd_static.dev_class_ptr = ptr (ithp, iod_tables_hdr.dev_class_tab_offset); iodd_static.text_strings_ptr, text_strings_ptr = ptr (ithp, iod_tables_hdr.text_strings_offset); /* see if we have to wait for a remote station to dial up */ iodd_static.attach_type = 0; /* start fresh, and avoid loop if tables change */ if first_arg = "listen" then do; /* YES, wait for a station */ /* first validate the line_id given from master console */ iodd_static.line_tab_idx = 0; do i = 1 to line_tab.n_lines while (iodd_static.line_tab_idx = 0); ltep = addr (line_tab.entries (i)); /* get entry pointer */ if lte.line_id = second_arg then iodd_static.line_tab_idx = i; end; if iodd_static.line_tab_idx = 0 then do; call iodd_msg_ (normal, master, 0, "", "No line table entry found for ^a", second_arg); go to ask_for_dev; end; call attach_and_listen (code); /* attach line, wait for dialup, and validate the station id */ if code ^= 0 then go to new_device; /* just to be sure */ request_type = "default"; /* try for default request types */ input_iocbp = iodd_static.slave_in; /* if we need to ask for a request_type */ end; else do; /* this is the normal device and request type case */ /* search for the major device in the device table */ request_dev.major_index = 0; do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0); idtep = addr (iod_device_tab.entries (i)); /* use new ptr for easy reference */ if idte.dev_id = first_arg then request_dev.major_index = i; /* record the index */ end; if request_dev.major_index = 0 then do; /* not found */ call iodd_msg_ (normal, master, 0, "", "Device ""^a"" not found in device table.", first_arg); go to ask_for_dev; /* let him try again....or quit */ end; if idte.attach_type = ATTACH_TYPE_VARIABLE_LINE then do; /* can't use Line variable type here */ call iodd_msg_ (normal, master, 0, "", "Specified device must be used with the ""listen"" command."); go to ask_for_dev; end; iodd_static.attach_type = idte.attach_type; iodd_static.attach_name = idte.attach_name; /* initialize major device info in static */ iodd_static.major_device, request_dev.major_name = first_arg; request_type = second_arg; /* keep first_arg and second_arg intact */ input_iocbp = iodd_static.master_in; /* in case we have to ask for a request type */ end; %page; /* Find each associated minor device and save the index and default device class */ request_dev.n_minor = 0; /* indicate that none have been found yet */ /* look for all posible minor devices...up to the max */ do i = idte.first_minor to idte.last_minor while (request_dev.n_minor < hbound (request_dev.minor, 1)); mdtep = addr (minor_device_tab.entries (i)); /* set pointer to table entry */ if mdte.major_index = request_dev.major_index then do; /* we found one that belongs to the major dev */ request_dev.n_minor = request_dev.n_minor + 1; /* count it */ request_dev.minor.name (request_dev.n_minor) = mdte.dev_id; /* copy the minor device name */ request_dev.minor.index (request_dev.n_minor) = i; /* save the minor index */ request_dev.minor.dvc_index (request_dev.n_minor) = mdte.default_dev_class; /* save the default device class index */ end; end; /* end of the table search */ if (request_dev.n_minor > 0) & (i <= idte.last_minor) then /* see if we omitted a minor device */ call iodd_msg_ (normal, slave, 0, "", "Restriction: only the first ^d minor devices will be used", hbound (request_dev.minor, 1)); if request_dev.n_minor = 0 then do; /* OOPS...the table is garbage */ call iodd_msg_ (error, both, 0, id, "Fatal error: Inconsistent data in minor_device_tab. Re-init the coordinator."); if iodd_static.test_entry then call early_quit; /* give programmer a look */ go to out; /* then give up */ end; /* See if we should force the operator to give a device class */ if request_type = "" then /* if no optional device class was given, check n_minor */ if request_dev.n_minor = 1 then use_default = "1"b; /* assume the default */ else use_default = "0"b; /* force response for multiple devices */ else if request_type = "default" then use_default = "1"b; /* operator overrides */ else use_default = "0"b; /* take the given class or ask if multiple */ /* Now we check out each possible device class for the requested devices */ if request_dev.n_minor > 1 | use_default then do; /* must check further for the request type(s) */ do i = 1 to request_dev.n_minor; /* for multiple minor devices we must ask for each dvc */ if ^use_default | request_dev.minor (i).dvc_index = 0 then do; /* no default? */ get_dvc: if request_dev.minor (i).dvc_index = 0 then question = "Enter request type for minor device ""^a"":"; else question = "Enter request type (or ""default"") for minor device ""^a"":"; call iodd_msg_ (normal, slave, 0, "", question, request_dev.minor.name (i)); call iox_$control (input_iocbp, "runout", null, code); /* invoke remote runout spacing */ call iox_$get_line (input_iocbp, addr (line), 120, nchars, code); if code ^= 0 then go to new_device; if nchars < 2 then go to get_dvc; /* ignore blank lines */ input.max = 4; /* most tokens allowed */ call iodd_parse_$command (substr (line, 1, nchars), addr (input), code); /* see what he said */ if code ^= 0 then do; if code = error_table_$noarg then go to get_dvc; /* try again if line was blank */ else do; bad_dvc: call iodd_msg_ (normal, slave, 0, "", "Invalid response."); call iox_$control (input_iocbp, "resetread", null, code); /* try for a clean start */ request_dev.minor (i).dvc_index = 0; /* not sure if it is the default any more */ go to get_dvc; end; end; if length (input.arg (1)) > length (request_type) then go to bad_dvc; request_type = input.arg (1); if request_type = "quit" | request_type = "new_device" | request_type = "newdevice" then go to ask_for_dev; if request_type = "default" then do; /* be sure there is a default */ if request_dev.minor (i).dvc_index = 0 then do; call iodd_msg_ (normal, slave, 0, "", "No default has been specified."); go to get_dvc; end; end; else do; /* have to search for the specified dvc */ call find_device_class (request_type, j, dev_class, queue_type, code); /* use internal proc */ if code ^= 0 then go to bad_dvc; /* let him try again...msg has been sent */ request_dev.minor (i).dvc_index = j; /* store the returned index */ end; end; /* Now check to be sure it is legal for this process. */ call validate_request (i, code); /* use the internal proc */ if code ^= 0 then go to bad_dvc; /* error has been printed already */ end; end; /* end of dvc request loop for multiple minor devices */ else do; /* we have a single device and a given request_type arg */ call find_device_class (request_type, j, dev_class, queue_type, code); if code ^= 0 then go to ask_for_dev; /* the message has already been printed */ request_dev.minor (1).dvc_index = j; /* store the dvc index returned */ call validate_request (1, code); /* check it out */ if code ^= 0 then go to ask_for_dev; /* if bad, start over */ end; /* WHEW...Now request_dev contains all the information needed to communicate to the coordinator */ %page; re_init_junction: /* This is the point of entry for re-initialization of the driver after a "no-coord" or "re_init" signal. We can proceed on the assumption that the same major and minor devices and device classes will be used. */ iodd_static.major_device = request_dev.major_name;/* this gets cleared by kill_device, so reset in case */ iodd_static.admin_ec_name = rtrim (request_dev.major_name) || "_admin.ec"; /* define x cmd ec name */ iodd_static.coord_proc_id = iodc_data.proc_id; /* save coordinators process id */ iodd_static.driver_proc_id = get_process_id_ (); /* and the drivers */ iodd_static.no_coord_flag = "1"b; /* accept a no_coord signal now */ iodd_static.recursion_flag = "0"b; /* be sure this is reset for reinit */ iodd_static.request_in_progress = "0"b; iodd_static.initialized = "0"b; iodd_static.master_hold = "0"b; iodd_static.slave_hold = "0"b; iodd_static.step = "0"b; iodd_static.quit_during_request = "0"b; iodd_static.logout_pending = "0"b; iodd_static.runout_requests = "0"b; iodd_static.quit_signaled = "0"b; iodd_static.auto_logout_interval = 0; /* default to no auto logout, must be set by command */ iodd_static.assigned_devices = 0; /* no devices at this point */ iodd_static.current_devices = 0; iodd_static.output_device = "Undefined"; iodd_static.auto_start_delay = 60; /* wait 60 seconds after quit before auto-start */ if iodd_static.attach_type ^= ATTACH_TYPE_VARIABLE_LINE then do; /* assume attachment good for variable line */ iodd_static.slave_in, iodd_static.slave_out = null; /* for now */ iodd_static.slave.active = "0"b; /* slave must be re-defined */ iodd_static.slave_ev_chan = 0; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave_output = null_stream; /* we are done with this now */ iodd_static.slave_input = null_stream; end; iodd_static.slave.log_msg = "0"b; /* must ask for log messages */ iodd_static.slave.echo_cmd = "0"b; /* don't echo cmds by default */ iodd_static.slave.allow_quits = "0"b; iodd_static.dev_io_stream = null_stream; iodd_static.dev_in_stream = null_stream; iodd_static.dev_out_stream = null_stream; iodd_static.driver_ptr = null (); iodd_static.driver_list_ptr, /* be ready to publish the list */ list_ptr = addr (driver_list); iodd_static.chan_list_ptr = addr (ev_chan_list); /* wait list for ipc_$block */ iodd_static.segptr = null; /* signal_handler cannot rely on segptr */ call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* reset error_output */ call ios_$detach ("broadcast_errors", "", "", io_stat); /* avoid multiple attachments for sure */ call ios_$attach ("broadcast_errors", "broadcast_", "error_i/o", "", io_stat); /* put back error stream */ iodd_static.master_output = "master_output"; /* incase they got clobbered */ iodd_static.master_input = "master_input"; /* save the default stream names */ iodd_static.log_stream = "log_output"; call iox_$look_iocb ("master_output", iodd_static.master_out, code); /* reset the important iocb ptrs */ call iox_$look_iocb ("master_input", iodd_static.master_in, code); call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code); call iox_$look_iocb ("error_i/o", iodd_static.error_io, code); /* check to see if the table has changed on us since we last looked */ on seg_fault_error begin; ithp = null; /* indicate that we need to initiate */ go to get_tables; /* and go back and get new indices */ end; table_time = iod_tables_hdr.date_time_compiled; /* reference through ptr to verify it */ revert seg_fault_error; /* don't special case the condition any longer */ /* With all the static data initialized, get ready to request the devices */ rqt_string = ""; /* build this as devices are initialized */ driver_dir = rtrim (sys_dir) || ">" || request_dev.major_name; init_ev_chan = iodc_data.init_event_channel; /* copy the coord's ipc chan */ ev_chan_list.number = 2; /* initially 2 channels in the wait list */ ev_chan_list.channel (1) = 0; /* this one is empty for now */ ev_chan_list.channel (2) = iodd_static.timer_chan;/* timer is second priority */ driver_ptr_list.number = 0; /* assume that no driver status segs exist */ new_driver_msg_p = addr (driver_message); /* this is where we build the request */ driver_message.lock_id = "0"b; /* this will ensure that set_lock works */ call set_lock_$lock (driver_message.lock_id, 0, code); /* store process lock id */ %page; /* At this point we will loop through the requested minor devices, asking the IO coordinator to establish this process as the driver. There is a lot of work to do for the initialization of each driver, so, the main loop will take a few pages of listing */ if iodd_static.test_entry then call iodd_msg_ (normal, master, 0, "", "Requesting devices from coordinator."); do i = 1 to request_dev.n_minor; /* once around for each minor dev */ call ipc_$create_ev_chn (driver_message.wakeup_chan, code); /* get a channel for the coord to use */ if code ^= 0 then do; call convert_ipc_code_ (code); call iodd_msg_ (error, both, code, id, "Fatal error: Unable to create minor device event channel."); call kill_device; /* drop any device assigned */ go to out; /* thats all she wrote! */ end; ev_chan_list.channel (1) = driver_message.wakeup_chan; /* get ready to block for coord */ driver_message.device_index = request_dev.minor (i).index; /* fill in the rest of the request */ driver_message.dev_class_index = request_dev.minor (i).dvc_index; call message_segment_$add_file (sys_dir, "coord_comm.ms", new_driver_msg_p, size (new_driver_msg) * 36, message_id, code); /* send off the request */ if code ^= 0 then do; call iodd_msg_ (error, both, code, id, "Fatal error: Unable to send new driver request to coord_comm.ms in ^a", sys_dir); call kill_device; /* drop any we have */ if iodd_static.test_entry then call early_quit; /* give programmer a look */ go to out; /* then bug out */ end; unspec (event_message) = message_id; /* give coord the message id in an event message */ call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code); if code ^= 0 then signal no_coord; /* on error assume the coord is gone */ /* now block until the coordinator gives us the device (up to 5 min max) */ call ipc_$drain_chn (iodd_static.timer_chan, code); /* clear the timer...in case */ call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan); /* start the clock */ call ipc_$block (addr (ev_chan_list), addr (event_info), code); /* and wait */ call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan); /* reset the clock */ if code ^= 0 then do; /* bad news, and dumb code */ call convert_ipc_code_ (code); call iodd_msg_ (error, both, code, id, "Fatal error: from ipc_$block ."); call kill_device; /* flush any previous devices */ if iodd_static.test_entry then call early_quit; /* take a peek, */ go to out; /* then forget it */ end; /* It was a legal wakeup, who sent it? */ if event_info.wait_list_index = 2 then do; /* bad news if it was the timer */ call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to new driver wakeup."); signal no_coord; /* don't bother to flush devices */ end; code = addr (event_info.message) -> ev_msg.code; /* see what the coord said */ if code ^= 0 then do; if request_dev.n_minor = 1 then dev_label = request_dev.major_name; else dev_label = rtrim (request_dev.major_name) || "." || request_dev.minor (i).name; if code = 6 then do; /* already assigned */ call iodd_msg_ (normal, both, 0, id, "Device ^a assigned to another process", dev_label); go to ask_for_dev; /* don't bother to flush */ end; else if code = 7 then do; /* already assigned to us, huh? */ call iodd_msg_ (normal, both, 0, id, "Device ^a already assigned to this process.", dev_label); end; /* tell the operator, but, keep on truckin' */ else do; /* otherwise it is very bad */ call iodd_msg_ (error, both, 0, id, "Coordinator could not initialize ^a driver. Code = ^d", dev_label, code); call kill_device; /* we may have had some devices assigned */ go to ask_for_dev; /* start all over again */ end; end; /* when we pass here, we are almost home free */ %page; /* The coord gave the OK....so find the driver status segment */ call hcs_$initiate (driver_dir, request_dev.minor (i).name, "", 0, 1, driver_status_ptr, code); if driver_status_ptr = null then do; call iodd_msg_ (error, both, code, id, "Unable to initiate driver status segment: ^a in ^a", request_dev.minor (i).name, driver_dir); call kill_device; /* drop it */ go to ask_for_dev; /* and start all over...UGH! */ end; driver_ptr_list.number = driver_ptr_list.number + 1; /* add one to the list */ driver_ptr_list.stat_segp (driver_ptr_list.number) = driver_status_ptr; /* save the driver ptr */ driver_status.driver_chan = ev_chan_list.channel (1); /* and the event channel */ driver_status.last_wake_time = 0; /* havn't asked for work yet */ driver_status.list_index = driver_ptr_list.number; /* for the future */ string (driver_status.status_flags) = "0"b; /* clear the flags */ driver_status.dev_ctl_ptr = null; /* don't leave uninitialized pointers around */ /* Now find the accounting procedure we will use for this driver */ /* It can be different for each minor device driver */ dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index)); qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index)); driver_status.generic_type = qgte.generic_type; /* record generic type for minor dev */ if return_string (qgte.accounting) = "nothing" then /* no accounting routine */ driver_status.have_accounting = "0"b; /* so indicate that */ else do; /* otherwise it is more trouble */ driver_status.have_accounting = "1"b; /* so indicate that */ if return_string (qgte.accounting) = "system" then /* use our special procedure */ driver_status.acct_entry = charge_user_; else do; temp_dir_entry = return_string (qgte.accounting); driver_status.acct_entry = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then do; if return_string (qgte.accounting) = "system" then call iodd_msg_ (error, both, code, id, "Unable to get pointer to system accounting procedure: ^a", temp_dir_entry); else call iodd_msg_ (error, both, code, id, "Unable to get pointer to accounting procedure: ^a.", temp_dir_entry); call kill_device; go to ask_for_dev; /* again */ end; end; end; /* set up the line_charge prices for this logical driver */ call io_daemon_account_$set_line_prices (driver_ptr_list.number, qgtep, code); if code ^= 0 then do; /* OOPS */ call iodd_msg_ (error, both, code, id, "Unable to set line charge prices for request type ^a.", driver_status.req_type_label); call kill_device; go to ask_for_dev; end; %page; /* now see if there is a request type info seg specified for the driver */ entry_name = qgte.rqti_seg_name; /* get the entry name from the iod_tables */ if entry_name ^= "" then do; /* must find the rqti seg */ call init_seg (rqti_dir, entry_name, driver_status.rqti_ptr, try_0_times, code); /* don't wait */ if driver_status.rqti_ptr = null then do; call iodd_msg_ (error, both, code, id, "Unable to find RQTI segment ^a.", entry_name); call kill_device; go to ask_for_dev; end; end; else driver_status.rqti_ptr = null; /* be sure of no mistake */ rqt_name = before (rtrim (driver_status.req_type_label), "."); /* get the real request type name */ if index (rqt_string, rtrim (rqt_name)) = 0 then /* look for duplicates */ rqt_string = rqt_string || " " || rtrim (rqt_name); /* add to the string */ /* associate minor device with rqt name for x command */ call set_iod_val (rtrim (driver_status.device_id), rtrim (rqt_name)); /* Go back and look for the next minor device driver to be assigned */ end; /* That's all for the big loop */ /* Time for final initialization */ idtep = addr (iod_device_tab.entries (request_dev.major_index)); /* locate major device data */ iodd_static.major_args = idte.args; /* if user says single sheet then set it, else force to continuous forms */ if idte.paper_type = PAPER_TYPE_SINGLE then iodd_static.paper_type = idte.paper_type; else iodd_static.paper_type = PAPER_TYPE_CONTINUOUS; iodd_static.assigned_devices = driver_ptr_list.number; /* start with the first in the list */ iodd_static.driver_ptr, driver_status_ptr = driver_ptr_list.stat_segp (1); iodd_static.output_device = iodd_static.driver_ptr -> driver_status.device_id; /* call the coord again and ask for the special command IPC channel (for drivers only) */ event_message = 0; /* clear the event message of trash */ msgp = addr (event_message); /* setup event message */ msgp -> ev_msg.code = 5; /* code 5: requesting cmd channel */ msgp -> ev_msg.minor_dev_index = /* name a minor device so coord can release */ driver_ptr_list.stat_segp (1) -> driver_status.dev_index; init_ev_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan; /* get request chan */ call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code); if code ^= 0 then signal no_coord; /* on error assume the coord is gone */ call ipc_$drain_chn (iodd_static.timer_chan, code); /* clear the timer...in case */ call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan); /* start the clock */ ev_chan_list.channel (1) = driver_ptr_list.stat_segp (1) -> driver_status.driver_chan; call ipc_$block (addr (ev_chan_list), addr (event_info), code); /* and wait */ call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan); /* reset the clock */ if code ^= 0 then do; /* bad news, and dumb code */ call convert_ipc_code_ (code); call iodd_msg_ (error, both, code, id, "Fatal error: from ipc_$block ."); call kill_device; /* flush any previous devices */ if iodd_static.test_entry then call early_quit; /* take a peek, */ go to out; /* then forget it */ end; if event_info.wait_list_index = 2 then do; /* bad news if it was the timer */ call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to standard wakeup."); signal no_coord; /* don't bother to flush devices */ end; iodd_static.coord_cmd_chan = event_info.message; /* save the returned ev chan */ /* Set the entry variables for calling the driver module */ temp_dir = return_string (idte.driver_module); temp_dir_entry = temp_dir || "$init"; iodd_static.driver_init = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then do; bad_entry: call iodd_msg_ (error, both, code, id, "Unable to find driver module ""^a"".", temp_dir_entry); call kill_device; go to ask_for_dev; end; temp_dir_entry = temp_dir || "$request"; iodd_static.driver_request = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_entry; temp_dir_entry = temp_dir || "$command"; iodd_static.driver_command = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_entry; temp_dir_entry = temp_dir || "$default_handler"; iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then do; if code ^= error_table_$no_ext_sym then go to bad_entry; /* we can handle one error only */ else do; temp_dir_entry = "iodd_$iodd_"; iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_entry; /* perish the thought! */ end; end; /* set the entry variables for the head_sheet entries. If not supplied in iod_tables, use default of head_sheet_ */ temp_dir = return_string (idte.head_sheet); if temp_dir = "" then do; iodd_static.print_head_sheet = head_sheet_$print_head_sheet; iodd_static.print_head_separator = head_sheet_$print_separator; end; else do; temp_dir_entry = temp_dir || "$print_head_sheet"; iodd_static.print_head_sheet = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then do; bad_banner_entry: call iodd_msg_ (error, both, code, id, "Unable to find banner page module ""^a"".", temp_dir_entry); call kill_device; go to ask_for_dev; end; temp_dir_entry = temp_dir || "$print_separator"; iodd_static.print_head_separator = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_banner_entry; end; if iodd_static.test_entry then do; /* ... and that head sheet printer can find printer_notice */ if temp_dir = "" then call head_sheet_$test (sys_dir); else do; temp_dir_entry = temp_dir || "$test"; entry_variable = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_banner_entry; call entry_variable (sys_dir); end; end; /* set the entry variables for the tail_sheet entries */ temp_dir = return_string (idte.tail_sheet); if temp_dir = "" then iodd_static.print_tail_sheet = tail_sheet_$print_tail_sheet; else do; temp_dir_entry = temp_dir || "$print_tail_sheet"; iodd_static.print_tail_sheet = cv_entry_ (temp_dir_entry, null (), code); if code ^= 0 then go to bad_banner_entry; end; /* Set up the wait list for blocking, except for the ctl_term entry */ call iox_$control (iodd_static.master_in, "read_status", addr (read_info), code); if code ^= 0 then do; call iodd_msg_ (error, both, code, id, "Attempting read_status control on master_input."); call kill_device; go to out; end; ev_chan_list.channel (1) = read_info.ev_chan; /* save the master console event channel in first position */ do i = 1 to driver_ptr_list.number; ev_chan_list.channel (i + 2) = driver_ptr_list.stat_segp (i) -> driver_status.driver_chan; end; /* leave the timer chan in position 2 for now */ ev_chan_list.number = driver_ptr_list.number + 2; if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then /* for line variable, device is the slave */ ev_chan_list.channel (2) = iodd_static.slave_ev_chan; /* the slave is defined as station device */ /* Check on the control terminal. If we have one, its ev_chan will go into position 2 after attachment */ /* unless this is a line variable type device. Then allow ctl term, but not as the slave. */ if iodd_static.ctl_term.attached then do; /* check to see if it is still dialed */ call check_for_dialup (code); if code = 0 then go to set_ctl_streams; /* if still there, finish attachments */ if code = 5 then do; /* this signals we are changing ctl terminals */ line = NL || "hangup terminal" || NL; call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat); call ios_$order (iodd_static.ctl_io, "runout", null, io_stat); call ipc_$decl_ev_wait_chn (iodd_static.ctl_dial_chan, code); /* ready for dial_manager_ */ release_arg.version = dial_manager_arg_version_2; release_arg.channel_name = iodd_static.ctl_device; release_arg.dial_channel = iodd_static.ctl_dial_chan; release_arg.dial_qualifier = ""; call dial_manager_$release_channel (addr (release_arg), code); if code ^= 0 then call ios_$order ((iodd_static.ctl_io), "hangup", null, io_stat); /* do what we can to drop it */ call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code); /* no longer needed */ end; call ios_$detach (iodd_static.ctl_io, "", "", io_stat); /* drop the dead terminal */ call ios_$detach (iodd_static.ctl_input, "", "", io_stat); call ios_$detach (iodd_static.ctl_output, "", "", io_stat); iodd_static.ctl_term.attached = "0"b; /* all clear now */ end; iodd_static.ctl_term.ctl_attach_name = idte.ctl_attach_name; iodd_static.ctl_term.ctl_attach_type = idte.ctl_attach_type; if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY | iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_DIAL then do; call wait_for_dial (code); /* must ask answering service for terminal line or for dial */ if code ^= 0 then do; if code > 10 then call iodd_msg_ (normal, master, code, id, "Unable to get dialed terminal."); else call iodd_msg_ (normal, master, 0, id, "Unable to get dialed terminal. code = ^d", code); call kill_device; go to ask_for_dev; end; end; else if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_MC then do; /* we want the message coordinator */ iodd_static.ctl_dev_dim = "mrd_"; iodd_static.ctl_device = idte.ctl_attach_name; /* attach name was the device */ end; else do; /* otherwise, no ctl_term is required */ iodd_static.ctl_input = null_stream; /* be sure all variables are cleared */ iodd_static.ctl_output = null_stream; iodd_static.ctl_io = null_stream; iodd_static.ctl_dev_dim = "Undefined"; iodd_static.ctl_dial_chan = 0; iodd_static.ctl_ev_chan = 0; /* this means the timer chan will be a dummy */ /* in the event wait list...it avoids errors */ go to call_driver; /* ready to pass this process along */ end; call ios_$attach ("ctl_i/o", iodd_static.ctl_dev_dim, iodd_static.ctl_device, "", io_stat); if st.code ^= 0 then do; /* couldn't attach? */ if st.code = error_table_$ionmat then go to set_ctl_streams; /* already attached, ??? */ call iodd_msg_ (normal, master, st.code, id, "Attaching ""ctl_i/o"" to ""^a"" with interface module ""^a"".", iodd_static.ctl_device, iodd_static.ctl_dev_dim); call kill_device; go to ask_for_dev; /* might be better to ask operator what to do */ end; set_ctl_streams: /* set the input, output, and error streams */ iodd_static.ctl_term.attached = "1"b; /* this must be true in all cases */ iodd_static.ctl_io = "ctl_i/o"; iodd_static.ctl_input = "ctl_input"; iodd_static.ctl_output = "ctl_output"; if iodd_static.ctl_term.forms then dim_name = "form_"; /* use the paging dim for simulating forms */ else dim_name = "syn"; call ios_$attach ("ctl_input", dim_name, iodd_static.ctl_io, "", io_stat); if st.code ^= 0 then if st.code ^= error_table_$ionmat then do; /* let it ride if attached */ syn_err: call iodd_msg_ (normal, master, st.code, id, "Error attaching control terminal streams. Dim: ^a", dim_name); go to start_new_device_cleanup; end; call ios_$attach ("ctl_output", dim_name, iodd_static.ctl_io, "", io_stat); if st.code ^= 0 then if st.code ^= error_table_$ionmat then go to syn_err; /* Put the control terminal event channel in the wait list */ call ios_$order (iodd_static.ctl_io, "read_status", addr (read_info), io_stat); if st.code ^= 0 then do; /* did someone lie? this should always work */ call iodd_msg_ (normal, master, st.code, id, """read_status"" on stream ""^a"".", iodd_static.ctl_io); go to start_new_device_cleanup; end; iodd_static.ctl_ev_chan = read_info.ev_chan; /* save here for other uses */ if ^iodd_static.slave.active then do; /* if active, it was a line variable type */ /* so don't make the control terminal the salve */ ev_chan_list.channel (2) = read_info.ev_chan;/* slave term is lower priority than master */ iodd_static.slave_ev_chan = read_info.ev_chan; /* Set the ctl_term as the slave device. */ iodd_static.slave_input = iodd_static.ctl_input; iodd_static.slave_output = iodd_static.ctl_output; iodd_static.slave.active = "1"b; call iox_$look_iocb ((iodd_static.slave_output), iodd_static.slave_out, code); if code ^= 0 then do; slave_init_err: call iodd_msg_ (normal, master, code, id, "Unable to find slave iocbp."); go to start_new_device_cleanup; end; call iox_$look_iocb ((iodd_static.slave_input), iodd_static.slave_in, code); if code ^= 0 then go to slave_init_err; call ios_$order (iodd_static.ctl_io, "start", null (), io_stat); end; %page; call_driver: /* call the init entry of the driver module */ call set_iod_val ("device", rtrim (request_dev.major_name)); /* set values for iod_val active function */ call set_iod_val ("station_id", rtrim (request_dev.major_name)); call set_iod_val ("channel", rtrim (iodd_static.attach_name)); if iodd_static.assigned_devices > 1 then request_type = ""; /* define request type if only one */ else request_type = before (iodd_static.driver_ptr -> driver_status.req_type_label, "."); call set_iod_val ("request_type", rtrim (request_type)); call set_iod_val ("rqt_string", (rqt_string)); /* define all the request types for iod_admin.ec */ if ^iodd_static.slave.active then do; /* set slave control modes if ctl term active */ iodd_static.slave.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; end; else do; dim_name = "broadcast_"; call ios_$attach ("broadcast_errors", dim_name, iodd_static.slave_output, "", io_stat); if st.code ^= 0 then call iodd_msg_ (normal, both, st.code, id, "Unable to attach broadcast_errors to slave."); else do; call ios_$attach ("error_output", "syn", "broadcast_errors", "", io_stat); if st.code ^= 0 then call iodd_msg_ (normal, both, st.code, id, "Unable to attach error_output stream to broadcast_errors."); end; iodd_static.slave.allow_quits = "1"b; iodd_static.slave.accept_input = "1"b; iodd_static.slave.print_errors = "1"b; if iodd_static.slave_output ^= iodd_static.ctl_output then iodd_static.slave.log_msg = "1"b; /* send log msgs to slave if not the ctl terminal */ end; if iodd_static.test_entry then /* see if we are testing in one process */ if iodd_static.coord_proc_id = iodd_static.driver_proc_id then /* make them different for locking */ iodd_static.driver_proc_id = bit (fixed (iodd_static.driver_proc_id, 35) + 100, 36); call iodd_command_processor_$init (stat_p); /* be sure these related procs are initialized */ call iodd_quit_handler_$init (stat_p); call write_control_form_$init (stat_p); iodd_static.initialized = "1"b; /* tell the signal handler we are initialized */ call iodd_static.driver_init (stat_p); /* take it away */ /* if we return, the driver was not able to initialize. so try again */ call iodd_msg_ (error, both, 0, id, "Unable to initialize driver.^/"); go to start_new_device_cleanup; /* let the handler do the work */ %page; out: if iodd_static.test_entry then do; /* make a clean return if testing */ if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then call hangup_station; call ipc_$delete_ev_chn (iodd_static.timer_chan, code); call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code); call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code); call ipc_$delete_ev_chn (iodd_static.dial_ev_chan, code); call ios_$attach ("error_output", "syn", "user_i/o", "", io_stat); /* put it back where we found it */ call ios_$detach ("broadcast_errors", "", "", io_stat); call ios_$order ("user_i/o", "start", null (), io_stat); /* in case tty dim bug gives trouble */ return; /* thereby going away */ end; else call logout; /* in normal mode must log out explicitly */ start_new_device_cleanup: /* the transfer to here will invoke all cleanup handlers */ call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* put it back in case it was changed */ if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then call hangup_station; call kill_device; /* inform the coordinator that current device is gone */ go to new_device; /* now go back and start over */ driver_logout_label: if iodd_static.ctl_term.attached then do; /* we may have a new ctl_term */ call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code); /* tell initializer */ line = NL || "hangup terminal" || NL; call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat); call ios_$order (iodd_static.ctl_io, "runout", null, io_stat); call ios_$order (iodd_static.ctl_io, "hangup", null, io_stat); /* now free the tty chan */ call ios_$detach (iodd_static.ctl_io, "", "", io_stat); end; call kill_device; /* tell the coord if we can */ call hangup_station; /* this will tell iox_ we don't have the terminal */ go to out; /* this will correct for test mode */ re_init_driver: /* this will invoke all cleanup handlers */ call kill_device; if iodd_static.re_init_in_progress then /* Only way to get here with this set... */ if iodd_static.logout_on_hangup then do; /* is in case of a hangup */ call iodd_msg_ (error, both, 0, id, "Driver logging out. (hangup_on_logout in effect.)"); goto out; end; iodd_static.recursion_flag = "0"b; /* clear incase of signal during attachment */ iodd_static.re_init_in_progress = "0"b; /* anyone who cares already knows */ if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then do; /* re-validate the station if line variable type */ if ^iodd_static.initialized then call hangup_station; /* in case remote_driver_ couldn't hangup */ iodd_static.initialized = "0"b; iodd_static.no_coord_flag = "0"b; call timer_manager_$sleep (10, RELATIVE_SECONDS); /* let answering service clean up */ go to get_tables; end; iodd_static.initialized = "0"b; if iodd_static.attach_type ^= ATTACH_TYPE_IOM then call timer_manager_$sleep (10, RELATIVE_SECONDS); /* let answering service clean up */ if iodd_static.no_coord_flag then go to re_init_junction; go to new_device; no_coord_signal: /* this will invoke all cleanup handlers then wait for a new coordinator */ call kill_device; /* this is to terminate the segs */ iodd_static.recursion_flag = "0"b; iodd_static.initialized = "0"b; iodd_static.re_init_in_progress = "0"b; /* all who care have seen this */ call iodd_msg_ (error, master, 0, id, "Driver will await new coordinator."); times = 0; check_proc_id: if iodc_data.proc_id ^= (36)"0"b then if iodc_data.proc_id ^= iodd_static.coord_proc_id then /* see if there is a new process id */ if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then go to get_tables; else go to re_init_junction; /* not changed yet, wait 30 seconds and try again */ times = times + 1; /* record the number of times we sleep */ if times > 10 then do; /* only wait 5 minutes */ call iodd_msg_ (error, master, 0, id, "^a^/Waited too long for coordinator. Process logging out.^/^a^a", stars, stars, bel_string); go to driver_logout_label; /* nothing else left to do */ end; call timer_manager_$sleep (30, RELATIVE_SECONDS); /* sleep for 30 seconds, then... */ go to check_proc_id; /* try again */ %page; /* ---------INTERNAL PROCEDURES ------------ */ early_quit: proc; /* If we get a quit before regular handler is set up */ dcl cmd char (80); dcl line char (32); dcl nc fixed bin (21); dcl stat bit (72) aligned; dcl give_start bit (1); give_start = "1"b; /* give an auto start unless something happens */ call ioa_$ioa_stream ("user_i/o", "^/Early ""quit""^/"); call timer_manager_$alarm_call (iodd_static.auto_start_delay, RELATIVE_SECONDS, try_auto_start); on alrm call continue_to_signal_ (code); /* let this go through */ on any_other begin; give_start = "0"b; /* stop the auto start proc */ call timer_manager_$reset_alarm_call (try_auto_start); /* in case this frame goes away */ call continue_to_signal_ (code); end; get_line: call ioa_$ioa_stream ("user_i/o", "Enter command(early quit):"); call iox_$get_line (iodd_static.master_in, addr (cmd), 80, nc, code); /* get a command line */ if give_start then do; /* expecting to give an auto start? */ give_start = "0"b; /* we got something, so cancel the auto_start */ call timer_manager_$reset_alarm_call (try_auto_start); /* don't use a bad frame */ end; if code ^= 0 then go to no_master; line = substr (cmd, 1, nc - 1); if line = "" then go to get_line; /* be nice about blank lines */ if line = "start" then do; auto_start: call ios_$order ("user_i/o", "start", null, stat); /* be sure we don't lose a wakeup */ return; end; else if line = "new_device" then do; go to start_new_device_cleanup; end; else if line = "logout" then do; go to driver_logout_label; /* assume he really means it */ end; else if line = "return" then do; /* return to the caller of iodd_$iodd_init */ if iodd_static.test_entry then go to out; end; else if line = "debug" then do; if iodd_static.test_entry then do; call ioa_$ioa_stream ("user_i/o", "Calling debug"); /* let him know what we are doing */ call debug; go to get_line; end; end; else if line = "probe" | line = "pb" then do; if iodd_static.test_entry then do; call ioa_$ioa_stream ("user_i/o", "Calling probe"); /* let him know what we are doing */ call probe; go to get_line; end; end; else if line = "pi" then do; if iodd_static.test_entry then do; signal program_interrupt; go to get_line; /* in case it returns */ end; end; else if line = "." | line = "hold" then go to get_line; /* we just cancelled the auto start */ else if line = "help" then do; /* tell what commands can be used */ call ioa_$ioa_stream ("user_i/o", "Commands at this level are: hold, start, new_device, logout"); if iodd_static.test_entry then call ioa_$ioa_stream ("user_i/o", "Test commands: debug, probe, return, pi"); go to get_line; end; call ioa_$ioa_stream ("user_i/o", "Invalid response: ""^a"" Type ""help"" for instructions.", line); go to get_line; try_auto_start: proc; if give_start then do; call ioa_$ioa_stream ("user_i/o", "Automatic start given."); go to auto_start; end; return; /* otherwise forget it */ end; end early_quit; %page; init_seg: proc (dir_name, seg_name, segp, num_times, ec); /* Little procedure to initiate segments */ dcl seg_name char (*); dcl segp ptr; dcl dir_name char (*); dcl num_times fixed bin; /* number of times we should try to initiate */ dcl ec fixed bin (35); dcl times fixed bin; times = 0; /* haven't tried at all yet */ try_again: /* be sure to set reference name */ call hcs_$initiate (dir_name, seg_name, seg_name, 0, 1, segp, ec); if segp = null () then if ec = error_table_$namedup then do; call hcs_$terminate_name (seg_name, ec); if ec = 0 then go to try_again; return; /* all attempts have failed */ end; else if ec = error_table_$noentry then do; /* wait a bit and try again (coordinator may create seg. when it comes up) */ times = times + 1; /* count the number of times we try */ if times > num_times then return; /* after num_times give up */ call timer_manager_$sleep (30, RELATIVE_SECONDS); go to try_again; end; else return; /* unrecoverable error */ ec = 0; return; end init_seg; %page; attach_and_listen: proc (code); dcl station_id char (32); dcl code fixed bin (35); dcl att_desc char (256); dcl tries fixed bin; dcl station_password char (8); dcl cmd_msg char (32); dcl err_msg char (80); dcl len fixed bin (21); dcl 1 hangup_info aligned, /* structure for the "hangup_proc" control order */ 2 entry entry, /* entry to be called */ 2 data_ptr ptr, /* pointer to be passed to entry */ 2 priority fixed bin; /* ipc_ call chan priority */ code = 0; tries = 0; /* count the attach attempts, allow up to five */ /* make attach description */ call ioa_$rsnnl ("remote_teleprinter_ " || return_string (lte.att_desc), att_desc, len, lte.chan_id); attach_chan: tries = tries + 1; /* increment the attempt count */ if tries > 5 then do; /* over 5, give up */ code = error_table_$no_operation; /* be sure we abort this device */ call iodd_msg_ (error, master, 0, id, "All attach attempts failed."); /* sound beeper */ return; end; call iodd_msg_ (normal, master, 0, "", "Attaching line ""^a"" on channel (^a).", lte.line_id, lte.chan_id); call timer_manager_$sleep (5, RELATIVE_SECONDS); /* pause to allow answering service to catch up */ iodd_static.major_device = ""; /* no station defined at this point */ iodd_static.attach_type = 0; /* nothing really attached yet either */ iodd_static.attach_name = ""; request_dev.major_index = 0; request_dev.major_name = ""; call iox_$attach_name ("teleprinter", iodd_static.slave_in, att_desc, null, code); if code ^= 0 then if ^(code = error_table_$ionmat | code = error_table_$not_detached) then do; /* very bad */ call iodd_msg_ (normal, master, code, id, "Unable to attach line."); call hangup_station; /* just to be sure */ go to attach_chan; /* now try again */ end; call iox_$open (iodd_static.slave_in, Stream_input_output, ""b, code); if code ^= 0 then if code ^= error_table_$not_closed then do; call iodd_msg_ (normal, master, code, id, "Unable to open line io switch."); call hangup_station; /* just to be sure */ go to attach_chan; /* now try again */ end; iodd_static.slave.active = "1"b; /* got a live one */ iodd_static.slave.accept_input = "1"b; iodd_static.slave.print_errors = "1"b; iodd_static.slave_out = iodd_static.slave_in; /* they are both the same */ iodd_static.slave_input, iodd_static.slave_output = "teleprinter"; iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE; /* tell all what we did */ iodd_static.attach_name = lte.chan_id; call iox_$control (iodd_static.slave_in, "read_status", addr (read_info), code); if code ^= 0 then do; call iodd_msg_ (normal, master, code, id, "Attempting read_status control operation."); call hangup_station; go to attach_chan; /* now try again */ end; iodd_static.slave_ev_chan = read_info.ev_chan; /* save this for later */ hangup_info.entry = iodd_hangup_$iodd_hangup_; /* in case answering service detects a hangup */ hangup_info.data_ptr = stat_p; hangup_info.priority = 1; call iox_$control (iodd_static.slave_in, "hangup_proc", addr (hangup_info), code); if code ^= 0 then call iodd_msg_ (normal, master, code, id, "Warning: Could not establish handler for hangups from the device."); call iodd_msg_ (normal, master, 0, "", "Requesting station identifier on line ""^a"".", lte.line_id); call iox_$put_chars (iodd_static.slave_out, addr (FF), 1, code); /* start a new page */ if code ^= 0 then go to drop_station; tries = 0; /* attempt counter is now used for station IDs */ cmd_msg = "Enter station command:" || NL; go to ask_for_station; clear_input_buffer: /* flush all input buffers */ call iox_$control (iodd_static.slave_in, "resetread", null, code); ask_for_station: tries = tries + 1; /* increment the count of station ids requested */ if tries > 10 then go to drop_station; /* over the limit, hangup the intruder */ call iox_$put_chars (iodd_static.slave_out, addr (cmd_msg), length (rtrim (cmd_msg)), code); if code ^= 0 then do; drop_station: call hangup_station; call iodd_msg_ (normal, master, code, id, "Trouble initializing station. Will re-attach line."); tries = 0; /* reset the attach counter for new station */ call timer_manager_$sleep (10, RELATIVE_SECONDS); /* let the line settle or operator send quit */ go to attach_chan; end; call iox_$control (iodd_static.slave_out, "runout", null, code); /* force out the message */ /* Look for the command line: station */ line = ""; /* clear the input buffer */ call iox_$get_line (iodd_static.slave_in, addr (line), 80, len, code); if code ^= 0 then go to drop_station; line = rtrim (line, " " || NL); /* strip any new line chars */ if index (line, "station") = 0 then go to bad_cmd; station_id = before (ltrim (after (line, "station")), " "); if station_id = "" then do; bad_cmd: call iodd_msg_ (normal, both, 0, "***", "Invalid station command."); go to clear_input_buffer; end; station_password = before (ltrim (after (line, rtrim (station_id))), " "); if station_password = "" then /* ... left off password: ask for it */ call read_password_$switch (iodd_static.slave_out, iodd_static.slave_in, STATION_PW_PROMPT, station_password, code); if station_password = "*" then /* ... user really wants a blank password */ station_password = ""; if station_password ^= "" then do; temp_password = station_password; station_password = scramble_ (temp_password); temp_password = ""; /* Security */ end; call validate_card_input_$station (station_id, station_password, err_msg, code); station_password = ""; /* Security */ if code ^= 0 then do; call iodd_msg_ (normal, both, 0, "***", "^a: ^a", err_msg, station_id); go to clear_input_buffer; end; /* assume the station_id and major device are the same */ request_dev.major_name, iodd_static.major_device = station_id; request_dev.major_index = 0; do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0); idtep = addr (iod_device_tab.entries (i)); /* use new ptr for easy reference */ if idte.dev_id = request_dev.major_name then request_dev.major_index = i; /* record the index */ end; if request_dev.major_index = 0 then do; /* not found */ call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" not defined in iod_tables.", request_dev.major_name); go to clear_input_buffer; /* let him try again....or quit */ end; if substr (lte.maj_dev_list, request_dev.major_index, 1) ^= "1"b then do; /* OOPS */ call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" is not permitted to use Line ""^a"".", idte.dev_id, lte.line_id); go to clear_input_buffer; end; call iodd_msg_ (normal, master, 0, "", "Driver initializing for station: ^a", iodd_static.major_device); code = 0; /* all was well, say so */ return; end attach_and_listen; %page; find_device_class: proc (string, ind, dev_class, request_type, ec); /* Internal procedure to search the queue group table and the device class table to find the device class index for the specified input string. The string is in the form of request_type.dev_class with the dev_class part being optional, thus assuming request_type.request_type. */ dcl string char (*); /* input can be no more than 64 chars */ dcl ind fixed bin; /* the device class index - output */ dcl dev_class char (32); /* device class name used - output */ dcl request_type char (32); /* queue group name used - output */ dcl ec fixed bin (35); /* error code returned */ dcl i fixed bin; /* random fixed bin variable */ dcl qgt_index fixed bin; /* index of the queue group entry in the table */ ec = 0; /* clear the error code */ /* break it into two components, if there. If only one component, make device_class the same as request_type */ request_type = before (string, "."); dev_class = after (string, "."); if dev_class = "" then dev_class = request_type; if request_type = "" then do; ec = error_table_$badopt; /* first char was ".", naughty */ call iodd_msg_ (normal, slave, 0, "", "Illegal form of request_type: ^a", string); return; end; /* search the queue group table for the requested entry */ do i = 1 to iodd_static.qgtp -> q_group_tab.n_q_groups; if iodd_static.qgtp -> q_group_tab.entries (i).name = request_type then go to found_group; end; call iodd_msg_ (normal, slave, 0, "", "Request type ""^a"" not found in table.", request_type); ec = error_table_$badopt; return; found_group: qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (i)); /* for easy reference */ qgt_index = i; /* save the index for the next test */ /* Now look in the device class table for the entry which matches the dev_class and request_type */ do i = qgte.first_dev_class to qgte.last_dev_class; dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (i)); if dcte.qgte_index = qgt_index then /* must belong to the request_type */ if dcte.id = dev_class then do; /* and be the right name */ ind = i; /* return the index of the entry */ return; end; end; ec = error_table_$badopt; /* no entry found */ call iodd_msg_ (normal, slave, 0, "", "Device class ""^a"" not found.", dev_class); return; end find_device_class; %page; validate_request: proc (ind, code); /* Internal procedure to check that the device class index for the minor device in the request_dev structure specified by "ind" is valid for this process at its current access authorization. The IO coordinator will make the same checks, this check is made so we can properly respond to the operator at the right time if an error occurs. */ dcl ind fixed bin; /* minor device index in the request_dev structure */ dcl code fixed bin (35); /* error code to be returned */ dcl ec fixed bin (35); /* local error code */ dcl i fixed bin; /* index variables */ dcl authorization bit (72) aligned; /* access authorization of process */ dcl dev_label char (32); /* name for messages */ dcl allowed_name char (24); /* driver's name max of 22 char */ dcl allowed_proj char (12); /* driver's project...max of 9 char */ dcl driver_name char (24); /* driver's name max of 22 char */ dcl driver_proj char (12); /* driver's project...max of 9 char */ dcl userid char (32); /* copy of the required driver userid */ i = ind; /* copy the argument */ if request_dev.n_minor = 1 then dev_label = request_dev.major_name; else dev_label = char (rtrim (request_dev.major_name) || "." || request_dev.minor (i).name, length (dev_label)); if request_dev.minor (i).dvc_index = 0 then do; call iodd_msg_ (normal, both, 0, "", "No default request type has been assigned to device ""^a"".", dev_label); code = error_table_$noentry; /* indicate an error */ return; /* nothing more we can check */ end; dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index)); ec = 0; /* initialize the failure indicator */ /* First check that this minor device is allowed for this device class */ if ^(substr (dcte.device_list, request_dev.minor (i).index, 1)) then do; /* if the device bit is off...too bad */ call iodd_msg_ (normal, both, 0, "", "Device ""^a"" is not allowed for device class ""^a"".", dev_label, dcte.id); ec = error_table_$noentry; /* flag the error */ /* then keep going to give all possible errors */ end; /* Now check that the process access authorization is high enough to handle all requests */ authorization = get_authorization_ (); /* get current authorization */ if ^aim_check_$greater_or_equal (authorization, dcte.max_access) then do; /* fail if authorization is not greater or equal */ /* to highest request driver is to handle */ call iodd_msg_ (normal, both, 0, "", "Process access authorization is not sufficient for device class ""^a"".", dcte.id); ec = error_table_$ai_restricted; /* set the failure flag */ /* this error should be error_table_$ai_restricted */ end; /* Now check for the correct process group id of the driver */ userid = get_group_id_ (); /* get id of driver */ driver_name = before (userid, "."); /* and break into components */ driver_proj = before (after (userid, "."), "."); /* get ready to look at the q_group_tab entry */ qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index)); userid = qgte.driver_id; /* get id of allowed drivers */ allowed_name = before (userid, "."); /* and break into components */ allowed_proj = before (after (userid, "."), "."); if allowed_name ^= driver_name then /* name must be equal or "*" to be accepted */ if allowed_name ^= "*" then go to name_err; /* too bad for him */ if allowed_proj ^= driver_proj then do; /* project must match */ name_err: call iodd_msg_ (normal, both, 0, "", "User ""^a.^a"" not authorized as driver for request type ""^a"".", driver_name, driver_proj, qgte.name); /* tell the operator */ ec = error_table_$user_not_found; /* indicate failure */ end; /* If all was well give back the device class name */ if ec = 0 then request_dev.minor (i).dev_class = dcte.id; /* save the dvc name */ code = ec; /* report any errors */ return; end validate_request; %page; kill_device: proc; /* internal procedure to tell the IO coordinator that the device and all minor devices which have been assigned to this process should be released */ dcl coord_chan fixed bin (71); /* place for copy of coord ev chan */ dcl send bit (1); /* flag to abort sending a wakeup */ dcl recursion_flag bit (1); dcl i fixed bin; /* local index variable */ dcl (p, p1) ptr; /* temp ptr for easy reading */ dcl code fixed bin (35); recursion_flag = "0"b; on command_error ; on any_other begin; /* in case driver_status is gone */ send = "0"b; /* abort the wakeup */ if recursion_flag then go to forget_it; recursion_flag = "1"b; go to term_seg; /* but try to clean up address space */ end; if driver_ptr_list.number = 0 then do; /* see if any have been assigned */ send = "0"b; /* if not, abort wakeup */ go to term_seg; /* try to terminate the parent dir */ end; else send = "1"b; event_message = 0; /* clear the event message of trash */ msgp = addr (event_message); /* setup event message */ msgp -> ev_msg.code = 4; /* code 4: we are about to logout */ msgp -> ev_msg.minor_dev_index = /* name a minor device so coord can release */ driver_ptr_list.stat_segp (1) -> driver_status.dev_index; coord_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan; /* save this in temp because we must terminate status seg before using it */ term_seg: do i = 1 to driver_ptr_list.number; /* first terminate all driver status segs */ p = driver_ptr_list.stat_segp (i); if send then do; /* can we still reference a driver status seg ? */ call ipc_$delete_ev_chn (p -> driver_status.driver_chan, code); p1 = p -> driver_status.rqti_ptr; /* get rqti ptr */ if p1 ^= null then call hcs_$terminate_noname (p1, code); /* try to terminate */ end; call hcs_$terminate_noname (p, code); if code ^= 0 then call iodd_msg_ (error, master, code, "kill_device", "Warning: driver status segment may be initiated."); end; if iodd_static.major_device ^= "" then do; call hcs_$terminate_file (sys_dir, iodd_static.major_device, 0, code); if code ^= 0 then call iodd_msg_ (error, master, code, "kill_device", "Warning: directory ^a in ^a may not be terminated.", iodd_static.major_device, sys_dir); end; iodd_static.major_device = ""; /* the device is gone */ driver_ptr_list.number = 0; /* assume all driver stat segs are gone */ if send then /* inform the coord only after all terminations are done */ call hcs_$wakeup (iodd_static.coord_proc_id, coord_chan, event_message, code); /* forget error code....can't do anything about it */ forget_it: return; end kill_device; %page; hangup_station: proc; dcl ec fixed bin (35); if iodd_static.slave_out ^= null then do; /* when defined, drop it */ call iox_$control (iodd_static.slave_out, "hangup", null, ec); call iox_$close (iodd_static.slave_out, ec); call iox_$detach_iocb (iodd_static.slave_out, ec); end; iodd_static.attach_name = ""; iodd_static.slave_out, iodd_static.slave_in = null; iodd_static.slave.active = "0"b; /* slave must be re-defined */ iodd_static.slave.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.log_msg = "0"b; /* must ask for log messages */ iodd_static.slave.echo_cmd = "0"b; /* don't echo cmds by default */ iodd_static.slave.priv1 = "0"b; /* driver module defined privleges */ iodd_static.slave.priv2 = "0"b; /* " */ iodd_static.slave.priv3 = "0"b; /* " */ iodd_static.slave_output = null_stream; /* we are done with this now */ iodd_static.slave_input = null_stream; return; end hangup_station; %page; wait_for_dial: proc (ec); /* Internal procedure to wait for a control terminal to be dialed to the driver process. We have failed badly if a non-zero value is returned in "ec". */ dcl ec fixed bin (35); /* error code */ dcl n_dev fixed bin; /* dummy for number of dialed dev arg */ dcl 1 dial_wait aligned, /* wait list for dial wakeup */ 2 num fixed bin, 2 chan fixed bin (71); dcl 1 dial_arg aligned like dial_manager_arg; call ipc_$create_ev_chn (iodd_static.ctl_dial_chan, ec); if ec ^= 0 then return; dial_wait.num = 1; /* we will wait on one channel */ dial_wait.chan = iodd_static.ctl_dial_chan; /* this one */ dial_arg.version = dial_manager_arg_version_2; /* use the constant */ dial_arg.dial_qualifier = char (iodd_static.ctl_attach_name, length (dial_arg.dial_qualifier)); dial_arg.dial_channel = dial_wait.chan; dial_arg.channel_name = iodd_static.ctl_attach_name; /* this is the tty we want */ dial_arg.dial_out_destination = ""; dial_arg.reservation_string = ""; if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY then do; /* 1 is priv attach, 2 is dial */ call dial_manager_$privileged_attach (addr (dial_arg), ec); /* ask for it */ if ec ^= 0 then return; /* if all is well we will wait */ call iodd_msg_ (normal, both, 0, "", "^a driver waiting for control terminal channel ""^a"" to become active.", iodd_static.major_device, iodd_static.ctl_attach_name); /* tell operator */ end; else do; /* this is the dial case */ call dial_manager_$allow_dials (addr (dial_arg), ec); if ec ^= 0 then return; call iodd_msg_ (normal, both, 0, "", "^a driver waiting for control terminal ""^a"" to dial.", iodd_static.major_device, iodd_static.ctl_term.ctl_attach_name); /* tell operator we are waiting */ end; wait: call ipc_$block (addr (dial_wait), addr (event_info), ec); if ec ^= 0 then return; call convert_dial_message_ (event_info.message, dev_name, dim_name, n_dev, status_flags, ec); if ec ^= 0 then return; if status_flags.hung_up then do; /* someone sent a hangup?? */ call iodd_hangup_$iodd_hangup_ (addr (event_info)); go to wait; /* in case it returns */ end; if ^status_flags.dialed_up then go to wait; /* we wait until a "dial" is received */ iodd_static.ctl_device = dev_name; /* save the device name here */ iodd_static.ctl_dev_dim = dim_name; /* and the dim */ call hcs_$make_ptr (ref_ptr, "iodd_hangup_", "iodd_hangup_", temp_ptr, ec); /* for ipc_ call chan */ if ec ^= 0 then return; call ipc_$decl_ev_call_chn (iodd_static.ctl_dial_chan, temp_ptr, stat_p, 1, ec); if ec ^= 0 then return; call iodd_msg_ (normal, both, 0, "", "Control terminal accepted."); return; end wait_for_dial; %page; check_for_dialup: proc (ec); /* This internal procedure checks to be sure the control terminal is in the dialed up state. The driver can do I/O to the terminal only when it is in the dialed up state. Otherwise com_err_ and ioa_ will signal "io_error" when trying to write on the control terminal. That causes nasty things to happen. Due to insufficient data from the standard tty dim, we have to call the hardcore tty interface directly. This should be a temporary measure until a new order call can be defined. (JCW - Jan 1975) Note, due to the use of the hardcore tty interface, this procedure cannot be used for a control terminal attached through mrd_. */ dcl ec fixed bin (35); /* error code to be returned */ dcl tw_index fixed bin; /* device index of the tty channel */ dcl state fixed bin; /* device state that we are after */ /* 1 = inactive - this cannot happen (they say) */ /* 2 = waiting - terminal is not there */ /* 5 = dialed up - on this state we can go */ ec = 0; /* start clean */ if iodd_static.ctl_attach_name ^= idte.ctl_attach_name | iodd_static.ctl_attach_type ^= idte.ctl_attach_type then do; /* same device? */ ec = 5; /* the changing device code for caller */ return; end; if iodd_static.ctl_dev_dim = "mrd_" then return; /* this is never a problem */ call hcs_$tty_index (iodd_static.ctl_device, tw_index, state, ec); if ec ^= 0 then return; /* let caller handle all errors */ if state ^= 5 then ec = 10; /* if not dialed up, drop the terminal */ return; end check_for_dialup; %page; return_string: proc (target) returns (char (*)); /* little procedure to return a string from text_strings.chars given the first char index and total number of chars in the string */ dcl 1 target unaligned like text_offset; if target.total_chars = 0 then return (""); else return ( substr (iodd_static.text_strings_ptr -> text_strings.chars, target.first_char, target.total_chars) ); end return_string; %page; %include device_class; %page; %include dial_manager_arg; %page; %include driver_ptr_list; %page; %include driver_status; %page; %include iod_constants; %page; %include iod_device_tab; %page; %include iod_event_message; %page; %include iod_line_tab; %page; %include iod_tables_hdr; %page; %include iodc_data; %page; %include iodd_static; %page; %include iox_dcls; %page; %include iox_modes; %page; %include mseg_message_info; %page; %include new_driver_msg; %page; %include q_group_tab; %page; %include request_descriptor; %page; %include timer_manager_constants; end iodd_;  iodd_command_processor_.pl1 10/28/88 1403.5rew 10/28/88 1233.5 648405 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ /* format: off */ iodd_command_processor_: proc (source, state, command_line, ec); /* This procedure is called by an io_daemon driver when it's ready to process an operator command. The validity of a command will depend on the source terminal and the state of the driver in processing requests. state = 0 means that there are no active devices. state = 1 means that we were called from iodd_listen_ with devices ready. state = 2 means that we were called while processing another command (or??) state = 3 means that we were called while processing a request (request command level). state = 4 means that we were called after a quit. state = 5 means that we were called from the signal handler (test mode) */ /* Originally coded as input_cmd_ in August 1973 by Robert S. Coren */ /* Modified and renamed in January 1975 by J. C. Whitmore for generalization and access isolation */ /* Modified in Dec 1975 by J. C. Whitmore for new restart functions & control terminal hangup before detach */ /* Modified in April 1976 by J. C. Whitmore to expand the dcl of ios_ mode variables to 256 */ /* Modified in August 1977 by J. C. Whitmore to extend input "state" and add new ctl_term options */ /* Modified in Nov 1977 by J. C. Whitmore to use iodd_msg_ and add new slave_term option */ /* Modified in May 1978 by J. C. Whitmore to add the x command and minor bug fixes */ /* Modified in July 1978 by J. C. Whitmore to add cmds: restart_q, auto_start_delay, defer, next, defer_time; to change the coord communication strategy; and to extend the save and restart commands */ /* Modified in August 1978 by J. C. Whitmore to add slave_term echo cmd and per device admin ec calls */ /* Modified 10/78 by J. C. Whitmore: go bug fix and status attach type 4 */ /* Modified 3/79 by J. C. Whitmore to support "-a" ctl arg to halt command */ /* Modified 6/81 by E. N. Kittlitz for new condition_info structures */ /* Modified January 1984 by C. Marker Added probe as a legal command in test mode. */ /* Modified February 23, 1985 by C. Marker to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. Status command fixed to handle long minor device names. END HISTORY COMMENTS */ /* format: on */ /* ARGUMENTS */ dcl source fixed bin; dcl state fixed bin; dcl command_line char (*); dcl ec fixed bin (35); /* AUTOMATIC */ dcl att_desc char (64); dcl code fixed bin (35); dcl command char (256) aligned; /* for the x command line to the command processor */ dcl change_data bit (1); /* flag for ok to change info */ dcl dr_ptr ptr; dcl desc_ptr ptr; dcl ec_name char (32); dcl segp ptr; dcl lg_sw bit (1) aligned; /* long option switch as needed */ dcl number fixed bin (35); dcl msgp ptr; dcl err_mess char (128); dcl error_flag bit (1); dcl message char (64); /* general message string */ dcl what char (16); dcl mode char (256); dcl omode char (256); dcl i fixed bin; dcl idx fixed bin; dcl len fixed bin; dcl tried_once bit (1); dcl person char (24); dcl project char (24); dcl restart_series fixed bin (35); dcl seq_id fixed bin (35); dcl series fixed bin (35); dcl series_sw bit (1); dcl device_id_length fixed bin; dcl req_type_label_length fixed bin; dcl io_stat bit (72) aligned; dcl 1 st aligned based (addr (io_stat)), 2 code fixed bin (35), 2 junk bit (36); dcl 1 arg_list aligned, /* structure of parsed command line tokens */ 2 max_args fixed bin init (21), /* the amount of storage we allocated */ 2 n fixed bin, 2 cmd char (64) var, /* first token is always the command */ 2 args (20) char (64) var; /* up to 20 args per command */ dcl 1 ev_chan_list aligned, /* IPC event list for coord communication */ 2 number fixed bin, /* number of channels in list (we use 2) */ 2 pad fixed bin, 2 chan (2) fixed bin (71); dcl 1 event_info aligned, /* info returned from ipc_$block */ 2 chan fixed bin (71), /* channel wakeup came in on */ 2 msg fixed bin (71), /* event message from sender */ 2 sender bit (36), /* proc id of sender */ 2 origin fixed bin, /* junk - ring, or device flag, or ? */ 2 wait_list_idx fixed bin; /* index of chan in ev_chan_list */ dcl 1 option aligned, /* control option bits for next command */ 2 dev bit (1) unal, 2 q bit (1) unal, 2 user bit (1) unal, 2 id bit (1) unal, 2 et bit (1) unal, 2 pn bit (1) unal; dcl 1 cond_info aligned like condition_info; /* BASED VARIABLES */ dcl sys_dir char (168) aligned based; /* string for the variable in iodd_'s static */ dcl floating float bin based; /* for the convert builtin */ dcl fixed_bin fixed bin based; /* " " " */ dcl fixed_bin_35 fixed bin (35) based; /* " " " */ /* CONSTANTS */ dcl master fixed bin int static init (1) options (constant); /* constant indicating the master device */ dcl slave fixed bin int static init (2) options (constant);/* constant indicating the slave device */ dcl both fixed bin int static init (0) options (constant); /* both the salve and master */ dcl normal fixed bin int static init (1) options (constant); dcl whoami char (24) int static options (constant) init ("iodd_command_processor_"); dcl null_cmd_level fixed bin int static options (constant) init (0); /* command level of state 0 */ dcl listen_cmd_level fixed bin int static options (constant) init (1); /* command level of state 3 */ dcl quit_cmd_level fixed bin int static options (constant) init (4); /* command level of state 4 */ dcl signal_cmd_level fixed bin int static options (constant) init (5); /* command level of state 5 */ dcl null_stream char (32) int static options (constant) init ("iodd_null_stream"); dcl unknown_cmd_code fixed bin (35) int static options (constant) init (1239); dcl bad_chars char (5) int static options (constant) init ("([]);"); dcl chn_type (4) char (8) int static options (constant) init ("iom ch", "tty ch", "dial id", "tty ch"); /* ENTRIES */ dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl cu_$cp entry (ptr, fixed bin, fixed bin (35)); dcl debug entry; dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl logout entry (); dcl hcs_$initiate entry (char (*) aligned, char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl iodd_msg_ entry options (variable); dcl ( ioa_, ioa_$rsnnl ) entry options (variable); dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*), bit (72) aligned); dcl ios_$order entry (char (*) aligned, char (*), ptr, bit (72) aligned); dcl ios_$changemode entry (char (*) aligned, char (*), char (*), bit (72) aligned); dcl iox_$attach_ptr entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl iodd_parse_$command entry (char (*), ptr, fixed bin (35)); dcl iodc_$command_level entry (); dcl message_segment_$add_file entry (char (*) aligned, char (*), ptr, fixed bin (24), bit (72) aligned, fixed bin (35)); dcl probe entry (); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); /* BUILTINS */ dcl (addr, fixed, index, divide, stac, convert, null, substr, before, after, string, mod, rtrim, length, search, currentsize, unspec, float, verify) builtin; /* EXTERNAL STATIC */ dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$namedup fixed bin (35) ext static; dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$request_not_recognized fixed bin (35) ext static; dcl iox_$user_output ptr ext; dcl iox_$user_input ptr ext; dcl iox_$error_output ptr ext; /* CONDITIONS */ dcl (conversion, no_coord, re_init, daemon_logout, daemon_slave_logout, daemon_again, daemon_cancel, daemon_kill, daemon_new_device, daemon_again_slave, program_interrupt, daemon_defer, resume, size) condition; dcl (any_other, cleanup, daemon_save) condition; /* include file no longer declares version 5 */ dcl cq_info_version_5 fixed bin int static init (5); dcl coord_msg (50) fixed bin (71) aligned; /* this is the last dcl to make indent happy */ /* must hold iodd_comm but PL/I will not allow */ /* us to set the size to the size (iodd_comm) */ /* START OF MAIN PROGRAM */ comm_ptr = addr (coord_msg); /* get ready for special commands */ on conversion begin; call iodd_msg_ (normal, source, 0, "", "Argument conversion error. Try again."); go to ignore; end; on size begin; call iodd_msg_ (normal, source, 0, "", "Argument numerical size error. Try again."); go to ignore; end; call iodd_parse_$command (command_line, addr (arg_list), ec); /* see what he said */ if ec ^= 0 then do; if ec = error_table_$noarg then do; /* just a blank line */ ignore: ec = 0; /* don't force a reset read */ return; end; err_mess = "Unable to parse command line."; error: call iodd_msg_ (normal, source, 0, "", "^a driver: ^a", iodd_static.major_device, err_mess); return; end; /* Now the command and all the arguments are in the arg_list structure */ /* find which command it is and branch to the correct label */ if cmd = "." then go to ignore; /* just ask for a command */ /* The full list of commands is getting long, so start on the next page */ /* Here is the real list of commands for the standard driver */ /* All commands must be accepted without the undersocre character for remote devices. */ if cmd = "auto_start_delay" | cmd = "autostartdelay" then go to auto_start_delay_command; if cmd = "cancel" then go to cancel_command; if cmd = "coord" then go to coord_command; if cmd = "ctl_term" | cmd = "ctlterm" then go to ctl_term_command; if cmd = "debug" then go to debug_command; if cmd = "defer" then go to defer_command; if cmd = "defer_time" | cmd = "defertime" then go to defer_time_command; if cmd = "go" then go to go_command; if cmd = "halt" then go to halt_command; if cmd = "help" then go to help_command; if cmd = "hold" then go to hold_command; if cmd = "inactive_limit" | cmd = "inactivelimit" then go to inactive_limit_command; if cmd = "kill" then go to kill_command; if cmd = "logout" then go to logout_command; if cmd = "master" then go to master_command; if cmd = "new_device" | cmd = "newdevice" then go to new_device_command; if cmd = "next" then go to next_command; if cmd = "pi" then go to pi_command; if cmd = "probe" | cmd = "pb" then go to probe_command; if cmd = "ready" then go to ready_command; if cmd = "reinit" then go to reinit_command; if cmd = "release" | cmd = "rl" then go to release_command; if cmd = "restart" then go to restart_command; if cmd = "restart_q" | cmd = "restartq" then go to restart_q_command; if cmd = "resume" then go to resume_command; if cmd = "return" then go to return_command; if cmd = "save" then go to save_command; if cmd = "slave" then go to slave_command; if cmd = "slave_term" | cmd = "slaveterm" then go to slave_term_command; if cmd = "start" then go to start_command; if cmd = "status" then go to status_command; if cmd = "step" then go to step_command; if cmd = "x" then go to x_command; /* The command is not implemented here. See if the driver module wants it. */ ec = unknown_cmd_code; /* set to an unlikely value in case driver module just returns */ err_mess = "Invalid command for driver - " || cmd; pass_on: call iodd_static.driver_command (source, state, addr (arg_list), ec); if ec = unknown_cmd_code then go to error; /* no one home...other errors were already reported */ if ec = 1 | ec = 2 then ec = 0; /* driver module cannot force a continue */ return; /* clean return for a valid driver_module command */ /* **************************************************************************************** */ /* This is where the real work starts. One label for each command. */ auto_start_delay_command: if arg_list.n > 1 then do; /* set the value */ number = convert (fixed_bin, args (1)); /* make it fixed bin */ if number < 30 then do; /* this is the lower limit */ call iodd_msg_ (normal, source, 0, "", "The lower limit for the delay time is 30 seconds."); return; end; iodd_static.auto_start_delay = number; end; call iodd_msg_ (normal, source, 0, "", "The auto start delay is: ^d seconds.", iodd_static.auto_start_delay); return; cancel_command: what = "cancel"; /* make next section common with the kill command */ cancel_or_kill: if source = slave then if iodd_static.master_hold then do; err_mess = "Driver in hold by master terminal."; go to error; end; if iodd_static.request_in_progress then do; /* can only kill or cancel active request */ dr_ptr = iodd_static.driver_ptr; /* find the current request number */ desc_ptr = addr (dr_ptr -> driver_status.descriptor); desc_ptr -> request_descriptor.dont_delete = "1"b; /* cancel any delete option, just in case */ iodd_static.master_hold = "0"b; /* already 0 if not the master */ iodd_static.slave_hold = "0"b; /* both MBZ for next command level */ call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); if what = "cancel" then do; desc_ptr -> request_descriptor.cancelled = "1"b; /* mark the request */ signal daemon_cancel; /* let the driver module clean out */ end; else signal daemon_kill; /* the other action */ return; end; err_mess = "No current request to " || what; go to error; coord_command: /* for calling coord command level when testing */ /* coord and driver in one process */ if iodd_static.test_entry then if source = master then do; /* only the master can do this */ call iodc_$command_level (); /* coord will do its own i/o */ call iox_$control (iodd_static.master_in, "start", null, ec); /* just to be safe */ return; end; err_mess = "The coord command is for master terminal test mode only."; go to error; ctl_term_command: if arg_list.n < 2 then do; /* must be one arg to the command */ err_mess = "Expected argument missing."; go to error; end; if ^iodd_static.ctl_term.attached then do; /* there must be one attached */ err_mess = "Control terminal not attached."; go to error; end; if args (1) = "detach" then do; /* drop the thing forever */ if source = master then do; /* if the master says so */ call ios_$order (iodd_static.ctl_io, "hangup", null, io_stat); /* give back to answering service */ if (iodd_static.slave_output = iodd_static.ctl_output) & iodd_static.slave.active then do; iodd_static.slave.active = "0"b; /* it was also the slave..drop it too */ call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* don't forget this */ call ios_$detach ("broadcast_errors", iodd_static.slave_output, "", io_stat); iodd_static.slave.allow_quits = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.log_msg = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave_out = null; /* cancel the iocb ptrs too */ iodd_static.slave_in = null; iodd_static.slave_output = null_stream; iodd_static.slave_input = null_stream; end; call ios_$detach (iodd_static.ctl_io, "", "", io_stat); call ios_$detach (iodd_static.ctl_output, "", "", io_stat); call ios_$detach (iodd_static.ctl_input, "", "", io_stat); iodd_static.ctl_term.attached = "0"b; iodd_static.ctl_term.forms = "0"b; iodd_static.ctl_output = null_stream; iodd_static.ctl_input = null_stream; iodd_static.ctl_io = null_stream; return; end; /* all cleared out now */ err_mess = "Only the master terminal can detach the control terminal."; go to error; end; if args (1) = "simulate" then do; /* initiate terminal FF simulation */ if ^iodd_static.forms then do; /* be sure we are not already doing so */ iodd_static.ctl_term.ctl_dev_dim = "form_"; /* record the new dim name */ call ios_$attach (iodd_static.ctl_output, "form_", iodd_static.ctl_io, "", io_stat); /* was using "syn" */ call ios_$attach (iodd_static.ctl_input, "form_", iodd_static.ctl_io, "", io_stat); if st.code ^= 0 then do; /* errors??? */ ec = st.code; call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold."); iodd_static.master_hold = "1"b; return; end; iodd_static.forms = "1"b; /* this is the important part */ call iodd_msg_ (normal, source, 0, "", "Forms will have to be aligned."); return; end; err_mess = "Already simulating forms."; /* someone goofed */ go to error; end; if args (1) = "aligned" then do; if iodd_static.forms then do; /* only when simulating */ call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat); if st.code ^= 0 then do; ec = st.code; call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold."); iodd_static.master_hold = "1"b; end; return; end; err_mess = "Driver not simulating forms."; go to error; end; /* The remaining functions of this command require an additional argument */ if arg_list.n < 3 then do; /* one check for all command keywords */ err_mess = "Invalid ctl_term command request:" || substr (command_line, 9); go to error; end; if args (1) = "form_type" | args (1) = "formtype" then do; if args (2) = "default" then do; /* we can't really set the default here */ iodd_static.form_type = "undefined_form"; /* so do what we can and then... */ go to pass_on; /* see if the driver_module wants to change it */ end; if args (2) = "none" then iodd_static.form_type = "undefined"; /* special type to supress forms */ else iodd_static.form_type = args (2); /* gobble it up...we'll check it later */ return; end; if args (1) = "modes" then do; /* change the modes of the output stream */ mode = args (2); /* copy them to fixed length string */ omode = "not returned"; /* just to make the message clear */ call ios_$changemode (iodd_static.ctl_output, mode, omode, io_stat); if st.code ^= 0 then do; /* OOPS */ ec = st.code; /* report the error */ call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold."); iodd_static.master_hold = "1"b; end; call iodd_msg_ (normal, source, 0, "", "Mode was: ^a", omode); return; end; if args (1) = "page_length" | args (1) = "pagelength" then do; if ^iodd_static.forms then do; /* must be simulating paging */ err_mess = "Driver not simulating forms."; go to error; end; i = convert (fixed_bin, args (2)); call ios_$order (iodd_static.ctl_output, "page_length", addr (i), io_stat); if st.code ^= 0 then do; ec = st.code; call iodd_msg_ (normal, both, ec, whoami, "Driver goes into master hold."); iodd_static.master_hold = "1"b; end; return; end; err_mess = "Undefined ctl_term request:" || substr (command_line, 9); go to error; debug_command: if source = master then if iodd_static.test_entry then do; call iodd_msg_ (normal, master, 0, "", "Calling debug"); /* give reassuring message */ call debug (); return; end; err_mess = "The debug command is for master terminal test mode only."; go to error; defer_command: if iodd_static.request_in_progress then do; desc_ptr = addr (iodd_static.driver_ptr -> driver_status.descriptor); if desc_ptr -> request_descriptor.restarted then do; err_mess = "Request was restarted and is no longer in the queue. Use ""save""."; go to error; end; if source = slave then if iodd_static.master_hold then do; /* don't interrupt the master */ err_mess = "Driver in hold by master terminal."; go to error; end; desc_ptr -> request_descriptor.finished = "1"b; desc_ptr -> request_descriptor.keep_in_queue = "1"b; call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); signal daemon_defer; /* tell the driver module (or subr ) */ return; end; err_mess = "No current request to defer."; go to error; defer_time_command: if arg_list.n = 1 then do; /* command and no args */ if iodd_static.assigned_devices > 1 then do; /* ambiguous */ err_mess = "Multiple minor devices require a second argument - dev."; go to error; end; change_data = "0"b; /* can only give current values */ dr_ptr = iodd_static.driver_ptr; /* only one driver status seg */ end; else if arg_list.n = 2 then do; /* one arg case dev or number */ if iodd_static.assigned_devices = 1 & verify (args (1), "1234567890.") = 0 then change_data = "1"b; /* looks like a real number and its legal */ else change_data = "0"b; /* must be a device id */ if ^change_data then do; call find_minor_dev (args (1), dr_ptr, code); if code ^= 0 then go to error; end; else do; what = args (1); /* store the value to be converted */ dr_ptr = iodd_static.driver_ptr; /* must be current driver status seg */ end; end; else do; /* 3 args case (don't look at any more) */ call find_minor_dev (args (1), dr_ptr, code); if code ^= 0 then go to error; change_data = "1"b; /* there must be a time value */ what = args (2); /* in the second argument */ end; if ^change_data then do; /* no data, just print current values */ if dr_ptr -> driver_status.defer_time_limit = 0 then message = "No auto defer time limit has been set."; else call ioa_$rsnnl ("Auto defer time limit: ^.1f minutes", message, i, float (dr_ptr -> driver_status.defer_time_limit) / 60.0e0); number = dr_ptr -> driver_status.bit_rate_est; /* get the xfr rate */ call iodd_msg_ (normal, source, 0, "", "^a^/Current transfer rate: ^[^d bits/sec (^d chars/sec)^;undefined^s^s^]", message, (number > 0), number, divide (number, 9, 17)); return; /* and we're done */ end; number = fixed (convert (floating, what) * 60); /* input is in minutes, store as seconds */ if number < 10 then number = 0; dr_ptr -> driver_status.defer_time_limit = number; call iodd_msg_ (normal, source, 0, "", "Changing auto defer time limit to: ^[^.1f minutes^;no limit^s^]", (number > 0), float (number) / 60.0e0); return; go_command: /* start processing requests */ if state > listen_cmd_level then do; err_mess = "The go command is not valid at this command level."; go to error; end; if state = null_cmd_level & ^iodd_static.runout_requests then do; err_mess = "No ready device."; go to error; end; if source = slave & iodd_static.master_hold then do; err_mess = "Driver in hold by master terminal."; go to error; end; if arg_list.n = 1 then iodd_static.requests_til_cmd = 0; else do; /* operator wants to go for N requests */ if iodd_static.step then do; err_mess = "The go command cannot recognize a number while in step mode."; go to error; end; i = convert (fixed_bin, args (1)); /* get the N as fixed bin */ if i < 1 then do; /* a real value? */ err_mess = "Invalid number of requests specified: " || args (1); go to error; end; iodd_static.requests_til_cmd = i; /* OK, use the new value */ end; iodd_static.master_hold = "0"b; iodd_static.slave_hold = "0"b; ec = 1; /* give the "go" code */ return; /* let 'er rip */ halt_command: list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if arg_list.n < 2 then do; /* no arguments */ if iodd_static.assigned_devices = 1 then call halt_all; /* only legal for the one device case */ else do; /* give error msg */ err_mess = "Multiple minor devices require an argument."; go to error; end; end; else do; /* there were args ... check them */ if args (1) = "-all" | args (1) = "-a" then call halt_all; /* ctl arg must be first arg */ else do i = 1 to arg_list.n - 1; /* only devices given ... search for them */ call find_minor_dev (args (i), dr_ptr, code); if code = 0 then do; if dr_ptr -> driver_status.ready then iodd_static.current_devices = iodd_static.current_devices - 1; /* reduce count */ dr_ptr -> driver_status.ready = "0"b; /* turn off the ready flag to stop driver */ if ^stac (addr (dr_ptr -> driver_status.request_pending), iodd_static.driver_proc_id) then if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then do; call iodd_msg_ (normal, source, 0, "", "Pending request for device ""^a""", args (i)); iodd_static.runout_requests = "1"b; end; end; else call iodd_msg_ (normal, source, 0, "", "Minor device ""^a"" not assigned.", args (i)); end; /* look for next device arg */ end; if iodd_static.runout_requests then do; /* there was a pending request */ call iodd_msg_ (normal, source, 0, "", "Pending requests for halted devices will be processed."); if state <= listen_cmd_level then do; /* avoid resetting after a quit */ if source = master then iodd_static.master_hold = "0"b; /* can we go? */ if iodd_static.master_hold then do; err_mess = "Driver in hold by master terminal."; go to error; end; iodd_static.slave_hold = "0"b; /* don't come back for another command until done */ ec = 1; /* do an automatic "go" from normal command level */ return; end; return; end; if iodd_static.current_devices = 0 then do; /* nothing to run */ err_mess = "All devices are halted."; go to error; end; return; help_command: /* Put in a 1 line syntax description for each legal command */ call iodd_msg_ (normal, source, 0, "", "^/** Standard Driver Commands **^/"); /* title */ call iodd_msg_ (normal, source, 0, "", "auto_start_delay [seconds]"); call iodd_msg_ (normal, source, 0, "", "cancel"); call iodd_msg_ (normal, source, 0, "", "ctl_term []"); call iodd_msg_ (normal, source, 0, "", "defer"); call iodd_msg_ (normal, source, 0, "", "defer_time [dev] [mins]"); call iodd_msg_ (normal, source, 0, "", "go [N]"); call iodd_msg_ (normal, source, 0, "", "halt (...) | (-a|-all)"); call iodd_msg_ (normal, source, 0, "", "hold"); call iodd_msg_ (normal, source, 0, "", "inactive_limit []"); call iodd_msg_ (normal, source, 0, "", "kill"); call iodd_msg_ (normal, source, 0, "", "logout"); call iodd_msg_ (normal, source, 0, "", "master "); call iodd_msg_ (normal, source, 0, "", "new_device"); call iodd_msg_ (normal, source, 0, "", "next -user -id ID -pn -et -dev "); call iodd_msg_ (normal, source, 0, "", "ready (...) | (-a|-all)"); call iodd_msg_ (normal, source, 0, "", "reinit"); call iodd_msg_ (normal, source, 0, "", "release | rl"); call iodd_msg_ (normal, source, 0, "", "restart [ | -from ]"); call iodd_msg_ (normal, source, 0, "", "restart_q []"); call iodd_msg_ (normal, source, 0, "", "save [ | -from ]"); call iodd_msg_ (normal, source, 0, "", "slave "); call iodd_msg_ (normal, source, 0, "", "slave_term "); call iodd_msg_ (normal, source, 0, "", "start"); call iodd_msg_ (normal, source, 0, "", "status [-lg]"); call iodd_msg_ (normal, source, 0, "", "step [set|reset]"); call iodd_msg_ (normal, source, 0, "", "x []"); if iodd_static.test_entry then do; /* only give the test commands in test mode */ call iodd_msg_ (normal, source, 0, "", "^/** Test Mode Commands **^/"); call iodd_msg_ (normal, source, 0, "", "coord"); call iodd_msg_ (normal, source, 0, "", "debug"); call iodd_msg_ (normal, source, 0, "", "probe"); call iodd_msg_ (normal, source, 0, "", "pi"); call iodd_msg_ (normal, source, 0, "", "resume"); call iodd_msg_ (normal, source, 0, "", "return"); end; call driver_command (source, state, addr (arg_list), ec); call iodd_msg_ (normal, source, 0, "", ""); /* separate from command request */ return; hold_command: if source = slave then iodd_static.slave_hold = "1"b; /* master hold will override */ if source = master then iodd_static.master_hold = "1"b; return; inactive_limit_command: if arg_list.n > 1 then do; /* new limit data? */ number = convert (fixed_bin, args (1)); /* get the value as fixed bin */ if number < 0 | number > 200 then do; err_mess = "Unreasonable inactivity time limit value: " || args (1) || " minutes"; go to error; end; if number > 0 then do; /* if not reseting, must be long enough for coord response */ i = divide (2 * iodd_static.wakeup_time + 59, 60, 17); /* minutes for at least 2 wakeup intervals */ if number < i then do; call iodd_msg_ (normal, source, 0, "", "The minimum inactivity time limit for this driver is ^d minute^[s^], or zero to reset.", i, i > 1); return; end; end; iodd_static.auto_logout_interval = number * 60; /* store as seconds for timer_manager_ */ end; number = divide (iodd_static.auto_logout_interval, 60, 17); /* get current value as minutes */ if number = 0 then call iodd_msg_ (normal, source, 0, "", "Driver will not logout for inactivity."); else call iodd_msg_ (normal, source, 0, "", "Driver will automatically logout after ^d minute^[s^] of inactivity.", number, number > 1); return; kill_command: what = "kill"; /* ready to make use of common code with cancel */ go to cancel_or_kill; /* see the cancel command */ logout_command: if source = master then iodd_static.master_hold = "0"b; if iodd_static.master_hold then do; err_mess = "Cannot logout while driver in hold by master terminal."; go to error; end; if arg_list.n > 1 then if arg_list.args (1) ^= "-force" then do; /* recognize the obsolete arg */ err_mess = "Invalid argument to logout command: " || arg_list.args (1); go to error; end; if source = slave then call iodd_msg_ (normal, master, 0, "", "Driver logout received from slave."); if iodd_static.slave.active then do; call iodd_msg_ (normal, slave, 0, "", "^/Driver is logging out.^/"); call iox_$control (iodd_static.slave_out, "runout", null, ec); end; if (source = slave) & ^iodd_static.ctl_term.attached /* use special signal for remote slave */ then signal daemon_slave_logout; /* in case the driver module wants it */ signal daemon_logout; /* normal logout for the master or control terminal */ return; /* just to be tidy */ master_command: /* slave wants to send master a message */ if source = slave then do; call iodd_msg_ (normal, master, 0, "From slave", substr (command_line, index (command_line, "master") + 6)) ; return; end; call iodd_msg_ (normal, master, 0, "", "Invalid command for master terminal."); /* master talking to itself?? */ return; new_device_command: if source ^= master then do; /* this one is restricted to the master */ err_mess = "The new_device command is valid from the master terminal only."; go to error; end; if iodd_static.slave.active then call iodd_msg_ (normal, slave, 0, "", "^/Driver process changing to new device.^/"); signal daemon_new_device; /* if halt ran to completion, we are all set */ /* if operator "QUIT" let it pass any way */ return; next_command: if iodd_static.assigned_devices = 1 then number = 4; else number = 6; if arg_list.n < number + 1 then do; call ioa_$rsnnl ("Too few args. Specify -user [-entry, -path or -id] ^[-dev ^]", err_mess, len, (number = 6)); go to error; end; if mod (arg_list.n, 2) = 0 then do; /* must have command plus even number of args */ err_mess = "Arguments must be given in pairs."; go to error; end; error_flag = ""b; string (option) = ""b; /* clear the given option flags */ coord_msg (*) = 0; /* clear the message */ iodd_comm.req_id = ""; /* set the char string which is optional */ do idx = 1 to arg_list.n - 1 by 2; /* go through the args */ if args (idx) = "-queue" | args (idx) = "-q" then do; /* OPTION = -queue */ if option.q then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -queue control argument can only be given once."); end; else do; option.q = "1"b; /* mark it as given */ if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ iodd_comm.queue_no = convert (fixed_bin, args (idx + 1)); if iodd_comm.queue_no < 1 | iodd_comm.queue_no > 4 then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "Invalid queue number - ^a", args (idx + 1)); end; end; end; else if args (idx) = "-entry" | args (idx) = "-et" then do; /* OPTION = -entry */ if option.pn then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -entry and -path control args are incomaptible."); end; else if option.et then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -entry control argument can only be given once."); end; else do; /* OK to use it */ option.et = "1"b; /* mark it */ if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ iodd_comm.data_len = length (args (idx + 1)); iodd_comm.data = args (idx + 1); end; end; else if args (idx) = "-path" | args (idx) = "-pn" then do; /* OPTION = -path */ if option.et then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -path and -entry control args are incompatible."); end; else if option.pn then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -path control argument can only be given once."); end; else do; /* OK to use it */ option.pn = "1"b; /* mark it */ if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ iodd_comm.data_len = length (args (idx + 1)); iodd_comm.data = args (idx + 1); if substr (args (idx + 1), 1, 1) ^= ">" then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "Full pathname must be given: ^a", args (idx + 1)); end; end; end; else if args (idx) = "-id" then do; /* OPTION = -id */ if option.id then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -id control argument can only be given once."); end; else do; /* OK to use it */ option.id = "1"b; /* mark it as used */ if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ iodd_comm.req_id = args (idx + 1); if verify (iodd_comm.req_id, "0123456789. ") > 0 then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "Invalid request id: ^a", iodd_comm.req_id); end; end; end; else if args (idx) = "-user" then do; /* OPTION = -user */ if option.user then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -user control argument can only be given once."); end; else do; /* OK record the user name */ option.user = "1"b; if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ person = before (args (idx + 1), "."); project = before (after (args (idx + 1), "."), "."); /* in case the tag was given */ if person = "" | project = "" then do; /* not nice */ error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The full person and project names must be given."); end; iodd_comm.user_id = rtrim (person) || "." || project; end; end; else if args (idx) = "-device" | args (idx) = "-dev" then do; /* OPTION = -device */ if option.dev then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", "The -device control argument can only be given once."); end; else do; option.dev = "1"b; if substr (args (idx + 1), 1, 1) = "-" then go to bad_order; /* was it an option? */ call find_minor_dev (args (idx + 1), dr_ptr, code); if code ^= 0 then do; error_flag = "1"b; call iodd_msg_ (normal, source, 0, "", err_mess); end; else iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index; end; end; else do; /* OPTION = Not Defined Here */ if substr (args (idx), 1, 1) = "-" then call iodd_msg_ (normal, source, 0, "", "Undefined control argument ^d", args (idx)); else do; bad_order: call iodd_msg_ (normal, source, 0, "", "Arguments missing or out of sequence at: ^a", args (idx)) ; end; error_flag = "1"b; idx = idx - 1; /* try to get back in sync */ end; end; if error_flag then return; /* that's all */ if ^option.dev then do; if iodd_static.assigned_devices > 1 then do; err_mess = "For multiple minor devices, the -device control argument must be given."; go to error; end; option.dev = "1"b; /* single device, we will assume it */ iodd_comm.minor_idx = iodd_static.driver_ptr -> driver_status.dev_index; end; error_flag = ^option.user | ^(option.et | option.pn | option.id); if error_flag then do; err_mess = "Minimum args required are user and some request identifier."; go to error; end; /* we should have a good request now */ iodd_comm.type = next_req; /* finish off the data */ iodd_comm.type_ext = string (option); /* show the given options to coord */ err_mess = ""; call send_coord_msg (code, number); if code ^= 0 then call iodd_msg_ (normal, source, code, "", err_mess); else call iodd_msg_ (normal, source, 0, "", "Request found."); return; probe_command: if source = master then if iodd_static.test_entry then do; call iodd_msg_ (normal, master, 0, "", "Calling probe"); /* give reassuring message */ call probe (); return; end; err_mess = "The probe command is for master terminal test mode only."; go to error; pi_command: if iodd_static.test_entry then if source = master then do; /* very restricted */ call iox_$control (iodd_static.master_in, "start", null, ec); /* play safe */ signal program_interrupt; /* back to debug .. we hope */ return; end; err_mess = "The pi command is only valid from the master terminal in test mode."; go to error; ready_command: /* put the devices in the ready state */ list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if arg_list.n < 2 then do; /* no arguments */ if iodd_static.assigned_devices = 1 then call ready_all; /* only legal for the one device case */ else do; /* give error msg */ err_mess = "Multiple minor devices require an argument."; go to error; end; end; else do; /* there were args ... check them */ do i = 1 to arg_list.n - 1; /* if we find "-all" we are done */ if args (i) = "-a" | args (i) = "-all" then do; call ready_all; return; /* that's all there is to it */ end; end; do i = 1 to arg_list.n - 1; /* only devices given ... search for them */ call find_minor_dev (args (i), dr_ptr, code); if code = 0 then do; if dr_ptr -> driver_status.attached then do; /* can only ready attached devices */ if ^dr_ptr -> driver_status.ready then do; iodd_static.current_devices = iodd_static.current_devices + 1; /* increase count */ dr_ptr -> driver_status.ready = "1"b; /* turn on the ready flag to ready driver */ end; if dr_ptr -> driver_status.request_pending then /* check for driver pid */ if dr_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id then dr_ptr -> driver_status.request_pending = (36)"0"b; end; else do; /* not attached, check the count */ if dr_ptr -> driver_status.ready then current_devices = current_devices - 1; dr_ptr -> driver_status.ready = "0"b; /* be sure it is not ready */ call iodd_msg_ (normal, source, 0, "", "Device ""^a"" is not attached.", args (i)); end; end; else call iodd_msg_ (normal, source, 0, "", "Minor device ""^a"" not assigned.", args (i)); end; /* look for next device arg */ end; return; reinit_command: /* this will force the driver to re-initialize */ if source = master then iodd_static.master_hold = "0"b; /* always go for master */ if iodd_static.master_hold then do; /* protect the master */ err_mess = "Driver in hold by master terminal."; go to error; end; signal re_init; /* OK, here we go! */ return; release_command: if (state < signal_cmd_level) | (source = master) then do; if source = master then iodd_static.master_hold = "0"b; if iodd_static.master_hold then do; /* don't interrupt the master */ err_mess = "Driver in hold by master terminal."; go to error; end; if iodd_static.request_in_progress then call iodd_msg_ (normal, source, 0, "", "Warning - Request in progress will be run again."); iodd_static.driver_ptr -> driver_status.busy = "0"b; /* don't throw away a pending request */ iodd_static.slave_hold = "1"b; /* force a command at normal level */ call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); signal resume; /* go back to iodd_listen_ */ iodd_static.master_hold = "1"b; /* OOPS, trouble. */ return; end; err_mess = "The release command is only valid from the master terminal at this command level."; go to error; restart_command: list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if source = slave then if iodd_static.master_hold then do; /* can't override the master */ err_mess = "Command not valid while process is in hold by master terminal."; go to error; end; if arg_list.n = 1 then do; /* no sequence number given */ if (state > listen_cmd_level) & iodd_static.request_in_progress then do; iodd_static.master_hold = "0"b; /* this must be the master or value is already 0 */ iodd_static.slave_hold = "0"b; /* be sure they are off for next command level */ call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); if source = master then signal daemon_again; /* say it was the master */ else signal daemon_again_slave; /* otherwise it was the slave */ end; else do; err_mess = "No current request to restart."; go to error; end; return; end; iodd_comm.type = restart; /* mark the type so following can be used for save */ restart_or_save: if args (1) = "-from" then do; /* this is a series request */ series_sw = "1"b; seq_id = convert (fixed_bin_35, args (2)); end; else do; /* a single request */ seq_id = convert (fixed_bin_35, args (1)); series_sw = "0"b; end; iodd_comm.data_len = 0; /* construct the command for the coord */ iodd_comm.queue_no = 0; iodd_comm.user_id = ""; /* don't care, but initialize */ iodd_comm.req_id = ""; dr_ptr = iodd_static.driver_ptr; /* need any minor device index, use current */ iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index; /* say who we are */ iodd_comm.dvc_idx = dr_ptr -> driver_status.maj_index; iodd_comm.request_no = seq_id; /* pass on the request number */ iodd_comm.type_ext = series_sw; /* use type extension to indicate single/series */ err_mess = ""; /* clear the message for the int proc */ call send_coord_msg (code, number); /* ship it */ if code ^= 0 then do; if code = error_table_$namedup then err_mess = "A restart is already in progress."; else if code = error_table_$noentry then err_mess = "Request number not found in saved list."; else if code = error_table_$action_not_performed then err_mess = "The specified request series is invalid for this driver."; call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver", "^a", err_mess); return; end; if ^series_sw | iodd_comm.type = save then return; if number ^= seq_id then call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver", "Series will be restarted from request ^d", number); restart_series = divide (seq_id, 10000, 35, 0); /* get the series he restarted */ do i = 1 to iodd_static.assigned_devices; /* see if there is a pending request */ /* of the same series */ dr_ptr = driver_ptr_list.stat_segp (i); /* look at each driver_status seg */ desc_ptr = addr (dr_ptr -> driver_status.descriptor); /* and request descriptor */ series = desc_ptr -> request_descriptor.seq_id; /* get the seq no of this request */ series = divide (series, 10000, 35, 0); /* strip out the series number */ if restart_series = series then do; /* if they match, we are done with the search */ if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then do; /* is it active? */ desc_ptr -> request_descriptor.finished = "1"b; /* mark it done so we can pass back */ if dr_ptr -> driver_status.ready then dr_ptr -> driver_status.request_pending = (36)"0"b; /* clear the pending flag */ else dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id; /* or busy the driver */ if dr_ptr -> driver_status.busy then do; /* was driver processing the request? */ iodd_static.slave_hold = "1"b;/* return to command level after aborting request */ if iodd_static.request_in_progress then signal daemon_save; /* try a normal save, or ... */ signal resume; /* send the current request back to the coord */ end; else do; /* we want to send a pending request back to the coord */ dr_ptr -> driver_status.last_wake_time = 0; /* force driver to request new one */ event_message = 0; /* clear the message to the coord */ msgp = addr (event_message); msgp -> ev_msg.code = 0; /* code 0 means take back this request and wait */ msgp -> ev_msg.minor_dev_index = /* tell which driver it was */ fixed (dr_ptr -> driver_status.dev_index, 17); call hcs_$wakeup (iodd_static.coord_proc_id, dr_ptr -> driver_status.coord_chan, event_message, code); if code ^= 0 then signal no_coord; /* again, errors are bad news!! */ end; end; return; /* we don't have to look at anything more */ end; end; /* end of the loop for assigned devices */ return; restart_q_command: if iodd_static.assigned_devices > 1 & arg_list.n = 1 then do; /* device needed? */ err_mess = "Multiple minor devices require an argument."; go to error; end; if arg_list.n > 1 then do; /* find the minor device index as requested */ call find_minor_dev (args (1), dr_ptr, code); if code ^= 0 then go to error; /* msg has been set */ iodd_comm.minor_idx = dr_ptr -> driver_status.dev_index; iodd_comm.dvc_idx = dr_ptr -> driver_status.maj_index; end; else do; iodd_comm.minor_idx = iodd_static.driver_ptr -> driver_status.dev_index; iodd_comm.dvc_idx = iodd_static.driver_ptr -> driver_status.maj_index; end; /* now complete the message */ iodd_comm.type = restart_q; iodd_comm.type_ext = ""b; iodd_comm.request_no = 0; iodd_comm.queue_no = 0; /* we restart all queues */ iodd_comm.data_len = 0; /* define a null char string */ iodd_comm.req_id = ""; iodd_comm.user_id = ""; err_mess = ""; call send_coord_msg (code, number); if code ^= 0 then call iodd_msg_ (normal, source, code, rtrim (iodd_static.major_device) || " driver", err_mess); else call iodd_msg_ (normal, source, 0, "", "Coord has restarted the queues."); return; resume_command: if iodd_static.test_entry & (source = master) then do; iodd_static.slave_hold = "1"b; /* force a command at normal level */ call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); signal resume; /* go back to iodd_listen_ */ iodd_static.master_hold = "1"b; /* OOPS, trouble. But, master did it */ return; end; err_mess = "The resume command is valid from the master terminal in test mode only."; go to error; return_command: list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if iodd_static.test_entry then if source = master then do; driver_ptr_list.number = 0; /* don't tell the coord we are going away */ signal daemon_logout; iodd_static.master_hold = "1"b; /* we won't get here, but.... */ return; end; err_mess = "The return command is only valid from the master terminal in test mode."; return; save_command: /* ask coord to save requests in our device class */ list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if arg_list.n > 1 then do; /* the N or -from N case */ iodd_comm.type = save; /* mark the type of command */ go to restart_or_save; /* use some common code with restart */ end; if source = slave then if iodd_static.master_hold then do; /* can't override the master */ err_mess = "Command not valid while process is in hold by master terminal."; go to error; end; if (state > listen_cmd_level) & iodd_static.request_in_progress then do; iodd_static.master_hold = "0"b; /* this must be the master or value is already 0 */ iodd_static.slave_hold = "0"b; /* be sure they are off for next command level */ call iox_$control (iodd_static.master_in, "start", null, ec); /* avoid lost wakeups */ if iodd_static.slave.active then call iox_$control (iodd_static.slave_in, "start", null, ec); desc_ptr = addr (iodd_static.driver_ptr -> driver_status.descriptor); desc_ptr -> request_descriptor.saved = "1"b; desc_ptr -> request_descriptor.finished = "1"b; desc_ptr -> request_descriptor.cancelled = ""b; /* just to be sure */ signal daemon_save; /* try for a clean finish of what was done */ ec = 2; /* make like a start command was given */ return; end; else do; err_mess = "No current request to save."; go to error; end; return; slave_command: if source = master then /* slave can't send itself a message */ if iodd_static.slave.active then do; call iodd_msg_ (normal, slave, 0, "", "From master: ^a", substr (command_line, index (command_line, "slave") + 5)); call iox_$control (iodd_static.slave_out, "runout", null, code); return; end; else do; err_mess = "Slave device is not active."; go to error; end; err_mess = "Invalid command for slave terminal."; go to error; slave_term_command: if ^iodd_static.slave.active then do; err_mess = "Slave terminal is not active."; go to error; end; if arg_list.n < 2 then do; err_mess = "Expected argument missing."; go to error; end; if args (1) = "errors" then do; iodd_static.slave.print_errors = "1"b; call ios_$attach ("error_output", "syn", "broadcast_errors", "", io_stat); end; else if args (1) = "no_errors" | args (1) = "noerrors" then do; iodd_static.slave.print_errors = "0"b; call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); end; else if args (1) = "commands" then do; if source = slave then do; call master_only ("slave_term " || args (1)); return; end; iodd_static.accept_input = "1"b; if state >= quit_cmd_level & ^iodd_static.slave.allow_quits then call iodd_msg_ (normal, master, 0, "", "This will not be effective at this level while quits are disabled."); end; else if args (1) = "no_commands" | args (1) = "nocommands" then do; if source = slave then do; call master_only ("slave_term " || args (1)); return; end; iodd_static.accept_input = "0"b; if state >= quit_cmd_level then call iodd_msg_ (normal, master, 0, "", "WARNING: The previous command input state may be restored after start."); end; else if args (1) = "quits" then do; if source = slave then do; call master_only ("slave_term " || args (1)); return; end; iodd_static.allow_quits = "1"b; end; else if args (1) = "no_quits" | args (1) = "noquits" then do; if source = slave then do; call master_only ("slave_term " || args (1)); return; end; iodd_static.allow_quits = "0"b; end; else if args (1) = "log" then do; iodd_static.slave.log_msg = "1"b; end; else if args (1) = "no_log" | args (1) = "nolog" then do; iodd_static.slave.log_msg = "0"b; end; else if args (1) = "echo" then do; iodd_static.slave.echo_cmd = "1"b; end; else if args (1) = "no_echo" | args (1) = "noecho" then do; iodd_static.slave.echo_cmd = "0"b; end; else if args (1) = "modes" then do; /* see if he wants a changemode */ if arg_list.n < 3 then do; /* just report current mode */ mode = ""; message = "Current_modes:"; end; else do; mode = args (2); message = "Modes were:"; end; omode = "not returned"; /* just to make the message clear */ call ios_$changemode (iodd_static.slave_output, mode, omode, io_stat); if st.code ^= 0 then do; /* OOPS */ ec = st.code; /* report the error */ call iodd_msg_ (normal, both, ec, whoami); end; call iodd_msg_ (normal, source, 0, "", "^a ^a", message, omode); end; else do; /* otherwise ...not implemented here */ ec = unknown_cmd_code; /* see if driver module recognizes it */ err_mess = "Invalid function for slave_term command: " || args (1); go to pass_on; /* give it to the driver module for action */ end; return; start_command: if state > listen_cmd_level then do; /* we use start after a quit */ iodd_static.slave_hold = "0"b; if source = master then iodd_static.master_hold = "0"b; if iodd_static.master_hold then do; err_mess = "Driver in hold by master terminal."; go to error; end; ec = 2; /* this is the start code for the quit handler */ return; end; err_mess = "The ""start"" command is not valid at this level."; go to error; status_command: if arg_list.n > 1 then do; if args (1) = "-long" | args (1) = "-lg" then lg_sw = "1"b; /* gave the long option */ else do; err_mess = "Invalid control argument: " || args (1); go to error; end; end; else lg_sw = "0"b; list_ptr = iodd_static.driver_list_ptr; /* make the reference easier */ if iodd_static.step then message = "(step mode set)"; else message = ""; call iodd_msg_ (normal, source, 0, "", "^/IO Daemon Version: ^a^/Device:^2x^a^3x^a:^2x^a^3x^a", iodd_static.io_daemon_version, iodd_static.major_device, chn_type (iodd_static.attach_type), iodd_static.attach_name, message); if iodd_static.assigned_devices = 1 then do; /* different form for one device */ dr_ptr = iodd_static.driver_ptr; /* use the current driver */ call iodd_msg_ (normal, source, 0, "", "Request type: ^a", dr_ptr -> driver_status.req_type_label); call get_driver_status (message); call iodd_msg_ (normal, source, 0, "", "Status:^8x^a^/", message); return; end; /* determine length to generate legible display */ device_id_length, req_type_label_length = 12; do i = 1 to iodd_static.assigned_devices; dr_ptr = driver_ptr_list.stat_segp (i); if dr_ptr -> driver_status.attached | lg_sw then do; if length (rtrim (dr_ptr -> driver_status.device_id)) > device_id_length then device_id_length = length (rtrim (dr_ptr -> driver_status.device_id)); if length (rtrim (dr_ptr -> driver_status.req_type_label)) > req_type_label_length then req_type_label_length = length (rtrim (dr_ptr -> driver_status.req_type_label)); end; end; call iodd_msg_ (normal, source, 0, "", "^/minor device^vx request type^vx status^/", device_id_length - 12, req_type_label_length - 12); do i = 1 to iodd_static.assigned_devices; dr_ptr = driver_ptr_list.stat_segp (i); if dr_ptr -> driver_status.attached | lg_sw then do; call get_driver_status (message); call iodd_msg_ (normal, source, 0, "", "^va ^va ^a", device_id_length, dr_ptr -> driver_status.device_id, req_type_label_length, dr_ptr -> driver_status.req_type_label, message); end; end; call iodd_msg_ (normal, source, 0, "", "^/"); /* separate from command request */ return; step_command: if arg_list.n > 1 then do; /* an argument was given */ if args (1) = "set" then iodd_static.step = "1"b; else if args (1) = "reset" then iodd_static.step = "0"b; else do; /* unknown arg */ err_mess = "Valid arguments are set and reset."; go to error; end; end; else iodd_static.step = "1"b; return; x_command: if search (command_line, bad_chars) > 0 then do; /* trying to trick us? */ call iodd_msg_ (normal, source, 0, "", "Invalid characters in command line."); ec = unknown_cmd_code; return; end; on any_other call x_cmd_handler; /* in case ec gets into trouble */ on cleanup call reattach_master; if source = slave then do; /* for slave, we must swap streams around */ call swap_user_io_streams (ec); if ec ^= 0 then do; err_mess = "Unable to switch user io switches to salve."; call reattach_master; go to error; end; end; else do; /* for master, be sure slave doesn't get error messages */ att_desc = "syn_ error_i/o -inhibit close"; call iox_$detach_iocb (iox_$error_output, ec); call iox_$attach_ptr (iox_$error_output, att_desc, null, ec); if ec ^= 0 then do; err_mess = "Error switching error_output."; call reattach_master; /* try like hell */ go to error; end; end; tried_once = "0"b; /* get set for not finding _admin.ec */ ec_name = iodd_static.admin_ec_name; /* get the first name */ once_more: call hcs_$initiate (iodd_static.sys_dir_ptr -> sys_dir, ec_name, "", 0, 1, segp, code); if segp = null then do; /* not there */ if ^tried_once then do; /* look for iod_admin.ec */ ec_name = "iod_admin.ec"; tried_once = "1"b; /* say we have tried once already */ go to once_more; /* try_again */ end; ec = code; /* too bad, give up */ err_mess = "Unable to find " || rtrim (iodd_static.admin_ec_name) || " or iod_admin.ec for this driver."; call reattach_master; go to error; end; if iodd_static.admin_ec_name ^= ec_name then do; /* if we switched, tell operator */ call iodd_msg_ (normal, source, 0, "", "Using ^a for x command.", ec_name); iodd_static.admin_ec_name = ec_name; /* incase we had to switch */ end; command = "exec_com " || rtrim (iodd_static.sys_dir_ptr -> sys_dir) || ">" || rtrim (ec_name) || substr (command_line, index (command_line, "x") + 1); /* be sure to leave in the leading space */ call cu_$cp (addr (command), length (rtrim (command)), code); if code ^= 0 then ec = unknown_cmd_code; /* force a reset_read */ call reattach_master; return; /* END OF DEFINED COMMANDS */ /* ************************************ */ /* *********************************** */ init: entry (a_ptr); /* initialize the static data */ dcl a_ptr ptr; stat_p = a_ptr; /* set the pointer to iodd_static */ return; /* **** INTERNAL PROCEDURES **** */ halt_all: proc; /* unready all devices assigned to the process */ dcl i fixed bin; /* don't destroy the one in the external proc */ do i = 1 to iodd_static.assigned_devices; dr_ptr = driver_ptr_list.stat_segp (i); dr_ptr -> driver_status.ready = "0"b; /* turn off the ready flag to stop driver */ if ^stac (addr (dr_ptr -> driver_status.request_pending), iodd_static.driver_proc_id) then do; if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then iodd_static.runout_requests = "1"b;/* there was a pending request */ end; iodd_static.current_devices = 0; /* reset the count...all stopped */ end; end halt_all; ready_all: proc; /* ready all attached minor devices */ dcl i fixed bin; /* save the variable in external proc */ iodd_static.current_devices = 0; /* clear the count */ do i = 1 to iodd_static.assigned_devices; dr_ptr = driver_ptr_list.stat_segp (i); /* get driver ptr */ if dr_ptr -> driver_status.attached then do; dr_ptr -> driver_status.ready = "1"b; iodd_static.current_devices = iodd_static.current_devices + 1; /* one more ready */ if dr_ptr -> driver_status.request_pending then /* if open to coord, leave it alone */ if dr_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id then dr_ptr -> driver_status.request_pending = (36)"0"b; end; else do; dr_ptr -> driver_status.ready = "0"b; /* just to be sure */ dr_ptr -> driver_status.busy = "0"b; end; end; end ready_all; get_driver_status: proc (status); /* internal procedure to set a string description of the driver status seg pointed */ /* to by dr_ptr. */ dcl status char (*); dcl string char (32); dcl len fixed bin; dcl pending bit (1); if dr_ptr -> driver_status.ready then status = "ready"; else if dr_ptr -> driver_status.attached then status = "halted"; else status = "not attached"; if dr_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then do; /* request there? */ desc_ptr = addr (dr_ptr -> driver_status.descriptor); pending = ^((dr_ptr = iodd_static.driver_ptr) & iodd_static.request_in_progress); seq_id = desc_ptr -> request_descriptor.seq_id; call ioa_$rsnnl ("request ^d ^[pending^;in progress^]", string, len, seq_id, pending); substr (status, 16) = string; end; return; end get_driver_status; find_minor_dev: proc (dev_id, dr_ptr, code); dcl dev_id char (*) var; dcl dr_ptr ptr; dcl code fixed bin (35); dcl j fixed bin; code = 0; list_ptr = iodd_static.driver_list_ptr; do j = 1 to iodd_static.assigned_devices; dr_ptr = driver_ptr_list.stat_segp (j); if dr_ptr -> driver_status.device_id = dev_id then return; /* found the device */ end; code = error_table_$noentry; err_mess = "Invalid minor device name: " || dev_id; return; end find_minor_dev; master_only: proc (msg); dcl msg char (*); call iodd_msg_ (normal, source, 0, "", "^a driver: Invalid function from the slave terminal. ^a", iodd_static.major_device, msg); ec = unknown_cmd_code; return; end master_only; x_cmd_handler: proc; /* any_other handler for the x command */ dcl code fixed bin (35); /* local error code */ dcl type char (32); cond_info.version = 1; call find_condition_info_ (null, addr (cond_info), code); type = cond_info.condition_name; /* for easy reference */ if type = "cput" then do; continue_signal: call continue_to_signal_ (code); /* this is harmless */ return; end; if type = "alrm" then go to continue_signal; if type = "finish" then go to continue_signal; if type = "command_error" then return; if type = "command_question" then do; cq_info_ptr = cond_info.info_ptr; /* get pointer to question info structure */ if command_question_info.version >= cq_info_version_5 then do; /* if we can */ command_question_info.question_iocbp = iox_$user_output; /* set the switches for Q and A */ command_question_info.answer_iocbp = iox_$user_input; command_question_info.repeat_time = 120;/* ask every 2 minutes */ end; return; end; if iodd_static.test_entry then if type = "mme2" then go to continue_signal; else if type = "program_interrupt" then go to continue_signal; call ioa_ ("Error: ^a condition during the driver x command. Command aborted.", type); call reattach_master; go to ignore; /* go back to command level */ end x_cmd_handler; swap_user_io_streams: proc (code); dcl code fixed bin (35); code = 0; att_desc = "syn_ " || rtrim (iodd_static.slave_output) || " -inhibit close"; call iox_$detach_iocb (iox_$user_output, code); if code ^= 0 then return; call iox_$attach_ptr (iox_$user_output, att_desc, null, code); if code ^= 0 then return; call iox_$detach_iocb (iox_$error_output, ec); if ec ^= 0 then return; call iox_$attach_ptr (iox_$error_output, att_desc, null, ec); if ec ^= 0 then return; att_desc = "syn_ " || rtrim (iodd_static.slave_input) || " -inhibit close "; call iox_$detach_iocb (iox_$user_input, code); if code ^= 0 then return; call iox_$attach_ptr (iox_$user_input, att_desc, null, code); return; end swap_user_io_streams; reattach_master: proc; /* reconnect the user_output, error_output and user_input switches to user_i/o */ dcl code fixed bin (35); code = 0; att_desc = "syn_ user_i/o -inhibit close"; call iox_$detach_iocb (iox_$user_output, code); if code ^= 0 then go to fatal_error; call iox_$attach_ptr (iox_$user_output, att_desc, null, code); if code ^= 0 then go to fatal_error; call iox_$detach_iocb (iox_$user_input, code); if code ^= 0 then go to fatal_error; call iox_$attach_ptr (iox_$user_input, att_desc, null, code); if code ^= 0 then go to fatal_error; if iodd_static.slave.active & iodd_static.slave.print_errors then att_desc = "syn_ broadcast_errors -inhibit close"; else att_desc = "syn_ error_i/o -inhibit close"; call iox_$detach_iocb (iox_$error_output, code); if code ^= 0 then go to fatal_error; call iox_$attach_ptr (iox_$error_output, att_desc, null, code); if code = 0 then return; fatal_error: call iodd_msg_ (error, both, code, whoami, "Fatal error swapping user io streams."); if iodd_static.test_entry then do; call iodd_msg_ (normal, master, 0, "", "Calling Probe - and hope for the best."); call probe; return; end; call logout; return; end reattach_master; send_coord_msg: proc (code, number); dcl code fixed bin (35); dcl number fixed bin (35); dcl len fixed bin; dcl msg_id bit (72) aligned; iodd_comm.ack_chan = iodd_static.cmd_ack_chan; /* this is how we expext to get confirmation */ len = currentsize (iodd_comm); /* get size of message */ call message_segment_$add_file (iodd_static.sys_dir_ptr -> sys_dir, "coord_comm.ms", comm_ptr, len * 36, msg_id, code); if code ^= 0 then do; err_mess = "unable to add command request to coord_comm.ms."; return; end; call ipc_$drain_chn (iodd_static.cmd_ack_chan, code); /* clear any pending wakeups */ call ipc_$drain_chn (iodd_static.timer_chan, code); /* especially this one */ unspec (event_message) = msg_id; /* give the message id to the coord in ev message */ call hcs_$wakeup (iodd_static.coord_proc_id, iodd_static.coord_cmd_chan, event_message, code); if code ^= 0 then go to bad_ipc; /* errors are bad news */ /* set up a timer to be sure we don't block too long */ call timer_manager_$alarm_wakeup (120, "11"b, iodd_static.timer_chan); /* allow coord two munutes */ ev_chan_list.number = 2; /* get ready to block */ ev_chan_list.chan (1) = iodd_static.cmd_ack_chan; /* first priority is coord */ ev_chan_list.chan (2) = iodd_static.timer_chan; /* next is the timer */ call ipc_$block (addr (ev_chan_list), addr (event_info), code); call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan); /* stop the timer, if possible */ if code ^= 0 then do; /* very bad news */ bad_ipc: call convert_ipc_code_ (code); call iodd_msg_ (normal, both, code, whoami, "Fatal error. Driver will reinitialize."); signal re_init; end; if event_info.wait_list_idx = 1 then do; /* it was from the coord */ msgp = addr (event_info.msg); code = msgp -> ack_msg.code; number = msgp -> ack_msg.num; end; else do; /* the timer went off, is ther a coord at all? */ code = error_table_$request_not_recognized; err_mess = "Coordinator did not respond to command."; end; return; end send_coord_msg; %page; %include command_question_info; %page; %include condition_info; %page; %include condition_info_header; %page; %include driver_ptr_list; %page; %include driver_status; %page; %include iod_event_message; %page; %include iod_tables_hdr; %page; %include iodd_comm; %page; %include iodd_static; %page; %include mseg_message_info; %page; %include request_descriptor; end iodd_command_processor_;  iodd_get_cmd_.pl1 10/28/88 1403.5rew 10/28/88 1230.0 83367 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ iodd_get_cmd_: proc (a_wp, a_max_chars, a_chars_read, ctl, a_msg, a_source, a_code); /* This is the procedure used by the io daemon to read a command line from either of the terminals which can give commands to the driver. It may wait for a command to be read, or it may return if no command was typed on either terminal as determined by the ctl (flags) arg. */ /* Coded in August 1977 by J. C. Whitmore */ /* Modified Mar 1978 by J. C. Whitmore for bug fix, clearing prompt slave flag */ /* Modified Aug 1978 by J. C. Whitmore to fix the ctl declaration and add slave echo */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. END HISTORY COMMENTS */ /* ENTRIES */ dcl iodd_msg_ entry options (variable); dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl ioa_$rs entry options (variable); dcl iox_$get_line entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35)); dcl iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); /* ARGUMENTS */ dcl a_wp ptr; /* workspace pointer to input buffer */ dcl a_max_chars fixed bin (24); /* sixe of the workspace */ dcl a_chars_read fixed bin (24); /* number of chars actually read */ dcl a_msg char (*); /* added message for Enter command(a_msg): */ dcl a_source fixed bin; /* was the cmd from the master(1) or the slave(2) */ dcl a_code fixed bin (35); /* you guessed it! error code */ /* AUTOMATIC */ dcl code fixed bin (35); dcl prompt_msg char (128); /* command request message */ dcl msg_len fixed bin (24); dcl quit_signaled bit (1); dcl master fixed bin int static options (constant) init (1); /* constant indicating input from master device */ dcl slave fixed bin int static options (constant) init (2); /* constant indicating input from slave */ dcl 1 ctl aligned parameter, 2 wait_for_input bit (1) unal, /* true if we should wait for a cmd line */ 2 prompt_master bit (1) unal, /* true if we should ask master for cmd */ 2 prompt_slave bit (1) unal, /* true if we should ask slave for cmd */ 2 pad bit (33) unal; dcl 1 read_info aligned, /* structure for ios_$order "read_status" */ 2 read_ev_chan fixed bin (71), 2 input_ready bit (1) unal; dcl 1 event_info aligned, /* info about a wakeup received */ 2 chan fixed bin (71), 2 ev_msg fixed bin (71), 2 sender bit (36), 2 origin fixed bin, 2 wait_list_index fixed bin; dcl 1 input_list aligned, /* IPC wait list for operator input */ 2 number fixed bin, /* number of entries in the list = 2 */ 2 channel (2) fixed bin (71);/* ipc event channels */ /* CONDITIONS */ dcl (daemon_unclaimed, re_init, quit) condition; /* BUILTINS */ dcl (addr, null) builtin; /* BASED STRUCTURES AND INCLUDE FILES */ dcl chan_list_ptr ptr; /* pointer to event channel list */ dcl 1 ev_chan_list aligned based (chan_list_ptr), /* wait list for all drivers and consoles */ 2 number fixed bin, 2 channel (12) fixed bin (71); /* EXT STATIC */ dcl iodd_stat_p ptr ext static; %include iod_tables_hdr; %include iodd_static; stat_p = iodd_stat_p; /* get pointer to iodd_static */ quit_signaled = "0"b; a_code = 0; a_chars_read = 0; chan_list_ptr = iodd_static.chan_list_ptr; /* get pointer to list of event channels */ input_list.number = 2; /* two input devices, master and slave */ input_list.channel (1) = ev_chan_list.channel (1);/* copy from the full list */ input_list.channel (2) = ev_chan_list.channel (2); read_info.read_ev_chan = ev_chan_list.channel (1);/* in case the order fails first time */ read_info.input_ready = "0"b; if ^iodd_static.slave.accept_input then do; ctl.prompt_master = "1"b; /* no slave, so force the master flag */ end; ctl.prompt_slave = (ctl.prompt_slave | ^ctl.prompt_master); /* ask slave if not master */ prompt_msg = ""; /* start clean */ call ioa_$rs ("Enter command^[(^a)^]:", prompt_msg, msg_len, ^(a_msg = ""), a_msg); /* format the prompt message */ on quit begin; /* check for a quit */ quit_signaled = "1"b; /* tell main proc about it */ call continue_to_signal_ ((0)); /* and pass it on */ end; go to read; wait: if ctl.prompt_slave & iodd_static.slave.accept_input then do; call iox_$put_chars (iodd_static.slave_out, addr (prompt_msg), msg_len, code); if code ^= 0 then ctl.prompt_master = "1"b; /* be sure we prompt someone */ call iox_$control (iodd_static.slave_out, "runout", null, code); ctl.prompt_slave = "0"b; /* don't repeat til needed */ end; if ctl.prompt_master then do; /* do we ask for a command? */ call iox_$put_chars (iodd_static.master_out, addr (prompt_msg), msg_len, code); ctl.prompt_master = "0"b; /* don't ask again til necessary */ end; quit_signaled = "0"b; /* watch for a quit while blocked */ call ipc_$block (addr (input_list), addr (event_info), code); /* wait for a response */ if code ^= 0 then do; call convert_ipc_code_ (code); /* make it an error_table_code */ call iodd_msg_ (2, master, code, "iodd_get_cmd_", "Fatal error: blocking for terminal input"); if iodd_static.test_entry then signal daemon_unclaimed; /* give programmer a look */ else signal re_init; end; if quit_signaled then ctl.prompt_master, ctl.prompt_slave = "1"b; /* get a quit while blocked? */ read: call iox_$control (iodd_static.master_in, "read_status", addr (read_info), code); input_list.channel (1), ev_chan_list.channel (1) = read_info.read_ev_chan; /* master will always prevail */ if input_ready then do; call ipc_$drain_chn (input_list.channel (1), code); /* we only want new wakeups later */ call ipc_$drain_chn (input_list.channel (2), code); /* for the slave too! */ ctl.prompt_master = "1"b; /* be sure we ask for more input */ call iox_$get_line (iodd_static.master_in, a_wp, a_max_chars, a_chars_read, code); if a_chars_read = 0 then go to read; /* not likely...., but... */ a_code = code; a_source = master; return; end; /* Now see if the slave has anything, if we can accept a cmd line */ if iodd_static.slave.accept_input then do; call iox_$control (iodd_static.slave_in, "read_status", addr (read_info), code); if code ^= 0 then go to bad_slave; /* redefine the slave event channel, may change */ input_list.channel (2), ev_chan_list.channel (2) = read_ev_chan; if input_ready then do; call ipc_$drain_chn (input_list.channel (2), code); /* clear old wakeups */ ctl.prompt_slave = "1"b; /* be sure we ask for more later */ call iox_$get_line (iodd_static.slave_in, a_wp, a_max_chars, a_chars_read, code); if code ^= 0 then do; /* we can drop the slave on errors */ bad_slave: iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.allow_quits = "0"b; iodd_static.slave.log_msg = "0"b; iodd_static.slave.echo_cmd = "0"b; call iox_$control (iodd_static.slave_out, "quit_disable", null, (0)); /* lets try */ call ios_$attach ("error_output", "syn", "error_i/o", "", ("0"b)); /* just to be sure */ call iodd_msg_ (2, master, code, "iodd_get_cmd_", "Slave input terminated."); call iox_$control (iodd_static.master_in, "resetread", null, code); ctl.prompt_master = "1"b; /* we must ask for guidance */ ctl.wait_for_input = "1"b; ctl.prompt_slave = "1"b; /* in case we come back later */ go to read; end; if a_chars_read = 0 then go to read; /* possible due to g115 dim bug */ a_code = code; a_source = slave; if iodd_static.slave.echo_cmd then do; call iox_$put_chars (iodd_static.slave_out, a_wp, (a_chars_read), code); /* echo cmd line */ if code ^= 0 then go to bad_slave; end; return; end; end; if ctl.wait_for_input then go to wait; /* wakeup, but no input...go and wait */ a_source = 0; /* There was no input */ a_chars_read = 0; a_code = 0; return; end iodd_get_cmd_;  iodd_hangup_.pl1 11/08/88 1425.7rew 11/08/88 1422.6 77238 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthenstmt */ /* format: off */ /* I/O daemon handler for messages from the answering service concerning the channels attached to the daemon */ /* Created: 1975 by J. C. Whitmore */ /* Modified: July 1978 by J. C. Whitmore to convert to iodd_msg_ subroutine */ /* Modified: November 1978 by J. C. Whitmore to support attach_type 4: variable line type */ /* Modified: March 1979 by J. C. Whitmore for minor message fixes */ /* Modified: 18 December 1981 by G. Palter to treat any hangup as requiring the driver to be reinitialized as the only channels for which this procedure is defined to handle wakeups are of immediate concern to the driver; in particular, when the channel is attached via a dial preaccess request, it isn't possible to check its name against any values in iodd_static */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-11-08,MR12.2-1199): Upgraded to version 5 iod tables. 2) change(88-11-03,Brunelle), approve(88-11-03,MCR7911), audit(88-11-08,Wallman), install(88-11-08,MR12.2-1199): Changed to allow "y" & "n" for yes/no answers. END HISTORY COMMENTS */ /* format: on */ iodd_hangup_: procedure (arg_p); dcl arg_p ptr; dcl code fixed bin (35); dcl dev_name char (32); dcl dim_name char (32); dcl answer char (80) aligned; dcl master_state bit (1); /* state of the master hold bit */ dcl nelt fixed bin; dcl n_dialed fixed bin; dcl iodd_stat_p pointer external static; /* external static pointer to iodd_static */ dcl 1 ev_info based (arg_p), 2 channel fixed bin (71), 2 message fixed bin (71), 2 sender bit (36), /* process id sending the wakeup */ 2 origin bit (36), /* ring and device data..don't care */ 2 data_p ptr; /* argument from call chan creation */ dcl io_stat bit (72) aligned; /* ios status code */ dcl 1 status_flags aligned, 2 dialed_up bit (1) unal, 2 hung_up bit (1) unal, 2 control bit (1) unal, 2 pad (33) bit (1) unal; dcl convert_dial_message_ entry (fixed bin (71), char (*), char (*), fixed bin, 1 aligned like status_flags, fixed bin (35)); dcl new_proc entry (); dcl iodd_msg_ entry options (variable); dcl ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned); dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$close entry (ptr, fixed bin (35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl re_init condition; dcl (addr, null, substr) builtin; dcl master fixed bin int static options (constant) init (1); dcl stars char (40) int static options (constant) init ((40)"*"); dcl bells char (40) int static options (constant) init ((40)""); /* 40 bells 007 octal */ /* */ stat_p = iodd_stat_p; /* get a pointer to iodd_static */ master_state = iodd_static.master_hold; /* save the state */ iodd_static.master_hold = "1"b; /* default to master hold set */ call iox_$control (iodd_static.master_in, "resetread", null, code); /* unprocessed input is invalid */ call iox_$control (iodd_static.master_in, "start", null, code); /* be sure not to lose a wakeup */ call convert_dial_message_ (ev_info.message, dev_name, dim_name, n_dialed, status_flags, code); if code = 0 then do; if status_flags.hung_up & dev_name = iodd_static.ctl_device then do; /* The control terminal has hungup: ask the central site operator if he wishes to continue */ if ^iodd_static.ctl_term.attached then do; /* ignore if control terminal not in use */ iodd_static.master_hold = master_state; return; end; call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); call ios_$detach (iodd_static.ctl_io, "", "", io_stat); call ios_$detach ("broadcast_errors", iodd_static.ctl_output, "", io_stat); call ios_$detach (iodd_static.ctl_input, "", "", io_stat); call ios_$detach (iodd_static.ctl_output, "", "", io_stat); iodd_static.ctl_term.attached = "0"b; /* control terminal is now detached ... */ iodd_static.ctl_ev_chan = 0; if iodd_static.ctl_output = iodd_static.slave_output then do; iodd_static.slave.active = "0"b; /* control terminal was the slave terminal also */ iodd_static.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; end; call iodd_msg_ (2, master, 0, "", "^/^a^/Control terminal hangup received.^/^a^a", stars, bells, stars); call iodd_msg_ (1, master, 0, "", "^/Do you want to continue without control terminal?^/"); read: answer = ""; /* clear the string of crud */ call iox_$get_line (iodd_static.master_in, addr (answer), 80, nelt, code); if code ^= 0 then call new_proc (); /* this is tooooo..bad to correct */ call iox_$control (iodd_static.master_in, "start", null, code); /* send wakeup after each read */ if substr (answer, 1, 3) = "yes" | substr (answer, 1, 1) = "y" then do; iodd_static.forms = "0"b; /* can't simulate forms */ iodd_static.master_hold = master_state; return; /* restore the state as we go on */ end; if substr (answer, 1, 2) = "no" | substr (answer, 1, 1) = "n" then do; signal re_init; /* reinitialize to get the control terminal back */ end; call iodd_msg_ (1, master, 0, "", "Please answer ""yes"" or ""no""."); call iox_$control (iodd_static.master_in, "resetread", null, code); go to read; end; else if status_flags.hung_up then do; /* A channel other than the control terminal has hungup: assume it is the device's channel and reinitialize the driver */ call iodd_msg_ (1, master, 0, "", "^a^/Hangup received for device ""^a"" on channel ""^a"".^/^a^a", stars, iodd_static.major_device, dev_name, bells, stars); call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); if iodd_static.attach_type = 4 then do; /* variable line: detach it now as reinitialization won't */ call iox_$close (iodd_static.slave_out, code); call iox_$detach_iocb (iodd_static.slave_out, code); iodd_static.slave_out, iodd_static.slave_in = null; iodd_static.slave.active = "0"b; /* slave must be re-defined */ iodd_static.slave.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.log_msg = "0"b; /* must ask for log messages */ iodd_static.slave.echo_cmd = "0"b; /* don't echo cmds by default */ iodd_static.slave.priv1 = "0"b; /* driver module defined privleges */ iodd_static.slave.priv2 = "0"b; /* " */ iodd_static.slave.priv3 = "0"b; /* " */ iodd_static.slave_output, iodd_static.slave_input = "Undefined_Stream"; iodd_static.attach_name = ""; /* no longer defined */ end; if ^iodd_static.re_init_in_progress then signal re_init; return; end; else if status_flags.dialed_up then do; /* A channel issued a dial request: ignore it */ call iodd_msg_ (1, master, 0, "iodd_hangup_", "Dial received from device ""^a"".", dev_name); iodd_static.master_hold = master_state; /* not fatal, restore state and return */ return; end; else do; call iodd_msg_ (1, master, 0, "iodd_hangup_", "Dial control signal received. There are ^d dialed devices.", n_dialed); iodd_static.master_hold = master_state; /* this is also non-fatal */ return; end; end; call iodd_msg_ (2, master, code, "iodd_hangup_", "Unable to convert message from dial control."); return; %page; %include iod_tables_hdr; %page; %include iodd_static; end iodd_hangup_;  iodd_listen_.pl1 10/28/88 1403.5rew 10/28/88 1229.8 229437 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthenstmt */ /* format: off */ /* This is the central I/O daemon driver procedure, which "listens" for operator input and for wakeups from the coordinator (in general, whichever happens first). It avoids going blocked for input (unless needed) by using the iodd_get_cmd_ subroutine. It will listen for requests to be processed for each of the minor devices assigned to the process (if currently active) and service them in a round-robin fashion. This procedure will normally be called once per session, except in case of reinitialization */ /* Created: September 1973 by Robert S. Coren */ /* Modified: January 1975 by J. C. Whitmore for generalization and access isolation */ /* Modified: October 1975 by J. C. Whitmore to check for active slave before printing message */ /* Modified: December 1975 by M. A. Braida to include default condition handler for restart from slave */ /* Modified: August 1977 by J. C. Whitmore to use iodd_get_cmd_ for reading command lines */ /* Modified: November 1977 by J. C. Whitmore to use iodd_msg_ for all operator messages */ /* Modified: July 1978 by J. C. Whitmore to support daemon_save condition and commands: next, go N */ /* Modified: November 1978 by J. C. Whitmore to implement inactivity logout */ /* Modified: October 1979 by J. C. Whitmore to signal when driver is idle */ /* Modified: 18 December 1981 by G. Palter to correct entry number 0033 (phx11367) on the io_daemon error list: When operating in test mode with the coordinator and a driver in the same process, if the operator types ahead the necessary commands to stop both the driver and coordinator while a request is running, the request will be finished normally but will remain in the queue and be reprocessed the next time that queue is run */ /* Modified: February 23, 1985 by C. Marker to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. END HISTORY COMMENTS */ /* format: on */ iodd_listen_: procedure (); /* Entries */ dcl clock_ entry () returns (fixed bin (71)); dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl iodd_msg_ entry options (variable); dcl iodd_get_cmd_ entry (ptr, fixed bin, fixed bin, 1 aligned like ctl, char (*), fixed bin, fixed bin (35)); dcl iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35)); dcl iodd_quit_handler_ entry (); dcl iox_$look_iocb entry (char (*) aligned, ptr, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry); dcl timer_manager_$reset_alarm_call entry (entry); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); /* Automatic */ dcl wakeup_code fixed bin; /* action for coord on wakeup */ dcl wakeup_count fixed bin; /* how many coord request wakeups to send before block */ dcl dr_ptr ptr; /* general pointer to a driver status seg */ dcl desc_ptr ptr; /* pointer to the request descriptor */ dcl i fixed bin; /* do loop index */ dcl code fixed bin (35); dcl line char (132); /* input from terminal */ dcl nchars fixed bin; /* number of chars read */ dcl must_tell_coord bit (1); dcl idle_msg_sent bit (1); dcl timer_channel fixed bin (71); /* IPC channel to use for the timer */ dcl 1 ctl aligned, /* control flags for iodd_get_cmd_ */ 2 wait_for_input bit (1) unal, /* true if we should wait for a command */ 2 prompt_master bit (1) unal, /* true if we want to ask master for a cmd */ 2 prompt_slave bit (1) unal, /* true if we want to ask slave for a cmd */ 2 pad bit (33) unal; dcl state fixed bin; /* state of command processing */ /* 0 = not ready to handle requests */ /* 1 = ready or processing requests */ /* 2 & 3 are driver module defined cmd levels */ /* 4 = handling a quit */ /* 5 = unclaimed signal (test mode) */ dcl source fixed bin; /* which terminal gave the command line */ dcl last_cmd fixed bin; /* which source (master or slave) gave the last cmd line */ dcl master_cmd bit (1); /* true if master gave a cmd at this level */ dcl slave_cmd bit (1); /* true if slave gave a cmd at this level */ dcl terminal (2) ptr; /* iocb ptrs of the master and slave input devices */ dcl free_devices fixed bin; /* counter for round robin loop */ dcl driver_index fixed bin; /* ptr list index of current minor dev driver */ dcl now fixed bin (71); /* current clock_ time */ dcl 1 event_info aligned, /* info about a wakeup received */ 2 chan fixed bin (71), 2 ev_msg fixed bin (71), 2 sender bit (36), 2 origin fixed bin, 2 wait_list_index fixed bin; dcl 1 form_data aligned, /* data from ctl_dim_ for form alignment */ 2 page_length fixed bin, /* length of logical page */ 2 line_length fixed bin, /* number of chars before folding line */ 2 line_no fixed bin, /* current line on the page */ 2 carriage_pos fixed bin, /* position of next char on the line */ 2 aligned bit (1) unal, /* "1"b if we are simulating form feeds */ 2 pad bit (35) unal; /* Constants */ dcl null_cmd_level fixed bin int static options (constant) init (0); dcl listen_cmd_level fixed bin int static options (constant) init (1); dcl none fixed bin int static options (constant) init (0); /* constant for no terminal giving cmd */ dcl master fixed bin int static options (constant) init (1); /* constant indicating input from master device */ dcl slave fixed bin int static options (constant) init (2);/* constant indicating input from slave */ dcl both fixed bin int static options (constant) init (0); /* constant indicating both the master and slave */ dcl normal fixed bin int static options (constant) init (1); /* normal iodd_msg_ messages */ dcl error fixed bin int static options (constant) init (2);/* error messages for iodd_msg_ */ dcl new_request fixed bin int static options (constant) init (1); /* coord code for new request - done with current */ dcl request_done fixed bin int static options (constant) init (0); /* coord code to take back current request */ /* Conditions */ dcl (quit, no_coord, daemon_again, daemon_again_slave, daemon_kill, daemon_cancel, daemon_unclaimed, daemon_save, resume, re_init, daemon_logout, daemon_slave_logout, daemon_idle, cleanup) condition; /* Builtins */ dcl (addr, null, substr, string) builtin; /* Based structures */ dcl chan_list_ptr ptr; /* pointer to event channel list */ dcl 1 ev_chan_list aligned based (chan_list_ptr), /* wait list for all drivers and consoles */ 2 number fixed bin, 2 channel (12) fixed bin (71); /* External static */ dcl iodd_stat_p ptr external static; /* */ stat_p = iodd_stat_p; /* set the pointer to iodd_static */ list_ptr = iodd_static.driver_list_ptr; /* establish the list of driver status segs */ chan_list_ptr = iodd_static.chan_list_ptr; /* get pointer to list of event channels */ timer_channel = ev_chan_list.channel (3); /* timer uses the first minor dev chan */ call iox_$look_iocb (iodd_static.slave_input, iodd_static.slave_in, code); if code ^= 0 then go to slave_err; call iox_$look_iocb (iodd_static.slave_output, iodd_static.slave_out, code); /* just checking */ if code ^= 0 then do; slave_err: if iodd_static.slave.active then /* did we think there was a slave? */ call iodd_msg_ (error, master, code, "iodd_listen_", "Slave functions terminated."); iodd_static.slave.active = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; iodd_static.slave.allow_quits = "0"b; end; iodd_static.requests_til_cmd = 0; /* set for free running mode */ iodd_static.quit_during_request = "0"b; /* make sure initialization is correct */ iodd_static.request_in_progress = "0"b; iodd_static.recursion_flag = "0"b; iodd_static.re_init_in_progress = "0"b; /* any re_init is now done */ iodd_static.logout_pending = "0"b; iodd_static.auto_logout_pending = "0"b; iodd_static.runout_requests = "0"b; iodd_static.current_devices = 0; /* we will check for ready devices */ idle_msg_sent = "0"b; /* init flag for idle condition handler */ do i = 1 to iodd_static.assigned_devices; /* check the data in driver status */ dr_ptr = driver_ptr_list.stat_segp (i); /* next driver status ptr */ if ^dr_ptr -> driver_status.attached then do;/* not attached, can't be ready */ dr_ptr -> driver_status.ready = "0"b; /* correct the error */ dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id; /* tell coord */ end; else if dr_ptr -> driver_status.ready then do; iodd_static.current_devices = iodd_static.current_devices + 1; /* count it */ dr_ptr -> driver_status.request_pending = (36)"0"b; /* tell coord */ end; else dr_ptr -> driver_status.request_pending = iodd_static.driver_proc_id; /* not ready */ dr_ptr -> driver_status.busy = "0"b; /* none busy yet */ end; /* Now set up the remaining condition handlers */ on cleanup call timer_manager_$reset_alarm_call (trigger_auto_logout); on quit begin; call timer_manager_$reset_alarm_call (trigger_auto_logout); iodd_static.auto_logout_pending = "0"b; call iodd_quit_handler_; /* to come to command level after quit */ end; on resume go to resume_operation; /* clean up after unclaimed signal */ on daemon_save ; /* make this a null condition */ on daemon_again call iodd_msg_ (normal, master, 0, "", "No current request to ""restart""."); on daemon_again_slave call iodd_msg_ (normal, slave, 0, "", "No current request to ""restart""."); on daemon_cancel call iodd_msg_ (normal, both, 0, "iodd_listen_", "No current request to ""cancel""."); on daemon_kill call iodd_msg_ (normal, both, 0, "iodd_listen_", "No current request to ""kill""."); on daemon_idle call idle_proc; if iodd_static.slave.allow_quits then call iox_$control (iodd_static.slave_in, "quit_enable", null, code); terminal (master) = iodd_static.master_in; /* internal copy of iocbp for easy logic */ must_tell_coord = ""b; /* clear the send wakeup flag */ string (ctl) = ""b; /* clear all control flags */ driver_index = 0; /* so we start with index of 1st driver */ /* Everything is initialized, start the listen function by checking for commands */ check_for_cmd: ctl.wait_for_input = (iodd_static.step | iodd_static.master_hold | iodd_static.slave_hold); ctl.prompt_master = "0"b; /* normally the slave will give commands */ ctl.prompt_slave = "1"b; master_cmd = "0"b; /* no cmd from the master yet */ slave_cmd = "0"b; /* likewise for the slave */ last_cmd = none; go to read; wait: ctl.wait_for_input = "1"b; /* say we must wait for input */ read: if iodd_static.current_devices > 0 then state = listen_cmd_level; /* get ready for iodd_command_processor_ */ else state = null_cmd_level; call iodd_get_cmd_ (addr (line), 128, nchars, ctl, "", source, code); if must_tell_coord then do; /* do we owe the coord a wakeup? */ if source = none then do; iodd_static.driver_ptr -> driver_status.last_wake_time = clock_ (); wakeup_code = new_request; /* save an extra wakeup */ end; else wakeup_code = request_done; /* have a command, send this back and wait */ call wake_coord (wakeup_code); must_tell_coord = ""b; end; if source = none then go to find_work; /* no command, go look for a request */ call timer_manager_$reset_alarm_call (trigger_auto_logout); /* this is some activity, cancel auto logout */ iodd_static.auto_logout_pending = "0"b; idle_msg_sent = "0"b; /* we want a new idle message after commands */ if source = master then do; if iodd_static.slave.active then /* don't let the slave interrupt the master */ call iox_$control (iodd_static.slave_in, "quit_disable", null, (0)); master_cmd = "1"b; /* if master gave a cmd */ end; else slave_cmd = "1"b; /* otherwise it was the slave */ last_cmd = source; /* who gave the last command? */ ctl.wait_for_input = "0"b; /* got some */ call iodd_command_processor_ (source, state, substr (line, 1, nchars), code); if iodd_static.slave.allow_quits then /* let slave get a chance */ call iox_$control (iodd_static.slave_in, "quit_enable", null, (0)); terminal (slave) = iodd_static.slave_in; /* reset this, it may change */ if code = 1 then go to read; /* go for a request... but first check for more input */ if code = 0 | code = 2 then go to wait; /* we want more input .. no errors */ call iox_$control (terminal (source), "resetread", null, (0)); /* clear input after bad command */ go to wait; /* and wait for correct input */ find_work: /* ask coord for work if all is well */ if iodd_static.forms then /* be sure alignment is set when simulating forms */ if iodd_static.ctl_term.attached then do; /* if the terminal is there */ call iox_$control (iodd_static.slave_out, "form_status", addr (form_data), code); if code ^= 0 then do; /* something was wrong */ iodd_static.forms = "0"b; /* drop the forms */ call iodd_msg_ (normal, both, code, "iodd_listen_", "Control terminal form simulation terminated."); ctl.prompt_master = "1"b; /* force operator action */ ctl.prompt_slave = "1"b; /* slave can also answer */ call iox_$control (iodd_static.master_in, "resetread", null, (0)); /* but fresh answer */ call iox_$control (iodd_static.slave_in, "resetread", null, (0)); go to wait; end; if ^form_data.aligned then do; /* dim says not aligned...so, */ call iodd_msg_ (normal, slave, 0, "", "Control forms not aligned."); /* tell someone */ go to wait; /* must enable wakeups */ end; end; else iodd_static.forms = "0"b; /* not legal if no ctl term attached */ if last_cmd = slave then /* do we owe the master a courtesy msg? */ if master_cmd then call iodd_msg_ (normal, master, 0, "", "^a driver continuing.", iodd_static.major_device); else ; else if slave_cmd then if iodd_static.slave.active then /* be sure it wasn't detached by last command */ call iodd_msg_ (normal, slave, 0, "", "^a driver continuing.", iodd_static.major_device); master_cmd = "0"b; slave_cmd = "0"b; call timer_manager_$reset_alarm_wakeup (timer_channel); /* clear out any pending timeouts */ do i = 3 to ev_chan_list.number; /* reset all wakeups from coord */ call ipc_$drain_chn (ev_chan_list.channel (i), code); /* can't afford to check code here */ end; /* */ /* This is the main loop for checking to see if the coordinator has given any requests to process. We will go through the entire list of device drivers for this process and do any pending requests. Start with the last driver to be checked (not necessarily the current driver) as indicated by the value of "driver_index". If there is no request pending for an active driver, we will ask the coordinator for service if we have waited more than "wakeup_time" seconds with no word. Otherwise, we will block for "wakeup_time" seconds to see if a request comes in or if a command arrives */ free_devices = 0; /* clear the count of inactive devices */ wakeup_count = iodd_static.current_devices; /* max number of wakeups to send before block */ do while (free_devices < iodd_static.assigned_devices); driver_index = driver_index + 1; /* start with the next device */ if driver_index > iodd_static.assigned_devices then driver_index = 1; iodd_static.driver_ptr = driver_ptr_list.stat_segp (driver_index); /* set the current driver ptr */ iodd_static.output_device = driver_ptr -> driver_status.device_id; /* make things consistent */ if runout_requests then do; /* trying to flush pending requests from halted dev */ free_devices = free_devices + 1; /* only go around once */ if ^driver_ptr -> driver_status.ready then /* check pending for non-ready devices */ if driver_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then go to process_request; end; else if driver_ptr -> driver_status.request_pending then do; /* something waiting or driver inactive? */ if driver_ptr -> driver_status.request_pending = iodd_static.coord_proc_id then go to process_request; /* we found one that is valid */ free_devices = free_devices + 1; /* not the coord, must be free */ driver_ptr -> driver_status.busy = "0"b; driver_ptr -> driver_status.ready = "0"b; /* just to be sure */ end; else do; /* device driver is ready with nothing to do */ now = clock_ (); /* see what time it is */ if last_cmd = none then /* in automatic mode */ if driver_ptr -> driver_status.last_wake_time + 1000000 * iodd_static.wakeup_time > now then go to block_for_all_events; if wakeup_count <= 0 then go to block_for_all_events; /* when all are serviced, wait */ call wake_coord (new_request); /* request some service from the coord */ driver_ptr -> driver_status.last_wake_time = now; /* record the time */ free_devices = 0; /* reset the count...we found one */ driver_ptr -> driver_status.ready = "1"b; /* keep it straight in case driver module goofs */ wakeup_count = wakeup_count - 1; /* say we sent one */ end; end; /* that's all for the main loop */ /* if we fall through, there was nothing to do */ if iodd_static.runout_requests then do; /* if we expected to stop everything */ iodd_static.runout_requests = "0"b; /* change back to normal mode */ if iodd_static.logout_pending then signal daemon_logout; /* this is a clean way back */ end; else call iodd_msg_ (normal, both, 0, "", "No ready device or pending requests."); iodd_static.slave_hold = "1"b; /* force the issue */ iodd_static.logout_pending = "0"b; /* cancel the flag in case */ go to check_for_cmd; /* get a command and enable wakeups */ /* */ block_for_all_events: /* Here we wait for something to happen */ if iodd_static.auto_logout_interval > 0 then /* are we watching for inactivity? */ call timer_manager_$alarm_call ((iodd_static.auto_logout_interval), "11"b, trigger_auto_logout); call timer_manager_$alarm_wakeup (iodd_static.wakeup_time, "11"b, timer_channel); /* simulate a coord wakeup after N seconds */ call ipc_$block (chan_list_ptr, addr (event_info), code); if code ^= 0 then do; call convert_ipc_code_ (code); /* get an error_table_ value */ call iodd_msg_ (error, master, code, "iodd_listen_", "Fatal error: main block point."); if iodd_static.test_entry then signal daemon_unclaimed; /* let programmer peek */ else signal re_init; end; if event_info.wait_list_index < 3 then go to read; /* if it was a terminal, go look for input */ driver_ptr = driver_ptr_list.stat_segp (event_info.wait_list_index - 2); /* set the current driver ptr */ iodd_static.output_device = driver_ptr -> driver_status.device_id; if driver_ptr -> driver_status.request_pending ^= iodd_static.coord_proc_id /* really a request? */ then if iodd_static.auto_logout_pending then signal daemon_slave_logout; /* No, are we to logout? */ else do; signal daemon_idle; /* see if driver module wants to take action */ go to check_for_cmd; /* Nope! So poke around a bit */ end; process_request: /* We have a valid request from the coordinator */ idle_msg_sent = "0"b; /* give message again when we are next idle */ call timer_manager_$reset_alarm_call (trigger_auto_logout); /* this is some activity, cancel auto logout */ iodd_static.auto_logout_pending = "0"b; driver_ptr -> driver_status.busy = "1"b; /* be sure we tell the coord when done */ call iodd_static.driver_request; /* pass it off to the driver module for action */ iodd_static.requests_til_cmd = iodd_static.requests_til_cmd - 1; /* decrement the go N value */ /* */ resume_operation: /* pass it back to coord if done or "resume" signalled */ if iodd_static.requests_til_cmd = 0 then iodd_static.slave_hold = "1"b; /* force cmd hold after N done */ desc_ptr = addr (driver_ptr -> driver_status.descriptor); if iodd_static.driver_ptr -> driver_status.busy | desc_ptr -> request_descriptor.finished then do; if driver_ptr -> driver_status.ready then driver_ptr -> driver_status.request_pending = (36)"0"b; /* ready for next one */ else driver_ptr -> driver_status.request_pending = iodd_static.driver_proc_id; desc_ptr -> request_descriptor.finished = "1"b; /* force the done flag */ if iodd_static.step then wakeup_code = request_done; /* step mode, ask for request later */ else if iodd_static.master_hold then wakeup_code = request_done; /* in hold, ask later */ else if iodd_static.slave_hold then wakeup_code = request_done; else if driver_ptr -> driver_status.ready then wakeup_code = new_request; /* we want more service */ else wakeup_code = request_done; /* we don't want another request right now */ if wakeup_code = new_request then must_tell_coord = "1"b; /* tell coord after checking for cmd */ else do; call wake_coord (wakeup_code); must_tell_coord = ""b; /* we already told it */ end; driver_ptr -> driver_status.busy = "0"b; /* all done */ end; iodd_static.request_in_progress, iodd_static.recursion_flag, iodd_static.quit_during_request, iodd_static.quit_signaled = "0"b; iodd_static.segptr = null; /* reset current segment pointer */ go to check_for_cmd; /* See if there is a command, or wait for step */ /* */ /* Send "ready/done" wakeup to coordinator */ wake_coord: procedure (wakeup_code); dcl ec fixed bin (35); /* temp error code */ dcl wakeup_code fixed bin; /* what action is wanted */ /* 1 = done and give me another */ /* 0 = done and don't bug me */ event_message = 0; addr (event_message) -> ev_msg.code = wakeup_code; addr (event_message) -> ev_msg.seq_id = 0; addr (event_message) -> ev_msg.minor_dev_index = driver_ptr -> driver_status.dev_index; call hcs_$wakeup (coord_proc_id, driver_ptr -> driver_status.coord_chan, event_message, code); if code ^= 0 then do; ec = code; /* if error_table_ code...report */ call convert_ipc_code_ (ec); call iodd_msg_ (error, master, ec, "iodd_listen_", "Fatal error: Unable to send wakeup to coord."); if code = 1 | code = 3 then signal no_coord; else signal re_init; /* must be bad args */ end; if iodd_static.test_entry /* give coordinator (which may be us) a chance to wakeup */ then call timer_manager_$sleep (1, "11"b); /* 1 second should be enough */ return; end wake_coord; /* */ /* Handles the daemon_idle condition */ idle_proc: procedure (); if ^idle_msg_sent then /* if not told already about idle condition... */ call iodd_msg_ (normal, slave, 0, "", "^a driver: No requests, driver is idle.", iodd_static.major_device); idle_msg_sent = "1"b; /* don't repeat the message */ call continue_to_signal_ (0); /* let the driver module know about this */ return; end idle_proc; /* Sets the auto logout bit in iodd_static so the driver will logout after N minutes of inactivity, where N is defined by iodd_static.auto_logout_interval */ trigger_auto_logout: procedure (); iodd_static.auto_logout_pending = "1"b; /* if no command or request is present after returning from the main block point, the driver will logout */ return; end trigger_auto_logout; %page; %include driver_ptr_list; %page; %include driver_status; %page; %include iod_event_message; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include mseg_message_info; %page; %include request_descriptor; end iodd_listen_;  iodd_misc_cmds.pl1 11/15/82 1835.7rew 11/15/82 1508.3 55683 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ iodd_misc_cmds: proc; return; /* illegal entry point */ /* This is a procedure to collect several external commands for the driver's use */ /* written by J. C. Whitmore 9/78 */ dcl normal fixed bin int static options (constant) init (1); dcl slave fixed bin int static options (constant) init (2); dcl iod_val_segp ptr int static init (null); dcl last_sender char (64) int static init (""); dcl ap ptr; dcl al fixed bin; dcl bchr char (al) unal based (ap); dcl answer char (168) varying; dcl bvcs char (al) varying based (ap); dcl count fixed bin; dcl ec fixed bin (35); dcl idx fixed bin; dcl not_af bit (1) init ("1"b); /* default assumption is not an active function */ dcl string char (168) aligned; dcl msg_pfx char (80); dcl (first, last) fixed bin; dcl (null, substr, length, rtrim) builtin; dcl active_fnc_err_ entry options (variable); dcl com_err_ entry options (variable); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cu_$af_arg_count entry (fixed bin, fixed bin (35)); dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl ioa_ entry options (variable); dcl iodd_msg_ entry options (variable); dcl error_table_$wrong_no_of_args fixed bin (35) ext; dcl error_table_$not_act_fnc fixed bin (35) ext; dcl 1 valueseg based (iod_val_segp) aligned, 2 laste fixed bin, 2 freep fixed bin, 2 pad (6) fixed bin, 2 arry (1000), 3 name char (32), 3 valu char (168), 3 lth fixed bin, 3 chain fixed bin; /* === Entry for drivers to get messages via send_message === */ /* Usage: accept_messages -pn -bf -call iod_driver_message */ iod_driver_message: entry (a_number, a_sender, a_time, a_message, a_mbx_seg); dcl (a_number, a_sender, a_time, a_message, a_mbx_seg) char (*); if a_sender = last_sender then msg_pfx = "="; /* same as last sender, be brief */ else do; /* the sender is formatted like this: Person.Project (sent from) at */ /* we are most concerned with "sent from" since Person and Project of all drivers is usually equal. */ first = index (a_sender, "("); /* look for start of "(sent from)" field */ if first = 0 then do; /* not there, use the whole thing */ first = 1; last = length (rtrim (a_sender)); end; else do; /* sent from is defined */ first = first + 1; /* want the char after the "(" */ last = index (a_sender, ")"); /* look for the close */ if last = 0 then last = length (rtrim (a_sender)); /* missing, take all */ else last = last - 1; end; msg_pfx = "From " || substr (a_sender, first, last - first + 1); /* this is the first part */ end; idx = length (rtrim (msg_pfx)); /* how much was defined */ msg_pfx = substr (msg_pfx, 1, idx) || " (" || substr (a_time, 11, 6) || ")"; /* the last part */ call iodd_msg_ (normal, slave, 0, msg_pfx, a_message); last_sender = a_sender; /* save last sender's identity */ return; /* === Entry to return per process values from an active function == */ /* Usage: [iod_val keyword] */ /* returns the value associated with the keyword which was last set by the set_iod_val entry. */ /* If no value has been set, the string "undefined!" is returned. */ iod_val: entry; not_af = "0"b; /* assume we were called as an active function */ call cu_$af_arg_count (count, ec); if ec ^= 0 then if ec = error_table_$not_act_fnc then do; not_af = "1"b; /* not an active function */ call cu_$arg_count (count); end; else go to error; if count ^= 1 then do; ec = error_table_$wrong_no_of_args; go to error; end; if iod_val_segp = null then do; call get_temp_segment_ ("iod_val", iod_val_segp, ec); if ec ^= 0 | iod_val_segp = null then do; error: if not_af then call com_err_ (ec, "iod_val"); else call active_fnc_err_ (ec, "iod_val"); return; end; end; if not_af then call cu_$arg_ptr (1, ap, al, ec); else call cu_$af_arg_ptr (1, ap, al, ec); if ec ^= 0 then go to error; do idx = 1 to laste; if chain (idx) = 0 then if name (idx) ^= "" then if bchr = name (idx) then do; answer = substr (valu (idx), 1, lth (idx)); go to give; end; end; answer = "undefined!"; give: if not_af then call ioa_ (answer); else do; call cu_$af_return_arg (1, ap, al, ec); if ec ^= 0 then go to error; bvcs = answer; end; return; /* === Entry to define keywords and set values for them (returned by iod_val entry) === */ /* Usage: set_iod_val keyword {new_value} */ /* if new value is missing, keyword is "undefined!" */ set_iod_val: entry; if iod_val_segp = null then do; call get_temp_segment_ ("iod_val", iod_val_segp, ec); if ec ^= 0 | iod_val_segp = null then go to error; end; call cu_$arg_ptr (1, ap, al, ec); if ec ^= 0 then go to error; string = bchr; call cu_$arg_ptr (2, ap, al, ec); if ec ^= 0 then do; do idx = 1 to laste; if string = name (idx) then do; chain (idx) = freep; freep = idx; name (idx) = ""; end; end; return; end; do idx = 1 to laste; if chain (idx) = 0 then if name (idx) ^= "" then if name (idx) = string then do; go to f1; end; end; if freep = 0 then idx, laste = laste + 1; else do; idx = freep; freep = chain (idx); end; name (idx) = string; f1: valu (idx) = bchr; chain (idx) = 0; lth (idx) = al; return; end iodd_misc_cmds;  iodd_msg_.pl1 10/28/88 1403.5rew 10/28/88 1233.2 69723 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ iodd_msg_: proc (a_sev, a_target, a_code, proc_name); /* Procedure to print messages to the operator(s) of the IO Daemon driver. This is an alternative to com_err_ in that it has the same calling sequence starting with the code argument. It does not signal any conditions. It will write to the log, the error output switch, or to the user output switch. a_sev = 0 write a log message a_sev = 1 write a normal operator message a_sev = 2 write an error message It will write to the master, the slave or both. a_target = 0 write to both the master and the slave a_target = 1 write to the master only a_target = 2 write to the slave (if not active, write to master) */ /* Originally coded Nov 1977 by J. C. Whitmore */ /* Modified by J. C. Whitmore, 11/79, to decode the error code parameter descriptor */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. END HISTORY COMMENTS */ dcl a_sev fixed bin; /* severity: 0 = log, 1 = normal, 2 = error */ dcl a_target fixed bin; /* 0 = master and slave, 1 = master, 2 = slave */ dcl a_code fixed bin (35); /* error a_code for the message */ dcl proc_name char (*); /* calling proc */ dcl log fixed bin int static options (constant) init (0); dcl normal fixed bin int static options (constant) init (1); dcl error fixed bin int static options (constant) init (2); dcl master fixed bin int static options (constant) init (1); dcl slave fixed bin int static options (constant) init (2); dcl both fixed bin int static options (constant) init (0); dcl NL char (1) int static options (constant) init (" "); dcl aptr ptr; /* arg list ptr */ dcl arg_count fixed bin; dcl (ec, code) fixed bin (35); dcl full_msg char (512) aligned;/* message buffer */ dcl proc_msg char (256) aligned;/* msg from ioa_$general_rs based on args */ dcl short char (8) aligned; /* short error_table_ msg */ dcl long char (100) aligned;/* long error_table_ msg */ dcl target fixed bin; dcl sev fixed bin; dcl (lth, n, l) fixed bin; dcl type fixed bin; dcl packed bit (1) aligned; dcl ndims fixed bin; dcl prec fixed bin; dcl scale fixed bin; dcl arg_ptr ptr; dcl based_code fixed bin (35) based; dcl iodd_stat_p ptr ext static; dcl convert_status_code_ entry (fixed bin (35), char (*) aligned, char (*) aligned); dcl decode_descriptor_ ext entry (ptr, fixed bin, fixed bin, bit (1) aligned, fixed bin, fixed bin, fixed bin); dcl cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl cu_$arg_list_ptr entry (ptr); dcl cu_$arg_count entry (fixed bin); dcl ioa_$general_rs entry options (variable); dcl iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35)); dcl (addr, substr, rtrim, length, bin) builtin; %page; call cu_$arg_count (arg_count); /* how many args passed? */ if arg_count < 4 then return; /* must be something or forget it */ stat_p = iodd_stat_p; /* copy the iodd_static ptr for easy ref */ target = a_target; /* copy the args */ sev = a_sev; if ^(target = master | target = slave) then target = both; /* validate the args */ if ^(sev = log | sev = error) then sev = normal; l = 1; /* ready to build full message at char 1 */ if proc_name ^= "" then do; n = length (rtrim (proc_name)); /* how long is it? */ full_msg = substr (proc_name, 1, n) || ": "; /* insert name */ l = l + n + 2; /* bump the index */ end; call cu_$arg_list_ptr (aptr); call cu_$arg_ptr (3, arg_ptr, (0), ec); call decode_descriptor_ (aptr, 1, type, packed, ndims, prec, scale); if (type = real_fix_bin_1_dtype) & (packed = "0"b) then code = arg_ptr -> based_code; else do; intype = 2 * type + bin (packed, 1); if (type >= bit_dtype) & (type <= varying_char_dtype) then inclength = prec; else do; info.inscale = scale; info.inprec = prec; end; outtype = 2 * real_fix_bin_1_dtype; outfo.outscale = 0; outfo.outprec = 35; call assign_ (addr (code), outtype, outscale_prec, arg_ptr, intype, inscale_prec); end; if code ^= 0 then do; /* will there be an error_table message? */ short, long = ""; /* clear the strings */ call convert_status_code_ (code, short, long); n = length (rtrim (long)); /* how long is it */ substr (full_msg, l) = substr (long, 1, n) || NL; /* fill it in and start a new line */ l = l + n + 1; /* bump the index */ end; if arg_count > 4 then do; /* is there an additional message from the proc? */ call ioa_$general_rs (aptr, 5, 6, proc_msg, lth, "0"b, "0"b); /* format the msg */ if lth > 0 then do; /* is anything there */ substr (full_msg, l) = substr (proc_msg, 1, lth) || NL; /* add in a new line */ l = l + lth + 1; end; end; lth = l - 1; /* this is the number of chars that were good */ if lth < 1 then return; /* just checking */ /* now see who we will tell about it */ if sev = log then do; /* just a message for the log */ if target = slave | target = both then if iodd_static.slave.active & iodd_static.slave.log_msg then do; /* maybe to the slave */ call write_msg (iodd_static.slave_out, ec); if ec ^= 0 then target = master; /* OOPS - tell the master */ end; else target = master; /* if not possible, tell someone */ if target = master | target = both then call write_msg (iodd_static.log_iocbp, ec); /* send it to the iodd log */ end; else if sev = error then do; /* it is an error message, sound the beeper */ if target = slave | target = both then /* protect the slave */ if iodd_static.slave.active & iodd_static.slave.print_errors then do; call write_msg (iodd_static.slave_out, ec); if ec ^= 0 then target = master; end; else target = master; if target = master | target = both then call write_msg (iodd_static.error_io, ec); /* avoid error_output due to broadcast */ end; else do; /* the normal operator message case */ if target = slave | target = both then if iodd_static.slave.active then do; call write_msg (iodd_static.slave_out, ec); if ec ^= 0 then target = master; end; else target = master; /* be sure someone gets the message */ if target = master | target = both then call write_msg (iodd_static.master_out, ec); end; return; write_msg: proc (iocbp, ec); dcl ec fixed bin (35); dcl iocbp ptr; call iox_$put_chars (iocbp, addr (full_msg), lth, ec); return; /* if it didn't work...well we tried */ end write_msg; %page; %include desc_dcls; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include std_descriptor_types; end iodd_msg_;  iodd_parse_.pl1 10/28/88 1404.4rew 10/28/88 1230.2 73548 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * ******************************************** */ /****^ HISTORY COMMENTS: 1) change(88-06-13,Brunelle), approve(88-06-13,MCR7911), audit(88-10-21,Wallman), install(88-10-28,MR12.2-1199): Created. END HISTORY COMMENTS */ /* format: style4 */ /* This is a common procedure containing entrypoints to parse an input command line and to parse a major/minor arguments string */ iodd_parse_: proc; /* no entry here */ return; /* Arguments */ /* Following two are for iodd_parse_$args */ dcl key char (*) var parameter; /* key string to look for */ dcl arg_string char (*) parameter; /* string to examine */ /* following three are for iodd_parse_$command */ dcl command_line char (*) parameter; /* command line to parse */ dcl elements_ptr ptr parameter; /* pointer to the structure we fill in */ dcl ec fixed bin (35); /* error code */ /* External Procedures & Variables */ dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$bigarg fixed bin (35) ext static; dcl error_table_$unbalanced_quotes ext fixed bin (35); /* Builtins */ dcl (addr, index, length, ltrim, rtrim, search, substr, verify) builtin; /* Internal Static */ dcl COMMA char (1) defined QUOTE_COMMA pos (2); dcl NEWLINE char (1) defined WHITESPACE pos (4); dcl SPACE_OR_TAB char (2) defined WHITESPACE pos (2); dcl QUOTE char (1) defined QUOTE_COMMA pos (1); dcl QUOTE_COMMA char (2) int static options (constant) init (""","); /* whitespace - BS SP HT NL VT NP CR */ dcl WHITESPACE char (7) static options (constant) init (" "); /* Automatic */ dcl break_char_index fixed bin; /* location of break char following keyword string */ dcl first char (1) based (addr (line)); /* first char of the line */ dcl i fixed bin; /* do index */ dcl keyword_location fixed bin; /* location of keyword within arg_string */ dcl len fixed bin; /* general index variable for length */ dcl line char (128); /* internal copy of the command line */ dcl one_char char (1); /* obvious */ dcl start fixed bin; /* starting position of the token */ dcl string_offset fixed bin; dcl temp char (256) var; dcl value char (256) var; dcl 1 elements aligned based (elements_ptr), /* this is the structure we fill in */ 2 max_wanted fixed bin, /* the number of tokens to look for */ 2 n fixed bin, /* number of valid tokens */ 2 token (max_wanted) char (64) var; /* save exact length with each */ %page; args: entry (key, arg_string) returns (char (256) var); /* this entry is a common argument parsing routine used by the I/O daemon driver processes on the system. It was originally extracted from remote_driver_.pl1. Each of the drivers on the system use this routine to parse the data in their major and/or minor argument strings. The format for data within the strings is [optional space] [, [optional space] ] */ /* make gross pass to see if key exists in input string. if not, get out quick */ keyword_location = index (arg_string, key); if keyword_location = 0 then do; return (""); end; /* the keyword exists. if it is 1st keyword or preceeded by whitespace, it is valid keyword; otherwise it is last part of another type of keyword and we must look further */ if keyword_location > 1 then do; try_again: one_char = substr (arg_string, keyword_location - 1, 1); if index (WHITESPACE, one_char) ^= 0 then /* preceeded by whitespace */ goto copy_to_temp_string; if one_char = COMMA then /* preceeded by a comma */ goto copy_to_temp_string; if keyword_location < length (arg_string) then do; string_offset = keyword_location + length (key); keyword_location = index (substr (arg_string, string_offset), key); if keyword_location ^= 0 then do; keyword_location = keyword_location + string_offset - 1; go to try_again; end; end; return (""); end; else do; /* copy all of string following the keyword, removing leading and trailing whitespace */ copy_to_temp_string: string_offset = keyword_location + length (key); temp = rtrim (ltrim (substr (arg_string, string_offset), WHITESPACE), WHITESPACE); if temp = "" then do; /* all blanks */ return (""); end; /* look for a break char to terminate end of return string. If no break char is found, return value is rest of string so just return it as is */ break_char_index = search (temp, QUOTE_COMMA); if break_char_index = 0 then do; return (temp); end; /* found some sort of break char, must process based on type of character it is. If it is a comma, this terminates the end of the string to return so return everything up to the comma */ if substr (temp, break_char_index, 1) = COMMA then do; return (substr (temp, 1, break_char_index - 1)); end; /* the break character was a start quote then we must look for an end quote */ /* copy everything up to the quote into return string */ value = substr (temp, 1, break_char_index - 1); find_level_1: if break_char_index = length (temp) then /* quotes don't balance */ return (""); temp = substr (temp, break_char_index + 1); /* skip starting quote */ break_char_index = search (temp, QUOTE); /* look for closing quote */ /* allow commas within quotes */ if break_char_index = 0 then do; /* quotes do not balance */ return (""); /* so return nothing */ end; /* copy everything up to the new quote */ value = value || substr (temp, 1, break_char_index - 1); if break_char_index = length (temp) then /* unbalanced quotes */ return (""); if substr (temp, break_char_index + 1, 1) = QUOTE then do; /* double quote? */ value = value || QUOTE; /* replace with a single quote */ break_char_index = break_char_index + 1;/* move the index */ go to find_level_1; /* and search on */ end; end; temp = value; return (rtrim (temp)); %page; command: entry (command_line, elements_ptr, ec); /* entry to parse the command_line string into a structure containing one element per token up to the maximum requested */ elements.n = 0; /* initialize to none found */ len = length (command_line); /* how long is it? */ if len > 127 then do; /* if too long to leave trailing blank */ ec = error_table_$bigarg; /* give a code */ return; /* and quit now */ end; line = command_line; /* copy the string */ i = index (line, NEWLINE); /* see if there was a nl char */ if i > 0 then line = substr (line, 1, i - 1); /* and drop it and the rest */ do i = 1 to max_wanted; /* look for max_wanted tokens */ len = verify (line, SPACE_OR_TAB); /* correct for leading spaces or tabs */ if len = 0 then go to tally; /* nothing left so quit */ if len > 1 then line = substr (line, len); /* left justify */ start = 1; /* assume the first char is good */ if first = QUOTE then do; /* different action for quoted string */ start = 2; /* so we will skip the quote later */ len = index (substr (line, 2), QUOTE); /* find the closing quote */ if len = 0 then do; ec = error_table_$unbalanced_quotes; /* too bad */ return; /* return what we found */ end; end; else len = search (line, SPACE_OR_TAB); /* find end of token */ if len > 64 then do; /* complain if too long */ ec = error_table_$bigarg; return; /* return what we found */ end; elements.n = elements.n + 1; /* add one more token to the list */ elements.token (elements.n) = substr (line, start, len - 1); line = substr (line, len + start); /* get ready for the next one...left shift */ end; tally: if elements.n = 0 then /* if none found, give an error */ ec = error_table_$noarg; else ec = 0; return; end iodd_parse_;  iodd_quit_handler_.pl1 10/28/88 1403.5rew 10/28/88 1233.0 109035 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ iodd_quit_handler_: proc; /* This is the standard quit handler for the I/O daemon driver process */ /* Its primary function is to see who sent the quit by looking for input. */ /* We assume that the first to give a response is the one who QUIT, and will */ /* accept the next input line as a command to be passed to the I/O daemon */ /* command processor. If all is well, we will return to where the */ /* Quit took place. However, the command processor may signal a condition */ /* and never return. */ /* Originally coded in Sept 1973 by Robert S. Coren */ /* Rewritten in Feb 1975 by J. C. Whitmore for the access isolation */ /* mechanism and general restructuring of the driver process. */ /* Modified Dec 1975 by J. C. Whitmore to pass quit/signal state to command processor and */ /* to avoid writing on the slave stream if detached. */ /* Modified Aug 1977 by J. C. Whitmore to use the iodd_get_cmd_ subroutine for reading cmd lines */ /* Modified Nov 1977 by J. C. Whitmore to use iodd_msg_ for operator messages */ /* Modified Mar 1978 by J. C. Whitmore to use parameter to set auto start delay time */ /* Modified Mar 1979 by J. C. Whitmore to give proc name in last error call */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. END HISTORY COMMENTS */ /* ENTRIES */ dcl continue_to_signal_ entry (fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl iodd_command_processor_ entry (fixed bin, fixed bin, char (*), fixed bin (35)); dcl iodd_msg_ entry options (variable); dcl iodd_get_cmd_ entry (ptr, fixed bin, fixed bin, bit (36), char (*), fixed bin, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry); dcl timer_manager_$reset_alarm_call entry (entry); /* AUTOMATIC */ dcl code fixed bin (35); dcl terminal (2) ptr; dcl line char (132); /* input from terminal */ dcl message char (64); /* what to say after a quit */ dcl junk fixed bin; /* length from ioa_$rsnnl */ dcl nchars fixed bin; /* number of chars read */ dcl state fixed bin; /* quit = 2, signal handler = 3 */ dcl control bit (36); /* control flags for the get cmd subr */ dcl 1 ctl based (addr (control)), 2 wait_for_input bit (1), 2 prompt_master bit (1), 2 prompt_slave bit (1), 2 pad bit (33); dcl iodd_stat_p ptr ext static; /* where stat_p is stored */ dcl none fixed bin int static options (constant) init (0); dcl master fixed bin int static options (constant) init (1); /* constant indicating input from master device */ dcl slave fixed bin int static options (constant) init (2); /* constant indicating input from slave */ dcl both fixed bin int static options (constant) init (0); /* constant for output to both master & salve */ dcl normal fixed bin int static options (constant) init (1); dcl error fixed bin int static options (constant) init (2); dcl id char (20) int static options (constant) init ("iodd_quit_handler_"); dcl quit_cmd_level fixed bin int static options (constant) init (4); dcl signal_cmd_level fixed bin int static options (constant) init (5); dcl master_cmd bit (1); /* true if master gave a cmd at this level */ dcl slave_cmd bit (1); /* true if the slave gave a cmd at this level */ dcl last_cmd fixed bin; /* who gave the last cmd line */ dcl source fixed bin; /* who gave the current command line */ dcl slave_input_state bit (1); /* last setting of the slave accept input switch */ dcl 1 form_data aligned, /* data from ctl_dim_ for form alignment */ 2 page_length fixed bin, /* length of logical page */ 2 line_length fixed bin, /* number of chars before folding line */ 2 line_no fixed bin, /* current line on the page */ 2 carriage_pos fixed bin, /* position of next char on the line */ 2 aligned bit (1) unal, /* "1"b if we are simulating form feeds */ 2 pad bit (35) unal; /* CONDITIONS */ dcl (cleanup, any_other, alrm) condition; /* BUILTINS */ dcl (addr, null, substr, rtrim) builtin; /* BASED STRUCTURES AND INCLUDE FILES */ %include iod_tables_hdr; %include iodd_static; %page; stat_p = iodd_stat_p; /* copy ptr to iodd_static */ control = "0"b; ctl.prompt_master = "0"b; /* get ready to ask for help */ ctl.prompt_slave = "1"b; if iodd_static.request_in_progress then iodd_static.quit_during_request = "1"b; if iodd_static.request_in_progress then if iodd_static.assigned_devices > 1 then call ioa_$rsnnl ("* QUIT * request in progress on device: ^a", message, junk, iodd_static.output_device); else call ioa_$rsnnl ("* QUIT * request in progress", message, junk); else message = "* QUIT *"; call iox_$control (iodd_static.master_in, "resetread", null, code); /* we want clean input */ if iodd_static.slave.active & iodd_static.slave.accept_input & iodd_static.allow_quits then do; call iox_$control (iodd_static.slave_in, "resetread", null, code); source = both; /* send message to both master and slave */ end; else source = master; call iodd_msg_ (normal, source, 0, "", message); call timer_manager_$alarm_call (iodd_static.auto_start_delay, "11"b, auto_start); /* set a timer to automatically restart */ /* if no command is given within 60 seconds */ on alrm call continue_to_signal_ (code); /* let this go through */ on any_other begin; last_cmd = master; /* stop the auto start proc */ call timer_manager_$reset_alarm_call (auto_start); /* in case this frame goes away */ call continue_to_signal_ (code); end; message = "quit"; state = quit_cmd_level; /* tell the command processor it was a quit */ iodd_static.quit_signaled = "1"b; /* set the flag for anyone who is watching */ join: slave_input_state = iodd_static.slave.accept_input; /* in case of a cleanup */ if ^iodd_static.slave.allow_quits then /* if no quits allowed, don't read the terminal */ iodd_static.slave.accept_input = "0"b; on cleanup begin; call timer_manager_$reset_alarm_call (auto_start); /* now we know the frame is gone */ iodd_static.slave.accept_input = slave_input_state; if iodd_static.slave.active & iodd_static.allow_quits then call iox_$control (iodd_static.slave_in, "quit_enable", null, (0)); end; master_cmd = "0"b; /* no commands received yet */ slave_cmd = "0"b; last_cmd = none; terminal (master) = iodd_static.master_in; /* copy the iocb ptrs for easy use */ terminal (slave) = iodd_static.slave_in; wait: ctl.wait_for_input = "1"b; /* say to wait for a command */ read: call iodd_get_cmd_ (addr (line), 128, nchars, control, rtrim (message), source, code); if source = master then if iodd_static.slave.active then /* don't let the slave interrupt the master */ call iox_$control (iodd_static.slave_in, "quit_disable", null, (0)); if source = none then go to start; /* last cmd was start, so let er roll */ if source = master then master_cmd = "1"b; /* if master gave the cmd */ else slave_cmd = "1"b; /* otherwise it was the slave */ last_cmd = source; /* who gave the last cmd */ ctl.wait_for_input = "0"b; /* gotsome input */ call iodd_command_processor_ (source, state, substr (line, 1, nchars), code); if iodd_static.slave.allow_quits then do; /* let slave get a chance */ iodd_static.slave.accept_input = (iodd_static.slave.accept_input | slave_input_state); call iox_$control (iodd_static.slave_in, "quit_enable", null, (0)); end; else do; /* not accepting input */ if iodd_static.slave.accept_input then slave_input_state = "1"b; /* in case set */ iodd_static.slave.accept_input = "0"b; /* hold off for now */ end; if code = 2 then go to read; /* let's roll...but first check for input */ if code = 0 | code = 1 then go to wait; /* we want more input...no errors */ call iox_$control (terminal (source), "resetread", null, (0)); /* clear input after bad command */ go to wait; /* and wait for correct input */ start: call timer_manager_$reset_alarm_call (auto_start);/* just in case.... */ /* We can continue from the point of interruption now, unless operator has forced a "hold" */ if iodd_static.forms then /* check alignment if simulating forms */ if iodd_static.ctl_term.attached then do; /* if the terminal is there */ call iox_$control (iodd_static.slave_out, "form_status", addr (form_data), code); if code ^= 0 then do; /* something was wrong */ iodd_static.forms = "0"b;/* drop the forms */ call iodd_msg_ (error, slave, code, id, "Control terminal form simulation terminated."); ctl.prompt_master = "1"b;/* force operator action */ ctl.prompt_slave = "1"b; /* slave can answer */ call iox_$control (iodd_static.master_in, "resetread", null, (0)); call iox_$control (iodd_static.slave_in, "resetread", null, (0)); go to wait; end; if ^form_data.aligned then do; /* dim says not aligned...so, */ call iodd_msg_ (normal, slave, 0, "", "Control forms not aligned."); /* tell slave opr */ iodd_static.slave_hold = "1"b; go to wait; end; end; else iodd_static.forms = "0"b; /* not legal if no ctl term attached */ if last_cmd = slave then /* do we owe the master a courtesy message? */ if master_cmd then call iodd_msg_ (normal, master, 0, "", "^a driver continuing.", iodd_static.major_device); else ; else if slave_cmd then /* do we owe the slave a courtesy message? */ if iodd_static.slave.active then /* be sure it wasn't detached since last prompt */ call iodd_msg_ (normal, slave, 0, "", "^a driver continuing.", iodd_static.major_device); iodd_static.slave.accept_input = slave_input_state; call iox_$control (iodd_static.master_in, "start", null, (0)); /* be sure we don't lose a wakeup */ if iodd_static.slave.active then do; call iox_$control (iodd_static.slave_in, "start", null, (0)); /* be sure we don't lose a wakeup */ end; return; /* let'er roll */ command_level: entry; /* This entry is used by the signal handler in test mode to allow most commands to be used after the process has been initialized. */ control = "0"b; ctl.prompt_master = "1"b; /* only tell the master of the problem */ ctl.prompt_slave = "0"b; message = "iodd signal"; /* new cmd level name */ state = signal_cmd_level; /* tell the command processor it was from an unclaimed signal */ iodd_static.master_hold = "1"b; /* force a response from the master */ go to join; /* now join the main procedure */ init: entry (aptr); dcl aptr ptr; stat_p = aptr; /* init the pointer for iodd_static */ return; auto_start: proc; /* internal proc to automatically "start" after a quit if no commands are given in 60 seconds */ if iodd_static.re_init_in_progress then return; if last_cmd = none then do; call iodd_msg_ (normal, both, 0, "", "Automatic Start Given"); go to start; end; else return; /* wasn't that easy? */ end auto_start; end iodd_quit_handler_;  iodd_signal_handler_.pl1 10/28/88 1403.5rew 10/28/88 1233.0 98397 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ iodd_signal_handler_: proc; /* Unclaimed signal handler for I/O Daemon driver process. In "test" mode it will invoke the "debug" command; otherwise it will attempt to move on to whatever is to be done next. */ /* Coded September 1973 by Robert S. Coren */ /* Modified January 1975 by J. C. Whitmore to work with iodd_ */ /* Modified November 1975 by M. A. Braida to special case seg_fault_error on user's segment */ /* Modified Sept 1977 by J. C. Whitmore to not terminate driver status segs (now done by iodd_) */ /* Modified by J. C. Whitmore, 11/78, to use iodd_msg_ instead of ioa_ for messages */ /* Modified by J. C. Whitmore, 3/79, to correct a misplaced end statement */ /* Modified BIM 84-01-06 for default_restart, quiet_restart */ /* Modified by C. Marker, 02/23/85, to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 iod tables. END HISTORY COMMENTS */ dcl bel_string char (40) aligned int static; dcl stars char (50) aligned int static options (constant) init ((5)"**********"); dcl condition char (32); /* fixed length string for condition name */ dcl io_stat bit (72) aligned; dcl ec fixed bin (35); /* error code */ dcl ios_$attach entry (char (*) aligned, char (*), char (*), char (*), bit (72) aligned); dcl ios_$order entry (char (*), char (*), ptr, bit (72) aligned); dcl iodd_msg_ entry options (variable); dcl new_proc entry (); dcl iodd_quit_handler_$command_level entry (); dcl debug entry; dcl timer_manager_$sleep entry (fixed bin (71), bit (2) aligned); dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr); dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl continue_to_signal_ entry (fixed bin (35)); dcl get_system_free_area_ entry (ptr); dcl areap ptr; dcl msgp ptr; dcl msg_len fixed bin; dcl err_message char (msg_len) based (msgp); dcl sys_area area (262144) based (areap); dcl id char (24) int static options (constant) init ("iodd_signal_handler_"); dcl master fixed bin int static options (constant) init (1); dcl both fixed bin int static options (constant) init (0); dcl error fixed bin int static options (constant) init (2); dcl normal fixed bin int static options (constant) init (1); dcl recursion_count fixed bin int static init (0); /* depth of signals */ dcl (null, fixed, addr, baseno) builtin; dcl (resume, any_other, cleanup, daemon_again, daemon_new_device) condition; %page; dcl 1 local_condition_info aligned like condition_info; /* */ on cleanup call ios_$order ("user_i/o", "start", null, io_stat); local_condition_info.version = condition_info_version_1; /* version of the condition_info structure */ call find_condition_info_ (null (), addr (local_condition_info), ec); /* get condition data */ condition = local_condition_info.condition_name; /* change to fixed string for the compiler */ if condition = "alrm" then do; /* pass these on...quits will never come here */ pass_on: call continue_to_signal_ (ec); /* pass the condition on to someone else */ return; end; condition_info_header_ptr = local_condition_info.info_ptr; if condition = "cput" then goto pass_on; if condition = "finish" then goto pass_on; if iodd_static.test_entry then if condition = "mme2" then go to pass_on; /* to be able to use debug */ else if condition = "program_interrupt" then go to pass_on; if condition = "command_error" then return; if condition = "command_question" then return; if condition_info_header_ptr ^= null then if condition_info_header.quiet_restart | condition_info_header.default_restart then go to pass_on; if condition = "daemon_new_device" then go to proc_dies; /* this procedure should never see this */ /* that's all for the benign system conditions, time to be careful */ if ^iodd_static.recursion_flag then recursion_count = 0; /* coming from known state? */ iodd_static.recursion_flag = "1"b; /* start watching for trouble */ recursion_count = recursion_count + 1; /* increment the counter */ if recursion_count > 4 then call new_proc; /* maximum trouble, calls for drastic action */ if recursion_count = 3 then call iodd_msg_ (error, both, 0, id, "recursive errors, driver may new_proc."); if condition = "no_coord" then /* for this condition.... */ if iodd_static.no_coord_flag then do; /* be sure process is ready to accept */ /* This condition is signalled if the coordinator process has gone away. We will attempt */ /* to reinitialize, but not until the coordinator process id recorded in iodc_data */ /* has changed (signifying the advent of a new coordinator). */ iodd_static.re_init_in_progress = "1"b; /* let others know what happened */ call iodd_msg_ (error, both, 0, id, """no_coord"" condition signalled."); go to iodd_static.no_coord_label; /* invoke all the cleanup handlers */ end; if condition = "re_init" | condition = "resume" then do; on any_other signal daemon_new_device; /* This condition is signalled when the driver is in trouble. We will attempt */ /* to reinitialize the device specified by the operator without asking */ /* him to input the device again. */ iodd_static.re_init_in_progress = "1"b; call iodd_msg_ (error, both, 0, id, "Driver starting reinitialization"); go to iodd_static.re_init_label; /* first catch the cleanup handlers */ end; if condition = "io_error" then do; /* in this case we have to be careful about */ /* writing on the slave stream to avoid another error */ /* the control terminal probably got hung up */ call timer_manager_$sleep (5, "11"b); /* give the hangup handler a chance */ iodd_static.master_hold = "1"b; /* force operator attention */ if recursion_count > 3 then go to proc_dies; /* multiple times is too much */ call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* only talk to the master */ if iodd_static.slave.active | iodd_static.ctl_term.attached then do; iodd_static.forms = "0"b; /* can't simulate forms now */ iodd_static.slave.allow_quits = "0"b; iodd_static.slave.accept_input = "0"b; iodd_static.slave.print_errors = "0"b; call iodd_msg_ (error, both, 0, id, "^/^a^/Condition ""io_error"" signalled. Slave functions have been terminated.^/^a", stars, stars); end; if request_in_progress then do; /* maybe we can continue */ call iodd_msg_ (normal, both, 0, "", "Current request will be restarted."); signal daemon_again; /* restart the request */ end; end; if condition = "seg_fault_error" then do; /* find out if current segment caused the condition */ mcp = local_condition_info.mc_ptr; /* set machine condition ptr */ scup = addr (mc.scu); /* find segment number in machine condition */ if fixed (baseno (iodd_static.segptr), 17, 0) = fixed (scu.tpr.tsr, 17, 0) then /* if the segment numbers are the same ... */ go to driver_default; /* skip the long error message */ end; call get_system_free_area_ (areap); msgp = null; call condition_interpreter_ (areap, msgp, msg_len, 3, local_condition_info.mc_ptr, condition, local_condition_info.wc_ptr, local_condition_info.info_ptr); if msgp ^= null then do; call iodd_msg_ (error, both, 0, id, err_message); free msgp -> err_message in (sys_area); end; else call iodd_msg_ (error, both, 0, id, "^a condition signalled.", condition); if condition = "stack" then go to proc_dies; /* we will not attempt to deal with this */ on resume go to continue; /* to get around CP in test mode */ if iodd_static.test_entry then do; /* give programmer chance to find out what happened */ if ^iodd_static.initialized then do; /* be careful about blocking before init is done */ call iodd_msg_ (error, master, 0, id, "Warning - initialization is not complete"); /* some commands won't work */ call iodd_msg_ (normal, master, 0, "", "Calling debug"); call debug; /* this should do the trick */ end; else call iodd_quit_handler_$command_level (); /* give programmer a shot */ return; /* assume problem was fixed, so start */ end; continue: revert resume; /* drop the handler...we may signal it */ if recursion_count > 1 then call iodd_msg_ (error, both, 0, id, "^a^/Condition ^a signalled while handling unclaimed signal.^/^a^a", stars, condition, stars, bel_string); if recursion_count > 2 then do; /* after two conditions, give up */ proc_dies: on any_other call new_proc; /* dont take chances, we are in trouble */ call iodd_msg_ (error, both, 0, id, "New process will be created."); call new_proc (); end; driver_default: if iodd_static.initialized then do; /* is there enough data to do more? */ call driver_default_handler (addr (local_condition_info)); /* see if the driver module needs the condition */ /* the driver module is responsible for cleaning up */ /* any requests in progress */ signal resume; /* if we return, pass back to iodd_listen_ */ end; else do; /* no data, tell someone and commit suicide */ call iodd_msg_ (error, both, 0, id, "^a^/Condition ^a occured before full initialization.", stars, condition); signal daemon_new_device; end; go to proc_dies; /* this should never happen, but .... */ init: entry (a_ptr); dcl a_ptr ptr; stat_p = a_ptr; if iodd_static.test_entry then bel_string = ""; /* null for testing */ else bel_string = (40)""; /* 40 bells (007(8)) */ return; %page; %include condition_info; %page; %include condition_info_header; %page; %include driver_ptr_list; %page; %include driver_status; %page; %include iod_event_message; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include mc; %page; %include mseg_message_info; %page; %include request_descriptor; end iodd_signal_handler_;  output_request_.pl1 10/28/88 1403.5rew 10/28/88 1229.6 430488 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ output_request_: proc (a_stream_name, a_element_size, a_stat_p, a_banner_proc, a_code); /* General procedure for doing output for an I/O daemon device driver */ /* Rewritten from old procedure "io_daemon" in August 1973 by Robert S. Coren */ /* Modified in March 1975 by J.C. Whitmore during driver restructuring */ /* Modified in December 1975 by M. A. Braida to include new restart capabilities and update the accounting mechanism */ /* modified 05/76 by THVV for set_kst_attributes & force deactivation */ /* Modified 06/76 by J. C. Whitmore to fix translate hardware bug */ /* Modified June 1976 by J. L. Homan to accommodate charging by line count instead of block count. */ /* modified July 1976 by THVV for message notification */ /* Modified Nov 1977 by J. C. Whitmore for minor bug fixed and remote driver compatability */ /* Modified Mar 1978 by J. C. Whitmore for new dprint_msg format and driver upgrade */ /* Modified Aug 1978 by J. C. Whitmore for: auto defer by time estimate, separation of charge queue and request queue, no deletion if device error occurs, and further upgrade. */ /* Modified Nov 1978 by J. C. Whitmore to add path to device error msg and to notify user on deferring request */ /* Modified Mar 1979 by J. C. Whitmore to correct string size on some assignments */ /* Modified by J. C. Whitmore, 1/80, to limit the scope of system_privileges_ for send mail (V5.4) */ /* Modified: February 23, 1985 by C. Marker if the page labels are not the same as the access class of the segment a message will be logged. Changed to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-07-31,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Changed to implement line numbered output. 2) change(88-06-03,Brunelle), approve(88-06-03,MCR7911), audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 I/O daemon tables. END HISTORY COMMENTS */ dcl a_stream_name char (*); /* stream to write the output on */ dcl a_element_size fixed bin; /* number of bits in each stream element */ dcl a_stat_p ptr; /* the value of stat_p from caller */ dcl a_banner_proc entry; /* procedure to be called for head and tail banners */ dcl a_code fixed bin (35); /* error code....used for driver_fatal_error */ /* AUTOMATIC */ dcl abort_msg char (256) var; /* string for bad error messages */ dcl access_class bit (72) aligned; /* access class of user file */ dcl auth bit (72) aligned; /* authorization used to set banner access class */ dcl auth_string char (680); /* string form of auth */ dcl banner_proc entry variable options (variable); /* proc to be called for messages */ dcl chgsw bit (1) aligned; /* do we charge for this request/copy */ dcl code fixed bin (35); dcl copies_left fixed bin; dcl delete_msg char (32); dcl desc_ptr ptr; dcl dest char (24) aligned; dcl device_error bit (1); dcl dr_ptr ptr; /* pointer to driver status segment */ dcl el_size fixed bin; dcl ename char (32) aligned; /* entry name of file for output */ dcl err_mess char (200) var; dcl fcbp ptr; dcl full_path char (168) aligned; dcl head char (64) aligned; dcl header_sw bit (1); dcl i fixed bin; /* random variable */ dcl iocbp ptr; /* iocb pointer for request stream */ dcl l fixed bin; dcl last_error_count fixed bin; dcl lg_msg char (100) aligned; dcl mailname char (32) aligned; dcl max_comp fixed bin; /* highest msf component number */ dcl msg char (256) aligned; dcl new_clock fixed bin (71); dcl new_cpu fixed bin (52); dcl new_pp fixed bin; dcl new_rate fixed bin; dcl new_waits fixed bin (35); dcl nret fixed bin; dcl old_clock fixed bin (71); dcl oldmodes char (256); dcl old_cpu fixed bin (52); dcl old_pp fixed bin; dcl old_rate fixed bin; dcl old_waits fixed bin (35); dcl pverb char (5) aligned; dcl req_stream char (32); dcl save_code fixed bin (35); dcl seconds fixed bin; /* number of seconds to do one copy */ dcl segp ptr; dcl start_segp pointer; dcl short_msg char (8) aligned; dcl time_est fixed bin; /* number of seconds estimated to do request */ dcl total_bits fixed bin (35); dcl user_dir char (168) aligned;/* directory containing users' segment */ dcl val fixed bin; /* for validation level */ /* INTERNAL STATIC */ dcl bad_chars char (4) int static; dcl err_label label int static; /* point of return from condition handler */ dcl fault_name char (32) aligned int static; dcl first_call bit (1) static init ("1"b); /* TRUE on first call */ dcl privileged bit (1) static init ("1"b); /* TRUE if we can call phcs_ */ dcl sys_priv bit (1) static init ("1"b); /* True if process can call system_privilege_ */ dcl request_data_p ptr int static; /* ptr to REQUEST for set_single_copy entrry */ /* CONSTANTS */ dcl both fixed bin int static options (constant) init (0); dcl error fixed bin int static options (constant) init (2); dcl error_msg fixed bin int static options (constant) init (3); /* value for print error message */ dcl factor float bin int static options (constant) init (0.75e0); /* smoothing factor for rate estimate */ dcl header fixed bin int static options (constant) init (1); /* value for header wanted */ dcl id char (24) int static options (constant) init ("output_request_"); dcl log fixed bin int static options (constant) init (0); dcl master fixed bin int static options (constant) init (1); dcl quiet bit (1) int static options (constant) init ("0"b); dcl restart_source fixed bin int static init (1); dcl slave fixed bin int static options (constant) init (2); dcl stars char (40) int static options (constant) aligned init ((40)"*"); /* For error messages */ dcl tail fixed bin int static options (constant) init (2); /* value for tail wanted */ dcl tell_user bit (1) int static options (constant) init ("1"b); dcl NL char (1) int static options (constant) init (" "); dcl TAB char (1) int static options (constant) init (" "); /* the tab character */ dcl VT char (1) int static options (constant) init (" "); /* the vertical tab */ dcl FF char (1) int static options (constant) init (" "); /* and the form feed */ /* EXTERNAL STATIC */ dcl access_operations_$io_daemon_set_page_labels bit (36) aligned external static; dcl error_table_$improper_data_format fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$moderr fixed bin (35) ext static; dcl error_table_$dirseg ext static fixed bin (35); dcl error_table_$ai_restricted ext static fixed bin (35); /* EXTERNAL ENTRIES */ dcl access_audit_gate_$log_obj_ptr_user entry options (variable); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl clock_ ext entry returns (fixed bin (71)); /* gets clock time */ dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_status_code_ ext entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cpu_time_and_paging_ entry (fixed bin (35), fixed bin (52), fixed bin); dcl cu_$level_get entry (fixed bin); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl date_time_ entry (fixed bin (71), char (*) aligned); dcl hcs_$fs_get_mode ext entry (ptr, fixed bin (5), fixed bin (35)); dcl hcs_$fs_get_path_name entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)); dcl hcs_$get_access_class entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin (35)); dcl hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin (5), fixed bin (35)); dcl hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (2), fixed bin (24), fixed bin (35)); dcl io_daemon_account_ entry (entry, ptr); dcl ioa_$ioa_stream entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl iodd_msg_ entry options (variable); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$modes entry (ptr, char (*), char (*), fixed bin (35)); dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); dcl iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35)); dcl msf_manager_$close entry (ptr); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); dcl msf_manager_$open entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)); dcl phcs_$deactivate entry (ptr, fixed bin (35)); dcl phcs_$set_kst_attributes entry (fixed bin, ptr, fixed bin (35)); dcl read_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl send_mail_$access_class entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned, fixed bin (35)); dcl system_privilege_$ipc_priv_on entry (fixed bin (35)); dcl system_privilege_$ipc_priv_off entry (fixed bin (35)); dcl system_privilege_$ring1_priv_on entry (fixed bin (35)); dcl system_privilege_$ring1_priv_off entry (fixed bin (35)); /* STRUCTURES */ dcl 1 ksta like kst_attributes aligned int static; dcl 1 counts_data aligned like counts; /* BUILTINS */ dcl (addr, bit, divide, fixed, length, null, substr, ltrim, rtrim, translate) builtin; dcl (baseno, binary, string, unspec, float, min, char) builtin; /* CONDITIONS */ dcl (cleanup, linkage_error, daemon_again, daemon_again_slave, daemon_kill, daemon_save, daemon_defer, daemon_cancel, any_other) condition; /* output_request_: proc (a_stream_name, a_element_size, a_stat_p, a_banner_proc, a_code); MAIN ENTRY */ /* copy arguments and initialize pointers and control switches */ stat_p = a_stat_p; sdb_ptr = null (); banner_proc = a_banner_proc; /* no charging yet */ chgsw = "0"b; fcbp, segp, start_segp = null; req_stream = a_stream_name; el_size = a_element_size; a_code = 0; /* set to zero for now */ if first_call then do; /* Conduct an experiment to see about phcs_ */ bad_chars = TAB || NL || VT || FF; /* define the bad chars for labels */ on linkage_error begin; privileged = "0"b; go to tough; end; string (ksta) = "0"b; call phcs_$set_kst_attributes (binary (baseno (stat_p), 18), addr (ksta), (0)); /* This is a NOP - structure is 0 */ ksta.set.tpd, ksta.value.tpd = "1"b; /* Dont put on bulkstore just for lil ole me */ ksta.set.explicit_deactivate_ok, ksta.value.explicit_deactivate_ok = "1"b; ksta.set.allow_write = "1"b; /* Dont let me wreck user seg by accident */ ksta.set.tus, ksta.value.tus = "1"b; /* Save a vtoc write */ tough: revert linkage_error; first_call = "0"b; /* Now we know */ end; last_error_count = -1; /* invalid error count, hasn't been set */ dr_ptr = iodd_static.driver_ptr; /* get ptr to the current driver status seg */ desc_ptr = addr (dr_ptr -> driver_status.descriptor); /* and to the request descriptor */ mseg_message_info_ptr = desc_ptr; /* first part of desciptor is mseg_message_info */ dmp = addr (dr_ptr -> driver_status.message); /* set dprint_msg default pointer */ request_data_p = addr (REQUEST); /* get ready to handle "single copy" request */ driver_data_p = addr (desc_ptr -> request_descriptor.driver_data); /* get ptr to printer_driver_data */ orderp = addr (counts_data); /* set auto ref ptr to counts structure */ header_sw = ""b; call iox_$look_iocb (req_stream, iocbp, code); if code ^= 0 then do; call driver_fatal_error (code, "Unable to find iocb pointer for output stream."); go to clean_out; end; on cleanup call clean_proc; /* establish a cleanup handler */ sdb_ptr = iocbp; err_label = abort_request; /* Set up master structure used by this pgm. */ string (REQUEST.control_flags) = ""b; /* clear all the flags */ REQUEST.requestor = mseg_message_info.sender_id; REQUEST.continued = desc_ptr -> request_descriptor.continued; REQUEST.restarted = desc_ptr -> request_descriptor.restarted; REQUEST.priority_request = desc_ptr -> request_descriptor.priority_request; REQUEST.separator = "1"b; /* we always want a print separator first time */ REQUEST.device_name = dr_ptr -> driver_status.dev_name_label; REQUEST.request_type = dr_ptr -> driver_status.req_type_label; REQUEST.queue = desc_ptr -> request_descriptor.q; REQUEST.charge_queue = desc_ptr -> request_descriptor.charge_q; /* coord may want a priority rate */ REQUEST.request_no = desc_ptr -> request_descriptor.seq_id; /* coord assigned the number */ REQUEST.restart_no = desc_ptr -> request_descriptor.prev_seq_id; /* previous number of request (0 = not restarted) */ REQUEST.contd_no = desc_ptr -> request_descriptor.contd_seq_id; /* previous number of continued request (0 = not continued) */ REQUEST.dpmp = dmp; if dprint_msg.delete_sw then REQUEST.delete = 1; else REQUEST.delete = 0; REQUEST.bit_count = 0; REQUEST.line_count = 0; REQUEST.page_count = 0; REQUEST.line_nbrs = dprint_msg.line_nbrs; REQUEST.copies = dprint_msg.copies; if ^(REQUEST.continued | REQUEST.restarted) then print_driver_data.copies_done = 0; /* no copies assumed, unless continued or restarted */ /* if none completed, it's not continued */ else if print_driver_data.copies_done < 1 then REQUEST.continued = "0"b; print_driver_data.copies_done = min (print_driver_data.copies_done, REQUEST.copies - 1); /* be sure we do at least one copy */ copies_left = REQUEST.copies - print_driver_data.copies_done; /* might be partly done */ REQUEST.copy_no = print_driver_data.copies_done + 1; /* we start with the next copy */ REQUEST.notify = dprint_msg.notify; REQUEST.output_mode = ""; /* clear in case of error message */ REQUEST.total_charge = 0e0; REQUEST.charge = 0e0; REQUEST.time_start_request = clock_ (); call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request); if dprint_msg.output_module = 1 then do; REQUEST.punsw = 0; pverb = "print"; end; else do; REQUEST.punsw = 1; pverb = "punch"; end; l = length (rtrim (REQUEST.requestor)) - 2; /* get length of Person.Project */ mailname = substr (REQUEST.requestor, 1, l); unspec (send_mail_info) = "0"b; send_mail_info.version = send_mail_info_version_2; send_mail_info.wakeup = "1"b; send_mail_info.always_add = "1"b; send_mail_info.sent_from = REQUEST.request_type; /* get pathname of file for operator and error messages */ user_dir = dprint_msg.dirname; ename = dprint_msg.ename; call ioa_$rsnnl ("^a^[>^]^a", full_path, l, user_dir, (user_dir ^= ">"), ename); REQUEST.full_path = translate (full_path, "", bad_chars); /* force a page fault - HARDWARE BUG WRITEAROUND */ full_path = translate (full_path, "", bad_chars); /* remove bad chars for banner */ dprint_msg.destination = translate (dprint_msg.destination, "", bad_chars); dprint_msg.heading = translate (dprint_msg.heading, "", bad_chars); REQUEST.full_path = full_path; /* save the clean copy */ /* record the processing of this request in the log */ head = dprint_msg.heading; if substr (head, 1, 5) = " for " then /* see if dprint added something */ head = substr (head, 6); /* if so get rid of it */ if head ^= "" then call ioa_$rsnnl ("(for ""^a"" ", msg, l, head); else do; l = 1; /* no heading, get ready for a dest msg */ msg = "("; end; dest = dprint_msg.destination; if dest ^= "" then call ioa_$rsnnl ("^vaat ""^a"")", msg, l, (l), substr (msg, 1, l), dest); else if l = 1 then msg = ""; /* no head or dest case */ else substr (msg, l, 1) = ")"; /* heading only case */ call iodd_msg_ (log, both, 0, "", /* let the subr do the work */ "Request ^d ^a q^d: ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a", REQUEST.request_no, REQUEST.request_type, REQUEST.queue, full_path, (copies_left > 1), copies_left, REQUEST.priority_request, REQUEST.charge_queue, REQUEST.requestor, msg); err_mess = full_path; /* let this sit here in case */ /* Find the access class to use for the banner */ if aim_check_$greater (mseg_message_info.sender_authorization, dr_ptr -> driver_status.min_banner) then auth = mseg_message_info.sender_authorization; else auth = dr_ptr -> driver_status.min_banner; /* mark the output with auth */ call convert_authorization_$to_string (auth, auth_string, code); /* get string form */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; l = length (rtrim (auth_string)); /* how long is the string */ if l > 132 then do; /* when too long for one line */ call convert_authorization_$from_string (access_class, "system_high", code); if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; if aim_check_$equal (auth, access_class) then auth_string = "SYSTEM HIGH"; /* this is shorter */ end; REQUEST.access_class_string = char (auth_string, length (REQUEST.access_class_string)); /* save all we can for the label */ /* check the requestor's access to the pathname he specified */ val = mseg_message_info.sender_level; call check_user_access (user_dir, ename, code); /* use the internal proc to do the work */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; call open_file (user_dir, ename, fcbp, max_comp, code); /* one call does a lot */ if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; on daemon_again begin; /* to restart the current request.... */ restart_source = master; /* talking to the master terminal */ go to check_reprint_copies; end; on daemon_again_slave begin; /* to restart the current request.... */ restart_source = slave; /* talking to slave terminal */ go to check_reprint_copies; end; on daemon_save begin; REQUEST.saved = "1"b; if ^header_sw then go to clean_out; else go to save_request; end; on daemon_defer go to defer_request; /* save it for later */ on daemon_kill go to flush_request; /* flush the current request */ on daemon_cancel go to flush_request; /* likewise, the cancelled flag has been set */ iodd_static.request_in_progress = "1"b; /* ready to accept kill, cancel etc. */ /* now we can restart this request if necessary */ /* with the true total bitcount, we can make an estimate of the time needed to do the request */ if dr_ptr -> driver_status.bit_rate_est > 0 then do; total_bits = REQUEST.bit_count * copies_left; /* total is bits per copy times copies */ time_est = divide (total_bits, dr_ptr -> driver_status.bit_rate_est, 17, 0); if (dr_ptr -> driver_status.defer_time_limit > 0) & /* if a limit is defined, check it */ (time_est > dr_ptr -> driver_status.defer_time_limit + 6) then do; /* allow 6 sec fuzz */ /* so estimate will look bigger than limit in msg */ if REQUEST.priority_request then /* priority requests go any way */ msg = "Defer time limit suspended for priority request."; else if REQUEST.restarted then /* can't defer what is not in the queue */ msg = "Restarted request exceeds time limit but cannot be deferred."; else do; /* drop this one */ desc_ptr -> request_descriptor.keep_in_queue = "1"b; call iodd_msg_ (log, both, 0, "", "**Deferring request ^d. Time estimate: ^.1f mins.", REQUEST.request_no, float (time_est) / 60.0e0); call ioa_$rsnnl ("Deferring request for ^a.^/Time estimate: ^.1f minutes.", msg, l, REQUEST.full_path, float (time_est) / 60.0e0); call notify_user (substr (msg, 1, l)); go to clean_out; end; end; else msg = ""; if time_est > 60 | msg ^= "" then /* tell operator if request will exceed 1 minute */ call iodd_msg_ (log, slave, 0, "", " Time estimate for request ^d: ^.1f mins.^[^/^2x^a^]", REQUEST.request_no, float (time_est) / 60.0e0, (msg ^= ""), msg); end; if REQUEST.copy_no > 1 then call iodd_msg_ (log, both, 0, "", " Starting request ^d at copy ^d of ^d.", REQUEST.request_no, REQUEST.copy_no, REQUEST.copies); go to start_request; /* begin the output of the request */ restart_this_request: /* this is the point where we come to restart the current request */ REQUEST.continued = "1"b; /* make this look like a continuation */ REQUEST.contd_no = REQUEST.request_no; /* of this request */ REQUEST.charge = 0e0; REQUEST.time_start_request = clock_ (); call date_time_ (REQUEST.time_start_request, REQUEST.date_time_start_request); start_request: REQUEST.cpu_time = 0; /* reset the usage data */ REQUEST.real_time = 0; REQUEST.page_waits = 0; REQUEST.pre_pages = 0; REQUEST.copy_no = print_driver_data.copies_done + 1; /* initialize copy-counter */ call iox_$control (iocbp, "get_error_count", addr (last_error_count), code); /* start checking for errors */ if code ^= 0 then last_error_count = -1; /* value not defined */ call check_labels (user_dir, ename, start_segp, code); if code ^= 0 then do; /* oops....bad news */ call fatal_error (tell_user); /* tell the operator, and user */ go to clean_out; /* drop the request */ end; do while (REQUEST.copies >= REQUEST.copy_no); /* once around for each copy */ call banner_proc (req_stream, header, addr (REQUEST), code); /* print header banner */ if code ^= 0 then do; /* I/O error trying to print header */ call driver_fatal_error (code, "I/O ERROR -- trying to print header."); go to clean_out; /* abort this request completely */ end; REQUEST.separator = "0"b; /* separator bar was for first banner only */ header_sw = "1"b; /* header was ok, do tail */ call iox_$control (iocbp, "runout", null, code); /* be sure head sheet is done before clock reading */ call cpu_time_and_paging_ (old_waits, old_cpu, old_pp); /* keep time and page waits for accounting */ old_clock = clock_ (); /* time copy started */ call output_file (code); /* this will do it */ if code ^= 0 then do; call driver_fatal_error (code, (err_mess)); go to clean_out; end; call iox_$control (iocbp, "runout", null, code); /* be sure copy is done before counting it */ if ^desc_ptr -> request_descriptor.saved then /* if leaving this til later, don't charge now */ if REQUEST.copies > print_driver_data.copies_charged then do; chgsw = "1"b; /* user honestly deserves these charges */ print_driver_data.copies_charged = print_driver_data.copies_charged + 1; end; else chgsw = "0"b; else chgsw = "0"b; call charge_for_work; /* do the accounting so we can put price on tail */ if last_error_count = -1 then device_error = ""b; /* no error data */ else do; call iox_$control (iocbp, "get_error_count", addr (i), code); if code ^= 0 | i > last_error_count then device_error = "1"b; else device_error = "0"b; /* we can figure the transfer rate */ end; if ^(iodd_static.quit_during_request | device_error) then do; /* can we update the rate estimate? */ old_rate = dr_ptr -> driver_status.bit_rate_est; /* get the last value */ seconds = divide (REQUEST.real_time, 1000000, 17); /* see how many seconds have passed */ if seconds < 1 then new_rate = old_rate; /* avoid divide by zero */ else new_rate = divide (REQUEST.bit_count, seconds, 17, 0); /* get bits/sec */ if old_rate > 0 then /* use first good rate to start the estimate */ new_rate = fixed (old_rate * factor + new_rate * (1e0 - factor)); /* use exp smoothing */ dr_ptr -> driver_status.bit_rate_est = new_rate; /* put back new value */ end; call banner_proc (req_stream, tail, addr (REQUEST), code); /* this will put on the tail banner */ if code ^= 0 then do; /* some type of error..don't do it again */ call driver_fatal_error (code, "I/O ERROR -- attempting to write tail banner."); go to clean_out; end; print_driver_data.copies_done = print_driver_data.copies_done + 1; REQUEST.copy_no = REQUEST.copy_no + 1; /* get ready for next copy */ header_sw = "0"b; end; /* done with this copy...check for more in while loop */ call iodd_msg_ (log, both, 0, "", " Charge for request ^d: $^.2f, ^[(^d lines, ^d pages^;(^d cards^s^]^[ per copy)^;)^]", REQUEST.request_no, REQUEST.total_charge, (REQUEST.punsw = 0), REQUEST.line_count, REQUEST.page_count, (copies_left > 1)); if REQUEST.notify then do; call ioa_$rsnnl ("^aed ^a $^.2f queue ^d ^a ^d", abort_msg, l, pverb, REQUEST.full_path, REQUEST.total_charge, REQUEST.queue, REQUEST.device_name, REQUEST.request_no); call notify_user (substr (abort_msg, 1, l)); end; clean_out: /* get ready for the next users' request */ if last_error_count > -1 then do; /* if error count is defined */ call iox_$control (iocbp, "get_error_count", addr (i), code); if code ^= 0 | i > last_error_count then /* if errors are possible */ if ^desc_ptr -> request_descriptor.dont_delete then do; /* and user not told about it */ if REQUEST.delete = 1 then do; /* tell user we cancelled his delete request */ desc_ptr -> request_descriptor.dont_delete = "1"b; call ioa_$rsnnl ("Device error during request ^d. Segment ^a will not be deleted.", msg, l, REQUEST.request_no, REQUEST.full_path); call notify_user (substr (msg, 1, l)); end; end; end; call clean_proc; /* get junk out of the address space */ desc_ptr -> request_descriptor.finished = "1"b; /* mark it as done */ iodd_static.request_in_progress = "0"b; /* no more commands can be effective */ call iox_$control (iocbp, "runout", null, code); /* make device disgorge */ return; check_reprint_copies: /* on restart, we transfer back here to release the */ /* stack frame with the dim, so the slave can again write */ /* to the remote device and ask a question */ call restart_request (restart_source); /* this will do the work */ /* and ask the operator how many copies were good */ go to restart_this_request; /* now go back and restart the request */ /* This is where the condition handlers "go to" when something has gone wrong */ flush_request: /* kill and cancel handlers jump back here */ msg = "Operator aborted output"; /* message for kill and cancel */ chgsw = "0"b; /* can't charge */ go to no_delete; abort_request: /* unclaimed signals transfer to here */ chgsw = ""b; /* assume we can't charge user */ msg = """" || rtrim (fault_name) || """ condition occured"; /* format basic message */ if fault_name = "seg_fault_error" & /* user deleted seg, charge for what was done */ iodd_static.segptr ^= null then do; chgsw = "1"b; delete_msg = ""; /* forget to tell user we won't delete his seg */ end; else do; no_delete: if REQUEST.delete ^= 0 then delete_msg = "; segment will not be deleted"; else delete_msg = ""; end; call ioa_$rsnnl ("^a during processing of ^a request^a.", err_mess, l, msg, pverb, delete_msg); code = 0; call fatal_error (tell_user); /* this will clean things up a bit */ go to clean_out; /* now drop the request */ defer_request: /* leave this in the queue for a while */ err_mess = "Operator deferred request until a later time."; chgsw = ""b; code = 0; call fatal_error (tell_user); go to clean_out; save_request: err_mess = "Processing suspended by operator."; chgsw = "0"b; code = 0; call fatal_error (quiet); /* abort gently */ go to clean_out; /* ======================================================================================= */ /* ============================== INTERNAL PROCEDURES ============================== */ /* ======================================================================================= */ fatal_error: proc (notify); dcl notify bit (1); save_code = code; /* hold this for now */ REQUEST.notify = REQUEST.notify | notify; /* set notify flag by arg if off */ desc_ptr -> request_descriptor.dont_delete = "1"b;/* make sure we don't delete user seg */ if ^REQUEST.notify & ^header_sw then do; /* try to tell requestor */ call banner_proc (req_stream, header, addr (REQUEST), code); if code = 0 then header_sw = "1"b; /* all was well */ end; if header_sw then call charge_for_work; /* update REQUEST data if possible */ call error_write (save_code, err_mess); if header_sw then /* if we owe a tail banner, do it */ call banner_proc (req_stream, tail, addr (REQUEST), code); call iodd_msg_ (log, both, 0, "", "Processing of request ^d terminated.", REQUEST.request_no); return; /* let the caller flush the request */ end fatal_error; /* ===================================== */ error_write: proc (code, message); /* for writing error messages to console & request stream */ dcl code fixed bin (35); dcl message char (*) varying; short_msg, lg_msg = ""; /* clear any junk */ if code ^= 0 then call convert_status_code_ (code, short_msg, lg_msg); call ioa_$rsnnl ("Request for ^a. ^a ^a", msg, l, REQUEST.full_path, lg_msg, message); if REQUEST.notify then /* this lets us be quiet about save and defer */ call notify_user (substr (msg, 1, l)); call iodd_msg_ (log, both, 0, "", "**Request ^d: ^a ^a", REQUEST.request_no, lg_msg, message); if header_sw then do; /* must not do a "reset" or line and page count is lost */ call ioa_$rsnnl ("^2/^a^a^/io_daemon: ^a ^a^/^a^a^2/", abort_msg, l, VT, stars, lg_msg, message, stars, VT); call banner_proc (req_stream, error_msg, addr (abort_msg), code); /* put out error msg to media */ end; return; end error_write; check_labels: procedure (user_dir, ename, segptr, code); /* Internal procedure to check that the top and bottom labels are the access class of the segment. */ dcl access_class bit (72) aligned; dcl code fixed bin (35); dcl ename char (*) aligned; dcl level fixed bin; dcl user_dir char (*) aligned; dcl segptr pointer; dcl sys_info$access_class_floor bit (72) aligned external static; dcl 1 local_audit_user_info aligned like audit_user_info; dcl 1 local_audit_eventflags aligned like audit_event_flags; code = 0; if dprint_msg.top_label ^= dprint_msg.bottom_label then do; LOG_AUDIT_MESSAGE: call cu_$level_get (level); unspec (local_audit_user_info) = ""b; local_audit_user_info.version = audit_user_info_version_1; local_audit_user_info.user_id = mseg_message_info.sender_id; local_audit_user_info.ring = mseg_message_info.sender_level; local_audit_user_info.process_id = mseg_message_info.sender_process_id; local_audit_user_info.authorization = mseg_message_info.sender_authorization; local_audit_user_info.authorization_range (1) = sys_info$access_class_floor; local_audit_user_info.authorization_range (2) = mseg_message_info.sender_max_authorization; local_audit_user_info.audit_flags = mseg_message_info.sender_audit; unspec (local_audit_eventflags) = ""b; local_audit_eventflags.grant = "1"b; call access_audit_gate_$log_obj_ptr_user ("output_request_", level, unspec (local_audit_eventflags), access_operations_$io_daemon_set_page_labels, segptr, 0, null (), 0, addr (local_audit_user_info)); return; end; call hcs_$get_access_class (user_dir, ename, access_class, code); if code ^= 0 then return; call convert_authorization_$from_string (authorization, rtrim (dprint_msg.top_label), code); if code ^= 0 then do; code = 0; goto LOG_AUDIT_MESSAGE; /* This isn't an access class */ end; if ^(aim_check_$equal (access_class, authorization)) then goto LOG_AUDIT_MESSAGE; return; end check_labels; notify_user: proc (message); dcl message char (*) aligned; dcl (ipc_ind, r1_ind, ec) fixed bin (35); ipc_ind, r1_ind = -1; /* set to non-zero to test call */ if ^sys_priv then go to send_it; /* if they failed once, .... */ on linkage_error begin; sys_priv = "0"b; /* stop trying if we fail */ go to revert_handler; /* send the message if possible */ end; on any_other begin; if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind); if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind); r1_ind, ipc_ind = -1; call continue_to_signal_ (ec); end; call system_privilege_$ring1_priv_on (r1_ind); call system_privilege_$ipc_priv_on (ipc_ind); revert_handler: revert linkage_error; send_it: call send_mail_$access_class (mailname, message, addr (send_mail_info), mseg_message_info.sender_authorization, ec); if r1_ind = 0 then call system_privilege_$ring1_priv_off (r1_ind); if ipc_ind = 0 then call system_privilege_$ipc_priv_off (ipc_ind); return; end notify_user; charge_for_work: proc; /* Accounting section, done at end of processing each copy of output. */ counts.line_count = 0; /* Clear these items so that if the order is unknown.. */ counts.page_count = 0; /* .. (like if card dim doesn't do them) we still go */ counts.line = 0; call iox_$control (iocbp, "get_count", orderp, code); new_clock = clock_ (); call cpu_time_and_paging_ (new_waits, new_cpu, new_pp); if counts.line_count > 0 then REQUEST.line_count = counts.line_count; else REQUEST.line_count = divide (REQUEST.bit_count + 699, 700, 24, 0); /* Use block count if dim returns zero line count */ if counts.line = 1 then REQUEST.page_count = counts.page_count - 1; /* if ending with a FF */ else REQUEST.page_count = counts.page_count; REQUEST.cpu_time = new_cpu - old_cpu; REQUEST.real_time = new_clock - old_clock; REQUEST.page_waits = fixed (new_waits - old_waits, 35); REQUEST.pre_pages = fixed (new_pp - old_pp, 35); if chgsw then do; if dr_ptr -> driver_status.have_accounting then do; call io_daemon_account_ (dr_ptr -> driver_status.acct_entry, addr (REQUEST)); end; else do; REQUEST.price_per_n_lines, /* zap all charges to zero */ REQUEST.price_per_n_pages, REQUEST.charge = 0e0; REQUEST.no_accounting = "1"b; /* and flag it */ end; end; else REQUEST.charge = 0e0; /* reset any undefined values */ REQUEST.total_charge = REQUEST.total_charge + REQUEST.charge; return; end charge_for_work; check_user_access: proc (user_dir, ename, ec); /* Internal procedure to check that the requestor has at least "r" access to the specified segment */ dcl user_dir char (*) aligned; dcl ename char (*) aligned; dcl code fixed bin (35); dcl ec fixed bin (35); dcl mode fixed bin (5); dcl access_class bit (72) aligned; call hcs_$get_user_effmode (user_dir, ename, REQUEST.requestor, val, mode, code); if code ^= 0 then do; if code = error_table_$noentry then err_mess = ""; /* simple case, just say no entry */ else err_mess = "Unable to get user's mode."; ec = code; return; end; if (bit (mode, 5) & "01000"b) = "0"b then do; err_mess = "User does not have read access."; ec = error_table_$moderr; return; end; call hcs_$get_access_class (user_dir, ename, access_class, code); if code ^= 0 then do; err_mess = "Unable to get access class of segment."; ec = code; return; end; if ^read_allowed_ (mseg_message_info.sender_authorization, access_class) then do; ec = error_table_$ai_restricted; err_mess = "User not allowed to read segment."; return; end; ec = 0; /* ok, user passed the checks */ return; end check_user_access; open_file: proc (user_dir, ename, fcbp, max_comp, code); dcl user_dir char (*) aligned; dcl ename char (*) aligned; dcl fcbp ptr; dcl max_comp fixed bin; dcl code fixed bin (35); dcl comp_dir char (168) aligned; dcl comp_name char (32) aligned; dcl type fixed bin (2); dcl dir fixed bin int static options (constant) init (2); dcl dir_len fixed bin; dcl bc fixed bin (24); dcl mode fixed bin (5); dcl mult_ind fixed bin; REQUEST.bit_count = 0; call hcs_$status_minf (user_dir, ename, 1, type, bc, code); /* see what kind of a thing it is */ if code ^= 0 then do; err_mess = char ("Driver cannot get status of file: " || full_path, length (err_mess)); return; end; if type = dir then /* directory */ if bc < 1 then do; /* it was a directory */ code = error_table_$dirseg; return; end; else max_comp = bc - 1; /* MSF - highest component is bitcount less one */ else max_comp = 0; /* SSF - highest component is 0 */ call msf_manager_$open (user_dir, ename, fcbp, code); if code ^= 0 then do; err_mess = "Unable to open file: " || full_path; return; end; do mult_ind = 0 to max_comp; /* now we look at each component */ call msf_manager_$get_ptr (fcbp, mult_ind, "0"b, segp, bc, code); if code ^= 0 then do; /* we failed, don't try to do partial files */ call ioa_$rsnnl ("Unable to get pointer to file component: ^d.", err_mess, dir_len, mult_ind); return; end; if mult_ind = 0 then start_segp = segp; /* this is a pointer to the first component */ /* we got a pointer to something...where is it */ /* and does the requestor have access to it? */ call hcs_$fs_get_path_name (segp, comp_dir, dir_len, comp_name, code); if code ^= 0 then do; err_mess = "Could not get file component pathname."; return; end; call check_user_access (comp_dir, comp_name, code); if code ^= 0 then do; /* he tried to pull a fast one and got caught */ err_mess = err_mess || " " || substr (comp_dir, 1, dir_len) || ">" || comp_name; /* most of err_mess was set by check_user_access */ return; end; if bc < el_size then do; /* must be at least one element per component */ code = error_table_$improper_data_format; /* choose a good error message */ err_mess = "Zero length segment: " || substr (comp_dir, 1, dir_len) || ">" || comp_name; return; end; REQUEST.bit_count = REQUEST.bit_count + bc; /* total the bits for accounting */ call hcs_$fs_get_mode (segp, mode, code); /* make sure daemon has access */ if code ^= 0 then do; err_mess = "Driver process does not have access to segment."; return; end; if (bit (mode, 5) & "01000"b) = "0"b then do; err_mess = "Driver process does not have read access to segment."; code = error_table_$moderr; /* give some access violation code */ return; end; end; /* Now we know that the file is there and that the requestor has the correct access to it. The continued operation of the driver now assumes that the file will remain the same until the driver is done. That is, the access will not change, the number of components will not change, and the size of each component will not change. */ end open_file; output_file: proc (ec); dcl ec fixed bin (35); /* you guessed it, error code */ dcl bc fixed bin (24); dcl comp_no fixed bin; /* current msf component number */ dcl max_el fixed bin (24); ec = 0; /* clear the error code */ segp = null; /* don't try to deactivate */ comp_no = 0; /* start at the begining of msf */ oldmodes = ""; if REQUEST.line_nbrs then do; call iox_$modes (iocbp, "line_nbrs", oldmodes, code); if code ^= 0 then do; err_mess = "Setting line_nbrs mode"; return; end; end; next_comp: /* done with last component */ if segp ^= null & privileged then call phcs_$deactivate (segp, (0)); /* so try to deactivate the seg */ call msf_manager_$get_ptr (fcbp, comp_no, "0"b, segp, bc, ec); /* get ptr to seg */ if segp = null then do; err_mess = "Invalid seg ptr to component."; return; end; if privileged then /* .. do it (gently if possible) */ call phcs_$set_kst_attributes (binary (baseno (segp), 18), addr (ksta), (0)); iodd_static.segptr = segp; /* tell signal handler what segment we are using */ max_el = divide (bc + el_size - 1, el_size, 24, 0); /* see now many elements to write out */ call iox_$put_chars (iocbp, segp, max_el, ec); /* This is the actual output of segment */ iodd_static.segptr = null; /* not referencing user seg now */ if ec ^= 0 then do; err_mess = "IO error during output of file."; return; end; if comp_no < max_comp then do; /* are we at real end of file */ comp_no = comp_no + 1; /* go on to the next component */ go to next_comp; /* deactivate old and get new */ end; if REQUEST.line_nbrs then if oldmodes ^= "" then call iox_$modes (iocbp, oldmodes, "", (0)); if privileged & (REQUEST.copies = REQUEST.copy_no | max_comp > 0) then call phcs_$deactivate (segp, (0)); /* try to deactivate */ segp = null; return; end output_file; driver_fatal_error: proc (code, err_msg); /* Internal procedure to print messages when there is an IO error on the output stream */ dcl code fixed bin (35); dcl err_msg char (*); call iodd_msg_ (error, both, code, id, "^a ^/Driver returning to command level. Request is deferred.", err_msg); desc_ptr -> request_descriptor.dont_delete = "1"b;/* give a reprieve....in case */ desc_ptr -> request_descriptor.keep_in_queue = "1"b; /* defer it if possible */ a_code = code; /* report driver_fatal_error */ return; end driver_fatal_error; restart_request: proc (source); /* internal procedure used to question operator regarding the restart of current request */ dcl source fixed bin; dcl answer char (120); dcl cnt_msg char (24); /* space to specify a continued request */ dcl copies_good fixed bin (35); /* operator response to number of good copies */ dcl nelt fixed bin; dcl input_iocbp ptr; dcl output_stream char (32); dcl code fixed bin (35); dcl pg_count_msg char (30); /* space to specify pages per copy */ dcl restrt_msg char (30); /* space that the request is to be restarted */ /* set up input/output stream for the master terminal */ if source = master then do; input_iocbp = iodd_static.master_in; output_stream = iodd_static.master_output; end; /* set up input/output stream for the slave terminal */ else do; source = slave; /* just to be sure */ input_iocbp = iodd_static.slave.slave_in; output_stream = iodd_static.slave.slave_output; end; /* is there a need to query the operator? */ if REQUEST.punsw = 1 | print_driver_data.copies_done = 0 | REQUEST.copies = 1 then do; restrt_msg = ""; REQUEST.separator = "1"b; print_driver_data.copies_done = 0; end; else do; /* must query operator */ if REQUEST.page_count > 0 then /* is there a non zero page count? */ call ioa_$rsnnl (" (^d pages each)", pg_count_msg, nret, REQUEST.page_count); else pg_count_msg = ""; if REQUEST.continued then /* is this a continued request? */ cnt_msg = " (continued request)"; else cnt_msg = ""; ask_how_many_good: /* tell operator how many were done */ call ioa_$ioa_stream (output_stream, "^d of ^d copies^a were done^a. How many were good?", print_driver_data.copies_done, REQUEST.copies, pg_count_msg, cnt_msg); /* now let's see what the operator tells us */ answer = ""; /* first make the answer all blank */ call iox_$get_line (input_iocbp, addr (answer), 10, nelt, code); if code ^= 0 then do; copies_good = 0; go to tell_operator; end; answer = ltrim (rtrim (answer, NL || " ")); /* remove leading spaces and NL chars */ copies_good = cv_dec_check_ (answer, code); if code ^= 0 then do; /* was the answer a number? */ bad_no: call ioa_$ioa_stream (output_stream, "Please specify a number between 0 and ^d", print_driver_data.copies_done); go to ask_how_many_good; end; if copies_good < 0 | copies_good > print_driver_data.copies_done then go to bad_no; tell_operator: print_driver_data.copies_done = copies_good; /* update the record of finished copies */ if copies_good = 0 then REQUEST.separator = "1"b; call ioa_$rsnnl (" from copy number ^d", restrt_msg, nret, copies_good + 1); end; call ioa_$ioa_stream (output_stream, "Restarting request^a.", restrt_msg); return; end restart_request; clean_proc: proc; iodd_static.segptr = null; /* tell signal handler we are done with it */ if fcbp ^= null then do; if segp ^= null then if privileged then call phcs_$deactivate (segp, (0)); call msf_manager_$close (fcbp); end; segp, fcbp = null; /* because this is used for several functions */ return; end clean_proc; error_during_request: entry (cond); /* for coming back after signal */ dcl cond char (*); fault_name = cond; go to err_label; set_single_copy: entry; /* to abort multiple copies if the single command must be used */ request_data_p -> ordata.copies = 1; /* make it fall out of the loop after tail sheet */ return; %page; %include access_audit_eventflags; %page; %include access_audit_user_info; %page; %include dprint_msg; %page; %include driver_status; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include kst_attributes; %page; %include mseg_message_info; %page; %include output_request_data; %page; %include print_driver_data; %page; %include prt_conv_info; %page; %include prt_info; %page; %include prt_order_info; %page; %include prt_sdb; %page; %include queue_msg_hdr; %page; %include request_descriptor; %page; %include send_mail_info; end output_request_;  printer_driver_.pl1 10/03/89 1000.4rew 10/03/89 0953.5 278010 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ /* format: off */ /* I/O Daemon driver module for the printer with settable paper characteristics and logical channel stops */ /* Created: September 1977 by J. C. Whitmore from the original version of printer_driver_ */ /* Modified: March 1978 by J. C. Whitmore for new dprint message format */ /* Modified: June 1979 by C. Hornig to initialize driver_status.dev_ctl_ptr */ /* Modified: 25 December 1981 by G. Palter to initialize prt_ctl.flags so that any unimplemented features will not be accidently left on (eg: force_ctl_char) */ /* Modified: November 1983 by C. Marker added support for force_nsep */ /* Modified: February 23, 1985 by C. Marker to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Update for version 4 dprint_msg and allow previos version(s). 2) change(88-06-03,Brunelle), approve(88-06-03,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Upgraded to version 5 I/O daemon tables. 3) change(88-08-29,Farley), approve(88-08-19,MCR7911), audit(88-10-19,Wallman), install(88-10-28,MR12.2-1199): Updated for version 5 dprint_msg. 4) change(89-06-15,Brunelle), approve(89-09-18,MCR8129), audit(89-09-29,Beattie), install(89-10-03,MR12.3-1083): Correct generation of major/minor_args_ptr when using offset into the I/O daemon tables string area. END HISTORY COMMENTS */ /* format: on */ printer_driver_: procedure (); return; /* this is not a legal entry */ /* Automatic variables */ dcl date_string char (24); dcl ec fixed bin (35); /* standard error code for calls */ dcl ignore fixed bin (35); /* error code to be ignored */ dcl i fixed bin; /* index variable */ dcl major_args char (major_args_length) based (major_args_ptr); dcl major_args_ptr ptr; /* ptr to major_args string */ dcl major_args_length fixed bin; dcl omode char (256) aligned; dcl opr_msg char (160); /* string for operator messages */ dcl value char (32); /* temporary char string */ dcl p2 ptr; dcl io_stat bit (72) aligned; /* ios_ status code */ dcl 1 st aligned based (addr (io_stat)), /* breakdown of status code */ 2 code fixed bin (35), 2 flags bit (36); dcl 1 form_info aligned, 2 page_length fixed bin, 2 line_length fixed bin, 2 line_no fixed bin, 2 carriage_position fixed bin, 2 aligned bit (1) unal, 2 pad bit (35) unal; %page; /* External entries */ dcl add_char_offset_ entry (ptr, fixed bin(21)) returns(ptr) reducible; dcl clock_ entry () returns (fixed bin (71)); dcl com_err_ entry options (variable); dcl date_time_ entry (fixed bin (71), char (*)); dcl iodd_listen_ entry (ptr); dcl iodd_msg_ entry options (variable); dcl iodd_parse_$args entry (char(*) var, char(*)) returns(char(256) var); dcl ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$changemode entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$find_iocb entry (char (*) aligned, ptr, fixed bin (35)); dcl do_prt_request_ entry (ptr, ptr, fixed bin (35)); dcl do_prt_request_$error_during_request entry (char (*)); dcl do_prt_request_$single_copy entry (); dcl timer_manager_$sleep entry (fixed bin (71), bit (2) aligned); dcl write_sample_form_ entry (char (*) aligned, char (*) aligned, fixed bin (35)); dcl write_sample_prt_banner_ entry (char (*) aligned, ptr, ptr, fixed bin (35)); %page; /* Internal static */ dcl whoami char (24) int static options (constant) init ("printer_driver_"); dcl master fixed bin int static options (constant) init (1); dcl slave fixed bin int static options (constant) init (2); dcl both fixed bin int static options (constant) init (0); dcl log fixed bin int static options (constant) init (0); dcl normal fixed bin int static options (constant) init (1); dcl error fixed bin int static options (constant) init (2); dcl initial_bit_rate fixed bin int static options (constant) init (7000); /* this is a starting value which is betweeen */ /* the rates for the PRU-1200 and the PRT-301 */ dcl stream (2) char (32) aligned int static; /* streams for writing to terminals */ dcl time fixed bin (71) int static init (1); dcl 1 ctl aligned int static like prt_ctl; /* here we hold the defaults used by do_prt_request_ */ /* Builtins */ dcl (addr, null, substr, length, convert, max, string, mod) builtin; /* Conditions */ dcl (cleanup, conversion) condition; /* External static -- error table entries */ dcl error_table_$no_operation fixed bin (35) ext static; dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$fatal_error fixed bin (35) ext static; %page; init: entry (arg_p); dcl arg_p ptr; stat_p = arg_p; /* put the arg into static for easy reference */ driver_status_ptr = iodd_static.driver_ptr; /* get pointer to driver_status seg */ driver_status.dev_ctl_ptr, prt_ctl_ptr = addr (ctl); text_strings_ptr = iodd_static.text_strings_ptr; /* get ptr to i/o daemon table text area */ /* use static device control parameters */ stream (1) = "user_output"; /* output stream for master terminal */ stream (2) = iodd_static.slave_output; /* check for active before use */ if iodd_static.attach_type ^= ATTACH_TYPE_IOM then do; /* this driver expects an IOM channel */ call iodd_msg_ (error, master, error_table_$fatal_error, whoami, "This driver requires a printer attached through the IOM."); return; /* quit now */ end; if iodd_static.assigned_devices > 1 then do; /* be sure all is correct */ call iodd_msg_ (error, master, error_table_$fatal_error, whoami, "Multiple minor devices are not supported by the printer driver."); return; end; if iodd_static.form_type = "undefined_form" then do; iodd_static.form_type = "std_ctl_msg"; /* if set, keep over a re-init */ driver_status.form_wait_time = 5; /* set this as a reasonable default */ end; /* locate the major args for the device in the iod_tables */ major_args_ptr = add_char_offset_ (addr (text_strings.chars), iodd_static.major_args.first_char - 1); major_args_length = iodd_static.major_args.total_chars; iodd_static.device_dim = iodd_parse_$args ("dim=", major_args); /* see if there was a dim given */ if iodd_static.device_dim = "" then /* otherwise use our default */ iodd_static.device_dim = "prtdim_"; /* this is the default */ iodd_static.dev_io_stream = "dev_i/o"; /* record the stream name */ call ios_$attach (iodd_static.dev_io_stream, iodd_static.device_dim, iodd_static.attach_name, "save_vfc", io_stat); if st.code ^= 0 then do; call iodd_msg_ (error, master, st.code, whoami, "Fatal error: Unable to attach channel ^a", iodd_static.attach_name); return; end; on cleanup begin; /* they will try to transfer back to iodd_ by go to */ call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat); end; iodd_static.dev_in_stream = "Daemon_null_stream"; /* just to avoid un-initialized variables */ driver_status.dev_out_stream = "printer_output"; /* define the stream name for all time */ call ios_$attach (driver_status.dev_out_stream, "syn", "dev_i/o", "", io_stat); /* stick to convention */ if st.code ^= 0 then do; call iodd_msg_ (error, master, st.code, whoami, "Fatal error: Unable to attach syn to dev_i/o."); go to clean_out; end; call iox_$find_iocb (driver_status.dev_out_stream, driver_status.dev_out_iocbp, ec); if ec ^= 0 then do; call iodd_msg_ (error, master, ec, whoami, "Fatal error: Unable to get iocbp for device stream."); go to clean_out; /* that's all we can do... */ end; %page; string (prt_ctl.flags) = ""b; if driver_status.rqti_ptr ^= null then do; /* if there is an rqti seg, use it */ prt_rqtip = driver_status.rqti_ptr; /* make the based references cleaner */ if prt_rqti.header.header_version ^= rqti_header_version_1 then do; call iodd_msg_ (error, master, error_table_$fatal_error, whoami, "prt rqt info version ^d found (expected ^d)", prt_rqti.header.header_version, rqti_header_version_1); go to clean_out; end; prt_ctl.meter = prt_rqti.header.meter; /* do we save meters for this rqt? */ iodd_static.slave_hold = ^(prt_rqti.header.auto_go); /* set the initial hold state as requested */ iodd_static.wakeup_time = max (30, prt_rqti.header.driver_wait_time); /* seconds to wait for a request */ if prt_rqti.header.type_code = 0 then go to set_defaults; /* this is only a header */ else if prt_rqti.header.type_code ^= 1 then do; call iodd_msg_ (error, master, error_table_$fatal_error, whoami, "Wrong rqt info seg type for printer."); go to clean_out; end; if prt_rqti.version ^= prt_rqti_version_1 then do; /* see if it is the right version */ call iodd_msg_ (error, master, error_table_$fatal_error, whoami, "Wrong version of prt_rqti. Found ^d (expected ^d)", prt_rqti.version, prt_rqti_version_1); go to clean_out; end; if prt_rqti.opr_msg ^= "" then call iodd_msg_ (normal, both, 0, "", "^/^a", prt_rqti.opr_msg); /* give operator instructions */ prt_ctl.phys_page_length = prt_rqti.paper_length; /* get paper data for prtdim */ prt_ctl.phys_line_length = prt_rqti.paper_width; prt_ctl.lines_per_inch = prt_rqti.lines_per_inch; prt_ctl.channel_stops (*) = prt_rqti.channel_stops (*); /* get VFU stops for prtdim */ prt_ctl.banner_type = prt_rqti.banner_type; /* copy control info to writable storage */ prt_ctl.force_nep = prt_rqti.force_nep; prt_ctl.force_esc = prt_rqti.force_esc; prt_ctl.force_nsep = prt_rqti.force_nsep; prt_ctl.no_auto_print = prt_rqti.no_auto_print; prt_ctl.banner_bars = prt_rqti.banner_bars; prt_ctl.banner_indent = prt_rqti.banner_indent; prt_ctl.banner_line = prt_rqti.banner_line; end; else do; /* no rqti seg, so set some defaults */ prt_ctl.meter = "0"b; /* don't keep any meters */ iodd_static.slave_hold = "1"b; /* be sure to ask for a start command */ iodd_static.wakeup_time = 30; /* check every 30 seconds */ set_defaults: /* set up the default paper data */ prt_ctl.phys_page_length = 66; /* 11 inch paper at 6 lpi is 66 lines */ prt_ctl.phys_line_length = 136; /* assume the standard printer paper */ prt_ctl.lines_per_inch = 6; /* normal for good readibility */ string (prt_ctl.channel_stops) = "0"b; /* no slew stops are defined */ prt_ctl.force_nep = "0"b; /* let user have his way */ prt_ctl.force_esc = "0"b; prt_ctl.force_nsep = "0"b; /* allow printing of inner head and tail sheets */ prt_ctl.no_auto_print = "0"b; /* print without requesting operator attn */ prt_ctl.banner_type = NORMAL_BANNERS; /* use normal head/tail sheets */ prt_ctl.banner_bars = NORMAL_BANNER_BARS; /* set for overprinting */ prt_ctl.banner_indent = 0; /* again */ prt_ctl.banner_line = 1; /* again */ end; /* Now set up the dim with the paper and channel stop data */ call set_paper_info (slave, ec); if ec ^= 0 then go to clean_out; /* message was printed by proc */ call iox_$control (driver_status.dev_out_iocbp, "channel_stops", addr (prt_ctl.channel_stops), ec); if ec ^= 0 then do; call iodd_msg_ (error, master, ec, whoami, "Fatal error: Unable to perform channel_stops order."); go to clean_out; /* fatal error */ end; driver_status.generic_type = "printer"; /* this is the type of device we use */ driver_status.attached = "1"b; driver_status.ready = "1"b; driver_status.busy = "0"b; driver_status.request_pending = (36)"0"b; driver_status.elem_size = 9; /* printer output is in characters - 9 bits each */ driver_status.message_type = 1; /* we only want print requests */ driver_status.bit_rate_est = initial_bit_rate; /* no history on output rate yet */ driver_status.defer_time_limit = 0; /* make operator specify reject time_limit */ iodd_static.current_devices = iodd_static.assigned_devices; /* make them equal */ if iodd_static.ctl_term.attached then call ios_$changemode (iodd_static.ctl_output, "^hndlquit", omode, io_stat); /* we reset read on quit */ value = iodd_parse_$args ("form_type=", major_args); /* check on a ctl term form type */ if value ^= "" then iodd_static.form_type = substr (value, 1, length (iodd_static.form_type)); call date_time_ (clock_ (), date_string); /* get set for ready message */ call iodd_msg_ (normal, both, 0, "", /* let the subr do the work */ "^/^a driver ready at ^16a^/", driver_status.dev_name_label, date_string); call iodd_listen_ (stat_p); clean_out: call ios_$detach (iodd_static.dev_io_stream, "", "", io_stat); return; %page; request: entry (); /* This is the entry which is called by the iodd_listen_ procedure when a request for this driver has been received from the coordinator. The purpose of the code for this entry of the printer driver is to validate that the request is one that we expect and can correctly interpret. Then we call do_prt_request_ to do all the work of access checking etc. */ driver_status_ptr = iodd_static.driver_ptr; /* make it general although it will always be the same */ p2 = addr (driver_status.descriptor); /* find request descriptor */ dmp = addr (driver_status.message); /* get ptr to message */ prt_ctl_ptr = driver_status.dev_ctl_ptr; /* only one for this driver */ if dprint_msg.header.hdr_version ^= queue_msg_hdr_version_1 then do; /* trouble */ call iodd_msg_ (log, both, 0, "", "Invalid message header. Cannot read request ^d.^d.", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q); p2 -> request_descriptor.keep_in_queue = "1"b; /* save for conversion later */ go to be_nice; end; if dprint_msg.header.message_type ^= driver_status.message_type then do; call iodd_msg_ (log, both, 0, "", /* log the error */ "Incorrect message type for printer.^/Request ^d.^d for ^a (segment ^a) not processed.", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename); p2 -> request_descriptor.cancelled = "1"b; /* we don't want this one back */ be_nice: p2 -> request_descriptor.dont_delete = "1"b; /* save the user's data */ p2 -> request_descriptor.finished = "1"b; /* mark it done */ return; /* it wasn't for us after all */ end; if dprint_msg.version ^= dprint_msg_version_5 /* Current version */ & dprint_msg.version ^= dprint_msg_version_4 /* Previous version */ & dprint_msg.version ^= dprint_msg_version_3 /* Previous version */ then do; /* other trouble? */ call iodd_msg_ (log, both, 0, "", "Wrong dprint message version found.^/Request ^d.^d for ^a (segment ^a) not processed", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename); p2 -> request_descriptor.keep_in_queue = "1"b; go to be_nice; end; if dprint_msg.version < dprint_msg_version_4 then /* Disallow line numbers before version 4 */ dprint_msg.control.line_nbrs = "0"b; if dprint_msg.line_lth > prt_ctl.phys_line_length then do; /* platten wide enough */ call iodd_msg_ (log, both, 0, "", "Request ^d.^d for ^a (segment ^a) deferred.^/Requires a device with line length of ^d.", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename, dprint_msg.line_lth); p2 -> request_descriptor.keep_in_queue = "1"b; /* defer it */ go to be_nice; end; iodd_static.quit_during_request = "0"b; /* start clean */ call do_prt_request_ (driver_status.dev_out_iocbp, stat_p, ec); if ec ^= 0 then iodd_static.slave_hold = "1"b; /* on errors go to command level */ if iodd_static.test_entry then if time > 1 then call timer_manager_$sleep (time, "11"b); /* pause if testing */ return; %page; command: entry (source, state, arg_list_p, c_code); dcl source fixed bin; /* 1 = master console, 2 = slave */ dcl state fixed bin; /* 0 = not quite ready to handle a request */ /* 1 = drivers are ready */ /* 2 = command entered after a quit */ dcl arg_list_p ptr; /* ptr to structure returned by parse_command_ */ dcl c_code fixed bin (35); /* error code: zero if command handled correctly */ dcl save_code fixed bin (35); /* saved value of c_code when called */ /* error_table_ code for bad syntax or unknown command */ dcl 1 arg_list aligned based (arg_list_p), /* parse_command_ structure */ 2 max_tokens fixed bin, /* space allocated, do not change */ 2 n_tokens fixed bin, /* number of tokens from command line (including cmd) */ 2 command char (64) var, /* the first token is the command */ 2 arg (n_tokens - 1) char (64) var; /* the other tokens are args to the command */ dcl new_pl fixed bin; /* temp for setting the phys page length */ dcl new_ll fixed bin; /* temp for the new phys line length */ dcl new_lpi fixed bin; /* and for the new lines per inch value */ dcl not bit (1); stream (2) = iodd_static.slave_output; /* in case it has changed */ on conversion begin; /* handler for conversion errors */ call iodd_msg_ (normal, source, 0, "", "Argument conversion error. Try again."); go to cmd_error; end; save_code = c_code; /* save the called value */ driver_status_ptr = iodd_static.driver_ptr; /* make this ready for command use */ prt_ctl_ptr = driver_status.dev_ctl_ptr; /* this is the only one for this driver */ c_code, ec = 0; /* say we handled it for now */ if command = "help" then do; call iodd_msg_ (normal, source, 0, "", "^/** Commands for the printer driver **^/"); call iodd_msg_ (normal, source, 0, "", "banner_bars [] single | double | none"); call iodd_msg_ (normal, source, 0, "", "banner_type [] standard | brief | none"); call iodd_msg_ (normal, source, 0, "", "paper_info [] [-ll ] [-pl ] [-lpi <6 or 8>]"); call iodd_msg_ (normal, source, 0, "", "prt_control [] [^]KEY ... (KEYs: force_nep, force_esc, force_nsep, autoprint)"); call iodd_msg_ (normal, source, 0, "", "sample_hs []"); call iodd_msg_ (normal, source, 0, "", "sample_form"); call iodd_msg_ (normal, source, 0, "", "single"); if test_entry then call iodd_msg_ (normal, source, 0, "", "time []"); go to end_cmd; end; if command = "ctl_term" | command = "ctlterm" then do; /* this was passed on by iodd_command_processor_ */ /* to have us set the default form type */ iodd_static.form_type = "std_ctl_msg"; /* this is our default */ go to end_cmd; /* the request entry will set the wait time */ end; if command = "time" then if ^iodd_static.test_entry then do; /* refuse to recognize if not testing */ ec = save_code; go to end_cmd; end; else do; if n_tokens > 1 then time = convert (time, arg (1)); else time = 1; /* return to the default..full speed */ go to end_cmd; end; if command = "banner_bars" | command = "bannerbars" then do; if arg_list.n_tokens > 1 then /* some arg given */ if driver_status.device_id = arg (1) then i = 2; /* minor device, args can start at number 2 */ else i = 1; /* first arg was a value */ else i = 1; /* no args at all */ if arg_list.n_tokens = i | arg (i) = "-print" then do; /* give value */ if prt_ctl.banner_bars = NORMAL_BANNER_BARS then opr_msg = "double"; else if prt_ctl.banner_bars = SINGLE_BANNER_BARS then opr_msg = "single"; else if prt_ctl.banner_bars = NO_BANNER_BARS then opr_msg = "none"; else opr_msg = "Undefined value"; call iodd_msg_ (normal, source, 0, "", "Current value is: ^a", opr_msg); go to end_cmd; end; if arg (i) = "double" then prt_ctl.banner_bars = NORMAL_BANNER_BARS; else if arg (i) = "single" then prt_ctl.banner_bars = SINGLE_BANNER_BARS; else if arg (i) = "none" then prt_ctl.banner_bars = NO_BANNER_BARS; else do; call iodd_msg_ (normal, source, 0, "", "Undefined argument ^a. Use single, double or none.", arg (1)) ; go to cmd_error; end; go to end_cmd; end; if command = "single" then do; /* operator wants to single space FF and VT */ if iodd_static.request_in_progress then do; call ios_$changemode (driver_status.dev_out_stream, "single.", omode, io_stat); /* set mode */ call do_prt_request_$single_copy (); /* avoid same problem if another copy requested */ end; else call iodd_msg_ (normal, source, 0, "", "No current request."); go to end_cmd; end; if command = "paper_info" | command = "paperinfo" then do; if arg_list.n_tokens > 1 then /* some arg given */ if driver_status.device_id = arg (1) then i = 2; /* minor device, args can start at number 2 */ else i = 1; /* possibly first arg was a value */ else i = 1; /* no args at all */ if n_tokens = i | arg (i) = "-print" then do; call iodd_msg_ (normal, source, 0, "", "Physical paper width: ^d characters ^/Physical paper length: ^d lines (at ^d lines per inch)", prt_ctl.phys_line_length, prt_ctl.phys_page_length, prt_ctl.lines_per_inch); go to end_cmd; end; if mod ((n_tokens - i), 2) = 1 then do; call iodd_msg_ (normal, source, 0, "", "The paper_info command must have an even number of arguments."); go to cmd_error; /* make him do it right */ end; new_ll = prt_ctl.phys_line_length; /* record the old values as the default */ new_pl = prt_ctl.phys_page_length; new_lpi = prt_ctl.lines_per_inch; do i = i to n_tokens - 1 by 2; /* check the arg pairs */ if arg (i) = "-ll" then new_ll = convert (new_ll, arg (i + 1)); else if arg (i) = "-pl" then new_pl = convert (new_pl, arg (i + 1)); else if arg (i) = "-lpi" then new_lpi = convert (new_lpi, arg (i + 1)); else do; /* bad control arg */ call iodd_msg_ (normal, source, 0, "", "Invalid control argument: ^a", arg (i)); go to cmd_error; end; end; if new_ll < 10 | new_ll > 200 then do; /* check the range */ call iodd_msg_ (normal, source, 0, "", "Line length range is 10 to 200."); go to cmd_error; end; if ^(new_lpi = 6 | new_lpi = 8) then do; call iodd_msg_ (normal, source, 0, "", "Lines per inch must be 6 or 8."); go to cmd_error; end; if new_pl < 10 then do; call iodd_msg_ (normal, source, 0, "", "Minimum paper length is 10 lines."); go to cmd_error; end; if new_pl > 127 then do; call iodd_msg_ (normal, source, 0, "", "Maximum paper length is 127 lines."); go to cmd_error; end; prt_ctl.phys_line_length = new_ll; prt_ctl.phys_page_length = new_pl; prt_ctl.lines_per_inch = new_lpi; call iodd_msg_ (normal, source, 0, "", "Changing to: ll ^d, pl ^d at ^d lines per inch.", prt_ctl.phys_line_length, prt_ctl.phys_page_length, prt_ctl.lines_per_inch); call set_paper_info (source, ec); go to end_cmd; end; if command = "sample_form" | command = "sampleform" then do; if iodd_static.ctl_term.attached then do; /* be sure there is a place to write */ if iodd_static.forms then do; /* are we simulating FF? */ call ios_$order (iodd_static.ctl_output, "form_status", addr (form_info), io_stat); if st.code ^= 0 then do; /* OOPS.... */ iodd_static.master_hold = "1"b; /* this is a problem for master terminal */ call com_err_ (st.code, whoami, "^/form_status order call. Master terminal action required to continue."); go to cmd_error; end; if ^form_info.aligned then call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat); /* this will work */ end; call write_sample_form_ (iodd_static.form_type, iodd_static.ctl_output, ec); end; else call iodd_msg_ (normal, source, 0, "", "Control terminal is not attached."); go to end_cmd; end; if command = "prt_control" | command = "prtcontrol" then do; if arg_list.n_tokens > 1 then /* some arg given */ if driver_status.device_id = arg (1) then i = 2; /* minor device, args can start at number 2 */ else i = 1; /* possibly first arg was a value */ else i = 1; /* no args at all */ if n_tokens = i | arg (i) = "-print" then do;/* give the values */ call iodd_msg_ (normal, source, 0, "", "Values are: ^[^^^]force_nep, ^[^^^]force_esc, ^[^^^]auto_print, ^[^^^]force_nsep", ^prt_ctl.force_nep, ^prt_ctl.force_esc, prt_ctl.no_auto_print, prt_ctl.force_nsep); end; else do; do i = i to n_tokens - 1; /* look at each argument */ not = (substr (arg (i), 1, 1) = "^"); /* was first char a "^" */ if not then value = substr (arg (i), 2); else value = arg (i); if value = "force_nep" | value = "forcenep" then prt_ctl.force_nep = ^not; else if value = "force_esc" | value = "forceesc" then prt_ctl.force_esc = ^not; else if value = "force_nsep" | value = "forcensep" then prt_ctl.force_nsep = ^not; else if value = "auto_print" | value = "autoprint" then prt_ctl.no_auto_print = not; else call iodd_msg_ (normal, source, 0, "", "Undefined argument: ^a", arg (i)); end; end; go to end_cmd; end; if command = "banner_type" | command = "bannertype" then do; if arg_list.n_tokens > 1 then /* some arg given */ if driver_status.device_id = arg (1) then i = 2; /* minor device, args can start at number 2 */ else i = 1; /* possibly first arg was a value */ else i = 1; /* no args at all */ if n_tokens = i | arg (i) = "-print" then do;/* give the values */ if prt_ctl.banner_type = NO_BANNERS then opr_msg = "none"; else if prt_ctl.banner_type = NORMAL_BANNERS then opr_msg = "standard"; else if prt_ctl.banner_type = BRIEF_BANNERS then opr_msg = "brief"; else opr_msg = "Undefined value"; call iodd_msg_ (normal, source, 0, "", "Current value is: ^a", opr_msg); go to end_cmd; end; if arg (i) = "standard" then prt_ctl.banner_type = NORMAL_BANNERS; else if arg (i) = "none" then prt_ctl.banner_type = NO_BANNERS; else if arg (i) = "brief" then prt_ctl.banner_type = BRIEF_BANNERS; else do; call iodd_msg_ (normal, source, 0, "", "Banner type ^a is not defined.", arg (i)); go to cmd_error; end; go to end_cmd; end; if command = "sample_hs" | command = "samplehs" then do; if arg_list.n_tokens > 1 then /* some arg given */ if driver_status.device_id = arg (1) then i = 2; /* minor device, args can start at number 2 */ else i = 1; /* possibly first arg was a value */ else i = 1; /* no args at all */ call iox_$control (driver_status.dev_out_iocbp, "reset", null, ignore); /* clear everything */ call iox_$control (driver_status.dev_out_iocbp, "inside_page", null, ignore); call write_sample_prt_banner_ ("head_sheet", driver_status.dev_out_iocbp, prt_ctl_ptr, ec); call iox_$control (driver_status.dev_out_iocbp, "end_of_page", null, ignore); call iox_$control (driver_status.dev_out_iocbp, "runout", null, ignore); /* be sure it prints */ go to end_cmd; end; /* If we come past here, this command is illegal. So make a clean return without changing anything. */ c_code = save_code; /* restore the original value */ return; end_cmd: c_code = ec; /* pass back any defined errors */ return; cmd_error: c_code = error_table_$action_not_performed; /* cause a resetread */ return; %page; default_handler: entry (condition_info_ptr); dcl condition char (32); /* fixed string for the call */ condition = condition_info.condition_name; /* this will indent funny */ if iodd_static.request_in_progress then /* try to avoid mistakes */ call do_prt_request_$error_during_request (condition); /* take it away */ return; /* do_prt_request_ should not return, but.... */ %page; set_paper_info: procedure (source, code); dcl code fixed bin (35); dcl source fixed bin; code = 0; call iox_$control (driver_status.dev_out_iocbp, "paper_info", addr (prt_ctl.paper_info), code); if code ^= 0 then if code = error_table_$no_operation then do; /* if dim couldn't, tell the operator */ call iodd_msg_ (normal, source, 0, "", "Mount VFU tape for ^d lines per page. ^/Set printer for ^d lines/inch.", prt_ctl.phys_page_length, prt_ctl.lines_per_inch); iodd_static.slave_hold = "1"b; /* be sure we let the op load VFU */ code = 0; end; else do; /* a real error */ call iodd_msg_ (normal, source, code, whoami, "Unable to perform paper_info order."); return; end; return; end set_paper_info; %page; %include condition_info; %page; %include dprint_msg; %page; %include driver_status; %page; %include iod_constants; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include mseg_message_info; %page; %include prt_ctl; %page; %include prt_order_info; %page; %include prt_rqti; %page; %include queue_msg_hdr; %page; %include request_descriptor; end printer_driver_;  punch_driver_.pl1 10/01/90 1537.2rew 10/01/90 1530.0 221463 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1990 * * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ punch_driver_: proc; return; /* this is not a legal entry */ /* Standard punch device driver control module for the I/O daemon. */ /* Originally coded in March 1975 by J. C. Whitmore */ /* Modified November 1975 by M. A. Braida to print flip card header */ /* Modified by J. C. Whitmore, 4/78, for new dprint_msg format and general upgrade */ /* Modified by J. C. Whitmore, 7/78, to initialize for auto deferring of long requests */ /* Modified by J. C. Whitmore, 3/79, to correct string size on two assignments */ /* Modified by C. Marker, 02/23/85, to use version 5 message segments */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-08-17,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Update for version 4 dprint_msg, and allow previous version. 2) change(88-08-19,Brunelle), approve(88-08-19,MCR7911), audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199): Upgrade for version 5 iod tables. 3) change(88-08-29,Farley), approve(88-08-19,MCR7911), audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199): Updated for version 5 dprint_msg. 4) change(90-08-30,Vu), approve(90-08-30,MCR8196), audit(90-09-12,Zimmerman), install(90-10-01,MR12.4-1034): Correct generation of major_args_ptr when using offset into the I/O daemon tables string area. END HISTORY COMMENTS */ /* AUTOMATIC VARIABLES */ dcl date_string char (24); dcl ec fixed bin (35); dcl i fixed bin; /* general index variable */ dcl io_stat bit (72) aligned; /* ios_ status code */ dcl major_args char (major_args_length) based (major_args_ptr); dcl major_args_ptr ptr; /* ptr to major_args string */ dcl major_args_length fixed bin; dcl nelm fixed bin; dcl nelt fixed bin; dcl dest char (24); /* temp for the destination */ dcl head char (64) aligned; /* temp for the heading */ dcl banner_stream char (32) aligned; dcl access_class char (36) aligned; /* temp for the first access class token */ dcl p2 ptr; dcl retry_sw bit (1); dcl 1 st aligned based (addr (io_stat)), /* breakdown of status code */ 2 code fixed bin (35), 2 flags bit (36); /* EXTERNAL ENTRIES */ dcl add_char_offset_ entry (ptr, fixed bin(21)) returns(ptr) reducible; dcl clock_ entry () returns (fixed bin (71)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl date_time_ entry (fixed bin (71), char (*)); dcl ioa_$rsnnl entry options (variable); dcl iodd_listen_ entry (ptr); dcl iodd_msg_ entry options (variable); dcl iodd_parse_$args entry (char(*) var, char(*)) returns(char(256) var); dcl ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$changemode entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); dcl ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned); dcl ios_$getsize entry (char (*) aligned, fixed bin, bit (72) aligned); dcl ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl output_request_ entry (char (*) aligned, fixed bin, ptr, entry, fixed bin (35)); dcl output_request_$error_during_request entry (char (*)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2) aligned, fixed bin (71)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2) aligned); dcl write_control_form_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)); dcl write_sample_form_ entry (char (*) aligned, char (*) aligned, fixed bin (35)); /* INTERNAL STATIC */ dcl card_header char (512) aligned int static; /* buffer for flip card head/tail */ dcl xxbar char (22) aligned int static options (constant) init ((11)" -"); /* string of "NL-"'s for flip cards */ dcl ctl_msg_sent bit (1) int static init ("0"b); /* flag set when msg sent ok */ dcl time fixed bin (71) int static init (1); dcl alarm_channel fixed bin (71) int static; /* channel used for time out checks */ dcl meter_sw bit (1) int static; /* TRUE - if we are to keep metering data (future) */ dcl master fixed bin int static options (constant) init (1); dcl both fixed bin int static options (constant) init (0); dcl whoami char (24) int static options (constant) init ("punch_driver_"); dcl initial_bit_rate fixed bin int static options (constant) init (1000); /* starting value for the bit rate estimate */ dcl 1 ctl_wait_list int static aligned, /* ipc wait list for the form terminnal */ 2 number fixed bin, 2 channel fixed bin (71); dcl 1 event_info int static aligned, /* info returned from ipc_$block */ 2 chan fixed bin (71), 2 message fixed bin (71), 2 sender bit (36), 2 origin fixed bin, 2 wait_list_index fixed bin; dcl 1 form_info aligned int static, /* data from the form paging dim */ 2 page_length fixed bin, /* put in static to save stack space */ 2 line_length fixed bin, 2 line_no fixed bin, 2 carriage_position fixed bin, 2 aligned bit (1) unal, /* tells if the dim considers the forms alignedd */ 2 pad bit (35) unal; dcl 1 sw (5) aligned int static, /* format stream (switch) data structure */ 2 name char (32) init ("Undefined", "viipunch_output", "mcc_output", "raw_output", "flipper_output"), 2 size fixed bin init (9, 1, 9, 960, 9), /* element size for this format */ 2 dim char (32) init ("syn", "viipunch_", "mcc_", "raw_", "flipper_"); %page; /* BUILTINS */ dcl (addr, null, substr, before, after, length, rtrim) builtin; /* CONDITIONS */ dcl cleanup condition; /* EXTERNAL STATIC -- ERROR TABLE ENTRIES */ dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$fatal_error fixed bin (35) ext static; dcl error_table_$ionmat fixed bin (35) ext static; %page; init: entry (arg_p); dcl arg_p ptr; stat_p = arg_p; /* put the arg into static for easy reference */ driver_status_ptr = iodd_static.driver_ptr; /* get current driver status ptr */ text_strings_ptr = iodd_static.text_strings_ptr; /* get ptr to i/o daemon table text area */ retry_sw = "1"b; /* retry attachments once on error */ if iodd_static.attach_type ^= ATTACH_TYPE_IOM then do; /* this driver expects an IOM channel */ ec = error_table_$fatal_error; call iodd_msg_ (2, master, ec, whoami, "This driver requires a punch attached through the IOM."); return; /* quit now */ end; if iodd_static.assigned_devices > 1 then do; /* be sure all is correct */ ec = error_table_$fatal_error; call iodd_msg_ (2, master, ec, whoami, "Multiple minor devices are not supported by the punch driver."); return; end; /* locate the major args for the device in the iod_tables */ major_args_ptr = add_char_offset_ (addr (text_strings.chars), (iodd_static.major_args.first_char - 1)); major_args_length = iodd_static.major_args.total_chars; iodd_static.device_dim = iodd_parse_$args ("dim=", major_args); /* see if a dim was specified */ if iodd_static.device_dim = "" then iodd_static.device_dim = "cpz"; /* no, use the default */ iodd_static.dev_out_stream = "punch_output_stream"; iodd_static.dev_io_stream = iodd_static.dev_out_stream; /* make them the same */ iodd_static.dev_in_stream = "Undefined_Daemon_Stream"; /* avoid uninitialized variables */ attach: call ios_$attach (iodd_static.dev_out_stream, iodd_static.device_dim, iodd_static.attach_name, "", io_stat); if st.code ^= 0 then do; if st.code = error_table_$ionmat & retry_sw then do; /* can we try again */ retry: retry_sw = "0"b; /* yes, but only once */ call detach_all; /* clear the slate */ go to attach; end; call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Unable to attach channel ^a", iodd_static.attach_name); return; end; on cleanup call detach_all; /* for reinit, no_coord, logout, new_device, etc... */ /* set up the punch code formatting dims corresponding to the dprint_msg outer_module variable */ do i = 2 to 5; /* attach the defined format streams */ call ios_$attach (sw.name (i), sw.dim (i), iodd_static.dev_out_stream, "", io_stat); if st.code ^= 0 then do; if st.code = error_table_$ionmat & retry_sw then go to retry; /* start_over */ call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Unable to attach ^a to ^a.", sw.name (i), iodd_static.dev_out_stream); go to clean_out; end; end; do i = 2 to 4; /* get the stream element sizes for 7punch, mcc and raw */ call ios_$getsize (sw.name (i), sw.size (i), io_stat); if st.code ^= 0 then do; call iodd_msg_ (2, master, st.code, whoami, "Fatal Error: Invalid getsize call for dim ^a.", sw.dim (i)); go to clean_out; end; end; driver_status.elem_size = 1; driver_status.message_type = 2; /* expected dprint message type */ driver_status.attached = "1"b; driver_status.ready = "1"b; /* issue an automatic "ready" command */ driver_status.form_wait_time = 5; /* set this as a reasonable default */ driver_status.dev_out_stream = iodd_static.dev_out_stream; /* record this too */ driver_status.bit_rate_est = initial_bit_rate; driver_status.defer_time_limit = 0; if iodd_static.ctl_term.attached then do; ctl_wait_list.number = 1; ctl_wait_list.channel = iodd_static.ctl_ev_chan; alarm_channel = iodd_static.ctl_ev_chan; call ios_$changemode (iodd_static.ctl_output, "^hndlquit", "", io_stat); /* we reset read on quit */ end; else do; ctl_wait_list.number = 0; /* otherwise clear to avoid errors */ ctl_wait_list.channel = 0; alarm_channel = 0; end; if driver_status.rqti_ptr ^= null then do; /* see if there is any rqti data */ p2 = driver_status.rqti_ptr; /* copy the pointer for easy reference */ if p2 -> rqti_header.header_version ^= rqti_header_version_1 then do; call iodd_msg_ (2, both, error_table_$fatal_error, whoami, "RQTI header version ^d found (expected ^d).", p2 -> rqti_header.header_version, rqti_header_version_1); go to clean_out; end; if ^(p2 -> rqti_header.type_code = 0 | p2 -> rqti_header.type_code = 2) then do; ec = error_table_$fatal_error; /* allow header only or punch RQTI - no others */ call iodd_msg_ (2, both, ec, whoami, "Incorrect RQTI segment format for punch."); go to clean_out; end; iodd_static.slave_hold = ^(p2 -> rqti_header.auto_go); /* get the auto go value */ iodd_static.wakeup_time = p2 -> rqti_header.driver_wait_time; /* and wait time */ meter_sw = p2 -> rqti_header.meter; /* meters needed? (for the future) */ end; else do; /* use default values, no rqti seg */ iodd_static.slave_hold = "1"b; /* ask for a go command */ iodd_static.wakeup_time = 120; /* should wait 2 min before asking for work */ meter_sw = "0"b; /* no metering (future) */ end; iodd_static.form_type = iodd_parse_$args ("form_type=", major_args); /* was form type given */ if iodd_static.form_type = "" then iodd_static.form_type = "std_ctl_msg"; /* no, use standard default */ call date_time_ (clock_ (), date_string); /* get set for ready message */ call iodd_msg_ (1, both, 0, "", "^/^a driver ready at ^16a^/", driver_status.dev_name_label, date_string); call iodd_listen_ (stat_p); /* iodd_listen_ will never return */ clean_out: /* this label is for error recovery */ call detach_all; return; %page; request: entry; /* This is the entry which is called by the iodd_listen_ procedure when a request for this driver has been received from the coordinator. The purpose of the code for this entry of the punch driver is to validate that the request is one that we expect and can correctly interpret. Then we call output_request_ to do all the work of access checking etc. The stream to be used is based on the outer module specified in the request. */ driver_status_ptr = iodd_static.driver_ptr; /* make it general although it will always be the same */ p2 = addr (driver_status.descriptor); /* find the request descriptor */ dmp = addr (driver_status.message); /* get ptr to message */ if dprint_msg.header.hdr_version ^= queue_msg_hdr_version_1 then do; /* trouble */ call iodd_msg_ (0, both, 0, "", "Invalid message header. Cannot read request ^d.^d.", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q); p2 -> request_descriptor.keep_in_queue = "1"b; /* save for conversion later */ go to be_nice; end; if dprint_msg.header.message_type ^= driver_status.message_type then do; call iodd_msg_ (0, both, 0, "", /* log the error */ "Incorrect message type for punch.^/Request ^d.^d for ^a (segment ^a) not processed.", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename); p2 -> request_descriptor.cancelled = "1"b; be_nice: p2 -> request_descriptor.dont_delete = "1"b; /* save the user's data */ p2 -> request_descriptor.finished = "1"b; /* mark it done */ return; /* it wasn't for us after all */ end; if dprint_msg.version ^= dprint_msg_version_3 /* Previous version */ & dprint_msg.version ^= dprint_msg_version_4 /* Previous version */ & dprint_msg.version ^= dprint_msg_version_5 /* Current version */ then do; /* other trouble? */ call iodd_msg_ (0, both, 0, "", "Wrong message version found.^/Request ^d.^d for ^a (segment ^a) not processed", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename); p2 -> request_descriptor.keep_in_queue = "1"b; go to be_nice; end; if dprint_msg.version < dprint_msg_version_4 then /* Disallow -line_nbrs before version 4 */ dprint_msg.control.line_nbrs = "0"b; i = dprint_msg.output_module; /* get the user defined format */ if i < 2 | i > 4 then do; /* be sure it is defined */ call iodd_msg_ (0, both, 0, "", "Undefined punch format in user request.^/Request ^d.^d for ^a (segment ^a) not processed", p2 -> request_descriptor.seq_id, p2 -> request_descriptor.q, p2 -> request_descriptor.mseg_message_info_copy.sender_id, dprint_msg.header.ename); p2 -> request_descriptor.cancelled = "1"b; go to be_nice; end; iodd_static.quit_during_request = "0"b; /* start clean */ ctl_msg_sent = "0"b; /* initialize to no msg yet */ call output_request_ (sw.name (i), sw.size (i), stat_p, print_banner, ec); if ec ^= 0 then iodd_static.slave_hold = "1"b; /* on errors go to command level */ return; %page; print_banner: entry (a_stream, type, data_ptr, code); dcl a_stream char (*); /* this would normally be the banner output stream */ /* but we can only use the flip card stream */ dcl type fixed bin; /* type of banner to be written */ /* 1 = heading banner */ /* 2 = tail banner */ /* 3 = error message */ dcl data_ptr ptr; /* pointer to output request data or */ /* to char(256) varying string error msg */ dcl code fixed bin (35); /* error code */ banner_stream = sw.name (5); /* we must use the flipper stream */ if type = 1 then do; /* heading banner for punch wanted */ iodd_static.quit_during_request = "0"b; /* reset for each request */ if iodd_static.ctl_term.attached then do; /* message to ctl term? */ call write_control_form_ (iodd_static.form_type, iodd_static.ctl_output, data_ptr, ec); if ec ^= 0 then do; if code ^= error_table_$action_not_performed then do; /* this is normal */ call iodd_msg_ (2, master, ec, whoami, "Writing message on control terminal."); iodd_static.slave_hold = "1"b;/* avoid automatic start */ end; ctl_msg_sent = "0"b; /* don't wait for bad message */ end; else ctl_msg_sent = "1"b; /* say all was well, so we can wait */ if ctl_wait_list.number = 1 & ctl_msg_sent then do; /* are we going to sync with the term? */ call ipc_$drain_chn (ctl_wait_list.channel, ec); if ec ^= 0 then do; /* avoid futher trouble, but not fatal */ ctl_wait_list.channel = 0; /* stop trying */ ctl_wait_list.number = 0; iodd_static.slave_hold = "1"b; ctl_msg_sent = "0"b; /* don't wait , no wakeup will come */ call iodd_msg_ (2, master, 0, whoami, "print_banner bad call to ipc_drain ^d", ec); end; else call timer_manager_$alarm_wakeup (driver_status.form_wait_time, "11"b, alarm_channel); end; end; else ctl_msg_sent = "0"b; /* don't wait */ dmp = addr (iodd_static.driver_ptr -> driver_status.message); /* get pointer to meessage */ ordatap = data_ptr; /* set default ptr for output_request_data */ /* PRINT THE FLIP CARDS HERE */ if dprint_msg.heading = "" then head = before (ordata.requestor, "."); /* default to the person */ else head = dprint_msg.heading; if dprint_msg.destination = "" then dest = before (after (ordata.requestor, "."), "."); /* default to project */ else dest = dprint_msg.destination; access_class = before (ordata.access_class_string, ","); /* we want the first token, strip the rest */ /* Now, format the flip card header. */ call ioa_$rsnnl ("^a^/^x^7a^x^2/^7d^2x^2/^3xCOPY^2x^2/^x^2d OF^2d^x^2/^x^8a^2/^x^8a^2/^x^7a^x^2/^x^7a^x^/", card_header, nelm, xxbar, "REQUEST", ordata.request_no, ordata.copy_no, ordata.copies, substr (ordata.date_time_start_request, 1, 8), substr (ordata.date_time_start_request, 11, 6), substr (dest, 1, 7), substr (dest, 8, 7)); call write_msg (card_header); /* the first few cards */ call write_msg (ordata.requestor); call write_msg (access_class); call write_msg (ordata.full_path); call write_msg (xxbar); /* this closes out the header cards */ call ios_$order (banner_stream, "reset", null, io_stat); /* clear card count */ end; else if type = 2 then do; /* a trailing banner is wanted */ if iodd_static.test_entry then /* be able to set a reasonable pace */ if time > 1 then call timer_manager_$sleep (time, "11"b); /* simulate device */ /* PUT IN A TAIL SEPARATOR HERE */ call ioa_$rsnnl ("^3xEND OF^6xDECK^3x^a", card_header, nelm, xxbar); call write_msg (card_header); if iodd_static.quit_during_request then /* output was lost */ ctl_msg_sent = "0"b; /* cancel the flag */ else if ctl_msg_sent then do; /* avoid premature blocking */ ctl_msg_sent = "0"b; /* ready for the next one */ call ipc_$block (addr (ctl_wait_list), addr (event_info), ec); /* wait for form to finish */ end; end; else if type = 3 then do; /* put out an error message */ card_header = xxbar || "ERROR DURING REQUEST " || xxbar; /* just a general message */ call ios_$write (banner_stream, addr (card_header), 0, 66, nelt, io_stat); code = 0; /* don't cause trouble */ end; else code = error_table_$action_not_performed; /* all other banner types are undefined */ return; flip_err: code = st.code; /* report the error */ return; /* and stop writing */ %page; command: entry (source, state, arg_list_p, c_code); dcl source fixed bin; /* 1 = master console, 2 = slave */ dcl state fixed bin; /* 0 = not quite ready to handle a request */ /* 1 = drivers are ready */ /* 2 = command entered after a quit */ dcl arg_list_p ptr; /* ptr to structure returned by parse_command_ */ dcl c_code fixed bin (35); /* error code: zero if command handled correctly */ /* error_table_ code for bad syntax or unknown command */ dcl 1 arg_list aligned based (arg_list_p), /* parse_command_ structure */ 2 max_tokens fixed bin, /* space allocated, do not change */ 2 n_tokens fixed bin, /* number of tokens from command line (including cmd) */ 2 command char (64) var, /* the first token is the command */ 2 arg (n_tokens - 1) char (64) var; /* the other tokens are args to the command */ if command = "help" then do; c_code = 0; call iodd_msg_ (1, source, 0, "", "^/** Commands for the punch driver **^/"); call iodd_msg_ (1, source, 0, "", "sample_form"); if test_entry then call iodd_msg_ (1, source, 0, "", "time []"); end; else if command = "ctl_term" then do; /* this was passed on by iodd_command_processor_ */ iodd_static.driver_ptr -> driver_status.form_wait_time = 5; /* to have us set the default form type */ iodd_static.form_type = "std_ctl_msg"; /* this is our default */ end; else if command = "time" then do; if iodd_static.test_entry then do; /* refuse to recognize if not testing */ c_code = 0; /* the command was good */ if n_tokens > 1 then do; time = cv_dec_check_ ((arg (1)), ec); if ec ^= 0 then time = 10; end; else time = 1; /* return to the default..full speed */ end; end; else if command = "sample_form" then do; c_code = 0; /* we'll handle everything here */ if iodd_static.ctl_term.attached then do; /* be sure there is a place to write */ if iodd_static.forms then do; /* are we simulating FF? */ call ios_$order (iodd_static.ctl_output, "form_status", addr (form_info), io_stat); if st.code ^= 0 then do; /* OOPS.... */ c_code = st.code; /* pass it back */ iodd_static.master_hold = "1"b; /* this is a problem for master terminal */ call iodd_msg_ (1, both, st.code, whoami, "^/form_status order call. Master terminal action required to continue."); return; end; if ^form_info.aligned then call ios_$order (iodd_static.ctl_output, "form_aligned", null, io_stat); /* this will work */ end; call write_sample_form_ (iodd_static.form_type, iodd_static.ctl_output, c_code); end; else call iodd_msg_ (1, source, 0, "", "Control terminal is not attached."); end; return; /* return any undefined commands without changing anything */ %page; default_handler: entry (condition_info_ptr); dcl condition char (32); /* fixed string for the call */ condition = condition_info.condition_name; /* this will indent funny */ if iodd_static.request_in_progress then /* try to avoid mistakes */ call output_request_$error_during_request (condition); /* take it away */ return; /* output_request_ should not return, but.... */ %page; detach_all: proc; /* cleanup proc to detach all possible streams we could have attached */ call ios_$detach (iodd_static.dev_out_stream, "", "", io_stat); do i = 2 to 5; call ios_$detach (sw.name (i), "", "", io_stat); end; return; end detach_all; write_msg: proc (string); dcl string char (*) aligned; nelm = length (rtrim (string)); if nelm > 0 then do; /* write flip cards for non blank message */ call ios_$write (banner_stream, addr (string), 0, nelm, nelt, io_stat); if st.code ^= 0 then go to flip_err; /* trouble */ end; return; end write_msg; %page; %include condition_info; %page; %include dprint_msg; %page; %include driver_status; %page; %include iod_constants; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include mseg_message_info; %page; %include output_request_data; %page; %include queue_msg_hdr; %page; %include request_descriptor; %page; %include rqti_header; end punch_driver_;  write_control_form_.pl1 10/28/88 1403.5rew 10/28/88 1232.4 112095 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ write_control_form_: proc (a_type, a_stream, a_ordatap, a_code); /* This is the program which acts as a transfer vector for printing control forms of different formats based on the a_type argument. The a_stream is passed on to the actual program which knows the format to be used. The "write_sample_form_" entry generates a dummy set of data to pass on to the form writing program to check alignment. */ /* Originally coded in March 1975 by J. C. Whitmore */ /* Modified in Dec 1975 by J. C. Whitmore for new ordata structure info */ /* Modified in April 1976 by J. C. Whitmore to correct the declaration of iodd_ to named ext static */ /* Modified in August 1977 by J. C. Whitmore to special case the form names "head_sheet" and "tail_sheet" */ /* Modified in March 1978 by J. C. Whitmore for new dprint_msg format and new ordata info */ /* Modified by J. C. Whitmore, 8/78, for new output_request_data info */ /* Modified by J. C. Whitmore, 8/79, to add write_sample_prt_banner_ entry */ /* Modified by R. McDonald May 1980 to include page charges for printing. (UNCA) */ /* Modified by E. N. Kittlitz June 1981 for UNCA page charges */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Updated dprint_msg to version 4. 2) change(88-02-18,Brunelle), approve(88-09-16,MCR7911), audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199): Added $init entrypoint to take ptr to iodd_static so we can use the head/tail sheet entry variables store there. Change code to use entry variables in iodd_static if available. 3) change(88-08-30,Farley), approve(88-09-16,MCR7911), audit(88-10-20,Wallman), install(88-10-28,MR12.2-1199): Updated to use version 5 dprint_msg. END HISTORY COMMENTS */ /* External Procedures & Variables */ dcl cu_$ptr_call entry options (variable); dcl error_table_$action_not_performed fixed bin (35) ext static; dcl ioa_$ioa_stream entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl iodd_$ ext static; /* so we can find the ref dir of make seg */ dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); /* Parameters */ dcl a_code fixed bin (35) parameter; /* error code */ dcl a_iocbp ptr parameter; /* user-supplied iocb to output on */ dcl a_ordatap ptr parameter; /* user-supplied output request data to use */ dcl a_prt_ctl_ptr ptr parameter; /* user-supplied printer control info ptr */ dcl a_static_ptr ptr parameter; /* ptr to iodd_static */ dcl a_stream char (*) parameter; /* user-supplied stream to output on */ dcl a_type char (*) parameter; /* user-supplied type of control form to output */ /* Automatic */ dcl copies_left fixed bin; /* number of copies computed for control form output */ dcl dest char (36); /* for output */ dcl head char (64); /* for output */ dcl iocbp ptr; /* iocb ptr to output on. */ /* if user passed stream name, we will locate the ptr */ dcl iodd_static_ptr ptr int static init (null ()); /* ptr to drivers iodd_static */ dcl l fixed bin; dcl last_type char (32) int static init (""); dcl len fixed bin; dcl oprmsg char (256); dcl prt_ctl_ptr ptr; /* prt_ctl ptr to use */ /* if user didn't pass one, define as null */ dcl proc_name char (32); dcl proc_ptr ptr int static init (null); dcl searched bit (1); dcl 1 request aligned int static like ordata; /* the rest of the daemon info */ %page; /* write_control_form_: proc (a_type, a_stream, a_ordatap, a_code); Main entry */ ordatap = a_ordatap; /* copy the input data pointer */ prt_ctl_ptr = null; /* locate the iocb for the given stream */ call iox_$look_iocb (a_stream, iocbp, a_code); if a_code ^= 0 then return; common_write: a_code = 0; /* this is common to both entries */ if a_type = "undefined" then do; /* so we can bypass, if desired */ a_code = error_table_$action_not_performed; return; end; if a_type = "std_ctl_msg" then do; /* this is the default for the normal ctl term */ if ordata.separator then do; /* one message per separator bar */ copies_left = ordata.copies - ordata.copy_no + 1; /* number we will print */ dmp = ordata.dpmp; /* get the pointer to the dprint message */ head = dprint_msg.heading; if substr (head, 1, 5) = " for " then /* see if dprint added something */ head = substr (head, 6); /* if so get rid of it */ if head ^= "" then call ioa_$rsnnl ("(for ""^a"" ", oprmsg, l, head); else do; l = 1; /* no heading, get ready for a dest msg */ oprmsg = "("; end; dest = dprint_msg.destination; if dest ^= "" then call ioa_$rsnnl ("^vaat ""^a"")", oprmsg, l, (l), substr (oprmsg, 1, l), dest); else if l = 1 then oprmsg = ""; /* no head or dest case */ else substr (oprmsg, l, 1) = ")"; /* heading only case */ call ioa_$rsnnl ("Request ^d ^a q^d: ^a^/^2x^[(^d copies) ^;^s^]^[priority ^d ^;^s^]from ^a ^a", oprmsg, l, ordata.request_no, ordata.request_type, ordata.queue, ordata.full_path, (copies_left > 1), copies_left, ordata.priority_request, ordata.charge_queue, ordata.requestor, (oprmsg)); call ioa_$ioa_stream (a_stream, "^a", oprmsg); end; return; end; if a_type = "head_sheet" then do; call iodd_static_ptr -> iodd_static.print_head_sheet (iocbp, prt_ctl_ptr, ordatap, a_code); return; end; if a_type = "tail_sheet" then do; call iodd_static_ptr -> iodd_static.print_tail_sheet (iocbp, prt_ctl_ptr, ordatap, a_code); return; end; if a_type = "separator" then do; call iodd_static_ptr -> iodd_static.print_head_separator (iocbp, prt_ctl_ptr, "separator", a_code); return; end; /* otherwise we will have to search for the module to call....must be in search path */ searched = "0"b; /* havn't searched for the proc name */ if last_type ^= a_type then do; /* try for some efficiency */ find: call ioa_$rsnnl ("write_^a_", proc_name, len, a_type); /* format to "write_type_" as module name */ call hcs_$make_ptr (addr (iodd_$), proc_name, proc_name, proc_ptr, a_code); if a_code ^= 0 then do; /* this is bad */ last_type = ""; /* have to set the ptr after re-compile */ return; end; last_type = a_type; /* so we don't do this too often */ searched = "1"b; /* we have tried searching */ end; call cu_$ptr_call (proc_ptr, a_stream, ordatap, a_code); if a_code ^= 0 then if ^searched then go to find; /* possibly an error on the old pointer */ return; /* let the caller handle the error if any */ write_sample_prt_banner_: entry (a_type, a_iocbp, a_prt_ctl_ptr, a_code); /* this entry is used to print sample head_sheets and tail_sheets */ if a_type ^= "head_sheet" & a_type ^= "tail_sheet" then do; not_done: a_code = error_table_$action_not_performed; return; end; iocbp = a_iocbp; if iocbp = null then go to not_done; prt_ctl_ptr = a_prt_ctl_ptr; go to sample_common; write_sample_form_: entry (a_type, a_stream, a_code); dcl init bit (1) int static init ("0"b); /* initialization flag to avoid extra work */ dcl (addr, string, null, substr) builtin; dcl clock_ entry () returns (fixed bin (71)); dcl date_time_ entry (fixed bin (71), char (*) aligned); dcl alloc_dmp ptr int static init (null); /* locate the iocb for the given stream */ call iox_$look_iocb (a_stream, iocbp, a_code); if a_code ^= 0 then return; prt_ctl_ptr = null; sample_common: ordatap = addr (request); /* we want the dummy data */ if alloc_dmp = null then /* need a copy of dprint_msg too */ allocate dprint_msg set (alloc_dmp); if ^init then do; /* first time we set these values */ request.dpmp = alloc_dmp; /* ptr to dummy message */ request.requestor = "Username.Project.x"; request.full_path = ">user_dir_dir>Project_name>Username>segment_name"; request.queue = 3; request.charge_queue = 1; /* charge at rate for queue 1 */ request.copies = 4; request.copy_no = 1; request.request_no = 999999; /* highest possible request for a driver */ request.restart_no = 888888; /* previous number which was restarted */ request.request_type = "request_type_name"; /* Hope this is general enough */ request.access_class_string = "-AIM--Field-, Category 2, Category 4"; request.punsw = 0; request.delete = 1; request.device_name = "device_name"; request.output_mode = "single,noskip,non_edited,ll132,pl60,in10."; request.line_count = 4600; request.page_count = 78; request.cpu_time = 1000000; /* 1 million microseconds */ request.real_time = 20000000; /* 20 million microseconds */ request.page_waits = 3687; request.pre_pages = 2017; request.bit_count = 224745; request.charge = 9.20; /* $9.20 should be large enough */ request.price_per_n_lines = 2.00; /* try for $2.00 per 1000 lines */ request.n_lines_for_price = 1000; /* this is the per 1000 part */ request.price_per_n_pages = 8.00; /* try for $8.00 per 1000 pages */ request.n_pages_for_price = 1000; /* this is the per 1000 part */ request.total_charge = 9.20; request.notify = "1"b; request.continued = "0"b; request.restarted = "1"b; /* this will show a restarted request - if needed */ request.separator = "1"b; /* indicates a message should be printed */ request.saved = "1"b; /* say we suspended request */ request.priority_request = "1"b; /* this one was high priority */ request.contd_no = 0; /* not a continued request */ /* now for the actual dprint message */ dmp = alloc_dmp; /* copy the ptr for auto based reference */ dprint_msg.msg_time = clock_ (); /* just a legal value */ dprint_msg.dirname = ">user_dir_dir>Project_name>Username"; dprint_msg.ename = "segment_name"; dprint_msg.hdr_version = queue_msg_hdr_version_1; dprint_msg.state = 0; dprint_msg.orig_queue = 3; string (dprint_msg.bit_flags) = ""b; dprint_msg.version = dprint_msg_version_5; dprint_msg.message_type = 1; /* we are assuming a print request */ dprint_msg.copies = 4; dprint_msg.delete_sw = "1"b; dprint_msg.notify = "1"b; dprint_msg.heading_lth = head_max_lth; dprint_msg.top_label_lth = label_max_lth; dprint_msg.bottom_label_lth = label_max_lth; dprint_msg.chan_stop_path_lth = 0; dprint_msg.heading = "-HEAD-BANNER-WITH-NO-BLANKS-WHICH-CAN-GO-ON-FOR-64-CHARS-------*"; dprint_msg.output_module = 1; string (dprint_msg.control) = (36)"1"b; dprint_msg.destination = "SAMPLE---DESTINATION"; dprint_msg.forms = ""; dprint_msg.forms_name_lth = 0; dprint_msg.lmargin = 10; dprint_msg.line_lth = 132; dprint_msg.page_lth = 60; dprint_msg.top_label = (3)"This will appear at the top and bottom of each page. "; dprint_msg.bottom_label = dprint_msg.top_label; init = "1"b; /* lets not do this again!! */ end; request.time_start_request = clock_ (); call date_time_ (request.time_start_request, request.date_time_start_request); go to common_write; /* entrypoint to save ptr to the drivers iodd_static structure */ init: entry (a_static_ptr); iodd_static_ptr = a_static_ptr; return; %page; %include dprint_msg; %page; %include iod_tables_hdr; %page; %include iodd_static; %page; %include output_request_data; %page; %include queue_msg_hdr; end write_control_form_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved