COMPILATION LISTING OF SEGMENT speedtype_expand_ Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1248.4 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 speedtype_expand_: procedure (arg_in_ptr, arg_in_len, arg_out_ptr, arg_out_len, arg_out_used, arg_ecode); 11 12 /* This procedure is an internal and external interface of the Speedtype subsystem. 13* * Created on 12/29/75 by Bill Silver as notescript_expand_. 14* * Changed on 06/13/77 by Bill Silver to speedtype_expand_. 15* * Changed on 06/03/80 by Paul Benjamin to add special suffixing. 16**/ 17 /* ARGUMENTS */ 18 19 dcl arg_ecode fixed bin (35); /* (O) error_table code. */ 20 dcl arg_in_len fixed bin (21); /* (I) Length of input string in characters. */ 21 dcl arg_in_ptr ptr; /* (I) Pointer to input string. */ 22 dcl arg_out_len fixed bin (21); /* (I) Length of output buffer in characters. */ 23 dcl arg_out_ptr ptr; /* (I) Pointer to output buffer. */ 24 dcl arg_out_used fixed bin (21); /* (O) Actual length of output in characters. */ 25 26 27 /* AUTOMATIC DATA */ 28 29 dcl symbol_buffer char (8); /* Holds symbol string. */ 30 dcl exp_buffer char (300); /* Holds modified expansion. */ 31 32 dcl continue_flag bit (1); /* ON => continue prefix processing. */ 33 dcl convert_flag bit (1); /* ON => convert perm escape to pad escape. */ 34 dcl escape_flag bit (1); /* ON => escape next text token. */ 35 dcl first_flag bit (1); /* ON => first letter of symbol is a capital. */ 36 dcl period_flag bit (1); /* ON => last character of symbol is a period. */ 37 dcl prefix_flag bit (1); /* ON => symbol preceded by prefix character(s). */ 38 dcl under_flag bit (1); /* ON => underline processing. */ 39 dcl upper_flag bit (1); /* ON => uppercase processing. */ 40 41 dcl actionx fixed bin; /* Used to process suffixes. */ 42 dcl ecode fixed bin (35); /* Error table code. */ 43 dcl first_char_ptr ptr; /* Pointer to first output character. */ 44 dcl i fixed bin; 45 dcl in_len fixed bin (21); /* Length of unused part of input string. */ 46 dcl in_ptr ptr; /* Pointer to input string. */ 47 dcl in_used fixed bin; /* Length of used part of input string. */ 48 dcl last_char char (1); /* Used for adding "ing". */ 49 dcl sb_tab_len fixed bin; /* Length of defined symbol entry table. */ 50 dcl sb_tab_ptr ptr; /* Pointer to symbol table. */ 51 dcl sbx fixed bin; /* Symbol table entry index. */ 52 dcl out_len fixed bin (21); /* Length of actual output. */ 53 dcl out_ptr ptr; /* Pointer to output string. */ 54 dcl out_used fixed bin (21); /* Length of used part of output string. */ 55 dcl space_count fixed bin; /* Number of spaces to add. */ 56 dcl startx fixed bin; /* Start of underscore triplet in work buffer. */ 57 dcl suffix char (4) varying; /* Used to add a suffix string. */ 58 dcl suffix_len fixed bin; /* Length of the suffix string. */ 59 dcl suffixx fixed bin; /* Index of suffix character. */ 60 dcl symbol_len fixed bin; /* Length of actual symbol. */ 61 dcl symbol_ptr ptr; /* Pointer to actual symbol. */ 62 dcl test_char char (1); 63 dcl token_len fixed bin; /* Length of one token. */ 64 dcl token_ptr ptr; /* Pointer to a token. */ 65 dcl x fixed bin; 66 67 68 /* BASED DATA */ 69 70 dcl 1 input based (in_ptr) aligned, /* Overlay of input string. */ 71 (2 used char (in_used), /* Part of segment that has been processed. */ 72 2 text char (in_len)) unaligned; /* Part of segment still to be processed. */ 73 74 dcl 1 output based (out_ptr) aligned, /* Overlay of output string. */ 75 (2 used char (out_used), /* Part of segment that has been processed. */ 76 2 text char (1)) unaligned; /* Beginning of unprocessed part. */ 77 78 dcl sb_table char (sb_tab_len) based (sb_tab_ptr) aligned; 79 80 dcl symbol char (symbol_len) based (symbol_ptr); /* Overlay of actual symbol. */ 81 dcl token char (token_len) based (token_ptr); /* Overlay of one token string. */ 82 83 dcl token_first_char char (1) based (token_ptr); 84 85 86 /* INTERNAL STATIC DATA */ 87 88 dcl spaces char (99) /* Used to fill in spaces. */ 89 internal static init (" "); 90 91 dcl backspace char (1) /* Used to underscore a token. */ 92 internal static init (""); 93 94 dcl caps char (26) aligned /* Capital letters in frequency order. */ 95 internal static init ("EAIOUSTCYHNLMRWFGPBDJQKXVZ"); 96 97 dcl lowers char (26) aligned /* Lower case letters in the same order. */ 98 internal static init ("eaioustcyhnlmrwfgpbdjqkxvz"); 99 100 dcl suffix_strings (5) char (4) varying aligned 101 internal static init ("s", "ed", "ing", "er", "ly"); 102 103 dcl period char (1) /* Used to move a period character. */ 104 internal static init ("."); 105 106 107 /* EXTERNAL ENTRIES */ 108 109 dcl (addr, fixed, index, length, search, substr, verify) builtin; 110 111 dcl error_table_$item_too_big fixed bin (35) external; 112 113 dcl speedtype_info_$pointer entry (ptr, fixed bin (35)); 114 /* */ 1 1 /* Begin include file ... speedtype_symbols.incl.pl1 1 2** Created on 09/06/76 by Bill Silver. 1 3** Modified 06/03/80 by Paul Benjamin to allow special suffixing. 1 4** 1 5** This include file defines the format of a Speedtype Symbol Dictionary. 1 6** The default Speedtype options are: 1 7** 1 8** ESCAPES: 1 9** temp "~" pad (Octal 177) perm "`" trans ":" space ";" 1 10** PREFIXES: 1 11** under "_" upper "+" 1 12** SUFFIXES: 1 13** plural "+" ed "-" ing "*" er "=" ly "|" 1 14** DELIMITERS: 1 15** ,"()?!<>[]{} 1 16**/ 1 17 dcl ssd_ptr ptr; /* Pointer to the base of a Speedtype Symbol Dictionary. */ 1 18 dcl exp_ptr ptr; /* Pointer to an expansion entry. */ 1 19 dcl sb_ptr ptr; /* Pointer to a symbol entry. */ 1 20 dcl spc_ptr ptr; /* Pointer to a special entry. */ 1 21 dcl delim_ptr ptr; /* Pointer to delimiter characters. */ 1 22 1 23 dcl ssd_version_2 fixed bin /* Version of this include file. */ 1 24 internal static init (2); 1 25 1 26 dcl 1 ssd based(ssd_ptr) aligned, /* Format of a Speedtype Symbol Dictionary. */ 1 27 2 version fixed bin, /* Version number. Currently = 2. */ 1 28 2 identifier char(12), /* "Seedtype_SD" => this is a Speedtype Symbol Dictionary. */ 1 29 2 flags bit(36), /* Not used, all zero. */ 1 30 2 delimiters char(24), /* Blank, New Line, Tab, Escapes, Others. */ 1 31 2 escapes char(5), /* Pad, Perm, Temp, Trans, Space */ 1 32 2 prefixes char(2), /* Under, Upper. */ 1 33 2 suffixes char(5), /* Plural, ed, ing, er, ly. */ 1 34 2 num_symbols fixed bin, /* Number of defined symbols. */ 1 35 2 table_size fixed bin, /* Size of the 3 tables to follow. */ 1 36 2 pad(14) bit(36), /* Round out header to 32 words. */ 1 37 2 spec_tab(table_size) like spc, /* Special entries. */ 1 38 2 exp_tab(table_size) like exp, /* Expansion entries. */ 1 39 2 sb_tab(table_size) like sb; /* Symbol entries. */ 1 40 1 41 dcl 1 delim_chars based(delim_ptr) aligned, /* Overlay of ssd.delimiters. */ 1 42 ( 2 blank char(1), 1 43 2 new_line char(1), 1 44 2 tab char(1), 1 45 2 escapes char(5), 1 46 2 others char(16)) unaligned; 1 47 1 48 dcl 1 sb based(sb_ptr) aligned, /* Symbol entry. */ 1 49 ( 2 new_line char(1), /* Needed to make index functions work. */ 1 50 2 symbol char(7)) unal; /* Actual symbol string. */ 1 51 1 52 dcl 1 exp based(exp_ptr) aligned, /* Expansion entry. */ 1 53 ( 2 actionx(5) fixed bin(8), /* Action index for each suffix. */ 1 54 2 pad fixed bin(17), /* Reserved for additional suffixes, flags, etc.. */ 1 55 2 len fixed bin(8), /* Actual length of expansion. */ 1 56 2 expansion char(56)) unal; /* Expansion of string (56 => size(exp) = 16 words). */ 1 57 dcl 1 spc based(spc_ptr) aligned, /* Special entry. */ 1 58 2 special (5) char(56) unal; /* One for each possible suffix. */ 1 59 1 60 /* End include file ... speedtype_symbols.incl.pl1 */ 115 116 /* */ 117 /* Begin Expansion 118**/ 119 in_ptr = arg_in_ptr; /* Copy arguments and initialize. */ 120 in_len = arg_in_len; 121 out_ptr = arg_out_ptr; 122 out_len = arg_out_len; 123 124 in_used, 125 out_used, 126 ecode = 0; 127 128 call INIT_SYMBOL_DICT; /* Set up to use current Speedtype symbol dictionary. */ 129 if ecode ^= 0 then goto RETURN; 130 131 do while ((in_len > 0) & (ecode = 0)); /* Copy input to output until no more input. */ 132 call COPY_DELIMITERS; /* Copy all delimiters up to next token. */ 133 call COPY_TEXT; /* Copy next text token. */ 134 end; 135 136 RETURN: 137 arg_out_used = out_used; /* Return number of chars in output string. */ 138 arg_ecode = ecode; 139 return; 140 141 142 143 144 145 MOVE_OUT: procedure; 146 147 /* This procedure is called to move the current token string 148* * into the output string. It will make sure that there is 149* * enough room in the output string. 150**/ 151 if token_len = 0 then return; /* No token => nothing to do. */ 152 153 if (out_used + token_len) > out_len /* Is there room for this output? */ 154 then do; /* No. */ 155 token_len = out_len - out_used; /* Make equal to actual length of token moved. */ 156 ecode = error_table_$item_too_big; 157 end; 158 159 addr (output.text) -> token = token; /* Copy token into output. */ 160 161 out_used = out_used + token_len; /* Move output pointer over token. */ 162 163 end MOVE_OUT; 164 /* */ 165 COPY_DELIMITERS: procedure; 166 167 /* This procedure is called to copy all delimiters up to the next token 168* * or up to the end of the input string. 169**/ 170 token_ptr = addr (input.text); /* Copy delimiters as a token. */ 171 token_len = verify (input.text, ssd.delimiters); /* Position to next non-delimiter character. */ 172 173 if token_len > 0 /* Did we hit a real token? */ 174 then token_len = token_len - 1; /* Yes, get real length of delimiter token. */ 175 else token_len = in_len; /* No, we hit the end of the input string. */ 176 177 if token_len = 0 then return; /* If no delimiters return. */ 178 179 in_used = in_used + token_len; /* Move window on input string. */ 180 in_len = in_len - token_len; 181 182 call CHECK_ESCAPES; /* Process any escape delimiters. */ 183 184 call MOVE_OUT; /* Copy delimiters into output string. */ 185 186 if convert_flag /* Was there a perm escape? */ 187 then do; /* Yes, convert to pad escape. */ 188 substr (output.used, out_used, 1) = substr (ssd.escapes, 1, 1); 189 convert_flag = "0"b; 190 end; 191 192 if continue_flag /* Was there a trans escape? */ 193 then continue_flag = "0"b; /* Yes, just turn off flag. */ 194 else do; /* No, turn off all prefix flags. */ 195 under_flag = "0"b; 196 upper_flag = "0"b; 197 end; 198 199 if space_count = 0 then return; /* If no spacing, all done. */ 200 201 token_ptr = addr (spaces); /* Prepare to move the specified number of spaces. */ 202 token_len = space_count; 203 call MOVE_OUT; /* Move the spaces. */ 204 space_count = 0; /* Reset this counter/flag. */ 205 206 end COPY_DELIMITERS; 207 /* */ 208 CHECK_ESCAPES: procedure; 209 210 /* This procedure is called to check the last character in a delimiter string 211* * to see if it is an escape. If so, special processing must be done. 212* * The escape flag will be ON if the following term is to be escaped. 213**/ 214 /* See if last delimiter is an escape. */ 215 x = index (ssd.escapes, substr (token, token_len, 1)); 216 217 goto ESCAPE (x); /* Go process escape accordingly. */ 218 219 ESCAPE (0): /* NONE */ 220 return; 221 222 ESCAPE (1): /* PAD */ 223 escape_flag = "1"b; 224 return; /* Nothing to do, next token is escaped. */ 225 226 ESCAPE (2): /* PERMANENT */ 227 convert_flag, /* After move, convert to pad escape. */ 228 escape_flag = "1"b; 229 return; 230 231 ESCAPE (3): /* TEMPORARY */ 232 escape_flag = "1"b; 233 token_len = token_len - 1; /* This escape character not copied. */ 234 return; 235 236 ESCAPE (4): /* TRANSPARENT */ 237 continue_flag = "1"b; /* Continue any prefix processing. */ 238 token_len = token_len - 1; /* Don't copy transparent escape character. */ 239 return; 240 241 ESCAPE (5): /* SPACE */ 242 if in_len = 0 then return; /* If no more input then all done. */ 243 244 x = verify (input.text, "0123456789") -1; /* Get following numeric characters. */ 245 if (x < 1) | (x > 2) /* Space count must be from 1 to 99. */ 246 then return; /* Not a valid space count. */ 247 248 space_count = fixed (substr (input.text, 1, x)); 249 250 in_used = in_used + x; /* Skip over space count characters. */ 251 in_len = in_len - x; 252 253 token_len = token_len - 1; /* Delete space escape delimiter. */ 254 return; 255 256 end CHECK_ESCAPES; 257 /* */ 258 COPY_TEXT: procedure; 259 260 /* This procedure will copy one real token from the input string to the 261* * output string. A real token is defined as a string with no delimiters. 262* * We will check to see if this token is a defined symbol in the current 263* * Speedtype symbol dictionary. If it is we will copy its expansion. 264**/ 265 if (in_len = 0) | /* Have we reached the end of the input string? */ 266 (ecode ^= 0) /* Or was there an error? */ 267 then return; /* Yes, no copy needed. */ 268 269 token_ptr = addr (input.text); /* Token starts with beginning of input data. */ 270 token_len = search (input.text, delimiters); /* Ends with next delimiter. */ 271 272 if token_len > 0 /* Did we hit a delimiter? */ 273 then token_len = token_len - 1; /* Yes, get real length of token. */ 274 else token_len = in_len; /* No, we hit the end of the input string. */ 275 276 in_used = in_used + token_len; /* Move window on input string. */ 277 in_len = in_len - token_len; 278 279 call GET_SYMBOL; /* Get expanded or unexpanded symbol. */ 280 281 first_char_ptr = addr (output.text); /* Remember where first output character will be. */ 282 call MOVE_OUT; /* Copy token into output string. */ 283 if ecode ^= 0 then return; /* Check for end of output seg. */ 284 285 if first_flag /* Do we have to replace the first character? */ 286 then do; /* Yes, translate 1st char of expansion. */ 287 x = index (lowers, token_first_char); 288 if x ^= 0 /* If a lowercase letter make uppercase. */ 289 then first_char_ptr -> token_first_char = substr (caps, x, 1); 290 first_flag = "0"b; 291 end; 292 if upper_flag /* Uppercase processing? */ 293 then do; /* Yes, convert lowercase to uppercase. */ 294 token_ptr = first_char_ptr; /* Process expansion in output string. */ 295 do i = 1 to token_len; /* Test each text character copied. */ 296 x = index (lowers, substr (token, i, 1)); 297 if x ^= 0 /* Is this character a lowercase letter? */ 298 then substr (token, i, 1) = substr (caps, x, 1); 299 end; 300 end; 301 if under_flag /* Underline processing? */ 302 then do; /* Yes. */ 303 call UNDERLINE; 304 if ecode ^= 0 then return; 305 end; 306 if period_flag /* Did symbol have a trailing period? */ 307 then do; /* Yes. */ 308 token_ptr = addr (period); /* Copy a period into output string. */ 309 token_len = 1; 310 call MOVE_OUT; 311 period_flag = "0"b; 312 end; 313 314 end COPY_TEXT; 315 /* */ 316 GET_SYMBOL: procedure; 317 318 /* This procedure will test the current token to see if it is a defined 319* * symbol in the current Speedtype symbol dictionary. If it is, the expansion 320* * of this symbol will be copied instead. Special processing of the leading 321* * and trailing characters of the token is performed: 322* * 1. If the last delimiter character was the escape character then the 323* * token is without expansion. 324* * 2. If the first characters of the token are prefix characters, 325* * then these prefix character are stripped from the token. 326* * The output string for this token (expanded or not) is 327* * processed as specified by these prefixes. 328* * 3. If the last character of the text token is a period ".", 329* * then the period is temporarily stripped from the token. 330* * 4. If the last character (after any period is stripped) is a 331* * suffix character, then this character is stripped off and 332* * suffixing is specified. 333* * 5. Before testing to see if this token is a defined symbol we 334* * will translate the first character to lower case if it is an 335* * upper case letter. The original character will be replaced 336* * in the expanded string. 337* * 6. If the last character in the token was a suffix character then the 338* * expansion, if there is one, has the specified suffix added. 339**/ 340 if escape_flag /* Is this token to be escaped? */ 341 then do; /* Yes, copy as is. */ 342 escape_flag = "0"b; 343 return; 344 end; 345 346 symbol_len = token_len; /* Now, symbol = text token. */ 347 symbol_ptr = token_ptr; 348 349 prefix_flag = "1"b; /* Turn ON to get into the loop. */ 350 do while (prefix_flag); /* Process all prefix characters. */ 351 x = index (ssd.prefixes, substr (symbol, 1, 1)); 352 if x = 0 /* Is there a prefix? */ 353 then prefix_flag = "0"b; /* No. */ 354 else do; /* Yes, remember to process this prefix. */ 355 if symbol_len = 1 /* Is the symbol just the prefix? */ 356 then return; /* Yes, it is not a valid symbol. */ 357 symbol_ptr = addr (substr (symbol, 2, 1)); /* Strip prefix character from symbol. */ 358 symbol_len = symbol_len - 1; 359 if x = 1 /* Which prefix is it? */ 360 then under_flag = "1"b; 361 else upper_flag = "1"b; 362 end; 363 end; 364 365 if substr (symbol, symbol_len, 1) = "." /* Is there a trailing period? */ 366 then do; /* Yes. */ 367 if symbol_len = 1 /* Is the symbol just the period? */ 368 then do; /* Yes, it is an invalid symbol. */ 369 under_flag, /* Turn off prefix processing. */ 370 upper_flag = "0"b; 371 return; 372 end; 373 symbol_len = symbol_len - 1; /* Strip off period. */ 374 period_flag = "1"b; /* Remember period. */ 375 end; 376 377 suffixx = index (ssd.suffixes, substr (symbol, symbol_len, 1)); 378 if suffixx > 0 /* Is last character of symbol a suffix? */ 379 then do; /* Yes. */ 380 if symbol_len = 1 /* Is symbol just a suffix? */ 381 then return; /* Yes, an invalid symbol. */ 382 symbol_len = symbol_len - 1; /* Strip off suffix character. */ 383 end; 384 385 /* We now have found the symbol. */ 386 if symbol_len > 7 /* Is symbol too long? */ 387 then do; /* Yes, an invalid symbol. */ 388 token_ptr = symbol_ptr; /* make the token be the symbol */ 389 if suffixx > 0 390 then token_len = symbol_len+1; /* put back a suffix if it was there */ 391 else token_len = symbol_len; 392 return; 393 end; 394 395 sb.symbol = symbol; /* Copy symbol into symbol buffer. */ 396 397 x = index (caps, substr (sb.symbol, 1, 1)); /* Check for capitalization. */ 398 if x ^= 0 /* Is first character a capital letter? */ 399 then do; /* Yes, translate to lowercase. */ 400 substr (sb.symbol, 1, 1) = substr (lowers, x, 1); 401 first_flag = "1"b; /* Note special first character processing. */ 402 end; 403 404 sbx = index (sb_table, symbol_buffer); /* Search for symbol in symbol table. */ 405 if sbx = 0 /* Did we find it? */ 406 then do; /* No, symbol is not defined. */ 407 token_ptr = symbol_ptr; /* Copy symbol within text token. */ 408 if suffixx > 0 /* Put back suffix character if there was one. */ 409 then token_len = symbol_len + 1; 410 else token_len = symbol_len; 411 first_flag = "0"b; /* No capitialization needed. */ 412 return; 413 end; 414 415 sbx = ((sbx -1) / 8) + 1; /* Convert string index to table index. */ 416 exp_ptr = addr (ssd.exp_tab (sbx)); /* Get pointer to corresponding expansion. */ 417 418 if suffixx = 0 /* Was a suffix character specified? */ 419 then do; /* No, copy expansion as is. */ 420 token_ptr = addr (exp.expansion); /* Replace token with this expansion. */ 421 token_len = exp.len; /* Get actual length of expansion string. */ 422 return; 423 end; 424 425 actionx = exp.actionx (suffixx); /* Index => how to add suffix. */ 426 427 if actionx = 0 /* 0 => no expansion, no suffix. */ 428 then do; /* Copy as if symbol not defined. */ 429 token_ptr = symbol_ptr; 430 if suffixx > 0 431 then token_len = symbol_len + 1; 432 else token_len = symbol_len; 433 first_flag = "0"b; /* No modification. */ 434 return; 435 end; 436 437 exp_buffer = exp.expansion; /* Move expansion so we can add a suffix. */ 438 token_ptr = addr (exp_buffer); /* We will copy from this buffer. */ 439 440 goto ACTION (actionx); /* Add suffix according to specified suffix type. */ 441 442 ACTION (6): /* Add "e", then add suffix. */ 443 token_len = exp.len + 1; 444 substr (token, token_len, 1) = "e"; 445 goto ADD_SUFFIX; 446 447 ACTION (5): /* Replace last char with "ie", then add suffix. */ 448 token_len = exp.len + 1; 449 substr (token, (token_len - 1), 2) = "ie"; 450 goto ADD_SUFFIX; 451 452 ACTION (4): /* Replace last char with "i", then add suffix. */ 453 token_len = exp.len; 454 substr (token, token_len, 1) = "i"; 455 goto ADD_SUFFIX; 456 457 ACTION (3): /* Double last letter. */ 458 last_char = substr (token, exp.len, 1); 459 token_len = exp.len + 1; 460 substr (token, token_len, 1) = last_char; 461 goto ADD_SUFFIX; /* Now go add suffix string. */ 462 463 ACTION (2): /* Drop last letter. */ 464 token_len = exp.len - 1; 465 goto ADD_SUFFIX; 466 467 ACTION (1): /* Add suffix directly. */ 468 token_len = exp.len; 469 goto ADD_SUFFIX; 470 471 ACTION (7): /* User has supplied his own suffixed word. */ 472 spc_ptr = addr (ssd.spec_tab (sbx)); 473 token_len = length(rtrim(spc.special(suffixx))); 474 token = spc.special(suffixx); 475 return; 476 477 ADD_SUFFIX: /* Add suffix to expanded string. */ 478 suffix = suffix_strings (suffixx); /* Get the suffix string to add. */ 479 suffix_len = length (suffix); /* Get length of this suffix. */ 480 substr (token, (token_len + 1), suffix_len) = suffix; 481 token_len = token_len + suffix_len; 482 483 end GET_SYMBOL; 484 /* */ 485 UNDERLINE: procedure; 486 487 /* This procedure is called to underline the current text token. 488* * The text token has already been copied into the output string. 489* * This procedure copies it back into a work buffer. This is done 490* * character by character. Each character copied is underlined in 491* * accordance with canonical form. 492**/ 493 token_ptr = first_char_ptr; /* Token already copied into output string. */ 494 495 if index (token, backspace) ^= 0 /* Is there any backspace in this string? */ 496 then return; /* Yes, asume already underlined. */ 497 498 startx = 1; /* Initialize place in expansion buffer. */ 499 do i = 1 to token_len; /* Copy each character in output string. */ 500 if (startx + 3) > length (exp_buffer) /* Is there room in work buffer? */ 501 then do; 502 ecode = error_table_$item_too_big; 503 return; 504 end; 505 test_char = substr (token, i, 1); /* Save the current character. */ 506 if (test_char = " ") | /* Special case blanks and underscore. */ 507 (test_char = "_") 508 then do; /* Relpace with just one underscore. */ 509 substr (exp_buffer, startx, 1) = "_"; 510 startx = startx + 1; 511 end; 512 else if test_char = "" /* Test for PAD character. */ 513 then do; /* Copy without underlining. */ 514 substr (exp_buffer, startx, 1) = test_char; 515 startx = startx + 1; 516 end; 517 else if test_char < "_" /* Less than or greater than underscore? */ 518 then do; /* Less than, => character first. */ 519 substr (exp_buffer, startx, 3) = test_char || backspace || "_"; 520 startx = startx + 3; 521 522 end; 523 else do; /* Greater than => underscore first. */ 524 substr (exp_buffer, startx, 3) = "_" || backspace || test_char; 525 startx = startx + 3; 526 end; 527 end; 528 529 out_used = out_used - token_len; /* Back up the real output string. */ 530 token_ptr = addr (exp_buffer); /* Copy underlined string in expansion buffer. */ 531 token_len = startx - 1; /* Get actual length of underlined string. */ 532 call MOVE_OUT; /* Move underlined string to output string. */ 533 534 end UNDERLINE; 535 /* */ 536 INIT_SYMBOL_DICT: procedure; 537 538 /* This procedure will get a pointer to the Speedtype symbol dictionary 539* * currently in use. It will set up the overlays used to search the 540* * symbol entry table. 541**/ 542 call speedtype_info_$pointer (ssd_ptr, ecode); 543 if ecode ^= 0 then return; 544 545 sb_tab_len = ssd.num_symbols * 8; /* Get length of all entries actually used. */ 546 sb_tab_ptr = addr (ssd.sb_tab); /* Get pointer to beginning of the table. */ 547 548 sb_ptr = addr (symbol_buffer); /* Get pointer to work symbol entry. */ 549 sb.new_line = " 550 "; /* Set new line in work symbol entry. */ 551 552 continue_flag, /* Initialize flags. */ 553 convert_flag, 554 escape_flag, 555 first_flag, 556 period_flag, 557 under_flag, 558 upper_flag = "0"b; 559 560 space_count = 0; 561 562 end INIT_SYMBOL_DICT; 563 564 end speedtype_expand_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1248.1 speedtype_expand_.pl1 >spec>on>speed>speedtype_expand_.pl1 115 1 11/14/80 1152.8 speedtype_symbols.incl.pl1 >ldd>include_1>speedtype_symbols.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. actionx 000225 automatic fixed bin(17,0) dcl 41 in procedure "speedtype_expand_" set ref 425* 427 440 actionx based fixed bin(8,0) array level 2 in structure "exp" packed unaligned dcl 1-52 in procedure "speedtype_expand_" ref 425 addr builtin function dcl 109 ref 159 170 201 269 281 308 357 416 420 438 471 530 546 548 arg_ecode parameter fixed bin(35,0) dcl 19 set ref 10 138* arg_in_len parameter fixed bin(21,0) dcl 20 ref 10 120 arg_in_ptr parameter pointer dcl 21 ref 10 119 arg_out_len parameter fixed bin(21,0) dcl 22 ref 10 122 arg_out_ptr parameter pointer dcl 23 ref 10 121 arg_out_used parameter fixed bin(21,0) dcl 24 set ref 10 136* backspace constant char(1) initial unaligned dcl 91 ref 495 519 524 caps 000036 constant char(26) initial dcl 94 ref 288 297 397 continue_flag 000215 automatic bit(1) unaligned dcl 32 set ref 192 192* 236* 552* convert_flag 000216 automatic bit(1) unaligned dcl 33 set ref 186 189* 226* 552* delimiters 5 based char(24) level 2 dcl 1-26 ref 171 270 ecode 000226 automatic fixed bin(35,0) dcl 42 set ref 124* 129 131 138 156* 265 283 304 502* 542* 543 error_table_$item_too_big 000042 external static fixed bin(35,0) dcl 111 ref 156 502 escape_flag 000217 automatic bit(1) unaligned dcl 34 set ref 222* 226* 231* 340 342* 552* escapes 13 based char(5) level 2 dcl 1-26 ref 188 215 exp based structure level 1 dcl 1-52 exp_buffer 000102 automatic char(300) unaligned dcl 30 set ref 437* 438 500 509* 514* 519* 524* 530 exp_ptr 000274 automatic pointer dcl 1-18 set ref 416* 420 421 425 437 442 447 452 457 459 463 467 exp_tab based structure array level 2 dcl 1-26 set ref 416 expansion 2 based char(56) level 2 packed unaligned dcl 1-52 set ref 420 437 first_char_ptr 000230 automatic pointer dcl 43 set ref 281* 288 294 493 first_flag 000220 automatic bit(1) unaligned dcl 35 set ref 285 290* 401* 411* 433* 552* fixed builtin function dcl 109 ref 248 i 000232 automatic fixed bin(17,0) dcl 44 set ref 295* 296 297* 499* 505* in_len 000233 automatic fixed bin(21,0) dcl 45 set ref 120* 131 170 171 175 180* 180 241 244 248 251* 251 265 269 270 274 277* 277 in_ptr 000234 automatic pointer dcl 46 set ref 119* 170 171 244 248 269 270 in_used 000236 automatic fixed bin(17,0) dcl 47 set ref 124* 170 171 179* 179 244 248 250* 250 269 270 276* 276 index builtin function dcl 109 ref 215 287 296 351 377 397 404 495 input based structure level 1 dcl 70 last_char 000237 automatic char(1) unaligned dcl 48 set ref 457* 460 len 1(27) based fixed bin(8,0) level 2 packed unaligned dcl 1-52 ref 421 442 447 452 457 459 463 467 length builtin function dcl 109 ref 473 479 500 lowers 000027 constant char(26) initial dcl 97 ref 287 296 400 new_line based char(1) level 2 packed unaligned dcl 1-48 set ref 549* num_symbols 20 based fixed bin(17,0) level 2 dcl 1-26 ref 545 out_len 000245 automatic fixed bin(21,0) dcl 52 set ref 122* 153 155 out_ptr 000246 automatic pointer dcl 53 set ref 121* 159 188 281 out_used 000250 automatic fixed bin(21,0) dcl 54 set ref 124* 136 153 155 159 161* 161 188 188 281 529* 529 output based structure level 1 dcl 74 period 000041 internal static char(1) initial unaligned dcl 103 set ref 308 period_flag 000221 automatic bit(1) unaligned dcl 36 set ref 306 311* 374* 552* prefix_flag 000222 automatic bit(1) unaligned dcl 37 set ref 349* 350 352* prefixes 15 based char(2) level 2 dcl 1-26 ref 351 sb based structure level 1 dcl 1-48 sb_ptr 000276 automatic pointer dcl 1-19 set ref 395 397 400 548* 549 sb_tab based structure array level 2 dcl 1-26 set ref 546 sb_tab_len 000240 automatic fixed bin(17,0) dcl 49 set ref 404 545* sb_tab_ptr 000242 automatic pointer dcl 50 set ref 404 546* sb_table based char dcl 78 ref 404 sbx 000244 automatic fixed bin(17,0) dcl 51 set ref 404* 405 415* 415 416 471 search builtin function dcl 109 ref 270 space_count 000251 automatic fixed bin(17,0) dcl 55 set ref 199 202 204* 248* 560* spaces 000010 internal static char(99) initial unaligned dcl 88 set ref 201 spc based structure level 1 dcl 1-57 spc_ptr 000300 automatic pointer dcl 1-20 set ref 471* 473 474 spec_tab 40 based structure array level 2 dcl 1-26 set ref 471 special based char(56) array level 2 packed unaligned dcl 1-57 ref 473 474 speedtype_info_$pointer 000044 constant entry external dcl 113 ref 542 ssd based structure level 1 dcl 1-26 ssd_ptr 000272 automatic pointer dcl 1-17 set ref 171 188 215 270 351 377 416 416 471 542* 545 546 546 546 startx 000252 automatic fixed bin(17,0) dcl 56 set ref 498* 500 509 510* 510 514 515* 515 519 520* 520 524 525* 525 531 substr builtin function dcl 109 set ref 188* 188 215 248 288 296 297* 297 351 357 365 377 397 400* 400 444* 449* 454* 457 460* 480* 505 509* 514* 519* 524* suffix 000254 automatic varying char(4) dcl 57 set ref 477* 479 480 suffix_len 000256 automatic fixed bin(17,0) dcl 58 set ref 479* 480 481 suffix_strings 000015 constant varying char(4) initial array dcl 100 ref 477 suffixes 16 based char(5) level 2 dcl 1-26 ref 377 suffixx 000257 automatic fixed bin(17,0) dcl 59 set ref 377* 378 389 408 418 425 430 473 474 477 symbol based char unaligned dcl 80 in procedure "speedtype_expand_" set ref 351 357 365 377 395 symbol 0(09) based char(7) level 2 in structure "sb" packed unaligned dcl 1-48 in procedure "speedtype_expand_" set ref 395* 397 400* symbol_buffer 000100 automatic char(8) unaligned dcl 29 set ref 404 548 symbol_len 000260 automatic fixed bin(17,0) dcl 60 set ref 346* 351 355 357 358* 358 365 365 367 373* 373 377 377 380 382* 382 386 389 391 395 408 410 430 432 symbol_ptr 000262 automatic pointer dcl 61 set ref 347* 351 357* 357 365 377 388 395 407 429 table_size 21 based fixed bin(17,0) level 2 dcl 1-26 ref 416 546 546 test_char 000264 automatic char(1) unaligned dcl 62 set ref 505* 506 506 512 514 517 519 524 text based char level 2 in structure "input" packed unaligned dcl 70 in procedure "speedtype_expand_" set ref 170 171 244 248 269 270 text based char(1) level 2 in structure "output" packed unaligned dcl 74 in procedure "speedtype_expand_" set ref 159 281 token based char unaligned dcl 81 set ref 159* 159 215 296 297* 444* 449* 454* 457 460* 474* 480* 495 505 token_first_char based char(1) unaligned dcl 83 set ref 287 288* token_len 000265 automatic fixed bin(17,0) dcl 63 set ref 151 153 155* 159 159 161 171* 173 173* 173 175* 177 179 180 202* 215 215 233* 233 238* 238 253* 253 270* 272 272* 272 274* 276 277 295 296 297 309* 346 389* 391* 408* 410* 421* 430* 432* 442* 444 444 447* 449 449 452* 454 454 457 459* 460 460 463* 467* 473* 474 480 480 481* 481 495 499 505 529 531* token_ptr 000266 automatic pointer dcl 64 set ref 159 170* 201* 215 269* 287 294* 296 297 308* 347 388* 407* 420* 429* 438* 444 449 454 457 460 474 480 493* 495 505 530* under_flag 000223 automatic bit(1) unaligned dcl 38 set ref 195* 301 359* 369* 552* upper_flag 000224 automatic bit(1) unaligned dcl 39 set ref 196* 292 361* 369* 552* used based char level 2 packed unaligned dcl 74 set ref 188* verify builtin function dcl 109 ref 171 244 x 000270 automatic fixed bin(17,0) dcl 65 set ref 215* 217 244* 245 245 248 250 251 287* 288 288 296* 297 297 351* 352 359 397* 398 400 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. delim_chars based structure level 1 dcl 1-41 delim_ptr automatic pointer dcl 1-21 ssd_version_2 internal static fixed bin(17,0) initial dcl 1-23 NAMES DECLARED BY EXPLICIT CONTEXT. ACTION 000006 constant label array(7) dcl 442 ref 440 ADD_SUFFIX 001110 constant label dcl 477 ref 445 450 455 461 465 469 CHECK_ESCAPES 000237 constant entry internal dcl 208 ref 182 COPY_DELIMITERS 000153 constant entry internal dcl 165 ref 132 COPY_TEXT 000343 constant entry internal dcl 258 ref 133 ESCAPE 000000 constant label array(0:5) dcl 219 set ref 217 GET_SYMBOL 000506 constant entry internal dcl 316 ref 279 INIT_SYMBOL_DICT 001272 constant entry internal dcl 536 ref 128 MOVE_OUT 000124 constant entry internal dcl 145 ref 184 203 282 310 532 RETURN 000116 constant label dcl 136 ref 129 UNDERLINE 001132 constant entry internal dcl 485 ref 303 speedtype_expand_ 000061 constant entry external dcl 10 NAME DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 473 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1616 1664 1544 1626 Length 2056 1544 46 156 52 32 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME speedtype_expand_ 426 external procedure is an external procedure. MOVE_OUT internal procedure shares stack frame of external procedure speedtype_expand_. COPY_DELIMITERS internal procedure shares stack frame of external procedure speedtype_expand_. CHECK_ESCAPES internal procedure shares stack frame of external procedure speedtype_expand_. COPY_TEXT internal procedure shares stack frame of external procedure speedtype_expand_. GET_SYMBOL internal procedure shares stack frame of external procedure speedtype_expand_. UNDERLINE internal procedure shares stack frame of external procedure speedtype_expand_. INIT_SYMBOL_DICT internal procedure shares stack frame of external procedure speedtype_expand_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 spaces speedtype_expand_ 000041 period speedtype_expand_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME speedtype_expand_ 000100 symbol_buffer speedtype_expand_ 000102 exp_buffer speedtype_expand_ 000215 continue_flag speedtype_expand_ 000216 convert_flag speedtype_expand_ 000217 escape_flag speedtype_expand_ 000220 first_flag speedtype_expand_ 000221 period_flag speedtype_expand_ 000222 prefix_flag speedtype_expand_ 000223 under_flag speedtype_expand_ 000224 upper_flag speedtype_expand_ 000225 actionx speedtype_expand_ 000226 ecode speedtype_expand_ 000230 first_char_ptr speedtype_expand_ 000232 i speedtype_expand_ 000233 in_len speedtype_expand_ 000234 in_ptr speedtype_expand_ 000236 in_used speedtype_expand_ 000237 last_char speedtype_expand_ 000240 sb_tab_len speedtype_expand_ 000242 sb_tab_ptr speedtype_expand_ 000244 sbx speedtype_expand_ 000245 out_len speedtype_expand_ 000246 out_ptr speedtype_expand_ 000250 out_used speedtype_expand_ 000251 space_count speedtype_expand_ 000252 startx speedtype_expand_ 000254 suffix speedtype_expand_ 000256 suffix_len speedtype_expand_ 000257 suffixx speedtype_expand_ 000260 symbol_len speedtype_expand_ 000262 symbol_ptr speedtype_expand_ 000264 test_char speedtype_expand_ 000265 token_len speedtype_expand_ 000266 token_ptr speedtype_expand_ 000270 x speedtype_expand_ 000272 ssd_ptr speedtype_expand_ 000274 exp_ptr speedtype_expand_ 000276 sb_ptr speedtype_expand_ 000300 spc_ptr speedtype_expand_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry trunc_fx2 set_cs_eis index_cs_eis verify_eis search_eis any_to_any_tr divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. speedtype_info_$pointer THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$item_too_big LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000053 119 000066 120 000072 121 000074 122 000077 124 000101 128 000104 129 000105 131 000107 132 000113 133 000114 134 000115 136 000116 138 000121 139 000123 145 000124 151 000125 153 000130 155 000133 156 000136 159 000141 161 000150 163 000152 165 000153 170 000154 171 000160 173 000170 175 000174 177 000176 179 000201 180 000202 182 000204 184 000205 186 000206 188 000210 189 000216 192 000217 195 000223 196 000224 199 000225 201 000230 202 000233 203 000234 204 000235 206 000236 208 000237 215 000240 217 000254 219 000255 222 000256 224 000260 226 000261 229 000264 231 000265 233 000267 234 000271 236 000272 238 000274 239 000276 241 000277 244 000302 245 000315 248 000322 250 000334 251 000336 253 000340 254 000342 258 000343 265 000344 269 000351 270 000355 272 000365 274 000371 276 000373 277 000375 279 000377 281 000400 282 000404 283 000405 285 000410 287 000412 288 000424 290 000431 292 000432 294 000434 295 000436 296 000445 297 000457 299 000464 301 000466 303 000470 304 000471 306 000474 308 000476 309 000501 310 000503 311 000504 314 000505 316 000506 340 000507 342 000511 343 000512 346 000513 347 000515 349 000517 350 000521 351 000523 352 000536 355 000541 357 000545 358 000551 359 000553 361 000561 363 000563 365 000564 367 000572 369 000575 371 000577 373 000600 374 000602 377 000604 378 000617 380 000620 382 000624 386 000626 388 000631 389 000632 391 000640 392 000642 395 000643 397 000647 398 000660 400 000661 401 000664 404 000666 405 000675 407 000676 408 000677 410 000705 411 000707 412 000710 415 000711 416 000725 418 000735 420 000737 421 000741 422 000745 425 000746 427 000755 429 000756 430 000757 432 000765 433 000767 434 000770 437 000771 438 000774 440 000776 442 000777 444 001004 445 001007 447 001010 449 001015 450 001020 452 001021 454 001025 455 001030 457 001031 459 001040 460 001042 461 001045 463 001046 465 001053 467 001054 469 001060 471 001061 473 001065 474 001103 475 001107 477 001110 479 001121 480 001123 481 001130 483 001131 485 001132 493 001133 495 001135 498 001151 499 001153 500 001162 502 001166 503 001171 505 001172 506 001200 509 001205 510 001211 511 001212 512 001213 514 001215 515 001221 516 001222 517 001223 519 001225 520 001237 522 001241 524 001242 525 001255 527 001257 529 001261 530 001263 531 001265 532 001270 534 001271 536 001272 542 001273 543 001304 545 001307 546 001313 548 001324 549 001326 552 001330 560 001337 562 001340 ----------------------------------------------------------- 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