COMPILATION LISTING OF SEGMENT db_parse_arg Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1822.4 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_parse_arg: proc (il, lin, ill, retp, type, size); 12 13 dcl l fixed bin; 14 15 dcl il char (132) aligned, /* input character string to be scanned */ 16 conversion bit (1) aligned, 17 lin fixed bin, /* starting index into il */ 18 ill fixed bin, /* length of il */ 19 retp ptr, /* pointer to location in which to return arg */ 20 type fixed bin, /* type of returned arg */ 21 size fixed bin; /* size in chars or bits of returned arg */ 22 23 /* types handled: 24* 25* 1 fixed bin (octal or decimal) 26* 3 float bin 27* 13 pointer 28* 19 bit string 29* 21 char string 30* 0 variable 31* -1 no arg error 32* -2 syntax error 33* -3 % in string 34* 35* */ 36 37 dcl (bit, fixed, addrel, substr, mod, ptr) builtin; 38 39 dcl db_conversion condition; 40 41 dcl neg fixed bin; 42 43 dcl work char (80); 44 dcl bstr bit (size) based (retp) aligned, 45 cstr char (size) based (retp) aligned, 46 (i, j, cstrt, k, depth) fixed bin, 47 nl char (1) aligned static init (" 48 "), 49 (temp, temp1) float bin, 50 fword fixed bin based, 51 flword float bin based, 52 c1 char (1) aligned, 53 bptr ptr based, 54 db_get_count$data ext entry (char (132) aligned, fixed bin, fixed bin, ptr, fixed bin, fixed bin), 55 db_get_count ext entry (char (132) aligned, fixed bin, fixed bin) returns (fixed bin), 56 db_get_count$dec ext entry (char (132) aligned, fixed bin, fixed bin) returns (fixed bin); 57 58 dcl assign_ ext entry (ptr, fixed bin, fixed bin, ptr, fixed bin, fixed bin); 1 1 /* BEGIN INCLUDE FILE its.incl.pl1 1 2* modified 27 July 79 by JRDavis to add its_unsigned 1 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 1 4 1 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 1 6 2 pad1 bit (3) unaligned, 1 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 1 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 1 9 2 pad2 bit (9) unaligned, 1 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 1 11 1 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 1 13 2 pad3 bit (3) unaligned, 1 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 1 15 2 pad4 bit (3) unaligned, 1 16 2 mod bit (6) unaligned; /* further modification */ 1 17 1 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 1 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 1 20 2 pad1 bit (27) unaligned, 1 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 1 22 1 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 1 24 2 pad2 bit (3) unaligned, 1 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 1 26 2 pad3 bit (3) unaligned, 1 27 2 mod bit (6) unaligned; /* further modification */ 1 28 1 29 1 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 1 31 2 pad1 bit (3) unaligned, 1 32 2 segno fixed bin (15) unsigned unaligned, 1 33 2 ringno fixed bin (3) unsigned unaligned, 1 34 2 pad2 bit (9) unaligned, 1 35 2 its_mod bit (6) unaligned, 1 36 1 37 2 offset fixed bin (18) unsigned unaligned, 1 38 2 pad3 bit (3) unaligned, 1 39 2 bit_offset fixed bin (6) unsigned unaligned, 1 40 2 pad4 bit (3) unaligned, 1 41 2 mod bit (6) unaligned; 1 42 1 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 1 44 2 pr_no fixed bin (3) unsigned unaligned, 1 45 2 pad1 bit (27) unaligned, 1 46 2 itp_mod bit (6) unaligned, 1 47 1 48 2 offset fixed bin (18) unsigned unaligned, 1 49 2 pad2 bit (3) unaligned, 1 50 2 bit_offset fixed bin (6) unsigned unaligned, 1 51 2 pad3 bit (3) unaligned, 1 52 2 mod bit (6) unaligned; 1 53 1 54 1 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 1 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 1 57 1 58 /* END INCLUDE FILE its.incl.pl1 */ 59 60 /* */ 61 62 type = -1; /* initialize return args */ 63 size = 0; 64 neg = 0; 65 66 do i = lin to ill while (substr (il, i, 1) = " "); /* skip leading blanks */ 67 end; 68 if i >= ill then go to ERROR; /* syntax error if off end of string */ 69 70 c1 = substr (il, i, 1); /* get first character of argument */ 71 if c1 = ")" | c1 = ";" then return; /* must signal no arg error */ 72 73 if c1 = "&" then do; /* decimal fixed bin */ 74 if substr (il, i+1, 1) = "n" then do; 75 i = i + 2; 76 go to is_var; 77 end; 78 if substr (il, i+1, 1) = "d" | substr (il, i+1, 1) = "o" then go to get_fixed; 79 else go to ERROR; 80 end; 81 82 if c1 = "." then do; /* decimal # or floating # */ 83 call get_float; 84 end; 85 86 if c1 = """" then do; /* bit or char string */ 87 cstrt = 0; 88 scan_end_chars: 89 do j = i+1 to ill while (substr (il, j, 1) ^= """"); /* look for end of string */ 90 end; 91 if j >= ill then go to ERROR; /* syntax error */ 92 size = j - i - 1; /* get size of string */ 93 if substr (il, j+1, 1) = "b" then do; /* bit string */ 94 if cstrt ^= 0 then go to ERROR; /* have found doubled quotes in it */ 95 bstr = "0"b; /* set to zeros to start */ 96 do k = 1 to size; /* set each one bit ON */ 97 if substr (il, i+k, 1) = "1" then substr (bstr, k, 1) = "1"b; 98 end; 99 type = 19; 100 lin = j+2; 101 return; 102 end; 103 /* check here for "" in char string */ 104 if substr (il, j+1, 1) = """" then do; 105 substr (cstr, cstrt+1, size+1) = substr (il, i+1, size+1); /* copy string ending with " */ 106 i = j + 1; /* remember where in scan we are */ 107 cstrt = cstrt+size+1; /* update filled in offset in output string */ 108 go to scan_end_chars; /* and scan for closing " */ 109 end; 110 111 substr (cstr, cstrt+1, size) = substr (il, i+1, size); /* copy string */ 112 size = cstrt+size; /* and remember final size for caller */ 113 type = 21; 114 lin = j + 1; 115 return; 116 end; 117 118 if verify (c1, "-+0123456789") = 0 then do; 119 get_fixed: j = db_get_count$dec (il, i, lin); /* assume afixed binary no. */ 120 if i = lin then go to ERROR; 121 if substr (il, lin, 1) = "." | substr (il, lin, 1) = "e" then call get_float; 122 else if substr (il, lin, 1) = "|" then do; 123 j = db_get_count (il, i, lin); /* rescan in octal for segment no. */ 124 call get_offset; 125 end; 126 type = 1; 127 retp -> fword = j; 128 go to RETURN; 129 end; 130 131 if c1 = "%" then do; /* dummy argument */ 132 type = -3; 133 lin = i+1; /* set up return arg */ 134 c1 = substr (il, lin, 1); 135 if verify (c1, ", );") ^= 0 then go to ERROR; 136 return; 137 end; 138 139 is_var: depth = 0; /* argument must be a variable */ 140 do lin = i+1 to ill; /* scan char by char */ 141 c1 = substr (il, lin, 1); /* pick up current character */ 142 if verify (c1, "0123456789 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ._") = 0 then go to endl; 143 if c1 = "(" then depth = depth + 1; 144 if c1 = ")" then do; 145 if depth > 0 then depth = depth - 1; 146 else go to done; 147 end; 148 else if c1 = "-" then do; 149 if substr (il, lin+1, 1) = ">" then lin = lin + 1; 150 else if depth = 0 then go to done; 151 end; 152 else if depth = 0 then go to done; 153 endl: end; 154 go to ERROR; 155 done: 156 size = lin - i; /* get length of variable name */ 157 cstr = substr (il, i, size); /* copy name into return area */ 158 type = 0; 159 RETURN: return; 160 161 ERROR: type = -2; 162 return; 163 164 165 166 167 ptr_offset: entry (il, lin, ill, base_val, retp, type, size); 168 169 /* entry to parse the offset portion of a pointer whose seg. no. is known */ 170 171 dcl base_val fixed bin; 172 173 j = base_val; 174 call get_offset; 175 176 177 get_float: proc; 178 call db_get_count$data (il, i, lin, retp, 6, 35); 179 if i = lin then go to ERROR;; 180 type = 3; 181 go to RETURN; 182 end get_float; 183 184 get_offset: proc; 185 186 k = db_get_count (il, lin+1, lin); /* get offset */ 187 retp -> bptr = ptr (baseptr (j), k); /* create and return pointer */ 188 type = 13; 189 if substr (il, lin, 1) = "(" then do; /* bit offset given */ 190 j = db_get_count$dec (il, lin+1, lin); 191 retp -> bptr = addrel (retp -> bptr, divide (j, 36, 18, 0)); /* maybe bit offset > 36 */ 192 retp -> its.bit_offset = bit (fixed (mod (j, 36), 6)); /* stuff in bit offset */ 193 if substr (il, lin, 1) ^= ")" then go to ERROR; 194 lin = lin + 1; /* skip over last ")" */ 195 end; 196 if substr (il, lin, 1) = "[" 197 then do; 198 l = db_get_count$dec (il, lin+1, lin); 199 if l > 7 then go to ERROR; 200 retp -> its.ringno = bit (fixed (l, 3), 3); 201 if substr (il, lin, 1) ^= "]" then go to ERROR; 202 lin = lin + 1; 203 end; 204 go to RETURN; 205 206 end get_offset; 207 208 209 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1628.7 db_parse_arg.pl1 >dumps>old>recomp>db_parse_arg.pl1 59 1 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.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. addrel builtin function dcl 37 ref 191 base_val parameter fixed bin(17,0) dcl 171 ref 167 173 bit builtin function dcl 37 ref 192 200 bit_offset 1(21) based bit(6) level 2 packed unaligned dcl 1-5 set ref 192* bptr based pointer dcl 44 set ref 187* 191* 191 bstr based bit dcl 44 set ref 95* 97* c1 000107 automatic char(1) dcl 44 set ref 70* 71 71 73 82 86 118 131 134* 135 141* 142 143 144 148 cstr based char dcl 44 set ref 105* 111* 157* cstrt 000104 automatic fixed bin(17,0) dcl 44 set ref 87* 94 105 107* 107 111 112 db_get_count 000012 constant entry external dcl 44 ref 123 186 db_get_count$data 000010 constant entry external dcl 44 ref 178 db_get_count$dec 000014 constant entry external dcl 44 ref 119 190 198 depth 000106 automatic fixed bin(17,0) dcl 44 set ref 139* 143* 143 145 145* 145 150 152 fixed builtin function dcl 37 ref 192 200 fword based fixed bin(17,0) dcl 44 set ref 127* i 000102 automatic fixed bin(17,0) dcl 44 set ref 66* 66* 68 70 74 75* 75 78 78 88 92 97 105 106* 111 119* 120 123* 133 140 155 157 178* 179 il parameter char(132) dcl 15 set ref 11 66 70 74 78 78 88 93 97 104 105 111 119* 121 121 122 123* 134 141 149 157 167 178* 186* 189 190* 193 196 198* 201 ill parameter fixed bin(17,0) dcl 15 ref 11 66 68 88 91 140 167 its based structure level 1 dcl 1-5 j 000103 automatic fixed bin(17,0) dcl 44 set ref 88* 88* 91 92 93 100 104 106 114 119* 123* 127 173* 187 190* 191 192 k 000105 automatic fixed bin(17,0) dcl 44 set ref 96* 97 97* 186* 187 l 000100 automatic fixed bin(17,0) dcl 13 set ref 198* 199 200 lin parameter fixed bin(17,0) dcl 15 set ref 11 66 100* 114* 119* 120 121 121 122 123* 133* 134 140* 141 149 149* 149* 155 167 178* 179 186 186* 189 190 190* 193 194* 194 196 198 198* 201 202* 202 mod builtin function dcl 37 ref 192 neg 000101 automatic fixed bin(17,0) dcl 41 set ref 64* ptr builtin function dcl 37 ref 187 retp parameter pointer dcl 15 set ref 11 95 97 105 111 127 157 167 178* 187 191 191 192 200 ringno 0(18) based bit(3) level 2 packed unaligned dcl 1-5 set ref 200* size parameter fixed bin(17,0) dcl 15 set ref 11 63* 92* 95 96 97 105 105 105 107 111 111 111 112* 112 155* 157 157 167 substr builtin function dcl 37 set ref 66 70 74 78 78 88 93 97 97* 104 105* 105 111* 111 121 121 122 134 141 149 157 189 193 196 201 type parameter fixed bin(17,0) dcl 15 set ref 11 62* 99* 113* 126* 132* 158* 161* 167 180* 188* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ITP_MODIFIER internal static bit(6) initial unaligned dcl 1-56 ITS_MODIFIER internal static bit(6) initial unaligned dcl 1-55 assign_ 000000 constant entry external dcl 58 conversion automatic bit(1) dcl 15 db_conversion 000000 stack reference condition dcl 39 flword based float bin(27) dcl 44 itp based structure level 1 dcl 1-18 itp_unsigned based structure level 1 dcl 1-43 its_unsigned based structure level 1 dcl 1-30 nl internal static char(1) initial dcl 44 temp automatic float bin(27) dcl 44 temp1 automatic float bin(27) dcl 44 work automatic char(80) unaligned dcl 43 NAMES DECLARED BY EXPLICIT CONTEXT. ERROR 000541 constant label dcl 161 ref 68 79 91 94 120 135 154 179 193 199 201 RETURN 000540 constant label dcl 159 ref 128 181 204 db_parse_arg 000042 constant entry external dcl 11 done 000526 constant label dcl 155 ref 145 150 152 endl 000523 constant label dcl 153 ref 142 get_fixed 000330 constant label dcl 119 ref 78 get_float 000573 constant entry internal dcl 177 ref 83 121 get_offset 000631 constant entry internal dcl 184 ref 124 174 is_var 000442 constant label dcl 139 ref 76 ptr_offset 000552 constant entry external dcl 167 scan_end_chars 000145 constant label dcl 88 ref 108 NAMES DECLARED BY CONTEXT OR IMPLICATION. baseptr builtin function ref 187 divide builtin function ref 191 verify builtin function ref 118 135 142 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1110 1126 1035 1120 Length 1312 1035 16 150 53 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME db_parse_arg 136 external procedure is an external procedure. get_float internal procedure shares stack frame of external procedure db_parse_arg. get_offset internal procedure shares stack frame of external procedure db_parse_arg. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME db_parse_arg 000100 l db_parse_arg 000101 neg db_parse_arg 000102 i db_parse_arg 000103 j db_parse_arg 000104 cstrt db_parse_arg 000105 k db_parse_arg 000106 depth db_parse_arg 000107 c1 db_parse_arg THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return mod_fx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. db_get_count db_get_count$data db_get_count$dec NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000034 62 000056 63 000060 64 000061 66 000062 67 000077 68 000101 70 000104 71 000111 73 000116 74 000120 75 000126 76 000130 78 000131 79 000135 82 000136 83 000140 86 000141 87 000144 88 000145 90 000164 91 000166 92 000171 93 000174 94 000204 95 000206 96 000216 97 000225 98 000242 99 000244 100 000246 101 000252 104 000253 105 000255 106 000271 107 000274 108 000300 111 000301 112 000310 113 000312 114 000314 115 000317 118 000320 119 000330 120 000346 121 000352 122 000366 123 000370 124 000405 126 000406 127 000410 128 000413 131 000414 132 000416 133 000420 134 000424 135 000431 136 000441 139 000442 140 000443 141 000455 142 000462 143 000472 144 000476 145 000500 147 000504 148 000505 149 000507 150 000516 151 000520 152 000521 153 000523 154 000525 155 000526 157 000531 158 000537 159 000540 161 000541 162 000543 167 000544 173 000566 174 000571 209 000572 177 000573 178 000574 179 000622 180 000626 181 000630 184 000631 186 000632 187 000653 188 000663 189 000665 190 000674 191 000714 192 000723 193 000740 194 000747 196 000750 198 000757 199 000777 200 001002 201 001013 202 001022 204 001023 ----------------------------------------------------------- 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