COMPILATION LISTING OF SEGMENT format_string Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/01/84 1404.1 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* *********************************************************** */ 6 7 8 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 9 /* */ 10 /* Name: format_string, fstr */ 11 /* */ 12 /* This command/af does fill and adjust processing for a string, using */ 13 /* format_document_$string. */ 14 /* */ 15 /* History: */ 16 /* 0) Created: December 1983 by G. C. Dixon */ 17 /* */ 18 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 19 20 format_string: 21 fstr: proc options(variable); 22 23 dcl Ifirst_string_arg fixed bin, /* arg no of the first string argument. It and */ 24 /* all remaining args are strings to be */ 25 /* formatted. */ 26 Presult ptr, /* ptr to resulting output from format_document_ */ 27 Pstr ptr, /* ptr to input to format_document_$string. */ 28 Pstr_nonvar ptr, /* ptr to nonvarying representation of input. */ 29 Pundent_line ptr, /* ptr to portion of first line of result which */ 30 /* must be indented or undented. */ 31 Sadjust bit(1), /* On if output to be right-adjusted. */ 32 Sbreak_word bit(1), /* On if over-length words can be broken across */ 33 /* lines. */ 34 Shyphenate bit(1), /* On if hyphenation should be performed. */ 35 code fixed bin(35), 36 (hyphenate_word_part, indent, line_length, starting_column, undent) 37 fixed bin, /* Control argument operand values. */ 38 (result_len, str_length) fixed bin(21); /* Length of input and output strings. */ 39 40 dcl Lstr_nonvar fixed bin(21) based(Pstr), 41 result char(result_len) based(Presult), 42 result_array (result_len) char(1) based (Presult), 43 str char(str_length) varying based (Pstr), 44 str_nonvar char(Lstr_nonvar) based(Pstr_nonvar), 45 undent_line char(line_length) varying based (Pundent_line); 46 47 dcl (abs, addr, addrel, copy, currentsize, index, 48 length, null, substr, wordno) 49 builtin; 50 51 dcl (cleanup, sub_error_) condition; 52 53 dcl format_document_$string entry (char(*), char(*), fixed bin(21), ptr, fixed bin(35)), 54 (get_temp_segment_, release_temp_segment_) 55 entry (char(*), ptr, fixed bin(35)), 56 ioa_$nnl entry() options(variable), 57 requote_string_ entry (char(*)) returns(char(*)); 58 59 dcl (FALSE init("0"b), 60 TRUE init("1"b)) bit(1) int static options(constant), 61 NL char(1) int static options(constant) init(" 62 "), 63 SP char(1) int static options(constant) init(" "), 64 (error_table_$badopt, 65 error_table_$inconsistent, 66 error_table_$noarg) fixed bin(35) ext static, 67 ME char(13) int static options(constant) init("format_string"), 68 sys_info$max_seg_size fixed bin(35) ext static; 69 70 call get_invocation_type (Saf); /* Find out how we were invoked, get count of args*/ 71 72 Sadjust = FALSE; /* Initialize control argument values. */ 73 Sbreak_word = TRUE; 74 Shyphenate = FALSE; 75 hyphenate_word_part = 2; 76 indent = 0; 77 line_length = 65; 78 starting_column = 1; 79 str_length = 0; 80 undent = 0; 81 82 do while (get_arg()); /* Process control arguments, and figure length */ 83 if index(arg, "-") = 1 then do; /* of text string. */ 84 85 if arg = "-line_length" | arg = "-ll" then do; 86 if get_op ("^a requires a line length operand.", arg) then do; 87 line_length = cv_int$pos (op, "^a requires a positive line length operand.", arg); 88 end; 89 end; 90 91 else if arg = "-indent" | arg = "-ind" | arg = "-in" then do; 92 if get_op ("^a requires a line indentation operand.", arg) then do; 93 indent = cv_int$nonneg (op, "^a requires a nonnegative indentation count.", arg); 94 end; 95 end; 96 97 else if arg = "-undent" | arg = "-und" | arg = "-un" then do; 98 if get_op ("^a requires a first line undentation operand.", arg) then do; 99 undent = cv_int (op, "^a requires an integer undentation operand.", arg); 100 end; 101 end; 102 103 else if arg = "-column" | arg = "-col" then do; 104 if get_op ("^a requires a starting column position operand.", arg) then do; 105 starting_column = cv_int$pos (op, "^a requires a positive column position.", arg); 106 end; 107 end; 108 109 else if arg = "-adjust" | arg = "-adj" then 110 Sadjust = TRUE; 111 else if arg = "-no_adjust" | arg = "-nadj" then 112 Sadjust = FALSE; 113 114 else if arg = "-break_word" then 115 Sbreak_word = TRUE; 116 else if arg = "-no_break_word" then 117 Sbreak_word = FALSE; 118 119 else if arg = "-hyphenate" | arg = "-hph" then do; 120 Shyphenate = TRUE; 121 if get_op ("", arg) then do; 122 hyphenate_word_part = cv_int$pos (op, "", arg); 123 if hyphenate_word_part = -9999 then do; 124 call put_op(); /* -9999 indicates conversion error occurred. */ 125 hyphenate_word_part = 2; /* Assumed -hph operand is really another ctl arg.*/ 126 end; 127 end; 128 end; 129 else if arg = "-no_hyphenate" | arg = "-nhph" then 130 Shyphenate = FALSE; 131 132 else if arg = "-string" | arg = "-str" then do; 133 if get_arg () then go to STRING_ARG; 134 end; 135 136 else 137 call error (error_table_$badopt, ME, arg); 138 end; 139 140 else do; /* first text string argument. */ 141 STRING_ARG: Ifirst_string_arg = Iarg; 142 str_length = str_length + length(arg); 143 do while (get_arg()); /* All remaining args are text strings. */ 144 str_length = str_length + length(SP) + length(arg); 145 end; 146 end; 147 end; 148 149 if str_length = 0 then /* Check argument consistency. */ 150 call error (error_table_$noarg, ME, "Need a string to be formatted."); 151 if (indent > 0 & indent >= line_length) then 152 call error (error_table_$inconsistent, ME, "^/-line_length ^d -indent ^d", line_length, indent); 153 if (undent > 0 & undent > indent) then 154 call error (error_table_$inconsistent, ME, "^/-indent ^d -undent ^d", indent, undent); 155 if (undent < 0 & indent-undent > line_length) then 156 call error (error_table_$inconsistent, ME, "^/-line_length ^d ^[-indent ^d ^;^s^]-undent ^d", 157 line_length, indent > 0, indent, undent); 158 if (starting_column > line_length) then 159 call error (error_table_$inconsistent, ME, "^/-line_length ^d -column ^d", 160 line_length, starting_column); 161 if Serror then return; 162 163 str_length = str_length + abs(undent) + starting_column; 164 /* Add room to text string for undent space */ 165 /* and starting column filler. */ 166 167 Pstr = null; /* Get temp seg to hold string, undent_line and */ 168 on cleanup begin; /* result. */ 169 call release_temp_segment_ (ME, Pstr, code); 170 end; 171 call get_temp_segment_ (ME, Pstr, code); 172 Serrors_are_fatal = TRUE; 173 call error (code, ME, "Getting a temp segment."); 174 175 Pstr_nonvar = addrel(Pstr, 1); /* Overlay str (which is a varying string) */ 176 /* with its nonvarying representation. */ 177 178 fdo.version_number = format_document_version_2; /* Fill in format_document_ info structure. */ 179 fdo.indentation = indent; 180 fdo.line_length = line_length - indent; 181 fdo.switches = FALSE; 182 fdo.adj_sw = Sadjust; 183 fdo.galley_sw = TRUE; 184 fdo.literal_sw = TRUE; 185 fdo.break_word_sw = Sbreak_word; 186 fdo.max_line_length_sw = TRUE; 187 fdo.sub_err_sw = TRUE; 188 fdo.hyphenation_sw = Shyphenate; 189 fdo.syllable_size = hyphenate_word_part; 190 191 str = ""; /* Prepare to fill in string from arguments. */ 192 if undent < 0 then /* For indented first line, add a place holder. */ 193 str = copy ("~", -undent); 194 195 call reprocess_args(Ifirst_string_arg); /* Reprocess arguments to fill in text args into */ 196 do while (get_arg()); /* string variable. */ 197 str = str || arg; 198 do while (get_arg()); 199 str = str || SP; 200 str = str || arg; 201 end; 202 end; 203 204 Pundent_line = addrel (Pstr, currentsize(str)); 205 if undent > 0 then do; /* For undented first line, save portion of string*/ 206 undent_line = copy(SP, indent-undent); /* to be undented, removing it from input. */ 207 if length(str) > undent then do; 208 undent_line = undent_line || substr (str, 1, undent); 209 str = substr(str, undent+1); 210 end; 211 else do; 212 undent_line = undent_line || str; 213 str = copy (SP, undent-length(str)+1); 214 end; 215 end; 216 217 Presult = addrel (Pundent_line, currentsize(undent_line)); 218 result_len = sys_info$max_seg_size*4 - wordno(Presult); 219 220 on sub_error_ call sub_error_handler(); 221 call format_document_$string (str_nonvar, result, 222 result_len, addr(fdo), code); /* Call format_document_ to do the fill/adj work. */ 223 revert sub_error_; 224 if code ^= 0 then 225 call error (code, ME, "While formatting the string."); 226 227 else do; /* If no errors occurred: */ 228 if undent < 0 then /* remove placeholder for indented first line. */ 229 substr (result, indent+1, -undent) = ""; 230 else if undent > 0 then /* or add undented part of first line to result.*/ 231 substr (result, 1, indent) = undent_line; 232 if starting_column > 1 then do; /* If other text already appears on first line: */ 233 if starting_column-1 <= indent-undent then do; 234 Presult = addr (result_array(starting_column)); 235 result_len = result_len - (starting_column-1); 236 end; /* remove indent spaces on first line to */ 237 /* accommodate assumed text; or */ 238 else do; /* force output to begin on a new line. */ 239 result_len = result_len + length(NL); 240 result = NL || substr(result, 1, result_len-length(NL)); 241 end; 242 end; 243 if Saf then do; /* AF: return unquoted result, without final NL. */ 244 result_len = result_len - length(NL); 245 call set_return_arg (requote_string_(result)); 246 end; 247 else /* COMMAND: print final result. */ 248 call ioa_$nnl ("^a", result); 249 end; 250 251 RETURN: if Pstr ^= null then /* Give back the temp segment. */ 252 call release_temp_segment_ (ME, Pstr, code); 253 return; 254 255 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 256 257 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 258 /* */ 259 /* I N T E R N A L P R O C E D U R E S */ 260 /* */ 261 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 262 263 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 264 265 266 cv_int: proc (op, str, arg1) returns (fixed bin); /* Convert control arg operand to integer. */ 267 268 dcl op char(*), 269 str char(*), 270 arg1 char(*); 271 272 dcl Smust_be_nonnegative bit(1), 273 Smust_be_positive bit(1), 274 number fixed bin; 275 276 dcl convert builtin; 277 278 dcl (conversion, size) condition; 279 280 dcl (error_table_$bad_conversion, 281 error_table_$out_of_bounds) fixed bin(35) ext static; 282 283 Smust_be_nonnegative = FALSE; 284 Smust_be_positive = FALSE; 285 286 CV_NUM: on conversion, size begin; 287 code = error_table_$bad_conversion; 288 if str = "" then go to BAD_NUM_OK; /* operand optional: no error message. */ 289 go to BAD_NUM; 290 end; 291 number = convert (number, op); 292 revert conversion, size; 293 if (number < 0 & Smust_be_nonnegative) | 294 (number < 1 & Smust_be_positive) then do; 295 code = error_table_$out_of_bounds; 296 BAD_NUM: call error (code, ME, "^a ^a^/" || str, arg1, op, arg1); 297 return (1); 298 end; 299 return (number); 300 301 BAD_NUM_OK: 302 return (-9999); 303 304 cv_int$nonneg: 305 entry (op, str, arg1) returns(fixed bin); 306 307 Smust_be_nonnegative = TRUE; 308 Smust_be_positive = FALSE; 309 go to CV_NUM; 310 311 cv_int$pos: 312 entry (op, str, arg1) returns(fixed bin); 313 314 Smust_be_nonnegative = FALSE; 315 Smust_be_positive = TRUE; 316 go to CV_NUM; 317 318 end cv_int; 319 320 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 321 322 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 323 324 325 dcl Serror bit(1), /* On if fatal error has occurred. */ 326 Serrors_are_fatal bit(1); /* On if errors are fatal. */ 327 328 error: proc options(variable); /* Procedure to report errors via com_err_ or */ 329 /* active_fnc_err_, as appropriate. This proc */ 330 /* has same calling sequence as com_err_. */ 331 332 dcl code fixed bin(35) based (Pcode), 333 Pcode ptr; 334 335 dcl cu_$arg_list_ptr entry returns(ptr), 336 cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 337 cu_$generate_call entry (entry, ptr); 338 339 call cu_$arg_ptr (1, Pcode, 0, 0); /* Access error table code argument. */ 340 if code = 0 then return; /* If non-zero, this ISN'T an error. */ 341 Serror = TRUE; /* Record fact that an error occurred. */ 342 call cu_$generate_call (err, cu_$arg_list_ptr()); /* Actually call com_err_ or active_fnc_err_. */ 343 if Serrors_are_fatal then 344 go to RETURN; 345 346 end error; 347 348 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 349 350 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 351 352 353 dcl Iarg fixed bin, /* Current argument being processed. */ 354 Larg fixed bin(21), /* Length of current argument. */ 355 Lop fixed bin(21), /* Length of current ctl arg operand. */ 356 Lret fixed bin(21), /* Max length of AF return value. */ 357 Nargs fixed bin, /* Number of arguments. */ 358 Parg ptr, /* Ptr to current argument. */ 359 Parg_list ptr, /* Ptr to command/af's argument list. */ 360 Pop ptr, /* Ptr to current operand. */ 361 Pret ptr, /* Ptr to AF return value. */ 362 Saf bit(1), /* On if invoked as an active function. */ 363 arg char(Larg) based(Parg), 364 op char(Lop) based(Pop), 365 ret char(Lret) varying based(Pret), 366 (arg_ptr variable, 367 cu_$af_arg_ptr_rel, 368 cu_$arg_ptr_rel) entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr), 369 cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 370 cu_$arg_list_ptr entry returns(ptr), 371 (err variable, 372 active_fnc_err_, 373 com_err_) entry() options(variable); 374 375 376 get_invocation_type: /* Were we invoked as command or af? Arg count? */ 377 proc (Saf); 378 379 dcl Saf bit(1); 380 381 Serrors_are_fatal = FALSE; 382 call cu_$af_return_arg (Nargs, Pret, Lret, code); 383 if code = 0 then do; 384 Saf = TRUE; 385 arg_ptr = cu_$af_arg_ptr_rel; 386 err = active_fnc_err_; 387 ret = ""; 388 end; 389 else do; 390 Saf = FALSE; 391 arg_ptr = cu_$arg_ptr_rel; 392 err = com_err_; 393 end; 394 Iarg = 0; /* No args processed so far. */ 395 Serror = FALSE; /* No errors so far. */ 396 Parg_list = cu_$arg_list_ptr(); /* Remember arg list ptr for subrs below. */ 397 398 end get_invocation_type; 399 400 401 get_arg: proc returns(bit(1)); /* Returns TRUE if another argument exists. */ 402 /* Its value is accessible via arg variable. */ 403 404 if Iarg+1 > Nargs then 405 return(FALSE); 406 Iarg = Iarg + 1; 407 call arg_ptr (Iarg, Parg, Larg, code, Parg_list); 408 return(TRUE); 409 410 get_op: entry (str, arg1) returns(bit(1)); /* Returns TRUE if another argument exists. */ 411 /* Its value is accessible via op variable. */ 412 413 dcl str char(*), 414 arg1 char(*); 415 416 dcl error_table_$smallarg fixed bin(35) ext static; 417 418 if Iarg+1 > Nargs then do; 419 if str ^= "" then 420 call error (error_table_$noarg, ME, str, arg1); 421 return(FALSE); 422 end; 423 Iarg = Iarg + 1; 424 call arg_ptr (Iarg, Pop, Lop, code, Parg_list); 425 if op = "" then do; 426 if str ^= "" then 427 call error (error_table_$smallarg, ME, """^va""^/" || str, length(op), op, arg1); 428 return(FALSE); 429 end; 430 return(TRUE); 431 432 433 put_op: entry; /* Return operand to list of unprocessed args. */ 434 435 Iarg = Iarg - 1; 436 return; 437 438 439 reprocess_args: /* Reprocess argument list again, starting with */ 440 entry (Ith_arg); /* the Ith argument. */ 441 442 dcl Ith_arg fixed bin; 443 444 Iarg = Ith_arg - 1; /* get_arg adds 1 before reading an arg. */ 445 return; 446 447 448 set_return_arg: /* Set AF return value. */ 449 entry (str); 450 451 ret = str; 452 return; 453 454 end get_arg; 455 456 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 457 458 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 459 460 461 sub_error_handler: 462 proc; 463 464 dcl code fixed bin(35), 465 continue_to_signal_ entry (fixed bin(35)), 466 error_table_$unimplemented_version 467 fixed bin(35) ext static, 468 find_condition_info_ entry (ptr, ptr, fixed bin(35)); 469 470 condition_info_ptr = addr (auto_condition_info); 471 condition_info.version = condition_info_version_1; 472 call find_condition_info_ (null(), addr(condition_info), code); 473 if code ^= 0 then 474 call error (code, ME, "Handling sub_error_ condition from format_document_$string."); 475 476 sub_error_info_ptr = condition_info.info_ptr; 477 if sub_error_info.version ^= sub_error_info_version_1 then 478 call error (error_table_$unimplemented_version, ME, " 479 Version ^d of sub_error_info structure isn't supported.", 480 sub_error_info.version); 481 if sub_error_info.name ^= "format_document_" then do; 482 call continue_to_signal_ (code); 483 return; 484 end; 485 486 format_document_error_ptr = sub_error_info.info_ptr; 487 if format_document_error.version_number ^= format_document_error_version_1 then 488 call error (error_table_$unimplemented_version, ME, " 489 Version ^d of format_document_error structure isn't supported.", 490 format_document_error.version_number); 491 call error (format_document_error.error_code, ME); 492 return; 493 1 1 /* BEGIN INCLUDE FILE ... condition_info.incl.pl1 */ 1 2 1 3 /* Structure for find_condition_info_. 1 4* 1 5* Written 1-Mar-79 by M. N. Davidoff. 1 6**/ 1 7 1 8 /* automatic */ 1 9 1 10 declare condition_info_ptr pointer; 1 11 1 12 /* based */ 1 13 1 14 declare 1 condition_info aligned based (condition_info_ptr), 1 15 2 mc_ptr pointer, /* pointer to machine conditions at fault time */ 1 16 2 version fixed binary, /* Must be 1 */ 1 17 2 condition_name char (32) varying, /* name of condition */ 1 18 2 info_ptr pointer, /* pointer to the condition data structure */ 1 19 2 wc_ptr pointer, /* pointer to wall crossing machine conditions */ 1 20 2 loc_ptr pointer, /* pointer to location where condition occured */ 1 21 2 flags unaligned, 1 22 3 crawlout bit (1), /* on if condition occured in lower ring */ 1 23 3 pad1 bit (35), 1 24 2 pad2 bit (36), 1 25 2 user_loc_ptr pointer, /* ptr to most recent nonsupport loc before condition occurred */ 1 26 2 pad3 (4) bit (36); 1 27 1 28 /* internal static */ 1 29 1 30 declare condition_info_version_1 1 31 fixed binary internal static options (constant) initial (1); 1 32 1 33 /* END INCLUDE FILE ... condition_info.incl.pl1 */ 494 495 496 dcl 1 auto_condition_info aligned like condition_info; 497 2 1 /* BEGIN INCLUDE FILE condition_info_header.incl.pl1 BIM 1981 */ 2 2 /* format: style2 */ 2 3 2 4 declare condition_info_header_ptr 2 5 pointer; 2 6 declare 1 condition_info_header 2 7 aligned based (condition_info_header_ptr), 2 8 2 length fixed bin, /* length in words of this structure */ 2 9 2 version fixed bin, /* version number of this structure */ 2 10 2 action_flags aligned, /* tell handler how to proceed */ 2 11 3 cant_restart bit (1) unaligned, /* caller doesn't ever want to be returned to */ 2 12 3 default_restart bit (1) unaligned, /* caller can be returned to with no further action */ 2 13 3 quiet_restart bit (1) unaligned, /* return, and print no message */ 2 14 3 support_signal bit (1) unaligned, /* treat this signal as if the signalling procedure had the support bit set */ 2 15 /* if the signalling procedure had the support bit set, do the same for its caller */ 2 16 3 pad bit (32) unaligned, 2 17 2 info_string char (256) varying, /* may contain printable message */ 2 18 2 status_code fixed bin (35); /* if^=0, code interpretable by com_err_ */ 2 19 2 20 /* END INCLUDE FILE condition_info_header.incl.pl1 */ 498 3 1 /* BEGIN INCLUDE FILE sub_error_info.incl.pl1 */ 3 2 /* format: style2 */ 3 3 3 4 /* The include file condition_info_header must be used with this file */ 3 5 3 6 declare sub_error_info_ptr pointer; 3 7 declare 1 sub_error_info aligned based (sub_error_info_ptr), 3 8 2 header aligned like condition_info_header, 3 9 2 retval fixed bin (35), /* return value */ 3 10 2 name char (32), /* module name */ 3 11 2 info_ptr ptr; 3 12 3 13 declare sub_error_info_version_1 3 14 internal static options (constant) fixed bin init (1); 3 15 3 16 /* END INCLUDE FILE sub_error_info.incl.pl1 */ 499 500 4 1 /* BEGIN INCLUDE FILE format_document_error.incl.pl1 4 2* 4 3* Information structure used by format_document_ in calls to sub_err_. 4 4* 4 5* Written 83.03.03 by Paul W. Benjamin 4 6* 4 7**/ 4 8 4 9 dcl 1 format_document_error aligned based (format_document_error_ptr), 4 10 2 version_number fixed bin, /* format_document_error_version_1 */ 4 11 2 error_code fixed bin (35), /* which error has occurred? */ 4 12 2 line_number fixed bin, /* and on what line? */ 4 13 2 text_line char (128) varying; /* the offending line (or first 128 chars) */ 4 14 4 15 dcl format_document_error_ptr ptr; 4 16 dcl format_document_error_version_1 fixed bin int static options (constant) init (1); 4 17 4 18 /* END INCLUDE FILE format_document_error.incl.pl1 */ 501 502 503 end sub_error_handler; 504 505 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 506 5 1 /* BEGIN INCLUDE FILE format_document_options.incl.pl1 5 2* 5 3* Modified 82.10.18 by Paul W. Benjamin to add dont_compress_sw and upgrade 5 4* to version_2. 5 5* Modified 83.02.15 by PWB to add break_word_sw and max_line_length_sw. 5 6* Modified 83.03.01 by PWB to add dont_break_indented_lines_sw. 5 7* Modified 83.03.03 by PWB to add sub_err_sw. 5 8* Modified 83.06.07 by PWB to add dont_fill_sw. 5 9* Modified 83.06.09 by PWB to add hyphenation_sw and syllable_size. 5 10**/ 5 11 5 12 dcl 1 format_document_options aligned based (format_document_options_ptr), 5 13 2 version_number fixed bin, /* input */ 5 14 /* must be format_document_version_2 */ 5 15 2 indentation fixed bin, /* input */ 5 16 /* all lines must be indented by this value */ 5 17 2 line_length fixed bin, /* input */ 5 18 /* initial line length */ 5 19 2 switches, 5 20 3 pgno_sw bit (1) unal, /* input */ 5 21 /* end each page with a centered page number */ 5 22 3 adj_sw bit (1) unal, /* input */ 5 23 /* adjust mode initially on */ 5 24 /* only meaningful if dont_fill_sw = "0"b */ 5 25 3 galley_sw bit (1) unal, /* input */ 5 26 /* galley mode -- no page breaks */ 5 27 3 error_sw bit (1) unal, /* input */ 5 28 /* report all errors on error_output */ 5 29 3 literal_sw bit (1) unal, /* input */ 5 30 /* "1"b - interpret all lines as text */ 5 31 /* "0"b - lines that start with "." are controls */ 5 32 3 file_sw bit (1) unal, /* output */ 5 33 /* has meaning for non-zero storage system status codes */ 5 34 /* "1"b code refers to output file */ 5 35 /* "0"b code refers to input file */ 5 36 3 dont_compress_sw bit (1) unal, /* input */ 5 37 /* "1"b - don't compress white space */ 5 38 /* "0"b - compress white space when filling */ 5 39 3 break_word_sw bit (1) unal, /* input */ 5 40 /* "1"b - break a word rather than exceed line_length */ 5 41 /* "0"b - write an overlength line if no spaces found */ 5 42 3 max_line_length_sw bit (1) unal, /* input */ 5 43 /* "1"b - line_length cannot be exceeded */ 5 44 /* "0"b - line_length can be exceeded (by .pdw controls) */ 5 45 3 dont_break_indented_lines_sw /* input */ 5 46 bit (1) unal, /* don't break a line that begins with whitespace */ 5 47 /* when it is the last line, or the next line is */ 5 48 /* null or the next line begins with whitespace */ 5 49 3 sub_err_sw bit (1) unal, /* input */ 5 50 /* quietly call sub_err_ with diagnostic errors */ 5 51 3 dont_fill_sw bit (1) unal, /* input */ 5 52 /* "1"b - fill mode off initially */ 5 53 /* "0"b - fill mode on initially */ 5 54 3 hyphenation_sw bit (1) unal, 5 55 3 mbz bit (23) unal, /* input */ 5 56 /* MUST be zero */ 5 57 2 syllable_size 5 58 fixed bin; /* input */ 5 59 /* smallest portion of word */ 5 60 /* to be left by hyphenation */ 5 61 5 62 dcl format_document_options_ptr ptr; 5 63 dcl format_document_version_2 fixed bin int static options (constant) init (2); 5 64 dcl format_document_version_1 fixed bin int static options (constant) init (1); 5 65 5 66 /* END INCLUDE FILE format_document_options.incl.pl1 */ 507 508 509 dcl 1 fdo aligned like format_document_options; 510 511 end format_string; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/01/84 1303.8 format_string.pl1 >special_ldd>online>6675-11/01/84>format_string.pl1 494 1 06/28/79 1204.8 condition_info.incl.pl1 >ldd>include>condition_info.incl.pl1 498 2 03/24/82 1347.2 condition_info_header.incl.pl1 >ldd>include>condition_info_header.incl.pl1 499 3 07/18/81 1100.0 sub_error_info.incl.pl1 >ldd>include>sub_error_info.incl.pl1 501 4 04/13/83 1552.8 format_document_error.incl.pl1 >ldd>include>format_document_error.incl.pl1 507 5 11/01/84 1301.3 format_document_options.incl.pl1 >special_ldd>online>6675-11/01/84>format_document_options.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. FALSE constant bit(1) initial unaligned dcl 59 ref 72 74 111 116 129 181 283 284 308 314 381 390 395 404 421 428 Iarg 000144 automatic fixed bin(17,0) dcl 353 set ref 141 394* 404 406* 406 407* 418 423* 423 424* 435* 435 444* Ifirst_string_arg 000100 automatic fixed bin(17,0) dcl 23 set ref 141* 195* Ith_arg parameter fixed bin(17,0) dcl 442 ref 439 444 Larg 000145 automatic fixed bin(21,0) dcl 353 set ref 83 85 85 86 86 87 87 91 91 91 92 92 93 93 97 97 97 98 98 99 99 103 103 104 104 105 105 109 109 111 111 114 116 119 119 121 121 122 122 129 129 132 132 136 136 142 144 197 200 407* Lop 000146 automatic fixed bin(21,0) dcl 353 set ref 87 87 93 93 99 99 105 105 122 122 424* 425 426 426 426 426 Lret 000147 automatic fixed bin(21,0) dcl 353 set ref 382* 387 451 Lstr_nonvar based fixed bin(21,0) dcl 40 ref 221 221 ME 000000 constant char(13) initial unaligned dcl 59 set ref 136* 149* 151* 153* 155* 158* 169* 171* 173* 224* 251* 296* 419* 426* 473* 477* 487* 491* NL 004161 constant char(1) initial unaligned dcl 59 ref 239 240 240 244 Nargs 000150 automatic fixed bin(17,0) dcl 353 set ref 382* 404 418 Parg 000152 automatic pointer dcl 353 set ref 83 85 85 86 87 91 91 91 92 93 97 97 97 98 99 103 103 104 105 109 109 111 111 114 116 119 119 121 122 129 129 132 132 136 142 144 197 200 407* Parg_list 000154 automatic pointer dcl 353 set ref 396* 407* 424* Pcode 000100 automatic pointer dcl 332 set ref 339* 340 Pop 000156 automatic pointer dcl 353 set ref 87 93 99 105 122 424* 425 426 426 426 Presult 000102 automatic pointer dcl 23 set ref 217* 218 221 228 230 234* 234 240 240 245 247 Pret 000160 automatic pointer dcl 353 set ref 382* 387 451 Pstr 000104 automatic pointer dcl 23 set ref 167* 169* 171* 175 191 192 197 197 199 199 200 200 204 204 207 208 209 209 212 213 213 221 221 251 251* Pstr_nonvar 000106 automatic pointer dcl 23 set ref 175* 221 Pundent_line 000110 automatic pointer dcl 23 set ref 204* 206 208 208 212 212 217 217 230 SP 004160 constant char(1) initial unaligned dcl 59 ref 144 199 206 213 Sadjust 000112 automatic bit(1) unaligned dcl 23 set ref 72* 109* 111* 182 Saf 000162 automatic bit(1) unaligned dcl 353 in procedure "fstr" set ref 70* 243 Saf parameter bit(1) unaligned dcl 379 in procedure "get_invocation_type" set ref 376 384* 390* Sbreak_word 000113 automatic bit(1) unaligned dcl 23 set ref 73* 114* 116* 185 Serror 000142 automatic bit(1) unaligned dcl 325 set ref 161 341* 395* Serrors_are_fatal 000143 automatic bit(1) unaligned dcl 325 set ref 172* 343 381* Shyphenate 000114 automatic bit(1) unaligned dcl 23 set ref 74* 120* 129* 188 Smust_be_nonnegative 000100 automatic bit(1) unaligned dcl 272 set ref 283* 293 307* 314* Smust_be_positive 000101 automatic bit(1) unaligned dcl 272 set ref 284* 293 308* 315* TRUE constant bit(1) initial unaligned dcl 59 ref 73 109 114 120 172 183 184 186 187 307 315 341 384 408 430 abs builtin function dcl 47 ref 163 active_fnc_err_ 000042 constant entry external dcl 353 ref 386 addr builtin function dcl 47 ref 221 221 234 470 472 472 addrel builtin function dcl 47 ref 175 204 217 arg based char unaligned dcl 353 set ref 83 85 85 86* 87* 91 91 91 92* 93* 97 97 97 98* 99* 103 103 104* 105* 109 109 111 111 114 116 119 119 121* 122* 129 129 132 132 136* 142 144 197 200 arg1 parameter char unaligned dcl 413 in procedure "get_arg" set ref 410 419* 426* arg1 parameter char unaligned dcl 268 in procedure "cv_int" set ref 266 296* 296* 304 311 arg_ptr 000164 automatic entry variable dcl 353 set ref 385* 391* 407 424 auto_condition_info 000112 automatic structure level 1 dcl 496 set ref 470 cleanup 000126 stack reference condition dcl 51 ref 168 code 000115 automatic fixed bin(35,0) dcl 23 in procedure "fstr" set ref 169* 171* 173* 221* 224 224* 251* 287* 295* 296* 382* 383 407* 424* code based fixed bin(35,0) dcl 332 in procedure "error" ref 340 code 000106 automatic fixed bin(35,0) dcl 464 in procedure "sub_error_handler" set ref 472* 473 473* 482* com_err_ 000044 constant entry external dcl 353 ref 392 condition_info based structure level 1 dcl 1-14 set ref 472 472 condition_info_header based structure level 1 dcl 2-6 condition_info_ptr 000110 automatic pointer dcl 1-10 set ref 470* 471 472 472 476 condition_info_version_1 constant fixed bin(17,0) initial dcl 1-30 ref 471 continue_to_signal_ 000062 constant entry external dcl 464 ref 482 conversion 000104 stack reference condition dcl 278 ref 286 292 convert builtin function dcl 276 ref 291 copy builtin function dcl 47 ref 192 206 213 cu_$af_arg_ptr_rel 000032 constant entry external dcl 353 ref 385 cu_$af_return_arg 000036 constant entry external dcl 353 ref 382 cu_$arg_list_ptr 000040 constant entry external dcl 353 in procedure "fstr" ref 396 cu_$arg_list_ptr 000052 constant entry external dcl 335 in procedure "error" ref 342 342 cu_$arg_ptr 000054 constant entry external dcl 335 ref 339 cu_$arg_ptr_rel 000034 constant entry external dcl 353 ref 391 cu_$generate_call 000056 constant entry external dcl 335 ref 342 currentsize builtin function dcl 47 ref 204 217 err 000170 automatic entry variable dcl 353 set ref 342* 386* 392* error_code 1 based fixed bin(35,0) level 2 dcl 4-9 set ref 491* error_table_$bad_conversion 000046 external static fixed bin(35,0) dcl 280 ref 287 error_table_$badopt 000022 external static fixed bin(35,0) dcl 59 set ref 136* error_table_$inconsistent 000024 external static fixed bin(35,0) dcl 59 set ref 151* 153* 155* 158* error_table_$noarg 000026 external static fixed bin(35,0) dcl 59 set ref 149* 419* error_table_$out_of_bounds 000050 external static fixed bin(35,0) dcl 280 ref 295 error_table_$smallarg 000060 external static fixed bin(35,0) dcl 416 set ref 426* error_table_$unimplemented_version 000064 external static fixed bin(35,0) dcl 464 set ref 477* 487* fdo 000174 automatic structure level 1 dcl 509 set ref 221 221 find_condition_info_ 000066 constant entry external dcl 464 ref 472 format_document_$string 000010 constant entry external dcl 53 ref 221 format_document_error based structure level 1 dcl 4-9 format_document_error_ptr 000146 automatic pointer dcl 4-15 set ref 486* 487 487 491 format_document_error_version_1 constant fixed bin(17,0) initial dcl 4-16 ref 487 format_document_options based structure level 1 dcl 5-12 format_document_version_2 constant fixed bin(17,0) initial dcl 5-63 ref 178 get_temp_segment_ 000012 constant entry external dcl 53 ref 171 header based structure level 2 dcl 3-7 hyphenate_word_part 000116 automatic fixed bin(17,0) dcl 23 set ref 75* 122* 123 125* 189 indent 000117 automatic fixed bin(17,0) dcl 23 set ref 76* 93* 151 151 151* 153 153* 155 155 155* 179 180 206 228 230 233 index builtin function dcl 47 ref 83 info_ptr 14 based pointer level 2 in structure "condition_info" dcl 1-14 in procedure "sub_error_handler" set ref 476 info_ptr 116 based pointer level 2 in structure "sub_error_info" dcl 3-7 in procedure "sub_error_handler" ref 486 ioa_$nnl 000016 constant entry external dcl 53 ref 247 length builtin function dcl 47 ref 142 144 144 207 213 239 240 244 426 426 line_length 000120 automatic fixed bin(17,0) dcl 23 set ref 77* 87* 151 151* 155 155* 158 158* 180 206 208 212 217 name 106 based char(32) level 2 dcl 3-7 ref 481 null builtin function dcl 47 ref 167 251 472 472 number 000102 automatic fixed bin(17,0) dcl 272 set ref 291* 291 293 293 299 op parameter char unaligned dcl 268 in procedure "cv_int" set ref 266 291 296* 304 311 op based char unaligned dcl 353 in procedure "fstr" set ref 87* 93* 99* 105* 122* 425 426 426 426* release_temp_segment_ 000014 constant entry external dcl 53 ref 169 251 requote_string_ 000020 constant entry external dcl 53 ref 245 result based char unaligned dcl 40 set ref 221* 228* 230* 240* 240 245* 247* result_array based char(1) array unaligned dcl 40 set ref 234 result_len 000123 automatic fixed bin(21,0) dcl 23 set ref 218* 221 221 221* 228 230 235* 235 239* 239 240 240 240 244* 244 245 245 247 247 ret based varying char dcl 353 set ref 387* 451* size 000112 stack reference condition dcl 278 ref 286 292 starting_column 000121 automatic fixed bin(17,0) dcl 23 set ref 78* 105* 158 158* 163 232 233 234 235 str based varying char dcl 40 in procedure "fstr" set ref 191* 192* 197* 197 199* 199 200* 200 204 207 208 209* 209 212 213* 213 str parameter char unaligned dcl 268 in procedure "cv_int" ref 266 288 296 304 311 str parameter char unaligned dcl 413 in procedure "get_arg" set ref 410 419 419* 426 426 448 451 str_length 000124 automatic fixed bin(21,0) dcl 23 set ref 79* 142* 142 144* 144 149 163* 163 191 192 197 199 200 204 209 213 str_nonvar based char unaligned dcl 40 set ref 221* sub_error_ 000134 stack reference condition dcl 51 ref 220 223 sub_error_info based structure level 1 dcl 3-7 sub_error_info_ptr 000144 automatic pointer dcl 3-6 set ref 476* 477 477 481 486 sub_error_info_version_1 constant fixed bin(17,0) initial dcl 3-13 ref 477 substr builtin function dcl 47 set ref 208 209 228* 230* 240 sys_info$max_seg_size 000030 external static fixed bin(35,0) dcl 59 ref 218 undent 000122 automatic fixed bin(17,0) dcl 23 set ref 80* 99* 153 153 153* 155 155 155* 163 192 192 205 206 207 208 209 213 228 228 230 233 undent_line based varying char dcl 40 set ref 206* 208* 208 212* 212 217 230 version 2 based fixed bin(17,0) level 2 in structure "condition_info" dcl 1-14 in procedure "sub_error_handler" set ref 471* version 1 based fixed bin(17,0) level 3 in structure "sub_error_info" dcl 3-7 in procedure "sub_error_handler" set ref 477 477* version_number based fixed bin(17,0) level 2 dcl 4-9 set ref 487 487* wordno builtin function dcl 47 ref 218 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. condition_info_header_ptr automatic pointer dcl 2-4 format_document_options_ptr automatic pointer dcl 5-62 format_document_version_1 internal static fixed bin(17,0) initial dcl 5-64 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_NUM 002743 constant label dcl 296 ref 289 BAD_NUM_OK 003031 constant label dcl 301 ref 288 CV_NUM 002651 constant label dcl 286 ref 309 316 RETURN 002573 constant label dcl 251 ref 343 STRING_ARG 001337 constant label dcl 141 ref 133 cv_int 002622 constant entry internal dcl 266 ref 99 cv_int$nonneg 003036 constant entry internal dcl 304 ref 93 cv_int$pos 003070 constant entry internal dcl 311 ref 87 105 122 error 003122 constant entry internal dcl 328 ref 136 149 151 153 155 158 173 224 296 419 426 473 477 487 491 format_string 000432 constant entry external dcl 20 fstr 000423 constant entry external dcl 20 get_arg 003274 constant entry internal dcl 401 ref 82 133 143 196 198 get_invocation_type 003204 constant entry internal dcl 376 ref 70 get_op 003360 constant entry internal dcl 410 ref 86 92 98 104 121 put_op 003630 constant entry internal dcl 433 ref 124 reprocess_args 003650 constant entry internal dcl 439 ref 195 set_return_arg 003672 constant entry internal dcl 448 ref 245 sub_error_handler 003730 constant entry internal dcl 461 ref 220 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4600 4670 4163 4610 Length 5244 4163 70 340 415 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fstr 258 external procedure is an external procedure. on unit on line 168 78 on unit on unit on line 220 168 on unit cv_int 246 internal procedure enables or reverts conditions. on unit on line 286 64 on unit error 82 internal procedure is called during a stack extension, and is declared options(variable). get_invocation_type internal procedure shares stack frame of external procedure fstr. get_arg 138 internal procedure is called during a stack extension. sub_error_handler internal procedure shares stack frame of on unit on line 220. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cv_int 000100 Smust_be_nonnegative cv_int 000101 Smust_be_positive cv_int 000102 number cv_int error 000100 Pcode error fstr 000100 Ifirst_string_arg fstr 000102 Presult fstr 000104 Pstr fstr 000106 Pstr_nonvar fstr 000110 Pundent_line fstr 000112 Sadjust fstr 000113 Sbreak_word fstr 000114 Shyphenate fstr 000115 code fstr 000116 hyphenate_word_part fstr 000117 indent fstr 000120 line_length fstr 000121 starting_column fstr 000122 undent fstr 000123 result_len fstr 000124 str_length fstr 000142 Serror fstr 000143 Serrors_are_fatal fstr 000144 Iarg fstr 000145 Larg fstr 000146 Lop fstr 000147 Lret fstr 000150 Nargs fstr 000152 Parg fstr 000154 Parg_list fstr 000156 Pop fstr 000160 Pret fstr 000162 Saf fstr 000164 arg_ptr fstr 000170 err fstr 000174 fdo fstr on unit on line 220 000106 code sub_error_handler 000110 condition_info_ptr sub_error_handler 000112 auto_condition_info sub_error_handler 000144 sub_error_info_ptr sub_error_handler 000146 format_document_error_ptr sub_error_handler THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a alloc_cs call_var call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc return tra_ext signal enable shorten_stack ext_entry int_entry int_entry_desc any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ continue_to_signal_ cu_$af_arg_ptr_rel cu_$af_return_arg cu_$arg_list_ptr cu_$arg_list_ptr cu_$arg_ptr cu_$arg_ptr_rel cu_$generate_call find_condition_info_ format_document_$string get_temp_segment_ ioa_$nnl release_temp_segment_ requote_string_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$badopt error_table_$inconsistent error_table_$noarg error_table_$out_of_bounds error_table_$smallarg error_table_$unimplemented_version sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 20 000422 70 000437 72 000441 73 000442 74 000444 75 000445 76 000447 77 000450 78 000452 79 000454 80 000455 82 000456 83 000467 85 000503 86 000514 87 000545 89 000602 91 000603 92 000617 93 000650 95 000705 97 000706 98 000722 99 000753 101 001010 103 001011 104 001021 105 001052 107 001107 109 001110 111 001123 114 001135 116 001144 119 001152 120 001162 121 001164 122 001212 123 001244 124 001247 125 001253 128 001255 129 001256 132 001270 133 001300 134 001311 136 001312 138 001336 141 001337 142 001341 143 001343 144 001355 145 001361 147 001362 149 001363 151 001411 153 001450 155 001512 158 001565 161 001623 163 001625 167 001634 168 001636 169 001652 170 001673 171 001674 172 001715 173 001717 175 001745 178 001750 179 001752 180 001754 181 001757 182 002013 183 002020 184 002022 185 002024 186 002031 187 002033 188 002035 189 002042 191 002044 192 002045 195 002064 196 002073 197 002105 198 002121 199 002133 200 002143 201 002156 202 002157 204 002160 205 002167 206 002171 207 002207 208 002213 209 002226 210 002240 212 002241 213 002254 214 002272 217 002273 218 002302 220 002314 221 002332 223 002373 224 002374 228 002422 230 002433 232 002443 233 002446 234 002456 235 002464 236 002466 239 002467 240 002470 241 002511 243 002512 244 002515 245 002517 246 002547 247 002551 251 002573 253 002620 266 002621 283 002647 284 002650 286 002651 287 002665 288 002671 289 002704 286 002707 291 002714 292 002725 293 002727 295 002737 296 002743 297 003021 299 003026 301 003031 304 003035 307 003063 308 003065 309 003066 311 003067 314 003115 315 003116 316 003120 328 003121 339 003127 340 003147 341 003151 342 003154 343 003175 346 003203 376 003204 381 003206 382 003207 383 003224 384 003226 385 003233 386 003240 387 003243 388 003244 390 003245 391 003252 392 003257 394 003262 395 003263 396 003264 398 003272 401 003273 404 003306 406 003325 407 003326 408 003344 410 003357 418 003405 419 003412 421 003450 423 003463 424 003464 425 003502 426 003511 428 003600 430 003614 433 003627 435 003636 436 003641 439 003647 444 003656 445 003663 448 003671 451 003706 452 003722 461 003730 470 003731 471 003733 472 003735 473 003754 476 004002 477 004005 481 004041 482 004046 483 004055 486 004056 487 004060 491 004114 492 004132 ----------------------------------------------------------- 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