COMPILATION LISTING OF SEGMENT parse_file_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1842.2 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 12 /* PARSE_FILE_ - Character String Parsing Program. 13* 1/22/70 - Noel I. Morris 14* with apologies to C. Garman */ 15 16 /* last modified by E Stone on 14 Dec 1970 */ 17 18 parse_file_$parse_file_init_name: proc (dir, entry, p, code); 19 20 dcl name char (*), /* segment name of segment to be examined */ 21 p ptr, /* pointer to segment (returned) */ 22 code fixed bin (35); /* error code */ 23 24 dcl (segp ptr, /* static pointer to segment */ 25 cur_pos fixed bin (17), /* current scanning index */ 26 cur_nl fixed bin (17), /* index of last NL encountered */ 27 line_no fixed bin, /* current line number */ 28 msl fixed bin (17)) static; /* maximum number of characters in segment */ 29 /* less one */ 30 31 dcl NL char (1) static init (" 32 "); 33 34 dcl 1 break_table static aligned, /* table of break characters */ 35 2 bit (0:127) bit (1) unaligned; 36 37 dcl bitcnt fixed bin (24), /* bit count of segment */ 38 i fixed bin (17), /* loop index */ 39 dir char (*), /* directory path name of segment */ 40 dname char (168), 41 entry char (*), /* entry name of segment */ 42 ename char (32); 43 44 dcl (null, index, addr, divide, min, substr, fixed, unspec) builtin; 45 46 dcl (expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), 47 hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)), 48 com_err_ entry options (variable)) ext; 49 50 51 /* */ 52 53 /* PARSE_FILE_INIT_NAME - Initialize Program. 54* 55* Calling Sequence: 56* call parse_file_init_name (dir, entry, p, code); 57* 58* Where: 59* dir = directory path name of segment to be examined (input) 60* entry = entry name of segment to be examined (input) 61* p = pointer to segment (returned) 62* code = error code (returned) 63* 64**/ 65 66 code = 0; /* Clear the error code. */ 67 68 call hcs_$initiate_count (dir, entry, "", bitcnt, 0, segp, code); 69 if segp = null then return; /* Test for null pointer returned. */ 70 code = 0; /* Clear any residual error code. */ 71 72 p = segp; /* Return pointer to segment. */ 73 msl = divide (bitcnt, 9, 18, 0) - 1; /* Compute character count from bit count. */ 74 75 common: 76 cur_pos, cur_nl = 0; /* Zero the position indices. */ 77 line_no = 1; /* Start with the first line. */ 78 79 do i = 0 to 47, 58 to 64, 91 to 96, 123 to 127; /* Set up the break table. */ 80 break_table.bit (i) = "1"b; 81 end; 82 do i = 48 to 57, 65 to 90, 97 to 122; /* 0-9, A-Z, a-z are not break characters. */ 83 break_table.bit (i) = "0"b; 84 end; 85 86 return; /* Return to caller. */ 87 88 89 /* */ 90 91 /* PARSE_FILE_INIT_PTR - Initialize Program with Supplied Pointer. 92* 93* Calling Sequence: 94* call parse_file_init_ptr (p, cc); 95* 96* Where: 97* p = pointer to segment (supplied). 98* cc = character count. 99* 100**/ 101 102 parse_file_init_ptr: entry (p, cc); 103 104 dcl cc fixed bin (17); /* character count */ 105 106 107 segp = p; /* Save pointer to segment. */ 108 msl = cc - 1; /* Save character count. */ 109 110 go to common; /* Tom VV says we should do this. */ 111 112 113 /* */ 114 115 /* PARSE_FILE_SET_BREAK - Define Break Character(s). 116* 117* Calling Sequence: 118* call parse_file_set_break (cs); 119* 120* Where: 121* cs = control string. A break will be set for each 122* character in the control string. 123* 124**/ 125 126 parse_file_set_break: entry (cs); 127 128 dcl cs char (*); /* control string */ 129 130 dcl setting bit (1); /* table setting */ 131 132 133 setting = "1"b; /* Setting is on. */ 134 135 set: 136 do i = 1 to length (cs); /* Scan the control string. */ 137 c1 = substr (cs, i, 1); 138 break_table.bit (fixed (unspec (c1), 9)) = setting; 139 /* Set appropriate bit. */ 140 end; 141 142 return; 143 144 145 /* */ 146 147 /* PARSE_FILE_UNSET_BREAK - Undefine Break Character(s). 148* 149* Calling Sequence: 150* call parse_file_unset_break (cs); 151* 152**/ 153 154 parse_file_unset_break: entry (cs); 155 156 157 setting = "0"b; /* Setting is off. */ 158 go to set; /* Join common code. */ 159 160 161 /* */ 162 163 /* PARSE_FILE_ - Return Atom from Text. 164* 165* Calling Sequence: 166* call parse_file_ (ci, cc, break, eof); 167* 168* Where: 169* ci = character index of start of atom (1st char = 1) 170* cc = count of characters in atom 171* break = non-zero if atom is single-character break 172* eof = non-zero if end of segment encountered 173* 174**/ 175 176 parse_file_: entry (ci, cc, break, eof); 177 178 dcl ci fixed bin (17), /* character index */ 179 break fixed bin (1), /* break indicator */ 180 eof fixed bin (1); /* end-of-file indicator */ 181 182 dcl c1 char (1), /* current character */ 183 sw fixed bin (1); /* non-zero if pointer to be returned */ 184 185 dcl 1 text based (segp) aligned, /* text overlay declaration */ 186 2 ch (0:65535) char (1) unaligned; 187 188 189 sw = 0; /* Clear the return pointer switch. */ 190 191 loop: 192 if cur_pos > msl then do; /* Test for end of file. */ 193 seteof: eof = 1; /* Set end-of-file switch. */ 194 return; /* Return to caller. */ 195 end; 196 197 c1 = text.ch (cur_pos); /* Grab current character. */ 198 199 if c1 <= " " then do; /* Ignore all blanks and control characters. */ 200 cur_pos = cur_pos + 1; /* Step character position. */ 201 if c1 = NL then do; /* Test for new line character. */ 202 cur_nl = cur_pos; /* Save position of beginning of line. */ 203 line_no = line_no + 1; /* Count one line. */ 204 end; 205 go to loop; /* Try for another character. */ 206 end; 207 208 if c1 = "/" then if cur_pos < msl then if text.ch (cur_pos + 1) = "*" then do; 209 /* Test for a comment. */ 210 do i = cur_pos + 2 to msl - 1; /* Scan for end of comment. */ 211 if text.ch (i) = NL then line_no = line_no + 1; /* look for newlines in comment */ 212 if text.ch (i) = "*" then if text.ch (i + 1) = "/" then 213 go to end_comment; 214 end; 215 go to seteof; /* Hit the end of file. */ 216 end_comment: 217 cur_pos = i + 2; /* Step over the comment. */ 218 go to loop; /* And continue scan. */ 219 end; 220 221 222 /* */ 223 224 /* Arrive here after finding a non-break, non-comment sequence. */ 225 226 break_search: 227 do i = cur_pos to msl; /* Scan through the text. */ 228 c1 = text.ch (i); /* Pick up current character. */ 229 if break_table.bit (fixed (unspec (c1), 9)) then go to break_found; 230 /* Exit loop on break character. */ 231 if c1 = "/" then if text.ch (i + 1) = "*" then 232 go to break_found; /* Test for sneaky comment. */ 233 end break_search; 234 235 break_found: 236 if i = cur_pos then do; /* Test for single character break. */ 237 i = cur_pos + 1; /* Step to character following break. */ 238 break = 1; /* Indicate break character found. */ 239 end; 240 else /* Non-break sequence. */ 241 break = 0; /* Turn of break indication. */ 242 243 if sw = 0 then /* If index desired ... */ 244 ci = cur_pos + 1; /* Return character index. */ 245 else 246 p = addr (text.ch (cur_pos)); /* Return pointer to string. */ 247 cc = i - cur_pos; /* Return character count. */ 248 eof = 0; /* Turn off end-of-file switch. */ 249 cur_pos = i; /* Update current character position. */ 250 251 return; 252 253 254 /* */ 255 256 /* PARSE_FILE_PTR - Return Pointer to Atom. 257* 258* Calling Sequence: 259* call parse_file_ptr (p, cc, break, eof); 260* 261* Where: 262* p = pointer to atom (with bit offset) 263* 264**/ 265 266 parse_file_ptr: entry (p, cc, break, eof); 267 268 269 sw = 1; /* Set switch. */ 270 go to loop; /* Enter main scanning loop. */ 271 272 273 /* */ 274 275 /* PARSE_FILE_CUR_LINE - Return Current Line Being Scanned. 276* 277* Calling Sequence: 278* call parse_file_cur_line (ci, cc); 279* 280**/ 281 282 parse_file_cur_line: entry (ci, cc); 283 284 285 do i = cur_pos to msl while (text.ch (i) ^= NL); 286 /* Scan to end of file or NL. */ 287 end; 288 289 ci = cur_nl + 1; /* Return index to beginning of line. */ 290 cc = min (i, msl) - cur_nl + 1; /* Return correct character count. */ 291 292 return; 293 294 295 /* */ 296 297 /* PARSE_FILE_LINE_NO - Return the current line number in text. 298* 299* Calling sequence: 300* call parse_file_line_no (ci); 301* 302* Where: 303* ci = current line number (returned) 304* 305**/ 306 307 parse_file_line_no: entry (ci); 308 309 310 ci = line_no; /* This is a complicated entry. */ 311 return; /* Isn't it? */ 312 313 314 315 /* */ 316 317 /* PARSE_FILE_INIT - Initialize Program. 318* 319* Calling Sequence: 320* call parse_file_init (name, p, code); 321* 322* Where: 323* name = name of segment to be examined 324* p = pointer to segment (returned) 325* code = error code 326* 327**/ 328 329 parse_file_init: entry (name, p, code); 330 331 332 code = 0; /* Clear the error code. */ 333 334 call expand_pathname_ (name, dname, ename, code); 335 /* Convert segment name. */ 336 if code ^= 0 then do; /* Test for error. */ 337 error: call com_err_ (code, "parse_file_", name); /* Print error message. */ 338 return; 339 end; 340 341 call hcs_$initiate_count (dname, ename, "", bitcnt, 0, segp, code); 342 if segp = null then go to error; /* Test for null pointer returned. */ 343 code = 0; /* Clear any residual error code. */ 344 345 p = segp; /* Return pointer to segment. */ 346 msl = divide (bitcnt, 9, 18, 0) - 1; /* Compute character count from bit count. */ 347 348 go to common; 349 350 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1631.7 parse_file_.pl1 >dumps>old>recomp>parse_file_.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. NL 001070 constant char(1) initial unaligned dcl 31 ref 201 211 285 addr builtin function dcl 44 ref 245 bit 000016 internal static bit(1) array level 2 packed unaligned dcl 34 set ref 80* 83* 138* 229 bitcnt 000100 automatic fixed bin(24,0) dcl 37 set ref 68* 73 341* 346 break parameter fixed bin(1,0) dcl 178 set ref 176 238* 240* 266 break_table 000016 internal static structure level 1 dcl 34 c1 000165 automatic char(1) unaligned dcl 182 set ref 137* 138 197* 199 201 208 228* 229 231 cc parameter fixed bin(17,0) dcl 104 set ref 102 108 176 247* 266 282 290* ch based char(1) array level 2 packed unaligned dcl 185 set ref 197 208 211 212 212 228 231 245 285 ci parameter fixed bin(17,0) dcl 178 set ref 176 243* 282 289* 307 310* code parameter fixed bin(35,0) dcl 20 set ref 18 66* 68* 70* 329 332* 334* 336 337* 341* 343* com_err_ 000026 constant entry external dcl 46 ref 337 cs parameter char unaligned dcl 128 ref 126 135 137 154 cur_nl 000013 internal static fixed bin(17,0) dcl 24 set ref 75* 202* 289 290 cur_pos 000012 internal static fixed bin(17,0) dcl 24 set ref 75* 191 197 200* 200 202 208 208 210 216* 226 235 237 243 245 247 249* 285 dir parameter char unaligned dcl 37 set ref 18 68* divide builtin function dcl 44 ref 73 346 dname 000102 automatic char(168) unaligned dcl 37 set ref 334* 341* ename 000154 automatic char(32) unaligned dcl 37 set ref 334* 341* entry parameter char unaligned dcl 37 set ref 18 68* eof parameter fixed bin(1,0) dcl 178 set ref 176 193* 248* 266 expand_pathname_ 000022 constant entry external dcl 46 ref 334 fixed builtin function dcl 44 ref 138 229 hcs_$initiate_count 000024 constant entry external dcl 46 ref 68 341 i 000101 automatic fixed bin(17,0) dcl 37 set ref 79* 80* 82* 83* 135* 137* 210* 211 212 212* 216 226* 228 231* 235 237* 247 249 285* 285* 290 line_no 000014 internal static fixed bin(17,0) dcl 24 set ref 77* 203* 203 211* 211 310 min builtin function dcl 44 ref 290 msl 000015 internal static fixed bin(17,0) dcl 24 set ref 73* 108* 191 208 210 226 285 290 346* name parameter char unaligned dcl 20 set ref 329 334* 337* null builtin function dcl 44 ref 69 342 p parameter pointer dcl 20 set ref 18 72* 102 107 245* 266 329 345* segp 000010 internal static pointer dcl 24 set ref 68* 69 72 107* 197 208 211 212 212 228 231 245 285 341* 342 345 setting 000164 automatic bit(1) unaligned dcl 130 set ref 133* 138 157* substr builtin function dcl 44 ref 137 sw 000166 automatic fixed bin(1,0) dcl 182 set ref 189* 243 269* text based structure level 1 dcl 185 unspec builtin function dcl 44 ref 138 229 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. index builtin function dcl 44 NAMES DECLARED BY EXPLICIT CONTEXT. break_found 000542 constant label dcl 235 ref 229 231 break_search 000505 constant label dcl 226 common 000131 constant label dcl 75 ref 110 348 end_comment 000502 constant label dcl 216 ref 212 error 000761 constant label dcl 337 ref 342 loop 000407 constant label dcl 191 ref 205 218 270 parse_file_ 000401 constant entry external dcl 176 parse_file_$parse_file_init_name 000026 constant entry external dcl 18 parse_file_cur_line 000624 constant entry external dcl 282 parse_file_init 000707 constant entry external dcl 329 parse_file_init_ptr 000262 constant entry external dcl 102 parse_file_line_no 000671 constant entry external dcl 307 parse_file_ptr 000605 constant entry external dcl 266 parse_file_set_break 000306 constant entry external dcl 126 parse_file_unset_break 000357 constant entry external dcl 154 set 000323 constant label dcl 135 ref 158 seteof 000413 constant label dcl 193 ref 215 NAME DECLARED BY CONTEXT OR IMPLICATION. length builtin function ref 135 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1264 1314 1073 1274 Length 1524 1073 30 174 170 12 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME parse_file_$parse_file_init_name 180 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 segp parse_file_$parse_file_init_name 000012 cur_pos parse_file_$parse_file_init_name 000013 cur_nl parse_file_$parse_file_init_name 000014 line_no parse_file_$parse_file_init_name 000015 msl parse_file_$parse_file_init_name 000016 break_table parse_file_$parse_file_init_name STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME parse_file_$parse_file_init_name 000100 bitcnt parse_file_$parse_file_init_name 000101 i parse_file_$parse_file_init_name 000102 dname parse_file_$parse_file_init_name 000154 ename parse_file_$parse_file_init_name 000164 setting parse_file_$parse_file_init_name 000165 c1 parse_file_$parse_file_init_name 000166 sw parse_file_$parse_file_init_name THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc return ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ expand_pathname_ hcs_$initiate_count NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000021 66 000053 68 000054 69 000115 70 000122 72 000123 73 000125 75 000131 77 000134 79 000136 80 000144 81 000151 82 000212 83 000221 84 000226 86 000255 102 000256 107 000272 108 000276 110 000302 126 000303 133 000321 135 000323 137 000336 138 000344 140 000352 142 000354 154 000355 157 000372 158 000373 176 000374 189 000406 191 000407 193 000413 194 000416 197 000417 199 000424 200 000430 201 000431 202 000433 203 000435 205 000436 208 000437 210 000447 211 000460 212 000471 214 000477 215 000501 216 000502 218 000504 226 000505 228 000514 229 000522 231 000530 233 000540 235 000542 237 000546 238 000551 239 000554 240 000555 243 000557 245 000565 247 000571 248 000574 249 000575 251 000577 266 000600 269 000615 270 000617 282 000620 285 000631 287 000647 289 000651 290 000656 292 000665 307 000666 310 000676 311 000702 329 000703 332 000727 334 000730 336 000757 337 000761 338 001010 341 001011 342 001053 343 001060 345 001061 346 001063 348 001067 ----------------------------------------------------------- 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