COMPILATION LISTING OF SEGMENT clear_partition Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/06/85 1245.2 mst Wed Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 clear_partition: 12 procedure () options (variable); 13 14 /* * Command to clear a disk partition. 15* * 16* * clear_partition Pvname Partition_name 17* * 18* * 10/21/80, W. Olin Sibert 19* * 1/31/85, Keith Loepere, for real error codes. 20* */ 21 22 dcl ap pointer; 23 dcl al fixed bin (21); 24 dcl arg char (al) based (ap); 25 dcl code fixed bin (35); 26 dcl (nargs, argno) fixed bin; 27 dcl af_sw bit (1) aligned; 28 29 dcl brief_sw bit (1) aligned; 30 dcl answer char (4) varying; 31 dcl pvname char (32); 32 dcl part_name char (4); 33 dcl pvid bit (36) aligned; 34 dcl pattern_value fixed bin (35); 35 dcl pattern_word bit (36) aligned; 36 dcl pattern_page (1024) bit (36) aligned; 37 dcl idx fixed bin fixed bin; 38 39 dcl com_err_ entry options (variable); 40 dcl command_query_ entry options (variable); 41 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 42 dcl cu_$arg_ptr entry (fixed bin, pointer, fixed bin (21), fixed bin (35)); 43 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 44 dcl dump_segment_ entry (pointer, pointer, fixed bin, fixed bin (35), fixed bin (18), bit (*)); 45 dcl hphcs_$read_partition entry (bit (36) aligned, char (*), fixed bin (35), pointer, fixed bin (18), fixed bin (35)); 46 dcl hphcs_$write_partition entry (bit (36) aligned, char (*), fixed bin (35), pointer, fixed bin (18), fixed bin (35)); 47 dcl ioa_ entry options (variable); 48 dcl mdc_$pvname_info entry (char (*), bit (36) aligned, char (*), bit (36) aligned, fixed bin, fixed bin (35)); 49 50 dcl (error_table_$badopt, 51 error_table_$noarg, 52 error_table_$too_many_args, 53 error_table_$bigarg, 54 error_table_$out_of_bounds, 55 error_table_$bad_conversion) fixed bin (35) external static; 56 57 dcl WHOAMI char (32) internal static options (constant) init ("clear_partition"); 58 59 dcl linkage_error condition; 60 61 dcl (addr, char, hbound, length, maxlength, null, size, string, substr) builtin; 62 63 /* */ 64 65 pvname = ""; 66 part_name = ""; 67 brief_sw = "0"b; 68 pattern_word = ""b; 69 70 call cu_$arg_count (nargs, code); 71 if code ^= 0 then do; 72 call com_err_ (code, WHOAMI); 73 RETURN: return; 74 end; 75 76 do argno = 1 to nargs; 77 call cu_$arg_ptr (argno, ap, al, (0)); 78 79 if (arg = "-pattern") then do; 80 if argno = nargs then do; 81 call com_err_ (error_table_$noarg, WHOAMI, "After ^a", arg); 82 goto RETURN; 83 end; 84 85 argno = argno + 1; 86 call cu_$arg_ptr (argno, ap, al, (0)); 87 pattern_value = cv_oct_check_ (arg, code); 88 if code ^= 0 then do; 89 call com_err_ (error_table_$bad_conversion, WHOAMI, 90 "Pattern must be an octal number, not ^a", arg); 91 goto RETURN; 92 end; 93 94 pattern_word = unspec (pattern_value); 95 end; 96 97 else if (arg = "-long") | (arg = "-lg") then 98 brief_sw = "0"b; 99 else if (arg = "-brief") | (arg = "-bf") then 100 brief_sw = "1"b; 101 102 else if char (arg, 1) = "-" then do; 103 call com_err_ (error_table_$badopt, WHOAMI, "^a", arg); 104 goto RETURN; 105 end; 106 107 else if pvname = "" then /* first arg is volume name */ 108 pvname = arg; 109 110 else if part_name = "" then do; /* second arg is partition name */ 111 if length (rtrim (arg)) > maxlength (part_name) then do; 112 call com_err_ (error_table_$bigarg, WHOAMI, 113 "Partition name must be ^d characters or less. ^a", 114 maxlength (part_name), arg); 115 goto RETURN; 116 end; 117 118 part_name = rtrim (arg); 119 end; 120 121 else do; 122 code = error_table_$too_many_args; 123 goto USAGE; 124 end; 125 end; /* of argument loop */ 126 127 if part_name = "" then do; 128 code = error_table_$noarg; 129 USAGE: call com_err_ (code, WHOAMI, 130 "^/Usage:^-^a pvname part_name {-control_args}", WHOAMI); 131 goto RETURN; 132 end; 133 134 /* */ 135 136 call mdc_$pvname_info (pvname, pvid, (""), (""b), (0), code); 137 if code ^= 0 then do; 138 call com_err_ (code, WHOAMI, "^a", pvname); 139 goto RETURN; 140 end; 141 142 on condition (linkage_error) begin; /* exit gracefully */ 143 call com_err_ (0, WHOAMI, 144 "This opertaion requires privileged access (hphcs_) not given to this process."); 145 goto RETURN; /* and punt */ 146 end; 147 148 call hphcs_$read_partition (pvid, part_name, 0, addr (pattern_page), size (pattern_page), code); 149 150 revert condition (linkage_error); 151 152 if code ^= 0 then do; 153 call com_err_ (code, WHOAMI, "Cannot read partition ^a on ^a.", part_name, pvname); 154 goto RETURN; 155 end; 156 157 query_info.yes_or_no_sw = "1"b; 158 if brief_sw then 159 call command_query_ (addr (query_info), answer, WHOAMI, 160 "Do you wish to overwrite partition ^a on ^a?", 161 part_name, pvname); 162 else call command_query_ (addr (query_info), answer, WHOAMI, 163 "Partition ^a on ^a begins with:^/^3x^4(^w^x^)^/^3x^4(^w^x^)^/Do you wish to overwrite it?", 164 part_name, pvname, pattern_page (1), pattern_page (2), pattern_page (3), pattern_page (4), 165 pattern_page (5), pattern_page (6), pattern_page (7), pattern_page (8)); 166 167 if (answer ^= "yes") then /* He chickened out */ 168 goto RETURN; 169 170 pattern_page (*) = pattern_word; /* fill it in */ 171 172 do idx = 0 by 1; /* and go to it */ 173 call hphcs_$write_partition (pvid, part_name, 174 (idx * 1024), addr (pattern_page), size (pattern_page), code); 175 if code = error_table_$out_of_bounds then /* All done */ 176 goto FINISHED; 177 178 else if code ^= 0 then do; 179 call com_err_ (code, WHOAMI, "Cannot write record ^d to partition ^a on ^a. Aborting", 180 (idx - 1), part_name, pvname); 181 goto RETURN; 182 end; 183 end; /* of loop writing records */ 184 185 FINISHED: if ^brief_sw then 186 call ioa_ ("^a: Cleared partition ^a on ^a (^d. records)^[, with pattern ^w^].", 187 WHOAMI, part_name, pvname, idx, (pattern_word ^= ""b), pattern_word); 188 189 goto RETURN; /* all done */ 190 191 /* 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 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 1 6 1 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 1 8 2 version fixed bin, /* version of this structure - must be set, see below */ 1 9 2 switches aligned, /* various bit switch values */ 1 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 1 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 1 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 1 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 1 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 1 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 1 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 1 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 1 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 1 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 1 20 1 21 /* Limit of data defined for version 2 */ 1 22 1 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 1 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 1 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 1 26 /* minimum of 30 seconds required for repeat */ 1 27 /* otherwise, no repeat will occur */ 1 28 /* Limit of data defined for version 4 */ 1 29 1 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 1 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 1 32 1 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 1 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 1 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 1 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 1 37 1 38 /* END INCLUDE FILE query_info.incl.pl1 */ 191 192 193 end clear_partition; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/06/85 1213.0 clear_partition.pl1 >special_ldd>online>41-10>clear_partition.pl1 191 1 03/11/83 1204.3 query_info.incl.pl1 >ldd>include>query_info.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. WHOAMI 000000 constant char(32) initial unaligned dcl 57 set ref 72* 81* 89* 103* 112* 129* 129* 138* 143* 153* 158* 162* 179* 185* addr builtin function dcl 61 ref 148 148 158 158 162 162 173 173 al 000102 automatic fixed bin(21,0) dcl 23 set ref 77* 79 81 81 86* 87 87 89 89 97 97 99 99 102 103 103 107 111 112 112 118 answer 000110 automatic varying char(4) dcl 30 set ref 158* 162* 167 answer_iocbp 6 002136 automatic pointer initial level 2 dcl 1-7 set ref 1-7* ap 000100 automatic pointer dcl 22 set ref 77* 79 81 86* 87 89 97 97 99 99 102 103 107 111 112 118 arg based char unaligned dcl 24 set ref 79 81* 87* 89* 97 97 99 99 102 103* 107 111 112* 118 argno 000105 automatic fixed bin(17,0) dcl 26 set ref 76* 77* 80 85* 85 86* brief_sw 000106 automatic bit(1) dcl 29 set ref 67* 97* 99* 158 185 char builtin function dcl 61 ref 102 code 000103 automatic fixed bin(35,0) dcl 25 set ref 70* 71 72* 87* 88 122* 128* 129* 136* 137 138* 148* 152 153* 173* 175 178 179* com_err_ 000010 constant entry external dcl 39 ref 72 81 89 103 112 129 138 143 153 179 command_query_ 000012 constant entry external dcl 40 ref 158 162 cp_escape_control 1(02) 002136 automatic bit(2) initial level 3 packed unaligned dcl 1-7 set ref 1-7* cu_$arg_count 000014 constant entry external dcl 41 ref 70 cu_$arg_ptr 000016 constant entry external dcl 42 ref 77 86 cv_oct_check_ 000020 constant entry external dcl 43 ref 87 error_table_$bad_conversion 000044 external static fixed bin(35,0) dcl 50 set ref 89* error_table_$badopt 000032 external static fixed bin(35,0) dcl 50 set ref 103* error_table_$bigarg 000040 external static fixed bin(35,0) dcl 50 set ref 112* error_table_$noarg 000034 external static fixed bin(35,0) dcl 50 set ref 81* 128 error_table_$out_of_bounds 000042 external static fixed bin(35,0) dcl 50 ref 175 error_table_$too_many_args 000036 external static fixed bin(35,0) dcl 50 ref 122 explanation_len 14 002136 automatic fixed bin(21,0) initial level 2 dcl 1-7 set ref 1-7* explanation_ptr 12 002136 automatic pointer initial level 2 dcl 1-7 set ref 1-7* hphcs_$read_partition 000022 constant entry external dcl 45 ref 148 hphcs_$write_partition 000024 constant entry external dcl 46 ref 173 idx 002126 automatic fixed bin(17,0) dcl 37 set ref 172* 173 179* 185* ioa_ 000026 constant entry external dcl 47 ref 185 length builtin function dcl 61 ref 111 linkage_error 002130 stack reference condition dcl 59 ref 142 150 literal_sw 1(05) 002136 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* maxlength builtin function dcl 61 ref 111 112 112 mdc_$pvname_info 000030 constant entry external dcl 48 ref 136 nargs 000104 automatic fixed bin(17,0) dcl 26 set ref 70* 76 80 null builtin function dcl 61 ref 1-7 1-7 1-7 padding 1(07) 002136 automatic bit(29) initial level 3 packed unaligned dcl 1-7 set ref 1-7* part_name 000122 automatic char(4) unaligned dcl 32 set ref 66* 110 111 112 112 118* 127 148* 153* 158* 162* 173* 179* 185* pattern_page 000126 automatic bit(36) array dcl 36 set ref 148 148 148 148 162* 162* 162* 162* 162* 162* 162* 162* 170* 173 173 173 173 pattern_value 000124 automatic fixed bin(35,0) dcl 34 set ref 87* 94 pattern_word 000125 automatic bit(36) dcl 35 set ref 68* 94* 170 185 185* prompt_after_explanation 1(06) 002136 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* pvid 000123 automatic bit(36) dcl 33 set ref 136* 148* 173* pvname 000112 automatic char(32) unaligned dcl 31 set ref 65* 107 107* 136* 138* 153* 158* 162* 179* 185* query_code 3 002136 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* query_info 002136 automatic structure level 1 dcl 1-7 set ref 158 158 162 162 question_iocbp 4 002136 automatic pointer initial level 2 dcl 1-7 set ref 1-7* repeat_time 10 002136 automatic fixed bin(71,0) initial level 2 dcl 1-7 set ref 1-7* size builtin function dcl 61 ref 148 148 173 173 status_code 2 002136 automatic fixed bin(35,0) initial level 2 dcl 1-7 set ref 1-7* suppress_name_sw 1(01) 002136 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* suppress_spacing 1(04) 002136 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 1-7* switches 1 002136 automatic structure level 2 dcl 1-7 yes_or_no_sw 1 002136 automatic bit(1) initial level 3 packed unaligned dcl 1-7 set ref 157* 1-7* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. af_sw automatic bit(1) dcl 27 dump_segment_ 000000 constant entry external dcl 44 hbound builtin function dcl 61 query_info_version_3 internal static fixed bin(17,0) initial dcl 1-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 1-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 1-35 query_info_version_6 internal static fixed bin(17,0) initial dcl 1-36 string builtin function dcl 61 substr builtin function dcl 61 NAMES DECLARED BY EXPLICIT CONTEXT. FINISHED 001541 constant label dcl 185 ref 175 RETURN 000357 constant label dcl 73 ref 82 91 104 115 131 139 145 154 167 181 189 USAGE 000762 constant label dcl 129 ref 123 clear_partition 000264 constant entry external dcl 11 NAMES DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 111 118 unspec builtin function ref 94 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2022 2070 1620 2032 Length 2310 1620 46 203 201 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME clear_partition 1278 external procedure is an external procedure. on unit on line 142 100 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME clear_partition 000100 ap clear_partition 000102 al clear_partition 000103 code clear_partition 000104 nargs clear_partition 000105 argno clear_partition 000106 brief_sw clear_partition 000110 answer clear_partition 000112 pvname clear_partition 000122 part_name clear_partition 000123 pvid clear_partition 000124 pattern_value clear_partition 000125 pattern_word clear_partition 000126 pattern_page clear_partition 002126 idx clear_partition 002136 query_info clear_partition THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc call_ext_out return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ cu_$arg_count cu_$arg_ptr cv_oct_check_ hphcs_$read_partition hphcs_$write_partition ioa_ mdc_$pvname_info THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$badopt error_table_$bigarg error_table_$noarg error_table_$out_of_bounds error_table_$too_many_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000263 1 7 000271 65 000321 66 000324 67 000326 68 000327 70 000330 71 000340 72 000342 73 000357 76 000360 77 000367 79 000405 80 000413 81 000416 82 000450 85 000451 86 000452 87 000470 88 000513 89 000515 91 000550 94 000551 95 000553 97 000554 99 000566 102 000601 103 000610 104 000642 107 000643 110 000654 111 000661 112 000676 115 000737 118 000740 119 000743 122 000744 123 000747 125 000750 127 000752 128 000757 129 000762 131 001010 136 001011 137 001050 138 001052 139 001100 142 001101 143 001115 145 001141 148 001144 150 001205 152 001206 153 001210 154 001243 157 001244 158 001246 162 001312 167 001405 170 001412 172 001423 173 001424 175 001467 178 001473 179 001475 181 001536 183 001537 185 001541 189 001611 ----------------------------------------------------------- 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