COMPILATION LISTING OF SEGMENT canonicalize Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Adv Computing Technology Centre Compiled on: 04/12/90 1653.5 mdt Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1988 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 8* * * 9* * Copyright (c) 1978 by Massachusetts Institute of * 10* * Technology and Honeywell Information Systems, Inc. * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* *********************************************************** */ 16 17 18 /****^ HISTORY COMMENTS: 19* 1) change(71-01-01,VanVleck), approve(), audit(), install(): 20* Written by THVV, date unknown (above date is made up). 21* 2) change(71-01-01,Vinograd), approve(), audit(), install(): 22* Modified by D. Vinograd to add subroutine entry (date unknown). 23* 3) change(78-11-01,Spector), approve(), audit(), install(): 24* Modified by David Spector: 25* 1. Bug which could cause a fatal process error fixed. 26* 2. Subroutine entry made to call clean_up when done. 27* 3. Bug in which final lines not terminated by NL, VT, or FF were deleted 28* fixed. 29* 4. Bug in which final lines consisting only of NL, VT, or FF ("null 30* lines") were deleted fixed. 31* 5. Command made to check for error when setting bit count of the output 32* segment. 33* 6. Truncation of output segment now done in right place and with right 34* count. 35* 7. Precision of several char length calculations corrected to 21 bits. 36* 8. Command made to check for write access to output segment. 37* 9. Bug in which allocated "bead" not freed upon certain errors fixed. 38* 10. Command made to use expand_pathname_ instead of expand_path_. 39* 4) change(80-03-26,Herbst), approve(), audit(), install(): 40* Modified by S. Herbst to leave zero-length seg alone. 41* 5) change(81-04-01,Wallman), approve(), audit(), install(): 42* Modified by E. Wallman to enforce range of printing chars. 43* 6) change(84-01-01,Lippard), approve(85-12-30,MCR7322), 44* audit(86-01-15,KFleming), install(86-01-20,MR12.0-1006): 45* Modified by Jim Lippard to: 46* 1. allow input tab length specification 47* 2. refuse to canonicalize object segments and archives 48* 3. not delete nonprinting characters 49* 4. terminate zero-length segments 50* 5. query if input segment is to be overwritten 51* 6. add the name "-ev" to "-every" 52* 7. optimize processing of non-overstruck data (speedup from 53* Calgary's modified canonicalize by Tom Oke) 54* 7) change(86-02-11,Lippard), approve(86-02-11,PBF7322), 55* audit(86-02-11,Dickson), install(86-02-17,MR12.0-1018): 56* Modified to determine if a character is a nonprinting character 57* correctly. 58* 8) change(86-03-06,Lippard), approve(86-03-14,MCR7371), 59* audit(86-04-22,Dickson), install(86-04-22,MR12.0-1042): 60* Modified to calculate the increment of col correctly. 61* 9) change(86-08-21,Lippard), approve(86-09-08,MCR7537), 62* audit(86-09-30,Dickson), install(86-10-07,MR12.0-1178): 63* Modified to properly strip white space off the ends of lines which 64* contain no other characters. 65* 10) change(88-05-26,TLNguyen), approve(88-05-26,MCR7879), 66* audit(88-10-04,RBarstad), install(90-04-12,MR12.4-1004): 67* SCP6348: allow MSF in canon. 68* 11) change(90-03-02,LZimmerman), approve(90-03-02,MCR8158), 69* audit(90-03-07,Kallstrom), install(90-04-12,MR12.4-1004): 70* Correct unwarranted termination of input segment. (canonicalize_, 71* canonicalize_tabs_) 72* END HISTORY COMMENTS */ 73 74 /* format: style4 */ 75 76 canonicalize: 77 canon: 78 proc; 79 80 /* CANONICALIZE - fix file up to be canonical form. take out tabs too. (option to put in again) */ 81 82 /* Syntax as a command: canon path1 {path2} {-control_args} */ 83 84 85 /* automatic variables */ 86 dcl Access_ptr ptr; /* access pointer */ 87 /* the structure defined below is needed for both special cases: */ 88 /* SSF canonicalize MSF (expanded); MSF canonicalize SSF (shrunk) */ 89 /* Warning: the access structure defined below must be the same as */ 90 /* the access structure defined in the access_.pl1 program */ 91 /* access.set can be: 0 = NO, 1 = ACL_ADDED, or 2 = ACL_REPLACED */ 92 /* access.type can be SEGMENT, DIRECTORY, or MSF */ 93 /* access.old_mode to be reset when ACL_REPLACED */ 94 /* directory path whose access was changed */ 95 /* entryname whose access was changed */ 96 dcl 1 Access aligned based (Access_ptr), 97 2 version char (8), 98 2 set fixed bin, 99 2 type fixed bin (2), 100 2 old_mode bit (36), 101 2 dir char (168) unaligned, 102 2 ent char char (32) unaligned; 103 104 dcl Arg_len fixed bin; /* length of an input argument */ 105 dcl Arg_numb fixed bin; /* counter */ 106 dcl Arg_ptr ptr; /* pointer to an input argument. */ 107 dcl Arg_count fixed bin; /* counter */ 108 109 dcl Area_ptr ptr; 110 dcl Bead_ptr ptr; 111 dcl Bead_storage (1024) fixed bin; 112 dcl Bead_storage_size fixed bin; 113 dcl Beg_line fixed bin (21); /* location of the beginning of the next line */ 114 dcl Bitc fixed bin (24); /* bit count of an input segment */ 115 dcl Cantab_flag bit (1) aligned; 116 dcl Chars_in_line fixed bin (21); /* counter */ 117 dcl Chars_to_remove fixed bin (21); /* counter */ 118 dcl Charx fixed bin; /* counter */ 119 dcl Col fixed bin; /* column position in input scan */ 120 dcl Create_temp_msf_flag bit (1) aligned; 121 dcl Desired_access bit (36); 122 dcl Dn char (168); /* directory name of an input segment. */ 123 dcl Do_not_create_temp_msf_flag bit (1) aligned; 124 dcl Ec fixed bin (35); /* error code */ 125 dcl En char (32); /* entryname of an input segment */ 126 dcl Eof_flag bit (1) aligned; /* set when end of file of an input segment reaches. */ 127 dcl Eqln char (32); /* equal entryname of an output segment. Got from calling expand_pathname_, given an output segment pathname. */ 128 dcl Everytab fixed bin; 129 dcl Fs_util_type char (32); /* determine the type of a specified entry */ 130 dcl Have_infile_flag bit (1) aligned; /* set if an input segment is specified */ 131 dcl Have_outfile_flag bit (1) aligned; /* set if an output segment is specified */ 132 dcl Ii fixed bin (21); /* counter */ 133 dcl In_everytab fixed bin; 134 dcl In_nstops fixed bin; 135 dcl In_msf_comp_bitc fixed bin (24); /* bit count of a component of an input MSF */ 136 /* the number of components in an input MSF */ 137 dcl In_msf_total_original_comps fixed bin (24); 138 dcl Input_msf_comp_index fixed bin; /* the number of components in an input MSF */ 139 dcl Input_msf_comp_ptr ptr; /* pointer to a component of an input msf */ 140 dcl Input_msf_fcb_ptr ptr; /* pointer to the FCB for an input MSF */ 141 dcl In_stops (40) fixed bin; 142 dcl In_stopx fixed bin; 143 dcl Jj fixed bin (21); /* counter */ 144 dcl Kk fixed bin (21); /* counter */ 145 dcl Lth fixed bin (21); /* line length */ 146 dcl Mm fixed bin; /* counter */ 147 dcl Nch fixed bin (21); /* population of Beads */ 148 dcl Next_pos fixed bin; /* number of positions output */ 149 dcl Nonexistent_outfile_flag bit (1) aligned; 150 dcl Nstops fixed bin; 151 dcl Obuf_ptr ptr; /* ptr to output buffer temp */ 152 dcl Out_seg_ptr ptr; /* ptr to an Outc segment. */ 153 dcl Outc_ptr ptr; /* ptr to Outc which holds a line of canonical characters */ 154 dcl Out_dname char (168); /* a directory name contains a specified Outc file (path2) */ 155 dcl Out_ename char (32); /* an entryname of a specified Outc file (path2) */ 156 dcl Outc_len fixed bin (21); /* the length of Outc which holds a line of canonical chars */ 157 dcl Output_segment_length_in_words fixed bin (19); 158 dcl Overwrite_exist_path_flag bit (1); 159 dcl Ox fixed bin (21); /* output line index */ 160 dcl Spaces_to_go fixed bin; /* counter */ 161 dcl Second_temp_seg_ptr ptr; 162 dcl Specified_infile_type fixed bin (2); 163 dcl Specified_temp_file_flag bit (1) aligned; /* set when -temp_file PATH is specified */ 164 dcl Seg_ptr ptr; /* ptr to an input segment. */ 165 dcl Stops (40) fixed bin; 166 dcl Stopx fixed bin; /* counter */ 167 dcl Subroutine_call_flag bit (1) aligned; 168 dcl Tab_flag bit (1) aligned; /* set if insert tabs. */ 169 dcl Target_tabstop fixed bin; 170 dcl Temp_msf_comp_bitc fixed bin (24); /* bit count of an component of an output MSF */ 171 dcl Temp_msf_fcb_ptr ptr; /* pointer to the FCB for an output MSF */ 172 dcl Temp_ptr ptr; 173 dcl Temp_dn char (168); /* directory name contains a temp file */ 174 dcl Temp_en char (32); /* temp file */ 175 dcl Temp_seg_len fixed bin (21); /* the length of a temp seg */ 176 dcl Temp_seg_len_in_chars fixed bin (21); /* the length of a temp seg in characters */ 177 dcl Temp_seg_ptr ptr; /* points to a temp seg */ 178 dcl Temp_msf_total_components fixed bin (24); /* the number of components in a temp MSF */ 179 dcl Temp_msf_comp_index fixed bin; 180 dcl Temp_msf_comp_ptr ptr; /* pointer to an component of an output MSF. */ 181 dcl This_tabstop fixed bin; 182 183 /* based */ 184 185 dcl Arg char (Arg_len) based (Arg_ptr); /* temp storage for for each input argument on the command line. */ 186 187 dcl Bcs char (Lth) based (Seg_ptr) aligned; /* holds the contents of the input file in NONcanonical form */ 188 189 /* Temp storage for a char string in line. It has a char position and char value fields */ 190 dcl 1 Bead (Bead_storage_size) based (Bead_ptr) aligned, 191 2 loc fixed bin (26) unal, 192 2 char char (1) unal; 193 194 dcl Obuf char (512) based (Obuf_ptr); /* holds up to 512 chars of path1 in NONcanonical form */ 195 /* temporary segment holds the contents of path1 in CANONICAL form */ 196 197 dcl Outc char (Outc_len) based (Outc_ptr); /* holds the contents of one line of characters in CANONICAL form */ 198 199 dcl Second_temp_seg char (Temp_seg_len_in_chars) based (Second_temp_seg_ptr); 200 201 dcl Temp_seg char (Temp_seg_len_in_chars) based (Temp_seg_ptr); 202 203 dcl System_area area based (Area_ptr); 204 205 dcl Word_array (Output_segment_length_in_words) bit (36) based; 206 /* an array of an output segment in words. */ 207 208 /* builtin */ 209 dcl ( 210 addr, 211 copy, 212 divide, 213 hbound, 214 index, 215 max, 216 min, 217 null, 218 rank, 219 reverse, 220 rtrim, 221 search, 222 substr, 223 unspec, 224 verify 225 ) builtin; 226 227 /* condition */ 228 dcl (cleanup, record_quota_overflow) condition; 229 230 /* external entries */ 231 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 232 dcl access_$reset entry (ptr, fixed bin (35)); 233 dcl access_$set_temporarily entry (char (*), char (*), fixed bin (2), bit (*), ptr, fixed bin (35)); 234 dcl active_fnc_err_ entry options (variable); 235 dcl archive_$next_component entry (ptr, fixed bin (24), ptr, fixed bin (24), char (*), fixed bin (35)); 236 dcl com_err_ entry options (variable); 237 dcl com_err_$suppress_name entry options (variable); 238 dcl command_query_$yes_no entry () options (variable); 239 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 240 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 241 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 242 dcl delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35)); 243 dcl dm_error_$file_in_use fixed bin (35) external; 244 dcl ( 245 error_table_$active_function, 246 error_table_$archive_pathname, 247 error_table_$bad_arg, 248 error_table_$badopt, 249 error_table_$dirseg, 250 error_table_$empty_file, 251 error_table_$rqover, 252 error_table_$noarg, 253 error_table_$noentry, 254 error_table_$no_m_permission, 255 error_table_$no_r_permission, 256 error_table_$no_w_permission, 257 error_table_$not_seg_type, 258 error_table_$zero_length_seg 259 ) fixed bin (35) external; 260 261 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 262 dcl fs_util_$get_type entry (char (*), char (*), char (*), fixed bin (35)); 263 dcl get_equal_name_ entry (char (*), char (*), char (*), fixed bin (35)); 264 dcl get_group_id_ entry returns (char (32) aligned); 265 dcl get_pdir_ entry returns (char (168)); 266 dcl get_system_free_area_ entry () returns (ptr); 267 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 268 dcl hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35)); 269 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 270 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 271 dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); 272 dcl initiate_file_$create entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35)); 273 dcl msf_manager_$adjust entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35)); 274 dcl msf_manager_$close entry (ptr); 275 dcl msf_manager_$msf_get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); 276 dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35)); 277 dcl object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35)); 278 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 279 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); 280 dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); 281 dcl unique_chars_ entry (bit (*)) returns (char (15)); 282 283 /* like attribute */ 284 dcl 1 oi aligned like object_info; 285 286 /* static constants */ 287 dcl ACL_REPLACED fixed bin (2) int static options (constant) init (2); 288 289 dcl HT char (1) int static options (constant) init (" "); 290 dcl NLVTFF char (3) int static options (constant) init (" 291 "); 292 dcl SP char (1) int static options (constant) init (" "); 293 dcl BS char (1) int static options (constant) init (""); 294 dcl CR char (1) int static options (constant) init (" "); 295 dcl SPBSCRHT char (4) int static options (constant) init ("  "); 296 dcl HTSP char (2) int static options (constant) init (" "); 297 dcl BSCR char (2) int static options (constant) init (" "); 298 299 dcl COMPONENT_ZERO fixed bin int static options (constant) init (0); 300 301 dcl DIRECTORY fixed bin (2) int static options (constant) init (2); 302 dcl MSF fixed bin (2) int static options (constant) init (3); 303 dcl SEGMENT fixed bin (2) int static options (constant) init (1); 304 305 dcl FALSE bit (1) int static options (constant) init ("0"b); 306 dcl TRUE bit (1) int static options (constant) init ("1"b); 307 308 dcl PRECISION_FIXED_BIN_17 fixed bin int static options (constant) init (17); 309 dcl PRECISION_FIXED_BIN_19 fixed bin int static options (constant) init (19); 310 dcl PRECISION_FIXED_BIN_21 fixed bin int static options (constant) init (21); 311 312 dcl SWITCHES bit (6) int static options (constant) init ("100111"b); 313 dcl THREE_BIT_SWITCH bit (3) int static options (constant) init ("111"b); 314 315 dcl ME char (12) int static options (constant) init ("canonicalize"); 316 317 /* -------------------------------------------------------------------------- */ 318 319 /* begin canonicalize main program */ 320 321 call initialization; 322 323 call parsing_input_arguments; 324 if Ec ^= 0 then return; 325 326 if ^Have_infile_flag then do; /* forget path1 */ 327 call com_err_$suppress_name ((0), ME, "Usage: ^a path1 {path2} {-control_args}", ME); 328 return; 329 end; 330 /* prepare access values for later reference */ 331 if ^Have_outfile_flag then 332 Desired_access = RW_ACCESS; /* when wanted to overwrite the original input file (segment or MSF) */ 333 else Desired_access = R_ACCESS; /* otherwise, only "read" access is needed */ 334 335 on cleanup begin; 336 call clean_up; 337 call term_segs; 338 end; 339 340 341 /* mainly proceeds canonicalization of an input file whose type is either a Segment or a Multisegment_file */ 342 call get_temp_segment_ (ME, Outc_ptr, Ec); /* points to a temp storage Outc which holds one line of canincal chars */ 343 if Ec ^= 0 then do; 344 call com_err_ (Ec, ME, "Cannot get temp segment."); 345 return; 346 end; 347 348 if ^Specified_temp_file_flag then do; /* by default, create a temp seg in the process directory */ 349 /* points to a temp storage Temp_seg which holds a segment size of canonical chars */ 350 call get_temp_segment_ (ME, Temp_seg_ptr, Ec); 351 if Ec ^= 0 then do; 352 call com_err_ (Ec, ME, "Cannot get temp segment."); 353 return; 354 end; 355 end; 356 else do; /* -temp_file PATH was specified */ 357 call hcs_$make_seg (Temp_dn, Temp_en, "", RW_ACCESS_BIN, Temp_seg_ptr, Ec); 358 if Ec ^= 0 then do; 359 call com_err_ (Ec, ME, "^a", pathname_ (Temp_dn, Temp_en)); 360 return; 361 end; 362 end; 363 364 /* determine the entry type of an input file path1 and its length in bits */ 365 call hcs_$status_minf (Dn, En, 1, Specified_infile_type, Bitc, Ec); 366 if Ec ^= 0 then do; 367 call com_err_ (Ec, ME, "^a", pathname_ (Dn, En)); 368 call release_temp_segment_ (ME, Outc_ptr, (0)); 369 call release_temp_segment_ (ME, Temp_seg_ptr, (0)); 370 return; 371 end; 372 373 if Specified_infile_type = SEGMENT then 374 call canon_segment; 375 376 else if Specified_infile_type = DIRECTORY then 377 call canon_msf; 378 379 else do; 380 call com_err_ (error_table_$not_seg_type, ME, "^a", pathname_ (Dn, En)); 381 call release_temp_segment_ (ME, Outc_ptr, (0)); 382 call release_temp_segment_ (ME, Temp_seg_ptr, (0)); 383 return; 384 end; 385 386 call clean_up; 387 call term_segs; 388 389 390 return; /* complete canonicalize main program */ 391 392 /* --------------------------------------------------------------------------- */ 393 394 parsing_input_arguments: proc; 395 396 /* evaluate each input argument specified on the command level. */ 397 398 /* begin parsing_input_arguments procedure */ 399 400 Ec = 0; 401 402 call cu_$arg_count (Arg_count, Ec); 403 if Ec ^= 0 then do; 404 if Ec = error_table_$active_function then call active_fnc_err_ (Ec, ME); 405 else call com_err_ (Ec, ME); 406 return; 407 end; 408 409 do Arg_numb = 1 to Arg_count; 410 call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec); 411 if Ec ^= 0 then do; 412 call com_err_ (Ec, ME); 413 return; 414 end; 415 416 if index (Arg, "-") = 1 then do; 417 if Arg = "-output_tabs" | Arg = "-otabs" then do; 418 Tab_flag = TRUE; 419 420 Arg_numb = Arg_numb + 1; 421 if Arg_numb > Arg_count then do; 422 Ec = error_table_$noarg; 423 call com_err_ (Ec, ME); 424 return; 425 end; 426 427 call continue_parsing_arguments; 428 if Ec ^= 0 then return; 429 end; 430 else if Arg = "-no_output_tabs" | Arg = "-notabs" then Tab_flag = FALSE; 431 else if Arg = "-input_tabs" | Arg = "-itabs" then do; 432 Arg_numb = Arg_numb + 1; 433 if Arg_numb > Arg_count then do; 434 Ec = error_table_$noarg; 435 call com_err_ (Ec, ME); 436 return; 437 end; 438 439 call continue_parsing_arguments; 440 if Ec ^= 0 then return; 441 end; 442 else if Arg = "-force" | Arg = "-fc" then Overwrite_exist_path_flag = TRUE; 443 else if Arg = "-no_force" | Arg = "-nfc" then Overwrite_exist_path_flag = FALSE; 444 else if Arg = "-temp_file" | Arg = "-tf" then do; 445 Specified_temp_file_flag = TRUE; 446 447 if Arg_numb = Arg_count then do; /* -temp_file */ 448 Ec = -1; 449 call com_err_ (0, ME, "Missing PATH argument for ^a.", Arg); 450 return; 451 end; 452 else do; /* -temp_file PATH */ 453 Arg_numb = Arg_numb + 1; 454 call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec); 455 if Ec ^= 0 then do; 456 call com_err_ (Ec, ME, "Cannot get PATH argument for -temp_file."); 457 return; 458 end; 459 460 if index (Arg, "-") = 1 then do; 461 /* -temp_file -bad_input_argument */ 462 Ec = error_table_$badopt; 463 call com_err_ (Ec, ME, "^a. Missing PATH argument for -temp_file.", Arg); 464 return; 465 end; 466 467 call expand_pathname_ (Arg, Temp_dn, Temp_en, Ec); 468 if Ec ^= 0 then do; 469 call com_err_ (Ec, ME, "Cannot expand the given PATH argument ^a for -temp_file.", Arg); 470 return; 471 end; 472 /* since the equal convention is allowed to specify a temp file similar to the input file */ 473 call get_equal_name_ (En, Temp_en, Temp_en, Ec); 474 475 if Ec ^= 0 then do; 476 call com_err_ (Ec, ME, "Cannot get an equal name similar to the original input file name ^a", pathname_ (Dn, En)); 477 return; 478 end; 479 end; 480 end; 481 else do; 482 Ec = error_table_$badopt; 483 call com_err_ (Ec, ME, "^a", Arg); 484 return; 485 end; 486 end; 487 else if ^Have_infile_flag then do; 488 call expand_pathname_ (Arg, Dn, En, Ec); 489 if Ec ^= 0 then do; 490 call com_err_ (Ec, ME, "Cannot expand the given input path1 ^a", Arg); 491 return; 492 end; 493 Have_infile_flag = TRUE; 494 end; 495 else if ^Have_outfile_flag then do; 496 Have_outfile_flag = TRUE; 497 call expand_pathname_ (Arg, Out_dname, Eqln, Ec); 498 if Ec ^= 0 then do; /* name for output seg */ 499 call com_err_ (Ec, ME, "Cannot expand the specified output path2 ^a", Arg); 500 return; 501 end; 502 503 call get_equal_name_ (En, Eqln, Out_ename, Ec); 504 if Ec ^= 0 then do; 505 call com_err_ (Ec, ME, "Cannot get an equal name similar to the original file name ^a", pathname_ (Dn, En)); 506 return; 507 end; 508 end; 509 else do; 510 Ec = error_table_$bad_arg; 511 call com_err_$suppress_name (Ec, ME, "Usage: ^a path1 {path2} {-control_args}", ME); 512 return; 513 end; 514 end; 515 516 return; /* return from parsing_input_arguments procedure to canonicalize main program */ 517 518 /* --------------------------------------------------------------------------- */ 519 520 continue_parsing_arguments: proc; 521 522 call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec); 523 if Ec ^= 0 then do; 524 call com_err_ (Ec, ME, "^a", Arg); 525 return; 526 end; 527 528 if Arg = "-every" | Arg = "-ev" then do; 529 Arg_numb = Arg_numb + 1; 530 if Arg_numb > Arg_count then do; 531 Ec = error_table_$noarg; 532 call com_err_ (Ec, ME, "Missing value for ^a", Arg); 533 return; 534 end; 535 536 call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec); 537 if Ec ^= 0 then do; 538 call com_err_ (Ec, ME); 539 return; 540 end; 541 542 if Tab_flag then Everytab = cv_dec_check_ (Arg, Ec); 543 else In_everytab = cv_dec_check_ (Arg, Ec); 544 545 if Ec ^= 0 then do; 546 Ec = error_table_$bad_arg; 547 call com_err_ (Ec, ME, "^a", Arg); 548 return; 549 end; 550 end; 551 else do; 552 if Tab_flag then call grab_tabs (Stops, Nstops); 553 else call grab_tabs (In_stops, In_nstops); 554 555 if Ec ^= 0 then return; 556 end; 557 558 return; /* return to parsing_input_arguments procedure */ 559 560 end continue_parsing_arguments; 561 562 /* --------------------------------------------------------------------------- */ 563 564 grab_tabs: proc (p_stops, p_nstop); 565 566 567 dcl p_nstop fixed bin, /* number of stops set */ 568 p_stops (*) fixed bin; /* array of set tab stops */ 569 570 /* begin grab_tabs procedure */ 571 572 Ec = 0; 573 Kk = 1; 574 do while (Kk < Arg_len); 575 Jj = index (substr (Arg, Kk), ","); 576 if Jj = 0 then Jj = Arg_len - Kk + 2; 577 578 Mm = cv_dec_check_ (substr (Arg, Kk, Jj - 1), Ec); 579 if Ec ^= 0 then do; 580 Ec = error_table_$bad_arg; 581 call com_err_ (Ec, ME, "^a", substr (Arg, Kk, Jj - 1)); 582 return; 583 end; 584 585 p_nstop = p_nstop + 1; 586 if p_nstop > hbound (p_stops, 1) - 1 then do; 587 Ec = -1; /* indicates error */ 588 call com_err_ (0, ME, "Too many ^[output^;input^] tabstops: ^d - max is ^d", Tab_flag, Mm, hbound (p_stops, 1) - 1); 589 return; /* we blew it */ 590 end; 591 592 p_stops (p_nstop) = Mm; 593 Kk = Kk + Jj; 594 end; 595 596 return; /* return to parsing_input_arguments. */ 597 598 end grab_tabs; 599 600 /* --------------------------------------------------------------------------- */ 601 602 end parsing_input_arguments; 603 604 /* --------------------------------------------------------------------------- */ 605 606 canonicalize_tabs_: 607 entry (p_input_ptr, p_input_len, p_output_ptr, p_output_len, p_tab_flag, p_code); 608 609 dcl p_tab_flag bit (1); /* input parameter */ 610 611 /* begin canonicalize_tabs_ external entry */ 612 613 call initialization; 614 615 Tab_flag = p_tab_flag; 616 if Tab_flag then Everytab = 10; 617 618 goto NON_MSF_COMMON; 619 620 /* ----------------------------------------------------------------------- */ 621 622 canonicalize_: 623 entry (p_input_ptr, p_input_len, p_output_ptr, p_output_len, p_code); 624 625 dcl p_code fixed bin (35); 626 dcl p_input_ptr ptr; 627 dcl p_input_len fixed bin (21); 628 dcl p_output_ptr ptr; 629 dcl p_output_len fixed bin (21); 630 631 /* begin canonicalize_ entry */ 632 633 call initialization; 634 635 NON_MSF_COMMON: 636 p_code = 0; 637 /* prepare canonicalization of the given input file whose type is segment */ 638 Seg_ptr = p_input_ptr; 639 Lth = p_input_len; 640 641 if Lth = 0 then do; /* the given input file is empty */ 642 p_code = error_table_$zero_length_seg; 643 return; 644 end; 645 646 on cleanup call clean_up; 647 648 call get_temp_segment_ (ME, Outc_ptr, p_code); /* each line of the input file is canonicalized and then a line of */ 649 /* canonical characters are stored in a temp segment pointed by Outc_ptr pointer */ 650 if p_code ^= 0 then return; 651 652 /* the entire input file is canonicalized and then the entire canonical */ 653 /* characters are stored in a temp segment pointed by Temp_seg_ptr pointer */ 654 call get_temp_segment_ (ME, Temp_seg_ptr, p_code); 655 if p_code ^= 0 then return; 656 /* do not create a temp MSF when canonicalization of an input file */ 657 /* causes a temp segment reach its max seg size while canonicalization is in progress */ 658 Do_not_create_temp_msf_flag = TRUE; 659 660 call do_canon; /* convert the contents of the input SSF into a canonical form */ 661 662 if Ec ^= 0 then p_code = Ec; 663 else do; 664 p_output_ptr -> Temp_seg = Temp_seg; /* copy Temp_seg into a specified output file whose type is segment */ 665 p_output_len = Temp_seg_len_in_chars; /* update the length of the output file */ 666 end; 667 668 Seg_ptr = null; 669 670 call clean_up; 671 672 return; /* complete either canonicalize_tabs_ or canonicalize_ */ 673 674 /* --------------------------------------------------------------------------- */ 675 676 validate_access: proc (p_dir, p_ename, p_type, p_desired_access, p_overwritten_flag); 677 678 /* validate the access modes of the directory input parameter. If that */ 679 /* directory doesn't have a "modify" mode then canon reports an error. */ 680 /* Otherwise, an appropriate queried message will be printed when an user */ 681 /* wanted to overwrite an input path1 or a specified existent output path2, */ 682 /* but he either did not have a "write" access mode to it or has a */ 683 /* sufficient access (rew or rw) to it. */ 684 /* For the case of unsufficient access, if he answers yes to the question, */ 685 /* a "write" mode is TEMPORARILY set on it. Otherwise, canon returns to the */ 686 /* command level. */ 687 688 /* in/out parameters */ 689 dcl p_desired_access bit (*); /* input */ 690 dcl (p_dir, p_ename) char (*); /* input */ 691 dcl p_type char (*); /* input */ 692 dcl p_overwritten_flag bit (1); /* input/output */ 693 694 /* local */ 695 dcl full_pathname char (168); 696 dcl grand_dn char (168); 697 dcl mode fixed bin (5); 698 dcl msf_directory_pathname char (168); 699 dcl parents_dn char (32); 700 dcl ring fixed bin; 701 dcl user_id char (32); 702 703 /* begin validate_access procedure */ 704 705 Ec = 0; 706 full_pathname = " "; 707 grand_dn = " "; 708 mode = 0; 709 msf_directory_pathname = " "; 710 parents_dn = " "; 711 ring = -1; /* indicates that a default value of the validation level of the calling process is used */ 712 user_id = " "; 713 714 on cleanup call clean_up; 715 716 call absolute_pathname_ (p_dir, full_pathname, Ec); 717 if Ec ^= 0 then do; 718 call com_err_ (Ec, ME, "Cannot get the absolute pathname of the directory ^a", p_dir); 719 return; 720 end; 721 call expand_pathname_ (full_pathname, grand_dn, parents_dn, Ec); 722 if Ec ^= 0 then do; 723 call com_err_ (Ec, ME, "Cannot expand the directory ^a", full_pathname); 724 return; 725 end; 726 727 user_id = get_group_id_ (); 728 call hcs_$get_user_effmode (grand_dn, parents_dn, user_id, ring, mode, Ec); 729 if Ec ^= 0 then do; 730 call com_err_ (Ec, ME, "Cannot get the user effective mode of directory ^a", pathname_ (grand_dn, parents_dn)); 731 return; 732 end; 733 734 if (mode ^= M_ACCESS_BIN) & (mode ^= SM_ACCESS_BIN) & (mode ^= SMA_ACCESS_BIN) then do; 735 Ec = error_table_$no_m_permission; 736 call com_err_ (Ec, ME, "^a", pathname_ (grand_dn, parents_dn)); 737 return; 738 end; 739 740 if p_type = FS_OBJECT_TYPE_SEGMENT then do; 741 call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to update the protected file ^a?", pathname_ (p_dir, p_ename)); 742 if ^p_overwritten_flag then return; 743 744 call access_$set_temporarily (p_dir, p_ename, SEGMENT, p_desired_access, Access_ptr, Ec); 745 if Ec ^= 0 then do; 746 call com_err_ (Ec, ME, "Cannot set ""write"" access mode on ^a", pathname_ (p_dir, p_ename)); 747 return; 748 end; 749 end; 750 751 if p_type = FS_OBJECT_TYPE_MSF then do; 752 msf_directory_pathname = pathname_ (p_dir, p_ename); 753 call hcs_$get_user_effmode (msf_directory_pathname, "0", user_id, ring, mode, Ec); 754 if Ec ^= 0 then do; 755 call com_err_ (Ec, ME, "Cannot get effective access mode of component 0 for MSF ^a", pathname_ (p_dir, p_ename)); 756 return; 757 end; 758 759 if (mode = N_ACCESS_BIN) | (mode = E_ACCESS_BIN) | (mode = W_ACCESS_BIN) then do; 760 Ec = error_table_$no_r_permission; 761 call com_err_ (Ec, ME, "^a", pathname_ (p_dir, p_ename)); 762 return; 763 end; 764 765 else if (mode = R_ACCESS_BIN) | (mode = RE_ACCESS_BIN) then do; 766 call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to update the protected file ^a?", 767 pathname_ (p_dir, p_ename)); 768 if ^p_overwritten_flag then return; 769 /* add a "write" access mode temporarily on a "read" only MSF */ 770 call access_$set_temporarily (p_dir, p_ename, MSF, p_desired_access, Access_ptr, Ec); 771 if Ec ^= 0 then do; 772 call com_err_ (Ec, ME, "Cannot set ""write"" access mode on ^a", pathname_ (p_dir, p_ename)); 773 return; 774 end; 775 end; 776 /* ask for overwritten a specified existent MSF after finding that */ 777 /* it has a sufficient ACL (either RW_ACCESS_BIN or REW_ACCESS_BIN */ 778 else call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (p_dir, p_ename)); 779 end; 780 781 return; 782 783 end validate_access; 784 785 /* --------------------------------------------------------------------------- */ 786 787 canon_msf: proc; 788 789 /* given an input file whose type is MSF, an user's request was wanted to */ 790 /* convert its NONCANONICAL characters into a CANONICAL form. */ 791 /* The canonical data can be put either back into that input file if wanted */ 792 /* to overwrite it (e.g. canon infile_MSF) or into a specified output */ 793 /* file (e.g. canon infile_MSF existent_or_nonexistent_outfile). Note */ 794 /* that a specified output file can be ALREADY existed in an user's working */ 795 /* working directory or NOT existed yet. */ 796 /* */ 797 /* If an output path2 is specified and is not existed yet in the current */ 798 /* working directory, it will be created in one of the following methods: */ 799 /* (a) by calling initiate_file_$create when canonicalization of the */ 800 /* input MSF gives canonical characters which are stored in the */ 801 /* Temp_seg and Temp_seg length has NEVER reached its max segment */ 802 /* length. */ 803 /* (b) by creating a temporary MSF when canonicalization of the input */ 804 /* MSF gives canonical characters which are stored in the Temp_seg */ 805 /* and Temp_seg length has reached its maximum segment length */ 806 /* AT LEAST ONCE while canonicalization is in progress. This causes */ 807 /* a temp MSF to be created to copy Temp_seg's contents into an */ 808 /* appropriate component of the temp MSF in order to continue */ 809 /* canonicalization of the remaining components of the input MSF. */ 810 /* */ 811 /* There are two cases for processing canonicalization of the original */ 812 /* inut file whose entry type is Multissegment file (MSF): */ 813 /* Case 1: MSF canonicalize MSF (unchanged: type is unchanged) */ 814 /* Canonicalization of an input file, whose type is MSF, gives */ 815 /* canonical characters to be stored in an output file. */ 816 /* The length of the canonical output file is GREATER than the */ 817 /* max length of a segment. So its type is MSF which is the same */ 818 /* type as the type of the noncanonical input file path1. */ 819 /* */ 820 /* Case 2: MSF canonicalize SSF (shrink: type changed from MSF to SSF) */ 821 /* Canonicalization of an input file path1, whose type is MSF, */ 822 /* gives canonical characters to be stored in an output file. */ 823 /* The length of the canonical output file is LESS or EQUAL than */ 824 /* the max length of a segment. So the type of the canonical */ 825 /* output file is SSF which is different type with the */ 826 /* noncanonical input file path1 whose type is MSF. */ 827 /* */ 828 829 830 /* begin canon_msf procedure */ 831 832 In_msf_total_original_comps = Bitc; /* save the total components of the input path1 MSF for later reference */ 833 834 on cleanup call clean_up; 835 836 if Bitc = 0 then do; /* the input path1 is a directory type which is not allowed for canon. */ 837 call com_err_ (error_table_$dirseg, ME, "Cannot canonicalize a directory. ^a", pathname_ (Dn, En)); 838 return; 839 end; 840 /* make sure that acceptable path1 type is either segment or Multisegment-file. */ 841 call get_specified_file_type (Dn, En, Fs_util_type); 842 if Ec ^= 0 then return; 843 844 if ^Have_outfile_flag then do; /* only an input path1 is specified */ 845 call validate_access (Dn, En, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag); 846 if Ec ^= 0 then return; 847 848 if ^Overwrite_exist_path_flag then return; /* did not want to overwrite the input path2 MSF */ 849 end; 850 else do; /* an output file path2 is specified */ 851 call initiate_specified_output_file; 852 if Ec ^= 0 then return; 853 /* the specified output file path2 exists and do not want to overwrite it */ 854 if ^Nonexistent_outfile_flag & ^Overwrite_exist_path_flag then return; 855 end; 856 857 /* open the specified input path1 whose type is MSF */ 858 call msf_manager_$open (Dn, En, Input_msf_fcb_ptr, Ec); 859 if Ec ^= 0 then do; 860 call com_err_ (Ec, ME, "Cannot open MSF input file. ^a", pathname_ (Dn, En)); 861 return; 862 end; 863 /* for each component of input path1 MSF, call do_canon to convert */ 864 /* its noncanonical data into a canonical data which stored in Temp_seg */ 865 do Input_msf_comp_index = COMPONENT_ZERO to (In_msf_total_original_comps - 1); 866 /* get a specified component of the input file path1 whose type is MSF */ 867 call msf_manager_$msf_get_ptr (Input_msf_fcb_ptr, Input_msf_comp_index, FALSE, Input_msf_comp_ptr, In_msf_comp_bitc, Ec); 868 if Ec ^= 0 then do; /* the input MSF and the temp MSF will be closed in the clean_up internal proc */ 869 if Seg_ptr ^= null then /* sp points to a specified component of the input file (MSF) path1 */ 870 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of the input MSF */ 871 call com_err_ (Ec, ME, "Cannot get component ^d of input MSF ^a.", Input_msf_comp_index, pathname_ (Dn, En)); 872 return; 873 end; 874 875 Seg_ptr = Input_msf_comp_ptr; /* prepare for converting a particular component's contents into a canonical form */ 876 /* calculate the length of that component in characters */ 877 Lth = divide (In_msf_comp_bitc + (BITS_PER_CHAR - 1), BITS_PER_CHAR, PRECISION_FIXED_BIN_21, 0); 878 879 if Lth = 0 then do; 880 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of an input MSF */ 881 Ec = error_table_$empty_file; 882 call com_err_ (Ec, ME, "The component ^d of the input MSF ^a is empty.", Input_msf_comp_index, rtrim (pathname_ (Dn, En))); 883 return; 884 end; 885 886 call do_canon; /* perform canonicalization of a specified component of the input MSF */ 887 888 if Ec ^= 0 then do; /* the input MSF path1 and temp MSF will be closed in the clean_up int.proc */ 889 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of an input MSF */ 890 return; 891 end; 892 893 Eof_flag = FALSE; /* prepare to convert the next component's contents of the input MSF into a canonical form */ 894 end; /* complete read in components of the input path1 MSF */ 895 896 if ^Create_temp_msf_flag then do; /* case: MSF canonicalize SSF SHRUNK */ 897 if ^Have_outfile_flag then do; /* wanted to overwrite the input path1 MSF */ 898 call copy_temp_seg_into_msf (Dn, En, Input_msf_fcb_ptr, COMPONENT_ZERO, Input_msf_comp_ptr, In_msf_comp_bitc, 899 Temp_msf_total_components); 900 if Ec ^= 0 then return; 901 902 call msf_manager_$adjust (Input_msf_fcb_ptr, COMPONENT_ZERO, In_msf_comp_bitc, THREE_BIT_SWITCH, Ec); 903 if Ec ^= 0 then do; /* the input MSF path1 will be closed in the clean_up internal proc. */ 904 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of an input MSF */ 905 call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a", COMPONENT_ZERO, rtrim (pathname_ (Dn, En))); 906 return; 907 end; 908 end; /* only the input path1 was specified */ 909 else do; /* output path2 was specified */ 910 if Out_seg_ptr ^= null then /* the specified output path2 exists and its type is SSF */ 911 /* put the contents of Temp_seg into a specified existent output path2 SSF */ 912 call copy_temp_seg_into_segment; 913 914 else if Nonexistent_outfile_flag then do; 915 /* output path2 was specified and did not exist yet since Out_seg_ptr value is null */ 916 /* so, creates and initiates the specified nonexistent output path2 */ 917 call initiate_file_$create (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Nonexistent_outfile_flag, Bitc, Ec); 918 if Ec ^= 0 then do; /* will close the input MSF path1 in the clean_up internal proc. */ 919 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of an input MSF */ 920 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 921 return; 922 end; 923 /* copy the contents of Temp_seg into a newly created segment */ 924 call copy_temp_seg_into_segment; 925 end; /* output path2 was specified and did not exist yet */ 926 927 else if Fs_util_type = FS_OBJECT_TYPE_MSF then do; 928 /* copy Temp_seg into the specified output path2 whose type is MSF */ 929 call copy_temp_seg_into_spec_pth2_MSF; 930 if Ec ^= 0 then do; /* will close the input MSF path1 in the clean_up internal proc. */ 931 Seg_ptr = null; /* do not call terminate_file_ to terminate the current component of an input MSF */ 932 return; 933 end; 934 end; /* copy Temp_seg into a specified existent path2 whose type is MSF */ 935 end; /* copy Temp_seg into a specified path2 whose type is either SSF or MSF */ 936 end; /* case: MSF canonicalize SSF SHRUNK */ 937 else do; /* case: MSF canonicalize MSF UNCHANGED */ 938 if Temp_seg_len_in_chars > 0 then do; 939 call temp_seg_to_temp_msf; /* copy Temp_seg into a the next created component of a temp MSF */ 940 if Ec ^= 0 then return; /* will close the input MSF path1 in the clean_up; temp MSF is already closed */ 941 end; 942 943 if ^Have_outfile_flag then do; /* only the input MSF path1 was specified */ 944 call temp_msf_to_infile_or_outfile (Dn, En); 945 if Ec ^= 0 then return; 946 end; 947 else do; 948 /* open the specified output file path2 */ 949 call msf_manager_$open (Out_dname, Out_ename, Input_msf_fcb_ptr, Ec); 950 if Ec ^= 0 then do; 951 if Ec ^= error_table_$noentry then do; 952 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 953 return; 954 end; 955 else Ec = 0; /* no problem. It will be created soon by the call to msf_manager_$msf_get_ptr */ 956 end; 957 /* copy temp MSF into the specified output file */ 958 call temp_msf_to_infile_or_outfile (Out_dname, Out_ename); 959 if Ec ^= 0 then return; 960 961 if Out_seg_ptr ^= null then Out_seg_ptr = null; /* points to a specified output SSF path2. Do not call terminate_file_ */ 962 end; /* output file path2 was specified */ 963 end; /* case: MSF canonicalize MSF UNCHANGED */ 964 965 return; 966 967 end canon_msf; 968 969 /* ------------------------------------------------------------------------ */ 970 971 canon_segment: proc; 972 973 /* given an input file whose type is Segment, an user's request was to */ 974 /* convert its NONCANICAL characters into a CANONICAL form. */ 975 /* Canonical chars can be put either back into that input file if wanted */ 976 /* to overwrite it (e.g. canon infile_MSF) or into a specified output */ 977 /* file (e.g. canon infile_MSF existent_or_nonexistent_outfile). Note */ 978 /* that a specified output file can be ALREADY existed in an user's working */ 979 /* working directory or NOT existed yet. */ 980 /* */ 981 /* If an output path2 is specified and is not existed yet in the current */ 982 /* working directory, it will be created in one of the following methods: */ 983 /* (a) by calling initiate_file_$create when canonicalization of the */ 984 /* input SSF gives canonical characters which are stored in the */ 985 /* Temp_seg and Temp_seg length has NEVER reached its max segment */ 986 /* length. */ 987 /* (b) by creating a temporary MSF when canonicalization of the input */ 988 /* SSF gives canonical characters which are stored in the Temp_seg */ 989 /* and Temp_seg length has reached its maximum segment length */ 990 /* AT LEAST ONCE while canonicalization is in progress. This causes */ 991 /* a temp MSF to be created to copy Temp_seg's contents into an */ 992 /* appropriate component of the temp MSF in order to continue */ 993 /* canonicalization of the remaining components of the input SSF. */ 994 /* */ 995 /* There are two cases for processing canonicalization of a specified input */ 996 /* file whose type is segment (SSF). */ 997 /* */ 998 /* Case 1: SSF canonicalize SSF (type is unchanged) */ 999 /* Canonicalization of input file path1, whose type is SSF, gives */ 1000 /* canonical characters to be stored in an output file. */ 1001 /* Because the length of the canonical output file is LESS or EQUAL */ 1002 /* the maximum length of a segment, so the type of the output file */ 1003 /* is SSF which is the same type as the noncanical input file path1 */ 1004 /* */ 1005 /* Case 2: SSF canonicalize MSF (expanded: type is changed from SSF to MSF) */ 1006 /* Canonicalization of input file path1, whose type is SSF, gives */ 1007 /* canonical characters to be stored in an output file. */ 1008 /* Because the max length of canonical output file is GREATER than */ 1009 /* the max length of a segment, so the type of the canonical output */ 1010 /* file is MSF which is different type with the noncanonical input */ 1011 /* file path1 whose type is SSF. */ 1012 /* */ 1013 1014 /* begin canon_segment procedure */ 1015 1016 on cleanup call clean_up; 1017 1018 if Bitc = 0 then do; /* the input path1 whose type is SSF is empty */ 1019 call com_err_ (error_table_$zero_length_seg, ME, "^a", pathname_ (Dn, En)); 1020 return; 1021 end; 1022 /* initiate the input path1 SSF */ 1023 call initiate_file_ (Dn, En, Desired_access, Seg_ptr, Bitc, Ec); 1024 if Ec ^= 0 then do; 1025 if Ec = error_table_$no_w_permission then do;/* do not treat as an error until digging in details */ 1026 Fs_util_type = FS_OBJECT_TYPE_SEGMENT; 1027 call validate_access (Dn, En, Fs_util_type, Desired_access, Overwrite_exist_path_flag); 1028 if Ec ^= 0 then return; 1029 if ^Overwrite_exist_path_flag then return; 1030 /* must reinitiate again to get Seg_ptr pointer pointing to an input SSF path1 */ 1031 call initiate_file_ (Dn, En, Desired_access, Seg_ptr, Bitc, (0)); 1032 end; 1033 else do; 1034 call com_err_ (Ec, ME, "^a", pathname_ (Dn, En)); 1035 return; 1036 end; 1037 end; /* an error occured while initiating the input path1 */ 1038 /* assume had no problem with initiation. Ask for overwritting the input path1 */ 1039 if ^Have_outfile_flag & ^Overwrite_exist_path_flag then do; 1040 call command_query_$yes_no (Overwrite_exist_path_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (Dn, En)); 1041 if ^Overwrite_exist_path_flag then return; 1042 /* at this point, users want to overwrite the input path1 SSF */ 1043 Fs_util_type = FS_OBJECT_TYPE_SEGMENT; /* mark for later reference for the case: SSF canonicalize MSF (expanded) */ 1044 end; 1045 1046 call archive_$next_component (Seg_ptr, Bitc, (null ()), (0), (""), Ec); 1047 if Ec = 0 then do; 1048 Ec = error_table_$archive_pathname; 1049 call com_err_ (Ec, ME, "The specified path is an archive. ^a", pathname_ (Dn, En)); 1050 return; 1051 end; 1052 1053 oi.version_number = object_info_version_2; 1054 call object_info_$brief (Seg_ptr, Bitc, addr (oi), Ec); 1055 if Ec = 0 then do; 1056 Ec = error_table_$bad_arg; 1057 call com_err_ (Ec, ME, "The specified path is an object segment. ^a", pathname_ (Dn, En)); 1058 return; 1059 end; 1060 /* calculate the length of input path1 SSF in characters */ 1061 Lth = divide (Bitc + (BITS_PER_CHAR - 1), BITS_PER_CHAR, PRECISION_FIXED_BIN_21, 0); 1062 1063 if Have_outfile_flag then do; /* output path2 is specified */ 1064 call initiate_specified_output_file; 1065 if Ec ^= 0 then return; 1066 /* the specified output file path2 exists and do not want to overwrite it */ 1067 if ^Nonexistent_outfile_flag & ^Overwrite_exist_path_flag then return; 1068 end; 1069 else Out_seg_ptr = Seg_ptr; /* Out_seg_ptr points to an input file path1 SSF because wanted to overwrite it */ 1070 1071 1072 call do_canon; /* convert the contents of the input SSF into a canonical form */ 1073 if Ec ^= 0 then return; 1074 1075 if ^Create_temp_msf_flag then do; /* case: SSF canonicalize SSF (canonical chars are stored in a temp seg) */ 1076 if Out_seg_ptr ^= null then 1077 /* copy Temp_seg into either the input file (SSF) path1, or */ 1078 /* the specified existent output file (SSF) path2 */ 1079 call copy_temp_seg_into_segment; 1080 1081 else if Nonexistent_outfile_flag then do; /* the specified output file path2 did not exist */ 1082 call initiate_file_$create (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Nonexistent_outfile_flag, Bitc, Ec); 1083 if Ec ^= 0 then do; 1084 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1085 return; 1086 end; 1087 1088 call copy_temp_seg_into_segment; /* copy Temp_seg contents into the newly created output file (SSF) path2 */ 1089 end; 1090 1091 else do; /* the specified existent output path2 is a Multisegment-file (MSF) */ 1092 call copy_temp_seg_into_spec_pth2_MSF; 1093 if Ec ^= 0 then return; 1094 end; /* the specified existent output path2 is a Multisegment-file (MSF) */ 1095 /* terminate the input path1 SSF pointed by Seg_ptr pointer by call terminate_file_ */ 1096 call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0)); 1097 end; /* case: SSF canonicialize SSF */ 1098 else do; /* case: SSF canonicalize MSF */ 1099 if Temp_seg_len_in_chars > 0 then do; /* Temp_seg contains canonical characters */ 1100 call temp_seg_to_temp_msf; /* copy the contents of Temp_seg into a proper component of a temp MSF */ 1101 if Ec ^= 0 then return; 1102 end; 1103 1104 if ^Have_outfile_flag then do; /* for overwritten an input path1 SSF */ 1105 call msf_manager_$open (Dn, En, Input_msf_fcb_ptr, Ec); 1106 if Ec ^= 0 then do; /* will close temp MSF in the clean_up internal proc. */ 1107 call com_err_ (Ec, ME, "^a", pathname_ (Dn, En)); 1108 return; 1109 end; 1110 /* copy the contents of temp msf into the input path1 SSF which converted to MSF */ 1111 call temp_msf_to_infile_or_outfile (Dn, En); 1112 if Ec ^= 0 then return; 1113 1114 Seg_ptr = null; /* don't call terminate_file_ because the input SSF path1 has converted to MSF */ 1115 end; 1116 else do; /* a output path2 was specified */ 1117 /* open either a specified existent output path2 whose type either SSF or MSF */ 1118 /* or a specified nonexistent output file path2 */ 1119 call msf_manager_$open (Out_dname, Out_ename, Input_msf_fcb_ptr, Ec); 1120 if Ec ^= 0 then do; 1121 if Ec ^= error_table_$noentry then do; /* will close the temp MSF in the clean_up internal procedure */ 1122 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1123 return; 1124 end; 1125 else Ec = 0; /* OK for specifying a nonexistent output file path2 */ 1126 /* it will be created when msf_manager_$msf_get_ptr is called */ 1127 end; 1128 /* copy the contents of temp MSF into a specified output file path2 */ 1129 call temp_msf_to_infile_or_outfile (Out_dname, Out_ename); 1130 if Ec ^= 0 then do; 1131 if Nonexistent_outfile_flag then 1132 call delete_$path (Out_dname, Out_ename, SWITCHES, ME, (0)); 1133 return; 1134 end; 1135 /* call terminate_file_ to terminate the input SSF path1 after */ 1136 /* copying the contents of temp MSF into a specified output file path2 */ 1137 call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0)); 1138 end; 1139 end; /* case: SSF CANONICALIZE MSF EXPANDED */ 1140 1141 return; 1142 1143 end canon_segment; 1144 1145 /* --------------------------------------------------------------------------- */ 1146 1147 clean_up: proc; 1148 1149 /* begin clean_up procedure */ 1150 1151 if Access_ptr ^= null then do; /* a write access mode has been temporarily added to a read only file */ 1152 if Create_temp_msf_flag then do; /* a temp MSF has been created earlier */ 1153 1154 if Fs_util_type = FS_OBJECT_TYPE_SEGMENT then do; 1155 /* must take care the ACL of the converted MSF whose original type is SSF */ 1156 Access.type = MSF; /* reinitialize to 3 to indicate that the new entry type is MSF */ 1157 Access.set = ACL_REPLACED; /* prepare to replace the current ACL with its original ACL */ 1158 Access.old_mode = R_ACCESS; /* restore its origial access mode */ 1159 call access_$reset (Access_ptr, (0)); /* replace the current ACL with the original ACL */ 1160 end; /* the original type of the converted path2 MSF was SSF */ 1161 1162 if Fs_util_type = FS_OBJECT_TYPE_MSF then /* the original entry type was MSF */ 1163 call access_$reset (Access_ptr, (0)); /* remove the "write" access mode that temporarily added earlier */ 1164 end; /* a temp MSF was created */ 1165 else if Fs_util_type ^= " " then do; /* a temp MSF has NEVER been created and the entry type is SSF or MSF */ 1166 if Fs_util_type = FS_OBJECT_TYPE_MSF then 1167 /* the original type of the converted path2 SSF was MSF */ 1168 Access.type = SEGMENT; /* update the entry type which is SSF */ 1169 1170 call access_$reset (Access_ptr, (0)); /* remove the "write" access mode that temporarily added earlier */ 1171 end; 1172 end; /* a "write" access mode has been temporarily added to a "read" only in/out file */ 1173 1174 if Input_msf_fcb_ptr ^= null then do; 1175 call msf_manager_$close (Input_msf_fcb_ptr); 1176 if Seg_ptr ^= null then Seg_ptr = null; /* double check since sp pointed to a specified component of an input MSF path1 */ 1177 /* or to the convert input MSF path1 whose original type was SSF */ 1178 end; 1179 1180 if Temp_msf_fcb_ptr ^= null then do; 1181 call msf_manager_$close (Temp_msf_fcb_ptr); 1182 if Out_seg_ptr ^= null then Out_seg_ptr = null; /* double check since Out_seg_ptr pointed to the converted output MSF path2 whose original type is SSF */ 1183 end; 1184 1185 if Temp_ptr ^= null then free Temp_ptr -> Bead; 1186 1187 if Outc_ptr ^= null then 1188 call release_temp_segment_ (ME, Outc_ptr, (0)); 1189 1190 if Temp_seg_ptr ^= null then do; 1191 if ^Specified_temp_file_flag then 1192 call release_temp_segment_ (ME, Temp_seg_ptr, (0)); 1193 else do; 1194 Temp_seg_ptr = null; 1195 call delete_$path (Temp_dn, Temp_en, SWITCHES, ME, (0)); 1196 end; 1197 end; 1198 1199 if Second_temp_seg_ptr ^= null then 1200 call release_temp_segment_ (ME, Second_temp_seg_ptr, (0)); 1201 1202 return; 1203 1204 end clean_up; 1205 1206 /***************************************************************************/ 1207 /* This is part of the clean_up procedure that is not required if the 1208* call has come thru canonicalize_ or canonicalize_tabs_. */ 1209 1210 term_segs: 1211 proc; 1212 1213 if Out_seg_ptr = Seg_ptr then Out_seg_ptr = null; /* Out_seg_ptr also pointed to source since wanted to overwrite the input file path1 */ 1214 1215 if Seg_ptr ^= null then 1216 call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0)); 1217 1218 if Out_seg_ptr ^= null then 1219 call terminate_file_ (Out_seg_ptr, (0), TERM_FILE_TERM, (0)); 1220 1221 end term_segs; 1222 /****************************************************************************/ 1223 1224 /* -------------------------------------------------------------------------- */ 1225 1226 copy_temp_seg_into_msf: proc (p_dn, p_en, p_fcb_ptr, p_comp_index, p_comp_ptr, p_comp_bitc, p_temp_msf_total_components); 1227 1228 /* put the contents of Temp_seg which contains canonical characters into */ 1229 /* either an appropriate component of the temp MSF or component 0 of a */ 1230 /* specified output path2 whose type is MSF. */ 1231 1232 /* parameters */ 1233 dcl (p_dn, p_en) char (*); 1234 dcl (p_comp_ptr, p_fcb_ptr) ptr; 1235 dcl p_comp_index fixed bin; 1236 dcl (p_comp_bitc, p_temp_msf_total_components) fixed bin (24); 1237 1238 /* begin copy_temp_seg_into_msf procedure */ 1239 1240 Ec = 0; 1241 1242 on cleanup call clean_up; 1243 1244 on record_quota_overflow begin; 1245 Ec = error_table_$rqover; 1246 call msf_manager_$close (p_fcb_ptr); 1247 revert record_quota_overflow; 1248 goto temp_seg_to_msf_ERROR_RETURN; 1249 end; 1250 /* want to create a specified component if it doesn't exist yet */ 1251 call msf_manager_$msf_get_ptr (p_fcb_ptr, p_comp_index, TRUE, p_comp_ptr, p_comp_bitc, Ec); 1252 if Ec ^= 0 then do; 1253 call msf_manager_$close (p_fcb_ptr); 1254 1255 if Fs_util_type = FS_OBJECT_TYPE_MSF then 1256 call com_err_ (Ec, ME, "Cannot get component ^d of specified output MSF ^a", p_comp_index, pathname_ (p_dn, p_en)); 1257 else call com_err_ (Ec, ME, "Cannot get component ^d of temp MSF ^a", p_comp_index, pathname_ (p_dn, p_en)); 1258 1259 return; 1260 end; 1261 1262 p_comp_ptr -> Temp_seg = Temp_seg; /* copy the contents of Temp_seg into into a specified component */ 1263 1264 if (p_comp_index = 0) & (p_temp_msf_total_components = 0) then 1265 /* case of a specified path2 is nonexistent and a temp MSF has been created */ 1266 p_temp_msf_total_components = 1; /* update the total number of components in a temp MSF */ 1267 1268 /* calculate the bitc count of that component */ 1269 p_comp_bitc = Temp_seg_len_in_chars * BITS_PER_CHAR; 1270 1271 temp_seg_to_msf_ERROR_RETURN: 1272 1273 return; 1274 1275 end copy_temp_seg_into_msf; 1276 1277 /* --------------------------------------------------------------------------- */ 1278 1279 copy_temp_seg_into_spec_pth2_MSF: proc; 1280 1281 /* copy the contents of Temp_seg into the component 0 of a specified output */ 1282 /* path2 whose type is MSF. */ 1283 1284 /* begin copy_temp_seg_into_spec_pth2_MSF procedure */ 1285 /* get File control Block pointer */ 1286 call msf_manager_$open (Out_dname, Out_ename, Temp_msf_fcb_ptr, Ec); 1287 if Ec ^= 0 then do; 1288 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1289 return; 1290 end; 1291 /* copy Temp_seg into the component 0 of the specified output path2 MSF */ 1292 call copy_temp_seg_into_msf (Out_dname, Out_ename, Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_ptr, 1293 Temp_msf_comp_bitc, Temp_msf_total_components); 1294 if Ec ^= 0 then return; 1295 /* sets the bit count, truncates, and terminates its component 0 */ 1296 call msf_manager_$adjust (Temp_msf_fcb_ptr, (Temp_msf_comp_index), Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec); 1297 if Ec ^= 0 then do; 1298 call msf_manager_$close (Temp_msf_fcb_ptr); 1299 call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a", Temp_msf_comp_index, pathname_ (Out_dname, Out_ename)); 1300 return; 1301 end; 1302 1303 return; 1304 1305 end copy_temp_seg_into_spec_pth2_MSF; 1306 1307 /* --------------------------------------------------------------------------- */ 1308 1309 copy_temp_seg_into_segment: proc; 1310 1311 /* when canonicalization of an input SSF is finished and Temp_seg length has */ 1312 /* not reached the system defined max length yet, CHARS_PER_SEGMENT, */ 1313 /* copy_temp_seg_into_segment copies the contents of Temp_seg into one */ 1314 /* of the following files: */ 1315 /* (a) the specified output path2. Note that if it did not exist, it */ 1316 /* was created by calling initiate_file_$create earlier. */ 1317 /* (b) the original input path1. */ 1318 1319 1320 dcl output_segment_length_in_bits fixed bin (24); 1321 1322 /* begin copy_temp_seg_into_segment procedure */ 1323 1324 output_segment_length_in_bits = 0; 1325 1326 on cleanup call clean_up; 1327 1328 on record_quota_overflow begin; 1329 Ec = error_table_$rqover; 1330 revert record_quota_overflow; 1331 goto temp_seg_to_segment_ERROR_RETURN; 1332 end; 1333 1334 Output_segment_length_in_words = divide (Temp_seg_len_in_chars + (CHARS_PER_WORD - 1), CHARS_PER_WORD, PRECISION_FIXED_BIN_19, 0); 1335 call terminate_file_ (Out_seg_ptr, (Output_segment_length_in_words), TERM_FILE_TRUNC, Ec); 1336 if Ec ^= 0 then do; 1337 if Out_seg_ptr = Seg_ptr then 1338 call com_err_ (Ec, ME, "^a", pathname_ (Dn, En)); 1339 else call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1340 return; 1341 end; 1342 /* Clear last word used */ 1343 Out_seg_ptr -> Word_array (Output_segment_length_in_words) = FALSE; 1344 1345 Out_seg_ptr -> Temp_seg = Temp_seg; /* copy canonical data into either input path1 or a specified output path2 */ 1346 1347 output_segment_length_in_bits = Temp_seg_len_in_chars * BITS_PER_CHAR; 1348 call terminate_file_ (Out_seg_ptr, (output_segment_length_in_bits), TERM_FILE_BC, Ec); 1349 if Ec ^= 0 then do; 1350 if Out_seg_ptr = Seg_ptr then 1351 call com_err_ (Ec, ME, "^a", pathname_ (Dn, En)); 1352 else call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1353 return; 1354 end; 1355 1356 temp_seg_to_segment_ERROR_RETURN: 1357 call terminate_file_ (Out_seg_ptr, (0), TERM_FILE_TERM, Ec); 1358 1359 return; 1360 1361 end copy_temp_seg_into_segment; 1362 1363 /* -------------------------------------------------------------------------- */ 1364 1365 do_canon: procedure; 1366 1367 /* Each line of either the input segment or the specified component of the */ 1368 /* input MSF is read in. Scan each character in that line to find out */ 1369 /* whether it is a normal character or a specified character. For standard */ 1370 /* characters, no convertion to canonical form is made, just copied them */ 1371 /* into Outc. However, for special characters such as Backspace (BS), SP, */ 1372 /* Carriage return (CR), Horizontal tab (HT), ect., special processing is */ 1373 /* required to convertion them into standard (canonical) form before storing */ 1374 /* in Outc. So, continue to proceed the input line until a slew character */ 1375 /* is found. Then copy the Outc which contains a line of characters in */ 1376 /* standard (canonical) form into the Temp_seg. At this point, canon */ 1377 /* checks the length of Temp_seg in order to decide what actions will be */ 1378 /* taken next if tem_seg length reaches the maximum segment length. */ 1379 /* (a) Assume that the max segment length has not been reached. Read in the */ 1380 /* next input line. Repeat canonicalization of that line. do_canon */ 1381 /* terminates the convertion after the last line of the input segment */ 1382 /* or of a specified component of the input MSF has been converted into */ 1383 /* a canonical form. */ 1384 /* (b) Assume that the max segment length has been reached while */ 1385 /* canonicalization is in progress. A temporarly MSF is created in */ 1386 /* either the process directory with a unique name (by default) or */ 1387 /* in a specified directory (-temp_file was specified). Copy Temp_seg */ 1388 /* which is now full into a specified component of the newly created */ 1389 /* temp MSF. Then clear out the Temp_seg before continuing to put the */ 1390 /* remaining contents of Outc (which is left over) into Temp_seg. */ 1391 /* do_canon terminates the canonicalization of the input file after */ 1392 /* the last line of the input file has been converted. */ 1393 /* */ 1394 /* A "slew" character is a line-terminator (NL, VT, or FF). */ 1395 1396 dcl available_pos_for_insertion fixed bin (21); 1397 dcl next_char_pos fixed bin (21); 1398 dcl remaining_pos_for_insertion fixed bin (21); 1399 dcl slew_index fixed binary (21); 1400 dcl slew_present_flag bit (1); 1401 1402 1403 /* begin do_canon procedure */ 1404 1405 Ec = 0; 1406 available_pos_for_insertion = 0; 1407 remaining_pos_for_insertion = 0; 1408 Obuf_ptr = null; 1409 Beg_line = 1; /* beginning line position */ 1410 1411 on cleanup call clean_up; 1412 1413 Bead_storage_size = hbound (Bead_storage, 1); 1414 1415 Bead_ptr = addr (Bead_storage); 1416 Area_ptr = get_system_free_area_ (); 1417 1418 do while (^Eof_flag); /* scan each existing line of the input (segment or MSF component). */ 1419 Outc_len, Ox = 0; /* clear out Outc which contains a line of caninical chars before continuing */ 1420 /* to convert the next input line into canonical form and store them in Outc */ 1421 Nch = 0; /* no chars seen */ 1422 Obuf_ptr = addr (substr (Bcs, Beg_line, 1)); /* locate begin of line */ 1423 1424 Chars_in_line = search (substr (Bcs, Beg_line), NLVTFF); 1425 /* find end of line */ 1426 if Chars_in_line = 0 then do; /* no more NL or other slew chars remain in input */ 1427 slew_present_flag = FALSE; 1428 Chars_in_line = Lth - Beg_line + 2; 1429 /* include a mythical slew char in count */ 1430 end; 1431 else slew_present_flag = TRUE; /* NL or other slew char found in input */ 1432 1433 Beg_line = Beg_line + Chars_in_line; /* up to begin of next line */ 1434 if Beg_line > Lth then Eof_flag = TRUE; 1435 1436 slew_index = Chars_in_line; 1437 1438 /* Remove trailing SPBSCRHTs. */ 1439 Chars_to_remove = verify (reverse (substr (Obuf_ptr -> Bcs, 1, Chars_in_line - 1)), SPBSCRHT); 1440 if Chars_to_remove = 0 then Chars_to_remove = Chars_in_line; 1441 1442 Chars_in_line = Chars_in_line - Chars_to_remove + 1; 1443 1444 Col, Jj, In_stopx, Stopx, Next_pos = 1; 1445 if search (substr (Obuf_ptr -> Bcs, 1, Chars_in_line - 1), BSCR) ^= 0 then do; /* special processing necessary */ 1446 do while (Jj <= Chars_in_line - 1); /* .. simulating a typewriter */ 1447 if substr (Obuf, Jj, 1) = BS then do; 1448 Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), BS) - 1; 1449 Jj = Jj + Ii; 1450 Col = max (Col - Ii, 1); /* don't backspace off end */ 1451 end; 1452 else if substr (Obuf, Jj, 1) = CR then do; 1453 Col = 1; 1454 Jj = Jj + 1; 1455 end; 1456 else if substr (Obuf, Jj, 1) = HT then do; 1457 Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), HT) - 1; 1458 if In_nstops > 0 then do; 1459 if Col >= In_stops (In_nstops) then Col = Col + Ii; 1460 else do; 1461 do In_stopx = In_stopx to In_nstops + 1 1462 while (Col >= In_stops (In_stopx)); 1463 end; 1464 if In_stopx + Ii > In_nstops then 1465 Col = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops; 1466 else Col = In_stops (In_stopx + Ii - 1); 1467 end; 1468 end; 1469 else Col = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1; 1470 1471 Jj = Jj + Ii; 1472 end; 1473 else if substr (Obuf, Jj, 1) = SP then do; 1474 Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), SP) - 1; 1475 Jj = Jj + Ii; 1476 Col = Col + Ii; 1477 end; 1478 else do; /* printing char */ 1479 Nch = Nch + 1; /* allocate */ 1480 if Nch > Bead_storage_size then do; /* make sure don't blow array */ 1481 Mm = Bead_storage_size; 1482 Bead_storage_size = 2 * Bead_storage_size; 1483 1484 allocate Bead set (Temp_ptr) in (System_area); 1485 1486 Bead_storage_size = Mm; 1487 Temp_ptr -> Bead = Bead; 1488 if Bead_ptr ^= addr (Bead_storage) then free Bead; 1489 1490 Bead_ptr = Temp_ptr; 1491 Bead_storage_size = 2 * Bead_storage_size; 1492 end; 1493 Bead (Nch).char = substr (Obuf, Jj, 1); 1494 Bead (Nch).loc = Col; /* note (aparent) position */ 1495 1496 if (rank (substr (Obuf, Jj, 1)) >= rank (" ") & rank (substr (Obuf, Jj, 1)) <= rank ("~")) then Col = Col + 1; 1497 1498 Jj = Jj + 1; 1499 end; 1500 end; /* looping termination */ 1501 1502 call sort; /* all chars done. sort array */ 1503 1504 Next_pos = 1; /* next output pos */ 1505 do Charx = 1 to Nch; /* now put out the chars in right order */ 1506 if Charx > 1 then do; 1507 if unspec (Bead (Charx)) = unspec (Bead (Charx - 1)) 1508 then goto do_canon_SKIP; 1509 end; 1510 /* Canonical form says no duplicate in same pos */ 1511 Spaces_to_go = Bead (Charx).loc - Next_pos; 1512 /* number of spaces to put */ 1513 if Spaces_to_go > 0 then do; /* if space needed */ 1514 if Tab_flag & Spaces_to_go > 1 then do; /* inserting tabs? */ 1515 if Nstops > 0 then do; 1516 do Stopx = 1 to Nstops while (Next_pos >= Stops (Stopx)); 1517 end; 1518 1519 Cantab_flag = (Stopx <= Nstops); 1520 do while (Cantab_flag & (Bead (Charx).loc >= Stops (Stopx))); 1521 call output (HT); 1522 Next_pos = Stops (Stopx); 1523 Spaces_to_go = Bead (Charx).loc - Next_pos; 1524 /* Recalculate spaces needed. */ 1525 if Stopx >= Nstops then Cantab_flag = FALSE; 1526 else if Stops (Stopx + 1) > Bead (Charx).loc then Cantab_flag = FALSE; 1527 else Stopx = Stopx + 1; 1528 end; 1529 end; 1530 else do; /* -every case */ 1531 Target_tabstop = Everytab * divide (Bead (Charx).loc - 1, Everytab, PRECISION_FIXED_BIN_17, 0) + 1; 1532 1533 do while (Next_pos < Target_tabstop); 1534 call output (HT); 1535 1536 This_tabstop = Everytab * divide (Next_pos - 1 + Everytab, Everytab, PRECISION_FIXED_BIN_17, 0) + 1; 1537 Next_pos = This_tabstop; 1538 Spaces_to_go = Bead (Charx).loc - Next_pos; 1539 /* Recalculate spaces needed */ 1540 end; 1541 end; 1542 end; 1543 1544 do Ii = 1 to Spaces_to_go; /* put out blanks */ 1545 call output (SP); 1546 end; 1547 end; 1548 1549 /* We consider nonprinting characters to not take up space for the purposes of 1550* calculating tabs and so forth, but we don't actually want to separate them 1551* by backspaces. */ 1552 if Spaces_to_go < 0 & (rank (Bead (Charx).char) >= rank (" ") & rank (Bead (Charx).char) <= rank ("~")) 1553 then call output ((BS)); /* never more than one */ 1554 1555 call output (Bead (Charx).char); /* type char out */ 1556 1557 Next_pos = Bead (Charx).loc + 1; /* next column */ 1558 do_canon_SKIP: 1559 end; 1560 end; /* typewriter simulation */ 1561 else do; /* just take the whole line */ 1562 Nch = 1; /* non_zero to start copy */ 1563 1564 if ^Tab_flag then do; /* process case with space fill */ 1565 do while (Nch ^= 0); 1566 Nch = index (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT); /* find HT */ 1567 if Nch = 0 then 1568 Ii = Chars_in_line - Jj; 1569 else Ii = Nch - 1; /* omit the tab in copy */ 1570 if Ii > 0 then do; 1571 Outc_len = Outc_len + Ii; 1572 substr (Outc, Ox + 1, Ii) = substr (Obuf_ptr -> Bcs, Jj, Ii); 1573 1574 do Kk = Jj to (Jj + Ii - 1); 1575 if (rank (substr (Obuf_ptr -> Bcs, Kk, 1)) >= rank (" ") & rank (substr (Obuf_ptr -> Bcs, Kk, 1)) <= rank ("~")) 1576 then Col = Col + 1; 1577 end; 1578 1579 Ox = Ox + Ii; 1580 Jj = Jj + Ii; 1581 end; 1582 1583 if Nch ^= 0 then do; /* fill spaces */ 1584 Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT) - 1; /* take out multiples */ 1585 1586 Next_pos = Col; 1587 if In_nstops > 0 then do; 1588 if Col >= In_stops (In_nstops) then Spaces_to_go = Ii; 1589 else do; 1590 do In_stopx = In_stopx to In_nstops + 1 1591 while (Col >= In_stops (In_stopx)); 1592 end; 1593 1594 if In_stopx + Ii > In_nstops 1595 then Spaces_to_go = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops - Col; 1596 else Spaces_to_go = In_stops (In_stopx + Ii - 1) - Next_pos; 1597 end; 1598 end; 1599 else Spaces_to_go = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1 - Next_pos; /* number of spaces to fill in */ 1600 1601 Outc_len = Outc_len + Spaces_to_go; 1602 substr (Outc, Ox + 1, Spaces_to_go) = copy (SP, Spaces_to_go); 1603 Ox = Ox + Spaces_to_go; 1604 Col = Col + Spaces_to_go; 1605 Jj = Jj + Ii; /* add source space for the tab */ 1606 end; 1607 end; 1608 end; 1609 1610 1611 /* Process Case with Tab Fill */ 1612 else do; 1613 do while (Jj <= Chars_in_line - 1); 1614 1615 /* Clip spacing before section */ 1616 do while (search (substr (Obuf_ptr -> Bcs, Jj, 1), HTSP) ^= 0); 1617 if substr (Obuf_ptr -> Bcs, Jj, 1) = SP then do; 1618 Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), SP) - 1; 1619 Col = Col + Ii; 1620 Jj = Jj + Ii; 1621 end; 1622 else do; 1623 Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT) - 1; 1624 1625 if In_nstops > 0 then do; 1626 if Col >= In_stops (In_nstops) then 1627 Col = Col + Ii; 1628 else do; 1629 do In_stopx = In_stopx to In_nstops + 1 1630 while (Col >= In_stops (In_stopx)); 1631 end; 1632 if In_stopx + Ii > In_nstops then 1633 Col = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops; 1634 else Col = In_stops (In_stopx + Ii - 1); 1635 end; 1636 end; 1637 else Col = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1; 1638 1639 Jj = Jj + Ii; 1640 end; 1641 end; 1642 1643 /* At this point initial white space has been clipped, Col = column after the 1644* white space, and Next_pos = last column printed + 1. Now section through 1645* the tabulation. */ 1646 Spaces_to_go = Col - Next_pos;/* number of spaces to put */ 1647 if Spaces_to_go > 0 then do; /* if space needed */ 1648 if (Tab_flag) & (Spaces_to_go > 1) then do; /* inserting tabs? */ 1649 if Nstops > 0 then do; 1650 if Next_pos > Stops (Nstops) 1651 then goto omit_simple_spaces; /* beyond reach */ 1652 /* Start from last tabstop for scan */ 1653 do Stopx = Stopx to Nstops + 1 1654 while (Next_pos >= Stops (Stopx)); 1655 end; 1656 1657 do Ii = Stopx to Nstops + 1 1658 while (Col >= Stops (Ii)); 1659 end; /* find terminator */ 1660 1661 Ii = Ii - Stopx; /* number of tabs involved */ 1662 if Ii < 1 then goto omit_simple_spaces; /* no tabs involved */ 1663 1664 Spaces_to_go = Col - Stops (Ii + Stopx - 1); /* spaces after last tab */ 1665 end; 1666 else do; /* -every */ 1667 /* tabstop number */ 1668 Target_tabstop = divide (Col - 1, Everytab, PRECISION_FIXED_BIN_17, 0); 1669 /* number of tabs to do */ 1670 Ii = Target_tabstop - divide (Next_pos - 1, Everytab, PRECISION_FIXED_BIN_17, 0); 1671 if Ii < 1 then goto omit_simple_spaces; /* no tabbing involved */ 1672 Spaces_to_go = Col - (Target_tabstop * Everytab + 1); /* spaces left after */ 1673 end; 1674 1675 if Ii > 0 then do; 1676 Outc_len = Outc_len + Ii; 1677 substr (Outc, Ox + 1, Ii) = copy (HT, Ii); 1678 Ox = Ox + Ii; /* Output Horizontal tabs */ 1679 end; 1680 end; 1681 1682 omit_simple_spaces: 1683 if Spaces_to_go > 0 then do; 1684 Outc_len = Outc_len + Spaces_to_go; 1685 substr (Outc, Ox + 1, Spaces_to_go) = copy (SP, Spaces_to_go); 1686 Ox = Ox + Spaces_to_go; 1687 end; 1688 end; 1689 1690 /* Take out a string of text, to next gap. */ 1691 Ii = search (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HTSP) - 1; 1692 if Ii < 1 then 1693 Ii = Chars_in_line - Jj; 1694 1695 Outc_len = Outc_len + Ii; 1696 substr (Outc, Ox + 1, Ii) = substr (Obuf_ptr -> Bcs, Jj, Ii); /* output string */ 1697 Ox = Ox + Ii; 1698 do Kk = Jj to (Jj + Ii - 1); 1699 if (rank (substr (Obuf_ptr -> Bcs, Kk, 1)) >= rank (" ") & rank (substr (Obuf_ptr -> Bcs, Kk, 1)) <= rank ("~")) then 1700 Col = Col + 1; 1701 end; 1702 1703 Jj = Jj + Ii; 1704 Next_pos = Col; 1705 end; /* end of parse loop */ 1706 end; 1707 end; 1708 1709 if slew_present_flag then 1710 /* finally, append the slew char to the Outc which contains a line of CANONINCAL chars */ 1711 call output (substr (Obuf, slew_index, 1)); 1712 1713 /* check the boundary of temp seg after adding an entire line of canonincal chars to it */ 1714 if (Temp_seg_len_in_chars + Outc_len) < CHARS_PER_SEGMENT then do; 1715 /* copy the entire line of canonical chars (stored in Outc) into the Temp_seg */ 1716 next_char_pos = Temp_seg_len_in_chars + 1; 1717 Temp_seg_len_in_chars = Temp_seg_len_in_chars + Outc_len; 1718 substr (Temp_seg, next_char_pos, Outc_len) = Outc; 1719 end; 1720 else do; /* case of reaching the maximum length of Temp_seg */ 1721 /* calculate the number of spaces left in temp seg, then filled up temp seg */ 1722 available_pos_for_insertion = CHARS_PER_SEGMENT - Temp_seg_len_in_chars; 1723 next_char_pos = Temp_seg_len_in_chars + 1; 1724 Temp_seg_len_in_chars = Temp_seg_len_in_chars + available_pos_for_insertion; 1725 substr (Temp_seg, next_char_pos, available_pos_for_insertion) = substr (Outc, 1, available_pos_for_insertion); 1726 1727 if Do_not_create_temp_msf_flag then do; 1728 /* the canonicalize_tab_ and canonincal_ entries don't want to expand path1 SSF into MSF */ 1729 Ec = error_table_$rqover; 1730 return; 1731 end; 1732 /* temp seg containing canonical characters is full */ 1733 if ^Create_temp_msf_flag then do; 1734 Create_temp_msf_flag = TRUE; 1735 1736 if ^Specified_temp_file_flag then do; /* by default: prepare to create a temp MSF in the process directory with an unique name */ 1737 Temp_dn = get_pdir_ (); 1738 Temp_en = unique_chars_ (FALSE); 1739 end; 1740 else do; /* a temp segment ws created ealier by hcs_$make_seg when -tf was given */ 1741 /* this specified temp segment will be converted to a temp MSF very soon. */ 1742 /* So, canon must get another temp seg for continuing canonicalization. */ 1743 call get_temp_segment_ (ME, Second_temp_seg_ptr, Ec); 1744 if Ec ^= 0 then do; 1745 call com_err_ (Ec, ME, "Cannot get temp segment."); 1746 return; 1747 end; 1748 /* copy the specified temp segment's contents into another temp segment */ 1749 Second_temp_seg_ptr -> Second_temp_seg = Temp_seg_ptr -> Temp_seg; 1750 /* assign Temp_seg_ptr points to another temp segment */ 1751 /* such that the remaining canonical chars will be stored in the second temp seg */ 1752 /* and the specified temp segment in a specified directory will be */ 1753 /* converted into a temp MSF by calling msf_manager_$msf_get_ptr soon */ 1754 /* in the call to copy_temp_seg_into_msf internal procedure */ 1755 Temp_seg_ptr = Second_temp_seg_ptr; 1756 1757 Second_temp_seg_ptr = null; /* no need */ 1758 end; 1759 /* open temp MSF. Wants a pointer that points to the FCB of the temp MSF */ 1760 call msf_manager_$open (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Ec); 1761 if Ec ^= 0 then do; 1762 if Ec ^= error_table_$noentry then do; 1763 call com_err_ (Ec, ME, "^a", pathname_ (Temp_dn, Temp_en)); 1764 return; 1765 end; 1766 else Ec = 0; /* OK for temp MSF not found. It will be created in copy_temp_seg_into_msf */ 1767 end; 1768 end; 1769 /* prepare to request a component greater than 0 */ 1770 if Temp_msf_total_components > 0 then do; 1771 Temp_msf_comp_index = Temp_msf_total_components; 1772 Temp_msf_total_components = Temp_msf_total_components + 1; 1773 end; 1774 1775 /* copy tem_seg into an appropriate component of a newly created temp MSF */ 1776 call copy_temp_seg_into_msf (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Temp_msf_comp_index, 1777 Temp_msf_comp_ptr, Temp_msf_comp_bitc, Temp_msf_total_components); 1778 if Ec ^= 0 then return; 1779 1780 Temp_seg_len_in_chars = 0; /* clear out Temp_seg to indicate it is now empty. */ 1781 /* Is any char left in the Outc after filled up tem_seg? */ 1782 remaining_pos_for_insertion = Outc_len - available_pos_for_insertion; 1783 if remaining_pos_for_insertion > 0 then do; 1784 /* copy left over canonical characters from the Outc into Temp_seg */ 1785 Temp_seg_len_in_chars = remaining_pos_for_insertion; 1786 substr (Temp_seg, 1, remaining_pos_for_insertion) = substr (Outc, available_pos_for_insertion + 1, remaining_pos_for_insertion); 1787 end; 1788 end; /* case of reaching the boundary of Temp_seg */ 1789 end; /* end of do while (^Eof_flag) */ 1790 1791 return; /* return from do_canon procedure */ 1792 1793 /* --------------------------------------------------------------------------- */ 1794 1795 output: proc (p_slew_char); 1796 1797 /* append a slew character (NL, VT, or FF) to Outc which contains a line */ 1798 /* of canonical (standard) characters. */ 1799 1800 dcl p_slew_char char (1); /* input parameter */ 1801 1802 /* begin output procedure which is called by do_canon procedure */ 1803 1804 Outc_len, Ox = Ox + 1; /* update canonical line length. Also update output line index */ 1805 substr (Outc, Ox, 1) = p_slew_char; /* append a slew character to a line of canonical character */ 1806 1807 return; /* return to do_canon procedure */ 1808 1809 end output; 1810 1811 /* -------------------------------------------------------------------------- */ 1812 1813 sort: proc; 1814 1815 /* Sort characters in Bead array of record. Bead contains characters */ 1816 /* and corresponding character positions in the current line. Nch is */ 1817 /* the actual upper bound of the array. */ 1818 1819 dcl d fixed bin; 1820 dcl i fixed bin; 1821 dcl swaps fixed bin; 1822 dcl temp bit (36) aligned; 1823 1824 /* begin sort procedure */ 1825 1826 d = Nch; /* get the actual max array index */ 1827 1828 sort_pass: 1829 swaps = 0; /* prepare to sort characters in alphabetic order */ 1830 1831 d = divide (d + 1, 2, 17, 0); /* split the entire portion into two equal array portions */ 1832 1833 do i = 1 to Nch - d; /* loop through the upper portion */ 1834 /* compare each character in the upper portion with each character in the lower portion, respectively */ 1835 if unspec (Bead (i)) > unspec (Bead (i + d)) then do; 1836 swaps = swaps + 1; 1837 temp = unspec (Bead (i)); 1838 unspec (Bead (i)) = unspec (Bead (i + d)); 1839 unspec (Bead (i + d)) = temp; 1840 end; 1841 end; 1842 1843 if d > 1 then goto sort_pass; /* continue to split the upper array portion based on upper array portion's update max index */ 1844 1845 if swaps > 0 then goto sort_pass; 1846 1847 return; /* return to do_canon procedure */ 1848 1849 end sort; 1850 1851 /* --------------------------------------------------------------------------- */ 1852 1853 end do_canon; 1854 1855 /* --------------------------------------------------------------------------- */ 1856 1857 get_specified_file_type: proc (p_dn, p_en, p_fs_util_type); 1858 1859 /* get the entry type of a specified file by calling fs_util_$get_type. */ 1860 /* Only accept canonicalization of either a single Segment file (SSF) or */ 1861 /* a Multisegment_file (MSF). */ 1862 1863 /* parameters */ 1864 dcl (p_dn, p_en) char (*); /* input */ 1865 dcl p_fs_util_type char (32); /* in/out */ 1866 1867 /* begin get_specified_file_type procedure */ 1868 1869 Ec = 0; 1870 1871 call fs_util_$get_type (p_dn, p_en, p_fs_util_type, Ec); 1872 if Ec ^= 0 then do; 1873 call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en)); 1874 return; 1875 end; 1876 1877 if p_fs_util_type = FS_OBJECT_TYPE_DIRECTORY then do; 1878 Ec = error_table_$dirseg; 1879 call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en)); 1880 end; 1881 1882 if p_fs_util_type = FS_OBJECT_TYPE_DM_FILE then do; 1883 Ec = dm_error_$file_in_use; 1884 call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en)); 1885 end; 1886 1887 return; 1888 1889 end get_specified_file_type; 1890 1891 /* ------------------------------------------------------------------------ */ 1892 1893 initialization: proc; 1894 1895 /* initializes all automatic variables. They are grouped together */ 1896 /* depending on their data types. For each group, their appearance */ 1897 /* is based on alphabetic order. This purpose is used to speed up canon. */ 1898 1899 /* begin initialization procedure */ 1900 1901 Access_ptr, 1902 Input_msf_comp_ptr, 1903 Input_msf_fcb_ptr, 1904 Outc_ptr, 1905 Out_seg_ptr, 1906 Second_temp_seg_ptr, 1907 Seg_ptr, 1908 Temp_msf_comp_ptr, 1909 Temp_msf_fcb_ptr, 1910 Temp_ptr, 1911 Temp_seg_ptr = null; 1912 1913 Bitc, 1914 Ec, 1915 Everytab, 1916 Input_msf_comp_index, 1917 In_msf_comp_bitc, 1918 In_msf_total_original_comps, 1919 In_nstops, 1920 In_stops (*), 1921 Mm, 1922 Nstops, 1923 Specified_infile_type, 1924 Stops (*), 1925 Temp_msf_comp_bitc, 1926 Temp_msf_comp_index, 1927 Temp_msf_total_components, 1928 Temp_seg_len, 1929 Temp_seg_len_in_chars = 0; 1930 1931 Dn, 1932 En, 1933 Fs_util_type, 1934 Out_dname, 1935 Out_ename, 1936 Temp_dn, 1937 Temp_en = " "; 1938 1939 Create_temp_msf_flag, 1940 Do_not_create_temp_msf_flag, 1941 Eof_flag, 1942 Have_infile_flag, 1943 Have_outfile_flag, 1944 Overwrite_exist_path_flag, 1945 Nonexistent_outfile_flag, 1946 Specified_temp_file_flag, 1947 Subroutine_call_flag, 1948 Tab_flag = FALSE; 1949 1950 Desired_access = (36)"0"b; 1951 1952 In_everytab = 10; /* by default */ 1953 1954 return; 1955 1956 end initialization; 1957 1958 /* --------------------------------------------------------------------------- */ 1959 1960 initiate_specified_output_file: proc; 1961 1962 /* initiate the specified output file path2. If suceeds initiatation, ask */ 1963 /* for overwritten the specified existent output path2. */ 1964 1965 /* begin initiate_specified_output_file procedure */ 1966 1967 Ec = 0; 1968 1969 call initiate_file_ (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Bitc, Ec); 1970 if Ec ^= 0 then do; 1971 if Ec = error_table_$noentry then do; /* it's OK for a specified NONEXISTENT output path2. Will make it exist later on */ 1972 /* depending on either case MSF canonicalize MSF or MSF canonicalize SSF */ 1973 Ec = 0; 1974 Nonexistent_outfile_flag = TRUE; /* mark that the specified output path2 does not exist. */ 1975 end; 1976 1977 else if Ec = error_table_$no_w_permission then do; 1978 /* do not treat as an error until digging in details */ 1979 Fs_util_type = FS_OBJECT_TYPE_SEGMENT; 1980 call validate_access (Out_dname, Out_ename, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag); 1981 if Ec ^= 0 then return; 1982 if ^Overwrite_exist_path_flag then return; 1983 /* must reinitiate again to get its pointer value, Out_seg_ptr */ 1984 call initiate_file_ (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Bitc, Ec); 1985 if Ec ^= 0 then do; 1986 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 1987 return; 1988 end; 1989 end; 1990 1991 else if Ec = error_table_$dirseg then do; /* the specified output path2 EXISTS and its type is either directory or MSF */ 1992 /* do not treat as an error until digging in details */ 1993 call get_specified_file_type (Out_dname, Out_ename, Fs_util_type); 1994 if Ec ^= 0 then return; 1995 1996 call validate_access (Out_dname, Out_ename, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag); 1997 if Ec ^= 0 then return; 1998 if ^Overwrite_exist_path_flag then return; 1999 end; /* the specified path2 exists and its type is either directory or MSF */ 2000 else do; 2001 call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename)); 2002 return; 2003 end; 2004 end; /* an error occured while initiating the specified output path2 */ 2005 2006 if ^Overwrite_exist_path_flag & ^Nonexistent_outfile_flag then do; 2007 /* assume had no problem when initiated the specified EXISTENT output path2 */ 2008 call command_query_$yes_no (Overwrite_exist_path_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (Out_dname, Out_ename)); 2009 if ^Overwrite_exist_path_flag then return; 2010 2011 Fs_util_type = FS_OBJECT_TYPE_SEGMENT; 2012 end; 2013 2014 return; 2015 2016 end initiate_specified_output_file; 2017 2018 /* --------------------------------------------------------------------------- */ 2019 2020 temp_seg_to_temp_msf: proc; 2021 2022 /* copies the contents of Temp_seg into the next component of the temp MSF. */ 2023 /* This is done by calling the internal procedure named */ 2024 /* copy_temp_seg_into_msf. Then calls msf_manager_$adjust to set */ 2025 /* the bit count, truncate, and terminate that component. */ 2026 2027 /* begin temp_seg_to_temp_msf procedure */ 2028 2029 if Temp_msf_total_components > 0 then do; /* prepare to create another component in the temp MSF */ 2030 Temp_msf_comp_index = Temp_msf_total_components; 2031 Temp_msf_total_components = Temp_msf_total_components + 1; 2032 end; 2033 /* copy the contents of Temp_seg into a specified component of a temp. MSF */ 2034 call copy_temp_seg_into_msf (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_ptr, 2035 Temp_msf_comp_bitc, Temp_msf_total_components); 2036 if Ec ^= 0 then do; /* close temp MSF */ 2037 call msf_manager_$close (Temp_msf_fcb_ptr); 2038 return; 2039 end; 2040 /* sets the bit count, truncates and terminates the components of the temp. MSF */ 2041 call msf_manager_$adjust (Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec); 2042 if Ec ^= 0 then do; /* close temp MSF */ 2043 call msf_manager_$close (Temp_msf_fcb_ptr); 2044 call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a", Temp_msf_comp_index, pathname_ (Temp_dn, Temp_en)); 2045 return; 2046 end; 2047 2048 return; 2049 2050 end temp_seg_to_temp_msf; 2051 2052 /* --------------------------------------------------------------------------- */ 2053 2054 temp_msf_to_infile_or_outfile: proc (p_dirname, p_enname); 2055 2056 /* copy each component of a temp MSF into the corresponding component of */ 2057 /* either the input file path1 or a specified output file path2. */ 2058 /* If path2 was specified and does not exist, the call to */ 2059 /* msf_manager_$msf_get_ptr will create it as a MSF. */ 2060 2061 /* input parameters */ 2062 dcl p_dirname char (*); 2063 dcl p_enname char (*); 2064 2065 /* begin temp_msf_to_infile_or_outfile procedure */ 2066 2067 Ec = 0; 2068 2069 on record_quota_overflow begin; 2070 Ec = error_table_$rqover; 2071 call msf_manager_$close (Input_msf_fcb_ptr); 2072 call msf_manager_$close (Temp_msf_fcb_ptr); 2073 revert record_quota_overflow; 2074 goto temp_msf_ERROR_RETURN; 2075 end; 2076 2077 Temp_seg_len = Temp_seg_len_in_chars; /* save the current length of Temp_seg */ 2078 2079 Temp_seg_len_in_chars = CHARS_PER_SEGMENT; /* prepare to copy full components (whose length has reached the max */ 2080 /* component length) of a temp MSF */ 2081 2082 do Temp_msf_comp_index = COMPONENT_ZERO to (Temp_msf_total_components - 1); 2083 /* prepare to create a specified component */ 2084 Input_msf_comp_index = Temp_msf_comp_index; 2085 /* create a specified component if it does not exist yet */ 2086 call msf_manager_$msf_get_ptr (Input_msf_fcb_ptr, Input_msf_comp_index, TRUE, Input_msf_comp_ptr, In_msf_comp_bitc, Ec); 2087 2088 if Ec ^= 0 then do; 2089 call msf_manager_$close (Input_msf_fcb_ptr); 2090 call msf_manager_$close (Temp_msf_fcb_ptr); 2091 call com_err_ (Ec, ME, "Cannot get component ^d of MSF ^a", Input_msf_comp_index, pathname_ (p_dirname, p_enname)); 2092 return; 2093 end; 2094 /* get a specified component of the temp MSF */ 2095 call msf_manager_$msf_get_ptr (Temp_msf_fcb_ptr, Temp_msf_comp_index, FALSE, Temp_msf_comp_ptr, Temp_msf_comp_bitc, Ec); 2096 if Ec ^= 0 then do; 2097 call com_err_ (Ec, ME, "Cannot get component ^d of MSF ^a.", Input_msf_comp_index, pathname_ (Temp_dn, Temp_en)); 2098 call msf_manager_$close (Input_msf_fcb_ptr); 2099 call msf_manager_$close (Temp_msf_fcb_ptr); 2100 return; 2101 end; 2102 /* have the last component of the temp MSF been reached */ 2103 if Temp_msf_comp_index = (Temp_msf_total_components - 1) then 2104 /* prepare to copy the last component of the temp MSF */ 2105 Temp_seg_len_in_chars = Temp_seg_len; 2106 2107 /* copy the contents of each component of temp MSF into the corresponding */ 2108 /* component of either input file path1 or a specified output file path2 */ 2109 Input_msf_comp_ptr -> Temp_seg = Temp_msf_comp_ptr -> Temp_seg; 2110 end; /* complete copied one by one component */ 2111 /* sets bit count, truncates, and terminates the components of that file */ 2112 call msf_manager_$adjust (Input_msf_fcb_ptr, Input_msf_comp_index, Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec); 2113 if Ec ^= 0 then do; 2114 call msf_manager_$close (Input_msf_fcb_ptr); 2115 call msf_manager_$close (Temp_msf_fcb_ptr); 2116 call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a.", Input_msf_comp_index, pathname_ (p_dirname, p_enname)); 2117 return; 2118 end; 2119 2120 temp_msf_ERROR_RETURN: 2121 return; 2122 2123 end temp_msf_to_infile_or_outfile; 2124 2125 /* --------------------------------------------------------------------------- */ 2126 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 2127 2128 2 1 /* BEGIN INCLUDE FILE ... object_info.incl.pl1 2 2*coded February 8, 1972 by Michael J. Spier */ 2 3 /* modified May 26, 1972 by M. Weaver */ 2 4 /* modified 15 April, 1975 by M. Weaver */ 2 5 2 6 declare 1 object_info aligned based, /* structure containing object info based, returned by object_info_ */ 2 7 2 version_number fixed bin, /* version number of current structure format (=2) */ 2 8 2 textp pointer, /* pointer to beginning of text section */ 2 9 2 defp pointer, /* pointer to beginning of definition section */ 2 10 2 linkp pointer, /* pointer to beginning of linkage section */ 2 11 2 statp pointer, /* pointer to beginning of static section */ 2 12 2 symbp pointer, /* pointer to beginning of symbol section */ 2 13 2 bmapp pointer, /* pointer to beginning of break map (may be null) */ 2 14 2 tlng fixed bin, /* length in words of text section */ 2 15 2 dlng fixed bin, /* length in words of definition section */ 2 16 2 llng fixed bin, /* length in words of linkage section */ 2 17 2 ilng fixed bin, /* length in words of static section */ 2 18 2 slng fixed bin, /* length in words of symbol section */ 2 19 2 blng fixed bin, /* length in words of break map */ 2 20 2 format, /* word containing bit flags about object type */ 2 21 3 old_format bit(1) unaligned, /* on if segment isn't in new format, i.e. has old style object map */ 2 22 3 bound bit(1) unaligned, /* on if segment is bound */ 2 23 3 relocatable bit(1) unaligned, /* on if seg has relocation info in its first symbol block */ 2 24 3 procedure bit(1) unaligned, /* on if segment is an executable object program */ 2 25 3 standard bit(1) unaligned, /* on if seg is in standard format (more than just standard map) */ 2 26 3 gate bit(1) unaligned, /* on if segment is a gate */ 2 27 3 separate_static bit(1) unaligned, /* on if static not in linkage */ 2 28 3 links_in_text bit(1) unaligned, /* on if there are threaded links in text */ 2 29 3 perprocess_static bit (1) unaligned, /* on if static is not to be per run unit */ 2 30 3 pad bit(27) unaligned, 2 31 2 entry_bound fixed bin, /* entry bound if segment is a gate */ 2 32 2 textlinkp pointer, /* ptr to first link in text */ 2 33 2 34 /* LIMIT OF BRIEF STRUCTURE */ 2 35 2 36 2 compiler char(8) aligned, /* name of processor which generated segment */ 2 37 2 compile_time fixed bin(71), /* clock reading of date/time object was generated */ 2 38 2 userid char(32) aligned, /* standard Multics id of creator of object segment */ 2 39 2 cvers aligned, /* generator version name in printable char string form */ 2 40 3 offset bit(18) unaligned, /* offset of name in words relative to base of symbol section */ 2 41 3 length bit(18) unaligned, /* length of name in characters */ 2 42 2 comment aligned, /* printable comment concerning generator or generation of segment */ 2 43 3 offset bit(18) unaligned, /* offset of comment in words relative to base of symbol section */ 2 44 3 length bit(18) unaligned, /* length of comment in characters */ 2 45 2 source_map fixed bin, /* offset, relative to base of symbol section, of source map structure */ 2 46 2 47 /* LIMIT OF DISPLAY STRUCTURE */ 2 48 2 49 2 rel_text pointer, /* pointer to text section relocation info */ 2 50 2 rel_def pointer, /* pointer to definition section relocation info */ 2 51 2 rel_link pointer, /* pointer to linkage section relocation info */ 2 52 2 rel_static pointer, /* pointer to static section relocation info */ 2 53 2 rel_symbol pointer, /* pointer to symbol section relocation info */ 2 54 2 text_boundary fixed bin, /* specifies mod of text section base boundary */ 2 55 2 static_boundary fixed bin, /* specifies mod of internal static base boundary */ 2 56 /* currently not used by system */ 2 57 2 default_truncate fixed bin, /* offset rel to symbp for binder to automatically trunc. symb sect. */ 2 58 2 optional_truncate fixed bin; /* offset rel to symbp for binder to optionally trunc. symb sect. */ 2 59 2 60 declare object_info_version_2 fixed bin int static init(2); 2 61 2 62 /* END INCLUDE FILE ... object_info.incl.pl1 */ 2129 2130 3 1 /* BEGIN INCLUDE FILE ... system_constants.incl.pl1 */ 3 2 3 3 /****^ HISTORY COMMENTS: 3 4* 1) change(86-11-12,GWMay), approve(86-11-12,MCR7445), audit(86-11-19,GDixon), 3 5* install(86-11-21,MR12.0-1223): 3 6* created. 3 7* END HISTORY COMMENTS */ 3 8 3 9 /* format: off */ 3 10 3 11 /* ************************************************************************ */ 3 12 /* */ 3 13 /* Function: Provides constants for commonly used Multics system values. */ 3 14 /* */ 3 15 /* Usage: These values are available for use in place of "magic" numbers */ 3 16 /* (unexplained numbers) in programming applications. */ 3 17 /* */ 3 18 /* Definitions: */ 3 19 /* */ 3 20 /* PER bit character/byte word page segment */ 3 21 /* */ 3 22 /* bits 1 9 36 36864 9400320 */ 3 23 /* characters/bytes 1 4 4096 1044480 */ 3 24 /* words 1 1024 261120 */ 3 25 /* pages 1 255 */ 3 26 /* segments 1 */ 3 27 /* */ 3 28 /* The base values for a bit, char, word and page are determined by the */ 3 29 /* Multics hardware implementation. The other values are calculated from */ 3 30 /* their relation to one another as shown in the matrix above. */ 3 31 /* */ 3 32 /* BITS_PER_CHAR = 9 (defined by the hardware) */ 3 33 /* BITS_PER_WORD = BITS_PER_CHAR * CHARS_PER_WORD */ 3 34 /* = 9 * 4 */ 3 35 /* = 36 */ 3 36 /* BITS_PER_PAGE = BITS_PER_CHAR * CHARS_PER_WORD * CHARS_PER_PAGE */ 3 37 /* = 9 * 4 * 1024 */ 3 38 /* = 36864 */ 3 39 /* BITS_PER_SEGMENT = BITS_PER_CHAR * CHARS_PER_WORD * CHARS_PER_PAGE * */ 3 40 /* PAGES_PER_SEGMENT */ 3 41 /* = 9 * 4 * 1024 * 255 */ 3 42 /* = 9400320 */ 3 43 /* */ 3 44 /* CHARS_PER_WORD = 4 (defined by the hardware) */ 3 45 /* CHARS_PER_PAGE = CHARS_PER_WORD * WORDS_PER_PAGE */ 3 46 /* = 4 * 1024 */ 3 47 /* = 4096 */ 3 48 /* CHARS_PER_SEGMENT = CHARS_PER_WORD * WORDS_PER_PAGE * PAGES_PER_SEGMENT */ 3 49 /* = 4 * 1024 * 255 */ 3 50 /* = 1044480 */ 3 51 /* */ 3 52 /* WORDS_PER_PAGE = 1024 (defined by the hardware) */ 3 53 /* WORDS_PER_SEGMENT = WORDS_PER_PAGE * PAGES_PER_SEGMENT */ 3 54 /* = 1024 * 255 */ 3 55 /* = 261120 */ 3 56 /* */ 3 57 /* PAGES_PER_SEGMENT = 255 (defined by system standard) */ 3 58 /* */ 3 59 /* ************************************************************************ */ 3 60 3 61 declare BITS_PER_CHAR fixed bin (4) internal static 3 62 options (constant) initial (9); 3 63 3 64 declare BITS_PER_WORD fixed bin (6) internal static 3 65 options (constant) initial (36); 3 66 3 67 declare BITS_PER_PAGE fixed bin (16) internal static 3 68 options (constant) initial (36864); 3 69 3 70 declare BITS_PER_SEGMENT fixed bin (24) internal static 3 71 options (constant) initial (9400320); 3 72 3 73 declare CHARS_PER_WORD fixed bin (3) internal static 3 74 options (constant) initial (4); 3 75 3 76 declare CHARS_PER_PAGE fixed bin (13) internal static 3 77 options (constant) initial (4096); 3 78 3 79 declare CHARS_PER_SEGMENT fixed bin (21) internal static 3 80 options (constant) initial (1044480); 3 81 3 82 /* Note: WORDS_PER_PAGE should be equal to sys_info$max_page_size */ 3 83 3 84 declare WORDS_PER_PAGE fixed bin (11) internal static 3 85 options (constant) initial (1024); 3 86 3 87 /* Note: WORDS_PER_SEGMENT should be equal to sys_info$max_seg_size */ 3 88 3 89 declare WORDS_PER_SEGMENT fixed bin (21) internal static 3 90 options (constant) initial (261120); 3 91 3 92 declare PAGES_PER_SEGMENT fixed bin (8) internal static 3 93 options (constant) initial (255); 3 94 3 95 /* END INCLUDE FILE ... system_constants.incl.pl1 */ 3 96 2131 2132 4 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 4 2 /* format: style2,^inddcls,idind32 */ 4 3 4 4 declare 1 terminate_file_switches based, 4 5 2 truncate bit (1) unaligned, 4 6 2 set_bc bit (1) unaligned, 4 7 2 terminate bit (1) unaligned, 4 8 2 force_write bit (1) unaligned, 4 9 2 delete bit (1) unaligned; 4 10 4 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 4 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 4 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 4 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 4 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 4 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 4 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 4 18 4 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 2133 2134 5 1 /* BEGIN INCLUDE FILE: copy_flags.incl.pl1 */ 5 2 5 3 /* Flags for attributes that should/may be copied by the copy_ subroutine. This include file is 5 4* required by suffix_info.incl.pl1 and copy_options.incl.pl1 5 5* 5 6* Jay Pattin 6/23/83 */ 5 7 5 8 declare 1 copy_flags aligned based, /* ON means that this attribute may be copied by copy_ */ 5 9 2 names bit (1) unaligned, 5 10 2 acl bit (1) unaligned, 5 11 2 ring_brackets bit (1) unaligned, 5 12 2 max_length bit (1) unaligned, 5 13 2 copy_switch bit (1) unaligned, 5 14 2 safety_switch bit (1) unaligned, 5 15 2 dumper_switches bit (1) unaligned, 5 16 2 entry_bound bit (1) unaligned, /* only for vanilla object segments */ 5 17 2 extend bit (1) unaligned, /* copy_ may append to end of existing object */ 5 18 2 update bit (1) unaligned, /* copy_ may replace contents of existing object */ 5 19 2 mbz bit (26) unaligned; 5 20 5 21 /* END INCLUDE FILE: copy_flags.incl.pl1 */ 2135 2136 6 1 /* BEGIN INCLUDE FILE: suffix_info.incl.pl1 */ 6 2 /* format: style3,indcomtxt,idind30 */ 6 3 /**** Jay Pattin 2/13/83 6 4* M. Pandolf 1984.11.30 to set FS_OBJECT_TYPE_MSF to -multisegment_file 6 5* 6 6* The include file copy_flags.incl.pl1 must be included in any program using this include file. 6 7* 6 8* This structure is returned by the suffix_XXX_$suffix_info subroutines */ 6 9 6 10 declare suffix_info_ptr ptr; 6 11 6 12 declare 1 suffix_info aligned based (suffix_info_ptr), 6 13 2 version char (8), 6 14 2 type char (32) unaligned, 6 15 2 type_name char (32) unaligned, /* Singular name of the object type, e.g. "mailbox" */ 6 16 2 plural_name char (32) unaligned, /* Plural of above, e.g. "mailboxes" */ 6 17 2 flags unaligned, 6 18 3 standard_object bit (1) unaligned, /* ON if not an extended object (no suffix_XXX_) */ 6 19 3 extended_acl bit (1) unaligned, /* ON if uses extended ACLs, off if regular ACLs */ 6 20 3 has_switches bit (1) unaligned, /* ON if supports switches for objects */ 6 21 3 mbz1 bit (33) unaligned, 6 22 2 modes char (36), /* correspondence between bits and chars for extended modes */ 6 23 2 max_mode_len fixed bin, /* maximum number of modes on an object */ 6 24 2 num_ring_brackets fixed bin, /* number of ring brackets on object */ 6 25 2 copy_flags like copy_flags, /* See copy_flags.incl.pl1 */ 6 26 2 info_pathname char (168) unaligned; 6 27 /* pathname of info segment containing more info */ 6 28 6 29 declare SUFFIX_INFO_VERSION_1 char (8) static options (constant) init ("SUFFIX01"); 6 30 6 31 /* This information is returned by the suffix_XXX_$list_switches subroutines */ 6 32 6 33 declare switch_list_ptr ptr, 6 34 alloc_switch_count fixed bin, 6 35 alloc_switch_name_count fixed bin; 6 36 6 37 declare 1 switch_list aligned based (switch_list_ptr), 6 38 2 version char (8), /* SWITCH_LIST_VERSION_1 */ 6 39 2 switch_count fixed bin, /* total number of switches */ 6 40 2 switch_name_count fixed bin, /* total number of names */ 6 41 2 switches (alloc_switch_count refer (switch_list.switch_count)), 6 42 3 name_index fixed bin, /* index of first name for this switch */ 6 43 3 name_count fixed bin, /* number of names for this switch */ 6 44 3 default_value bit (1) aligned, /* default setting for this switch */ 6 45 3 mbz1 bit (36) aligned, /* reserved for future use */ 6 46 2 names (alloc_switch_name_count refer (switch_list.switch_name_count)) char (32); 6 47 6 48 declare SWITCH_LIST_VERSION_1 char (8) static options (constant) init ("SWLIST01"); 6 49 6 50 declare ( 6 51 FS_OBJECT_TYPE_SEGMENT init ("-segment"), 6 52 FS_OBJECT_TYPE_DIRECTORY init ("-directory"), 6 53 FS_OBJECT_TYPE_MSF init ("-multisegment_file"), 6 54 FS_OBJECT_TYPE_DM_FILE init ("-dm_file"), 6 55 FS_OBJECT_TYPE_LINK init ("-link") 6 56 ) char (32) unaligned int static options (constant); 6 57 6 58 /* END INCLUDE FILE: suffix_info.incl.pl1 */ 2137 2138 2139 end canonicalize; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/12/90 1653.5 canonicalize.pl1 >spec>install>1004>canonicalize.pl1 2127 1 04/11/85 1552.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 2129 2 08/05/77 1122.5 object_info.incl.pl1 >ldd>include>object_info.incl.pl1 2131 3 11/24/86 1343.9 system_constants.incl.pl1 >ldd>include>system_constants.incl.pl1 2133 4 04/06/83 1339.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 2135 5 10/14/83 1706.7 copy_flags.incl.pl1 >ldd>include>copy_flags.incl.pl1 2137 6 03/05/85 1907.3 suffix_info.incl.pl1 >ldd>include>suffix_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. ACL_REPLACED constant fixed bin(2,0) initial dcl 287 ref 1157 Access based structure level 1 dcl 96 Access_ptr 000100 automatic pointer dcl 86 set ref 744* 770* 1151 1156 1157 1158 1159* 1162* 1166 1170* 1901* Area_ptr 000110 automatic pointer dcl 109 set ref 1416* 1484 Arg based char packed unaligned dcl 185 set ref 416 417 417 430 430 431 431 442 442 443 443 444 444 449* 460 463* 467* 469* 483* 488* 490* 497* 499* 524* 528 528 532* 542* 543* 547* 575 578 578 581 581 Arg_count 000106 automatic fixed bin(17,0) dcl 107 set ref 402* 409 421 433 447 530 Arg_len 000102 automatic fixed bin(17,0) dcl 104 set ref 410* 416 417 417 430 430 431 431 442 442 443 443 444 444 449 449 454* 460 463 463 467 467 469 469 483 483 488 488 490 490 497 497 499 499 522* 524 524 528 528 532 532 536* 542 542 543 543 547 547 574 575 576 578 578 581 581 Arg_numb 000103 automatic fixed bin(17,0) dcl 105 set ref 409* 410* 420* 420 421 432* 432 433 447 453* 453 454* 522* 529* 529 530 536* Arg_ptr 000104 automatic pointer dcl 106 set ref 410* 416 417 417 430 430 431 431 442 442 443 443 444 444 449 454* 460 463 467 469 483 488 490 497 499 522* 524 528 528 532 536* 542 543 547 575 578 578 581 581 BITS_PER_CHAR constant fixed bin(4,0) initial dcl 3-61 ref 877 877 1061 1061 1269 1347 BS constant char(1) initial packed unaligned dcl 293 ref 1447 1448 1552 BSCR constant char(2) initial packed unaligned dcl 297 ref 1445 Bcs based char dcl 187 set ref 1422 1424 1439 1445 1566 1572 1575 1575 1584 1616 1617 1618 1623 1691 1696 1699 1699 Bead based structure array level 1 dcl 190 set ref 1185 1484 1487* 1487 1488 1507 1507 1835 1835 1837 1838* 1838 1839* Bead_ptr 000112 automatic pointer dcl 110 set ref 1415* 1487 1488 1488 1490* 1493 1494 1507 1507 1511 1520 1523 1526 1531 1538 1552 1552 1555 1557 1835 1835 1837 1838 1838 1839 Bead_storage 000114 automatic fixed bin(17,0) array dcl 111 set ref 1413 1415 1488 Bead_storage_size 002114 automatic fixed bin(17,0) dcl 112 set ref 1185 1413* 1480 1481 1482* 1482 1484 1486* 1487 1488 1491* 1491 Beg_line 002115 automatic fixed bin(21,0) dcl 113 set ref 1409* 1422 1424 1428 1433* 1433 1434 Bitc 002116 automatic fixed bin(24,0) dcl 114 set ref 365* 832 836 917* 1018 1023* 1031* 1046* 1054* 1061 1082* 1913* 1969* 1984* CHARS_PER_SEGMENT 000042 constant fixed bin(21,0) initial dcl 3-79 ref 1714 1722 2079 CHARS_PER_WORD constant fixed bin(3,0) initial dcl 3-73 ref 1334 1334 COMPONENT_ZERO 000136 constant fixed bin(17,0) initial dcl 299 set ref 865 898* 902* 905* 2082 CR constant char(1) initial packed unaligned dcl 294 ref 1452 Cantab_flag 002117 automatic bit(1) dcl 115 set ref 1519* 1520 1525* 1526* Chars_in_line 002120 automatic fixed bin(21,0) dcl 116 set ref 1424* 1426 1428* 1433 1436 1439 1440 1442* 1442 1445 1446 1448 1457 1474 1566 1567 1584 1613 1618 1623 1691 1692 Chars_to_remove 002121 automatic fixed bin(21,0) dcl 117 set ref 1439* 1440 1440* 1442 Charx 002122 automatic fixed bin(17,0) dcl 118 set ref 1505* 1506 1507 1507 1511 1520 1523 1526 1531 1538 1552 1552 1555 1557* Col 002123 automatic fixed bin(17,0) dcl 119 set ref 1444* 1450* 1450 1453* 1459 1459* 1459 1461 1464* 1466* 1469* 1469 1476* 1476 1494 1496* 1496 1575* 1575 1586 1588 1590 1594 1599 1604* 1604 1619* 1619 1626 1626* 1626 1629 1632* 1634* 1637* 1637 1646 1657 1664 1668 1672 1699* 1699 1704 Create_temp_msf_flag 002124 automatic bit(1) dcl 120 set ref 896 1075 1152 1733 1734* 1939* DIRECTORY constant fixed bin(2,0) initial dcl 301 ref 376 Desired_access 002125 automatic bit(36) packed unaligned dcl 121 set ref 331* 333* 1023* 1027* 1031* 1950* Dn 002126 automatic char(168) packed unaligned dcl 122 set ref 365* 367* 367* 380* 380* 476* 476* 488* 505* 505* 837* 837* 841* 845* 858* 860* 860* 871* 871* 882* 882* 898* 905* 905* 944* 1019* 1019* 1023* 1027* 1031* 1034* 1034* 1040* 1040* 1049* 1049* 1057* 1057* 1105* 1107* 1107* 1111* 1337* 1337* 1350* 1350* 1931* Do_not_create_temp_msf_flag 002200 automatic bit(1) dcl 123 set ref 658* 1727 1939* E_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 759 Ec 002201 automatic fixed bin(35,0) dcl 124 set ref 324 342* 343 344* 350* 351 352* 357* 358 359* 365* 366 367* 400* 402* 403 404 404* 405* 410* 411 412* 422* 423* 428 434* 435* 440 448* 454* 455 456* 462* 463* 467* 468 469* 473* 475 476* 482* 483* 488* 489 490* 497* 498 499* 503* 504 505* 510* 511* 522* 523 524* 531* 532* 536* 537 538* 542* 543* 545 546* 547* 555 572* 578* 579 580* 581* 587* 662 662 705* 716* 717 718* 721* 722 723* 728* 729 730* 735* 736* 744* 745 746* 753* 754 755* 760* 761* 770* 771 772* 842 846 852 858* 859 860* 867* 868 871* 881* 882* 888 900 902* 903 905* 917* 918 920* 930 940 945 949* 950 951 952* 955* 959 1023* 1024 1025 1028 1034* 1046* 1047 1048* 1049* 1054* 1055 1056* 1057* 1065 1073 1082* 1083 1084* 1093 1101 1105* 1106 1107* 1112 1119* 1120 1121 1122* 1125* 1130 1240* 1245* 1251* 1252 1255* 1257* 1286* 1287 1288* 1294 1296* 1297 1299* 1329* 1335* 1336 1337* 1339* 1348* 1349 1350* 1352* 1356* 1405* 1729* 1743* 1744 1745* 1760* 1761 1762 1763* 1766* 1778 1869* 1871* 1872 1873* 1878* 1879* 1883* 1884* 1913* 1967* 1969* 1970 1971 1973* 1977 1981 1984* 1985 1986* 1991 1994 1997 2001* 2036 2041* 2042 2044* 2067* 2070* 2086* 2088 2091* 2095* 2096 2097* 2112* 2113 2116* En 002202 automatic char(32) packed unaligned dcl 125 set ref 365* 367* 367* 380* 380* 473* 476* 476* 488* 503* 505* 505* 837* 837* 841* 845* 858* 860* 860* 871* 871* 882* 882* 898* 905* 905* 944* 1019* 1019* 1023* 1027* 1031* 1034* 1034* 1040* 1040* 1049* 1049* 1057* 1057* 1105* 1107* 1107* 1111* 1337* 1337* 1350* 1350* 1931* Eof_flag 002212 automatic bit(1) dcl 126 set ref 893* 1418 1434* 1939* Eqln 002213 automatic char(32) packed unaligned dcl 127 set ref 497* 503* Everytab 002223 automatic fixed bin(17,0) dcl 128 set ref 542* 616* 1531 1531 1536 1536 1536 1668 1670 1672 1913* FALSE 000136 constant bit(1) initial packed unaligned dcl 305 set ref 430 443 867* 893 1343 1427 1525 1526 1738* 1939 2095* FS_OBJECT_TYPE_DIRECTORY 000020 constant char(32) initial packed unaligned dcl 6-50 ref 1877 FS_OBJECT_TYPE_DM_FILE 000000 constant char(32) initial packed unaligned dcl 6-50 ref 1882 FS_OBJECT_TYPE_MSF 000010 constant char(32) initial packed unaligned dcl 6-50 ref 751 927 1162 1166 1255 FS_OBJECT_TYPE_SEGMENT 000030 constant char(32) initial packed unaligned dcl 6-50 ref 740 1026 1043 1154 1979 2011 Fs_util_type 002224 automatic char(32) packed unaligned dcl 129 set ref 841* 845* 927 1026* 1027* 1043* 1154 1162 1165 1166 1255 1931* 1979* 1980* 1993* 1996* 2011* HT 000054 constant char(1) initial packed unaligned dcl 289 set ref 1456 1457 1521* 1534* 1566 1584 1623 1677 HTSP 020067 constant char(2) initial packed unaligned dcl 296 ref 1616 1691 Have_infile_flag 002234 automatic bit(1) dcl 130 set ref 326 487 493* 1939* Have_outfile_flag 002235 automatic bit(1) dcl 131 set ref 331 495 496* 844 897 943 1039 1063 1104 1939* Ii 002236 automatic fixed bin(21,0) dcl 132 set ref 1448* 1449 1450 1457* 1459 1464 1464 1464 1466 1469 1471 1474* 1475 1476 1544* 1567* 1569* 1570 1571 1572 1572 1574 1579 1580 1584* 1588 1594 1594 1594 1596 1599 1605 1618* 1619 1620 1623* 1626 1632 1632 1632 1634 1637 1639 1657* 1657* 1661* 1661 1662 1664 1670* 1671 1675 1676 1677 1677 1678 1691* 1692 1692* 1695 1696 1696 1697 1698 1703 In_everytab 002237 automatic fixed bin(17,0) dcl 133 set ref 543* 1469 1469 1599 1599 1637 1637 1952* In_msf_comp_bitc 002241 automatic fixed bin(24,0) dcl 135 set ref 867* 877 898* 902* 1913* 2086* In_msf_total_original_comps 002242 automatic fixed bin(24,0) dcl 137 set ref 832* 865 1913* In_nstops 002240 automatic fixed bin(17,0) dcl 134 set ref 553* 1458 1459 1461 1464 1464 1464 1587 1588 1590 1594 1594 1594 1625 1626 1629 1632 1632 1632 1913* In_stops 002250 automatic fixed bin(17,0) array dcl 141 set ref 553* 1459 1461 1464 1466 1588 1590 1594 1596 1626 1629 1632 1634 1913* In_stopx 002320 automatic fixed bin(17,0) dcl 142 set ref 1444* 1461* 1461 1461* 1464 1464 1464 1466 1590* 1590 1590* 1594 1594 1594 1596 1629* 1629 1629* 1632 1632 1632 1634 Input_msf_comp_index 002243 automatic fixed bin(17,0) dcl 138 set ref 865* 867* 871* 882* 1913* 2084* 2086* 2091* 2097* 2112* 2116* Input_msf_comp_ptr 002244 automatic pointer dcl 139 set ref 867* 875 898* 1901* 2086* 2109 Input_msf_fcb_ptr 002246 automatic pointer dcl 140 set ref 858* 867* 898* 902* 949* 1105* 1119* 1174 1175* 1901* 2071* 2086* 2089* 2098* 2112* 2114* Jj 002321 automatic fixed bin(21,0) dcl 143 set ref 575* 576 576* 578 578 581 581 593 1444* 1446 1447 1448 1448 1449* 1449 1452 1454* 1454 1456 1457 1457 1471* 1471 1473 1474 1474 1475* 1475 1493 1496 1496 1498* 1498 1566 1566 1567 1572 1574 1574 1580* 1580 1584 1584 1605* 1605 1613 1616 1617 1618 1618 1620* 1620 1623 1623 1639* 1639 1691 1691 1692 1696 1698 1698 1703* 1703 Kk 002322 automatic fixed bin(21,0) dcl 144 set ref 573* 574 575 576 578 578 581 581 593* 593 1574* 1575 1575* 1698* 1699 1699* Lth 002323 automatic fixed bin(21,0) dcl 145 set ref 639* 641 877* 879 1061* 1422 1424 1428 1434 1439 1445 1566 1572 1575 1575 1584 1616 1617 1618 1623 1691 1696 1699 1699 ME 000044 constant char(12) initial packed unaligned dcl 315 set ref 327* 327* 342* 344* 350* 352* 359* 367* 368* 369* 380* 381* 382* 404* 405* 412* 423* 435* 449* 456* 463* 469* 476* 483* 490* 499* 505* 511* 511* 524* 532* 538* 547* 581* 588* 648* 654* 718* 723* 730* 736* 741* 746* 755* 761* 766* 772* 778* 837* 860* 871* 882* 905* 920* 952* 1019* 1034* 1040* 1049* 1057* 1084* 1107* 1122* 1131* 1187* 1191* 1195* 1199* 1255* 1257* 1288* 1299* 1337* 1339* 1350* 1352* 1743* 1745* 1763* 1873* 1879* 1884* 1986* 2001* 2008* 2044* 2091* 2097* 2116* MSF 000137 constant fixed bin(2,0) initial dcl 302 set ref 770* 1156 M_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 734 Mm 002324 automatic fixed bin(17,0) dcl 146 set ref 578* 588* 592 1481* 1486 1913* NLVTFF 000053 constant char(3) initial packed unaligned dcl 290 ref 1424 N_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 759 Nch 002325 automatic fixed bin(21,0) dcl 147 set ref 1421* 1479* 1479 1480 1493 1494 1505 1562* 1565 1566* 1567 1569 1583 1826 1833 Next_pos 002326 automatic fixed bin(17,0) dcl 148 set ref 1444* 1504* 1511 1516 1522* 1523 1533 1536 1537* 1538 1557* 1586* 1596 1599 1646 1650 1653 1670 1704* Nonexistent_outfile_flag 002327 automatic bit(1) dcl 149 set ref 854 914 917* 1067 1081 1082* 1131 1939* 1974* 2006 Nstops 002330 automatic fixed bin(17,0) dcl 150 set ref 552* 1515 1516 1519 1525 1649 1650 1653 1657 1913* Obuf based char(512) packed unaligned dcl 194 ref 1447 1448 1452 1456 1457 1473 1474 1493 1496 1496 1709 1709 Obuf_ptr 002332 automatic pointer dcl 151 set ref 1408* 1422* 1439 1445 1447 1448 1452 1456 1457 1473 1474 1493 1496 1496 1566 1572 1575 1575 1584 1616 1617 1618 1623 1691 1696 1699 1699 1709 1709 Out_dname 002340 automatic char(168) packed unaligned dcl 154 set ref 497* 917* 920* 920* 949* 952* 952* 958* 1082* 1084* 1084* 1119* 1122* 1122* 1129* 1131* 1286* 1288* 1288* 1292* 1299* 1299* 1339* 1339* 1352* 1352* 1931* 1969* 1980* 1984* 1986* 1986* 1993* 1996* 2001* 2001* 2008* 2008* Out_ename 002412 automatic char(32) packed unaligned dcl 155 set ref 503* 917* 920* 920* 949* 952* 952* 958* 1082* 1084* 1084* 1119* 1122* 1122* 1129* 1131* 1286* 1288* 1288* 1292* 1299* 1299* 1339* 1339* 1352* 1352* 1931* 1969* 1980* 1984* 1986* 1986* 1993* 1996* 2001* 2001* 2008* 2008* Out_seg_ptr 002334 automatic pointer dcl 152 set ref 910 917* 961 961* 1069* 1076 1082* 1182 1182* 1213 1213* 1218 1218* 1335* 1337 1343 1345 1348* 1350 1356* 1901* 1969* 1984* Outc based char packed unaligned dcl 197 set ref 1572* 1602* 1677* 1685* 1696* 1718 1725 1786 1805* Outc_len 002422 automatic fixed bin(21,0) dcl 156 set ref 1419* 1571* 1571 1572 1601* 1601 1602 1676* 1676 1677 1684* 1684 1685 1695* 1695 1696 1714 1717 1718 1718 1725 1782 1786 1804* 1805 Outc_ptr 002336 automatic pointer dcl 153 set ref 342* 368* 381* 648* 1187 1187* 1572 1602 1677 1685 1696 1718 1725 1786 1805 1901* Output_segment_length_in_words 002423 automatic fixed bin(19,0) dcl 157 set ref 1334* 1335 1343 Overwrite_exist_path_flag 002424 automatic bit(1) packed unaligned dcl 158 set ref 442* 443* 845* 848 854 1027* 1029 1039 1040* 1041 1067 1939* 1980* 1982 1996* 1998 2006 2008* 2009 Ox 002425 automatic fixed bin(21,0) dcl 159 set ref 1419* 1572 1579* 1579 1602 1603* 1603 1677 1678* 1678 1685 1686* 1686 1696 1697* 1697 1804 1804* 1805 PRECISION_FIXED_BIN_17 constant fixed bin(17,0) initial dcl 308 ref 1469 1531 1536 1599 1637 1668 1670 PRECISION_FIXED_BIN_19 constant fixed bin(17,0) initial dcl 309 ref 1334 PRECISION_FIXED_BIN_21 constant fixed bin(17,0) initial dcl 310 ref 877 1061 RE_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 765 RW_ACCESS 000043 constant bit(3) initial packed unaligned dcl 1-11 set ref 331 845* 917* 1082* 1969* 1980* 1984* 1996* RW_ACCESS_BIN 000122 constant fixed bin(5,0) initial dcl 1-36 set ref 357* R_ACCESS constant bit(3) initial packed unaligned dcl 1-11 ref 333 1158 R_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 765 SEGMENT 000150 constant fixed bin(2,0) initial dcl 303 set ref 373 744* 1166 SMA_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 734 SM_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 734 SP constant char(1) initial packed unaligned dcl 292 set ref 1473 1474 1545* 1602 1617 1618 1685 SPBSCRHT 000052 constant char(4) initial packed unaligned dcl 295 ref 1439 SWITCHES 000050 constant bit(6) initial packed unaligned dcl 312 set ref 1131* 1195* Second_temp_seg based char packed unaligned dcl 199 set ref 1749* Second_temp_seg_ptr 002430 automatic pointer dcl 161 set ref 1199 1199* 1743* 1749 1755 1757* 1901* Seg_ptr 002434 automatic pointer dcl 164 set ref 638* 668* 869 869* 875* 880* 889* 904* 919* 931* 1023* 1031* 1046* 1054* 1069 1096* 1114* 1137* 1176 1176* 1213 1215 1215* 1337 1350 1422 1424 1901* Spaces_to_go 002426 automatic fixed bin(17,0) dcl 160 set ref 1511* 1513 1514 1523* 1538* 1544 1552 1588* 1594* 1596* 1599* 1601 1602 1602 1603 1604 1646* 1647 1648 1664* 1672* 1682 1684 1685 1685 1686 Specified_infile_type 002432 automatic fixed bin(2,0) dcl 162 set ref 365* 373 376 1913* Specified_temp_file_flag 002433 automatic bit(1) dcl 163 set ref 348 445* 1191 1736 1939* Stops 002436 automatic fixed bin(17,0) array dcl 165 set ref 552* 1516 1520 1522 1526 1650 1653 1657 1664 1913* Stopx 002506 automatic fixed bin(17,0) dcl 166 set ref 1444* 1516* 1516* 1519 1520 1522 1525 1526 1527* 1527 1653* 1653 1653* 1657 1661 1664 Subroutine_call_flag 002507 automatic bit(1) dcl 167 set ref 1939* System_area based area(1024) dcl 203 ref 1484 TERM_FILE_BC 000041 constant bit(2) initial packed unaligned dcl 4-12 set ref 1348* TERM_FILE_TERM 000040 constant bit(3) initial packed unaligned dcl 4-14 set ref 1096* 1137* 1215* 1218* 1356* TERM_FILE_TRUNC 000051 constant bit(1) initial packed unaligned dcl 4-11 set ref 1335* THREE_BIT_SWITCH 000047 constant bit(3) initial packed unaligned dcl 313 set ref 902* 1296* 2041* 2112* TRUE 000051 constant bit(1) initial packed unaligned dcl 306 set ref 418 442 445 493 496 658 1251* 1431 1434 1734 1974 2086* Tab_flag 002510 automatic bit(1) dcl 168 set ref 418* 430* 542 552 588* 615* 616 1514 1564 1648 1939* Target_tabstop 002511 automatic fixed bin(17,0) dcl 169 set ref 1531* 1533 1668* 1670 1672 Temp_dn 002520 automatic char(168) packed unaligned dcl 173 set ref 357* 359* 359* 467* 1195* 1737* 1760* 1763* 1763* 1776* 1931* 2034* 2044* 2044* 2097* 2097* Temp_en 002572 automatic char(32) packed unaligned dcl 174 set ref 357* 359* 359* 467* 473* 473* 1195* 1738* 1760* 1763* 1763* 1776* 1931* 2034* 2044* 2044* 2097* 2097* Temp_msf_comp_bitc 002512 automatic fixed bin(24,0) dcl 170 set ref 1292* 1296* 1776* 1913* 2034* 2041* 2095* 2112* Temp_msf_comp_index 002607 automatic fixed bin(17,0) dcl 179 set ref 1292* 1296 1299* 1771* 1776* 1913* 2030* 2034* 2041* 2044* 2082* 2084 2095* 2103* Temp_msf_comp_ptr 002610 automatic pointer dcl 180 set ref 1292* 1776* 1901* 2034* 2095* 2109 Temp_msf_fcb_ptr 002514 automatic pointer dcl 171 set ref 1180 1181* 1286* 1292* 1296* 1298* 1760* 1776* 1901* 2034* 2037* 2041* 2043* 2072* 2090* 2095* 2099* 2115* Temp_msf_total_components 002606 automatic fixed bin(24,0) dcl 178 set ref 898* 1292* 1770 1771 1772* 1772 1776* 1913* 2029 2030 2031* 2031 2034* 2082 2103 Temp_ptr 002516 automatic pointer dcl 172 set ref 1185 1185 1484* 1487 1490 1901* Temp_seg based char packed unaligned dcl 201 set ref 664* 664 1262* 1262 1345* 1345 1718* 1725* 1749 1786* 2109* 2109 Temp_seg_len 002602 automatic fixed bin(21,0) dcl 175 set ref 1913* 2077* 2103 Temp_seg_len_in_chars 002603 automatic fixed bin(21,0) dcl 176 set ref 664 664 665 938 1099 1262 1262 1269 1334 1345 1345 1347 1714 1716 1717* 1717 1718 1722 1723 1724* 1724 1725 1749 1749 1780* 1785* 1786 1913* 2077 2079* 2103* 2109 2109 Temp_seg_ptr 002604 automatic pointer dcl 177 set ref 350* 357* 369* 382* 654* 664 1190 1191* 1194* 1262 1345 1718 1725 1749 1755* 1786 1901* This_tabstop 002612 automatic fixed bin(17,0) dcl 181 set ref 1536* 1537 W_ACCESS_BIN constant fixed bin(5,0) initial dcl 1-36 ref 759 Word_array based bit(36) array packed unaligned dcl 205 set ref 1343* absolute_pathname_ 000010 constant entry external dcl 231 ref 716 access_$reset 000012 constant entry external dcl 232 ref 1159 1162 1170 access_$set_temporarily 000014 constant entry external dcl 233 ref 744 770 active_fnc_err_ 000016 constant entry external dcl 234 ref 404 addr builtin function dcl 209 ref 1054 1054 1415 1422 1488 archive_$next_component 000020 constant entry external dcl 235 ref 1046 available_pos_for_insertion 000100 automatic fixed bin(21,0) dcl 1396 set ref 1406* 1722* 1724 1725 1725 1782 1786 char 0(27) based char(1) array level 2 packed packed unaligned dcl 190 set ref 1493* 1552 1552 1555* cleanup 002614 stack reference condition dcl 228 ref 335 646 714 834 1016 1242 1326 1411 com_err_ 000022 constant entry external dcl 236 ref 344 352 359 367 380 405 412 423 435 449 456 463 469 476 483 490 499 505 524 532 538 547 581 588 718 723 730 736 746 755 761 772 837 860 871 882 905 920 952 1019 1034 1049 1057 1084 1107 1122 1255 1257 1288 1299 1337 1339 1350 1352 1745 1763 1873 1879 1884 1986 2001 2044 2091 2097 2116 com_err_$suppress_name 000024 constant entry external dcl 237 ref 327 511 command_query_$yes_no 000026 constant entry external dcl 238 ref 741 766 778 1040 2008 copy builtin function dcl 209 ref 1602 1677 1685 copy_flags based structure level 1 dcl 5-8 cu_$arg_count 000030 constant entry external dcl 239 ref 402 cu_$arg_ptr 000032 constant entry external dcl 240 ref 410 454 522 536 cv_dec_check_ 000034 constant entry external dcl 241 ref 542 543 578 d 000142 automatic fixed bin(17,0) dcl 1819 set ref 1826* 1831* 1831 1833 1835 1838 1839 1843 delete_$path 000036 constant entry external dcl 242 ref 1131 1195 divide builtin function dcl 209 ref 877 1061 1334 1469 1531 1536 1599 1637 1668 1670 1831 dm_error_$file_in_use 000040 external static fixed bin(35,0) dcl 243 ref 1883 error_table_$active_function 000042 external static fixed bin(35,0) dcl 244 ref 404 error_table_$archive_pathname 000044 external static fixed bin(35,0) dcl 244 ref 1048 error_table_$bad_arg 000046 external static fixed bin(35,0) dcl 244 ref 510 546 580 1056 error_table_$badopt 000050 external static fixed bin(35,0) dcl 244 ref 462 482 error_table_$dirseg 000052 external static fixed bin(35,0) dcl 244 set ref 837* 1878 1991 error_table_$empty_file 000054 external static fixed bin(35,0) dcl 244 ref 881 error_table_$no_m_permission 000064 external static fixed bin(35,0) dcl 244 ref 735 error_table_$no_r_permission 000066 external static fixed bin(35,0) dcl 244 ref 760 error_table_$no_w_permission 000070 external static fixed bin(35,0) dcl 244 ref 1025 1977 error_table_$noarg 000060 external static fixed bin(35,0) dcl 244 ref 422 434 531 error_table_$noentry 000062 external static fixed bin(35,0) dcl 244 ref 951 1121 1762 1971 error_table_$not_seg_type 000072 external static fixed bin(35,0) dcl 244 set ref 380* error_table_$rqover 000056 external static fixed bin(35,0) dcl 244 ref 1245 1329 1729 2070 error_table_$zero_length_seg 000074 external static fixed bin(35,0) dcl 244 set ref 642 1019* expand_pathname_ 000076 constant entry external dcl 261 ref 467 488 497 721 fs_util_$get_type 000100 constant entry external dcl 262 ref 1871 full_pathname 000100 automatic char(168) packed unaligned dcl 695 set ref 706* 716* 721* 723* get_equal_name_ 000102 constant entry external dcl 263 ref 473 503 get_group_id_ 000104 constant entry external dcl 264 ref 727 get_pdir_ 000106 constant entry external dcl 265 ref 1737 get_system_free_area_ 000110 constant entry external dcl 266 ref 1416 get_temp_segment_ 000112 constant entry external dcl 267 ref 342 350 648 654 1743 grand_dn 000152 automatic char(168) packed unaligned dcl 696 set ref 707* 721* 728* 730* 730* 736* 736* hbound builtin function dcl 209 ref 586 588 1413 hcs_$get_user_effmode 000114 constant entry external dcl 268 ref 728 753 hcs_$make_seg 000116 constant entry external dcl 269 ref 357 hcs_$status_minf 000120 constant entry external dcl 270 ref 365 i 000143 automatic fixed bin(17,0) dcl 1820 set ref 1833* 1835 1835 1837 1838 1838 1839* index builtin function dcl 209 ref 416 460 575 1566 initiate_file_ 000122 constant entry external dcl 271 ref 1023 1031 1969 1984 initiate_file_$create 000124 constant entry external dcl 272 ref 917 1082 loc based fixed bin(26,0) array level 2 packed packed unaligned dcl 190 set ref 1494* 1511 1520 1523 1526 1531 1538 1557 max builtin function dcl 209 ref 1450 min builtin function dcl 209 ref 1464 1594 1632 mode 000224 automatic fixed bin(5,0) dcl 697 set ref 708* 728* 734 734 734 753* 759 759 759 765 765 msf_directory_pathname 000225 automatic char(168) packed unaligned dcl 698 set ref 709* 752* 753* msf_manager_$adjust 000126 constant entry external dcl 273 ref 902 1296 2041 2112 msf_manager_$close 000130 constant entry external dcl 274 ref 1175 1181 1246 1253 1298 2037 2043 2071 2072 2089 2090 2098 2099 2114 2115 msf_manager_$msf_get_ptr 000132 constant entry external dcl 275 ref 867 1251 2086 2095 msf_manager_$open 000134 constant entry external dcl 276 ref 858 949 1105 1119 1286 1760 next_char_pos 000101 automatic fixed bin(21,0) dcl 1397 set ref 1716* 1718 1723* 1725 null builtin function dcl 209 ref 668 869 869 880 889 904 910 919 931 961 961 1046 1076 1114 1151 1174 1176 1176 1180 1182 1182 1185 1187 1190 1194 1199 1213 1215 1218 1408 1757 1901 object_info based structure level 1 dcl 2-6 object_info_$brief 000136 constant entry external dcl 277 ref 1054 object_info_version_2 constant fixed bin(17,0) initial dcl 2-60 ref 1053 oi 002622 automatic structure level 1 dcl 284 set ref 1054 1054 old_mode 4 based bit(36) level 2 dcl 96 set ref 1158* output_segment_length_in_bits 000100 automatic fixed bin(24,0) dcl 1320 set ref 1324* 1347* 1348 p_code parameter fixed bin(35,0) dcl 625 set ref 606 622 635* 642* 648* 650 654* 655 662* p_comp_bitc parameter fixed bin(24,0) dcl 1236 set ref 1226 1251* 1269* p_comp_index parameter fixed bin(17,0) dcl 1235 set ref 1226 1251* 1255* 1257* 1264 p_comp_ptr parameter pointer dcl 1234 set ref 1226 1251* 1262 p_desired_access parameter bit packed unaligned dcl 689 set ref 676 744* 770* p_dir parameter char packed unaligned dcl 690 set ref 676 716* 718* 741* 741* 744* 746* 746* 752* 755* 755* 761* 761* 766* 766* 770* 772* 772* 778* 778* p_dirname parameter char packed unaligned dcl 2062 set ref 2054 2091* 2091* 2116* 2116* p_dn parameter char packed unaligned dcl 1864 in procedure "get_specified_file_type" set ref 1857 1871* 1873* 1873* 1879* 1879* 1884* 1884* p_dn parameter char packed unaligned dcl 1233 in procedure "copy_temp_seg_into_msf" set ref 1226 1255* 1255* 1257* 1257* p_en parameter char packed unaligned dcl 1864 in procedure "get_specified_file_type" set ref 1857 1871* 1873* 1873* 1879* 1879* 1884* 1884* p_en parameter char packed unaligned dcl 1233 in procedure "copy_temp_seg_into_msf" set ref 1226 1255* 1255* 1257* 1257* p_ename parameter char packed unaligned dcl 690 set ref 676 741* 741* 744* 746* 746* 752* 755* 755* 761* 761* 766* 766* 770* 772* 772* 778* 778* p_enname parameter char packed unaligned dcl 2063 set ref 2054 2091* 2091* 2116* 2116* p_fcb_ptr parameter pointer dcl 1234 set ref 1226 1246* 1251* 1253* p_fs_util_type parameter char(32) packed unaligned dcl 1865 set ref 1857 1871* 1877 1882 p_input_len parameter fixed bin(21,0) dcl 627 ref 606 622 639 p_input_ptr parameter pointer dcl 626 ref 606 622 638 p_nstop parameter fixed bin(17,0) dcl 567 set ref 564 585* 585 586 592 p_output_len parameter fixed bin(21,0) dcl 629 set ref 606 622 665* p_output_ptr parameter pointer dcl 628 ref 606 622 664 p_overwritten_flag parameter bit(1) packed unaligned dcl 692 set ref 676 741* 742 766* 768 778* p_slew_char parameter char(1) packed unaligned dcl 1800 ref 1795 1805 p_stops parameter fixed bin(17,0) array dcl 567 set ref 564 586 588 592* p_tab_flag parameter bit(1) packed unaligned dcl 609 ref 606 615 p_temp_msf_total_components parameter fixed bin(24,0) dcl 1236 set ref 1226 1264 1264* p_type parameter char packed unaligned dcl 691 ref 676 740 751 parents_dn 000277 automatic char(32) packed unaligned dcl 699 set ref 710* 721* 728* 730* 730* 736* 736* pathname_ 000140 constant entry external dcl 278 ref 359 359 367 367 380 380 476 476 505 505 730 730 736 736 741 741 746 746 752 755 755 761 761 766 766 772 772 778 778 837 837 860 860 871 871 882 882 905 905 920 920 952 952 1019 1019 1034 1034 1040 1040 1049 1049 1057 1057 1084 1084 1107 1107 1122 1122 1255 1255 1257 1257 1288 1288 1299 1299 1337 1337 1339 1339 1350 1350 1352 1352 1763 1763 1873 1873 1879 1879 1884 1884 1986 1986 2001 2001 2008 2008 2044 2044 2091 2091 2097 2097 2116 2116 rank builtin function dcl 209 ref 1496 1496 1496 1496 1552 1552 1552 1552 1575 1575 1575 1575 1699 1699 1699 1699 record_quota_overflow 000000 stack reference condition dcl 228 ref 1244 1247 1328 1330 2069 2073 release_temp_segment_ 000142 constant entry external dcl 279 ref 368 369 381 382 1187 1191 1199 remaining_pos_for_insertion 000102 automatic fixed bin(21,0) dcl 1398 set ref 1407* 1782* 1783 1785 1786 1786 reverse builtin function dcl 209 ref 1439 ring 000307 automatic fixed bin(17,0) dcl 700 set ref 711* 728* 753* rtrim builtin function dcl 209 ref 882 882 905 905 search builtin function dcl 209 ref 1424 1445 1616 1691 set 2 based fixed bin(17,0) level 2 dcl 96 set ref 1157* slew_index 000103 automatic fixed bin(21,0) dcl 1399 set ref 1436* 1709 1709 slew_present_flag 000104 automatic bit(1) packed unaligned dcl 1400 set ref 1427* 1431* 1709 substr builtin function dcl 209 set ref 575 578 578 581 581 1422 1424 1439 1445 1447 1448 1452 1456 1457 1473 1474 1493 1496 1496 1566 1572* 1572 1575 1575 1584 1602* 1616 1617 1618 1623 1677* 1685* 1691 1696* 1696 1699 1699 1709 1709 1718* 1725* 1725 1786* 1786 1805* swaps 000144 automatic fixed bin(17,0) dcl 1821 set ref 1828* 1836* 1836 1845 temp 000145 automatic bit(36) dcl 1822 set ref 1837* 1839 terminate_file_ 000144 constant entry external dcl 280 ref 1096 1137 1215 1218 1335 1348 1356 type 3 based fixed bin(2,0) level 2 dcl 96 set ref 1156* 1166* unique_chars_ 000146 constant entry external dcl 281 ref 1738 unspec builtin function dcl 209 set ref 1507 1507 1835 1835 1837 1838* 1838 1839* user_id 000310 automatic char(32) packed unaligned dcl 701 set ref 712* 727* 728* 753* verify builtin function dcl 209 ref 1439 1448 1457 1474 1584 1618 1623 version_number 002622 automatic fixed bin(17,0) level 2 dcl 284 set ref 1053* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 BITS_PER_PAGE internal static fixed bin(16,0) initial dcl 3-67 BITS_PER_SEGMENT internal static fixed bin(24,0) initial dcl 3-70 BITS_PER_WORD internal static fixed bin(6,0) initial dcl 3-64 CHARS_PER_PAGE internal static fixed bin(13,0) initial dcl 3-76 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 FS_OBJECT_TYPE_LINK internal static char(32) initial packed unaligned dcl 6-50 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 PAGES_PER_SEGMENT internal static fixed bin(8,0) initial dcl 3-92 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SUFFIX_INFO_VERSION_1 internal static char(8) initial packed unaligned dcl 6-29 SWITCH_LIST_VERSION_1 internal static char(8) initial packed unaligned dcl 6-48 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 TERM_FILE_DELETE internal static bit(5) initial packed unaligned dcl 4-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial packed unaligned dcl 4-16 TERM_FILE_TRUNC_BC internal static bit(2) initial packed unaligned dcl 4-13 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial packed unaligned dcl 4-15 WORDS_PER_PAGE internal static fixed bin(11,0) initial dcl 3-84 WORDS_PER_SEGMENT internal static fixed bin(21,0) initial dcl 3-89 W_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 alloc_switch_count automatic fixed bin(17,0) dcl 6-33 alloc_switch_name_count automatic fixed bin(17,0) dcl 6-33 suffix_info based structure level 1 dcl 6-12 suffix_info_ptr automatic pointer dcl 6-10 switch_list based structure level 1 dcl 6-37 switch_list_ptr automatic pointer dcl 6-33 terminate_file_switches based structure level 1 packed packed unaligned dcl 4-4 NAMES DECLARED BY EXPLICIT CONTEXT. NON_MSF_COMMON 001716 constant label dcl 635 ref 618 canon 000761 constant entry external dcl 76 canon_msf 005524 constant entry internal dcl 787 ref 376 canon_segment 007055 constant entry internal dcl 971 ref 373 canonicalize 000770 constant entry external dcl 76 canonicalize_ 001705 constant entry external dcl 622 canonicalize_tabs_ 001653 constant entry external dcl 606 clean_up 010523 constant entry internal dcl 1147 ref 336 386 646 670 714 834 1016 1242 1326 1411 continue_parsing_arguments 003312 constant entry internal dcl 520 ref 427 439 copy_temp_seg_into_msf 011154 constant entry internal dcl 1226 ref 898 1292 1776 2034 copy_temp_seg_into_segment 011772 constant entry internal dcl 1309 ref 910 924 1076 1088 copy_temp_seg_into_spec_pth2_MSF 011506 constant entry internal dcl 1279 ref 929 1092 do_canon 012461 constant entry internal dcl 1365 ref 660 886 1072 do_canon_SKIP 013436 constant label dcl 1558 ref 1507 get_specified_file_type 015001 constant entry internal dcl 1857 ref 841 1993 grab_tabs 003633 constant entry internal dcl 564 ref 552 553 initialization 015275 constant entry internal dcl 1893 ref 321 613 633 initiate_specified_output_file 015424 constant entry internal dcl 1960 ref 851 1064 omit_simple_spaces 014206 constant label dcl 1682 ref 1650 1662 1671 output 014712 constant entry internal dcl 1795 ref 1521 1534 1545 1552 1555 1709 parsing_input_arguments 002055 constant entry internal dcl 394 ref 323 sort 014727 constant entry internal dcl 1813 ref 1502 sort_pass 014733 constant label dcl 1828 ref 1843 1845 temp_msf_ERROR_RETURN 017025 constant label dcl 2120 ref 2074 temp_msf_to_infile_or_outfile 016312 constant entry internal dcl 2054 ref 944 958 1111 1129 temp_seg_to_msf_ERROR_RETURN 011504 constant label dcl 1271 ref 1248 temp_seg_to_segment_ERROR_RETURN 012430 constant label dcl 1356 ref 1331 temp_seg_to_temp_msf 016114 constant entry internal dcl 2020 ref 939 1100 term_segs 011050 constant entry internal dcl 1210 ref 337 387 validate_access 004071 constant entry internal dcl 676 ref 845 1027 1980 1996 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 21154 21324 20070 21164 Length 22142 20070 150 602 1063 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME canon 1799 external procedure is an external procedure. on unit on line 335 64 on unit parsing_input_arguments internal procedure shares stack frame of external procedure canon. continue_parsing_arguments internal procedure shares stack frame of external procedure canon. grab_tabs internal procedure shares stack frame of external procedure canon. on unit on line 646 64 on unit validate_access 320 internal procedure enables or reverts conditions. on unit on line 714 64 on unit canon_msf 180 internal procedure enables or reverts conditions. on unit on line 834 64 on unit canon_segment 174 internal procedure enables or reverts conditions. on unit on line 1016 64 on unit clean_up 108 internal procedure is called by several nonquick procedures. term_segs 84 internal procedure is called by several nonquick procedures. copy_temp_seg_into_msf 170 internal procedure enables or reverts conditions. on unit on line 1242 64 on unit on unit on line 1244 74 on unit enables or reverts conditions. copy_temp_seg_into_spec_pth2_MSF 162 internal procedure is called by several nonquick procedures. copy_temp_seg_into_segment 140 internal procedure enables or reverts conditions. on unit on line 1326 64 on unit on unit on line 1328 70 on unit enables or reverts conditions. do_canon 203 internal procedure enables or reverts conditions. on unit on line 1411 64 on unit output internal procedure shares stack frame of internal procedure do_canon. sort internal procedure shares stack frame of internal procedure do_canon. get_specified_file_type 128 internal procedure is called by several nonquick procedures. initialization internal procedure shares stack frame of external procedure canon. initiate_specified_output_file 174 internal procedure is called by several nonquick procedures. temp_seg_to_temp_msf 174 internal procedure is called by several nonquick procedures. temp_msf_to_infile_or_outfile 166 internal procedure enables or reverts conditions. on unit on line 2069 74 on unit enables or reverts conditions. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME canon 000100 Access_ptr canon 000102 Arg_len canon 000103 Arg_numb canon 000104 Arg_ptr canon 000106 Arg_count canon 000110 Area_ptr canon 000112 Bead_ptr canon 000114 Bead_storage canon 002114 Bead_storage_size canon 002115 Beg_line canon 002116 Bitc canon 002117 Cantab_flag canon 002120 Chars_in_line canon 002121 Chars_to_remove canon 002122 Charx canon 002123 Col canon 002124 Create_temp_msf_flag canon 002125 Desired_access canon 002126 Dn canon 002200 Do_not_create_temp_msf_flag canon 002201 Ec canon 002202 En canon 002212 Eof_flag canon 002213 Eqln canon 002223 Everytab canon 002224 Fs_util_type canon 002234 Have_infile_flag canon 002235 Have_outfile_flag canon 002236 Ii canon 002237 In_everytab canon 002240 In_nstops canon 002241 In_msf_comp_bitc canon 002242 In_msf_total_original_comps canon 002243 Input_msf_comp_index canon 002244 Input_msf_comp_ptr canon 002246 Input_msf_fcb_ptr canon 002250 In_stops canon 002320 In_stopx canon 002321 Jj canon 002322 Kk canon 002323 Lth canon 002324 Mm canon 002325 Nch canon 002326 Next_pos canon 002327 Nonexistent_outfile_flag canon 002330 Nstops canon 002332 Obuf_ptr canon 002334 Out_seg_ptr canon 002336 Outc_ptr canon 002340 Out_dname canon 002412 Out_ename canon 002422 Outc_len canon 002423 Output_segment_length_in_words canon 002424 Overwrite_exist_path_flag canon 002425 Ox canon 002426 Spaces_to_go canon 002430 Second_temp_seg_ptr canon 002432 Specified_infile_type canon 002433 Specified_temp_file_flag canon 002434 Seg_ptr canon 002436 Stops canon 002506 Stopx canon 002507 Subroutine_call_flag canon 002510 Tab_flag canon 002511 Target_tabstop canon 002512 Temp_msf_comp_bitc canon 002514 Temp_msf_fcb_ptr canon 002516 Temp_ptr canon 002520 Temp_dn canon 002572 Temp_en canon 002602 Temp_seg_len canon 002603 Temp_seg_len_in_chars canon 002604 Temp_seg_ptr canon 002606 Temp_msf_total_components canon 002607 Temp_msf_comp_index canon 002610 Temp_msf_comp_ptr canon 002612 This_tabstop canon 002622 oi canon copy_temp_seg_into_segment 000100 output_segment_length_in_bits copy_temp_seg_into_segment do_canon 000100 available_pos_for_insertion do_canon 000101 next_char_pos do_canon 000102 remaining_pos_for_insertion do_canon 000103 slew_index do_canon 000104 slew_present_flag do_canon 000142 d sort 000143 i sort 000144 swaps sort 000145 temp sort validate_access 000100 full_pathname validate_access 000152 grand_dn validate_access 000224 mode validate_access 000225 msf_directory_pathname validate_access 000277 parents_dn validate_access 000307 ring validate_access 000310 user_id validate_access THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_le_a alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry int_entry_desc op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ access_$reset access_$set_temporarily active_fnc_err_ archive_$next_component com_err_ com_err_$suppress_name command_query_$yes_no cu_$arg_count cu_$arg_ptr cv_dec_check_ delete_$path expand_pathname_ fs_util_$get_type get_equal_name_ get_group_id_ get_pdir_ get_system_free_area_ get_temp_segment_ hcs_$get_user_effmode hcs_$make_seg hcs_$status_minf initiate_file_ initiate_file_$create msf_manager_$adjust msf_manager_$close msf_manager_$msf_get_ptr msf_manager_$open object_info_$brief pathname_ release_temp_segment_ terminate_file_ unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. dm_error_$file_in_use error_table_$active_function error_table_$archive_pathname error_table_$bad_arg error_table_$badopt error_table_$dirseg error_table_$empty_file error_table_$no_m_permission error_table_$no_r_permission error_table_$no_w_permission error_table_$noarg error_table_$noentry error_table_$not_seg_type error_table_$rqover error_table_$zero_length_seg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 76 000760 321 000775 323 000776 324 000777 326 001001 327 001003 328 001033 331 001034 333 001041 335 001043 336 001057 337 001064 338 001071 342 001072 343 001113 344 001115 345 001141 348 001142 350 001144 351 001165 352 001167 353 001213 355 001214 357 001215 358 001252 359 001254 360 001323 365 001324 366 001363 367 001365 368 001434 369 001456 370 001500 373 001501 376 001511 380 001520 381 001567 382 001611 383 001633 386 001634 387 001640 390 001644 606 001645 613 001663 615 001664 616 001672 618 001677 622 001700 633 001715 635 001716 638 001717 639 001723 641 001725 642 001726 643 001731 646 001732 648 001754 650 001775 654 001777 655 002020 658 002022 660 002024 662 002030 664 002034 665 002044 668 002046 670 002050 672 002054 394 002055 400 002056 402 002057 403 002070 404 002072 405 002112 406 002126 409 002127 410 002137 411 002154 412 002156 413 002173 416 002174 417 002210 418 002220 420 002222 421 002223 422 002226 423 002231 424 002245 427 002246 428 002247 429 002252 430 002253 431 002265 432 002275 433 002276 434 002301 435 002304 436 002320 439 002321 440 002322 441 002325 442 002326 443 002341 444 002354 445 002364 447 002366 448 002371 449 002373 450 002427 453 002430 454 002431 455 002446 456 002450 457 002474 460 002475 462 002511 463 002514 464 002546 467 002547 468 002577 469 002601 470 002634 473 002635 475 002657 476 002661 477 002731 480 002732 482 002733 483 002736 484 002767 486 002770 487 002771 488 002773 489 003023 490 003025 491 003060 493 003061 494 003063 495 003064 496 003066 497 003070 498 003120 499 003122 500 003155 503 003156 504 003201 505 003203 506 003253 508 003254 510 003255 511 003260 512 003306 514 003307 516 003311 520 003312 522 003313 523 003330 524 003332 525 003364 528 003365 529 003377 530 003400 531 003403 532 003406 533 003443 536 003444 537 003461 538 003463 539 003500 542 003501 543 003531 545 003555 546 003557 547 003562 548 003613 550 003614 552 003615 553 003624 555 003627 558 003632 564 003633 572 003637 573 003640 574 003642 575 003645 576 003664 578 003671 579 003723 580 003726 581 003731 582 003772 585 003774 586 003776 587 004004 588 004006 589 004052 592 004053 593 004064 594 004066 596 004067 676 004070 705 004123 706 004125 707 004130 708 004133 709 004134 710 004137 711 004142 712 004144 714 004147 716 004171 717 004215 718 004220 719 004252 721 004253 722 004277 723 004302 724 004332 727 004333 728 004345 729 004402 730 004405 731 004456 734 004457 735 004466 736 004471 737 004540 740 004541 741 004550 742 004634 744 004642 745 004701 746 004704 747 004760 751 004761 752 004770 753 005012 754 005052 755 005055 756 005131 759 005132 760 005140 761 005143 762 005215 765 005216 766 005222 768 005307 770 005315 771 005354 772 005357 773 005433 775 005434 778 005435 781 005522 787 005523 832 005531 834 005534 836 005556 837 005561 838 005631 841 005632 842 005652 844 005655 845 005657 846 005707 848 005712 849 005715 851 005716 852 005723 854 005726 858 005734 859 005761 860 005764 861 006035 865 006036 867 006050 868 006071 869 006074 871 006102 872 006157 875 006160 877 006162 879 006166 880 006167 881 006171 882 006174 883 006270 886 006272 888 006277 889 006302 890 006304 893 006305 894 006306 896 006310 897 006312 898 006314 900 006353 902 006356 903 006375 904 006400 905 006402 906 006477 908 006501 910 006502 914 006514 917 006517 918 006560 919 006563 920 006565 921 006635 924 006636 925 006643 927 006644 929 006650 930 006655 931 006660 932 006662 936 006663 938 006664 939 006666 940 006673 943 006676 944 006700 945 006715 946 006720 949 006721 950 006746 951 006751 952 006754 953 007023 955 007024 958 007025 959 007042 961 007045 965 007053 971 007054 1016 007062 1018 007104 1019 007107 1020 007156 1023 007157 1024 007214 1025 007217 1026 007222 1027 007225 1028 007255 1029 007260 1031 007263 1032 007321 1034 007322 1035 007371 1039 007372 1040 007400 1041 007462 1043 007466 1046 007471 1047 007527 1048 007532 1049 007535 1050 007605 1053 007606 1054 007610 1055 007627 1056 007632 1057 007635 1058 007705 1061 007706 1063 007712 1064 007714 1065 007721 1067 007724 1068 007732 1069 007733 1072 007735 1073 007742 1075 007745 1076 007747 1081 007761 1082 007764 1083 010025 1084 010030 1085 010100 1088 010101 1089 010106 1092 010107 1093 010114 1096 010117 1097 010147 1099 010150 1100 010152 1101 010157 1104 010162 1105 010164 1106 010211 1107 010214 1108 010264 1111 010265 1112 010302 1114 010305 1115 010307 1119 010310 1120 010335 1121 010340 1122 010343 1123 010412 1125 010413 1129 010414 1130 010431 1131 010434 1133 010471 1137 010472 1141 010521 1147 010522 1151 010530 1152 010535 1154 010537 1156 010543 1157 010546 1158 010550 1159 010552 1162 010563 1164 010602 1165 010603 1166 010607 1170 010616 1174 010627 1175 010634 1176 010643 1180 010652 1181 010656 1182 010665 1185 010674 1187 010702 1190 010731 1191 010736 1194 010763 1195 010765 1199 011017 1202 011046 1210 011047 1213 011055 1215 011064 1218 011116 1221 011152 1226 011153 1240 011174 1242 011176 1244 011220 1245 011234 1246 011240 1247 011250 1248 011251 1251 011254 1252 011277 1253 011302 1255 011312 1257 011401 1259 011462 1262 011463 1264 011473 1269 011501 1271 011504 1279 011505 1286 011513 1287 011540 1288 011543 1289 011613 1292 011614 1294 011653 1296 011656 1297 011677 1298 011702 1299 011711 1300 011767 1303 011770 1309 011771 1324 011777 1326 012000 1328 012022 1329 012036 1330 012042 1331 012043 1334 012046 1335 012053 1336 012101 1337 012104 1339 012161 1340 012231 1343 012232 1345 012240 1347 012246 1348 012251 1349 012277 1350 012302 1352 012357 1353 012427 1356 012430 1359 012457 1365 012460 1405 012466 1406 012470 1407 012471 1408 012472 1409 012474 1411 012476 1413 012520 1415 012523 1416 012525 1418 012534 1419 012537 1421 012541 1422 012542 1424 012550 1426 012570 1427 012571 1428 012572 1430 012576 1431 012577 1433 012601 1434 012602 1436 012607 1439 012611 1440 012625 1442 012630 1444 012634 1445 012644 1446 012660 1447 012665 1448 012675 1449 012712 1450 012713 1451 012721 1452 012722 1453 012724 1454 012726 1455 012727 1456 012730 1457 012732 1458 012746 1459 012750 1461 012757 1463 012774 1464 012776 1466 013016 1468 013022 1469 013023 1471 013032 1472 013034 1473 013035 1474 013037 1475 013053 1476 013054 1477 013055 1479 013056 1480 013057 1481 013062 1482 013064 1484 013066 1486 013075 1487 013077 1488 013104 1490 013114 1491 013120 1493 013123 1494 013137 1496 013143 1498 013161 1500 013162 1502 013163 1504 013164 1505 013167 1506 013200 1507 013202 1511 013206 1513 013214 1514 013215 1515 013222 1516 013224 1517 013240 1519 013242 1520 013246 1521 013260 1522 013262 1523 013266 1525 013275 1526 013302 1527 013307 1528 013310 1529 013311 1531 013312 1533 013322 1534 013326 1536 013330 1537 013342 1538 013343 1540 013351 1544 013352 1545 013364 1546 013366 1552 013371 1555 013414 1557 013427 1558 013436 1560 013440 1562 013441 1564 013443 1565 013446 1566 013451 1567 013466 1569 013473 1570 013475 1571 013476 1572 013477 1574 013510 1575 013522 1577 013540 1579 013542 1580 013544 1583 013545 1584 013547 1586 013564 1587 013566 1588 013570 1590 013577 1592 013614 1594 013616 1596 013637 1598 013644 1599 013645 1601 013657 1602 013660 1603 013671 1604 013673 1605 013674 1607 013676 1608 013677 1613 013700 1616 013705 1617 013724 1618 013727 1619 013743 1620 013744 1621 013745 1623 013746 1625 013762 1626 013764 1629 013773 1631 014010 1632 014012 1634 014032 1636 014036 1637 014037 1639 014046 1641 014050 1646 014051 1647 014054 1648 014055 1649 014062 1650 014064 1653 014070 1655 014106 1657 014110 1659 014126 1661 014130 1662 014132 1664 014135 1665 014142 1668 014143 1670 014147 1671 014156 1672 014160 1675 014170 1676 014172 1677 014173 1678 014204 1682 014206 1684 014210 1685 014211 1686 014222 1691 014224 1692 014241 1695 014246 1696 014247 1697 014260 1698 014262 1699 014274 1701 014312 1703 014314 1704 014316 1705 014320 1709 014321 1714 014334 1716 014341 1717 014344 1718 014346 1719 014354 1722 014355 1723 014360 1724 014363 1725 014365 1727 014373 1729 014375 1730 014400 1733 014401 1734 014403 1736 014405 1737 014407 1738 014416 1739 014437 1743 014440 1744 014461 1745 014464 1746 014510 1749 014511 1755 014517 1757 014520 1760 014522 1761 014547 1762 014552 1763 014555 1764 014624 1766 014625 1770 014626 1771 014630 1772 014631 1776 014632 1778 014671 1780 014674 1782 014675 1783 014700 1785 014701 1786 014702 1789 014710 1791 014711 1795 014712 1804 014714 1805 014721 1807 014726 1813 014727 1826 014730 1828 014733 1831 014734 1833 014740 1835 014751 1836 014762 1837 014763 1838 014764 1839 014766 1841 014770 1843 014772 1845 014775 1847 014777 1857 015000 1869 015021 1871 015023 1872 015050 1873 015053 1874 015126 1877 015127 1878 015135 1879 015140 1882 015211 1883 015217 1884 015223 1887 015274 1893 015275 1901 015276 1913 015312 1931 015353 1939 015400 1950 015417 1952 015420 1954 015422 1960 015423 1967 015431 1969 015433 1970 015467 1971 015472 1973 015475 1974 015476 1975 015500 1977 015501 1979 015503 1980 015506 1981 015536 1982 015541 1984 015544 1985 015601 1986 015604 1987 015654 1989 015655 1991 015656 1993 015660 1994 015700 1996 015703 1997 015733 1998 015736 1999 015741 2001 015742 2002 016011 2006 016012 2008 016021 2009 016103 2011 016107 2014 016112 2020 016113 2029 016121 2030 016124 2031 016125 2034 016126 2036 016165 2037 016170 2038 016177 2041 016200 2042 016217 2043 016222 2044 016231 2045 016307 2048 016310 2054 016311 2067 016332 2069 016334 2070 016350 2071 016354 2072 016362 2073 016373 2074 016374 2077 016377 2079 016402 2082 016404 2084 016416 2086 016417 2088 016440 2089 016443 2090 016452 2091 016462 2092 016542 2095 016543 2096 016564 2097 016567 2098 016644 2099 016654 2100 016664 2103 016665 2109 016673 2110 016701 2112 016703 2113 016722 2114 016725 2115 016734 2116 016744 2117 017024 2120 017025 ----------------------------------------------------------- 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