COMPILATION LISTING OF SEGMENT linus_write Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 03/15/88 1553.9 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 9 10 /****^ HISTORY COMMENTS: 11* 1) change(88-01-27,Dupuis), approve(88-03-03,MCR7844), audit(88-03-14,Blair), 12* install(88-03-15,MR12.2-1036): 13* Implemented the -progress/-no_progress control arguments. 14* END HISTORY COMMENTS */ 15 16 17 /* format: off */ 18 19 /* This is the main level procedure called by ssu_ to implement the 20* linus write request. Description and usage follows. 21* 22* Description: 23* 24* This request retrieves the selected data from the data base and writes 25* it to a file. 26* 27* Usage: "write pathname {-control_args}" 28* 29* where pathname is the name of the file which will contain the data. 30* 31* -control_args can be: 32* 33* -column_delimiter X -- the delimiter used to separate column values. 34* X can be any single ascii character (default is one blank). The old 35* control arg -delimiter is still accepted but not documented. 36* 37* -extend -- the file is extended rather than truncated. 38* 39* -progress {N} -- prints a progress report every N tuples, where N defaults 40* to linus_data_$trace_every_n_tuples if not specified. 41* 42* -row_delimiter X -- the delimiter used to separate rows. X can be any 43* single ascii character (default is newline character). 44* 45* -truncate -- the file is truncated rather than extended (default). 46* 47* Both parameters are passed to this request by ssu_. 48* 49* 50* Known Bugs: 51* 52* Other Problems: 53* 54* History: 55* 56* Written - Al Dupuis - September 1983 - complete rewrite of old module. 57* 58**/ 59 60 linus_write: proc ( 61 62 sci_ptr_parm, /* input: ptr to the subsystem control info structure */ 63 lcb_ptr_parm /* input: ptr to the linus control block info structure */ 64 ); 65 66 dcl sci_ptr_parm ptr parm; 67 dcl lcb_ptr_parm ptr parm; 68 69 /* 70* Mainline Processing Overview: 71* 72* (1) Process control arguments setting flags and collecting values. 73* 74* (2) Have the subroutine do all the work (it reports errors and calls 75* ssu_$abort_line if things don't go well). 76* 77**/ 78 79 call initialize; 80 call process_args; 81 call linus_create_data_file (lcb_ptr, addr (data_file_info)); 82 83 return; 84 85 initialize: proc; 86 87 sci_ptr = sci_ptr_parm; 88 lcb_ptr = lcb_ptr_parm; 89 90 unspec (data_file_info) = OFF; 91 data_file_info.column_delimiter = BLANK; 92 data_file_info.row_delimiter = NEWLINE; 93 data_file_info.flags.truncate_file = ON; 94 data_file_info.trace_every_n_tuples = linus_data_$trace_every_n_tuples; 95 96 call ssu_$arg_count (sci_ptr, number_of_args_supplied); 97 if number_of_args_supplied = 0 98 then call ssu_$abort_line (sci_ptr, error_table_$noarg, 99 "An output file pathname must be supplied."); 100 101 call ssu_$arg_ptr (sci_ptr, 1, arg_ptr, arg_length); 102 data_file_info.output_file_pathname = arg; 103 104 return; 105 106 end initialize; 107 108 process_args: proc; 109 110 do current_arg_number = 2 to number_of_args_supplied; 111 112 call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length); 113 114 if arg = "-extend" 115 then data_file_info.flags.truncate_file = OFF; 116 else if arg = "-truncate" | arg = "-tc" 117 then data_file_info.flags.truncate_file = ON; 118 else if arg = "-no_progress" | arg = "-npg" 119 then do; 120 data_file_info.flags.tracing = OFF; 121 data_file_info.trace_every_n_tuples = linus_data_$trace_every_n_tuples; 122 end; 123 else if arg = "-progress" | arg = "-pg" 124 then call setup_tracing; 125 else if arg = "-column_delimiter" | arg = "-cdm" 126 | arg = "-delimiter" | arg = "-dm" | arg = "-row_delimiter" | arg = "-rdm" 127 then call setup_delimiter; 128 else call ssu_$abort_line (sci_ptr, error_table_$badopt, 129 "^a is not a valid control argument.", arg); 130 end; 131 132 return; 133 134 setup_delimiter: proc; 135 136 if current_arg_number + 1 > number_of_args_supplied 137 then call ssu_$abort_line (sci_ptr, error_table_$inconsistent, 138 "^/^[-row_delimiter^;-column_delimiter^] must be followed by a delimiter.", 139 (arg = "-row_delimiter" | arg = "-rdm")); 140 141 current_arg_number = current_arg_number + 1; 142 call ssu_$arg_ptr (sci_ptr, current_arg_number, arg_ptr, arg_length); 143 if arg_length ^= 1 144 then call ssu_$abort_line (sci_ptr, 0, 145 "The specified delimiter ""^a"" is not a single ascii character.", arg); 146 if (arg = "-row_delimiter" | arg = "-rdm") 147 then data_file_info.row_delimiter = arg; 148 else data_file_info.column_delimiter = arg; 149 150 return; 151 152 end setup_delimiter; 153 154 setup_tracing: proc; 155 156 data_file_info.tracing = ON; 157 158 if current_arg_number + 1 > number_of_args_supplied 159 then return; 160 161 call ssu_$arg_ptr (sci_ptr, current_arg_number + 1, arg_ptr, arg_length); 162 if verify (arg, "01234546789") = 0 163 then do; 164 data_file_info.trace_every_n_tuples = convert (data_file_info.trace_every_n_tuples, arg); 165 current_arg_number = current_arg_number + 1; 166 end; 167 168 return; 169 170 end setup_tracing; 171 172 end process_args; 173 174 dcl BLANK char (1) static internal options (constant) init (" "); 175 176 dcl NEWLINE char (1) static internal options (constant) init (" 177 "); 178 179 dcl OFF bit (1) aligned static internal options (constant) init ("0"b); 180 dcl ON bit (1) aligned static internal options (constant) init ("1"b); 181 182 dcl addr builtin; 183 dcl arg char (arg_length) based (arg_ptr); 184 dcl arg_length fixed bin (21); 185 dcl arg_ptr ptr; 186 187 dcl current_arg_number fixed bin; 188 189 dcl error_table_$badopt fixed bin(35) ext static; 190 dcl error_table_$inconsistent fixed bin(35) ext static; 191 dcl error_table_$noarg fixed bin(35) ext static; 192 193 dcl lcb_ptr ptr; 194 dcl linus_create_data_file entry (ptr, ptr); 195 dcl linus_data_$trace_every_n_tuples fixed bin (35) external static; 196 197 dcl number_of_args_supplied fixed bin; 198 199 dcl sci_ptr ptr; 200 dcl ssu_$abort_line entry() options(variable); 201 dcl ssu_$arg_count entry (ptr, fixed bin); 202 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21)); 203 204 dcl unspec builtin; 205 1 1 /* BEGIN INCLUDE FILE linus_data_file_info.incl.pl1 1 2* 1 3* Written - Al Dupuis - September 1983 1 4**/ 1 5 1 6 /****^ HISTORY COMMENTS: 1 7* 1) change(88-01-27,Dupuis), approve(88-03-03,MCR7844), 1 8* audit(88-03-14,Blair), install(88-03-15,MR12.2-1036): 1 9* Added the trace_every_n_tuples field and the tracing flag. 1 10* END HISTORY COMMENTS */ 1 11 1 12 /* format: off */ 1 13 1 14 dcl 1 create_columns_map aligned based (create_cm_ptr), 1 15 2 number_of_columns fixed bin, 1 16 2 column_numbers (create_columns_map_init_number_of_columns refer (create_columns_map.number_of_columns)) fixed bin; 1 17 dcl create_columns_map_init_number_of_columns fixed bin; 1 18 dcl create_cm_ptr ptr; 1 19 1 20 dcl 1 data_file_info aligned, 1 21 2 flags, 1 22 3 truncate_file bit (1) unaligned, /* ON means truncate */ 1 23 3 check_values_for_delimiters bit (1) unaligned, /* ON means to check */ 1 24 3 process_quotes bit (1) unaligned, /* ON means process quotes */ 1 25 3 process_whitespace bit (1) unaligned, /* ON means treat all whitespace as one blank */ 1 26 3 last_column_delimiter_is_optional bit (1) unaligned, /* ON means last column delimiter is optional */ 1 27 3 create_new_columns bit (1) unaligned, /* ON means create new columns */ 1 28 3 file_is_opened bit (1) unaligned, /* ON means file is opened */ 1 29 3 file_is_attached bit (1) unaligned, /* ON means file is attached */ 1 30 3 end_of_file_has_been_hit bit (1) unaligned, /* ON means we've already hit EOF */ 1 31 3 tracing bit (1) unaligned, /* ON means we need to give progress reports */ 1 32 3 available bit (26) unaligned, 1 33 2 current_row_number fixed bin (35), /* current row number in table */ 1 34 2 current_line_number fixed bin (35), /* current line number of file */ 1 35 2 current_char_in_buffer fixed bin (35), /* index of where we're about to start */ 1 36 2 current_char_in_previous_buffer fixed bin (35), /* index of where we left off in previous buffer */ 1 37 2 file_buffer_length fixed bin (21), /* length of file buffer in chars */ 1 38 2 trace_every_n_tuples fixed bin (35), /* print a progress report every n */ 1 39 2 create_columns_map_ptr ptr, /* points to create_columns_map structure */ 1 40 2 file_iocb_ptr ptr, /* points to iocb for file */ 1 41 2 file_buffer_ptr ptr, /* points to buffer for file */ 1 42 2 column_delimiter char (1) unaligned, /* a single ascii character */ 1 43 2 row_delimiter char (1) unaligned, /* a single ascii character */ 1 44 2 output_file_pathname char (168) unaligned, /* path of output file */ 1 45 2 entry_name char (32) unaligned, /* dir name where file is located */ 1 46 2 directory_name char (168) unaligned; /* entry name of file */ 1 47 1 48 /* END INCLUDE FILE linus_data_file_info.incl.pl1 */ 206 207 208 end linus_write; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/15/88 1551.4 linus_write.pl1 >spec>install>MR12.2-1036>linus_write.pl1 206 1 03/15/88 1550.1 linus_data_file_info.incl.pl1 >spec>install>MR12.2-1036>linus_data_file_info.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 constant char(1) initial packed unaligned dcl 174 ref 91 NEWLINE constant char(1) initial packed unaligned dcl 176 ref 92 OFF constant bit(1) initial dcl 179 ref 90 114 120 ON constant bit(1) initial dcl 180 ref 93 116 156 addr builtin function dcl 182 ref 81 81 arg based char packed unaligned dcl 183 set ref 102 114 116 116 118 118 123 123 125 125 125 125 125 125 128* 136 136 143* 146 146 146 148 162 164 arg_length 000100 automatic fixed bin(21,0) dcl 184 set ref 101* 102 112* 114 116 116 118 118 123 123 125 125 125 125 125 125 128 128 136 136 142* 143 143 143 146 146 146 148 161* 162 164 arg_ptr 000102 automatic pointer dcl 185 set ref 101* 102 112* 114 116 116 118 118 123 123 125 125 125 125 125 125 128 136 136 142* 143 146 146 146 148 161* 162 164 column_delimiter 16 000114 automatic char(1) level 2 packed packed unaligned dcl 1-20 set ref 91* 148* current_arg_number 000104 automatic fixed bin(17,0) dcl 187 set ref 110* 112* 136 141* 141 142* 158 161 165* 165 data_file_info 000114 automatic structure level 1 dcl 1-20 set ref 81 81 90* error_table_$badopt 000010 external static fixed bin(35,0) dcl 189 set ref 128* error_table_$inconsistent 000012 external static fixed bin(35,0) dcl 190 set ref 136* error_table_$noarg 000014 external static fixed bin(35,0) dcl 191 set ref 97* flags 000114 automatic structure level 2 dcl 1-20 lcb_ptr 000106 automatic pointer dcl 193 set ref 81* 88* lcb_ptr_parm parameter pointer dcl 67 ref 60 88 linus_create_data_file 000016 constant entry external dcl 194 ref 81 linus_data_$trace_every_n_tuples 000020 external static fixed bin(35,0) dcl 195 ref 94 121 number_of_args_supplied 000110 automatic fixed bin(17,0) dcl 197 set ref 96* 97 110 136 158 output_file_pathname 16(18) 000114 automatic char(168) level 2 packed packed unaligned dcl 1-20 set ref 102* row_delimiter 16(09) 000114 automatic char(1) level 2 packed packed unaligned dcl 1-20 set ref 92* 146* sci_ptr 000112 automatic pointer dcl 199 set ref 87* 96* 97* 101* 112* 128* 136* 142* 143* 161* sci_ptr_parm parameter pointer dcl 66 ref 60 87 ssu_$abort_line 000022 constant entry external dcl 200 ref 97 128 136 143 ssu_$arg_count 000024 constant entry external dcl 201 ref 96 ssu_$arg_ptr 000026 constant entry external dcl 202 ref 101 112 142 161 trace_every_n_tuples 6 000114 automatic fixed bin(35,0) level 2 dcl 1-20 set ref 94* 121* 164* 164 tracing 0(09) 000114 automatic bit(1) level 3 packed packed unaligned dcl 1-20 set ref 120* 156* truncate_file 000114 automatic bit(1) level 3 packed packed unaligned dcl 1-20 set ref 93* 114* 116* unspec builtin function dcl 204 set ref 90* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. create_cm_ptr automatic pointer dcl 1-18 create_columns_map based structure level 1 dcl 1-14 create_columns_map_init_number_of_columns automatic fixed bin(17,0) dcl 1-17 NAMES DECLARED BY EXPLICIT CONTEXT. initialize 000167 constant entry internal dcl 85 ref 79 linus_write 000144 constant entry external dcl 60 process_args 000276 constant entry internal dcl 108 ref 80 setup_delimiter 000470 constant entry internal dcl 134 ref 125 setup_tracing 000641 constant entry internal dcl 154 ref 123 NAMES DECLARED BY CONTEXT OR IMPLICATION. convert builtin function ref 164 verify builtin function ref 162 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1242 1272 1121 1252 Length 1476 1121 30 170 121 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_write 488 external procedure is an external procedure. initialize internal procedure shares stack frame of external procedure linus_write. process_args internal procedure shares stack frame of external procedure linus_write. setup_delimiter internal procedure shares stack frame of external procedure linus_write. setup_tracing internal procedure shares stack frame of external procedure linus_write. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_write 000100 arg_length linus_write 000102 arg_ptr linus_write 000104 current_arg_number linus_write 000106 lcb_ptr linus_write 000110 number_of_args_supplied linus_write 000112 sci_ptr linus_write 000114 data_file_info linus_write THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out return_mac ext_entry any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. linus_create_data_file ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$inconsistent error_table_$noarg linus_data_$trace_every_n_tuples LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 60 000140 79 000151 80 000152 81 000153 83 000166 85 000167 87 000170 88 000174 90 000177 91 000202 92 000204 93 000206 94 000210 96 000213 97 000223 101 000251 102 000270 104 000275 108 000276 110 000277 112 000307 114 000324 116 000335 118 000350 120 000360 121 000362 122 000365 123 000366 125 000400 128 000432 130 000465 132 000467 134 000470 136 000471 141 000543 142 000544 143 000561 146 000617 148 000635 150 000640 154 000641 156 000642 158 000644 161 000651 162 000671 164 000705 165 000715 168 000716 ----------------------------------------------------------- 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