COMPILATION LISTING OF SEGMENT convert_old_basic_file_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/18/82 1703.5 mst Thu 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 /* This procedure converts old format basic random foramt files to new format 12* files which are maintained by vfile_. Access and quota on the old file 13* must be adequate. */ 14 15 /* coded 76.1.19 by M. Weaver */ 16 17 convert_old_basic_file_: proc (dir, ent, code); 18 19 dcl (dir, ent) char (*); 20 dcl code fixed bin (35); 21 22 dcl (i, k, dlng, margin) fixed bin; 23 dcl type fixed bin (2); 24 dcl bitcnt fixed bin (24); 25 dcl (old_ptr, new_ptr, iocb_ptr, arrayp, fcb_pt) ptr; 26 dcl new_path char (168) var; 27 dcl dirname char (168); 28 dcl entname char (32); 29 30 dcl fixed_dec_value fixed dec (7); 31 dcl fixed_digits char (8) aligned based (addr (fixed_dec_value)); 32 33 dcl unique_count fixed dec (6) static init (0); 34 dcl 1 unique_value static, 35 2 header char (11) init ("convert_bf."), 36 2 count picture "999999"; 37 38 dcl based_array (1) ptr based (arrayp); 39 40 dcl 1 random_numeric aligned based, 41 2 header bit (36), 42 2 count fixed bin (18), 43 2 value (i) float bin; 44 45 dcl 1 d_random_numeric aligned based, 46 2 header bit (36), 47 2 count fixed bin (18), 48 2 value (i) float bin (63); 49 50 dcl 1 random_string aligned based, 51 2 header unaligned, 52 3 flag bit (18), 53 3 max_length fixed bin (12), 54 2 count fixed bin, 55 2 value (i), 56 3 vlng fixed bin, 57 3 vstring char (margin); 58 59 dcl (stream_input_output init(3), 60 sequential_update init(7)) fixed bin static options(constant); 61 62 dcl error_table_$not_done ext fixed bin (35); 63 64 dcl (addr, convert, index, min, null, string, substr, verify) builtin; 65 dcl cleanup condition; 66 67 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); 68 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 69 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 70 dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 71 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 72 dcl iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)); 73 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); 74 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 75 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 76 dcl iox_$close entry (ptr, fixed bin (35)); 77 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 78 dcl iox_$destroy_iocb entry (ptr, fixed bin (35)); 79 dcl hcs_$fs_move_seg entry (ptr, ptr, fixed bin (1), fixed bin (35)); 80 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); 81 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 82 83 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* format: style2 */ 1 3 1 4 dcl 1 iocb aligned based, /* I/O control block. */ 1 5 2 version character (4) aligned, 1 6 2 name char (32), /* I/O name of this block. */ 1 7 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 8 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 9 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 10 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 11 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 12 2 reserved bit (72), /* Reserved for future use. */ 1 13 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 14 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 15 /* open(p,mode,not_used,s) */ 1 16 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 17 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 18 /* get_line(p,bufptr,buflen,actlen,s) */ 1 19 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 21 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 22 /* put_chars(p,bufptr,buflen,s) */ 1 23 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 24 /* modes(p,newmode,oldmode,s) */ 1 25 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 26 /* position(p,u1,u2,s) */ 1 27 2 control entry (ptr, char (*), ptr, fixed (35)), 1 28 /* control(p,order,infptr,s) */ 1 29 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 30 /* read_record(p,bufptr,buflen,actlen,s) */ 1 31 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 32 /* write_record(p,bufptr,buflen,s) */ 1 33 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* rewrite_record(p,bufptr,buflen,s) */ 1 35 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 36 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 37 /* seek_key(p,key,len,s) */ 1 38 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* read_key(p,key,len,s) */ 1 40 2 read_length entry (ptr, fixed (21), fixed (35)); 1 41 /* read_length(p,len,s) */ 1 42 1 43 declare iox_$iocb_version_sentinel 1 44 character (4) aligned external static; 1 45 1 46 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 84 85 86 87 /* must always initiate original file so we can look at it */ 88 89 call hcs_$initiate (dir, ent, "", 0, 0, old_ptr, code); 90 if old_ptr = null then return; 91 92 if old_ptr -> random_string.header.flag ^= (18)"1"b then do; /* terminal format file */ 93 call hcs_$terminate_noname (old_ptr, code); 94 code = error_table_$not_done; /* special code to indicate no conversion necessary */ 95 return; 96 end; 97 98 iocb_ptr, new_ptr = null; 99 on cleanup call clean_up; 100 101 arrayp = addr (new_ptr); 102 code = 0; /* temporary kludge for get_temp_segments_ */ 103 call get_temp_segments_ ("convert_old_basic_file_", based_array, code); 104 if code ^= 0 then goto finish; 105 106 call hcs_$fs_get_path_name (new_ptr, dirname, dlng, entname, code); 107 if code ^= 0 then goto finish; 108 k = index (entname, " "); 109 if k = 0 then k = 33; 110 new_path = substr (dirname, 1, dlng) || ">" || substr (entname, 1, k-1); 111 112 /* get switchname; use unique ionames so program will be reentrant */ 113 114 unique_count = unique_count + 1; 115 unique_value.count = unique_count; 116 i = 1; 117 118 if old_ptr -> random_numeric.header = (36)"1"b then do; 119 call iox_$attach_ioname (string (unique_value), iocb_ptr, "vfile_ " 120 || new_path || " -no_trunc -header 1 -ssf", code); 121 if code ^= 0 then goto finish; 122 123 call iox_$open (iocb_ptr, stream_input_output, "0"b, code); 124 if code ^= 0 then goto finish; 125 126 call iox_$put_chars (iocb_ptr, addr (old_ptr -> random_numeric.value (1)), 127 4 * old_ptr -> random_numeric.count, code); 128 if code ^= 0 then goto finish; 129 end; 130 131 else if old_ptr -> d_random_numeric.header = "111111111111111111010101010101010101"b then do; 132 133 call iox_$attach_ioname (string (unique_value), iocb_ptr, "vfile_ " || 134 new_path || " -no_trunc -header 2 -ssf", code); 135 if code ^= 0 then goto finish; 136 137 call iox_$open (iocb_ptr, stream_input_output, "0"b, code); 138 if code ^= 0 then goto finish; 139 140 call iox_$put_chars (iocb_ptr, addr (old_ptr -> random_numeric.value (1)), 141 8 * old_ptr -> d_random_numeric.count, code); 142 if code ^= 0 then goto finish; 143 end; 144 145 else do; /* must be random string file */ 146 147 margin = old_ptr -> random_string.header.max_length; 148 fixed_dec_value = convert (fixed_dec_value, margin); 149 k = verify (substr (fixed_digits, 2), "0"); 150 151 call iox_$attach_ioname (string (unique_value), iocb_ptr, "vfile_ " || 152 new_path || " -blocked " || substr (fixed_digits, k+1) || " -ssf", code); 153 if code ^= 0 then goto finish; 154 155 call iox_$open (iocb_ptr, sequential_update, "0"b, code); 156 if code ^= 0 then goto finish; 157 158 do i = 1 to old_ptr -> random_string.count; 159 call iox_$write_record (iocb_ptr, addr (old_ptr -> random_string.value (i).vstring), 160 min (old_ptr -> random_string.value (i).vlng, margin), code); 161 if code ^= 0 then goto finish; 162 end; 163 end; 164 165 166 finish: call clean_up; 167 return; 168 169 170 171 clean_up: proc; 172 173 dcl ecode fixed bin (35); /* don't want to disturb returned code */ 174 175 ecode = -1; 176 if iocb_ptr ^= null then do; /* clean up iox stuff */ 177 if iocb_ptr -> iocb.open_descrip_ptr ^= null 178 then call iox_$close (iocb_ptr, ecode); 179 180 if ecode <= 0 181 then if iocb_ptr -> iocb.attach_descrip_ptr ^= null 182 then call iox_$detach_iocb (iocb_ptr, ecode); 183 184 if ecode = 0 then call iox_$destroy_iocb (iocb_ptr, ecode); 185 186 if code = 0 then do; /* assume file was converted */ 187 call hcs_$fs_move_seg (new_ptr, old_ptr, 1, code); /* replace file */ 188 if code = 0 then do; 189 call hcs_$status_mins (new_ptr, type, bitcnt, ecode); /* important to get bit count */ 190 call hcs_$set_bc_seg (old_ptr, bitcnt, ecode); /* tells vfile_ how much info */ 191 end; 192 end; 193 194 end; 195 196 call hcs_$terminate_noname (old_ptr, ecode); 197 198 if new_ptr ^= null then do; 199 call hcs_$set_bc_seg (new_ptr, 0, ecode); 200 call release_temp_segments_ ("convert_old_basic_file_", based_array, ecode); 201 end; 202 203 return; 204 end; 205 206 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/18/82 1630.2 convert_old_basic_file_.pl1 >dumps>old>recomp>convert_old_basic_file_.pl1 84 1 07/28/81 1333.4 iocb.incl.pl1 >ldd>include>iocb.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. addr builtin function dcl 64 ref 101 126 126 140 140 149 151 159 159 arrayp 000114 automatic pointer dcl 25 set ref 101* 103 200 attach_descrip_ptr 14 based pointer level 2 dcl 1-4 ref 180 based_array based pointer array dcl 38 set ref 103* 200* bitcnt 000105 automatic fixed bin(24,0) dcl 24 set ref 189* 190* cleanup 000256 stack reference condition dcl 65 ref 99 code parameter fixed bin(35,0) dcl 20 set ref 17 89* 93* 94* 102* 103* 104 106* 107 119* 121 123* 124 126* 128 133* 135 137* 138 140* 142 151* 153 155* 156 159* 161 186 187* 188 convert builtin function dcl 64 ref 148 count 2(27) 000012 internal static picture(6) level 2 in structure "unique_value" packed unaligned dcl 34 in procedure "convert_old_basic_file_" set ref 115* count 1 based fixed bin(18,0) level 2 in structure "d_random_numeric" dcl 45 in procedure "convert_old_basic_file_" ref 140 count 1 based fixed bin(18,0) level 2 in structure "random_numeric" dcl 40 in procedure "convert_old_basic_file_" ref 126 count 1 based fixed bin(17,0) level 2 in structure "random_string" dcl 50 in procedure "convert_old_basic_file_" ref 158 d_random_numeric based structure level 1 dcl 45 dir parameter char unaligned dcl 19 set ref 17 89* dirname 000171 automatic char(168) unaligned dcl 27 set ref 106* 110 dlng 000102 automatic fixed bin(17,0) dcl 22 set ref 106* 110 ecode 000100 automatic fixed bin(35,0) dcl 173 set ref 175* 177* 180 180* 184 184* 189* 190* 196* 199* 200* ent parameter char unaligned dcl 19 set ref 17 89* entname 000243 automatic char(32) unaligned dcl 28 set ref 106* 108 110 error_table_$not_done 000020 external static fixed bin(35,0) dcl 62 ref 94 fixed_dec_value 000254 automatic fixed dec(7,0) dcl 30 set ref 148* 148 149 151 fixed_digits based char(8) dcl 31 ref 149 151 flag based bit(18) level 3 packed unaligned dcl 50 ref 92 get_temp_segments_ 000026 constant entry external dcl 69 ref 103 hcs_$fs_get_path_name 000032 constant entry external dcl 71 ref 106 hcs_$fs_move_seg 000052 constant entry external dcl 79 ref 187 hcs_$initiate 000022 constant entry external dcl 67 ref 89 hcs_$set_bc_seg 000056 constant entry external dcl 81 ref 190 199 hcs_$status_mins 000054 constant entry external dcl 80 ref 189 hcs_$terminate_noname 000024 constant entry external dcl 68 ref 93 196 header based structure level 2 in structure "random_string" packed unaligned dcl 50 in procedure "convert_old_basic_file_" header based bit(36) level 2 in structure "random_numeric" dcl 40 in procedure "convert_old_basic_file_" ref 118 header based bit(36) level 2 in structure "d_random_numeric" dcl 45 in procedure "convert_old_basic_file_" ref 131 i 000100 automatic fixed bin(17,0) dcl 22 set ref 116* 158* 159 159 159 159* index builtin function dcl 64 ref 108 iocb based structure level 1 dcl 1-4 iocb_ptr 000112 automatic pointer dcl 25 set ref 98* 119* 123* 126* 133* 137* 140* 151* 155* 159* 176 177 177* 180 180* 184* iox_$attach_ioname 000034 constant entry external dcl 72 ref 119 133 151 iox_$close 000044 constant entry external dcl 76 ref 177 iox_$destroy_iocb 000050 constant entry external dcl 78 ref 184 iox_$detach_iocb 000046 constant entry external dcl 77 ref 180 iox_$open 000036 constant entry external dcl 73 ref 123 137 155 iox_$put_chars 000040 constant entry external dcl 74 ref 126 140 iox_$write_record 000042 constant entry external dcl 75 ref 159 k 000101 automatic fixed bin(17,0) dcl 22 set ref 108* 109 109* 110 149* 151 margin 000103 automatic fixed bin(17,0) dcl 22 set ref 147* 148 159 159 159 159 159 159 159 159 159 159 159 159 max_length 0(18) based fixed bin(12,0) level 3 packed unaligned dcl 50 ref 147 min builtin function dcl 64 ref 159 159 new_path 000116 automatic varying char(168) dcl 26 set ref 110* 119 133 151 new_ptr 000110 automatic pointer dcl 25 set ref 98* 101 106* 187* 189* 198 199* null builtin function dcl 64 ref 90 98 176 177 180 198 old_ptr 000106 automatic pointer dcl 25 set ref 89* 90 92 93* 118 126 126 126 131 140 140 140 147 158 159 159 159 159 187* 190* 196* open_descrip_ptr 20 based pointer level 2 dcl 1-4 ref 177 random_numeric based structure level 1 dcl 40 random_string based structure level 1 dcl 50 release_temp_segments_ 000030 constant entry external dcl 70 ref 200 sequential_update 000000 constant fixed bin(17,0) initial dcl 59 set ref 155* stream_input_output 000010 constant fixed bin(17,0) initial dcl 59 set ref 123* 137* string builtin function dcl 64 ref 119 119 133 133 151 151 substr builtin function dcl 64 ref 110 110 149 151 type 000104 automatic fixed bin(2,0) dcl 23 set ref 189* unique_count 000010 internal static fixed dec(6,0) initial dcl 33 set ref 114* 114 115 unique_value 000012 internal static structure level 1 packed unaligned dcl 34 set ref 119 119 133 133 151 151 value 2 based structure array level 2 in structure "random_string" dcl 50 in procedure "convert_old_basic_file_" value 2 based float bin(27) array level 2 in structure "random_numeric" dcl 40 in procedure "convert_old_basic_file_" set ref 126 126 140 140 verify builtin function dcl 64 ref 149 vlng 2 based fixed bin(17,0) array level 3 dcl 50 ref 159 159 vstring 3 based char array level 3 dcl 50 set ref 159 159 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fcb_pt automatic pointer dcl 25 iox_$iocb_version_sentinel external static char(4) dcl 1-43 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 001126 constant entry internal dcl 171 ref 99 166 convert_old_basic_file_ 000063 constant entry external dcl 17 finish 001120 constant label dcl 166 ref 104 107 121 124 128 135 138 142 153 156 161 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1610 1670 1362 1620 Length 2116 1362 60 211 225 10 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME convert_old_basic_file_ 235 external procedure is an external procedure. on unit on line 99 64 on unit clean_up 96 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 unique_count convert_old_basic_file_ 000012 unique_value convert_old_basic_file_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME clean_up 000100 ecode clean_up convert_old_basic_file_ 000100 i convert_old_basic_file_ 000101 k convert_old_basic_file_ 000102 dlng convert_old_basic_file_ 000103 margin convert_old_basic_file_ 000104 type convert_old_basic_file_ 000105 bitcnt convert_old_basic_file_ 000106 old_ptr convert_old_basic_file_ 000110 new_ptr convert_old_basic_file_ 000112 iocb_ptr convert_old_basic_file_ 000114 arrayp convert_old_basic_file_ 000116 new_path convert_old_basic_file_ 000171 dirname convert_old_basic_file_ 000243 entname convert_old_basic_file_ 000254 fixed_dec_value convert_old_basic_file_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_temp_segments_ hcs_$fs_get_path_name hcs_$fs_move_seg hcs_$initiate hcs_$set_bc_seg hcs_$status_mins hcs_$terminate_noname iox_$attach_ioname iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$open iox_$put_chars iox_$write_record release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_done LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 17 000057 89 000103 90 000145 92 000151 93 000155 94 000167 95 000173 98 000174 99 000177 101 000221 102 000223 103 000225 104 000251 106 000254 107 000305 108 000310 109 000321 110 000324 114 000361 115 000366 116 000372 118 000374 119 000377 121 000456 123 000462 124 000501 126 000504 128 000527 129 000532 131 000533 133 000536 135 000615 137 000621 138 000640 140 000643 142 000666 143 000671 147 000672 148 000676 149 000701 151 000713 153 001017 155 001023 156 001042 158 001045 159 001055 161 001113 162 001116 166 001120 167 001124 171 001125 175 001133 176 001135 177 001142 180 001157 184 001200 186 001214 187 001220 188 001237 189 001243 190 001260 196 001274 198 001306 199 001313 200 001327 203 001354 ----------------------------------------------------------- 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