COMPILATION LISTING OF SEGMENT db_get_count Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1821.7 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 db_get_count: proc(line,start_index,next_index,number); 12 13 /* db_get_count Parses the string "line" beginning at "start_index" and returns a fixed binary number. 14* using an octal default. 15* 16* db_get_count$double Returns a double word and uses an octal default. 17* 18* db_get_count$dec Returns a fixed binary number, but assumes a decimal default. 19* 20* Escape strings must immediately preceed the number. 21* 22* &o Change the default to octal. 23* &d Change the default to decimal. 24**/ 25 26 27 28 29 dcl line char(132); /* character string to convert to a number */ 30 dcl (start_index, /* index of start of string */ 31 next_index) fixed; /* index of character following the number */ 32 dcl number fixed bin(35); /* number returned */ 33 34 dcl no fixed bin(71) init(0); 35 dcl data_type fixed bin; 36 dcl data_len fixed bin; 37 dcl (i,j,st,end) fixed bin; 38 dcl data bit(1) init("0"b); 39 dcl dec_default bit(1) init("0"b); /* 1 = assume decimal init("0"); 0 = assume octal init("0"); */ 40 dcl assign_ ext entry (ptr,fixed bin,fixed bin,ptr,fixed bin,fixed bin); 41 dcl signal_ ext entry (char(*)); 42 dcl (addr, fixed, index, length, substr, verify, unspec) builtin; 43 dcl data_ptr ptr; /* ptr to number */ 44 45 46 number = 0; 47 call initial; 48 if ^dec_default then number = no; 49 else call decimal; 50 return; 51 52 ERROR: next_index = start_index; 53 54 RETURN: return; 55 56 57 db_get_count$double: entry (line,start_index,next_index,double_no); 58 59 dcl double_no fixed bin(71); 60 61 data = "1"b; 62 call initial; 63 if ^dec_default then double_no = no; 64 else do; 65 data_ptr = addr(double_no); 66 data_type = 4; 67 data_len = 71; 68 call decimal; 69 end; 70 71 return; 72 73 db_get_count$dec: entry (line,start_index,next_index,number); 74 75 dec_default = "1"b; 76 call initial; 77 if dec_default then call decimal; 78 else number = no; 79 return; 80 81 db_get_count$data: entry(line,start_index,next_index,arg_ptr,arg_type,arg_len); 82 83 dcl (arg_type, /* 2*arg type */ 84 arg_len) fixed bin; /* precesion */ 85 dcl arg_ptr ptr; /* pointer to location of number */ 86 87 data = "1"b; 88 dec_default = "1"b; 89 call initial; 90 if ^dec_default then call assign_(arg_ptr,arg_type,arg_len,addr(no),4,71); 91 else do; /* decimal default */ 92 i = verify (substr(line,st),"+-0123456789.e"); 93 if i = 1 then go to ERROR; 94 else if i = 0 then i = end; 95 else i = st + i -2; 96 call assign_(arg_ptr, arg_type, arg_len,addr(substr(line,st)),43,i-st+1); 97 next_index = i + 1; 98 end; 99 100 return; 101 102 initial: proc; 103 104 st = start_index; 105 end =length(line); 106 if ^data then do; 107 data_ptr = addr(number); 108 data_type = 2; 109 data_len = 35; 110 end; 111 if substr(line,st,2) = "&o" then do; 112 st = st +2; 113 dec_default = "0"b; 114 end; 115 else if substr(line,st,2) = "&d" then do; 116 st = st + 2; 117 dec_default = "1"b; 118 end; 119 120 if ^dec_default then call octal; 121 return; 122 end initial; 123 124 octal: proc; 125 126 dcl minus bit(1); 127 128 minus = "0"b; 129 if substr(line,st,1) = "-" then do; 130 st = st + 1; 131 minus = "1"b; 132 end; 133 else if substr (line,st,1) = "+" then st = st + 1; 134 135 i = verify(substr(line,st,end-st+1),"01234567"); 136 if i = 1 then do; 137 if substr(line,st,1) = "8" | substr(line,st,1) = "9" then call signal_("db_conversion"); 138 else go to ERROR; 139 end; 140 else if i = 0 then j = end; 141 else do; 142 j = st + i - 2; 143 if substr(line,j+1,1) = "8" | substr(line,j+1,1) = "9" then call signal_ ("db_conversion"); 144 end; 145 no = 0; 146 do i = st to j; 147 no = no*8 + fixed (unspec(substr(line,i,1)),35) - 48; 148 end; 149 next_index = j + 1; 150 if minus then no = -no; 151 return; 152 end octal; 153 154 decimal: proc; 155 156 if ^data then do; /* default is fixed bin(35) */ 157 data_ptr = addr(number); 158 data_type = 2; 159 data_len = 35; 160 number = 0; 161 end; 162 163 i = verify (substr(line,st,end-st+1),"+-0123456789"); 164 165 if i = 1 then go to ERROR; 166 if i = 0 then j = end; 167 else j = st + i - 2; 168 169 call assign_(data_ptr, data_type, data_len, addr(substr(line,st)), 43, j-st+1); 170 next_index = j + 1; 171 return; 172 173 end decimal; 174 175 end db_get_count; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1609.4 db_get_count.pl1 >dumps>old>recomp>db_get_count.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 42 ref 65 90 90 96 96 107 157 169 169 arg_len parameter fixed bin(17,0) dcl 83 set ref 81 90* 96* arg_ptr parameter pointer dcl 85 set ref 81 90* 96* arg_type parameter fixed bin(17,0) dcl 83 set ref 81 90* 96* assign_ 000010 constant entry external dcl 40 ref 90 96 169 data 000110 automatic bit(1) initial unaligned dcl 38 set ref 38* 61* 87* 106 156 data_len 000103 automatic fixed bin(17,0) dcl 36 set ref 67* 109* 159* 169* data_ptr 000112 automatic pointer dcl 43 set ref 65* 107* 157* 169* data_type 000102 automatic fixed bin(17,0) dcl 35 set ref 66* 108* 158* 169* dec_default 000111 automatic bit(1) initial unaligned dcl 39 set ref 39* 48 63 75* 77 88* 90 113* 117* 120 double_no parameter fixed bin(71,0) dcl 59 set ref 57 63* 65 end 000107 automatic fixed bin(17,0) dcl 37 set ref 94 105* 135 140 163 166 fixed builtin function dcl 42 ref 147 i 000104 automatic fixed bin(17,0) dcl 37 set ref 92* 93 94 94* 95* 95 96 97 135* 136 140 142 146* 147* 163* 165 166 167 j 000105 automatic fixed bin(17,0) dcl 37 set ref 140* 142* 143 143 146 149 166* 167* 169 170 length builtin function dcl 42 ref 105 line parameter char(132) unaligned dcl 29 set ref 11 57 73 81 92 96 96 105 111 115 129 133 135 137 137 143 143 147 163 169 169 minus 000130 automatic bit(1) unaligned dcl 126 set ref 128* 131* 150 next_index parameter fixed bin(17,0) dcl 30 set ref 11 52* 57 73 81 97* 149* 170* no 000100 automatic fixed bin(71,0) initial dcl 34 set ref 34* 48 63 78 90 90 145* 147* 147 150* 150 number parameter fixed bin(35,0) dcl 32 set ref 11 46* 48* 73 78* 107 157 160* signal_ 000012 constant entry external dcl 41 ref 137 143 st 000106 automatic fixed bin(17,0) dcl 37 set ref 92 95 96 96 96 104* 111 112* 112 115 116* 116 129 130* 130 133 133* 133 135 135 137 137 142 146 163 163 167 169 169 169 start_index parameter fixed bin(17,0) dcl 30 ref 11 52 57 73 81 104 substr builtin function dcl 42 ref 92 96 96 111 115 129 133 135 137 137 143 143 147 163 169 169 unspec builtin function dcl 42 ref 147 verify builtin function dcl 42 ref 92 135 163 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. index builtin function dcl 42 NAMES DECLARED BY EXPLICIT CONTEXT. ERROR 000057 constant label dcl 52 ref 93 137 165 RETURN 000062 constant label dcl 54 db_get_count 000036 constant entry external dcl 11 db_get_count$data 000151 constant entry external dcl 81 db_get_count$dec 000122 constant entry external dcl 73 db_get_count$double 000070 constant entry external dcl 57 decimal 000551 constant entry internal dcl 154 ref 49 68 77 initial 000313 constant entry internal dcl 102 ref 47 62 76 89 octal 000357 constant entry internal dcl 124 ref 120 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1564 1600 1456 1574 Length 1756 1456 14 142 105 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME db_get_count 146 external procedure is an external procedure. initial internal procedure shares stack frame of external procedure db_get_count. octal internal procedure shares stack frame of external procedure db_get_count. decimal internal procedure shares stack frame of external procedure db_get_count. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME db_get_count 000100 no db_get_count 000102 data_type db_get_count 000103 data_len db_get_count 000104 i db_get_count 000105 j db_get_count 000106 st db_get_count 000107 end db_get_count 000110 data db_get_count 000111 dec_default db_get_count 000112 data_ptr db_get_count 000130 minus octal THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mpfx2 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_ signal_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000023 38 000025 39 000026 11 000031 46 000044 47 000046 48 000047 49 000055 50 000056 52 000057 54 000062 57 000063 61 000076 62 000100 63 000101 65 000107 66 000112 67 000114 68 000116 71 000117 73 000120 75 000130 76 000132 77 000133 78 000137 79 000142 81 000143 87 000157 88 000161 89 000162 90 000163 92 000216 93 000241 94 000243 95 000250 96 000253 97 000306 100 000312 102 000313 104 000314 105 000317 106 000321 107 000323 108 000325 109 000327 111 000331 112 000341 113 000343 114 000344 115 000345 116 000347 117 000351 120 000353 121 000356 124 000357 128 000360 129 000361 130 000372 131 000373 132 000375 133 000376 135 000401 136 000417 137 000421 139 000446 140 000447 142 000454 143 000457 145 000504 146 000506 147 000515 148 000536 149 000540 150 000544 151 000550 154 000551 156 000552 157 000554 158 000557 159 000561 160 000563 163 000564 165 000604 166 000606 167 000613 169 000616 170 000651 171 000655 ----------------------------------------------------------- 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