COMPILATION LISTING OF SEGMENT dfast_get_table_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/19/88 1501.5 mst Tue Options: optimize map 1 dfast_get_table_: proc (convert, seg_ptr, seg_length, table_ptr, code); 2 3 /* * This procedure fills in the line table and checks the segment to be sure it is ordered. 4* * If the segment is out of order and convert is not set then an error code is set. 5* * Otherwise the table is set up and sorted so that the lines will be in order when copied. 6* * 7* * If the segment doesn't end with a new line it the characters following the last new line will 8* * be discarded. (The whole file if necessary). 9* * 10* * If lines do not begin with line numbers they will be deleted. 11* */ 12 13 dcl convert bit (1) unal; /* ON if illegal lines should be converted */ 14 dcl seg_ptr ptr; /* points to segment with source code */ 15 dcl seg_length fixed bin (21); /* number of characters in segment */ 16 dcl table_ptr ptr; /* points to table structure */ 17 dcl code fixed bin (35); 18 19 /* automatic */ 20 21 dcl seg_index fixed bin (21); /* seg_index from 1 on segment */ 22 dcl new_number fixed bin; 23 dcl last_num fixed bin; 24 dcl i fixed bin (21); 25 dcl sorted bit (1) unal; 26 dcl blank bit (1) unal; /* ON if line with just a number */ 27 dcl len fixed bin (21); 28 29 dcl 1 temp_line, 30 2 temp_num fixed bin (21), /* for moving lines around */ 31 2 temp_start fixed bin (21), 32 2 temp_num_chars fixed bin (21); 33 34 dcl (index, substr, verify) builtin; 35 36 /* external */ 37 38 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 39 40 /* constants */ 41 42 dcl new_line char (1) int static options (constant) init (" 43 "); 44 45 /* based */ 46 47 dcl seg char (seg_length) based (seg_ptr); 48 dcl 1 t aligned based (table_ptr) like dfast_line_table; 49 1 1 /* BEGIN ... dfast_line_table.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(87-12-03,TLNguyen), approve(87-12-03,MCR7806), 1 7* audit(87-12-10,Lippard), install(88-01-19,MR12.2-1015): 1 8* _ Replace the "dfast_line_table aligned based" with "dfast_line_table 1 9* aligned based (table_ptr)" and the "line (2)" array field with 1 10* "line (dfast_line_table.table_length)" to fixed subscript range 1 11* occured in the dfast_get_table_.pl1. 1 12* END HISTORY COMMENTS */ 1 13 1 14 1 15 dcl 1 dfast_line_table aligned based (table_ptr), 1 16 2 table_length fixed bin (21), 1 17 2 line (dfast_line_table.table_length), 1 18 3 number fixed bin, 1 19 3 start fixed bin (21), 1 20 3 num_chars fixed bin (21); 1 21 1 22 /* END INCLUDE ... dfast_line_table.incl.pl1 */ 50 2 1 /* BEGIN INCLUDE ... dfast_error_codes.incl.pl1 */ 2 2 2 3 dcl error_alt_empty fixed bin (35) int static init (1)options (constant); 2 4 dcl error_max_size fixed bin (35) int static init (2)options (constant); 2 5 dcl error_cur_empty fixed bin (35) int static init (3)options (constant); 2 6 dcl error_not_saved fixed bin (35) int static init (4)options (constant); 2 7 dcl error_name_dup fixed bin (35) int static init (5)options (constant); 2 8 dcl error_long_rec fixed bin (35) int static init (6)options (constant); 2 9 dcl error_unknown_arg fixed bin (35) int static init (7)options (constant); 2 10 dcl error_no_expl fixed bin (35) int static init (8)options (constant); 2 11 dcl error_bad_name fixed bin (35) int static init (9)options (constant); 2 12 dcl error_bad_req fixed bin (35) int static init (10)options (constant); 2 13 dcl error_syntax_string fixed bin (35) int static init (11)options (constant); 2 14 dcl error_name_miss fixed bin (35) int static init (12)options (constant); 2 15 dcl error_no_comp fixed bin (35) int static init (13)options (constant); 2 16 dcl error_no_main fixed bin (35) int static init (14)options (constant); 2 17 dcl error_block_spec fixed bin (35) int static init (15)options (constant); 2 18 dcl error_obj_nop fixed bin (35) int static init (16)options (constant); 2 19 dcl error_sav_cur fixed bin (35) int static init (17)options (constant); 2 20 dcl error_bad_type fixed bin (35) int static init (18)options (constant); 2 21 dcl error_unkn_sys fixed bin (35) int static init (19)options (constant); 2 22 dcl error_no_suffix fixed bin (35) int static init (20)options (constant); 2 23 dcl error_no_nl fixed bin (35) int static init (21)options (constant); 2 24 dcl error_bad_sort fixed bin (35) int static init (22)options (constant); 2 25 dcl error_no_num fixed bin (35) int static init (23)options (constant); 2 26 dcl error_line_miss fixed bin (35) int static init (24)options (constant); 2 27 dcl error_request_miss fixed bin (35) int static init (25)options (constant); 2 28 dcl error_bad_line fixed bin (35) int static init (26)options (constant); 2 29 dcl error_no_string fixed bin (35) int static init (27)options (constant); 2 30 dcl error_line_order fixed bin (35) int static init (28)options (constant); 2 31 dcl error_max_lines fixed bin (35) int static init (29)options (constant); 2 32 dcl error_bad_pathname fixed bin (35) int static init (30)options (constant); 2 33 dcl error_access_mode fixed bin (35) int static init (31)options (constant); 2 34 dcl error_delimiter_miss fixed bin (35) int static init (32)options (constant); 2 35 dcl error_size_fixed_record fixed bin (35) int static init (33)options (constant); 2 36 dcl error_bad_rec_len fixed bin (35) int static init (34)options (constant); 2 37 dcl error_string_size fixed bin (35) int static init (35)options (constant); 2 38 dcl error_max_line_number fixed bin (35) int static init (36)options (constant); 2 39 dcl error_max_args fixed bin (35) int static init (37)options (constant); 2 40 dcl error_name_sys fixed bin (35) int static init (38)options (constant); 2 41 dcl error_dprint_map fixed bin (35) int static init (39)options (constant); 2 42 dcl error_max_num fixed bin (35) int static options (constant) init (40); 2 43 dcl error_edit_max_num fixed bin (35) int static options (constant) init (41); 2 44 dcl error_un_num_text fixed bin (35) int static options (constant) init (42); 2 45 dcl error_no_new_line fixed bin (35) int static options (constant) init (43); 2 46 2 47 /* END INCLUDE ... dfast_error_codes.incl.pl1 */ 51 52 53 /* */ 54 last_num = -1; 55 seg_index = 1; 56 sorted = "1"b; 57 t.table_length = 0; 58 59 do while (seg_index <= seg_length); 60 61 len = index (substr (seg, seg_index, seg_length - seg_index + 1), new_line); 62 if len = 0 then do; 63 if convert then seg_index = seg_length + 1; /* discard line fragment */ 64 else code = error_no_nl; 65 end; 66 67 else do; 68 if get_number (substr (seg, seg_index, len), new_number, blank, code) then do; 69 if new_number > last_num then t.table_length = t.table_length +1; 70 71 else do; 72 if ^convert then code = error_bad_sort; 73 74 /* If the lines have the same number the index is not incremented and so the earlier line is ignored. */ 75 76 else do; 77 if new_number < last_num then do; 78 t.table_length = t.table_length +1; 79 sorted = "0"b; 80 end; 81 end; 82 end; 83 84 if code = 0 then do; 85 t.line (t.table_length).number = new_number; 86 t.line (t.table_length).start = seg_index; 87 if blank then t.line (t.table_length).num_chars = 0; 88 else t.line (t.table_length).num_chars = len; 89 end; 90 last_num = new_number; 91 end; 92 end; 93 if code ^= 0 then do; 94 call dfast_error_ (code, "sort", substr (seg, seg_index, len)); 95 return; 96 end; 97 seg_index = seg_index + len; 98 end; 99 100 101 do i = 1 to t.table_length -1 while (^sorted); 102 sorted = "1"b; 103 do seg_index = 1 to t.table_length -i; 104 if t.line (seg_index).number > t.line (seg_index+1).number then do; 105 sorted = "0"b; 106 temp_line = t.line (seg_index); 107 t.line (seg_index) = t.line (seg_index+1); 108 t.line (seg_index+1) = temp_line; 109 end; 110 111 else if t.line (seg_index).number = t.line (seg_index +1).number then t.line (seg_index).num_chars = 0; 112 end; 113 end; 114 115 return; 116 117 /* */ 118 /* This procedure is given a string of characters ending with a new_line character. 119* It returns the line number of the line and if it is a blank line. A blank line 120* contains a line number followed by a new_line character. If the line contains blanks or tabs it is 121* not considered blank. 122* If convert is 0 then code is set. 123**/ 124 get_number: proc (string, number, blank, code) returns (bit (1) unal); 125 126 dcl string char (*); 127 dcl number fixed bin; 128 dcl blank bit (1) unal; /* On if the line only contains a number */ 129 dcl code fixed bin (35); 130 131 dcl fst_cv_line_num_ entry (char (*), fixed bin, fixed bin (35)) returns (bit (1) unal); 132 133 dcl i fixed bin (21); 134 135 i = verify (string, "0123456789"); 136 if i = 1 then code = error_bad_line; 137 else do; 138 if fst_cv_line_num_ (substr (string, 1, i-1), number, code) then do; 139 if substr (string, i, 1) = new_line then blank = "1"b; 140 else blank = "0"b; 141 return ("1"b); 142 end; 143 end; 144 145 if convert then code = 0; 146 return ("0"b); 147 148 end get_number; 149 end dfast_get_table_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/19/88 1501.5 dfast_get_table_.pl1 >spec>install>MR12.2-1015>dfast_get_table_.pl1 50 1 01/19/88 1501.5 dfast_line_table.incl.pl1 >spec>install>MR12.2-1015>dfast_line_table.incl.pl1 51 2 03/27/82 0439.4 dfast_error_codes.incl.pl1 >ldd>include>dfast_error_codes.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. blank 000105 automatic bit(1) unaligned dcl 26 in procedure "dfast_get_table_" set ref 68* 87 blank parameter bit(1) unaligned dcl 128 in procedure "get_number" set ref 124 139* 140* code parameter fixed bin(35,0) dcl 129 in procedure "get_number" set ref 124 136* 138* 145* code parameter fixed bin(35,0) dcl 17 in procedure "dfast_get_table_" set ref 1 64* 68* 72* 84 93 94* convert parameter bit(1) unaligned dcl 13 ref 1 63 72 145 dfast_error_ 000010 constant entry external dcl 38 ref 94 dfast_line_table based structure level 1 dcl 1-15 error_bad_line constant fixed bin(35,0) initial dcl 2-28 ref 136 error_bad_sort constant fixed bin(35,0) initial dcl 2-24 ref 72 error_no_nl constant fixed bin(35,0) initial dcl 2-23 ref 64 fst_cv_line_num_ 000012 constant entry external dcl 131 ref 138 i 000100 automatic fixed bin(21,0) dcl 133 in procedure "get_number" set ref 135* 136 138 138 139 i 000103 automatic fixed bin(21,0) dcl 24 in procedure "dfast_get_table_" set ref 101* 103* index builtin function dcl 34 ref 61 last_num 000102 automatic fixed bin(17,0) dcl 23 set ref 54* 69 77 90* len 000106 automatic fixed bin(21,0) dcl 27 set ref 61* 62 68 68 88 94 94 97 line 1 based structure array level 2 dcl 48 set ref 106 107* 107 108* new_line 000721 constant char(1) initial unaligned dcl 42 ref 61 139 new_number 000101 automatic fixed bin(17,0) dcl 22 set ref 68* 69 77 85 90 num_chars 3 based fixed bin(21,0) array level 3 dcl 48 set ref 87* 88* 111* number parameter fixed bin(17,0) dcl 127 in procedure "get_number" set ref 124 138* number 1 based fixed bin(17,0) array level 3 in structure "t" dcl 48 in procedure "dfast_get_table_" set ref 85* 104 104 111 111 seg based char unaligned dcl 47 ref 61 68 68 94 94 seg_index 000100 automatic fixed bin(21,0) dcl 21 set ref 55* 59 61 61 63* 68 68 86 94 94 97* 97 103* 104 104 106 106 106 107 107 108 108 108 111 111 111* seg_length parameter fixed bin(21,0) dcl 15 ref 1 59 61 61 63 68 68 94 94 seg_ptr parameter pointer dcl 14 ref 1 61 68 68 94 94 sorted 000104 automatic bit(1) unaligned dcl 25 set ref 56* 79* 101 102* 105* start 2 based fixed bin(21,0) array level 3 dcl 48 set ref 86* string parameter char unaligned dcl 126 ref 124 135 138 138 139 substr builtin function dcl 34 ref 61 68 68 94 94 138 138 139 t based structure level 1 dcl 48 table_length based fixed bin(21,0) level 2 dcl 48 set ref 57* 69* 69 78* 78 85 86 87 88 101 103 table_ptr parameter pointer dcl 16 ref 1 57 69 69 78 78 85 85 86 86 87 87 88 88 101 103 104 104 106 107 107 108 111 111 111 temp_line 000107 automatic structure level 1 unaligned dcl 29 set ref 106* 108 verify builtin function dcl 34 ref 135 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_access_mode internal static fixed bin(35,0) initial dcl 2-33 error_alt_empty internal static fixed bin(35,0) initial dcl 2-3 error_bad_name internal static fixed bin(35,0) initial dcl 2-11 error_bad_pathname internal static fixed bin(35,0) initial dcl 2-32 error_bad_rec_len internal static fixed bin(35,0) initial dcl 2-36 error_bad_req internal static fixed bin(35,0) initial dcl 2-12 error_bad_type internal static fixed bin(35,0) initial dcl 2-20 error_block_spec internal static fixed bin(35,0) initial dcl 2-17 error_cur_empty internal static fixed bin(35,0) initial dcl 2-5 error_delimiter_miss internal static fixed bin(35,0) initial dcl 2-34 error_dprint_map internal static fixed bin(35,0) initial dcl 2-41 error_edit_max_num internal static fixed bin(35,0) initial dcl 2-43 error_line_miss internal static fixed bin(35,0) initial dcl 2-26 error_line_order internal static fixed bin(35,0) initial dcl 2-30 error_long_rec internal static fixed bin(35,0) initial dcl 2-8 error_max_args internal static fixed bin(35,0) initial dcl 2-39 error_max_line_number internal static fixed bin(35,0) initial dcl 2-38 error_max_lines internal static fixed bin(35,0) initial dcl 2-31 error_max_num internal static fixed bin(35,0) initial dcl 2-42 error_max_size internal static fixed bin(35,0) initial dcl 2-4 error_name_dup internal static fixed bin(35,0) initial dcl 2-7 error_name_miss internal static fixed bin(35,0) initial dcl 2-14 error_name_sys internal static fixed bin(35,0) initial dcl 2-40 error_no_comp internal static fixed bin(35,0) initial dcl 2-15 error_no_expl internal static fixed bin(35,0) initial dcl 2-10 error_no_main internal static fixed bin(35,0) initial dcl 2-16 error_no_new_line internal static fixed bin(35,0) initial dcl 2-45 error_no_num internal static fixed bin(35,0) initial dcl 2-25 error_no_string internal static fixed bin(35,0) initial dcl 2-29 error_no_suffix internal static fixed bin(35,0) initial dcl 2-22 error_not_saved internal static fixed bin(35,0) initial dcl 2-6 error_obj_nop internal static fixed bin(35,0) initial dcl 2-18 error_request_miss internal static fixed bin(35,0) initial dcl 2-27 error_sav_cur internal static fixed bin(35,0) initial dcl 2-19 error_size_fixed_record internal static fixed bin(35,0) initial dcl 2-35 error_string_size internal static fixed bin(35,0) initial dcl 2-37 error_syntax_string internal static fixed bin(35,0) initial dcl 2-13 error_un_num_text internal static fixed bin(35,0) initial dcl 2-44 error_unkn_sys internal static fixed bin(35,0) initial dcl 2-21 error_unknown_arg internal static fixed bin(35,0) initial dcl 2-9 NAMES DECLARED BY EXPLICIT CONTEXT. dfast_get_table_ 000021 constant entry external dcl 1 get_number 000361 constant entry internal dcl 124 ref 68 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 776 1012 722 1006 Length 1222 722 14 174 53 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_get_table_ 104 external procedure is an external procedure. get_number 90 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dfast_get_table_ 000100 seg_index dfast_get_table_ 000101 new_number dfast_get_table_ 000102 last_num dfast_get_table_ 000103 i dfast_get_table_ 000104 sorted dfast_get_table_ 000105 blank dfast_get_table_ 000106 len dfast_get_table_ 000107 temp_line dfast_get_table_ get_number 000100 i get_number THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_int_this_desc return_mac shorten_stack ext_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. dfast_error_ fst_cv_line_num_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 000014 54 000026 55 000030 56 000032 57 000034 59 000037 61 000044 62 000063 63 000064 64 000075 65 000077 68 000100 69 000141 72 000151 77 000162 78 000164 79 000166 84 000167 85 000171 86 000200 87 000202 88 000211 90 000216 93 000220 94 000223 95 000260 97 000262 98 000264 101 000265 102 000301 103 000303 104 000315 105 000326 106 000327 107 000334 108 000342 109 000350 111 000351 112 000353 113 000355 115 000357 124 000360 135 000374 136 000410 138 000415 139 000454 140 000471 141 000475 145 000502 146 000513 ----------------------------------------------------------- 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