COMPILATION LISTING OF SEGMENT dfast_edit_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1554.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 dfast_edit_: proc (request, arg_string, edit_info_ptr, code); 7 8 /* This procedure handles all the command level edit functions. It uses these values for request: 9* * 10* * (1) append Append the alter segment onto the end of the current segment (no sort) 11* * (2) sort Merge the alter and current segment and sort. 12* * (3) list List the alter or current segments, or merge and then list 13* * (4) list (no header) Same as list, except the header is not printed. 14* * (5) build Add the string to the current segment. 15* * (6) alter Add the string to the alter segment. 16* * (7) length Merge the temporary segments and print the length. 17* * (9) merge Merge current and alter segments. 18**/ 19 20 dcl request fixed bin; 21 dcl arg_string char (*); 22 dcl edit_info_ptr ptr; /* ptr to FAST data base */ 23 dcl code fixed bin (35); /* error code */ 24 25 dcl len fixed bin (21); 26 dcl buffer char (max_seg_size) based; /* for moving segments */ 27 dcl s char (1); /* for length message */ 28 29 dcl (divide, length, substr) builtin; 30 31 /* constants */ 32 33 dcl edit_name (9) char (6) int static options (constant) init ( 34 "append", 35 "sort", 36 "list", 37 "list", 38 "build", 39 "alter", 40 "length", 41 "edit", 42 "merge"); 43 dcl APPEND fixed bin int static options (constant) init (1); 44 dcl SORT fixed bin int static options (constant) init (2); 45 dcl LIST fixed bin int static options (constant) init (3); 46 dcl LISTNH fixed bin int static options (constant) init (4); 47 dcl BUILD fixed bin int static options (constant) init (5); 48 dcl ALTER fixed bin int static options (constant) init (6); 49 dcl LENGTH fixed bin int static options (constant) init (7); 50 dcl MERGE fixed bin int static options (constant) init (9); 51 52 /* external */ 53 54 dcl iox_$user_output ptr ext static; 55 dcl dfast_error_ entry (fixed bin (35), char (*), char (*)); 56 dcl dfast_merge_ entry (bit (1) unal, ptr, fixed bin (35)); 57 dcl dfast_header_ entry (char (*), char (*)); 58 dcl message_ entry (fixed bin (35), char (*), char (*)); 59 dcl ioa_ entry options (variable); 60 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 61 1 1 /* BEGIN INCLUDE FILE -- dfast_edit_info.incl.pl1 1 2* written 5/75 by S.E.Barr 1 3**/ 1 4 dcl 1 dfast_edit_info aligned based (edit_info_ptr), 1 5 2 flags aligned, 1 6 3 brief_mode bit (1) unal, /* ON if short messages to be used */ 1 7 3 build_mode bit (1) unal, /* On if in build mode */ 1 8 3 source_segment bit (1) unal, /* ON if segment is source */ 1 9 3 edit_done bit (1) unal, /* ON if current segment has been edited since save */ 1 10 3 basic_system bit (1) unal, /* ON if basic, OFF if fortran */ 1 11 3 caps_mode bit (1) unal, /* ON if running in CAPS mode */ 1 12 3 dbasic bit (1) unal, /* ON if double prec basic */ 1 13 3 pad bit (29) unal, 1 14 2 system_info aligned, 1 15 3 max_seg_size fixed bin (21), /* maximum segment size in characters */ 1 16 3 user_name char (32) aligned, /* person id */ 1 17 3 tty_id char (6) unal, /* terminal id of the form "ttynnn" */ 1 18 3 current_name char (256) var aligned, /* name of current segment */ 1 19 3 current_length fixed bin (21), /* length in characters of current segment */ 1 20 3 alter_length fixed bin (21), /* length in characters of the alter segment */ 1 21 3 current_ptr ptr, /* ptr to current segment */ 1 22 3 alter_ptr ptr, 1 23 3 home_dir char (168) var, /* home directory from pit */ 1 24 3 user_id char (32) var, /* login id */ 1 25 3 project_id char (32) var, /* login home directory */ 1 26 3 source_directory char (168) aligned, /* directory of where the source was. For COMPILE. */ 1 27 3 source_entryname char (32); /* name of the source. For COMPILE. */ 1 28 1 29 /* END INCLUDE FILE -- dfast_edit_info.incl.pl1 */ 62 63 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 */ 64 65 /* */ 66 if ^source_segment & request ^= LENGTH then code = error_obj_nop; 67 68 else do; 69 70 /* append: The alter segment is appended to the end of the current segment. No editing is done. */ 71 72 if request = APPEND then do; 73 if alter_length = 0 then code = error_alt_empty; 74 else do; 75 len = current_length + alter_length; 76 if len > max_seg_size then code = error_max_size; 77 else do; 78 substr (current_ptr -> buffer, current_length + 1, alter_length) = alter_ptr -> buffer; 79 current_length = len; 80 alter_length = 0; 81 edit_done = "1"b; 82 end; 83 end; 84 end; 85 86 else if request = SORT then do; 87 call dfast_merge_ ("1"b, edit_info_ptr, code); 88 end; 89 90 /* list: If no segment is specified, then the current and alter segment are merged and the resultant 91* current segment is listed. If a line number was given, the segment is listed beginning with the first line 92* equal or greater than that line. 93**/ 94 else if request = LIST | request = LISTNH then do; 95 if arg_string = "alt" then do; 96 if alter_length = 0 then code = error_alt_empty; 97 else do; 98 if request = LIST then call dfast_header_ ("alter", ""); 99 call iox_$put_chars (iox_$user_output, alter_ptr, alter_length, code); 100 end; 101 end; 102 103 else do; 104 if arg_string ^= "cur" then do; 105 if alter_length > 0 then call dfast_merge_ ("0"b, edit_info_ptr, code); 106 if code ^= 0 then return; 107 end; 108 if current_length = 0 then code = error_cur_empty; 109 else do; 110 if request = LIST then call dfast_header_ ((current_name), ""); 111 call iox_$put_chars (iox_$user_output, current_ptr, current_length, code); 112 end; 113 end; 114 end; 115 116 /* build: The line is appended to the current segment. No editing is done. */ 117 118 else if request = BUILD then do; 119 len = length (arg_string); 120 if len + current_length > max_seg_size then do; 121 build_mode = "0"b; 122 code = error_max_size; 123 end; 124 else do; 125 substr (current_ptr -> buffer, current_length + 1, len) = arg_string; 126 current_length = current_length + len; 127 edit_done = "1"b; 128 end; 129 end; 130 131 /* alter: the line is appended to the alter file. No editing is done. */ 132 133 else if request = ALTER then do; 134 len = length (arg_string); 135 if alter_length + len > max_seg_size then code = error_max_size; 136 else do; 137 substr (alter_ptr -> buffer, alter_length + 1, len) = arg_string; 138 alter_length = alter_length + len; 139 end; 140 end; 141 142 /* length: If the alter segment is not empty, the current and alter segments are merged. The length of the resultent 143* segment is printed. If the segments can't be merged, an error 144* message is printed and an error return is made. 145**/ 146 else if request = LENGTH then do; 147 if alter_length > 0 then do; 148 call dfast_merge_ ("0"b, edit_info_ptr, code); 149 if code ^= 0 then return; 150 end; 151 if current_length = 0 then s = "s"; 152 else if current_length <= 4096 then s = ""; /* no. of characters in one record */ 153 else s = "s"; 154 call ioa_ ("""^a"" length = ^d words (^d record^a)", current_name, divide (current_length, 4, 17), 155 divide (current_length + 4095, 4096, 17, 0), s); 156 end; 157 158 else if request = MERGE then do; 159 if alter_length > 0 then call dfast_merge_ ("0"b, edit_info_ptr, code); 160 end; 161 end; 162 163 if code ^= 0 then call dfast_error_ (code, edit_name (request), (current_name)); 164 return; 165 end dfast_edit_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1552.3 dfast_edit_.pl1 >spec>on>comp-dir>dfast_edit_.pl1 62 1 03/27/82 0439.4 dfast_edit_info.incl.pl1 >ldd>include>dfast_edit_info.incl.pl1 64 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. ALTER constant fixed bin(17,0) initial dcl 48 ref 133 APPEND constant fixed bin(17,0) initial dcl 43 ref 72 BUILD constant fixed bin(17,0) initial dcl 47 ref 118 LENGTH constant fixed bin(17,0) initial dcl 49 ref 66 146 LIST constant fixed bin(17,0) initial dcl 45 ref 94 98 110 LISTNH constant fixed bin(17,0) initial dcl 46 ref 94 MERGE constant fixed bin(17,0) initial dcl 50 ref 158 SORT constant fixed bin(17,0) initial dcl 44 ref 86 alter_length 117 based fixed bin(21,0) level 3 dcl 1-4 set ref 73 75 78 80* 96 99* 105 135 137 138* 138 147 159 alter_ptr 122 based pointer level 3 dcl 1-4 set ref 78 99* 137 arg_string parameter char unaligned dcl 21 ref 6 95 104 119 125 134 137 buffer based char unaligned dcl 26 set ref 78* 78 125* 137* build_mode 0(01) based bit(1) level 3 packed unaligned dcl 1-4 set ref 121* code parameter fixed bin(35,0) dcl 23 set ref 6 66* 73* 76* 87* 96* 99* 105* 106 108* 111* 122* 135* 148* 149 159* 163 163* current_length 116 based fixed bin(21,0) level 3 dcl 1-4 set ref 75 78 79* 108 111* 120 125 126* 126 151 152 154 154 154 154 current_name 15 based varying char(256) level 3 dcl 1-4 set ref 110 154* 163 current_ptr 120 based pointer level 3 dcl 1-4 set ref 78 111* 125 dfast_edit_info based structure level 1 dcl 1-4 dfast_error_ 000012 constant entry external dcl 55 ref 163 dfast_header_ 000016 constant entry external dcl 57 ref 98 110 dfast_merge_ 000014 constant entry external dcl 56 ref 87 105 148 159 divide builtin function dcl 29 ref 154 154 154 154 edit_done 0(03) based bit(1) level 3 packed unaligned dcl 1-4 set ref 81* 127* edit_info_ptr parameter pointer dcl 22 set ref 6 66 73 75 75 76 78 78 78 78 78 78 79 80 81 87* 96 99 99 105 105* 108 110 111 111 120 120 121 125 125 125 126 126 127 135 135 137 137 137 138 138 147 148* 151 152 154 154 154 154 154 159 159* 163 edit_name 000000 constant char(6) initial array unaligned dcl 33 set ref 163* error_alt_empty constant fixed bin(35,0) initial dcl 2-3 ref 73 96 error_cur_empty constant fixed bin(35,0) initial dcl 2-5 ref 108 error_max_size constant fixed bin(35,0) initial dcl 2-4 ref 76 122 135 error_obj_nop constant fixed bin(35,0) initial dcl 2-18 ref 66 flags based structure level 2 dcl 1-4 ioa_ 000020 constant entry external dcl 59 ref 154 iox_$put_chars 000022 constant entry external dcl 60 ref 99 111 iox_$user_output 000010 external static pointer dcl 54 set ref 99* 111* len 000100 automatic fixed bin(21,0) dcl 25 set ref 75* 76 79 119* 120 125 126 134* 135 137 138 length builtin function dcl 29 ref 119 134 max_seg_size 2 based fixed bin(21,0) level 3 dcl 1-4 ref 76 78 78 120 125 135 137 request parameter fixed bin(17,0) dcl 20 ref 6 66 72 86 94 94 98 110 118 133 146 158 163 s 000101 automatic char(1) unaligned dcl 27 set ref 151* 152* 153* 154* source_segment 0(02) based bit(1) level 3 packed unaligned dcl 1-4 ref 66 substr builtin function dcl 29 set ref 78* 125* 137* system_info 2 based structure level 2 dcl 1-4 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_access_mode internal static fixed bin(35,0) initial dcl 2-33 error_bad_line internal static fixed bin(35,0) initial dcl 2-28 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_sort internal static fixed bin(35,0) initial dcl 2-24 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_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_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_nl internal static fixed bin(35,0) initial dcl 2-23 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_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 message_ 000000 constant entry external dcl 58 NAME DECLARED BY EXPLICIT CONTEXT. dfast_edit_ 000053 constant entry external dcl 6 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 722 746 626 732 Length 1160 626 24 175 74 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfast_edit_ 112 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dfast_edit_ 000100 len dfast_edit_ 000101 s dfast_edit_ 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. dfast_error_ dfast_header_ dfast_merge_ ioa_ iox_$put_chars THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000046 66 000066 72 000101 73 000104 75 000112 76 000114 78 000121 79 000132 80 000134 81 000135 84 000137 86 000140 87 000142 88 000156 94 000157 95 000163 96 000171 98 000177 99 000220 101 000240 104 000241 105 000245 106 000264 108 000267 110 000277 111 000327 114 000350 118 000351 119 000353 120 000355 121 000361 122 000363 123 000365 125 000366 126 000377 127 000400 129 000402 133 000403 134 000405 135 000407 137 000416 138 000427 140 000430 146 000431 147 000433 148 000436 149 000452 151 000455 152 000465 153 000472 154 000474 156 000535 158 000536 159 000540 163 000557 164 000623 ----------------------------------------------------------- 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