COMPILATION LISTING OF SEGMENT linus_convert_num_to_str Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/16/83 1745.4 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 linus_convert_num_to_str: 19 proc (value_ptr, desc_ptr, char_150_var_string, code); 20 21 /* DESCRIPTION: 22* 23* The purpose of this program is to return a varying character string 24* representation of a numeric value with leading and trailing zeros 25* surpressed. If the input value is of type float or a fixed value with some 26* scale other than 0, then at least a .0 will be returned in all cases. 27* 28* 29* 30* PARAMETERS: 31* value_ptr a pointer to the value to be converted. 32* 33* desc_ptr a pointer to the descriptor of the value to be 34* . converted. 35* 36* char_150_var_string the character stringing to be returned. 37* 38* code a standard return code. 39* 40* 41* 42* HISTORY: 43* 44* 80-02-18 Rickie E. Brinegar: Initially written. 45* 46**/ 47 1 1 /* BEGIN mdbm_arg_list.incl.pl1 -- jaw 5/31/78 */ 1 2 /* the duplicate mrds_arg_list.incl.pl1 was eliminated by Jim Gray, Nov. 1979 */ 1 3 1 4 /* layout of argument list for IDS and DBM entries with options (variable) */ 1 5 1 6 dcl 1 arg_list based (al_ptr), 1 7 2 arg_count fixed bin (17) unal, /* 2 * no. of args. */ 1 8 2 code fixed bin (17) unal, /* 4 => normal, 8 => special */ 1 9 2 desc_count fixed bin (17) unal, /* 2 * no. of descriptors */ 1 10 2 pad fixed bin (17) unal, /* must be 0 */ 1 11 2 arg_des_ptr (num_ptrs) ptr; /* argument/descriptor pointer */ 1 12 1 13 dcl al_ptr ptr; 1 14 dcl num_ptrs fixed bin; 1 15 1 16 /* END mdbm_arg_list.incl.pl1 */ 1 17 48 49 50 dcl ( 51 desc_ptr, /* INPUT: pointer to the descriptor 52* of the value to be converted. */ 53 value_ptr 54 ) ptr; /* INPUT: pointer to the value to be converted. */ 55 56 dcl (append_len, i) fixed bin; 57 58 dcl char_150 char (150); 59 dcl char_150_var_string char (150) varying;/* OUTPUT: the converted value. */ 60 dcl char_150_var_desc bit (36) init ("101011000000000000000000000010010110"b); 61 62 dcl code fixed bin (35); /* OUTPUT: a standard return code. */ 63 64 dcl char_75_var_string char (75) varying; 65 dcl char_75_var_desc bit (36) init ("101011000000000000000000000001001011"b); 66 67 dcl edit_string char (10) init ("^[^d^;^f^]"); 68 dcl edit_string_desc bit (36) init ("101010100000000000000000000000001010"b); 69 70 dcl (COMPLEX, INTEGER, FIXED) bit (1); 71 72 dcl INTEGER_desc bit (36) init ("101001100000000000000000000000000001"b); 73 74 dcl char_150_len fixed bin; 75 dcl char_150_len_desc bit (36) init ("100000100000000000000000000000000001"b); 76 77 dcl 1 desc based (desc_ptr), 78 2 flag bit (1), 79 2 type bit (6), 80 2 packed bit (1), 81 2 num_dim bit (4), 82 2 scale bit (12), 83 2 precision bit (12); 84 85 dcl linus_error_$non_numeric_argument ext fixed bin (35); 86 87 dcl ioa_$general_rs 88 entry (ptr, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, 89 bit (1) aligned); 90 dcl mdbm_util_$number_data_class entry (ptr) returns (bit (1)); 91 dcl mdbm_util_$complex_data_class entry (ptr) returns (bit (1)); 92 dcl mdbm_util_$fixed_data_class entry (ptr) returns (bit (1)); 93 94 i = 0; /* Initialize. */ 95 append_len = 0; 96 code = 0; 97 COMPLEX = mdbm_util_$complex_data_class (desc_ptr); 98 FIXED = mdbm_util_$fixed_data_class (desc_ptr); 99 INTEGER = FIXED & fixed (desc.scale) = 0; 100 101 if ^mdbm_util_$number_data_class (desc_ptr) then do; /* Was I called with a proper data type? */ 102 code = linus_error_$non_numeric_argument; /* No. */ 103 go to EXIT; 104 end; 105 106 num_ptrs = 10; /* Set up the argument list. */ 107 allocate arg_list; 108 arg_list.arg_count = 10; 109 arg_list.desc_count = 10; 110 arg_list.pad = 0; 111 arg_list.code = 4; 112 arg_list.arg_des_ptr (1) = addr (edit_string); 113 arg_list.arg_des_ptr (2) = addr (char_150_var_string); 114 arg_list.arg_des_ptr (3) = addr (char_150_len); 115 arg_list.arg_des_ptr (4) = addr (INTEGER); 116 arg_list.arg_des_ptr (5) = value_ptr; 117 arg_list.arg_des_ptr (6) = addr (edit_string_desc); 118 arg_list.arg_des_ptr (7) = addr (char_150_var_desc); 119 arg_list.arg_des_ptr (8) = addr (char_150_len_desc); 120 arg_list.arg_des_ptr (9) = addr (INTEGER_desc); 121 arg_list.arg_des_ptr (10) = desc_ptr; 122 123 call ioa_$general_rs (al_ptr, 1, 4, char_150, char_150_len, "1"b, "0"b); 124 char_150_var_string = substr (char_150, 1, char_150_len); 125 126 if INTEGER then /* Do I need to insure proper scaling? */ 127 if COMPLEX then /* No, Do I need to get the imaginary 128* part of a complex number? */ 129 call get_imaginary; 130 else /* No. */ 131 go to EXIT; 132 133 if FIXED then do; /* Do I have a scale to worry about? */ 134 append_len = 135 fixed (desc.scale) 136 - (char_150_len - index (char_150_var_string, ".")); 137 /* Yes. */ 138 do i = 1 to append_len while (append_len > 0); 139 char_150_var_string = char_150_var_string || "0"; 140 end; 141 end; 142 143 if index (char_150_var_string, ".") = length (char_150_var_string) then 144 /* If the last char is a "." */ 145 char_150_var_string = 146 substr (char_150_var_string, 1, char_150_len) || "0"; 147 /* then add a "0" after it. */ 148 149 if COMPLEX then 150 call get_imaginary; 151 152 EXIT: 153 return; 154 155 get_imaginary: 156 proc; 157 158 arg_list.arg_des_ptr (5) = addrel (value_ptr, 1); /* Update the argument list. */ 159 160 call ioa_$general_rs (al_ptr, 1, 4, char_150, char_150_len, "1"b, "0"b); 161 /* Get the character string. */ 162 if substr (char_150, 1, 1) ^= "-" then 163 char_75_var_string = "+" || substr (char_150, 1, char_150_len); 164 else char_75_var_string = substr (char_150, 1, char_150_len); 165 char_150_var_string = char_150_var_string || char_75_var_string; 166 167 if INTEGER then do; 168 char_150_var_string = char_150_var_string || "i"; 169 go to EXIT; 170 end; 171 172 if FIXED then do; 173 append_len = 174 fixed (desc.scale) 175 - (char_150_len - index (char_150_var_string, ".")); 176 do i = 1 to append_len while (append_len > 0); 177 char_75_var_string = char_75_var_string || "0"; 178 char_150_var_string = char_150_var_string || "0"; 179 end; 180 end; 181 182 if index (char_75_var_string, ".") = length (char_75_var_string) then 183 char_150_var_string = char_150_var_string || "0"; 184 185 char_150_var_string = char_150_var_string || "i"; 186 187 end get_imaginary; 188 189 end linus_convert_num_to_str; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/16/83 1739.3 linus_convert_num_to_str.pl1 >spec>on>09/16/83-linus>linus_convert_num_to_str.pl1 48 1 03/27/82 0431.6 mdbm_arg_list.incl.pl1 >ldd>include>mdbm_arg_list.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. COMPLEX 000205 automatic bit(1) unaligned dcl 70 set ref 97* 126 149 FIXED 000207 automatic bit(1) unaligned dcl 70 set ref 98* 99 133 172 INTEGER 000206 automatic bit(1) unaligned dcl 70 set ref 99* 115 126 167 INTEGER_desc 000210 automatic bit(36) initial unaligned dcl 72 set ref 72* 120 al_ptr 000100 automatic pointer dcl 1-13 set ref 107* 108 109 110 111 112 113 114 115 116 117 118 119 120 121 123* 158 160* append_len 000103 automatic fixed bin(17,0) dcl 56 set ref 95* 134* 138 138 173* 176 176 arg_count based fixed bin(17,0) level 2 packed unaligned dcl 1-6 set ref 108* arg_des_ptr 2 based pointer array level 2 dcl 1-6 set ref 112* 113* 114* 115* 116* 117* 118* 119* 120* 121* 158* arg_list based structure level 1 unaligned dcl 1-6 set ref 107 char_150 000105 automatic char(150) unaligned dcl 58 set ref 123* 124 160* 162 162 164 char_150_len 000211 automatic fixed bin(17,0) dcl 74 set ref 114 123* 124 134 143 160* 162 164 173 char_150_len_desc 000212 automatic bit(36) initial unaligned dcl 75 set ref 75* 119 char_150_var_desc 000153 automatic bit(36) initial unaligned dcl 60 set ref 60* 118 char_150_var_string parameter varying char(150) dcl 59 set ref 18 113 124* 134 139* 139 143 143 143* 143 165* 165 168* 168 173 178* 178 182* 182 185* 185 char_75_var_desc 000200 automatic bit(36) initial unaligned dcl 65 set ref 65* char_75_var_string 000154 automatic varying char(75) dcl 64 set ref 162* 164* 165 177* 177 182 182 code parameter fixed bin(35,0) dcl 62 in procedure "linus_convert_num_to_str" set ref 18 96* 102* code 0(18) based fixed bin(17,0) level 2 in structure "arg_list" packed unaligned dcl 1-6 in procedure "linus_convert_num_to_str" set ref 111* desc based structure level 1 packed unaligned dcl 77 desc_count 1 based fixed bin(17,0) level 2 packed unaligned dcl 1-6 set ref 109* desc_ptr parameter pointer dcl 50 set ref 18 97* 98* 99 101* 121 134 173 edit_string 000201 automatic char(10) initial unaligned dcl 67 set ref 67* 112 edit_string_desc 000204 automatic bit(36) initial unaligned dcl 68 set ref 68* 117 i 000104 automatic fixed bin(17,0) dcl 56 set ref 94* 138* 176* ioa_$general_rs 000012 constant entry external dcl 87 ref 123 160 linus_error_$non_numeric_argument 000010 external static fixed bin(35,0) dcl 85 ref 102 mdbm_util_$complex_data_class 000016 constant entry external dcl 91 ref 97 mdbm_util_$fixed_data_class 000020 constant entry external dcl 92 ref 98 mdbm_util_$number_data_class 000014 constant entry external dcl 90 ref 101 num_ptrs 000102 automatic fixed bin(17,0) dcl 1-14 set ref 106* 107 pad 1(18) based fixed bin(17,0) level 2 packed unaligned dcl 1-6 set ref 110* scale 0(12) based bit(12) level 2 packed unaligned dcl 77 ref 99 134 173 value_ptr parameter pointer dcl 50 ref 18 116 158 NAMES DECLARED BY EXPLICIT CONTEXT. EXIT 000413 constant label dcl 152 ref 103 126 169 get_imaginary 000414 constant entry internal dcl 155 ref 126 149 linus_convert_num_to_str 000022 constant entry external dcl 18 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 112 113 114 115 117 118 119 120 addrel builtin function ref 158 fixed builtin function ref 99 134 173 index builtin function ref 134 143 173 182 length builtin function ref 143 182 substr builtin function ref 124 143 162 162 164 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1014 1036 704 1024 Length 1234 704 22 161 110 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_convert_num_to_str 222 external procedure is an external procedure. get_imaginary internal procedure shares stack frame of external procedure linus_convert_num_to_str. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_convert_num_to_str 000100 al_ptr linus_convert_num_to_str 000102 num_ptrs linus_convert_num_to_str 000103 append_len linus_convert_num_to_str 000104 i linus_convert_num_to_str 000105 char_150 linus_convert_num_to_str 000153 char_150_var_desc linus_convert_num_to_str 000154 char_75_var_string linus_convert_num_to_str 000200 char_75_var_desc linus_convert_num_to_str 000201 edit_string linus_convert_num_to_str 000204 edit_string_desc linus_convert_num_to_str 000205 COMPLEX linus_convert_num_to_str 000206 INTEGER linus_convert_num_to_str 000207 FIXED linus_convert_num_to_str 000210 INTEGER_desc linus_convert_num_to_str 000211 char_150_len linus_convert_num_to_str 000212 char_150_len_desc linus_convert_num_to_str THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry alloc_based_storage THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_$general_rs mdbm_util_$complex_data_class mdbm_util_$fixed_data_class mdbm_util_$number_data_class THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_error_$non_numeric_argument LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000015 60 000027 65 000031 67 000033 68 000040 72 000042 75 000044 94 000046 95 000047 96 000050 97 000052 98 000062 99 000074 101 000112 102 000126 103 000132 106 000133 107 000135 108 000143 109 000145 110 000146 111 000150 112 000152 113 000154 114 000160 115 000162 116 000164 117 000167 118 000171 119 000173 120 000175 121 000177 123 000202 124 000250 126 000262 133 000270 134 000273 138 000325 139 000335 140 000346 143 000350 149 000406 152 000413 155 000414 158 000415 160 000423 162 000471 164 000517 165 000530 167 000544 168 000546 169 000555 172 000556 173 000561 176 000611 177 000621 178 000630 179 000641 182 000643 185 000667 187 000700 ----------------------------------------------------------- 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