COMPILATION LISTING OF SEGMENT ge_eval_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/18/82 1657.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 ge_eval_: proc; return; 19 20 /* Semantic analyzer for graphic_editor. */ 21 /* Written 1/10/75 by C. D. Tavares */ 22 /* Modified 08/14/75 by CDT to check for too many simple indirects in 23* reference, e.g. "foo......" where there are too many periods, and to strip 24* quotes from datablocks. */ 25 /* Modified 08/28/75 by CDT to call initialize_ptrs from perform_recursion. 26* Local ptrs were becoming invalid when recursive sons grew (therefore moved) 27* some tables. */ 28 /* Modified 10/15/75 by CDT to use new-type dispatch vector in system symbol 29* structure and to use "effective_level" to implement new parsing rules for 30* when a expression is terminated */ 31 /* Modified 04/22/76 by CDT to fix minor +/-1 bug in loop causing OOBs with 32* new areas */ 33 /* Modified 06/25/76 by CDT to add system macros feature (circles, arcs...) 34* and to add parenthesized macro argument feature to normal user macros. */ 35 /* Modified 08/30/76 by CDT to fix several problem bugs in regular expression 36* parsing, as far as what assignments to a Q.E. meant */ 37 /* Modified 10/29/76 by CDT not to reject tokens of type "Number" as text 38* strings. */ 39 /* Last modified 08/29/80 by CDT to fix defaults for scaling when no args 40* given */ 41 42 tuple_evaluator: entry (environment_ptr, code); 43 44 dcl environment_ptr pointer parameter, 45 code fixed bin (35) parameter; 46 47 dcl sysprint stream; 48 49 dcl temp_p pointer; 50 51 code = 0; 52 call tuple_evaluator_recur (environment_ptr, 0, code); 53 call check_for_undefineds (environment_ptr, code); 54 /* This call is directed to the internal block because all 55* the based variables are declared in the internal block. */ 56 return; 57 58 59 tuple_evaluator_recur: proc (environment_ptr, recursion_level, code) recursive; 60 61 dcl code fixed bin (35) parameter, 62 recursion_level fixed bin parameter; 63 64 dcl ge_parse_$get_token ext entry (char (*) varying, fixed bin, fixed bin), 65 ge_parse_$backup ext entry, 66 ge_parse_$push_macro ext entry (pointer, fixed bin, pointer); 67 68 dcl effective_level fixed bin; 69 70 dcl token char (200) varying, 71 (i, j, k) fixed bin, 72 token_type fixed bin; 73 74 dcl based_name char (32) based (name_ptr) varying, 75 name_ptr pointer; 76 77 dcl ioa_$rsnnl ext entry options (variable); 78 1 1 /* ---------------- BEGIN include file ge_environment.incl.pl1 ---------------- */ 1 2 1 3 /* Last modified 10/20/75 by C. D. Tavares to make items in all structures look 1 4* as much alike as possible. */ 1 5 1 6 dcl environment_ptr pointer parameter; 1 7 1 8 dcl 1 environment aligned based (environment_ptr), 1 9 2 stack_p pointer, 1 10 2 command_p pointer, 1 11 2 system_symbol_p pointer, 1 12 2 system_macro_p pointer, 1 13 2 sym_p pointer, 1 14 2 mac_p pointer, 1 15 2 areap pointer, 1 16 2 at_ptr pointer, 1 17 2 error_message char (100) varying, 1 18 2 external_char_table aligned, 1 19 3 dirname char (168) unaligned, 1 20 3 ename char (32) unaligned, 1 21 2 default_char_table aligned like external_char_table, 1 22 2 cur_char_table aligned like external_char_table; 1 23 1 24 dcl 1 based_system_symbol_list aligned based (system_symbol_p), 1 25 2 n_system_symbols fixed bin, 1 26 2 each_system_symbol (0 refer (based_system_symbol_list.n_system_symbols)) aligned, 1 27 3 system_symbols (2) char (32) varying, 1 28 3 system_symbol_vector fixed bin; 1 29 1 30 dcl 1 based_system_macro_list aligned based (system_macro_p), 1 31 2 n_system_macros fixed bin, 1 32 2 each_system_macro (0 refer (based_system_macro_list.n_system_macros)) aligned, 1 33 3 system_macros (2) char (32) varying, 1 34 3 system_macro_vector fixed bin; 1 35 1 36 dcl (stack_p, command_p, system_symbol_p, system_macro_p, 1 37 sym_p, mac_p, areap, at_ptr) pointer; 1 38 1 39 1 40 initialize_ptrs: proc; 1 41 1 42 stack_p = environment.stack_p; 1 43 command_p = environment.command_p; 1 44 system_symbol_p = environment.system_symbol_p; 1 45 system_macro_p = environment.system_macro_p; 1 46 sym_p = environment.sym_p; 1 47 mac_p = environment.mac_p; 1 48 areap = environment.areap; 1 49 at_ptr = environment.at_ptr; 1 50 1 51 environment.error_message = ""; 1 52 1 53 return; 1 54 end initialize_ptrs; 1 55 1 56 /* ----------------- END include file ge_environment.incl.pl1 ----------------- */ 79 80 2 1 /* ---------------- BEGIN include file ge_data_structures.incl.pl1 ---------------- */ 2 2 2 3 dcl my_area area (261120) based (areap); 2 4 2 5 dcl (max_frames, max_symbols, max_macros, cur_elements) fixed bin; 2 6 2 7 dcl 1 symbols aligned based (sym_p), 2 8 2 n_symbols initial (0) fixed bin, 2 9 2 cur_max_symbols fixed bin, 2 10 2 symbol (max_symbols refer (cur_max_symbols)) aligned, 2 11 3 name char (32) varying, 2 12 3 node_value fixed bin (18); 2 13 2 14 dcl 1 macros aligned based (mac_p), 2 15 2 n_macros initial (0) fixed bin, 2 16 2 cur_max_macros fixed bin, 2 17 2 macro (max_macros refer (cur_max_macros)) aligned like symbols.symbol; 2 18 2 19 dcl tuple_p pointer; 2 20 2 21 dcl 1 tuple aligned based (tuple_p), 2 22 2 n_elements fixed bin, 2 23 2 element (cur_elements refer (n_elements)) aligned, 2 24 3 name char (32) varying, 2 25 3 type fixed bin, 2 26 3 lvalue fixed bin (18), 2 27 3 offset fixed bin, 2 28 3 rvalue fixed bin (18), 2 29 3 table_idx fixed bin; 2 30 2 31 dcl 1 assembly_tuple aligned based (at_ptr), 2 32 2 element (4094) like tuple.element aligned; 2 33 2 34 dcl 1 stack aligned based (stack_p), 2 35 2 level fixed bin, 2 36 2 cur_max_frames fixed bin, 2 37 2 tuple_ptr (max_frames refer (cur_max_frames)) pointer; 2 38 2 39 /* ----------------- END include file ge_data_structures.incl.pl1 ----------------- */ 81 82 3 1 /* --------------- BEGIN include file ge_token_types.incl.pl1 --------------- */ 3 2 3 3 dcl (Illegal initial (-2), 3 4 Undefined initial (-1), 3 5 Name initial (1), 3 6 Break initial (2), 3 7 Number initial (3)) fixed bin static; 3 8 3 9 /* ---------------- END include file ge_token_types.incl.pl1 ---------------- */ 83 84 85 call initialize_ptrs; 86 cur_elements = 0; 87 code = 0; 88 89 effective_level = recursion_level + stack.level; /* now ge_parse_$get_token will require */ 90 /* a semicolon if we are recursing (meaning that */ 91 /* some parens are open) or if the stack is being */ 92 /* actively used (assignments pending, etc.) */ 93 94 do while ("1"b); /* forever, until some termination condition */ 95 /* allows us to return */ 96 call ge_parse_$get_token (token, token_type, effective_level); 97 98 if token_type = Break 99 then if token = "(" then do; 100 101 call perform_recursion; 102 call ge_parse_$get_token (token, token_type, effective_level); 103 if token ^= ")" 104 then call generate_error ("""^a"" where "")"" expected.", token); 105 106 tuple_p = stack (level).tuple_ptr; 107 108 do i = 1 to tuple.n_elements; 109 assembly_tuple.element (cur_elements + i) = tuple.element (i); 110 end; 111 112 cur_elements = cur_elements + i - 1; 113 114 free stack (level).tuple_ptr -> tuple in (my_area); 115 stack.level = stack.level - 1; 116 effective_level = effective_level - 1; 117 end; 118 119 else call generate_error ("""^a"" where symbol name expected.", token); 120 121 else if token_type = Name then do; 122 cur_elements = cur_elements + 1; 123 call get_values; 124 end; 125 126 else call generate_error ("Misplaced ""^a"".", token); 127 128 129 call ge_parse_$get_token (token, token_type, effective_level); 130 131 if token_type ^= Break then call generate_error ("""^a"" where separator expected.", token); 132 133 if token = "," then; /* do nothing; we will loop again */ 134 135 else if token = "=" then do; 136 call push_tuple; 137 call perform_recursion; 138 call perform_assignment; 139 return; 140 end; 141 142 else if token = ";" then do; 143 call ge_parse_$backup; 144 call push_tuple; 145 return; 146 end; 147 148 else if token = ")" then do; 149 if recursion_level = 0 then call generate_error ("Too many ""^a""'s.", token); 150 call push_tuple; 151 call ge_parse_$backup; 152 return; 153 end; 154 155 else call generate_error ("Bad separator ""^a"".", token); 156 end; 157 158 159 push_tuple: proc; 160 161 stack.level = stack.level + 1; 162 effective_level = effective_level + 1; 163 if stack.level > stack.cur_max_frames then do; 164 temp_p = stack_p; 165 max_frames = cur_max_frames + 50; 166 allocate stack in (my_area); 167 168 do k = 1 to temp_p -> stack.level; 169 stack_p -> stack.tuple_ptr (k) = temp_p -> stack.tuple_ptr (k); 170 end; 171 172 stack_p -> stack.level = temp_p -> stack.level; 173 174 environment.stack_p = stack_p; 175 176 free stack_p -> stack in (my_area); 177 end; 178 179 180 allocate tuple in (my_area); 181 do i = 1 to cur_elements; 182 tuple.element (i) = assembly_tuple.element (i); 183 end; 184 185 stack (level).tuple_ptr = tuple_p; 186 end push_tuple; 187 188 perform_recursion: proc; 189 190 /* This internal subroutine saves assembly_tuple in myarea and then calls tuple_evaluator_recur. 191* The reason this is necessary is that assembly_tuple is too big to be automatic; it 192* causes stack overflows. This works well and prevents overflows. */ 193 194 dcl i fixed bin, 195 save_at_ptr pointer; 196 197 allocate tuple in (my_area) set (save_at_ptr); 198 199 do i = 1 to cur_elements; 200 save_at_ptr -> tuple.element (i) = assembly_tuple.element (i); 201 end; 202 203 call tuple_evaluator_recur (environment_ptr, recursion_level + 1, code); 204 if code ^= 0 then goto return_hard; 205 206 effective_level = recursion_level + stack.level; /* reset this, stack may have changed */ 207 208 call initialize_ptrs; /* some tables may have been grown, therefore moved */ 209 210 do i = 1 to cur_elements; 211 assembly_tuple.element (i) = save_at_ptr -> tuple.element (i); 212 end; 213 214 free save_at_ptr -> tuple in (my_area); 215 216 return; 217 end perform_recursion; 218 219 220 221 get_values: proc; 222 223 dcl (i, j, first, last, n, eff_type) fixed bin, 224 element_list (4094) fixed bin (18), 225 cv_dec_ ext entry (char (*)) returns (fixed bin), 226 cv_float_ ext entry (char (*), fixed bin) returns (float bin), 227 coords (3) float bin; 228 229 dcl hold_name char (32) varying; 230 231 dcl 1 element like tuple.element based (element_ptr), 232 element_ptr pointer initial (addr (assembly_tuple.element (cur_elements))); 233 234 assembly_tuple (cur_elements).name = token; 235 name_ptr = addr (assembly_tuple (cur_elements).name); 236 offset = Undefined; 237 238 if substr (token, 1, 1) = """" then do; /* implicit text */ 239 call ge_parse_$backup; 240 token = "text"; 241 end; 242 243 if substr (token, 1, 1) = "#" then do; /* node constant */ 244 based_name = token; 245 rvalue = cv_dec_ (substr (token, 2)); 246 call graphic_manipulator_$examine_type (rvalue, ""b, 0, code); 247 if code ^= 0 then call generate_error ("Node constant ""^a"".", based_name); 248 end; 249 250 else do; /* must be symbol */ 251 do j = 2 to 1 by -1; 252 do k = 1 to n_system_symbols; 253 if token = system_symbols (k, j) then do; 254 lvalue, table_idx = Illegal; 255 eff_type = system_symbol_vector (k); 256 goto generate_element (eff_type); 257 end; 258 end; 259 end; 260 261 do j = 2 to 1 by -1; 262 do k = 1 to n_system_macros; 263 if token = system_macros (k, j) then do; 264 lvalue, table_idx = Illegal; 265 eff_type = system_macro_vector (k); 266 goto generate_sysmacro (eff_type); 267 end; 268 end; 269 end; 270 271 do j = 1 to n_macros; 272 if macro.name (j) = token then do; 273 call setup_macro (j); 274 call ge_parse_$get_token (token, token_type, effective_level); 275 call get_values; 276 return; 277 end; 278 end; 279 280 lvalue = Undefined; 281 type = Symbol; 282 283 do i = 1 to n_symbols while (token ^= symbol (i).name); 284 end; 285 286 if i > n_symbols then rvalue, table_idx = Undefined; 287 288 else do; 289 rvalue = symbol (i).node_value; 290 table_idx = i; 291 end; 292 end; 293 294 call ge_parse_$get_token (token, token_type, effective_level); 295 296 if token = "." 297 then if rvalue = Undefined 298 then call generate_error ("""^a"" undefined.", based_name); 299 300 else table_idx = Illegal; /* forget the table, we're gonna go a-qualifyin'. */ 301 302 303 /* MAIN QUALIFIED EXPRESSION PARSING LOOP */ 304 305 do while (token = "."); 306 307 based_name = based_name || "."; 308 309 if type ^= Symbol then 310 if lvalue = Undefined then /* at the end of the line already */ 311 no_such_level: call generate_error ("No such level of qualification: ""^a"".", based_name); 312 313 if type = Symbol then call indirect_thru_symbol; 314 else call get_to_contents; 315 316 if code ^= 0 then goto no_such_level; 317 318 call ge_parse_$get_token (token, token_type, effective_level); 319 320 if token = "." then; /* will catch "." next time; just reiterate thru loop */ 321 else if token = ";" then; /* ignore; we'll drop out of the loop */ 322 else if (token_type ^= Number & token ^= "*") then; 323 /* ignore it; we'll drop out of the loop */ 324 325 else do; 326 327 if token_type = Number then do; 328 first, last = cv_dec_ ((token)); 329 call ge_parse_$get_token (token, token_type, effective_level); 330 if token = ":" then do; 331 call ge_parse_$get_token (token, token_type, effective_level); 332 if token_type ^= Number 333 then if token ^= "*" 334 then call generate_error ("Bad qualifier ""^a"".", based_name); 335 336 if token_type = Number then last = cv_dec_ ((token)); 337 else last = -1; 338 call ge_parse_$get_token (token, token_type, effective_level); 339 end; 340 341 end; 342 343 else do; 344 first = 1; 345 last = -1; 346 call ge_parse_$get_token (token, token_type, effective_level); 347 end; 348 349 code = 0; 350 351 if type ^= Array then do while (code = 0); 352 call indirect_thru_symbol; 353 end; 354 355 if type ^= Array 356 then call generate_error ("""^a"" is not an array.", based_name); 357 358 call graphic_manipulator_$examine_list (rvalue, element_list, n, code); 359 if code ^= 0 then 360 internal_error: call generate_error ("Internal error on ""^a"".", based_name); 361 if last > n then call generate_error ("No such element in ""^a"".", based_name); 362 363 if last = -1 then last = n; 364 365 lvalue = rvalue; /* remember what list we were */ 366 367 hold_name = based_name; 368 369 do i = 0 to last - first; 370 371 j = cur_elements + i; 372 373 if i > 0 then assembly_tuple.element (j) 374 = assembly_tuple.element (cur_elements); 375 assembly_tuple (j).offset = first + i; 376 assembly_tuple (j).rvalue = element_list (first + i); 377 call ioa_$rsnnl ("^a^d", assembly_tuple (j).name, 0, hold_name, first + i); 378 379 assembly_tuple (j).type = Illegal; 380 /* usefulness of "type" of an array element is highly questionable. */ 381 end; 382 383 if last - first > 0 384 then if token = "." 385 then call generate_error ("Expansion qualifier not last in ""^a"".", based_name); 386 else cur_elements = cur_elements + i - 1; 387 end; 388 end; 389 390 if rvalue = Undefined 391 then if token_type ^= Break 392 then call generate_error ("""^a"" undefined.", based_name); 393 394 call ge_parse_$backup; 395 return; 396 397 /* ------------------------- */ 398 399 indirect_thru_symbol: proc; 400 401 dcl temp_node fixed bin (18); 402 403 call graphic_manipulator_$examine_symbol (rvalue, temp_node, 0, "", code); 404 if code = 0 then rvalue = temp_node; 405 else return; 406 407 get_to_contents: entry; 408 409 lvalue, offset = Undefined; 410 411 call graphic_manipulator_$examine_type (rvalue, ""b, type, code); 412 if type = List then type = Array; /* We trigger on array only; both act alike. */ 413 else if type = Symbol then lvalue = rvalue; 414 return; 415 416 end indirect_thru_symbol; 417 418 /* ------------------------- */ 419 /* ------------------------- */ 420 421 setup_macro: proc (which); 422 423 dcl which fixed bin, 424 macro_nodes (21) fixed bin (18), 425 string char (200), 426 temp_node fixed bin (18), 427 n_chars fixed bin; 428 429 dcl leading_sign char (1) varying; 430 431 dcl paren_level fixed bin; 432 433 call graphic_manipulator_$examine_symbol (macro.node_value (which), temp_node, 0, "", code); 434 if code ^= 0 then 435 macro_error: call generate_error ("While attempting to use macro ""^a"".", macro.name (which)); 436 437 call graphic_manipulator_$examine_list (temp_node, macro_nodes, n_macro_args, code); 438 if code ^= 0 then goto macro_error; 439 440 n_macro_args = n_macro_args - 1; 441 442 allocate macro_info in (my_area) set (macro_info_p); 443 444 macro_bits_l = size (based_macro_arg) * 36; 445 446 do i = 1 to n_macro_args; 447 macro_bits_p = addr (macro_info_p -> macro_info.argument (i)); 448 call graphic_manipulator_$examine_data (macro_nodes (i), 0, based_macro_bits, code); 449 if code ^= 0 then goto macro_error; 450 call ge_parse_$get_token (token, token_type, effective_level); 451 452 if token = "(" then do; /* parenthesized macro argument */ 453 454 macro_info_p -> macro_info.replacement (i) = ""; 455 paren_level = 1; 456 457 do while (paren_level > 0); 458 459 call ge_parse_$get_token (token, token_type, effective_level); 460 if token = "(" then paren_level = paren_level + 1; 461 else if token = ")" then paren_level = paren_level - 1; 462 else if token = ";" then do; 463 free macro_info_p -> macro_info in (my_area); 464 call generate_error ("Unbalanced parentheses in macro argument.", ""); 465 end; 466 467 if length (macro_info_p -> macro_info.replacement (i)) > 0 then 468 macro_info_p -> macro_info.replacement (i) = 469 macro_info_p -> macro_info.replacement (i) || " "; 470 471 if paren_level > 0 then 472 macro_info_p -> macro_info.replacement (i) = 473 macro_info_p -> macro_info.replacement (i) || token; 474 end; 475 476 end; 477 478 else do; 479 480 leading_sign = ""; 481 482 do while (token_type = Break); /* snarf all leading signs */ 483 if token = "+" then; /* nothing */ 484 else if token = "-" 485 then if leading_sign = "-" then leading_sign = "+"; 486 else leading_sign = "-"; 487 else do; 488 free macro_info_p -> macro_info in (my_area); 489 call generate_error ("""^a"" instead of macro argument.", token); 490 end; 491 492 call ge_parse_$get_token (token, token_type, effective_level); 493 494 end; 495 496 if leading_sign ^= "" 497 then if token_type ^= Number 498 then call generate_error ("Arithmetic signs encountered before ""^a"".", token); 499 500 501 macro_info_p -> macro_info.replacement (i) = leading_sign || token; 502 end; 503 end; 504 505 506 call ge_parse_$get_token (token, token_type, effective_level); 507 if token_type ^= Break then call generate_error ("Too many arguments to macro ""^a"".", macro.name (which)); 508 509 call ge_parse_$backup; 510 511 macro_bits_p = addr (macro_def); 512 macro_bits_l = size (macro_def) * 36; 513 call graphic_manipulator_$examine_data (macro_nodes (n_macro_args + 1), 0, based_macro_bits, code); 514 if code ^= 0 then goto macro_error; 515 516 string = macro_def; 517 n_chars = length (macro_def); 518 call ge_parse_$push_macro (addr (string), n_chars, macro_info_p); 519 520 return; 521 522 end setup_macro; 523 524 /* ------------------------- */ 525 526 generate_element (1): generate_element (2): generate_element (3): 527 generate_element (4): generate_element (5): /* all positional elements */ 528 coords = 0; 529 code = 0; 530 531 do i = 1 to 3 while (code = 0); 532 call get_float_number (coords (i), code); 533 end; 534 535 type = eff_type - 1; 536 rvalue = graphic_manipulator_$create_position (type, coords (1), coords (2), coords (3), code); 537 if code ^= 0 then goto internal_error; 538 539 return; 540 541 /* ------------------------- */ 542 543 get_float_number: proc (num, code); 544 545 dcl num float bin, 546 i fixed bin, 547 code fixed bin (35); 548 549 i = 1; 550 code = 0; 551 552 call ge_parse_$get_token (token, token_type, effective_level); 553 554 do while (token_type = Break); 555 if token = "+" then; /* do nothing */ 556 else if token = "-" then i = i * -1; /* reverse final sign */ 557 else goto unknown_sign; 558 call ge_parse_$get_token (token, token_type, effective_level); 559 end; 560 561 if token_type ^= Number then do; 562 unknown_sign: call ge_parse_$backup; /* leave for next chump */ 563 code = -1; 564 return; 565 end; 566 567 num = cv_float_ ((token), 0) * i; 568 return; 569 570 end get_float_number; 571 572 /* ------------------------- */ 573 574 generate_element (6): /* the null element */ 575 576 rvalue = 0; 577 type = Null; 578 return; 579 580 generate_element (7): /* text string */ 581 582 dcl alignment fixed bin, 583 text_string char (200) varying; 584 585 dcl alignment_abbrevs (9) char (12) varying initial 586 ("ul", "uc", "ur", "l", "c", "r", "ll", "lc", "lr"); 587 588 call read_text_element (text_string, alignment); 589 590 /* ------------------------- */ 591 592 read_text_element: proc (text_string, alignment); 593 594 /* This internal subr reads the arguments to the text element and assembles them into something meaningful. */ 595 596 dcl (text_string char (*) varying, 597 alignment fixed bin) parameter; 598 599 alignment = Undefined; 600 601 call ge_parse_$get_token (text_string, token_type, effective_level); 602 if token_type = Break then call generate_error ("""^a"" not a text string.", text_string); 603 604 if substr (text_string, 1, 1) = """" /* it is quoted */ 605 then text_string = substr (text_string, 2, length (text_string) - 2); /* strip quote marks */ 606 607 call ge_parse_$get_token (token, token_type, effective_level); 608 609 if token_type = Break then do; /* oops, no alignment given */ 610 call ge_parse_$backup; /* didn't want it */ 611 alignment = 1; /* default */ 612 end; 613 614 else if token_type = Number then alignment = cv_dec_ ((token)); /* got a number */ 615 616 else if token_type = Name /* convert name to number */ 617 then do j = 1 to hbound (Text_alignments, 1); 618 if (alignment_abbrevs (j) = token | 619 Text_alignments (j) = token) then do; 620 alignment = j; 621 i = 0; j = hbound (Text_alignments, 1) + 1; 622 end; 623 end; 624 625 if (alignment < lbound (alignment_abbrevs, 1) 626 | alignment > hbound (alignment_abbrevs, 1)) /* out of bounds */ 627 then alignment = Undefined; 628 629 if alignment = Undefined 630 then call generate_error ("""^a"" not a valid text alignment.", token); 631 632 return; 633 end read_text_element; 634 635 /* ------------------------- */ 636 637 rvalue = graphic_manipulator_$create_text (alignment, length (text_string), (text_string), code); 638 if code ^= 0 then goto internal_error; 639 type = Text; 640 return; 641 642 generate_element (8): /* array */ 643 644 call make_list_or_array (Array); 645 return; 646 647 generate_element (9): /* list */ 648 649 call make_list_or_array (List); 650 return; 651 652 /* ---------------------------- */ 653 654 make_list_or_array: proc (whatever); 655 656 dcl whatever fixed bin; 657 658 call ge_parse_$get_token (token, token_type, effective_level); 659 660 if token ^= "(" then call generate_error ("""^a"" instead of ""("" after array/list.", token); 661 662 call perform_recursion; 663 664 call ge_parse_$get_token (token, token_type, effective_level); 665 666 if token ^= ")" then call generate_error ("""^a"" instead of "")"" after array/list.", token); 667 668 call scan_for_undefineds (stack (level).tuple_ptr); 669 670 if whatever = List 671 then rvalue = graphic_manipulator_$create_list (stack (level).tuple_ptr -> tuple.rvalue (*), 672 stack (level).tuple_ptr -> tuple.n_elements, code); 673 674 else rvalue = graphic_manipulator_$create_array (stack (level).tuple_ptr -> tuple.rvalue (*), 675 stack (level).tuple_ptr -> tuple.n_elements, code); 676 677 if code ^= 0 then call generate_error ("Internal error making explicit list/array.", ""); 678 679 free stack (level).tuple_ptr -> tuple in (my_area); 680 stack.level = stack.level - 1; 681 effective_level = effective_level - 1; 682 type = whatever; 683 684 return; 685 686 end make_list_or_array; 687 688 /* ---------------------------- */ 689 690 generate_element (10): /* intensity */ 691 692 dcl intensity fixed bin; 693 694 intensity = 7; 695 696 call ge_parse_$get_token (token, token_type, effective_level); 697 698 if token_type = Number then do; 699 intensity = cv_dec_ ((token)); 700 if intensity < 0 then goto bad_intensity; 701 if intensity > 7 then goto bad_intensity; 702 end; 703 704 else if token = "off" then intensity = 0; 705 else if token = "full" then intensity = 7; 706 else if token = "on" then intensity = 7; 707 else do; /* wasn't any */ 708 bad_intensity: if token_type ^= Break then call generate_error ("Bad intensity level ""^a"".", token); 709 call ge_parse_$backup; 710 return; 711 end; 712 713 rvalue = graphic_manipulator_$create_mode (Intensity, intensity, code); 714 if code ^= 0 then goto internal_error; 715 type = Intensity; 716 717 return; 718 719 generate_element (11): /* linetype */ 720 721 dcl linetype fixed bin; 722 723 linetype = -1; 724 725 call ge_parse_$get_token (token, token_type, effective_level); 726 727 if token_type = Number then do; 728 linetype = cv_dec_ ((token)); 729 if linetype < lbound (Linetype_names, 1) then goto bad_linetype; 730 if linetype > hbound (Linetype_names, 1) then goto bad_linetype; 731 end; 732 733 else do i = lbound (Linetype_names, 1) to hbound (Linetype_names, 1); 734 if Linetype_names (i) = token then do; 735 linetype = i; 736 i = hbound (Linetype_names, 1); 737 end; 738 end; 739 740 if linetype = -1 then do; 741 bad_linetype: if token_type ^= Break then call generate_error ("Bad linetype ""^a"".", token); 742 call ge_parse_$backup; 743 linetype = 0; 744 end; 745 746 rvalue = graphic_manipulator_$create_mode (Linetype, linetype, code); 747 if code ^= 0 then goto internal_error; 748 type = Linetype; 749 750 return; 751 752 generate_element (12): /* blink */ 753 754 dcl blink fixed bin; 755 756 blink = -1; 757 758 call ge_parse_$get_token (token, token_type, effective_level); 759 760 if token_type = Number then do; 761 blink = cv_dec_ ((token)); 762 if blink < 0 then goto bad_blink; 763 if blink > 1 then goto bad_blink; 764 end; 765 else if token = "off" then blink = 0; 766 else if token = "on" then blink = 1; 767 768 else do i = 1 to hbound (Blink_names, 1); 769 if Blink_names (i) = token then do; 770 blink = i; 771 i = hbound (Blink_names, 1); 772 end; 773 end; 774 775 if blink = -1 then do; 776 bad_blink: if token_type ^= Break then call generate_error ("Bad blink type ""^a"".", token); 777 call ge_parse_$backup; 778 blink = 1; 779 end; 780 781 rvalue = graphic_manipulator_$create_mode (Blink, blink, code); 782 if code ^= 0 then goto internal_error; 783 type = Blink; 784 785 return; 786 787 generate_element (13): /* sensitivity */ 788 789 dcl sensitivity fixed bin; 790 791 sensitivity = -1; 792 793 call ge_parse_$get_token (token, token_type, effective_level); 794 795 if token_type = Number then do; 796 sensitivity = cv_dec_ ((token)); 797 if sensitivity < 0 then goto bad_sensitivity; 798 if sensitivity > 1 then goto bad_sensitivity; 799 end; 800 801 else if token = "on" then sensitivity = 1; 802 else if token = "off" then sensitivity = 0; 803 804 else do i = 1 to hbound (Sensitivity_names, 1); 805 if Sensitivity_names (i) = token then do; 806 sensitivity = i; 807 i = hbound (Sensitivity_names, 1); 808 end; 809 end; 810 811 if sensitivity = -1 then do; 812 bad_sensitivity: if token_type ^= Break then call generate_error ("Bad sensitivity type ""^a"".", token); 813 call ge_parse_$backup; 814 sensitivity = 1; 815 end; 816 817 rvalue = graphic_manipulator_$create_mode (Sensitivity, sensitivity, code); 818 if code ^= 0 then goto internal_error; 819 type = Sensitivity; 820 821 return; 822 823 824 generate_element (14): /* rotation */ 825 826 dcl angles (3) float bin; 827 828 code, angles = 0; 829 830 do i = 1 to 3 while (code = 0); 831 call get_float_number (angles (i), code); 832 end; 833 rvalue = graphic_manipulator_$create_rotation (angles (1), angles (2), angles (3), code); 834 if code ^= 0 then goto internal_error; 835 type = Rotation; 836 837 return; 838 839 generate_element (15): /* scaling */ 840 841 dcl scales (3) float bin; 842 843 code = 0; 844 scales = 1; 845 846 do i = 1 to 3 while (code = 0); 847 call get_float_number (scales (i), code); 848 end; 849 rvalue = graphic_manipulator_$create_scale (scales (1), scales (2), scales (3), code); 850 if code ^= 0 then goto internal_error; 851 type = Scaling; 852 853 return; 854 855 generate_element (16): /* datablock */ 856 857 call ge_parse_$get_token (token, token_type, effective_level); 858 if token_type = Break 859 then call generate_error ("Break ""^a"" instead of datablock contents.", token); 860 861 if substr (token, 1, 1) = """" /* was a quoted string */ 862 then token = substr (token, 2, length (token) - 2); /* strip quotes */ 863 864 macro_bits_p = addr (token); 865 macro_bits_l = length (token) * 9 + 36; /* save length word and meaningful part */ 866 rvalue = graphic_manipulator_$create_data (macro_bits_l, based_macro_bits, code); 867 if code ^= 0 then goto internal_error; 868 type = Datablock; 869 return; 870 871 generate_element (17): /* color */ 872 873 dcl colors (3) fixed bin, 874 which_color fixed bin, 875 color_value fixed bin; 876 877 dcl (red initial (1), 878 green initial (2), 879 blue initial (3)) fixed bin static options (constant); 880 881 colors = 0; 882 883 do i = 1 to 3; /* allow for 3 color specifications */ 884 885 color_value = 63; /* set to default */ 886 call ge_parse_$get_token (token, token_type, effective_level); 887 888 if token_type = Break then do; 889 if i = 1 then colors = 16; /* no color specified, use default */ 890 goto end_color_loop; 891 end; 892 893 if token = "red" then which_color = red; 894 else if token = "blue" then which_color = blue; 895 else if token = "green" then which_color = green; 896 else call generate_error ("""^a"" not a defined color.", token); 897 898 call ge_parse_$get_token (token, token_type, effective_level); 899 900 if token_type = Break then i = 3; 901 else if token_type = Name /* another color spec? */ 902 then if i < 3 /* there can still be one more */ 903 then call ge_parse_$backup; /* save it for later */ 904 else call generate_error ("Misplaced token ""^a"".", token); /* couldn't have been four color specs */ 905 else if token_type = Number then do; 906 color_value = cv_dec_ ((token)); 907 if color_value < 0 then 908 bad_color: call generate_error ("Bad color specification ""^a"".", token); 909 if color_value > 63 then goto bad_color; 910 end; 911 912 else goto bad_color; 913 914 colors (which_color) = color_value; 915 end; 916 917 end_color_loop: 918 if token_type = Break then call ge_parse_$backup; 919 920 rvalue = graphic_manipulator_$create_color (colors (1), colors (2), colors (3), code); 921 if code ^= 0 then goto internal_error; 922 type = Color; 923 return; 924 925 generate_sysmacro (3): /* circle builtin */ 926 927 dcl sysmacro_value fixed bin (18); 928 929 coords = 0; 930 code = 0; 931 932 do i = 1 to 2 while (code = 0); 933 call get_float_number (coords (i), code); 934 end; 935 936 sysmacro_value = graphic_macros_$circle (coords (1), coords (2), code); 937 if code ^= 0 then goto internal_error; 938 939 rvalue = make_sysmacro_array (sysmacro_value, "circle", "", 0, 0, coords, 2, ""); 940 return; 941 942 /* --------------- */ 943 944 make_sysmacro_array: proc (value, name, text_string, alignment, n_text_args, numeric_args, n_numeric_args, table_name) 945 returns (fixed bin (18)); 946 947 dcl (value fixed bin (18), 948 name char (12), 949 text_string char (*) varying, 950 alignment fixed bin, 951 n_text_args fixed bin, 952 numeric_args (*) float bin, 953 n_numeric_args fixed bin, 954 table_name char (32)) parameter; 955 956 dcl sysmacro_data_string char (128) varying, 957 sysmacro_data_string_len fixed bin, 958 (sysmacro_subarray (2), sysmacro_value, return_val) fixed bin (18); 959 960 dcl unique_chars_ ext entry (bit (*)) returns (char (15)); 961 962 if n_text_args ^= 0 then 963 call ioa_$rsnnl ("^a ^a ^a^[ ^f^2s^; ^f ^f^s^] ^a", 964 sysmacro_data_string, sysmacro_data_string_len, name, text_string, 965 Text_alignments (alignment), n_numeric_args, numeric_args, table_name); 966 967 else call ioa_$rsnnl ("^a^v( ^f^)", sysmacro_data_string, sysmacro_data_string_len, 968 name, n_numeric_args, numeric_args); 969 970 sysmacro_subarray (1) = graphic_manipulator_$create_data 971 (length (unspec (addr (sysmacro_data_string) -> based_varying_string)), 972 unspec (addr (sysmacro_data_string) -> based_varying_string), code); 973 if code ^= 0 then goto internal_error; 974 sysmacro_subarray (2) = value; 975 976 sysmacro_value = graphic_manipulator_$create_array (sysmacro_subarray, 2, code); 977 if code ^= 0 then goto internal_error; 978 979 return_val = graphic_manipulator_$assign_name ("!sysmacro." || unique_chars_ (""b), 980 sysmacro_value, code); 981 if code ^= 0 then goto internal_error; 982 983 return (return_val); 984 end make_sysmacro_array; 985 986 /* --------------- */ 987 988 generate_sysmacro (2): /* box builtin */ 989 990 coords = 0; 991 992 do i = 1 to 2 while (code = 0); 993 call get_float_number (coords (i), code); 994 end; 995 996 if code ^= 0 then call generate_error ("Not enough arguments to ""box"".", ""); 997 998 sysmacro_value = graphic_macros_$box (coords (1), coords (2), code); 999 if code ^= 0 then goto internal_error; 1000 1001 rvalue = make_sysmacro_array (sysmacro_value, "box", "", 0, 0, coords, 2, ""); 1002 return; 1003 1004 generate_sysmacro (1): /* arc builtin */ 1005 1006 coords = 0; 1007 1008 do i = 1 to 3 while (code = 0); 1009 call get_float_number (coords (i), code); 1010 end; 1011 1012 if code ^= 0 then call generate_error ("Not enough arguments to ""arc"".", ""); 1013 1014 sysmacro_value = graphic_macros_$arc (coords (1), coords (2), coords (3) /* really the fraction */, code); 1015 if code ^= 0 then goto internal_error; 1016 1017 rvalue = make_sysmacro_array (sysmacro_value, "arc", "", 0, 0, coords, 3, ""); 1018 return; 1019 1020 generate_sysmacro (4): /* ellipse builtin */ 1021 1022 dcl ellipse_data (5) float bin; 1023 1024 ellipse_data (*) = 0; 1025 1026 do i = 1 to 5 while (code = 0); 1027 call get_float_number (ellipse_data (i), code); 1028 end; 1029 1030 if i < 4 then call generate_error ("Not enough arguments to ""ellipse"".", ""); 1031 if code ^= 0 then ellipse_data (5) = 1; /* whole ellipse */ 1032 1033 sysmacro_value = graphic_macros_$ellipse (ellipse_data (1), ellipse_data (2), ellipse_data (3), 1034 fixed (ellipse_data (4)), ellipse_data (5), code); 1035 if code ^= 0 then goto internal_error; 1036 1037 rvalue = make_sysmacro_array (sysmacro_value, "ellipse", "", 0, 0, ellipse_data, 5, ""); 1038 return; 1039 1040 generate_sysmacro (5): /* polygon builtin */ 1041 1042 coords = 0; 1043 1044 do i = 1 to 3 while (code = 0); 1045 call get_float_number (coords (i), code); 1046 end; 1047 1048 if code ^= 0 then call generate_error ("Not enough arguments to ""polygon"".", ""); 1049 1050 sysmacro_value = graphic_macros_$polygon (coords (1), coords (2), fixed (coords (3)), code); 1051 if code ^= 0 then goto internal_error; 1052 1053 rvalue = make_sysmacro_array (sysmacro_value, "polygon", "", 0, 0, coords, 3, ""); 1054 return; 1055 1056 generate_sysmacro (6): /* varying_text */ 1057 1058 dcl default_text_size (3) float bin static options (constant) initial (18.380e0, 20e0, 0e0), 1059 temp_dirname char (168); 1060 1061 call read_text_element (text_string, alignment); 1062 1063 coords (*) = default_text_size (*); 1064 1065 do i = 1 to 2 while (code = 0); 1066 call get_float_number (coords (i), code); 1067 end; 1068 1069 if code ^= 0 then 1070 if i = 3 then coords (2) = coords (1); /* gave width only */ 1071 temp_dirname = ""; 1072 1073 call ge_parse_$get_token (token, token_type, effective_level); 1074 1075 if token_type ^= Name then do; 1076 1077 call ge_parse_$backup; 1078 1079 if environment.cur_char_table.ename ^= environment.default_char_table.ename then do; 1080 token = environment.default_char_table.ename; 1081 temp_dirname = environment.default_char_table.dirname; 1082 token_type = Name; 1083 end; 1084 end; 1085 1086 if token_type = Name then do; /* a graphic char table was specified */ 1087 if environment.cur_char_table.ename ^= token then do; 1088 call graphic_chars_$set_table (temp_dirname, (token), code); 1089 if code ^= 0 then call generate_error ("Undefined character table ""^a"".", token); 1090 call graphic_chars_$get_table (environment.cur_char_table.dirname, environment.cur_char_table.ename); 1091 end; 1092 end; 1093 1094 sysmacro_value = graphic_chars_ ((text_string), alignment, coords (1), coords (2), code); 1095 if code ^= 0 then goto internal_error; 1096 /* now double all quotes so replay description looks right. */ 1097 do i = 1 by 1 while (i < length (text_string)); 1098 if substr (text_string, i, 1) = """" then do; 1099 text_string = substr (text_string, 1, i) || """" || substr (text_string, i+1); 1100 i = i + 1; 1101 end; 1102 end; 1103 1104 text_string = """" || text_string || """"; 1105 1106 rvalue = make_sysmacro_array (sysmacro_value, "varying_text", text_string, alignment, 1107 2, coords, 1108 2, environment.cur_char_table.ename); 1109 return; 1110 1111 end get_values; 1112 1113 perform_assignment: proc; 1114 1115 dcl j fixed bin; 1116 1117 dcl (to_ptr, from_ptr) pointer; 1118 1119 dcl symbol_name char (32), 1120 symbol_len fixed bin; 1121 1122 from_ptr = stack (level).tuple_ptr; 1123 to_ptr = stack (level-1).tuple_ptr; 1124 1125 if debugsw then do; 1126 put list ("Beginning assignment;") skip; 1127 put list ("From "); 1128 put list /* data */ (from_ptr -> tuple) skip (2); 1129 put list ("To "); 1130 put list /* data */ (to_ptr -> tuple) skip (4); 1131 end; 1132 1133 if from_ptr -> tuple.n_elements = 1 1134 then if to_ptr -> tuple.n_elements > 1 1135 then do; 1136 1137 cur_elements = to_ptr -> tuple.n_elements; 1138 allocate tuple in (my_area); 1139 1140 do i = 1 to cur_elements; 1141 tuple_p -> tuple.element (i) = from_ptr -> tuple.element (1); 1142 end; 1143 1144 free from_ptr -> tuple in (my_area); 1145 1146 from_ptr, stack (level).tuple_ptr = tuple_p; 1147 end; 1148 1149 else; 1150 1151 else if from_ptr -> tuple.n_elements > 1 1152 then if to_ptr -> tuple.n_elements = 1 1153 then do; 1154 1155 call scan_for_undefineds (from_ptr); 1156 1157 cur_elements = 1; 1158 1159 allocate tuple in (my_area); 1160 1161 tuple_p -> tuple (1).rvalue = graphic_manipulator_$create_array 1162 (from_ptr -> tuple.rvalue (*), from_ptr -> tuple.n_elements, code); 1163 if code ^= 0 then call generate_error ("Internal error generating implicit array.", ""); 1164 tuple_p -> tuple (1).type = Array; 1165 1166 free from_ptr -> tuple in (my_area); 1167 1168 from_ptr, stack (level).tuple_ptr = tuple_p; 1169 end; 1170 1171 else; 1172 1173 if from_ptr -> tuple.n_elements ^= to_ptr -> tuple.n_elements 1174 then call generate_error ("Wrong number of elements assigned to ""^a"".", based_name); 1175 1176 do i = 1 to from_ptr -> tuple.n_elements; 1177 1178 name_ptr = addr (to_ptr -> tuple.name (i)); 1179 1180 if from_ptr -> tuple.rvalue (i) = Undefined 1181 then call generate_error ("""^a"" undefined.", from_ptr -> tuple.name (i)); 1182 1183 if to_ptr -> tuple.lvalue (i) = Illegal 1184 then call generate_error ("""^a"" may not be assigned to.", based_name); 1185 1186 if to_ptr -> tuple.offset (i) ^= Undefined then do; 1187 j = graphic_manipulator_$replace_element (to_ptr -> tuple.lvalue (i), 1188 to_ptr -> tuple.offset (i), from_ptr -> tuple.rvalue (i), code); 1189 if code ^= 0 then call generate_error ("Assigning to ""^a"".", based_name); 1190 to_ptr -> tuple.rvalue (i) = from_ptr -> tuple.rvalue (i); 1191 to_ptr -> tuple.offset (i) = Undefined; 1192 end; 1193 1194 else if to_ptr -> tuple.type (i) = Symbol then do; 1195 if from_ptr -> tuple.type (i) = Symbol 1196 then if from_ptr -> tuple.rvalue (i) = to_ptr -> tuple.rvalue (i) 1197 then call generate_error ("Recursive assignment of ""^a"".", based_name); 1198 1199 if to_ptr -> tuple.lvalue (i) = Undefined then do; 1200 symbol_name = to_ptr -> tuple.name (i); 1201 symbol_len = length (to_ptr -> tuple.name (i)); 1202 end; 1203 1204 else do; /* this is a symbol, but gotten to via a qualified exprn. */ 1205 /* therefore, tuple.name (i) contains a Q.E., NOT the */ 1206 /* real name of the symbol. So we determine it. */ 1207 call graphic_manipulator_$examine_symbol (to_ptr -> tuple.lvalue (i), 0, 1208 symbol_len, symbol_name, code); 1209 if code ^= 0 then call generate_error ("Internal error getting true name for ""^a"".", 1210 to_ptr -> tuple.name (i)); 1211 1212 do j = 1 to n_symbols while (symbol_name ^= symbol (j).name); 1213 end; 1214 1215 if j > n_symbols then call generate_error ("Internal error: symbol ""^a"" not found.", (symbol_name)); 1216 to_ptr -> tuple.table_idx (i) = j; 1217 end; 1218 1219 to_ptr -> tuple.rvalue (i) = graphic_manipulator_$assign_name 1220 (substr (symbol_name, 1, symbol_len), from_ptr -> tuple (i).rvalue, code); 1221 if code ^= 0 then call generate_error ("Assigning to symbol ""^a"".", based_name); 1222 end; 1223 1224 else do; /* terminal items, or whole arrays */ 1225 call graphic_manipulator_$replace_node (to_ptr -> tuple.rvalue (i), 1226 from_ptr -> tuple.rvalue (i), code); 1227 if code ^= 0 then call generate_error ("Replacing node ""^a"".", based_name); 1228 end; /* No need to assign to rvalues or lvalues */ 1229 1230 if to_ptr -> tuple.table_idx (i) = Undefined then do; 1231 to_ptr -> tuple.table_idx (i), j, n_symbols = n_symbols + 1; 1232 if j > cur_max_symbols then do; 1233 temp_p = sym_p; /* prepare to extend symbol area */ 1234 max_symbols = cur_max_symbols + 50; 1235 allocate symbols in (my_area); 1236 1237 do k = 1 to temp_p -> n_symbols - 1; 1238 sym_p -> symbol (k) = temp_p -> symbol (k); 1239 end; 1240 1241 sym_p -> n_symbols = temp_p -> n_symbols; 1242 1243 environment.sym_p = sym_p; 1244 1245 free temp_p -> symbols in (my_area); 1246 end; 1247 1248 symbol (j).name = to_ptr -> tuple.name (i); 1249 end; 1250 1251 else j = to_ptr -> tuple.table_idx (i); 1252 1253 if j ^= Illegal then symbol (j).node_value = to_ptr -> tuple.rvalue (i); 1254 1255 end; 1256 1257 if debugsw then do; 1258 put list ("Becomes "); 1259 put list /* data */ (to_ptr -> tuple); 1260 put skip (6); 1261 end; 1262 1263 free from_ptr -> tuple in (my_area); 1264 1265 stack.level = stack.level - 1; 1266 effective_level = effective_level - 1; 1267 1268 return; 1269 1270 end perform_assignment; 1271 1272 scan_for_undefineds: proc (tup_ptr); 1273 1274 /* This internal procedure scans a tuple to see if any of its elements are undefined. If they 1275* are, it generates an error. It is used in various places just before making arrays or lists 1276* out of things, to make sure the data is good. */ 1277 1278 dcl tup_ptr pointer; 1279 1280 dcl i fixed bin; 1281 1282 do i = 1 to tup_ptr -> tuple.n_elements; 1283 if tup_ptr -> tuple.element (i).rvalue = Undefined 1284 then call generate_error ("""^a"" undefined.", tup_ptr -> tuple.element (i).name); 1285 end; 1286 1287 return; 1288 end scan_for_undefineds; 1289 1290 1291 generate_error: proc (reason, offender); 1292 1293 dcl reason char (*) parameter, 1294 offender char (*) varying parameter; 1295 1296 if code = 0 then code = -1; 1297 call ioa_$rsnnl (reason, environment.error_message, 0, offender); 1298 goto return_hard; 1299 end generate_error; 1300 1301 check_for_undefineds: entry (environment_ptr, code); 1302 1303 dcl internal_stack_inconsistent condition; 1304 1305 call initialize_ptrs; 1306 1307 if stack.level ^= 1 then signal internal_stack_inconsistent; 1308 1309 call scan_for_undefineds (stack.tuple_ptr (1)); 1310 return; 1311 1312 end tuple_evaluator_recur; 1313 1314 return_hard: return; 1315 1316 1317 4 1 /* --------------- BEGIN include file ge_macro_info.incl.pl1 --------------- */ 4 2 4 3 dcl 1 macro_info based, 4 4 2 n_args fixed bin, 4 5 2 x (n_macro_args refer (macro_info.n_args)), 4 6 3 argument char (32) varying, 4 7 3 replacement char (1020) varying; 4 8 4 9 dcl replacement_string_size fixed bin static initial (1020) options (constant); 4 10 4 11 dcl 1 based_varying_string aligned based, 4 12 2 somelength fixed bin (35), 4 13 2 string char (0 refer (somelength)) aligned; 4 14 4 15 dcl n_macro_args fixed bin; 4 16 4 17 dcl macro_def char (200) varying; 4 18 4 19 dcl macro_info_p pointer; 4 20 4 21 dcl based_macro_bits bit (macro_bits_l) based (macro_bits_p), 4 22 macro_bits_p pointer, 4 23 macro_bits_l fixed bin; 4 24 4 25 dcl based_macro_arg char (32) based; 4 26 4 27 /* ---------------- END include file ge_macro_info.incl.pl1 ---------------- */ 1318 1319 5 1 /* *************** BEGIN INCLUDE FILE gm_entry_dcls.incl.pl1 *************** */ 5 2 5 3 dcl (graphic_manipulator_$init, 5 4 gm_$init) entry (fixed bin (35)); 5 5 5 6 dcl (graphic_manipulator_$segp, 5 7 gm_$segp) entry (pointer, fixed bin (35)); 5 8 5 9 dcl (graphic_manipulator_$create_position, 5 10 gm_$create_position, 5 11 graphic_manipulator_$cpos, 5 12 gm_$cpos) entry (fixed bin, float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 5 13 5 14 dcl (graphic_manipulator_$create_mode, 5 15 gm_$create_mode, 5 16 graphic_manipulator_$cmode, 5 17 gm_$cmode) entry (fixed bin, fixed bin, fixed bin (35)) returns (fixed bin (18)); 5 18 5 19 dcl (graphic_manipulator_$create_scale, 5 20 gm_$create_scale, 5 21 graphic_manipulator_$cscale, 5 22 gm_$cscale) entry (float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 5 23 5 24 dcl (graphic_manipulator_$create_rotation, 5 25 gm_$create_rotation, 5 26 graphic_manipulator_$crot, 5 27 gm_$crot) entry (float bin (27), float bin (27), float bin (27), fixed bin (35)) returns (fixed bin (18)); 5 28 5 29 dcl (graphic_manipulator_$create_clip, 5 30 gm_$create_clip, 5 31 graphic_manipulator_$cclip, 5 32 gm_$cclip) entry (float bin (27), float bin (27), float bin (27), float bin (27), float bin (27), float bin (27), 5 33 fixed bin (35)) returns (fixed bin (18)); 5 34 5 35 dcl (graphic_manipulator_$create_color, 5 36 gm_$create_color, 5 37 graphic_manipulator_$ccolor, 5 38 gm_$ccolor) entry (fixed bin, fixed bin, fixed bin, fixed bin (35)) returns (fixed bin (18)); 5 39 5 40 dcl (graphic_manipulator_$create_text, 5 41 gm_$create_text, 5 42 graphic_manipulator_$ctext, 5 43 gm_$ctext) entry (fixed bin, fixed bin, char (*), fixed bin (35)) returns (fixed bin (18)); 5 44 5 45 dcl (graphic_manipulator_$create_data, 5 46 gm_$create_data, 5 47 graphic_manipulator_$cdata, 5 48 gm_$cdata) entry (fixed bin, bit (*), fixed bin (35)) returns (fixed bin (18)); 5 49 5 50 dcl (graphic_manipulator_$create_list, 5 51 gm_$create_list, 5 52 graphic_manipulator_$clist, 5 53 gm_$clist) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)) returns (fixed bin (18)); 5 54 5 55 dcl (graphic_manipulator_$create_array, 5 56 gm_$create_array, 5 57 graphic_manipulator_$carray, 5 58 gm_$carray) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)) returns (fixed bin (18)); 5 59 5 60 dcl (graphic_manipulator_$assign_name, 5 61 gm_$assign_name) entry (char (*), fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 5 62 5 63 dcl (graphic_manipulator_$find_structure, 5 64 gm_$find_structure, 5 65 graphic_manipulator_$fstruc, 5 66 gm_$fstruc) entry (char (*), fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 5 67 5 68 dcl (graphic_manipulator_$add_element, 5 69 gm_$add_element) entry (fixed bin (18), fixed bin, fixed bin (18), fixed bin (35)); 5 70 5 71 dcl (graphic_manipulator_$replace_element, 5 72 gm_$replace_element) entry (fixed bin (18), fixed bin, fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 5 73 5 74 dcl (graphic_manipulator_$replace_node, 5 75 gm_$replace_node) entry (fixed bin (18), fixed bin (18), fixed bin (35)); 5 76 5 77 dcl (graphic_manipulator_$remove_symbol, 5 78 gm_$remove_symbol) entry (char (*), fixed bin (35)); 5 79 5 80 dcl (graphic_manipulator_$replicate, 5 81 gm_$replicate) entry (fixed bin (18), fixed bin (35)) returns (fixed bin (18)); 5 82 5 83 dcl (graphic_manipulator_$examine_type, 5 84 gm_$examine_type) entry (fixed bin (18), bit (1) aligned, fixed bin, fixed bin (35)); 5 85 5 86 dcl (graphic_manipulator_$examine_position, 5 87 gm_$examine_position, 5 88 graphic_manipulator_$epos, 5 89 gm_$epos) entry (fixed bin (18), fixed bin, float bin, float bin, float bin, fixed bin (35)); 5 90 5 91 dcl (graphic_manipulator_$examine_mode, 5 92 gm_$examine_mode, 5 93 graphic_manipulator_$emode, 5 94 gm_$emode) entry (fixed bin (18), fixed bin, fixed bin, fixed bin (35)); 5 95 5 96 dcl (graphic_manipulator_$examine_color, 5 97 gm_$examine_color, 5 98 graphic_manipulator_$ecolor, 5 99 gm_$ecolor) entry (fixed bin (18), fixed bin, fixed bin, fixed bin, fixed bin (35)); 5 100 5 101 dcl (graphic_manipulator_$examine_mapping, 5 102 gm_$examine_mapping, 5 103 graphic_manipulator_$emap, 5 104 gm_$emap) entry (fixed bin (18), fixed bin, float bin dimension (*), fixed bin, fixed bin (35)); 5 105 5 106 dcl (graphic_manipulator_$examine_contents, 5 107 gm_$examine_contents) entry (fixed bin (18), fixed bin (18) dimension (*), fixed bin, fixed bin (35)); 5 108 5 109 dcl (graphic_manipulator_$examine_list, 5 110 gm_$examine_list, 5 111 graphic_manipulator_$elist, 5 112 gm_$elist) entry (fixed bin (18), dimension (*) fixed bin (18), fixed bin, fixed bin (35)); 5 113 5 114 dcl (graphic_manipulator_$examine_symtab, 5 115 graphic_manipulator_$esymtab, 5 116 gm_$examine_symtab, 5 117 gm_$esymtab) entry (fixed bin (18) dimension (*), fixed bin, fixed bin (35)); 5 118 5 119 dcl (graphic_manipulator_$examine_symbol, 5 120 gm_$examine_symbol, 5 121 graphic_manipulator_$esymbol, 5 122 gm_$esymbol) entry (fixed bin (18), fixed bin (18), fixed bin, char (*), fixed bin (35)); 5 123 5 124 dcl (graphic_manipulator_$examine_text, 5 125 gm_$examine_text, 5 126 graphic_manipulator_$etext, 5 127 gm_$etext) entry (fixed bin (18), fixed bin, fixed bin, char (*), fixed bin (35)); 5 128 5 129 dcl (graphic_manipulator_$examine_data, 5 130 gm_$examine_data, 5 131 graphic_manipulator_$edata, 5 132 gm_$edata) entry (fixed bin (18), fixed bin, bit (*), fixed bin (35)); 5 133 5 134 dcl (graphic_manipulator_$get_struc, 5 135 gm_$get_struc, 5 136 graphic_manipulator_$gstruc, 5 137 gm_$gstruc) entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); 5 138 5 139 dcl (graphic_manipulator_$put_struc, 5 140 gm_$put_struc, 5 141 graphic_manipulator_$pstruc, 5 142 gm_$pstruc) entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); 5 143 5 144 dcl (graphic_manipulator_$save_file, 5 145 gm_$save_file) entry (char (*), char (*), fixed bin (35)); 5 146 5 147 dcl (graphic_manipulator_$use_file, 5 148 gm_$use_file) entry (char (*), char (*), fixed bin (35)); 5 149 5 150 /* **************** END INCLUDE FILE gm_entry_dcls.incl.pl1 **************** */ 1320 1321 6 1 /* --------------- BEGIN include file gmc_entry_dcls.incl.pl1 --------------- */ 6 2 6 3 dcl ((graphic_macros_$box, 6 4 gmc_$box) entry (float bin, float bin, fixed bin (35)), 6 5 (graphic_macros_$circle, 6 6 gmc_$circle) entry (float bin, float bin, fixed bin (35)), 6 7 (graphic_macros_$arc, 6 8 gmc_$arc) entry (float bin, float bin, float bin, fixed bin (35)), 6 9 (graphic_macros_$ellipse, 6 10 gmc_$ellipse) entry (float bin, float bin, float bin, fixed bin, float bin, fixed bin (35)), 6 11 (graphic_macros_$ellipse_by_foci, 6 12 gmc_$ellipse_by_foci) entry (float bin, float bin, float bin, float bin, float bin, fixed bin (35)), 6 13 (graphic_macros_$polygon, 6 14 gmc_$polygon) entry (float bin, float bin, fixed bin, fixed bin (35))) returns (fixed bin (18)); 6 15 6 16 /* ---------------- END include file gmc_entry_dcls.incl.pl1 ---------------- */ 1322 1323 7 1 /* --------------- BEGIN include file gch_entry_dcls.incl.pl1 --------------- */ 7 2 7 3 dcl graphic_chars_$init ext entry, 7 4 graphic_chars_ ext entry (char (*), fixed bin, float bin, float bin, fixed bin (35)) returns (fixed bin (18)), 7 5 graphic_chars_$set_table ext entry (char (*), char (*), fixed bin (35)), 7 6 graphic_chars_$get_table ext entry (char (*), char (*)), 7 7 (graphic_chars_$long, 7 8 graphic_chars_$long_tb) ext entry 7 9 (char (*), fixed bin, float bin, float bin, float bin, float bin, fixed bin (35)) returns (fixed bin (18)); 7 10 7 11 /* ---------------- END include file gch_entry_dcls.incl.pl1 ---------------- */ 1324 1325 8 1 /* --------------- BEGIN include file graphic_etypes.incl.pl1 --------------- */ 8 2 8 3 /* Types of position, mode, and other effectors for the 8 4* Multics General Graphic System */ 8 5 8 6 8 7 /* Null code */ 8 8 8 9 dcl (Null initial (-1), 8 10 8 11 /* Position codes */ 8 12 8 13 Setposition initial (0), 8 14 Setpoint initial (1), 8 15 Vector initial (2), 8 16 Shift initial (3), 8 17 Point initial (4), 8 18 8 19 /* Mode codes, with values where appropriate */ 8 20 8 21 Scaling initial (8), 8 22 Rotation initial (9), 8 23 Clipping initial (10), 8 24 8 25 Intensity initial (16), 8 26 Full_intensity initial (7), 8 27 Half_intensity initial (3), 8 28 Invisible initial (0), 8 29 8 30 Linetype initial (17), 8 31 Solid initial (0), 8 32 Dashed initial (1), 8 33 Dotted initial (2), 8 34 Dash_dotted initial (3), 8 35 Long_dashed initial (4), 8 36 8 37 Sensitivity initial (18), 8 38 Sensitive initial (1), 8 39 Insensitive initial (0), 8 40 8 41 Blink initial (19), 8 42 Steady initial (0), 8 43 Blinking initial (1), 8 44 8 45 Color initial (20), 8 46 8 47 Symbol initial (24), 8 48 8 49 /* Text code, with legal alignments */ 8 50 8 51 Text initial (25), 8 52 Upper_left initial (1), 8 53 Upper_center initial (2), 8 54 Upper_right initial (3), 8 55 Left initial (4), 8 56 Center initial (5), 8 57 Right initial (6), 8 58 Lower_left initial (7), 8 59 Lower_center initial (8), 8 60 Lower_right initial (9), 8 61 8 62 /* Datablock code */ 8 63 8 64 Datablock initial (26), 8 65 8 66 /* Structural effector codes */ 8 67 8 68 List initial (32), 8 69 Array initial (33), 8 70 8 71 /* Merge codes for gm_$get_struc and gm_$put_struc */ 8 72 8 73 On_dup_error initial (0), /* allow no name duplications */ 8 74 On_dup_source initial (1), /* on name dup, force move (use source copy) */ 8 75 On_dup_target_then_nulls initial (2), /* on name dup, use target copy, for nondup symbols create null ones */ 8 76 On_dup_target_then_source initial (3), /* on name dup, use target copy, for nondup symbols, use source copy */ 8 77 8 78 /* Device codes for graphic input devices */ 8 79 8 80 Terminal_program initial (0), 8 81 Keyboard initial (1), 8 82 Mouse initial (2), 8 83 Joystick initial (3), 8 84 Tablet_and_pen initial (4), 8 85 Light_pen initial (5), 8 86 Trackball initial (6), 8 87 Any_device initial (63)) /* 63 is equivalent to -1 in SPI */ 8 88 8 89 fixed bin internal static options (constant); 8 90 8 91 /* ---------------- END include file graphic_etypes.incl.pl1 ---------------- */ 1326 1327 9 1 /* --------------- BEGIN include file graphic_enames.incl.pl1 --------------- */ 9 2 9 3 dcl Element_names (-2:33) char (16) static options (constant) initial 9 4 ("illegal type", "null", "setposition", "setpoint", "vector", "shift", "point", (3) (1) "undefined", 9 5 "scaling", "rotation", "clipping", (5) (1) "undefined", 9 6 "intensity", "linetype", "sensitivity", "blink", "color", (3) (1) "undefined", 9 7 "symbol", "text", "datablock", (5) (1) "undefined", 9 8 "list", "array"); 9 9 9 10 dcl Intensity_names (0:7) char (8) static options (constant) initial 9 11 ("off", "1", "2", "3", "4", "5", "6", "full"); 9 12 9 13 dcl Linetype_names (0:4) char (12) static options (constant) initial 9 14 ("solid", "dashed", "dotted", "dash_dotted", "long_dashed"); 9 15 9 16 dcl Sensitivity_names (0:1) char (12) static options (constant) initial 9 17 ("insensitive", "sensitive"); 9 18 9 19 dcl Blink_names (0:1) char (8) static options (constant) initial 9 20 ("steady", "blinking"); 9 21 9 22 dcl Text_alignments (9) char (16) static options (constant) initial 9 23 ("upper_left", "upper_center", "upper_right", 9 24 "left", "center", "right", 9 25 "lower_left", "lower_center", "lower_right"); 9 26 9 27 dcl Input_device_names (0:63) char (16) static options (constant) initial 9 28 ("terminal_program", "keyboard", "mouse", "joystick", "pen_tablet", 9 29 "lightpen", "trackball", (56)(1)"undefined", "any"); 9 30 9 31 /* ---------------- END include file graphic_enames.incl.pl1 ---------------- */ 1328 1329 1330 flip: entry; 1331 1332 dcl debugsw bit (1) aligned static initial (""b); 1333 1334 debugsw = ^debugsw; 1335 return; 1336 1337 end ge_eval_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/18/82 1626.8 ge_eval_.pl1 >dumps>old>recomp>ge_eval_.pl1 79 1 12/17/79 1709.0 ge_environment.incl.pl1 >ldd>include>ge_environment.incl.pl1 81 2 08/27/75 1700.7 ge_data_structures.incl.pl1 >ldd>include>ge_data_structures.incl.pl1 83 3 08/27/75 1700.7 ge_token_types.incl.pl1 >ldd>include>ge_token_types.incl.pl1 1318 4 11/02/77 1738.4 ge_macro_info.incl.pl1 >ldd>include>ge_macro_info.incl.pl1 1320 5 08/27/75 1700.7 gm_entry_dcls.incl.pl1 >ldd>include>gm_entry_dcls.incl.pl1 1322 6 11/02/77 1737.5 gmc_entry_dcls.incl.pl1 >ldd>include>gmc_entry_dcls.incl.pl1 1324 7 12/17/79 1709.0 gch_entry_dcls.incl.pl1 >ldd>include>gch_entry_dcls.incl.pl1 1326 8 03/27/82 0439.2 graphic_etypes.incl.pl1 >ldd>include>graphic_etypes.incl.pl1 1328 9 03/27/82 0439.3 graphic_enames.incl.pl1 >ldd>include>graphic_enames.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. Array 000127 constant fixed bin(17,0) initial dcl 8-9 set ref 351 355 412 642* 1164 Blink 000224 constant fixed bin(17,0) initial dcl 8-9 set ref 781* 783 Blink_names 000076 constant char(8) initial array unaligned dcl 9-19 ref 768 769 771 Break constant fixed bin(17,0) initial dcl 3-3 ref 98 131 390 482 507 554 602 609 708 741 776 812 858 888 900 917 Color constant fixed bin(17,0) initial dcl 8-9 ref 922 Datablock constant fixed bin(17,0) initial dcl 8-9 ref 868 Illegal 014351 constant fixed bin(17,0) initial dcl 3-3 ref 254 264 300 379 1183 1253 Intensity 000172 constant fixed bin(17,0) initial dcl 8-9 set ref 713* 715 Linetype 000132 constant fixed bin(17,0) initial dcl 8-9 set ref 746* 748 Linetype_names 000110 constant char(12) initial array unaligned dcl 9-13 ref 729 730 733 733 734 736 List 000130 constant fixed bin(17,0) initial dcl 8-9 set ref 412 647* 670 Name constant fixed bin(17,0) initial dcl 3-3 ref 121 616 901 1075 1082 1086 Null constant fixed bin(17,0) initial dcl 8-9 ref 577 Number constant fixed bin(17,0) initial dcl 3-3 ref 322 327 332 336 496 561 614 698 727 760 795 905 Rotation constant fixed bin(17,0) initial dcl 8-9 ref 835 Scaling constant fixed bin(17,0) initial dcl 8-9 ref 851 Sensitivity 000131 constant fixed bin(17,0) initial dcl 8-9 set ref 817* 819 Sensitivity_names 000102 constant char(12) initial array unaligned dcl 9-16 ref 804 805 807 Symbol constant fixed bin(17,0) initial dcl 8-9 ref 281 309 313 413 1194 1195 Text constant fixed bin(17,0) initial dcl 8-9 ref 639 Text_alignments 000032 constant char(16) initial array unaligned dcl 9-22 set ref 616 618 621 962* Undefined 014350 constant fixed bin(17,0) initial dcl 3-3 ref 236 280 286 296 309 390 409 599 625 629 1180 1186 1191 1199 1230 1283 alignment parameter fixed bin(17,0) dcl 947 in procedure "make_sysmacro_array" ref 944 962 alignment 010122 automatic fixed bin(17,0) dcl 580 in procedure "get_values" set ref 588* 637* 1061* 1094* 1106* alignment parameter fixed bin(17,0) dcl 596 in procedure "read_text_element" set ref 592 599* 611* 614* 620* 625 625 625* 629 alignment_abbrevs 010206 automatic varying char(12) initial array dcl 585 set ref 585* 585* 585* 585* 585* 585* 585* 585* 585* 618 625 625 angles 010256 automatic float bin(27) array dcl 824 set ref 828* 831* 833* 833* 833* areap 000206 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 114 1-48* 166 176 180 197 214 442 463 488 679 1138 1144 1159 1166 1235 1245 1263 areap 14 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-48 argument 1 based varying char(32) array level 3 dcl 4-3 set ref 447 assembly_tuple based structure level 1 dcl 2-31 at_ptr 16 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-49 at_ptr 000210 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 109 1-49* 182 200 211 231 234 235 373 373 375 376 377 379 based_macro_arg based char(32) unaligned dcl 4-25 ref 444 based_macro_bits based bit unaligned dcl 4-21 set ref 448* 513* 866* based_name based varying char(32) dcl 74 set ref 244* 247* 296* 307* 307 309* 332* 355* 359* 361* 367 383* 390* 1173* 1183* 1189* 1195* 1221* 1227* based_system_macro_list based structure level 1 dcl 1-30 based_system_symbol_list based structure level 1 dcl 1-24 based_varying_string based structure level 1 dcl 4-11 ref 970 970 970 970 blink 010254 automatic fixed bin(17,0) dcl 752 set ref 756* 761* 762 763 765* 766* 770* 775 778* 781* blue constant fixed bin(17,0) initial dcl 877 ref 894 code parameter fixed bin(35,0) dcl 545 in procedure "get_float_number" set ref 543 550* 563* code parameter fixed bin(35,0) dcl 44 in procedure "ge_eval_" set ref 42 51* 52* 53* code parameter fixed bin(35,0) dcl 61 in procedure "tuple_evaluator_recur" set ref 59 87* 203* 204 246* 247 316 349* 351 358* 359 403* 404 411* 433* 434 437* 438 448* 449 513* 514 529* 531 532* 536* 537 637* 638 670* 674* 677 713* 714 746* 747 781* 782 817* 818 828* 830 831* 833* 834 843* 846 847* 849* 850 866* 867 920* 921 930* 932 933* 936* 937 970* 973 976* 977 979* 981 992 993* 996 998* 999 1008 1009* 1012 1014* 1015 1026 1027* 1031 1033* 1035 1044 1045* 1048 1050* 1051 1065 1066* 1069 1088* 1089 1094* 1095 1161* 1163 1187* 1189 1207* 1209 1219* 1221 1225* 1227 1296 1296* 1301 color_value 010270 automatic fixed bin(17,0) dcl 871 set ref 885* 906* 907 909 914 colors 010264 automatic fixed bin(17,0) array dcl 871 set ref 881* 889* 914* 920* 920* 920* command_p 000174 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 1-43* command_p 2 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-43 coords 010104 automatic float bin(27) array dcl 223 set ref 526* 532* 536* 536* 536* 929* 933* 936* 936* 939* 988* 993* 998* 998* 1001* 1004* 1009* 1014* 1014* 1014* 1017* 1040* 1045* 1050* 1050* 1050 1050 1053* 1063* 1066* 1069* 1069 1094* 1094* 1106* cur_char_table 216 based structure level 2 dcl 1-8 cur_elements 000214 automatic fixed bin(17,0) dcl 2-5 set ref 86* 109 112* 112 122* 122 180 180 181 197 197 199 210 231 234 235 371 373 386* 386 1137* 1138 1138 1140 1157* 1159 1159 cur_max_frames 1 based fixed bin(17,0) level 2 dcl 2-34 set ref 163 165 166* 176 cur_max_symbols 1 based fixed bin(17,0) level 2 dcl 2-7 set ref 1232 1234 1235* 1245 cv_dec_ 000106 constant entry external dcl 223 ref 245 328 336 614 699 728 761 796 906 cv_float_ 000110 constant entry external dcl 223 ref 567 debugsw 000010 internal static bit(1) initial dcl 1332 set ref 1125 1257 1334* 1334 default_char_table 134 based structure level 2 dcl 1-8 default_text_size 000027 constant float bin(27) initial array dcl 1056 ref 1063 dirname 216 based char(168) level 3 in structure "environment" packed unaligned dcl 1-8 in procedure "tuple_evaluator_recur" set ref 1090* dirname 134 based char(168) level 3 in structure "environment" packed unaligned dcl 1-8 in procedure "tuple_evaluator_recur" ref 1081 each_system_macro 1 based structure array level 2 dcl 1-30 each_system_symbol 1 based structure array level 2 dcl 1-24 eff_type 000105 automatic fixed bin(17,0) dcl 223 set ref 255* 256 265* 266 535 effective_level 000100 automatic fixed bin(17,0) dcl 68 set ref 89* 96* 102* 116* 116 129* 162* 162 206* 274* 294* 318* 329* 331* 338* 346* 450* 459* 492* 506* 552* 558* 601* 607* 658* 664* 681* 681 696* 725* 758* 793* 855* 886* 898* 1073* 1266* 1266 element based structure level 1 unaligned dcl 231 in procedure "get_values" element based structure array level 2 in structure "assembly_tuple" dcl 2-31 in procedure "tuple_evaluator_recur" set ref 109* 182 200 211* 231 373* 373 element 1 based structure array level 2 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 109 182* 200* 211 1141* 1141 element_list 000106 automatic fixed bin(18,0) array dcl 223 set ref 358* 376 element_ptr 010120 automatic pointer initial dcl 231 set ref 231* 236 245 246 254 254 264 264 280 281 286 286 289 290 296 300 309 309 313 351 355 358 365 365 390 403 404 409 409 411 411 412 412 413 413 413 535 536 536 574 577 637 639 670 674 682 713 715 746 748 781 783 817 819 833 835 849 851 866 868 920 922 939 1001 1017 1037 1053 1106 ellipse_data 010272 automatic float bin(27) array dcl 1020 set ref 1024* 1027* 1031* 1033* 1033* 1033* 1033 1033 1033* 1037* ename 206 based char(32) level 3 in structure "environment" packed unaligned dcl 1-8 in procedure "tuple_evaluator_recur" ref 1079 1080 ename 270 based char(32) level 3 in structure "environment" packed unaligned dcl 1-8 in procedure "tuple_evaluator_recur" set ref 1079 1087 1090* 1106* environment based structure level 1 dcl 1-8 environment_ptr parameter pointer dcl 44 in procedure "ge_eval_" set ref 42 52* 53* environment_ptr parameter pointer dcl 1-6 in procedure "tuple_evaluator_recur" set ref 59 1301 1-42 1-43 1-44 1-45 1-46 1-47 1-48 1-49 1-51 174 203* 1079 1079 1080 1081 1087 1090 1090 1106 1243 1297 error_message 20 based varying char(100) level 2 dcl 1-8 set ref 1-51* 1297* external_char_table 52 based structure level 2 dcl 1-8 first 000102 automatic fixed bin(17,0) dcl 223 set ref 328* 344* 369 375 376 377 383 from_ptr 000104 automatic pointer dcl 1117 set ref 1122* 1128 1133 1141 1144 1146* 1151 1155* 1161 1161 1166 1168* 1173 1176 1180 1180 1187 1190 1195 1195 1219 1225 1263 ge_parse_$backup 000100 constant entry external dcl 64 ref 143 151 239 394 509 562 610 709 742 777 813 901 917 1077 ge_parse_$get_token 000076 constant entry external dcl 64 ref 96 102 129 274 294 318 329 331 338 346 450 459 492 506 552 558 601 607 658 664 696 725 758 793 855 886 898 1073 ge_parse_$push_macro 000102 constant entry external dcl 64 ref 518 graphic_chars_ 000066 constant entry external dcl 7-3 ref 1094 graphic_chars_$get_table 000072 constant entry external dcl 7-3 ref 1090 graphic_chars_$set_table 000070 constant entry external dcl 7-3 ref 1088 graphic_macros_$arc 000060 constant entry external dcl 6-3 ref 1014 graphic_macros_$box 000054 constant entry external dcl 6-3 ref 998 graphic_macros_$circle 000056 constant entry external dcl 6-3 ref 936 graphic_macros_$ellipse 000062 constant entry external dcl 6-3 ref 1033 graphic_macros_$polygon 000064 constant entry external dcl 6-3 ref 1050 graphic_manipulator_$assign_name 000036 constant entry external dcl 5-60 ref 979 1219 graphic_manipulator_$create_array 000034 constant entry external dcl 5-55 ref 674 976 1161 graphic_manipulator_$create_color 000024 constant entry external dcl 5-35 ref 920 graphic_manipulator_$create_data 000030 constant entry external dcl 5-45 ref 866 970 graphic_manipulator_$create_list 000032 constant entry external dcl 5-50 ref 670 graphic_manipulator_$create_mode 000016 constant entry external dcl 5-14 ref 713 746 781 817 graphic_manipulator_$create_position 000014 constant entry external dcl 5-9 ref 536 graphic_manipulator_$create_rotation 000022 constant entry external dcl 5-24 ref 833 graphic_manipulator_$create_scale 000020 constant entry external dcl 5-19 ref 849 graphic_manipulator_$create_text 000026 constant entry external dcl 5-40 ref 637 graphic_manipulator_$examine_data 000052 constant entry external dcl 5-129 ref 448 513 graphic_manipulator_$examine_list 000046 constant entry external dcl 5-109 ref 358 437 graphic_manipulator_$examine_symbol 000050 constant entry external dcl 5-119 ref 403 433 1207 graphic_manipulator_$examine_type 000044 constant entry external dcl 5-83 ref 246 411 graphic_manipulator_$replace_element 000040 constant entry external dcl 5-71 ref 1187 graphic_manipulator_$replace_node 000042 constant entry external dcl 5-74 ref 1225 green constant fixed bin(17,0) initial dcl 877 ref 895 hold_name 010107 automatic varying char(32) dcl 229 set ref 367* 377* i 010522 automatic fixed bin(17,0) dcl 545 in procedure "get_float_number" set ref 549* 556* 556 567 i 000100 automatic fixed bin(17,0) dcl 194 in procedure "perform_recursion" set ref 199* 200 200* 210* 211 211* i 000100 automatic fixed bin(17,0) dcl 1280 in procedure "scan_for_undefineds" set ref 1282* 1283 1283* i 000100 automatic fixed bin(17,0) dcl 223 in procedure "get_values" set ref 283* 283* 286 289 290 369* 371 373 375 376 377* 386 446* 447 448 454 467 467 467 471 471 501* 531* 532* 621* 733* 734 735 736* 768* 769 770 771* 804* 805 806 807* 830* 831* 846* 847* 883* 889 900* 901* 932* 933* 992* 993* 1008* 1009* 1026* 1027* 1030 1044* 1045* 1065* 1066* 1069 1097* 1097* 1098 1099 1099 1100* 1100* i 000164 automatic fixed bin(17,0) dcl 70 in procedure "tuple_evaluator_recur" set ref 108* 109 109* 112 181* 182 182* 1140* 1141* 1176* 1178 1180 1180 1183 1186 1187 1187 1187 1190 1190 1191 1194 1195 1195 1195 1199 1200 1201 1207 1209 1216 1219 1219 1225 1225 1230 1231 1248 1251 1253* intensity 010252 automatic fixed bin(17,0) dcl 690 set ref 694* 699* 700 701 704* 705* 706* 713* internal_stack_inconsistent 000220 stack reference condition dcl 1303 ref 1307 ioa_$rsnnl 000104 constant entry external dcl 77 ref 377 962 967 1297 j 000101 automatic fixed bin(17,0) dcl 223 in procedure "get_values" set ref 251* 253* 261* 263* 271* 272 273* 371* 373 375 376 377 379 616* 618 618 620 621* j 000100 automatic fixed bin(17,0) dcl 1115 in procedure "perform_assignment" set ref 1187* 1212* 1212* 1215 1216 1231* 1232 1248 1251* 1253 1253 k 000165 automatic fixed bin(17,0) dcl 70 set ref 168* 169 169* 252* 253 255* 262* 263 265* 1237* 1238 1238* last 000103 automatic fixed bin(17,0) dcl 223 set ref 328* 336* 337* 345* 361 363 363* 369 383 leading_sign 010510 automatic varying char(1) dcl 429 set ref 480* 484 484* 486* 496 501 level based fixed bin(17,0) level 2 dcl 2-34 set ref 89 106 114 115* 115 161* 161 163 168 172* 172 185 206 668 670 670 674 674 679 680* 680 1122 1123 1146 1168 1265* 1265 1307 linetype 010253 automatic fixed bin(17,0) dcl 719 set ref 723* 728* 729 730 735* 740 743* 746* lvalue 12 based fixed bin(18,0) level 2 in structure "element" dcl 231 in procedure "get_values" set ref 254* 264* 280* 309 365* 409* 413* lvalue 13 based fixed bin(18,0) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 1183 1187* 1199 1207* mac_p 12 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-47 mac_p 000204 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 1-47* 271 272 433 434 507 macro 2 based structure array level 2 dcl 2-14 macro_bits_l 000172 automatic fixed bin(17,0) dcl 4-21 set ref 444* 448 448 512* 513 513 865* 866* 866 866 macro_bits_p 000170 automatic pointer dcl 4-21 set ref 447* 448 511* 513 864* 866 macro_def 000103 automatic varying char(200) dcl 4-17 set ref 511 512 516 517 macro_info based structure level 1 unaligned dcl 4-3 set ref 442 463 488 macro_info_p 000166 automatic pointer dcl 4-19 set ref 442* 447 454 463 467 467 467 471 471 488 501 518* macro_nodes 010376 automatic fixed bin(18,0) array dcl 423 set ref 437* 448* 513* macros based structure level 1 dcl 2-14 max_frames 000212 automatic fixed bin(17,0) dcl 2-5 set ref 165* 166 166 max_symbols 000213 automatic fixed bin(17,0) dcl 2-5 set ref 1234* 1235 1235 my_area based area(261120) dcl 2-3 ref 114 166 176 180 197 214 442 463 488 679 1138 1144 1159 1166 1235 1245 1263 n 000104 automatic fixed bin(17,0) dcl 223 set ref 358* 361 363 n_args based fixed bin(17,0) level 2 dcl 4-3 set ref 442* 463 488 n_chars 010506 automatic fixed bin(17,0) dcl 423 set ref 517* 518* n_elements based fixed bin(17,0) level 2 dcl 2-21 set ref 108 114 180* 197* 214 670 670* 674 674* 679 1128 1130 1133 1133 1137 1138* 1144 1151 1151 1159* 1161 1161* 1166 1173 1173 1176 1259 1263 1282 n_macro_args 000102 automatic fixed bin(17,0) dcl 4-15 set ref 437* 440* 440 442 442 446 513 n_macros based fixed bin(17,0) initial level 2 dcl 2-14 ref 271 n_numeric_args parameter fixed bin(17,0) dcl 947 set ref 944 962* 967* n_symbols based fixed bin(17,0) initial level 2 dcl 2-7 set ref 283 286 1212 1215 1231 1231* 1235* 1237 1241* 1241 n_system_macros based fixed bin(17,0) level 2 dcl 1-30 ref 262 n_system_symbols based fixed bin(17,0) level 2 dcl 1-24 ref 252 n_text_args parameter fixed bin(17,0) dcl 947 ref 944 962 name parameter char(12) unaligned dcl 947 in procedure "make_sysmacro_array" set ref 944 962* 967* name 2 based varying char(32) array level 3 in structure "macros" dcl 2-14 in procedure "tuple_evaluator_recur" set ref 272 434* 507* name 1 based varying char(32) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 1178 1180* 1200 1201 1209* 1248 1283* name based varying char(32) array level 3 in structure "assembly_tuple" dcl 2-31 in procedure "tuple_evaluator_recur" set ref 234* 235 377* name 2 based varying char(32) array level 3 in structure "symbols" dcl 2-7 in procedure "tuple_evaluator_recur" set ref 283 1212 1248* name_ptr 000170 automatic pointer dcl 74 set ref 235* 244 247 296 307 307 309 332 355 359 361 367 383 390 1173 1178* 1183 1189 1195 1221 1227 node_value 13 based fixed bin(18,0) array level 3 in structure "macros" dcl 2-14 in procedure "tuple_evaluator_recur" set ref 433* node_value 13 based fixed bin(18,0) array level 3 in structure "symbols" dcl 2-7 in procedure "tuple_evaluator_recur" set ref 289 1253* num parameter float bin(27) dcl 545 set ref 543 567* numeric_args parameter float bin(27) array dcl 947 set ref 944 962* 967* offender parameter varying char dcl 1293 set ref 1291 1297* offset 13 based fixed bin(17,0) level 2 in structure "element" dcl 231 in procedure "get_values" set ref 236* 409* offset 13 based fixed bin(17,0) array level 3 in structure "assembly_tuple" dcl 2-31 in procedure "tuple_evaluator_recur" set ref 375* offset 14 based fixed bin(17,0) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 1186 1187* 1191* paren_level 010512 automatic fixed bin(17,0) dcl 431 set ref 455* 457 460* 460 461* 461 471 reason parameter char unaligned dcl 1293 set ref 1291 1297* recursion_level parameter fixed bin(17,0) dcl 61 ref 59 89 149 203 206 red constant fixed bin(17,0) initial dcl 877 ref 893 replacement 12 based varying char(1020) array level 3 dcl 4-3 set ref 454* 467 467* 467 471* 471 501* return_val 010613 automatic fixed bin(18,0) dcl 956 set ref 979* 983 rvalue 14 based fixed bin(18,0) array level 3 in structure "assembly_tuple" dcl 2-31 in procedure "tuple_evaluator_recur" set ref 376* rvalue 14 based fixed bin(18,0) level 2 in structure "element" dcl 231 in procedure "get_values" set ref 245* 246* 286* 289* 296 358* 365 390 403* 404* 411* 413 536* 574* 637* 670* 674* 713* 746* 781* 817* 833* 849* 866* 920* 939* 1001* 1017* 1037* 1053* 1106* rvalue 15 based fixed bin(18,0) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 670* 674* 1161* 1161* 1180 1187* 1190* 1190 1195 1195 1219* 1219* 1225* 1225* 1253 1283 save_at_ptr 000102 automatic pointer dcl 194 set ref 197* 200 211 214 scales 010261 automatic float bin(27) array dcl 839 set ref 844* 847* 849* 849* 849* sensitivity 010255 automatic fixed bin(17,0) dcl 787 set ref 791* 796* 797 798 801* 802* 806* 811 814* 817* somelength based fixed bin(35,0) level 2 dcl 4-11 ref 970 970 970 970 stack based structure level 1 dcl 2-34 set ref 166 176 stack_p based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" set ref 1-42 174* stack_p 000172 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 89 106 106 114 114 115 115 1307 1309 1-42* 161 161 163 163 164 165 166* 169 172 174 176 185 185 206 668 668 670 670 670 670 674 674 674 674 679 679 680 680 1122 1122 1123 1123 1146 1146 1168 1168 1265 1265 string 010423 automatic char(200) unaligned dcl 423 set ref 516* 518 518 sym_p 10 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" set ref 1-46 1243* sym_p 000202 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 1-46* 283 283 286 289 1212 1212 1215 1231 1231 1232 1233 1234 1235* 1238 1241 1243 1248 1253 symbol 2 based structure array level 2 dcl 2-7 set ref 1238* 1238 symbol_len 000116 automatic fixed bin(17,0) dcl 1119 set ref 1201* 1207* 1219 1219 symbol_name 000106 automatic char(32) unaligned dcl 1119 set ref 1200* 1207* 1212 1215 1219 1219 symbols based structure level 1 dcl 2-7 set ref 1235 1245 sysmacro_data_string 010546 automatic varying char(128) dcl 956 set ref 962* 967* 970 970 970 970 sysmacro_data_string_len 010607 automatic fixed bin(17,0) dcl 956 set ref 962* 967* sysmacro_subarray 010610 automatic fixed bin(18,0) array dcl 956 set ref 970* 974* 976* sysmacro_value 010612 automatic fixed bin(18,0) dcl 956 in procedure "make_sysmacro_array" set ref 976* 979* sysmacro_value 010271 automatic fixed bin(18,0) dcl 925 in procedure "get_values" set ref 936* 939* 998* 1001* 1014* 1017* 1033* 1037* 1050* 1053* 1094* 1106* sysprint 000012 constant file stream dcl 47 set ref 1126 1127 1128 1129 1130 1258 1259 1260 system_macro_p 6 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-45 system_macro_p 000200 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 1-45* 262 263 265 system_macro_vector 23 based fixed bin(17,0) array level 3 dcl 1-30 ref 265 system_macros 1 based varying char(32) array level 3 dcl 1-30 ref 263 system_symbol_p 000176 automatic pointer dcl 1-36 in procedure "tuple_evaluator_recur" set ref 1-44* 252 253 255 system_symbol_p 4 based pointer level 2 in structure "environment" dcl 1-8 in procedure "tuple_evaluator_recur" ref 1-44 system_symbol_vector 23 based fixed bin(17,0) array level 3 dcl 1-24 ref 255 system_symbols 1 based varying char(32) array level 3 dcl 1-24 ref 253 table_idx 16 based fixed bin(17,0) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 1216* 1230 1231* 1251 table_idx 15 based fixed bin(17,0) level 2 in structure "element" dcl 231 in procedure "get_values" set ref 254* 264* 286* 290* 300* table_name parameter char(32) unaligned dcl 947 set ref 944 962* temp_dirname 010277 automatic char(168) unaligned dcl 1056 set ref 1071* 1081* 1088* temp_node 010366 automatic fixed bin(18,0) dcl 401 in procedure "indirect_thru_symbol" set ref 403* 404 temp_node 010505 automatic fixed bin(18,0) dcl 423 in procedure "setup_macro" set ref 433* 437* temp_p 000100 automatic pointer dcl 49 set ref 164* 168 169 172 1233* 1237 1238 1241 1245 text_string parameter varying char dcl 596 in procedure "read_text_element" set ref 592 601* 602* 604 604* 604 604 text_string parameter varying char dcl 947 in procedure "make_sysmacro_array" set ref 944 962* text_string 010123 automatic varying char(200) dcl 580 in procedure "get_values" set ref 588* 637 637 637 1061* 1094 1097 1098 1099* 1099 1099 1104* 1104 1106* to_ptr 000102 automatic pointer dcl 1117 set ref 1123* 1130 1133 1137 1151 1173 1178 1183 1186 1187 1187 1190 1191 1194 1195 1199 1200 1201 1207 1209 1216 1219 1225 1230 1231 1248 1251 1253 1259 token 000101 automatic varying char(200) dcl 70 set ref 96* 98 102* 103 103* 119* 126* 129* 131* 133 135 142 148 149* 155* 234 238 240* 243 244 245 245 253 263 272 274* 283 294* 296 305 318* 320 321 322 328 329* 330 331* 332 336 338* 346* 383 450* 452 459* 460 461 462 471 483 484 489* 492* 496* 501 506* 552* 555 556 558* 567 607* 614 618 618 629* 658* 660 660* 664* 666 666* 696* 699 704 705 706 708* 725* 728 734 741* 758* 761 765 766 769 776* 793* 796 801 802 805 812* 855* 858* 861 861* 861 861 864 865 886* 893 894 895 896* 898* 904* 906 907* 1073* 1080* 1087 1088 1089* token_type 000166 automatic fixed bin(17,0) dcl 70 set ref 96* 98 102* 121 129* 131 274* 294* 318* 322 327 329* 331* 332 336 338* 346* 390 450* 459* 482 492* 496 506* 507 552* 554 558* 561 601* 602 607* 609 614 616 658* 664* 696* 698 708 725* 727 741 758* 760 776 793* 795 812 855* 858 886* 888 898* 900 901 905 917 1073* 1075 1082* 1086 tup_ptr parameter pointer dcl 1278 ref 1272 1282 1283 1283 tuple based structure level 1 dcl 2-21 set ref 114 180 197 214 679 1128 1130 1138 1144 1159 1166 1259 1263 tuple_p 000216 automatic pointer dcl 2-19 set ref 106* 108 109 180* 182 185 1138* 1141 1146 1159* 1161 1164 1168 tuple_ptr 2 based pointer array level 2 dcl 2-34 set ref 106 114 169* 169 185* 668* 670 670 674 674 679 1122 1123 1146* 1168* 1309* type 12 based fixed bin(17,0) array level 3 in structure "tuple" dcl 2-21 in procedure "tuple_evaluator_recur" set ref 1164* 1194 1195 type 11 based fixed bin(17,0) array level 3 in structure "assembly_tuple" dcl 2-31 in procedure "tuple_evaluator_recur" set ref 379* type 11 based fixed bin(17,0) level 2 in structure "element" dcl 231 in procedure "get_values" set ref 281* 309 313 351 355 411* 412 412* 413 535* 536* 577* 639* 682* 715* 748* 783* 819* 835* 851* 868* 922* unique_chars_ 000112 constant entry external dcl 960 ref 979 value parameter fixed bin(18,0) dcl 947 ref 944 974 whatever parameter fixed bin(17,0) dcl 656 ref 654 670 682 which parameter fixed bin(17,0) dcl 423 ref 421 433 434 507 which_color 010267 automatic fixed bin(17,0) dcl 871 set ref 893* 894* 895* 914 x 1 based structure array level 2 unaligned dcl 4-3 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Any_device internal static fixed bin(17,0) initial dcl 8-9 Blinking internal static fixed bin(17,0) initial dcl 8-9 Center internal static fixed bin(17,0) initial dcl 8-9 Clipping internal static fixed bin(17,0) initial dcl 8-9 Dash_dotted internal static fixed bin(17,0) initial dcl 8-9 Dashed internal static fixed bin(17,0) initial dcl 8-9 Dotted internal static fixed bin(17,0) initial dcl 8-9 Element_names internal static char(16) initial array unaligned dcl 9-3 Full_intensity internal static fixed bin(17,0) initial dcl 8-9 Half_intensity internal static fixed bin(17,0) initial dcl 8-9 Input_device_names internal static char(16) initial array unaligned dcl 9-27 Insensitive internal static fixed bin(17,0) initial dcl 8-9 Intensity_names internal static char(8) initial array unaligned dcl 9-10 Invisible internal static fixed bin(17,0) initial dcl 8-9 Joystick internal static fixed bin(17,0) initial dcl 8-9 Keyboard internal static fixed bin(17,0) initial dcl 8-9 Left internal static fixed bin(17,0) initial dcl 8-9 Light_pen internal static fixed bin(17,0) initial dcl 8-9 Long_dashed internal static fixed bin(17,0) initial dcl 8-9 Lower_center internal static fixed bin(17,0) initial dcl 8-9 Lower_left internal static fixed bin(17,0) initial dcl 8-9 Lower_right internal static fixed bin(17,0) initial dcl 8-9 Mouse internal static fixed bin(17,0) initial dcl 8-9 On_dup_error internal static fixed bin(17,0) initial dcl 8-9 On_dup_source internal static fixed bin(17,0) initial dcl 8-9 On_dup_target_then_nulls internal static fixed bin(17,0) initial dcl 8-9 On_dup_target_then_source internal static fixed bin(17,0) initial dcl 8-9 Point internal static fixed bin(17,0) initial dcl 8-9 Right internal static fixed bin(17,0) initial dcl 8-9 Sensitive internal static fixed bin(17,0) initial dcl 8-9 Setpoint internal static fixed bin(17,0) initial dcl 8-9 Setposition internal static fixed bin(17,0) initial dcl 8-9 Shift internal static fixed bin(17,0) initial dcl 8-9 Solid internal static fixed bin(17,0) initial dcl 8-9 Steady internal static fixed bin(17,0) initial dcl 8-9 Tablet_and_pen internal static fixed bin(17,0) initial dcl 8-9 Terminal_program internal static fixed bin(17,0) initial dcl 8-9 Trackball internal static fixed bin(17,0) initial dcl 8-9 Upper_center internal static fixed bin(17,0) initial dcl 8-9 Upper_left internal static fixed bin(17,0) initial dcl 8-9 Upper_right internal static fixed bin(17,0) initial dcl 8-9 Vector internal static fixed bin(17,0) initial dcl 8-9 gm_$add_element 000000 constant entry external dcl 5-68 gm_$assign_name 000000 constant entry external dcl 5-60 gm_$carray 000000 constant entry external dcl 5-55 gm_$cclip 000000 constant entry external dcl 5-29 gm_$ccolor 000000 constant entry external dcl 5-35 gm_$cdata 000000 constant entry external dcl 5-45 gm_$clist 000000 constant entry external dcl 5-50 gm_$cmode 000000 constant entry external dcl 5-14 gm_$cpos 000000 constant entry external dcl 5-9 gm_$create_array 000000 constant entry external dcl 5-55 gm_$create_clip 000000 constant entry external dcl 5-29 gm_$create_color 000000 constant entry external dcl 5-35 gm_$create_data 000000 constant entry external dcl 5-45 gm_$create_list 000000 constant entry external dcl 5-50 gm_$create_mode 000000 constant entry external dcl 5-14 gm_$create_position 000000 constant entry external dcl 5-9 gm_$create_rotation 000000 constant entry external dcl 5-24 gm_$create_scale 000000 constant entry external dcl 5-19 gm_$create_text 000000 constant entry external dcl 5-40 gm_$crot 000000 constant entry external dcl 5-24 gm_$cscale 000000 constant entry external dcl 5-19 gm_$ctext 000000 constant entry external dcl 5-40 gm_$ecolor 000000 constant entry external dcl 5-96 gm_$edata 000000 constant entry external dcl 5-129 gm_$elist 000000 constant entry external dcl 5-109 gm_$emap 000000 constant entry external dcl 5-101 gm_$emode 000000 constant entry external dcl 5-91 gm_$epos 000000 constant entry external dcl 5-86 gm_$esymbol 000000 constant entry external dcl 5-119 gm_$esymtab 000000 constant entry external dcl 5-114 gm_$etext 000000 constant entry external dcl 5-124 gm_$examine_color 000000 constant entry external dcl 5-96 gm_$examine_contents 000000 constant entry external dcl 5-106 gm_$examine_data 000000 constant entry external dcl 5-129 gm_$examine_list 000000 constant entry external dcl 5-109 gm_$examine_mapping 000000 constant entry external dcl 5-101 gm_$examine_mode 000000 constant entry external dcl 5-91 gm_$examine_position 000000 constant entry external dcl 5-86 gm_$examine_symbol 000000 constant entry external dcl 5-119 gm_$examine_symtab 000000 constant entry external dcl 5-114 gm_$examine_text 000000 constant entry external dcl 5-124 gm_$examine_type 000000 constant entry external dcl 5-83 gm_$find_structure 000000 constant entry external dcl 5-63 gm_$fstruc 000000 constant entry external dcl 5-63 gm_$get_struc 000000 constant entry external dcl 5-134 gm_$gstruc 000000 constant entry external dcl 5-134 gm_$init 000000 constant entry external dcl 5-3 gm_$pstruc 000000 constant entry external dcl 5-139 gm_$put_struc 000000 constant entry external dcl 5-139 gm_$remove_symbol 000000 constant entry external dcl 5-77 gm_$replace_element 000000 constant entry external dcl 5-71 gm_$replace_node 000000 constant entry external dcl 5-74 gm_$replicate 000000 constant entry external dcl 5-80 gm_$save_file 000000 constant entry external dcl 5-144 gm_$segp 000000 constant entry external dcl 5-6 gm_$use_file 000000 constant entry external dcl 5-147 gmc_$arc 000000 constant entry external dcl 6-3 gmc_$box 000000 constant entry external dcl 6-3 gmc_$circle 000000 constant entry external dcl 6-3 gmc_$ellipse 000000 constant entry external dcl 6-3 gmc_$ellipse_by_foci 000000 constant entry external dcl 6-3 gmc_$polygon 000000 constant entry external dcl 6-3 graphic_chars_$init 000000 constant entry external dcl 7-3 graphic_chars_$long 000000 constant entry external dcl 7-3 graphic_chars_$long_tb 000000 constant entry external dcl 7-3 graphic_macros_$ellipse_by_foci 000000 constant entry external dcl 6-3 graphic_manipulator_$add_element 000000 constant entry external dcl 5-68 graphic_manipulator_$carray 000000 constant entry external dcl 5-55 graphic_manipulator_$cclip 000000 constant entry external dcl 5-29 graphic_manipulator_$ccolor 000000 constant entry external dcl 5-35 graphic_manipulator_$cdata 000000 constant entry external dcl 5-45 graphic_manipulator_$clist 000000 constant entry external dcl 5-50 graphic_manipulator_$cmode 000000 constant entry external dcl 5-14 graphic_manipulator_$cpos 000000 constant entry external dcl 5-9 graphic_manipulator_$create_clip 000000 constant entry external dcl 5-29 graphic_manipulator_$crot 000000 constant entry external dcl 5-24 graphic_manipulator_$cscale 000000 constant entry external dcl 5-19 graphic_manipulator_$ctext 000000 constant entry external dcl 5-40 graphic_manipulator_$ecolor 000000 constant entry external dcl 5-96 graphic_manipulator_$edata 000000 constant entry external dcl 5-129 graphic_manipulator_$elist 000000 constant entry external dcl 5-109 graphic_manipulator_$emap 000000 constant entry external dcl 5-101 graphic_manipulator_$emode 000000 constant entry external dcl 5-91 graphic_manipulator_$epos 000000 constant entry external dcl 5-86 graphic_manipulator_$esymbol 000000 constant entry external dcl 5-119 graphic_manipulator_$esymtab 000000 constant entry external dcl 5-114 graphic_manipulator_$etext 000000 constant entry external dcl 5-124 graphic_manipulator_$examine_color 000000 constant entry external dcl 5-96 graphic_manipulator_$examine_contents 000000 constant entry external dcl 5-106 graphic_manipulator_$examine_mapping 000000 constant entry external dcl 5-101 graphic_manipulator_$examine_mode 000000 constant entry external dcl 5-91 graphic_manipulator_$examine_position 000000 constant entry external dcl 5-86 graphic_manipulator_$examine_symtab 000000 constant entry external dcl 5-114 graphic_manipulator_$examine_text 000000 constant entry external dcl 5-124 graphic_manipulator_$find_structure 000000 constant entry external dcl 5-63 graphic_manipulator_$fstruc 000000 constant entry external dcl 5-63 graphic_manipulator_$get_struc 000000 constant entry external dcl 5-134 graphic_manipulator_$gstruc 000000 constant entry external dcl 5-134 graphic_manipulator_$init 000000 constant entry external dcl 5-3 graphic_manipulator_$pstruc 000000 constant entry external dcl 5-139 graphic_manipulator_$put_struc 000000 constant entry external dcl 5-139 graphic_manipulator_$remove_symbol 000000 constant entry external dcl 5-77 graphic_manipulator_$replicate 000000 constant entry external dcl 5-80 graphic_manipulator_$save_file 000000 constant entry external dcl 5-144 graphic_manipulator_$segp 000000 constant entry external dcl 5-6 graphic_manipulator_$use_file 000000 constant entry external dcl 5-147 j automatic fixed bin(17,0) dcl 70 max_macros automatic fixed bin(17,0) dcl 2-5 replacement_string_size internal static fixed bin(17,0) initial dcl 4-9 NAMES DECLARED BY EXPLICIT CONTEXT. bad_blink 004714 constant label dcl 776 ref 762 763 bad_color 005760 constant label dcl 907 ref 905 909 bad_intensity 004315 constant label dcl 708 ref 700 701 bad_linetype 004503 constant label dcl 741 ref 729 730 bad_sensitivity 005123 constant label dcl 812 ref 797 798 check_for_undefineds 001660 constant entry internal dcl 1301 ref 53 end_color_loop 006011 constant label dcl 917 ref 890 flip 001204 constant entry external dcl 1330 ge_eval_ 001132 constant entry external dcl 18 generate_element 000000 constant label array(17) dcl 526 ref 256 generate_error 014236 constant entry internal dcl 1291 ref 103 119 126 131 149 155 247 296 309 332 355 359 361 383 390 434 464 489 496 507 602 629 660 666 677 708 741 776 812 858 896 904 907 996 1012 1030 1048 1089 1163 1173 1180 1183 1189 1195 1209 1215 1221 1227 1283 generate_sysmacro 000021 constant label array(6) dcl 925 ref 266 get_float_number 010745 constant entry internal dcl 543 ref 532 831 847 933 993 1009 1027 1045 1066 get_to_contents 007714 constant entry internal dcl 407 ref 314 get_values 002221 constant entry internal dcl 221 ref 123 275 indirect_thru_symbol 007647 constant entry internal dcl 399 ref 313 352 initialize_ptrs 001713 constant entry internal dcl 1-40 ref 85 208 1305 internal_error 003523 constant label dcl 359 ref 537 638 714 747 782 818 834 850 867 921 937 973 977 981 999 1015 1035 1051 1095 macro_error 010022 constant label dcl 434 ref 438 449 514 make_list_or_array 011404 constant entry internal dcl 654 ref 642 647 make_sysmacro_array 011727 constant entry internal dcl 944 ref 939 1001 1017 1037 1053 1106 no_such_level 003065 constant label dcl 309 ref 316 perform_assignment 012250 constant entry internal dcl 1113 ref 138 perform_recursion 002066 constant entry internal dcl 188 ref 101 137 662 push_tuple 001747 constant entry internal dcl 159 ref 136 144 150 read_text_element 011112 constant entry internal dcl 592 ref 588 1061 return_hard 001202 constant label dcl 1314 set ref 204 1298 scan_for_undefineds 014156 constant entry internal dcl 1272 ref 668 1155 1309 setup_macro 007755 constant entry internal dcl 421 ref 273 tuple_evaluator 001145 constant entry external dcl 42 tuple_evaluator_recur 001220 constant entry internal dcl 59 ref 52 203 unknown_sign 011040 constant label dcl 562 ref 556 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 231 235 447 511 518 518 864 970 970 970 970 1178 fixed builtin function ref 1033 1033 1050 1050 hbound builtin function ref 616 621 625 730 733 736 768 771 804 807 lbound builtin function ref 625 729 733 length builtin function ref 467 517 604 637 637 861 865 970 970 1097 1201 size builtin function ref 444 512 substr builtin function ref 238 243 245 245 604 604 861 861 1098 1099 1099 1219 1219 unspec builtin function ref 970 970 970 970 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 15062 15176 14367 15072 Length 15704 14367 114 471 473 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ge_eval_ 136 external procedure is an external procedure. tuple_evaluator_recur 189 internal procedure is called by several nonquick procedures. initialize_ptrs 64 internal procedure is called by several nonquick procedures. push_tuple internal procedure shares stack frame of internal procedure tuple_evaluator_recur. perform_recursion 82 internal procedure is called by several nonquick procedures. get_values 4844 internal procedure calls itself recursively. indirect_thru_symbol internal procedure shares stack frame of internal procedure get_values. setup_macro internal procedure shares stack frame of internal procedure get_values. get_float_number internal procedure shares stack frame of internal procedure get_values. read_text_element internal procedure shares stack frame of internal procedure get_values. make_list_or_array internal procedure shares stack frame of internal procedure get_values. make_sysmacro_array internal procedure shares stack frame of internal procedure get_values. perform_assignment 200 internal procedure uses I/O statements. scan_for_undefineds 84 internal procedure is called by several nonquick procedures. generate_error 86 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 debugsw ge_eval_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ge_eval_ 000100 temp_p ge_eval_ 000102 n_macro_args ge_eval_ 000103 macro_def ge_eval_ 000166 macro_info_p ge_eval_ 000170 macro_bits_p ge_eval_ 000172 macro_bits_l ge_eval_ get_values 000100 i get_values 000101 j get_values 000102 first get_values 000103 last get_values 000104 n get_values 000105 eff_type get_values 000106 element_list get_values 010104 coords get_values 010107 hold_name get_values 010120 element_ptr get_values 010122 alignment get_values 010123 text_string get_values 010206 alignment_abbrevs get_values 010252 intensity get_values 010253 linetype get_values 010254 blink get_values 010255 sensitivity get_values 010256 angles get_values 010261 scales get_values 010264 colors get_values 010267 which_color get_values 010270 color_value get_values 010271 sysmacro_value get_values 010272 ellipse_data get_values 010277 temp_dirname get_values 010366 temp_node indirect_thru_symbol 010376 macro_nodes setup_macro 010423 string setup_macro 010505 temp_node setup_macro 010506 n_chars setup_macro 010510 leading_sign setup_macro 010512 paren_level setup_macro 010522 i get_float_number 010546 sysmacro_data_string make_sysmacro_array 010607 sysmacro_data_string_len make_sysmacro_array 010610 sysmacro_subarray make_sysmacro_array 010612 sysmacro_value make_sysmacro_array 010613 return_val make_sysmacro_array perform_assignment 000100 j perform_assignment 000102 to_ptr perform_assignment 000104 from_ptr perform_assignment 000106 symbol_name perform_assignment 000116 symbol_len perform_assignment perform_recursion 000100 i perform_recursion 000102 save_at_ptr perform_recursion scan_for_undefineds 000100 i scan_for_undefineds tuple_evaluator_recur 000100 effective_level tuple_evaluator_recur 000101 token tuple_evaluator_recur 000164 i tuple_evaluator_recur 000165 k tuple_evaluator_recur 000166 token_type tuple_evaluator_recur 000170 name_ptr tuple_evaluator_recur 000172 stack_p tuple_evaluator_recur 000174 command_p tuple_evaluator_recur 000176 system_symbol_p tuple_evaluator_recur 000200 system_macro_p tuple_evaluator_recur 000202 sym_p tuple_evaluator_recur 000204 mac_p tuple_evaluator_recur 000206 areap tuple_evaluator_recur 000210 at_ptr tuple_evaluator_recur 000212 max_frames tuple_evaluator_recur 000213 max_symbols tuple_evaluator_recur 000214 cur_elements tuple_evaluator_recur 000216 tuple_p tuple_evaluator_recur THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_cs alloc_bs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return fl2_to_fx1 tra_ext signal shorten_stack ext_entry int_entry int_entry_desc put_end stream_io put_list_eis put_field alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_ cv_float_ ge_parse_$backup ge_parse_$get_token ge_parse_$push_macro graphic_chars_ graphic_chars_$get_table graphic_chars_$set_table graphic_macros_$arc graphic_macros_$box graphic_macros_$circle graphic_macros_$ellipse graphic_macros_$polygon graphic_manipulator_$assign_name graphic_manipulator_$create_array graphic_manipulator_$create_color graphic_manipulator_$create_data graphic_manipulator_$create_list graphic_manipulator_$create_mode graphic_manipulator_$create_position graphic_manipulator_$create_rotation graphic_manipulator_$create_scale graphic_manipulator_$create_text graphic_manipulator_$examine_data graphic_manipulator_$examine_list graphic_manipulator_$examine_symbol graphic_manipulator_$examine_type graphic_manipulator_$replace_element graphic_manipulator_$replace_node ioa_$rsnnl unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. sysprint sysprint.fsb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 47 001114 18 001131 18 001140 42 001141 51 001153 52 001155 53 001170 56 001201 1314 001202 1330 001203 1334 001212 1335 001216 59 001217 85 001230 86 001234 87 001235 89 001236 96 001242 98 001262 101 001272 102 001276 103 001316 106 001345 108 001352 109 001361 110 001375 112 001377 114 001402 115 001413 116 001415 117 001417 119 001420 121 001440 122 001442 123 001443 124 001447 126 001450 129 001472 131 001512 133 001534 135 001542 136 001547 137 001550 138 001554 139 001560 142 001561 143 001566 144 001573 145 001574 148 001575 149 001602 150 001627 151 001630 152 001635 155 001636 156 001655 1301 001656 1305 001670 1307 001674 1309 001702 1310 001711 1 40 001712 1 42 001720 1 43 001726 1 44 001731 1 45 001733 1 46 001735 1 47 001737 1 48 001741 1 49 001743 1 51 001745 1 53 001746 159 001747 161 001750 162 001751 163 001752 164 001756 165 001760 166 001763 168 001774 169 002004 170 002011 172 002013 174 002016 176 002022 180 002027 181 002040 182 002046 183 002056 185 002060 186 002064 188 002065 197 002073 199 002106 200 002114 201 002125 203 002127 204 002147 206 002155 208 002162 210 002167 211 002177 212 002210 214 002212 216 002217 221 002220 231 002226 585 002234 234 002335 235 002346 236 002350 238 002352 239 002356 240 002362 243 002367 244 002373 245 002404 246 002435 247 002457 248 002506 251 002507 252 002514 253 002525 254 002542 255 002546 256 002551 258 002552 259 002554 261 002557 262 002564 263 002575 264 002612 265 002616 266 002621 268 002622 269 002624 271 002627 272 002637 273 002652 274 002654 275 002675 276 002702 278 002703 280 002705 281 002710 283 002712 284 002734 286 002736 289 002747 290 002754 294 002756 296 002777 300 003036 305 003040 307 003046 309 003056 313 003107 314 003115 316 003116 318 003121 320 003141 321 003150 322 003156 327 003167 328 003171 329 003221 330 003243 331 003251 332 003271 336 003323 337 003355 338 003360 341 003401 344 003402 345 003404 346 003406 349 003426 351 003430 352 003437 353 003440 355 003441 358 003471 359 003520 361 003550 363 003600 365 003605 367 003610 369 003617 371 003626 373 003631 375 003647 376 003656 377 003662 379 003721 381 003726 383 003730 386 003763 388 003767 390 003770 394 004023 395 004030 526 004031 529 004042 531 004044 532 004054 533 004065 535 004067 536 004073 537 004115 539 004120 574 004121 577 004122 578 004124 588 004125 637 004130 638 004173 639 004177 640 004202 642 004203 645 004205 647 004206 650 004210 694 004211 696 004213 698 004233 699 004237 700 004264 701 004267 702 004271 704 004272 705 004301 706 004307 708 004315 709 004341 710 004346 713 004347 714 004366 715 004371 717 004374 723 004375 725 004377 727 004417 728 004423 729 004450 730 004453 731 004455 733 004456 734 004462 735 004472 736 004474 738 004476 740 004500 741 004503 742 004532 743 004537 746 004540 747 004557 748 004562 750 004565 756 004566 758 004570 760 004610 761 004614 762 004641 763 004644 764 004646 765 004647 766 004656 768 004666 769 004673 770 004703 771 004705 773 004707 775 004711 776 004714 777 004740 778 004745 781 004747 782 004766 783 004771 785 004774 791 004775 793 004777 795 005017 796 005023 797 005050 798 005053 799 005055 801 005056 802 005066 804 005075 805 005102 806 005112 807 005114 809 005116 811 005120 812 005123 813 005147 814 005154 817 005156 818 005175 819 005200 821 005203 828 005204 830 005216 831 005226 832 005237 833 005241 834 005262 835 005265 837 005270 843 005271 844 005272 846 005303 847 005313 848 005324 849 005326 850 005347 851 005352 853 005355 855 005356 858 005376 861 005422 864 005440 865 005443 866 005447 867 005477 868 005502 869 005505 881 005506 883 005516 885 005523 886 005525 888 005546 889 005552 890 005566 893 005567 894 005577 895 005607 896 005617 898 005637 900 005660 901 005667 904 005702 905 005726 906 005730 907 005755 909 006001 914 006004 915 006007 917 006011 920 006022 921 006043 922 006046 923 006051 929 006052 930 006063 932 006065 933 006075 934 006106 936 006110 937 006126 939 006131 940 006212 988 006213 992 006224 993 006234 994 006245 996 006247 998 006273 999 006311 1001 006314 1002 006375 1004 006376 1008 006407 1009 006417 1010 006430 1012 006432 1014 006456 1015 006476 1017 006501 1018 006562 1024 006563 1026 006574 1027 006604 1028 006615 1030 006617 1031 006643 1033 006650 1035 006676 1037 006701 1038 006762 1040 006763 1044 006774 1045 007004 1046 007015 1048 007017 1050 007043 1051 007066 1053 007071 1054 007152 1061 007153 1063 007156 1065 007163 1066 007173 1067 007204 1069 007206 1071 007216 1073 007221 1075 007241 1077 007245 1079 007252 1080 007262 1081 007267 1082 007272 1086 007274 1087 007277 1088 007307 1089 007340 1090 007364 1094 007405 1095 007453 1097 007457 1098 007464 1099 007470 1100 007526 1102 007530 1104 007532 1106 007564 1109 007646 399 007647 403 007650 404 007703 405 007712 407 007713 409 007715 411 007721 412 007741 413 007750 414 007754 421 007755 433 007757 434 010017 437 010051 438 010101 440 010104 442 010107 444 010125 446 010127 447 010136 448 010144 449 010200 450 010203 452 010223 454 010231 455 010235 457 010237 459 010241 460 010262 461 010272 462 010302 463 010307 464 010315 467 010336 471 010357 474 010376 476 010377 480 010400 482 010401 483 010405 484 010413 486 010432 488 010437 489 010445 492 010466 494 010507 496 010510 501 010537 502 010572 503 010573 506 010575 507 010616 509 010650 511 010655 512 010661 513 010663 514 010715 516 010720 517 010725 518 010727 520 010744 543 010745 549 010747 550 010751 552 010752 554 010773 555 010777 556 011005 558 011015 559 011035 561 011036 562 011040 563 011045 564 011050 567 011051 568 011110 592 011112 599 011123 601 011126 602 011150 604 011201 607 011220 609 011241 610 011245 611 011252 612 011255 614 011256 616 011307 618 011317 620 011337 621 011342 621 011343 623 011345 625 011347 629 011357 632 011403 654 011404 658 011406 660 011427 662 011455 664 011462 666 011503 668 011531 670 011543 674 011614 677 011660 679 011704 680 011715 681 011720 682 011722 684 011726 944 011727 962 011740 967 012022 970 012064 973 012127 974 012133 976 012136 977 012165 979 012170 981 012240 983 012243 1113 012247 1122 012260 1123 012266 1125 012271 1126 012273 1127 012306 1128 012320 1129 012450 1130 012462 1133 012612 1137 012620 1138 012622 1140 012635 1141 012644 1142 012653 1144 012655 1146 012662 1149 012671 1151 012672 1155 012676 1157 012705 1159 012710 1161 012723 1163 012762 1164 013006 1166 013012 1168 013017 1173 013026 1176 013053 1178 013064 1180 013070 1183 013123 1186 013153 1187 013163 1189 013206 1190 013235 1191 013245 1192 013247 1194 013250 1195 013254 1199 013304 1200 013314 1201 013322 1202 013324 1207 013325 1209 013362 1212 013411 1213 013432 1215 013434 1216 013465 1219 013473 1221 013535 1222 013562 1225 013563 1227 013577 1230 013623 1231 013632 1232 013640 1233 013643 1234 013645 1235 013650 1237 013664 1238 013676 1239 013707 1241 013711 1243 013714 1245 013721 1248 013730 1249 013750 1251 013751 1253 013752 1255 013765 1257 013767 1258 013772 1259 014003 1260 014131 1263 014142 1265 014147 1266 014152 1268 014154 1272 014155 1282 014163 1283 014174 1285 014232 1287 014234 1291 014235 1296 014256 1297 014263 1298 014315 ----------------------------------------------------------- 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