THIS FILE IS DAMAGED COMPILATION LISTING OF SEGMENT eor_cv5_6_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1840.6 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 7 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 8 /* */ 9 /* This program is called by enter_output_request. eor stored user-defined default */ 10 /* control argument settings in the default value segment as binary data values. This */ 11 /* program converts these values from version 5 to version 6 format. The only */ 12 /* difference between versions is that version 5 makes no constraints on the names of */ 13 /* these groups of defaults. Version 6 disallows names which begin with a hyphen or */ 14 /* contain * or ? characters. */ 15 /* */ 16 /* Status: */ 17 /* Created: June 2, 1982 by G. C. Dixon */ 18 /* */ 19 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 20 21 eor_cv5_6_: 22 proc(Pdefault_header, code); 23 24 dcl Pdefault_header ptr, 25 code fixed bin(35); 26 27 dcl Pd ptr, 28 answer char(28) varying, 29 area area(4096), 30 dft_name char(28) varying, 31 d_size fixed bin(18), 32 i fixed bin, 33 unseen(2) bit(1) aligned, 34 unseen_overall_reason bit(1); 35 36 dcl 1 default_header aligned based(Pdefault_header), 37 2 version fixed bin, /* structure containing default request types and */ 38 2 default_request_type (3) char(24) unal, /* defining version of default_(print punch) */ 39 /* structures above. The default_request_type */ 40 /* array elements are for printing, punching and */ 41 Vdefault_header_6 fixed bin int static options(constant) init(6), 42 /* Version 6 de-supports default names beginning */ 43 /* with hyphen or which are starnames. */ 44 1 default, 45 2 header, 46 3 Ntype fixed bin, /* This structure holds information corresponding */ 47 3 name char(24) unal, /* to the O, S, N and PLS structures above, in */ 48 3 size fixed bin(18), /* the form in which it is stored as */ 49 1 d aligned based(Pd), 50 2 header like default.header, 51 2 data (d_size - size(default)) 52 fixed bin; 53 54 dcl (addr, after, empty, index, length, null, search, size, substr, translate) 55 builtin; 56 57 dcl command_query_ entry() options(variable), 58 ioa_$ioa_switch entry() options(variable), 59 value_$delete_data entry (ptr, bit(36) aligned, char(*), fixed bin(35)), 60 value_$get_data entry (ptr, bit(36) aligned, char(*), ptr, ptr, fixed bin(18), 61 fixed bin(35)), 62 value_$list_data_names entry (ptr, bit(36) aligned, ptr, ptr, ptr, fixed bin(35)), 63 value_$set_data entry (ptr, bit(36) aligned, char(*), ptr, fixed bin(18), ptr, ptr, 64 fixed bin(18), fixed bin(35)); 65 66 dcl AZ char(26) int static options(constant) 67 init("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 68 DEFAULT_VALUE_SEG ptr int static options(constant) init(null), 69 (FALSE init("0"b), 70 TRUE init("1"b)) bit(1) int static options(constant), 71 PERM bit(36) aligned int static opfawt  AWTaylor awt Multics VR; R녙RLnoneVIP7400_DTR NݞMZe"" or ""delete""."); 150 go to REASK_RENAME; 151 end; 152 153 unseen_overall_reason = FALSE; /* Mark overall reason for change, and this error */ 154 unseen(Nerr) = FALSE; /* as already having been seen. */ 155 156 if answer = "rename" then do; /* Renaming? Ask for the new name and validate it*/ 157 qi.explanation_ptr = addr(new_name_explanation); 158 qi.explanation_len = length(new_name_explanation); 159 call command_query_(addr(qi), answer, "enter_output_request", 160 "New name:", name); 161 ANSWER_CHECK: 162 if length(answer) > 24 then do; 163 call command_query_ (addr(qi), answer, "enter_output_request", 164 "^a is too long. The new name must be less than 25 characters long. 165 New name:", answer); 166 go to ANSWER_CHECK; 167 end; 168 else if index(answer,"-")=1 then do; 169 call command_query_ (addr(qi), answer, "enter_output_request", 170 "^a is an illegal name. The name cannot begin with a hyphen. 171 New name:", answer); 172 go to ANSWER_CHECK; 173 end; 174 else if search(answer,"*?")>0 then do; 175 call command_query_ (addr(qi), answer, "enter_output_request", 176 "^a is an illegal name. The name cannot be a starname. 177 New name:", answer); 178 go to ANSWER_CHECK; 179 end; 180 call value_$get_data (DEFAULT_VALUE_SEG, PERM, 181 "eor." || name || "._", addr(area), Pd, d_size, code); 182 d.name = answer; 183 call value_$delete_data (DEFAULT_VALUE_SEG, PERM, "eor." || name || "._", code); 184 if code ^= 0 then go to ERROR_EXIT; 185 call value_$set_data (DEFAULT_VALUE_SEG, PERM, 186 "eor." || answer || "._", Pd, d_size, null, null, 0, code); 187 if code ^= 0 then go to ERROR_EXIT; 188 free d in (area); 189 end; 190 191 else do; /* delete */ 192 call value_$delete_data (DEFAULT_VALUE_SEG, PERM, "eor." || name || "._", code); 193 if code ^= 0 then go to ERROR_EXIT; 194 end; 195 196 end eliminate; 197 198 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 199 1 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 1 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 1 3 /* version number changed to 4, 08/10/78 WOS */ 1 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 1 5 1 6 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 1 7 2 version fixed bin, /* version of this structure - must be set, see below */ 1 8 2 switches aligned, /* various bit switch values */ 1 9 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 1 10 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 1 11 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 1 12 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 1 13 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 1 14 3 padding bit (31) unaligned init (""b), /* pads it out to t word */ 1 15 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 1 16 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 1 17 1 18 /* Limit of data defined for version 2 */ 1 19 1 20 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 1 21 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 1 22 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 1 23 /* minimum of 30 seconds required for repeat */ 1 24 /* otherwise, no repeat will occur */ 1 25 /* Limit of data defined for version 4 */ 1 26 1 27 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 1 28 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 1 29 1 30 dcl query_info_version_3 fixed bin int static options (constant) init (3); 1 31 dcl query_info_version_4 fixed bin int static options (constant) init (4); 1 32 dcl query_info_version_5 fixed bin int static options (constant) init (5); /* the current version number */ 1 33 1 34 /* END INCLUDE FILE query_info.incl.pl1 */ 200 201 202 dcl 1 qi aligned like query_info; 203 2 1 /* BEGIN value_structures.incl.pl1 */ 2 2 2 3 dcl (match_info_ptr, value_list_info_ptr) ptr; 2 4 dcl (alloc_name_count, alloc_pair_count) fixed bin; 2 5 dcl (alloc_max_name_len, alloc_chars_len) fixed bin (21); 2 6 2 7 dcl 1 match_info aligned based (match_info_ptr), 2 8 2 version fixed bin, /* = 1 */ 2 9 2 name_count fixed bin, 2 10 2 max_name_len fixed bin (21), 2 11 2 name_array (alloc_name_count refer (match_info.name_count)), 2 12 3 exclude_sw bit (1) unaligned, /* ON for -exclude, OFF for -match */ 2 13 3 regexp_sw bit (1) unaligned, /* ON for regular exp. without the //, OFF for starname */ 2 14 3 pad bit (34) unaligned, 2 15 3 name char (alloc_max_name_len refer (match_info.max_name_len)) varying; 2 16 2 17 dcl 1 value_list_info aligned based (value_list_info_ptr), 2 18 2 version fixed bin, /* = 1 */ 2 19 2 pair_count fixed bin, 2 20 2 chars_len fixed bin (21), 2 21 2 pairs (alloc_pair_count refer (value_list_info.pair_count)), 2 22 3 type_switches bit (36), /* correspond to the selection switches arg */ 2 23 3 (name_index, name_len) fixed bin (21), 2 24 3 (value_index, value_len) fixed bin (21), 2 25 2 chars char (alloc_chars_len refer (value_list_info.chars_len)); 2 26 2 27 dcl (match_info_version_1, value_list_info_version_1) fixed bin int static options (constant) init (1); 2 28 2 29 /* END OF value_structures.incl.pl1 */ 204 205 206 dcl 1 mi aligned, /* automatic copy of match_info */ 207 2 version fixed bin init(1), 208 2 name_count fixed bin init(1), 209 2 max_name_length fixed bin init(30), 210 2 name_array (1), 211 3 exclude_sw bit(1) unal init("0"b), 212 3 regexp_sw bit(1) unal init("0"b), 213 3 pad bit(34) unal init("0"b), 214 3 name char(30) varying; 215 216 end eor_cv5_6_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1610.6 eor_cv5_6_.pl1 >dumps>old>recomp>eor_cv5_6_.pl1 200 1 08/12/81 0911.2 query_info.incl.pl1 >ldd>include>query_info.incl.pl1 204 2 06/24/81 1743.9 value_structures.incl.pl1 >ldd>include>value_structures.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. AZ 000130 constant char(26) initial unaligned dcl 66 ref 143 DEFAULT_VALUE_SEG 000126 constant pointer initial dcl 66 set ref 89* 102* 180* 183* 185* 192* FALSE constant bit(1) initial unaligned dcl 66 ref 120 121 153 154 Nerr parameter fixed bin(17,0) dcl 116 set ref 112 131* 131 154 PERM 000125 constant bit(36) initial dcl 66 set ref 89* 102* 180* 183* 185* 192* Pd 000100 automatic pointer dcl 27 set ref 180* 182 185* 188 Pdefault_header parameter pointer dcl 24 set ref 21 101 102* 102 102 TRUE constant bit(1) initial unaligned dcl 66 ref 84 85 Vdefault_header_6 constant fixed bin(17,0) initial dcl 36 ref 101 addr builtin function dcl 54 ref 89 89 89 89 129 131 131 157 159 159 163 163 169 169 175 175 180 180 after builtin function dcl 54 ref 94 answer 000102 automatic varying char(28) dcl 27 set ref 131* 143* 143 144 144 144 144* 146 146 146 146* 156 159* 161 163* 163* 168 169* 169* 174 175* 175* 182 185 answer_iocbp 6 010140 automatic pointer initial level 2 in structure "query_info" dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* answer_iocbp 6 010156 automatic pointer initial level 2 in structure "qi" dcl 202 in procedure "eor_cv5_6_" set ref 126* 202* area 000112 automatic area(4096) dcl 27 set ref 27* 89 89 180 180 188 az 000116 constant char(26) initial unaligned dcl 66 ref 143 chars based char level 2 dcl 2-17 ref 92 chars_len 2 based fixed bin(21,0) level 2 dcl 2-17 ref 92 code parameter fixed bin(35,0) dcl 24 set ref 21 83* 89* 102* 180* 183* 184 185* 187 192* 193 command_query_ 000010 constant entry external dcl 57 ref 131 159 163 169 175 cp_escape_control 1(02) 010156 automatic bit(2) initial level 3 in structure "qi" packed unaligned dcl 202 in procedure "eor_cv5_6_" set ref 202* cp_escape_control 1(02) 010140 automatic bit(2) initial level 3 in structure "query_info" packed unaligned dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* d based structure level 1 dcl 36 set ref 188 d_size 010122 automatic fixed bin(18,0) dcl 27 set ref 180* 185* 188 default 010127 automatic structure level 1 unaligned dcl 36 ref 188 default_header based structure level 1 dcl 36 set ref 102 102 dft_name 010112 automatic varying char(28) dcl 27 set ref 92* 94* 94 95* 95 95 96 96* 98 98* empty builtin function dcl 54 ref 27 exclude_sw 3 010176 automatic bit(1) initial array level 3 packed unaligned dcl 206 set ref 206* explanation_len 14 010140 automatic fixed bin(21,0) initial level 2 in structure "query_info" dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* explanation_len 14 010156 automatic fixed bin(21,0) initial level 2 in structure "qi" dcl 202 in procedure "eor_cv5_6_" set ref 130* 158* 202* explanation_ptr 12 010156 automatic pointer initial level 2 in structure "qi" dcl 202 in procedure "eor_cv5_6_" set ref 129* 157* 202* explanation_ptr 12 010140 automatic pointer initial level 2 in structure "query_info" dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* header 010127 automatic structure level 2 in structure "default" unaligned dcl 36 in procedure "eor_cv5_6_" header based structure level 2 in structure "d" dcl 36 in procedure "eor_cv5_6_" i 010123 automatic fixed bin(17,0) dcl 27 set ref 91* 92 92* index builtin function dcl 54 ref 96 168 ioa_$ioa_switch 000012 constant entry external dcl 57 ref 149 iox_$user_io 000024 external static pointer dcl 66 set ref 149* length builtin function dcl 54 ref 95 130 158 161 max_name_length 2 010176 automatic fixed bin(17,0) initial level 2 dcl 206 set ref 206* mi 010176 automatic structure level 1 dcl 206 set ref 89 89 name parameter varying char dcl 116 in procedure "eliminate" set ref 112 131* 131* 131* 159* 180 183 192 name 4 010176 automatic varying char(30) array level 3 in structure "mi" dcl 206 in procedure "eor_cv5_6_" set ref 88* name 1 based char(24) level 3 in structure "d" packed unaligned dcl 36 in procedure "eor_cv5_6_" set ref 182* name_array 3 010176 automatic structure array level 2 dcl 206 name_count 1 010176 automatic fixed bin(17,0) initial level 2 dcl 206 set ref 206* name_index 4 based fixed bin(21,0) array level 3 dcl 2-17 ref 92 name_len 5 based fixed bin(21,0) array level 3 dcl 2-17 ref 92 new_name_explanation 000077 constant char(58) initial unaligned dcl 66 set ref 157 158 null builtin function dcl 54 ref 102 102 102 102 1-6 1-6 1-6 125 126 185 185 185 185 202 202 202 pad 3(02) 010176 automatic bit(34) initial array level 3 packed unaligned dcl 206 set ref 206* padding 1(05) 010140 automatic bit(31) initial level 3 in structure "query_iKing "v r "v r King NMLPROD QjIRprocedure "eor_cv5_6_" set ref 122* 202* suppress_name_sw 1(01) 010140 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* suppress_spacing 1(04) 010156 automatic bit(1) initial level 3 in structure "qi" packed unaligned dcl 202 in procedure "eor_cv5_6_" set ref 202* suppress_spacing 1(04) 010140 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* switches 1 010156 automatic structure level 2 in structure "qi" dcl 202 in procedure "eor_cv5_6_" set ref 120* switches 1 010140 automatic structure level 2 in structure "query_info" dcl 1-6 in procedure "eor_cv5_6_" translate builtin function dcl 54 ref 143 unseen 010124 automatic bit(1) array dcl 27 set ref 85* 131* 154* unseen_overall_reason 010126 automatic bit(1) unaligned dcl 27 set ref 84* 122 131* 131* 153* value_$delete_data 000014 constant entry external dcl 57 ref 183 192 value_$get_data 000016 constant entry external dcl 57 ref 180 value_$list_data_names 000020 constant entry external dcl 57 ref 89 value_$set_data 000022 constant entry external dcl 57 ref 102 185 value_list_info based structure level 1 dcl 2-17 value_list_info_ptr 010174 automatic pointer dcl 2-3 set ref 89* 91 92 92 92 version based fixed bin(17,0) level 2 in structure "default_header" dcl 36 in procedure "eor_cv5_6_" set ref 101* version 010176 automatic fixed bin(17,0) initial level 2 in structure "mi" dcl 206 in procedure "eor_cv5_6_" set ref 206* version 010156 automatic fixed bin(17,0) level 2 in structure "qi" dcl 202 in procedure "eor_cv5_6_" set ref 119* yes_or_no_sw 1 010156 automatic bit(1) initial level 3 in structure "qi" packed unaligned dcl 202 in procedure "eor_cv5_6_" set ref 121* 202* yes_or_no_sw 1 010140 automatic bit(1) initial level 3 in structure "query_info" packed unaligned dcl 1-6 in procedure "eor_cv5_6_" set ref 1-6* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. alloc_chars_len automatic fixed bin(21,0) dcl 2-5 alloc_max_name_len automatic fixed bin(21,0) dcl 2-5 alloc_name_count automatic fixed bin(17,0) dcl 2-4 alloc_pair_count automatic fixed bin(17,0) dcl 2-4 match_info based structure level 1 dcl 2-7 match_info_ptr automatic pointer dcl 2-3 match_info_version_1 internal static fixed bin(17,0) initial dcl 2-27 query_info_version_3 internal static fixed bin(17,0) initial dcl 1-30 query_info_version_4 internal static fixed bin(17,0) initial dcl 1-31 value_list_info_version_1 internal static fixed bin(17,0) initial dcl 2-27 NAMES DECLARED BY EXPLICIT CONTEXT. ANSWER_CHECK 001410 constant label dcl 161 ref 166 172 178 ERROR_EXIT 001031 constant label dcl 104 ref 184 187 193 REASK_RENAME 001110 constant label dcl 131 ref 150 eliminate 001032 constant entry internal dcl 112 ref 96 98 eor_cv5_6_ 000427 constant entry external dcl 21 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2736 2764 2631 2746 Length 3174 2631 26 174 105 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME eor_cv5_6_ 4432 external procedure is an external procedure. eliminate internal procedure shares stack frame of external procedure eor_cv5_6_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME eor_cv5_6_ 000100 Pd eor_cv5_6_ 000102 answer eor_cv5_6_ 000112 area eor_cv5_6_ 010112 dft_name eor_cv5_6_ 010122 d_size eor_cv5_6_ 010123 i eor_cv5_6_ 010124 unseen eor_cv5_6_ 010126 unseen_overall_reason eor_cv5_6_ 010127 default eor_cv5_6_ 010140 query_info eor_cv5_6_ 010156 qi eor_cv5_6_ 010174 value_list_info_ptr eor_cv5_6_ 010176 mi eor_cv5_6_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry free_based empty THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. command_query_ ioa_$ioa_switch value_$delete_data value_$get_data value_$list_data_names value_$set_data THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$user_io LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000423 27 000434 1 6 000437 202 000463 206 000507 83 000536 84 000540 85 000542 88 000553 89 000560 91 000606 92 000616 94 000642 95 000665 96 000673 98 000721 100 000746 101 000750 102 000754 104 001031 112 001032 119 001050 120 001052 121 001064 122 001066 123 001075 124 001076 125 001077 126 001101 127 001102 129 001104 QComm Bdp Comm Office O؟) Oӏ6N ----------------------------------------------------------- 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