COMPILATION LISTING OF SEGMENT io_call_read_write_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 02/27/84 1337.2 mst Mon 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 /* This module does the put_chars, write_record, rewrite_record, get_chars, 12* get_line, and read_record functions of the io_call command. */ 13 /* Removed from main command June 1977 by Larry Johnson, and made to work as an active function */ 14 /* Modified 08/03/83 by Jim Lippard to not require specification of buffer 15* length, to not complain about short records when called as an AF, 16* to add a -string control argument for output requests, to print 17* the right information in error messages, and to fix write_record 18* and rewrite_record to leave things alone when -segment is used without 19* -nl or -nnl */ 20 /* Modified 12/13/83 by Jim Lippard to add -allow_newline (-alnl), 21* -append_newline (-apnl), and -remove_newline (-rmnl) and to 22* not require buffer length for read_record */ 23 24 io_call_read_write_: proc; 25 26 /* Parameters */ 27 28 dcl arg_iocb_ptr ptr; /* Pointer to the IOCB */ 29 dcl arg_arg_list_ptr ptr; /* Pointer to the commands argument list */ 30 31 /* Automatic storage */ 32 33 dcl code fixed bin (35); /* System status code */ 34 dcl arg_list_ptr ptr; /* Pointer to argument list */ 35 dcl arg_ptr ptr; /* Pointer to current argument */ 36 dcl arg_len fixed bin; /* Length of current argument */ 37 dcl n_args fixed bin; /* Number of arguments on command line */ 38 dcl next_arg fixed bin; /* Used in counting args */ 39 dcl dir char (168); /* To hold directory names */ 40 dcl ename char (32); /* To hold entry names */ 41 dcl seg_ptr ptr; /* Pointer to dir>ename */ 42 dcl arg_name char (32) var; /* Name of current arg for error msg */ 43 dcl iocb_ptr ptr; /* Pointer to IOCB being processed */ 44 dcl offset_val fixed bin (21); /* Value of offset into segment if specified */ 45 dcl length_val fixed bin (21); /* Value of length of string if specified */ 46 dcl bit_count fixed bin (24); /* Length of segment in bits */ 47 dcl char_cnt fixed bin (21); /* Length of segment in characters */ 48 dcl offset_sw bit (1); /* Set if offset given in command */ 49 dcl length_sw bit (1); /* Set if length given in command */ 50 dcl lines_sw bit (1); /* Set if -lines specified */ 51 dcl cv_dec_err fixed bin; /* Error code from cv_dec_check_ */ 52 dcl data_ptr ptr; /* Pointer to data if i/o from a segment */ 53 dcl data_len fixed bin (21); /* Length of data if io from segment */ 54 dcl init_sw bit (1) init ("0"b); /* Set if segment has been inited so it can be termed */ 55 dcl cmd_type bit (1); /* 0 if input operation, 1 if output */ 56 dcl (input init ("0"b), output init ("1"b)) bit (1) int static options (constant); /* Possible values for cmd_type */ 57 dcl string_sw bit (1); /* Set if string appears on command line */ 58 dcl string_ptr ptr; /* Pointer to string command argument */ 59 dcl string_len fixed bin (21); /* Length of string command argument */ 60 dcl nl_sw bit (1); /* Set if -append_newline appears */ 61 dcl nnl_sw bit (1); /* Set of -remove_newline appears */ 62 dcl alnl_sw bit (1); /* Set if -allow_newline appears */ 63 dcl nhe_sw bit (1); /* Set if -nhe or -no_header is used */ 64 dcl path_sw bit (1); /* Set if -segment or -sm appears */ 65 dcl temp_val fixed bin (35); /* Temp area used in conversions */ 66 dcl input_len fixed bin (21); /* Length of data read on input operation */ 67 dcl alloc_sw bit (1) init ("0"b); /* Set if string allocated and should be freed */ 68 dcl print_length bit (1) init ("0"b); /* Set if length of input record should be printed */ 69 dcl length_printed bit (1) init ("0"b); /* Set on input ops once length is printed */ 70 dcl ptr_array (1) ptr init (null); /* Array of pointers used by get_temp_segments_ */ 71 dcl ioname char (32); /* Name of current switch */ 72 dcl request_name char (32); /* Name of current request */ 73 dcl af_sw bit (1); /* Set if called as an active function */ 74 dcl no_quote_sw bit (1); /* Set if -no_quote specified */ 75 dcl error entry variable options (variable); /* Either com_err_ of active_fnc_err_ */ 76 dcl af_retp ptr; /* Pointer to af return string */ 77 dcl af_retl fixed bin; /* Its max length */ 78 79 /* Constants */ 80 81 dcl cmd_name char (7) int static options (constant) init ("io_call"); /* Name of this thing */ 82 dcl new_line char (1) int static options (constant) init (" 83 "); /* A new line character */ 84 85 /* Static storage */ 86 87 dcl old_dir char (168) static init (" "); /* Previous directory used */ 88 dcl old_ename char (32) static init (" "); /* Previous entry name */ 89 90 /* Based storage */ 91 92 dcl arg char (arg_len) based (arg_ptr); /* Some arbitrary argument */ 93 dcl based_seg char (char_cnt) based (seg_ptr); /* One way of looking at a segment */ 94 dcl based_seg_array (1:char_cnt) char (1) based (seg_ptr); /* Another way */ 95 dcl arg_string char (string_len) based (string_ptr); /* Command argument used as output string */ 96 dcl input_string char (input_len) based (data_ptr); /* Input string during read operation */ 97 dcl af_ret char (af_retl) based (af_retp) var; /* Return string for active function */ 98 99 /* Things allocated in system free area */ 100 101 dcl free_area_ptr ptr init (null); /* Pointer to the area */ 102 dcl free_area area based (free_area_ptr); /* A representation of the area */ 103 dcl free_area_string char (free_area_string_len) based (free_area_string_ptr); /* A string allocated there */ 104 dcl free_area_string_len fixed bin (21); /* Length of the string */ 105 dcl free_area_string_ptr ptr init (null); /* Pointer to that string */ 106 107 /* External variables */ 108 109 dcl error_table_$badopt ext fixed bin (35); 110 dcl error_table_$long_record ext fixed bin (35); 111 dcl error_table_$noarg ext fixed bin (35); 112 dcl error_table_$no_operation ext fixed bin (35); 113 dcl error_table_$short_record ext fixed bin (35); 114 dcl error_table_$too_many_args ext fixed bin (35); 115 116 dcl iox_$user_output ext ptr; 117 118 dcl sys_info$max_seg_size fixed bin(35) ext static; 119 120 /* Builtin functions */ 121 122 dcl (addr, addrel, bin, divide, index, length, max, mod, null, size, substr) builtin; 123 124 dcl (area, cleanup) condition; 125 126 /* Entry variables */ 127 128 dcl active_fnc_err_ entry options (variable); 129 dcl com_err_ entry options (variable); 130 131 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 132 dcl cu_$arg_count_rel entry (fixed bin, ptr); 133 dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 134 dcl cu_$af_arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 135 136 dcl cv_dec_check_ entry (char (*), fixed bin) returns (fixed bin (35)); 137 dcl expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); 138 dcl get_system_free_area_ entry returns (ptr); 139 dcl get_temp_segments_ entry (char (*), dim (*) ptr, fixed bin (35)); 140 141 dcl hcs_$get_max_length entry (char (*), char (*), fixed bin (18), fixed bin (35)); 142 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 143 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 144 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 145 dcl hcs_$set_max_length_seg entry (ptr, fixed bin (18), fixed bin (35)); 146 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 147 dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); 148 149 dcl ioa_ entry options (variable); 150 dcl ioa_$rsnnl entry options (variable); 151 152 153 dcl iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 154 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 155 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 156 dcl iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 157 dcl iox_$rewrite_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 158 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 159 160 dcl release_temp_segments_ entry (char (*), dim (*) ptr, fixed bin (35)); 161 dcl requote_string_ entry (char (*)) returns (char (*)); 162 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 163 164 165 /* PUT_CHARS operation */ 166 167 put_chars: entry (arg_iocb_ptr, arg_arg_list_ptr); 168 169 request_name = "put_chars"; 170 on cleanup call clean_up; 171 call setup; 172 cmd_type = output; /* Output command */ 173 call scan_cmd; /* Scan the command */ 174 if ^(nl_sw | nnl_sw | alnl_sw) then nl_sw = "1"b; /* -apnl default */ 175 call build_optr; /* Build pointer to data */ 176 call iox_$put_chars (iocb_ptr, data_ptr, data_len, code); /* Write it */ 177 if code ^= 0 then go to err_2; 178 exit: call clean_up; 179 return; 180 181 /* WRITE_RECORD operation */ 182 183 write_record: entry (arg_iocb_ptr, arg_arg_list_ptr); 184 185 request_name = "write_record"; 186 on cleanup call clean_up; 187 call setup; 188 cmd_type = output; /* Output command */ 189 call scan_cmd; /* Scan command */ 190 if ^path_sw & ^(nl_sw | nnl_sw | alnl_sw) then nnl_sw = "1"b; 191 else if path_sw & ^(nl_sw | nnl_sw | alnl_sw) then alnl_sw = "1"b; 192 call build_optr; /* Build pointer to data */ 193 call iox_$write_record (iocb_ptr, data_ptr, data_len, code); /* Write it */ 194 if code ^= 0 then go to err_2; 195 else go to exit; 196 197 /* REWRITE_RECORD operation */ 198 199 rewrite_record: entry (arg_iocb_ptr, arg_arg_list_ptr); 200 201 request_name = "rewrite_record"; 202 on cleanup call clean_up; 203 call setup; 204 cmd_type = output; /* Output command */ 205 call scan_cmd; /* Scan command line */ 206 if ^path_sw & ^(nl_sw | nnl_sw | alnl_sw) then nnl_sw = "1"b; 207 else if path_sw & ^(nl_sw | nnl_sw | alnl_sw) then alnl_sw = "1"b; 208 call build_optr; /* Build pointer to data */ 209 call iox_$rewrite_record (iocb_ptr, data_ptr, data_len, code); 210 if code ^= 0 then go to err_2; 211 else go to exit; 212 213 /* GET_CHARS operation */ 214 215 get_chars: entry (arg_iocb_ptr, arg_arg_list_ptr); 216 217 request_name = "get_chars"; 218 on cleanup call clean_up; 219 call setup; 220 cmd_type = input; 221 call scan_cmd; 222 if af_sw & ^(nl_sw | nnl_sw | alnl_sw) then nnl_sw = "1"b; 223 else if ^af_sw & path_sw & ^(nl_sw | nnl_sw | alnl_sw) then alnl_sw = "1"b; 224 else if ^af_sw & ^path_sw & ^(nl_sw | nnl_sw | alnl_sw) then nl_sw = "1"b; 225 call build_iptr; /* Get pointer to input area */ 226 print_length = "1"b; 227 input_len = -1; 228 call iox_$get_chars (iocb_ptr, data_ptr, data_len, input_len, code); /* Read chars */ 229 if code ^= 0 then do; 230 call print_code; 231 if input_len > 0 then call input_dispose; 232 go to exit; 233 end; 234 call input_dispose_final; 235 go to exit; 236 237 /* READ_RECORD operation */ 238 239 read_record: entry (arg_iocb_ptr, arg_arg_list_ptr); 240 241 request_name = "read_record"; 242 on cleanup call clean_up; 243 call setup; 244 cmd_type = input; 245 call scan_cmd; /* Scan command */ 246 if af_sw & ^(nl_sw | nnl_sw | alnl_sw) then nnl_sw = "1"b; 247 else if ^af_sw & ^(nl_sw | nnl_sw | alnl_sw) then alnl_sw = "1"b; 248 call build_iptr; 249 print_length = "1"b; /* Length should be printed */ 250 input_len = -1; 251 call iox_$read_record (iocb_ptr, data_ptr, data_len, input_len, code); /* Read record */ 252 if code ^= 0 then do; /* An error */ 253 if code = error_table_$long_record then do; 254 if input_len > data_len then do; /* If true length returned */ 255 call error (code, cmd_name, "^d characters in record, ^d returned.", input_len, data_len); 256 input_len = data_len; 257 length_printed = "1"b; /* Remember length already printed */ 258 end; 259 else call print_code; /* Use standard error print */ 260 end; 261 else call print_code; 262 if input_len > 0 then call input_dispose; 263 go to exit; 264 end; 265 call input_dispose_final; 266 go to exit; 267 268 /* GET_LINE operation */ 269 270 get_line: entry (arg_iocb_ptr, arg_arg_list_ptr); 271 272 request_name = "get_line"; 273 on cleanup call clean_up; 274 call setup; 275 cmd_type = input; 276 call scan_cmd; /* Scan command line */ 277 if af_sw & ^(nl_sw | nnl_sw | alnl_sw) then nnl_sw = "1"b; 278 else if ^af_sw & path_sw & ^(nl_sw | nnl_sw | alnl_sw) then alnl_sw = "1"b; 279 else if ^af_sw & ^path_sw & ^(nl_sw | nnl_sw | alnl_sw) then nl_sw = "1"b; 280 call build_iptr; /* Get pointer to input area */ 281 print_length = length_sw; /* If user supplied buffer length there will only be 282* one read so I can print the length */ 283 getl: input_len = -1; 284 call iox_$get_line (iocb_ptr, data_ptr, data_len, input_len, code); /* Read line */ 285 if code ^= 0 then do; /* If error */ 286 if length_sw then do; /* User supplied buffer */ 287 call print_code; 288 if input_len > 0 then call input_dispose; 289 go to exit; 290 end; 291 if code = error_table_$long_record then do; /* Didn't get it all */ 292 if path_sw then do; /* If reading into segment */ 293 offset_val = offset_val+input_len; /* Adjust offset */ 294 data_ptr = addr (based_seg_array (offset_val+1)); /* Compute new address */ 295 data_len = data_len-input_len; /* Space left */ 296 go to getl; 297 end; 298 else do; 299 call write_first; /* Write standard header */ 300 call iox_$put_chars (iox_$user_output, data_ptr, input_len, code); /* Write section to user_output */ 301 if code ^= 0 then go to out_err; 302 go to getl; /* And read more */ 303 end; 304 end; 305 else do; /* Other errors */ 306 call print_code; 307 if input_len > 0 then call input_dispose; 308 go to exit; 309 end; 310 end; 311 print_length = "1"b; /* If only one get_line needed, I can print the length */ 312 call input_dispose_final; 313 go to exit; 314 315 /* Procedure to scan command line on input or output operations to extract rest of options */ 316 317 scan_cmd: proc; 318 319 dcl carg_flag bit (1) init ("0"b); /* Once set, only control args are allowed */ 320 321 string_sw = "0"b; /* Output string not yet found */ 322 path_sw = "0"b; /* Segment specification not yet found */ 323 offset_sw = "0"b; /* Offset not yet found */ 324 length_sw = "0"b; /* Length not yet found */ 325 lines_sw = "0"b; /* -lines has not been specified */ 326 nl_sw = "0"b; /* -append_newline has not been specified */ 327 nnl_sw = "0"b; /* -remove_newline has not been specified */ 328 alnl_sw = "0"b; /* -allow_newline has not been specified */ 329 nhe_sw = "0"b; /* -no_header has not been specified */ 330 no_quote_sw = "0"b; /* -no_quote not specified */ 331 332 arg_loop: if next_arg > n_args then do; /* If no more arguments to process */ 333 if ^length_sw then length_val = sys_info$max_seg_size * 4; 334 return; 335 end; 336 call get_arg_ptr; /* Get next arg */ 337 if code ^= 0 then go to err_8; /* This shouldn't happen */ 338 if substr (arg, 1, 1) = "-" then go to carg; /* Go process control argument */ 339 if carg_flag then do; /* If only control arguments being accepted */ 340 code = error_table_$too_many_args; 341 go to err_3; 342 end; 343 if cmd_type = output then do; /* If output type command */ 344 string_sw = "1"b; /* Then this is the output string */ 345 string_ptr = arg_ptr; /* Save pointer */ 346 string_len = arg_len; /* Save length */ 347 carg_flag = "1"b; /* Only control arguments may appear now */ 348 end; 349 else do; /* If input type command */ 350 length_val = cv_dec (); /* This must be length */ 351 if cv_dec_err ^= 0 then go to err_9; 352 length_sw = "1"b; /* Length has been specified */ 353 carg_flag = "1"b; /* Only control arguments may follow */ 354 end; 355 narg: next_arg = next_arg+1; /* Next argument to process */ 356 go to arg_loop; 357 358 /* Process control argument */ 359 360 carg: if arg = "-nl" then nl_sw = "1"b; 361 else if arg = "-nnl" then nnl_sw = "1"b; 362 else if arg = "-allow_newline" | arg = "-alnl" then do; 363 nl_sw = "0"b; 364 nnl_sw = "0"b; 365 alnl_sw = "1"b; 366 end; 367 else if arg = "-append_newline" | arg = "-apnl" then do; 368 nl_sw = "1"b; 369 nnl_sw = "0"b; 370 alnl_sw = "0"b; 371 end; 372 else if arg = "-remove_newline" | arg = "-rmnl" then do; 373 nl_sw = "0"b; 374 nnl_sw = "1"b; 375 alnl_sw = "0"b; 376 end; 377 else if arg = "-lines" | arg = "-l" then lines_sw = "1"b; 378 else if arg = "-no_header" | arg = "-nhe" then nhe_sw = "1"b; 379 else if arg = "-no_quote" | arg = "-nq" then no_quote_sw = "1"b; 380 else if (arg = "-string" | arg = "-str") & cmd_type = output then do; 381 next_arg = next_arg + 1; 382 call get_arg_ptr; 383 if code ^= 0 then go to err_8; 384 if string_sw then do; 385 call com_err_ (0, cmd_name, "Output string may only be specified once."); 386 go to exit; 387 end; 388 string_sw = "1"b; 389 string_ptr = arg_ptr; 390 string_len = arg_len; 391 carg_flag = "1"b; 392 end; 393 else if ^af_sw & (arg = "-segment" | arg = "-sm") then do; 394 call sm_spec; /* Analyze segment specification */ 395 carg_flag = "1"b; /* Only control arguments may follow */ 396 end; 397 else do; 398 code = error_table_$badopt; /* Bad control arg */ 399 go to err_3; 400 end; 401 go to narg; 402 403 end scan_cmd; 404 405 /* Scan -segment portion of command line */ 406 407 sm_spec: proc; 408 409 if path_sw then do; /* If duplicate specification */ 410 call error (0, cmd_name, "Duplicate -segment specification."); 411 go to exit; 412 end; 413 arg_name = "pathname after -segment."; /* Looking for this now */ 414 next_arg = next_arg + 1; /* This should be path name */ 415 call get_arg_ptr; 416 if code ^= 0 then go to err_1; /* Failed */ 417 if arg = "." then do; /* "." means re-use last segment */ 418 if old_dir = "" | old_ename = "" then do; /* Assuming there was one */ 419 code = error_table_$noarg; 420 go to err_1; 421 end; 422 dir = old_dir; /* Copy saved name */ 423 ename = old_ename; 424 end; 425 else do; /* Analyze new name */ 426 call expand_path_ (arg_ptr, arg_len, addr (dir), addr (ename), code); 427 if code ^= 0 then go to err_3; 428 old_dir = dir; /* Save name */ 429 old_ename = ename; 430 end; 431 path_sw = "1"b; /* A path has been specified */ 432 if next_arg = n_args then return; /* If all args process, then done */ 433 next_arg = next_arg + 1; /* Step to next */ 434 call get_arg_ptr; 435 if code ^= 0 then go to err_8; /* Shouldn't happen */ 436 if substr (arg, 1, 1) = "-" then do; /* If this is control argument, -sm scan is done */ 437 sm_back: next_arg = next_arg - 1; /* Back up so caller can process this arg */ 438 return; 439 end; 440 temp_val = cv_dec (); /* Next arg should be decimal */ 441 if cv_dec_err ^= 0 then go to err_9; /* But wasn't */ 442 if cmd_type = input then do; /* If input type command */ 443 offset_sw = "1"b; /* This was the offset */ 444 offset_val = temp_val; 445 return; /* And done */ 446 end; 447 length_sw = "1"b; /* If this is output command, then this may be the length */ 448 length_val = temp_val; 449 if next_arg = n_args then return; /* Done if this was last arg */ 450 next_arg = next_arg+1; /* Try next */ 451 call get_arg_ptr; 452 if code ^= 0 then go to err_8; 453 if substr (arg, 1, 1) = "-" then go to sm_back; /* If control arg, then done with -sm */ 454 temp_val = cv_dec (); /* Should be decimal */ 455 if cv_dec_err ^= 0 then go to err_9; 456 offset_sw = "1"b; /* The first number was really the offset */ 457 offset_val = length_val; /* So move it */ 458 length_val = temp_val; /* This new number is the length */ 459 return; 460 461 end sm_spec; 462 463 /* Procedure used on output commands to compute pointer to and length of output data */ 464 465 build_optr: proc; 466 467 dcl has_nl bit (1) init ("0"b); /* Set if string given already has new line */ 468 469 if string_sw then do; /* If data is from command line string */ 470 check_nl: data_ptr = string_ptr; /* Pointer is known */ 471 data_len = string_len; /* Length is also known */ 472 if string_len > 0 then 473 if substr (arg_string, string_len, 1) = new_line then has_nl = "1"b; /* Check for a new-line */ 474 if nnl_sw then do; /* If requested to remove a newline */ 475 if has_nl then data_len = data_len-1; /* Easy to do by changing count */ 476 end; 477 if nl_sw then do; /* If requested to add a newline */ 478 if has_nl then return; /* Already there */ 479 call alloc_string (string_len+1); /* Create temporary string */ 480 data_ptr = free_area_string_ptr; /* Data located here */ 481 data_len = free_area_string_len; /* And is this long */ 482 free_area_string = arg_string; /* Copy body of string */ 483 substr (free_area_string, free_area_string_len, 1) = new_line; /* Append new-line */ 484 end; 485 return; 486 end; 487 if path_sw then do; /* If input from segment */ 488 call path_init; /* Find data there */ 489 string_ptr = addr (based_seg_array (offset_val+1)); /* Get pointer to data */ 490 string_len = length_val; 491 go to check_nl; /* Go check -nl and -nnl options */ 492 end; 493 494 call error (0, cmd_name, "No output specification."); 495 go to exit; 496 497 end build_optr; 498 499 /* Procedure used by input commands to compute pointer to data area */ 500 501 build_iptr: proc; 502 503 dcl max_len fixed bin (18); /* Used to hold max length of segment */ 504 505 if path_sw then do; /* If reading into segment */ 506 call path_init; /* Initiate it */ 507 data_ptr = addr (based_seg_array (offset_val+1)); /* Data goes here */ 508 if length_sw then data_len = length_val; /* If length given, use it */ 509 else do; /* If length not given */ 510 call hcs_$get_max_length (dir, ename, max_len, code); /* Get max segment length */ 511 if code ^= 0 then go to err_5; 512 data_len = 4*max_len-offset_val; /* Compute space remaining in segment */ 513 end; 514 end; 515 else do; /* Not reading into segment */ 516 call alloc_string (length_val); /* And create a string */ 517 data_ptr = free_area_string_ptr; /* Here */ 518 data_len = free_area_string_len; /* For this length */ 519 end; 520 521 return; 522 523 end build_iptr; 524 525 /* This procedure is called after an input operation to handle the final disposition of the data */ 526 527 input_dispose: proc; 528 529 dcl new_bit_count fixed bin (24); /* New segment bit count */ 530 dcl has_nl bit (1) init ("0"b); /* Set if newline at end of data */ 531 dcl word_cnt fixed bin (18); /* Word count of segment */ 532 dcl last_word_ptr ptr; /* Pointer to last word of segment */ 533 dcl last_word bit (36) based (last_word_ptr); /* Last word */ 534 dcl bits_used fixed bin; /* Bits used in last word */ 535 536 if input_len > 0 then 537 if substr (input_string, input_len, 1) = new_line then has_nl = "1"b; /* Check for newline at end */ 538 if path_sw then do; /* If data is to go into segment */ 539 if nl_sw & ^has_nl then do; /* If wants newline and doesn't have one */ 540 input_len = input_len+1; /* Make string longer */ 541 substr (input_string, input_len, 1) = new_line; /* Insert newline */ 542 end; 543 else if nnl_sw then /* If requested to strip newline */ 544 if has_nl then input_len = input_len-1; /* Strip it if present */ 545 new_bit_count = 9 * (offset_val + input_len); /* Compute new segment bit count */ 546 call hcs_$set_bc_seg (seg_ptr, new_bit_count, code); /* Set it */ 547 if code ^= 0 then go to err_5; 548 if new_bit_count < bit_count then do; /* If segment is shrinking */ 549 word_cnt = divide (new_bit_count+35, 36, 18, 0); /* Get length in words */ 550 call hcs_$truncate_seg (seg_ptr, word_cnt, code); /* And truncate it */ 551 if code ^= 0 then go to err_5; 552 bits_used = mod (new_bit_count, 36); /* Bits used in last word (0 if full) */ 553 if bits_used ^= 0 then do; /* If word partially filled */ 554 last_word_ptr = addrel (seg_ptr, word_cnt-1); /* Get pointer to last word */ 555 substr (last_word, bits_used+1) = "0"b; /* Zero remaining bits */ 556 end; 557 end; 558 end; 559 else if ^af_sw then do; /* Data will be written to terminal */ 560 call write_first; /* Write header */ 561 call iox_$put_chars (iox_$user_output, data_ptr, input_len, code); 562 if code ^= 0 then go to out_err; 563 if ^has_nl & nl_sw then do; /* If no newline */ 564 call iox_$put_chars (iox_$user_output, addr (new_line), 1, code); 565 if code ^= 0 then go to out_err; 566 end; 567 end; 568 else do; /* Called as an active function */ 569 if has_nl & nnl_sw then input_len = input_len - 1; 570 if no_quote_sw then af_ret = input_string; 571 else af_ret = requote_string_ (input_string); 572 end; 573 574 return; 575 576 end input_dispose; 577 578 input_dispose_final: proc; 579 580 call input_dispose; 581 if path_sw & ^length_printed then do; 582 print_length = "1"b; 583 call write_first; 584 end; 585 return; 586 587 end input_dispose_final; 588 589 /* This routines writes a standard message at the beginning of the data obtained on input commands. 590* This consists of at least the word "io_call:" and is usually followed by the number of characters 591* read by the command. */ 592 593 write_first: proc; 594 595 dcl header char (50); /* Temp area */ 596 dcl headl fixed bin; /* Value returned by ioa_$rsnnl */ 597 598 if length_printed | nhe_sw | af_sw then return; /* Only do this once */ 599 header = cmd_name || ": "; /* This is data to write */ 600 call iox_$put_chars (iox_$user_output, addr (header), length (cmd_name)+2, code); 601 if code ^= 0 then go to out_err; 602 if print_length then do; /* If length should be printed too */ 603 call ioa_$rsnnl ("^d character^v(s^) returned.", header, headl, input_len, bin (input_len ^= 1, 1)); 604 if path_sw then substr (header, headl+1, 1) = new_line; /* If data going to segment, this is end */ 605 call iox_$put_chars (iox_$user_output, addr (header), headl+1, code); /* Write data with extra char */ 606 if code ^= 0 then go to out_err; 607 end; 608 length_printed = "1"b; 609 return; 610 611 end write_first; 612 613 /* The following procedure are used when input operations get an error code. The error is printed and 614* plus the length of the data (if any) returned. */ 615 616 print_code: proc; 617 618 dcl (l, lt) fixed bin (21); 619 620 if code = error_table_$short_record & (af_sw | ^length_sw) then return; 621 l = input_len; /* Length read on last operation */ 622 lt = max (l, 0); /* Total length to print */ 623 624 if lt = 0 then do; /* If no data */ 625 if l < 0 then call error (code, cmd_name, "^a on switch ^a", request_name, ioname); /* Print this message if no length returned */ 626 else call error (code, cmd_name, "No data returned by ^a on switch ^a.", request_name, ioname); 627 end; 628 629 else call error (code, cmd_name, "^d character^v(s^) returned by ^a on switch ^a.", lt, bin (lt ^= 1, 1), request_name, ioname); 630 631 length_printed = "1"b; 632 633 return; 634 635 end print_code; 636 637 /* Procedure to allocate a temporary string */ 638 639 alloc_string: proc (string_len); 640 641 dcl string_len fixed bin (21); /* Length to allocate */ 642 643 if free_area_ptr = null then 644 free_area_ptr = get_system_free_area_ (); /* Start with pointer to free area */ 645 free_area_string_len = string_len; /* Length to allocate */ 646 on area go to alloc_err; /* In case error */ 647 allocate free_area_string in (free_area); /* Create string */ 648 alloc_sw = "1"b; /* Remember that I did this */ 649 return; 650 651 alloc_err: revert area; 652 653 /* Try to make a temporary segment since the allocate failed */ 654 655 call get_temp_segments_ (cmd_name, ptr_array, code); 656 if code ^= 0 then do; 657 call error (code, cmd_name, "Unable to allocate temp segment for data."); 658 go to exit; 659 end; 660 call hcs_$set_max_length_seg (ptr_array (1), size (free_area_string), code); /* Make seg bit enough */ 661 if code ^= 0 then do; 662 call error (code, cmd_name, "Unable to get ^d word segment to hold data.", size (free_area_string)); 663 go to exit; 664 end; 665 free_area_string_ptr = ptr_array (1); 666 return; 667 668 669 end alloc_string; 670 671 /* Procedure to locate data if in a segment */ 672 673 path_init: proc; 674 675 dcl cur_pos fixed bin (21); /* Used during scan for line feeds */ 676 677 call hcs_$initiate_count (dir, ename, "", bit_count, 0, seg_ptr, code); /* This is a good start */ 678 if seg_ptr = null then do; /* Initiate failed */ 679 if cmd_type = output then go to err_5; /* Must succeed if this is output */ 680 call hcs_$make_seg (dir, ename, "", 01010b, seg_ptr, code); /* Make new segment to read into */ 681 if seg_ptr = null then go to err_5; /* This should succeed */ 682 call ioa_ ("^a: Segment ^a^v(>^)^a created.", cmd_name, dir, bin (dir ^= ">", 1), ename); 683 bit_count = 0; /* New segment has no length */ 684 end; 685 init_sw = "1"b; /* Remember that I did this */ 686 char_cnt = divide (bit_count, 9, 21, 0); /* Compute length in characters */ 687 688 if ^lines_sw then do; /* If measurements are in characters */ 689 if cmd_type = output then do; /* If output command */ 690 if ^offset_sw then offset_val = 0; /* Assume 0 if offset omitted */ 691 if offset_val > char_cnt then go to bound_err; /* Check range */ 692 if ^length_sw then length_val = char_cnt-offset_val; /* Default length is rest of seg */ 693 if (offset_val + length_val) > char_cnt then go to bound_err; /* Check range */ 694 end; 695 else do; /* If input command */ 696 if ^offset_sw then offset_val = char_cnt; /* If no offset, assume end */ 697 if offset_val > char_cnt then go to bound_err; /* Check range */ 698 end; 699 end; 700 else do; /* If measurements in lines */ 701 cur_pos = 0; /* Initialize current position for scan */ 702 if cmd_type = output then do; /* If output command */ 703 if ^offset_sw then offset_val = 0; /* If no offset, assume 0 */ 704 call find_nl (offset_val, cur_pos); /* Scan down offset new-lines */ 705 offset_val = cur_pos; /* Offset now converted to chars */ 706 if ^length_sw then length_val = char_cnt-offset_val; /* If no length, use rest */ 707 else do; /* If length given */ 708 call find_nl (length_val, cur_pos); /* Scan down for new-lines */ 709 length_val = cur_pos-offset_val; /* Length in characters */ 710 end; 711 end; 712 else do; /* If input command */ 713 if ^offset_sw then offset_val = char_cnt; /* If no offset, use end of seg */ 714 else do; 715 call find_nl (offset_val, cur_pos); /* Scan down for new-lines */ 716 offset_val = cur_pos; /* Offset in characters */ 717 end; 718 end; 719 end; 720 721 return; 722 723 724 end path_init; 725 726 /* Procedure to scan down string for a given number of new-lines */ 727 728 find_nl: proc (n, pos); 729 730 dcl n fixed bin (21); /* Number of new-lines wanted */ 731 dcl pos fixed bin (21); /* Current loc in segment (input and output) */ 732 dcl i fixed bin (21); /* Loop index */ 733 dcl new_pos fixed bin (21); /* Temp pos */ 734 735 do i = 1 to n; /* Do for each new-line */ 736 if pos >= char_cnt then go to bound_err; /* Error if off end */ 737 new_pos = index (substr (based_seg, pos+1), new_line); /* Length of next line */ 738 if new_pos = 0 then go to bound_err; /* If new-line not found */ 739 pos = pos + new_pos; /* Compute new loc */ 740 end; 741 742 return; 743 744 end find_nl; 745 746 /* Internal procedure to call cu_$arg_ptr_rel so that this argument list is only built once */ 747 748 get_arg_ptr: proc; 749 750 if af_sw then call cu_$af_arg_ptr_rel (next_arg, arg_ptr, arg_len, code, arg_list_ptr); 751 else call cu_$arg_ptr_rel (next_arg, arg_ptr, arg_len, code, arg_list_ptr); 752 753 end get_arg_ptr; 754 755 756 /* Internal procedure to check next argument for a decimal value */ 757 758 cv_dec: proc returns (fixed bin (35)); 759 760 return (cv_dec_check_ (arg, cv_dec_err)); 761 762 end cv_dec; 763 764 /* Procedure to set up args at all entries */ 765 766 setup: proc; 767 768 iocb_ptr = arg_iocb_ptr; 769 arg_list_ptr = arg_arg_list_ptr; 770 next_arg = 3; 771 ioname = iocb_ptr -> iocb.name; 772 call cu_$af_return_arg_rel (n_args, af_retp, af_retl, code, arg_list_ptr); 773 if code = 0 then do; /* Called as active function */ 774 af_sw = "1"b; 775 error = active_fnc_err_; 776 end; 777 else do; /* Called as command */ 778 af_sw = "0"b; 779 error = com_err_; 780 call cu_$arg_count_rel (n_args, arg_list_ptr); 781 end; 782 return; 783 784 end setup; 785 786 787 /* Come here for various kinds of error messages */ 788 789 err_1: call error (code, cmd_name, "^a", arg_name); 790 go to exit; 791 792 err_2: if code = error_table_$no_operation then call error (code, cmd_name, "^a on switch ""^a"".", request_name, ioname); 793 else call error (code, cmd_name, "^a", ioname); 794 go to exit; 795 796 err_3: call error (code, cmd_name, "^a", arg); 797 go to exit; 798 799 err_5: call error (code, cmd_name, "^a^v(>^)^a", dir, bin (dir ^= ">", 1), ename); 800 go to exit; 801 802 err_6: call get_arg_ptr; 803 if code = 0 then do; 804 code = error_table_$too_many_args; 805 go to err_3; 806 end; 807 err_8: call error (code, cmd_name, " (arg ^d)", next_arg); 808 go to exit; 809 810 err_9: call error (0, cmd_name, "Invalid decimal number. ^a", arg); 811 go to exit; 812 813 bound_err: call error (0, cmd_name, "Offset/length exceeds bit count of segment."); 814 go to exit; 815 need_len: call error (0, cmd_name, "Length of input area must be specified."); 816 go to exit; 817 818 out_err: arg_name = "user_output"; 819 go to err_1; 820 821 /* Cleanup procedure for command termination */ 822 823 clean_up: proc; 824 825 826 if init_sw then do; /* If an init was done */ 827 init_sw = "0"b; 828 call hcs_$terminate_noname (seg_ptr, code); 829 end; 830 831 if alloc_sw then do; 832 alloc_sw = "0"b; 833 free free_area_string in (free_area); 834 end; 835 836 if ptr_array (1) ^= null then 837 call release_temp_segments_ (cmd_name, ptr_array, code); 838 839 840 841 end clean_up; 842 843 844 end io_call_read_write_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/27/84 1333.5 io_call_read_write_.pl1 >spec>on>6660>io_call_read_write_.pl1 163 1 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.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. active_fnc_err_ 000112 constant entry external dcl 128 ref 775 addr builtin function dcl 122 ref 294 426 426 426 426 489 507 564 564 600 600 605 605 addrel builtin function dcl 122 ref 554 af_ret based varying char dcl 97 set ref 570* 571* af_retl 000300 automatic fixed bin(17,0) dcl 77 set ref 570 571 772* af_retp 000276 automatic pointer dcl 76 set ref 570 571 772* af_sw 000270 automatic bit(1) unaligned dcl 73 set ref 222 223 224 246 247 277 278 279 393 559 598 620 750 774* 778* alloc_sw 000242 automatic bit(1) initial unaligned dcl 67 set ref 67* 648* 831 832* alnl_sw 000235 automatic bit(1) unaligned dcl 62 set ref 174 190 191 191* 206 207 207* 222 223 223* 224 246 247 247* 277 278 278* 279 328* 365* 370* 375* area 000000 stack reference condition dcl 124 ref 646 651 arg based char unaligned dcl 92 set ref 338 360 361 362 362 367 367 372 372 377 377 378 378 379 379 380 380 393 393 417 436 453 760* 796* 810* arg_arg_list_ptr parameter pointer dcl 29 ref 167 183 199 215 239 270 769 arg_iocb_ptr parameter pointer dcl 28 ref 167 183 199 215 239 270 768 arg_len 000106 automatic fixed bin(17,0) dcl 36 set ref 338 346 360 361 362 362 367 367 372 372 377 377 378 378 379 379 380 380 390 393 393 417 426* 436 453 750* 751* 760 760 796 796 810 810 arg_list_ptr 000102 automatic pointer dcl 34 set ref 750* 751* 769* 772* 780* arg_name 000176 automatic varying char(32) dcl 42 set ref 413* 789* 818* arg_ptr 000104 automatic pointer dcl 35 set ref 338 345 360 361 362 362 367 367 372 372 377 377 378 378 379 379 380 380 389 393 393 417 426* 436 453 750* 751* 760 796 810 arg_string based char unaligned dcl 95 ref 472 482 based_seg based char unaligned dcl 93 ref 737 based_seg_array based char(1) array unaligned dcl 94 set ref 294 489 507 bin builtin function dcl 122 ref 603 603 629 629 682 682 799 799 bit_count 000214 automatic fixed bin(24,0) dcl 46 set ref 548 677* 683* 686 bits_used 000372 automatic fixed bin(17,0) dcl 534 set ref 552* 553 555 carg_flag 000326 automatic bit(1) initial unaligned dcl 319 set ref 319* 339 347* 353* 391* 395* char_cnt 000215 automatic fixed bin(21,0) dcl 47 set ref 686* 691 692 693 696 697 706 713 736 737 cleanup 000310 stack reference condition dcl 124 ref 170 186 202 218 242 273 cmd_name 000002 constant char(7) initial unaligned dcl 81 set ref 255* 385* 410* 494* 599 600 625* 626* 629* 655* 657* 662* 682* 789* 792* 793* 796* 799* 807* 810* 813* 815* 836* cmd_type 000226 automatic bit(1) unaligned dcl 55 set ref 172* 188* 204* 220* 244* 275* 343 380 442 679 689 702 code 000100 automatic fixed bin(35,0) dcl 33 set ref 176* 177 193* 194 209* 210 228* 229 251* 252 253 255* 284* 285 291 300* 301 337 340* 383 398* 416 419* 426* 427 435 452 510* 511 546* 547 550* 551 561* 562 564* 565 600* 601 605* 606 620 625* 626* 629* 655* 656 657* 660* 661 662* 677* 680* 750* 751* 772* 773 789* 792 792* 793* 796* 799* 803 804* 807* 828* 836* com_err_ 000114 constant entry external dcl 129 ref 385 779 cu_$af_arg_ptr_rel 000124 constant entry external dcl 134 ref 750 cu_$af_return_arg_rel 000122 constant entry external dcl 133 ref 772 cu_$arg_count_rel 000120 constant entry external dcl 132 ref 780 cu_$arg_ptr_rel 000116 constant entry external dcl 131 ref 751 cur_pos 000444 automatic fixed bin(21,0) dcl 675 set ref 701* 704* 705 708* 709 715* 716 cv_dec_check_ 000126 constant entry external dcl 136 ref 760 cv_dec_err 000221 automatic fixed bin(17,0) dcl 51 set ref 351 441 455 760* data_len 000224 automatic fixed bin(21,0) dcl 53 set ref 176* 193* 209* 228* 251* 254 255* 256 284* 295* 295 471* 475* 475 481* 508* 512* 518* data_ptr 000222 automatic pointer dcl 52 set ref 176* 193* 209* 228* 251* 284* 294* 300* 470* 480* 507* 517* 536 541 561* 570 571 dir 000111 automatic char(168) unaligned dcl 39 set ref 422* 426 426 428 510* 677* 680* 682* 682 682 799* 799 799 divide builtin function dcl 122 ref 549 686 ename 000163 automatic char(32) unaligned dcl 40 set ref 423* 426 426 429 510* 677* 680* 682* 799* error 000272 automatic entry variable dcl 75 set ref 255 410 494 625 626 629 657 662 775* 779* 789 792 793 796 799 807 810 813 815 error_table_$badopt 000072 external static fixed bin(35,0) dcl 109 ref 398 error_table_$long_record 000074 external static fixed bin(35,0) dcl 110 ref 253 291 error_table_$no_operation 000100 external static fixed bin(35,0) dcl 112 ref 792 error_table_$noarg 000076 external static fixed bin(35,0) dcl 111 ref 419 error_table_$short_record 000102 external static fixed bin(35,0) dcl 113 ref 620 error_table_$too_many_args 000104 external static fixed bin(35,0) dcl 114 ref 340 804 expand_path_ 000130 constant entry external dcl 137 ref 426 free_area based area(1024) dcl 102 ref 647 833 free_area_ptr 000302 automatic pointer initial dcl 101 set ref 101* 643 643* 647 833 free_area_string based char unaligned dcl 103 set ref 482* 483* 647 660 660 662 662 833 free_area_string_len 000304 automatic fixed bin(21,0) dcl 104 set ref 481 482 483 483 518 645* 647 647 660 660 660 660 662 662 662 662 833 833 free_area_string_ptr 000306 automatic pointer initial dcl 105 set ref 105* 480 482 483 517 647* 660 660 662 662 665* 833 get_system_free_area_ 000132 constant entry external dcl 138 ref 643 get_temp_segments_ 000134 constant entry external dcl 139 ref 655 has_nl 000365 automatic bit(1) initial unaligned dcl 530 in procedure "input_dispose" set ref 530* 536* 539 543 563 569 has_nl 000344 automatic bit(1) initial unaligned dcl 467 in procedure "build_optr" set ref 467* 472* 475 478 hcs_$get_max_length 000136 constant entry external dcl 141 ref 510 hcs_$initiate_count 000140 constant entry external dcl 142 ref 677 hcs_$make_seg 000142 constant entry external dcl 143 ref 680 hcs_$set_bc_seg 000144 constant entry external dcl 144 ref 546 hcs_$set_max_length_seg 000146 constant entry external dcl 145 ref 660 hcs_$terminate_noname 000150 constant entry external dcl 146 ref 828 hcs_$truncate_seg 000152 constant entry external dcl 147 ref 550 header 000410 automatic char(50) unaligned dcl 595 set ref 599* 600 600 603* 604* 605 605 headl 000425 automatic fixed bin(17,0) dcl 596 set ref 603* 604 605 i 000454 automatic fixed bin(21,0) dcl 732 set ref 735* index builtin function dcl 122 ref 737 init_sw 000225 automatic bit(1) initial unaligned dcl 54 set ref 54* 685* 826 827* input constant bit(1) initial unaligned dcl 56 ref 220 244 275 442 input_len 000241 automatic fixed bin(21,0) dcl 66 set ref 227* 228* 231 250* 251* 254 255* 256* 262 283* 284* 288 293 295 300* 307 536 536 536 540* 540 541 541 543* 543 545 561* 569* 569 570 571 571 603* 603 603 621 input_string based char unaligned dcl 96 set ref 536 541* 570 571* ioa_ 000154 constant entry external dcl 149 ref 682 ioa_$rsnnl 000156 constant entry external dcl 150 ref 603 iocb based structure level 1 dcl 1-6 iocb_ptr 000210 automatic pointer dcl 43 set ref 176* 193* 209* 228* 251* 284* 768* 771 ioname 000250 automatic char(32) unaligned dcl 71 set ref 625* 626* 629* 771* 792* 793* iox_$get_chars 000160 constant entry external dcl 153 ref 228 iox_$get_line 000162 constant entry external dcl 154 ref 284 iox_$put_chars 000164 constant entry external dcl 155 ref 176 300 561 564 600 605 iox_$read_record 000166 constant entry external dcl 156 ref 251 iox_$rewrite_record 000170 constant entry external dcl 157 ref 209 iox_$user_output 000106 external static pointer dcl 116 set ref 300* 561* 564* 600* 605* iox_$write_record 000172 constant entry external dcl 158 ref 193 l 000434 automatic fixed bin(21,0) dcl 618 set ref 621* 622 625 last_word based bit(36) unaligned dcl 533 set ref 555* last_word_ptr 000370 automatic pointer dcl 532 set ref 554* 555 length builtin function dcl 122 ref 600 length_printed 000244 automatic bit(1) initial unaligned dcl 69 set ref 69* 257* 581 598 608* 631* length_sw 000217 automatic bit(1) unaligned dcl 49 set ref 281 286 324* 333 352* 447* 508 620 692 706 length_val 000213 automatic fixed bin(21,0) dcl 45 set ref 333* 350* 448* 457 458* 490 508 516* 692* 693 706* 708* 709* lines_sw 000220 automatic bit(1) unaligned dcl 50 set ref 325* 377* 688 lt 000435 automatic fixed bin(21,0) dcl 618 set ref 622* 624 629* 629 629 max builtin function dcl 122 ref 622 max_len 000354 automatic fixed bin(18,0) dcl 503 set ref 510* 512 mod builtin function dcl 122 ref 552 n parameter fixed bin(21,0) dcl 730 ref 728 735 n_args 000107 automatic fixed bin(17,0) dcl 37 set ref 332 432 449 772* 780* name 1 based char(32) level 2 dcl 1-6 ref 771 new_bit_count 000364 automatic fixed bin(24,0) dcl 529 set ref 545* 546* 548 549 552 new_line 000000 constant char(1) initial unaligned dcl 82 set ref 472 483 536 541 564 564 604 737 new_pos 000455 automatic fixed bin(21,0) dcl 733 set ref 737* 738 739 next_arg 000110 automatic fixed bin(17,0) dcl 38 set ref 332 355* 355 381* 381 414* 414 432 433* 433 437* 437 449 450* 450 750* 751* 770* 807* nhe_sw 000236 automatic bit(1) unaligned dcl 63 set ref 329* 378* 598 nl_sw 000233 automatic bit(1) unaligned dcl 60 set ref 174 174* 190 191 206 207 222 223 224 224* 246 247 277 278 279 279* 326* 360* 363* 368* 373* 477 539 563 nnl_sw 000234 automatic bit(1) unaligned dcl 61 set ref 174 190 190* 191 206 206* 207 222 222* 223 224 246 246* 247 277 277* 278 279 327* 361* 364* 369* 374* 474 543 569 no_quote_sw 000271 automatic bit(1) unaligned dcl 74 set ref 330* 379* 570 null builtin function dcl 122 ref 70 101 105 643 678 681 836 offset_sw 000216 automatic bit(1) unaligned dcl 48 set ref 323* 443* 456* 690 696 703 713 offset_val 000212 automatic fixed bin(21,0) dcl 44 set ref 293* 293 294 444* 457* 489 507 512 545 690* 691 692 693 696* 697 703* 704* 705* 706 709 713* 715* 716* old_dir 000010 internal static char(168) initial unaligned dcl 87 set ref 418 422 428* old_ename 000062 internal static char(32) initial unaligned dcl 88 set ref 418 423 429* output constant bit(1) initial unaligned dcl 56 ref 172 188 204 343 380 679 689 702 path_sw 000237 automatic bit(1) unaligned dcl 64 set ref 190 191 206 207 223 224 278 279 292 322* 409 431* 487 505 538 581 604 pos parameter fixed bin(21,0) dcl 731 set ref 728 736 737 739* 739 print_length 000243 automatic bit(1) initial unaligned dcl 68 set ref 68* 226* 249* 281* 311* 582* 602 ptr_array 000246 automatic pointer initial array dcl 70 set ref 70* 655* 660* 665 836 836* release_temp_segments_ 000174 constant entry external dcl 160 ref 836 request_name 000260 automatic char(32) unaligned dcl 72 set ref 169* 185* 201* 217* 241* 272* 625* 626* 629* 792* requote_string_ 000176 constant entry external dcl 161 ref 571 seg_ptr 000174 automatic pointer dcl 41 set ref 294 489 507 546* 550* 554 677* 678 680* 681 737 828* size builtin function dcl 122 ref 660 660 662 662 string_len parameter fixed bin(21,0) dcl 641 in procedure "alloc_string" ref 639 645 string_len 000232 automatic fixed bin(21,0) dcl 59 in procedure "io_call_read_write_" set ref 346* 390* 471 472 472 472 479 482 490* string_ptr 000230 automatic pointer dcl 58 set ref 345* 389* 470 472 482 489* string_sw 000227 automatic bit(1) unaligned dcl 57 set ref 321* 344* 384 388* 469 substr builtin function dcl 122 set ref 338 436 453 472 483* 536 541* 555* 604* 737 sys_info$max_seg_size 000110 external static fixed bin(35,0) dcl 118 ref 333 temp_val 000240 automatic fixed bin(35,0) dcl 65 set ref 440* 444 448 454* 458 word_cnt 000366 automatic fixed bin(18,0) dcl 531 set ref 549* 550* 554 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. iox_$iocb_version_sentinel external static char(4) dcl 1-51 NAMES DECLARED BY EXPLICIT CONTEXT. alloc_err 003714 constant label dcl 651 ref 646 alloc_string 003635 constant entry internal dcl 639 ref 479 516 arg_loop 002053 constant label dcl 332 ref 356 bound_err 001757 constant label dcl 813 set ref 691 693 697 736 738 build_iptr 002722 constant entry internal dcl 501 ref 225 248 280 build_optr 002600 constant entry internal dcl 465 ref 175 192 208 carg 002130 constant label dcl 360 ref 338 check_nl 002604 constant label dcl 470 ref 491 clean_up 004555 constant entry internal dcl 823 ref 170 178 186 202 218 242 273 cv_dec 004434 constant entry internal dcl 758 ref 350 440 454 err_1 001445 constant label dcl 789 ref 416 420 819 err_2 001474 constant label dcl 792 ref 177 194 210 err_3 001561 constant label dcl 796 ref 341 399 427 805 err_5 001613 constant label dcl 799 ref 511 547 551 679 681 err_6 001662 constant label dcl 802 err_8 001671 constant label dcl 807 ref 337 383 435 452 err_9 001723 constant label dcl 810 ref 351 441 455 exit 000507 constant label dcl 178 ref 195 211 232 235 263 266 289 308 313 386 411 495 658 663 790 794 797 800 808 811 814 816 find_nl 004331 constant entry internal dcl 728 ref 704 708 715 get_arg_ptr 004371 constant entry internal dcl 748 ref 336 382 415 434 451 802 get_chars 000724 constant entry external dcl 215 get_line 001244 constant entry external dcl 270 getl 001343 constant label dcl 283 ref 296 302 input_dispose 003006 constant entry internal dcl 527 ref 231 262 288 307 580 input_dispose_final 003265 constant entry internal dcl 578 ref 234 265 312 io_call_read_write_ 000405 constant entry external dcl 24 narg 002126 constant label dcl 355 ref 401 need_len 002004 constant label dcl 815 out_err 002031 constant label dcl 818 ref 301 562 565 601 606 path_init 004053 constant entry internal dcl 673 ref 488 506 print_code 003446 constant entry internal dcl 616 ref 230 259 261 287 306 put_chars 000420 constant entry external dcl 167 read_record 001057 constant entry external dcl 239 rewrite_record 000621 constant entry external dcl 199 scan_cmd 002037 constant entry internal dcl 317 ref 173 189 205 221 245 276 setup 004466 constant entry internal dcl 766 ref 171 187 203 219 243 274 sm_back 002526 constant label dcl 437 ref 453 sm_spec 002361 constant entry internal dcl 407 ref 394 write_first 003277 constant entry internal dcl 593 ref 299 560 583 write_record 000516 constant entry external dcl 183 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5420 5620 4672 5430 Length 6124 4672 200 267 525 62 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME io_call_read_write_ 740 external procedure is an external procedure. on unit on line 170 64 on unit on unit on line 186 64 on unit on unit on line 202 64 on unit on unit on line 218 64 on unit on unit on line 242 64 on unit on unit on line 273 64 on unit scan_cmd internal procedure shares stack frame of external procedure io_call_read_write_. sm_spec internal procedure shares stack frame of external procedure io_call_read_write_. build_optr internal procedure shares stack frame of external procedure io_call_read_write_. build_iptr internal procedure shares stack frame of external procedure io_call_read_write_. input_dispose internal procedure shares stack frame of external procedure io_call_read_write_. input_dispose_final internal procedure shares stack frame of external procedure io_call_read_write_. write_first internal procedure shares stack frame of external procedure io_call_read_write_. print_code internal procedure shares stack frame of external procedure io_call_read_write_. alloc_string 126 internal procedure enables or reverts conditions. on unit on line 646 64 on unit path_init internal procedure shares stack frame of external procedure io_call_read_write_. find_nl internal procedure shares stack frame of external procedure io_call_read_write_. get_arg_ptr internal procedure shares stack frame of external procedure io_call_read_write_. cv_dec internal procedure shares stack frame of external procedure io_call_read_write_. setup internal procedure shares stack frame of external procedure io_call_read_write_. clean_up 84 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 old_dir io_call_read_write_ 000062 old_ename io_call_read_write_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME io_call_read_write_ 000100 code io_call_read_write_ 000102 arg_list_ptr io_call_read_write_ 000104 arg_ptr io_call_read_write_ 000106 arg_len io_call_read_write_ 000107 n_args io_call_read_write_ 000110 next_arg io_call_read_write_ 000111 dir io_call_read_write_ 000163 ename io_call_read_write_ 000174 seg_ptr io_call_read_write_ 000176 arg_name io_call_read_write_ 000210 iocb_ptr io_call_read_write_ 000212 offset_val io_call_read_write_ 000213 length_val io_call_read_write_ 000214 bit_count io_call_read_write_ 000215 char_cnt io_call_read_write_ 000216 offset_sw io_call_read_write_ 000217 length_sw io_call_read_write_ 000220 lines_sw io_call_read_write_ 000221 cv_dec_err io_call_read_write_ 000222 data_ptr io_call_read_write_ 000224 data_len io_call_read_write_ 000225 init_sw io_call_read_write_ 000226 cmd_type io_call_read_write_ 000227 string_sw io_call_read_write_ 000230 string_ptr io_call_read_write_ 000232 string_len io_call_read_write_ 000233 nl_sw io_call_read_write_ 000234 nnl_sw io_call_read_write_ 000235 alnl_sw io_call_read_write_ 000236 nhe_sw io_call_read_write_ 000237 path_sw io_call_read_write_ 000240 temp_val io_call_read_write_ 000241 input_len io_call_read_write_ 000242 alloc_sw io_call_read_write_ 000243 print_length io_call_read_write_ 000244 length_printed io_call_read_write_ 000246 ptr_array io_call_read_write_ 000250 ioname io_call_read_write_ 000260 request_name io_call_read_write_ 000270 af_sw io_call_read_write_ 000271 no_quote_sw io_call_read_write_ 000272 error io_call_read_write_ 000276 af_retp io_call_read_write_ 000300 af_retl io_call_read_write_ 000302 free_area_ptr io_call_read_write_ 000304 free_area_string_len io_call_read_write_ 000306 free_area_string_ptr io_call_read_write_ 000326 carg_flag scan_cmd 000344 has_nl build_optr 000354 max_len build_iptr 000364 new_bit_count input_dispose 000365 has_nl input_dispose 000366 word_cnt input_dispose 000370 last_word_ptr input_dispose 000372 bits_used input_dispose 000410 header write_first 000425 headl write_first 000434 l print_code 000435 lt print_code 000444 cur_pos path_init 000454 i find_nl 000455 new_pos find_nl THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_cs call_var_desc call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext mod_fx1 enable shorten_stack ext_entry int_entry alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_ptr_rel cu_$af_return_arg_rel cu_$arg_count_rel cu_$arg_ptr_rel cv_dec_check_ expand_path_ get_system_free_area_ get_temp_segments_ hcs_$get_max_length hcs_$initiate_count hcs_$make_seg hcs_$set_bc_seg hcs_$set_max_length_seg hcs_$terminate_noname hcs_$truncate_seg ioa_ ioa_$rsnnl iox_$get_chars iox_$get_line iox_$put_chars iox_$read_record iox_$rewrite_record iox_$write_record release_temp_segments_ requote_string_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$long_record error_table_$no_operation error_table_$noarg error_table_$short_record error_table_$too_many_args iox_$user_output sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 54 000365 67 000366 68 000367 69 000370 70 000371 101 000400 105 000401 24 000404 167 000413 169 000426 170 000431 171 000453 172 000454 173 000456 174 000457 175 000467 176 000470 177 000505 178 000507 179 000513 183 000514 185 000524 186 000527 187 000551 188 000552 189 000554 190 000555 191 000570 192 000576 193 000577 194 000614 195 000616 199 000617 201 000627 202 000632 203 000654 204 000655 205 000657 206 000660 207 000673 208 000701 209 000702 210 000717 211 000721 215 000722 217 000732 218 000735 219 000757 220 000760 221 000761 222 000762 223 000775 224 001010 225 001020 226 001021 227 001023 228 001025 229 001044 230 001046 231 001047 232 001052 234 001053 235 001054 239 001055 241 001065 242 001070 243 001112 244 001113 245 001114 246 001115 247 001130 248 001136 249 001137 250 001141 251 001143 252 001162 253 001164 254 001167 255 001172 256 001224 257 001226 258 001230 259 001231 260 001232 261 001233 262 001234 263 001237 265 001240 266 001241 270 001242 272 001252 273 001255 274 001277 275 001300 276 001301 277 001302 278 001315 279 001330 280 001340 281 001341 283 001343 284 001345 285 001364 286 001366 287 001370 288 001371 289 001374 291 001375 292 001400 293 001402 294 001404 295 001410 296 001412 299 001413 300 001414 301 001431 302 001433 306 001434 307 001435 308 001440 311 001441 312 001443 313 001444 789 001445 790 001473 792 001474 793 001532 794 001560 796 001561 797 001612 799 001613 800 001661 802 001662 803 001663 804 001665 805 001670 807 001671 808 001722 810 001723 811 001756 813 001757 814 002003 815 002004 816 002030 818 002031 819 002036 317 002037 319 002040 321 002041 322 002042 323 002043 324 002044 325 002045 326 002046 327 002047 328 002050 329 002051 330 002052 332 002053 333 002056 334 002064 336 002065 337 002066 338 002070 339 002075 340 002077 341 002102 343 002103 344 002106 345 002110 346 002111 347 002113 348 002114 350 002115 351 002121 352 002123 353 002125 355 002126 356 002127 360 002130 361 002140 362 002147 363 002157 364 002160 365 002161 366 002163 367 002164 368 002174 369 002176 370 002177 371 002200 372 002201 373 002211 374 002212 375 002214 376 002215 377 002216 378 002231 379 002244 380 002257 381 002272 382 002273 383 002274 384 002276 385 002300 386 002325 388 002326 389 002330 390 002332 391 002334 392 002335 393 002336 394 002350 395 002351 396 002353 398 002354 399 002357 401 002360 407 002361 409 002362 410 002364 411 002410 413 002411 414 002416 415 002417 416 002420 417 002422 418 002430 419 002441 420 002443 422 002444 423 002447 424 002452 426 002453 427 002476 428 002500 429 002504 431 002507 432 002511 433 002515 434 002516 435 002517 436 002521 437 002526 438 002530 440 002531 441 002533 442 002535 443 002537 444 002541 445 002543 447 002544 448 002546 449 002550 450 002554 451 002555 452 002556 453 002560 454 002565 455 002567 456 002571 457 002573 458 002575 459 002577 465 002600 467 002601 469 002602 470 002604 471 002606 472 002610 474 002617 475 002621 477 002625 478 002627 479 002632 480 002643 481 002645 482 002647 483 002654 485 002657 487 002660 488 002662 489 002663 490 002667 491 002671 494 002672 495 002721 501 002722 505 002723 506 002725 507 002726 508 002732 510 002737 511 002764 512 002766 514 002772 516 002773 517 003001 518 003003 521 003005 527 003006 530 003007 536 003010 538 003021 539 003023 540 003027 541 003030 542 003035 543 003036 545 003044 546 003050 547 003063 548 003065 549 003070 550 003073 551 003106 552 003110 553 003114 554 003115 555 003122 558 003130 559 003131 560 003133 561 003134 562 003151 563 003153 564 003157 565 003200 567 003202 569 003203 570 003211 571 003226 572 003263 574 003264 578 003265 580 003266 581 003267 582 003273 583 003275 585 003276 593 003277 598 003300 599 003307 600 003322 601 003344 602 003346 603 003350 604 003411 605 003417 606 003441 608 003443 609 003445 616 003446 620 003447 621 003460 622 003462 624 003466 625 003470 626 003530 627 003562 629 003563 631 003631 633 003633 639 003634 643 003642 645 003655 646 003661 647 003700 648 003711 649 003713 651 003714 655 003715 656 003737 657 003742 658 003765 660 003770 661 004007 662 004012 663 004045 665 004050 666 004052 673 004053 677 004054 678 004116 679 004122 680 004125 681 004164 682 004170 683 004232 685 004233 686 004235 688 004240 689 004242 690 004245 691 004250 692 004252 693 004256 694 004262 696 004263 697 004266 699 004270 701 004271 702 004272 703 004275 704 004300 705 004302 706 004304 708 004312 709 004314 711 004317 713 004320 715 004324 716 004326 721 004330 728 004331 735 004333 736 004343 737 004347 738 004364 739 004365 740 004366 742 004370 748 004371 750 004372 751 004414 753 004433 758 004434 760 004436 766 004466 768 004467 769 004473 770 004476 771 004500 772 004504 773 004523 774 004525 775 004527 776 004534 778 004535 779 004536 780 004543 782 004553 823 004554 826 004562 827 004565 828 004566 831 004576 832 004601 833 004602 836 004607 841 004635 ----------------------------------------------------------- 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