COMPILATION LISTING OF SEGMENT convert_numeric_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 1631.4 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 convert_numeric_file: cnf: proc; 7 8 /* This command converts a single precision random numeric file (basic or fortran) 9* to a double precision random numeric file or vice versa. 10* Usage: convert_numeric_file old_path new_path -control arg- 11* 1) old_path is the pathname of the file to be converted 12* 2) new_path is the pathname of the target file; 13* . if it is not of 0 length, it is automatically truncated 14* 3) control arg may be either 15* . -double_precision,-dp convert from single to double precision; default 16* . -single_precision,-sp convert from double to single precision 17**/ 18 /* coded 76.02.17 by M. Weaver */ 19 20 dcl arg char (alng) based (aptr); 21 dcl header_numbers (2) char (1) init ("1", "2"); 22 dcl me char (20) aligned static init ("convert_numeric_file") options (constant); 23 dcl path (2) char (168); 24 25 dcl (alng, i, j, name_num, prec (2)) fixed bin; 26 dcl (num_size (2), n_read) fixed bin (21); 27 dcl (onum, tnum) float bin (63); 28 dcl based_single float bin (27) based (bs_ptr); 29 dcl code fixed bin (35); 30 dcl (error_table_$badopt, error_table_$end_of_info, error_table_$incompatible_attach) fixed bin (35) ext; 31 dcl sp_to_dp bit (1) aligned; 32 33 dcl cleanup condition; 34 35 dcl (aptr, iocb_ptr (2), onum_ptr, tnum_ptr, bs_ptr) ptr; 36 37 dcl (addr, null, round, substr) builtin; 38 39 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin) returns (fixed bin (35)); 40 dcl (com_err_, ioa_) entry options (variable); 41 dcl iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)); 42 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); 43 dcl iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 44 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 45 dcl iox_$close entry (ptr, fixed bin (35)); 46 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 47 dcl iox_$destroy_iocb entry (ptr, fixed bin (35)); 48 dcl unique_chars_ entry (bit (*)) returns (char (15)); 49 50 1 1 /* Begin include file ..... iox_modes.incl.pl1 */ 1 2 1 3 /* Written by C. D. Tavares, 03/17/75 */ 1 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 1 5 1 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 1 7 ("stream_input", "stream_output", "stream_input_output", 1 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 1 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 1 10 "direct_input", "direct_output", "direct_update"); 1 11 1 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 1 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 1 14 1 15 dcl (Stream_input initial (1), 1 16 Stream_output initial (2), 1 17 Stream_input_output initial (3), 1 18 Sequential_input initial (4), 1 19 Sequential_output initial (5), 1 20 Sequential_input_output initial (6), 1 21 Sequential_update initial (7), 1 22 Keyed_sequential_input initial (8), 1 23 Keyed_sequential_output initial (9), 1 24 Keyed_sequential_update initial (10), 1 25 Direct_input initial (11), 1 26 Direct_output initial (12), 1 27 Direct_update initial (13)) fixed bin int static options (constant); 1 28 1 29 /* End include file ..... iox_modes.incl.pl1 */ 51 52 2 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 2 2 /* format: style2 */ 2 3 2 4 dcl 1 iocb aligned based, /* I/O control block. */ 2 5 2 version character (4) aligned, 2 6 2 name char (32), /* I/O name of this block. */ 2 7 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 2 8 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 2 9 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 2 10 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 2 11 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 2 12 2 reserved bit (72), /* Reserved for future use. */ 2 13 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 2 14 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 2 15 /* open(p,mode,not_used,s) */ 2 16 2 close entry (ptr, fixed (35)),/* close(p,s) */ 2 17 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 18 /* get_line(p,bufptr,buflen,actlen,s) */ 2 19 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 20 /* get_chars(p,bufptr,buflen,actlen,s) */ 2 21 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 2 22 /* put_chars(p,bufptr,buflen,s) */ 2 23 2 modes entry (ptr, char (*), char (*), fixed (35)), 2 24 /* modes(p,newmode,oldmode,s) */ 2 25 2 position entry (ptr, fixed, fixed (21), fixed (35)), 2 26 /* position(p,u1,u2,s) */ 2 27 2 control entry (ptr, char (*), ptr, fixed (35)), 2 28 /* control(p,order,infptr,s) */ 2 29 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 2 30 /* read_record(p,bufptr,buflen,actlen,s) */ 2 31 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 2 32 /* write_record(p,bufptr,buflen,s) */ 2 33 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 2 34 /* rewrite_record(p,bufptr,buflen,s) */ 2 35 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 2 36 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 2 37 /* seek_key(p,key,len,s) */ 2 38 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 2 39 /* read_key(p,key,len,s) */ 2 40 2 read_length entry (ptr, fixed (21), fixed (35)); 2 41 /* read_length(p,len,s) */ 2 42 2 43 declare iox_$iocb_version_sentinel 2 44 character (4) aligned external static; 2 45 2 46 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 53 54 55 sp_to_dp = "1"b; /* initialize default */ 56 name_num = 0; 57 i = 1; 58 59 do while (cu_$arg_ptr (i, aptr, alng) = 0); 60 if substr (arg, 1, 1) = "-" then do; /* have control arg */ 61 if arg = "dp" | arg = "-double_precision" then sp_to_dp = "1"b; 62 else if arg = "-sp" | arg = "-single_precision" then sp_to_dp = "0"b; 63 else do; 64 call com_err_ (error_table_$badopt, me, arg); 65 return; 66 end; 67 end; 68 69 else do; /* must be pathname */ 70 name_num = name_num + 1; 71 if name_num > 2 then goto name_error; 72 path (name_num) = arg; 73 end; 74 i = i + 1; 75 end; 76 77 if name_num ^= 2 then do; 78 name_error: 79 call com_err_ (0, me, "Exactly two pathnames must be given."); 80 return; 81 end; 82 83 iocb_ptr (1), iocb_ptr (2) = null; 84 85 on cleanup call clean_up; 86 if sp_to_dp then do; 87 prec (1) = 1; 88 prec (2) = 2; 89 bs_ptr = addr (onum); 90 end; 91 else do; 92 prec (1) = 2; 93 prec (2) = 1; 94 bs_ptr = addr (tnum); 95 end; 96 97 /* open input file */ 98 99 j = 1; 100 call iox_$attach_ioname ((unique_chars_ ("0"b)), iocb_ptr (1), "vfile_ " || path (1) 101 || " -ssf -no_trunc -header " || header_numbers (prec (1)), code); 102 if code ^= 0 then goto finish; 103 104 call iox_$open (iocb_ptr (1), Stream_input, "0"b, code); 105 if code ^= 0 then goto finish; 106 107 /* open output file */ 108 109 j = 2; 110 call iox_$attach_ioname ((unique_chars_ ("0"b)), iocb_ptr (2), "vfile_ " || path (2) 111 || " -ssf -header " || header_numbers (prec (2)), code); 112 if code ^= 0 then goto finish; 113 114 call iox_$open (iocb_ptr (2), Stream_output, "0"b, code); 115 if code ^= 0 then goto finish; 116 117 onum_ptr = addr (onum); 118 tnum_ptr = addr (tnum); 119 do i = 1 to 2; 120 num_size (i) = prec (i) * 4; /* get byte count for input, output */ 121 end; 122 123 /* copy numbers one at a time; double precision variables are used for the actual I/O 124* but the appropriate one is referenced as single precision */ 125 126 do while ("1"b); /* loop is terminated by end of info */ 127 call iox_$get_chars (iocb_ptr (1), onum_ptr, num_size (1), n_read, code); 128 if code ^= 0 then do; 129 if code = error_table_$end_of_info then code = 0; /* normal termination */ 130 j = 1; /* print first pathname */ 131 goto finish; 132 end; 133 if sp_to_dp then tnum = based_single; 134 else based_single = round (onum, 27); 135 call iox_$put_chars (iocb_ptr (2), tnum_ptr, num_size (2), code); 136 if code ^= 0 then goto finish; 137 end; 138 139 finish: call clean_up; 140 if code ^= 0 then do; 141 if (j = 1) & (code = error_table_$incompatible_attach) 142 then call com_err_ (0, me, "File ^a does not need converting.", path (j)); 143 else call com_err_ (code, me, path (j)); 144 end; 145 return; 146 147 148 clean_up: proc; 149 150 dcl ecode fixed bin (35); 151 152 do i = 1 to 2; /* close, etc. all files */ 153 if iocb_ptr (i) ^= null then do; 154 ecode = -1; 155 if iocb_ptr (i) -> iocb.open_descrip_ptr ^= null 156 then call iox_$close (iocb_ptr (i), ecode); 157 if ecode <= 0 158 then if iocb_ptr (i) -> iocb.attach_descrip_ptr ^= null 159 then call iox_$detach_iocb (iocb_ptr (i), ecode); 160 if ecode = 0 then call iox_$destroy_iocb (iocb_ptr (i), ecode); 161 end; 162 end; 163 164 return; 165 end; 166 167 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/18/82 1627.6 convert_numeric_file.pl1 >dumps>old>recomp>convert_numeric_file.pl1 51 1 02/02/78 1229.7 iox_modes.incl.pl1 >ldd>include>iox_modes.incl.pl1 53 2 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. Stream_input 000024 constant fixed bin(17,0) initial dcl 1-15 set ref 104* Stream_output 000023 constant fixed bin(17,0) initial dcl 1-15 set ref 114* addr builtin function dcl 37 ref 89 94 117 118 alng 000225 automatic fixed bin(17,0) dcl 25 set ref 59* 60 61 61 62 62 64 64 72 aptr 000254 automatic pointer dcl 35 set ref 59* 60 61 61 62 62 64 72 arg based char unaligned dcl 20 set ref 60 61 61 62 62 64* 72 attach_descrip_ptr 14 based pointer level 2 dcl 2-4 ref 157 based_single based float bin(27) dcl 28 set ref 133 134* bs_ptr 000266 automatic pointer dcl 35 set ref 89* 94* 133 134 cleanup 000246 stack reference condition dcl 33 ref 85 code 000244 automatic fixed bin(35,0) dcl 29 set ref 100* 102 104* 105 110* 112 114* 115 127* 128 129 129* 135* 136 140 141 143* com_err_ 000020 constant entry external dcl 40 ref 64 78 141 143 cu_$arg_ptr 000016 constant entry external dcl 39 ref 59 ecode 000100 automatic fixed bin(35,0) dcl 150 set ref 154* 155* 157 157* 160 160* error_table_$badopt 000010 external static fixed bin(35,0) dcl 30 set ref 64* error_table_$end_of_info 000012 external static fixed bin(35,0) dcl 30 ref 129 error_table_$incompatible_attach 000014 external static fixed bin(35,0) dcl 30 ref 141 header_numbers 000100 automatic char(1) initial array unaligned dcl 21 set ref 21* 21* 100 110 i 000226 automatic fixed bin(17,0) dcl 25 set ref 57* 59* 74* 74 119* 120 120* 152* 153 155 155 157 157 160* iocb based structure level 1 dcl 2-4 iocb_ptr 000256 automatic pointer array dcl 35 set ref 83* 83* 100* 104* 110* 114* 127* 135* 153 155 155* 157 157* 160* iox_$attach_ioname 000022 constant entry external dcl 41 ref 100 110 iox_$close 000032 constant entry external dcl 45 ref 155 iox_$destroy_iocb 000036 constant entry external dcl 47 ref 160 iox_$detach_iocb 000034 constant entry external dcl 46 ref 157 iox_$get_chars 000026 constant entry external dcl 43 ref 127 iox_$open 000024 constant entry external dcl 42 ref 104 114 iox_$put_chars 000030 constant entry external dcl 44 ref 135 j 000227 automatic fixed bin(17,0) dcl 25 set ref 99* 109* 130* 141 141 143 me 000000 constant char(20) initial dcl 22 set ref 64* 78* 141* 143* n_read 000236 automatic fixed bin(21,0) dcl 26 set ref 127* name_num 000230 automatic fixed bin(17,0) dcl 25 set ref 56* 70* 70 71 72 77 null builtin function dcl 37 ref 83 153 155 157 num_size 000234 automatic fixed bin(21,0) array dcl 26 set ref 120* 127* 135* onum 000240 automatic float bin(63) dcl 27 set ref 89 117 134 onum_ptr 000262 automatic pointer dcl 35 set ref 117* 127* open_descrip_ptr 20 based pointer level 2 dcl 2-4 ref 155 path 000101 automatic char(168) array unaligned dcl 23 set ref 72* 100 110 141* 143* prec 000232 automatic fixed bin(17,0) array dcl 25 set ref 87* 88* 92* 93* 100 110 120 round builtin function dcl 37 ref 134 sp_to_dp 000245 automatic bit(1) dcl 31 set ref 55* 61* 62* 86 133 substr builtin function dcl 37 ref 60 tnum 000242 automatic float bin(63) dcl 27 set ref 94 118 133* tnum_ptr 000264 automatic pointer dcl 35 set ref 118* 135* unique_chars_ 000040 constant entry external dcl 48 ref 100 110 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Direct_input internal static fixed bin(17,0) initial dcl 1-15 Direct_output internal static fixed bin(17,0) initial dcl 1-15 Direct_update internal static fixed bin(17,0) initial dcl 1-15 Keyed_sequential_input internal static fixed bin(17,0) initial dcl 1-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 1-15 Keyed_sequential_update internal static fixed bin(17,0) initial dcl 1-15 Sequential_input internal static fixed bin(17,0) initial dcl 1-15 Sequential_input_output internal static fixed bin(17,0) initial dcl 1-15 Sequential_output internal static fixed bin(17,0) initial dcl 1-15 Sequential_update internal static fixed bin(17,0) initial dcl 1-15 Stream_input_output internal static fixed bin(17,0) initial dcl 1-15 ioa_ 000000 constant entry external dcl 40 iox_$iocb_version_sentinel external static char(4) dcl 2-43 iox_modes internal static char(24) initial array dcl 1-6 short_iox_modes internal static char(4) initial array dcl 1-12 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 001006 constant entry internal dcl 148 ref 85 139 cnf 000121 constant entry external dcl 6 convert_numeric_file 000131 constant entry external dcl 6 finish 000711 constant label dcl 139 ref 102 105 112 115 131 136 name_error 000263 constant label dcl 78 ref 71 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1320 1362 1122 1330 Length 1610 1122 42 211 175 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cnf 282 external procedure is an external procedure. on unit on line 85 64 on unit clean_up 72 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME clean_up 000100 ecode clean_up cnf 000100 header_numbers cnf 000101 path cnf 000225 alng cnf 000226 i cnf 000227 j cnf 000230 name_num cnf 000232 prec cnf 000234 num_size cnf 000236 n_read cnf 000240 onum cnf 000242 tnum cnf 000244 code cnf 000245 sp_to_dp cnf 000254 aptr cnf 000256 iocb_ptr cnf 000262 onum_ptr cnf 000264 tnum_ptr cnf 000266 bs_ptr cnf 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 int_entry round_fl THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr iox_$attach_ioname iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$get_chars iox_$open iox_$put_chars unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$end_of_info error_table_$incompatible_attach LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000103 6 000120 55 000137 56 000141 57 000142 59 000144 60 000163 61 000170 62 000204 64 000216 65 000242 67 000243 70 000244 71 000245 72 000250 74 000256 75 000257 77 000260 78 000263 80 000310 83 000311 85 000314 86 000336 87 000340 88 000342 89 000344 90 000346 92 000347 93 000351 94 000353 99 000355 100 000357 102 000447 104 000452 105 000471 109 000473 110 000475 112 000565 114 000570 115 000607 117 000611 118 000613 119 000615 120 000622 121 000626 127 000630 128 000647 129 000651 130 000655 131 000657 133 000660 134 000665 135 000671 136 000706 137 000710 139 000711 140 000715 141 000717 143 000761 145 001004 148 001005 152 001013 153 001022 154 001030 155 001032 157 001051 160 001076 162 001114 164 001117 ----------------------------------------------------------- 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