COMPILATION LISTING OF SEGMENT parse_search_rules_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1643.0 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 parse_search_rules_: proc (a_dirname, a_ename, a_caller, a_pointer, a_code); 12 13 /* This proceedure sets up pointers corresponding to the path names 14* found in the search rule segment. It also verifies that the 15* segments so initiated is a directory. */ 16 17 dcl (a_dirname, a_ename, a_caller) char (*); 18 19 dcl a_pointer ptr; 20 21 dcl a_code fixed bin (35); 22 dcl code fixed bin (35); 23 dcl bitcnt fixed bin (24); 24 dcl cc fixed bin; /* segment character count */ 25 dcl tcc fixed bin; /* total character count */ 26 dcl bn fixed bin; /* count to next blank */ 27 dcl nln fixed bin; /* count to nex new link */ 28 dcl ncl fixed bin; /* number of characters left */ 29 dcl size fixed bin; /* size of search rule name */ 30 dcl blank_flag fixed bin; /* =1 if no more blanks in seg */ 31 dcl src fixed bin; /* search rule counter */ 32 dcl ii fixed bin; 33 dcl i fixed bin; 34 35 dcl type fixed bin (2); 36 37 dcl (dname, dir, path) char (168), 38 (ename, entry, caller) char (32), 39 subname char (12), 40 string char (ncl) based, 41 ch (2) char (1) based unaligned; 42 43 dcl nl char (1) static options (constant) init (" 44 "), 45 blank char (1) static options (constant) init (" "); 46 47 dcl 1 sr based aligned, /* output name structure */ 48 2 number fixed bin, 49 2 name (22) char (168); 50 51 dcl (ptr, pptr, dirp, enp, 52 sp, srptr) ptr; 53 dcl segp ptr init (null); 54 55 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), 56 fixed bin (24), fixed bin (35)); 57 dcl hcs_$get_system_search_rules entry (ptr, fixed bin (35)); 58 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), 59 ptr, fixed bin (35)); 60 dcl com_err_ entry options (variable); 61 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 62 dcl expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); 63 64 dcl (error_table_$notadir, 65 error_table_$argerr) ext fixed bin (35); 66 1 1 /* BEGIN INCLUDE FILE ... system_dft_sr.incl.pl1 */ 1 2 1 3 dcl xsp ptr; 1 4 dcl 1 dft_sr_arg based (xsp) aligned, 1 5 2 ntags fixed bin, 1 6 2 nrules fixed bin, 1 7 2 tags (10), 1 8 3 name char (32), 1 9 3 flag bit (36), 1 10 2 rules (50), 1 11 3 name char (168), 1 12 3 flag bit (36); 1 13 1 14 /* END INCLUDE FILE ... system_dft_sr.incl.pl1 */ 67 2 1 /* BEGIN INCLUDE FILE ... search_rule_flags.incl.pl1 */ 2 2 2 3 dcl INITIATED_RULE bit (18) static options (constant) init ("000000000000000001"b); 2 4 dcl REFERENCING_DIR_RULE bit (18) static options (constant) init ("000000000000000010"b); 2 5 dcl WDIR_RULE bit (18) static options (constant) init ("000000000000000011"b); 2 6 dcl END_RULE bit (18) static options (constant) init ("000000000000000100"b); 2 7 dcl BAD_RULE bit (18) static options (constant) init ("000000000000001000"b); 2 8 2 9 dcl search_rule_names (8) char (32) aligned static options (constant) init 2 10 ("initiated_segments", 2 11 "referencing_dir", 2 12 "working_dir", 2 13 "end_rules", 2 14 "", 2 15 "", 2 16 "", 2 17 "bad search rule"); 2 18 2 19 /* END INCLUDE FILE ... search_rule_flags.incl.pl1 */ 68 69 70 dcl 1 system_rules like dft_sr_arg aligned; 71 72 dcl null builtin; 73 74 dirp = addr (dir); /* initiate some pointers */ 75 enp = addr (entry); 76 code, blank_flag = 0; 77 dname = a_dirname; /* copy args */ 78 ename = a_ename; 79 caller = a_caller; 80 srptr = a_pointer; 81 call hcs_$status_minf (dname, ename, 1, type, bitcnt, code); 82 if code ^= 0 then do; 83 call com_err_ (code, caller, " ^a>^a", dname, ename); 84 go to fin; 85 end; 86 if type ^= 1 then do; /* this is not a data segment */ 87 code = error_table_$argerr; 88 call com_err_ (code, caller, "^/ ^a>^a is not a search segment ", dname, ename); 89 go to fin; 90 end; 91 if bitcnt = 0 then go to search_rule_err; 92 call hcs_$initiate (dname, ename, "", 0, 1, segp, code); 93 if segp = null then do; 94 if code ^= 0 then go to init_err; 95 else code = error_table_$argerr; 96 init_err: call com_err_ (code, caller, "^/search segment ^a>^a was not initiated", dname, ename); 97 go to fin; 98 end; 99 100 /* initiate parse */ 101 102 tcc = divide (bitcnt, 9, 17, 0); /* get the total character count */ 103 if tcc = 0 then do; 104 search_rule_err: code = error_table_$argerr; 105 call com_err_ (code, caller, "^/search segment ^a>^a was empty", dname, ename); 106 go to fin; 107 end; 108 109 xsp = addr (system_rules); 110 call hcs_$get_system_search_rules (xsp, code); 111 if code ^= 0 then do; 112 call com_err_ (code, caller, "Cannot read dft rules"); 113 go to fin; 114 end; 115 116 cc = 1; /* start with first character */ 117 ncl = tcc; /* start with all characters left */ 118 src = 1; /* start with search rule count = 1 */ 119 120 parse: 121 sp = addr (segp -> ch (cc)); /* pointer to new string */ 122 if blank_flag = 1 then go to new_line; /* no more blanks in segment */ 123 if segp -> ch (cc) = blank then do; /* remove leading blanks */ 124 do i = cc to tcc while (segp -> ch (i) = blank); end; 125 cc = i; 126 end; 127 ncl = tcc - cc + 1; /* update characters left */ 128 if ncl <= 0 then go to nl_err; /* segment must end with a new line */ 129 sp = addr (segp -> ch (cc)); /* pointer to remaining string */ 130 new_line: nln = index (sp -> string, nl) - 1; /* count to next new line */ 131 if nln < 0 then do; /* must end with a new line */ 132 nl_err: code = error_table_$argerr; 133 call com_err_ (code, caller, "^/^a>^a search segment must end with a new line", dname, ename); 134 go to fin; 135 end; 136 if nln = 0 then go to next; /* try next line */ 137 if blank_flag = 1 then do; /* no more blanks so don't fool around */ 138 size = nln; 139 go to handle_string; 140 end; 141 bn = index (sp -> string, blank); /* count to next blank */ 142 if bn = 0 then do; /* no more blanks */ 143 blank_flag = 1; 144 size = nln; 145 go to handle_string; 146 end; 147 if bn < nln then do; /* find out how much to copy */ 148 size = bn; /* size of string to first blank */ 149 do i = bn + 1 to nln; /* check for imbedded blanks */ 150 if sp -> ch (i) ^= blank then do; 151 code = error_table_$argerr; 152 call com_err_ (code, caller, "^/search segment ^a>^a, imbedded blank in string ^a", 153 dname, ename, substr (sp -> string, 1, nln)); 154 go to fin; 155 end; 156 end; 157 go to handle_string; /* no imbedded blanks so copy it */ 158 end; 159 else size = nln; 160 161 handle_string: srptr -> sr.name (src) = substr (sp -> string, 1, size); /* copy the string */ 162 163 if sp -> ch (1) ^= ">" then go to check_code; /* absolute pathnames begin with > */ 164 pptr = addr (srptr -> sr.name (src)); 165 call expand_path_ (pptr, size, dirp, enp, code); 166 if code ^= 0 then do; 167 subname = "expand_path_"; 168 sub_err: call com_err_ (code, caller, "^a in search segment ^a>^a", srptr -> sr.name (src), dname, ename); 169 go to fin; 170 end; 171 172 call hcs_$status_minf (dir, entry, 1, type, bitcnt, code); 173 if code ^= 0 then do; 174 subname = "status_minf"; 175 go to sub_err; 176 end; 177 if type ^= 2 then do; 178 code = error_table_$notadir; 179 call com_err_ (code, caller, "^/improper search rule ^a, search segment ^a>^a", 180 srptr -> sr.name (src), dname, ename); 181 go to fin; 182 end; 183 184 next: 185 cc = cc + nln + 1; /* position to next line */ 186 if cc < tcc then do; /* continue if something left */ 187 ncl = tcc - cc + 1; /* find number of characters remaining */ 188 src = src + 1; /* bump search rule count */ 189 if src > 22 then do; /* too many search rules */ 190 code = error_table_$argerr; 191 call com_err_ (code, caller, "^/too many search rules in search segment ^a>^a", 192 dname, ename); 193 go to fin; 194 end; 195 go to parse; /* do the next one */ 196 end; 197 srptr -> sr.number = src; /* put away search rule count */ 198 199 fin: if segp ^= null then call hcs_$terminate_noname (segp, (0)); 200 a_code = code; 201 return; 202 check_code: 203 do ii = 1 to hbound (search_rule_names, 1); 204 if search_rule_names (ii) = srptr -> sr.name (src) then go to next; 205 end; 206 do ii = 1 to dft_sr_arg.ntags; 207 if dft_sr_arg.tags (ii).name = srptr -> sr.name (src) then go to next; 208 end; 209 if srptr -> sr.name (src) = "home_dir" then go to next; 210 if srptr -> sr.name (src) = "process_dir" then go to next; 211 code = error_table_$argerr; 212 call com_err_ (code, caller, "^/bad string ^a in search segment ^a>^a", 213 srptr -> sr.name (src), dname, ename); 214 go to fin; 215 216 end parse_search_rules_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1613.7 parse_search_rules_.pl1 >dumps>old>recomp>parse_search_rules_.pl1 67 1 03/10/77 1345.4 system_dft_sr.incl.pl1 >ldd>include>system_dft_sr.incl.pl1 68 2 09/13/76 1100.5 search_rule_flags.incl.pl1 >ldd>include>search_rule_flags.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. a_caller parameter char unaligned dcl 17 ref 11 79 a_code parameter fixed bin(35,0) dcl 21 set ref 11 200* a_dirname parameter char unaligned dcl 17 ref 11 77 a_ename parameter char unaligned dcl 17 ref 11 78 a_pointer parameter pointer dcl 19 ref 11 80 bitcnt 000101 automatic fixed bin(24,0) dcl 23 set ref 81* 91 102 172* blank 001677 constant char(1) initial unaligned dcl 43 ref 123 124 141 150 blank_flag 000110 automatic fixed bin(17,0) dcl 30 set ref 76* 122 137 143* bn 000104 automatic fixed bin(17,0) dcl 26 set ref 141* 142 147 148 149 caller 000261 automatic char(32) unaligned dcl 37 set ref 79* 83* 88* 96* 105* 112* 133* 152* 168* 179* 191* 212* cc 000102 automatic fixed bin(17,0) dcl 24 set ref 116* 120 123 124 125* 127 129 184* 184 186 187 ch based char(1) array unaligned dcl 37 set ref 120 123 124 129 150 163 code 000100 automatic fixed bin(35,0) dcl 22 set ref 76* 81* 82 83* 87* 88* 92* 94 95* 96* 104* 105* 110* 111 112* 132* 133* 151* 152* 165* 166 168* 172* 173 178* 179* 190* 191* 200 211* 212* com_err_ 000016 constant entry external dcl 60 ref 83 88 96 105 112 133 152 168 179 191 212 dft_sr_arg based structure level 1 dcl 1-4 dir 000167 automatic char(168) unaligned dcl 37 set ref 74 172* dirp 000276 automatic pointer dcl 51 set ref 74* 165* dname 000115 automatic char(168) unaligned dcl 37 set ref 77* 81* 83* 88* 92* 96* 105* 133* 152* 168* 179* 191* 212* ename 000241 automatic char(32) unaligned dcl 37 set ref 78* 81* 83* 88* 92* 96* 105* 133* 152* 168* 179* 191* 212* enp 000300 automatic pointer dcl 51 set ref 75* 165* entry 000251 automatic char(32) unaligned dcl 37 set ref 75 172* error_table_$argerr 000026 external static fixed bin(35,0) dcl 64 ref 87 95 104 132 151 190 211 error_table_$notadir 000024 external static fixed bin(35,0) dcl 64 ref 178 expand_path_ 000022 constant entry external dcl 62 ref 165 hcs_$get_system_search_rules 000012 constant entry external dcl 57 ref 110 hcs_$initiate 000014 constant entry external dcl 58 ref 92 hcs_$status_minf 000010 constant entry external dcl 55 ref 81 172 hcs_$terminate_noname 000020 constant entry external dcl 61 ref 199 i 000113 automatic fixed bin(17,0) dcl 33 set ref 124* 124* 125 149* 150* ii 000112 automatic fixed bin(17,0) dcl 32 set ref 202* 204* 206* 207* name 2 based char(32) array level 3 in structure "dft_sr_arg" dcl 1-4 in procedure "parse_search_rules_" ref 207 name 1 based char(168) array level 2 in structure "sr" dcl 47 in procedure "parse_search_rules_" set ref 161* 164 168* 179* 204 207 209 210 212* ncl 000106 automatic fixed bin(17,0) dcl 28 set ref 117* 127* 128 130 141 152 152 161 187* nl constant char(1) initial unaligned dcl 43 ref 130 nln 000105 automatic fixed bin(17,0) dcl 27 set ref 130* 131 136 138 144 147 149 152 152 159 184 ntags based fixed bin(17,0) level 2 dcl 1-4 ref 206 null builtin function dcl 72 ref 53 93 199 number based fixed bin(17,0) level 2 dcl 47 set ref 197* pptr 000274 automatic pointer dcl 51 set ref 164* 165* search_rule_names 000000 constant char(32) initial array dcl 2-9 ref 202 204 segp 000306 automatic pointer initial dcl 53 set ref 53* 92* 93 120 123 124 129 199 199* size 000107 automatic fixed bin(17,0) dcl 29 set ref 138* 144* 148* 159* 161 165* sp 000302 automatic pointer dcl 51 set ref 120* 129* 130 141 150 152 152 161 163 sr based structure level 1 dcl 47 src 000111 automatic fixed bin(17,0) dcl 31 set ref 118* 161 164 168 179 188* 188 189 197 204 207 209 210 212 srptr 000304 automatic pointer dcl 51 set ref 80* 161 164 168 179 197 204 207 209 210 212 string based char unaligned dcl 37 ref 130 141 152 152 161 subname 000271 automatic char(12) unaligned dcl 37 set ref 167* 174* system_rules 000312 automatic structure level 1 dcl 70 set ref 109 tags 2 based structure array level 2 dcl 1-4 tcc 000103 automatic fixed bin(17,0) dcl 25 set ref 102* 103 117 124 127 186 187 type 000114 automatic fixed bin(2,0) dcl 35 set ref 81* 86 172* 177 xsp 000310 automatic pointer dcl 1-3 set ref 109* 110* 206 207 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. BAD_RULE internal static bit(18) initial unaligned dcl 2-7 END_RULE internal static bit(18) initial unaligned dcl 2-6 INITIATED_RULE internal static bit(18) initial unaligned dcl 2-3 REFERENCING_DIR_RULE internal static bit(18) initial unaligned dcl 2-4 WDIR_RULE internal static bit(18) initial unaligned dcl 2-5 path automatic char(168) unaligned dcl 37 ptr automatic pointer dcl 51 NAMES DECLARED BY EXPLICIT CONTEXT. check_code 001550 constant label dcl 202 ref 163 fin 001526 constant label dcl 199 ref 84 89 97 106 113 134 154 169 181 193 214 handle_string 001221 constant label dcl 161 ref 139 145 157 init_err 000606 constant label dcl 96 ref 94 new_line 001024 constant label dcl 130 ref 122 next 001447 constant label dcl 184 ref 136 204 207 209 210 nl_err 001036 constant label dcl 132 ref 128 parse 000754 constant label dcl 120 ref 195 parse_search_rules_ 000313 constant entry external dcl 11 search_rule_err 000646 constant label dcl 104 set ref 91 sub_err 001270 constant label dcl 168 ref 175 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 74 75 109 120 129 164 divide builtin function ref 102 hbound builtin function ref 202 index builtin function ref 130 141 substr builtin function ref 152 152 161 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2022 2052 1701 2032 Length 2300 1701 30 212 120 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME parse_search_rules_ 2534 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME parse_search_rules_ 000100 code parse_search_rules_ 000101 bitcnt parse_search_rules_ 000102 cc parse_search_rules_ 000103 tcc parse_search_rules_ 000104 bn parse_search_rules_ 000105 nln parse_search_rules_ 000106 ncl parse_search_rules_ 000107 size parse_search_rules_ 000110 blank_flag parse_search_rules_ 000111 src parse_search_rules_ 000112 ii parse_search_rules_ 000113 i parse_search_rules_ 000114 type parse_search_rules_ 000115 dname parse_search_rules_ 000167 dir parse_search_rules_ 000241 ename parse_search_rules_ 000251 entry parse_search_rules_ 000261 caller parse_search_rules_ 000271 subname parse_search_rules_ 000274 pptr parse_search_rules_ 000276 dirp parse_search_rules_ 000300 enp parse_search_rules_ 000302 sp parse_search_rules_ 000304 srptr parse_search_rules_ 000306 segp parse_search_rules_ 000310 xsp parse_search_rules_ 000312 system_rules parse_search_rules_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ expand_path_ hcs_$get_system_search_rules hcs_$initiate hcs_$status_minf hcs_$terminate_noname THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr error_table_$notadir LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000306 53 000340 74 000342 75 000344 76 000346 77 000350 78 000356 79 000363 80 000370 81 000373 82 000431 83 000433 84 000465 86 000466 87 000471 88 000474 89 000526 91 000527 92 000531 93 000575 94 000601 95 000603 96 000606 97 000641 102 000642 103 000645 104 000646 105 000651 106 000703 109 000704 110 000706 111 000717 112 000721 113 000745 116 000746 117 000750 118 000752 120 000754 122 000762 123 000765 124 000772 124 001006 125 001010 127 001011 128 001015 129 001016 130 001024 131 001035 132 001036 133 001041 134 001073 136 001074 137 001075 138 001100 139 001102 141 001103 142 001114 143 001115 144 001117 145 001121 147 001122 148 001124 149 001125 150 001135 151 001142 152 001145 154 001212 156 001214 157 001216 159 001217 161 001221 163 001232 164 001237 165 001242 166 001261 167 001263 168 001270 169 001332 172 001333 173 001372 174 001374 175 001377 177 001400 178 001403 179 001406 181 001446 184 001447 186 001453 187 001455 188 001461 189 001462 190 001465 191 001470 193 001522 195 001523 197 001524 199 001526 200 001544 201 001547 202 001550 204 001555 205 001570 206 001572 207 001601 208 001615 209 001617 210 001627 211 001633 212 001637 214 001676 ----------------------------------------------------------- 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