COMPILATION LISTING OF SEGMENT apl_v1_copy_command_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1619.0 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 apl_v1_copy_command_: 11 procedure (bv_wsid, password, protected, names, number_of_names, bv_code); 12 13 declare (protected bit(1), 14 bv_wsid char (*), 15 password char (*), 16 names dimension (*) char (*), 17 number_of_names fixed bin, 18 bv_code fixed bin (35)) parameter; 19 20 /* procedure to copy a Version 1 APL workspace, converting it to Version 2 format. 21* Written 740201 by PG, after "copy_command" by MGS. 22* Modified 740430 by PG to fix bugs. 23* Modified 770301 by PG to copy external functions properly (bug 238), and to copy names less than 4 chars (bug 177). 24**/ 25 26 /* builtin */ 27 28 declare (addr, addrel, baseno, baseptr, bin, binary, char, divide, float, hbound, index, length, mod, null, ptr, 29 rel, size, string, substr, translate, unspec) builtin; 30 31 /* external static */ 32 33 declare apl_error_table_$cant_load_ws external static fixed bin (35); 34 35 /* entries into Version 2 */ 36 37 declare apl_allocate_words_ entry (fixed bin (18), unaligned pointer), 38 apl_date_time_ entry (fixed bin (71), char (*)), 39 apl_free_bead_ entry (ptr unaligned), 40 apl_function_lex_ entry (char (*) aligned, unaligned pointer, bit (1) aligned, fixed bin, ptr), 41 apl_system_error_ entry (fixed bin (35)), 42 apl_translate_pathname_$allow_version_one entry (char (*), char (*), char (*), ptr, fixed bin (35)), 43 apl_create_save_frame_ entry (), 44 apl_destroy_save_frame_update_ entry (), 45 apl_get_symbol_ entry (char (*), unaligned pointer, fixed bin); 46 47 /* entries into Multics */ 48 49 declare ioa_$ioa_stream entry options (variable), 50 msf_manager_$close entry (ptr), 51 msf_manager_$get_ptr entry(ptr, fixed, bit(1), ptr, fixed bin(24), fixed (35)); 52 53 /* automatic */ 54 55 declare bead_pointer pointer unaligned, 56 code fixed bin (35), 57 (data_elements, hook, name_length, name_number) fixed bin, 58 dname char (168), 59 ename char (32), 60 n_words fixed bin (18), 61 dtm char (17), 62 bitcount fixed bin (24), 63 (fcbp, free_space_ptr, p, pp, q, segptr) ptr; 64 65 /* declarations for Version 1 environment */ 66 67 dcl 68 wsid char(168) var, 69 i fixed, 70 csize(4) fixed int static init(1, 9, 36, 72), 71 got(16) fixed init((16)0), 72 73 1 seg based(segptr) aligned, 74 2 type fixed, 75 2 version, 76 3 len fixed, 77 3 name char(seg.version.len) aligned, 78 2 password char(8) aligned, 79 2 time_saved fixed bin(71), 80 2 tablen fixed, 81 2 table(seg.tablen) unaligned, 82 3 old unaligned, 83 4 seg bit(9) unaligned, 84 4 rel bit(18) unaligned, 85 3 new unaligned, 86 4 seg bit(9) unaligned, 87 4 rel bit(18) unaligned, 88 3 size bit(18) unaligned, 89 2 saved_static, 90 3 (digits, width, iorg, niorg, seed) fixed, 91 3 fuzz float bin(63), 92 3 (metersw, lexsw, parsesw) fixed, 93 3 goaheads(3), 94 4 len fixed, 95 4 chars char(16), 96 2 reserved_space(32) fixed, 97 2 data(261120) fixed, 98 99 type_of_ws fixed int static init(0), 100 line char(131) var, 101 symp ptr, 102 103 1 symtab based(symp), 104 2 prime fixed, 105 2 buckets(0:999), 106 3 (p, q) fixed, 107 108 1 sb based(p), /* Spelling bead */ 109 2 (o, np, nq, up, uq, length) fixed, 110 2 string char(sb.length), 111 112 1 ub based(q), /* Usage bead */ 113 2 o fixed, /* owner list for hooks */ 114 2 t fixed, /* type (var, fcn, group) */ 115 2 (vp, vq) fixed, /* hook to value */ 116 2 (np, nq) fixed, /* hook to next usage for this spelling */ 117 2 (sp, sq) fixed, /* hook to next spelling bead */ 118 2 globg bit(1); /* "1"b if global */ 119 120 /* Procedure bead. 19 August 1971 (19 lines) */ 121 122 dcl 123 1 pb based(pp), 124 2 p_owner fixed, 125 2 p_sname(0:0) fixed, /* S of fcn name. */ 126 2 p_sanswer fixed, /* Sname(1)=answer name, 0 if none. */ 127 2 p_sright fixed, /* (2)=right argument name. */ 128 2 p_sleft fixed, /* (3)=left argument name. */ 129 2 p_sxlocvs fixed, /* (4)=s of first explicit local. */ 130 2 p_nxlocvs fixed, /* Number of explicit local names. */ 131 2 p_nlabs fixed, /* Number of labels. */ 132 2 p_nlocvs fixed, /* Total number of local names. */ 133 2 (p_sourcep, p_sourceq) fixed, /* Hook to fcn source. */ 134 2 p_nschars fixed, /* Number of source characters. */ 135 2 p_nslines fixed, /* Number of source lines. */ 136 2 p_nllines fixed, /* Number of lexed lines. 0 for external fcns. */ 137 2 p_lexs(pp->p_nllines), /* Hooks to individual line lexs. */ 138 3 (p_lexp, p_lexq) fixed; 139 140 /* program */ 141 142 if bv_wsid = "" 143 then do; 144 not_found: 145 call ioa_$ioa_stream ("apl_output_", "ws not found"); 146 bv_code = apl_error_table_$cant_load_ws; 147 return; 148 end; 149 150 call apl_translate_pathname_$allow_version_one (bv_wsid, dname, ename, fcbp, bv_code); 151 if bv_code ^= 0 152 then go to not_found; 153 154 call msf_manager_$get_ptr(fcbp, 0, "0"b, segptr, bitcount, code); 155 if segptr=null then go to not_found; 156 got(1) = bin(baseno(segptr), 18); 157 158 if seg.type ^= type_of_ws 159 then call apl_system_error_ (apl_error_table_$cant_load_ws); 160 161 if seg.password ^= password 162 then do; 163 call ioa_$ioa_stream ("apl_output_", "ws locked"); 164 return; 165 end; 166 167 line = ""; 168 169 symp = addr(data(2)); 170 171 if binary(rel(symp), 18)+2*prime+1>65535 172 then call apl_system_error_ (apl_error_table_$cant_load_ws); 173 174 call apl_create_save_frame_; /* use global meanings */ 175 176 /* get ptr to end of parse stack for kludgy apl_lex_ interface */ 177 178 save_frame_pointer = ws_info.current_parse_frame_ptr; 179 free_space_ptr = addr (save_frame.symbol_list (hbound (save_frame.symbol_list, 1) + 1)); 180 181 if number_of_names = 0 /* copy all names */ 182 then do i = 0 to prime - 1; 183 do hook = buckets (i).q repeat p -> sb.nq while (hook ^= 0); 184 p = copy_expand (hook); 185 if sb.uq ^= 0 186 then do; 187 q = copy_expand(sb.uq); 188 do while(ub.nq^=0); 189 q = copy_expand(ub.nq); 190 end; 191 192 if ub.globg 193 then call copy (sb.string, q, "0"b); 194 end; 195 end; 196 end; 197 else do name_number = 1 to number_of_names; 198 name_length = index (names (name_number), " ") - 1; 199 if name_length = -1 200 then name_length = length (names (name_number)); 201 202 q = copy_symget (substr (names (name_number), 1, name_length)); 203 if q = null 204 then call not_copied (substr (names (name_number), 1, name_length)); 205 else call copy (substr (names (name_number), 1, name_length), q, "1"b); 206 end; 207 208 if length (line) > 0 then call ioa_$ioa_stream ("apl_output_", "^a", line); 209 210 call apl_date_time_ (time_saved, dtm); 211 call ioa_$ioa_stream ("apl_output_", "saved ^a", dtm); 212 call msf_manager_$close(fcbp); 213 call apl_destroy_save_frame_update_; 214 return; 215 216 copy: proc(name, q, chase_names); 217 218 /* parameters */ 219 220 declare (name char (*), 221 q ptr, 222 chase_names bit (1) aligned) parameter; 223 224 /* automatic */ 225 226 declare data_pointer pointer, 227 errors_occurred bit (1) aligned, 228 (in_start, in_length, line_length, number_of_groupies, out_start) fixed bin, 229 symbol_pointer pointer unaligned, 230 type bit (18) aligned; 231 232 /* builtin */ 233 234 declare string builtin; 235 236 /* internal static initial */ 237 238 declare (nl char (1) aligned initial (" 239 "), 240 v1_codes char (10) aligned initial ("""#$%&@^`{}"), /* " # $ % & @ ^ ` { } */ 241 v2_codes char (10) aligned initial ("¥¦§¨©ª«¬­®") /* \245 - \256 */ 242 ) internal static options (constant); 243 244 /* Version 1 data declarations */ 245 246 declare 1 bit_value based (vp), 247 2 (o, type, number, rhorho, rho (0 refer (bit_value.rhorho))) fixed, 248 2 element (0 refer (bit_value.number)) bit (1), 249 250 1 character_value based (vp), 251 2 (o, type, number, rhorho, rho (0 refer (character_value.rhorho))) fixed, 252 2 string char (character_value.number), 253 254 1 integer_value based (vp), 255 2 (o, type, number, rhorho, rho (0 refer (integer_value.rhorho))) fixed, 256 2 element (0 refer (integer_value.number)) fixed bin (35), 257 258 1 float_value based (vp), 259 2 (o, type, number, rhorho, rho (0 refer (float_value.rhorho))) fixed, 260 2 element (0 refer (float_value.number)) bit (72); 261 262 /* declarations for Version 1 environment */ 263 264 dcl 265 i fixed, 266 vp ptr, 267 vp1 ptr, 268 gp ptr, 269 270 1 vb based(vp), 271 2 (o, t, n, rr, r(vb.rr)) fixed, 272 2 v(vb.n) bit(csize(vb.t)), 273 274 1 vb1 based(vp1), 275 2 (o, t, n, rr, r(vb.rr)) fixed, 276 2 v(vb1.n) bit(csize(vb.t)), 277 278 1 sb based(sp), /* Source bead */ 279 2 o fixed, 280 2 source char(pp->p_nschars), 281 282 1 gb based(gp), 283 2 (o, np, nq, l) fixed, 284 2 n char(gb.l), 285 286 tm_var fixed int static init(46), 287 tm_group fixed int static init(73), 288 tm_zfn fixed int static init(48), 289 tm_mfn fixed int static init (49), 290 tm_dfn fixed int static init(50); 291 292 293 call apl_get_symbol_ (name, symbol_pointer, (0)); 294 295 if symbol_pointer -> symbol_bead.meaning_pointer ^= null 296 then do; 297 if protected 298 then do; 299 call not_copied (name); 300 return; 301 end; 302 call wash (symbol_pointer -> symbol_bead.meaning_pointer); 303 end; 304 305 if q -> ub.t = tm_var /* COPY VARIABLE */ 306 then do; 307 if q->ub.vq=0 then return; 308 vp = copy_expand(q->ub.vq); 309 310 data_elements = vb.n; 311 number_of_dimensions = vb.rr; 312 313 go to get_type (vb.t); 314 315 get_type (1): /* BIT */ 316 317 type = zero_or_one_value_type; 318 n_words = size (numeric_datum) + 1; 319 go to end_get_type; 320 321 get_type (2): /* CHARACTER */ 322 323 type = character_value_type; 324 n_words = size (character_string_overlay); 325 go to end_get_type; 326 327 get_type (3): /* INTEGER */ 328 329 type = integral_value_type; 330 n_words = size (numeric_datum) + 1; 331 go to end_get_type; 332 333 get_type (4): /* FLOAT */ 334 335 type = numeric_value_type; 336 n_words = size (numeric_datum) + 1; 337 338 end_get_type: 339 n_words = n_words + size (value_bead); 340 call apl_allocate_words_ (n_words, bead_pointer); 341 342 symbol_pointer -> symbol_bead.meaning_pointer = bead_pointer; 343 344 string (bead_pointer -> general_bead.type) = type; 345 bead_pointer -> value_bead.total_data_elements = data_elements; 346 bead_pointer -> value_bead.rhorho = number_of_dimensions; 347 348 data_pointer = addr (bead_pointer -> value_bead.rho (number_of_dimensions + 1)); 349 350 if type & numeric_value_type 351 then if substr (rel (data_pointer), 18, 1) 352 then data_pointer = addrel (data_pointer, 1); 353 354 bead_pointer -> value_bead.data_pointer = data_pointer; 355 356 do i = 1 to number_of_dimensions; 357 bead_pointer -> value_bead.rho (i) = vb.r (i); 358 end; 359 360 go to copy_data (vb.t); 361 362 copy_data (1): /* BIT */ 363 364 do i = 0 by 1 while (i < data_elements); 365 if bit_value.element (i + 1) 366 then data_pointer -> numeric_datum (i) = 1e0; 367 else data_pointer -> numeric_datum (i) = 0e0; 368 end; 369 go to end_copy_data; 370 371 copy_data (2): /* CHARACTER */ 372 373 data_pointer -> character_string_overlay = translate (character_value.string, v2_codes, v1_codes); 374 go to end_copy_data; 375 376 copy_data (3): /* INTEGER */ 377 378 do i = 0 by 1 while (i < data_elements); 379 data_pointer -> numeric_datum (i) = float (integer_value.element (i + 1), 63); 380 end; 381 go to end_copy_data; 382 383 copy_data (4): /* FLOAT */ 384 385 do i = 0 by 1 while (i < data_elements); 386 387 /* unspec must be used because Version 1 APL does not double-word align floating 388* point numbers */ 389 390 unspec (data_pointer -> numeric_datum (i)) = float_value.element (i + 1); 391 end; 392 393 end_copy_data: 394 end; 395 396 else if q -> ub.t >= tm_zfn & q -> ub.t <= tm_dfn /* COPY FUNCTION */ 397 then do; 398 if q->ub.vq=0 then return; 399 400 pp = copy_expand(q->ub.vq); 401 402 data_elements = pp -> pb.p_nschars; 403 n_words = size (function_bead); 404 405 call apl_allocate_words_ (n_words, bead_pointer); 406 407 symbol_pointer -> symbol_bead.meaning_pointer = bead_pointer; 408 409 string (bead_pointer -> general_bead.type) = function_type; 410 bead_pointer -> function_bead.lexed_function_bead_pointer = null; 411 bead_pointer -> function_bead.stop_control_pointer = null; 412 bead_pointer -> function_bead.trace_control_pointer = null; 413 vp = copy_expand (pp -> p_sourceq); 414 415 if pp -> pb.p_nllines = 0 /* We have an external function */ 416 then do; 417 if q -> ub.t = tm_zfn 418 then bead_pointer -> function_bead.class = 2; /* niladic fcn */ 419 else if q -> ub.t = tm_mfn 420 then bead_pointer -> function_bead.class = 3; /* monadic fcn */ 421 else bead_pointer -> function_bead.class = 4; /* dyadic fcn */ 422 423 bead_pointer -> function_bead.text_length = data_elements; 424 bead_pointer -> function_bead.text = vp -> sb.source; 425 end; 426 else do; 427 bead_pointer -> function_bead.class = 0; /* NORMAL UNLOCKED FUNCTION */ 428 in_start = 1; 429 in_length = length (vp -> sb.source); 430 out_start = 1; 431 do while (in_length > 2); 432 line_length = index (substr (vp -> sb.source, in_start, in_length), nl); 433 substr (bead_pointer -> function_bead.text, out_start, line_length) = translate (substr ( 434 vp -> sb.source, in_start, line_length), v2_codes, v1_codes); 435 out_start = out_start + line_length; 436 in_start = in_start + line_length + 2; 437 in_length = in_length - line_length - 2; 438 end; 439 440 bead_pointer -> function_bead.text_length = out_start - 1; 441 442 call apl_function_lex_ (bead_pointer -> function_bead.text, 443 bead_pointer -> function_bead.lexed_function_bead_pointer, errors_occurred, 0, free_space_ptr); 444 end; 445 end; 446 447 else if q -> ub.t = tm_group /* COPY GROUP */ 448 then do; 449 if q -> ub.vq = 0 450 then return; 451 452 /* Visit all members of this group to count how many there are */ 453 454 number_of_groupies = 1; 455 do gp = copy_expand (q -> ub.vq) repeat copy_expand (gp -> gb.nq) while (gp -> gb.nq ^= 0); 456 number_of_groupies = number_of_groupies + 1; 457 end; 458 459 n_words = size (group_bead) + number_of_groupies; 460 call apl_allocate_words_ (n_words, bead_pointer); 461 462 symbol_pointer -> symbol_bead.meaning_pointer = bead_pointer; 463 464 string (bead_pointer -> general_bead.type) = group_type; 465 466 bead_pointer -> group_bead.number_of_members = number_of_groupies; 467 468 gp = copy_expand (q -> ub.vq); 469 do i = 1 to number_of_groupies; 470 call apl_get_symbol_ (gp -> gb.n, symbol_pointer, (0)); 471 472 bead_pointer -> group_bead.member (number_of_groupies - i + 1) = symbol_pointer; 473 474 if chase_names 475 then do; 476 vp1 = copy_symget(gp->gb.n); 477 if vp1=null then call not_copied(gp->gb.n); 478 else call copy(gp->gb.n, vp1, "0"b); 479 end; 480 gp = copy_expand (gp -> gb.nq); 481 end; 482 end; 483 484 else call not_copied(name||"*"); 485 486 /* Don't flush if we created this guy, otherwise be transparent. */ 487 488 if symbol_pointer -> general_bead.reference_count > 1 489 then call wash (symbol_pointer); 490 491 return; 492 493 end; 494 495 wash: 496 procedure (bv_bead_pointer); 497 498 /* parameters */ 499 500 declare bv_bead_pointer pointer unaligned parameter; 501 502 /* automatic */ 503 504 declare bead_pointer pointer unaligned; 505 506 /* program */ 507 508 bead_pointer = bv_bead_pointer; 509 510 bead_pointer -> general_bead.reference_count = bead_pointer -> general_bead.reference_count - 1; 511 512 if bead_pointer -> general_bead.reference_count < 1 513 then call apl_free_bead_ (bead_pointer); 514 515 return; 516 517 end wash; 518 519 copy_expand: proc(val) returns(ptr); 520 521 dcl 522 val fixed, 523 i fixed, 524 sptr ptr, 525 high fixed, 526 low fixed, 527 try fixed; 528 529 if val=0 then return(null); 530 531 high = tablen; 532 low = 1; 533 534 loop: if high=low then do; 535 try = high; 536 go to found; 537 end; 538 539 try = divide(high + low, 2, 17, 0); 540 541 i = binary(table(try).old.seg || table(try).old.rel, 27); 542 543 if i=val then go to found; 544 545 if i char4 = name; 581 i = mod (i, prime); 582 583 do hook = buckets (i).q repeat p-> sb.nq while (hook ^= 0); 584 p = copy_expand (hook); 585 if p->sb.length = length(name) 586 then go to found; 587 end; 588 return (null); 589 590 found: if p->sb.uq=0 then return(null); 591 592 do p = copy_expand (p -> sb.uq) repeat copy_expand (p -> ub.nq) while (p -> ub.nq ^= 0); 593 end; 594 595 if p -> ub.globg 596 then return (p); 597 else return(null); 598 599 end copy_symget; 600 601 not_copied: proc(name); 602 603 dcl 604 name char(*); 605 606 if length(line)=0 then line = "not copied: "; 607 608 if length (line) + length (name) > ws_info.width 609 then do; 610 prt_line: 611 call ioa_$ioa_stream ("apl_output_", "^a", line); 612 line = (15)" "; 613 go to ok; 614 end; 615 616 line = line || substr((8)" ", 1, 8-mod(length(line), 8)); 617 if length (line) + length (name) > ws_info.width 618 then go to prt_line; 619 620 ok: line = line || name; 621 622 return; 623 624 end; 625 626 627 628 1 1 /* ====== BEGIN INCLUDE SEGMENT apl_number_data.incl.pl1 ================================== */ 1 2 1 3 /* 1 4* This include file contains information about the machine representation of numbers. 1 5* In all programs numbers should simply be declared 'float'. 1 6* All default statements should be in this include file. 1 7* 1 8* This is the binary version. The manifest constant Binary should be used by programs 1 9* that need to know whether we are using binary or decimal. 1 10* */ 1 11 1 12 /* format: style3,initlm0,idind30 */ 1 13 1 14 default (float & ^decimal & ^binary & ^precision & ^constant) float binary (63); 1 15 1 16 declare ( 1 17 TheBiggestNumberWeveGot float initial (0.1701411834604692317e+39), 1 18 TheSmallestNumberWeveGot float initial (.1469367938527859385e-38), 1 19 Binary bit (1) aligned initial ("1"b) 1 20 ) internal static options (constant); 1 21 1 22 /* Number of characters in a number datum entry; used for copying float number arrays as strings. 1 23* (Obsolete! use array copies!) */ 1 24 1 25 declare NumberSize fixed binary precision (4) internal static initial (8); 1 26 1 27 /* ------ END INCLUDE SEGMENT apl_number_data.incl.pl1 ---------------------------------- */ 629 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 2 2 2 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 2 4 2 5 /* automatic */ 2 6 2 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 2 8 2 9 /* external static */ 2 10 2 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 2 12 2 static_ws_info_ptr unaligned pointer; 2 13 2 14 /* based */ 2 15 2 16 declare 1 ws_info aligned based (ws_info_ptr), 2 17 2 version_number fixed bin, /* version of this structure (3) */ 2 18 2 switches unaligned, /* mainly ws parameters */ 2 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 2 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 2 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 2 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 2 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 2 24 3 restrict_external_functions 2 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 2 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 2 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 2 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 2 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 2 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 2 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 2 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 2 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 2 34 3 compatibility_check_mode 2 35 bit, /* if 1, check for incompatible operators */ 2 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 2 37 /* remaining 20 bits not presently used */ 2 38 2 39 2 values, /* attributes of the workspace */ 2 40 3 digits fixed bin, /* number of digits of precision printed on output */ 2 41 3 width fixed bin, /* line length for formatted output */ 2 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 2 43 3 random_link fixed bin(35), /* seed for random number generator */ 2 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 2 45 3 float_index_origin float, /* the index origin in floating point */ 2 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 2 47 3 maximum_value_stack_size 2 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 2 49 2 50 2 pointers, /* pointers to various internal tables */ 2 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 2 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 2 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 2 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 2 55 2 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 2 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 2 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 2 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 2 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 2 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 2 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 2 63 2 signoff_lock character (32), 2 64 2 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 2 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 2 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 2 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 2 69 bit, /* munging his tables */ 2 70 3 unused_interrupt_bit bit, /* not presently used */ 2 71 3 dont_interrupt_command bit, 2 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 2 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 2 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 2 75 2 76 2 user_name char (32), /* process group id of user */ 2 77 2 immediate_input_prompt char (32) varying, /* normal input */ 2 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 2 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 2 80 2 vcpu_time aligned, 2 81 3 total fixed bin (71), 2 82 3 setup fixed bin (71), 2 83 3 parse fixed bin (71), 2 84 3 lex fixed bin (71), 2 85 3 operator fixed bin (71), 2 86 3 storage_manager fixed bin (71), 2 87 2 output_info aligned, /* data pertaining to output buffer */ 2 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 2 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 2 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 2 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 2 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 2 93 2 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 2 95 2 96 /* internal static */ 2 97 2 98 declare max_parse_stack_depth fixed bin int static init(64536); 2 99 2 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 630 3 1 /* ====== BEGIN INCLUDE FILE apl_save_frame.incl.pl1 =================================== */ 3 2 3 3 declare save_frame_pointer pointer unaligned; 3 4 3 5 declare 1 save_frame aligned based (save_frame_pointer), 3 6 2 last_frame_pointer ptr unal, /* pointer to last parse frame */ 3 7 2 frame_type fixed bin, /* = save_frame_type */ 3 8 2 saved_symbol_count fixed bin (29), /* number of symbols in saved frame */ 3 9 2 symbol_list aligned dimension (total_symbols refer (save_frame.saved_symbol_count)), 3 10 3 symbol_pointer ptr unal, /* pointer to each symbol bead (never null) */ 3 11 3 saved_meaning_pointer ptr unal, /* ptr to local meaning at time save_frame is created */ 3 12 /* (if null, local meaning is null) */ 3 13 3 global_meaning_pointer_pointer /* pointer to the meaning pointer which */ 3 14 ptr unal; /* represents the global meaning of this symbol */ 3 15 /* (if null, either symbol was never localized, */ 3 16 /* or save_frame was created by apl_load_command_,*/ 3 17 /* and saved_meaning_ptr determines whether it */ 3 18 /* was localized) */ 3 19 3 20 /* ------ END INCLUDE FILE apl_save_frame.incl.pl1 ----------------------------------- */ 631 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 4 2 4 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 4 4 2 type unaligned, 4 5 3 bead_type unaligned, 4 6 4 operator bit (1), /* ON if operator bead */ 4 7 4 symbol bit (1), /* ON if symbol bead */ 4 8 4 value bit (1), /* ON if value bead */ 4 9 4 function bit (1), /* ON if function bead */ 4 10 4 group bit (1), /* ON if group bead */ 4 11 4 label bit (1), /* ON if label bead */ 4 12 4 shared_variable bit (1), /* ON if shared variable bead */ 4 13 4 lexed_function bit (1), /* ON if lexed function bead */ 4 14 3 data_type unaligned, 4 15 4 list_value bit (1), /* ON if a list value bead */ 4 16 4 character_value bit (1), /* ON if a character value bead */ 4 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 4 18 4 integral_value bit (1), /* ON if an integral value bead */ 4 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 4 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 4 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 4 22 2 size bit (18) unaligned, /* Number of words this bead occupies 4 23* (used by bead storage manager) */ 4 24 2 reference_count fixed binary (29); /* Number of pointers which point 4 25* to this bead (used by bead manager) */ 4 26 4 27 4 28 /* constant strings for initing type field in various beads */ 4 29 4 30 declare ( 4 31 operator_type init("100000000000000000"b), 4 32 symbol_type init("010000000000000000"b), 4 33 value_type init("001000000000000000"b), 4 34 function_type init("000100000000000000"b), 4 35 group_type init("000010000000000000"b), 4 36 label_type init("001001000011000000"b), 4 37 shared_variable_type init("001000100000000000"b), 4 38 lexed_function_type init("000000010000000000"b), 4 39 4 40 list_value_type init("000000001000000000"b), 4 41 character_value_type init("001000000100000000"b), 4 42 numeric_value_type init("001000000010000000"b), 4 43 integral_value_type init("001000000011000000"b), 4 44 zero_or_one_value_type init("001000000011100000"b), 4 45 complex_value_type init("001000000000010000"b), 4 46 4 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 4 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 4 49 ) bit(18) internal static; 4 50 4 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 632 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 5 2 5 3 /* Explanation of fields: 5 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 5 5* symbol_bead.meaning_pointer points to current "value" of this name: 5 6* = null => unused (e.g. undefined variable) 5 7* -> group bead => group name 5 8* -> value bead => variable with a value 5 9* -> function bead => function name 5 10* -> label bead => localized label value 5 11* -> shared var bead => shared variable */ 5 12 5 13 declare 1 symbol_bead aligned based, 5 14 2 header aligned like general_bead, 5 15 2 hash_link_pointer pointer unaligned, 5 16 2 meaning_pointer pointer unaligned, 5 17 2 name_length fixed binary, 5 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 5 19 5 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 633 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 6 2 6 3 declare 6 4 number_of_dimensions fixed bin, 6 5 6 6 1 value_bead aligned based, 6 7 2 header aligned like general_bead, 6 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 6 9 2 rhorho fixed binary, /* number of dimensions of value */ 6 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 6 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 6 12 /* dimensions of value (zero-origin) */ 6 13 6 14 6 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 6 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 6 17 /* actual elements of character array */ 6 18 6 19 declare character_string_overlay character (data_elements) aligned based; 6 20 /* to overlay on above structure */ 6 21 6 22 6 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 6 24 /* actual elements of numeric array */ 6 25 6 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 6 27 6 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 6 29 6 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 634 7 1 /* BEGIN INCLUDE FILE: apl_group_bead.incl.pl1 */ 7 2 7 3 /* Initial Version: 1973.06.18 7 4* Typed in by: Richard S. Lamson */ 7 5 7 6 7 7 declare 1 group_bead aligned based, /* Group: bead_type.group = "1"b */ 7 8 7 9 2 header aligned like general_bead, 7 10 7 11 2 number_of_members fixed binary, 7 12 7 13 2 member pointer unaligned dimension (0 refer (group_bead.number_of_members)); 7 14 /* Pointer to the symbol bead for each 7 15* member of the group */ 7 16 7 17 /* END INCLUDE FILE apl_group_bead.incl.pl1 */ 635 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 8 2 8 3 /* This bead is used by apl to store the source code for user-defined functions */ 8 4 8 5 declare 1 function_bead aligned based, 8 6 8 7 2 header aligned like general_bead, 8 8 8 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 8 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 8 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 8 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 8 13 2 text_length fixed bin(21), /* length of function text */ 8 14 2 text aligned char(data_elements refer (function_bead.text_length)); 8 15 /* the user's code exactly as typed in */ 8 16 8 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 636 637 638 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1347.3 apl_v1_copy_command_.pl1 >special_ldd>on>apl.1129>apl_v1_copy_command_.pl1 629 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 630 2 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 631 3 03/27/82 0439.1 apl_save_frame.incl.pl1 >ldd>include>apl_save_frame.incl.pl1 632 4 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 633 5 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 634 6 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 635 7 03/27/82 0438.7 apl_group_bead.incl.pl1 >ldd>include>apl_group_bead.incl.pl1 636 8 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.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. addr builtin function dcl 28 ref 169 179 348 580 addrel builtin function dcl 28 ref 350 apl_allocate_words_ 000012 constant entry external dcl 37 ref 340 405 460 apl_create_save_frame_ 000026 constant entry external dcl 37 ref 174 apl_date_time_ 000014 constant entry external dcl 37 ref 210 apl_destroy_save_frame_update_ 000030 constant entry external dcl 37 ref 213 apl_error_table_$cant_load_ws 000010 external static fixed bin(35,0) dcl 33 set ref 146 158* 171* apl_free_bead_ 000016 constant entry external dcl 37 ref 512 apl_function_lex_ 000020 constant entry external dcl 37 ref 442 apl_get_symbol_ 000032 constant entry external dcl 37 ref 293 470 apl_static_$ws_info_ptr 000042 external static structure level 1 dcl 2-11 apl_system_error_ 000022 constant entry external dcl 37 ref 158 171 apl_translate_pathname_$allow_version_one 000024 constant entry external dcl 37 ref 150 baseno builtin function dcl 28 ref 156 555 baseptr builtin function dcl 28 ref 558 bead_pointer 000100 automatic pointer unaligned dcl 55 in procedure "apl_v1_copy_command_" set ref 340* 342 344 345 346 348 354 357 405* 407 409 410 411 412 417 419 421 423 424 427 433 440 442 442 460* 462 464 466 472 bead_pointer 000132 automatic pointer unaligned dcl 504 in procedure "wash" set ref 508* 510 510 512 512* bin builtin function dcl 28 ref 156 550 555 558 558 558 binary builtin function dcl 28 ref 171 541 bit_value based structure level 1 unaligned dcl 246 bitcount 000176 automatic fixed bin(24,0) dcl 55 set ref 154* 553* buckets 1 based structure array level 2 unaligned dcl 67 bv_bead_pointer parameter pointer unaligned dcl 500 ref 495 508 bv_code parameter fixed bin(35,0) dcl 13 set ref 10 146* 150* 151 bv_wsid parameter char unaligned dcl 13 set ref 10 142 150* char4 based char(4) unaligned dcl 576 set ref 580* character_string_overlay based char dcl 6-19 set ref 324 371* character_value based structure level 1 unaligned dcl 246 character_value_type constant bit(18) initial unaligned dcl 4-30 ref 321 chase_names parameter bit(1) dcl 220 ref 216 474 class 3 based fixed bin(17,0) level 2 dcl 8-5 set ref 417* 419* 421* 427* code 000101 automatic fixed bin(35,0) dcl 55 set ref 154* 553* current_parse_frame_ptr 15 based pointer level 3 packed unaligned dcl 2-16 ref 178 data based fixed bin(17,0) array level 2 dcl 67 set ref 169 data_elements 000102 automatic fixed bin(17,0) dcl 55 set ref 310* 318 324 324 330 336 345 362 371 376 383 402* 403 423 data_pointer 4 based pointer level 2 in structure "value_bead" packed unaligned dcl 6-3 in procedure "apl_v1_copy_command_" set ref 354* data_pointer 000100 automatic pointer dcl 226 in procedure "copy" set ref 348* 350 350* 350 354 365 367 371 379 390 divide builtin function dcl 28 ref 539 dname 000106 automatic char(168) unaligned dcl 55 set ref 150* dtm 000171 automatic char(17) unaligned dcl 55 set ref 210* 211* element based fixed bin(35,0) array level 2 in structure "integer_value" dcl 246 in procedure "copy" ref 379 element based bit(1) array level 2 in structure "bit_value" packed unaligned dcl 246 in procedure "copy" ref 365 element based bit(72) array level 2 in structure "float_value" packed unaligned dcl 246 in procedure "copy" ref 390 ename 000160 automatic char(32) unaligned dcl 55 set ref 150* errors_occurred 000102 automatic bit(1) dcl 226 set ref 442* fcbp 000200 automatic pointer dcl 55 set ref 150* 154* 212* 553* float builtin function dcl 28 ref 379 float_value based structure level 1 unaligned dcl 246 free_space_ptr 000202 automatic pointer dcl 55 set ref 179* 442* function_bead based structure level 1 dcl 8-5 set ref 403 function_type constant bit(18) initial unaligned dcl 4-30 ref 409 gb based structure level 1 unaligned dcl 264 general_bead based structure level 1 dcl 4-3 globg 10 based bit(1) level 2 packed unaligned dcl 67 ref 192 595 got 000215 automatic fixed bin(17,0) initial array dcl 67 set ref 67* 156* 552 555* 558 gp 000120 automatic pointer dcl 264 set ref 455* 455* 457 468* 470 470 470 476 476 476 477 477 477 478 478 478 480* 480 group_bead based structure level 1 dcl 7-7 set ref 459 group_type constant bit(18) initial unaligned dcl 4-30 ref 464 hbound builtin function dcl 28 ref 179 high 000104 automatic fixed bin(17,0) dcl 521 set ref 531* 534 535 539 546* hook 000101 automatic fixed bin(17,0) dcl 572 in procedure "copy_symget" set ref 583* 583* 584* hook 000103 automatic fixed bin(17,0) dcl 55 in procedure "apl_v1_copy_command_" set ref 183* 183* 184* i 000100 automatic fixed bin(17,0) dcl 572 in procedure "copy_symget" set ref 580 581* 581 583 i 000214 automatic fixed bin(17,0) dcl 67 in procedure "apl_v1_copy_command_" set ref 181* 183* i 000112 automatic fixed bin(17,0) dcl 264 in procedure "copy" set ref 356* 357 357* 362* 362* 365 365 367* 376* 376* 379 379* 383* 383* 390 390* 469* 472* i 000100 automatic fixed bin(17,0) dcl 521 in procedure "copy_expand" set ref 541* 543 545 550* 552 553 555 558 in_length 000104 automatic fixed bin(17,0) dcl 226 set ref 429* 431 432 437* 437 in_start 000103 automatic fixed bin(17,0) dcl 226 set ref 428* 432 433 436* 436 index builtin function dcl 28 ref 198 432 integer_value based structure level 1 unaligned dcl 246 integral_value_type constant bit(18) initial unaligned dcl 4-30 ref 327 ioa_$ioa_stream 000034 constant entry external dcl 49 ref 144 163 208 211 610 l 3 based fixed bin(17,0) level 2 dcl 264 ref 470 470 476 476 477 477 478 478 len 1 based fixed bin(17,0) level 3 dcl 67 ref 161 169 169 210 531 541 541 550 558 558 length builtin function dcl 28 in procedure "apl_v1_copy_command_" ref 199 208 429 585 606 608 608 616 617 617 length 5 based fixed bin(17,0) level 2 in structure "sb" dcl 67 in procedure "apl_v1_copy_command_" ref 192 192 585 lexed_function_bead_pointer 2 based pointer level 2 packed unaligned dcl 8-5 set ref 410* 442* line 000235 automatic varying char(131) dcl 67 set ref 167* 208 208* 606 606* 608 610* 612* 616* 616 616 617 620* 620 line_length 000105 automatic fixed bin(17,0) dcl 226 set ref 432* 433 433 435 436 437 low 000105 automatic fixed bin(17,0) dcl 521 set ref 532* 534 539 545* meaning_pointer 3 based pointer level 2 packed unaligned dcl 5-13 set ref 295 302* 342* 407* 462* member 3 based pointer array level 2 packed unaligned dcl 7-7 set ref 472* mod builtin function dcl 28 ref 581 616 msf_manager_$close 000036 constant entry external dcl 49 ref 212 msf_manager_$get_ptr 000040 constant entry external dcl 49 ref 154 553 n 2 based fixed bin(17,0) level 2 in structure "vb" dcl 264 in procedure "copy" ref 310 n 4 based char level 2 in structure "gb" packed unaligned dcl 264 in procedure "copy" set ref 470* 476* 477* 478* n_words 000170 automatic fixed bin(18,0) dcl 55 set ref 318* 324* 330* 336* 338* 338 340* 403* 405* 459* 460* name parameter char unaligned dcl 568 in procedure "copy_symget" ref 563 580 585 name parameter char unaligned dcl 603 in procedure "not_copied" ref 601 608 617 620 name parameter char unaligned dcl 220 in procedure "copy" set ref 216 293* 299* 484 name_length 000104 automatic fixed bin(17,0) dcl 55 set ref 198* 199 199* 202 202 203 203 205 205 name_number 000105 automatic fixed bin(17,0) dcl 55 set ref 197* 198 199 202 202 203 203 205 205* names parameter char array unaligned dcl 13 ref 10 198 199 202 202 203 203 205 205 new based structure array level 3 packed unaligned dcl 67 nl constant char(1) initial dcl 238 ref 432 nq 2 based fixed bin(17,0) level 2 in structure "gb" dcl 264 in procedure "copy" set ref 455 457* 480* nq 2 based fixed bin(17,0) level 2 in structure "sb" dcl 67 in procedure "apl_v1_copy_command_" ref 195 587 nq 5 based fixed bin(17,0) level 2 in structure "ub" dcl 67 in procedure "apl_v1_copy_command_" set ref 188 189* 592 593* null builtin function dcl 28 ref 155 203 295 410 411 412 477 529 554 588 590 597 number 2 based fixed bin(17,0) level 2 dcl 246 ref 371 number_of_dimensions 000305 automatic fixed bin(17,0) dcl 6-3 set ref 311* 338 346 348 356 number_of_groupies 000106 automatic fixed bin(17,0) dcl 226 set ref 454* 456* 456 459 466 469 472 number_of_members 2 based fixed bin(17,0) level 2 dcl 7-7 set ref 466* number_of_names parameter fixed bin(17,0) dcl 13 ref 10 181 197 numeric_datum based float bin(63) array dcl 6-23 set ref 318 330 336 365* 367* 379* 390* numeric_value_type constant bit(18) initial unaligned dcl 4-30 ref 333 350 old based structure array level 3 packed unaligned dcl 67 out_start 000107 automatic fixed bin(17,0) dcl 226 set ref 430* 433 435* 435 440 p 000204 automatic pointer dcl 55 set ref 184* 185 187 192 192 192 195 584* 585 587 590 592* 592 592* 593 595 595 p_nllines 15 based fixed bin(17,0) level 2 dcl 122 ref 415 p_nschars 13 based fixed bin(17,0) level 2 dcl 122 ref 402 424 429 432 433 p_sourceq 12 based fixed bin(17,0) level 2 dcl 122 set ref 413* password based char(8) level 2 in structure "seg" dcl 67 in procedure "apl_v1_copy_command_" ref 161 password parameter char unaligned dcl 13 in procedure "apl_v1_copy_command_" ref 10 161 pb based structure level 1 unaligned dcl 122 pointers 14 based structure level 2 dcl 2-16 pp 000206 automatic pointer dcl 55 set ref 400* 402 413 415 424 429 432 433 prime based fixed bin(17,0) level 2 dcl 67 ref 171 181 581 protected parameter bit(1) unaligned dcl 13 ref 10 297 ptr builtin function dcl 28 ref 558 q 2 based fixed bin(17,0) array level 3 in structure "symtab" dcl 67 in procedure "apl_v1_copy_command_" ref 183 583 q parameter pointer dcl 220 in procedure "copy" ref 216 305 307 308 396 396 398 400 417 419 447 449 455 468 q 000210 automatic pointer dcl 55 in procedure "apl_v1_copy_command_" set ref 187* 188 189* 189 192 192* 202* 203 205* r 4 based fixed bin(17,0) array level 2 dcl 264 ref 357 reference_count 1 based fixed bin(29,0) level 2 dcl 4-3 set ref 488 510* 510 512 rel based bit(18) array level 4 in structure "seg" packed unaligned dcl 67 in procedure "apl_v1_copy_command_" ref 558 rel builtin function dcl 28 in procedure "apl_v1_copy_command_" ref 171 350 rel based bit(18) array level 4 in structure "seg" packed unaligned dcl 67 in procedure "apl_v1_copy_command_" ref 541 558 rho 5 based fixed bin(21,0) array level 2 dcl 6-3 set ref 348 357* rhorho 3 based fixed bin(17,0) level 2 in structure "float_value" dcl 246 in procedure "copy" ref 390 rhorho 3 based fixed bin(17,0) level 2 in structure "integer_value" dcl 246 in procedure "copy" ref 379 rhorho 3 based fixed bin(17,0) level 2 in structure "value_bead" dcl 6-3 in procedure "apl_v1_copy_command_" set ref 346* rhorho 3 based fixed bin(17,0) level 2 in structure "bit_value" dcl 246 in procedure "copy" ref 365 rhorho 3 based fixed bin(17,0) level 2 in structure "character_value" dcl 246 in procedure "copy" ref 371 rr 3 based fixed bin(17,0) level 2 dcl 264 ref 311 save_frame based structure level 1 dcl 3-5 save_frame_pointer 000304 automatic pointer unaligned dcl 3-3 set ref 178* 179 179 saved_symbol_count 2 based fixed bin(29,0) level 2 dcl 3-5 ref 179 sb based structure level 1 unaligned dcl 264 in procedure "copy" sb based structure level 1 unaligned dcl 67 in procedure "apl_v1_copy_command_" seg based bit(9) array level 4 in structure "seg" packed unaligned dcl 67 in procedure "apl_v1_copy_command_" ref 541 seg based bit(9) array level 4 in structure "seg" packed unaligned dcl 67 in procedure "apl_v1_copy_command_" ref 550 seg based structure level 1 dcl 67 in procedure "apl_v1_copy_command_" segptr 000212 automatic pointer dcl 55 set ref 154* 155 156 158 161 161 169 169 169 169 210 210 531 531 541 541 541 541 550 550 558 558 558 558 size builtin function dcl 28 ref 318 324 330 336 338 403 459 source 1 based char level 2 packed unaligned dcl 264 ref 424 429 432 433 sptr 000102 automatic pointer dcl 521 set ref 553* 554 555 static_ws_info_ptr 000042 external static pointer level 2 packed unaligned dcl 2-11 ref 2-7 stop_control_pointer 4 based pointer level 2 packed unaligned dcl 8-5 set ref 411* string 6 based char level 2 in structure "sb" packed unaligned dcl 67 in procedure "apl_v1_copy_command_" set ref 192* string based char level 2 in structure "character_value" packed unaligned dcl 246 in procedure "copy" ref 371 string builtin function dcl 234 in procedure "copy" set ref 344* 409* 464* substr builtin function dcl 28 set ref 202 202 203 203 205 205 350 432 433* 433 558 616 symbol_bead based structure level 1 dcl 5-13 symbol_list 3 based structure array level 2 dcl 3-5 set ref 179 179 symbol_pointer 000110 automatic pointer unaligned dcl 226 set ref 293* 295 302 342 407 462 470* 472 488 488* symp 000300 automatic pointer dcl 67 set ref 169* 171 171 181 183 581 583 symtab based structure level 1 unaligned dcl 67 t 1 based fixed bin(17,0) level 2 in structure "ub" dcl 67 in procedure "apl_v1_copy_command_" ref 305 396 396 417 419 447 t 1 based fixed bin(17,0) level 2 in structure "vb" dcl 264 in procedure "copy" ref 313 360 table based structure array level 2 packed unaligned dcl 67 tablen based fixed bin(17,0) level 2 dcl 67 ref 169 531 text 7 based char level 2 dcl 8-5 set ref 424* 433* 442* text_length 6 based fixed bin(21,0) level 2 dcl 8-5 set ref 423* 424 433 440* 442 442 time_saved based fixed bin(71,0) level 2 dcl 67 set ref 210* tm_dfn constant fixed bin(17,0) initial dcl 264 ref 396 tm_group constant fixed bin(17,0) initial dcl 264 ref 447 tm_mfn constant fixed bin(17,0) initial dcl 264 ref 419 tm_var constant fixed bin(17,0) initial dcl 264 ref 305 tm_zfn constant fixed bin(17,0) initial dcl 264 ref 396 417 total_data_elements 2 based fixed bin(21,0) level 2 dcl 6-3 set ref 345* trace_control_pointer 5 based pointer level 2 packed unaligned dcl 8-5 set ref 412* translate builtin function dcl 28 ref 371 433 try 000106 automatic fixed bin(17,0) dcl 521 set ref 535* 539* 541 541 545 546 550 558 558 type based fixed bin(17,0) level 2 in structure "seg" dcl 67 in procedure "apl_v1_copy_command_" ref 158 type based structure level 2 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_v1_copy_command_" set ref 344* 409* 464* type 000111 automatic bit(18) dcl 226 in procedure "copy" set ref 315* 321* 327* 333* 344 350 type_of_ws constant fixed bin(17,0) initial dcl 67 ref 158 ub based structure level 1 unaligned dcl 67 unspec builtin function dcl 28 set ref 390* 558 uq 4 based fixed bin(17,0) level 2 dcl 67 set ref 185 187* 590 592* v1_codes 000013 constant char(10) initial dcl 238 ref 371 433 v2_codes 000010 constant char(10) initial dcl 238 ref 371 433 val parameter fixed bin(17,0) dcl 521 ref 519 529 543 545 558 value_bead based structure level 1 dcl 6-3 set ref 338 values 2 based structure level 2 dcl 2-16 vb based structure level 1 unaligned dcl 264 version 1 based structure level 2 dcl 67 vp 000114 automatic pointer dcl 264 set ref 308* 310 311 313 357 360 365 371 371 379 390 413* 424 429 432 433 vp1 000116 automatic pointer dcl 264 set ref 476* 477 478* vq 3 based fixed bin(17,0) level 2 dcl 67 set ref 307 308* 398 400* 449 455* 468* width 3 based fixed bin(17,0) level 3 dcl 2-16 ref 608 617 ws_info based structure level 1 dcl 2-16 ws_info_ptr 000302 automatic pointer initial dcl 2-7 set ref 178 2-7* 608 617 zero_or_one_value_type constant bit(18) initial unaligned dcl 4-30 ref 315 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Binary internal static bit(1) initial dcl 1-16 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 6-28 NumberSize internal static fixed bin(4,0) initial dcl 1-25 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 char builtin function dcl 28 character_data_structure based structure level 1 dcl 6-15 complex_datum based complex float bin(63) array dcl 6-26 complex_value_type internal static bit(18) initial unaligned dcl 4-30 csize internal static fixed bin(17,0) initial array dcl 67 label_type internal static bit(18) initial unaligned dcl 4-30 lexed_function_type internal static bit(18) initial unaligned dcl 4-30 list_value_type internal static bit(18) initial unaligned dcl 4-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 2-98 not_integer_mask internal static bit(18) initial unaligned dcl 4-30 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 4-30 operator_type internal static bit(18) initial unaligned dcl 4-30 output_buffer based char unaligned dcl 2-94 shared_variable_type internal static bit(18) initial unaligned dcl 4-30 string builtin function dcl 28 symbol_type internal static bit(18) initial unaligned dcl 4-30 value_type internal static bit(18) initial unaligned dcl 4-30 vb1 based structure level 1 unaligned dcl 264 wsid automatic varying char(168) dcl 67 NAMES DECLARED BY EXPLICIT CONTEXT. apl_v1_copy_command_ 000100 constant entry external dcl 10 copy 001075 constant entry internal dcl 216 ref 192 205 478 copy_data 000004 constant label array(4) dcl 362 ref 360 copy_expand 002302 constant entry internal dcl 519 ref 184 187 189 308 400 413 455 457 468 480 584 592 593 copy_symget 002564 constant entry internal dcl 563 ref 202 476 end_copy_data 001471 constant label dcl 393 ref 369 374 381 end_get_type 001254 constant label dcl 338 set ref 319 325 331 found 002646 constant label dcl 590 in procedure "copy_symget" ref 585 found 002420 constant label dcl 550 in procedure "copy_expand" ref 536 543 get_type 000000 constant label array(4) dcl 315 ref 313 loop 002331 constant label dcl 534 ref 548 not_copied 002717 constant entry internal dcl 601 ref 203 299 477 484 not_found 000151 constant label dcl 144 ref 151 155 554 ok 003034 constant label dcl 620 ref 613 prt_line 002747 constant label dcl 610 ref 617 wash 002252 constant entry internal dcl 495 ref 302 488 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3536 3602 3266 3546 Length 4170 3266 44 351 250 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_v1_copy_command_ 248 external procedure is an external procedure. copy 136 internal procedure is called during a stack extension. wash internal procedure shares stack frame of internal procedure copy. copy_expand 89 internal procedure is called by several nonquick procedures. copy_symget 76 internal procedure is called during a stack extension. not_copied 84 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_v1_copy_command_ 000100 bead_pointer apl_v1_copy_command_ 000101 code apl_v1_copy_command_ 000102 data_elements apl_v1_copy_command_ 000103 hook apl_v1_copy_command_ 000104 name_length apl_v1_copy_command_ 000105 name_number apl_v1_copy_command_ 000106 dname apl_v1_copy_command_ 000160 ename apl_v1_copy_command_ 000170 n_words apl_v1_copy_command_ 000171 dtm apl_v1_copy_command_ 000176 bitcount apl_v1_copy_command_ 000200 fcbp apl_v1_copy_command_ 000202 free_space_ptr apl_v1_copy_command_ 000204 p apl_v1_copy_command_ 000206 pp apl_v1_copy_command_ 000210 q apl_v1_copy_command_ 000212 segptr apl_v1_copy_command_ 000214 i apl_v1_copy_command_ 000215 got apl_v1_copy_command_ 000235 line apl_v1_copy_command_ 000300 symp apl_v1_copy_command_ 000302 ws_info_ptr apl_v1_copy_command_ 000304 save_frame_pointer apl_v1_copy_command_ 000305 number_of_dimensions apl_v1_copy_command_ copy 000100 data_pointer copy 000102 errors_occurred copy 000103 in_start copy 000104 in_length copy 000105 line_length copy 000106 number_of_groupies copy 000107 out_start copy 000110 symbol_pointer copy 000111 type copy 000112 i copy 000114 vp copy 000116 vp1 copy 000120 gp copy 000132 bead_pointer wash copy_expand 000100 i copy_expand 000102 sptr copy_expand 000104 high copy_expand 000105 low copy_expand 000106 try copy_expand copy_symget 000100 i copy_symget 000101 hook copy_symget THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return tra_ext mod_fx1 shorten_stack ext_entry_desc int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_allocate_words_ apl_create_save_frame_ apl_date_time_ apl_destroy_save_frame_update_ apl_free_bead_ apl_function_lex_ apl_get_symbol_ apl_system_error_ apl_translate_pathname_$allow_version_one ioa_$ioa_stream msf_manager_$close msf_manager_$get_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$cant_load_ws apl_static_$ws_info_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000072 67 000125 2 7 000137 142 000142 144 000151 146 000177 147 000203 150 000204 151 000235 154 000240 155 000264 156 000270 158 000274 161 000305 163 000322 164 000351 167 000352 169 000353 171 000371 174 000411 178 000416 179 000421 181 000426 183 000441 184 000450 185 000460 187 000463 188 000473 189 000477 190 000507 192 000510 195 000541 196 000545 197 000550 198 000557 199 000604 202 000610 203 000633 205 000675 206 000744 208 000747 210 001001 211 001025 212 001057 213 001066 214 001073 216 001074 293 001110 295 001132 297 001136 299 001146 300 001161 302 001162 305 001170 307 001176 308 001200 310 001211 311 001215 313 001217 315 001221 318 001223 319 001227 321 001230 324 001232 325 001236 327 001237 330 001241 331 001245 333 001246 336 001250 338 001254 340 001257 342 001270 344 001274 345 001277 346 001301 348 001303 350 001305 354 001316 356 001317 357 001325 358 001333 360 001335 362 001340 365 001346 367 001367 368 001374 369 001376 371 001377 374 001415 376 001417 379 001424 380 001440 381 001442 383 001443 390 001450 391 001467 393 001471 396 001472 398 001476 400 001500 402 001512 403 001516 405 001522 407 001533 409 001537 410 001542 411 001544 412 001546 413 001550 415 001562 417 001566 419 001600 421 001606 423 001611 424 001614 425 001622 427 001623 428 001625 429 001627 430 001631 431 001633 432 001637 433 001652 435 001661 436 001662 437 001665 438 001671 440 001672 442 001677 445 001734 447 001735 449 001737 454 001741 455 001743 456 001757 457 001760 459 001772 460 001776 462 002007 464 002013 466 002016 468 002020 469 002034 470 002043 472 002071 474 002100 476 002104 477 002125 478 002147 480 002176 481 002210 482 002212 484 002213 488 002242 491 002251 495 002252 508 002254 510 002263 512 002266 515 002300 519 002301 529 002307 531 002315 532 002327 534 002331 535 002334 536 002335 539 002336 541 002341 543 002404 545 002407 546 002414 548 002417 550 002420 552 002446 553 002450 554 002476 555 002505 558 002513 563 002563 580 002577 581 002604 583 002611 584 002620 585 002632 587 002637 588 002642 590 002646 592 002654 593 002672 595 002704 597 002712 601 002716 606 002732 608 002742 610 002747 612 003000 613 003006 616 003007 617 003030 620 003034 622 003051 ----------------------------------------------------------- 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