COMPILATION LISTING OF SEGMENT cmcs_decode_status_ Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1023.7 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* *********************************************************** */ 8 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 14* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 15* MCR8060 cmcs_decode_status_.pl1 Reformatted code to new Cobol standard. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified since Version 4.3 */ 20 21 /* format: style3 */ 22 cmcs_decode_status_: 23 proc (a_iocbp, a_cdp, a_io_type, a_io_subtype, a_code); 24 25 /* This COBOL MCS subroutine decodes the status key in the input or output CD 26* and prints this information on the specified output switch. If the call 27* specifies a non-null output CD pointer, the station_names 28* (in the output CD) are also printed with their corresponding error_keys. 29* 30* Bob May, 6/30/77 */ 31 32 dcl a_iocbp ptr, 33 a_cdp ptr, /* don't know yet if input, output, or null */ 34 a_io_type fixed bin, 35 a_io_subtype fixed bin, 36 a_code fixed bin (35); /* if ever nonzero, there's a bug */ 37 38 dcl io_types (7) char (8) int static options (constant) 39 init ("Send", "Receive", "Enable", "Disable", "Accept", "Purge", "Print"); 40 /* STOP RUN can't have status key */ 41 42 dcl io_subtypes (0:28) char (24) int static options (constant) init ("Partial", 43 /* Send - 0 */ 44 "Segment", /* Send - 1 */ 45 "Message", /* Send - 2 */ 46 "Group", /* Send - 3 */ 47 "filler", /* send is 0-3, others are 1-4 */ 48 "Segment, No Wait", /* Receive - 1 */ 49 "Message, No Wait", /* Receive - 2 */ 50 "Segment, Wait", /* Receive - 3 */ 51 "Message, Wait", /* Receive - 4 */ 52 "Input (Queue)", /* Enable - 1 */ 53 "Input Terminal", /* Enable - 2 */ 54 "Output (Destination)", /* Enable - 3 */ 55 "N/A", /* Enable - 4 */ 56 "Input (Queue)", /* Disable - 1 */ 57 "Input Terminal", /* Disable - 2 */ 58 "Output (Destination)", /* Disable - 3 */ 59 "N/A", /* Disable - 4 */ 60 "Message Count", /* Accept - 1 */ 61 "N/A", /* Accept - 2 */ 62 "N/A", /* Accept - 3 */ 63 "N/A", /* Accept - 4 */ 64 "Sends Only (CODASYL)", /* Purge - 1 */ 65 "Receives Only (Multics)", /* Purge - 2 */ 66 "All (Multics)", /* Purge - 3 */ 67 "N/A", /* Purge - 4 */ 68 "Segment, No Wait", /* Print - 1 */ 69 "Message, No Wait", /* Print - 2 */ 70 "N/A", /* Print - 3 */ 71 "N/A"); /* Print - 4 */ 72 73 dcl status_keys (10) char (2) int static options (constant) 74 init ("na", "00", "10", "15", "20", "30", "40", "50", "60", "70"); 75 76 dcl io_type fixed bin, 77 io_subtype fixed bin, 78 count fixed bin, 79 status_key char (2), 80 error_key char (1), 81 i fixed bin, 82 input_cd_sw bit (1); 83 84 dcl ioa_$ioa_switch entry options (variable); 85 86 /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 1 2 1 3 /* This COBOL MCS include file defines the input and output CD structures 1 4* that are used by the COBOL object program to pass function-specific data 1 5* to the CMCS runtime support package. */ 1 6 1 7 /* Bob May, 6/30/77 */ 1 8 1 9 dcl input_cdp ptr; 1 10 1 11 /* Input CD Structure */ 1 12 1 13 dcl 1 input_cd aligned based (input_cdp), 1 14 1 15 /* Input Header */ 1 16 1 17 2 queue_ptr ptr, 1 18 2 flags, 1 19 (3 io_sw bit (1), /* always "1"b for input cd */ 1 20 3 cobol_sw bit (1), /* always "1"b for COBOL MCS */ 1 21 3 filler bit (34)) unaligned, 1 22 2 last_tree_path, /* for faster lookup only */ 1 23 3 level_names (4) char (12), 1 24 1 25 /* COBOL Input CD */ 1 26 1 27 2 tree_path, 1 28 3 level_names (4) char (12), /* DN 1-4 */ 1 29 (2 msg_date char (6), /* DN 5, YYMMDD */ 1 30 2 msg_time char (8), /* DN 6, HHMMSSTT */ 1 31 2 station_name char (12), /* DN 7 */ 1 32 2 text_len pic "9999", /* DN 8, S.B. pic "9999" */ 1 33 2 text_delim pic "9", /* DN 9, S.B. pic "9" */ 1 34 2 status_key char (2), /* DN 10 */ 1 35 2 msg_count pic "999999") unaligned; /* DN 11, S.B. pic "999999" */ 1 36 1 37 /* */ 1 38 1 39 dcl output_cdp ptr; 1 40 1 41 /* Output CD Structure */ 1 42 1 43 dcl 1 output_cd aligned based (output_cdp), 1 44 1 45 /* Output CD Header */ 1 46 1 47 2 last_station_info_ptr ptr, 1 48 2 flags, 1 49 (3 io_sw bit (1), /* always "0"b for output cd */ 1 50 3 cobol_sw bit (1), /* alays "1"b for COBOL MCS */ 1 51 3 filler bit (34)) unaligned, 1 52 2 bin_max_station_count fixed bin, /* who sets? ---- */ 1 53 2 char_max_station_count pic "9999", /* S.B. pic "9999" */ 1 54 1 55 /* COBOL Output CD */ 1 56 1 57 2 station_count pic "9999", /* DN 1, S.B. pic "9999" */ 1 58 2 text_len pic "9999", /* DN 2, S.B. pic "9999" */ 1 59 2 status_key char (2) unaligned, /* DN 3 */ 1 60 2 dest_table (0 refer (output_cd.bin_max_station_count)) unaligned, 1 61 3 error_key char (1), /* DN 4 */ 1 62 3 station_name char (12); /* DN 5 */ 1 63 1 64 /* Last Station Info */ 1 65 1 66 dcl 1 last_station_info based (output_cd.last_station_info_ptr) aligned, 1 67 2 last_dest (output_cd.bin_max_station_count), 1 68 3 queue_iocbp ptr, 1 69 3 station_name char (12); 1 70 1 71 /* END INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 87 2 1 /* BEGIN INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 2 2 2 3 /* Bob May, 6/30/77 */ 2 4 2 5 dcl (cmcs_error_table_$ambiguous_tree_path, cmcs_error_table_$bad_call_parm, cmcs_error_table_$bad_dest, 2 6 cmcs_error_table_$bad_dest_count, cmcs_error_table_$bad_message_length, 2 7 cmcs_error_table_$bad_password, cmcs_error_table_$bad_queue_path, cmcs_error_table_$bad_slew, 2 8 2 9 cmcs_error_table_$bad_source, cmcs_error_table_$bad_station, 2 10 cmcs_error_table_$bad_term_devchn, cmcs_error_table_$bad_tree_path, 2 11 cmcs_error_table_$dest_already_disabled, cmcs_error_table_$dest_already_enabled, 2 12 2 13 cmcs_error_table_$dest_disabled, cmcs_error_table_$no_message, 2 14 cmcs_error_table_$no_partial_messages, cmcs_error_table_$null_partial_message, 2 15 cmcs_error_table_$queue_already_disabled, cmcs_error_table_$queue_already_enabled, 2 16 2 17 cmcs_error_table_$queue_disabled, cmcs_error_table_$source_already_disabled, 2 18 cmcs_error_table_$source_already_enabled, cmcs_error_table_$source_disabled) fixed bin (35) external; 2 19 2 20 /* END INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 88 89 90 /* */ 91 a_code = 0; /* highly unlikely it will ever be otherwise */ 92 input_cdp, output_cdp = a_cdp; /* easier to do both now */ 93 94 go to set_io_type (a_io_type); 95 96 /* send, purge (CODASYL), enable/disable output */ 97 set_io_type (1): 98 set_purge_io_subtype (1): /* Standard CODASYL */ 99 set_purge_io_subtype (3): /* COBOL Extension */ 100 set_en_dis_io_subtype (3): 101 input_cd_sw = "0"b; /* function uses output CD */ 102 if output_cdp = null () 103 then status_key = "na"; 104 else status_key = output_cd.status_key; 105 go to print_status_key; 106 107 /* receive (and print), accept, enable/disable input/input terminal, purge (partial rcvs) */ 108 set_io_type (2): 109 set_io_type (5): 110 set_io_type (7): 111 set_en_dis_io_subtype (1): 112 set_en_dis_io_subtype (2): 113 set_purge_io_subtype (2): 114 input_cd_sw = "1"b; /* uses input CD */ 115 if input_cdp = null () 116 then status_key = "na"; /* special COBOL extension */ 117 else status_key = input_cd.status_key; 118 go to print_status_key; 119 120 /* enable, disable */ 121 set_io_type (3): 122 set_io_type (4): 123 go to set_en_dis_io_subtype (a_io_subtype); 124 125 /* purge */ 126 set_io_type (6): 127 go to set_purge_io_subtype (a_io_subtype); 128 129 /* */ 130 131 print_status_key: 132 call ioa_$ioa_switch (a_iocbp, "IO Type: ""^8a"", IO Subtype: ""^24a"", Status Key: ""^2a""", 133 io_types (a_io_type), io_subtypes ((4 * (a_io_type - 1) + a_io_subtype)), status_key); 134 135 do i = 1 to 12; 136 if status_key = status_keys (i) 137 then go to print_status_msg (i); 138 end; 139 140 a_code = cmcs_error_table_$bad_call_parm; 141 go to ds_ret; 142 143 /* na */ 144 print_status_msg (1): 145 call ioa_$ioa_switch (a_iocbp, "Null CD pointer used for this operation."); 146 go to print_error_keys; 147 148 /* 00 */ 149 print_status_msg (2): 150 call ioa_$ioa_switch (a_iocbp, "No error detected. Action completed."); 151 go to print_error_keys; 152 153 /* 10 */ 154 print_status_msg (3): 155 call ioa_$ioa_switch (a_iocbp, "One or more destinations are disabled. Action completed."); 156 go to print_error_keys; 157 158 /* 15 */ 159 print_status_msg (4): 160 call ioa_$ioa_switch (a_iocbp, "One or more queues or destinations already enabled."); 161 go to print_error_keys; 162 163 /* 20 */ 164 print_status_msg (5): 165 if a_io_subtype > 3 166 then io_type = 7 - a_io_type; /* 4, 5, 6 = 3, 2, 1, respectively */ 167 else io_type = a_io_type; /* lumps send/purge, receive/accept, enable/disable */ 168 169 if io_type = 1 170 then do; /* send, purge, enable/disable output */ 171 print_status_msg_20 (1): 172 call ioa_$ioa_switch (a_iocbp, 173 "One or more destinations unknown. Action completed for known destinations. No action taken for unknown destinations. Data-name-4 (ERROR KEY) indicates known or unknown." 174 ); 175 go to print_error_keys; 176 end; 177 178 else if io_type = 2 179 then do; 180 181 /* receive, accept, enable/disable input */ 182 print_status_msg_20 (2): 183 call ioa_$ioa_switch (a_iocbp, "One or more queues or subqueues unknown. No action taken."); 184 go to print_error_keys; 185 end; 186 187 else do; /* io_type = 3 */ 188 if a_io_subtype = 3 189 then io_subtype = 1; 190 else io_subtype = a_io_subtype + 1; 191 go to print_status_msg_20 (io_subtype); 192 end; 193 194 /* enable/disable input terminal */ 195 print_status_msg_20 (3): 196 call ioa_$ioa_switch (a_iocbp, "The source is unknown. No action taken."); 197 go to print_error_keys; 198 199 /* 30 */ 200 print_status_msg (6): 201 call ioa_$ioa_switch (a_iocbp, "Content of DESTINATION COUNT invalid. No action taken."); 202 go to print_error_keys; 203 204 /* 40 */ 205 print_status_msg (7): 206 call ioa_$ioa_switch (a_iocbp, "Passord invalid. No enabling/disabling action taken."); 207 go to print_error_keys; 208 209 /* 50 */ 210 print_status_msg (8): 211 call ioa_$ioa_switch (a_iocbp, "Character count greater than length of sending field. No action taken."); 212 go to print_error_keys; 213 214 /* 60 */ 215 print_status_msg (9): 216 call ioa_$ioa_switch (a_iocbp, 217 "Partial segment with either zero character count or no sending area specified. No action taken."); 218 go to print_error_keys; 219 220 /* 70 */ 221 print_status_msg (10): 222 call ioa_$ioa_switch (a_iocbp, 223 "One or more detinations do not have partial messages associated with them. Action completed for other destinations." 224 ); 225 go to print_error_keys; 226 227 print_error_keys: 228 if ^input_cd_sw 229 then if output_cdp ^= null () 230 then do; /* print out individual ERROR KEYs from output CD */ 231 count = output_cd.station_count; 232 if count <= output_cd.bin_max_station_count 233 then do; /* valid CD info */ 234 call ioa_$ioa_switch (a_iocbp, "Station Error Code"); 235 do i = 1 to count; 236 call ioa_$ioa_switch (a_iocbp, "^12a ^1a", output_cd.dest_table (i).station_name, 237 output_cd.dest_table (i).error_key); 238 end; 239 call ioa_$ioa_switch (a_iocbp, ""); 240 /* leave a little whitespace */ 241 end; 242 end; 243 244 ds_ret: 245 return; 246 247 end /* cmcs_decode_status_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0833.9 cmcs_decode_status_.pl1 >spec>install>MR12.3-1048>cmcs_decode_status_.pl1 87 1 03/27/82 0439.5 cmcs_cd_dcls.incl.pl1 >ldd>include>cmcs_cd_dcls.incl.pl1 88 2 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_cdp parameter pointer dcl 32 ref 22 92 a_code parameter fixed bin(35,0) dcl 32 set ref 22 91* 140* a_io_subtype parameter fixed bin(17,0) dcl 32 ref 22 121 126 131 164 188 190 a_io_type parameter fixed bin(17,0) dcl 32 ref 22 94 131 131 164 167 a_iocbp parameter pointer dcl 32 set ref 22 131* 144* 149* 154* 159* 171* 182* 195* 200* 205* 210* 215* 221* 234* 236* 239* bin_max_station_count 3 based fixed bin(17,0) level 2 dcl 1-43 ref 232 cmcs_error_table_$bad_call_parm 000012 external static fixed bin(35,0) dcl 2-5 ref 140 count 000102 automatic fixed bin(17,0) dcl 76 set ref 231* 232 235 dest_table 7(18) based structure array level 2 packed packed unaligned dcl 1-43 error_key 7(18) based char(1) array level 3 packed packed unaligned dcl 1-43 set ref 236* i 000104 automatic fixed bin(17,0) dcl 76 set ref 135* 136 136* 235* 236 236* input_cd based structure level 1 dcl 1-13 input_cd_sw 000105 automatic bit(1) packed unaligned dcl 76 set ref 97* 108* 227 input_cdp 000106 automatic pointer dcl 1-9 set ref 92* 115 117 io_subtype 000101 automatic fixed bin(17,0) dcl 76 set ref 188* 190* 191 io_subtypes 000037 constant char(24) initial array packed unaligned dcl 42 set ref 131* io_type 000100 automatic fixed bin(17,0) dcl 76 set ref 164* 167* 169 178 io_types 000315 constant char(8) initial array packed unaligned dcl 38 set ref 131* ioa_$ioa_switch 000010 constant entry external dcl 84 ref 131 144 149 154 159 171 182 195 200 205 210 215 221 234 236 239 output_cd based structure level 1 dcl 1-43 output_cdp 000110 automatic pointer dcl 1-39 set ref 92* 102 104 227 231 232 236 236 station_count 5 based picture(4) level 2 dcl 1-43 ref 231 station_name 7(27) based char(12) array level 3 packed packed unaligned dcl 1-43 set ref 236* status_key 7 based char(2) level 2 in structure "output_cd" packed packed unaligned dcl 1-43 in procedure "cmcs_decode_status_" ref 104 status_key 000103 automatic char(2) packed unaligned dcl 76 in procedure "cmcs_decode_status_" set ref 102* 104* 115* 117* 131* 136 status_key 42(27) based char(2) level 2 in structure "input_cd" packed packed unaligned dcl 1-13 in procedure "cmcs_decode_status_" ref 117 status_keys 000032 constant char(2) initial array packed unaligned dcl 73 ref 136 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cmcs_error_table_$ambiguous_tree_path external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_dest external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_dest_count external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_message_length external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_password external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_queue_path external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_slew external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_source external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_station external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_term_devchn external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$bad_tree_path external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$dest_already_disabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$dest_already_enabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$dest_disabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$no_message external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$no_partial_messages external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$null_partial_message external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$queue_already_disabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$queue_already_enabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$queue_disabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$source_already_disabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$source_already_enabled external static fixed bin(35,0) dcl 2-5 cmcs_error_table_$source_disabled external static fixed bin(35,0) dcl 2-5 error_key automatic char(1) packed unaligned dcl 76 last_station_info based structure level 1 dcl 1-66 NAMES DECLARED BY EXPLICIT CONTEXT. cmcs_decode_status_ 000744 constant entry external dcl 22 ds_ret 001631 constant label dcl 244 ref 141 print_error_keys 001467 constant label dcl 227 ref 146 151 156 161 175 184 197 202 207 212 218 225 print_status_key 001020 constant label dcl 131 ref 105 118 print_status_msg 000015 constant label array(10) dcl 144 set ref 136 print_status_msg_20 000027 constant label array(3) dcl 171 ref 191 set_en_dis_io_subtype 000000 constant label array(3) dcl 97 ref 121 set_io_type 000006 constant label array(7) dcl 97 ref 94 set_purge_io_subtype 000003 constant label array(3) dcl 97 ref 126 NAME DECLARED BY CONTEXT OR IMPLICATION. null builtin function ref 102 115 227 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1710 1724 1635 1720 Length 2146 1635 14 205 52 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cmcs_decode_status_ 158 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cmcs_decode_status_ 000100 io_type cmcs_decode_status_ 000101 io_subtype cmcs_decode_status_ 000102 count cmcs_decode_status_ 000103 status_key cmcs_decode_status_ 000104 i cmcs_decode_status_ 000105 input_cd_sw cmcs_decode_status_ 000106 input_cdp cmcs_decode_status_ 000110 output_cdp cmcs_decode_status_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc return_mac ext_entry unpack_picture THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_$ioa_switch THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$bad_call_parm LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000737 91 000751 92 000753 94 000757 97 000761 102 000762 104 000771 105 000774 108 000775 115 000777 117 001006 118 001013 121 001014 126 001016 131 001020 135 001065 136 001073 138 001102 140 001104 141 001110 144 001111 146 001132 149 001133 151 001154 154 001155 156 001176 159 001177 161 001220 164 001221 167 001231 169 001233 171 001235 175 001256 178 001257 182 001261 184 001302 188 001303 190 001311 191 001313 195 001314 197 001334 200 001335 202 001356 205 001357 207 001400 210 001401 212 001422 215 001423 218 001444 221 001445 225 001466 227 001467 231 001475 232 001505 234 001511 235 001535 236 001545 238 001611 239 001613 244 001631 ----------------------------------------------------------- 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