COMPILATION LISTING OF SEGMENT apl_parse_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 02/06/85 1132.9 mst Wed Options: optimize list 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* format: style3 */ 11 apl_parse_: 12 procedure; 13 14 /* This routine sets up a suspended frame on the parse stack, and 15* runs apl. 16* 17* Initially written July 1973 by Dan Bricklin */ 18 19 /* Modified 26 January 1974 by PG to handle "finish" and "error" conditions. 20* Modified 740131 by PG to fix bugs. 21* Modified 740226 by PG to add QuadIT, QuadEC, and QuadAF. 22* Modified 740307 by PG to change call to apl_editor_, and to validate number of args in function calls. 23* Modified 740624 by PG to fix assign to copy rho vector in inline case, fix stop/trace to not bomb out 24* if given bad function name, initialize operators_argument before calling external functions, 25* fix niladic external functions to work, to do a resetread & resetwrite after a quit, 26* and to call the format operator. 27* Modified 740829 by PG to fix assign to not copy rho vector if rhorho is zero, move resetread & resetwrite 28* into the dim, and trap the record_quota_overflow condition. 29* Modified 751231 by PG to fix setup_monadic to clear the left opnd on_stack bit so lazy operators won't get confused. 30* Modified 760413 by PG to fix "(OP VAL RE" reduction to stop marking return value as being on the value stack, 31* so "(FCN VAL RE" would work (return value is in heap). 32* Modified 760914 by PG to make setup_(monadic dyadic)_operator_routine_call quick, and to fix bug 241 33* that had caused trace output to be surpressed for lines that contained function calls. 34* Modified 761011 by PG for new parse_frame declaration (first step in flushing excessive use of addr). 35* Modified 770120 by PG to experiment with reverting user_input back to user_i/o if user quits. 36* Modified 770121 by PG to get QUITs to work if user is &attached to an exec_com. 37* Modified 770204 by PG to get all cases of assignment to handle reference counts properly, fixing bug 38* 264 (RQO during case 3 of assignment gives ref count errors), and an unnumbered bug that 39* left the values of labels around after the function was freed. 40* Modified 770222 by PG to fix bug 232 (ref count of params too high) that was caused by the function 41* call/return code forgetting to wash the rs.semantics ptr(s) that pointed to the arguments. 42* Modified 770225 by PG to allow operators and external functions to just return with operators_argument.error_code 43* set to a non-zero value, instead of forcing them to signal apl_operator_error_. 44* Modified 770310 by PG to fix bug 251 ('FOO';A-<1 wouldn't cause mixed output). 45* Modified 770315 by PG to cleanup handling of buffer for input line. 46* Modified 770317 by PG to get latent expression executed when ws is auto-loaded (bug 156), 47* and handle multi-line input correctly (bug 148). 48* Modified 770322 by PG to fix bug in handling of depth error (bug 223). 49* Modified 771104 by PG to fix decrement_reference_count to null its argument in all cases, thus fixing (I hope) 50* bug 290 and all of the reference count errors that happen after a RQO. Also changed all calls 51* to apl_copy_value_ so that dont_interrupt_parse flag is off during the call. 52* Modified 771121 by PG to cleanup handling of system errors generated by the parse itself, and to change the 53* underflow handler to work with the current fim. 54* Modified 780403 by PG to fix bug 239 (permit _ei0), and to fix bug 296 whereby latent expression could not 55* always be executed if the SI was left uninitialized by )LOAD. 56* Modified 780426 by Bill York to fix bug 283 (Assigning to a function causes a non_in_read_bracket fault) 57* by initializing some rs state bits. 58* Modified 780504 by PG to add diamond processing 59* Modified 780927 by PG to fix default handler to pull current instruction out of executing segment, 60* instead of trusting unreliable SCU data, to cleanup diamond implementation, to implement 61* branches out of diamond lines and mixed-output lines (bug 333), and to reattach user_input to 62* user_i/o if EOF is discovered while reading input lines. 63* Modified 781102 by PG to fix 349 (branch out of diamond-lines was always taken!), 64* and to eliminate the prompt for multi-line quoted strings (sugg 350). 65* Modified 781106 by PG to add argument list processing. 66* Modified 781108 by PG to perform read_back_spaces order on user_i/o, to 67* fix problem whereby using &attach caused apl to run in read_back_input mode forever. 68* Modified 781118 by PG to have successful branch abort mixed output for the 69* containing line, unless the line is being traced. 70* Modified 790209 by WMY to add (monadic dyadic)_action (9) for file system functions. 71* Modified 790212 by WMY to add separate call for niladic file system functions. 72* Modified 790305 by WMY to check for the monadic laminate case, and cause a 73* context error if it occurs. 74* Modified 790326 by WMY to handle functions with no body, just a header (bug 388). 75* Modified 790523 by WMY to fix bug 88 (!), automatic saving of continue workspaces 76* on a hangup doesn't work. Bug was put on list 731013!! 77* Modified 790917 by PG to eliminate handling of apl_operator_error_ (obsolete), and to interface 78* to new apl_print_value_. 79* Modified 791023 by PG to let the FIM perform all of the modifications to the machine conditions for 80* underflow, since the 34-9 (MR8.0) FIM does it right. 81* Modified 800129 by PG to implement localized system variables. 82* Modified 800204 by PG to change execute of an assignment print nothing. 83* Modified 800206 by BIM to make branches inside of execute(s) work (bug 452). 84* Modified 800226 by PG to switch to iox_. 85* Modified 810125 by WMY to fix bug 480, depending on order of evaluation in 86* a statement can cause a reference through a null pointer. 87* Modified 810528 by WMY to fix the above fix (misplaced end statement) 88* Modified 811211 by HH to add 'qCALL' system function. 89* Modified 811211 by HH to correctly handle expressions left of argument list semicolons. 90* Modified 841022 by WAAnderson to fix diamond line storage cleanup. 91**/ 92 93 /* automatic */ 94 95 declare assignment_done bit (1) aligned, 96 branch_pf_ptr ptr, /* ptr to "parent" of execute frame, used by branch */ 97 input_buffer_ptr ptr, 98 input_line_position fixed bin (21), 99 max_input_line fixed bin (21), 100 n_underflows fixed bin, 101 scan_token_type fixed bin, 102 temp18 bit (18) aligned, 103 trace_branch_line bit (1) aligned, /* ON when result of branch is traced */ 104 was_branch bit (1) aligned, /* ON if branch seen on this line */ 105 was_branch_value bit (1) aligned, /* ON if branch had non-null operand */ 106 (x, xx) float; /* temporaries for fuzz computations */ 107 108 /* based */ 109 110 declare 1 input_buffer aligned based (input_buffer_ptr), 111 2 n_read fixed bin (21), 112 2 line char (max_input_line refer (input_buffer.n_read)) unaligned; 113 114 /* internal static initial */ 115 116 declare read_back_spaces_order 117 char (16) initial ("read_back_spaces") internal static options (constant); 118 119 /* conditions */ 120 121 declare (apl_dirty_stop_, apl_quit_) 122 condition; 123 124 /* builtins */ 125 126 declare (abs, addr, addrel, binary, divide, fixed, floor, length, max, null, rel, size, string, substr, unspec, verify) 127 builtin; 128 129 /* Multics entries */ 130 131 declare timer_manager_$alarm_call 132 entry (fixed bin (71), bit (2), entry), 133 timer_manager_$reset_alarm_call 134 entry (entry), 135 condition_ entry (char (*), entry), 136 cu_$ptr_call entry (ptr, 1 aligned like operators_argument), 137 iox_$attach_ptr entry (ptr, char (*), ptr, fixed bin (35)), 138 iox_$close entry (ptr, fixed bin (35)), 139 iox_$control entry (ptr, char (*), ptr, fixed bin (35)), 140 iox_$detach_iocb entry (ptr, fixed bin (35)), 141 iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 142 iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 143 144 /* APL entries */ 145 146 declare (apl_dyadic_, apl_dyadic_format_, apl_inner_product_, apl_monadic_, apl_monadic_format_, apl_monadic_not_, 147 apl_outer_product_, apl_reduction_, apl_scan_operator_, apl_subscript_a_value_) 148 entry (1 aligned like operators_argument); 149 150 declare apl_editor_ entry (char (*), fixed bin (21), fixed bin (35)), 151 apl_flush_buffer_nl_ 152 entry (), 153 apl_print_value_ entry (ptr unal, bit (1) aligned, bit (1) aligned), 154 apl_print_string_ entry (char (*)), 155 apl_scan_ entry (char (*), fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, unaligned pointer), 156 apl_subscripted_assignment_ 157 entry (1 aligned like operators_argument, ptr); 158 159 /* external static */ 160 161 declare ( 162 apl_static_$apl_input, 163 apl_static_$apl_output, 164 iox_$user_input, 165 iox_$user_io 166 ) ptr external static; 167 168 declare ( 169 apl_error_table_$not_end_with_value, 170 apl_error_table_$cant_read_input, 171 apl_error_table_$pull_system_error, 172 apl_error_table_$pull_assign_system_error, 173 apl_error_table_$report_error_system_error, 174 apl_error_table_$done_line_system_error, 175 apl_error_table_$ws_full_no_quota, 176 apl_error_table_$improper_niladic_usage, 177 apl_error_table_$too_much_input, 178 apl_error_table_$locked_function_error, 179 apl_error_table_$assign_to_value, 180 apl_error_table_$super_dirty_stop, 181 apl_error_table_$interrupt, 182 apl_error_table_$cant_get_stop_trace, 183 apl_error_table_$depth, 184 apl_error_table_$ws_cleared, 185 apl_error_table_$ws_loaded, 186 apl_error_table_$return_from_apl, 187 apl_error_table_$execute, 188 apl_error_table_$bad_execute, 189 apl_error_table_$bad_evaluated_input, 190 apl_error_table_$assign_to_label, 191 apl_error_table_$bad_assignment, 192 apl_error_table_$rank, 193 apl_error_table_$operator_subscript_range, 194 apl_error_table_$context, 195 apl_error_table_$improper_monadic_usage, 196 apl_error_table_$improper_dyadic_usage, 197 apl_error_table_$domain, 198 apl_error_table_$value, 199 error_table_$end_of_info, 200 error_table_$not_closed, 201 error_table_$short_record 202 ) fixed bin (35) external static; 203 204 /* declarations */ 205 206 dcl parse_frame_ptr ptr, 207 diamond_temp fixed bin init(0), 208 tmp_parseme fixed bin, 209 rsp ptr, 210 have_a_line bit (1), /* "1"b means OK to print line in error message */ 211 in_printer bit (1), /* "1"b means interrupt terminates printing */ 212 current_parseme fixed bin, 213 current_lexeme fixed bin, 214 lexed_function_bead_ptr 215 ptr, 216 based_unaligned_ptr based unaligned ptr, 217 operator_ptr ptr, 218 execute_value_ptr ptr, 219 where_execute_error fixed bin, 220 apl_error_ entry (fixed bin (35), bit (36) aligned, fixed bin, char (*), ptr unaligned, fixed bin), 221 was_error bit (1) aligned, 222 apl_line_lex_ entry (char (*), ptr unaligned, bit (1) aligned, fixed bin, ptr), 223 apl_execute_lex_ entry (char (*) aligned, ptr unaligned, bit (1) aligned, fixed bin, ptr), 224 apl_function_lex_ entry (char (*) aligned, ptr unaligned, bit (1) aligned, fixed bin, ptr), 225 apl_function_lex_no_messages_ 226 entry (char (*) aligned, ptr unaligned, bit (1) aligned, fixed bin, ptr, fixed bin), 227 apl_command_ entry (char (*), fixed bin (21), fixed bin (35)), 228 apl_monadic_iota_ entry (1 aligned like operators_argument), 229 apl_monadic_rho_ entry (1 aligned like operators_argument), 230 apl_copy_value_ entry (ptr unaligned, ptr unaligned), 231 apl_dyadic_epsilon_ entry (1 aligned like operators_argument), 232 apl_encode_ entry (1 aligned like operators_argument), 233 apl_decode_ entry (1 aligned like operators_argument), 234 apl_ibeam_ entry (1 aligned like operators_argument), 235 apl_dyadic_ibeam_ entry (1 aligned like operators_argument), 236 apl_system_variables_ 237 entry (1 aligned like operators_argument), 238 apl_system_functions_ 239 entry (1 aligned like operators_argument), 240 apl_file_system_ entry (1 aligned like operators_argument), 241 apl_file_system_$niladic_functions 242 entry (1 aligned like operators_argument), 243 apl_dyadic_iota_ entry (1 aligned like operators_argument), 244 apl_take_ entry (1 aligned like operators_argument), 245 apl_drop_ entry (1 aligned like operators_argument), 246 apl_ravel_ entry (1 aligned like operators_argument), 247 apl_catenate_ entry (1 aligned like operators_argument), 248 apl_laminate_ entry (1 aligned like operators_argument), 249 apl_dyadic_rho_ entry (1 aligned like operators_argument), 250 apl_domino_operator_ 251 entry (1 aligned like operators_argument), 252 apl_compression_ entry (1 aligned like operators_argument), 253 apl_expansion_ entry (1 aligned like operators_argument), 254 apl_reverse_ entry (1 aligned like operators_argument), 255 apl_rotate_ entry (1 aligned like operators_argument), 256 apl_transpose_ entry (1 aligned like operators_argument), 257 apl_random_ entry (1 aligned like operators_argument), 258 apl_grade_up_ entry (1 aligned like operators_argument), 259 apl_grade_down_ entry (1 aligned like operators_argument), 260 apl_quadcall_ entry (1 aligned like operators_argument), 261 apl_external_fcn_addr_ 262 entry (char (*) aligned, ptr unaligned), 263 external_function_ptr 264 ptr, 265 symbol_ptr_unal ptr unaligned, 266 meaning_ptr_unal ptr unaligned, 267 temp_ptr ptr, 268 value_bead_ptr ptr, 269 data_elements fixed bin, 270 start fixed bin, 271 put_result fixed bin, 272 return_point fixed bin, 273 number_of_arguments fixed bin, 274 print_final_value bit (1) aligned, 275 code fixed bin (35), 276 error_mark_structure_ptr 277 ptr unaligned, 278 ok_to_stop_control bit (1), 279 apl_free_bead_ entry (ptr unaligned), 280 i fixed bin, 281 packed_temp_ptr ptr unaligned, 282 ptr_to_returned_value 283 ptr, 284 bits_for_returned_value 285 bit (36) aligned, 286 number_of_non_labels 287 fixed bin, 288 monadic_table (0:124) fixed bin int static init ((21) 1, 289 /* 0-20 monadic scalar operators */ 290 (15) 1, /* 21-35 unused */ 291 24, /* 36 rho */ 292 4, /* 37 comma */ 293 23, /* 38 iota */ 294 (2) 1, /* 39-40 take, drop (not monadic) */ 295 27, /* 41 grade up */ 296 28, /* 42 grade down */ 297 (2) 1, /* 43-44 compress, expand last (not monadic) */ 298 11, /* 45 reverse-last */ 299 (2) 1, /* 46-47 compress, expand first (not monadic) */ 300 12, /* 48 reverse-first */ 301 13, /* 49 transpose */ 302 (3) 1, /* 50-52 epsilon, decode, encode (not monadic) */ 303 14, /* 53 execute */ 304 15, /* 54 format */ 305 16, /* 55 i-beam */ 306 10, /* 56 not */ 307 26, /* 57 roll */ 308 (9) 21, /* 58-66 system functions */ 309 3, /* 67 branch */ 310 25, /* 68 domino */ 311 21, /* 69 QuadSVR system function */ 312 21, /* 70 QuadEC system function */ 313 21, /* 71 QuadAF system function */ 314 1, /* 72 semicolon cons (dyadic only) */ 315 (4) 1, /* 73-76 dyadic file system functions */ 316 9, /* 77 qFDROP file system function */ 317 1, /* 78 qFERASE dyadic file system function */ 318 9, /* 79 qFHOLD file system function */ 319 9, /* 80 qFLIB file system function */ 320 9, /* 81 qFLIM file system function */ 321 9, /* 82 qFLISTACL file system function */ 322 (2) 1, /* 83-84 niladic file system functions */ 323 9, /* 85 qFRDCI file system function */ 324 9, /* 86 qFREAD file system function */ 325 (3) 1, /* 87-89 dyadic file system functions */ 326 9, /* 90 qFSIZE */ 327 (2) 1, /* 91-92 dyadic file system functions */ 328 29, /* 93 laminate (dyadic only) */ 329 5, /* 94 reduction last */ 330 6, /* 95 reduction first */ 331 7, /* 96 scan last */ 332 8, /* 97 scan first */ 333 1, /* 98 outer product */ 334 2, /* 99 invoke function */ 335 1, /* 100 stop control */ 336 1, /* 101 trace control */ 337 1, /* 102 assignment */ 338 1, /* 103 subscripted assignment */ 339 17, /* 104 quad gets */ 340 18, /* 105 quad-quote gets */ 341 (6) 19, /* 106-111 assign to system variable */ 342 (2) 22, /* 112-113 assign to stop/trace */ 343 20, /* 114 assign to system variable which ignores assignment */ 344 (5) 1, /* 115-119 ignore */ 345 19, /* 120 QuadIT system variable */ 346 9, /* 121 qFUNTIE file system function */ 347 1, /* 122 catenate first (dyadic only) */ 348 30, /* 123 qCALL system function */ 349 1), /* 124 qCALL semicolon (dyadic only) */ 350 dyadic_table (0:124) fixed bin int static init ((21) 1, 351 /* 0-20 dyadic scalar operators */ 352 (15) 1, /* 21-35 unused */ 353 10, /* 36 rho */ 354 6, /* 37 comma */ 355 4, /* 38 iota */ 356 15, /* 39 take */ 357 16, /* 40 drop */ 358 (2) 1, /* 41-42 (grade up, grade down; not dyadic) */ 359 7, /* 43 compress last */ 360 8, /* 44 expand last */ 361 17, /* 45 rotate-last */ 362 12, /* 46 compress first */ 363 13, /* 47 expand first */ 364 18, /* 48 rotate-first */ 365 19, /* 49 transpose */ 366 3, /* 50 epsilon */ 367 20, /* 51 decode */ 368 21, /* 52 encode */ 369 1, /* 53 execute (not dyadic) */ 370 23, /* 54 format */ 371 29, /* 55 dyadic i-beam */ 372 1, /* 56 not (not dyadic) */ 373 25, /* 57 deal */ 374 (9) 26, /* 58-66 system functions */ 375 1, /* 67 branch (not dyadic) */ 376 27, /* 68 domino */ 377 (3) 1, /* 69-71 monadic system functions */ 378 24, /* 72 semicolon cons */ 379 9, /* 73 qFADDACL file system function */ 380 9, /* 74 qFAPPEND file system function */ 381 9, /* 75 qFCREATE file system function */ 382 9, /* 76 qFDELETEACL file system function */ 383 1, /* 77 qFDROP monadic file system function */ 384 9, /* 78 qFERASE file system function */ 385 (4) 1, /* 79-82 monadic file system functions */ 386 (2) 1, /* 83-84 niladic file system functions */ 387 (2) 1, /* 85-86 monadic file system functions */ 388 9, /* 87 qFRENAME file system function */ 389 9, /* 88 qFREPLACE file system function */ 390 9, /* 89 qFSETACL file system function */ 391 1, /* 90 qFSIZE monadic file system function */ 392 9, /* 91 qFSTIE file system function */ 393 9, /* 92 qFTIE file system function */ 394 11, /* 93 laminate */ 395 (4) 1, /* 94-97 (reduction, scan; not dyadic) */ 396 14, /* 98 outer product */ 397 5, /* 99 invoke function */ 398 (2) 1, /* 100-101 (stop, trace; not dyadic) */ 399 2, /* 102 simple assignment */ 400 28, /* 103 subscripted assignment */ 401 (18) 1, /* 104-121 (various; not dyadic) */ 402 22, /* 122 catenate first */ 403 1, /* 123 qCALL system function (monadic only) */ 404 24), /* 124 qCALL semicolon */ 405 value_bits bit (36) aligned int static init ("0000001"b), 406 computed_value_bits bit (36) aligned int static init ("0000001001"b), 407 external_function_bits 408 (2:4) bit (36) aligned int static 409 init ("000001000010000000000000000001100011"b, "000011000010000000000000000001100011"b, 410 "000101000010000000000000000001100011"b), 411 1 rs (1000) aligned based (rsp), 412 2 type fixed bin, 413 2 bits unaligned like operator_bead.bits_for_parse, 414 2 semantics ptr unaligned, 415 2 lexeme fixed bin, 416 1 rs_for_op (1000) aligned based (rsp), 417 2 type fixed bin, 418 2 bits unaligned like operator_bead.bits_for_parse, 419 2 semantics fixed bin, 420 2 lexeme fixed bin, 421 1 rs_overlay aligned based, 422 2 type fixed bin, 423 2 bits unaligned like operator_bead.bits_for_parse, 424 2 semantics ptr unaligned, 425 2 lexeme fixed bin, 426 1 error_mark_structure 427 aligned based (error_mark_structure_ptr), 428 2 error_line_number 429 fixed bin, 430 2 error_line_index 431 fixed bin (21), 432 2 error_index_within_line 433 fixed bin, 434 2 length_of_line fixed bin; 435 436 /* include files */ 437 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 ---------------------------------- */ 438 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_characters.incl.pl1 =================================== */ 2 2 2 3 /* 2 4* * This include file contains all the characters in the APL character set, 2 5* * declared char(1) [Instead of fixed bin as in the apl_character_codes.incl.pl1 file] 2 6* * 2 7* Modified 780913 by PG to add CentSign 2 8* Modified 790319 by PG to add CommaHyphen 2 9* */ 2 10 2 11 declare ( 2 12 QBell init(""), 2 13 QBackSpace init(""), 2 14 QTab init(" "), 2 15 QNewLine init(" 2 16 "), 2 17 QSpace init(" "), 2 18 QExclamation init("!"), 2 19 QDollar init("$"), 2 20 QApostrophe init("'"), 2 21 QLeftParen init("("), 2 22 QRightParen init(")"), 2 23 QStar init("*"), 2 24 QPlus init("+"), 2 25 QComma init(","), 2 26 QMinus init("-"), 2 27 QPeriod init("."), 2 28 QSlash init("/"), 2 29 QZero init("0"), 2 30 QOne init("1"), 2 31 QTwo init("2"), 2 32 QThree init("3"), 2 33 QFour init("4"), 2 34 QFive init("5"), 2 35 QSix init("6"), 2 36 QSeven init("7"), 2 37 QEight init("8"), 2 38 QNine init("9"), 2 39 QColon init(":"), 2 40 QSemiColon init(";"), 2 41 QLessThan init("<"), 2 42 QEqual init("="), 2 43 QGreaterThan init(">"), 2 44 QQuestion init("?"), 2 45 QLetterA_ init("A"), 2 46 QLetterB_ init("B"), 2 47 QLetterC_ init("C"), 2 48 QLetterD_ init("D"), 2 49 QLetterE_ init("E"), 2 50 QLetterF_ init("F"), 2 51 QLetterG_ init("G"), 2 52 QLetterH_ init("H"), 2 53 QLetterI_ init("I"), 2 54 QLetterJ_ init("J"), 2 55 QLetterK_ init("K"), 2 56 QLetterL_ init("L"), 2 57 QLetterM_ init("M"), 2 58 QLetterN_ init("N"), 2 59 QLetterO_ init("O"), 2 60 QLetterP_ init("P"), 2 61 QLetterQ_ init("Q"), 2 62 QLetterR_ init("R"), 2 63 QLetterS_ init("S"), 2 64 QLetterT_ init("T"), 2 65 QLetterU_ init("U"), 2 66 QLetterV_ init("V"), 2 67 QLetterW_ init("W"), 2 68 QLetterX_ init("X"), 2 69 QLetterY_ init("Y"), 2 70 QLetterZ_ init("Z"), 2 71 QLeftBracket init("["), 2 72 QBackSlash init("\"), 2 73 QRightBracket init("]"), 2 74 QUnderLine init("_"), 2 75 QLetterA init("a"), 2 76 QLetterB init("b"), 2 77 QLetterC init("c"), 2 78 QLetterD init("d"), 2 79 QLetterE init("e"), 2 80 QLetterF init("f"), 2 81 QLetterG init("g"), 2 82 QLetterH init("h"), 2 83 QLetterI init("i"), 2 84 QLetterJ init("j"), 2 85 QLetterK init("k"), 2 86 QLetterL init("l"), 2 87 QLetterM init("m"), 2 88 QLetterN init("n"), 2 89 QLetterO init("o"), 2 90 QLetterP init("p"), 2 91 QLetterQ init("q"), 2 92 QLetterR init("r"), 2 93 QLetterS init("s"), 2 94 QLetterT init("t"), 2 95 QLetterU init("u"), 2 96 QLetterV init("v"), 2 97 QLetterW init("w"), 2 98 QLetterX init("x"), 2 99 QLetterY init("y"), 2 100 QLetterZ init("z"), 2 101 QLeftBrace init("{"), 2 102 QVerticalBar init("|"), 2 103 QRightBrace init("}"), 2 104 QTilde init("~"), 2 105 QLessOrEqual init(""), 2 106 QGreaterOrEqual init(""), 2 107 QNotEqual init(""), 2 108 QOrSign init(""), 2 109 QAndSign init(""), 2 110 QDivision init(""), 2 111 QEpsilon init(""), 2 112 QUpArrow init(""), 2 113 QDownArrow init(""), 2 114 QCircle init(""), 2 115 QCeiling init(""), 2 116 QFloor init(""), 2 117 QDelta init(""), 2 118 QSmallCircle init(""), 2 119 QQuad init(""), 2 120 QCap init(""), 2 121 QDeCode init(""), 2 122 QEnCode init(""), 2 123 QLeftLump init(""), 2 124 QRightLump init(""), 2 125 QCup init(""), 2 126 QNorSign init(""), 2 127 QNandSign init(""), 2 128 QCircleHyphen init(""), 2 129 QSlashHyphen init(""), 2 130 QDelTilde init(""), 2 131 QCircleStar init(""), 2 132 QCircleBar init(""), 2 133 QCircleBackSlash init(""), 2 134 QCircleSlash init(""), 2 135 QGradeDown init(""), 2 136 QGradeUp init(""), 2 137 QLamp init(""), 2 138 QQuadQuote init(""), 2 139 QIBeam init(""), 2 140 QBackSlashHyphen init(""), 2 141 QDomino init(""), 2 142 QDiaresis init(""), 2 143 QOmega init(""), 2 144 QIota init(""), 2 145 QRho init(""), 2 146 QTimes init(""), 2 147 QAlpha init(""), 2 148 QUpperMinus init(""), 2 149 QDel init(""), 2 150 QLeftArrow init(""), 2 151 QRightArrow init(""), 2 152 QDiamond init(""), 2 153 QZero_ init(""), 2 154 QOne_ init(""), 2 155 QTwo_ init(""), 2 156 QThree_ init(""), 2 157 QFour_ init(""), 2 158 QFive_ init(""), 2 159 QSix_ init(""), 2 160 QSeven_ init(""), 2 161 QEight_ init(""), 2 162 QNine_ init(""), 2 163 QDelta_ init(""), 2 164 QMarkError init(""), 2 165 QExecuteSign init(""), 2 166 QFormatSign init(""), 2 167 QLeftTack init(""), 2 168 QRightTack init(""), 2 169 QLineFeed init(""), 2 170 QConditionalNewLine init(""), 2 171 QCentSign init(""), 2 172 QCommaHyphen init("") 2 173 ) char(1) internal static options (constant); 2 174 2 175 /* ------ END INCLUDE SEGMENT apl_characters.incl.pl1 ----------------------------------- */ 439 3 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 3 2 3 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 3 4 3 5 /* automatic */ 3 6 3 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 3 8 3 9 /* external static */ 3 10 3 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 3 12 2 static_ws_info_ptr unaligned pointer; 3 13 3 14 /* based */ 3 15 3 16 declare 1 ws_info aligned based (ws_info_ptr), 3 17 2 version_number fixed bin, /* version of this structure (3) */ 3 18 2 switches unaligned, /* mainly ws parameters */ 3 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 3 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 3 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 3 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 3 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 3 24 3 restrict_external_functions 3 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 3 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 3 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 3 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 3 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 3 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 3 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 3 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 3 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 3 34 3 compatibility_check_mode 3 35 bit, /* if 1, check for incompatible operators */ 3 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 3 37 /* remaining 20 bits not presently used */ 3 38 3 39 2 values, /* attributes of the workspace */ 3 40 3 digits fixed bin, /* number of digits of precision printed on output */ 3 41 3 width fixed bin, /* line length for formatted output */ 3 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 3 43 3 random_link fixed bin(35), /* seed for random number generator */ 3 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 3 45 3 float_index_origin float, /* the index origin in floating point */ 3 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 3 47 3 maximum_value_stack_size 3 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 3 49 3 50 2 pointers, /* pointers to various internal tables */ 3 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 3 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 3 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 3 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 3 55 3 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 3 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 3 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 3 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 3 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 3 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 3 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 3 63 2 signoff_lock character (32), 3 64 3 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 3 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 3 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 3 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 3 69 bit, /* munging his tables */ 3 70 3 unused_interrupt_bit bit, /* not presently used */ 3 71 3 dont_interrupt_command bit, 3 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 3 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 3 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 3 75 3 76 2 user_name char (32), /* process group id of user */ 3 77 2 immediate_input_prompt char (32) varying, /* normal input */ 3 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 3 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 3 80 2 vcpu_time aligned, 3 81 3 total fixed bin (71), 3 82 3 setup fixed bin (71), 3 83 3 parse fixed bin (71), 3 84 3 lex fixed bin (71), 3 85 3 operator fixed bin (71), 3 86 3 storage_manager fixed bin (71), 3 87 2 output_info aligned, /* data pertaining to output buffer */ 3 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 3 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 3 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 3 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 3 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 3 93 3 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 3 95 3 96 /* internal static */ 3 97 3 98 declare max_parse_stack_depth fixed bin int static init(64536); 3 99 3 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 440 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 ---------------------------------- */ 441 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 5 2 5 3 /* This bead is used by apl to store the source code for user-defined functions */ 5 4 5 5 declare 1 function_bead aligned based, 5 6 5 7 2 header aligned like general_bead, 5 8 5 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 5 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 5 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 5 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 5 13 2 text_length fixed bin(21), /* length of function text */ 5 14 2 text aligned char(data_elements refer (function_bead.text_length)); 5 15 /* the user's code exactly as typed in */ 5 16 5 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 442 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 ========================== */ 6 2 6 3 /* this is the format of a user-defined function after it has been run 6 4* through apl_lex_, the first (left to right) parsing phase. */ 6 5 6 6 dcl 1 lexed_function_bead based aligned, 6 7 2 header like general_bead, /* type bits, etc. */ 6 8 6 9 2 name pointer unaligned, /* -> symbol bead which names the function */ 6 10 2 bits_for_parse unaligned like operator_bead.bits_for_parse, /* so can treat like system function */ 6 11 2 number_of_statements fixed bin, 6 12 2 number_of_localized_symbols fixed bin, /* including labels and parameter variables, return var */ 6 13 /* even if they aren't there, thus >_ 3 */ 6 14 2 number_of_labels fixed bin, 6 15 2 label_values_ptr pointer unaligned, /* -> label_values below */ 6 16 2 statement_map_ptr pointer unaligned, /* -> statement_map below */ 6 17 2 lexeme_array_ptr pointer unaligned, /* -> lexeme_array below */ 6 18 6 19 /* the first 3 localized symbols are always reserved for ReturnSymbol, LeftArgSymbol, RighArgSymbol respectively. 6 20* If some of these symbols are not present (e.g. monadic or value-less function), null pointers are used. 6 21* So beware!, there can be null ptrs in the localized_symbols array. */ 6 22 6 23 2 localized_symbols( (0) refer (lexed_function_bead.number_of_localized_symbols)) pointer unaligned, 6 24 /* first localized vars from header line, then labels */ 6 25 2 label_values ( (0) refer (lexed_function_bead.number_of_labels)) pointer unaligned, 6 26 /* ptrs to label-value beads for labels */ 6 27 2 statement_map ( (0) refer (lexed_function_bead.number_of_statements)) fixed bin(18), 6 28 /* index in lexeme_array of rightmost lexeme of each stmt */ 6 29 2 lexeme_array ( (0) refer (lexed_function_bead.number_of_labels) /* not really, but fake out compiler */ ) pointer unaligned; 6 30 /* the actual lexemes. Length of array is 6 31* statement_map(number_of_statements) */ 6 32 6 33 6 34 /* manifest constants for first 3 localized symbols */ 6 35 6 36 dcl (ReturnSymbol init(1), 6 37 LeftArgSymbol init(2), 6 38 RightArgSymbol init(3) 6 39 ) fixed binary static; 6 40 6 41 6 42 /* the last three parts of this bead are referenced separately, though ptrs earlier in the bead. 6 43* Here are declarations for them as level-1 structures */ 6 44 6 45 dcl 1 lexed_function_label_values_structure based aligned, 6 46 2 lexed_function_label_values ( 500 /* or so */ ) pointer unaligned, 6 47 6 48 statement_count fixed bin, 6 49 lexed_function_statement_map (statement_count) fixed bin(18) aligned based, 6 50 6 51 1 lexed_function_lexemes_structure based aligned, 6 52 2 lexed_function_lexeme_array ( 500 /* or so */ ) pointer unaligned; 6 53 6 54 /* ------ END INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 -------------------------- */ 443 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 7 2 7 3 declare 7 4 1 operator_bead aligned based, 7 5 7 6 2 type unaligned like general_bead.type, 7 7 7 8 2 bits_for_lex unaligned, 7 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 7 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 7 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 7 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 7 13 3 ignores_assignment bit(1), /* assignment has no effect */ 7 14 3 allow_subscripted_assignment 7 15 bit(1), /* system variable that can be subscripted assigned */ 7 16 3 pad bit(12), 7 17 7 18 2 bits_for_parse unaligned, 7 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 7 20* (op1 tells which) */ 7 21 3 quad bit(1), /* this is a quad type */ 7 22 3 system_variable bit(1), /* this is a system variable, not an op */ 7 23 3 dyadic bit(1), /* operator may be dyadic */ 7 24 3 monadic bit(1), /* operator may be monadic */ 7 25 3 function bit(1), /* operator is a user defined function */ 7 26 3 semantics_valid bit(1), /* if semantics has been set */ 7 27 3 has_list bit(1), /* semantics is a list */ 7 28 3 inner_product bit(1), /* op2 is valid */ 7 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 7 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 7 31 3 pad bit(7), 7 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 7 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 7 34 2 type_code fixed bin; /* for parse */ 7 35 7 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 444 8 1 /* ====== BEGIN INCLUDE SEGEMENT apl_operators_argument.incl.pl1 =========================== */ 8 2 8 3 declare 1 operators_argument aligned, 8 4 2 operands (2) aligned, /* these are the operands to the operator to be executed. 8 5* if operand (1).value is null, operator is monadic */ 8 6 3 value pointer unaligned, /* a pointer to the value bead for this operand */ 8 7 3 on_stack bit (1) aligned, /* ON if this value resides on the value stack */ 8 8 2 operator aligned, /* information about the operator to be executed */ 8 9 3 dimension fixed bin, /* (optional) dimension along which to operate */ 8 10 3 padding bit (18) unaligned, /* unused part of operator bead */ 8 11 3 op2 fixed bin (8) unal, /* a modifier for op1, or a 2nd operator if inner product */ 8 12 3 op1 fixed bin (8) unal, /* code for the actual operator to be executed */ 8 13 2 result pointer unal, /* (output) set by operator to point to result bead in stack */ 8 14 2 error_code fixed bin (35), /* (output) set before signaling apl_operator_error_ */ 8 15 2 where_error fixed bin; /* parseme index of where error was - parse sets to operator */ 8 16 8 17 /* ------ END INCLUDE SEGMENT apl_operators_argument.incl.pl1 --------------------------- */ 445 9 1 /* ====== BEGIN INCLUDE SEGMENT apl_parse_frame.incl.pl1 ================================== */ 9 2 9 3 declare 1 parse_frame aligned based (parse_frame_ptr), 9 4 2 last_parse_frame_ptr ptr unaligned, /* pointer to last parse frame, or null */ 9 5 2 parse_frame_type fixed bin, /* suspended, function, eval input, etc. */ 9 6 2 function_bead_ptr ptr unaligned, /* ptr to function bead */ 9 7 2 lexed_function_bead_ptr ptr unaligned, /* ptr to lexed function bead */ 9 8 2 reduction_stack_ptr ptr unaligned, /* ptr to reduction stack for this frame */ 9 9 2 current_parseme fixed bin, /* element of reduction stack that is top of stack */ 9 10 2 current_lexeme fixed bin, /* element number of current lexeme */ 9 11 2 current_line_number fixed bin, /* line number being executed */ 9 12 2 return_point fixed bin, /* where to join the reductions on return */ 9 13 2 put_result fixed bin, /* where to put the value when returning to this frame */ 9 14 2 print_final_value bit(1) aligned, /* if true, print final value on line */ 9 15 2 initial_value_stack_ptr ptr unaligned, /* for cleaning up the value stack */ 9 16 2 number_of_ptrs fixed bin, /* number of old meaning ptrs */ 9 17 2 old_meaning_ptrs dim (number_of_ptrs refer (parse_frame.number_of_ptrs)) ptr unaligned; 9 18 /* old meanings for local variables. */ 9 19 9 20 declare number_of_ptrs fixed bin; 9 21 9 22 declare (suspended_frame_type init (1), /* for comparison with parse frame type */ 9 23 function_frame_type init (2), 9 24 evaluated_frame_type init (3), 9 25 execute_frame_type init (4), 9 26 save_frame_type init (5) 9 27 ) fixed bin internal static options (constant); 9 28 9 29 declare reductions_pointer pointer; 9 30 9 31 declare 9 32 1 reduction_stack aligned dim (1000) based (reductions_pointer), 9 33 2 type fixed bin, /* type of parseme */ 9 34 2 bits unaligned like operator_bead.bits_for_parse, 9 35 2 semantics ptr unaligned, 9 36 2 lexeme fixed bin, 9 37 9 38 1 reduction_stack_for_op aligned dim (1000) based (reductions_pointer), 9 39 2 type fixed bin, 9 40 2 bits unaligned like operator_bead.bits_for_parse, 9 41 2 semantics fixed bin, 9 42 2 lexeme fixed bin, 9 43 9 44 (eol_type init(0), /* parseme types - end of line */ 9 45 bol_type init(1), /* begining of line */ 9 46 val_type init(2), /* value */ 9 47 op_type init(3), /* op */ 9 48 open_paren_type init(4), 9 49 close_paren_type init(5), 9 50 open_bracket_type init(6), 9 51 close_subscript_type init(7), 9 52 close_rank_type init(8), 9 53 semi_colon_type init(9), 9 54 diamond_type init (10), 9 55 subscript_type init (11)) fixed bin internal static options (constant); 9 56 9 57 /* ------ END INCLUDE SEGMENT apl_parse_frame.incl.pl1 ---------------------------------- */ 446 10 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 10 2 10 3 /* Explanation of fields: 10 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 10 5* symbol_bead.meaning_pointer points to current "value" of this name: 10 6* = null => unused (e.g. undefined variable) 10 7* -> group bead => group name 10 8* -> value bead => variable with a value 10 9* -> function bead => function name 10 10* -> label bead => localized label value 10 11* -> shared var bead => shared variable */ 10 12 10 13 declare 1 symbol_bead aligned based, 10 14 2 header aligned like general_bead, 10 15 2 hash_link_pointer pointer unaligned, 10 16 2 meaning_pointer pointer unaligned, 10 17 2 name_length fixed binary, 10 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 10 19 10 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 447 11 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 11 2 11 3 declare 11 4 number_of_dimensions fixed bin, 11 5 11 6 1 value_bead aligned based, 11 7 2 header aligned like general_bead, 11 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 11 9 2 rhorho fixed binary, /* number of dimensions of value */ 11 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 11 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 11 12 /* dimensions of value (zero-origin) */ 11 13 11 14 11 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 11 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 11 17 /* actual elements of character array */ 11 18 11 19 declare character_string_overlay character (data_elements) aligned based; 11 20 /* to overlay on above structure */ 11 21 11 22 11 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 11 24 /* actual elements of numeric array */ 11 25 11 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 11 27 11 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 11 29 11 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 448 12 1 /* ====== BEGIN INCLUDE SEGMENT apl_list_bead.incl.pl1 ==================================== */ 12 2 12 3 declare n_members fixed bin, 12 4 12 5 1 list_bead aligned based, 12 6 2 header aligned like general_bead, 12 7 2 number_of_members fixed bin, 12 8 2 members dimension (n_members refer (list_bead.number_of_members)) aligned, 12 9 3 member_ptr unaligned pointer, 12 10 3 bits unaligned like operator_bead.bits_for_parse; 12 11 12 12 /* ------ END INCLUDE SEGMENT apl_list_bead.incl.pl1 ------------------------------------ */ 449 13 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_codes.incl.pl1 =============================== */ 13 2 13 3 /* This include file contains declarations of the 9-bit codes used for each operator. */ 13 4 13 5 /* Modified 811211 by H. Hoover (UofC) to add quadcall_semicolon_code. */ 13 6 /* Modified 811211 by H. Hoover (UofC) to add semicolon_cons_code. */ 13 7 13 8 declare (plus_code init (0), 13 9 minus_code init (1), 13 10 times_code init (2), 13 11 divide_code init (3), 13 12 max_code init (4), 13 13 min_code init (5), 13 14 power_code init (6), 13 15 log_code init (7), 13 16 residue_code init (8), 13 17 factorial_code init (9), 13 18 trig_code init (10), 13 19 and_code init (11), 13 20 or_code init (12), 13 21 nand_code init (13), 13 22 nor_code init (14), 13 23 less_code init (15), 13 24 less_equal_code init (16), 13 25 equal_code init (17), 13 26 greater_equal_code init (18), 13 27 greater_code init (19), 13 28 not_equal_code init (20), 13 29 13 30 /* space will be left here in case more simple operators are added one day */ 13 31 13 32 rho_code init (36), 13 33 ravel_code init (37), 13 34 iota_code init (38), 13 35 take_code init (39), 13 36 leave_code init (40), 13 37 grade_up_code init (41), 13 38 grade_down_code init (42), 13 39 branch_code init (67), 13 40 semicolon_cons_code init (72), 13 41 fnames_code init (83), 13 42 fnums_code init (84), 13 43 laminate_code init (93), 13 44 stop_code init (100), 13 45 trace_code init (101), 13 46 assignment_code init (102), 13 47 subscripted_assignment_code 13 48 init (103), 13 49 assign_to_stop_code init (112), 13 50 assign_to_trace_code 13 51 init (113), 13 52 quadcall_semicolon_code 13 53 init (124) 13 54 ) fixed binary (8) internal static; 13 55 13 56 /* ------ END INCLUDE SEGMENT apl_operator_codes.incl.pl1 ------------------------------- */ 450 451 452 /* Initialize interrupt masking bits and mask parse against interrupts. Actually, there is 453* a very small window between the time we turn on the bits and the time we establish the default 454* handler. If the user sneaks in a quit in the window, he'd better type start and not program_interrupt... */ 455 456 call reset_interrupt_info; 457 call condition_ ("any_other", apl_default_handler_); 458 459 /* We should really do the following order on user_input, and check the 460* status code if it fails. (Which it would in &attach mode in an ec). 461* Probably we should not use read_back_spaces at all... */ 462 463 call iox_$control (iox_$user_io, read_back_spaces_order, null, (0)); 464 n_underflows = 0; 465 466 start_anew: 467 ws_info.current_parse_frame_ptr -> parse_frame.last_parse_frame_ptr = null; 468 /* sb in other pgm */ 469 parse_frame_ptr = ws_info.current_parse_frame_ptr;/* copy frame ptr into auto */ 470 call initialize_suspended_frame; 471 472 ws_just_loaded: 473 if parse_frame.parse_frame_type = evaluated_frame_type 474 then go to read_and_lex_line; 475 476 if ws_info.wsid = "clear ws" /* skip latent expression */ 477 then go to read_and_lex_line; 478 479 number_of_ptrs = 1; /* so size builtin will work, below. */ 480 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 481 input_buffer.n_read = 5; 482 input_buffer.line = QExecuteSign || QQuad || "lx" || QNewLine; 483 /* _eqLX */ 484 parse_frame.current_line_number = 1; 485 call lex_input_line (code); 486 go to start_line; 487 488 next_line: 489 if parse_frame.lexed_function_bead_ptr ^= null 490 then call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 491 492 read_and_lex_line: 493 code = 1; 494 do while (code ^= 0); 495 call read_executable_input_line; 496 call lex_input_line (code); 497 end; 498 499 start_line: 500 lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 501 /* copy into auto */ 502 /* If there are no statements, this is an empty function and we are done. */ 503 504 if lexed_function_bead_ptr -> lexed_function_bead.number_of_statements = 0 505 then go to function_return; 506 507 current_lexeme = lexed_function_bead_ptr -> statement_map (parse_frame.current_line_number) + 1; 508 /* end of line is after line */ 509 have_a_line = "1"b; /* if interrupt, we now have a line to print */ 510 if parse_frame_type = function_frame_type 511 then if parse_frame.function_bead_ptr -> stop_control_pointer ^= null 512 then if this_statement_is_one (parse_frame.current_line_number, 513 parse_frame.function_bead_ptr -> stop_control_pointer) 514 then if ok_to_stop_control 515 then do; 516 call print_where_I_am (parse_frame_ptr, "0"b, "1"b); 517 call save_state; 518 call push_new_frame; 519 call initialize_suspended_frame; 520 go to read_and_lex_line; 521 end; 522 523 ok_to_stop_control = "1"b; 524 print_final_value = "1"b; 525 was_branch = "0"b; 526 was_branch_value = "0"b; 527 trace_branch_line = "0"b; 528 current_parseme = 1; /* fill in first parseme - end of line */ 529 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 530 rs (current_parseme).type = eol_type; /* fill in first parseme on reduction stack */ 531 unspec (rs (current_parseme).bits) = ""b; 532 if clean_interrupt_pending 533 then do; 534 dont_interrupt_parse = "0"b; 535 current_lexeme = current_lexeme - 1; 536 go to dirty_stop; 537 end; 538 539 go to re; /* get into reductions at re (right end) */ 540 541 /* A P L R E D U C T I O N S 542* 543* These reductions are the heart of the APL interpreter. Using the lexeme array 544* produced by apl_lex_, the following code determines the next action to be 545* performed, calls the necessary operator routines, and "reduces" the stack 546* by the work just done, putting the result in place of the operator and 547* input arguments. */ 548 549 re: 550 return_point = 8; 551 go to pull; 552 operator_return (8): 553 go to x_re (rs (current_parseme).type); /* dispatch on what it was */ 554 555 x_re (1): /* BOL RE */ 556 bol_re: 557 if parse_frame_type = evaluated_frame_type 558 then if rs (current_parseme - 1).semantics_valid 559 then go to bad_evaluated_input; 560 else go to next_line; 561 562 if parse_frame_type = execute_frame_type 563 then if rs (current_parseme - 1).semantics_valid 564 then go to bad_execute; 565 else do; 566 ptr_to_returned_value = null; 567 bits_for_returned_value = value_bits; 568 go to eval_execute_return; 569 end; 570 571 go to done_line; 572 573 x_re (2): /* VAL RE */ 574 val_re: 575 return_point = 9; 576 go to pull; 577 operator_return (9): 578 go to x_val_re (rs (current_parseme).type); 579 580 x_re (3): /* OP RE */ 581 if rs (current_parseme).op1 ^= branch_code /* allow only -> here */ 582 then go to not_end_with_value; 583 584 pop_stack: 585 call clean_up_rs; 586 if last_parse_frame_ptr = null 587 then go to next_line; 588 if parse_frame.lexed_function_bead_ptr ^= null 589 then do; 590 lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 591 call restore_old_meanings; 592 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 593 if parse_frame.parse_frame_type = function_frame_type 594 then call decrement_reference_count (parse_frame.function_bead_ptr); 595 end; 596 parse_frame_ptr = last_parse_frame_ptr; 597 call restore_state; 598 if parse_frame_type ^= suspended_frame_type 599 then go to pop_stack; 600 else go to next_line; 601 602 x_re (4): /* ( RE */ 603 go to context_error_0; 604 605 x_re (5): /* ) RE */ 606 go to re; 607 608 x_re (6): /* [ RE */ 609 call append_to_list_bead (addr (rs (current_parseme - 1)) -> rs_overlay); 610 rs (current_parseme - 1).semantics -> list_bead.member_ptr (1) = null; 611 unspec (rs (current_parseme - 1).semantics -> list_bead.bits (1)) = ""b; 612 rs (current_parseme - 1).lexeme = rs (current_parseme).lexeme; 613 current_parseme = current_parseme - 1; 614 rs (current_parseme).type = subscript_type; 615 go to sub; 616 617 x_re (7): /* ]SB RE */ 618 go to re; 619 620 x_re (8): /* ]RK RE */ 621 go to context_error_0; 622 623 x_re (9): /* ; RE */ 624 print_final_value = "1"b; 625 call append_to_list_bead (addr (rs (current_parseme - 1)) -> rs_overlay); 626 rs (current_parseme - 1).semantics -> list_bead.member_ptr (1) = null; 627 unspec (rs (current_parseme - 1).semantics -> list_bead.bits (1)) = ""b; 628 /* bits.op1 = 0 means print value */ 629 current_parseme = current_parseme - 1; 630 go to re; 631 632 x_re (10): /* <> RE */ 633 call print_value; 634 current_parseme = current_parseme - 1; 635 print_final_value = "1"b; 636 go to re; 637 638 x_val_re (1): /* BOL VAL RE */ 639 bol_val_re: 640 if rs (current_parseme - 2).semantics_valid 641 then do; /* if line had any mixed-output semicolons */ 642 call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 643 if print_final_value /* set up bits.op1 for whether to print value */ 644 then rs (current_parseme - 1).bits.op1 = 0; 645 else rs (current_parseme - 1).bits.op1 = 1; 646 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = 647 unspec (rs (current_parseme - 1).bits); 648 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 649 rs (current_parseme - 1) = rs (current_parseme); 650 current_parseme = current_parseme - 1; 651 go to bol_re; 652 end; 653 654 if parse_frame.parse_frame_type = evaluated_frame_type | parse_frame.parse_frame_type = execute_frame_type 655 then do; 656 ptr_to_returned_value = rs (current_parseme - 1).semantics; 657 bits_for_returned_value = unspec (rs (current_parseme - 1).bits); 658 659 eval_execute_return: 660 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 661 parse_frame_ptr = last_parse_frame_ptr; 662 call restore_state_after_execute; 663 rs (put_result).type = val_type; 664 rs (put_result).semantics = ptr_to_returned_value; 665 unspec (rs (put_result).bits) = bits_for_returned_value; 666 go to operator_return (return_point); 667 end; 668 669 go to done_line; 670 671 x_val_re (2): /* VAL VAL RE */ 672 go to context_error_0; 673 674 x_val_re (3): /* OP VAL RE */ 675 op_val_re: 676 if rs (current_parseme).op1 = semicolon_cons_code | rs (current_parseme).op1 = quadcall_semicolon_code 677 then if rs (current_parseme-2).op1 = semicolon_cons_code | rs (current_parseme-2).op1 = quadcall_semicolon_code 678 then do; /* Do previously deferred semicolon. */ 679 current_parseme = current_parseme - 1; 680 current_lexeme = current_lexeme + 1; 681 goto val_op_val_re; 682 end; 683 else do; /* Defer semicolon until its left arg is evaluated. */ 684 rs (current_parseme).type = close_paren_type; /* Evaluation deferred by pretending it's a ')'. */ 685 goto re; 686 end; 687 return_point = 10; 688 689 if (rs (current_parseme).op1 = assignment_code) | (rs (current_parseme).op1 = subscripted_assignment_code) 690 then go to pull_assignment_variable; 691 692 go to pull; 693 operator_return (10): 694 go to x_op_val_re (rs (current_parseme).type); 695 696 x_val_re (4): /* ( VAL RE */ 697 if rs (current_parseme-2).op1 = semicolon_cons_code | rs (current_parseme-2).op1 = quadcall_semicolon_code 698 then do; /* Do previously deferred semicolon. */ 699 current_parseme = current_parseme - 1; 700 current_lexeme = current_lexeme + 1; 701 goto val_op_val_re; 702 end; 703 print_final_value = "1"b; 704 rs (current_parseme - 2) = rs (current_parseme - 1); 705 current_parseme = current_parseme - 2; 706 if rs (current_parseme - 1).type = op_type 707 then go to val_op_val_re; 708 else if rs (current_parseme - 1).type = subscript_type 709 then go to val_sub; 710 else go to val_re; 711 712 x_val_re (5): /* ) VAL RE */ 713 go to context_error_0; 714 715 x_val_re (6): /* [ VAL RE */ 716 open_bracket_val_re: 717 rs (current_parseme - 2).type = subscript_type; 718 call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 719 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = unspec (rs (current_parseme - 1).bits); 720 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 721 rs (current_parseme - 2).lexeme = rs (current_parseme).lexeme; 722 current_parseme = current_parseme - 2; 723 go to sub; 724 725 x_val_re (7): /* ]SB VAL RE */ 726 go to context_error_0; 727 728 x_val_re (8): /* ]RK VAL RE */ 729 go to re; 730 731 x_val_re (9): /* ; VAL RE */ 732 semi_colon_val_re: 733 call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 734 rs (current_parseme - 1).bits.op1 = binary (^print_final_value, 1); 735 /* 1 if assignment, else 0 */ 736 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = unspec (rs (current_parseme - 1).bits); 737 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 738 current_parseme = current_parseme - 2; 739 print_final_value = "1"b; 740 go to re; 741 742 x_val_re (10): /* <> VAL RE */ 743 diamond_val_re: 744 diamond_temp = current_parseme; 745 tmp_parseme = parse_frame.current_parseme; 746 call print_value; 747 call clean_up_rs; 748 current_parseme = diamond_temp; 749 parse_frame.current_parseme = tmp_parseme; 750 print_final_value = "1"b; 751 go to re; 752 753 x_op_val_re (1): /* BOL OP VAL RE */ 754 start = current_parseme - 1; 755 put_result = current_parseme - 2; 756 return_point = 1; 757 go to do_monadic; 758 operator_return (1): 759 rs (put_result).lexeme = rs (current_parseme - 1).lexeme; 760 rs (current_parseme - 1).type = bol_type; 761 current_parseme = current_parseme - 1; 762 go to bol_val_re; 763 764 x_op_val_re (2): /* VAL OP VAL RE */ 765 val_op_val_re: 766 start = current_parseme; 767 put_result = current_parseme - 2; 768 return_point = 2; 769 go to do_dyadic; 770 operator_return (2): 771 rs (put_result).lexeme = rs (current_parseme).lexeme; 772 current_parseme = current_parseme - 2; 773 go to val_re; 774 775 x_op_val_re (3): /* OP OP VAL RE */ 776 start = current_parseme - 1; 777 put_result = current_parseme - 2; 778 return_point = 3; 779 go to do_monadic; 780 operator_return (3): 781 rs (put_result).lexeme = rs (current_parseme - 1).lexeme; 782 rs (current_parseme - 1) = rs (current_parseme); 783 current_parseme = current_parseme - 1; 784 go to op_val_re; 785 786 x_op_val_re (4): /* ( OP VAL RE */ 787 if rs (current_parseme-3).op1 = semicolon_cons_code | rs (current_parseme-3).op1 = quadcall_semicolon_code 788 then do; /* Change from (OP VAL1;VAL2)... TO (OP VAL1);VAL2... */ 789 rs (current_parseme-5) = rs (current_parseme-4); 790 rs (current_parseme-4) = rs (current_parseme-3); 791 rs (current_parseme-4).type = op_type; /* Remember we pretended the ';' was a ')'. */ 792 end; 793 start = current_parseme - 1; 794 put_result = current_parseme - 3; 795 return_point = 4; 796 go to do_monadic; 797 operator_return (4): 798 print_final_value = "1"b; 799 rs (current_parseme - 3).lexeme = rs (current_parseme - 2).lexeme; 800 current_parseme = current_parseme - 3; 801 if rs (current_parseme - 1).type = op_type 802 then go to val_op_val_re; 803 else if rs (current_parseme - 1).type = subscript_type 804 then go to val_sub; 805 else go to val_re; 806 807 x_op_val_re (5): /* ) OP VAL RE */ 808 go to re; 809 810 x_op_val_re (6): /* [ OP VAL RE */ 811 start = current_parseme - 1; 812 put_result = current_parseme - 2; 813 return_point = 5; 814 go to do_monadic; 815 operator_return (5): 816 rs (current_parseme - 1) = rs (current_parseme); 817 current_parseme = current_parseme - 1; 818 go to open_bracket_val_re; 819 820 x_op_val_re (7): /* ]SB OP VAL RE */ 821 go to re; 822 823 x_op_val_re (8): /* ]RK OP VAL RE */ 824 start = current_parseme - 1; 825 put_result = current_parseme - 2; 826 return_point = 6; 827 go to do_monadic; 828 operator_return (6): 829 rs (current_parseme - 1) = rs (current_parseme); 830 current_parseme = current_parseme - 1; 831 go to re; 832 833 x_op_val_re (9): /* ; OP VAL RE */ 834 start = current_parseme - 1; 835 put_result = current_parseme - 2; 836 return_point = 7; 837 go to do_monadic; 838 operator_return (7): 839 rs (current_parseme - 1) = rs (current_parseme); 840 current_parseme = current_parseme - 1; 841 if was_branch_value 842 then go to bol_val_re; 843 go to semi_colon_val_re; 844 845 x_op_val_re (10): /* <> OP VAL RE */ 846 start = current_parseme - 1; 847 put_result = current_parseme - 2; 848 return_point = 12; 849 go to do_monadic; 850 operator_return (12): 851 rs (current_parseme - 1) = rs (current_parseme); 852 current_parseme = current_parseme - 1; 853 if was_branch_value 854 then go to bol_val_re; 855 go to diamond_val_re; 856 857 sub: 858 return_point = 11; 859 go to pull; 860 operator_return (11): 861 go to x_sub (rs (current_parseme).type); 862 863 x_sub (1): /* BOL SUB */ 864 go to context_error_0; 865 866 x_sub (2): /* VAL SUB */ 867 val_sub: 868 if rs (current_parseme).semantics = null 869 then call value_error_reporter (current_lexeme); 870 871 operators_argument.value (1) = rs (current_parseme).semantics; 872 operators_argument.value (2) = rs (current_parseme - 1).semantics; 873 operators_argument.on_stack (1) = rs (current_parseme).bits.semantics_on_stack; 874 operators_argument.where_error = current_parseme - 1; 875 operators_argument.error_code = 0; 876 877 call apl_subscript_a_value_ (operators_argument); 878 879 if operators_argument.error_code ^= 0 880 then go to report_error_from_operator; 881 882 if ^operators_argument.on_stack (1) 883 then call decrement_reference_count (rs (current_parseme).semantics); 884 rs (current_parseme - 1).semantics = operators_argument.result; 885 unspec (rs (current_parseme - 1).bits) = computed_value_bits; 886 rs (current_parseme - 1).type = val_type; 887 rs (current_parseme - 1).lexeme = rs (current_parseme).lexeme; 888 print_final_value = "1"b; 889 current_parseme = current_parseme - 1; 890 if rs (current_parseme - 1).type = op_type 891 then go to val_op_val_re; 892 else if rs (current_parseme - 1).type = subscript_type 893 then go to val_sub; 894 else go to val_re; 895 896 x_sub (3): /* OP SUB */ 897 if ^rs (current_parseme - 1).semantics_valid 898 then go to value_error_1; 899 if rs (current_parseme).op1 = subscripted_assignment_code 900 then do; 901 rs (current_parseme).semantics = rs (current_parseme - 1).semantics; 902 rs (current_parseme).semantics_valid = "1"b; 903 rs (current_parseme).semantics_on_stack = "1"b; 904 rs (current_parseme).has_list = "1"b; 905 rs (current_parseme - 1) = rs (current_parseme); 906 current_parseme = current_parseme - 1; 907 go to op_val_re; 908 end; 909 temp_ptr = rs (current_parseme - 1).semantics; 910 if temp_ptr -> list_bead.number_of_members ^= 1 911 then go to rank_error_1; 912 temp_ptr = temp_ptr -> list_bead.member_ptr (1); 913 if temp_ptr = null 914 then go to value_error_1; 915 if temp_ptr -> value_bead.total_data_elements ^= 1 916 then go to rank_error_1; 917 if ^temp_ptr -> value_bead.numeric_value 918 then go to domain_error_1; 919 x = temp_ptr -> value_bead.data_pointer -> numeric_datum (0); 920 921 /* make sure the rank-subscript is an integer */ 922 923 xx = floor (x + 0.5); 924 if abs (xx - x) >= integer_fuzz 925 then do; /* not an integer - allow if laminate */ 926 if rs (current_parseme).op1 ^= ravel_code 927 then go to rank_error_1; 928 929 rs (current_parseme).op1 = laminate_code; 930 xx = floor (x); /* set up value to pass to laminate routine */ 931 end; /* fix the rank-subscript */ 932 933 if abs (xx) > 100000 934 then go to rank_error_1; 935 i = fixed (xx, 17) + 1 - index_origin; /* convert to 1-origin for operators */ 936 if i <= 0 937 then if rs (current_parseme).op1 ^= laminate_code /* if not laminate, which is special, */ 938 then go to rank_error_1; /* then barf if not a good number */ 939 else if i ^= 0 940 then go to rank_error_1; /* if laminate, then barf if negative, but */ 941 else ; /* laminate on zero'th dimension is allowed. */ 942 rs_for_op (current_parseme).semantics = i; 943 rs (current_parseme).semantics_valid = "1"b; 944 if ^rs (current_parseme - 1).semantics -> list_bead.semantics_on_stack (1) 945 then call decrement_reference_count (rs (current_parseme - 1).semantics -> list_bead.member_ptr (1)); 946 rs (current_parseme - 1) = rs (current_parseme); 947 current_parseme = current_parseme - 1; 948 go to op_val_re; 949 950 x_sub (4): /* ( SUB */ 951 go to context_error_0; 952 953 x_sub (5): /* ) SUB */ 954 go to re; 955 956 x_sub (6): /* [ SUB */ 957 go to context_error_0; 958 959 x_sub (7): /* ]SB SUB */ 960 go to re; 961 962 x_sub (8): /* ]RK SUB */ 963 go to context_error_0; 964 965 x_sub (9): /* ; SUB */ 966 go to context_error_0; 967 968 x_sub (10): /* <> SUB */ 969 go to context_error_0; 970 971 done_line: 972 if parse_frame.parse_frame_type = function_frame_type 973 then if parse_frame.function_bead_ptr -> function_bead.trace_control_pointer ^= null 974 then call check_trace_vector; 975 976 print_final_value = print_final_value | trace_branch_line; 977 978 if ^was_branch_value | trace_branch_line /* branch aborts mixed output, unless traced */ 979 then call print_value; 980 981 call clean_up_rs; 982 983 if parse_frame.parse_frame_type = suspended_frame_type 984 then do; 985 if ^was_branch 986 then go to next_line; 987 988 if last_parse_frame_ptr = null 989 then go to next_line; 990 991 if was_branch_value 992 then last_parse_frame_ptr -> parse_frame.current_line_number = parse_frame.current_line_number; 993 994 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 995 ok_to_stop_control = "0"b; 996 parse_frame_ptr = last_parse_frame_ptr; 997 call restore_state; 998 go to increment_function_line_number; 999 end; 1000 1001 if parse_frame_type = function_frame_type 1002 then do; 1003 increment_function_line_number: 1004 parse_frame.current_line_number = parse_frame.current_line_number + 1; 1005 if parse_frame.current_line_number < 1 1006 | parse_frame.current_line_number > lexed_function_bead_ptr -> number_of_statements 1007 then go to function_return; 1008 go to start_line; 1009 end; 1010 1011 go to done_line_system_error; /* workspace is screwed up */ 1012 1013 function_return: 1014 ptr_to_returned_value = lexed_function_bead_ptr -> localized_symbols (ReturnSymbol); 1015 if ptr_to_returned_value ^= null 1016 then do; 1017 ptr_to_returned_value = ptr_to_returned_value -> meaning_pointer; 1018 if ptr_to_returned_value ^= null 1019 then ptr_to_returned_value -> general_bead.reference_count = 1020 ptr_to_returned_value -> general_bead.reference_count + 1; 1021 end; 1022 1023 call restore_old_meanings; 1024 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 1025 call decrement_reference_count (parse_frame.function_bead_ptr); 1026 parse_frame_ptr = last_parse_frame_ptr; 1027 call restore_state; 1028 1029 if number_of_arguments = 2 1030 then do; /* dyadic case */ 1031 1032 /* arguments are known to be in the heap, not on the stack. */ 1033 1034 call decrement_reference_count (rs (start).semantics); 1035 call decrement_reference_count (rs (start - 2).semantics); 1036 end; 1037 else if number_of_arguments = 1 1038 then call decrement_reference_count (rs (start - 1).semantics); 1039 /* monadic case */ 1040 else ; /* niladic...no arguments */ 1041 1042 1043 rs (put_result).semantics = ptr_to_returned_value; 1044 rs (put_result).type = val_type; 1045 unspec (rs (put_result).bits) = value_bits; 1046 go to operator_return (return_point); 1047 1048 return_statement: 1049 return; 1050 1051 context_error_0: 1052 operators_argument.error_code = apl_error_table_$context; 1053 go to report_error; 1054 1055 value_error_1: 1056 operators_argument.error_code = apl_error_table_$value; 1057 current_lexeme = rs (current_parseme - 1).lexeme; 1058 go to report_error; 1059 1060 domain_error: 1061 operators_argument.error_code = apl_error_table_$domain; 1062 current_lexeme = rs (operators_argument.where_error).lexeme; 1063 go to report_error; 1064 1065 domain_error_1: 1066 operators_argument.error_code = apl_error_table_$domain; 1067 current_lexeme = rs (current_parseme - 1).lexeme; 1068 go to report_error; 1069 1070 value_error_s2: 1071 operators_argument.error_code = apl_error_table_$value; 1072 current_lexeme = rs (start - 2).lexeme; 1073 go to report_error; 1074 1075 value_error_s0: 1076 operators_argument.error_code = apl_error_table_$value; 1077 current_lexeme = rs (start).lexeme; 1078 go to report_error; 1079 1080 value_error_s1: 1081 operators_argument.error_code = apl_error_table_$value; 1082 current_lexeme = rs (start - 1).lexeme; 1083 go to report_error; 1084 1085 improper_dyadic_usage: 1086 operators_argument.error_code = apl_error_table_$improper_dyadic_usage; 1087 current_lexeme = rs (start - 1).lexeme; 1088 go to report_error; 1089 1090 improper_monadic_usage: 1091 operators_argument.error_code = apl_error_table_$improper_monadic_usage; 1092 current_lexeme = rs (start).lexeme; 1093 go to report_error; 1094 1095 improper_niladic_usage: 1096 operators_argument.error_code = apl_error_table_$improper_niladic_usage; 1097 current_lexeme = rs (start + 1).lexeme; 1098 go to report_error; 1099 1100 rank_error_1: 1101 operators_argument.error_code = apl_error_table_$operator_subscript_range; 1102 current_lexeme = rs (current_parseme - 1).lexeme; 1103 go to report_error; 1104 1105 bad_assignment: 1106 operators_argument.error_code = apl_error_table_$bad_assignment; 1107 current_lexeme = rs (operators_argument.where_error).lexeme; 1108 go to report_error; 1109 1110 bad_assign_to_label: 1111 operators_argument.error_code = apl_error_table_$assign_to_label; 1112 current_lexeme = rs (operators_argument.where_error).lexeme; 1113 go to report_error; 1114 1115 bad_evaluated_input: 1116 operators_argument.error_code = apl_error_table_$bad_evaluated_input; 1117 current_lexeme = current_lexeme + 1; /* assumes only called from bol_re */ 1118 go to report_error; 1119 1120 bad_execute: 1121 operators_argument.error_code = apl_error_table_$bad_execute; 1122 call clean_up_rs; 1123 parse_frame_ptr = last_parse_frame_ptr; 1124 call restore_state; 1125 current_lexeme = 2; 1126 go to report_error; 1127 1128 domain_error_s1: 1129 operators_argument.error_code = apl_error_table_$domain; 1130 current_lexeme = rs (start - 1).lexeme; 1131 go to report_error; 1132 1133 rank_error_s1: 1134 operators_argument.error_code = apl_error_table_$rank; 1135 current_lexeme = rs (start - 1).lexeme; 1136 go to report_error; 1137 1138 execute_error_s0: 1139 parse_frame_ptr = last_parse_frame_ptr; 1140 call restore_state; 1141 operators_argument.error_code = apl_error_table_$execute; 1142 current_lexeme = rs (current_parseme - 1).lexeme; 1143 go to report_error; 1144 1145 depth_error: 1146 operators_argument.error_code = apl_error_table_$depth; 1147 /* depth errors get special handling. */ 1148 1149 join_depth_handler: 1150 call apl_error_ (operators_argument.error_code, ""b, 0, "", null, 0); 1151 call reset_interrupt_info; 1152 call initialize_suspended_frame; 1153 go to read_and_lex_line; 1154 1155 cant_get_stop_trace: 1156 operators_argument.error_code = apl_error_table_$cant_get_stop_trace; 1157 go to report_error; 1158 1159 not_end_with_value: 1160 operators_argument.error_code = apl_error_table_$not_end_with_value; 1161 go to report_error; 1162 1163 ws_full_no_quota_error: 1164 ws_info.dont_interrupt_parse = "1"b; 1165 operators_argument.error_code = apl_error_table_$ws_full_no_quota; 1166 1167 /* because the apl_lex_ routine which is used to help position the error marker uses 1168* several pages of free storage (on the various stacks), we would probably take a 1169* fatal process error if the quota fault is on the process directory. Until this 1170* code can be upgraded to check the pdir quota, or to check the quota on the directory 1171* containing the segment on which we faulted, we will just play it safe and not 1172* call the lex. (thus avoiding recursive RQO faults). sigh. */ 1173 1174 have_a_line = "0"b; 1175 go to report_error; 1176 1177 dirty_stop: 1178 call reset_interrupt_info; 1179 operators_argument.error_code = apl_error_table_$interrupt; 1180 go to report_error; 1181 1182 pull_system_error: 1183 operators_argument.error_code = apl_error_table_$pull_system_error; 1184 go to report_error; 1185 1186 pull_assign_system_error: 1187 operators_argument.error_code = apl_error_table_$pull_assign_system_error; 1188 go to report_error; 1189 1190 report_error_system_error: 1191 operators_argument.error_code = apl_error_table_$report_error_system_error; 1192 go to join_depth_handler; /* special action to avoid loop */ 1193 1194 done_line_system_error: 1195 operators_argument.error_code = apl_error_table_$done_line_system_error; 1196 go to report_error; 1197 1198 report_error_from_operator: 1199 current_lexeme = rs (operators_argument.where_error).lexeme; 1200 1201 report_error: 1202 if (parse_frame.parse_frame_type = suspended_frame_type) | (parse_frame.parse_frame_type = evaluated_frame_type) 1203 then do; 1204 if have_a_line 1205 then call apl_line_lex_ (input_buffer.line, error_mark_structure_ptr, was_error, current_lexeme, 1206 addr (rs (current_parseme + 1))); 1207 else do; 1208 n_read = 0; /* if no line, pass a null string to apl_error_ */ 1209 error_mark_structure_ptr = parse_frame_ptr; 1210 /* (KLUDGE) values won't be used, can point anywhere. */ 1211 end; 1212 1213 packed_temp_ptr = null; 1214 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, input_buffer.line, 1215 packed_temp_ptr, 0); 1216 end; 1217 else if parse_frame_type = function_frame_type 1218 then do; 1219 symbol_ptr_unal = parse_frame.lexed_function_bead_ptr -> lexed_function_bead.name; 1220 meaning_ptr_unal = parse_frame.function_bead_ptr; 1221 if meaning_ptr_unal -> function_bead.class ^= 0 1222 then do; 1223 1224 /* error while executing in locked function - cause domain error in caller */ 1225 1226 operators_argument.error_code = apl_error_table_$locked_function_error; 1227 parse_frame_ptr = parse_frame.last_parse_frame_ptr; 1228 /* unwind */ 1229 call restore_state; 1230 go to report_error; 1231 end; 1232 1233 call apl_function_lex_ (meaning_ptr_unal -> function_bead.text, error_mark_structure_ptr, was_error, 1234 current_lexeme, addr (rs (current_parseme + 1))); 1235 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, 1236 substr (meaning_ptr_unal -> function_bead.text, error_line_index, length_of_line), symbol_ptr_unal, 1237 parse_frame.current_line_number); 1238 1239 end; 1240 else if parse_frame.parse_frame_type = execute_frame_type 1241 then do; 1242 call clean_up_rs; 1243 where_execute_error = current_lexeme; 1244 if parse_frame.lexed_function_bead_ptr ^= null 1245 then call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 1246 parse_frame_ptr = last_parse_frame_ptr; 1247 call restore_state; 1248 1249 if ws_info.long_error_mode 1250 then do; 1251 execute_value_ptr = rs (current_parseme - 2).semantics; 1252 data_elements = execute_value_ptr -> value_bead.total_data_elements; 1253 call apl_execute_lex_ (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, 1254 error_mark_structure_ptr, was_error, where_execute_error, addr (rs (current_parseme + 1))); 1255 packed_temp_ptr = null; 1256 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, 1257 substr (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, 1), 1258 packed_temp_ptr, 0); 1259 end; 1260 1261 current_lexeme = rs (current_parseme - 1).lexeme; 1262 operators_argument.error_code = apl_error_table_$execute; 1263 go to report_error; 1264 end; 1265 else go to report_error_system_error; /* workspace is screwed up */ 1266 1267 recover_from_error: 1268 call reset_interrupt_info; 1269 call clean_up_rs; 1270 1271 if parse_frame_type = suspended_frame_type 1272 then go to next_line; 1273 if parse_frame_type = evaluated_frame_type 1274 then go to next_line; 1275 1276 call save_state; 1277 call push_new_frame; 1278 call initialize_suspended_frame; 1279 go to read_and_lex_line; 1280 1281 /* Called on simple assignmnet and subscripted assignment to get the variable being assigned to. */ 1282 1283 pull_assignment_variable: 1284 current_parseme = current_parseme + 1; /* bump parseme number */ 1285 current_lexeme = current_lexeme - 1; /* and move to the left to get next lexeme */ 1286 rs (current_parseme).lexeme = current_lexeme; /* remember where we got it */ 1287 unspec (rs (current_parseme).bits) = ""b; /* initialize state bits */ 1288 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 1289 1290 if ^operator_ptr -> general_bead.type.symbol 1291 then go to pull_assign_system_error; /* lex is supposed to check */ 1292 1293 rs (current_parseme).semantics = operator_ptr -> symbol_bead.meaning_pointer; 1294 if rs (current_parseme).semantics = null 1295 then go to pull_null_var; /* not yet assigned */ 1296 if rs (current_parseme).semantics -> general_bead.type.value 1297 then do; /* pull variable action - has value that will be replaced */ 1298 rs (current_parseme).type = val_type; 1299 unspec (rs (current_parseme).bits) = value_bits; 1300 rs (current_parseme).semantics -> general_bead.reference_count = 1301 rs (current_parseme).semantics -> general_bead.reference_count + 1; 1302 go to operator_return (return_point); 1303 end; 1304 1305 /* assign to a function or something - barf */ 1306 1307 operators_argument.error_code = apl_error_table_$assign_to_value; 1308 go to report_error; 1309 1310 pull: 1311 current_parseme = current_parseme + 1; /* bump parseme number */ 1312 current_lexeme = current_lexeme - 1; /* and move to the left to get next lexeme */ 1313 rs (current_parseme).lexeme = current_lexeme; /* remember where we got it */ 1314 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 1315 1316 /* Until the compiler optimizes repeated references to bits in the same word, we'll do it by hand 1317* in the following case statement. (We really just want to check general_bead.type.operator, etc). */ 1318 1319 temp18 = string (operator_ptr -> general_bead.type); 1320 /* copy for speed */ 1321 1322 if temp18 = operator_type /* is it an operator? */ 1323 then do; 1324 rs (current_parseme).type = operator_ptr -> operator_bead.type_code; 1325 unspec (rs (current_parseme).bits) = unspec (operator_ptr -> operator_bead.bits_for_parse); 1326 1327 /* Until compiler combines tests before it combines common subexpressions, the 1328* following kludgy code is the only way to test both the system_variable and stop_trace bits */ 1329 1330 if (unspec (rs (current_parseme).bits) & "101000000000000000"b) ^= ""b 1331 then if rs (current_parseme).stop_trace_control 1332 then go to pull_stop_trace; 1333 else go to pull_system_variable; 1334 else go to operator_return (return_point); 1335 end; 1336 else if temp18 = symbol_type /* is it a symbol? */ 1337 then do; 1338 if current_lexeme > 1 1339 & current_lexeme < lexed_function_bead_ptr -> statement_map (parse_frame.current_line_number) 1340 then do; /* Check if symbol should be passed by name. */ 1341 temp_ptr = operator_ptr -> symbol_bead.meaning_pointer; 1342 if temp_ptr ^= null 1343 then if ^temp_ptr -> general_bead.value 1344 then goto not_by_name; /* Must be undefined or a value. */ 1345 temp_ptr = lexed_function_bead_ptr -> lexeme_array_ptr 1346 -> lexed_function_lexeme_array (current_lexeme - 1); 1347 if string (temp_ptr -> general_bead.type) ^= operator_type 1348 then goto not_by_name; /* Must be preceded by a 'qCALL' ";". */ 1349 if temp_ptr -> operator_bead.op1 ^= quadcall_semicolon_code 1350 then goto not_by_name; /* Must be preceded by a 'qCALL' ";". */ 1351 temp_ptr = lexed_function_bead_ptr -> lexeme_array_ptr 1352 -> lexed_function_lexeme_array (current_lexeme + 1); 1353 if string (temp_ptr -> general_bead.type) ^= operator_type 1354 then goto not_by_name; /* Must be followed by a 'qCALL' ";" or ")". */ 1355 if temp_ptr -> operator_bead.op1 ^= quadcall_semicolon_code 1356 & temp_ptr -> operator_bead.type_code ^= close_paren_type 1357 then goto not_by_name; /* Must be followed by a 'qCALL' ";" or ")". */ 1358 rs (current_parseme).semantics = operator_ptr; /* semantics is symbol itself */ 1359 rs (current_parseme).type = val_type; 1360 unspec (rs (current_parseme).bits) = value_bits; 1361 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme). 1362 semantics -> general_bead.reference_count + 1; 1363 go to operator_return (return_point); 1364 not_by_name: 1365 end; 1366 rs (current_parseme).semantics = operator_ptr -> symbol_bead.meaning_pointer; 1367 /* semantics is where symbol pts */ 1368 if rs (current_parseme).semantics = null/* no value yet */ 1369 then do; 1370 1371 pull_null_var: 1372 rs (current_parseme).type = val_type; 1373 unspec (rs (current_parseme).bits) = ""b; 1374 if rs (current_parseme - 1).type ^= op_type 1375 then call value_error_reporter (current_lexeme); 1376 if rs (current_parseme - 1).op1 ^= assignment_code 1377 then call value_error_reporter (current_lexeme); 1378 1379 unspec (rs (current_parseme).bits) = value_bits; 1380 go to operator_return (return_point); 1381 end; 1382 1383 if rs (current_parseme).semantics -> general_bead.type.value 1384 then do; 1385 rs (current_parseme).type = val_type; 1386 unspec (rs (current_parseme).bits) = value_bits; 1387 rs (current_parseme).semantics -> general_bead.reference_count = 1388 rs (current_parseme).semantics -> general_bead.reference_count + 1; 1389 go to operator_return (return_point); 1390 end; 1391 1392 if rs (current_parseme).semantics -> general_bead.type.function 1393 then do; 1394 temp_ptr = rs (current_parseme).semantics -> function_bead.lexed_function_bead_pointer; 1395 rs (current_parseme).type = op_type; 1396 unspec (rs (current_parseme).bits) = ""b; 1397 if temp_ptr = null /* unlexed function */ 1398 then do; 1399 temp_ptr = rs (current_parseme).semantics; 1400 1401 if temp_ptr -> function_bead.class > 1 1402 /* external function */ 1403 then do; 1404 call apl_external_fcn_addr_ (temp_ptr -> function_bead.text, 1405 temp_ptr -> function_bead.lexed_function_bead_pointer); 1406 if temp_ptr -> function_bead.lexed_function_bead_pointer = null 1407 then go to recover_from_error; 1408 end; 1409 else do; 1410 call apl_function_lex_no_messages_ (operator_ptr 1411 -> symbol_bead.meaning_pointer -> function_bead.text, 1412 temp_ptr -> function_bead.lexed_function_bead_pointer, was_error, 0, 1413 addr (rs (current_parseme + 1)), (0)); 1414 if was_error 1415 then go to recover_from_error; 1416 end; 1417 temp_ptr = temp_ptr -> function_bead.lexed_function_bead_pointer; 1418 end; 1419 rs (current_parseme).semantics -> general_bead.reference_count = 1420 rs (current_parseme).semantics -> general_bead.reference_count + 1; 1421 1422 if rs (current_parseme).semantics -> function_bead.class > 1 1423 then unspec (rs (current_parseme).bits) = 1424 external_function_bits (rs (current_parseme).semantics -> function_bead.class); 1425 else unspec (rs (current_parseme).bits) = 1426 unspec (temp_ptr -> lexed_function_bead.bits_for_parse); 1427 rs (current_parseme).semantics_valid = "1"b; 1428 1429 if ^rs (current_parseme).bits.monadic 1430 then if ^rs (current_parseme).bits.dyadic 1431 then do; 1432 number_of_arguments = 0; 1433 put_result = current_parseme; 1434 start = current_parseme - 1; 1435 go to invoke_niladic_function; 1436 end; 1437 go to operator_return (return_point); 1438 end; 1439 1440 rs (current_parseme).type = val_type; /* get here if symbol isn't bound to a value */ 1441 unspec (rs (current_parseme).bits) = ""b; 1442 /* or function...make rs consistent */ 1443 rs (current_parseme).semantics = null; /* again so we can keep running. */ 1444 end; 1445 else if (temp18 & value_type) = value_type /* is it a value? */ 1446 then do; 1447 operator_ptr -> general_bead.reference_count = operator_ptr -> general_bead.reference_count + 1; 1448 rs (current_parseme).semantics = operator_ptr; 1449 rs (current_parseme).type = val_type; 1450 unspec (rs (current_parseme).bits) = value_bits; 1451 go to operator_return (return_point); 1452 end; 1453 1454 go to pull_system_error; /* invalid lexeme or invalid meaning for name */ 1455 1456 pull_system_variable: 1457 if rs (current_parseme).op1 ^= 0 1458 then do; 1459 operators_argument.op1 = rs (current_parseme).op1; 1460 operators_argument.where_error = current_parseme; 1461 operators_argument.error_code = 0; 1462 1463 /* If op1 is code for niladic file system functions qFNAMES 1464* or qFNUMS, call the file system. */ 1465 1466 if (operators_argument.op1 = fnames_code) | (operators_argument.op1 = fnums_code) 1467 then call apl_file_system_$niladic_functions (operators_argument); 1468 else call apl_system_variables_ (operators_argument); 1469 if operators_argument.error_code ^= 0 1470 then go to report_error_from_operator; 1471 1472 rs (current_parseme).semantics = operators_argument.result; 1473 unspec (rs (current_parseme).bits) = computed_value_bits; 1474 /* force the right bits on */ 1475 rs (current_parseme).type = val_type; 1476 go to operator_return (return_point); 1477 end; 1478 1479 put_result = current_parseme; 1480 call save_state; 1481 call push_new_frame; 1482 parse_frame_type = evaluated_frame_type; 1483 parse_frame.number_of_ptrs, number_of_ptrs = 3; 1484 go to read_and_lex_line; 1485 1486 pull_stop_trace: 1487 current_lexeme = current_lexeme - 1; 1488 temp_ptr = operator_ptr; 1489 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 1490 rs (current_parseme).semantics = null; 1491 if operator_ptr -> meaning_pointer = null 1492 then go to cant_get_stop_trace; 1493 operator_ptr = operator_ptr -> meaning_pointer; 1494 if ^operator_ptr -> general_bead.function 1495 then go to cant_get_stop_trace; 1496 1497 if temp_ptr -> operator_bead.op1 = stop_code 1498 then rs (current_parseme).semantics = operator_ptr -> function_bead.stop_control_pointer; 1499 else if temp_ptr -> operator_bead.op1 = trace_code 1500 then rs (current_parseme).semantics = operator_ptr -> function_bead.trace_control_pointer; 1501 else if temp_ptr -> operator_bead.op1 = assign_to_stop_code 1502 then rs (current_parseme).semantics = operator_ptr; 1503 else rs (current_parseme).semantics = operator_ptr; 1504 1505 if rs (current_parseme).semantics = null 1506 then go to cant_get_stop_trace; 1507 1508 rs (current_parseme).semantics -> general_bead.reference_count = 1509 rs (current_parseme).semantics -> general_bead.reference_count + 1; 1510 1511 go to operator_return (return_point); 1512 1513 do_dyadic: 1514 print_final_value = "1"b; 1515 operators_argument.where_error = start - 1; 1516 if ^rs (start - 1).bits.dyadic 1517 then go to improper_dyadic_usage; 1518 if rs (start - 1).bits.inner_product 1519 then go to do_inner_product; 1520 go to dyadic_action (dyadic_table (rs (start - 1).bits.op1)); 1521 1522 dyadic_action (1): /* scalar dyadic operators */ 1523 call setup_dyadic_operator_routine_call; 1524 call apl_dyadic_ (operators_argument); 1525 call finish_dyadic_operator_routine_call; 1526 go to operator_return (return_point); 1527 1528 dyadic_action (2): /* (non-subscripted) assignment */ 1529 print_final_value = "0"b; 1530 1531 if rs (start - 2).semantics = null /* rhs */ 1532 then go to value_error_s2; 1533 1534 if rs (start).semantics_valid /* lhs was pulled onto rs, but we don't */ 1535 then if ^rs (start).semantics_on_stack /* need it ... wash the ptr to it. */ 1536 then if rs (start).semantics ^= null 1537 then call decrement_reference_count (rs (start).semantics); 1538 1539 temp_ptr = 1540 lexed_function_bead_ptr -> lexed_function_bead.lexeme_array_ptr 1541 -> lexed_function_lexeme_array (rs (start).lexeme); 1542 /* get ptr to symbol_bead for lhs */ 1543 1544 if ^temp_ptr -> general_bead.symbol /* lhs must be a symbol */ 1545 then go to bad_assignment; 1546 1547 if temp_ptr -> symbol_bead.meaning_pointer ^= null 1548 then if temp_ptr -> symbol_bead.meaning_pointer -> general_bead.label 1549 then go to bad_assign_to_label; /* lhs cannot be a label */ 1550 1551 /* CASE 1: If the rhs is already in the heap (and isn't a label) we can assign it by reference. 1552* The reference count of the rhs is bumped by 2 because both the meaning_pointer 1553* and rs (put_result).semantics point to it. The fact that rs (start-2).semantics also 1554* also points to it is already counted for...it will be washed away, below. */ 1555 1556 if ^rs (start - 2).semantics_on_stack /* if rhs on heap */ & ^rs (start - 2).semantics -> value_bead.label 1557 /* if rhs is not a label */ 1558 then do; 1559 if temp_ptr -> symbol_bead.meaning_pointer ^= null 1560 then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 1561 /* drop lhs ref ct */ 1562 1563 rs (start - 2).semantics -> general_bead.reference_count = 1564 rs (start - 2).semantics -> general_bead.reference_count + 2; 1565 1566 temp_ptr -> symbol_bead.meaning_pointer = rs (start - 2).semantics; 1567 /* assign it */ 1568 end; 1569 1570 else if temp_ptr -> symbol_bead.meaning_pointer ^= null /* lhs has meaning */ 1571 then if temp_ptr -> symbol_bead.meaning_pointer -> general_bead.reference_count = 1 1572 & string (rs (start - 2).semantics -> general_bead.bead_type) 1573 = string (temp_ptr -> symbol_bead.meaning_pointer -> general_bead.bead_type) 1574 & substr (string (rs (start - 2).semantics -> general_bead.data_type), 1, 3) 1575 = substr (string (temp_ptr -> symbol_bead.meaning_pointer -> general_bead.data_type), 1, 3) 1576 & rs (start - 2).semantics -> value_bead.total_data_elements 1577 = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.total_data_elements 1578 & rs (start - 2).semantics -> value_bead.rhorho 1579 = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rhorho 1580 then do; 1581 1582 /* CASE 2: lhs has a value, it is unshared, and it occupies 1583* the same number of words as the rhs. The rhs is just copied over the lhs */ 1584 1585 string (temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_type) = 1586 string (rs (start - 2).semantics -> value_bead.data_type); 1587 1588 data_elements = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.total_data_elements; 1589 1590 if temp_ptr -> symbol_bead.meaning_pointer -> value_bead.character_value 1591 then temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_pointer -> character_string_overlay = 1592 rs (start - 2).semantics -> value_bead.data_pointer -> character_string_overlay; 1593 else temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_pointer -> numeric_datum (*) = 1594 rs (start - 2).semantics -> value_bead.data_pointer -> numeric_datum (*); 1595 1596 if temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rhorho ^= 0 1597 /* make check 'cause PL/I won't */ 1598 then temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rho (*) = 1599 rs (start - 2).semantics -> value_bead.rho (*); 1600 1601 /* The reference count is 2 because both the meaning_pointer and rs (put_result).semantics 1602* point to the bead. */ 1603 1604 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count = 2; 1605 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.label = "0"b; 1606 end; 1607 1608 else goto case_3; /* else clause for multiple "and" clause test above */ 1609 1610 else do; /* else clause for null pointer test */ 1611 1612 /* CASE 3: Everything else comes here. We have to copy the rhs into the heap 1613* and make the lhs point to it. The reference count of the lhs is bumped by 1 1614* because both the meaning_pointer and rs (put_result).semantics point to it. */ 1615 1616 case_3: 1617 if temp_ptr -> symbol_bead.meaning_pointer ^= null 1618 /* drop old meaning */ 1619 then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 1620 1621 ws_info.dont_interrupt_parse = "0"b; /* unmask so RQO handler can get control */ 1622 call apl_copy_value_ (rs (start - 2).semantics, temp_ptr -> symbol_bead.meaning_pointer); 1623 ws_info.dont_interrupt_parse = "1"b; /* remask */ 1624 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.label = "0"b; 1625 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count = 1626 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count + 1; 1627 end; 1628 1629 if rs (start - 2).semantics_on_stack 1630 then ws_info.value_stack_ptr = rs (start - 2).semantics; 1631 else call decrement_reference_count (rs (start - 2).semantics); 1632 /* wash rs ptr to rhs */ 1633 1634 rs (put_result).semantics = temp_ptr -> symbol_bead.meaning_pointer; 1635 unspec (rs (put_result).bits) = value_bits; 1636 go to operator_return (return_point); 1637 1638 dyadic_action (3): /* dyadic epsilon */ 1639 call setup_dyadic_operator_routine_call; 1640 call apl_dyadic_epsilon_ (operators_argument); 1641 call finish_dyadic_operator_routine_call; 1642 go to operator_return (return_point); 1643 1644 dyadic_action (4): /* index */ 1645 call setup_dyadic_operator_routine_call; 1646 call apl_dyadic_iota_ (operators_argument); 1647 call finish_dyadic_operator_routine_call; 1648 go to operator_return (return_point); 1649 1650 dyadic_action (5): /* invoke dyadic function */ 1651 number_of_arguments = 2; 1652 1653 if ^rs (start - 2).semantics_valid 1654 then call value_error_reporter (start - 2); 1655 if rs (start - 2).semantics = null 1656 then call value_error_reporter (start - 2); 1657 if ^rs (start).semantics_valid 1658 then call value_error_reporter (start); 1659 if rs (start).semantics = null 1660 then call value_error_reporter (start); 1661 1662 invoke_niladic_function: 1663 invoke_monadic_function: 1664 temp_ptr = rs (start - number_of_arguments + 1).semantics; 1665 1666 if temp_ptr -> function_bead.class > 1 1667 then go to invoke_external_function; 1668 1669 temp_ptr = temp_ptr -> function_bead.lexed_function_bead_pointer; 1670 1671 if number_of_arguments = 2 1672 then if ^temp_ptr -> lexed_function_bead.bits_for_parse.dyadic 1673 then go to improper_dyadic_usage; 1674 else ; 1675 else if number_of_arguments = 1 1676 then if ^temp_ptr -> lexed_function_bead.bits_for_parse.monadic 1677 then go to improper_monadic_usage; 1678 else ; 1679 else if temp_ptr -> lexed_function_bead.bits_for_parse.monadic 1680 | temp_ptr -> lexed_function_bead.bits_for_parse.dyadic 1681 then go to improper_niladic_usage; 1682 1683 call save_state; 1684 call push_new_frame; 1685 1686 /* Initialize the new function frame. */ 1687 1688 parse_frame.parse_frame_type = function_frame_type; 1689 parse_frame.current_line_number = 1; 1690 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 1691 1692 parse_frame.function_bead_ptr = rs (start - number_of_arguments + 1).semantics; 1693 lexed_function_bead_ptr, 1694 parse_frame.lexed_function_bead_ptr = 1695 parse_frame.function_bead_ptr -> function_bead.lexed_function_bead_pointer; 1696 lexed_function_bead_ptr -> general_bead.reference_count = 1697 lexed_function_bead_ptr -> general_bead.reference_count + 1; 1698 1699 /* Localize local names and labels. */ 1700 1701 parse_frame.number_of_ptrs, 1702 number_of_ptrs = lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 1703 do i = 1 to lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 1704 temp_ptr = lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (i); 1705 if temp_ptr ^= null 1706 then if temp_ptr -> general_bead.symbol 1707 then do; 1708 parse_frame.old_meaning_ptrs (i) = temp_ptr -> symbol_bead.meaning_pointer; 1709 temp_ptr -> symbol_bead.meaning_pointer = null; 1710 end; 1711 else do; /* must be operator bead for localized system variable */ 1712 parse_frame.old_meaning_ptrs (i) = save_system_variable_value (temp_ptr); 1713 end; 1714 else parse_frame.old_meaning_ptrs (i) = null; 1715 end; 1716 1717 number_of_non_labels = 1718 lexed_function_bead_ptr -> number_of_localized_symbols - lexed_function_bead_ptr -> number_of_labels; 1719 1720 do i = lexed_function_bead_ptr -> number_of_localized_symbols to number_of_non_labels + 1 by -1; 1721 temp_ptr = lexed_function_bead_ptr -> localized_symbols (i); 1722 temp_ptr -> meaning_pointer = 1723 lexed_function_bead_ptr -> label_values_ptr -> lexed_function_label_values (i - number_of_non_labels); 1724 temp_ptr -> meaning_pointer -> general_bead.reference_count = 1725 temp_ptr -> meaning_pointer -> general_bead.reference_count + 1; 1726 end; 1727 1728 /* Copy the arguments into the heap...arguments must look like real values, not stack temps. */ 1729 1730 temp_ptr = rsp; 1731 rsp, reduction_stack_ptr = addrel (parse_frame_ptr, size (parse_frame)); 1732 1733 if number_of_arguments = 2 1734 then do; 1735 call fill_in_arguments (temp_ptr, start - 2, (RightArgSymbol)); 1736 call fill_in_arguments (temp_ptr, start, (LeftArgSymbol)); 1737 end; 1738 else if number_of_arguments = 1 1739 then call fill_in_arguments (temp_ptr, start - 1, (RightArgSymbol)); 1740 1741 go to start_line; 1742 1743 invoke_external_function: 1744 external_function_ptr = rs (start - number_of_arguments + 1).semantics; 1745 1746 if number_of_arguments + 2 ^= external_function_ptr -> function_bead.class 1747 then go to context_error_0; 1748 1749 operators_argument.result = null; 1750 1751 if number_of_arguments = 0 1752 then do; 1753 operators_argument.value (1) = null; 1754 operators_argument.value (2) = null; 1755 operators_argument.on_stack (1) = "0"b; 1756 operators_argument.on_stack (2) = "0"b; 1757 operators_argument.error_code = 0; 1758 dont_interrupt_parse = "0"b; 1759 if dirty_interrupt_pending 1760 then go to dirty_stop; 1761 end; 1762 else if number_of_arguments = 1 1763 then call setup_monadic_operator_routine_call; 1764 else call setup_dyadic_operator_routine_call; 1765 1766 call cu_$ptr_call ((external_function_ptr -> function_bead.lexed_function_bead_pointer), operators_argument); 1767 call decrement_reference_count (rs (start - number_of_arguments + 1).semantics); 1768 1769 if number_of_arguments = 0 1770 then do; 1771 if operators_argument.error_code ^= 0 1772 then go to report_error_from_operator; 1773 1774 dont_interrupt_parse = "1"b; 1775 rs (put_result).semantics = operators_argument.result; 1776 unspec (rs (put_result).bits) = computed_value_bits; 1777 end; 1778 else if number_of_arguments = 1 1779 then call finish_monadic_operator_routine_call; 1780 else call finish_dyadic_operator_routine_call; 1781 1782 rs (put_result).type = val_type; 1783 go to operator_return (return_point); 1784 1785 dyadic_action (6): /* catenate */ 1786 call setup_dyadic_operator_routine_call; 1787 1788 if rs (start - 1).bits.semantics_valid 1789 then operators_argument.dimension = rs_for_op (start - 1).semantics; 1790 else operators_argument.dimension = 1791 max (rs (start).semantics -> value_bead.rhorho, rs (start - 2).semantics -> value_bead.rhorho); 1792 1793 join_catenate: 1794 call apl_catenate_ (operators_argument); 1795 call finish_dyadic_operator_routine_call; 1796 go to operator_return (return_point); 1797 1798 dyadic_action (7): /* compression last */ 1799 call setup_dyadic_operator_routine_call; 1800 operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 1801 1802 join_compression: 1803 if rs (start - 1).semantics_valid 1804 then operators_argument.dimension = rs_for_op (start - 1).semantics; 1805 1806 call apl_compression_ (operators_argument); 1807 call finish_dyadic_operator_routine_call; 1808 go to operator_return (return_point); 1809 1810 dyadic_action (8): /* expansion last */ 1811 call setup_dyadic_operator_routine_call; 1812 operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 1813 1814 join_expansion: 1815 if rs (start - 1).semantics_valid 1816 then operators_argument.dimension = rs_for_op (start - 1).semantics; 1817 1818 call apl_expansion_ (operators_argument); 1819 call finish_dyadic_operator_routine_call; 1820 go to operator_return (return_point); 1821 1822 dyadic_action (9): /* dyadic file system functions */ 1823 call setup_dyadic_operator_routine_call; 1824 call apl_file_system_ (operators_argument); 1825 call finish_dyadic_operator_routine_call; 1826 go to operator_return (return_point); 1827 1828 dyadic_action (10): /* dyadic rho */ 1829 call setup_dyadic_operator_routine_call; 1830 call apl_dyadic_rho_ (operators_argument); 1831 call finish_dyadic_operator_routine_call; 1832 go to operator_return (return_point); 1833 1834 dyadic_action (11): /* laminate */ 1835 call setup_dyadic_operator_routine_call; 1836 operators_argument.dimension = rs_for_op (start - 1).semantics; 1837 call apl_laminate_ (operators_argument); 1838 call finish_dyadic_operator_routine_call; 1839 go to operator_return (return_point); 1840 1841 dyadic_action (12): /* compression first */ 1842 call setup_dyadic_operator_routine_call; 1843 operators_argument.dimension = 1; 1844 go to join_compression; 1845 1846 dyadic_action (13): /* expansion first */ 1847 call setup_dyadic_operator_routine_call; 1848 operators_argument.dimension = 1; 1849 go to join_expansion; 1850 1851 dyadic_action (14): /* outer product */ 1852 call setup_dyadic_operator_routine_call; 1853 operators_argument.op1 = rs (start - 1).bits.op2; 1854 call apl_outer_product_ (operators_argument); 1855 call finish_dyadic_operator_routine_call; 1856 go to operator_return (return_point); 1857 1858 dyadic_action (15): /* take */ 1859 call setup_dyadic_operator_routine_call; 1860 call apl_take_ (operators_argument); 1861 call finish_dyadic_operator_routine_call; 1862 go to operator_return (return_point); 1863 1864 dyadic_action (16): /* drop */ 1865 call setup_dyadic_operator_routine_call; 1866 call apl_drop_ (operators_argument); 1867 call finish_dyadic_operator_routine_call; 1868 go to operator_return (return_point); 1869 1870 dyadic_action (17): /* rotate last */ 1871 call setup_dyadic_operator_routine_call; 1872 if rs (start - 1).semantics_valid 1873 then operators_argument.dimension = rs_for_op (start - 1).semantics; 1874 else operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 1875 1876 rotate_either: 1877 call apl_rotate_ (operators_argument); 1878 call finish_dyadic_operator_routine_call; 1879 go to operator_return (return_point); 1880 1881 dyadic_action (18): /* rotate first */ 1882 call setup_dyadic_operator_routine_call; 1883 if rs (start - 1).semantics_valid 1884 then operators_argument.dimension = rs_for_op (start - 1).semantics; 1885 else operators_argument.dimension = 1; 1886 go to rotate_either; 1887 1888 dyadic_action (19): /* dyadic transpose */ 1889 call setup_dyadic_operator_routine_call; 1890 call apl_transpose_ (operators_argument); 1891 call finish_dyadic_operator_routine_call; 1892 go to operator_return (return_point); 1893 1894 dyadic_action (20): /* decode */ 1895 call setup_dyadic_operator_routine_call; 1896 call apl_decode_ (operators_argument); 1897 call finish_dyadic_operator_routine_call; 1898 go to operator_return (return_point); 1899 1900 dyadic_action (21): /* encode */ 1901 call setup_dyadic_operator_routine_call; 1902 call apl_encode_ (operators_argument); 1903 call finish_dyadic_operator_routine_call; 1904 go to operator_return (return_point); 1905 1906 dyadic_action (22): /* catenate first */ 1907 call setup_dyadic_operator_routine_call; 1908 operators_argument.dimension = 1; 1909 go to join_catenate; 1910 1911 dyadic_action (23): /* format */ 1912 call setup_dyadic_operator_routine_call; 1913 call apl_dyadic_format_ (operators_argument); 1914 call finish_dyadic_operator_routine_call; 1915 go to operator_return (return_point); 1916 1917 dyadic_action (24): /* semicolon cons */ 1918 if rs (start).semantics = null 1919 then go to value_error_s0; 1920 1921 if rs (start - 2).semantics = null 1922 then go to value_error_s2; 1923 1924 call append_to_list_bead (addr (rs (start - 2)) -> rs_overlay); 1925 rs (start - 2).semantics -> list_bead.member_ptr (1) = rs (start).semantics; 1926 unspec (rs (start - 2).semantics -> list_bead.bits (1)) = unspec (rs (start).bits); 1927 1928 /* the reference counts are OK... */ 1929 1930 rs (put_result).semantics = rs (start - 2).semantics; 1931 unspec (rs (put_result).bits) = unspec (rs (start - 2).bits); 1932 go to operator_return (return_point); 1933 1934 dyadic_action (25): /* deal */ 1935 call setup_dyadic_operator_routine_call; 1936 call apl_random_ (operators_argument); 1937 call finish_dyadic_operator_routine_call; 1938 go to operator_return (return_point); 1939 1940 dyadic_action (26): /* system functions */ 1941 call setup_dyadic_operator_routine_call; 1942 parse_frame.current_parseme = current_parseme; 1943 call apl_system_functions_ (operators_argument); 1944 call finish_dyadic_operator_routine_call; 1945 go to operator_return (return_point); 1946 1947 dyadic_action (27): /* dyadic domino */ 1948 call setup_dyadic_operator_routine_call; 1949 call apl_domino_operator_ (operators_argument); 1950 call finish_dyadic_operator_routine_call; 1951 go to operator_return (return_point); 1952 1953 dyadic_action (28): /* subscripted assignment */ 1954 print_final_value = "0"b; 1955 operators_argument.error_code = 0; 1956 call apl_subscripted_assignment_ (operators_argument, addr (rs (start))); 1957 1958 if operators_argument.error_code ^= 0 1959 then go to report_error_from_operator; 1960 1961 rs (put_result).semantics = rs (start - 2).semantics; 1962 unspec (rs (put_result).bits) = unspec (rs (start - 2).bits); 1963 go to operator_return (return_point); 1964 1965 dyadic_action (29): /* dyadic ibeam */ 1966 call setup_dyadic_operator_routine_call; 1967 call apl_dyadic_ibeam_ (operators_argument); 1968 call finish_dyadic_operator_routine_call; 1969 go to operator_return (return_point); 1970 1971 do_inner_product: 1972 call setup_dyadic_operator_routine_call; 1973 operators_argument.op2 = rs (start - 1).bits.op2; 1974 call apl_inner_product_ (operators_argument); 1975 call finish_dyadic_operator_routine_call; 1976 go to operator_return (return_point); 1977 1978 do_monadic: 1979 print_final_value = "1"b; 1980 operators_argument.where_error = start; 1981 if ^rs (start).bits.monadic 1982 then go to improper_monadic_usage; 1983 go to monadic_action (monadic_table (rs (start).bits.op1)); 1984 1985 monadic_action (1): /* monadic scalar operators */ 1986 call setup_monadic_operator_routine_call; 1987 call apl_monadic_ (operators_argument); 1988 call finish_monadic_operator_routine_call; 1989 go to operator_return (return_point); 1990 1991 monadic_action (2): /* monadic functions */ 1992 number_of_arguments = 1; 1993 1994 if ^rs (start - 1).semantics_valid 1995 then call value_error_reporter (start - 1); 1996 if rs (start - 1).semantics = null 1997 then call value_error_reporter (start - 1); 1998 1999 go to invoke_monadic_function; 2000 2001 monadic_action (3): /* branch */ 2002 print_final_value = "0"b; 2003 if rs (start - 1).semantics = null 2004 then go to value_error_s0; 2005 2006 /* Get out of any execute frame(s) we are in, and back to the last function frame. */ 2007 2008 do branch_pf_ptr = parse_frame_ptr repeat (branch_pf_ptr -> parse_frame.last_parse_frame_ptr) 2009 while (branch_pf_ptr -> parse_frame.parse_frame_type = execute_frame_type); 2010 end; 2011 2012 if branch_pf_ptr -> parse_frame.parse_frame_type = function_frame_type 2013 then if branch_pf_ptr -> parse_frame.function_bead_ptr -> function_bead.trace_control_pointer ^= null 2014 then if this_statement_is_one (branch_pf_ptr -> parse_frame.current_line_number, 2015 branch_pf_ptr -> parse_frame.function_bead_ptr -> function_bead.trace_control_pointer) 2016 then do; 2017 call print_where_I_am (branch_pf_ptr, "1"b, "0"b); 2018 trace_branch_line = "1"b; 2019 end; 2020 if rs (start - 1).semantics -> value_bead.total_data_elements > 0 2021 then do; 2022 if ^rs (start - 1).semantics -> value_bead.numeric_value 2023 then go to domain_error; 2024 x = rs (start - 1).semantics -> value_bead.data_pointer -> numeric_datum (0); 2025 xx = floor (x + 0.5); 2026 if abs (xx - x) > integer_fuzz 2027 then go to domain_error; 2028 if abs (xx) > 131071 2029 then go to domain_error; /* check if integer & fixable in parse_frame.current_line_number */ 2030 2031 branch_pf_ptr -> parse_frame.current_line_number = fixed (xx, 17) - 1; 2032 /* subtract 1 so that adding 1 later will cancel out */ 2033 was_branch_value = "1"b; 2034 end; 2035 else was_branch_value = "0"b; 2036 was_branch = "1"b; 2037 rs (put_result).semantics = rs (start - 1).semantics; 2038 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 2039 go to operator_return (return_point); 2040 2041 monadic_action (4): /* ravel */ 2042 call setup_monadic_operator_routine_call; 2043 call apl_ravel_ (operators_argument); 2044 call finish_monadic_operator_routine_call; 2045 go to operator_return (return_point); 2046 2047 monadic_action (5): /* reduction last */ 2048 call setup_monadic_operator_routine_call; 2049 2050 if rs (start).bits.semantics_valid 2051 then operators_argument.dimension = rs_for_op (start).semantics; 2052 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 2053 2054 operators_argument.op1 = rs (start).bits.op2; 2055 call apl_reduction_ (operators_argument); 2056 call finish_monadic_operator_routine_call; 2057 go to operator_return (return_point); 2058 2059 monadic_action (6): /* reduction first */ 2060 call setup_monadic_operator_routine_call; 2061 2062 if rs (start).bits.semantics_valid 2063 then operators_argument.dimension = rs_for_op (start).semantics; 2064 else operators_argument.dimension = 1; 2065 2066 operators_argument.op1 = rs (start).bits.op2; 2067 call apl_reduction_ (operators_argument); 2068 call finish_monadic_operator_routine_call; 2069 go to operator_return (return_point); 2070 2071 2072 monadic_action (7): /* scan last */ 2073 call setup_monadic_operator_routine_call; 2074 if rs (start).semantics_valid 2075 then operators_argument.dimension = rs_for_op (start).semantics; 2076 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 2077 2078 operators_argument.op1 = rs (start).op2; 2079 call apl_scan_operator_ (operators_argument); 2080 call finish_monadic_operator_routine_call; 2081 go to operator_return (return_point); 2082 2083 monadic_action (8): /* scan first */ 2084 call setup_monadic_operator_routine_call; 2085 if rs (start).semantics_valid 2086 then operators_argument.dimension = rs_for_op (start).semantics; 2087 else operators_argument.dimension = 1; 2088 2089 operators_argument.op1 = rs (start).op2; 2090 call apl_scan_operator_ (operators_argument); 2091 call finish_monadic_operator_routine_call; 2092 go to operator_return (return_point); 2093 2094 monadic_action (9): /* monadic file system functions */ 2095 call setup_monadic_operator_routine_call; 2096 call apl_file_system_ (operators_argument); 2097 call finish_monadic_operator_routine_call; 2098 go to operator_return (return_point); 2099 2100 monadic_action (10): /* monadic not */ 2101 call setup_monadic_operator_routine_call; 2102 call apl_monadic_not_ (operators_argument); 2103 call finish_monadic_operator_routine_call; 2104 go to operator_return (return_point); 2105 2106 monadic_action (11): /* reverse last */ 2107 call setup_monadic_operator_routine_call; 2108 2109 if rs (start).bits.semantics_valid 2110 then operators_argument.dimension = rs_for_op (start).semantics; 2111 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 2112 2113 reverse_either: 2114 call apl_reverse_ (operators_argument); 2115 call finish_monadic_operator_routine_call; 2116 go to operator_return (return_point); 2117 2118 monadic_action (12): /* reverse first */ 2119 call setup_monadic_operator_routine_call; 2120 2121 if rs (start).bits.semantics_valid 2122 then operators_argument.dimension = rs_for_op (start).semantics; 2123 else operators_argument.dimension = 1; 2124 2125 go to reverse_either; 2126 2127 monadic_action (13): /* monadic transpose */ 2128 call setup_monadic_operator_routine_call; 2129 call apl_transpose_ (operators_argument); 2130 call finish_monadic_operator_routine_call; 2131 go to operator_return (return_point); 2132 2133 monadic_action (14): /* execute */ 2134 execute_value_ptr = rs (start - 1).semantics; 2135 if execute_value_ptr = null 2136 then go to value_error_s1; 2137 data_elements = execute_value_ptr -> value_bead.total_data_elements; 2138 if ^execute_value_ptr -> value_bead.character_value 2139 then if execute_value_ptr -> value_bead.numeric_value & data_elements > 0 2140 then go to domain_error_s1; 2141 if execute_value_ptr -> value_bead.rhorho > 1 2142 then go to rank_error_s1; 2143 2144 call save_state; 2145 call push_new_frame; 2146 parse_frame_type = execute_frame_type; 2147 parse_frame.number_of_ptrs, number_of_ptrs = 3; 2148 rsp, reduction_stack_ptr = addrel (parse_frame_ptr, size (parse_frame)); 2149 2150 current_parseme = 0; /* in case of errors */ 2151 parse_frame.current_parseme = 0; 2152 call apl_execute_lex_ (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, 2153 parse_frame.lexed_function_bead_ptr, was_error, 0, rsp); 2154 if was_error 2155 then go to execute_error_s0; 2156 parse_frame.current_line_number = 1; 2157 go to start_line; 2158 2159 monadic_action (15): /* format */ 2160 call setup_monadic_operator_routine_call; 2161 call apl_monadic_format_ (operators_argument); 2162 call finish_monadic_operator_routine_call; 2163 go to operator_return (return_point); 2164 2165 monadic_action (16): /* ibeam */ 2166 call setup_monadic_operator_routine_call; 2167 call apl_ibeam_ (operators_argument); 2168 call finish_monadic_operator_routine_call; 2169 go to operator_return (return_point); 2170 2171 monadic_action (17): /* assign to quad */ 2172 if rs (start - 1).semantics = null 2173 then go to value_error_s1; 2174 in_printer = "1"b; 2175 call apl_print_value_ (rs (start - 1).semantics, "1"b, "1"b); 2176 in_printer = "0"b; 2177 go to nop_operator; 2178 2179 monadic_action (18): /* assign to quote quad */ 2180 if rs (start - 1).semantics = null 2181 then go to value_error_s1; 2182 in_printer = "1"b; 2183 call apl_print_value_ (rs (start - 1).semantics, "0"b, "1"b); 2184 in_printer = "0"b; 2185 go to nop_operator; 2186 2187 monadic_action (19): /* assign to system variables */ 2188 call setup_monadic_operator_routine_call; 2189 call apl_system_variables_ (operators_argument); 2190 if operators_argument.error_code ^= 0 2191 then go to report_error_from_operator; 2192 2193 nop_operator: 2194 dont_interrupt_parse = "1"b; 2195 print_final_value = "0"b; 2196 rs (put_result).semantics = rs (start - 1).semantics; 2197 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 2198 go to operator_return (return_point); 2199 2200 monadic_action (20): /* assign to system variable which ignores assignment */ 2201 go to nop_operator; 2202 2203 monadic_action (21): /* monadic system functions */ 2204 call setup_monadic_operator_routine_call; 2205 parse_frame.current_parseme = current_parseme; 2206 call apl_system_functions_ (operators_argument); 2207 call finish_monadic_operator_routine_call; 2208 go to operator_return (return_point); 2209 2210 monadic_action (22): /* assign to stop/trace */ 2211 print_final_value = "0"b; 2212 if rs (start - 1).semantics = null 2213 then go to value_error_s2; 2214 2215 temp_ptr = rs (start - 1).semantics; 2216 if rs (start).op1 = assign_to_stop_code 2217 then value_bead_ptr = addr (rs (start).semantics -> function_bead.stop_control_pointer); 2218 else value_bead_ptr = addr (rs (start).semantics -> function_bead.trace_control_pointer); 2219 2220 if temp_ptr -> value_bead.character_value 2221 then if temp_ptr -> value_bead.total_data_elements ^= 0 2222 /* not '' */ 2223 then go to domain_error; 2224 2225 if value_bead_ptr -> based_unaligned_ptr ^= null 2226 then call decrement_reference_count (value_bead_ptr -> based_unaligned_ptr); 2227 2228 assignment_done = "0"b; /* we will turn this on if we are resetting stop/trace */ 2229 2230 if temp_ptr -> value_bead.total_data_elements = 0 2231 then assignment_done = "1"b; 2232 else if (temp_ptr -> value_bead.total_data_elements = 1 2233 & temp_ptr -> value_bead.data_pointer -> numeric_datum (0) = 0.0e0) 2234 then assignment_done = "1"b; 2235 2236 if ^assignment_done 2237 then do; 2238 ws_info.dont_interrupt_parse = "0"b; /* unmask so RQO handler can get control */ 2239 call apl_copy_value_ (rs (start - 1).semantics, value_bead_ptr -> based_unaligned_ptr); 2240 ws_info.dont_interrupt_parse = "1"b; /* remask */ 2241 value_bead_ptr -> based_unaligned_ptr -> value_bead.label = "0"b; 2242 value_bead_ptr -> based_unaligned_ptr -> value_bead.reference_count = 2243 value_bead_ptr -> based_unaligned_ptr -> value_bead.reference_count + 1; 2244 end; 2245 2246 call decrement_reference_count (rs (start).semantics); 2247 rs (put_result).semantics = rs (start - 1).semantics; 2248 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 2249 go to operator_return (return_point); 2250 2251 monadic_action (23): /* monadic iota */ 2252 call setup_monadic_operator_routine_call; 2253 call apl_monadic_iota_ (operators_argument); 2254 call finish_monadic_operator_routine_call; 2255 go to operator_return (return_point); 2256 2257 monadic_action (24): /* monadic rho */ 2258 call setup_monadic_operator_routine_call; 2259 call apl_monadic_rho_ (operators_argument); 2260 call finish_monadic_operator_routine_call; 2261 go to operator_return (return_point); 2262 2263 monadic_action (25): /* monadic domino */ 2264 call setup_monadic_operator_routine_call; 2265 call apl_domino_operator_ (operators_argument); 2266 call finish_monadic_operator_routine_call; 2267 go to operator_return (return_point); 2268 2269 monadic_action (26): /* roll */ 2270 call setup_monadic_operator_routine_call; 2271 call apl_random_ (operators_argument); 2272 call finish_monadic_operator_routine_call; 2273 go to operator_return (return_point); 2274 2275 monadic_action (27): /* grade up */ 2276 call setup_monadic_operator_routine_call; 2277 if rs (start).semantics_valid 2278 then operators_argument.dimension = rs_for_op (start).semantics; 2279 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 2280 2281 call apl_grade_up_ (operators_argument); 2282 call finish_monadic_operator_routine_call; 2283 go to operator_return (return_point); 2284 2285 monadic_action (28): /* grade down */ 2286 call setup_monadic_operator_routine_call; 2287 if rs (start).semantics_valid 2288 then operators_argument.dimension = rs_for_op (start).semantics; 2289 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 2290 2291 call apl_grade_down_ (operators_argument); 2292 call finish_monadic_operator_routine_call; 2293 go to operator_return (return_point); 2294 2295 monadic_action (29): /* monadic laminate (invalid) */ 2296 go to context_error_0; 2297 2298 monadic_action (30): /* monadic qCALL system function */ 2299 call setup_monadic_operator_routine_call; 2300 call apl_quadcall_ (operators_argument); 2301 call finish_monadic_operator_routine_call; 2302 goto operator_return (return_point); 2303 /* INTERNAL PROCEDURES */ 2304 2305 setup_dyadic_operator_routine_call: 2306 proc; 2307 2308 if rs (start).semantics = null 2309 then go to value_error_s0; 2310 if rs (start - 2).semantics = null 2311 then go to value_error_s2; 2312 2313 operators_argument.value (1) = rs (start).semantics; 2314 operators_argument.value (2) = rs (start - 2).semantics; 2315 operators_argument.on_stack (1) = rs (start).bits.semantics_on_stack; 2316 operators_argument.on_stack (2) = rs (start - 2).bits.semantics_on_stack; 2317 operators_argument.op1 = rs (start - 1).bits.op1; 2318 operators_argument.error_code = 0; 2319 2320 dont_interrupt_parse = "0"b; 2321 if dirty_interrupt_pending 2322 then go to dirty_stop; 2323 2324 return; 2325 2326 end; 2327 2328 2329 finish_dyadic_operator_routine_call: 2330 proc; 2331 2332 if operators_argument.error_code ^= 0 /* Operator discovered an error... */ 2333 then go to report_error_from_operator; 2334 2335 ws_info.dont_interrupt_parse = "1"b; 2336 2337 if ^operators_argument.on_stack (1) 2338 then call decrement_reference_count (rs (start).semantics); 2339 2340 if ^operators_argument.on_stack (2) 2341 then call decrement_reference_count (rs (start - 2).semantics); 2342 2343 rs (put_result).semantics = operators_argument.result; 2344 unspec (rs (put_result).bits) = computed_value_bits; 2345 /* force the right bits on */ 2346 2347 return; 2348 2349 end; 2350 2351 setup_monadic_operator_routine_call: 2352 procedure; 2353 2354 if rs (start - 1).semantics = null 2355 then go to value_error_s1; 2356 2357 operators_argument.value (1) = null; 2358 operators_argument.value (2) = rs (start - 1).semantics; 2359 operators_argument.on_stack (1) = "0"b; 2360 operators_argument.on_stack (2) = rs (start - 1).bits.semantics_on_stack; 2361 operators_argument.op1 = rs (start).bits.op1; 2362 operators_argument.error_code = 0; 2363 2364 dont_interrupt_parse = "0"b; 2365 if dirty_interrupt_pending 2366 then go to dirty_stop; 2367 2368 return; 2369 2370 end; 2371 2372 2373 finish_monadic_operator_routine_call: 2374 proc; 2375 2376 if operators_argument.error_code ^= 0 /* Operator ran into a problem... */ 2377 then go to report_error_from_operator; 2378 2379 ws_info.dont_interrupt_parse = "1"b; 2380 2381 if ^operators_argument.on_stack (2) 2382 then call decrement_reference_count (rs (start - 1).semantics); 2383 2384 rs (put_result).semantics = operators_argument.result; 2385 unspec (rs (put_result).bits) = computed_value_bits; 2386 /* force the right bits on */ 2387 2388 return; 2389 2390 end; 2391 2392 /* Function to restore the value of a system variable. In the current implementation, 2393* we get the old value out of a value_bead, and put it back into ws_info. */ 2394 2395 restore_system_variable_value: 2396 procedure (P_operator_bead_ptr, P_bead_ptr); 2397 2398 /* parameters */ 2399 2400 declare ( 2401 P_operator_bead_ptr ptr, 2402 P_bead_ptr ptr unal 2403 ) parameter; 2404 2405 /* automatic */ 2406 2407 declare bead_ptr ptr unal, 2408 value float; 2409 2410 /* builtins */ 2411 2412 declare fixed builtin; 2413 2414 /* program */ 2415 2416 bead_ptr = P_bead_ptr; 2417 2418 if P_operator_bead_ptr -> operator_bead.op2 ^= 4 /* qLX */ 2419 then value = bead_ptr -> value_bead.data_pointer -> numeric_datum (0); 2420 2421 go to set_value (P_operator_bead_ptr -> operator_bead.op1); 2422 2423 set_value (2): /* qCT */ 2424 ws_info.fuzz = value; 2425 go to end_set_value; 2426 2427 set_value (3): /* qIO */ 2428 ws_info.float_index_origin = value; 2429 ws_info.index_origin = fixed (value, 35); 2430 go to end_set_value; 2431 2432 set_value (4): /* qLX */ 2433 call decrement_reference_count (ws_info.latent_expression); 2434 bead_ptr -> general_bead.reference_count = bead_ptr -> general_bead.reference_count + 1; 2435 ws_info.latent_expression = bead_ptr; 2436 go to end_set_value; 2437 2438 set_value (5): /* qPP */ 2439 ws_info.digits = fixed (value, 35); 2440 go to end_set_value; 2441 2442 set_value (6): /* qPW */ 2443 ws_info.width = fixed (value, 35); 2444 go to end_set_value; 2445 2446 set_value (7): /* qRL */ 2447 ws_info.random_link = fixed (value, 35); 2448 go to end_set_value; 2449 2450 set_value (16): /* qIT */ 2451 ws_info.integer_fuzz = value; 2452 go to end_set_value; 2453 2454 end_set_value: 2455 call decrement_reference_count (bead_ptr); 2456 return; 2457 2458 end restore_system_variable_value; 2459 2460 /* Function to localize a system variable. In the current implementation, 2461* we must turn the current value of the system variable into a value_bead, 2462* and return a pointer to that value_bead. */ 2463 2464 save_system_variable_value: 2465 procedure (P_bead_ptr) returns (ptr); 2466 2467 /* parameters */ 2468 2469 declare P_bead_ptr ptr parameter; 2470 2471 /* automatic */ 2472 2473 declare bead_ptr ptr unal, 2474 data_ptr ptr, 2475 n_words fixed bin (19), 2476 value float; 2477 2478 /* builtins */ 2479 2480 declare (addrel, float, rel, size, string) 2481 builtin; 2482 2483 /* entries */ 2484 2485 declare apl_allocate_words_ entry (fixed bin (19), ptr unal); 2486 2487 /* program */ 2488 2489 bead_ptr = P_bead_ptr; 2490 2491 /* We assume that the lex has validated the function so that only system variables 2492* that can actually be localized every reach us. */ 2493 2494 go to get_value (bead_ptr -> operator_bead.op1); 2495 2496 get_value (2): /* qCT */ 2497 value = ws_info.fuzz; 2498 go to end_get_value; 2499 2500 get_value (3): /* qIO */ 2501 value = ws_info.float_index_origin; 2502 go to end_get_value; 2503 2504 get_value (4): /* qLX */ 2505 ws_info.latent_expression -> general_bead.reference_count = 2506 ws_info.latent_expression -> general_bead.reference_count + 1; 2507 return (ws_info.latent_expression); 2508 2509 get_value (5): /* qPP */ 2510 value = float (ws_info.digits, 63); 2511 go to end_get_value; 2512 2513 get_value (6): /* qPW */ 2514 value = float (ws_info.width, 63); 2515 go to end_get_value; 2516 2517 get_value (7): /* qRL */ 2518 value = float (ws_info.random_link, 63); 2519 go to end_get_value; 2520 2521 get_value (16): /* qIT */ 2522 value = ws_info.integer_fuzz; 2523 go to end_get_value; 2524 2525 end_get_value: 2526 number_of_dimensions = 0; 2527 data_elements = 1; 2528 n_words = size (value_bead) + size (numeric_datum) + 1; 2529 call apl_allocate_words_ (n_words, bead_ptr); 2530 2531 string (bead_ptr -> value_bead.type) = numeric_value_type; 2532 bead_ptr -> value_bead.total_data_elements = data_elements; 2533 bead_ptr -> value_bead.rhorho = 0; 2534 data_ptr = addrel (bead_ptr, size (value_bead)); 2535 if substr (rel (data_ptr), 18, 1) 2536 then data_ptr = addrel (data_ptr, 1); 2537 2538 bead_ptr -> value_bead.data_pointer = data_ptr; 2539 data_ptr -> numeric_datum (0) = value; 2540 return (bead_ptr); 2541 2542 end save_system_variable_value; 2543 2544 print_value: 2545 procedure; 2546 2547 /* automatic */ 2548 2549 dcl val_ptr ptr unal; 2550 2551 /* program */ 2552 2553 if rs (current_parseme - 1).semantics_valid 2554 then if rs (current_parseme - 1).semantics ^= null 2555 then do; 2556 val_ptr = rs (current_parseme - 1).semantics; 2557 2558 if ^print_final_value 2559 then if val_ptr -> general_bead.type.list_value 2560 then do; /* check for list of all assignments, suppress printing */ 2561 do i = 1 to val_ptr -> list_bead.number_of_members; 2562 if val_ptr -> list_bead.members (i).bits.op1 = 0 /* non-assignment */ 2563 & val_ptr -> list_bead.member_ptr (i) ^= null 2564 /* non-null list (i.e. not ;;) */ 2565 then print_final_value = "1"b; 2566 /* non assignment appears in list */ 2567 end; 2568 end; 2569 2570 if print_final_value 2571 then do; 2572 in_printer = "1"b; 2573 call apl_print_value_ (val_ptr, "1"b, "1"b); 2574 in_printer = "0"b; 2575 end; 2576 end; 2577 2578 end /* print_value */; 2579 2580 read_executable_input_line: 2581 proc; 2582 2583 /* automatic */ 2584 2585 declare in_constant bit (1) aligned, 2586 n_read_more fixed bin (21), 2587 prompt_length fixed bin (21), 2588 prompt_ptr ptr; 2589 2590 /* entries */ 2591 2592 declare apl_system_error_ entry (fixed bin (35)); 2593 2594 /* program */ 2595 2596 read_again: 2597 have_a_line = "0"b; /* if interrupt, cannot display current line */ 2598 current_parseme = 0; 2599 parse_frame.current_parseme = 0; 2600 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 2601 parse_frame.lexed_function_bead_ptr = null; 2602 parse_frame.number_of_ptrs, number_of_ptrs = 1; /* we'd say 0, except that's not good PL/I */ 2603 2604 /* In a suspended frame (or evaluated input frame) the input buffer overlays the area normally 2605* used by the old meaning ptrs */ 2606 2607 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 2608 input_buffer.n_read = 0; 2609 ok_to_stop_control = "1"b; 2610 2611 call check_for_interrupt_while_input; 2612 2613 if parse_frame_type = suspended_frame_type 2614 then do; 2615 prompt_ptr = addr (ws_info.immediate_input_prompt); 2616 prompt_length = length (ws_info.immediate_input_prompt); 2617 end; 2618 else do; 2619 prompt_ptr = addr (ws_info.evaluated_input_prompt); 2620 prompt_length = length (ws_info.evaluated_input_prompt); 2621 end; 2622 2623 prompt_ptr = addrel (prompt_ptr, 1); /* point to chars in the varying string */ 2624 call iox_$put_chars (apl_static_$apl_output, prompt_ptr, prompt_length, (0)); 2625 2626 max_input_line = 4 * (65536 - binary (rel (input_buffer_ptr), 18)); 2627 2628 call append_to_input_buffer; 2629 can_be_interrupted = "0"b; 2630 2631 packed_temp_ptr = null; 2632 call apl_scan_ (input_buffer.line, 1, input_line_position, (0), scan_token_type, packed_temp_ptr); 2633 2634 if scan_token_type = 1 2635 then if substr (input_buffer.line, input_line_position, 1) = QRightParen 2636 then do; 2637 dont_interrupt_parse = "0"b; 2638 if dirty_interrupt_pending 2639 then go to dirty_stop; 2640 call apl_command_ (input_buffer.line, input_line_position, code); 2641 dont_interrupt_parse = "1"b; 2642 2643 if code = 0 2644 then go to read_again; /* nothing special this time */ 2645 2646 if code = apl_error_table_$return_from_apl 2647 then go to return_statement; 2648 2649 if code = apl_error_table_$ws_cleared 2650 then go to start_anew; 2651 2652 parse_frame_ptr = ws_info.current_parse_frame_ptr; 2653 rsp = parse_frame.reduction_stack_ptr; 2654 2655 if code = apl_error_table_$ws_loaded 2656 then go to ws_just_loaded; 2657 2658 go to read_again; /* this stmt should never be executed */ 2659 end; 2660 else if substr (input_buffer.line, input_line_position, 1) = QDel 2661 | substr (input_buffer.line, input_line_position, 1) = QDelTilde 2662 then do; 2663 dont_interrupt_parse = "0"b; 2664 if dirty_interrupt_pending 2665 then go to dirty_stop; 2666 call apl_editor_ (input_buffer.line, input_line_position, code); 2667 dont_interrupt_parse = "1"b; 2668 if code = apl_error_table_$return_from_apl 2669 then go to return_statement; 2670 if code = apl_error_table_$ws_cleared 2671 then go to start_anew; 2672 go to read_again; 2673 end; 2674 2675 /* check for use of multi-line character constant */ 2676 2677 in_constant = "0"b; 2678 scan_for_constants_again: 2679 do input_line_position = input_line_position by 1 while (input_line_position <= input_buffer.n_read); 2680 if substr (input_buffer.line, input_line_position, 1) = QApostrophe 2681 then in_constant = ^in_constant; 2682 else if ^in_constant 2683 then if substr (input_buffer.line, input_line_position, 1) = QLamp 2684 then go to exitloop; 2685 end; 2686 2687 exitloop: 2688 if in_constant /* constant extends to next line */ 2689 then do; 2690 call check_for_interrupt_while_input; 2691 if max_input_line - input_buffer.n_read < 500 2692 then call apl_system_error_ (apl_error_table_$too_much_input); 2693 2694 call append_to_input_buffer; 2695 can_be_interrupted = "0"b; 2696 input_line_position = input_buffer.n_read - n_read_more + 1; 2697 /* scan the line that was read */ 2698 go to scan_for_constants_again; 2699 end; 2700 2701 parse_frame.current_line_number = 1; 2702 return; 2703 2704 append_to_input_buffer: 2705 procedure; 2706 2707 /* automatic */ 2708 2709 declare got_line bit (1) aligned, 2710 input_read_ptr ptr, 2711 user_input_attachment_known 2712 bit (1) aligned; 2713 2714 /* based */ 2715 2716 declare input_buffer_array (max_input_line) char (1) based (addr (input_buffer.line)); 2717 2718 /* program */ 2719 2720 user_input_attachment_known = "0"b; 2721 got_line = "0"b; 2722 2723 do while (^got_line); 2724 2725 ws_info.dont_interrupt_parse = "0"b; 2726 input_read_ptr = addr (input_buffer_array (input_buffer.n_read + 1)); 2727 call iox_$get_line (apl_static_$apl_input, input_read_ptr, max_input_line - input_buffer.n_read, n_read_more, 2728 code); 2729 ws_info.dont_interrupt_parse = "1"b; 2730 if code = 0 2731 then got_line = "1"b; 2732 else if code = error_table_$short_record /* no trailing NL */ 2733 then do; 2734 n_read_more = n_read_more + 1; 2735 substr (input_buffer.line, input_buffer.n_read + n_read_more, 1) = QNewLine; 2736 got_line = "1"b; 2737 end; 2738 else if code = error_table_$end_of_info 2739 then do; 2740 if user_input_attachment_known 2741 then call apl_system_error_ (apl_error_table_$cant_read_input); 2742 2743 call reattach_user_input; 2744 user_input_attachment_known = "1"b; 2745 end; 2746 end; 2747 input_buffer.n_read = input_buffer.n_read + n_read_more; 2748 2749 end /* append_to_input_buffer */; 2750 2751 check_for_interrupt_while_input: 2752 procedure; 2753 2754 can_be_interrupted = "1"b; 2755 if clean_interrupt_pending 2756 then do; 2757 call apl_error_ (apl_error_table_$interrupt, ""b, 0, "", packed_temp_ptr, 0); 2758 go to recover_from_error; 2759 end; 2760 2761 end /* check_for_interrupt_while_input */; 2762 2763 end /* read_executable_input_line */; 2764 2765 lex_input_line: 2766 procedure (bv_code); 2767 2768 /* parameters */ 2769 2770 declare bv_code fixed bin (35) parameter; 2771 2772 /* program */ 2773 2774 was_error = "0"b; 2775 parse_frame.number_of_ptrs, number_of_ptrs = 1 + divide (input_buffer.n_read + 3, 4, 21, 0); 2776 parse_frame.reduction_stack_ptr, rsp = addrel (parse_frame_ptr, size (parse_frame)); 2777 call apl_line_lex_ (input_buffer.line, parse_frame.lexed_function_bead_ptr, was_error, 0, rsp); 2778 if was_error 2779 then bv_code = 1; 2780 else bv_code = 0; 2781 return; 2782 2783 end lex_input_line; 2784 2785 initialize_suspended_frame: 2786 procedure; 2787 2788 parse_frame.parse_frame_type = suspended_frame_type; 2789 /* it is a suspended frame */ 2790 parse_frame.number_of_ptrs, number_of_ptrs = 3; /* put reduction stack next */ 2791 parse_frame.reduction_stack_ptr, rsp = addrel (parse_frame_ptr, size (parse_frame)); 2792 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 2793 return; 2794 2795 end initialize_suspended_frame; 2796 2797 /* Procedure to wash a pointer (decrement the reference count of the bead pointed at, free the bead 2798* if necessary, and wipe out the original pointer). */ 2799 2800 decrement_reference_count: 2801 procedure (bv_bead_ptr); 2802 2803 /* parameters */ 2804 2805 declare bv_bead_ptr ptr unaligned; 2806 2807 /* program */ 2808 2809 bv_bead_ptr -> general_bead.reference_count = bv_bead_ptr -> general_bead.reference_count - 1; 2810 2811 if bv_bead_ptr -> general_bead.reference_count < 1 2812 then call apl_free_bead_ (bv_bead_ptr); 2813 2814 bv_bead_ptr = null; /* since heap ptrs are passed by reference, this will */ 2815 return; /* actually null out whatever variable pointer here. */ 2816 2817 end decrement_reference_count; 2818 2819 clean_up_rs: 2820 proc; 2821 2822 do current_parseme = current_parseme to 1 by -1; 2823 if rs (current_parseme).bits.has_list 2824 then call free_list_bead (rs (current_parseme).semantics); 2825 2826 if rs (current_parseme).type = val_type 2827 then if rs (current_parseme).bits.semantics_valid 2828 then if rs (current_parseme).semantics ^= null 2829 then if ^rs (current_parseme).bits.semantics_on_stack 2830 then call decrement_reference_count (rs (current_parseme).semantics); 2831 end; 2832 2833 parse_frame.current_parseme = 0; 2834 ws_info.value_stack_ptr = parse_frame.initial_value_stack_ptr; 2835 return; 2836 2837 end; 2838 2839 save_state: 2840 proc; 2841 2842 parse_frame.current_parseme = current_parseme; 2843 parse_frame.current_lexeme = current_lexeme; 2844 parse_frame.return_point = return_point; 2845 parse_frame.put_result = put_result; 2846 parse_frame.print_final_value = print_final_value; 2847 return; 2848 2849 end; 2850 2851 restore_state: 2852 proc; 2853 2854 print_final_value = parse_frame.print_final_value; 2855 was_branch = "0"b; 2856 was_branch_value = "0"b; 2857 trace_branch_line = "0"b; 2858 2859 restore_state_after_execute: 2860 entry (); 2861 2862 current_parseme = parse_frame.current_parseme; 2863 current_lexeme = parse_frame.current_lexeme; 2864 return_point = parse_frame.return_point; 2865 put_result = parse_frame.put_result; 2866 lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 2867 ws_info.current_parse_frame_ptr = parse_frame_ptr; 2868 rsp = parse_frame.reduction_stack_ptr; 2869 2870 number_of_ptrs = 1; /* I'm not sure these stmts are necessary */ 2871 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 2872 /* .. */ 2873 2874 /* Due to an oversight in the original implementation, the variables 2875* "start" and "number_of_arguments" were not saved in the parse_frame. 2876* Since the format of saved workspaces would have to be changed to save them 2877* now (and we would still have to be able to run with old workspaces), it seems 2878* easier to recalculate them here. */ 2879 2880 if return_point = 2 2881 then do; 2882 start = current_parseme; 2883 number_of_arguments = 2; 2884 end; 2885 else do; 2886 start = current_parseme - 1; 2887 2888 if return_point >= 8 2889 then number_of_arguments = 0; 2890 else number_of_arguments = 1; 2891 end; 2892 2893 return; 2894 2895 end; 2896 2897 value_error_reporter: 2898 proc (where); 2899 2900 dcl where fixed bin; 2901 2902 operators_argument.error_code = apl_error_table_$value; 2903 current_lexeme = where; 2904 go to report_error; 2905 2906 end; 2907 2908 push_new_frame: 2909 proc; 2910 2911 temp_ptr = addr (rs (current_parseme + 1)); 2912 temp_ptr -> last_parse_frame_ptr = parse_frame_ptr; 2913 parse_frame_ptr = temp_ptr; 2914 ws_info.current_parse_frame_ptr = parse_frame_ptr; 2915 parse_frame.lexed_function_bead_ptr = null; 2916 parse_frame.current_parseme = 0; 2917 current_parseme = 0; 2918 2919 if fixed (rel (ws_info.current_parse_frame_ptr), 18) > max_parse_stack_depth 2920 then go to depth_error; 2921 2922 return; 2923 2924 end; 2925 2926 /* Mixed output hangs a list_bead off of the right-end (RE) parseme. 2927* This procedure knows how to (re)allocate it so that a new value can be added on the front. */ 2928 2929 append_to_list_bead: 2930 proc (reduction); 2931 2932 /* parameters */ 2933 2934 dcl 1 reduction aligned, 2935 2 type fixed bin, 2936 2 bits unaligned like operator_bead.bits_for_parse, 2937 2 semantics ptr unaligned, 2938 2 lexeme fixed bin; 2939 2940 /* program */ 2941 2942 if reduction.semantics_valid 2943 then if reduction.semantics -> general_bead.list_value 2944 then n_members = reduction.semantics -> list_bead.number_of_members + 1; 2945 else n_members = 2; 2946 else n_members = 1; 2947 2948 temp_ptr = apl_push_stack_ (size (list_bead)); 2949 unspec (temp_ptr -> list_bead.type) = list_value_type; 2950 temp_ptr -> list_bead.reference_count = -1; 2951 temp_ptr -> list_bead.number_of_members = n_members; 2952 2953 if ^reduction.semantics_valid 2954 then do; 2955 reduction.semantics_valid = "1"b; 2956 reduction.semantics_on_stack = "1"b; 2957 reduction.has_list = "1"b; 2958 reduction.semantics = temp_ptr; 2959 return; 2960 end; 2961 2962 if reduction.semantics -> general_bead.list_value 2963 then do i = 2 to temp_ptr -> list_bead.number_of_members; 2964 unspec (temp_ptr -> list_bead.members (i)) = unspec (reduction.semantics -> list_bead.members (i - 1)); 2965 end; 2966 else do; 2967 temp_ptr -> list_bead.member_ptr (2) = reduction.semantics; 2968 unspec (temp_ptr -> list_bead.bits (2)) = unspec (reduction.bits); 2969 unspec (reduction.bits) = ""b; 2970 reduction.semantics_valid = "1"b; 2971 reduction.semantics_on_stack = "1"b; 2972 reduction.has_list = "1"b; 2973 end; 2974 2975 reduction.semantics = temp_ptr; 2976 return; 2977 2978 end; 2979 2980 free_list_bead: 2981 proc (which); 2982 2983 dcl i fixed bin, 2984 which ptr unal; 2985 2986 do i = 1 to which -> list_bead.number_of_members; 2987 if which -> list_bead.member_ptr (i) ^= null 2988 then if ^which -> list_bead.bits (i).semantics_on_stack 2989 then call decrement_reference_count (which -> list_bead.member_ptr (i)); 2990 end; 2991 2992 return; 2993 2994 end; 2995 2996 2997 restore_old_meanings: 2998 procedure; 2999 3000 do i = 1 to lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 3001 temp_ptr = lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (i); 3002 if temp_ptr ^= null 3003 then if temp_ptr -> general_bead.symbol 3004 then do; 3005 if temp_ptr -> symbol_bead.meaning_pointer ^= null 3006 then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 3007 3008 temp_ptr -> symbol_bead.meaning_pointer = parse_frame.old_meaning_ptrs (i); 3009 end; 3010 else do; /* must be a localized system var */ 3011 call restore_system_variable_value (temp_ptr, parse_frame.old_meaning_ptrs (i)); 3012 end; 3013 end; 3014 3015 return; 3016 3017 end /* restore_old_meanings */; 3018 3019 check_trace_vector: 3020 procedure; 3021 3022 /* program */ 3023 3024 if ^was_branch 3025 then if this_statement_is_one (parse_frame.current_line_number, 3026 parse_frame.function_bead_ptr -> function_bead.trace_control_pointer) 3027 then do; 3028 print_final_value = "1"b; 3029 if ^rs (current_parseme - 1).semantics_valid | rs (current_parseme - 1).semantics = null 3030 then call print_where_I_am (parse_frame_ptr, "0"b, "1"b); 3031 else call print_where_I_am (parse_frame_ptr, "0"b, "0"b); 3032 end; 3033 3034 end /* check_trace_vector */; 3035 3036 this_statement_is_one: 3037 procedure (P_line_number, P_ptr_to_vb) returns (bit (1) aligned); 3038 3039 /* parameters */ 3040 3041 declare ( 3042 P_line_number fixed bin, 3043 P_ptr_to_vb ptr unal 3044 ) parameter; 3045 3046 /* automatic */ 3047 3048 declare ptr_to_vb pointer; 3049 3050 /* program */ 3051 3052 ptr_to_vb = P_ptr_to_vb; 3053 x = P_line_number; 3054 3055 do i = 0 by 1 while (i < ptr_to_vb -> value_bead.total_data_elements); 3056 xx = ptr_to_vb -> value_bead.data_pointer -> numeric_datum (i); 3057 if x = xx 3058 then return ("1"b); 3059 if abs (x - xx) < fuzz * abs (x + xx) 3060 then return ("1"b); 3061 end; 3062 return ("0"b); 3063 3064 end /* this_statement_is_one */; 3065 3066 print_where_I_am: 3067 procedure (P_frame_ptr, P_add_arrow, P_add_nl); 3068 3069 /* parameters */ 3070 3071 declare ( 3072 P_frame_ptr ptr, 3073 (P_add_arrow, P_add_nl) 3074 bit (1) aligned 3075 ) parameter; 3076 3077 /* pictures */ 3078 3079 declare line_number picture "zzzzzzzzzz9"; /* 11 digits */ 3080 3081 /* automatic */ 3082 3083 declare (first_nonblank, line_len, linex, n_nonblank) 3084 fixed bin (21), 3085 sp ptr; 3086 3087 /* based */ 3088 3089 declare line char (line_len) based (addr (rs (current_parseme + 1))); 3090 3091 /* program */ 3092 3093 sp = P_frame_ptr -> parse_frame.lexed_function_bead_ptr -> lexed_function_bead.name; 3094 linex = length (sp -> symbol_bead.name); 3095 substr (line, 1, linex) = sp -> symbol_bead.name; 3096 linex = linex + 1; 3097 3098 substr (line, linex, 1) = QLeftBracket; 3099 linex = linex + 1; 3100 3101 line_number = P_frame_ptr -> parse_frame.current_line_number; 3102 first_nonblank = verify (line_number, " "); 3103 n_nonblank = length (line_number) - first_nonblank + 1; 3104 substr (line, linex, n_nonblank) = substr (line_number, first_nonblank, n_nonblank); 3105 linex = linex + n_nonblank; 3106 3107 substr (line, linex, 1) = QRightBracket; 3108 linex = linex + 1; 3109 3110 if P_add_arrow 3111 then do; 3112 substr (line, linex, 2) = " " || QRightArrow; 3113 linex = linex + 2; 3114 end; 3115 3116 if ^P_add_nl 3117 then do; 3118 substr (line, linex, 1) = " "; 3119 linex = linex + 1; 3120 end; 3121 3122 line_len = linex - 1; 3123 call apl_print_string_ (line); 3124 3125 if P_add_nl 3126 then call apl_flush_buffer_nl_; 3127 3128 return; 3129 3130 end; 3131 3132 initial_interrupt: 3133 procedure; 3134 3135 declare ( 3136 four_seconds fixed binary (71) initial (4), 3137 relative_seconds bit (2) initial ("11"b) 3138 ) internal static options (constant); 3139 3140 /* Re-syn user_input to user_i/o so that &attach effect of exec_coms will be undone if 3141* user QUITS while in an exec_com that &attaches. */ 3142 3143 call reattach_user_input; 3144 call iox_$control (apl_static_$apl_input, "resetread", null, (0)); 3145 3146 if in_printer /* in apl_print_value_, stop typing and INTERRUPT now */ 3147 | can_be_interrupted & ^clean_interrupt_pending 3148 then do; 3149 3150 /* interrupt now. */ 3151 3152 operators_argument.error_code = apl_error_table_$interrupt; 3153 go to report_error; /* go print "INTERRUPT" and maybe the line being executed */ 3154 end; 3155 else if clean_interrupt_pending /* ignore multiple interrupts */ 3156 then return; 3157 3158 /* we cannot take the interrupt now. defer it until later. */ 3159 3160 clean_interrupt_pending = "1"b; 3161 3162 call timer_manager_$alarm_call (four_seconds, relative_seconds, first_timer); 3163 3164 return; 3165 3166 end; 3167 3168 /* Small procedure to attach user_input back to user_i/o. Handles case where user_input is presently 3169* attached via syn_, and case where user_input is attached via regular IO module. */ 3170 3171 reattach_user_input: 3172 procedure; 3173 3174 call iox_$detach_iocb (iox_$user_input, code); 3175 if code ^= 0 3176 then if code = error_table_$not_closed 3177 then do; /* means was vfile_ or something */ 3178 call iox_$close (iox_$user_input, code); 3179 call iox_$detach_iocb (iox_$user_input, code); 3180 end; 3181 call iox_$attach_ptr (iox_$user_input, "syn_ user_i/o", null, code); 3182 3183 end /* reattach_user_input */; 3184 3185 reset_interrupt_info: 3186 procedure; 3187 3188 call timer_manager_$reset_alarm_call (first_timer); 3189 call timer_manager_$reset_alarm_call (second_timer); 3190 ws_info.dont_interrupt_parse = "1"b; 3191 ws_info.dont_interrupt_operator = "0"b; 3192 ws_info.dont_interrupt_storage_manager = "0"b; 3193 ws_info.dont_interrupt_command = "0"b; 3194 ws_info.can_be_interrupted = "0"b; 3195 ws_info.clean_interrupt_pending = "0"b; 3196 ws_info.dirty_interrupt_pending = "0"b; 3197 in_printer = "0"b; 3198 3199 return; 3200 3201 end; 3202 3203 first_timer: 3204 procedure; 3205 3206 declare ( 3207 ten_seconds fixed binary (71) initial (10), 3208 relative_seconds bit (2) initial ("11"b) 3209 ) internal static options (constant); 3210 3211 dirty_interrupt_pending = "1"b; 3212 signal apl_dirty_stop_; 3213 3214 call timer_manager_$alarm_call (ten_seconds, relative_seconds, second_timer); 3215 3216 return; 3217 3218 end; 3219 3220 3221 second_timer: 3222 procedure; 3223 3224 /* entries */ 3225 3226 declare apl_system_error_ entry (fixed bin (35)); 3227 3228 /* program */ 3229 3230 call apl_system_error_ (apl_error_table_$super_dirty_stop); 3231 return; 3232 3233 end second_timer; 3234 3235 fill_in_arguments: 3236 procedure (bv_rsp, from_which, to_where); 3237 3238 /* parameters */ 3239 3240 declare ( 3241 bv_rsp ptr, 3242 from_which fixed bin, 3243 to_where fixed bin 3244 ) parameter; 3245 3246 /* program */ 3247 3248 if bv_rsp -> rs (from_which).semantics_on_stack 3249 then do; 3250 ws_info.dont_interrupt_parse = "0"b; /* unmask so RQO handler can get control */ 3251 call apl_copy_value_ (bv_rsp -> rs (from_which).semantics, packed_temp_ptr); 3252 ws_info.dont_interrupt_parse = "1"b; /* remask */ 3253 bv_rsp -> rs (from_which).semantics = packed_temp_ptr; 3254 bv_rsp -> rs (from_which).semantics_on_stack = "0"b; 3255 end; 3256 3257 lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (to_where) -> symbol_bead.meaning_pointer = 3258 bv_rsp -> rs (from_which).semantics; 3259 bv_rsp -> rs (from_which).semantics -> general_bead.reference_count = 3260 bv_rsp -> rs (from_which).semantics -> general_bead.reference_count + 1; 3261 3262 return; 3263 3264 end fill_in_arguments; 3265 14 1 /* ====== BEGIN INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 =============================== */ 14 2 14 3 /* format: style3 */ 14 4 apl_push_stack_: 14 5 procedure (P_n_words) returns (ptr); 14 6 14 7 /* Function to (1) double-word align ws_info.value_stack_ptr, and 14 8* (2) make sure allocation request will fit on current value stack. 14 9* 14 10* Written 770413 by PG 14 11* Modified 780210 by PG to round allocations up to an even number of words. 14 12**/ 14 13 14 14 /* parameters */ 14 15 14 16 declare P_n_words fixed bin (19) parameter; 14 17 14 18 /* automatic */ 14 19 14 20 declare block_ptr ptr, 14 21 num_words fixed bin (19); 14 22 14 23 /* builtins */ 14 24 14 25 declare (addrel, binary, rel, substr, unspec) 14 26 builtin; 14 27 14 28 /* entries */ 14 29 14 30 declare apl_get_value_stack_ 14 31 entry (fixed bin (19)); 14 32 14 33 /* program */ 14 34 14 35 num_words = P_n_words; 14 36 14 37 if substr (unspec (num_words), 36, 1) = "1"b /* num_words odd */ 14 38 then num_words = num_words + 1; 14 39 14 40 if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size 14 41 then call apl_get_value_stack_ (num_words); 14 42 14 43 block_ptr = ws_info.value_stack_ptr; 14 44 ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words); 14 45 return (block_ptr); 14 46 14 47 end apl_push_stack_; 14 48 14 49 /* ------ END INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 ------------------------------- */ 3266 3267 3268 /* this internal proc is invoked for every condition that is signalled during the execution of APL. 3269* It handles quits and pi's, makes the hardware faults into the appropriate APL action 3270* such as domain error, and processes those conditions which are used for internal 3271* communication within APL. 3272* Added 73.9.17 by DAM 3273* */ 3274 3275 apl_default_handler_: 3276 procedure (mc_ptr, condition_name, wc_mc_ptr, info_ptr, continue_switch); 3277 3278 /* parameters */ 3279 3280 declare ( 3281 mc_ptr pointer, 3282 condition_name char (*), 3283 wc_mc_ptr pointer, 3284 info_ptr pointer, 3285 continue_switch bit (1) aligned 3286 ) parameter; 3287 3288 /* automatic */ 3289 3290 declare oncode_number fixed bin; 3291 3292 /* builtins */ 3293 3294 declare oncode builtin; 3295 3296 /* entries */ 3297 3298 declare apl_save_command_ entry (char (*), char (*), fixed bin (35)); 3299 3300 /* program */ 3301 3302 if ws_info.transparent_to_signals /* )E or something - we're not supposed to be here */ 3303 then if condition_name ^= "program_interrupt" /* but let pi's get back into APL */ 3304 then do; 3305 continue_switch = "1"b; 3306 return; 3307 end; 3308 else ws_info.transparent_to_signals = "0"b; /* pi - clear flag since re-entering APL */ 3309 3310 /* conditions used for communication with the outside world */ 3311 3312 if condition_name = "quit" 3313 then do; 3314 if ws_info.switches.no_quit_handler 3315 then do; 3316 continue_switch = "1"b; 3317 return; 3318 end; 3319 3320 call iox_$control (apl_static_$apl_input, "process_quit", null, code); 3321 /* check for editing-attention */ 3322 if code ^= 0 /* if APL dim isn't there, we have to do it ourselves */ 3323 then do; /* assume quit was interrupt, since we can't edit here anyway */ 3324 call iox_$control (apl_static_$apl_output, "resetwrite", null, (0)); 3325 /* flush output */ 3326 call iox_$put_chars (apl_static_$apl_output, addr (QNewLine), length (QNewLine), (0)); 3327 signal apl_quit_; 3328 end; 3329 end; 3330 3331 else if condition_name = "program_interrupt" 3332 then go to recover_from_error; /* we probably faulted out; treat as system error */ 3333 3334 /* conditions used for internal communication */ 3335 3336 else if condition_name = "apl_system_error_" /* message already has been printed; just bomb out */ 3337 then go to recover_from_error; 3338 3339 else if condition_name = "apl_dirty_stop_" 3340 then do; /* stopping in the middle of a line, between operators */ 3341 3342 if dont_interrupt_parse 3343 then go to on_return; 3344 if dont_interrupt_operator 3345 then go to on_return; 3346 if dont_interrupt_storage_manager 3347 then go to on_return; 3348 if dont_interrupt_command 3349 then go to on_return; 3350 go to dirty_stop; 3351 3352 on_return: 3353 end; 3354 3355 else if condition_name = "apl_quit_" /* DIM decided this attention was an "interrupt" */ 3356 then call initial_interrupt; /* set up to stop later at some more convenient time */ 3357 3358 else do; 3359 3360 /* hardware conditions */ 3361 /* make sure that we are interruptible. If we are not interruptible, then we are not 3362* in an operator and any faults that occur are not domain errors but system errors. 3363* In this case we would let them out to default_error_handler_ so we can get a nice message. 3364* */ 3365 3366 if ws_info.dont_interrupt_parse | ws_info.dont_interrupt_storage_manager 3367 | ws_info.dont_interrupt_operator | ws_info.dont_interrupt_command 3368 then do; 3369 continue_switch = "1"b; 3370 return; 3371 end; 3372 3373 /* Note that a zerodivide condition is treated as a real error, and not an APL 0-:0 -> 1, because 3374* all of the APL divides are supposed to special-case 0-:0. */ 3375 3376 if (condition_name = "fixedoverflow") | (condition_name = "overflow") | (condition_name = "zerodivide") 3377 then go to domain_error; 3378 3379 else if condition_name = "underflow" 3380 then do; 3381 3382 /* The FIM has made the following changes to the machine conditions: 3383* 1. The AQ is "0"b. 3384* 2. The E is -128 (Thus, the EAQ is a normalized floating-point zero). 3385* 3. The ILC has been incremented if the instruction was not FSTR or DFSTR. 3386* 4. The RFI and IF bits in the SCU.CU data have been turned on. 3387* 3388* Thus, all we have to do is return, and the underflow will be changed into a zero. 3389* The FIM has the capability to restore the fault right in ring 0, but there 3390* is no way at present to turn that on. When a way is added, APL should be changed. 3391* PG 10/23/79 */ 3392 3393 n_underflows = n_underflows + 1; 3394 /* meter these */ 3395 end; 3396 3397 else if condition_name = "error" 3398 then do; 3399 oncode_number = oncode (); /* magic number which tells something about error */ 3400 if oncode_number > 0 3401 then if oncode_number <= 100 /* 1-100 are math errors */ 3402 then go to domain_error; 3403 3404 continue_switch = "1"b; /* unknown problem. let system print message */ 3405 end; 3406 3407 else if condition_name = "finish" /* signalled when process is being bumped */ 3408 then do; 3409 if ^ws_info.restrict_save /* sigh */ 3410 then call apl_save_command_ ("continue", "", code); 3411 3412 continue_switch = "1"b; /* let default system action be taken, too. */ 3413 end; 3414 3415 else if condition_name = "record_quota_overflow" 3416 /* hmm. if it's on the process dir, be careful! */ 3417 then go to ws_full_no_quota_error; 3418 3419 /* some condition that we don't know about. Either a timer went off 3420* or the guy just lost. In either case, let it out to default_error_handler_ 3421* so we can see the message; user can get back into APL with the program_interrupt command. */ 3422 3423 else continue_switch = "1"b; 3424 end; /* hardware conditions */ 3425 return; 3426 3427 end /* apl_default_handler_ */; 3428 3429 end /* apl_parse_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/06/85 1130.1 apl_parse_.pl1 >spec>on>7086>apl_parse_.pl1 438 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 439 2 03/27/82 0438.6 apl_characters.incl.pl1 >ldd>include>apl_characters.incl.pl1 440 3 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 441 4 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 442 5 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 443 6 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 444 7 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 445 8 03/27/82 0439.0 apl_operators_argument.incl.pl1 >ldd>include>apl_operators_argument.incl.pl1 446 9 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.incl.pl1 447 10 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 448 11 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 449 12 03/27/82 0438.7 apl_list_bead.incl.pl1 >ldd>include>apl_list_bead.incl.pl1 450 13 11/29/83 1707.2 apl_operator_codes.incl.pl1 >ldd>include>apl_operator_codes.incl.pl1 3266 14 03/27/82 0429.8 apl_push_stack_fcn.incl.pl1 >ldd>include>apl_push_stack_fcn.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. LeftArgSymbol constant fixed bin(17,0) initial dcl 6-36 ref 1736 P_add_arrow parameter bit(1) dcl 3071 ref 3066 3110 P_add_nl parameter bit(1) dcl 3071 ref 3066 3116 3125 P_bead_ptr parameter pointer unaligned dcl 2400 in procedure "restore_system_variable_value" ref 2395 2416 P_bead_ptr parameter pointer dcl 2469 in procedure "save_system_variable_value" ref 2464 2489 P_frame_ptr parameter pointer dcl 3071 ref 3066 3093 3101 P_line_number parameter fixed bin(17,0) dcl 3041 ref 3036 3053 P_n_words parameter fixed bin(19,0) dcl 14-16 ref 14-4 14-35 P_operator_bead_ptr parameter pointer dcl 2400 ref 2395 2418 2421 P_ptr_to_vb parameter pointer unaligned dcl 3041 ref 3036 3052 QApostrophe constant char(1) initial unaligned dcl 2-11 ref 2680 QDel constant char(1) initial unaligned dcl 2-11 ref 2660 QDelTilde constant char(1) initial unaligned dcl 2-11 ref 2660 QExecuteSign constant char(1) initial unaligned dcl 2-11 ref 482 QLamp constant char(1) initial unaligned dcl 2-11 ref 2682 QLeftBracket constant char(1) initial unaligned dcl 2-11 ref 3098 QNewLine 000224 constant char(1) initial unaligned dcl 2-11 set ref 482 2735 3326 3326 3326 3326 QQuad constant char(1) initial unaligned dcl 2-11 ref 482 QRightArrow constant char(1) initial unaligned dcl 2-11 ref 3112 QRightBracket constant char(1) initial unaligned dcl 2-11 ref 3107 QRightParen constant char(1) initial unaligned dcl 2-11 ref 2634 ReturnSymbol constant fixed bin(17,0) initial dcl 6-36 ref 1013 RightArgSymbol constant fixed bin(17,0) initial dcl 6-36 ref 1735 1738 abs builtin function dcl 126 ref 924 933 2026 2028 3059 3059 addr builtin function dcl 126 ref 608 625 642 718 731 1204 1204 1233 1233 1253 1253 1410 1410 1924 1956 1956 2216 2218 2615 2619 2726 2726 2911 3095 3098 3104 3107 3112 3118 3123 3326 3326 addrel builtin function dcl 2480 in procedure "save_system_variable_value" ref 2534 2535 addrel builtin function dcl 126 in procedure "apl_parse_" ref 480 1731 2148 2607 2623 2776 2791 2871 addrel builtin function dcl 14-25 in procedure "apl_push_stack_" ref 14-44 apl_allocate_words_ 000324 constant entry external dcl 2485 ref 2529 apl_catenate_ 000264 constant entry external dcl 206 ref 1793 apl_command_ 000222 constant entry external dcl 206 ref 2640 apl_compression_ 000274 constant entry external dcl 206 ref 1806 apl_copy_value_ 000230 constant entry external dcl 206 ref 1622 2239 3251 apl_decode_ 000236 constant entry external dcl 206 ref 1896 apl_dirty_stop_ 000000 stack reference condition dcl 121 ref 3212 apl_domino_operator_ 000272 constant entry external dcl 206 ref 1949 2265 apl_drop_ 000260 constant entry external dcl 206 ref 1866 apl_dyadic_ 000036 constant entry external dcl 146 ref 1524 apl_dyadic_epsilon_ 000232 constant entry external dcl 206 ref 1640 apl_dyadic_format_ 000040 constant entry external dcl 146 ref 1913 apl_dyadic_ibeam_ 000242 constant entry external dcl 206 ref 1967 apl_dyadic_iota_ 000254 constant entry external dcl 206 ref 1646 apl_dyadic_rho_ 000270 constant entry external dcl 206 ref 1830 apl_editor_ 000062 constant entry external dcl 150 ref 2666 apl_encode_ 000234 constant entry external dcl 206 ref 1902 apl_error_ 000210 constant entry external dcl 206 ref 1149 1214 1235 1256 2757 apl_error_table_$assign_to_label 000160 external static fixed bin(35,0) dcl 168 ref 1110 apl_error_table_$assign_to_value 000132 external static fixed bin(35,0) dcl 168 ref 1307 apl_error_table_$bad_assignment 000162 external static fixed bin(35,0) dcl 168 ref 1105 apl_error_table_$bad_evaluated_input 000156 external static fixed bin(35,0) dcl 168 ref 1115 apl_error_table_$bad_execute 000154 external static fixed bin(35,0) dcl 168 ref 1120 apl_error_table_$cant_get_stop_trace 000140 external static fixed bin(35,0) dcl 168 ref 1155 apl_error_table_$cant_read_input 000110 external static fixed bin(35,0) dcl 168 set ref 2740* apl_error_table_$context 000170 external static fixed bin(35,0) dcl 168 ref 1051 apl_error_table_$depth 000142 external static fixed bin(35,0) dcl 168 ref 1145 apl_error_table_$domain 000176 external static fixed bin(35,0) dcl 168 ref 1060 1065 1128 apl_error_table_$done_line_system_error 000120 external static fixed bin(35,0) dcl 168 ref 1194 apl_error_table_$execute 000152 external static fixed bin(35,0) dcl 168 ref 1141 1262 apl_error_table_$improper_dyadic_usage 000174 external static fixed bin(35,0) dcl 168 ref 1085 apl_error_table_$improper_monadic_usage 000172 external static fixed bin(35,0) dcl 168 ref 1090 apl_error_table_$improper_niladic_usage 000124 external static fixed bin(35,0) dcl 168 ref 1095 apl_error_table_$interrupt 000136 external static fixed bin(35,0) dcl 168 set ref 1179 2757* 3152 apl_error_table_$locked_function_error 000130 external static fixed bin(35,0) dcl 168 ref 1226 apl_error_table_$not_end_with_value 000106 external static fixed bin(35,0) dcl 168 ref 1159 apl_error_table_$operator_subscript_range 000166 external static fixed bin(35,0) dcl 168 ref 1100 apl_error_table_$pull_assign_system_error 000114 external static fixed bin(35,0) dcl 168 ref 1186 apl_error_table_$pull_system_error 000112 external static fixed bin(35,0) dcl 168 ref 1182 apl_error_table_$rank 000164 external static fixed bin(35,0) dcl 168 ref 1133 apl_error_table_$report_error_system_error 000116 external static fixed bin(35,0) dcl 168 ref 1190 apl_error_table_$return_from_apl 000150 external static fixed bin(35,0) dcl 168 ref 2646 2668 apl_error_table_$super_dirty_stop 000134 external static fixed bin(35,0) dcl 168 set ref 3230* apl_error_table_$too_much_input 000126 external static fixed bin(35,0) dcl 168 set ref 2691* apl_error_table_$value 000200 external static fixed bin(35,0) dcl 168 ref 1055 1070 1075 1080 2902 apl_error_table_$ws_cleared 000144 external static fixed bin(35,0) dcl 168 ref 2649 2670 apl_error_table_$ws_full_no_quota 000122 external static fixed bin(35,0) dcl 168 ref 1165 apl_error_table_$ws_loaded 000146 external static fixed bin(35,0) dcl 168 ref 2655 apl_execute_lex_ 000214 constant entry external dcl 206 ref 1253 2152 apl_expansion_ 000276 constant entry external dcl 206 ref 1818 apl_external_fcn_addr_ 000316 constant entry external dcl 206 ref 1404 apl_file_system_ 000250 constant entry external dcl 206 ref 1824 2096 apl_file_system_$niladic_functions 000252 constant entry external dcl 206 ref 1466 apl_flush_buffer_nl_ 000064 constant entry external dcl 150 ref 3125 apl_free_bead_ 000320 constant entry external dcl 206 ref 2811 apl_function_lex_ 000216 constant entry external dcl 206 ref 1233 apl_function_lex_no_messages_ 000220 constant entry external dcl 206 ref 1410 apl_get_value_stack_ 000332 constant entry external dcl 14-30 ref 14-40 apl_grade_down_ 000312 constant entry external dcl 206 ref 2291 apl_grade_up_ 000310 constant entry external dcl 206 ref 2281 apl_ibeam_ 000240 constant entry external dcl 206 ref 2167 apl_inner_product_ 000042 constant entry external dcl 146 ref 1974 apl_laminate_ 000266 constant entry external dcl 206 ref 1837 apl_line_lex_ 000212 constant entry external dcl 206 ref 1204 2777 apl_monadic_ 000044 constant entry external dcl 146 ref 1987 apl_monadic_format_ 000046 constant entry external dcl 146 ref 2161 apl_monadic_iota_ 000224 constant entry external dcl 206 ref 2253 apl_monadic_not_ 000050 constant entry external dcl 146 ref 2102 apl_monadic_rho_ 000226 constant entry external dcl 206 ref 2259 apl_outer_product_ 000052 constant entry external dcl 146 ref 1854 apl_print_string_ 000070 constant entry external dcl 150 ref 3123 apl_print_value_ 000066 constant entry external dcl 150 ref 2175 2183 2573 apl_quadcall_ 000314 constant entry external dcl 206 ref 2300 apl_quit_ 000000 stack reference condition dcl 121 ref 3327 apl_random_ 000306 constant entry external dcl 206 ref 1936 2271 apl_ravel_ 000262 constant entry external dcl 206 ref 2043 apl_reduction_ 000054 constant entry external dcl 146 ref 2055 2067 apl_reverse_ 000300 constant entry external dcl 206 ref 2113 apl_rotate_ 000302 constant entry external dcl 206 ref 1876 apl_save_command_ 000334 constant entry external dcl 3298 ref 3409 apl_scan_ 000072 constant entry external dcl 150 ref 2632 apl_scan_operator_ 000056 constant entry external dcl 146 ref 2079 2090 apl_static_$apl_input 000076 external static pointer dcl 161 set ref 2727* 3144* 3320* apl_static_$apl_output 000100 external static pointer dcl 161 set ref 2624* 3324* 3326* apl_static_$ws_info_ptr 000322 external static structure level 1 dcl 3-11 apl_subscript_a_value_ 000060 constant entry external dcl 146 ref 877 apl_subscripted_assignment_ 000074 constant entry external dcl 150 ref 1956 apl_system_error_ 000326 constant entry external dcl 2592 in procedure "read_executable_input_line" ref 2691 2740 apl_system_error_ 000330 constant entry external dcl 3226 in procedure "second_timer" ref 3230 apl_system_functions_ 000246 constant entry external dcl 206 ref 1943 2206 apl_system_variables_ 000244 constant entry external dcl 206 ref 1468 2189 apl_take_ 000256 constant entry external dcl 206 ref 1860 apl_transpose_ 000304 constant entry external dcl 206 ref 1890 2129 assign_to_stop_code constant fixed bin(8,0) initial dcl 13-8 ref 1501 2216 assignment_code constant fixed bin(8,0) initial dcl 13-8 ref 689 1376 assignment_done 000100 automatic bit(1) dcl 95 set ref 2228* 2230* 2232* 2236 based_unaligned_ptr based pointer unaligned dcl 206 set ref 2225 2225* 2239* 2241 2242 2242 bead_ptr 000264 automatic pointer unaligned dcl 2473 in procedure "save_system_variable_value" set ref 2489* 2494 2529* 2531 2532 2533 2534 2538 2540 bead_ptr 000252 automatic pointer unaligned dcl 2407 in procedure "restore_system_variable_value" set ref 2416* 2418 2434 2434 2435 2454* bead_type based structure level 4 in structure "value_bead" packed unaligned dcl 11-3 in procedure "apl_parse_" bead_type based structure level 3 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_parse_" ref 1570 1570 binary builtin function dcl 126 in procedure "apl_parse_" ref 734 2626 binary builtin function dcl 14-25 in procedure "apl_push_stack_" ref 14-40 bits 1 based structure array level 2 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 531* 646 657 665* 719 736 885* 1045* 1287* 1299* 1325* 1330 1360* 1373* 1379* 1386* 1396* 1422* 1425* 1441* 1450* 1473* 1635* 1776* 1926 1931* 1931 1962* 1962 2038* 2038 2197* 2197 2248* 2248 2344* 2385* bits 1 parameter structure level 2 in structure "reduction" packed unaligned dcl 2934 in procedure "append_to_list_bead" set ref 2968 2969* bits 4 based structure array level 3 in structure "list_bead" packed unaligned dcl 12-3 in procedure "apl_parse_" set ref 611* 627* 646* 719* 736* 1926* 2968* bits_for_parse 3 based structure level 2 in structure "lexed_function_bead" packed unaligned dcl 6-6 in procedure "apl_parse_" ref 1425 bits_for_parse 1 based structure level 2 in structure "operator_bead" packed unaligned dcl 7-3 in procedure "apl_parse_" ref 1325 bits_for_returned_value 000172 automatic bit(36) dcl 206 set ref 567* 657* 665 block_ptr 000532 automatic pointer dcl 14-20 set ref 14-43* 14-45 bol_type constant fixed bin(17,0) initial dcl 9-31 ref 760 branch_code constant fixed bin(8,0) initial dcl 13-8 ref 580 branch_pf_ptr 000102 automatic pointer dcl 95 set ref 2008* 2008* 2010 2012 2012 2012 2012 2017* 2031 bv_bead_ptr parameter pointer unaligned dcl 2805 set ref 2800 2809 2809 2811 2811* 2814* bv_code parameter fixed bin(35,0) dcl 2770 set ref 2765 2778* 2780* bv_rsp parameter pointer dcl 3240 ref 3235 3248 3251 3253 3254 3257 3259 3259 can_be_interrupted 105 based bit(1) level 3 dcl 3-16 set ref 2629* 2695* 2754* 3146 3194* character_string_overlay based char dcl 11-19 set ref 1253* 1256 1256 1590* 1590 2152* character_value 0(09) based bit(1) level 5 packed unaligned dcl 11-3 set ref 1590 2138 2220 class 3 based fixed bin(17,0) level 2 dcl 5-5 ref 1221 1401 1422 1422 1666 1746 clean_interrupt_pending 106 based bit(1) level 3 dcl 3-16 set ref 532 2755 3146 3155 3160* 3195* close_paren_type constant fixed bin(17,0) initial dcl 9-31 ref 684 1355 code 000162 automatic fixed bin(35,0) dcl 206 set ref 485* 492* 494 496* 2640* 2643 2646 2649 2655 2666* 2668 2670 2727* 2730 2732 2738 3174* 3175 3175 3178* 3179* 3181* 3320* 3322 3409* computed_value_bits constant bit(36) initial dcl 206 ref 885 1473 1776 2344 2385 condition_ 000016 constant entry external dcl 131 ref 457 condition_name parameter char unaligned dcl 3280 ref 3275 3302 3312 3331 3336 3339 3355 3376 3376 3376 3379 3397 3407 3415 continue_switch parameter bit(1) dcl 3280 set ref 3275 3305* 3316* 3369* 3404* 3412* 3423* cu_$ptr_call 000020 constant entry external dcl 131 ref 1766 current_lexeme 000133 automatic fixed bin(17,0) dcl 206 in procedure "apl_parse_" set ref 507* 535* 535 680* 680 700* 700 866* 1057* 1062* 1067* 1072* 1077* 1082* 1087* 1092* 1097* 1102* 1107* 1112* 1117* 1117 1125* 1130* 1135* 1142* 1198* 1204* 1233* 1243 1261* 1285* 1285 1286 1288 1312* 1312 1313 1314 1338 1338 1345 1351 1374* 1376* 1486* 1486 1489 2843 2863* 2903* current_lexeme 6 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 2843* 2863 current_line_number 7 based fixed bin(17,0) level 2 dcl 9-3 set ref 484* 507 510* 991* 991 1003* 1003 1005 1005 1235* 1338 1689* 2012* 2031* 2156* 2701* 3024* 3101 current_parse_frame_ptr 15 based pointer level 3 packed unaligned dcl 3-16 set ref 466 469 2652 2867* 2914* 2919 current_parseme 5 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 745 749* 1942* 2151* 2205* 2599* 2833* 2842* 2862 2916* current_parseme 000132 automatic fixed bin(17,0) dcl 206 in procedure "apl_parse_" set ref 528* 530 531 552 555 562 577 580 608 610 611 612 612 613* 613 614 625 626 627 629* 629 634* 634 638 642 643 645 646 646 648 648 649 649 650* 650 656 657 674 674 674 674 679* 679 684 689 689 693 696 696 699* 699 704 704 705* 705 706 708 715 718 719 719 720 720 721 721 722* 722 731 734 736 736 737 737 738* 738 742 748* 753 755 758 760 761* 761 764 767 770 772* 772 775 777 780 782 782 783* 783 786 786 789 789 790 790 791 793 794 799 799 800* 800 801 803 810 812 815 815 817* 817 823 825 828 828 830* 830 833 835 838 838 840* 840 845 847 850 850 852* 852 860 866 871 872 873 874 882 884 885 886 887 887 889* 889 890 892 896 899 901 901 902 903 904 905 905 906* 906 909 926 929 936 942 943 944 944 946 946 947* 947 1057 1067 1102 1142 1204 1204 1233 1233 1251 1253 1253 1261 1283* 1283 1286 1287 1293 1294 1296 1298 1299 1300 1300 1310* 1310 1313 1324 1325 1330 1330 1358 1359 1360 1361 1361 1366 1368 1371 1373 1374 1376 1379 1383 1385 1386 1387 1387 1392 1394 1395 1396 1399 1410 1410 1419 1419 1422 1422 1422 1425 1427 1429 1429 1433 1434 1440 1441 1443 1448 1449 1450 1456 1459 1460 1472 1473 1475 1479 1490 1497 1499 1501 1503 1505 1508 1508 1942 2150* 2205 2553 2553 2556 2598* 2822* 2822* 2823 2823 2826 2826 2826 2826 2826* 2842 2862* 2882 2886 2911 2917* 3029 3029 3095 3098 3104 3107 3112 3118 3123 data_elements 000154 automatic fixed bin(17,0) dcl 206 set ref 1252* 1253 1253 1256 1256 1588* 1590 1590 1593 2137* 2138 2152 2152 2527* 2528 2532 data_pointer 4 based pointer level 2 packed unaligned dcl 11-3 set ref 919 1253 1256 1256 1590 1590 1593 1593 2024 2152 2232 2418 2538* 3056 data_ptr 000266 automatic pointer dcl 2473 set ref 2534* 2535 2535* 2535 2538 2539 data_type 0(08) based structure level 4 in structure "value_bead" packed unaligned dcl 11-3 in procedure "apl_parse_" set ref 1585* 1585 data_type 0(08) based structure level 3 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_parse_" ref 1570 1570 diamond_temp 000124 automatic fixed bin(17,0) initial dcl 206 set ref 206* 742* 748 digits 2 based fixed bin(17,0) level 3 dcl 3-16 set ref 2438* 2509 dimension 4 000176 automatic fixed bin(17,0) level 3 dcl 8-3 set ref 1788* 1790* 1800* 1802* 1812* 1814* 1836* 1843* 1848* 1872* 1874* 1883* 1885* 1908* 2050* 2052* 2062* 2064* 2074* 2076* 2085* 2087* 2109* 2111* 2121* 2123* 2277* 2279* 2287* 2289* dirty_interrupt_pending 107 based bit(1) level 3 dcl 3-16 set ref 1759 2321 2365 2638 2664 3196* 3211* divide builtin function dcl 126 ref 2775 dont_interrupt_command 104 based bit(1) level 3 dcl 3-16 set ref 3193* 3348 3366 dont_interrupt_operator 101 based bit(1) level 3 dcl 3-16 set ref 3191* 3344 3366 dont_interrupt_parse 100 based bit(1) level 3 dcl 3-16 set ref 534* 1163* 1621* 1623* 1758* 1774* 2193* 2238* 2240* 2320* 2335* 2364* 2379* 2637* 2641* 2663* 2667* 2725* 2729* 3190* 3250* 3252* 3342 3366 dont_interrupt_storage_manager 102 based bit(1) level 3 dcl 3-16 set ref 3192* 3346 3366 dyadic 3(03) based bit(1) level 3 in structure "lexed_function_bead" packed unaligned dcl 6-6 in procedure "apl_parse_" ref 1671 1679 dyadic 1(03) based bit(1) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 1429 1516 dyadic_table 000230 constant fixed bin(17,0) initial array dcl 206 ref 1520 eol_type constant fixed bin(17,0) initial dcl 9-31 ref 530 error_code 7 000176 automatic fixed bin(35,0) level 2 dcl 8-3 set ref 875* 879 1051* 1055* 1060* 1065* 1070* 1075* 1080* 1085* 1090* 1095* 1100* 1105* 1110* 1115* 1120* 1128* 1133* 1141* 1145* 1149* 1155* 1159* 1165* 1179* 1182* 1186* 1190* 1194* 1214* 1226* 1235* 1256* 1262* 1307* 1461* 1469 1757* 1771 1955* 1958 2190 2318* 2332 2362* 2376 2902* 3152* error_index_within_line 2 based fixed bin(17,0) level 2 dcl 206 set ref 1214* 1235* 1256* error_line_index 1 based fixed bin(21,0) level 2 dcl 206 ref 1235 1235 error_mark_structure based structure level 1 dcl 206 error_mark_structure_ptr 000163 automatic pointer unaligned dcl 206 set ref 1204* 1209* 1214 1233* 1235 1235 1235 1235 1235 1253* 1256 error_table_$end_of_info 000202 external static fixed bin(35,0) dcl 168 ref 2738 error_table_$not_closed 000204 external static fixed bin(35,0) dcl 168 ref 3175 error_table_$short_record 000206 external static fixed bin(35,0) dcl 168 ref 2732 evaluated_frame_type constant fixed bin(17,0) initial dcl 9-22 ref 472 555 654 1201 1273 1482 evaluated_input_prompt 131 based varying char(32) level 2 dcl 3-16 set ref 2619 2620 execute_frame_type constant fixed bin(17,0) initial dcl 9-22 ref 562 654 1240 2008 2146 execute_value_ptr 000140 automatic pointer dcl 206 set ref 1251* 1252 1253 1256 1256 2133* 2135 2137 2138 2138 2141 2152 external_function_bits 000225 constant bit(36) initial array dcl 206 ref 1422 external_function_ptr 000144 automatic pointer dcl 206 set ref 1743* 1746 1766 first_nonblank 000501 automatic fixed bin(21,0) dcl 3083 set ref 3102* 3103 3104 fixed builtin function dcl 126 in procedure "apl_parse_" ref 935 2031 2919 fixed builtin function dcl 2412 in procedure "restore_system_variable_value" ref 2429 2438 2442 2446 float builtin function dcl 2480 ref 2509 2513 2517 float_index_origin 10 based float bin(63) level 3 dcl 3-16 set ref 2427* 2500 floor builtin function dcl 126 ref 923 930 2025 fnames_code constant fixed bin(8,0) initial dcl 13-8 ref 1466 fnums_code constant fixed bin(8,0) initial dcl 13-8 ref 1466 four_seconds 000222 constant fixed bin(71,0) initial dcl 3135 set ref 3162* from_which parameter fixed bin(17,0) dcl 3240 ref 3235 3248 3251 3253 3254 3257 3259 3259 function 0(03) based bit(1) level 4 packed unaligned dcl 4-3 ref 1392 1494 function_bead based structure level 1 dcl 5-5 function_bead_ptr 2 based pointer level 2 packed unaligned dcl 9-3 set ref 510 510 593* 971 1025* 1220 1692* 1693 2012 2012 3024 function_frame_type constant fixed bin(17,0) initial dcl 9-22 ref 510 593 971 1001 1217 1688 2012 fuzz 6 based float bin(63) level 3 dcl 3-16 set ref 2423* 2496 3059 general_bead based structure level 1 dcl 4-3 got_line 000326 automatic bit(1) dcl 2709 set ref 2721* 2723 2730* 2736* has_list 1(07) based bit(1) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 904* 2823 has_list 1(07) parameter bit(1) level 3 in structure "reduction" packed unaligned dcl 2934 in procedure "append_to_list_bead" set ref 2957* 2972* have_a_line 000130 automatic bit(1) unaligned dcl 206 set ref 509* 1174* 1204 2596* header based structure level 2 in structure "value_bead" dcl 11-3 in procedure "apl_parse_" header based structure level 2 in structure "list_bead" dcl 12-3 in procedure "apl_parse_" i 000165 automatic fixed bin(17,0) dcl 206 in procedure "apl_parse_" set ref 935* 936 939 942 1703* 1704 1708 1712 1714* 1720* 1721 1722* 2561* 2562 2562* 2962* 2964 2964* 3000* 3001 3008 3011* 3055* 3055* 3056* i 000440 automatic fixed bin(17,0) dcl 2983 in procedure "free_list_bead" set ref 2986* 2987 2987 2987* immediate_input_prompt 120 based varying char(32) level 2 dcl 3-16 set ref 2615 2616 in_constant 000312 automatic bit(1) dcl 2585 set ref 2677* 2680* 2680 2682 2687 in_printer 000131 automatic bit(1) unaligned dcl 206 set ref 2174* 2176* 2182* 2184* 2572* 2574* 3146 3197* index_origin 4 based fixed bin(17,0) level 3 dcl 3-16 set ref 935 2429* info_ptr parameter pointer dcl 3280 ref 3275 initial_value_stack_ptr 13 based pointer level 2 packed unaligned dcl 9-3 set ref 529* 1690* 2600* 2792* 2834 inner_product 1(08) based bit(1) array level 3 packed unaligned dcl 206 set ref 1518 input_buffer based structure level 1 dcl 110 input_buffer_array based char(1) array unaligned dcl 2716 set ref 2726 input_buffer_ptr 000104 automatic pointer dcl 95 set ref 480* 481 482 1204 1208 1214 2607* 2608 2626 2632 2634 2640 2660 2660 2666 2678 2680 2682 2691 2696 2726 2726 2727 2735 2735 2747 2747 2775 2777 2871* input_line_position 000106 automatic fixed bin(21,0) dcl 95 set ref 2632* 2634 2640* 2660 2660 2666* 2678* 2678 2678* 2680 2682* 2696* input_read_ptr 000330 automatic pointer dcl 2709 set ref 2726* 2727* integer_fuzz 22 based float bin(63) level 2 dcl 3-16 set ref 924 2026 2450* 2521 interrupt_info 100 based structure level 2 dcl 3-16 iox_$attach_ptr 000022 constant entry external dcl 131 ref 3181 iox_$close 000024 constant entry external dcl 131 ref 3178 iox_$control 000026 constant entry external dcl 131 ref 463 3144 3320 3324 iox_$detach_iocb 000030 constant entry external dcl 131 ref 3174 3179 iox_$get_line 000032 constant entry external dcl 131 ref 2727 iox_$put_chars 000034 constant entry external dcl 131 ref 2624 3326 iox_$user_input 000102 external static pointer dcl 161 set ref 3174* 3178* 3179* 3181* iox_$user_io 000104 external static pointer dcl 161 set ref 463* label 0(05) based bit(1) level 5 in structure "value_bead" packed unaligned dcl 11-3 in procedure "apl_parse_" set ref 1556 1605* 1624* 2241* label 0(05) based bit(1) level 4 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_parse_" ref 1547 label_values_ptr 7 based pointer level 2 packed unaligned dcl 6-6 ref 1722 laminate_code constant fixed bin(8,0) initial dcl 13-8 ref 929 936 last_parse_frame_ptr based pointer level 2 packed unaligned dcl 9-3 set ref 466* 586 596 661 988 991 996 1026 1123 1138 1227 1246 2010 2912* latent_expression 25 based pointer level 2 packed unaligned dcl 3-16 set ref 2432* 2435* 2504 2504 2507 length builtin function dcl 126 ref 2616 2620 3094 3103 3326 3326 length_of_line 3 based fixed bin(17,0) level 2 dcl 206 ref 1235 1235 lexed_function_bead based structure level 1 dcl 6-6 lexed_function_bead_pointer 2 based pointer level 2 packed unaligned dcl 5-5 set ref 1394 1404* 1406 1410* 1417 1669 1693 1766 lexed_function_bead_ptr 000134 automatic pointer dcl 206 in procedure "apl_parse_" set ref 499* 504 507 590* 1005 1013 1288 1314 1338 1345 1351 1489 1539 1693* 1696 1696 1701 1703 1704 1717 1717 1720 1721 1722 2866* 3000 3001 3257 lexed_function_bead_ptr 3 based pointer level 2 in structure "parse_frame" packed unaligned dcl 9-3 in procedure "apl_parse_" set ref 488 488* 499 588 590 592* 659* 994* 1024* 1219 1244 1244* 1693* 2152* 2601* 2777* 2866 2915* 3093 lexed_function_label_values based pointer array level 2 packed unaligned dcl 6-45 ref 1722 lexed_function_label_values_structure based structure level 1 dcl 6-45 lexed_function_lexeme_array based pointer array level 2 packed unaligned dcl 6-45 ref 1288 1314 1345 1351 1489 1539 lexed_function_lexemes_structure based structure level 1 dcl 6-45 lexeme 3 based fixed bin(17,0) array level 2 dcl 206 set ref 612* 612 721* 721 758* 758 770* 770 780* 780 799* 799 887* 887 1057 1062 1067 1072 1077 1082 1087 1092 1097 1102 1107 1112 1130 1135 1142 1198 1261 1286* 1313* 1539 lexeme_array_ptr 11 based pointer level 2 packed unaligned dcl 6-6 ref 1288 1314 1345 1351 1489 1539 line 1 based char level 2 in structure "input_buffer" packed unaligned dcl 110 in procedure "apl_parse_" set ref 482* 1204* 1214* 2632* 2634 2640* 2660 2660 2666* 2680 2682 2726 2735* 2777* line based char unaligned dcl 3089 in procedure "print_where_I_am" set ref 3095* 3098* 3104* 3107* 3112* 3118* 3123* line_len 000502 automatic fixed bin(21,0) dcl 3083 set ref 3095 3098 3104 3107 3112 3118 3122* 3123 3123 line_number 000476 automatic picture(11) unaligned dcl 3079 set ref 3101* 3102 3103 3104 linex 000503 automatic fixed bin(21,0) dcl 3083 set ref 3094* 3095 3096* 3096 3098 3099* 3099 3104 3105* 3105 3107 3108* 3108 3112 3113* 3113 3118 3119* 3119 3122 list_bead based structure level 1 dcl 12-3 set ref 2948 2948 list_value 0(08) based bit(1) level 4 packed unaligned dcl 4-3 ref 2558 2942 2962 list_value_type constant bit(18) initial unaligned dcl 4-30 ref 2949 localized_symbols 12 based pointer array level 2 packed unaligned dcl 6-6 ref 1013 1704 1721 3001 3257 long_error_mode 1 based bit(1) level 3 packed unaligned dcl 3-16 ref 1249 max builtin function dcl 126 ref 1790 max_input_line 000107 automatic fixed bin(21,0) dcl 95 set ref 2626* 2691 2727 max_parse_stack_depth constant fixed bin(17,0) initial dcl 3-98 ref 2919 maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 3-16 ref 14-40 mc_ptr parameter pointer dcl 3280 ref 3275 meaning_pointer 3 based pointer level 2 packed unaligned dcl 10-13 set ref 1017 1293 1341 1366 1410 1491 1493 1547 1547 1559 1559* 1566* 1570 1570 1570 1570 1570 1570 1585 1588 1590 1590 1593 1596 1596 1604 1605 1616 1616* 1622* 1624 1625 1625 1634 1708 1709* 1722* 1724 1724 3005 3005* 3008* 3257* meaning_ptr_unal 000147 automatic pointer unaligned dcl 206 set ref 1220* 1221 1233 1235 1235 member_ptr 3 based pointer array level 3 packed unaligned dcl 12-3 set ref 610* 626* 648* 720* 737* 912 944* 1925* 2562 2967* 2987 2987* members 3 based structure array level 2 dcl 12-3 set ref 2964* 2964 monadic 1(04) based bit(1) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 1429 1981 monadic 3(04) based bit(1) level 3 in structure "lexed_function_bead" packed unaligned dcl 6-6 in procedure "apl_parse_" ref 1675 1679 monadic_table 000425 constant fixed bin(17,0) initial array dcl 206 ref 1983 n_members 000211 automatic fixed bin(17,0) dcl 12-3 set ref 2942* 2945* 2946* 2948 2948 2951 n_nonblank 000504 automatic fixed bin(21,0) dcl 3083 set ref 3103* 3104 3104 3105 n_read based fixed bin(21,0) level 2 dcl 110 set ref 481* 482 1204 1204 1208* 1214 1214 2608* 2632 2632 2634 2640 2640 2660 2660 2666 2666 2678 2680 2682 2691 2696 2726 2726 2727 2735 2735 2747* 2747 2775 2777 2777 n_read_more 000313 automatic fixed bin(21,0) dcl 2585 set ref 2696 2727* 2734* 2734 2735 2747 n_underflows 000110 automatic fixed bin(17,0) dcl 95 set ref 464* 3393* 3393 n_words 000270 automatic fixed bin(19,0) dcl 2473 set ref 2528* 2529* name 5 based char level 2 in structure "symbol_bead" packed unaligned dcl 10-13 in procedure "apl_parse_" ref 3094 3095 name 2 based pointer level 2 in structure "lexed_function_bead" packed unaligned dcl 6-6 in procedure "apl_parse_" ref 1219 3093 name_length 4 based fixed bin(17,0) level 2 dcl 10-13 ref 3094 3095 no_quit_handler 1(15) based bit(1) level 3 packed unaligned dcl 3-16 ref 3314 null builtin function dcl 126 ref 463 463 466 488 510 566 586 588 610 626 866 913 971 988 1015 1018 1149 1149 1213 1244 1255 1294 1342 1368 1397 1406 1443 1490 1491 1505 1531 1534 1547 1559 1570 1616 1655 1659 1705 1709 1714 1749 1753 1754 1917 1921 1996 2003 2012 2135 2171 2179 2212 2225 2308 2310 2354 2357 2553 2562 2601 2631 2814 2826 2915 2987 3002 3005 3029 3144 3144 3181 3181 3320 3320 3324 3324 num_words 000534 automatic fixed bin(19,0) dcl 14-20 set ref 14-35* 14-37 14-37* 14-37 14-40 14-40* 14-44 number_of_arguments 000160 automatic fixed bin(17,0) dcl 206 set ref 1029 1037 1432* 1650* 1662 1671 1675 1692 1733 1738 1743 1746 1751 1762 1767 1769 1778 1991* 2883* 2888* 2890* number_of_dimensions 000210 automatic fixed bin(17,0) dcl 11-3 set ref 2525* 2528 2534 number_of_labels 6 based fixed bin(17,0) level 2 dcl 6-6 ref 507 1338 1717 number_of_localized_symbols 5 based fixed bin(17,0) level 2 dcl 6-6 ref 507 1338 1701 1703 1717 1720 3000 number_of_members 2 based fixed bin(17,0) level 2 dcl 12-3 set ref 910 2561 2942 2951* 2962 2986 number_of_non_labels 000173 automatic fixed bin(17,0) dcl 206 set ref 1717* 1720 1722 number_of_ptrs 14 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 1483* 1701* 2147* 2602* 2775* 2790* number_of_ptrs 000207 automatic fixed bin(17,0) dcl 9-20 in procedure "apl_parse_" set ref 479* 480 1483* 1701* 1731 2147* 2148 2602* 2607 2775* 2776 2790* 2791 2870* 2871 number_of_statements 4 based fixed bin(17,0) level 2 dcl 6-6 ref 504 1005 numeric_datum based float bin(63) array dcl 11-23 set ref 919 1593* 1593 2024 2232 2418 2528 2539* 3056 numeric_value 0(10) based bit(1) level 5 packed unaligned dcl 11-3 set ref 917 2022 2138 numeric_value_type constant bit(18) initial unaligned dcl 4-30 ref 2531 ok_to_stop_control 000164 automatic bit(1) unaligned dcl 206 set ref 510 523* 995* 2609* old_meaning_ptrs 15 based pointer array level 2 packed unaligned dcl 9-3 set ref 1708* 1712* 1714* 3008 3011* on_stack 1 000176 automatic bit(1) array level 3 dcl 8-3 set ref 873* 882 1755* 1756* 2315* 2316* 2337 2340 2359* 2360* 2381 oncode builtin function dcl 3294 ref 3399 oncode_number 000106 automatic fixed bin(17,0) dcl 3290 set ref 3399* 3400 3400 op1 4(27) based fixed bin(8,0) array level 4 in structure "list_bead" packed unaligned dcl 12-3 in procedure "apl_parse_" set ref 2562 op1 5(27) 000176 automatic fixed bin(8,0) level 3 in structure "operators_argument" packed unaligned dcl 8-3 in procedure "apl_parse_" set ref 1459* 1466 1466 1853* 2054* 2066* 2078* 2089* 2317* 2361* op1 1(27) based fixed bin(8,0) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 580 643* 645* 674 674 674 674 689 689 696 696 734* 786 786 899 926 929* 936 1376 1456 1459 1520 1983 2216 2317 2361 op1 1(27) based fixed bin(8,0) level 3 in structure "operator_bead" packed unaligned dcl 7-3 in procedure "apl_parse_" ref 1349 1355 1497 1499 1501 2421 2494 op2 5(18) 000176 automatic fixed bin(8,0) level 3 in structure "operators_argument" packed unaligned dcl 8-3 in procedure "apl_parse_" set ref 1973* op2 1(18) based fixed bin(8,0) level 3 in structure "operator_bead" packed unaligned dcl 7-3 in procedure "apl_parse_" ref 2418 op2 1(18) based fixed bin(8,0) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 1853 1973 2054 2066 2078 2089 op_type constant fixed bin(17,0) initial dcl 9-31 ref 706 791 801 890 1374 1395 operands 000176 automatic structure array level 2 dcl 8-3 operator 4 000176 automatic structure level 2 dcl 8-3 operator_bead based structure level 1 dcl 7-3 operator_ptr 000136 automatic pointer dcl 206 set ref 1288* 1290 1293 1314* 1319 1324 1325 1341 1358 1366 1410 1447 1447 1448 1488 1489* 1491 1493* 1493 1494 1497 1499 1501 1503 operator_type constant bit(18) initial unaligned dcl 4-30 ref 1322 1347 1353 operators_argument 000176 automatic structure level 1 dcl 8-3 set ref 877* 1466* 1468* 1524* 1640* 1646* 1766* 1793* 1806* 1818* 1824* 1830* 1837* 1854* 1860* 1866* 1876* 1890* 1896* 1902* 1913* 1936* 1943* 1949* 1956* 1967* 1974* 1987* 2043* 2055* 2067* 2079* 2090* 2096* 2102* 2113* 2129* 2161* 2167* 2189* 2206* 2253* 2259* 2265* 2271* 2281* 2291* 2300* packed_temp_ptr 000166 automatic pointer unaligned dcl 206 set ref 1213* 1214* 1255* 1256* 2631* 2632* 2757* 3251* 3253 parse_frame based structure level 1 dcl 9-3 set ref 480 1731 2148 2607 2776 2791 2871 parse_frame_ptr 000122 automatic pointer dcl 206 set ref 469* 472 480 480 484 488 488 499 507 510 510 510 510 516* 529 555 562 586 588 590 592 593 593 596* 596 598 654 654 659 661* 661 745 749 971 971 983 988 991 991 994 996* 996 1001 1003 1003 1005 1005 1024 1025 1026* 1026 1123* 1123 1138* 1138 1201 1201 1209 1217 1219 1220 1227* 1227 1235 1240 1244 1244 1246* 1246 1271 1273 1338 1482 1483 1688 1689 1690 1692 1693 1693 1701 1708 1712 1714 1731 1731 1731 1942 2008 2146 2147 2148 2148 2148 2151 2152 2156 2205 2599 2600 2601 2602 2607 2607 2613 2652* 2653 2701 2775 2776 2776 2776 2777 2788 2790 2791 2791 2791 2792 2833 2834 2842 2843 2844 2845 2846 2854 2862 2863 2864 2865 2866 2867 2868 2871 2871 2912 2913* 2914 2915 2916 3008 3011 3024 3024 3029* 3031* parse_frame_type 1 based fixed bin(17,0) level 2 dcl 9-3 set ref 472 510 555 562 593 598 654 654 971 983 1001 1201 1201 1217 1240 1271 1273 1482* 1688* 2008 2012 2146* 2613 2788* pointers 14 based structure level 2 dcl 3-16 print_final_value 12 based bit(1) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 2846* 2854 print_final_value 000161 automatic bit(1) dcl 206 in procedure "apl_parse_" set ref 524* 623* 635* 643 703* 734 739* 750* 797* 888* 976* 976 1513* 1528* 1953* 1978* 2001* 2195* 2210* 2558 2562* 2570 2846 2854* 3028* prompt_length 000314 automatic fixed bin(21,0) dcl 2585 set ref 2616* 2620* 2624* prompt_ptr 000316 automatic pointer dcl 2585 set ref 2615* 2619* 2623* 2623 2624* ptr_to_returned_value 000170 automatic pointer dcl 206 set ref 566* 656* 664 1013* 1015 1017* 1017 1018 1018 1018 1043 ptr_to_vb 000466 automatic pointer dcl 3048 set ref 3052* 3055 3056 put_result 000156 automatic fixed bin(17,0) dcl 206 in procedure "apl_parse_" set ref 663 664 665 755* 758 767* 770 777* 780 794* 812* 825* 835* 847* 1043 1044 1045 1433* 1479* 1634 1635 1775 1776 1782 1930 1931 1961 1962 2037 2038 2196 2197 2247 2248 2343 2344 2384 2385 2845 2865* put_result 11 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 2845* 2865 quadcall_semicolon_code constant fixed bin(8,0) initial dcl 13-8 ref 674 674 696 786 1349 1355 random_link 5 based fixed bin(35,0) level 3 dcl 3-16 set ref 2446* 2517 ravel_code constant fixed bin(8,0) initial dcl 13-8 ref 926 read_back_spaces_order 000622 constant char(16) initial unaligned dcl 116 set ref 463* reduction parameter structure level 1 dcl 2934 set ref 2929 reduction_stack_ptr 4 based pointer level 2 packed unaligned dcl 9-3 set ref 1731* 2148* 2653 2776* 2791* 2868 reference_count 1 based fixed bin(29,0) level 2 in structure "general_bead" dcl 4-3 in procedure "apl_parse_" set ref 1018* 1018 1300* 1300 1361* 1361 1387* 1387 1419* 1419 1447* 1447 1508* 1508 1563* 1563 1570 1696* 1696 1724* 1724 2434* 2434 2504* 2504 2809* 2809 2811 3259* 3259 reference_count 1 based fixed bin(29,0) level 3 in structure "list_bead" dcl 12-3 in procedure "apl_parse_" set ref 2950* reference_count 1 based fixed bin(29,0) level 3 in structure "value_bead" dcl 11-3 in procedure "apl_parse_" set ref 1604* 1625* 1625 2242* 2242 rel builtin function dcl 14-25 in procedure "apl_push_stack_" ref 14-40 rel builtin function dcl 126 in procedure "apl_parse_" ref 2626 2919 rel builtin function dcl 2480 in procedure "save_system_variable_value" ref 2535 relative_seconds 000220 constant bit(2) initial unaligned dcl 3206 in procedure "first_timer" set ref 3214* relative_seconds 000220 constant bit(2) initial unaligned dcl 3135 in procedure "initial_interrupt" set ref 3162* restrict_save 1(08) based bit(1) level 3 packed unaligned dcl 3-16 ref 3409 result 6 000176 automatic pointer level 2 packed unaligned dcl 8-3 set ref 884 1472 1749* 1775 2343 2384 return_point 10 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 9-3 in procedure "apl_parse_" set ref 2844* 2864 return_point 000157 automatic fixed bin(17,0) dcl 206 in procedure "apl_parse_" set ref 549* 573* 666 687* 756* 768* 778* 795* 813* 826* 836* 848* 857* 1046 1302 1330 1363 1380 1389 1437 1451 1476 1511 1526 1636 1642 1648 1783 1796 1808 1820 1826 1832 1839 1856 1862 1868 1879 1892 1898 1904 1915 1932 1938 1945 1951 1963 1969 1976 1989 2039 2045 2057 2069 2081 2092 2098 2104 2116 2131 2163 2169 2198 2208 2249 2255 2261 2267 2273 2283 2293 2302 2844 2864* 2880 2888 rho 5 based fixed bin(21,0) array level 2 dcl 11-3 set ref 1596* 1596 rhorho 3 based fixed bin(17,0) level 2 dcl 11-3 set ref 1570 1570 1596 1596 1790 1790 1800 1812 1874 2052 2076 2111 2141 2279 2289 2533* rs based structure array level 1 dcl 206 set ref 608 625 642 649* 649 704* 704 718 731 782* 782 789* 789 790* 790 815* 815 828* 828 838* 838 850* 850 905* 905 946* 946 1204 1204 1233 1233 1253 1253 1410 1410 1924 1956 1956 2911 3095 3098 3104 3107 3112 3118 3123 rs_for_op based structure array level 1 dcl 206 rs_overlay based structure level 1 dcl 206 set ref 608* 625* 642* 718* 731* 1924* rsp 000126 automatic pointer dcl 206 set ref 530 531 552 555 562 577 580 608 610 611 612 612 614 625 626 627 638 642 643 645 646 646 648 648 649 649 656 657 663 664 665 674 674 674 674 684 689 689 693 696 696 704 704 706 708 715 718 719 719 720 720 721 721 731 734 736 736 737 737 758 758 760 770 770 780 780 782 782 786 786 789 789 790 790 791 799 799 801 803 815 815 828 828 838 838 850 850 860 866 871 872 873 882 884 885 886 887 887 890 892 896 899 901 901 902 903 904 905 905 909 926 929 936 942 943 944 944 946 946 1034 1035 1037 1043 1044 1045 1057 1062 1067 1072 1077 1082 1087 1092 1097 1102 1107 1112 1130 1135 1142 1198 1204 1204 1233 1233 1251 1253 1253 1261 1286 1287 1293 1294 1296 1298 1299 1300 1300 1313 1324 1325 1330 1330 1358 1359 1360 1361 1361 1366 1368 1371 1373 1374 1376 1379 1383 1385 1386 1387 1387 1392 1394 1395 1396 1399 1410 1410 1419 1419 1422 1422 1422 1425 1427 1429 1429 1440 1441 1443 1448 1449 1450 1456 1459 1472 1473 1475 1490 1497 1499 1501 1503 1505 1508 1508 1516 1518 1520 1531 1534 1534 1534 1534 1539 1556 1556 1563 1563 1566 1570 1570 1570 1570 1585 1590 1593 1596 1622 1629 1629 1631 1634 1635 1653 1655 1657 1659 1662 1692 1730 1731* 1743 1767 1775 1776 1782 1788 1788 1790 1790 1800 1802 1802 1812 1814 1814 1836 1853 1872 1872 1874 1883 1883 1917 1921 1924 1925 1925 1926 1926 1930 1930 1931 1931 1956 1956 1961 1961 1962 1962 1973 1981 1983 1994 1996 2003 2020 2022 2024 2037 2037 2038 2038 2050 2050 2052 2054 2062 2062 2066 2074 2074 2076 2078 2085 2085 2089 2109 2109 2111 2121 2121 2133 2148* 2152* 2171 2175 2179 2183 2196 2196 2197 2197 2212 2215 2216 2216 2218 2239 2246 2247 2247 2248 2248 2277 2277 2279 2287 2287 2289 2308 2310 2313 2314 2315 2316 2317 2337 2340 2343 2344 2354 2358 2360 2361 2381 2384 2385 2553 2553 2556 2653* 2776* 2777* 2791* 2823 2823 2826 2826 2826 2826 2826 2868* 2911 3029 3029 3095 3098 3104 3107 3112 3118 3123 scan_token_type 000111 automatic fixed bin(17,0) dcl 95 set ref 2632* 2634 semantics 2 based fixed bin(17,0) array level 2 in structure "rs_for_op" dcl 206 in procedure "apl_parse_" set ref 942* 1788 1802 1814 1836 1872 1883 2050 2062 2074 2085 2109 2121 2277 2287 semantics 2 parameter pointer level 2 in structure "reduction" packed unaligned dcl 2934 in procedure "append_to_list_bead" set ref 2942 2942 2958* 2962 2964 2967 2975* semantics 2 based pointer array level 2 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 610 611 626 627 646 648 648 656 664* 719 720 720 736 737 737 866 871 872 882* 884* 901* 901 909 944 944 1034* 1035* 1037* 1043* 1251 1293* 1294 1296 1300 1300 1358* 1361 1361 1366* 1368 1383 1387 1387 1392 1394 1399 1419 1419 1422 1422 1443* 1448* 1472* 1490* 1497* 1499* 1501* 1503* 1505 1508 1508 1531 1534 1534* 1556 1563 1563 1566 1570 1570 1570 1570 1585 1590 1593 1596 1622* 1629 1631* 1634* 1655 1659 1662 1692 1743 1767* 1775* 1790 1790 1800 1812 1874 1917 1921 1925 1925 1926 1930* 1930 1961* 1961 1996 2003 2020 2022 2024 2037* 2037 2052 2076 2111 2133 2171 2175* 2179 2183* 2196* 2196 2212 2215 2216 2218 2239* 2246* 2247* 2247 2279 2289 2308 2310 2313 2314 2337* 2340* 2343* 2354 2358 2381* 2384* 2553 2556 2823* 2826 2826* 3029 3251* 3253* 3257 3259 3259 semantics_on_stack 1(09) based bit(1) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 873 903* 1534 1556 1629 2315 2316 2360 2826 3248 3254* semantics_on_stack 1(09) parameter bit(1) level 3 in structure "reduction" packed unaligned dcl 2934 in procedure "append_to_list_bead" set ref 2956* 2971* semantics_on_stack 4(09) based bit(1) array level 4 in structure "list_bead" packed unaligned dcl 12-3 in procedure "apl_parse_" set ref 944 2987 semantics_valid 1(06) based bit(1) array level 3 in structure "rs" packed unaligned dcl 206 in procedure "apl_parse_" set ref 555 562 638 896 902* 943* 1427* 1534 1653 1657 1788 1802 1814 1872 1883 1994 2050 2062 2074 2085 2109 2121 2277 2287 2553 2826 3029 semantics_valid 1(06) parameter bit(1) level 3 in structure "reduction" packed unaligned dcl 2934 in procedure "append_to_list_bead" set ref 2942 2953 2955* 2970* semicolon_cons_code constant fixed bin(8,0) initial dcl 13-8 ref 674 674 696 786 size builtin function dcl 2480 in procedure "save_system_variable_value" ref 2528 2528 2534 size builtin function dcl 126 in procedure "apl_parse_" ref 480 1731 2148 2607 2776 2791 2871 2948 2948 sp 000506 automatic pointer dcl 3083 set ref 3093* 3094 3095 start 000155 automatic fixed bin(17,0) dcl 206 set ref 753* 764* 775* 793* 810* 823* 833* 845* 1034 1035 1037 1072 1077 1082 1087 1092 1097 1130 1135 1434* 1515 1516 1518 1520 1531 1534 1534 1534 1534 1539 1556 1556 1563 1563 1566 1570 1570 1570 1570 1585 1590 1593 1596 1622 1629 1629 1631 1653 1653 1655 1655 1657 1657* 1659 1659* 1662 1692 1735 1736* 1738 1743 1767 1788 1788 1790 1790 1800 1802 1802 1812 1814 1814 1836 1853 1872 1872 1874 1883 1883 1917 1921 1924 1925 1925 1926 1926 1930 1931 1956 1956 1961 1962 1973 1980 1981 1983 1994 1994 1996 1996 2003 2020 2022 2024 2037 2038 2050 2050 2052 2054 2062 2062 2066 2074 2074 2076 2078 2085 2085 2089 2109 2109 2111 2121 2121 2133 2171 2175 2179 2183 2196 2197 2212 2215 2216 2216 2218 2239 2246 2247 2248 2277 2277 2279 2287 2287 2289 2308 2310 2313 2314 2315 2316 2317 2337 2340 2354 2358 2360 2361 2381 2882* 2886* statement_map based fixed bin(18,0) array level 2 dcl 6-6 ref 507 1338 static_ws_info_ptr 000322 external static pointer level 2 packed unaligned dcl 3-11 ref 3-7 stop_code constant fixed bin(8,0) initial dcl 13-8 ref 1497 stop_control_pointer 4 based pointer level 2 packed unaligned dcl 5-5 set ref 510 510* 1497 2216 stop_trace_control 1 based bit(1) array level 3 packed unaligned dcl 206 set ref 1330 string builtin function dcl 126 in procedure "apl_parse_" set ref 1319 1347 1353 1570 1570 1570 1570 1585* 1585 string builtin function dcl 2480 in procedure "save_system_variable_value" set ref 2531* subscript_type constant fixed bin(17,0) initial dcl 9-31 ref 614 708 715 803 892 subscripted_assignment_code constant fixed bin(8,0) initial dcl 13-8 ref 689 899 substr builtin function dcl 14-25 in procedure "apl_push_stack_" ref 14-37 substr builtin function dcl 126 in procedure "apl_parse_" set ref 1235 1235 1256 1256 1570 1570 2535 2634 2660 2660 2680 2682 2735* 3095* 3098* 3104* 3104 3107* 3112* 3118* suspended_frame_type constant fixed bin(17,0) initial dcl 9-22 ref 598 983 1201 1271 2613 2788 switches 1 based structure level 2 packed unaligned dcl 3-16 symbol 0(01) based bit(1) level 4 packed unaligned dcl 4-3 ref 1290 1544 1705 3002 symbol_bead based structure level 1 dcl 10-13 symbol_ptr_unal 000146 automatic pointer unaligned dcl 206 set ref 1219* 1235* symbol_type constant bit(18) initial unaligned dcl 4-30 ref 1336 temp18 000112 automatic bit(18) dcl 95 set ref 1319* 1322 1336 1445 temp_ptr 000150 automatic pointer dcl 206 set ref 909* 910 912* 912 913 915 917 919 1341* 1342 1342 1345* 1347 1349 1351* 1353 1355 1355 1394* 1397 1399* 1401 1404 1404 1406 1410 1417* 1417 1425 1488* 1497 1499 1501 1539* 1544 1547 1547 1559 1559 1566 1570 1570 1570 1570 1570 1570 1585 1588 1590 1590 1593 1596 1596 1604 1605 1616 1616 1622 1624 1625 1625 1634 1662* 1666 1669* 1669 1671 1675 1679 1679 1704* 1705 1705 1708 1709 1712* 1721* 1722 1724 1724 1730* 1735* 1736* 1738* 2215* 2220 2220 2230 2232 2232 2911* 2912 2913 2948* 2949 2950 2951 2958 2962 2964 2967 2968 2975 3001* 3002 3002 3005 3005 3008 3011* ten_seconds 000216 constant fixed bin(71,0) initial dcl 3206 set ref 3214* text 7 based char level 2 dcl 5-5 set ref 1233* 1235 1235 1404* 1410* text_length 6 based fixed bin(21,0) level 2 dcl 5-5 ref 1233 1233 1235 1235 1404 1404 1410 1410 timer_manager_$alarm_call 000012 constant entry external dcl 131 ref 3162 3214 timer_manager_$reset_alarm_call 000014 constant entry external dcl 131 ref 3188 3189 tmp_parseme 000125 automatic fixed bin(17,0) dcl 206 set ref 745* 749 to_where parameter fixed bin(17,0) dcl 3240 ref 3235 3257 total_data_elements 2 based fixed bin(21,0) level 2 dcl 11-3 set ref 915 1252 1570 1570 1588 2020 2137 2220 2230 2232 2532* 3055 trace_branch_line 000113 automatic bit(1) dcl 95 set ref 527* 976 978 2018* 2857* trace_code constant fixed bin(8,0) initial dcl 13-8 ref 1499 trace_control_pointer 5 based pointer level 2 packed unaligned dcl 5-5 set ref 971 1499 2012 2012* 2218 3024* transparent_to_signals 1(11) based bit(1) level 3 packed unaligned dcl 3-16 set ref 3302 3308* type based structure level 3 in structure "function_bead" packed unaligned dcl 5-5 in procedure "apl_parse_" type based structure level 3 in structure "list_bead" packed unaligned dcl 12-3 in procedure "apl_parse_" set ref 2949* type based structure level 2 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_parse_" ref 1319 1347 1353 type based fixed bin(17,0) array level 2 in structure "rs" dcl 206 in procedure "apl_parse_" set ref 530* 552 577 614* 663* 684* 693 706 708 715* 760* 791* 801 803 860 886* 890 892 1044* 1298* 1324* 1359* 1371* 1374 1385* 1395* 1440* 1449* 1475* 1782* 2826 type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 6-6 in procedure "apl_parse_" type based structure level 3 in structure "symbol_bead" packed unaligned dcl 10-13 in procedure "apl_parse_" type based structure level 3 in structure "value_bead" packed unaligned dcl 11-3 in procedure "apl_parse_" set ref 2531* type_code 2 based fixed bin(17,0) level 2 dcl 7-3 ref 1324 1355 unspec builtin function dcl 14-25 in procedure "apl_push_stack_" ref 14-37 unspec builtin function dcl 126 in procedure "apl_parse_" set ref 531* 611* 627* 646* 646 657 665* 719* 719 736* 736 885* 1045* 1287* 1299* 1325* 1325 1330 1360* 1373* 1379* 1386* 1396* 1422* 1425* 1425 1441* 1450* 1473* 1635* 1776* 1926* 1926 1931* 1931 1962* 1962 2038* 2038 2197* 2197 2248* 2248 2344* 2385* 2949* 2964* 2964 2968* 2968 2969* user_input_attachment_known 000332 automatic bit(1) dcl 2709 set ref 2720* 2740 2744* val_ptr 000302 automatic pointer unaligned dcl 2549 set ref 2556* 2558 2561 2562 2562 2573* val_type constant fixed bin(17,0) initial dcl 9-31 ref 663 886 1044 1298 1359 1371 1385 1440 1449 1475 1782 2826 value 000272 automatic float bin(63) dcl 2473 in procedure "save_system_variable_value" set ref 2496* 2500* 2509* 2513* 2517* 2521* 2539 value 000254 automatic float bin(63) dcl 2407 in procedure "restore_system_variable_value" set ref 2418* 2423 2427 2429 2438 2442 2446 2450 value 0(02) based bit(1) level 4 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_parse_" ref 1296 1342 1383 value 000176 automatic pointer array level 3 in structure "operators_argument" packed unaligned dcl 8-3 in procedure "apl_parse_" set ref 871* 872* 1753* 1754* 2313* 2314* 2357* 2358* value_bead based structure level 1 dcl 11-3 set ref 2528 2534 value_bead_ptr 000152 automatic pointer dcl 206 set ref 2216* 2218* 2225 2225 2239 2241 2242 2242 value_bits constant bit(36) initial dcl 206 ref 567 1045 1299 1360 1379 1386 1450 1635 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 3-16 set ref 529 1629* 1690 2600 2792 2834* 14-40 14-43 14-44* 14-44 value_type constant bit(18) initial unaligned dcl 4-30 ref 1445 1445 values 2 based structure level 2 dcl 3-16 verify builtin function dcl 126 ref 3102 was_branch 000114 automatic bit(1) dcl 95 set ref 525* 985 2036* 2855* 3024 was_branch_value 000115 automatic bit(1) dcl 95 set ref 526* 841 853 978 991 2033* 2035* 2856* was_error 000143 automatic bit(1) dcl 206 set ref 1204* 1233* 1253* 1410* 1414 2152* 2154 2774* 2777* 2778 wc_mc_ptr parameter pointer dcl 3280 ref 3275 where parameter fixed bin(17,0) dcl 2900 ref 2897 2903 where_error 10 000176 automatic fixed bin(17,0) level 2 dcl 8-3 set ref 874* 1062 1107 1112 1198 1460* 1515* 1980* where_execute_error 000142 automatic fixed bin(17,0) dcl 206 set ref 1243* 1253* which parameter pointer unaligned dcl 2983 ref 2980 2986 2987 2987 2987 width 3 based fixed bin(17,0) level 3 dcl 3-16 set ref 2442* 2513 ws_info based structure level 1 dcl 3-16 ws_info_ptr 000174 automatic pointer initial dcl 3-7 set ref 466 469 476 529 532 534 924 935 1163 1249 1621 1623 1629 1690 1758 1759 1774 2026 2193 2238 2240 3-7* 2320 2321 2335 2364 2365 2379 2423 2427 2429 2432 2435 2438 2442 2446 2450 2496 2500 2504 2504 2507 2509 2513 2517 2521 2600 2615 2616 2619 2620 2629 2637 2638 2641 2652 2663 2664 2667 2695 2725 2729 2754 2755 2792 2834 2867 2914 2919 3059 3146 3146 3155 3160 3190 3191 3192 3193 3194 3195 3196 3211 3250 3252 14-40 14-40 14-43 14-44 14-44 3302 3308 3314 3342 3344 3346 3348 3366 3366 3366 3366 3409 wsid 36 based char(100) level 2 dcl 3-16 ref 476 x 000116 automatic float bin(63) dcl 95 set ref 919* 923 924 930 2024* 2025 2026 3053* 3057 3059 3059 xx 000120 automatic float bin(63) dcl 95 set ref 923* 924 930* 933 935 2025* 2026 2028 2031 3056* 3057 3059 3059 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 11-28 NumberSize internal static fixed bin(4,0) initial dcl 1-25 QAlpha internal static char(1) initial unaligned dcl 2-11 QAndSign internal static char(1) initial unaligned dcl 2-11 QBackSlash internal static char(1) initial unaligned dcl 2-11 QBackSlashHyphen internal static char(1) initial unaligned dcl 2-11 QBackSpace internal static char(1) initial unaligned dcl 2-11 QBell internal static char(1) initial unaligned dcl 2-11 QCap internal static char(1) initial unaligned dcl 2-11 QCeiling internal static char(1) initial unaligned dcl 2-11 QCentSign internal static char(1) initial unaligned dcl 2-11 QCircle internal static char(1) initial unaligned dcl 2-11 QCircleBackSlash internal static char(1) initial unaligned dcl 2-11 QCircleBar internal static char(1) initial unaligned dcl 2-11 QCircleHyphen internal static char(1) initial unaligned dcl 2-11 QCircleSlash internal static char(1) initial unaligned dcl 2-11 QCircleStar internal static char(1) initial unaligned dcl 2-11 QColon internal static char(1) initial unaligned dcl 2-11 QComma internal static char(1) initial unaligned dcl 2-11 QCommaHyphen internal static char(1) initial unaligned dcl 2-11 QConditionalNewLine internal static char(1) initial unaligned dcl 2-11 QCup internal static char(1) initial unaligned dcl 2-11 QDeCode internal static char(1) initial unaligned dcl 2-11 QDelta internal static char(1) initial unaligned dcl 2-11 QDelta_ internal static char(1) initial unaligned dcl 2-11 QDiamond internal static char(1) initial unaligned dcl 2-11 QDiaresis internal static char(1) initial unaligned dcl 2-11 QDivision internal static char(1) initial unaligned dcl 2-11 QDollar internal static char(1) initial unaligned dcl 2-11 QDomino internal static char(1) initial unaligned dcl 2-11 QDownArrow internal static char(1) initial unaligned dcl 2-11 QEight internal static char(1) initial unaligned dcl 2-11 QEight_ internal static char(1) initial unaligned dcl 2-11 QEnCode internal static char(1) initial unaligned dcl 2-11 QEpsilon internal static char(1) initial unaligned dcl 2-11 QEqual internal static char(1) initial unaligned dcl 2-11 QExclamation internal static char(1) initial unaligned dcl 2-11 QFive internal static char(1) initial unaligned dcl 2-11 QFive_ internal static char(1) initial unaligned dcl 2-11 QFloor internal static char(1) initial unaligned dcl 2-11 QFormatSign internal static char(1) initial unaligned dcl 2-11 QFour internal static char(1) initial unaligned dcl 2-11 QFour_ internal static char(1) initial unaligned dcl 2-11 QGradeDown internal static char(1) initial unaligned dcl 2-11 QGradeUp internal static char(1) initial unaligned dcl 2-11 QGreaterOrEqual internal static char(1) initial unaligned dcl 2-11 QGreaterThan internal static char(1) initial unaligned dcl 2-11 QIBeam internal static char(1) initial unaligned dcl 2-11 QIota internal static char(1) initial unaligned dcl 2-11 QLeftArrow internal static char(1) initial unaligned dcl 2-11 QLeftBrace internal static char(1) initial unaligned dcl 2-11 QLeftLump internal static char(1) initial unaligned dcl 2-11 QLeftParen internal static char(1) initial unaligned dcl 2-11 QLeftTack internal static char(1) initial unaligned dcl 2-11 QLessOrEqual internal static char(1) initial unaligned dcl 2-11 QLessThan internal static char(1) initial unaligned dcl 2-11 QLetterA internal static char(1) initial unaligned dcl 2-11 QLetterA_ internal static char(1) initial unaligned dcl 2-11 QLetterB internal static char(1) initial unaligned dcl 2-11 QLetterB_ internal static char(1) initial unaligned dcl 2-11 QLetterC internal static char(1) initial unaligned dcl 2-11 QLetterC_ internal static char(1) initial unaligned dcl 2-11 QLetterD internal static char(1) initial unaligned dcl 2-11 QLetterD_ internal static char(1) initial unaligned dcl 2-11 QLetterE internal static char(1) initial unaligned dcl 2-11 QLetterE_ internal static char(1) initial unaligned dcl 2-11 QLetterF internal static char(1) initial unaligned dcl 2-11 QLetterF_ internal static char(1) initial unaligned dcl 2-11 QLetterG internal static char(1) initial unaligned dcl 2-11 QLetterG_ internal static char(1) initial unaligned dcl 2-11 QLetterH internal static char(1) initial unaligned dcl 2-11 QLetterH_ internal static char(1) initial unaligned dcl 2-11 QLetterI internal static char(1) initial unaligned dcl 2-11 QLetterI_ internal static char(1) initial unaligned dcl 2-11 QLetterJ internal static char(1) initial unaligned dcl 2-11 QLetterJ_ internal static char(1) initial unaligned dcl 2-11 QLetterK internal static char(1) initial unaligned dcl 2-11 QLetterK_ internal static char(1) initial unaligned dcl 2-11 QLetterL internal static char(1) initial unaligned dcl 2-11 QLetterL_ internal static char(1) initial unaligned dcl 2-11 QLetterM internal static char(1) initial unaligned dcl 2-11 QLetterM_ internal static char(1) initial unaligned dcl 2-11 QLetterN internal static char(1) initial unaligned dcl 2-11 QLetterN_ internal static char(1) initial unaligned dcl 2-11 QLetterO internal static char(1) initial unaligned dcl 2-11 QLetterO_ internal static char(1) initial unaligned dcl 2-11 QLetterP internal static char(1) initial unaligned dcl 2-11 QLetterP_ internal static char(1) initial unaligned dcl 2-11 QLetterQ internal static char(1) initial unaligned dcl 2-11 QLetterQ_ internal static char(1) initial unaligned dcl 2-11 QLetterR internal static char(1) initial unaligned dcl 2-11 QLetterR_ internal static char(1) initial unaligned dcl 2-11 QLetterS internal static char(1) initial unaligned dcl 2-11 QLetterS_ internal static char(1) initial unaligned dcl 2-11 QLetterT internal static char(1) initial unaligned dcl 2-11 QLetterT_ internal static char(1) initial unaligned dcl 2-11 QLetterU internal static char(1) initial unaligned dcl 2-11 QLetterU_ internal static char(1) initial unaligned dcl 2-11 QLetterV internal static char(1) initial unaligned dcl 2-11 QLetterV_ internal static char(1) initial unaligned dcl 2-11 QLetterW internal static char(1) initial unaligned dcl 2-11 QLetterW_ internal static char(1) initial unaligned dcl 2-11 QLetterX internal static char(1) initial unaligned dcl 2-11 QLetterX_ internal static char(1) initial unaligned dcl 2-11 QLetterY internal static char(1) initial unaligned dcl 2-11 QLetterY_ internal static char(1) initial unaligned dcl 2-11 QLetterZ internal static char(1) initial unaligned dcl 2-11 QLetterZ_ internal static char(1) initial unaligned dcl 2-11 QLineFeed internal static char(1) initial unaligned dcl 2-11 QMarkError internal static char(1) initial unaligned dcl 2-11 QMinus internal static char(1) initial unaligned dcl 2-11 QNandSign internal static char(1) initial unaligned dcl 2-11 QNine internal static char(1) initial unaligned dcl 2-11 QNine_ internal static char(1) initial unaligned dcl 2-11 QNorSign internal static char(1) initial unaligned dcl 2-11 QNotEqual internal static char(1) initial unaligned dcl 2-11 QOmega internal static char(1) initial unaligned dcl 2-11 QOne internal static char(1) initial unaligned dcl 2-11 QOne_ internal static char(1) initial unaligned dcl 2-11 QOrSign internal static char(1) initial unaligned dcl 2-11 QPeriod internal static char(1) initial unaligned dcl 2-11 QPlus internal static char(1) initial unaligned dcl 2-11 QQuadQuote internal static char(1) initial unaligned dcl 2-11 QQuestion internal static char(1) initial unaligned dcl 2-11 QRho internal static char(1) initial unaligned dcl 2-11 QRightBrace internal static char(1) initial unaligned dcl 2-11 QRightLump internal static char(1) initial unaligned dcl 2-11 QRightTack internal static char(1) initial unaligned dcl 2-11 QSemiColon internal static char(1) initial unaligned dcl 2-11 QSeven internal static char(1) initial unaligned dcl 2-11 QSeven_ internal static char(1) initial unaligned dcl 2-11 QSix internal static char(1) initial unaligned dcl 2-11 QSix_ internal static char(1) initial unaligned dcl 2-11 QSlash internal static char(1) initial unaligned dcl 2-11 QSlashHyphen internal static char(1) initial unaligned dcl 2-11 QSmallCircle internal static char(1) initial unaligned dcl 2-11 QSpace internal static char(1) initial unaligned dcl 2-11 QStar internal static char(1) initial unaligned dcl 2-11 QTab internal static char(1) initial unaligned dcl 2-11 QThree internal static char(1) initial unaligned dcl 2-11 QThree_ internal static char(1) initial unaligned dcl 2-11 QTilde internal static char(1) initial unaligned dcl 2-11 QTimes internal static char(1) initial unaligned dcl 2-11 QTwo internal static char(1) initial unaligned dcl 2-11 QTwo_ internal static char(1) initial unaligned dcl 2-11 QUnderLine internal static char(1) initial unaligned dcl 2-11 QUpArrow internal static char(1) initial unaligned dcl 2-11 QUpperMinus internal static char(1) initial unaligned dcl 2-11 QVerticalBar internal static char(1) initial unaligned dcl 2-11 QZero internal static char(1) initial unaligned dcl 2-11 QZero_ internal static char(1) initial unaligned dcl 2-11 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 and_code internal static fixed bin(8,0) initial dcl 13-8 assign_to_trace_code internal static fixed bin(8,0) initial dcl 13-8 character_data_structure based structure level 1 dcl 11-15 character_value_type internal static bit(18) initial unaligned dcl 4-30 close_rank_type internal static fixed bin(17,0) initial dcl 9-31 close_subscript_type internal static fixed bin(17,0) initial dcl 9-31 complex_datum based complex float bin(63) array dcl 11-26 complex_value_type internal static bit(18) initial unaligned dcl 4-30 diamond_type internal static fixed bin(17,0) initial dcl 9-31 divide_code internal static fixed bin(8,0) initial dcl 13-8 equal_code internal static fixed bin(8,0) initial dcl 13-8 factorial_code internal static fixed bin(8,0) initial dcl 13-8 function_type internal static bit(18) initial unaligned dcl 4-30 grade_down_code internal static fixed bin(8,0) initial dcl 13-8 grade_up_code internal static fixed bin(8,0) initial dcl 13-8 greater_code internal static fixed bin(8,0) initial dcl 13-8 greater_equal_code internal static fixed bin(8,0) initial dcl 13-8 group_type internal static bit(18) initial unaligned dcl 4-30 integral_value_type internal static bit(18) initial unaligned dcl 4-30 iota_code internal static fixed bin(8,0) initial dcl 13-8 label_type internal static bit(18) initial unaligned dcl 4-30 leave_code internal static fixed bin(8,0) initial dcl 13-8 less_code internal static fixed bin(8,0) initial dcl 13-8 less_equal_code internal static fixed bin(8,0) initial dcl 13-8 lexed_function_statement_map based fixed bin(18,0) array dcl 6-45 lexed_function_type internal static bit(18) initial unaligned dcl 4-30 log_code internal static fixed bin(8,0) initial dcl 13-8 max_code internal static fixed bin(8,0) initial dcl 13-8 min_code internal static fixed bin(8,0) initial dcl 13-8 minus_code internal static fixed bin(8,0) initial dcl 13-8 nand_code internal static fixed bin(8,0) initial dcl 13-8 nor_code internal static fixed bin(8,0) initial dcl 13-8 not_equal_code internal static fixed bin(8,0) initial dcl 13-8 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 open_bracket_type internal static fixed bin(17,0) initial dcl 9-31 open_paren_type internal static fixed bin(17,0) initial dcl 9-31 or_code internal static fixed bin(8,0) initial dcl 13-8 output_buffer based char unaligned dcl 3-94 plus_code internal static fixed bin(8,0) initial dcl 13-8 power_code internal static fixed bin(8,0) initial dcl 13-8 reduction_stack based structure array level 1 dcl 9-31 reduction_stack_for_op based structure array level 1 dcl 9-31 reductions_pointer automatic pointer dcl 9-29 residue_code internal static fixed bin(8,0) initial dcl 13-8 rho_code internal static fixed bin(8,0) initial dcl 13-8 save_frame_type internal static fixed bin(17,0) initial dcl 9-22 semi_colon_type internal static fixed bin(17,0) initial dcl 9-31 shared_variable_type internal static bit(18) initial unaligned dcl 4-30 statement_count automatic fixed bin(17,0) dcl 6-45 take_code internal static fixed bin(8,0) initial dcl 13-8 times_code internal static fixed bin(8,0) initial dcl 13-8 trig_code internal static fixed bin(8,0) initial dcl 13-8 zero_or_one_value_type internal static bit(18) initial unaligned dcl 4-30 NAMES DECLARED BY EXPLICIT CONTEXT. apl_default_handler_ 013303 constant entry internal dcl 3275 ref 457 457 apl_parse_ 000775 constant entry external dcl 11 apl_push_stack_ 013237 constant entry internal dcl 14-4 ref 2948 append_to_input_buffer 011305 constant entry internal dcl 2704 ref 2628 2694 append_to_list_bead 012044 constant entry internal dcl 2929 ref 608 625 642 718 731 1924 bad_assign_to_label 003270 constant label dcl 1110 ref 1547 bad_assignment 003257 constant label dcl 1105 ref 1544 bad_evaluated_input 003301 constant label dcl 1115 ref 555 bad_execute 003306 constant label dcl 1120 ref 562 bol_re 001300 constant label dcl 555 ref 651 bol_val_re 001507 constant label dcl 638 ref 762 841 853 cant_get_stop_trace 003426 constant label dcl 1155 set ref 1491 1494 1505 case_3 005265 constant label dcl 1616 ref 1570 check_for_interrupt_while_input 011412 constant entry internal dcl 2751 ref 2611 2690 check_trace_vector 012321 constant entry internal dcl 3019 ref 971 clean_up_rs 011630 constant entry internal dcl 2819 ref 584 747 981 1122 1242 1269 context_error_0 003131 constant label dcl 1051 ref 602 620 671 712 725 863 950 956 962 965 968 1746 2295 decrement_reference_count 011575 constant entry internal dcl 2800 ref 488 592 593 659 882 944 994 1024 1025 1034 1035 1037 1244 1534 1559 1616 1631 1767 2225 2246 2337 2340 2381 2432 2454 2826 2987 3005 depth_error 003356 constant label dcl 1145 ref 2919 diamond_val_re 002054 constant label dcl 742 ref 855 dirty_stop 003446 constant label dcl 1177 ref 536 1759 2321 2365 2638 2664 3350 do_dyadic 005014 constant label dcl 1513 ref 769 do_inner_product 006623 constant label dcl 1971 ref 1518 do_monadic 006644 constant label dcl 1978 ref 757 779 796 814 827 837 849 domain_error 003144 constant label dcl 1060 set ref 2022 2026 2028 2220 3376 3400 domain_error_1 003155 constant label dcl 1065 ref 917 domain_error_s1 003320 constant label dcl 1128 ref 2138 done_line 002724 constant label dcl 971 ref 571 669 done_line_system_error 003467 constant label dcl 1194 ref 1011 dyadic_action 000064 constant label array(29) dcl 1522 ref 1520 end_get_value 010550 constant label dcl 2525 ref 2498 2502 2511 2515 2519 2523 end_set_value 010471 constant label dcl 2454 ref 2425 2430 2436 2440 2444 2448 2452 eval_execute_return 001604 constant label dcl 659 set ref 568 execute_error_s0 003342 constant label dcl 1138 ref 2154 exitloop 011253 constant label dcl 2687 ref 2682 fill_in_arguments 013157 constant entry internal dcl 3235 ref 1735 1736 1738 finish_dyadic_operator_routine_call 010231 constant entry internal dcl 2329 ref 1525 1641 1647 1780 1795 1807 1819 1825 1831 1838 1855 1861 1867 1878 1891 1897 1903 1914 1937 1944 1950 1968 1975 finish_monadic_operator_routine_call 010334 constant entry internal dcl 2373 ref 1778 1988 2044 2056 2068 2080 2091 2097 2103 2115 2130 2162 2168 2207 2254 2260 2266 2272 2282 2292 2301 first_timer 013105 constant entry internal dcl 3203 ref 3162 3162 3188 3188 free_list_bead 012172 constant entry internal dcl 2980 ref 2823 function_return 003012 constant label dcl 1013 ref 504 1005 get_value 000176 constant label array(2:16) dcl 2496 ref 2494 improper_dyadic_usage 003216 constant label dcl 1085 ref 1516 1671 improper_monadic_usage 003227 constant label dcl 1090 ref 1675 1981 improper_niladic_usage 003240 constant label dcl 1095 set ref 1679 increment_function_line_number 003000 constant label dcl 1003 ref 998 initial_interrupt 012632 constant entry internal dcl 3132 ref 3355 initialize_suspended_frame 011553 constant entry internal dcl 2785 ref 470 519 1152 1278 invoke_external_function 005711 constant label dcl 1743 ref 1666 invoke_monadic_function 005463 constant label dcl 1662 set ref 1999 invoke_niladic_function 005463 constant label dcl 1662 ref 1435 join_catenate 006056 constant label dcl 1793 ref 1909 join_compression 006077 constant label dcl 1802 ref 1844 join_depth_handler 003361 constant label dcl 1149 ref 1192 join_expansion 006133 constant label dcl 1814 ref 1849 lex_input_line 011462 constant entry internal dcl 2765 ref 485 496 monadic_action 000121 constant label array(30) dcl 1985 ref 1983 next_line 001134 constant label dcl 488 ref 560 586 600 985 988 1271 1273 nop_operator 007612 constant label dcl 2193 ref 2177 2185 2200 not_by_name 004362 constant label dcl 1364 ref 1342 1347 1349 1353 1355 not_end_with_value 003432 constant label dcl 1159 ref 580 on_return 013535 constant label dcl 3352 ref 3342 3344 3346 3348 op_val_re 001634 constant label dcl 674 ref 784 907 948 open_bracket_val_re 001756 constant label dcl 715 ref 818 operator_return 000000 constant label array(12) dcl 552 ref 666 1046 1302 1330 1363 1380 1389 1437 1451 1476 1511 1526 1636 1642 1648 1783 1796 1808 1820 1826 1832 1839 1856 1862 1868 1879 1892 1898 1904 1915 1932 1938 1945 1951 1963 1969 1976 1989 2039 2045 2057 2069 2081 2092 2098 2104 2116 2131 2163 2169 2198 2208 2249 2255 2261 2267 2273 2283 2293 2302 pop_stack 001351 constant label dcl 584 ref 598 print_value 010624 constant entry internal dcl 2544 ref 632 746 978 print_where_I_am 012457 constant entry internal dcl 3066 ref 516 2017 3029 3031 pull 004225 constant label dcl 1310 ref 551 576 692 859 pull_assign_system_error 003457 constant label dcl 1186 ref 1290 pull_assignment_variable 004160 constant label dcl 1283 ref 689 pull_null_var 004367 constant label dcl 1371 ref 1294 pull_stop_trace 004742 constant label dcl 1486 ref 1330 pull_system_error 003453 constant label dcl 1182 ref 1454 pull_system_variable 004651 constant label dcl 1456 ref 1333 push_new_frame 012020 constant entry internal dcl 2908 ref 518 1277 1481 1684 2145 rank_error_1 003251 constant label dcl 1100 ref 910 915 926 933 936 939 rank_error_s1 003331 constant label dcl 1133 ref 2141 re 001267 constant label dcl 549 ref 539 605 617 630 636 685 728 740 751 807 820 831 953 959 read_again 010725 constant label dcl 2596 set ref 2643 2658 2672 read_and_lex_line 001146 constant label dcl 492 ref 472 476 520 1153 1279 1484 read_executable_input_line 010724 constant entry internal dcl 2580 ref 495 reattach_user_input 012740 constant entry internal dcl 3171 ref 2743 3143 recover_from_error 004144 constant label dcl 1267 ref 1406 1414 2758 3331 3336 report_error 003500 constant label dcl 1201 ref 1053 1058 1063 1068 1073 1078 1083 1088 1093 1098 1103 1108 1113 1118 1126 1131 1136 1143 1157 1161 1175 1180 1184 1188 1196 1230 1263 1308 2904 3153 report_error_from_operator 003473 constant label dcl 1198 ref 879 1469 1771 1958 2190 2332 2376 report_error_system_error 003463 constant label dcl 1190 ref 1240 reset_interrupt_info 013044 constant entry internal dcl 3185 ref 456 1151 1177 1267 restore_old_meanings 012241 constant entry internal dcl 2997 ref 591 1023 restore_state 011727 constant entry internal dcl 2851 ref 597 997 1027 1124 1140 1229 1247 restore_state_after_execute 011737 constant entry internal dcl 2859 ref 662 restore_system_variable_value 010367 constant entry internal dcl 2395 ref 3011 return_statement 003130 constant label dcl 1048 ref 2646 2668 reverse_either 007321 constant label dcl 2113 ref 2125 rotate_either 006330 constant label dcl 1876 ref 1886 save_state 011712 constant entry internal dcl 2839 ref 517 1276 1480 1683 2144 save_system_variable_value 010474 constant entry internal dcl 2464 ref 1712 scan_for_constants_again 011223 constant label dcl 2678 ref 2698 second_timer 013143 constant entry internal dcl 3221 ref 3189 3189 3214 3214 semi_colon_val_re 002014 constant label dcl 731 ref 843 set_value 000157 constant label array(2:16) dcl 2423 ref 2421 setup_dyadic_operator_routine_call 010164 constant entry internal dcl 2305 ref 1522 1638 1644 1764 1785 1798 1810 1822 1828 1834 1841 1846 1851 1858 1864 1870 1881 1888 1894 1900 1906 1911 1934 1940 1947 1965 1971 setup_monadic_operator_routine_call 010300 constant entry internal dcl 2351 ref 1762 1985 2041 2047 2059 2072 2083 2094 2100 2106 2118 2127 2159 2165 2187 2203 2251 2257 2263 2269 2275 2285 2298 start_anew 001063 constant label dcl 466 set ref 2649 2670 start_line 001156 constant label dcl 499 ref 486 1008 1741 2157 sub 002415 constant label dcl 857 ref 615 723 this_statement_is_one 012377 constant entry internal dcl 3036 ref 510 2012 3024 val_op_val_re 002122 constant label dcl 764 ref 681 701 706 801 890 val_re 001333 constant label dcl 573 ref 710 773 805 894 val_sub 002427 constant label dcl 866 ref 708 803 892 value_error_1 003135 constant label dcl 1055 ref 896 913 value_error_reporter 012010 constant entry internal dcl 2897 ref 866 1374 1376 1653 1655 1657 1659 1994 1996 value_error_s0 003174 constant label dcl 1075 ref 1917 2003 2308 value_error_s1 003205 constant label dcl 1080 ref 2135 2171 2179 2354 value_error_s2 003163 constant label dcl 1070 ref 1531 1921 2212 2310 ws_full_no_quota_error 003436 constant label dcl 1163 set ref 3415 ws_just_loaded 001073 constant label dcl 472 ref 2655 x_op_val_re 000040 constant label array(10) dcl 753 ref 693 x_re 000014 constant label array(10) dcl 555 ref 552 x_sub 000052 constant label array(10) dcl 863 ref 860 x_val_re 000026 constant label array(10) dcl 638 ref 577 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 15576 16134 14071 15606 Length 17142 14071 336 771 1505 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_parse_ 672 external procedure is an external procedure. setup_dyadic_operator_routine_call internal procedure shares stack frame of external procedure apl_parse_. finish_dyadic_operator_routine_call internal procedure shares stack frame of external procedure apl_parse_. setup_monadic_operator_routine_call internal procedure shares stack frame of external procedure apl_parse_. finish_monadic_operator_routine_call internal procedure shares stack frame of external procedure apl_parse_. restore_system_variable_value internal procedure shares stack frame of external procedure apl_parse_. save_system_variable_value internal procedure shares stack frame of external procedure apl_parse_. print_value internal procedure shares stack frame of external procedure apl_parse_. read_executable_input_line internal procedure shares stack frame of external procedure apl_parse_. append_to_input_buffer internal procedure shares stack frame of external procedure apl_parse_. check_for_interrupt_while_input internal procedure shares stack frame of external procedure apl_parse_. lex_input_line internal procedure shares stack frame of external procedure apl_parse_. initialize_suspended_frame internal procedure shares stack frame of external procedure apl_parse_. decrement_reference_count internal procedure shares stack frame of external procedure apl_parse_. clean_up_rs internal procedure shares stack frame of external procedure apl_parse_. save_state internal procedure shares stack frame of external procedure apl_parse_. restore_state internal procedure shares stack frame of external procedure apl_parse_. value_error_reporter internal procedure shares stack frame of external procedure apl_parse_. push_new_frame internal procedure shares stack frame of external procedure apl_parse_. append_to_list_bead internal procedure shares stack frame of external procedure apl_parse_. free_list_bead internal procedure shares stack frame of external procedure apl_parse_. restore_old_meanings internal procedure shares stack frame of external procedure apl_parse_. check_trace_vector internal procedure shares stack frame of external procedure apl_parse_. this_statement_is_one internal procedure shares stack frame of external procedure apl_parse_. print_where_I_am internal procedure shares stack frame of external procedure apl_parse_. initial_interrupt internal procedure shares stack frame of internal procedure apl_default_handler_. reattach_user_input 90 internal procedure is called by several nonquick procedures. reset_interrupt_info internal procedure shares stack frame of external procedure apl_parse_. first_timer 82 internal procedure is assigned to an entry variable. second_timer 68 internal procedure is assigned to an entry variable. fill_in_arguments internal procedure shares stack frame of external procedure apl_parse_. apl_push_stack_ internal procedure shares stack frame of external procedure apl_parse_. apl_default_handler_ 136 internal procedure is assigned to an entry variable. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_default_handler_ 000106 oncode_number apl_default_handler_ apl_parse_ 000100 assignment_done apl_parse_ 000102 branch_pf_ptr apl_parse_ 000104 input_buffer_ptr apl_parse_ 000106 input_line_position apl_parse_ 000107 max_input_line apl_parse_ 000110 n_underflows apl_parse_ 000111 scan_token_type apl_parse_ 000112 temp18 apl_parse_ 000113 trace_branch_line apl_parse_ 000114 was_branch apl_parse_ 000115 was_branch_value apl_parse_ 000116 x apl_parse_ 000120 xx apl_parse_ 000122 parse_frame_ptr apl_parse_ 000124 diamond_temp apl_parse_ 000125 tmp_parseme apl_parse_ 000126 rsp apl_parse_ 000130 have_a_line apl_parse_ 000131 in_printer apl_parse_ 000132 current_parseme apl_parse_ 000133 current_lexeme apl_parse_ 000134 lexed_function_bead_ptr apl_parse_ 000136 operator_ptr apl_parse_ 000140 execute_value_ptr apl_parse_ 000142 where_execute_error apl_parse_ 000143 was_error apl_parse_ 000144 external_function_ptr apl_parse_ 000146 symbol_ptr_unal apl_parse_ 000147 meaning_ptr_unal apl_parse_ 000150 temp_ptr apl_parse_ 000152 value_bead_ptr apl_parse_ 000154 data_elements apl_parse_ 000155 start apl_parse_ 000156 put_result apl_parse_ 000157 return_point apl_parse_ 000160 number_of_arguments apl_parse_ 000161 print_final_value apl_parse_ 000162 code apl_parse_ 000163 error_mark_structure_ptr apl_parse_ 000164 ok_to_stop_control apl_parse_ 000165 i apl_parse_ 000166 packed_temp_ptr apl_parse_ 000170 ptr_to_returned_value apl_parse_ 000172 bits_for_returned_value apl_parse_ 000173 number_of_non_labels apl_parse_ 000174 ws_info_ptr apl_parse_ 000176 operators_argument apl_parse_ 000207 number_of_ptrs apl_parse_ 000210 number_of_dimensions apl_parse_ 000211 n_members apl_parse_ 000252 bead_ptr restore_system_variable_value 000254 value restore_system_variable_value 000264 bead_ptr save_system_variable_value 000266 data_ptr save_system_variable_value 000270 n_words save_system_variable_value 000272 value save_system_variable_value 000302 val_ptr print_value 000312 in_constant read_executable_input_line 000313 n_read_more read_executable_input_line 000314 prompt_length read_executable_input_line 000316 prompt_ptr read_executable_input_line 000326 got_line append_to_input_buffer 000330 input_read_ptr append_to_input_buffer 000332 user_input_attachment_known append_to_input_buffer 000440 i free_list_bead 000466 ptr_to_vb this_statement_is_one 000476 line_number print_where_I_am 000501 first_nonblank print_where_I_am 000502 line_len print_where_I_am 000503 linex print_where_I_am 000504 n_nonblank print_where_I_am 000506 sp print_where_I_am 000532 block_ptr apl_push_stack_ 000534 num_words apl_push_stack_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return move_label_var make_label_var fl2_to_fx1 tra_ext signal shorten_stack ext_entry int_entry int_entry_desc floor_fl THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_allocate_words_ apl_catenate_ apl_command_ apl_compression_ apl_copy_value_ apl_decode_ apl_domino_operator_ apl_drop_ apl_dyadic_ apl_dyadic_epsilon_ apl_dyadic_format_ apl_dyadic_ibeam_ apl_dyadic_iota_ apl_dyadic_rho_ apl_editor_ apl_encode_ apl_error_ apl_execute_lex_ apl_expansion_ apl_external_fcn_addr_ apl_file_system_ apl_file_system_$niladic_functions apl_flush_buffer_nl_ apl_free_bead_ apl_function_lex_ apl_function_lex_no_messages_ apl_get_value_stack_ apl_grade_down_ apl_grade_up_ apl_ibeam_ apl_inner_product_ apl_laminate_ apl_line_lex_ apl_monadic_ apl_monadic_format_ apl_monadic_iota_ apl_monadic_not_ apl_monadic_rho_ apl_outer_product_ apl_print_string_ apl_print_value_ apl_quadcall_ apl_random_ apl_ravel_ apl_reduction_ apl_reverse_ apl_rotate_ apl_save_command_ apl_scan_ apl_scan_operator_ apl_subscript_a_value_ apl_subscripted_assignment_ apl_system_error_ apl_system_error_ apl_system_functions_ apl_system_variables_ apl_take_ apl_transpose_ condition_ cu_$ptr_call iox_$attach_ptr iox_$close iox_$control iox_$detach_iocb iox_$get_line iox_$put_chars on_data_$get_oncode timer_manager_$alarm_call timer_manager_$reset_alarm_call THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$assign_to_label apl_error_table_$assign_to_value apl_error_table_$bad_assignment apl_error_table_$bad_evaluated_input apl_error_table_$bad_execute apl_error_table_$cant_get_stop_trace apl_error_table_$cant_read_input apl_error_table_$context apl_error_table_$depth apl_error_table_$domain apl_error_table_$done_line_system_error apl_error_table_$execute apl_error_table_$improper_dyadic_usage apl_error_table_$improper_monadic_usage apl_error_table_$improper_niladic_usage apl_error_table_$interrupt apl_error_table_$locked_function_error apl_error_table_$not_end_with_value apl_error_table_$operator_subscript_range apl_error_table_$pull_assign_system_error apl_error_table_$pull_system_error apl_error_table_$rank apl_error_table_$report_error_system_error apl_error_table_$return_from_apl apl_error_table_$super_dirty_stop apl_error_table_$too_much_input apl_error_table_$value apl_error_table_$ws_cleared apl_error_table_$ws_full_no_quota apl_error_table_$ws_loaded apl_static_$apl_input apl_static_$apl_output apl_static_$ws_info_ptr error_table_$end_of_info error_table_$not_closed error_table_$short_record iox_$user_input iox_$user_io CONSTANTS 013727 aa 777677777777 013730 aa 777377777777 013731 aa 112 070 321 000 J8 013732 aa 000006000000 013733 aa 000000000000 013734 aa 600000000041 013735 aa 000122000000 013736 aa 600000000041 013737 aa 001157000000 013740 aa 600000000041 013741 aa 001156000000 013742 aa 000006000000 013743 aa 000000000000 013744 aa 600000000041 013745 aa 000122000000 013746 aa 600000000041 013747 aa 001156000000 013750 aa 600000000041 013751 aa 001157000000 013752 aa 000004000000 013753 aa 000000000000 013754 aa 600000000041 013755 aa 001125000000 013756 aa 600000000041 013757 aa 000150000000 013760 aa 000002000000 013761 aa 000000000000 013762 aa 600000000041 013763 aa 000252000000 013764 aa 000006000000 013765 aa 000000000000 013766 aa 600000000041 013767 aa 000102000000 013770 aa 600000000041 013771 aa 000611000000 013772 aa 600000000041 013773 aa 000606000000 013774 aa 000002000000 013775 aa 000000000000 013776 aa 600000000041 013777 aa 000611000000 014000 aa 000006000000 014001 aa 000000000000 014002 aa 600000000041 014003 aa 000150000000 014004 aa 600000000041 014005 aa 000611000000 014006 aa 600000000041 014007 aa 000610000000 014010 aa 000006000000 014011 aa 000000000000 014012 aa 600000000041 014013 aa 000150000000 014014 aa 600000000041 014015 aa 000155000000 014016 aa 600000000041 014017 aa 000611000000 014020 aa 000006000000 014021 aa 000000000000 014022 aa 600000000041 014023 aa 000150000000 014024 aa 600000000041 014025 aa 000610000000 014026 aa 600000000041 014027 aa 000611000000 014030 aa 000004000000 014031 aa 000000000000 014032 aa 600000000041 014033 aa 000150000000 014034 aa 600000000041 014035 aa 000650000000 014036 aa 000002000000 014037 aa 000000000000 014040 aa 600000000041 014041 aa 000155000000 014042 aa 000002000000 014043 aa 000000000000 014044 aa 600000000041 014045 aa 000607000000 014046 aa 767777777777 014050 aa 000002000000 014051 aa 000000000000 014052 aa 600000000041 014053 aa 000133000000 014054 aa 000006000000 014055 aa 000000000000 014056 aa 600000000041 014057 aa 000122000000 014060 aa 600000000041 014061 aa 000541000000 014062 aa 600000000041 014063 aa 000535000000 014064 aa 000002000000 014065 aa 000000000000 014066 aa 600000000041 014067 aa 000162000000 014070 aa 007777000001 000216 aa 000000000000 000217 aa 000000000012 000220 aa 600000000000 000222 aa 000000000000 000223 aa 000000000004 000224 aa 012 000 000 000 000225 aa 010200000143 000226 aa 030200000143 000227 aa 050200000143 000230 aa 000000000001 000231 aa 000000000001 000232 aa 000000000001 000233 aa 000000000001 000234 aa 000000000001 000235 aa 000000000001 000236 aa 000000000001 000237 aa 000000000001 000240 aa 000000000001 000241 aa 000000000001 000242 aa 000000000001 000243 aa 000000000001 000244 aa 000000000001 000245 aa 000000000001 000246 aa 000000000001 000247 aa 000000000001 000250 aa 000000000001 000251 aa 000000000001 000252 aa 000000000001 000253 aa 000000000001 000254 aa 000000000001 000255 aa 000000000001 000256 aa 000000000001 000257 aa 000000000001 000260 aa 000000000001 000261 aa 000000000001 000262 aa 000000000001 000263 aa 000000000001 000264 aa 000000000001 000265 aa 000000000001 000266 aa 000000000001 000267 aa 000000000001 000270 aa 000000000001 000271 aa 000000000001 000272 aa 000000000001 000273 aa 000000000001 000274 aa 000000000012 000275 aa 000000000006 000276 aa 000000000004 000277 aa 000000000017 000300 aa 000000000020 000301 aa 000000000001 000302 aa 000000000001 000303 aa 000000000007 000304 aa 000000000010 000305 aa 000000000021 000306 aa 000000000014 000307 aa 000000000015 000310 aa 000000000022 000311 aa 000000000023 000312 aa 000000000003 000313 aa 000000000024 000314 aa 000000000025 000315 aa 000000000001 000316 aa 000000000027 000317 aa 000000000035 000320 aa 000000000001 000321 aa 000000000031 000322 aa 000000000032 000323 aa 000000000032 000324 aa 000000000032 000325 aa 000000000032 000326 aa 000000000032 000327 aa 000000000032 000330 aa 000000000032 000331 aa 000000000032 000332 aa 000000000032 000333 aa 000000000001 000334 aa 000000000033 000335 aa 000000000001 000336 aa 000000000001 000337 aa 000000000001 000340 aa 000000000030 000341 aa 000000000011 000342 aa 000000000011 000343 aa 000000000011 000344 aa 000000000011 000345 aa 000000000001 000346 aa 000000000011 000347 aa 000000000001 000350 aa 000000000001 000351 aa 000000000001 000352 aa 000000000001 000353 aa 000000000001 000354 aa 000000000001 000355 aa 000000000001 000356 aa 000000000001 000357 aa 000000000011 000360 aa 000000000011 000361 aa 000000000011 000362 aa 000000000001 000363 aa 000000000011 000364 aa 000000000011 000365 aa 000000000013 000366 aa 000000000001 000367 aa 000000000001 000370 aa 000000000001 000371 aa 000000000001 000372 aa 000000000016 000373 aa 000000000005 000374 aa 000000000001 000375 aa 000000000001 000376 aa 000000000002 000377 aa 000000000034 000400 aa 000000000001 000401 aa 000000000001 000402 aa 000000000001 000403 aa 000000000001 000404 aa 000000000001 000405 aa 000000000001 000406 aa 000000000001 000407 aa 000000000001 000410 aa 000000000001 000411 aa 000000000001 000412 aa 000000000001 000413 aa 000000000001 000414 aa 000000000001 000415 aa 000000000001 000416 aa 000000000001 000417 aa 000000000001 000420 aa 000000000001 000421 aa 000000000001 000422 aa 000000000026 000423 aa 000000000001 000424 aa 000000000030 000425 aa 000000000001 000426 aa 000000000001 000427 aa 000000000001 000430 aa 000000000001 000431 aa 000000000001 000432 aa 000000000001 000433 aa 000000000001 000434 aa 000000000001 000435 aa 000000000001 000436 aa 000000000001 000437 aa 000000000001 000440 aa 000000000001 000441 aa 000000000001 000442 aa 000000000001 000443 aa 000000000001 000444 aa 000000000001 000445 aa 000000000001 000446 aa 000000000001 000447 aa 000000000001 000450 aa 000000000001 000451 aa 000000000001 000452 aa 000000000001 000453 aa 000000000001 000454 aa 000000000001 000455 aa 000000000001 000456 aa 000000000001 000457 aa 000000000001 000460 aa 000000000001 000461 aa 000000000001 000462 aa 000000000001 000463 aa 000000000001 000464 aa 000000000001 000465 aa 000000000001 000466 aa 000000000001 000467 aa 000000000001 000470 aa 000000000001 000471 aa 000000000030 000472 aa 000000000004 000473 aa 000000000027 000474 aa 000000000001 000475 aa 000000000001 000476 aa 000000000033 000477 aa 000000000034 000500 aa 000000000001 000501 aa 000000000001 000502 aa 000000000013 000503 aa 000000000001 000504 aa 000000000001 000505 aa 000000000014 000506 aa 000000000015 000507 aa 000000000001 000510 aa 000000000001 000511 aa 000000000001 000512 aa 000000000016 000513 aa 000000000017 000514 aa 000000000020 000515 aa 000000000012 000516 aa 000000000032 000517 aa 000000000025 000520 aa 000000000025 000521 aa 000000000025 000522 aa 000000000025 000523 aa 000000000025 000524 aa 000000000025 000525 aa 000000000025 000526 aa 000000000025 000527 aa 000000000025 000530 aa 000000000003 000531 aa 000000000031 000532 aa 000000000025 000533 aa 000000000025 000534 aa 000000000025 000535 aa 000000000001 000536 aa 000000000001 000537 aa 000000000001 000540 aa 000000000001 000541 aa 000000000001 000542 aa 000000000011 000543 aa 000000000001 000544 aa 000000000011 000545 aa 000000000011 000546 aa 000000000011 000547 aa 000000000011 000550 aa 000000000001 000551 aa 000000000001 000552 aa 000000000011 000553 aa 000000000011 000554 aa 000000000001 000555 aa 000000000001 000556 aa 000000000001 000557 aa 000000000011 000560 aa 000000000001 000561 aa 000000000001 000562 aa 000000000035 000563 aa 000000000005 000564 aa 000000000006 000565 aa 000000000007 000566 aa 000000000010 000567 aa 000000000001 000570 aa 000000000002 000571 aa 000000000001 000572 aa 000000000001 000573 aa 000000000001 000574 aa 000000000001 000575 aa 000000000021 000576 aa 000000000022 000577 aa 000000000023 000600 aa 000000000023 000601 aa 000000000023 000602 aa 000000000023 000603 aa 000000000023 000604 aa 000000000023 000605 aa 000000000026 000606 aa 000000000026 000607 aa 000000000024 000610 aa 000000000001 000611 aa 000000000001 000612 aa 000000000001 000613 aa 000000000001 000614 aa 000000000001 000615 aa 000000000023 000616 aa 000000000011 000617 aa 000000000001 000620 aa 000000000036 000621 aa 000000000001 000622 aa 162 145 141 144 read 000623 aa 137 142 141 143 _bac 000624 aa 153 137 163 160 k_sp 000625 aa 141 143 145 163 aces 000626 aa 524000000010 000627 aa 524000000012 000630 aa 524000000014 000631 aa 161 165 151 164 quit 000632 aa 526077777777 000633 aa 404000000023 000634 aa 524000000015 000635 aa 404000000025 000636 aa 042777776000 000637 aa 526000000000 000640 aa 466000000000 000641 aa 524000000000 000642 aa 404000000021 000643 aa 514000000044 000644 aa 042606500000 000645 aa 404000000043 000646 aa 526000000020 000647 aa 500000000000 000650 aa 524000000011 000651 aa 514000000001 000652 aa 464000000000 000654 aa 143 157 156 164 cont 000655 aa 151 156 165 145 inue 000656 aa 146 151 156 151 fini 000657 aa 163 150 000 000 sh 000660 aa 145 162 162 157 erro 000661 aa 162 000 000 000 r 000662 aa 157 166 145 162 over 000663 aa 146 154 157 167 flow 000664 aa 143 154 145 141 clea 000665 aa 162 040 167 163 r ws 000666 aa 077777000043 000667 aa 000001000000 000670 aa 165 156 144 145 unde 000671 aa 162 146 154 157 rflo 000672 aa 167 000 000 000 w 000673 aa 172 145 162 157 zero 000674 aa 144 151 166 151 divi 000675 aa 144 145 000 000 de 000676 aa 162 145 163 145 rese 000677 aa 164 167 162 151 twri 000700 aa 164 145 000 000 te 000701 aa 160 162 157 143 proc 000702 aa 145 163 163 137 ess_ 000703 aa 161 165 151 164 quit 000704 aa 162 145 163 145 rese 000705 aa 164 162 145 141 trea 000706 aa 144 000 000 000 d 000707 aa 141 156 171 137 any_ 000710 aa 157 164 150 145 othe 000711 aa 162 000 000 000 r 000712 aa 141 160 154 137 apl_ 000713 aa 161 165 151 164 quit 000714 aa 137 000 000 000 _ 000715 aa 146 151 170 145 fixe 000716 aa 144 157 166 145 dove 000717 aa 162 146 154 157 rflo 000720 aa 167 000 000 000 w 000721 aa 163 171 156 137 syn_ 000722 aa 040 165 163 145 use 000723 aa 162 137 151 057 r_i/ 000724 aa 157 000 000 000 o 000725 aa 141 160 154 137 apl_ 000726 aa 144 151 162 164 dirt 000727 aa 171 137 163 164 y_st 000730 aa 157 160 137 000 op_ 000731 aa 141 160 154 137 apl_ 000732 aa 163 171 163 164 syst 000733 aa 145 155 137 145 em_e 000734 aa 162 162 157 162 rror 000735 aa 137 000 000 000 _ 000736 aa 160 162 157 147 prog 000737 aa 162 141 155 137 ram_ 000740 aa 151 156 164 145 inte 000741 aa 162 162 165 160 rrup 000742 aa 164 000 000 000 t 000743 aa 162 145 143 157 reco 000744 aa 162 144 137 161 rd_q 000745 aa 165 157 164 141 uota 000746 aa 137 157 166 145 _ove 000747 aa 162 146 154 157 rflo 000750 aa 167 000 000 000 w 000751 aa 504000000004 000752 aa 404000000021 000753 aa 506000000016 000754 aa 516000000001 000755 aa 516000000001 000756 aa 516000000001 000757 aa 516000000001 000760 aa 516000000001 000761 aa 516000000001 000762 aa 516000000001 000763 aa 516000000001 000764 aa 516000000001 000765 aa 516000000001 000766 aa 516000000001 000767 aa 516000000007 000770 aa 406000000010 000771 aa 406000000010 000772 aa 466000000000 000773 aa 404000000021 LABEL ARRAYS 000000 aa 002104 7100 04 tra 1092,ic 002104 000001 aa 002130 7100 04 tra 1112,ic 002131 000002 aa 002153 7100 04 tra 1131,ic 002155 000003 aa 002235 7100 04 tra 1181,ic 002240 000004 aa 002271 7100 04 tra 1209,ic 002275 000005 aa 002316 7100 04 tra 1230,ic 002323 000006 aa 002342 7100 04 tra 1250,ic 002350 000007 aa 001263 7100 04 tra 691,ic 001272 000010 aa 001326 7100 04 tra 726,ic 001336 000011 aa 001673 7100 04 tra 955,ic 001704 000012 aa 002406 7100 04 tra 1286,ic 002420 000013 aa 002364 7100 04 tra 1268,ic 002377 000014 aa 001264 7100 04 tra 692,ic 001300 000015 aa 001316 7100 04 tra 718,ic 001333 000016 aa 001326 7100 04 tra 726,ic 001344 000017 aa 001376 7100 04 tra 766,ic 001415 000020 aa 001376 7100 04 tra 766,ic 001416 000021 aa 001376 7100 04 tra 766,ic 001417 000022 aa 001430 7100 04 tra 792,ic 001452 000023 aa 001430 7100 04 tra 792,ic 001453 000024 aa 001430 7100 04 tra 792,ic 001454 000025 aa 001454 7100 04 tra 812,ic 001501 000026 aa 001461 7100 04 tra 817,ic 001507 000027 aa 001604 7100 04 tra 900,ic 001633 000030 aa 001604 7100 04 tra 900,ic 001634 000031 aa 001661 7100 04 tra 945,ic 001712 000032 aa 001723 7100 04 tra 979,ic 001755 000033 aa 001723 7100 04 tra 979,ic 001756 000034 aa 001756 7100 04 tra 1006,ic 002012 000035 aa 001756 7100 04 tra 1006,ic 002013 000036 aa 001756 7100 04 tra 1006,ic 002014 000037 aa 002015 7100 04 tra 1037,ic 002054 000040 aa 002033 7100 04 tra 1051,ic 002073 000041 aa 002061 7100 04 tra 1073,ic 002122 000042 aa 002102 7100 04 tra 1090,ic 002144 000043 aa 002133 7100 04 tra 1115,ic 002176 000044 aa 002217 7100 04 tra 1167,ic 002263 000045 aa 002217 7100 04 tra 1167,ic 002264 000046 aa 002243 7100 04 tra 1187,ic 002311 000047 aa 002243 7100 04 tra 1187,ic 002312 000050 aa 002267 7100 04 tra 1207,ic 002337 000051 aa 002315 7100 04 tra 1229,ic 002366 000052 aa 002354 7100 04 tra 1260,ic 002426 000053 aa 002354 7100 04 tra 1260,ic 002427 000054 aa 002461 7100 04 tra 1329,ic 002535 000055 aa 002640 7100 04 tra 1440,ic 002715 000056 aa 002640 7100 04 tra 1440,ic 002716 000057 aa 002640 7100 04 tra 1440,ic 002717 000060 aa 002640 7100 04 tra 1440,ic 002720 000061 aa 002640 7100 04 tra 1440,ic 002721 000062 aa 002640 7100 04 tra 1440,ic 002722 000063 aa 002640 7100 04 tra 1440,ic 002723 000064 aa 004755 7100 04 tra 2541,ic 005041 000065 aa 004767 7100 04 tra 2551,ic 005054 000066 aa 005277 7100 04 tra 2751,ic 005365 000067 aa 005311 7100 04 tra 2761,ic 005400 000070 aa 005323 7100 04 tra 2771,ic 005413 000071 aa 005737 7100 04 tra 3039,ic 006030 000072 aa 005776 7100 04 tra 3070,ic 006070 000073 aa 006031 7100 04 tra 3097,ic 006124 000074 aa 006064 7100 04 tra 3124,ic 006160 000075 aa 006076 7100 04 tra 3134,ic 006173 000076 aa 006110 7100 04 tra 3144,ic 006206 000077 aa 006127 7100 04 tra 3159,ic 006226 000100 aa 006132 7100 04 tra 3162,ic 006232 000101 aa 006135 7100 04 tra 3165,ic 006236 000102 aa 006156 7100 04 tra 3182,ic 006260 000103 aa 006170 7100 04 tra 3192,ic 006273 000104 aa 006202 7100 04 tra 3202,ic 006306 000105 aa 006235 7100 04 tra 3229,ic 006342 000106 aa 006254 7100 04 tra 3244,ic 006362 000107 aa 006266 7100 04 tra 3254,ic 006375 000110 aa 006300 7100 04 tra 3264,ic 006410 000111 aa 006312 7100 04 tra 3274,ic 006423 000112 aa 006315 7100 04 tra 3277,ic 006427 000113 aa 006327 7100 04 tra 3287,ic 006442 000114 aa 006372 7100 04 tra 3322,ic 006506 000115 aa 006404 7100 04 tra 3332,ic 006521 000116 aa 006421 7100 04 tra 3345,ic 006537 000117 aa 006433 7100 04 tra 3355,ic 006552 000120 aa 006470 7100 04 tra 3384,ic 006610 000121 aa 006542 7100 04 tra 3426,ic 006663 000122 aa 006554 7100 04 tra 3436,ic 006676 000123 aa 006604 7100 04 tra 3460,ic 006727 000124 aa 006740 7100 04 tra 3552,ic 007064 000125 aa 006752 7100 04 tra 3562,ic 007077 000126 aa 007005 7100 04 tra 3589,ic 007133 000127 aa 007037 7100 04 tra 3615,ic 007166 000130 aa 007072 7100 04 tra 3642,ic 007222 000131 aa 007124 7100 04 tra 3668,ic 007255 000132 aa 007136 7100 04 tra 3678,ic 007270 000133 aa 007150 7100 04 tra 3688,ic 007303 000134 aa 007177 7100 04 tra 3711,ic 007333 000135 aa 007214 7100 04 tra 3724,ic 007351 000136 aa 007226 7100 04 tra 3734,ic 007364 000137 aa 007337 7100 04 tra 3807,ic 007476 000140 aa 007351 7100 04 tra 3817,ic 007511 000141 aa 007363 7100 04 tra 3827,ic 007524 000142 aa 007407 7100 04 tra 3847,ic 007551 000143 aa 007435 7100 04 tra 3869,ic 007600 000144 aa 007467 7100 04 tra 3895,ic 007633 000145 aa 007467 7100 04 tra 3895,ic 007634 000146 aa 007504 7100 04 tra 3908,ic 007652 000147 aa 007645 7100 04 tra 4005,ic 010014 000150 aa 007657 7100 04 tra 4015,ic 010027 000151 aa 007671 7100 04 tra 4025,ic 010042 000152 aa 007703 7100 04 tra 4035,ic 010055 000153 aa 007715 7100 04 tra 4045,ic 010070 000154 aa 007744 7100 04 tra 4068,ic 010120 000155 aa 007773 7100 04 tra 4091,ic 010150 000156 aa 007773 7100 04 tra 4091,ic 010151 000157 aa 010240 7100 04 tra 4256,ic 010417 000160 aa 010243 7100 04 tra 4259,ic 010423 000161 aa 010250 7100 04 tra 4264,ic 010431 000162 aa 010264 7100 04 tra 4276,ic 010446 000163 aa 010270 7100 04 tra 4280,ic 010453 000164 aa 010274 7100 04 tra 4284,ic 010460 000165 aa 000000000000 000166 aa 000000000000 000167 aa 000000000000 000170 aa 000000000000 000171 aa 000000000000 000172 aa 000000000000 000173 aa 000000000000 000174 aa 000000000000 000175 aa 010270 7100 04 tra 4280,ic 010465 000176 aa 010310 7100 04 tra 4296,ic 010506 000177 aa 010313 7100 04 tra 4299,ic 010512 000200 aa 010316 7100 04 tra 4302,ic 010516 000201 aa 010324 7100 04 tra 4308,ic 010525 000202 aa 010330 7100 04 tra 4312,ic 010532 000203 aa 010334 7100 04 tra 4316,ic 010537 000204 aa 000000000000 000205 aa 000000000000 000206 aa 000000000000 000207 aa 000000000000 000210 aa 000000000000 000211 aa 000000000000 000212 aa 000000000000 000213 aa 000000000000 000214 aa 010330 7100 04 tra 4312,ic 010544 BEGIN PROCEDURE apl_parse_ ENTRY TO apl_parse_ STATEMENT 1 ON LINE 11 apl_parse_: procedure; 000774 da 001443200000 000775 aa 001240 6270 00 eax7 672 000776 aa 7 00034 3521 20 epp2 pr7|28,* 000777 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 001000 aa 000000000000 001001 aa 000000000000 STATEMENT 1 ON LINE 206 001002 aa 6 00124 4501 00 stz pr6|84 diamond_temp STATEMENT 1 ON LINE 7 OF FILE 3 001003 la 4 00322 7671 20 lprp7 pr4|210,* apl_static_$ws_info_ptr.static_ws_info_ptr 001004 aa 6 00174 6535 00 spri7 pr6|124 ws_info_ptr STATEMENT 1 ON LINE 456 call reset_interrupt_info; 001005 aa 012037 6700 04 tsp4 5151,ic 013044 STATEMENT 1 ON LINE 457 call condition_ ("any_other", apl_default_handler_); 001006 aa 777701 2350 04 lda -63,ic 000707 = 141156171137 001007 aa 777701 2360 04 ldq -63,ic 000710 = 157164150145 001010 aa 6 00536 7571 00 staq pr6|350 001011 aa 162000 2350 03 lda 58368,du 001012 aa 6 00540 7551 00 sta pr6|352 001013 aa 012270 3520 04 epp2 5304,ic 013303 = 000220627000 001014 aa 6 00542 2521 00 spri2 pr6|354 cp.1079 001015 aa 6 00544 6521 00 spri6 pr6|356 cp.1079 001016 aa 6 00536 3521 00 epp2 pr6|350 001017 aa 6 00550 2521 00 spri2 pr6|360 001020 aa 6 00542 3521 00 epp2 pr6|354 cp.1079 001021 aa 6 00552 2521 00 spri2 pr6|362 001022 aa 777626 3520 04 epp2 -106,ic 000650 = 524000000011 001023 aa 6 00554 2521 00 spri2 pr6|364 001024 aa 777623 3520 04 epp2 -109,ic 000647 = 500000000000 001025 aa 6 00556 2521 00 spri2 pr6|366 001026 aa 6 00546 6211 00 eax1 pr6|358 001027 aa 010000 4310 07 fld 4096,dl 001030 aa 6 00044 3701 20 epp4 pr6|36,* 001031 la 4 00016 3521 20 epp2 pr4|14,* condition_ 001032 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 463 call iox_$control (iox_$user_io, read_back_spaces_order, null, (0)); 001033 aa 777633 3734 24 epp7 -101,ic* 001034 aa 6 00560 6535 00 spri7 pr6|368 001035 aa 6 00541 4501 00 stz pr6|353 001036 aa 6 00044 3701 20 epp4 pr6|36,* 001037 la 4 00104 3521 20 epp2 pr4|68,* iox_$user_io 001040 aa 6 00564 2521 00 spri2 pr6|372 001041 aa 777561 3520 04 epp2 -143,ic 000622 = 162145141144 001042 aa 6 00566 2521 00 spri2 pr6|374 001043 aa 6 00560 3521 00 epp2 pr6|368 001044 aa 6 00570 2521 00 spri2 pr6|376 001045 aa 6 00541 3521 00 epp2 pr6|353 001046 aa 6 00572 2521 00 spri2 pr6|378 001047 aa 777603 3520 04 epp2 -125,ic 000652 = 464000000000 001050 aa 6 00574 2521 00 spri2 pr6|380 001051 aa 6 00600 2521 00 spri2 pr6|384 001052 aa 777574 3520 04 epp2 -132,ic 000646 = 526000000020 001053 aa 6 00576 2521 00 spri2 pr6|382 001054 aa 777571 3520 04 epp2 -135,ic 000645 = 404000000043 001055 aa 6 00602 2521 00 spri2 pr6|386 001056 aa 6 00562 6211 00 eax1 pr6|370 001057 aa 020000 4310 07 fld 8192,dl 001060 la 4 00026 3521 20 epp2 pr4|22,* iox_$control 001061 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 464 n_underflows = 0; 001062 aa 6 00110 4501 00 stz pr6|72 n_underflows STATEMENT 1 ON LINE 466 start_anew: ws_info.current_parse_frame_ptr -> parse_frame.last_parse_frame_ptr = null; 001063 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 001064 aa 7 00015 7671 00 lprp7 pr7|13 ws_info.current_parse_frame_ptr 001065 aa 013003 2360 04 ldq 5635,ic 014070 = 007777000001 001066 aa 7 00000 7561 00 stq pr7|0 parse_frame.last_parse_frame_ptr STATEMENT 1 ON LINE 469 parse_frame_ptr = ws_info.current_parse_frame_ptr; 001067 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 001070 aa 5 00015 7651 00 lprp5 pr5|13 ws_info.current_parse_frame_ptr 001071 aa 6 00122 6515 00 spri5 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 470 call initialize_suspended_frame; 001072 aa 010461 6700 04 tsp4 4401,ic 011553 STATEMENT 1 ON LINE 472 ws_just_loaded: if parse_frame.parse_frame_type = evaluated_frame_type then go to read_and_lex_line; 001073 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001074 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 001075 aa 000003 1160 07 cmpq 3,dl 001076 aa 000050 6000 04 tze 40,ic 001146 STATEMENT 1 ON LINE 476 if ws_info.wsid = "clear ws" /* skip latent expression */ then go to read_and_lex_line; 001077 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 001100 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 001101 aa 5 00036 00 0144 desc9a pr5|30,100 ws_info.wsid 001102 aa 777564 00 0010 desc9a -140,8 000664 = 143154145141 001103 aa 000043 6000 04 tze 35,ic 001146 STATEMENT 1 ON LINE 479 number_of_ptrs = 1; 001104 aa 000001 2360 07 ldq 1,dl 001105 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 480 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 001106 aa 000014 0760 07 adq 12,dl 001107 aa 7 00000 3521 06 epp2 pr7|0,ql 001110 aa 000000 0520 03 adwp2 0,du 001111 aa 6 00104 2521 00 spri2 pr6|68 input_buffer_ptr STATEMENT 1 ON LINE 481 input_buffer.n_read = 5; 001112 aa 000005 2360 07 ldq 5,dl 001113 aa 2 00000 7561 00 stq pr2|0 input_buffer.n_read STATEMENT 1 ON LINE 482 input_buffer.line = QExecuteSign || QQuad || "lx" || QNewLine; 001114 aa 000216 2350 03 lda 142,du 001115 aa 274000 2750 03 ora 96256,du 001116 aa 6 00541 7551 00 sta pr6|353 001117 aa 154170 2350 07 lda 55416,dl 001120 aa 6 00541 2751 00 ora pr6|353 001121 aa 012000 2360 03 ldq 5120,du 001122 aa 6 00560 7571 00 staq pr6|368 001123 aa 2 00000 2361 00 ldq pr2|0 input_buffer.n_read 001124 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 001125 aa 6 00560 00 0005 desc9a pr6|368,5 001126 aa 2 00001 00 0006 desc9a pr2|1,ql input_buffer.line STATEMENT 1 ON LINE 484 parse_frame.current_line_number = 1; 001127 aa 000001 2360 07 ldq 1,dl 001130 aa 7 00007 7561 00 stq pr7|7 parse_frame.current_line_number STATEMENT 1 ON LINE 485 call lex_input_line (code); 001131 aa 012733 3520 04 epp2 5595,ic 014064 = 000002000000 001132 aa 010330 6700 04 tsp4 4312,ic 011462 STATEMENT 1 ON LINE 486 go to start_line; 001133 aa 000023 7100 04 tra 19,ic 001156 STATEMENT 1 ON LINE 488 next_line: if parse_frame.lexed_function_bead_ptr ^= null then call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 001134 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001135 aa 7 00003 2361 00 ldq pr7|3 parse_frame.lexed_function_bead_ptr 001136 aa 012732 1160 04 cmpq 5594,ic 014070 = 007777000001 001137 aa 000007 6000 04 tze 7,ic 001146 001140 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 001141 aa 6 00550 2521 00 spri2 pr6|360 001142 aa 6 00546 3521 00 epp2 pr6|358 001143 aa 004000 4310 07 fld 2048,dl 001144 aa 2 00000 7571 00 staq pr2|0 001145 aa 010430 6700 04 tsp4 4376,ic 011575 STATEMENT 1 ON LINE 492 read_and_lex_line: code = 1; 001146 aa 000001 2360 07 ldq 1,dl 001147 aa 6 00162 7561 00 stq pr6|114 code STATEMENT 1 ON LINE 494 do while (code ^= 0); 001150 aa 6 00162 2361 00 ldq pr6|114 code 001151 aa 000005 6000 04 tze 5,ic 001156 STATEMENT 1 ON LINE 495 call read_executable_input_line; 001152 aa 007552 6700 04 tsp4 3946,ic 010724 STATEMENT 1 ON LINE 496 call lex_input_line (code); 001153 aa 012711 3520 04 epp2 5577,ic 014064 = 000002000000 001154 aa 010306 6700 04 tsp4 4294,ic 011462 STATEMENT 1 ON LINE 497 end; 001155 aa 777773 7100 04 tra -5,ic 001150 STATEMENT 1 ON LINE 499 start_line: lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 001156 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001157 aa 7 00003 7671 00 lprp7 pr7|3 parse_frame.lexed_function_bead_ptr 001160 aa 6 00134 6535 00 spri7 pr6|92 lexed_function_bead_ptr STATEMENT 1 ON LINE 504 if lexed_function_bead_ptr -> lexed_function_bead.number_of_statements = 0 then go to function_return; 001161 aa 7 00004 2361 00 ldq pr7|4 lexed_function_bead.number_of_statements 001162 aa 001630 6000 04 tze 920,ic 003012 STATEMENT 1 ON LINE 507 current_lexeme = lexed_function_bead_ptr -> statement_map (parse_frame.current_line_number) + 1; 001163 aa 7 00005 2361 00 ldq pr7|5 lexed_function_bead.number_of_localized_symbols 001164 aa 000012 0760 07 adq 10,dl 001165 aa 7 00006 0761 00 adq pr7|6 lexed_function_bead.number_of_labels 001166 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 001167 aa 5 00007 0761 00 adq pr5|7 parse_frame.current_line_number 001170 aa 7 77777 2361 06 ldq pr7|-1,ql lexed_function_bead.statement_map 001171 aa 000001 0760 07 adq 1,dl 001172 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 509 have_a_line = "1"b; 001173 aa 400000 2350 03 lda 131072,du 001174 aa 6 00130 7551 00 sta pr6|88 have_a_line STATEMENT 1 ON LINE 510 if parse_frame_type = function_frame_type then if parse_frame.function_bead_ptr -> stop_control_pointer ^= null then if this_statement_is_one (parse_frame.current_line_number, parse_frame.function_bead_ptr -> stop_control_pointer) then if ok_to_stop_control then do; 001175 aa 5 00001 2361 00 ldq pr5|1 parse_frame.parse_frame_type 001176 aa 000002 1160 07 cmpq 2,dl 001177 aa 000036 6010 04 tnz 30,ic 001235 001200 aa 5 00002 7631 00 lprp3 pr5|2 parse_frame.function_bead_ptr 001201 aa 3 00004 2361 00 ldq pr3|4 function_bead.stop_control_pointer 001202 aa 012666 1160 04 cmpq 5558,ic 014070 = 007777000001 001203 aa 000032 6000 04 tze 26,ic 001235 001204 aa 5 00007 3521 00 epp2 pr5|7 parse_frame.current_line_number 001205 aa 6 00550 2521 00 spri2 pr6|360 001206 aa 3 00004 3521 00 epp2 pr3|4 function_bead.stop_control_pointer 001207 aa 6 00552 2521 00 spri2 pr6|362 001210 aa 6 00541 3521 00 epp2 pr6|353 001211 aa 6 00554 2521 00 spri2 pr6|364 001212 aa 6 00546 3521 00 epp2 pr6|358 001213 aa 014000 4310 07 fld 6144,dl 001214 aa 2 00000 7571 00 staq pr2|0 001215 aa 011162 6700 04 tsp4 4722,ic 012377 001216 aa 6 00541 2351 00 lda pr6|353 001217 aa 400000 3150 03 cana 131072,du 001220 aa 000015 6000 04 tze 13,ic 001235 001221 aa 6 00164 2351 00 lda pr6|116 ok_to_stop_control 001222 aa 000013 6000 04 tze 11,ic 001235 STATEMENT 1 ON LINE 516 call print_where_I_am (parse_frame_ptr, "0"b, "1"b); 001223 aa 000000 2350 07 lda 0,dl 001224 aa 6 00541 7551 00 sta pr6|353 001225 aa 400000 2350 03 lda 131072,du 001226 aa 6 00535 7551 00 sta pr6|349 001227 aa 012625 3520 04 epp2 5525,ic 014054 = 000006000000 001230 aa 011227 6700 04 tsp4 4759,ic 012457 STATEMENT 1 ON LINE 517 call save_state; 001231 aa 010461 6700 04 tsp4 4401,ic 011712 STATEMENT 1 ON LINE 518 call push_new_frame; 001232 aa 010566 6700 04 tsp4 4470,ic 012020 STATEMENT 1 ON LINE 519 call initialize_suspended_frame; 001233 aa 010320 6700 04 tsp4 4304,ic 011553 STATEMENT 1 ON LINE 520 go to read_and_lex_line; 001234 aa 777712 7100 04 tra -54,ic 001146 STATEMENT 1 ON LINE 521 end; STATEMENT 1 ON LINE 523 ok_to_stop_control = "1"b; 001235 aa 400000 2350 03 lda 131072,du 001236 aa 6 00164 7551 00 sta pr6|116 ok_to_stop_control STATEMENT 1 ON LINE 524 print_final_value = "1"b; 001237 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 525 was_branch = "0"b; 001240 aa 6 00114 4501 00 stz pr6|76 was_branch STATEMENT 1 ON LINE 526 was_branch_value = "0"b; 001241 aa 6 00115 4501 00 stz pr6|77 was_branch_value STATEMENT 1 ON LINE 527 trace_branch_line = "0"b; 001242 aa 6 00113 4501 00 stz pr6|75 trace_branch_line STATEMENT 1 ON LINE 528 current_parseme = 1; 001243 aa 000001 2360 07 ldq 1,dl 001244 aa 6 00132 7561 00 stq pr6|90 current_parseme STATEMENT 1 ON LINE 529 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 001245 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 001246 aa 7 00016 2361 00 ldq pr7|14 ws_info.value_stack_ptr 001247 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 001250 aa 5 00013 7561 00 stq pr5|11 parse_frame.initial_value_stack_ptr STATEMENT 1 ON LINE 530 rs (current_parseme).type = eol_type; 001251 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001252 aa 000002 7360 00 qls 2 001253 aa 000000 6270 06 eax7 0,ql 001254 aa 000000 2360 07 ldq 0,dl 001255 aa 6 00126 3535 20 epp3 pr6|86,* rsp 001256 aa 3 77774 7561 17 stq pr3|-4,7 rs.type STATEMENT 1 ON LINE 531 unspec (rs (current_parseme).bits) = ""b; 001257 aa 3 77775 4501 17 stz pr3|-3,7 STATEMENT 1 ON LINE 532 if clean_interrupt_pending then do; 001260 aa 7 00106 2351 00 lda pr7|70 ws_info.clean_interrupt_pending 001261 aa 000006 6000 04 tze 6,ic 001267 STATEMENT 1 ON LINE 534 dont_interrupt_parse = "0"b; 001262 aa 7 00100 4501 00 stz pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 535 current_lexeme = current_lexeme - 1; 001263 aa 000001 3360 07 lcq 1,dl 001264 aa 6 00133 0561 00 asq pr6|91 current_lexeme STATEMENT 1 ON LINE 536 go to dirty_stop; 001265 aa 002161 7100 04 tra 1137,ic 003446 STATEMENT 1 ON LINE 537 end; STATEMENT 1 ON LINE 539 go to re; 001266 aa 000001 7100 04 tra 1,ic 001267 STATEMENT 1 ON LINE 549 re: return_point = 8; 001267 aa 000010 2360 07 ldq 8,dl 001270 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 551 go to pull; 001271 aa 002734 7100 04 tra 1500,ic 004225 STATEMENT 1 ON LINE 552 operator_return (8): go to x_re (rs (current_parseme).type); 001272 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001273 aa 000002 7360 00 qls 2 001274 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001275 aa 7 77774 7271 06 lxl7 pr7|-4,ql rs.type 001276 aa 6 00535 7561 00 stq pr6|349 001277 ta 000013 7100 17 tra 11,7 STATEMENT 1 ON LINE 555 x_re (1): /* BOL RE */ bol_re: if parse_frame_type = evaluated_frame_type then if rs (current_parseme - 1).semantics_valid then go to bad_evaluated_input; 001300 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001301 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 001302 aa 000003 1160 07 cmpq 3,dl 001303 aa 000011 6010 04 tnz 9,ic 001314 001304 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001305 aa 000001 1760 07 sbq 1,dl 001306 aa 000002 7360 00 qls 2 001307 aa 6 00126 3715 20 epp5 pr6|86,* rsp 001310 aa 5 77775 2351 06 lda pr5|-3,ql rs.semantics_valid 001311 aa 004000 3150 03 cana 2048,du 001312 aa 001767 6010 04 tnz 1015,ic 003301 STATEMENT 1 ON LINE 560 else go to next_line; 001313 aa 777621 7100 04 tra -111,ic 001134 STATEMENT 1 ON LINE 562 if parse_frame_type = execute_frame_type then if rs (current_parseme - 1).semantics_valid then go to bad_execute; 001314 aa 000004 1160 07 cmpq 4,dl 001315 aa 001407 6010 04 tnz 775,ic 002724 001316 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001317 aa 000001 1760 07 sbq 1,dl 001320 aa 000002 7360 00 qls 2 001321 aa 6 00126 3715 20 epp5 pr6|86,* rsp 001322 aa 5 77775 2351 06 lda pr5|-3,ql rs.semantics_valid 001323 aa 004000 3150 03 cana 2048,du 001324 aa 001762 6010 04 tnz 1010,ic 003306 STATEMENT 1 ON LINE 565 else do; STATEMENT 1 ON LINE 566 ptr_to_returned_value = null; 001325 aa 777341 2370 04 ldaq -287,ic 000666 = 077777000043 000001000000 001326 aa 6 00170 7571 00 staq pr6|120 ptr_to_returned_value STATEMENT 1 ON LINE 567 bits_for_returned_value = value_bits; 001327 aa 004000 2350 03 lda 2048,du 001330 aa 6 00172 7551 00 sta pr6|122 bits_for_returned_value STATEMENT 1 ON LINE 568 go to eval_execute_return; 001331 aa 000253 7100 04 tra 171,ic 001604 STATEMENT 1 ON LINE 569 end; STATEMENT 1 ON LINE 571 go to done_line; 001332 aa 001372 7100 04 tra 762,ic 002724 STATEMENT 1 ON LINE 573 x_re (2): /* VAL RE */ val_re: return_point = 9; 001333 aa 000011 2360 07 ldq 9,dl 001334 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 576 go to pull; 001335 aa 002670 7100 04 tra 1464,ic 004225 STATEMENT 1 ON LINE 577 operator_return (9): go to x_val_re (rs (current_parseme).type); 001336 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001337 aa 000002 7360 00 qls 2 001340 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001341 aa 7 77774 7271 06 lxl7 pr7|-4,ql rs.type 001342 aa 6 00541 7561 00 stq pr6|353 001343 ta 000025 7100 17 tra 21,7 STATEMENT 1 ON LINE 580 x_re (3): /* OP RE */ if rs (current_parseme).op1 ^= branch_code /* allow only -> here */ then go to not_end_with_value; 001344 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 001345 aa 000033 7350 00 als 27 001346 aa 000077 7330 00 lrs 63 001347 aa 000103 1160 07 cmpq 67,dl 001350 aa 002062 6010 04 tnz 1074,ic 003432 STATEMENT 1 ON LINE 584 pop_stack: call clean_up_rs; 001351 aa 010257 6700 04 tsp4 4271,ic 011630 STATEMENT 1 ON LINE 586 if last_parse_frame_ptr = null then go to next_line; 001352 aa 6 00122 2361 20 ldq pr6|82,* parse_frame.last_parse_frame_ptr 001353 aa 012515 1160 04 cmpq 5453,ic 014070 = 007777000001 001354 aa 777560 6000 04 tze -144,ic 001134 STATEMENT 1 ON LINE 588 if parse_frame.lexed_function_bead_ptr ^= null then do; 001355 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001356 aa 7 00003 2361 00 ldq pr7|3 parse_frame.lexed_function_bead_ptr 001357 aa 012511 1160 04 cmpq 5449,ic 014070 = 007777000001 001360 aa 000025 6000 04 tze 21,ic 001405 STATEMENT 1 ON LINE 590 lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 001361 aa 7 00003 7651 00 lprp5 pr7|3 parse_frame.lexed_function_bead_ptr 001362 aa 6 00134 6515 00 spri5 pr6|92 lexed_function_bead_ptr STATEMENT 1 ON LINE 591 call restore_old_meanings; 001363 aa 010656 6700 04 tsp4 4526,ic 012241 STATEMENT 1 ON LINE 592 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 001364 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001365 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 001366 aa 6 00550 2521 00 spri2 pr6|360 001367 aa 6 00546 3521 00 epp2 pr6|358 001370 aa 004000 4310 07 fld 2048,dl 001371 aa 2 00000 7571 00 staq pr2|0 001372 aa 010203 6700 04 tsp4 4227,ic 011575 STATEMENT 1 ON LINE 593 if parse_frame.parse_frame_type = function_frame_type then call decrement_reference_count (parse_frame.function_bead_ptr); 001373 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001374 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 001375 aa 000002 1160 07 cmpq 2,dl 001376 aa 000007 6010 04 tnz 7,ic 001405 001377 aa 7 00002 3521 00 epp2 pr7|2 parse_frame.function_bead_ptr 001400 aa 6 00550 2521 00 spri2 pr6|360 001401 aa 6 00546 3521 00 epp2 pr6|358 001402 aa 004000 4310 07 fld 2048,dl 001403 aa 2 00000 7571 00 staq pr2|0 001404 aa 010171 6700 04 tsp4 4217,ic 011575 STATEMENT 1 ON LINE 595 end; STATEMENT 1 ON LINE 596 parse_frame_ptr = last_parse_frame_ptr; 001405 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 001406 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 597 call restore_state; 001407 aa 010320 6700 04 tsp4 4304,ic 011727 STATEMENT 1 ON LINE 598 if parse_frame_type ^= suspended_frame_type then go to pop_stack; 001410 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001411 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 001412 aa 000001 1160 07 cmpq 1,dl 001413 aa 777736 6010 04 tnz -34,ic 001351 STATEMENT 1 ON LINE 600 else go to next_line; 001414 aa 777520 7100 04 tra -176,ic 001134 STATEMENT 1 ON LINE 602 x_re (4): /* ( RE */ go to context_error_0; 001415 aa 001514 7100 04 tra 844,ic 003131 STATEMENT 1 ON LINE 605 x_re (5): /* ) RE */ go to re; 001416 aa 777651 7100 04 tra -87,ic 001267 STATEMENT 1 ON LINE 608 x_re (6): /* [ RE */ call append_to_list_bead (addr (rs (current_parseme - 1)) -> rs_overlay); 001417 aa 7 77770 3521 06 epp2 pr7|-8,ql rs_overlay 001420 aa 6 00550 2521 00 spri2 pr6|360 001421 aa 6 00546 3521 00 epp2 pr6|358 001422 aa 004000 4310 07 fld 2048,dl 001423 aa 2 00000 7571 00 staq pr2|0 001424 aa 010420 6700 04 tsp4 4368,ic 012044 STATEMENT 1 ON LINE 610 rs (current_parseme - 1).semantics -> list_bead.member_ptr (1) = null; 001425 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001426 aa 000002 7360 00 qls 2 001427 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001430 aa 7 77772 7671 06 lprp7 pr7|-6,ql rs.semantics 001431 aa 000000 6270 06 eax7 0,ql 001432 aa 012436 2360 04 ldq 5406,ic 014070 = 007777000001 001433 aa 7 00003 7561 00 stq pr7|3 list_bead.member_ptr STATEMENT 1 ON LINE 611 unspec (rs (current_parseme - 1).semantics -> list_bead.bits (1)) = ""b; 001434 aa 6 00126 3715 20 epp5 pr6|86,* rsp 001435 aa 5 77772 7651 17 lprp5 pr5|-6,7 rs.semantics 001436 aa 5 00004 4501 00 stz pr5|4 STATEMENT 1 ON LINE 612 rs (current_parseme - 1).lexeme = rs (current_parseme).lexeme; 001437 aa 6 00126 3535 20 epp3 pr6|86,* rsp 001440 aa 3 77777 2361 17 ldq pr3|-1,7 rs.lexeme 001441 aa 3 77773 7561 17 stq pr3|-5,7 rs.lexeme STATEMENT 1 ON LINE 613 current_parseme = current_parseme - 1; 001442 aa 000001 3360 07 lcq 1,dl 001443 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 614 rs (current_parseme).type = subscript_type; 001444 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001445 aa 000002 7360 00 qls 2 001446 aa 000000 6260 06 eax6 0,ql 001447 aa 000013 2360 07 ldq 11,dl 001450 aa 3 77774 7561 16 stq pr3|-4,6 rs.type STATEMENT 1 ON LINE 615 go to sub; 001451 aa 000744 7100 04 tra 484,ic 002415 STATEMENT 1 ON LINE 617 x_re (7): /* ]SB RE */ go to re; 001452 aa 777615 7100 04 tra -115,ic 001267 STATEMENT 1 ON LINE 620 x_re (8): /* ]RK RE */ go to context_error_0; 001453 aa 001456 7100 04 tra 814,ic 003131 STATEMENT 1 ON LINE 623 x_re (9): /* ; RE */ print_final_value = "1"b; 001454 aa 400000 2350 03 lda 131072,du 001455 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 625 call append_to_list_bead (addr (rs (current_parseme - 1)) -> rs_overlay); 001456 aa 7 77770 3521 06 epp2 pr7|-8,ql rs_overlay 001457 aa 6 00550 2521 00 spri2 pr6|360 001460 aa 6 00546 3521 00 epp2 pr6|358 001461 aa 004000 4310 07 fld 2048,dl 001462 aa 2 00000 7571 00 staq pr2|0 001463 aa 010361 6700 04 tsp4 4337,ic 012044 STATEMENT 1 ON LINE 626 rs (current_parseme - 1).semantics -> list_bead.member_ptr (1) = null; 001464 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001465 aa 000002 7360 00 qls 2 001466 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001467 aa 7 77772 7671 06 lprp7 pr7|-6,ql rs.semantics 001470 aa 000000 6270 06 eax7 0,ql 001471 aa 012377 2360 04 ldq 5375,ic 014070 = 007777000001 001472 aa 7 00003 7561 00 stq pr7|3 list_bead.member_ptr STATEMENT 1 ON LINE 627 unspec (rs (current_parseme - 1).semantics -> list_bead.bits (1)) = ""b; 001473 aa 6 00126 3715 20 epp5 pr6|86,* rsp 001474 aa 5 77772 7651 17 lprp5 pr5|-6,7 rs.semantics 001475 aa 5 00004 4501 00 stz pr5|4 STATEMENT 1 ON LINE 629 current_parseme = current_parseme - 1; 001476 aa 000001 3360 07 lcq 1,dl 001477 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 630 go to re; 001500 aa 777567 7100 04 tra -137,ic 001267 STATEMENT 1 ON LINE 632 x_re (10): /* <> RE */ call print_value; 001501 aa 007123 6700 04 tsp4 3667,ic 010624 STATEMENT 1 ON LINE 634 current_parseme = current_parseme - 1; 001502 aa 000001 3360 07 lcq 1,dl 001503 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 635 print_final_value = "1"b; 001504 aa 400000 2350 03 lda 131072,du 001505 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 636 go to re; 001506 aa 777561 7100 04 tra -143,ic 001267 STATEMENT 1 ON LINE 638 x_val_re (1): /* BOL VAL RE */ bol_val_re: if rs (current_parseme - 2).semantics_valid then do; 001507 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001510 aa 000002 1760 07 sbq 2,dl 001511 aa 000002 7360 00 qls 2 001512 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001513 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 001514 aa 004000 3150 03 cana 2048,du 001515 aa 000053 6000 04 tze 43,ic 001570 STATEMENT 1 ON LINE 642 call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 001516 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001517 aa 000002 7360 00 qls 2 001520 aa 7 77764 3521 06 epp2 pr7|-12,ql rs_overlay 001521 aa 6 00550 2521 00 spri2 pr6|360 001522 aa 6 00604 7561 00 stq pr6|388 001523 aa 6 00546 3521 00 epp2 pr6|358 001524 aa 004000 4310 07 fld 2048,dl 001525 aa 2 00000 7571 00 staq pr2|0 001526 aa 010316 6700 04 tsp4 4302,ic 012044 STATEMENT 1 ON LINE 643 if print_final_value /* set up bits.op1 for whether to print value */ then rs (current_parseme - 1).bits.op1 = 0; 001527 aa 6 00161 2351 00 lda pr6|113 print_final_value 001530 aa 000011 6000 04 tze 9,ic 001541 001531 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001532 aa 000001 1760 07 sbq 1,dl 001533 aa 000002 7360 00 qls 2 001534 aa 000000 2350 03 lda 0,du 001535 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001536 aa 7 77775 3715 06 epp5 pr7|-3,ql rs.op1 001537 aa 5 00000 5511 04 stba pr5|0,04 rs.op1 001540 aa 000010 7100 04 tra 8,ic 001550 STATEMENT 1 ON LINE 645 else rs (current_parseme - 1).bits.op1 = 1; 001541 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001542 aa 000001 1760 07 sbq 1,dl 001543 aa 000002 7360 00 qls 2 001544 aa 000001 2350 07 lda 1,dl 001545 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001546 aa 7 77775 3715 06 epp5 pr7|-3,ql rs.op1 001547 aa 5 00000 5511 04 stba pr5|0,04 rs.op1 STATEMENT 1 ON LINE 646 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = unspec (rs (current_parseme - 1).bits); 001550 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001551 aa 000002 7360 00 qls 2 001552 aa 7 77766 7651 06 lprp5 pr7|-10,ql rs.semantics 001553 aa 7 77771 2351 06 lda pr7|-7,ql 001554 aa 5 00004 7551 00 sta pr5|4 STATEMENT 1 ON LINE 648 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 001555 aa 000000 6270 06 eax7 0,ql 001556 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 001557 aa 5 00003 7561 00 stq pr5|3 list_bead.member_ptr STATEMENT 1 ON LINE 649 rs (current_parseme - 1) = rs (current_parseme); 001560 aa 7 77774 3535 17 epp3 pr7|-4,7 rs 001561 aa 7 77770 3515 17 epp1 pr7|-8,7 rs 001562 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001563 aa 3 00000 00 0020 desc9a pr3|0,16 rs 001564 aa 1 00000 00 0020 desc9a pr1|0,16 rs STATEMENT 1 ON LINE 650 current_parseme = current_parseme - 1; 001565 aa 000001 3360 07 lcq 1,dl 001566 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 651 go to bol_re; 001567 aa 777511 7100 04 tra -183,ic 001300 STATEMENT 1 ON LINE 652 end; STATEMENT 1 ON LINE 654 if parse_frame.parse_frame_type = evaluated_frame_type | parse_frame.parse_frame_type = execute_frame_type then do; 001570 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 001571 aa 5 00001 2361 00 ldq pr5|1 parse_frame.parse_frame_type 001572 aa 000003 1160 07 cmpq 3,dl 001573 aa 000003 6000 04 tze 3,ic 001576 001574 aa 000004 1160 07 cmpq 4,dl 001575 aa 001127 6010 04 tnz 599,ic 002724 STATEMENT 1 ON LINE 656 ptr_to_returned_value = rs (current_parseme - 1).semantics; 001576 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001577 aa 000002 7360 00 qls 2 001600 aa 7 77772 7631 06 lprp3 pr7|-6,ql rs.semantics 001601 aa 6 00170 2535 00 spri3 pr6|120 ptr_to_returned_value STATEMENT 1 ON LINE 657 bits_for_returned_value = unspec (rs (current_parseme - 1).bits); 001602 aa 7 77771 2351 06 lda pr7|-7,ql 001603 aa 6 00172 7551 00 sta pr6|122 bits_for_returned_value STATEMENT 1 ON LINE 659 eval_execute_return: call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 001604 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 001605 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 001606 aa 6 00550 2521 00 spri2 pr6|360 001607 aa 6 00546 3521 00 epp2 pr6|358 001610 aa 004000 4310 07 fld 2048,dl 001611 aa 2 00000 7571 00 staq pr2|0 001612 aa 007763 6700 04 tsp4 4083,ic 011575 STATEMENT 1 ON LINE 661 parse_frame_ptr = last_parse_frame_ptr; 001613 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 001614 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 662 call restore_state_after_execute; 001615 aa 010122 6700 04 tsp4 4178,ic 011737 STATEMENT 1 ON LINE 663 rs (put_result).type = val_type; 001616 aa 6 00156 2361 00 ldq pr6|110 put_result 001617 aa 000002 7360 00 qls 2 001620 aa 000000 6270 06 eax7 0,ql 001621 aa 000002 2360 07 ldq 2,dl 001622 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001623 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 664 rs (put_result).semantics = ptr_to_returned_value; 001624 aa 6 00170 3715 20 epp5 pr6|120,* ptr_to_returned_value 001625 aa 7 77776 5451 17 sprp5 pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 665 unspec (rs (put_result).bits) = bits_for_returned_value; 001626 aa 6 00172 2351 00 lda pr6|122 bits_for_returned_value 001627 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 666 go to operator_return (return_point); 001630 aa 6 00157 7261 00 lxl6 pr6|111 return_point 001631 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 667 end; STATEMENT 1 ON LINE 669 go to done_line; 001632 aa 001072 7100 04 tra 570,ic 002724 STATEMENT 1 ON LINE 671 x_val_re (2): /* VAL VAL RE */ go to context_error_0; 001633 aa 001276 7100 04 tra 702,ic 003131 STATEMENT 1 ON LINE 674 x_val_re (3): /* OP VAL RE */ op_val_re: if rs (current_parseme).op1 = semicolon_cons_code | rs (current_parseme).op1 = quadcall_semicolon_code then if rs (current_parseme-2).op1 = semicolon_cons_code | rs (current_parseme-2).op1 = quadcall_semicolon_code then do; 001634 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001635 aa 000002 7360 00 qls 2 001636 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001637 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 001640 aa 000033 7350 00 als 27 001641 aa 6 00605 7561 00 stq pr6|389 001642 aa 000077 7330 00 lrs 63 001643 aa 6 00606 7561 00 stq pr6|390 rs.op1 001644 aa 000110 1160 07 cmpq 72,dl 001645 aa 000003 6000 04 tze 3,ic 001650 001646 aa 000174 1160 07 cmpq 124,dl 001647 aa 000025 6010 04 tnz 21,ic 001674 001650 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001651 aa 000002 1760 07 sbq 2,dl 001652 aa 000002 7360 00 qls 2 001653 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 001654 aa 000033 7350 00 als 27 001655 aa 6 00607 7561 00 stq pr6|391 001656 aa 000077 7330 00 lrs 63 001657 aa 6 00607 7561 00 stq pr6|391 rs.op1 001660 aa 000110 1160 07 cmpq 72,dl 001661 aa 000003 6000 04 tze 3,ic 001664 001662 aa 000174 1160 07 cmpq 124,dl 001663 aa 000005 6010 04 tnz 5,ic 001670 STATEMENT 1 ON LINE 679 current_parseme = current_parseme - 1; 001664 aa 000001 3360 07 lcq 1,dl 001665 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 680 current_lexeme = current_lexeme + 1; 001666 aa 6 00133 0541 00 aos pr6|91 current_lexeme STATEMENT 1 ON LINE 681 goto val_op_val_re; 001667 aa 000233 7100 04 tra 155,ic 002122 STATEMENT 1 ON LINE 682 end; STATEMENT 1 ON LINE 683 else do; STATEMENT 1 ON LINE 684 rs (current_parseme).type = close_paren_type; 001670 aa 000005 2360 07 ldq 5,dl 001671 aa 6 00605 7271 00 lxl7 pr6|389 001672 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 685 goto re; 001673 aa 777374 7100 04 tra -260,ic 001267 STATEMENT 1 ON LINE 686 end; STATEMENT 1 ON LINE 687 return_point = 10; 001674 aa 000012 2360 07 ldq 10,dl 001675 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 689 if (rs (current_parseme).op1 = assignment_code) | (rs (current_parseme).op1 = subscripted_assignment_code) then go to pull_assignment_variable; 001676 aa 6 00606 2361 00 ldq pr6|390 rs.op1 001677 aa 000146 1160 07 cmpq 102,dl 001700 aa 002260 6000 04 tze 1200,ic 004160 001701 aa 000147 1160 07 cmpq 103,dl 001702 aa 002256 6000 04 tze 1198,ic 004160 STATEMENT 1 ON LINE 692 go to pull; 001703 aa 002322 7100 04 tra 1234,ic 004225 STATEMENT 1 ON LINE 693 operator_return (10): go to x_op_val_re (rs (current_parseme).type); 001704 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001705 aa 000002 7360 00 qls 2 001706 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001707 aa 7 77774 7271 06 lxl7 pr7|-4,ql rs.type 001710 aa 6 00606 7561 00 stq pr6|390 001711 ta 000037 7100 17 tra 31,7 STATEMENT 1 ON LINE 696 x_val_re (4): /* ( VAL RE */ if rs (current_parseme-2).op1 = semicolon_cons_code | rs (current_parseme-2).op1 = quadcall_semicolon_code then do; 001712 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001713 aa 000002 1760 07 sbq 2,dl 001714 aa 000002 7360 00 qls 2 001715 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 001716 aa 000033 7350 00 als 27 001717 aa 6 00605 7561 00 stq pr6|389 001720 aa 000077 7330 00 lrs 63 001721 aa 6 00605 7561 00 stq pr6|389 rs.op1 001722 aa 000110 1160 07 cmpq 72,dl 001723 aa 000003 6000 04 tze 3,ic 001726 001724 aa 000174 1160 07 cmpq 124,dl 001725 aa 000005 6010 04 tnz 5,ic 001732 STATEMENT 1 ON LINE 699 current_parseme = current_parseme - 1; 001726 aa 000001 3360 07 lcq 1,dl 001727 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 700 current_lexeme = current_lexeme + 1; 001730 aa 6 00133 0541 00 aos pr6|91 current_lexeme STATEMENT 1 ON LINE 701 goto val_op_val_re; 001731 aa 000171 7100 04 tra 121,ic 002122 STATEMENT 1 ON LINE 702 end; STATEMENT 1 ON LINE 703 print_final_value = "1"b; 001732 aa 400000 2350 03 lda 131072,du 001733 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 704 rs (current_parseme - 2) = rs (current_parseme - 1); 001734 aa 6 00541 7261 00 lxl6 pr6|353 001735 aa 7 77770 3715 16 epp5 pr7|-8,6 rs 001736 aa 7 77764 3535 16 epp3 pr7|-12,6 rs 001737 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001740 aa 5 00000 00 0020 desc9a pr5|0,16 rs 001741 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 705 current_parseme = current_parseme - 2; 001742 aa 000002 3360 07 lcq 2,dl 001743 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 706 if rs (current_parseme - 1).type = op_type then go to val_op_val_re; 001744 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001745 aa 000002 7360 00 qls 2 001746 aa 6 00541 7561 00 stq pr6|353 001747 aa 7 77770 2361 06 ldq pr7|-8,ql rs.type 001750 aa 000003 1160 07 cmpq 3,dl 001751 aa 000151 6000 04 tze 105,ic 002122 STATEMENT 1 ON LINE 708 else if rs (current_parseme - 1).type = subscript_type then go to val_sub; 001752 aa 000013 1160 07 cmpq 11,dl 001753 aa 000454 6000 04 tze 300,ic 002427 STATEMENT 1 ON LINE 710 else go to val_re; 001754 aa 777357 7100 04 tra -273,ic 001333 STATEMENT 1 ON LINE 712 x_val_re (5): /* ) VAL RE */ go to context_error_0; 001755 aa 001154 7100 04 tra 620,ic 003131 STATEMENT 1 ON LINE 715 x_val_re (6): /* [ VAL RE */ open_bracket_val_re: rs (current_parseme - 2).type = subscript_type; 001756 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001757 aa 000002 7360 00 qls 2 001760 aa 000000 6270 06 eax7 0,ql 001761 aa 000013 2360 07 ldq 11,dl 001762 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001763 aa 7 77764 7561 17 stq pr7|-12,7 rs.type STATEMENT 1 ON LINE 718 call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 001764 aa 7 77764 3521 17 epp2 pr7|-12,7 rs_overlay 001765 aa 6 00550 2521 00 spri2 pr6|360 001766 aa 6 00546 3521 00 epp2 pr6|358 001767 aa 004000 4310 07 fld 2048,dl 001770 aa 2 00000 7571 00 staq pr2|0 001771 aa 6 00541 7471 00 stx7 pr6|353 001772 aa 010052 6700 04 tsp4 4138,ic 012044 STATEMENT 1 ON LINE 719 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = unspec (rs (current_parseme - 1).bits); 001773 aa 6 00132 2361 00 ldq pr6|90 current_parseme 001774 aa 000002 7360 00 qls 2 001775 aa 6 00126 3735 20 epp7 pr6|86,* rsp 001776 aa 7 77766 7671 06 lprp7 pr7|-10,ql rs.semantics 001777 aa 6 00126 3715 20 epp5 pr6|86,* rsp 002000 aa 5 77771 2351 06 lda pr5|-7,ql 002001 aa 7 00004 7551 00 sta pr7|4 STATEMENT 1 ON LINE 720 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 002002 aa 000000 6270 06 eax7 0,ql 002003 aa 5 77772 2361 06 ldq pr5|-6,ql rs.semantics 002004 aa 7 00003 7561 00 stq pr7|3 list_bead.member_ptr STATEMENT 1 ON LINE 721 rs (current_parseme - 2).lexeme = rs (current_parseme).lexeme; 002005 aa 5 77777 2361 17 ldq pr5|-1,7 rs.lexeme 002006 aa 5 77767 7561 17 stq pr5|-9,7 rs.lexeme STATEMENT 1 ON LINE 722 current_parseme = current_parseme - 2; 002007 aa 000002 3360 07 lcq 2,dl 002010 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 723 go to sub; 002011 aa 000404 7100 04 tra 260,ic 002415 STATEMENT 1 ON LINE 725 x_val_re (7): /* ]SB VAL RE */ go to context_error_0; 002012 aa 001117 7100 04 tra 591,ic 003131 STATEMENT 1 ON LINE 728 x_val_re (8): /* ]RK VAL RE */ go to re; 002013 aa 777254 7100 04 tra -340,ic 001267 STATEMENT 1 ON LINE 731 x_val_re (9): /* ; VAL RE */ semi_colon_val_re: call append_to_list_bead (addr (rs (current_parseme - 2)) -> rs_overlay); 002014 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002015 aa 000002 7360 00 qls 2 002016 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002017 aa 7 77764 3521 06 epp2 pr7|-12,ql rs_overlay 002020 aa 6 00550 2521 00 spri2 pr6|360 002021 aa 6 00605 7561 00 stq pr6|389 002022 aa 6 00546 3521 00 epp2 pr6|358 002023 aa 004000 4310 07 fld 2048,dl 002024 aa 2 00000 7571 00 staq pr2|0 002025 aa 010017 6700 04 tsp4 4111,ic 012044 STATEMENT 1 ON LINE 734 rs (current_parseme - 1).bits.op1 = binary (^print_final_value, 1); 002026 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002027 aa 000001 1760 07 sbq 1,dl 002030 aa 000002 7360 00 qls 2 002031 aa 6 00161 2351 00 lda pr6|113 print_final_value 002032 aa 0 00002 6751 00 era pr0|2 = 400000000000 002033 aa 000000 6270 06 eax7 0,ql 002034 aa 000107 7730 00 lrl 71 002035 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002036 aa 7 77775 3715 17 epp5 pr7|-3,7 rs.op1 002037 aa 5 00000 5521 04 stbq pr5|0,04 rs.op1 STATEMENT 1 ON LINE 736 unspec (rs (current_parseme - 2).semantics -> list_bead.bits (1)) = unspec (rs (current_parseme - 1).bits); 002040 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002041 aa 000002 7360 00 qls 2 002042 aa 7 77766 7651 06 lprp5 pr7|-10,ql rs.semantics 002043 aa 7 77771 2351 06 lda pr7|-7,ql 002044 aa 5 00004 7551 00 sta pr5|4 STATEMENT 1 ON LINE 737 rs (current_parseme - 2).semantics -> list_bead.member_ptr (1) = rs (current_parseme - 1).semantics; 002045 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 002046 aa 5 00003 7561 00 stq pr5|3 list_bead.member_ptr STATEMENT 1 ON LINE 738 current_parseme = current_parseme - 2; 002047 aa 000002 3360 07 lcq 2,dl 002050 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 739 print_final_value = "1"b; 002051 aa 400000 2350 03 lda 131072,du 002052 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 740 go to re; 002053 aa 777214 7100 04 tra -372,ic 001267 STATEMENT 1 ON LINE 742 x_val_re (10): /* <> VAL RE */ diamond_val_re: diamond_temp = current_parseme; 002054 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002055 aa 6 00124 7561 00 stq pr6|84 diamond_temp STATEMENT 1 ON LINE 745 tmp_parseme = parse_frame.current_parseme; 002056 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 002057 aa 7 00005 2361 00 ldq pr7|5 parse_frame.current_parseme 002060 aa 6 00125 7561 00 stq pr6|85 tmp_parseme STATEMENT 1 ON LINE 746 call print_value; 002061 aa 006543 6700 04 tsp4 3427,ic 010624 STATEMENT 1 ON LINE 747 call clean_up_rs; 002062 aa 007546 6700 04 tsp4 3942,ic 011630 STATEMENT 1 ON LINE 748 current_parseme = diamond_temp; 002063 aa 6 00124 2361 00 ldq pr6|84 diamond_temp 002064 aa 6 00132 7561 00 stq pr6|90 current_parseme STATEMENT 1 ON LINE 749 parse_frame.current_parseme = tmp_parseme; 002065 aa 6 00125 2361 00 ldq pr6|85 tmp_parseme 002066 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 002067 aa 7 00005 7561 00 stq pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 750 print_final_value = "1"b; 002070 aa 400000 2350 03 lda 131072,du 002071 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 751 go to re; 002072 aa 777175 7100 04 tra -387,ic 001267 STATEMENT 1 ON LINE 753 x_op_val_re (1): /* BOL OP VAL RE */ start = current_parseme - 1; 002073 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002074 aa 000001 1760 07 sbq 1,dl 002075 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 755 put_result = current_parseme - 2; 002076 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002077 aa 000002 1760 07 sbq 2,dl 002100 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 756 return_point = 1; 002101 aa 000001 2360 07 ldq 1,dl 002102 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 757 go to do_monadic; 002103 aa 004541 7100 04 tra 2401,ic 006644 STATEMENT 1 ON LINE 758 operator_return (1): rs (put_result).lexeme = rs (current_parseme - 1).lexeme; 002104 aa 6 00156 2361 00 ldq pr6|110 put_result 002105 aa 000002 7360 00 qls 2 002106 aa 000000 6270 06 eax7 0,ql 002107 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002110 aa 000002 7360 00 qls 2 002111 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002112 aa 000000 6260 06 eax6 0,ql 002113 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 002114 aa 7 77777 7561 17 stq pr7|-1,7 rs.lexeme STATEMENT 1 ON LINE 760 rs (current_parseme - 1).type = bol_type; 002115 aa 000001 2360 07 ldq 1,dl 002116 aa 7 77770 7561 16 stq pr7|-8,6 rs.type STATEMENT 1 ON LINE 761 current_parseme = current_parseme - 1; 002117 aa 000001 3360 07 lcq 1,dl 002120 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 762 go to bol_val_re; 002121 aa 777366 7100 04 tra -266,ic 001507 STATEMENT 1 ON LINE 764 x_op_val_re (2): /* VAL OP VAL RE */ val_op_val_re: start = current_parseme; 002122 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002123 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 767 put_result = current_parseme - 2; 002124 aa 000002 1760 07 sbq 2,dl 002125 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 768 return_point = 2; 002126 aa 000002 2360 07 ldq 2,dl 002127 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 769 go to do_dyadic; 002130 aa 002664 7100 04 tra 1460,ic 005014 STATEMENT 1 ON LINE 770 operator_return (2): rs (put_result).lexeme = rs (current_parseme).lexeme; 002131 aa 6 00156 2361 00 ldq pr6|110 put_result 002132 aa 000002 7360 00 qls 2 002133 aa 000000 6270 06 eax7 0,ql 002134 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002135 aa 000002 7360 00 qls 2 002136 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002137 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 002140 aa 7 77777 7561 17 stq pr7|-1,7 rs.lexeme STATEMENT 1 ON LINE 772 current_parseme = current_parseme - 2; 002141 aa 000002 3360 07 lcq 2,dl 002142 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 773 go to val_re; 002143 aa 777170 7100 04 tra -392,ic 001333 STATEMENT 1 ON LINE 775 x_op_val_re (3): /* OP OP VAL RE */ start = current_parseme - 1; 002144 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002145 aa 000001 1760 07 sbq 1,dl 002146 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 777 put_result = current_parseme - 2; 002147 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002150 aa 000002 1760 07 sbq 2,dl 002151 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 778 return_point = 3; 002152 aa 000003 2360 07 ldq 3,dl 002153 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 779 go to do_monadic; 002154 aa 004470 7100 04 tra 2360,ic 006644 STATEMENT 1 ON LINE 780 operator_return (3): rs (put_result).lexeme = rs (current_parseme - 1).lexeme; 002155 aa 6 00156 2361 00 ldq pr6|110 put_result 002156 aa 000002 7360 00 qls 2 002157 aa 000000 6270 06 eax7 0,ql 002160 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002161 aa 000002 7360 00 qls 2 002162 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002163 aa 000000 6260 06 eax6 0,ql 002164 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 002165 aa 7 77777 7561 17 stq pr7|-1,7 rs.lexeme STATEMENT 1 ON LINE 782 rs (current_parseme - 1) = rs (current_parseme); 002166 aa 7 77774 3715 16 epp5 pr7|-4,6 rs 002167 aa 7 77770 3535 16 epp3 pr7|-8,6 rs 002170 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002171 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002172 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 783 current_parseme = current_parseme - 1; 002173 aa 000001 3360 07 lcq 1,dl 002174 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 784 go to op_val_re; 002175 aa 777437 7100 04 tra -225,ic 001634 STATEMENT 1 ON LINE 786 x_op_val_re (4): /* ( OP VAL RE */ if rs (current_parseme-3).op1 = semicolon_cons_code | rs (current_parseme-3).op1 = quadcall_semicolon_code then do; 002176 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002177 aa 000003 1760 07 sbq 3,dl 002200 aa 000002 7360 00 qls 2 002201 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 002202 aa 000033 7350 00 als 27 002203 aa 6 00607 7561 00 stq pr6|391 002204 aa 000077 7330 00 lrs 63 002205 aa 000110 1160 07 cmpq 72,dl 002206 aa 6 00607 7561 00 stq pr6|391 rs.op1 002207 aa 000003 6000 04 tze 3,ic 002212 002210 aa 000174 1160 07 cmpq 124,dl 002211 aa 000016 6010 04 tnz 14,ic 002227 STATEMENT 1 ON LINE 789 rs (current_parseme-5) = rs (current_parseme-4); 002212 aa 6 00606 7261 00 lxl6 pr6|390 002213 aa 7 77754 3715 16 epp5 pr7|-20,6 rs 002214 aa 7 77750 3535 16 epp3 pr7|-24,6 rs 002215 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002216 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002217 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 790 rs (current_parseme-4) = rs (current_parseme-3); 002220 aa 7 77760 3515 16 epp1 pr7|-16,6 rs 002221 aa 7 77754 3535 16 epp3 pr7|-20,6 rs 002222 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002223 aa 1 00000 00 0020 desc9a pr1|0,16 rs 002224 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 791 rs (current_parseme-4).type = op_type; 002225 aa 000003 2360 07 ldq 3,dl 002226 aa 7 77754 7561 16 stq pr7|-20,6 rs.type STATEMENT 1 ON LINE 792 end; STATEMENT 1 ON LINE 793 start = current_parseme - 1; 002227 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002230 aa 000001 1760 07 sbq 1,dl 002231 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 794 put_result = current_parseme - 3; 002232 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002233 aa 000003 1760 07 sbq 3,dl 002234 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 795 return_point = 4; 002235 aa 000004 2360 07 ldq 4,dl 002236 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 796 go to do_monadic; 002237 aa 004405 7100 04 tra 2309,ic 006644 STATEMENT 1 ON LINE 797 operator_return (4): print_final_value = "1"b; 002240 aa 400000 2350 03 lda 131072,du 002241 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 799 rs (current_parseme - 3).lexeme = rs (current_parseme - 2).lexeme; 002242 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002243 aa 000002 7360 00 qls 2 002244 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002245 aa 000000 6270 06 eax7 0,ql 002246 aa 7 77767 2361 06 ldq pr7|-9,ql rs.lexeme 002247 aa 7 77763 7561 17 stq pr7|-13,7 rs.lexeme STATEMENT 1 ON LINE 800 current_parseme = current_parseme - 3; 002250 aa 000003 3360 07 lcq 3,dl 002251 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 801 if rs (current_parseme - 1).type = op_type then go to val_op_val_re; 002252 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002253 aa 000002 7360 00 qls 2 002254 aa 6 00606 7561 00 stq pr6|390 002255 aa 7 77770 2361 06 ldq pr7|-8,ql rs.type 002256 aa 000003 1160 07 cmpq 3,dl 002257 aa 777643 6000 04 tze -93,ic 002122 STATEMENT 1 ON LINE 803 else if rs (current_parseme - 1).type = subscript_type then go to val_sub; 002260 aa 000013 1160 07 cmpq 11,dl 002261 aa 000146 6000 04 tze 102,ic 002427 STATEMENT 1 ON LINE 805 else go to val_re; 002262 aa 777051 7100 04 tra -471,ic 001333 STATEMENT 1 ON LINE 807 x_op_val_re (5): /* ) OP VAL RE */ go to re; 002263 aa 777004 7100 04 tra -508,ic 001267 STATEMENT 1 ON LINE 810 x_op_val_re (6): /* [ OP VAL RE */ start = current_parseme - 1; 002264 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002265 aa 000001 1760 07 sbq 1,dl 002266 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 812 put_result = current_parseme - 2; 002267 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002270 aa 000002 1760 07 sbq 2,dl 002271 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 813 return_point = 5; 002272 aa 000005 2360 07 ldq 5,dl 002273 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 814 go to do_monadic; 002274 aa 004350 7100 04 tra 2280,ic 006644 STATEMENT 1 ON LINE 815 operator_return (5): rs (current_parseme - 1) = rs (current_parseme); 002275 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002276 aa 000002 7360 00 qls 2 002277 aa 000000 6270 06 eax7 0,ql 002300 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002301 aa 7 77774 3715 17 epp5 pr7|-4,7 rs 002302 aa 7 77770 3535 17 epp3 pr7|-8,7 rs 002303 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002304 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002305 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 817 current_parseme = current_parseme - 1; 002306 aa 000001 3360 07 lcq 1,dl 002307 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 818 go to open_bracket_val_re; 002310 aa 777446 7100 04 tra -218,ic 001756 STATEMENT 1 ON LINE 820 x_op_val_re (7): /* ]SB OP VAL RE */ go to re; 002311 aa 776756 7100 04 tra -530,ic 001267 STATEMENT 1 ON LINE 823 x_op_val_re (8): /* ]RK OP VAL RE */ start = current_parseme - 1; 002312 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002313 aa 000001 1760 07 sbq 1,dl 002314 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 825 put_result = current_parseme - 2; 002315 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002316 aa 000002 1760 07 sbq 2,dl 002317 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 826 return_point = 6; 002320 aa 000006 2360 07 ldq 6,dl 002321 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 827 go to do_monadic; 002322 aa 004322 7100 04 tra 2258,ic 006644 STATEMENT 1 ON LINE 828 operator_return (6): rs (current_parseme - 1) = rs (current_parseme); 002323 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002324 aa 000002 7360 00 qls 2 002325 aa 000000 6270 06 eax7 0,ql 002326 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002327 aa 7 77774 3715 17 epp5 pr7|-4,7 rs 002330 aa 7 77770 3535 17 epp3 pr7|-8,7 rs 002331 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002332 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002333 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 830 current_parseme = current_parseme - 1; 002334 aa 000001 3360 07 lcq 1,dl 002335 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 831 go to re; 002336 aa 776731 7100 04 tra -551,ic 001267 STATEMENT 1 ON LINE 833 x_op_val_re (9): /* ; OP VAL RE */ start = current_parseme - 1; 002337 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002340 aa 000001 1760 07 sbq 1,dl 002341 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 835 put_result = current_parseme - 2; 002342 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002343 aa 000002 1760 07 sbq 2,dl 002344 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 836 return_point = 7; 002345 aa 000007 2360 07 ldq 7,dl 002346 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 837 go to do_monadic; 002347 aa 004275 7100 04 tra 2237,ic 006644 STATEMENT 1 ON LINE 838 operator_return (7): rs (current_parseme - 1) = rs (current_parseme); 002350 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002351 aa 000002 7360 00 qls 2 002352 aa 000000 6270 06 eax7 0,ql 002353 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002354 aa 7 77774 3715 17 epp5 pr7|-4,7 rs 002355 aa 7 77770 3535 17 epp3 pr7|-8,7 rs 002356 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002357 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002360 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 840 current_parseme = current_parseme - 1; 002361 aa 000001 3360 07 lcq 1,dl 002362 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 841 if was_branch_value then go to bol_val_re; 002363 aa 6 00115 2351 00 lda pr6|77 was_branch_value 002364 aa 777123 6010 04 tnz -429,ic 001507 STATEMENT 1 ON LINE 843 go to semi_colon_val_re; 002365 aa 777427 7100 04 tra -233,ic 002014 STATEMENT 1 ON LINE 845 x_op_val_re (10): /* <> OP VAL RE */ start = current_parseme - 1; 002366 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002367 aa 000001 1760 07 sbq 1,dl 002370 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 847 put_result = current_parseme - 2; 002371 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002372 aa 000002 1760 07 sbq 2,dl 002373 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 848 return_point = 12; 002374 aa 000014 2360 07 ldq 12,dl 002375 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 849 go to do_monadic; 002376 aa 004246 7100 04 tra 2214,ic 006644 STATEMENT 1 ON LINE 850 operator_return (12): rs (current_parseme - 1) = rs (current_parseme); 002377 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002400 aa 000002 7360 00 qls 2 002401 aa 000000 6270 06 eax7 0,ql 002402 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002403 aa 7 77774 3715 17 epp5 pr7|-4,7 rs 002404 aa 7 77770 3535 17 epp3 pr7|-8,7 rs 002405 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002406 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002407 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 852 current_parseme = current_parseme - 1; 002410 aa 000001 3360 07 lcq 1,dl 002411 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 853 if was_branch_value then go to bol_val_re; 002412 aa 6 00115 2351 00 lda pr6|77 was_branch_value 002413 aa 777074 6010 04 tnz -452,ic 001507 STATEMENT 1 ON LINE 855 go to diamond_val_re; 002414 aa 777440 7100 04 tra -224,ic 002054 STATEMENT 1 ON LINE 857 sub: return_point = 11; 002415 aa 000013 2360 07 ldq 11,dl 002416 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 859 go to pull; 002417 aa 001606 7100 04 tra 902,ic 004225 STATEMENT 1 ON LINE 860 operator_return (11): go to x_sub (rs (current_parseme).type); 002420 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002421 aa 000002 7360 00 qls 2 002422 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002423 aa 7 77774 7271 06 lxl7 pr7|-4,ql rs.type 002424 aa 6 00606 7561 00 stq pr6|390 002425 ta 000051 7100 17 tra 41,7 STATEMENT 1 ON LINE 863 x_sub (1): /* BOL SUB */ go to context_error_0; 002426 aa 000503 7100 04 tra 323,ic 003131 STATEMENT 1 ON LINE 866 x_sub (2): /* VAL SUB */ val_sub: if rs (current_parseme).semantics = null then call value_error_reporter (current_lexeme); 002427 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002430 aa 000002 7360 00 qls 2 002431 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002432 aa 7 77776 2361 06 ldq pr7|-2,ql rs.semantics 002433 aa 011435 1160 04 cmpq 4893,ic 014070 = 007777000001 002434 aa 000003 6010 04 tnz 3,ic 002437 002435 aa 011413 3520 04 epp2 4875,ic 014050 = 000002000000 002436 aa 007352 6700 04 tsp4 3818,ic 012010 STATEMENT 1 ON LINE 871 operators_argument.value (1) = rs (current_parseme).semantics; 002437 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002440 aa 000002 7360 00 qls 2 002441 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002442 aa 000000 6270 06 eax7 0,ql 002443 aa 7 77776 2361 06 ldq pr7|-2,ql rs.semantics 002444 aa 6 00176 7561 00 stq pr6|126 operators_argument.value STATEMENT 1 ON LINE 872 operators_argument.value (2) = rs (current_parseme - 1).semantics; 002445 aa 7 77772 2361 17 ldq pr7|-6,7 rs.semantics 002446 aa 6 00200 7561 00 stq pr6|128 operators_argument.value STATEMENT 1 ON LINE 873 operators_argument.on_stack (1) = rs (current_parseme).bits.semantics_on_stack; 002447 aa 7 77775 2351 17 lda pr7|-3,7 rs.semantics_on_stack 002450 aa 000011 7350 00 als 9 002451 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 002452 aa 6 00177 7551 00 sta pr6|127 operators_argument.on_stack STATEMENT 1 ON LINE 874 operators_argument.where_error = current_parseme - 1; 002453 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002454 aa 000001 1760 07 sbq 1,dl 002455 aa 6 00206 7561 00 stq pr6|134 operators_argument.where_error STATEMENT 1 ON LINE 875 operators_argument.error_code = 0; 002456 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 877 call apl_subscript_a_value_ (operators_argument); 002457 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 002460 aa 6 00544 2521 00 spri2 pr6|356 002461 aa 6 00542 6211 00 eax1 pr6|354 002462 aa 004000 4310 07 fld 2048,dl 002463 aa 6 00044 3701 20 epp4 pr6|36,* 002464 la 4 00060 3521 20 epp2 pr4|48,* apl_subscript_a_value_ 002465 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 879 if operators_argument.error_code ^= 0 then go to report_error_from_operator; 002466 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 002467 aa 001004 6010 04 tnz 516,ic 003473 STATEMENT 1 ON LINE 882 if ^operators_argument.on_stack (1) then call decrement_reference_count (rs (current_parseme).semantics); 002470 aa 6 00177 2351 00 lda pr6|127 operators_argument.on_stack 002471 aa 400000 3150 03 cana 131072,du 002472 aa 000012 6010 04 tnz 10,ic 002504 002473 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002474 aa 000002 7360 00 qls 2 002475 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002476 aa 7 77776 3521 06 epp2 pr7|-2,ql rs.semantics 002477 aa 6 00550 2521 00 spri2 pr6|360 002500 aa 6 00546 3521 00 epp2 pr6|358 002501 aa 004000 4310 07 fld 2048,dl 002502 aa 2 00000 7571 00 staq pr2|0 002503 aa 007072 6700 04 tsp4 3642,ic 011575 STATEMENT 1 ON LINE 884 rs (current_parseme - 1).semantics = operators_argument.result; 002504 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002505 aa 000002 7360 00 qls 2 002506 aa 000000 6270 06 eax7 0,ql 002507 aa 6 00204 2361 00 ldq pr6|132 operators_argument.result 002510 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002511 aa 7 77772 7561 17 stq pr7|-6,7 rs.semantics STATEMENT 1 ON LINE 885 unspec (rs (current_parseme - 1).bits) = computed_value_bits; 002512 aa 004400 2350 03 lda 2304,du 002513 aa 7 77771 7551 17 sta pr7|-7,7 STATEMENT 1 ON LINE 886 rs (current_parseme - 1).type = val_type; 002514 aa 000002 2360 07 ldq 2,dl 002515 aa 7 77770 7561 17 stq pr7|-8,7 rs.type STATEMENT 1 ON LINE 887 rs (current_parseme - 1).lexeme = rs (current_parseme).lexeme; 002516 aa 7 77777 2361 17 ldq pr7|-1,7 rs.lexeme 002517 aa 7 77773 7561 17 stq pr7|-5,7 rs.lexeme STATEMENT 1 ON LINE 888 print_final_value = "1"b; 002520 aa 400000 2350 03 lda 131072,du 002521 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 889 current_parseme = current_parseme - 1; 002522 aa 000001 3360 07 lcq 1,dl 002523 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 890 if rs (current_parseme - 1).type = op_type then go to val_op_val_re; 002524 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002525 aa 000002 7360 00 qls 2 002526 aa 6 00607 7561 00 stq pr6|391 002527 aa 7 77770 2361 06 ldq pr7|-8,ql rs.type 002530 aa 000003 1160 07 cmpq 3,dl 002531 aa 777371 6000 04 tze -263,ic 002122 STATEMENT 1 ON LINE 892 else if rs (current_parseme - 1).type = subscript_type then go to val_sub; 002532 aa 000013 1160 07 cmpq 11,dl 002533 aa 777674 6000 04 tze -68,ic 002427 STATEMENT 1 ON LINE 894 else go to val_re; 002534 aa 776577 7100 04 tra -641,ic 001333 STATEMENT 1 ON LINE 896 x_sub (3): /* OP SUB */ if ^rs (current_parseme - 1).semantics_valid then go to value_error_1; 002535 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002536 aa 000001 1760 07 sbq 1,dl 002537 aa 000002 7360 00 qls 2 002540 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 002541 aa 004000 3150 03 cana 2048,du 002542 aa 000373 6000 04 tze 251,ic 003135 STATEMENT 1 ON LINE 899 if rs (current_parseme).op1 = subscripted_assignment_code then do; 002543 aa 6 00606 7261 00 lxl6 pr6|390 002544 aa 7 77775 2351 16 lda pr7|-3,6 rs.op1 002545 aa 000033 7350 00 als 27 002546 aa 000077 7330 00 lrs 63 002547 aa 6 00607 7561 00 stq pr6|391 rs.op1 002550 aa 000147 1160 07 cmpq 103,dl 002551 aa 000021 6010 04 tnz 17,ic 002572 STATEMENT 1 ON LINE 901 rs (current_parseme).semantics = rs (current_parseme - 1).semantics; 002552 aa 7 77772 2361 16 ldq pr7|-6,6 rs.semantics 002553 aa 7 77776 7561 16 stq pr7|-2,6 rs.semantics STATEMENT 1 ON LINE 902 rs (current_parseme).semantics_valid = "1"b; 002554 aa 004000 2350 03 lda 2048,du 002555 aa 7 77775 2551 16 orsa pr7|-3,6 rs.semantics_valid STATEMENT 1 ON LINE 903 rs (current_parseme).semantics_on_stack = "1"b; 002556 aa 000400 2350 03 lda 256,du 002557 aa 7 77775 2551 16 orsa pr7|-3,6 rs.semantics_on_stack STATEMENT 1 ON LINE 904 rs (current_parseme).has_list = "1"b; 002560 aa 002000 2350 03 lda 1024,du 002561 aa 7 77775 2551 16 orsa pr7|-3,6 rs.has_list STATEMENT 1 ON LINE 905 rs (current_parseme - 1) = rs (current_parseme); 002562 aa 7 77774 3715 16 epp5 pr7|-4,6 rs 002563 aa 7 77770 3535 16 epp3 pr7|-8,6 rs 002564 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002565 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002566 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 906 current_parseme = current_parseme - 1; 002567 aa 000001 3360 07 lcq 1,dl 002570 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 907 go to op_val_re; 002571 aa 777043 7100 04 tra -477,ic 001634 STATEMENT 1 ON LINE 908 end; STATEMENT 1 ON LINE 909 temp_ptr = rs (current_parseme - 1).semantics; 002572 aa 7 77772 7651 16 lprp5 pr7|-6,6 rs.semantics 002573 aa 6 00150 6515 00 spri5 pr6|104 temp_ptr STATEMENT 1 ON LINE 910 if temp_ptr -> list_bead.number_of_members ^= 1 then go to rank_error_1; 002574 aa 5 00002 2361 00 ldq pr5|2 list_bead.number_of_members 002575 aa 000001 1160 07 cmpq 1,dl 002576 aa 000453 6010 04 tnz 299,ic 003251 STATEMENT 1 ON LINE 912 temp_ptr = temp_ptr -> list_bead.member_ptr (1); 002577 aa 5 00003 7631 00 lprp3 pr5|3 list_bead.member_ptr 002600 aa 6 00150 2535 00 spri3 pr6|104 temp_ptr STATEMENT 1 ON LINE 913 if temp_ptr = null then go to value_error_1; 002601 aa 6 00150 2371 00 ldaq pr6|104 temp_ptr 002602 aa 776064 6770 04 eraq -972,ic 000666 = 077777000043 000001000000 002603 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 002604 aa 000331 6000 04 tze 217,ic 003135 STATEMENT 1 ON LINE 915 if temp_ptr -> value_bead.total_data_elements ^= 1 then go to rank_error_1; 002605 aa 3 00002 2361 00 ldq pr3|2 value_bead.total_data_elements 002606 aa 000001 1160 07 cmpq 1,dl 002607 aa 000442 6010 04 tnz 290,ic 003251 STATEMENT 1 ON LINE 917 if ^temp_ptr -> value_bead.numeric_value then go to domain_error_1; 002610 aa 3 00000 2351 00 lda pr3|0 value_bead.numeric_value 002611 aa 000200 3150 03 cana 128,du 002612 aa 000343 6000 04 tze 227,ic 003155 STATEMENT 1 ON LINE 919 x = temp_ptr -> value_bead.data_pointer -> numeric_datum (0); 002613 aa 3 00004 7651 00 lprp5 pr3|4 value_bead.data_pointer 002614 aa 5 00000 4331 00 dfld pr5|0 numeric_datum 002615 aa 6 00116 4571 00 dfst pr6|78 x STATEMENT 1 ON LINE 923 xx = floor (x + 0.5); 002616 aa 000400 4750 03 fad 256,du 002617 aa 0 01123 7001 00 tsx0 pr0|595 floor_fl 002620 aa 6 00120 4571 00 dfst pr6|80 xx STATEMENT 1 ON LINE 924 if abs (xx - x) >= integer_fuzz then do; 002621 aa 6 00116 5771 00 dfsb pr6|78 x 002622 aa 000002 6050 04 tpl 2,ic 002624 002623 aa 000000 5130 00 fneg 0 002624 aa 6 00174 3515 20 epp1 pr6|124,* ws_info_ptr 002625 aa 1 00022 5171 00 dfcmp pr1|18 ws_info.integer_fuzz 002626 aa 000012 6040 04 tmi 10,ic 002640 STATEMENT 1 ON LINE 926 if rs (current_parseme).op1 ^= ravel_code then go to rank_error_1; 002627 aa 6 00607 2361 00 ldq pr6|391 rs.op1 002630 aa 000045 1160 07 cmpq 37,dl 002631 aa 000420 6010 04 tnz 272,ic 003251 STATEMENT 1 ON LINE 929 rs (current_parseme).op1 = laminate_code; 002632 aa 000135 2350 07 lda 93,dl 002633 aa 7 77775 3715 16 epp5 pr7|-3,6 rs.op1 002634 aa 5 00000 5511 04 stba pr5|0,04 rs.op1 STATEMENT 1 ON LINE 930 xx = floor (x); 002635 aa 6 00116 4331 00 dfld pr6|78 x 002636 aa 0 01123 7001 00 tsx0 pr0|595 floor_fl 002637 aa 6 00120 4571 00 dfst pr6|80 xx STATEMENT 1 ON LINE 931 end; STATEMENT 1 ON LINE 933 if abs (xx) > 100000 then go to rank_error_1; 002640 aa 6 00120 4331 00 dfld pr6|80 xx 002641 aa 000002 6050 04 tpl 2,ic 002643 002642 aa 000000 5130 00 fneg 0 002643 aa 6 00560 4571 00 dfst pr6|368 002644 aa 776000 4310 04 fld -1024,ic 000644 = 042606500000 002645 aa 6 00560 5171 00 dfcmp pr6|368 002646 aa 000403 6040 04 tmi 259,ic 003251 STATEMENT 1 ON LINE 935 i = fixed (xx, 17) + 1 - index_origin; 002647 aa 6 00120 4331 00 dfld pr6|80 xx 002650 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 002651 aa 000001 0760 07 adq 1,dl 002652 aa 1 00004 1761 00 sbq pr1|4 ws_info.index_origin 002653 aa 6 00165 7561 00 stq pr6|117 i STATEMENT 1 ON LINE 936 if i <= 0 then if rs (current_parseme).op1 ^= laminate_code /* if not laminate, which is special, */ then go to rank_error_1; 002654 aa 000010 6054 04 tpnz 8,ic 002664 002655 aa 7 77775 2351 16 lda pr7|-3,6 rs.op1 002656 aa 000033 7350 00 als 27 002657 aa 000077 7330 00 lrs 63 002660 aa 000135 1160 07 cmpq 93,dl 002661 aa 000370 6010 04 tnz 248,ic 003251 STATEMENT 1 ON LINE 939 else if i ^= 0 then go to rank_error_1; 002662 aa 6 00165 2361 00 ldq pr6|117 i 002663 aa 000366 6010 04 tnz 246,ic 003251 STATEMENT 1 ON LINE 942 rs_for_op (current_parseme).semantics = i; 002664 aa 7 77776 7561 16 stq pr7|-2,6 rs_for_op.semantics STATEMENT 1 ON LINE 943 rs (current_parseme).semantics_valid = "1"b; 002665 aa 004000 2350 03 lda 2048,du 002666 aa 7 77775 2551 16 orsa pr7|-3,6 rs.semantics_valid STATEMENT 1 ON LINE 944 if ^rs (current_parseme - 1).semantics -> list_bead.semantics_on_stack (1) then call decrement_reference_count (rs (current_parseme - 1).semantics -> list_bead.member_ptr (1)); 002667 aa 7 77772 7651 16 lprp5 pr7|-6,6 rs.semantics 002670 aa 5 00004 2351 00 lda pr5|4 list_bead.semantics_on_stack 002671 aa 000400 3150 03 cana 256,du 002672 aa 000007 6010 04 tnz 7,ic 002701 002673 aa 5 00003 3521 00 epp2 pr5|3 list_bead.member_ptr 002674 aa 6 00550 2521 00 spri2 pr6|360 002675 aa 6 00546 3521 00 epp2 pr6|358 002676 aa 004000 4310 07 fld 2048,dl 002677 aa 2 00000 7571 00 staq pr2|0 002700 aa 006675 6700 04 tsp4 3517,ic 011575 STATEMENT 1 ON LINE 946 rs (current_parseme - 1) = rs (current_parseme); 002701 aa 6 00132 2361 00 ldq pr6|90 current_parseme 002702 aa 000002 7360 00 qls 2 002703 aa 000000 6270 06 eax7 0,ql 002704 aa 6 00126 3735 20 epp7 pr6|86,* rsp 002705 aa 7 77774 3715 17 epp5 pr7|-4,7 rs 002706 aa 7 77770 3535 17 epp3 pr7|-8,7 rs 002707 aa 000 100 100 500 mlr (pr),(pr),fill(000) 002710 aa 5 00000 00 0020 desc9a pr5|0,16 rs 002711 aa 3 00000 00 0020 desc9a pr3|0,16 rs STATEMENT 1 ON LINE 947 current_parseme = current_parseme - 1; 002712 aa 000001 3360 07 lcq 1,dl 002713 aa 6 00132 0561 00 asq pr6|90 current_parseme STATEMENT 1 ON LINE 948 go to op_val_re; 002714 aa 776720 7100 04 tra -560,ic 001634 STATEMENT 1 ON LINE 950 x_sub (4): /* ( SUB */ go to context_error_0; 002715 aa 000214 7100 04 tra 140,ic 003131 STATEMENT 1 ON LINE 953 x_sub (5): /* ) SUB */ go to re; 002716 aa 776351 7100 04 tra -791,ic 001267 STATEMENT 1 ON LINE 956 x_sub (6): /* [ SUB */ go to context_error_0; 002717 aa 000212 7100 04 tra 138,ic 003131 STATEMENT 1 ON LINE 959 x_sub (7): /* ]SB SUB */ go to re; 002720 aa 776347 7100 04 tra -793,ic 001267 STATEMENT 1 ON LINE 962 x_sub (8): /* ]RK SUB */ go to context_error_0; 002721 aa 000210 7100 04 tra 136,ic 003131 STATEMENT 1 ON LINE 965 x_sub (9): /* ; SUB */ go to context_error_0; 002722 aa 000207 7100 04 tra 135,ic 003131 STATEMENT 1 ON LINE 968 x_sub (10): /* <> SUB */ go to context_error_0; 002723 aa 000206 7100 04 tra 134,ic 003131 STATEMENT 1 ON LINE 971 done_line: if parse_frame.parse_frame_type = function_frame_type then if parse_frame.function_bead_ptr -> function_bead.trace_control_pointer ^= null then call check_trace_vector; 002724 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 002725 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 002726 aa 000002 1160 07 cmpq 2,dl 002727 aa 000006 6010 04 tnz 6,ic 002735 002730 aa 7 00002 7651 00 lprp5 pr7|2 parse_frame.function_bead_ptr 002731 aa 5 00005 2361 00 ldq pr5|5 function_bead.trace_control_pointer 002732 aa 011136 1160 04 cmpq 4702,ic 014070 = 007777000001 002733 aa 000002 6000 04 tze 2,ic 002735 002734 aa 007365 6700 04 tsp4 3829,ic 012321 STATEMENT 1 ON LINE 976 print_final_value = print_final_value | trace_branch_line; 002735 aa 6 00113 2351 00 lda pr6|75 trace_branch_line 002736 aa 6 00161 2551 00 orsa pr6|113 print_final_value STATEMENT 1 ON LINE 978 if ^was_branch_value | trace_branch_line /* branch aborts mixed output, unless traced */ then call print_value; 002737 aa 6 00115 2351 00 lda pr6|77 was_branch_value 002740 aa 000003 6000 04 tze 3,ic 002743 002741 aa 6 00113 2351 00 lda pr6|75 trace_branch_line 002742 aa 000002 6000 04 tze 2,ic 002744 002743 aa 005661 6700 04 tsp4 2993,ic 010624 STATEMENT 1 ON LINE 981 call clean_up_rs; 002744 aa 006664 6700 04 tsp4 3508,ic 011630 STATEMENT 1 ON LINE 983 if parse_frame.parse_frame_type = suspended_frame_type then do; 002745 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 002746 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 002747 aa 000001 1160 07 cmpq 1,dl 002750 aa 000026 6010 04 tnz 22,ic 002776 STATEMENT 1 ON LINE 985 if ^was_branch then go to next_line; 002751 aa 6 00114 2351 00 lda pr6|76 was_branch 002752 aa 776162 6000 04 tze -910,ic 001134 STATEMENT 1 ON LINE 988 if last_parse_frame_ptr = null then go to next_line; 002753 aa 7 00000 2361 00 ldq pr7|0 parse_frame.last_parse_frame_ptr 002754 aa 011114 1160 04 cmpq 4684,ic 014070 = 007777000001 002755 aa 776157 6000 04 tze -913,ic 001134 STATEMENT 1 ON LINE 991 if was_branch_value then last_parse_frame_ptr -> parse_frame.current_line_number = parse_frame.current_line_number; 002756 aa 6 00115 2351 00 lda pr6|77 was_branch_value 002757 aa 000004 6000 04 tze 4,ic 002763 002760 aa 7 00000 7651 00 lprp5 pr7|0 parse_frame.last_parse_frame_ptr 002761 aa 7 00007 2361 00 ldq pr7|7 parse_frame.current_line_number 002762 aa 5 00007 7561 00 stq pr5|7 parse_frame.current_line_number STATEMENT 1 ON LINE 994 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 002763 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 002764 aa 6 00550 2521 00 spri2 pr6|360 002765 aa 6 00546 3521 00 epp2 pr6|358 002766 aa 004000 4310 07 fld 2048,dl 002767 aa 2 00000 7571 00 staq pr2|0 002770 aa 006605 6700 04 tsp4 3461,ic 011575 STATEMENT 1 ON LINE 995 ok_to_stop_control = "0"b; 002771 aa 6 00164 4501 00 stz pr6|116 ok_to_stop_control STATEMENT 1 ON LINE 996 parse_frame_ptr = last_parse_frame_ptr; 002772 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 002773 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 997 call restore_state; 002774 aa 006733 6700 04 tsp4 3547,ic 011727 STATEMENT 1 ON LINE 998 go to increment_function_line_number; 002775 aa 000003 7100 04 tra 3,ic 003000 STATEMENT 1 ON LINE 999 end; STATEMENT 1 ON LINE 1001 if parse_frame_type = function_frame_type then do; 002776 aa 000002 1160 07 cmpq 2,dl 002777 aa 000470 6010 04 tnz 312,ic 003467 STATEMENT 1 ON LINE 1003 increment_function_line_number: parse_frame.current_line_number = parse_frame.current_line_number + 1; 003000 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 003001 aa 7 00007 0541 00 aos pr7|7 parse_frame.current_line_number STATEMENT 1 ON LINE 1005 if parse_frame.current_line_number < 1 | parse_frame.current_line_number > lexed_function_bead_ptr -> number_of_statements then go to function_return; 003002 aa 7 00007 2361 00 ldq pr7|7 parse_frame.current_line_number 003003 aa 000001 1160 07 cmpq 1,dl 003004 aa 000006 6040 04 tmi 6,ic 003012 003005 aa 6 00134 3715 20 epp5 pr6|92,* lexed_function_bead_ptr 003006 aa 5 00004 1161 00 cmpq pr5|4 lexed_function_bead.number_of_statements 003007 aa 000003 6054 04 tpnz 3,ic 003012 STATEMENT 1 ON LINE 1008 go to start_line; 003010 aa 776146 7100 04 tra -922,ic 001156 STATEMENT 1 ON LINE 1009 end; STATEMENT 1 ON LINE 1011 go to done_line_system_error; 003011 aa 000456 7100 04 tra 302,ic 003467 STATEMENT 1 ON LINE 1013 function_return: ptr_to_returned_value = lexed_function_bead_ptr -> localized_symbols (ReturnSymbol); 003012 aa 000001 7270 07 lxl7 1,dl 003013 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 003014 aa 7 00011 7671 17 lprp7 pr7|9,7 lexed_function_bead.localized_symbols 003015 aa 6 00170 6535 00 spri7 pr6|120 ptr_to_returned_value STATEMENT 1 ON LINE 1015 if ptr_to_returned_value ^= null then do; 003016 aa 6 00170 2371 00 ldaq pr6|120 ptr_to_returned_value 003017 aa 775647 6770 04 eraq -1113,ic 000666 = 077777000043 000001000000 003020 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 003021 aa 000010 6000 04 tze 8,ic 003031 STATEMENT 1 ON LINE 1017 ptr_to_returned_value = ptr_to_returned_value -> meaning_pointer; 003022 aa 7 00003 7651 00 lprp5 pr7|3 symbol_bead.meaning_pointer 003023 aa 6 00170 6515 00 spri5 pr6|120 ptr_to_returned_value STATEMENT 1 ON LINE 1018 if ptr_to_returned_value ^= null then ptr_to_returned_value -> general_bead.reference_count = ptr_to_returned_value -> general_bead.reference_count + 1; 003024 aa 6 00170 2371 00 ldaq pr6|120 ptr_to_returned_value 003025 aa 775641 6770 04 eraq -1119,ic 000666 = 077777000043 000001000000 003026 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 003027 aa 000002 6000 04 tze 2,ic 003031 003030 aa 5 00001 0541 00 aos pr5|1 general_bead.reference_count STATEMENT 1 ON LINE 1021 end; STATEMENT 1 ON LINE 1023 call restore_old_meanings; 003031 aa 007210 6700 04 tsp4 3720,ic 012241 STATEMENT 1 ON LINE 1024 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 003032 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 003033 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 003034 aa 6 00550 2521 00 spri2 pr6|360 003035 aa 6 00546 3521 00 epp2 pr6|358 003036 aa 004000 4310 07 fld 2048,dl 003037 aa 2 00000 7571 00 staq pr2|0 003040 aa 006535 6700 04 tsp4 3421,ic 011575 STATEMENT 1 ON LINE 1025 call decrement_reference_count (parse_frame.function_bead_ptr); 003041 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 003042 aa 7 00002 3521 00 epp2 pr7|2 parse_frame.function_bead_ptr 003043 aa 6 00550 2521 00 spri2 pr6|360 003044 aa 6 00546 3521 00 epp2 pr6|358 003045 aa 004000 4310 07 fld 2048,dl 003046 aa 2 00000 7571 00 staq pr2|0 003047 aa 006526 6700 04 tsp4 3414,ic 011575 STATEMENT 1 ON LINE 1026 parse_frame_ptr = last_parse_frame_ptr; 003050 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 003051 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 1027 call restore_state; 003052 aa 006655 6700 04 tsp4 3501,ic 011727 STATEMENT 1 ON LINE 1029 if number_of_arguments = 2 then do; 003053 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 003054 aa 000002 1160 07 cmpq 2,dl 003055 aa 000024 6010 04 tnz 20,ic 003101 STATEMENT 1 ON LINE 1034 call decrement_reference_count (rs (start).semantics); 003056 aa 6 00155 2361 00 ldq pr6|109 start 003057 aa 000002 7360 00 qls 2 003060 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003061 aa 7 77776 3521 06 epp2 pr7|-2,ql rs.semantics 003062 aa 6 00550 2521 00 spri2 pr6|360 003063 aa 6 00546 3521 00 epp2 pr6|358 003064 aa 004000 4310 07 fld 2048,dl 003065 aa 2 00000 7571 00 staq pr2|0 003066 aa 006507 6700 04 tsp4 3399,ic 011575 STATEMENT 1 ON LINE 1035 call decrement_reference_count (rs (start - 2).semantics); 003067 aa 6 00155 2361 00 ldq pr6|109 start 003070 aa 000002 7360 00 qls 2 003071 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003072 aa 7 77766 3521 06 epp2 pr7|-10,ql rs.semantics 003073 aa 6 00550 2521 00 spri2 pr6|360 003074 aa 6 00546 3521 00 epp2 pr6|358 003075 aa 004000 4310 07 fld 2048,dl 003076 aa 2 00000 7571 00 staq pr2|0 003077 aa 006476 6700 04 tsp4 3390,ic 011575 STATEMENT 1 ON LINE 1036 end; 003100 aa 000014 7100 04 tra 12,ic 003114 STATEMENT 1 ON LINE 1037 else if number_of_arguments = 1 then call decrement_reference_count (rs (start - 1).semantics); 003101 aa 000001 1160 07 cmpq 1,dl 003102 aa 000012 6010 04 tnz 10,ic 003114 003103 aa 6 00155 2361 00 ldq pr6|109 start 003104 aa 000002 7360 00 qls 2 003105 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003106 aa 7 77772 3521 06 epp2 pr7|-6,ql rs.semantics 003107 aa 6 00550 2521 00 spri2 pr6|360 003110 aa 6 00546 3521 00 epp2 pr6|358 003111 aa 004000 4310 07 fld 2048,dl 003112 aa 2 00000 7571 00 staq pr2|0 003113 aa 006462 6700 04 tsp4 3378,ic 011575 STATEMENT 1 ON LINE 1043 rs (put_result).semantics = ptr_to_returned_value; 003114 aa 6 00156 2361 00 ldq pr6|110 put_result 003115 aa 000002 7360 00 qls 2 003116 aa 6 00170 3735 20 epp7 pr6|120,* ptr_to_returned_value 003117 aa 6 00126 3715 20 epp5 pr6|86,* rsp 003120 aa 5 77776 5471 06 sprp7 pr5|-2,ql rs.semantics STATEMENT 1 ON LINE 1044 rs (put_result).type = val_type; 003121 aa 000000 6270 06 eax7 0,ql 003122 aa 000002 2360 07 ldq 2,dl 003123 aa 5 77774 7561 17 stq pr5|-4,7 rs.type STATEMENT 1 ON LINE 1045 unspec (rs (put_result).bits) = value_bits; 003124 aa 004000 2350 03 lda 2048,du 003125 aa 5 77775 7551 17 sta pr5|-3,7 STATEMENT 1 ON LINE 1046 go to operator_return (return_point); 003126 aa 6 00157 7261 00 lxl6 pr6|111 return_point 003127 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1048 return_statement: return; 003130 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 1051 context_error_0: operators_argument.error_code = apl_error_table_$context; 003131 aa 6 00044 3701 20 epp4 pr6|36,* 003132 la 4 00170 2361 20 ldq pr4|120,* apl_error_table_$context 003133 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1053 go to report_error; 003134 aa 000344 7100 04 tra 228,ic 003500 STATEMENT 1 ON LINE 1055 value_error_1: operators_argument.error_code = apl_error_table_$value; 003135 aa 6 00044 3701 20 epp4 pr6|36,* 003136 la 4 00200 2361 20 ldq pr4|128,* apl_error_table_$value 003137 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1057 current_lexeme = rs (current_parseme - 1).lexeme; 003140 aa 6 00606 7261 00 lxl6 pr6|390 003141 aa 7 77773 2361 16 ldq pr7|-5,6 rs.lexeme 003142 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1058 go to report_error; 003143 aa 000335 7100 04 tra 221,ic 003500 STATEMENT 1 ON LINE 1060 domain_error: operators_argument.error_code = apl_error_table_$domain; 003144 aa 6 00044 3701 20 epp4 pr6|36,* 003145 la 4 00176 2361 20 ldq pr4|126,* apl_error_table_$domain 003146 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1062 current_lexeme = rs (operators_argument.where_error).lexeme; 003147 aa 6 00206 2361 00 ldq pr6|134 operators_argument.where_error 003150 aa 000002 7360 00 qls 2 003151 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003152 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003153 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1063 go to report_error; 003154 aa 000324 7100 04 tra 212,ic 003500 STATEMENT 1 ON LINE 1065 domain_error_1: operators_argument.error_code = apl_error_table_$domain; 003155 aa 6 00044 3701 20 epp4 pr6|36,* 003156 la 4 00176 2361 20 ldq pr4|126,* apl_error_table_$domain 003157 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1067 current_lexeme = rs (current_parseme - 1).lexeme; 003160 aa 7 77773 2361 16 ldq pr7|-5,6 rs.lexeme 003161 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1068 go to report_error; 003162 aa 000316 7100 04 tra 206,ic 003500 STATEMENT 1 ON LINE 1070 value_error_s2: operators_argument.error_code = apl_error_table_$value; 003163 aa 6 00044 3701 20 epp4 pr6|36,* 003164 la 4 00200 2361 20 ldq pr4|128,* apl_error_table_$value 003165 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1072 current_lexeme = rs (start - 2).lexeme; 003166 aa 6 00155 2361 00 ldq pr6|109 start 003167 aa 000002 7360 00 qls 2 003170 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003171 aa 7 77767 2361 06 ldq pr7|-9,ql rs.lexeme 003172 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1073 go to report_error; 003173 aa 000305 7100 04 tra 197,ic 003500 STATEMENT 1 ON LINE 1075 value_error_s0: operators_argument.error_code = apl_error_table_$value; 003174 aa 6 00044 3701 20 epp4 pr6|36,* 003175 la 4 00200 2361 20 ldq pr4|128,* apl_error_table_$value 003176 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1077 current_lexeme = rs (start).lexeme; 003177 aa 6 00155 2361 00 ldq pr6|109 start 003200 aa 000002 7360 00 qls 2 003201 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003202 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003203 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1078 go to report_error; 003204 aa 000274 7100 04 tra 188,ic 003500 STATEMENT 1 ON LINE 1080 value_error_s1: operators_argument.error_code = apl_error_table_$value; 003205 aa 6 00044 3701 20 epp4 pr6|36,* 003206 la 4 00200 2361 20 ldq pr4|128,* apl_error_table_$value 003207 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1082 current_lexeme = rs (start - 1).lexeme; 003210 aa 6 00155 2361 00 ldq pr6|109 start 003211 aa 000002 7360 00 qls 2 003212 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003213 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 003214 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1083 go to report_error; 003215 aa 000263 7100 04 tra 179,ic 003500 STATEMENT 1 ON LINE 1085 improper_dyadic_usage: operators_argument.error_code = apl_error_table_$improper_dyadic_usage; 003216 aa 6 00044 3701 20 epp4 pr6|36,* 003217 la 4 00174 2361 20 ldq pr4|124,* apl_error_table_$improper_dyadic_usage 003220 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1087 current_lexeme = rs (start - 1).lexeme; 003221 aa 6 00155 2361 00 ldq pr6|109 start 003222 aa 000002 7360 00 qls 2 003223 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003224 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 003225 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1088 go to report_error; 003226 aa 000252 7100 04 tra 170,ic 003500 STATEMENT 1 ON LINE 1090 improper_monadic_usage: operators_argument.error_code = apl_error_table_$improper_monadic_usage; 003227 aa 6 00044 3701 20 epp4 pr6|36,* 003230 la 4 00172 2361 20 ldq pr4|122,* apl_error_table_$improper_monadic_usage 003231 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1092 current_lexeme = rs (start).lexeme; 003232 aa 6 00155 2361 00 ldq pr6|109 start 003233 aa 000002 7360 00 qls 2 003234 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003235 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003236 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1093 go to report_error; 003237 aa 000241 7100 04 tra 161,ic 003500 STATEMENT 1 ON LINE 1095 improper_niladic_usage: operators_argument.error_code = apl_error_table_$improper_niladic_usage; 003240 aa 6 00044 3701 20 epp4 pr6|36,* 003241 la 4 00124 2361 20 ldq pr4|84,* apl_error_table_$improper_niladic_usage 003242 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1097 current_lexeme = rs (start + 1).lexeme; 003243 aa 6 00155 2361 00 ldq pr6|109 start 003244 aa 000002 7360 00 qls 2 003245 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003246 aa 7 00003 2361 06 ldq pr7|3,ql rs.lexeme 003247 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1098 go to report_error; 003250 aa 000230 7100 04 tra 152,ic 003500 STATEMENT 1 ON LINE 1100 rank_error_1: operators_argument.error_code = apl_error_table_$operator_subscript_range; 003251 aa 6 00044 3701 20 epp4 pr6|36,* 003252 la 4 00166 2361 20 ldq pr4|118,* apl_error_table_$operator_subscript_range 003253 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1102 current_lexeme = rs (current_parseme - 1).lexeme; 003254 aa 7 77773 2361 16 ldq pr7|-5,6 rs.lexeme 003255 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1103 go to report_error; 003256 aa 000222 7100 04 tra 146,ic 003500 STATEMENT 1 ON LINE 1105 bad_assignment: operators_argument.error_code = apl_error_table_$bad_assignment; 003257 aa 6 00044 3701 20 epp4 pr6|36,* 003260 la 4 00162 2361 20 ldq pr4|114,* apl_error_table_$bad_assignment 003261 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1107 current_lexeme = rs (operators_argument.where_error).lexeme; 003262 aa 6 00206 2361 00 ldq pr6|134 operators_argument.where_error 003263 aa 000002 7360 00 qls 2 003264 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003265 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003266 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1108 go to report_error; 003267 aa 000211 7100 04 tra 137,ic 003500 STATEMENT 1 ON LINE 1110 bad_assign_to_label: operators_argument.error_code = apl_error_table_$assign_to_label; 003270 aa 6 00044 3701 20 epp4 pr6|36,* 003271 la 4 00160 2361 20 ldq pr4|112,* apl_error_table_$assign_to_label 003272 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1112 current_lexeme = rs (operators_argument.where_error).lexeme; 003273 aa 6 00206 2361 00 ldq pr6|134 operators_argument.where_error 003274 aa 000002 7360 00 qls 2 003275 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003276 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003277 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1113 go to report_error; 003300 aa 000200 7100 04 tra 128,ic 003500 STATEMENT 1 ON LINE 1115 bad_evaluated_input: operators_argument.error_code = apl_error_table_$bad_evaluated_input; 003301 aa 6 00044 3701 20 epp4 pr6|36,* 003302 la 4 00156 2361 20 ldq pr4|110,* apl_error_table_$bad_evaluated_input 003303 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1117 current_lexeme = current_lexeme + 1; 003304 aa 6 00133 0541 00 aos pr6|91 current_lexeme STATEMENT 1 ON LINE 1118 go to report_error; 003305 aa 000173 7100 04 tra 123,ic 003500 STATEMENT 1 ON LINE 1120 bad_execute: operators_argument.error_code = apl_error_table_$bad_execute; 003306 aa 6 00044 3701 20 epp4 pr6|36,* 003307 la 4 00154 2361 20 ldq pr4|108,* apl_error_table_$bad_execute 003310 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1122 call clean_up_rs; 003311 aa 006317 6700 04 tsp4 3279,ic 011630 STATEMENT 1 ON LINE 1123 parse_frame_ptr = last_parse_frame_ptr; 003312 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 003313 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 1124 call restore_state; 003314 aa 006413 6700 04 tsp4 3339,ic 011727 STATEMENT 1 ON LINE 1125 current_lexeme = 2; 003315 aa 000002 2360 07 ldq 2,dl 003316 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1126 go to report_error; 003317 aa 000161 7100 04 tra 113,ic 003500 STATEMENT 1 ON LINE 1128 domain_error_s1: operators_argument.error_code = apl_error_table_$domain; 003320 aa 6 00044 3701 20 epp4 pr6|36,* 003321 la 4 00176 2361 20 ldq pr4|126,* apl_error_table_$domain 003322 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1130 current_lexeme = rs (start - 1).lexeme; 003323 aa 6 00155 2361 00 ldq pr6|109 start 003324 aa 000002 7360 00 qls 2 003325 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003326 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 003327 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1131 go to report_error; 003330 aa 000150 7100 04 tra 104,ic 003500 STATEMENT 1 ON LINE 1133 rank_error_s1: operators_argument.error_code = apl_error_table_$rank; 003331 aa 6 00044 3701 20 epp4 pr6|36,* 003332 la 4 00164 2361 20 ldq pr4|116,* apl_error_table_$rank 003333 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1135 current_lexeme = rs (start - 1).lexeme; 003334 aa 6 00155 2361 00 ldq pr6|109 start 003335 aa 000002 7360 00 qls 2 003336 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003337 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 003340 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1136 go to report_error; 003341 aa 000137 7100 04 tra 95,ic 003500 STATEMENT 1 ON LINE 1138 execute_error_s0: parse_frame_ptr = last_parse_frame_ptr; 003342 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 003343 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 1140 call restore_state; 003344 aa 006363 6700 04 tsp4 3315,ic 011727 STATEMENT 1 ON LINE 1141 operators_argument.error_code = apl_error_table_$execute; 003345 aa 6 00044 3701 20 epp4 pr6|36,* 003346 la 4 00152 2361 20 ldq pr4|106,* apl_error_table_$execute 003347 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1142 current_lexeme = rs (current_parseme - 1).lexeme; 003350 aa 6 00132 2361 00 ldq pr6|90 current_parseme 003351 aa 000002 7360 00 qls 2 003352 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003353 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 003354 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1143 go to report_error; 003355 aa 000123 7100 04 tra 83,ic 003500 STATEMENT 1 ON LINE 1145 depth_error: operators_argument.error_code = apl_error_table_$depth; 003356 aa 6 00044 3701 20 epp4 pr6|36,* 003357 la 4 00142 2361 20 ldq pr4|98,* apl_error_table_$depth 003360 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1149 join_depth_handler: call apl_error_ (operators_argument.error_code, ""b, 0, "", null, 0); 003361 aa 000000 2350 07 lda 0,dl 003362 aa 6 00606 7551 00 sta pr6|390 003363 aa 6 00607 4501 00 stz pr6|391 003364 aa 010504 7670 04 lprp7 4420,ic 014070 = 007777000001 003365 aa 6 00611 5471 00 sprp7 pr6|393 003366 aa 6 00612 4501 00 stz pr6|394 003367 aa 6 00205 3521 00 epp2 pr6|133 operators_argument.error_code 003370 aa 6 00616 2521 00 spri2 pr6|398 003371 aa 6 00606 3521 00 epp2 pr6|390 003372 aa 6 00620 2521 00 spri2 pr6|400 003373 aa 6 00607 3521 00 epp2 pr6|391 003374 aa 6 00622 2521 00 spri2 pr6|402 003375 aa 6 00610 3521 00 epp2 pr6|392 003376 aa 6 00624 2521 00 spri2 pr6|404 003377 aa 6 00611 3521 00 epp2 pr6|393 003400 aa 6 00626 2521 00 spri2 pr6|406 003401 aa 6 00612 3521 00 epp2 pr6|394 003402 aa 6 00630 2521 00 spri2 pr6|408 003403 aa 775242 3520 04 epp2 -1374,ic 000645 = 404000000043 003404 aa 6 00632 2521 00 spri2 pr6|410 003405 aa 775236 3520 04 epp2 -1378,ic 000643 = 514000000044 003406 aa 6 00634 2521 00 spri2 pr6|412 003407 aa 775233 3520 04 epp2 -1381,ic 000642 = 404000000021 003410 aa 6 00636 2521 00 spri2 pr6|414 003411 aa 6 00644 2521 00 spri2 pr6|420 003412 aa 775227 3520 04 epp2 -1385,ic 000641 = 524000000000 003413 aa 6 00640 2521 00 spri2 pr6|416 003414 aa 775224 3520 04 epp2 -1388,ic 000640 = 466000000000 003415 aa 6 00642 2521 00 spri2 pr6|418 003416 aa 6 00614 6211 00 eax1 pr6|396 003417 aa 030000 4310 07 fld 12288,dl 003420 aa 6 00044 3701 20 epp4 pr6|36,* 003421 la 4 00210 3521 20 epp2 pr4|136,* apl_error_ 003422 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1151 call reset_interrupt_info; 003423 aa 007421 6700 04 tsp4 3857,ic 013044 STATEMENT 1 ON LINE 1152 call initialize_suspended_frame; 003424 aa 006127 6700 04 tsp4 3159,ic 011553 STATEMENT 1 ON LINE 1153 go to read_and_lex_line; 003425 aa 775521 7100 04 tra -1199,ic 001146 STATEMENT 1 ON LINE 1155 cant_get_stop_trace: operators_argument.error_code = apl_error_table_$cant_get_stop_trace; 003426 aa 6 00044 3701 20 epp4 pr6|36,* 003427 la 4 00140 2361 20 ldq pr4|96,* apl_error_table_$cant_get_stop_trace 003430 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1157 go to report_error; 003431 aa 000047 7100 04 tra 39,ic 003500 STATEMENT 1 ON LINE 1159 not_end_with_value: operators_argument.error_code = apl_error_table_$not_end_with_value; 003432 aa 6 00044 3701 20 epp4 pr6|36,* 003433 la 4 00106 2361 20 ldq pr4|70,* apl_error_table_$not_end_with_value 003434 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1161 go to report_error; 003435 aa 000043 7100 04 tra 35,ic 003500 STATEMENT 1 ON LINE 1163 ws_full_no_quota_error: ws_info.dont_interrupt_parse = "1"b; 003436 aa 400000 2350 03 lda 131072,du 003437 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 003440 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 1165 operators_argument.error_code = apl_error_table_$ws_full_no_quota; 003441 aa 6 00044 3701 20 epp4 pr6|36,* 003442 la 4 00122 2361 20 ldq pr4|82,* apl_error_table_$ws_full_no_quota 003443 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1174 have_a_line = "0"b; 003444 aa 6 00130 4501 00 stz pr6|88 have_a_line STATEMENT 1 ON LINE 1175 go to report_error; 003445 aa 000033 7100 04 tra 27,ic 003500 STATEMENT 1 ON LINE 1177 dirty_stop: call reset_interrupt_info; 003446 aa 007376 6700 04 tsp4 3838,ic 013044 STATEMENT 1 ON LINE 1179 operators_argument.error_code = apl_error_table_$interrupt; 003447 aa 6 00044 3701 20 epp4 pr6|36,* 003450 la 4 00136 2361 20 ldq pr4|94,* apl_error_table_$interrupt 003451 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1180 go to report_error; 003452 aa 000026 7100 04 tra 22,ic 003500 STATEMENT 1 ON LINE 1182 pull_system_error: operators_argument.error_code = apl_error_table_$pull_system_error; 003453 aa 6 00044 3701 20 epp4 pr6|36,* 003454 la 4 00112 2361 20 ldq pr4|74,* apl_error_table_$pull_system_error 003455 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1184 go to report_error; 003456 aa 000022 7100 04 tra 18,ic 003500 STATEMENT 1 ON LINE 1186 pull_assign_system_error: operators_argument.error_code = apl_error_table_$pull_assign_system_error; 003457 aa 6 00044 3701 20 epp4 pr6|36,* 003460 la 4 00114 2361 20 ldq pr4|76,* apl_error_table_$pull_assign_system_error 003461 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1188 go to report_error; 003462 aa 000016 7100 04 tra 14,ic 003500 STATEMENT 1 ON LINE 1190 report_error_system_error: operators_argument.error_code = apl_error_table_$report_error_system_error; 003463 aa 6 00044 3701 20 epp4 pr6|36,* 003464 la 4 00116 2361 20 ldq pr4|78,* apl_error_table_$report_error_system_error 003465 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1192 go to join_depth_handler; 003466 aa 777673 7100 04 tra -69,ic 003361 STATEMENT 1 ON LINE 1194 done_line_system_error: operators_argument.error_code = apl_error_table_$done_line_system_error; 003467 aa 6 00044 3701 20 epp4 pr6|36,* 003470 la 4 00120 2361 20 ldq pr4|80,* apl_error_table_$done_line_system_error 003471 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1196 go to report_error; 003472 aa 000006 7100 04 tra 6,ic 003500 STATEMENT 1 ON LINE 1198 report_error_from_operator: current_lexeme = rs (operators_argument.where_error).lexeme; 003473 aa 6 00206 2361 00 ldq pr6|134 operators_argument.where_error 003474 aa 000002 7360 00 qls 2 003475 aa 6 00126 3735 20 epp7 pr6|86,* rsp 003476 aa 7 77777 2361 06 ldq pr7|-1,ql rs.lexeme 003477 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1201 report_error: if (parse_frame.parse_frame_type = suspended_frame_type) | (parse_frame.parse_frame_type = evaluated_frame_type) then do; 003500 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 003501 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 003502 aa 000001 1160 07 cmpq 1,dl 003503 aa 000003 6000 04 tze 3,ic 003506 003504 aa 000003 1160 07 cmpq 3,dl 003505 aa 000116 6010 04 tnz 78,ic 003623 STATEMENT 1 ON LINE 1204 if have_a_line then call apl_line_lex_ (input_buffer.line, error_mark_structure_ptr, was_error, current_lexeme, addr (rs (current_parseme + 1))); 003506 aa 6 00130 2351 00 lda pr6|88 have_a_line 003507 aa 000043 6000 04 tze 35,ic 003552 003510 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 003511 aa 526000 2760 03 orq 175104,du 003512 aa 6 00612 7561 00 stq pr6|394 003513 aa 6 00132 2361 00 ldq pr6|90 current_parseme 003514 aa 000002 7360 00 qls 2 003515 aa 6 00126 3715 66 epp5 pr6|86,*ql rs 003516 aa 6 00560 6515 00 spri5 pr6|368 003517 aa 6 00104 3535 20 epp3 pr6|68,* input_buffer_ptr 003520 aa 3 00001 3521 00 epp2 pr3|1 input_buffer.line 003521 aa 6 00616 2521 00 spri2 pr6|398 003522 aa 6 00163 3521 00 epp2 pr6|115 error_mark_structure_ptr 003523 aa 6 00620 2521 00 spri2 pr6|400 003524 aa 6 00143 3521 00 epp2 pr6|99 was_error 003525 aa 6 00622 2521 00 spri2 pr6|402 003526 aa 6 00133 3521 00 epp2 pr6|91 current_lexeme 003527 aa 6 00624 2521 00 spri2 pr6|404 003530 aa 6 00560 3521 00 epp2 pr6|368 003531 aa 6 00626 2521 00 spri2 pr6|406 003532 aa 6 00612 3521 00 epp2 pr6|394 003533 aa 6 00630 2521 00 spri2 pr6|408 003534 aa 775104 3520 04 epp2 -1468,ic 000640 = 466000000000 003535 aa 6 00632 2521 00 spri2 pr6|410 003536 aa 775113 3520 04 epp2 -1461,ic 000651 = 514000000001 003537 aa 6 00634 2521 00 spri2 pr6|412 003540 aa 775102 3520 04 epp2 -1470,ic 000642 = 404000000021 003541 aa 6 00636 2521 00 spri2 pr6|414 003542 aa 775110 3520 04 epp2 -1464,ic 000652 = 464000000000 003543 aa 6 00640 2521 00 spri2 pr6|416 003544 aa 6 00614 6211 00 eax1 pr6|396 003545 aa 024000 4310 07 fld 10240,dl 003546 aa 6 00044 3701 20 epp4 pr6|36,* 003547 la 4 00212 3521 20 epp2 pr4|138,* apl_line_lex_ 003550 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 003551 aa 000003 7100 04 tra 3,ic 003554 STATEMENT 1 ON LINE 1207 else do; STATEMENT 1 ON LINE 1208 n_read = 0; 003552 aa 6 00104 4501 20 stz pr6|68,* input_buffer.n_read STATEMENT 1 ON LINE 1209 error_mark_structure_ptr = parse_frame_ptr; 003553 aa 6 00163 5471 00 sprp7 pr6|115 error_mark_structure_ptr STATEMENT 1 ON LINE 1211 end; STATEMENT 1 ON LINE 1213 packed_temp_ptr = null; 003554 aa 010314 2360 04 ldq 4300,ic 014070 = 007777000001 003555 aa 6 00166 7561 00 stq pr6|118 packed_temp_ptr STATEMENT 1 ON LINE 1214 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, input_buffer.line, packed_temp_ptr, 0); 003556 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 003557 aa 526000 2760 03 orq 175104,du 003560 aa 6 00612 7561 00 stq pr6|394 003561 aa 000000 2350 07 lda 0,dl 003562 aa 6 00611 7551 00 sta pr6|393 003563 aa 6 00163 7671 00 lprp7 pr6|115 error_mark_structure_ptr 003564 aa 6 00610 4501 00 stz pr6|392 003565 aa 6 00205 3521 00 epp2 pr6|133 operators_argument.error_code 003566 aa 6 00616 2521 00 spri2 pr6|398 003567 aa 6 00611 3521 00 epp2 pr6|393 003570 aa 6 00620 2521 00 spri2 pr6|400 003571 aa 7 00002 3521 00 epp2 pr7|2 error_mark_structure.error_index_within_line 003572 aa 6 00622 2521 00 spri2 pr6|402 003573 aa 6 00104 3715 20 epp5 pr6|68,* input_buffer_ptr 003574 aa 5 00001 3521 00 epp2 pr5|1 input_buffer.line 003575 aa 6 00624 2521 00 spri2 pr6|404 003576 aa 6 00166 3521 00 epp2 pr6|118 packed_temp_ptr 003577 aa 6 00626 2521 00 spri2 pr6|406 003600 aa 6 00610 3521 00 epp2 pr6|392 003601 aa 6 00630 2521 00 spri2 pr6|408 003602 aa 775043 3520 04 epp2 -1501,ic 000645 = 404000000043 003603 aa 6 00632 2521 00 spri2 pr6|410 003604 aa 775037 3520 04 epp2 -1505,ic 000643 = 514000000044 003605 aa 6 00634 2521 00 spri2 pr6|412 003606 aa 775034 3520 04 epp2 -1508,ic 000642 = 404000000021 003607 aa 6 00636 2521 00 spri2 pr6|414 003610 aa 6 00644 2521 00 spri2 pr6|420 003611 aa 6 00612 3521 00 epp2 pr6|394 003612 aa 6 00640 2521 00 spri2 pr6|416 003613 aa 775025 3520 04 epp2 -1515,ic 000640 = 466000000000 003614 aa 6 00642 2521 00 spri2 pr6|418 003615 aa 6 00614 6211 00 eax1 pr6|396 003616 aa 030000 4310 07 fld 12288,dl 003617 aa 6 00044 3701 20 epp4 pr6|36,* 003620 la 4 00210 3521 20 epp2 pr4|136,* apl_error_ 003621 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1216 end; 003622 aa 000322 7100 04 tra 210,ic 004144 STATEMENT 1 ON LINE 1217 else if parse_frame_type = function_frame_type then do; 003623 aa 000002 1160 07 cmpq 2,dl 003624 aa 000136 6010 04 tnz 94,ic 003762 STATEMENT 1 ON LINE 1219 symbol_ptr_unal = parse_frame.lexed_function_bead_ptr -> lexed_function_bead.name; 003625 aa 7 00003 7651 00 lprp5 pr7|3 parse_frame.lexed_function_bead_ptr 003626 aa 5 00002 2361 00 ldq pr5|2 lexed_function_bead.name 003627 aa 6 00146 7561 00 stq pr6|102 symbol_ptr_unal STATEMENT 1 ON LINE 1220 meaning_ptr_unal = parse_frame.function_bead_ptr; 003630 aa 7 00002 2361 00 ldq pr7|2 parse_frame.function_bead_ptr 003631 aa 6 00147 7561 00 stq pr6|103 meaning_ptr_unal STATEMENT 1 ON LINE 1221 if meaning_ptr_unal -> function_bead.class ^= 0 then do; 003632 aa 6 00147 7631 00 lprp3 pr6|103 meaning_ptr_unal 003633 aa 3 00003 2361 00 ldq pr3|3 function_bead.class 003634 aa 6 00560 2535 00 spri3 pr6|368 003635 aa 000010 6000 04 tze 8,ic 003645 STATEMENT 1 ON LINE 1226 operators_argument.error_code = apl_error_table_$locked_function_error; 003636 aa 6 00044 3701 20 epp4 pr6|36,* 003637 la 4 00130 2361 20 ldq pr4|88,* apl_error_table_$locked_function_error 003640 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1227 parse_frame_ptr = parse_frame.last_parse_frame_ptr; 003641 aa 7 00000 7611 00 lprp1 pr7|0 parse_frame.last_parse_frame_ptr 003642 aa 6 00122 2515 00 spri1 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 1229 call restore_state; 003643 aa 006064 6700 04 tsp4 3124,ic 011727 STATEMENT 1 ON LINE 1230 go to report_error; 003644 aa 777634 7100 04 tra -100,ic 003500 STATEMENT 1 ON LINE 1231 end; STATEMENT 1 ON LINE 1233 call apl_function_lex_ (meaning_ptr_unal -> function_bead.text, error_mark_structure_ptr, was_error, current_lexeme, addr (rs (current_parseme + 1))); 003645 aa 3 00006 2361 00 ldq pr3|6 function_bead.text_length 003646 aa 524000 2760 03 orq 174080,du 003647 aa 6 00612 7561 00 stq pr6|394 003650 aa 6 00132 2361 00 ldq pr6|90 current_parseme 003651 aa 000002 7360 00 qls 2 003652 aa 6 00126 3515 66 epp1 pr6|86,*ql rs 003653 aa 6 00646 2515 00 spri1 pr6|422 003654 aa 3 00007 3521 00 epp2 pr3|7 function_bead.text 003655 aa 6 00616 2521 00 spri2 pr6|398 003656 aa 6 00163 3521 00 epp2 pr6|115 error_mark_structure_ptr 003657 aa 6 00620 2521 00 spri2 pr6|400 003660 aa 6 00143 3521 00 epp2 pr6|99 was_error 003661 aa 6 00622 2521 00 spri2 pr6|402 003662 aa 6 00133 3521 00 epp2 pr6|91 current_lexeme 003663 aa 6 00624 2521 00 spri2 pr6|404 003664 aa 6 00646 3521 00 epp2 pr6|422 003665 aa 6 00626 2521 00 spri2 pr6|406 003666 aa 6 00612 3521 00 epp2 pr6|394 003667 aa 6 00630 2521 00 spri2 pr6|408 003670 aa 774750 3520 04 epp2 -1560,ic 000640 = 466000000000 003671 aa 6 00632 2521 00 spri2 pr6|410 003672 aa 774757 3520 04 epp2 -1553,ic 000651 = 514000000001 003673 aa 6 00634 2521 00 spri2 pr6|412 003674 aa 774746 3520 04 epp2 -1562,ic 000642 = 404000000021 003675 aa 6 00636 2521 00 spri2 pr6|414 003676 aa 774754 3520 04 epp2 -1556,ic 000652 = 464000000000 003677 aa 6 00640 2521 00 spri2 pr6|416 003700 aa 6 00614 6211 00 eax1 pr6|396 003701 aa 024000 4310 07 fld 10240,dl 003702 aa 6 00044 3701 20 epp4 pr6|36,* 003703 la 4 00216 3521 20 epp2 pr4|142,* apl_function_lex_ 003704 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1235 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, substr (meaning_ptr_unal -> function_bead.text, error_line_index, length_of_line), symbol_ptr_unal, parse_frame.current_line_number); 003705 aa 6 00163 7671 00 lprp7 pr6|115 error_mark_structure_ptr 003706 aa 7 00003 2361 00 ldq pr7|3 error_mark_structure.length_of_line 003707 aa 524000 2760 03 orq 174080,du 003710 aa 6 00612 7561 00 stq pr6|394 003711 aa 000000 2350 07 lda 0,dl 003712 aa 6 00610 7551 00 sta pr6|392 003713 aa 6 00147 7651 00 lprp5 pr6|103 meaning_ptr_unal 003714 aa 7 00003 2361 00 ldq pr7|3 error_mark_structure.length_of_line 003715 aa 0 00551 7001 00 tsx0 pr0|361 alloc_cs 003716 aa 6 00624 2521 00 spri2 pr6|404 003717 aa 7 00001 2351 00 lda pr7|1 error_mark_structure.error_line_index 003720 aa 040 140 100 545 mlr (pr,rl,al),(pr,rl),fill(040) 003721 aa 5 00006 60 0006 desc9a pr5|6(3),ql function_bead.text 003722 aa 2 00000 00 0006 desc9a pr2|0,ql 003723 aa 6 00205 3521 00 epp2 pr6|133 operators_argument.error_code 003724 aa 6 00616 2521 00 spri2 pr6|398 003725 aa 6 00610 3521 00 epp2 pr6|392 003726 aa 6 00620 2521 00 spri2 pr6|400 003727 aa 7 00002 3521 00 epp2 pr7|2 error_mark_structure.error_index_within_line 003730 aa 6 00622 2521 00 spri2 pr6|402 003731 aa 6 00146 3521 00 epp2 pr6|102 symbol_ptr_unal 003732 aa 6 00626 2521 00 spri2 pr6|406 003733 aa 6 00122 3535 20 epp3 pr6|82,* parse_frame_ptr 003734 aa 3 00007 3521 00 epp2 pr3|7 parse_frame.current_line_number 003735 aa 6 00630 2521 00 spri2 pr6|408 003736 aa 774707 3520 04 epp2 -1593,ic 000645 = 404000000043 003737 aa 6 00632 2521 00 spri2 pr6|410 003740 aa 774703 3520 04 epp2 -1597,ic 000643 = 514000000044 003741 aa 6 00634 2521 00 spri2 pr6|412 003742 aa 774700 3520 04 epp2 -1600,ic 000642 = 404000000021 003743 aa 6 00636 2521 00 spri2 pr6|414 003744 aa 6 00644 2521 00 spri2 pr6|420 003745 aa 6 00612 3521 00 epp2 pr6|394 003746 aa 6 00640 2521 00 spri2 pr6|416 003747 aa 774671 3520 04 epp2 -1607,ic 000640 = 466000000000 003750 aa 6 00642 2521 00 spri2 pr6|418 003751 aa 6 00614 6211 00 eax1 pr6|396 003752 aa 030000 4310 07 fld 12288,dl 003753 aa 6 00044 3701 20 epp4 pr6|36,* 003754 la 4 00210 3521 20 epp2 pr4|136,* apl_error_ 003755 aa 6 00560 6515 00 spri5 pr6|368 003756 aa 6 00650 6535 00 spri7 pr6|424 003757 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1239 end; 003760 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack 003761 aa 000163 7100 04 tra 115,ic 004144 STATEMENT 1 ON LINE 1240 else if parse_frame.parse_frame_type = execute_frame_type then do; 003762 aa 000004 1160 07 cmpq 4,dl 003763 aa 777500 6010 04 tnz -192,ic 003463 STATEMENT 1 ON LINE 1242 call clean_up_rs; 003764 aa 005644 6700 04 tsp4 2980,ic 011630 STATEMENT 1 ON LINE 1243 where_execute_error = current_lexeme; 003765 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 003766 aa 6 00142 7561 00 stq pr6|98 where_execute_error STATEMENT 1 ON LINE 1244 if parse_frame.lexed_function_bead_ptr ^= null then call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 003767 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 003770 aa 7 00003 2361 00 ldq pr7|3 parse_frame.lexed_function_bead_ptr 003771 aa 010077 1160 04 cmpq 4159,ic 014070 = 007777000001 003772 aa 000007 6000 04 tze 7,ic 004001 003773 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 003774 aa 6 00550 2521 00 spri2 pr6|360 003775 aa 6 00546 3521 00 epp2 pr6|358 003776 aa 004000 4310 07 fld 2048,dl 003777 aa 2 00000 7571 00 staq pr2|0 004000 aa 005575 6700 04 tsp4 2941,ic 011575 STATEMENT 1 ON LINE 1246 parse_frame_ptr = last_parse_frame_ptr; 004001 aa 6 00122 7671 20 lprp7 pr6|82,* parse_frame.last_parse_frame_ptr 004002 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 1247 call restore_state; 004003 aa 005724 6700 04 tsp4 3028,ic 011727 STATEMENT 1 ON LINE 1249 if ws_info.long_error_mode then do; 004004 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 004005 aa 7 00001 2351 00 lda pr7|1 ws_info.long_error_mode 004006 aa 400000 3150 03 cana 131072,du 004007 aa 000124 6000 04 tze 84,ic 004133 STATEMENT 1 ON LINE 1251 execute_value_ptr = rs (current_parseme - 2).semantics; 004010 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004011 aa 000002 7360 00 qls 2 004012 aa 6 00126 3715 20 epp5 pr6|86,* rsp 004013 aa 5 77766 7651 06 lprp5 pr5|-10,ql rs.semantics 004014 aa 6 00140 6515 00 spri5 pr6|96 execute_value_ptr STATEMENT 1 ON LINE 1252 data_elements = execute_value_ptr -> value_bead.total_data_elements; 004015 aa 000000 6270 06 eax7 0,ql 004016 aa 5 00002 2361 00 ldq pr5|2 value_bead.total_data_elements 004017 aa 6 00154 7561 00 stq pr6|108 data_elements STATEMENT 1 ON LINE 1253 call apl_execute_lex_ (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, error_mark_structure_ptr, was_error, where_execute_error, addr (rs (current_parseme + 1))); 004020 aa 524000 2760 03 orq 174080,du 004021 aa 6 00610 7561 00 stq pr6|392 004022 aa 5 00004 7631 00 lprp3 pr5|4 value_bead.data_pointer 004023 aa 6 00126 3515 77 epp1 pr6|86,*7 rs 004024 aa 6 00646 2515 00 spri1 pr6|422 004025 aa 3 00000 3521 00 epp2 pr3|0 character_string_overlay 004026 aa 6 00616 2521 00 spri2 pr6|398 004027 aa 6 00163 3521 00 epp2 pr6|115 error_mark_structure_ptr 004030 aa 6 00620 2521 00 spri2 pr6|400 004031 aa 6 00143 3521 00 epp2 pr6|99 was_error 004032 aa 6 00622 2521 00 spri2 pr6|402 004033 aa 6 00142 3521 00 epp2 pr6|98 where_execute_error 004034 aa 6 00624 2521 00 spri2 pr6|404 004035 aa 6 00646 3521 00 epp2 pr6|422 004036 aa 6 00626 2521 00 spri2 pr6|406 004037 aa 6 00610 3521 00 epp2 pr6|392 004040 aa 6 00630 2521 00 spri2 pr6|408 004041 aa 774577 3520 04 epp2 -1665,ic 000640 = 466000000000 004042 aa 6 00632 2521 00 spri2 pr6|410 004043 aa 774606 3520 04 epp2 -1658,ic 000651 = 514000000001 004044 aa 6 00634 2521 00 spri2 pr6|412 004045 aa 774575 3520 04 epp2 -1667,ic 000642 = 404000000021 004046 aa 6 00636 2521 00 spri2 pr6|414 004047 aa 774603 3520 04 epp2 -1661,ic 000652 = 464000000000 004050 aa 6 00640 2521 00 spri2 pr6|416 004051 aa 6 00614 6211 00 eax1 pr6|396 004052 aa 024000 4310 07 fld 10240,dl 004053 aa 6 00044 3701 20 epp4 pr6|36,* 004054 la 4 00214 3521 20 epp2 pr4|140,* apl_execute_lex_ 004055 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1255 packed_temp_ptr = null; 004056 aa 010012 2360 04 ldq 4106,ic 014070 = 007777000001 004057 aa 6 00166 7561 00 stq pr6|118 packed_temp_ptr STATEMENT 1 ON LINE 1256 call apl_error_ (operators_argument.error_code, ""b, error_index_within_line, substr (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, 1), packed_temp_ptr, 0); 004060 aa 6 00154 2361 00 ldq pr6|108 data_elements 004061 aa 6 00612 7561 00 stq pr6|394 004062 aa 524000 2760 03 orq 174080,du 004063 aa 6 00610 7561 00 stq pr6|392 004064 aa 000000 2350 07 lda 0,dl 004065 aa 6 00611 7551 00 sta pr6|393 004066 aa 6 00163 7671 00 lprp7 pr6|115 error_mark_structure_ptr 004067 aa 6 00140 3715 20 epp5 pr6|96,* execute_value_ptr 004070 aa 5 00004 7651 00 lprp5 pr5|4 value_bead.data_pointer 004071 aa 6 00612 2361 00 ldq pr6|394 004072 aa 0 00551 7001 00 tsx0 pr0|361 alloc_cs 004073 aa 6 00624 2521 00 spri2 pr6|404 004074 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 004075 aa 5 00000 00 0006 desc9a pr5|0,ql character_string_overlay 004076 aa 2 00000 00 0006 desc9a pr2|0,ql 004077 aa 6 00607 4501 00 stz pr6|391 004100 aa 6 00205 3521 00 epp2 pr6|133 operators_argument.error_code 004101 aa 6 00616 2521 00 spri2 pr6|398 004102 aa 6 00611 3521 00 epp2 pr6|393 004103 aa 6 00620 2521 00 spri2 pr6|400 004104 aa 7 00002 3521 00 epp2 pr7|2 error_mark_structure.error_index_within_line 004105 aa 6 00622 2521 00 spri2 pr6|402 004106 aa 6 00166 3521 00 epp2 pr6|118 packed_temp_ptr 004107 aa 6 00626 2521 00 spri2 pr6|406 004110 aa 6 00607 3521 00 epp2 pr6|391 004111 aa 6 00630 2521 00 spri2 pr6|408 004112 aa 774533 3520 04 epp2 -1701,ic 000645 = 404000000043 004113 aa 6 00632 2521 00 spri2 pr6|410 004114 aa 774527 3520 04 epp2 -1705,ic 000643 = 514000000044 004115 aa 6 00634 2521 00 spri2 pr6|412 004116 aa 774524 3520 04 epp2 -1708,ic 000642 = 404000000021 004117 aa 6 00636 2521 00 spri2 pr6|414 004120 aa 6 00644 2521 00 spri2 pr6|420 004121 aa 6 00610 3521 00 epp2 pr6|392 004122 aa 6 00640 2521 00 spri2 pr6|416 004123 aa 774515 3520 04 epp2 -1715,ic 000640 = 466000000000 004124 aa 6 00642 2521 00 spri2 pr6|418 004125 aa 6 00614 6211 00 eax1 pr6|396 004126 aa 030000 4310 07 fld 12288,dl 004127 aa 6 00044 3701 20 epp4 pr6|36,* 004130 la 4 00210 3521 20 epp2 pr4|136,* apl_error_ 004131 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1259 end; 004132 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack STATEMENT 1 ON LINE 1261 current_lexeme = rs (current_parseme - 1).lexeme; 004133 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004134 aa 000002 7360 00 qls 2 004135 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004136 aa 7 77773 2361 06 ldq pr7|-5,ql rs.lexeme 004137 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 1262 operators_argument.error_code = apl_error_table_$execute; 004140 aa 6 00044 3701 20 epp4 pr6|36,* 004141 la 4 00152 2361 20 ldq pr4|106,* apl_error_table_$execute 004142 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1263 go to report_error; 004143 aa 777335 7100 04 tra -291,ic 003500 STATEMENT 1 ON LINE 1264 end; STATEMENT 1 ON LINE 1267 recover_from_error: call reset_interrupt_info; 004144 aa 006700 6700 04 tsp4 3520,ic 013044 STATEMENT 1 ON LINE 1269 call clean_up_rs; 004145 aa 005463 6700 04 tsp4 2867,ic 011630 STATEMENT 1 ON LINE 1271 if parse_frame_type = suspended_frame_type then go to next_line; 004146 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 004147 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 004150 aa 000001 1160 07 cmpq 1,dl 004151 aa 774763 6000 04 tze -1549,ic 001134 STATEMENT 1 ON LINE 1273 if parse_frame_type = evaluated_frame_type then go to next_line; 004152 aa 000003 1160 07 cmpq 3,dl 004153 aa 774761 6000 04 tze -1551,ic 001134 STATEMENT 1 ON LINE 1276 call save_state; 004154 aa 005536 6700 04 tsp4 2910,ic 011712 STATEMENT 1 ON LINE 1277 call push_new_frame; 004155 aa 005643 6700 04 tsp4 2979,ic 012020 STATEMENT 1 ON LINE 1278 call initialize_suspended_frame; 004156 aa 005375 6700 04 tsp4 2813,ic 011553 STATEMENT 1 ON LINE 1279 go to read_and_lex_line; 004157 aa 774767 7100 04 tra -1545,ic 001146 STATEMENT 1 ON LINE 1283 pull_assignment_variable: current_parseme = current_parseme + 1; 004160 aa 6 00132 0541 00 aos pr6|90 current_parseme STATEMENT 1 ON LINE 1285 current_lexeme = current_lexeme - 1; 004161 aa 000001 3360 07 lcq 1,dl 004162 aa 6 00133 0561 00 asq pr6|91 current_lexeme STATEMENT 1 ON LINE 1286 rs (current_parseme).lexeme = current_lexeme; 004163 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004164 aa 000002 7360 00 qls 2 004165 aa 000000 6270 06 eax7 0,ql 004166 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 004167 aa 7 77777 7561 17 stq pr7|-1,7 rs.lexeme STATEMENT 1 ON LINE 1287 unspec (rs (current_parseme).bits) = ""b; 004170 aa 7 77775 4501 17 stz pr7|-3,7 STATEMENT 1 ON LINE 1288 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 004171 aa 6 00134 3715 20 epp5 pr6|92,* lexed_function_bead_ptr 004172 aa 5 00011 7651 00 lprp5 pr5|9 lexed_function_bead.lexeme_array_ptr 004173 aa 5 77777 7631 06 lprp3 pr5|-1,ql lexed_function_lexemes_structure.lexed_function_lexeme_array 004174 aa 6 00136 2535 00 spri3 pr6|94 operator_ptr STATEMENT 1 ON LINE 1290 if ^operator_ptr -> general_bead.type.symbol then go to pull_assign_system_error; 004175 aa 3 00000 2351 00 lda pr3|0 general_bead.symbol 004176 aa 200000 3150 03 cana 65536,du 004177 aa 777260 6000 04 tze -336,ic 003457 STATEMENT 1 ON LINE 1293 rs (current_parseme).semantics = operator_ptr -> symbol_bead.meaning_pointer; 004200 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 004201 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1294 if rs (current_parseme).semantics = null then go to pull_null_var; 004202 aa 007666 1160 04 cmpq 4022,ic 014070 = 007777000001 004203 aa 000164 6000 04 tze 116,ic 004367 STATEMENT 1 ON LINE 1296 if rs (current_parseme).semantics -> general_bead.type.value then do; 004204 aa 7 77776 7611 17 lprp1 pr7|-2,7 rs.semantics 004205 aa 1 00000 2351 00 lda pr1|0 general_bead.value 004206 aa 100000 3150 03 cana 32768,du 004207 aa 6 00610 7471 00 stx7 pr6|392 004210 aa 6 00646 2515 00 spri1 pr6|422 004211 aa 000010 6000 04 tze 8,ic 004221 STATEMENT 1 ON LINE 1298 rs (current_parseme).type = val_type; 004212 aa 000002 2360 07 ldq 2,dl 004213 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1299 unspec (rs (current_parseme).bits) = value_bits; 004214 aa 004000 2350 03 lda 2048,du 004215 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1300 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme).semantics -> general_bead.reference_count + 1; 004216 aa 1 00001 0541 00 aos pr1|1 general_bead.reference_count STATEMENT 1 ON LINE 1302 go to operator_return (return_point); 004217 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004220 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1303 end; STATEMENT 1 ON LINE 1307 operators_argument.error_code = apl_error_table_$assign_to_value; 004221 aa 6 00044 3701 20 epp4 pr6|36,* 004222 la 4 00132 2361 20 ldq pr4|90,* apl_error_table_$assign_to_value 004223 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1308 go to report_error; 004224 aa 777254 7100 04 tra -340,ic 003500 STATEMENT 1 ON LINE 1310 pull: current_parseme = current_parseme + 1; 004225 aa 6 00132 0541 00 aos pr6|90 current_parseme STATEMENT 1 ON LINE 1312 current_lexeme = current_lexeme - 1; 004226 aa 000001 3360 07 lcq 1,dl 004227 aa 6 00133 0561 00 asq pr6|91 current_lexeme STATEMENT 1 ON LINE 1313 rs (current_parseme).lexeme = current_lexeme; 004230 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004231 aa 000002 7360 00 qls 2 004232 aa 000000 6270 06 eax7 0,ql 004233 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 004234 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004235 aa 7 77777 7561 17 stq pr7|-1,7 rs.lexeme STATEMENT 1 ON LINE 1314 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 004236 aa 6 00134 3715 20 epp5 pr6|92,* lexed_function_bead_ptr 004237 aa 5 00011 7651 00 lprp5 pr5|9 lexed_function_bead.lexeme_array_ptr 004240 aa 5 77777 7631 06 lprp3 pr5|-1,ql lexed_function_lexemes_structure.lexed_function_lexeme_array 004241 aa 6 00136 2535 00 spri3 pr6|94 operator_ptr STATEMENT 1 ON LINE 1319 temp18 = string (operator_ptr -> general_bead.type); 004242 aa 3 00000 2351 00 lda pr3|0 004243 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 004244 aa 6 00112 7551 00 sta pr6|74 temp18 STATEMENT 1 ON LINE 1322 if temp18 = operator_type /* is it an operator? */ then do; 004245 aa 400000 1150 03 cmpa 131072,du 004246 aa 6 00610 7471 00 stx7 pr6|392 004247 aa 6 00646 6515 00 spri5 pr6|422 004250 aa 000016 6010 04 tnz 14,ic 004266 STATEMENT 1 ON LINE 1324 rs (current_parseme).type = operator_ptr -> operator_bead.type_code; 004251 aa 3 00002 2361 00 ldq pr3|2 operator_bead.type_code 004252 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1325 unspec (rs (current_parseme).bits) = unspec (operator_ptr -> operator_bead.bits_for_parse); 004253 aa 3 00001 2351 00 lda pr3|1 004254 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1330 if (unspec (rs (current_parseme).bits) & "101000000000000000"b) ^= ""b then if rs (current_parseme).stop_trace_control then go to pull_stop_trace; 004255 aa 7 77775 2351 17 lda pr7|-3,7 004256 aa 500000 3150 03 cana 163840,du 004257 aa 000003 6010 04 tnz 3,ic 004262 004260 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004261 ta 777777 7100 16 tra -1,6 004262 aa 7 77775 2351 17 lda pr7|-3,7 rs.stop_trace_control 004263 aa 400000 3150 03 cana 131072,du 004264 aa 000456 6010 04 tnz 302,ic 004742 STATEMENT 1 ON LINE 1333 else go to pull_system_variable; 004265 aa 000364 7100 04 tra 244,ic 004651 STATEMENT 1 ON LINE 1335 end; STATEMENT 1 ON LINE 1336 else if temp18 = symbol_type /* is it a symbol? */ then do; 004266 aa 200000 1150 03 cmpa 65536,du 004267 aa 000346 6010 04 tnz 230,ic 004635 STATEMENT 1 ON LINE 1338 if current_lexeme > 1 & current_lexeme < lexed_function_bead_ptr -> statement_map (parse_frame.current_line_number) then do; 004270 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 004271 aa 000001 1160 07 cmpq 1,dl 004272 aa 000070 6044 04 tmoz 56,ic 004362 004273 aa 6 00134 3515 20 epp1 pr6|92,* lexed_function_bead_ptr 004274 aa 1 00005 2361 00 ldq pr1|5 lexed_function_bead.number_of_localized_symbols 004275 aa 000012 0760 07 adq 10,dl 004276 aa 1 00006 0761 00 adq pr1|6 lexed_function_bead.number_of_labels 004277 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 004300 aa 7 00007 0761 00 adq pr7|7 parse_frame.current_line_number 004301 aa 000000 6260 06 eax6 0,ql 004302 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 004303 aa 1 77777 1161 16 cmpq pr1|-1,6 lexed_function_bead.statement_map 004304 aa 000056 6050 04 tpl 46,ic 004362 STATEMENT 1 ON LINE 1341 temp_ptr = operator_ptr -> symbol_bead.meaning_pointer; 004305 aa 3 00003 7671 00 lprp7 pr3|3 symbol_bead.meaning_pointer 004306 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1342 if temp_ptr ^= null then if ^temp_ptr -> general_bead.value then goto not_by_name; 004307 aa 6 00150 2371 00 ldaq pr6|104 temp_ptr 004310 aa 774356 6770 04 eraq -1810,ic 000666 = 077777000043 000001000000 004311 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 004312 aa 000004 6000 04 tze 4,ic 004316 004313 aa 7 00000 2351 00 lda pr7|0 general_bead.value 004314 aa 100000 3150 03 cana 32768,du 004315 aa 000045 6000 04 tze 37,ic 004362 STATEMENT 1 ON LINE 1345 temp_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme - 1); 004316 aa 6 00133 7251 00 lxl5 pr6|91 current_lexeme 004317 aa 5 77776 7611 15 lprp1 pr5|-2,5 lexed_function_lexemes_structure.lexed_function_lexeme_array 004320 aa 6 00150 2515 00 spri1 pr6|104 temp_ptr STATEMENT 1 ON LINE 1347 if string (temp_ptr -> general_bead.type) ^= operator_type then goto not_by_name; 004321 aa 1 00000 2351 00 lda pr1|0 004322 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 004323 aa 400000 1150 03 cmpa 131072,du 004324 aa 000036 6010 04 tnz 30,ic 004362 STATEMENT 1 ON LINE 1349 if temp_ptr -> operator_bead.op1 ^= quadcall_semicolon_code then goto not_by_name; 004325 aa 1 00001 2351 00 lda pr1|1 operator_bead.op1 004326 aa 000033 7350 00 als 27 004327 aa 000077 7330 00 lrs 63 004330 aa 000174 1160 07 cmpq 124,dl 004331 aa 000031 6010 04 tnz 25,ic 004362 STATEMENT 1 ON LINE 1351 temp_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme + 1); 004332 aa 5 00000 7671 15 lprp7 pr5|0,5 lexed_function_lexemes_structure.lexed_function_lexeme_array 004333 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1353 if string (temp_ptr -> general_bead.type) ^= operator_type then goto not_by_name; 004334 aa 7 00000 2351 00 lda pr7|0 004335 aa 0 00044 3771 00 anaq pr0|36 = 777777000000 000000000000 004336 aa 400000 1150 03 cmpa 131072,du 004337 aa 000023 6010 04 tnz 19,ic 004362 STATEMENT 1 ON LINE 1355 if temp_ptr -> operator_bead.op1 ^= quadcall_semicolon_code & temp_ptr -> operator_bead.type_code ^= close_paren_type then goto not_by_name; 004340 aa 7 00001 2351 00 lda pr7|1 operator_bead.op1 004341 aa 000033 7350 00 als 27 004342 aa 000077 7330 00 lrs 63 004343 aa 000174 1160 07 cmpq 124,dl 004344 aa 000004 6000 04 tze 4,ic 004350 004345 aa 7 00002 2361 00 ldq pr7|2 operator_bead.type_code 004346 aa 000005 1160 07 cmpq 5,dl 004347 aa 000013 6010 04 tnz 11,ic 004362 STATEMENT 1 ON LINE 1358 rs (current_parseme).semantics = operator_ptr; 004350 aa 6 00126 3515 20 epp1 pr6|86,* rsp 004351 aa 1 77776 5431 17 sprp3 pr1|-2,7 rs.semantics STATEMENT 1 ON LINE 1359 rs (current_parseme).type = val_type; 004352 aa 000002 2360 07 ldq 2,dl 004353 aa 1 77774 7561 17 stq pr1|-4,7 rs.type STATEMENT 1 ON LINE 1360 unspec (rs (current_parseme).bits) = value_bits; 004354 aa 004000 2350 03 lda 2048,du 004355 aa 1 77775 7551 17 sta pr1|-3,7 STATEMENT 1 ON LINE 1361 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme). semantics -> general_bead.reference_count + 1; 004356 aa 1 77776 7671 17 lprp7 pr1|-2,7 rs.semantics 004357 aa 7 00001 0541 00 aos pr7|1 general_bead.reference_count STATEMENT 1 ON LINE 1363 go to operator_return (return_point); 004360 aa 6 00157 7241 00 lxl4 pr6|111 return_point 004361 ta 777777 7100 14 tra -1,4 STATEMENT 1 ON LINE 1364 not_by_name: end; STATEMENT 1 ON LINE 1366 rs (current_parseme).semantics = operator_ptr -> symbol_bead.meaning_pointer; 004362 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 004363 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004364 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1368 if rs (current_parseme).semantics = null/* no value yet */ then do; 004365 aa 007503 1160 04 cmpq 3907,ic 014070 = 007777000001 004366 aa 000036 6010 04 tnz 30,ic 004424 STATEMENT 1 ON LINE 1371 pull_null_var: rs (current_parseme).type = val_type; 004367 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004370 aa 000002 7360 00 qls 2 004371 aa 000000 6270 06 eax7 0,ql 004372 aa 000002 2360 07 ldq 2,dl 004373 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1373 unspec (rs (current_parseme).bits) = ""b; 004374 aa 7 77775 4501 17 stz pr7|-3,7 STATEMENT 1 ON LINE 1374 if rs (current_parseme - 1).type ^= op_type then call value_error_reporter (current_lexeme); 004375 aa 7 77770 2361 17 ldq pr7|-8,7 rs.type 004376 aa 000003 1160 07 cmpq 3,dl 004377 aa 000003 6000 04 tze 3,ic 004402 004400 aa 007450 3520 04 epp2 3880,ic 014050 = 000002000000 004401 aa 005407 6700 04 tsp4 2823,ic 012010 STATEMENT 1 ON LINE 1376 if rs (current_parseme - 1).op1 ^= assignment_code then call value_error_reporter (current_lexeme); 004402 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004403 aa 000001 1760 07 sbq 1,dl 004404 aa 000002 7360 00 qls 2 004405 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004406 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 004407 aa 000033 7350 00 als 27 004410 aa 000077 7330 00 lrs 63 004411 aa 000146 1160 07 cmpq 102,dl 004412 aa 000003 6000 04 tze 3,ic 004415 004413 aa 007435 3520 04 epp2 3869,ic 014050 = 000002000000 004414 aa 005374 6700 04 tsp4 2812,ic 012010 STATEMENT 1 ON LINE 1379 unspec (rs (current_parseme).bits) = value_bits; 004415 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004416 aa 000002 7360 00 qls 2 004417 aa 004000 2350 03 lda 2048,du 004420 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004421 aa 7 77775 7551 06 sta pr7|-3,ql STATEMENT 1 ON LINE 1380 go to operator_return (return_point); 004422 aa 6 00157 7271 00 lxl7 pr6|111 return_point 004423 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1381 end; STATEMENT 1 ON LINE 1383 if rs (current_parseme).semantics -> general_bead.type.value then do; 004424 aa 7 77776 7611 17 lprp1 pr7|-2,7 rs.semantics 004425 aa 1 00000 2351 00 lda pr1|0 general_bead.value 004426 aa 100000 3150 03 cana 32768,du 004427 aa 6 00650 2515 00 spri1 pr6|424 004430 aa 000010 6000 04 tze 8,ic 004440 STATEMENT 1 ON LINE 1385 rs (current_parseme).type = val_type; 004431 aa 000002 2360 07 ldq 2,dl 004432 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1386 unspec (rs (current_parseme).bits) = value_bits; 004433 aa 004000 2350 03 lda 2048,du 004434 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1387 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme).semantics -> general_bead.reference_count + 1; 004435 aa 1 00001 0541 00 aos pr1|1 general_bead.reference_count STATEMENT 1 ON LINE 1389 go to operator_return (return_point); 004436 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004437 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1390 end; STATEMENT 1 ON LINE 1392 if rs (current_parseme).semantics -> general_bead.type.function then do; 004440 aa 1 00000 2351 00 lda pr1|0 general_bead.function 004441 aa 040000 3150 03 cana 16384,du 004442 aa 000165 6000 04 tze 117,ic 004627 STATEMENT 1 ON LINE 1394 temp_ptr = rs (current_parseme).semantics -> function_bead.lexed_function_bead_pointer; 004443 aa 1 00002 7631 00 lprp3 pr1|2 function_bead.lexed_function_bead_pointer 004444 aa 6 00150 2535 00 spri3 pr6|104 temp_ptr STATEMENT 1 ON LINE 1395 rs (current_parseme).type = op_type; 004445 aa 000003 2360 07 ldq 3,dl 004446 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1396 unspec (rs (current_parseme).bits) = ""b; 004447 aa 7 77775 4501 17 stz pr7|-3,7 STATEMENT 1 ON LINE 1397 if temp_ptr = null /* unlexed function */ then do; 004450 aa 6 00150 2371 00 ldaq pr6|104 temp_ptr 004451 aa 774215 6770 04 eraq -1907,ic 000666 = 077777000043 000001000000 004452 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 004453 aa 000107 6010 04 tnz 71,ic 004562 STATEMENT 1 ON LINE 1399 temp_ptr = rs (current_parseme).semantics; 004454 aa 7 77776 7611 17 lprp1 pr7|-2,7 rs.semantics 004455 aa 6 00150 2515 00 spri1 pr6|104 temp_ptr STATEMENT 1 ON LINE 1401 if temp_ptr -> function_bead.class > 1 /* external function */ then do; 004456 aa 1 00003 2361 00 ldq pr1|3 function_bead.class 004457 aa 000001 1160 07 cmpq 1,dl 004460 aa 000026 6044 04 tmoz 22,ic 004506 STATEMENT 1 ON LINE 1404 call apl_external_fcn_addr_ (temp_ptr -> function_bead.text, temp_ptr -> function_bead.lexed_function_bead_pointer); 004461 aa 1 00006 2361 00 ldq pr1|6 function_bead.text_length 004462 aa 524000 2760 03 orq 174080,du 004463 aa 6 00607 7561 00 stq pr6|391 004464 aa 1 00007 3521 00 epp2 pr1|7 function_bead.text 004465 aa 6 00550 2521 00 spri2 pr6|360 004466 aa 1 00002 3521 00 epp2 pr1|2 function_bead.lexed_function_bead_pointer 004467 aa 6 00552 2521 00 spri2 pr6|362 004470 aa 6 00607 3521 00 epp2 pr6|391 004471 aa 6 00554 2521 00 spri2 pr6|364 004472 aa 774146 3520 04 epp2 -1946,ic 000640 = 466000000000 004473 aa 6 00556 2521 00 spri2 pr6|366 004474 aa 6 00546 6211 00 eax1 pr6|358 004475 aa 010000 4310 07 fld 4096,dl 004476 aa 6 00044 3701 20 epp4 pr6|36,* 004477 la 4 00316 3521 20 epp2 pr4|206,* apl_external_fcn_addr_ 004500 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1406 if temp_ptr -> function_bead.lexed_function_bead_pointer = null then go to recover_from_error; 004501 aa 6 00150 3735 20 epp7 pr6|104,* temp_ptr 004502 aa 7 00002 2361 00 ldq pr7|2 function_bead.lexed_function_bead_pointer 004503 aa 007365 1160 04 cmpq 3829,ic 014070 = 007777000001 004504 aa 777440 6000 04 tze -224,ic 004144 STATEMENT 1 ON LINE 1408 end; 004505 aa 000052 7100 04 tra 42,ic 004557 STATEMENT 1 ON LINE 1409 else do; STATEMENT 1 ON LINE 1410 call apl_function_lex_no_messages_ (operator_ptr -> symbol_bead.meaning_pointer -> function_bead.text, temp_ptr -> function_bead.lexed_function_bead_pointer, was_error, 0, addr (rs (current_parseme + 1)), (0)); 004506 aa 6 00136 3535 20 epp3 pr6|94,* operator_ptr 004507 aa 3 00003 7631 00 lprp3 pr3|3 symbol_bead.meaning_pointer 004510 aa 3 00006 2361 00 ldq pr3|6 function_bead.text_length 004511 aa 524000 2760 03 orq 174080,du 004512 aa 6 00607 7561 00 stq pr6|391 004513 aa 6 00612 4501 00 stz pr6|394 004514 aa 7 00000 3515 17 epp1 pr7|0,7 rs 004515 aa 6 00650 2515 00 spri1 pr6|424 004516 aa 6 00611 4501 00 stz pr6|393 004517 aa 3 00007 3521 00 epp2 pr3|7 function_bead.text 004520 aa 6 00616 2521 00 spri2 pr6|398 004521 aa 6 00150 3535 20 epp3 pr6|104,* temp_ptr 004522 aa 3 00002 3521 00 epp2 pr3|2 function_bead.lexed_function_bead_pointer 004523 aa 6 00620 2521 00 spri2 pr6|400 004524 aa 6 00143 3521 00 epp2 pr6|99 was_error 004525 aa 6 00622 2521 00 spri2 pr6|402 004526 aa 6 00612 3521 00 epp2 pr6|394 004527 aa 6 00624 2521 00 spri2 pr6|404 004530 aa 6 00650 3521 00 epp2 pr6|424 004531 aa 6 00626 2521 00 spri2 pr6|406 004532 aa 6 00611 3521 00 epp2 pr6|393 004533 aa 6 00630 2521 00 spri2 pr6|408 004534 aa 6 00607 3521 00 epp2 pr6|391 004535 aa 6 00632 2521 00 spri2 pr6|410 004536 aa 774102 3520 04 epp2 -1982,ic 000640 = 466000000000 004537 aa 6 00634 2521 00 spri2 pr6|412 004540 aa 774111 3520 04 epp2 -1975,ic 000651 = 514000000001 004541 aa 6 00636 2521 00 spri2 pr6|414 004542 aa 774100 3520 04 epp2 -1984,ic 000642 = 404000000021 004543 aa 6 00640 2521 00 spri2 pr6|416 004544 aa 6 00644 2521 00 spri2 pr6|420 004545 aa 774105 3520 04 epp2 -1979,ic 000652 = 464000000000 004546 aa 6 00642 2521 00 spri2 pr6|418 004547 aa 6 00614 6211 00 eax1 pr6|396 004550 aa 030000 4310 07 fld 12288,dl 004551 aa 6 00044 3701 20 epp4 pr6|36,* 004552 la 4 00220 3521 20 epp2 pr4|144,* apl_function_lex_no_messages_ 004553 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 1414 if was_error then go to recover_from_error; 004554 aa 6 00143 2351 00 lda pr6|99 was_error 004555 aa 400000 3150 03 cana 131072,du 004556 aa 777366 6010 04 tnz -266,ic 004144 STATEMENT 1 ON LINE 1416 end; STATEMENT 1 ON LINE 1417 temp_ptr = temp_ptr -> function_bead.lexed_function_bead_pointer; 004557 aa 6 00150 3735 20 epp7 pr6|104,* temp_ptr 004560 aa 7 00002 7671 00 lprp7 pr7|2 function_bead.lexed_function_bead_pointer 004561 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1418 end; STATEMENT 1 ON LINE 1419 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme).semantics -> general_bead.reference_count + 1; 004562 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004563 aa 000002 7360 00 qls 2 004564 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004565 aa 7 77776 7671 06 lprp7 pr7|-2,ql rs.semantics 004566 aa 7 00001 0541 00 aos pr7|1 general_bead.reference_count STATEMENT 1 ON LINE 1422 if rs (current_parseme).semantics -> function_bead.class > 1 then unspec (rs (current_parseme).bits) = external_function_bits (rs (current_parseme).semantics -> function_bead.class); 004567 aa 6 00607 7561 00 stq pr6|391 004570 aa 7 00003 2361 00 ldq pr7|3 function_bead.class 004571 aa 000001 1160 07 cmpq 1,dl 004572 aa 6 00650 6535 00 spri7 pr6|424 004573 aa 000006 6044 04 tmoz 6,ic 004601 004574 ta 000223 2350 06 lda 147,ql 004575 aa 6 00607 7271 00 lxl7 pr6|391 004576 aa 6 00126 3715 20 epp5 pr6|86,* rsp 004577 aa 5 77775 7551 17 sta pr5|-3,7 004600 aa 000006 7100 04 tra 6,ic 004606 STATEMENT 1 ON LINE 1425 else unspec (rs (current_parseme).bits) = unspec (temp_ptr -> lexed_function_bead.bits_for_parse); 004601 aa 6 00150 3715 20 epp5 pr6|104,* temp_ptr 004602 aa 5 00003 2351 00 lda pr5|3 004603 aa 6 00607 7271 00 lxl7 pr6|391 004604 aa 6 00126 3535 20 epp3 pr6|86,* rsp 004605 aa 3 77775 7551 17 sta pr3|-3,7 STATEMENT 1 ON LINE 1427 rs (current_parseme).semantics_valid = "1"b; 004606 aa 004000 2350 03 lda 2048,du 004607 aa 6 00126 3715 20 epp5 pr6|86,* rsp 004610 aa 5 77775 2551 17 orsa pr5|-3,7 rs.semantics_valid STATEMENT 1 ON LINE 1429 if ^rs (current_parseme).bits.monadic then if ^rs (current_parseme).bits.dyadic then do; 004611 aa 5 77775 2351 17 lda pr5|-3,7 rs.monadic 004612 aa 020000 3150 03 cana 8192,du 004613 aa 000012 6010 04 tnz 10,ic 004625 004614 aa 5 77775 2351 17 lda pr5|-3,7 rs.dyadic 004615 aa 040000 3150 03 cana 16384,du 004616 aa 000007 6010 04 tnz 7,ic 004625 STATEMENT 1 ON LINE 1432 number_of_arguments = 0; 004617 aa 6 00160 4501 00 stz pr6|112 number_of_arguments STATEMENT 1 ON LINE 1433 put_result = current_parseme; 004620 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004621 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 1434 start = current_parseme - 1; 004622 aa 000001 1760 07 sbq 1,dl 004623 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 1435 go to invoke_niladic_function; 004624 aa 000637 7100 04 tra 415,ic 005463 STATEMENT 1 ON LINE 1436 end; STATEMENT 1 ON LINE 1437 go to operator_return (return_point); 004625 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004626 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1438 end; STATEMENT 1 ON LINE 1440 rs (current_parseme).type = val_type; 004627 aa 000002 2360 07 ldq 2,dl 004630 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1441 unspec (rs (current_parseme).bits) = ""b; 004631 aa 7 77775 4501 17 stz pr7|-3,7 STATEMENT 1 ON LINE 1443 rs (current_parseme).semantics = null; 004632 aa 007236 2360 04 ldq 3742,ic 014070 = 007777000001 004633 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1444 end; 004634 aa 776617 7100 04 tra -625,ic 003453 STATEMENT 1 ON LINE 1445 else if (temp18 & value_type) = value_type /* is it a value? */ then do; 004635 aa 100000 3750 03 ana 32768,du 004636 aa 100000 1150 03 cmpa 32768,du 004637 aa 776614 6010 04 tnz -628,ic 003453 STATEMENT 1 ON LINE 1447 operator_ptr -> general_bead.reference_count = operator_ptr -> general_bead.reference_count + 1; 004640 aa 3 00001 0541 00 aos pr3|1 general_bead.reference_count STATEMENT 1 ON LINE 1448 rs (current_parseme).semantics = operator_ptr; 004641 aa 7 77776 5431 17 sprp3 pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1449 rs (current_parseme).type = val_type; 004642 aa 000002 2360 07 ldq 2,dl 004643 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1450 unspec (rs (current_parseme).bits) = value_bits; 004644 aa 004000 2350 03 lda 2048,du 004645 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1451 go to operator_return (return_point); 004646 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004647 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1452 end; STATEMENT 1 ON LINE 1454 go to pull_system_error; 004650 aa 776603 7100 04 tra -637,ic 003453 STATEMENT 1 ON LINE 1456 pull_system_variable: if rs (current_parseme).op1 ^= 0 then do; 004651 aa 7 77775 2351 17 lda pr7|-3,7 rs.op1 004652 aa 000033 7350 00 als 27 004653 aa 000077 7330 00 lrs 63 004654 aa 6 00607 7561 00 stq pr6|391 rs.op1 004655 aa 000052 6000 04 tze 42,ic 004727 STATEMENT 1 ON LINE 1459 operators_argument.op1 = rs (current_parseme).op1; 004656 aa 6 00203 5521 04 stbq pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 1460 operators_argument.where_error = current_parseme; 004657 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004660 aa 6 00206 7561 00 stq pr6|134 operators_argument.where_error STATEMENT 1 ON LINE 1461 operators_argument.error_code = 0; 004661 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1466 if (operators_argument.op1 = fnames_code) | (operators_argument.op1 = fnums_code) then call apl_file_system_$niladic_functions (operators_argument); 004662 aa 6 00203 2351 00 lda pr6|131 operators_argument.op1 004663 aa 000033 7350 00 als 27 004664 aa 000077 7330 00 lrs 63 004665 aa 6 00607 7561 00 stq pr6|391 operators_argument.op1 004666 aa 000123 1160 07 cmpq 83,dl 004667 aa 000003 6000 04 tze 3,ic 004672 004670 aa 000124 1160 07 cmpq 84,dl 004671 aa 000011 6010 04 tnz 9,ic 004702 004672 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 004673 aa 6 00544 2521 00 spri2 pr6|356 004674 aa 6 00542 6211 00 eax1 pr6|354 004675 aa 004000 4310 07 fld 2048,dl 004676 aa 6 00044 3701 20 epp4 pr6|36,* 004677 la 4 00252 3521 20 epp2 pr4|170,* apl_file_system_$niladic_functions 004700 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out 004701 aa 000010 7100 04 tra 8,ic 004711 STATEMENT 1 ON LINE 1468 else call apl_system_variables_ (operators_argument); 004702 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 004703 aa 6 00544 2521 00 spri2 pr6|356 004704 aa 6 00542 6211 00 eax1 pr6|354 004705 aa 004000 4310 07 fld 2048,dl 004706 aa 6 00044 3701 20 epp4 pr6|36,* 004707 la 4 00244 3521 20 epp2 pr4|164,* apl_system_variables_ 004710 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1469 if operators_argument.error_code ^= 0 then go to report_error_from_operator; 004711 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 004712 aa 776561 6010 04 tnz -655,ic 003473 STATEMENT 1 ON LINE 1472 rs (current_parseme).semantics = operators_argument.result; 004713 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004714 aa 000002 7360 00 qls 2 004715 aa 000000 6270 06 eax7 0,ql 004716 aa 6 00204 2361 00 ldq pr6|132 operators_argument.result 004717 aa 6 00126 3735 20 epp7 pr6|86,* rsp 004720 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1473 unspec (rs (current_parseme).bits) = computed_value_bits; 004721 aa 004400 2350 03 lda 2304,du 004722 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1475 rs (current_parseme).type = val_type; 004723 aa 000002 2360 07 ldq 2,dl 004724 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1476 go to operator_return (return_point); 004725 aa 6 00157 7261 00 lxl6 pr6|111 return_point 004726 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1477 end; STATEMENT 1 ON LINE 1479 put_result = current_parseme; 004727 aa 6 00132 2361 00 ldq pr6|90 current_parseme 004730 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 1480 call save_state; 004731 aa 004761 6700 04 tsp4 2545,ic 011712 STATEMENT 1 ON LINE 1481 call push_new_frame; 004732 aa 005066 6700 04 tsp4 2614,ic 012020 STATEMENT 1 ON LINE 1482 parse_frame_type = evaluated_frame_type; 004733 aa 000003 2360 07 ldq 3,dl 004734 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 004735 aa 7 00001 7561 00 stq pr7|1 parse_frame.parse_frame_type STATEMENT 1 ON LINE 1483 parse_frame.number_of_ptrs, number_of_ptrs = 3; 004736 aa 000003 2360 07 ldq 3,dl 004737 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 004740 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 1484 go to read_and_lex_line; 004741 aa 774205 7100 04 tra -1915,ic 001146 STATEMENT 1 ON LINE 1486 pull_stop_trace: current_lexeme = current_lexeme - 1; 004742 aa 000001 3360 07 lcq 1,dl 004743 aa 6 00133 0561 00 asq pr6|91 current_lexeme STATEMENT 1 ON LINE 1488 temp_ptr = operator_ptr; 004744 aa 6 00150 2535 00 spri3 pr6|104 temp_ptr STATEMENT 1 ON LINE 1489 operator_ptr = lexed_function_bead_ptr -> lexeme_array_ptr -> lexed_function_lexeme_array (current_lexeme); 004745 aa 6 00133 7261 00 lxl6 pr6|91 current_lexeme 004746 aa 5 77777 7611 16 lprp1 pr5|-1,6 lexed_function_lexemes_structure.lexed_function_lexeme_array 004747 aa 6 00136 2515 00 spri1 pr6|94 operator_ptr STATEMENT 1 ON LINE 1490 rs (current_parseme).semantics = null; 004750 aa 007120 2360 04 ldq 3664,ic 014070 = 007777000001 004751 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1491 if operator_ptr -> meaning_pointer = null then go to cant_get_stop_trace; 004752 aa 1 00003 1161 00 cmpq pr1|3 symbol_bead.meaning_pointer 004753 aa 776453 6000 04 tze -725,ic 003426 STATEMENT 1 ON LINE 1493 operator_ptr = operator_ptr -> meaning_pointer; 004754 aa 1 00003 7631 00 lprp3 pr1|3 symbol_bead.meaning_pointer 004755 aa 6 00136 2535 00 spri3 pr6|94 operator_ptr STATEMENT 1 ON LINE 1494 if ^operator_ptr -> general_bead.function then go to cant_get_stop_trace; 004756 aa 3 00000 2351 00 lda pr3|0 general_bead.function 004757 aa 040000 3150 03 cana 16384,du 004760 aa 776446 6000 04 tze -730,ic 003426 STATEMENT 1 ON LINE 1497 if temp_ptr -> operator_bead.op1 = stop_code then rs (current_parseme).semantics = operator_ptr -> function_bead.stop_control_pointer; 004761 aa 6 00150 3515 20 epp1 pr6|104,* temp_ptr 004762 aa 1 00001 2351 00 lda pr1|1 operator_bead.op1 004763 aa 000033 7350 00 als 27 004764 aa 000077 7330 00 lrs 63 004765 aa 6 00607 7561 00 stq pr6|391 operator_bead.op1 004766 aa 000144 1160 07 cmpq 100,dl 004767 aa 000004 6010 04 tnz 4,ic 004773 004770 aa 3 00004 2361 00 ldq pr3|4 function_bead.stop_control_pointer 004771 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics 004772 aa 000013 7100 04 tra 11,ic 005005 STATEMENT 1 ON LINE 1499 else if temp_ptr -> operator_bead.op1 = trace_code then rs (current_parseme).semantics = operator_ptr -> function_bead.trace_control_pointer; 004773 aa 000145 1160 07 cmpq 101,dl 004774 aa 000004 6010 04 tnz 4,ic 005000 004775 aa 3 00005 2361 00 ldq pr3|5 function_bead.trace_control_pointer 004776 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics 004777 aa 000006 7100 04 tra 6,ic 005005 STATEMENT 1 ON LINE 1501 else if temp_ptr -> operator_bead.op1 = assign_to_stop_code then rs (current_parseme).semantics = operator_ptr; 005000 aa 000160 1160 07 cmpq 112,dl 005001 aa 000003 6010 04 tnz 3,ic 005004 005002 aa 7 77776 5431 17 sprp3 pr7|-2,7 rs.semantics 005003 aa 000002 7100 04 tra 2,ic 005005 STATEMENT 1 ON LINE 1503 else rs (current_parseme).semantics = operator_ptr; 005004 aa 7 77776 5431 17 sprp3 pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1505 if rs (current_parseme).semantics = null then go to cant_get_stop_trace; 005005 aa 7 77776 2361 17 ldq pr7|-2,7 rs.semantics 005006 aa 007062 1160 04 cmpq 3634,ic 014070 = 007777000001 005007 aa 776417 6000 04 tze -753,ic 003426 STATEMENT 1 ON LINE 1508 rs (current_parseme).semantics -> general_bead.reference_count = rs (current_parseme).semantics -> general_bead.reference_count + 1; 005010 aa 7 77776 7651 17 lprp5 pr7|-2,7 rs.semantics 005011 aa 5 00001 0541 00 aos pr5|1 general_bead.reference_count STATEMENT 1 ON LINE 1511 go to operator_return (return_point); 005012 aa 6 00157 7251 00 lxl5 pr6|111 return_point 005013 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 1513 do_dyadic: print_final_value = "1"b; 005014 aa 400000 2350 03 lda 131072,du 005015 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 1515 operators_argument.where_error = start - 1; 005016 aa 6 00155 2361 00 ldq pr6|109 start 005017 aa 000001 1760 07 sbq 1,dl 005020 aa 6 00206 7561 00 stq pr6|134 operators_argument.where_error STATEMENT 1 ON LINE 1516 if ^rs (start - 1).bits.dyadic then go to improper_dyadic_usage; 005021 aa 6 00155 2361 00 ldq pr6|109 start 005022 aa 000001 1760 07 sbq 1,dl 005023 aa 000002 7360 00 qls 2 005024 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005025 aa 7 77775 2351 06 lda pr7|-3,ql rs.dyadic 005026 aa 040000 3150 03 cana 16384,du 005027 aa 776167 6000 04 tze -905,ic 003216 STATEMENT 1 ON LINE 1518 if rs (start - 1).bits.inner_product then go to do_inner_product; 005030 aa 7 77775 2351 06 lda pr7|-3,ql rs.inner_product 005031 aa 001000 3150 03 cana 512,du 005032 aa 6 00610 7561 00 stq pr6|392 005033 aa 001570 6010 04 tnz 888,ic 006623 STATEMENT 1 ON LINE 1520 go to dyadic_action (dyadic_table (rs (start - 1).bits.op1)); 005034 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 005035 aa 000033 7350 00 als 27 005036 aa 000077 7330 00 lrs 63 005037 ta 000230 7270 06 lxl7 152,ql 005040 ta 000063 7100 17 tra 51,7 STATEMENT 1 ON LINE 1522 dyadic_action (1): /* scalar dyadic operators */ call setup_dyadic_operator_routine_call; 005041 aa 003123 6700 04 tsp4 1619,ic 010164 STATEMENT 1 ON LINE 1524 call apl_dyadic_ (operators_argument); 005042 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 005043 aa 6 00544 2521 00 spri2 pr6|356 005044 aa 6 00542 6211 00 eax1 pr6|354 005045 aa 004000 4310 07 fld 2048,dl 005046 aa 6 00044 3701 20 epp4 pr6|36,* 005047 la 4 00036 3521 20 epp2 pr4|30,* apl_dyadic_ 005050 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1525 call finish_dyadic_operator_routine_call; 005051 aa 003160 6700 04 tsp4 1648,ic 010231 STATEMENT 1 ON LINE 1526 go to operator_return (return_point); 005052 aa 6 00157 7271 00 lxl7 pr6|111 return_point 005053 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1528 dyadic_action (2): /* (non-subscripted) assignment */ print_final_value = "0"b; 005054 aa 6 00161 4501 00 stz pr6|113 print_final_value STATEMENT 1 ON LINE 1531 if rs (start - 2).semantics = null /* rhs */ then go to value_error_s2; 005055 aa 6 00155 2361 00 ldq pr6|109 start 005056 aa 000002 7360 00 qls 2 005057 aa 000000 6260 06 eax6 0,ql 005060 aa 7 77766 2361 06 ldq pr7|-10,ql rs.semantics 005061 aa 007007 1160 04 cmpq 3591,ic 014070 = 007777000001 005062 aa 776101 6000 04 tze -959,ic 003163 STATEMENT 1 ON LINE 1534 if rs (start).semantics_valid /* lhs was pulled onto rs, but we don't */ then if ^rs (start).semantics_on_stack /* need it ... wash the ptr to it. */ then if rs (start).semantics ^= null then call decrement_reference_count (rs (start).semantics); 005063 aa 7 77775 2351 16 lda pr7|-3,6 rs.semantics_valid 005064 aa 004000 3150 03 cana 2048,du 005065 aa 000015 6000 04 tze 13,ic 005102 005066 aa 7 77775 2351 16 lda pr7|-3,6 rs.semantics_on_stack 005067 aa 000400 3150 03 cana 256,du 005070 aa 000012 6010 04 tnz 10,ic 005102 005071 aa 7 77776 2361 16 ldq pr7|-2,6 rs.semantics 005072 aa 006776 1160 04 cmpq 3582,ic 014070 = 007777000001 005073 aa 000007 6000 04 tze 7,ic 005102 005074 aa 7 77776 3521 16 epp2 pr7|-2,6 rs.semantics 005075 aa 6 00550 2521 00 spri2 pr6|360 005076 aa 6 00546 3521 00 epp2 pr6|358 005077 aa 004000 4310 07 fld 2048,dl 005100 aa 2 00000 7571 00 staq pr2|0 005101 aa 004474 6700 04 tsp4 2364,ic 011575 STATEMENT 1 ON LINE 1539 temp_ptr = lexed_function_bead_ptr -> lexed_function_bead.lexeme_array_ptr -> lexed_function_lexeme_array (rs (start).lexeme); 005102 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 005103 aa 7 00011 7671 00 lprp7 pr7|9 lexed_function_bead.lexeme_array_ptr 005104 aa 6 00155 2361 00 ldq pr6|109 start 005105 aa 000002 7360 00 qls 2 005106 aa 6 00126 3715 20 epp5 pr6|86,* rsp 005107 aa 5 77777 7271 06 lxl7 pr5|-1,ql rs.lexeme 005110 aa 7 77777 7631 17 lprp3 pr7|-1,7 lexed_function_lexemes_structure.lexed_function_lexeme_array 005111 aa 6 00150 2535 00 spri3 pr6|104 temp_ptr STATEMENT 1 ON LINE 1544 if ^temp_ptr -> general_bead.symbol /* lhs must be a symbol */ then go to bad_assignment; 005112 aa 3 00000 2351 00 lda pr3|0 general_bead.symbol 005113 aa 200000 3150 03 cana 65536,du 005114 aa 776143 6000 04 tze -925,ic 003257 STATEMENT 1 ON LINE 1547 if temp_ptr -> symbol_bead.meaning_pointer ^= null then if temp_ptr -> symbol_bead.meaning_pointer -> general_bead.label then go to bad_assign_to_label; 005115 aa 6 00607 7561 00 stq pr6|391 005116 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 005117 aa 006751 1160 04 cmpq 3561,ic 014070 = 007777000001 005120 aa 000005 6000 04 tze 5,ic 005125 005121 aa 3 00003 7611 00 lprp1 pr3|3 symbol_bead.meaning_pointer 005122 aa 1 00000 2351 00 lda pr1|0 general_bead.label 005123 aa 010000 3150 03 cana 4096,du 005124 aa 776144 6010 04 tnz -924,ic 003270 STATEMENT 1 ON LINE 1556 if ^rs (start - 2).semantics_on_stack /* if rhs on heap */ & ^rs (start - 2).semantics -> value_bead.label /* if rhs is not a label */ then do; 005125 aa 6 00607 7261 00 lxl6 pr6|391 005126 aa 5 77766 7611 16 lprp1 pr5|-10,6 rs.semantics 005127 aa 6 00155 2361 00 ldq pr6|109 start 005130 aa 000002 1760 07 sbq 2,dl 005131 aa 000002 7360 00 qls 2 005132 aa 5 77775 2351 06 lda pr5|-3,ql rs.semantics_on_stack 005133 aa 000400 3150 03 cana 256,du 005134 aa 6 00646 2515 00 spri1 pr6|422 005135 aa 000031 6010 04 tnz 25,ic 005166 005136 aa 1 00000 2351 00 lda pr1|0 value_bead.label 005137 aa 010000 3150 03 cana 4096,du 005140 aa 000026 6010 04 tnz 22,ic 005166 STATEMENT 1 ON LINE 1559 if temp_ptr -> symbol_bead.meaning_pointer ^= null then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 005141 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 005142 aa 006726 1160 04 cmpq 3542,ic 014070 = 007777000001 005143 aa 000007 6000 04 tze 7,ic 005152 005144 aa 3 00003 3521 00 epp2 pr3|3 symbol_bead.meaning_pointer 005145 aa 6 00550 2521 00 spri2 pr6|360 005146 aa 6 00546 3521 00 epp2 pr6|358 005147 aa 004000 4310 07 fld 2048,dl 005150 aa 2 00000 7571 00 staq pr2|0 005151 aa 004424 6700 04 tsp4 2324,ic 011575 STATEMENT 1 ON LINE 1563 rs (start - 2).semantics -> general_bead.reference_count = rs (start - 2).semantics -> general_bead.reference_count + 2; 005152 aa 6 00155 2361 00 ldq pr6|109 start 005153 aa 000002 7360 00 qls 2 005154 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005155 aa 7 77766 7671 06 lprp7 pr7|-10,ql rs.semantics 005156 aa 000000 6270 06 eax7 0,ql 005157 aa 000002 2360 07 ldq 2,dl 005160 aa 7 00001 0561 00 asq pr7|1 general_bead.reference_count STATEMENT 1 ON LINE 1566 temp_ptr -> symbol_bead.meaning_pointer = rs (start - 2).semantics; 005161 aa 6 00126 3715 20 epp5 pr6|86,* rsp 005162 aa 5 77766 2361 17 ldq pr5|-10,7 rs.semantics 005163 aa 6 00150 3535 20 epp3 pr6|104,* temp_ptr 005164 aa 3 00003 7561 00 stq pr3|3 symbol_bead.meaning_pointer STATEMENT 1 ON LINE 1568 end; 005165 aa 000140 7100 04 tra 96,ic 005325 STATEMENT 1 ON LINE 1570 else if temp_ptr -> symbol_bead.meaning_pointer ^= null /* lhs has meaning */ then if temp_ptr -> symbol_bead.meaning_pointer -> general_bead.reference_count = 1 & string (rs (start - 2).semantics -> general_bead.bead_type) = string (temp_ptr -> symbol_bead.meaning_pointer -> general_bead.bead_type) & substr (string (rs (start - 2).semantics -> general_bead.data_type), 1, 3) = substr (string (temp_ptr -> symbol_bead.meaning_pointer -> general_bead.data_type), 1, 3) & rs (start - 2).semantics -> value_bead.total_data_elements = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.total_data_elements & rs (start - 2).semantics -> value_bead.rhorho = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rhorho then do; 005166 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 005167 aa 006701 1160 04 cmpq 3521,ic 014070 = 007777000001 005170 aa 000075 6000 04 tze 61,ic 005265 005171 aa 3 00003 7671 00 lprp7 pr3|3 symbol_bead.meaning_pointer 005172 aa 7 00001 2361 00 ldq pr7|1 general_bead.reference_count 005173 aa 000001 1160 07 cmpq 1,dl 005174 aa 000071 6010 04 tnz 57,ic 005265 005175 aa 7 00000 2351 00 lda pr7|0 005176 aa 0 00020 3771 00 anaq pr0|16 = 776000000000 000000000000 005177 aa 6 00607 7551 00 sta pr6|391 005200 aa 1 00000 2351 00 lda pr1|0 005201 aa 0 00020 3771 00 anaq pr0|16 = 776000000000 000000000000 005202 aa 6 00607 1151 00 cmpa pr6|391 005203 aa 000062 6010 04 tnz 50,ic 005265 005204 aa 7 00000 2351 00 lda pr7|0 005205 aa 000010 7350 00 als 8 005206 aa 0 00006 3771 00 anaq pr0|6 = 700000000000 000000000000 005207 aa 6 00607 7551 00 sta pr6|391 005210 aa 1 00000 2351 00 lda pr1|0 005211 aa 000010 7350 00 als 8 005212 aa 0 00006 3771 00 anaq pr0|6 = 700000000000 000000000000 005213 aa 6 00607 1151 00 cmpa pr6|391 005214 aa 000051 6010 04 tnz 41,ic 005265 005215 aa 1 00002 2361 00 ldq pr1|2 value_bead.total_data_elements 005216 aa 7 00002 1161 00 cmpq pr7|2 value_bead.total_data_elements 005217 aa 000046 6010 04 tnz 38,ic 005265 005220 aa 1 00003 2361 00 ldq pr1|3 value_bead.rhorho 005221 aa 7 00003 1161 00 cmpq pr7|3 value_bead.rhorho 005222 aa 000043 6010 04 tnz 35,ic 005265 STATEMENT 1 ON LINE 1585 string (temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_type) = string (rs (start - 2).semantics -> value_bead.data_type); 005223 aa 1 00000 2351 00 lda pr1|0 005224 aa 7 00000 6751 00 era pr7|0 005225 aa 001760 3750 03 ana 1008,du 005226 aa 7 00000 6551 00 ersa pr7|0 STATEMENT 1 ON LINE 1588 data_elements = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.total_data_elements; 005227 aa 7 00002 2361 00 ldq pr7|2 value_bead.total_data_elements 005230 aa 6 00154 7561 00 stq pr6|108 data_elements STATEMENT 1 ON LINE 1590 if temp_ptr -> symbol_bead.meaning_pointer -> value_bead.character_value then temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_pointer -> character_string_overlay = rs (start - 2).semantics -> value_bead.data_pointer -> character_string_overlay; 005231 aa 7 00000 2351 00 lda pr7|0 value_bead.character_value 005232 aa 000400 3150 03 cana 256,du 005233 aa 6 00650 6535 00 spri7 pr6|424 005234 aa 000007 6000 04 tze 7,ic 005243 005235 aa 7 00004 7651 00 lprp5 pr7|4 value_bead.data_pointer 005236 aa 1 00004 7631 00 lprp3 pr1|4 value_bead.data_pointer 005237 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 005240 aa 3 00000 00 0006 desc9a pr3|0,ql character_string_overlay 005241 aa 5 00000 00 0006 desc9a pr5|0,ql character_string_overlay 005242 aa 000007 7100 04 tra 7,ic 005251 STATEMENT 1 ON LINE 1593 else temp_ptr -> symbol_bead.meaning_pointer -> value_bead.data_pointer -> numeric_datum (*) = rs (start - 2).semantics -> value_bead.data_pointer -> numeric_datum (*); 005243 aa 7 00004 7651 00 lprp5 pr7|4 value_bead.data_pointer 005244 aa 1 00004 7631 00 lprp3 pr1|4 value_bead.data_pointer 005245 aa 000003 7360 00 qls 3 005246 aa 000 140 100 540 mlr (pr,rl),(pr,rl),fill(000) 005247 aa 3 00000 00 0006 desc9a pr3|0,ql numeric_datum 005250 aa 5 00000 00 0006 desc9a pr5|0,ql numeric_datum STATEMENT 1 ON LINE 1596 if temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rhorho ^= 0 /* make check 'cause PL/I won't */ then temp_ptr -> symbol_bead.meaning_pointer -> value_bead.rho (*) = rs (start - 2).semantics -> value_bead.rho (*); 005251 aa 7 00003 2361 00 ldq pr7|3 value_bead.rhorho 005252 aa 000006 6000 04 tze 6,ic 005260 005253 aa 1 00003 2361 00 ldq pr1|3 value_bead.rhorho 005254 aa 000002 7360 00 qls 2 005255 aa 000 140 100 540 mlr (pr,rl),(pr,rl),fill(000) 005256 aa 1 00005 00 0006 desc9a pr1|5,ql value_bead.rho 005257 aa 7 00005 00 0006 desc9a pr7|5,ql value_bead.rho STATEMENT 1 ON LINE 1604 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count = 2; 005260 aa 000002 2360 07 ldq 2,dl 005261 aa 7 00001 7561 00 stq pr7|1 value_bead.reference_count STATEMENT 1 ON LINE 1605 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.label = "0"b; 005262 aa 006564 2350 04 lda 3444,ic 014046 = 767777777777 005263 aa 7 00000 3551 00 ansa pr7|0 value_bead.label STATEMENT 1 ON LINE 1606 end; 005264 aa 000041 7100 04 tra 33,ic 005325 STATEMENT 1 ON LINE 1610 else do; STATEMENT 1 ON LINE 1616 case_3: if temp_ptr -> symbol_bead.meaning_pointer ^= null /* drop old meaning */ then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 005265 aa 3 00003 2361 00 ldq pr3|3 symbol_bead.meaning_pointer 005266 aa 006602 1160 04 cmpq 3458,ic 014070 = 007777000001 005267 aa 000007 6000 04 tze 7,ic 005276 005270 aa 3 00003 3521 00 epp2 pr3|3 symbol_bead.meaning_pointer 005271 aa 6 00550 2521 00 spri2 pr6|360 005272 aa 6 00546 3521 00 epp2 pr6|358 005273 aa 004000 4310 07 fld 2048,dl 005274 aa 2 00000 7571 00 staq pr2|0 005275 aa 004300 6700 04 tsp4 2240,ic 011575 STATEMENT 1 ON LINE 1621 ws_info.dont_interrupt_parse = "0"b; 005276 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 005277 aa 7 00100 4501 00 stz pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 1622 call apl_copy_value_ (rs (start - 2).semantics, temp_ptr -> symbol_bead.meaning_pointer); 005300 aa 6 00155 2361 00 ldq pr6|109 start 005301 aa 000002 7360 00 qls 2 005302 aa 6 00126 3715 20 epp5 pr6|86,* rsp 005303 aa 5 77766 3521 06 epp2 pr5|-10,ql rs.semantics 005304 aa 6 00550 2521 00 spri2 pr6|360 005305 aa 6 00150 3535 20 epp3 pr6|104,* temp_ptr 005306 aa 3 00003 3521 00 epp2 pr3|3 symbol_bead.meaning_pointer 005307 aa 6 00552 2521 00 spri2 pr6|362 005310 aa 6 00546 6211 00 eax1 pr6|358 005311 aa 010000 4310 07 fld 4096,dl 005312 aa 6 00044 3701 20 epp4 pr6|36,* 005313 la 4 00230 3521 20 epp2 pr4|152,* apl_copy_value_ 005314 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1623 ws_info.dont_interrupt_parse = "1"b; 005315 aa 400000 2350 03 lda 131072,du 005316 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 005317 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 1624 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.label = "0"b; 005320 aa 6 00150 3715 20 epp5 pr6|104,* temp_ptr 005321 aa 5 00003 7651 00 lprp5 pr5|3 symbol_bead.meaning_pointer 005322 aa 006524 2350 04 lda 3412,ic 014046 = 767777777777 005323 aa 5 00000 3551 00 ansa pr5|0 value_bead.label STATEMENT 1 ON LINE 1625 temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count = temp_ptr -> symbol_bead.meaning_pointer -> value_bead.reference_count + 1; 005324 aa 5 00001 0541 00 aos pr5|1 value_bead.reference_count STATEMENT 1 ON LINE 1627 end; STATEMENT 1 ON LINE 1629 if rs (start - 2).semantics_on_stack then ws_info.value_stack_ptr = rs (start - 2).semantics; 005325 aa 6 00155 2361 00 ldq pr6|109 start 005326 aa 000002 1760 07 sbq 2,dl 005327 aa 000002 7360 00 qls 2 005330 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005331 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_on_stack 005332 aa 000400 3150 03 cana 256,du 005333 aa 000007 6000 04 tze 7,ic 005342 005334 aa 6 00155 2361 00 ldq pr6|109 start 005335 aa 000002 7360 00 qls 2 005336 aa 7 77766 2361 06 ldq pr7|-10,ql rs.semantics 005337 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 005340 aa 5 00016 7561 00 stq pr5|14 ws_info.value_stack_ptr 005341 aa 000011 7100 04 tra 9,ic 005352 STATEMENT 1 ON LINE 1631 else call decrement_reference_count (rs (start - 2).semantics); 005342 aa 6 00155 2361 00 ldq pr6|109 start 005343 aa 000002 7360 00 qls 2 005344 aa 7 77766 3521 06 epp2 pr7|-10,ql rs.semantics 005345 aa 6 00550 2521 00 spri2 pr6|360 005346 aa 6 00546 3521 00 epp2 pr6|358 005347 aa 004000 4310 07 fld 2048,dl 005350 aa 2 00000 7571 00 staq pr2|0 005351 aa 004224 6700 04 tsp4 2196,ic 011575 STATEMENT 1 ON LINE 1634 rs (put_result).semantics = temp_ptr -> symbol_bead.meaning_pointer; 005352 aa 6 00156 2361 00 ldq pr6|110 put_result 005353 aa 000002 7360 00 qls 2 005354 aa 6 00150 3735 20 epp7 pr6|104,* temp_ptr 005355 aa 000000 6270 06 eax7 0,ql 005356 aa 7 00003 2361 00 ldq pr7|3 symbol_bead.meaning_pointer 005357 aa 6 00126 3715 20 epp5 pr6|86,* rsp 005360 aa 5 77776 7561 17 stq pr5|-2,7 rs.semantics STATEMENT 1 ON LINE 1635 unspec (rs (put_result).bits) = value_bits; 005361 aa 004000 2350 03 lda 2048,du 005362 aa 5 77775 7551 17 sta pr5|-3,7 STATEMENT 1 ON LINE 1636 go to operator_return (return_point); 005363 aa 6 00157 7261 00 lxl6 pr6|111 return_point 005364 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1638 dyadic_action (3): /* dyadic epsilon */ call setup_dyadic_operator_routine_call; 005365 aa 002577 6700 04 tsp4 1407,ic 010164 STATEMENT 1 ON LINE 1640 call apl_dyadic_epsilon_ (operators_argument); 005366 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 005367 aa 6 00544 2521 00 spri2 pr6|356 005370 aa 6 00542 6211 00 eax1 pr6|354 005371 aa 004000 4310 07 fld 2048,dl 005372 aa 6 00044 3701 20 epp4 pr6|36,* 005373 la 4 00232 3521 20 epp2 pr4|154,* apl_dyadic_epsilon_ 005374 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1641 call finish_dyadic_operator_routine_call; 005375 aa 002634 6700 04 tsp4 1436,ic 010231 STATEMENT 1 ON LINE 1642 go to operator_return (return_point); 005376 aa 6 00157 7271 00 lxl7 pr6|111 return_point 005377 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1644 dyadic_action (4): /* index */ call setup_dyadic_operator_routine_call; 005400 aa 002564 6700 04 tsp4 1396,ic 010164 STATEMENT 1 ON LINE 1646 call apl_dyadic_iota_ (operators_argument); 005401 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 005402 aa 6 00544 2521 00 spri2 pr6|356 005403 aa 6 00542 6211 00 eax1 pr6|354 005404 aa 004000 4310 07 fld 2048,dl 005405 aa 6 00044 3701 20 epp4 pr6|36,* 005406 la 4 00254 3521 20 epp2 pr4|172,* apl_dyadic_iota_ 005407 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1647 call finish_dyadic_operator_routine_call; 005410 aa 002621 6700 04 tsp4 1425,ic 010231 STATEMENT 1 ON LINE 1648 go to operator_return (return_point); 005411 aa 6 00157 7271 00 lxl7 pr6|111 return_point 005412 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1650 dyadic_action (5): /* invoke dyadic function */ number_of_arguments = 2; 005413 aa 000002 2360 07 ldq 2,dl 005414 aa 6 00160 7561 00 stq pr6|112 number_of_arguments STATEMENT 1 ON LINE 1653 if ^rs (start - 2).semantics_valid then call value_error_reporter (start - 2); 005415 aa 6 00155 2361 00 ldq pr6|109 start 005416 aa 000002 1760 07 sbq 2,dl 005417 aa 000002 7360 00 qls 2 005420 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 005421 aa 004000 3150 03 cana 2048,du 005422 aa 000006 6010 04 tnz 6,ic 005430 005423 aa 6 00155 2361 00 ldq pr6|109 start 005424 aa 000002 1760 07 sbq 2,dl 005425 aa 6 00607 7561 00 stq pr6|391 005426 aa 006414 3520 04 epp2 3340,ic 014042 = 000002000000 005427 aa 004361 6700 04 tsp4 2289,ic 012010 STATEMENT 1 ON LINE 1655 if rs (start - 2).semantics = null then call value_error_reporter (start - 2); 005430 aa 6 00155 2361 00 ldq pr6|109 start 005431 aa 000002 7360 00 qls 2 005432 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005433 aa 7 77766 2361 06 ldq pr7|-10,ql rs.semantics 005434 aa 006434 1160 04 cmpq 3356,ic 014070 = 007777000001 005435 aa 000006 6010 04 tnz 6,ic 005443 005436 aa 6 00155 2361 00 ldq pr6|109 start 005437 aa 000002 1760 07 sbq 2,dl 005440 aa 6 00607 7561 00 stq pr6|391 005441 aa 006401 3520 04 epp2 3329,ic 014042 = 000002000000 005442 aa 004346 6700 04 tsp4 2278,ic 012010 STATEMENT 1 ON LINE 1657 if ^rs (start).semantics_valid then call value_error_reporter (start); 005443 aa 6 00155 2361 00 ldq pr6|109 start 005444 aa 000002 7360 00 qls 2 005445 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005446 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 005447 aa 004000 3150 03 cana 2048,du 005450 aa 000003 6010 04 tnz 3,ic 005453 005451 aa 006365 3520 04 epp2 3317,ic 014036 = 000002000000 005452 aa 004336 6700 04 tsp4 2270,ic 012010 STATEMENT 1 ON LINE 1659 if rs (start).semantics = null then call value_error_reporter (start); 005453 aa 6 00155 2361 00 ldq pr6|109 start 005454 aa 000002 7360 00 qls 2 005455 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005456 aa 7 77776 2361 06 ldq pr7|-2,ql rs.semantics 005457 aa 006411 1160 04 cmpq 3337,ic 014070 = 007777000001 005460 aa 000003 6010 04 tnz 3,ic 005463 005461 aa 006355 3520 04 epp2 3309,ic 014036 = 000002000000 005462 aa 004326 6700 04 tsp4 2262,ic 012010 STATEMENT 1 ON LINE 1662 invoke_niladic_function: invoke_monadic_function: temp_ptr = rs (start - number_of_arguments + 1).semantics; 005463 aa 6 00155 2361 00 ldq pr6|109 start 005464 aa 6 00160 1761 00 sbq pr6|112 number_of_arguments 005465 aa 000002 7360 00 qls 2 005466 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005467 aa 7 00002 7671 06 lprp7 pr7|2,ql rs.semantics 005470 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1666 if temp_ptr -> function_bead.class > 1 then go to invoke_external_function; 005471 aa 6 00607 7561 00 stq pr6|391 005472 aa 7 00003 2361 00 ldq pr7|3 function_bead.class 005473 aa 000001 1160 07 cmpq 1,dl 005474 aa 000215 6054 04 tpnz 141,ic 005711 STATEMENT 1 ON LINE 1669 temp_ptr = temp_ptr -> function_bead.lexed_function_bead_pointer; 005475 aa 7 00002 7651 00 lprp5 pr7|2 function_bead.lexed_function_bead_pointer 005476 aa 6 00150 6515 00 spri5 pr6|104 temp_ptr STATEMENT 1 ON LINE 1671 if number_of_arguments = 2 then if ^temp_ptr -> lexed_function_bead.bits_for_parse.dyadic then go to improper_dyadic_usage; 005477 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 005500 aa 000002 1160 07 cmpq 2,dl 005501 aa 000005 6010 04 tnz 5,ic 005506 005502 aa 5 00003 2351 00 lda pr5|3 lexed_function_bead.dyadic 005503 aa 040000 3150 03 cana 16384,du 005504 aa 775512 6000 04 tze -1206,ic 003216 STATEMENT 1 ON LINE 1674 else ; 005505 aa 000012 7100 04 tra 10,ic 005517 STATEMENT 1 ON LINE 1675 else if number_of_arguments = 1 then if ^temp_ptr -> lexed_function_bead.bits_for_parse.monadic then go to improper_monadic_usage; 005506 aa 000001 1160 07 cmpq 1,dl 005507 aa 000005 6010 04 tnz 5,ic 005514 005510 aa 5 00003 2351 00 lda pr5|3 lexed_function_bead.monadic 005511 aa 020000 3150 03 cana 8192,du 005512 aa 775515 6000 04 tze -1203,ic 003227 STATEMENT 1 ON LINE 1678 else ; 005513 aa 000004 7100 04 tra 4,ic 005517 STATEMENT 1 ON LINE 1679 else if temp_ptr -> lexed_function_bead.bits_for_parse.monadic | temp_ptr -> lexed_function_bead.bits_for_parse.dyadic then go to improper_niladic_usage; 005514 aa 5 00003 2351 00 lda pr5|3 lexed_function_bead.dyadic 005515 aa 060000 3150 03 cana 24576,du 005516 aa 775522 6010 04 tnz -1198,ic 003240 STATEMENT 1 ON LINE 1683 call save_state; 005517 aa 004173 6700 04 tsp4 2171,ic 011712 STATEMENT 1 ON LINE 1684 call push_new_frame; 005520 aa 004300 6700 04 tsp4 2240,ic 012020 STATEMENT 1 ON LINE 1688 parse_frame.parse_frame_type = function_frame_type; 005521 aa 000002 2360 07 ldq 2,dl 005522 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 005523 aa 7 00001 7561 00 stq pr7|1 parse_frame.parse_frame_type STATEMENT 1 ON LINE 1689 parse_frame.current_line_number = 1; 005524 aa 000001 2360 07 ldq 1,dl 005525 aa 7 00007 7561 00 stq pr7|7 parse_frame.current_line_number STATEMENT 1 ON LINE 1690 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 005526 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 005527 aa 5 00016 2361 00 ldq pr5|14 ws_info.value_stack_ptr 005530 aa 7 00013 7561 00 stq pr7|11 parse_frame.initial_value_stack_ptr STATEMENT 1 ON LINE 1692 parse_frame.function_bead_ptr = rs (start - number_of_arguments + 1).semantics; 005531 aa 6 00155 2361 00 ldq pr6|109 start 005532 aa 6 00160 1761 00 sbq pr6|112 number_of_arguments 005533 aa 000002 7360 00 qls 2 005534 aa 6 00126 3535 20 epp3 pr6|86,* rsp 005535 aa 3 00002 2361 06 ldq pr3|2,ql rs.semantics 005536 aa 7 00002 7561 00 stq pr7|2 parse_frame.function_bead_ptr STATEMENT 1 ON LINE 1693 lexed_function_bead_ptr, parse_frame.lexed_function_bead_ptr = parse_frame.function_bead_ptr -> function_bead.lexed_function_bead_pointer; 005537 aa 7 00002 7611 00 lprp1 pr7|2 parse_frame.function_bead_ptr 005540 aa 1 00002 7651 00 lprp5 pr1|2 function_bead.lexed_function_bead_pointer 005541 aa 6 00134 6515 00 spri5 pr6|92 lexed_function_bead_ptr 005542 aa 7 00003 5451 00 sprp5 pr7|3 parse_frame.lexed_function_bead_ptr STATEMENT 1 ON LINE 1696 lexed_function_bead_ptr -> general_bead.reference_count = lexed_function_bead_ptr -> general_bead.reference_count + 1; 005543 aa 6 00134 3515 20 epp1 pr6|92,* lexed_function_bead_ptr 005544 aa 1 00001 0541 00 aos pr1|1 general_bead.reference_count STATEMENT 1 ON LINE 1701 parse_frame.number_of_ptrs, number_of_ptrs = lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 005545 aa 1 00005 2361 00 ldq pr1|5 lexed_function_bead.number_of_localized_symbols 005546 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 005547 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 1703 do i = 1 to lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 005550 aa 1 00005 2361 00 ldq pr1|5 lexed_function_bead.number_of_localized_symbols 005551 aa 6 00212 7561 00 stq pr6|138 005552 aa 000001 2360 07 ldq 1,dl 005553 aa 6 00165 7561 00 stq pr6|117 i 005554 aa 6 00165 2361 00 ldq pr6|117 i 005555 aa 6 00212 1161 00 cmpq pr6|138 005556 aa 000037 6054 04 tpnz 31,ic 005615 STATEMENT 1 ON LINE 1704 temp_ptr = lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (i); 005557 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 005560 aa 7 00011 7671 06 lprp7 pr7|9,ql lexed_function_bead.localized_symbols 005561 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1705 if temp_ptr ^= null then if temp_ptr -> general_bead.symbol then do; 005562 aa 6 00150 2371 00 ldaq pr6|104 temp_ptr 005563 aa 773103 6770 04 eraq -2493,ic 000666 = 077777000043 000001000000 005564 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 005565 aa 000022 6000 04 tze 18,ic 005607 005566 aa 7 00000 2351 00 lda pr7|0 general_bead.symbol 005567 aa 200000 3150 03 cana 65536,du 005570 aa 000010 6000 04 tze 8,ic 005600 STATEMENT 1 ON LINE 1708 parse_frame.old_meaning_ptrs (i) = temp_ptr -> symbol_bead.meaning_pointer; 005571 aa 7 00003 2361 00 ldq pr7|3 symbol_bead.meaning_pointer 005572 aa 6 00165 7271 00 lxl7 pr6|117 i 005573 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 005574 aa 5 00014 7561 17 stq pr5|12,7 parse_frame.old_meaning_ptrs STATEMENT 1 ON LINE 1709 temp_ptr -> symbol_bead.meaning_pointer = null; 005575 aa 006273 2360 04 ldq 3259,ic 014070 = 007777000001 005576 aa 7 00003 7561 00 stq pr7|3 symbol_bead.meaning_pointer STATEMENT 1 ON LINE 1710 end; 005577 aa 000014 7100 04 tra 12,ic 005613 STATEMENT 1 ON LINE 1711 else do; STATEMENT 1 ON LINE 1712 parse_frame.old_meaning_ptrs (i) = save_system_variable_value (temp_ptr); 005600 aa 006230 3520 04 epp2 3224,ic 014030 = 000004000000 005601 aa 002673 6700 04 tsp4 1467,ic 010474 005602 aa 6 00650 3735 20 epp7 pr6|424,* 005603 aa 6 00165 7271 00 lxl7 pr6|117 i 005604 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 005605 aa 5 00014 5471 17 sprp7 pr5|12,7 parse_frame.old_meaning_ptrs STATEMENT 1 ON LINE 1713 end; 005606 aa 000005 7100 04 tra 5,ic 005613 STATEMENT 1 ON LINE 1714 else parse_frame.old_meaning_ptrs (i) = null; 005607 aa 006261 2360 04 ldq 3249,ic 014070 = 007777000001 005610 aa 6 00165 7271 00 lxl7 pr6|117 i 005611 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 005612 aa 5 00014 7561 17 stq pr5|12,7 parse_frame.old_meaning_ptrs STATEMENT 1 ON LINE 1715 end; 005613 aa 6 00165 0541 00 aos pr6|117 i 005614 aa 777740 7100 04 tra -32,ic 005554 STATEMENT 1 ON LINE 1717 number_of_non_labels = lexed_function_bead_ptr -> number_of_localized_symbols - lexed_function_bead_ptr -> number_of_labels; 005615 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 005616 aa 7 00005 2361 00 ldq pr7|5 lexed_function_bead.number_of_localized_symbols 005617 aa 7 00006 1761 00 sbq pr7|6 lexed_function_bead.number_of_labels 005620 aa 6 00173 7561 00 stq pr6|123 number_of_non_labels STATEMENT 1 ON LINE 1720 do i = lexed_function_bead_ptr -> number_of_localized_symbols to number_of_non_labels + 1 by -1; 005621 aa 000001 0760 07 adq 1,dl 005622 aa 6 00213 7561 00 stq pr6|139 005623 aa 7 00005 2361 00 ldq pr7|5 lexed_function_bead.number_of_localized_symbols 005624 aa 6 00165 7561 00 stq pr6|117 i 005625 aa 000000 0110 03 nop 0,du 005626 aa 6 00165 2361 00 ldq pr6|117 i 005627 aa 6 00213 1161 00 cmpq pr6|139 005630 aa 000016 6040 04 tmi 14,ic 005646 STATEMENT 1 ON LINE 1721 temp_ptr = lexed_function_bead_ptr -> localized_symbols (i); 005631 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 005632 aa 7 00011 7671 06 lprp7 pr7|9,ql lexed_function_bead.localized_symbols 005633 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1722 temp_ptr -> meaning_pointer = lexed_function_bead_ptr -> label_values_ptr -> lexed_function_label_values (i - number_of_non_labels); 005634 aa 6 00134 3715 20 epp5 pr6|92,* lexed_function_bead_ptr 005635 aa 5 00007 7651 00 lprp5 pr5|7 lexed_function_bead.label_values_ptr 005636 aa 6 00173 1761 00 sbq pr6|123 number_of_non_labels 005637 aa 5 77777 2361 06 ldq pr5|-1,ql lexed_function_label_values_structure.lexed_function_label_values 005640 aa 7 00003 7561 00 stq pr7|3 symbol_bead.meaning_pointer STATEMENT 1 ON LINE 1724 temp_ptr -> meaning_pointer -> general_bead.reference_count = temp_ptr -> meaning_pointer -> general_bead.reference_count + 1; 005641 aa 7 00003 7631 00 lprp3 pr7|3 symbol_bead.meaning_pointer 005642 aa 3 00001 0541 00 aos pr3|1 general_bead.reference_count STATEMENT 1 ON LINE 1726 end; 005643 aa 000001 3360 07 lcq 1,dl 005644 aa 6 00165 0561 00 asq pr6|117 i 005645 aa 777761 7100 04 tra -15,ic 005626 STATEMENT 1 ON LINE 1730 temp_ptr = rsp; 005646 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005647 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 1731 rsp, reduction_stack_ptr = addrel (parse_frame_ptr, size (parse_frame)); 005650 aa 6 00207 2361 00 ldq pr6|135 number_of_ptrs 005651 aa 000015 0760 07 adq 13,dl 005652 aa 6 00122 3521 66 epp2 pr6|82,*ql parse_frame_ptr 005653 aa 000000 0520 03 adwp2 0,du 005654 aa 6 00646 2521 00 spri2 pr6|422 005655 aa 6 00126 2521 00 spri2 pr6|86 rsp 005656 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 005657 aa 7 00004 5421 00 sprp2 pr7|4 parse_frame.reduction_stack_ptr STATEMENT 1 ON LINE 1733 if number_of_arguments = 2 then do; 005660 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 005661 aa 000002 1160 07 cmpq 2,dl 005662 aa 000015 6010 04 tnz 13,ic 005677 STATEMENT 1 ON LINE 1735 call fill_in_arguments (temp_ptr, start - 2, (RightArgSymbol)); 005663 aa 6 00155 2361 00 ldq pr6|109 start 005664 aa 000002 1760 07 sbq 2,dl 005665 aa 6 00610 7561 00 stq pr6|392 005666 aa 000003 2360 07 ldq 3,dl 005667 aa 6 00611 7561 00 stq pr6|393 005670 aa 006130 3520 04 epp2 3160,ic 014020 = 000006000000 005671 aa 005266 6700 04 tsp4 2742,ic 013157 STATEMENT 1 ON LINE 1736 call fill_in_arguments (temp_ptr, start, (LeftArgSymbol)); 005672 aa 000002 2360 07 ldq 2,dl 005673 aa 6 00611 7561 00 stq pr6|393 005674 aa 006114 3520 04 epp2 3148,ic 014010 = 000006000000 005675 aa 005262 6700 04 tsp4 2738,ic 013157 STATEMENT 1 ON LINE 1737 end; 005676 aa 773260 7100 04 tra -2384,ic 001156 STATEMENT 1 ON LINE 1738 else if number_of_arguments = 1 then call fill_in_arguments (temp_ptr, start - 1, (RightArgSymbol)); 005677 aa 000001 1160 07 cmpq 1,dl 005700 aa 773256 6010 04 tnz -2386,ic 001156 005701 aa 6 00155 2361 00 ldq pr6|109 start 005702 aa 000001 1760 07 sbq 1,dl 005703 aa 6 00611 7561 00 stq pr6|393 005704 aa 000003 2360 07 ldq 3,dl 005705 aa 6 00610 7561 00 stq pr6|392 005706 aa 006072 3520 04 epp2 3130,ic 014000 = 000006000000 005707 aa 005250 6700 04 tsp4 2728,ic 013157 STATEMENT 1 ON LINE 1741 go to start_line; 005710 aa 773246 7100 04 tra -2394,ic 001156 STATEMENT 1 ON LINE 1743 invoke_external_function: external_function_ptr = rs (start - number_of_arguments + 1).semantics; 005711 aa 6 00607 7271 00 lxl7 pr6|391 005712 aa 6 00126 3715 20 epp5 pr6|86,* rsp 005713 aa 5 00002 7651 17 lprp5 pr5|2,7 rs.semantics 005714 aa 6 00144 6515 00 spri5 pr6|100 external_function_ptr STATEMENT 1 ON LINE 1746 if number_of_arguments + 2 ^= external_function_ptr -> function_bead.class then go to context_error_0; 005715 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 005716 aa 000002 0760 07 adq 2,dl 005717 aa 5 00003 1161 00 cmpq pr5|3 function_bead.class 005720 aa 775211 6010 04 tnz -1399,ic 003131 STATEMENT 1 ON LINE 1749 operators_argument.result = null; 005721 aa 006147 2360 04 ldq 3175,ic 014070 = 007777000001 005722 aa 6 00204 7561 00 stq pr6|132 operators_argument.result STATEMENT 1 ON LINE 1751 if number_of_arguments = 0 then do; 005723 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 005724 aa 000014 6010 04 tnz 12,ic 005740 STATEMENT 1 ON LINE 1753 operators_argument.value (1) = null; 005725 aa 006143 2360 04 ldq 3171,ic 014070 = 007777000001 005726 aa 6 00176 7561 00 stq pr6|126 operators_argument.value STATEMENT 1 ON LINE 1754 operators_argument.value (2) = null; 005727 aa 6 00200 7561 00 stq pr6|128 operators_argument.value STATEMENT 1 ON LINE 1755 operators_argument.on_stack (1) = "0"b; 005730 aa 6 00177 4501 00 stz pr6|127 operators_argument.on_stack STATEMENT 1 ON LINE 1756 operators_argument.on_stack (2) = "0"b; 005731 aa 6 00201 4501 00 stz pr6|129 operators_argument.on_stack STATEMENT 1 ON LINE 1757 operators_argument.error_code = 0; 005732 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1758 dont_interrupt_parse = "0"b; 005733 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 005734 aa 3 00100 4501 00 stz pr3|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 1759 if dirty_interrupt_pending then go to dirty_stop; 005735 aa 3 00107 2351 00 lda pr3|71 ws_info.dirty_interrupt_pending 005736 aa 775510 6010 04 tnz -1208,ic 003446 STATEMENT 1 ON LINE 1761 end; 005737 aa 000006 7100 04 tra 6,ic 005745 STATEMENT 1 ON LINE 1762 else if number_of_arguments = 1 then call setup_monadic_operator_routine_call; 005740 aa 000001 1160 07 cmpq 1,dl 005741 aa 000003 6010 04 tnz 3,ic 005744 005742 aa 002336 6700 04 tsp4 1246,ic 010300 005743 aa 000002 7100 04 tra 2,ic 005745 STATEMENT 1 ON LINE 1764 else call setup_dyadic_operator_routine_call; 005744 aa 002220 6700 04 tsp4 1168,ic 010164 STATEMENT 1 ON LINE 1766 call cu_$ptr_call ((external_function_ptr -> function_bead.lexed_function_bead_pointer), operators_argument); 005745 aa 6 00144 3735 20 epp7 pr6|100,* external_function_ptr 005746 aa 7 00002 7671 00 lprp7 pr7|2 function_bead.lexed_function_bead_pointer 005747 aa 6 00646 6535 00 spri7 pr6|422 005750 aa 6 00646 3521 00 epp2 pr6|422 005751 aa 6 00550 2521 00 spri2 pr6|360 005752 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 005753 aa 6 00552 2521 00 spri2 pr6|362 005754 aa 6 00546 6211 00 eax1 pr6|358 005755 aa 010000 4310 07 fld 4096,dl 005756 aa 6 00044 3701 20 epp4 pr6|36,* 005757 la 4 00020 3521 20 epp2 pr4|16,* cu_$ptr_call 005760 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1767 call decrement_reference_count (rs (start - number_of_arguments + 1).semantics); 005761 aa 6 00155 2361 00 ldq pr6|109 start 005762 aa 6 00160 1761 00 sbq pr6|112 number_of_arguments 005763 aa 000002 7360 00 qls 2 005764 aa 6 00126 3735 20 epp7 pr6|86,* rsp 005765 aa 7 00002 3521 06 epp2 pr7|2,ql rs.semantics 005766 aa 6 00550 2521 00 spri2 pr6|360 005767 aa 6 00546 3521 00 epp2 pr6|358 005770 aa 004000 4310 07 fld 2048,dl 005771 aa 2 00000 7571 00 staq pr2|0 005772 aa 003603 6700 04 tsp4 1923,ic 011575 STATEMENT 1 ON LINE 1769 if number_of_arguments = 0 then do; 005773 aa 6 00160 2361 00 ldq pr6|112 number_of_arguments 005774 aa 000017 6010 04 tnz 15,ic 006013 STATEMENT 1 ON LINE 1771 if operators_argument.error_code ^= 0 then go to report_error_from_operator; 005775 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 005776 aa 775475 6010 04 tnz -1219,ic 003473 STATEMENT 1 ON LINE 1774 dont_interrupt_parse = "1"b; 005777 aa 400000 2350 03 lda 131072,du 006000 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 006001 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 1775 rs (put_result).semantics = operators_argument.result; 006002 aa 6 00156 2361 00 ldq pr6|110 put_result 006003 aa 000002 7360 00 qls 2 006004 aa 000000 6270 06 eax7 0,ql 006005 aa 6 00204 2361 00 ldq pr6|132 operators_argument.result 006006 aa 6 00126 3715 20 epp5 pr6|86,* rsp 006007 aa 5 77776 7561 17 stq pr5|-2,7 rs.semantics STATEMENT 1 ON LINE 1776 unspec (rs (put_result).bits) = computed_value_bits; 006010 aa 004400 2350 03 lda 2304,du 006011 aa 5 77775 7551 17 sta pr5|-3,7 STATEMENT 1 ON LINE 1777 end; 006012 aa 000006 7100 04 tra 6,ic 006020 STATEMENT 1 ON LINE 1778 else if number_of_arguments = 1 then call finish_monadic_operator_routine_call; 006013 aa 000001 1160 07 cmpq 1,dl 006014 aa 000003 6010 04 tnz 3,ic 006017 006015 aa 002317 6700 04 tsp4 1231,ic 010334 006016 aa 000002 7100 04 tra 2,ic 006020 STATEMENT 1 ON LINE 1780 else call finish_dyadic_operator_routine_call; 006017 aa 002212 6700 04 tsp4 1162,ic 010231 STATEMENT 1 ON LINE 1782 rs (put_result).type = val_type; 006020 aa 6 00156 2361 00 ldq pr6|110 put_result 006021 aa 000002 7360 00 qls 2 006022 aa 000000 6270 06 eax7 0,ql 006023 aa 000002 2360 07 ldq 2,dl 006024 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006025 aa 7 77774 7561 17 stq pr7|-4,7 rs.type STATEMENT 1 ON LINE 1783 go to operator_return (return_point); 006026 aa 6 00157 7261 00 lxl6 pr6|111 return_point 006027 ta 777777 7100 16 tra -1,6 STATEMENT 1 ON LINE 1785 dyadic_action (6): /* catenate */ call setup_dyadic_operator_routine_call; 006030 aa 002134 6700 04 tsp4 1116,ic 010164 STATEMENT 1 ON LINE 1788 if rs (start - 1).bits.semantics_valid then operators_argument.dimension = rs_for_op (start - 1).semantics; 006031 aa 6 00155 2361 00 ldq pr6|109 start 006032 aa 000001 1760 07 sbq 1,dl 006033 aa 000002 7360 00 qls 2 006034 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006035 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006036 aa 004000 3150 03 cana 2048,du 006037 aa 000006 6000 04 tze 6,ic 006045 006040 aa 6 00155 2361 00 ldq pr6|109 start 006041 aa 000002 7360 00 qls 2 006042 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006043 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 006044 aa 000012 7100 04 tra 10,ic 006056 STATEMENT 1 ON LINE 1790 else operators_argument.dimension = max (rs (start).semantics -> value_bead.rhorho, rs (start - 2).semantics -> value_bead.rhorho); 006045 aa 6 00155 2361 00 ldq pr6|109 start 006046 aa 000002 7360 00 qls 2 006047 aa 7 77776 7651 06 lprp5 pr7|-2,ql rs.semantics 006050 aa 7 77766 7631 06 lprp3 pr7|-10,ql rs.semantics 006051 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 006052 aa 3 00003 1161 00 cmpq pr3|3 value_bead.rhorho 006053 aa 000002 6050 04 tpl 2,ic 006055 006054 aa 3 00003 2361 00 ldq pr3|3 value_bead.rhorho 006055 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1793 join_catenate: call apl_catenate_ (operators_argument); 006056 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006057 aa 6 00544 2521 00 spri2 pr6|356 006060 aa 6 00542 6211 00 eax1 pr6|354 006061 aa 004000 4310 07 fld 2048,dl 006062 aa 6 00044 3701 20 epp4 pr6|36,* 006063 la 4 00264 3521 20 epp2 pr4|180,* apl_catenate_ 006064 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1795 call finish_dyadic_operator_routine_call; 006065 aa 002144 6700 04 tsp4 1124,ic 010231 STATEMENT 1 ON LINE 1796 go to operator_return (return_point); 006066 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006067 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1798 dyadic_action (7): /* compression last */ call setup_dyadic_operator_routine_call; 006070 aa 002074 6700 04 tsp4 1084,ic 010164 STATEMENT 1 ON LINE 1800 operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 006071 aa 6 00155 2361 00 ldq pr6|109 start 006072 aa 000002 7360 00 qls 2 006073 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006074 aa 7 77766 7671 06 lprp7 pr7|-10,ql rs.semantics 006075 aa 7 00003 2361 00 ldq pr7|3 value_bead.rhorho 006076 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1802 join_compression: if rs (start - 1).semantics_valid then operators_argument.dimension = rs_for_op (start - 1).semantics; 006077 aa 6 00155 2361 00 ldq pr6|109 start 006100 aa 000001 1760 07 sbq 1,dl 006101 aa 000002 7360 00 qls 2 006102 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006103 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006104 aa 004000 3150 03 cana 2048,du 006105 aa 000005 6000 04 tze 5,ic 006112 006106 aa 6 00155 2361 00 ldq pr6|109 start 006107 aa 000002 7360 00 qls 2 006110 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006111 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1806 call apl_compression_ (operators_argument); 006112 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006113 aa 6 00544 2521 00 spri2 pr6|356 006114 aa 6 00542 6211 00 eax1 pr6|354 006115 aa 004000 4310 07 fld 2048,dl 006116 aa 6 00044 3701 20 epp4 pr6|36,* 006117 la 4 00274 3521 20 epp2 pr4|188,* apl_compression_ 006120 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1807 call finish_dyadic_operator_routine_call; 006121 aa 002110 6700 04 tsp4 1096,ic 010231 STATEMENT 1 ON LINE 1808 go to operator_return (return_point); 006122 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006123 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1810 dyadic_action (8): /* expansion last */ call setup_dyadic_operator_routine_call; 006124 aa 002040 6700 04 tsp4 1056,ic 010164 STATEMENT 1 ON LINE 1812 operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 006125 aa 6 00155 2361 00 ldq pr6|109 start 006126 aa 000002 7360 00 qls 2 006127 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006130 aa 7 77766 7671 06 lprp7 pr7|-10,ql rs.semantics 006131 aa 7 00003 2361 00 ldq pr7|3 value_bead.rhorho 006132 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1814 join_expansion: if rs (start - 1).semantics_valid then operators_argument.dimension = rs_for_op (start - 1).semantics; 006133 aa 6 00155 2361 00 ldq pr6|109 start 006134 aa 000001 1760 07 sbq 1,dl 006135 aa 000002 7360 00 qls 2 006136 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006137 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006140 aa 004000 3150 03 cana 2048,du 006141 aa 000005 6000 04 tze 5,ic 006146 006142 aa 6 00155 2361 00 ldq pr6|109 start 006143 aa 000002 7360 00 qls 2 006144 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006145 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1818 call apl_expansion_ (operators_argument); 006146 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006147 aa 6 00544 2521 00 spri2 pr6|356 006150 aa 6 00542 6211 00 eax1 pr6|354 006151 aa 004000 4310 07 fld 2048,dl 006152 aa 6 00044 3701 20 epp4 pr6|36,* 006153 la 4 00276 3521 20 epp2 pr4|190,* apl_expansion_ 006154 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1819 call finish_dyadic_operator_routine_call; 006155 aa 002054 6700 04 tsp4 1068,ic 010231 STATEMENT 1 ON LINE 1820 go to operator_return (return_point); 006156 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006157 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1822 dyadic_action (9): /* dyadic file system functions */ call setup_dyadic_operator_routine_call; 006160 aa 002004 6700 04 tsp4 1028,ic 010164 STATEMENT 1 ON LINE 1824 call apl_file_system_ (operators_argument); 006161 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006162 aa 6 00544 2521 00 spri2 pr6|356 006163 aa 6 00542 6211 00 eax1 pr6|354 006164 aa 004000 4310 07 fld 2048,dl 006165 aa 6 00044 3701 20 epp4 pr6|36,* 006166 la 4 00250 3521 20 epp2 pr4|168,* apl_file_system_ 006167 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1825 call finish_dyadic_operator_routine_call; 006170 aa 002041 6700 04 tsp4 1057,ic 010231 STATEMENT 1 ON LINE 1826 go to operator_return (return_point); 006171 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006172 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1828 dyadic_action (10): /* dyadic rho */ call setup_dyadic_operator_routine_call; 006173 aa 001771 6700 04 tsp4 1017,ic 010164 STATEMENT 1 ON LINE 1830 call apl_dyadic_rho_ (operators_argument); 006174 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006175 aa 6 00544 2521 00 spri2 pr6|356 006176 aa 6 00542 6211 00 eax1 pr6|354 006177 aa 004000 4310 07 fld 2048,dl 006200 aa 6 00044 3701 20 epp4 pr6|36,* 006201 la 4 00270 3521 20 epp2 pr4|184,* apl_dyadic_rho_ 006202 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1831 call finish_dyadic_operator_routine_call; 006203 aa 002026 6700 04 tsp4 1046,ic 010231 STATEMENT 1 ON LINE 1832 go to operator_return (return_point); 006204 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006205 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1834 dyadic_action (11): /* laminate */ call setup_dyadic_operator_routine_call; 006206 aa 001756 6700 04 tsp4 1006,ic 010164 STATEMENT 1 ON LINE 1836 operators_argument.dimension = rs_for_op (start - 1).semantics; 006207 aa 6 00155 2361 00 ldq pr6|109 start 006210 aa 000002 7360 00 qls 2 006211 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006212 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006213 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1837 call apl_laminate_ (operators_argument); 006214 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006215 aa 6 00544 2521 00 spri2 pr6|356 006216 aa 6 00542 6211 00 eax1 pr6|354 006217 aa 004000 4310 07 fld 2048,dl 006220 aa 6 00044 3701 20 epp4 pr6|36,* 006221 la 4 00266 3521 20 epp2 pr4|182,* apl_laminate_ 006222 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1838 call finish_dyadic_operator_routine_call; 006223 aa 002006 6700 04 tsp4 1030,ic 010231 STATEMENT 1 ON LINE 1839 go to operator_return (return_point); 006224 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006225 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1841 dyadic_action (12): /* compression first */ call setup_dyadic_operator_routine_call; 006226 aa 001736 6700 04 tsp4 990,ic 010164 STATEMENT 1 ON LINE 1843 operators_argument.dimension = 1; 006227 aa 000001 2360 07 ldq 1,dl 006230 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1844 go to join_compression; 006231 aa 777646 7100 04 tra -90,ic 006077 STATEMENT 1 ON LINE 1846 dyadic_action (13): /* expansion first */ call setup_dyadic_operator_routine_call; 006232 aa 001732 6700 04 tsp4 986,ic 010164 STATEMENT 1 ON LINE 1848 operators_argument.dimension = 1; 006233 aa 000001 2360 07 ldq 1,dl 006234 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1849 go to join_expansion; 006235 aa 777676 7100 04 tra -66,ic 006133 STATEMENT 1 ON LINE 1851 dyadic_action (14): /* outer product */ call setup_dyadic_operator_routine_call; 006236 aa 001726 6700 04 tsp4 982,ic 010164 STATEMENT 1 ON LINE 1853 operators_argument.op1 = rs (start - 1).bits.op2; 006237 aa 6 00155 2361 00 ldq pr6|109 start 006240 aa 000001 1760 07 sbq 1,dl 006241 aa 000002 7360 00 qls 2 006242 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006243 aa 7 77775 2351 06 lda pr7|-3,ql rs.op2 006244 aa 000011 7710 00 arl 9 006245 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 1854 call apl_outer_product_ (operators_argument); 006246 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006247 aa 6 00544 2521 00 spri2 pr6|356 006250 aa 6 00542 6211 00 eax1 pr6|354 006251 aa 004000 4310 07 fld 2048,dl 006252 aa 6 00044 3701 20 epp4 pr6|36,* 006253 la 4 00052 3521 20 epp2 pr4|42,* apl_outer_product_ 006254 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1855 call finish_dyadic_operator_routine_call; 006255 aa 001754 6700 04 tsp4 1004,ic 010231 STATEMENT 1 ON LINE 1856 go to operator_return (return_point); 006256 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006257 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1858 dyadic_action (15): /* take */ call setup_dyadic_operator_routine_call; 006260 aa 001704 6700 04 tsp4 964,ic 010164 STATEMENT 1 ON LINE 1860 call apl_take_ (operators_argument); 006261 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006262 aa 6 00544 2521 00 spri2 pr6|356 006263 aa 6 00542 6211 00 eax1 pr6|354 006264 aa 004000 4310 07 fld 2048,dl 006265 aa 6 00044 3701 20 epp4 pr6|36,* 006266 la 4 00256 3521 20 epp2 pr4|174,* apl_take_ 006267 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1861 call finish_dyadic_operator_routine_call; 006270 aa 001741 6700 04 tsp4 993,ic 010231 STATEMENT 1 ON LINE 1862 go to operator_return (return_point); 006271 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006272 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1864 dyadic_action (16): /* drop */ call setup_dyadic_operator_routine_call; 006273 aa 001671 6700 04 tsp4 953,ic 010164 STATEMENT 1 ON LINE 1866 call apl_drop_ (operators_argument); 006274 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006275 aa 6 00544 2521 00 spri2 pr6|356 006276 aa 6 00542 6211 00 eax1 pr6|354 006277 aa 004000 4310 07 fld 2048,dl 006300 aa 6 00044 3701 20 epp4 pr6|36,* 006301 la 4 00260 3521 20 epp2 pr4|176,* apl_drop_ 006302 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1867 call finish_dyadic_operator_routine_call; 006303 aa 001726 6700 04 tsp4 982,ic 010231 STATEMENT 1 ON LINE 1868 go to operator_return (return_point); 006304 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006305 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1870 dyadic_action (17): /* rotate last */ call setup_dyadic_operator_routine_call; 006306 aa 001656 6700 04 tsp4 942,ic 010164 STATEMENT 1 ON LINE 1872 if rs (start - 1).semantics_valid then operators_argument.dimension = rs_for_op (start - 1).semantics; 006307 aa 6 00155 2361 00 ldq pr6|109 start 006310 aa 000001 1760 07 sbq 1,dl 006311 aa 000002 7360 00 qls 2 006312 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006313 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006314 aa 004000 3150 03 cana 2048,du 006315 aa 000006 6000 04 tze 6,ic 006323 006316 aa 6 00155 2361 00 ldq pr6|109 start 006317 aa 000002 7360 00 qls 2 006320 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006321 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 006322 aa 000006 7100 04 tra 6,ic 006330 STATEMENT 1 ON LINE 1874 else operators_argument.dimension = rs (start - 2).semantics -> value_bead.rhorho; 006323 aa 6 00155 2361 00 ldq pr6|109 start 006324 aa 000002 7360 00 qls 2 006325 aa 7 77766 7651 06 lprp5 pr7|-10,ql rs.semantics 006326 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 006327 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1876 rotate_either: call apl_rotate_ (operators_argument); 006330 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006331 aa 6 00544 2521 00 spri2 pr6|356 006332 aa 6 00542 6211 00 eax1 pr6|354 006333 aa 004000 4310 07 fld 2048,dl 006334 aa 6 00044 3701 20 epp4 pr6|36,* 006335 la 4 00302 3521 20 epp2 pr4|194,* apl_rotate_ 006336 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1878 call finish_dyadic_operator_routine_call; 006337 aa 001672 6700 04 tsp4 954,ic 010231 STATEMENT 1 ON LINE 1879 go to operator_return (return_point); 006340 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006341 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1881 dyadic_action (18): /* rotate first */ call setup_dyadic_operator_routine_call; 006342 aa 001622 6700 04 tsp4 914,ic 010164 STATEMENT 1 ON LINE 1883 if rs (start - 1).semantics_valid then operators_argument.dimension = rs_for_op (start - 1).semantics; 006343 aa 6 00155 2361 00 ldq pr6|109 start 006344 aa 000001 1760 07 sbq 1,dl 006345 aa 000002 7360 00 qls 2 006346 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006347 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006350 aa 004000 3150 03 cana 2048,du 006351 aa 000006 6000 04 tze 6,ic 006357 006352 aa 6 00155 2361 00 ldq pr6|109 start 006353 aa 000002 7360 00 qls 2 006354 aa 7 77772 2361 06 ldq pr7|-6,ql rs_for_op.semantics 006355 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 006356 aa 777752 7100 04 tra -22,ic 006330 STATEMENT 1 ON LINE 1885 else operators_argument.dimension = 1; 006357 aa 000001 2360 07 ldq 1,dl 006360 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1886 go to rotate_either; 006361 aa 777747 7100 04 tra -25,ic 006330 STATEMENT 1 ON LINE 1888 dyadic_action (19): /* dyadic transpose */ call setup_dyadic_operator_routine_call; 006362 aa 001602 6700 04 tsp4 898,ic 010164 STATEMENT 1 ON LINE 1890 call apl_transpose_ (operators_argument); 006363 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006364 aa 6 00544 2521 00 spri2 pr6|356 006365 aa 6 00542 6211 00 eax1 pr6|354 006366 aa 004000 4310 07 fld 2048,dl 006367 aa 6 00044 3701 20 epp4 pr6|36,* 006370 la 4 00304 3521 20 epp2 pr4|196,* apl_transpose_ 006371 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1891 call finish_dyadic_operator_routine_call; 006372 aa 001637 6700 04 tsp4 927,ic 010231 STATEMENT 1 ON LINE 1892 go to operator_return (return_point); 006373 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006374 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1894 dyadic_action (20): /* decode */ call setup_dyadic_operator_routine_call; 006375 aa 001567 6700 04 tsp4 887,ic 010164 STATEMENT 1 ON LINE 1896 call apl_decode_ (operators_argument); 006376 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006377 aa 6 00544 2521 00 spri2 pr6|356 006400 aa 6 00542 6211 00 eax1 pr6|354 006401 aa 004000 4310 07 fld 2048,dl 006402 aa 6 00044 3701 20 epp4 pr6|36,* 006403 la 4 00236 3521 20 epp2 pr4|158,* apl_decode_ 006404 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1897 call finish_dyadic_operator_routine_call; 006405 aa 001624 6700 04 tsp4 916,ic 010231 STATEMENT 1 ON LINE 1898 go to operator_return (return_point); 006406 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006407 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1900 dyadic_action (21): /* encode */ call setup_dyadic_operator_routine_call; 006410 aa 001554 6700 04 tsp4 876,ic 010164 STATEMENT 1 ON LINE 1902 call apl_encode_ (operators_argument); 006411 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006412 aa 6 00544 2521 00 spri2 pr6|356 006413 aa 6 00542 6211 00 eax1 pr6|354 006414 aa 004000 4310 07 fld 2048,dl 006415 aa 6 00044 3701 20 epp4 pr6|36,* 006416 la 4 00234 3521 20 epp2 pr4|156,* apl_encode_ 006417 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1903 call finish_dyadic_operator_routine_call; 006420 aa 001611 6700 04 tsp4 905,ic 010231 STATEMENT 1 ON LINE 1904 go to operator_return (return_point); 006421 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006422 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1906 dyadic_action (22): /* catenate first */ call setup_dyadic_operator_routine_call; 006423 aa 001541 6700 04 tsp4 865,ic 010164 STATEMENT 1 ON LINE 1908 operators_argument.dimension = 1; 006424 aa 000001 2360 07 ldq 1,dl 006425 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 1909 go to join_catenate; 006426 aa 777430 7100 04 tra -232,ic 006056 STATEMENT 1 ON LINE 1911 dyadic_action (23): /* format */ call setup_dyadic_operator_routine_call; 006427 aa 001535 6700 04 tsp4 861,ic 010164 STATEMENT 1 ON LINE 1913 call apl_dyadic_format_ (operators_argument); 006430 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006431 aa 6 00544 2521 00 spri2 pr6|356 006432 aa 6 00542 6211 00 eax1 pr6|354 006433 aa 004000 4310 07 fld 2048,dl 006434 aa 6 00044 3701 20 epp4 pr6|36,* 006435 la 4 00040 3521 20 epp2 pr4|32,* apl_dyadic_format_ 006436 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1914 call finish_dyadic_operator_routine_call; 006437 aa 001572 6700 04 tsp4 890,ic 010231 STATEMENT 1 ON LINE 1915 go to operator_return (return_point); 006440 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006441 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1917 dyadic_action (24): /* semicolon cons */ if rs (start).semantics = null then go to value_error_s0; 006442 aa 6 00155 2361 00 ldq pr6|109 start 006443 aa 000002 7360 00 qls 2 006444 aa 000000 6260 06 eax6 0,ql 006445 aa 7 77776 2361 06 ldq pr7|-2,ql rs.semantics 006446 aa 005422 1160 04 cmpq 2834,ic 014070 = 007777000001 006447 aa 774525 6000 04 tze -1707,ic 003174 STATEMENT 1 ON LINE 1921 if rs (start - 2).semantics = null then go to value_error_s2; 006450 aa 7 77766 2361 16 ldq pr7|-10,6 rs.semantics 006451 aa 005417 1160 04 cmpq 2831,ic 014070 = 007777000001 006452 aa 774511 6000 04 tze -1719,ic 003163 STATEMENT 1 ON LINE 1924 call append_to_list_bead (addr (rs (start - 2)) -> rs_overlay); 006453 aa 7 77764 3521 16 epp2 pr7|-12,6 rs_overlay 006454 aa 6 00550 2521 00 spri2 pr6|360 006455 aa 6 00546 3521 00 epp2 pr6|358 006456 aa 004000 4310 07 fld 2048,dl 006457 aa 2 00000 7571 00 staq pr2|0 006460 aa 6 00607 7461 00 stx6 pr6|391 006461 aa 003363 6700 04 tsp4 1779,ic 012044 STATEMENT 1 ON LINE 1925 rs (start - 2).semantics -> list_bead.member_ptr (1) = rs (start).semantics; 006462 aa 6 00155 2361 00 ldq pr6|109 start 006463 aa 000002 7360 00 qls 2 006464 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006465 aa 7 77766 7671 06 lprp7 pr7|-10,ql rs.semantics 006466 aa 6 00126 3715 20 epp5 pr6|86,* rsp 006467 aa 000000 6270 06 eax7 0,ql 006470 aa 5 77776 2361 06 ldq pr5|-2,ql rs.semantics 006471 aa 7 00003 7561 00 stq pr7|3 list_bead.member_ptr STATEMENT 1 ON LINE 1926 unspec (rs (start - 2).semantics -> list_bead.bits (1)) = unspec (rs (start).bits); 006472 aa 5 77766 7631 17 lprp3 pr5|-10,7 rs.semantics 006473 aa 5 77775 2351 17 lda pr5|-3,7 006474 aa 3 00004 7551 00 sta pr3|4 STATEMENT 1 ON LINE 1930 rs (put_result).semantics = rs (start - 2).semantics; 006475 aa 6 00156 2361 00 ldq pr6|110 put_result 006476 aa 000002 7360 00 qls 2 006477 aa 000000 6260 06 eax6 0,ql 006500 aa 5 77766 2361 17 ldq pr5|-10,7 rs.semantics 006501 aa 5 77776 7561 16 stq pr5|-2,6 rs.semantics STATEMENT 1 ON LINE 1931 unspec (rs (put_result).bits) = unspec (rs (start - 2).bits); 006502 aa 5 77765 2351 17 lda pr5|-11,7 006503 aa 5 77775 7551 16 sta pr5|-3,6 STATEMENT 1 ON LINE 1932 go to operator_return (return_point); 006504 aa 6 00157 7251 00 lxl5 pr6|111 return_point 006505 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 1934 dyadic_action (25): /* deal */ call setup_dyadic_operator_routine_call; 006506 aa 001456 6700 04 tsp4 814,ic 010164 STATEMENT 1 ON LINE 1936 call apl_random_ (operators_argument); 006507 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006510 aa 6 00544 2521 00 spri2 pr6|356 006511 aa 6 00542 6211 00 eax1 pr6|354 006512 aa 004000 4310 07 fld 2048,dl 006513 aa 6 00044 3701 20 epp4 pr6|36,* 006514 la 4 00306 3521 20 epp2 pr4|198,* apl_random_ 006515 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1937 call finish_dyadic_operator_routine_call; 006516 aa 001513 6700 04 tsp4 843,ic 010231 STATEMENT 1 ON LINE 1938 go to operator_return (return_point); 006517 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006520 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1940 dyadic_action (26): /* system functions */ call setup_dyadic_operator_routine_call; 006521 aa 001443 6700 04 tsp4 803,ic 010164 STATEMENT 1 ON LINE 1942 parse_frame.current_parseme = current_parseme; 006522 aa 6 00132 2361 00 ldq pr6|90 current_parseme 006523 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 006524 aa 7 00005 7561 00 stq pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 1943 call apl_system_functions_ (operators_argument); 006525 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006526 aa 6 00544 2521 00 spri2 pr6|356 006527 aa 6 00542 6211 00 eax1 pr6|354 006530 aa 004000 4310 07 fld 2048,dl 006531 aa 6 00044 3701 20 epp4 pr6|36,* 006532 la 4 00246 3521 20 epp2 pr4|166,* apl_system_functions_ 006533 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1944 call finish_dyadic_operator_routine_call; 006534 aa 001475 6700 04 tsp4 829,ic 010231 STATEMENT 1 ON LINE 1945 go to operator_return (return_point); 006535 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006536 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1947 dyadic_action (27): /* dyadic domino */ call setup_dyadic_operator_routine_call; 006537 aa 001425 6700 04 tsp4 789,ic 010164 STATEMENT 1 ON LINE 1949 call apl_domino_operator_ (operators_argument); 006540 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006541 aa 6 00544 2521 00 spri2 pr6|356 006542 aa 6 00542 6211 00 eax1 pr6|354 006543 aa 004000 4310 07 fld 2048,dl 006544 aa 6 00044 3701 20 epp4 pr6|36,* 006545 la 4 00272 3521 20 epp2 pr4|186,* apl_domino_operator_ 006546 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1950 call finish_dyadic_operator_routine_call; 006547 aa 001462 6700 04 tsp4 818,ic 010231 STATEMENT 1 ON LINE 1951 go to operator_return (return_point); 006550 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006551 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1953 dyadic_action (28): /* subscripted assignment */ print_final_value = "0"b; 006552 aa 6 00161 4501 00 stz pr6|113 print_final_value STATEMENT 1 ON LINE 1955 operators_argument.error_code = 0; 006553 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 1956 call apl_subscripted_assignment_ (operators_argument, addr (rs (start))); 006554 aa 6 00155 2361 00 ldq pr6|109 start 006555 aa 000002 7360 00 qls 2 006556 aa 7 77774 3715 06 epp5 pr7|-4,ql rs 006557 aa 6 00646 6515 00 spri5 pr6|422 006560 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006561 aa 6 00550 2521 00 spri2 pr6|360 006562 aa 6 00646 3521 00 epp2 pr6|422 006563 aa 6 00552 2521 00 spri2 pr6|362 006564 aa 6 00546 6211 00 eax1 pr6|358 006565 aa 010000 4310 07 fld 4096,dl 006566 aa 6 00044 3701 20 epp4 pr6|36,* 006567 la 4 00074 3521 20 epp2 pr4|60,* apl_subscripted_assignment_ 006570 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1958 if operators_argument.error_code ^= 0 then go to report_error_from_operator; 006571 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 006572 aa 774701 6010 04 tnz -1599,ic 003473 STATEMENT 1 ON LINE 1961 rs (put_result).semantics = rs (start - 2).semantics; 006573 aa 6 00156 2361 00 ldq pr6|110 put_result 006574 aa 000002 7360 00 qls 2 006575 aa 000000 6270 06 eax7 0,ql 006576 aa 6 00155 2361 00 ldq pr6|109 start 006577 aa 000002 7360 00 qls 2 006600 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006601 aa 000000 6260 06 eax6 0,ql 006602 aa 7 77766 2361 06 ldq pr7|-10,ql rs.semantics 006603 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 1962 unspec (rs (put_result).bits) = unspec (rs (start - 2).bits); 006604 aa 7 77765 2351 16 lda pr7|-11,6 006605 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 1963 go to operator_return (return_point); 006606 aa 6 00157 7251 00 lxl5 pr6|111 return_point 006607 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 1965 dyadic_action (29): /* dyadic ibeam */ call setup_dyadic_operator_routine_call; 006610 aa 001354 6700 04 tsp4 748,ic 010164 STATEMENT 1 ON LINE 1967 call apl_dyadic_ibeam_ (operators_argument); 006611 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006612 aa 6 00544 2521 00 spri2 pr6|356 006613 aa 6 00542 6211 00 eax1 pr6|354 006614 aa 004000 4310 07 fld 2048,dl 006615 aa 6 00044 3701 20 epp4 pr6|36,* 006616 la 4 00242 3521 20 epp2 pr4|162,* apl_dyadic_ibeam_ 006617 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1968 call finish_dyadic_operator_routine_call; 006620 aa 001411 6700 04 tsp4 777,ic 010231 STATEMENT 1 ON LINE 1969 go to operator_return (return_point); 006621 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006622 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1971 do_inner_product: call setup_dyadic_operator_routine_call; 006623 aa 001341 6700 04 tsp4 737,ic 010164 STATEMENT 1 ON LINE 1973 operators_argument.op2 = rs (start - 1).bits.op2; 006624 aa 6 00155 2361 00 ldq pr6|109 start 006625 aa 000001 1760 07 sbq 1,dl 006626 aa 000002 7360 00 qls 2 006627 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006630 aa 7 77775 2351 06 lda pr7|-3,ql rs.op2 006631 aa 6 00203 5511 10 stba pr6|131,10 operators_argument.op2 STATEMENT 1 ON LINE 1974 call apl_inner_product_ (operators_argument); 006632 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006633 aa 6 00544 2521 00 spri2 pr6|356 006634 aa 6 00542 6211 00 eax1 pr6|354 006635 aa 004000 4310 07 fld 2048,dl 006636 aa 6 00044 3701 20 epp4 pr6|36,* 006637 la 4 00042 3521 20 epp2 pr4|34,* apl_inner_product_ 006640 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1975 call finish_dyadic_operator_routine_call; 006641 aa 001370 6700 04 tsp4 760,ic 010231 STATEMENT 1 ON LINE 1976 go to operator_return (return_point); 006642 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006643 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1978 do_monadic: print_final_value = "1"b; 006644 aa 400000 2350 03 lda 131072,du 006645 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 1980 operators_argument.where_error = start; 006646 aa 6 00155 2361 00 ldq pr6|109 start 006647 aa 6 00206 7561 00 stq pr6|134 operators_argument.where_error STATEMENT 1 ON LINE 1981 if ^rs (start).bits.monadic then go to improper_monadic_usage; 006650 aa 000002 7360 00 qls 2 006651 aa 7 77775 2351 06 lda pr7|-3,ql rs.monadic 006652 aa 020000 3150 03 cana 8192,du 006653 aa 774354 6000 04 tze -1812,ic 003227 STATEMENT 1 ON LINE 1983 go to monadic_action (monadic_table (rs (start).bits.op1)); 006654 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 006655 aa 000033 7350 00 als 27 006656 aa 6 00610 7561 00 stq pr6|392 006657 aa 000077 7330 00 lrs 63 006660 ta 000425 7260 06 lxl6 277,ql 006661 aa 6 00612 7561 00 stq pr6|394 rs.op1 006662 ta 000120 7100 16 tra 80,6 STATEMENT 1 ON LINE 1985 monadic_action (1): /* monadic scalar operators */ call setup_monadic_operator_routine_call; 006663 aa 001415 6700 04 tsp4 781,ic 010300 STATEMENT 1 ON LINE 1987 call apl_monadic_ (operators_argument); 006664 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 006665 aa 6 00544 2521 00 spri2 pr6|356 006666 aa 6 00542 6211 00 eax1 pr6|354 006667 aa 004000 4310 07 fld 2048,dl 006670 aa 6 00044 3701 20 epp4 pr6|36,* 006671 la 4 00044 3521 20 epp2 pr4|36,* apl_monadic_ 006672 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 1988 call finish_monadic_operator_routine_call; 006673 aa 001441 6700 04 tsp4 801,ic 010334 STATEMENT 1 ON LINE 1989 go to operator_return (return_point); 006674 aa 6 00157 7271 00 lxl7 pr6|111 return_point 006675 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 1991 monadic_action (2): /* monadic functions */ number_of_arguments = 1; 006676 aa 000001 2360 07 ldq 1,dl 006677 aa 6 00160 7561 00 stq pr6|112 number_of_arguments STATEMENT 1 ON LINE 1994 if ^rs (start - 1).semantics_valid then call value_error_reporter (start - 1); 006700 aa 6 00155 2361 00 ldq pr6|109 start 006701 aa 000001 1760 07 sbq 1,dl 006702 aa 000002 7360 00 qls 2 006703 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 006704 aa 004000 3150 03 cana 2048,du 006705 aa 000006 6010 04 tnz 6,ic 006713 006706 aa 6 00155 2361 00 ldq pr6|109 start 006707 aa 000001 1760 07 sbq 1,dl 006710 aa 6 00611 7561 00 stq pr6|393 006711 aa 005063 3520 04 epp2 2611,ic 013774 = 000002000000 006712 aa 003076 6700 04 tsp4 1598,ic 012010 STATEMENT 1 ON LINE 1996 if rs (start - 1).semantics = null then call value_error_reporter (start - 1); 006713 aa 6 00155 2361 00 ldq pr6|109 start 006714 aa 000002 7360 00 qls 2 006715 aa 6 00126 3735 20 epp7 pr6|86,* rsp 006716 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 006717 aa 005151 1160 04 cmpq 2665,ic 014070 = 007777000001 006720 aa 776543 6010 04 tnz -669,ic 005463 006721 aa 6 00155 2361 00 ldq pr6|109 start 006722 aa 000001 1760 07 sbq 1,dl 006723 aa 6 00611 7561 00 stq pr6|393 006724 aa 005050 3520 04 epp2 2600,ic 013774 = 000002000000 006725 aa 003063 6700 04 tsp4 1587,ic 012010 STATEMENT 1 ON LINE 1999 go to invoke_monadic_function; 006726 aa 776535 7100 04 tra -675,ic 005463 STATEMENT 1 ON LINE 2001 monadic_action (3): /* branch */ print_final_value = "0"b; 006727 aa 6 00161 4501 00 stz pr6|113 print_final_value STATEMENT 1 ON LINE 2003 if rs (start - 1).semantics = null then go to value_error_s0; 006730 aa 6 00610 7251 00 lxl5 pr6|392 006731 aa 7 77772 2361 15 ldq pr7|-6,5 rs.semantics 006732 aa 005136 1160 04 cmpq 2654,ic 014070 = 007777000001 006733 aa 774241 6000 04 tze -1887,ic 003174 STATEMENT 1 ON LINE 2008 do branch_pf_ptr = parse_frame_ptr repeat (branch_pf_ptr -> parse_frame.last_parse_frame_ptr) while (branch_pf_ptr -> parse_frame.parse_frame_type = execute_frame_type); 006734 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 006735 aa 6 00102 6515 00 spri5 pr6|66 branch_pf_ptr 006736 aa 6 00102 3735 20 epp7 pr6|66,* branch_pf_ptr 006737 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 006740 aa 000004 1160 07 cmpq 4,dl 006741 aa 000004 6010 04 tnz 4,ic 006745 STATEMENT 1 ON LINE 2010 end; 006742 aa 7 00000 7651 00 lprp5 pr7|0 parse_frame.last_parse_frame_ptr 006743 aa 6 00102 6515 00 spri5 pr6|66 branch_pf_ptr 006744 aa 777772 7100 04 tra -6,ic 006736 STATEMENT 1 ON LINE 2012 if branch_pf_ptr -> parse_frame.parse_frame_type = function_frame_type then if branch_pf_ptr -> parse_frame.function_bead_ptr -> function_bead.trace_control_pointer ^= null then if this_statement_is_one (branch_pf_ptr -> parse_frame.current_line_number, branch_pf_ptr -> parse_frame.function_bead_ptr -> function_bead.trace_control_pointer) then do; 006745 aa 000002 1160 07 cmpq 2,dl 006746 aa 000032 6010 04 tnz 26,ic 007000 006747 aa 7 00002 7651 00 lprp5 pr7|2 parse_frame.function_bead_ptr 006750 aa 5 00005 2361 00 ldq pr5|5 function_bead.trace_control_pointer 006751 aa 005117 1160 04 cmpq 2639,ic 014070 = 007777000001 006752 aa 000026 6000 04 tze 22,ic 007000 006753 aa 7 00007 3521 00 epp2 pr7|7 parse_frame.current_line_number 006754 aa 6 00550 2521 00 spri2 pr6|360 006755 aa 5 00005 3521 00 epp2 pr5|5 function_bead.trace_control_pointer 006756 aa 6 00552 2521 00 spri2 pr6|362 006757 aa 6 00611 3521 00 epp2 pr6|393 006760 aa 6 00554 2521 00 spri2 pr6|364 006761 aa 6 00546 3521 00 epp2 pr6|358 006762 aa 014000 4310 07 fld 6144,dl 006763 aa 2 00000 7571 00 staq pr2|0 006764 aa 003413 6700 04 tsp4 1803,ic 012377 006765 aa 6 00611 2351 00 lda pr6|393 006766 aa 400000 3150 03 cana 131072,du 006767 aa 000011 6000 04 tze 9,ic 007000 STATEMENT 1 ON LINE 2017 call print_where_I_am (branch_pf_ptr, "1"b, "0"b); 006770 aa 400000 2350 03 lda 131072,du 006771 aa 6 00611 7551 00 sta pr6|393 006772 aa 000000 2350 07 lda 0,dl 006773 aa 6 00606 7551 00 sta pr6|390 006774 aa 004770 3520 04 epp2 2552,ic 013764 = 000006000000 006775 aa 003462 6700 04 tsp4 1842,ic 012457 STATEMENT 1 ON LINE 2018 trace_branch_line = "1"b; 006776 aa 400000 2350 03 lda 131072,du 006777 aa 6 00113 7551 00 sta pr6|75 trace_branch_line STATEMENT 1 ON LINE 2019 end; STATEMENT 1 ON LINE 2020 if rs (start - 1).semantics -> value_bead.total_data_elements > 0 then do; 007000 aa 6 00155 2361 00 ldq pr6|109 start 007001 aa 000002 7360 00 qls 2 007002 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007003 aa 7 77772 7671 06 lprp7 pr7|-6,ql rs.semantics 007004 aa 6 00606 7561 00 stq pr6|390 007005 aa 7 00002 2361 00 ldq pr7|2 value_bead.total_data_elements 007006 aa 6 00646 6535 00 spri7 pr6|422 007007 aa 000037 6044 04 tmoz 31,ic 007046 STATEMENT 1 ON LINE 2022 if ^rs (start - 1).semantics -> value_bead.numeric_value then go to domain_error; 007010 aa 7 00000 2351 00 lda pr7|0 value_bead.numeric_value 007011 aa 000200 3150 03 cana 128,du 007012 aa 774132 6000 04 tze -1958,ic 003144 STATEMENT 1 ON LINE 2024 x = rs (start - 1).semantics -> value_bead.data_pointer -> numeric_datum (0); 007013 aa 7 00004 7651 00 lprp5 pr7|4 value_bead.data_pointer 007014 aa 5 00000 4331 00 dfld pr5|0 numeric_datum 007015 aa 6 00116 4571 00 dfst pr6|78 x STATEMENT 1 ON LINE 2025 xx = floor (x + 0.5); 007016 aa 000400 4750 03 fad 256,du 007017 aa 0 01123 7001 00 tsx0 pr0|595 floor_fl 007020 aa 6 00120 4571 00 dfst pr6|80 xx STATEMENT 1 ON LINE 2026 if abs (xx - x) > integer_fuzz then go to domain_error; 007021 aa 6 00116 5771 00 dfsb pr6|78 x 007022 aa 000002 6050 04 tpl 2,ic 007024 007023 aa 000000 5130 00 fneg 0 007024 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 007025 aa 3 00022 5171 00 dfcmp pr3|18 ws_info.integer_fuzz 007026 aa 774116 6054 04 tpnz -1970,ic 003144 STATEMENT 1 ON LINE 2028 if abs (xx) > 131071 then go to domain_error; 007027 aa 6 00120 4331 00 dfld pr6|80 xx 007030 aa 000002 6050 04 tpl 2,ic 007032 007031 aa 000000 5130 00 fneg 0 007032 aa 6 00646 4571 00 dfst pr6|422 007033 aa 771603 4310 04 fld -3197,ic 000636 = 042777776000 007034 aa 6 00646 5171 00 dfcmp pr6|422 007035 aa 774107 6040 04 tmi -1977,ic 003144 STATEMENT 1 ON LINE 2031 branch_pf_ptr -> parse_frame.current_line_number = fixed (xx, 17) - 1; 007036 aa 6 00120 4331 00 dfld pr6|80 xx 007037 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 007040 aa 000001 1760 07 sbq 1,dl 007041 aa 6 00102 3515 20 epp1 pr6|66,* branch_pf_ptr 007042 aa 1 00007 7561 00 stq pr1|7 parse_frame.current_line_number STATEMENT 1 ON LINE 2033 was_branch_value = "1"b; 007043 aa 400000 2350 03 lda 131072,du 007044 aa 6 00115 7551 00 sta pr6|77 was_branch_value STATEMENT 1 ON LINE 2034 end; 007045 aa 000002 7100 04 tra 2,ic 007047 STATEMENT 1 ON LINE 2035 else was_branch_value = "0"b; 007046 aa 6 00115 4501 00 stz pr6|77 was_branch_value STATEMENT 1 ON LINE 2036 was_branch = "1"b; 007047 aa 400000 2350 03 lda 131072,du 007050 aa 6 00114 7551 00 sta pr6|76 was_branch STATEMENT 1 ON LINE 2037 rs (put_result).semantics = rs (start - 1).semantics; 007051 aa 6 00156 2361 00 ldq pr6|110 put_result 007052 aa 000002 7360 00 qls 2 007053 aa 6 00606 7271 00 lxl7 pr6|390 007054 aa 6 00126 3715 20 epp5 pr6|86,* rsp 007055 aa 000000 6260 06 eax6 0,ql 007056 aa 5 77772 2361 17 ldq pr5|-6,7 rs.semantics 007057 aa 5 77776 7561 16 stq pr5|-2,6 rs.semantics STATEMENT 1 ON LINE 2038 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 007060 aa 5 77771 2351 17 lda pr5|-7,7 007061 aa 5 77775 7551 16 sta pr5|-3,6 STATEMENT 1 ON LINE 2039 go to operator_return (return_point); 007062 aa 6 00157 7251 00 lxl5 pr6|111 return_point 007063 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 2041 monadic_action (4): /* ravel */ call setup_monadic_operator_routine_call; 007064 aa 001214 6700 04 tsp4 652,ic 010300 STATEMENT 1 ON LINE 2043 call apl_ravel_ (operators_argument); 007065 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007066 aa 6 00544 2521 00 spri2 pr6|356 007067 aa 6 00542 6211 00 eax1 pr6|354 007070 aa 004000 4310 07 fld 2048,dl 007071 aa 6 00044 3701 20 epp4 pr6|36,* 007072 la 4 00262 3521 20 epp2 pr4|178,* apl_ravel_ 007073 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2044 call finish_monadic_operator_routine_call; 007074 aa 001240 6700 04 tsp4 672,ic 010334 STATEMENT 1 ON LINE 2045 go to operator_return (return_point); 007075 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007076 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2047 monadic_action (5): /* reduction last */ call setup_monadic_operator_routine_call; 007077 aa 001201 6700 04 tsp4 641,ic 010300 STATEMENT 1 ON LINE 2050 if rs (start).bits.semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007100 aa 6 00155 2361 00 ldq pr6|109 start 007101 aa 000002 7360 00 qls 2 007102 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007103 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007104 aa 004000 3150 03 cana 2048,du 007105 aa 6 00606 7561 00 stq pr6|390 007106 aa 000004 6000 04 tze 4,ic 007112 007107 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007110 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007111 aa 000004 7100 04 tra 4,ic 007115 STATEMENT 1 ON LINE 2052 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 007112 aa 7 77772 7651 06 lprp5 pr7|-6,ql rs.semantics 007113 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 007114 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2054 operators_argument.op1 = rs (start).bits.op2; 007115 aa 6 00606 7271 00 lxl7 pr6|390 007116 aa 7 77775 2351 17 lda pr7|-3,7 rs.op2 007117 aa 000011 7710 00 arl 9 007120 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2055 call apl_reduction_ (operators_argument); 007121 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007122 aa 6 00544 2521 00 spri2 pr6|356 007123 aa 6 00542 6211 00 eax1 pr6|354 007124 aa 004000 4310 07 fld 2048,dl 007125 aa 6 00044 3701 20 epp4 pr6|36,* 007126 la 4 00054 3521 20 epp2 pr4|44,* apl_reduction_ 007127 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2056 call finish_monadic_operator_routine_call; 007130 aa 001204 6700 04 tsp4 644,ic 010334 STATEMENT 1 ON LINE 2057 go to operator_return (return_point); 007131 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007132 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2059 monadic_action (6): /* reduction first */ call setup_monadic_operator_routine_call; 007133 aa 001145 6700 04 tsp4 613,ic 010300 STATEMENT 1 ON LINE 2062 if rs (start).bits.semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007134 aa 6 00155 2361 00 ldq pr6|109 start 007135 aa 000002 7360 00 qls 2 007136 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007137 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007140 aa 004000 3150 03 cana 2048,du 007141 aa 6 00606 7561 00 stq pr6|390 007142 aa 000004 6000 04 tze 4,ic 007146 007143 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007144 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007145 aa 000003 7100 04 tra 3,ic 007150 STATEMENT 1 ON LINE 2064 else operators_argument.dimension = 1; 007146 aa 000001 2360 07 ldq 1,dl 007147 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2066 operators_argument.op1 = rs (start).bits.op2; 007150 aa 6 00606 7271 00 lxl7 pr6|390 007151 aa 7 77775 2351 17 lda pr7|-3,7 rs.op2 007152 aa 000011 7710 00 arl 9 007153 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2067 call apl_reduction_ (operators_argument); 007154 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007155 aa 6 00544 2521 00 spri2 pr6|356 007156 aa 6 00542 6211 00 eax1 pr6|354 007157 aa 004000 4310 07 fld 2048,dl 007160 aa 6 00044 3701 20 epp4 pr6|36,* 007161 la 4 00054 3521 20 epp2 pr4|44,* apl_reduction_ 007162 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2068 call finish_monadic_operator_routine_call; 007163 aa 001151 6700 04 tsp4 617,ic 010334 STATEMENT 1 ON LINE 2069 go to operator_return (return_point); 007164 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007165 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2072 monadic_action (7): /* scan last */ call setup_monadic_operator_routine_call; 007166 aa 001112 6700 04 tsp4 586,ic 010300 STATEMENT 1 ON LINE 2074 if rs (start).semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007167 aa 6 00155 2361 00 ldq pr6|109 start 007170 aa 000002 7360 00 qls 2 007171 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007172 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007173 aa 004000 3150 03 cana 2048,du 007174 aa 6 00606 7561 00 stq pr6|390 007175 aa 000004 6000 04 tze 4,ic 007201 007176 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007177 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007200 aa 000004 7100 04 tra 4,ic 007204 STATEMENT 1 ON LINE 2076 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 007201 aa 7 77772 7651 06 lprp5 pr7|-6,ql rs.semantics 007202 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 007203 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2078 operators_argument.op1 = rs (start).op2; 007204 aa 6 00606 7271 00 lxl7 pr6|390 007205 aa 7 77775 2351 17 lda pr7|-3,7 rs.op2 007206 aa 000011 7710 00 arl 9 007207 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2079 call apl_scan_operator_ (operators_argument); 007210 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007211 aa 6 00544 2521 00 spri2 pr6|356 007212 aa 6 00542 6211 00 eax1 pr6|354 007213 aa 004000 4310 07 fld 2048,dl 007214 aa 6 00044 3701 20 epp4 pr6|36,* 007215 la 4 00056 3521 20 epp2 pr4|46,* apl_scan_operator_ 007216 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2080 call finish_monadic_operator_routine_call; 007217 aa 001115 6700 04 tsp4 589,ic 010334 STATEMENT 1 ON LINE 2081 go to operator_return (return_point); 007220 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007221 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2083 monadic_action (8): /* scan first */ call setup_monadic_operator_routine_call; 007222 aa 001056 6700 04 tsp4 558,ic 010300 STATEMENT 1 ON LINE 2085 if rs (start).semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007223 aa 6 00155 2361 00 ldq pr6|109 start 007224 aa 000002 7360 00 qls 2 007225 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007226 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007227 aa 004000 3150 03 cana 2048,du 007230 aa 6 00606 7561 00 stq pr6|390 007231 aa 000004 6000 04 tze 4,ic 007235 007232 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007233 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007234 aa 000003 7100 04 tra 3,ic 007237 STATEMENT 1 ON LINE 2087 else operators_argument.dimension = 1; 007235 aa 000001 2360 07 ldq 1,dl 007236 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2089 operators_argument.op1 = rs (start).op2; 007237 aa 6 00606 7271 00 lxl7 pr6|390 007240 aa 7 77775 2351 17 lda pr7|-3,7 rs.op2 007241 aa 000011 7710 00 arl 9 007242 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2090 call apl_scan_operator_ (operators_argument); 007243 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007244 aa 6 00544 2521 00 spri2 pr6|356 007245 aa 6 00542 6211 00 eax1 pr6|354 007246 aa 004000 4310 07 fld 2048,dl 007247 aa 6 00044 3701 20 epp4 pr6|36,* 007250 la 4 00056 3521 20 epp2 pr4|46,* apl_scan_operator_ 007251 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2091 call finish_monadic_operator_routine_call; 007252 aa 001062 6700 04 tsp4 562,ic 010334 STATEMENT 1 ON LINE 2092 go to operator_return (return_point); 007253 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007254 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2094 monadic_action (9): /* monadic file system functions */ call setup_monadic_operator_routine_call; 007255 aa 001023 6700 04 tsp4 531,ic 010300 STATEMENT 1 ON LINE 2096 call apl_file_system_ (operators_argument); 007256 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007257 aa 6 00544 2521 00 spri2 pr6|356 007260 aa 6 00542 6211 00 eax1 pr6|354 007261 aa 004000 4310 07 fld 2048,dl 007262 aa 6 00044 3701 20 epp4 pr6|36,* 007263 la 4 00250 3521 20 epp2 pr4|168,* apl_file_system_ 007264 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2097 call finish_monadic_operator_routine_call; 007265 aa 001047 6700 04 tsp4 551,ic 010334 STATEMENT 1 ON LINE 2098 go to operator_return (return_point); 007266 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007267 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2100 monadic_action (10): /* monadic not */ call setup_monadic_operator_routine_call; 007270 aa 001010 6700 04 tsp4 520,ic 010300 STATEMENT 1 ON LINE 2102 call apl_monadic_not_ (operators_argument); 007271 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007272 aa 6 00544 2521 00 spri2 pr6|356 007273 aa 6 00542 6211 00 eax1 pr6|354 007274 aa 004000 4310 07 fld 2048,dl 007275 aa 6 00044 3701 20 epp4 pr6|36,* 007276 la 4 00050 3521 20 epp2 pr4|40,* apl_monadic_not_ 007277 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2103 call finish_monadic_operator_routine_call; 007300 aa 001034 6700 04 tsp4 540,ic 010334 STATEMENT 1 ON LINE 2104 go to operator_return (return_point); 007301 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007302 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2106 monadic_action (11): /* reverse last */ call setup_monadic_operator_routine_call; 007303 aa 000775 6700 04 tsp4 509,ic 010300 STATEMENT 1 ON LINE 2109 if rs (start).bits.semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007304 aa 6 00155 2361 00 ldq pr6|109 start 007305 aa 000002 7360 00 qls 2 007306 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007307 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007310 aa 004000 3150 03 cana 2048,du 007311 aa 6 00606 7561 00 stq pr6|390 007312 aa 000004 6000 04 tze 4,ic 007316 007313 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007314 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007315 aa 000004 7100 04 tra 4,ic 007321 STATEMENT 1 ON LINE 2111 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 007316 aa 7 77772 7651 06 lprp5 pr7|-6,ql rs.semantics 007317 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 007320 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2113 reverse_either: call apl_reverse_ (operators_argument); 007321 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007322 aa 6 00544 2521 00 spri2 pr6|356 007323 aa 6 00542 6211 00 eax1 pr6|354 007324 aa 004000 4310 07 fld 2048,dl 007325 aa 6 00044 3701 20 epp4 pr6|36,* 007326 la 4 00300 3521 20 epp2 pr4|192,* apl_reverse_ 007327 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2115 call finish_monadic_operator_routine_call; 007330 aa 001004 6700 04 tsp4 516,ic 010334 STATEMENT 1 ON LINE 2116 go to operator_return (return_point); 007331 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007332 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2118 monadic_action (12): /* reverse first */ call setup_monadic_operator_routine_call; 007333 aa 000745 6700 04 tsp4 485,ic 010300 STATEMENT 1 ON LINE 2121 if rs (start).bits.semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 007334 aa 6 00155 2361 00 ldq pr6|109 start 007335 aa 000002 7360 00 qls 2 007336 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007337 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 007340 aa 004000 3150 03 cana 2048,du 007341 aa 6 00606 7561 00 stq pr6|390 007342 aa 000004 6000 04 tze 4,ic 007346 007343 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 007344 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 007345 aa 777754 7100 04 tra -20,ic 007321 STATEMENT 1 ON LINE 2123 else operators_argument.dimension = 1; 007346 aa 000001 2360 07 ldq 1,dl 007347 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2125 go to reverse_either; 007350 aa 777751 7100 04 tra -23,ic 007321 STATEMENT 1 ON LINE 2127 monadic_action (13): /* monadic transpose */ call setup_monadic_operator_routine_call; 007351 aa 000727 6700 04 tsp4 471,ic 010300 STATEMENT 1 ON LINE 2129 call apl_transpose_ (operators_argument); 007352 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007353 aa 6 00544 2521 00 spri2 pr6|356 007354 aa 6 00542 6211 00 eax1 pr6|354 007355 aa 004000 4310 07 fld 2048,dl 007356 aa 6 00044 3701 20 epp4 pr6|36,* 007357 la 4 00304 3521 20 epp2 pr4|196,* apl_transpose_ 007360 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2130 call finish_monadic_operator_routine_call; 007361 aa 000753 6700 04 tsp4 491,ic 010334 STATEMENT 1 ON LINE 2131 go to operator_return (return_point); 007362 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007363 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2133 monadic_action (14): /* execute */ execute_value_ptr = rs (start - 1).semantics; 007364 aa 6 00610 7251 00 lxl5 pr6|392 007365 aa 7 77772 7651 15 lprp5 pr7|-6,5 rs.semantics 007366 aa 6 00140 6515 00 spri5 pr6|96 execute_value_ptr STATEMENT 1 ON LINE 2135 if execute_value_ptr = null then go to value_error_s1; 007367 aa 6 00140 2371 00 ldaq pr6|96 execute_value_ptr 007370 aa 771276 6770 04 eraq -3394,ic 000666 = 077777000043 000001000000 007371 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 007372 aa 773613 6000 04 tze -2165,ic 003205 STATEMENT 1 ON LINE 2137 data_elements = execute_value_ptr -> value_bead.total_data_elements; 007373 aa 5 00002 2361 00 ldq pr5|2 value_bead.total_data_elements 007374 aa 6 00154 7561 00 stq pr6|108 data_elements STATEMENT 1 ON LINE 2138 if ^execute_value_ptr -> value_bead.character_value then if execute_value_ptr -> value_bead.numeric_value & data_elements > 0 then go to domain_error_s1; 007375 aa 5 00000 2351 00 lda pr5|0 value_bead.character_value 007376 aa 000400 3150 03 cana 256,du 007377 aa 000006 6010 04 tnz 6,ic 007405 007400 aa 5 00000 2351 00 lda pr5|0 value_bead.numeric_value 007401 aa 000200 3150 03 cana 128,du 007402 aa 000003 6000 04 tze 3,ic 007405 007403 aa 6 00154 2361 00 ldq pr6|108 data_elements 007404 aa 773714 6054 04 tpnz -2100,ic 003320 STATEMENT 1 ON LINE 2141 if execute_value_ptr -> value_bead.rhorho > 1 then go to rank_error_s1; 007405 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 007406 aa 000001 1160 07 cmpq 1,dl 007407 aa 773722 6054 04 tpnz -2094,ic 003331 STATEMENT 1 ON LINE 2144 call save_state; 007410 aa 002302 6700 04 tsp4 1218,ic 011712 STATEMENT 1 ON LINE 2145 call push_new_frame; 007411 aa 002407 6700 04 tsp4 1287,ic 012020 STATEMENT 1 ON LINE 2146 parse_frame_type = execute_frame_type; 007412 aa 000004 2360 07 ldq 4,dl 007413 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 007414 aa 7 00001 7561 00 stq pr7|1 parse_frame.parse_frame_type STATEMENT 1 ON LINE 2147 parse_frame.number_of_ptrs, number_of_ptrs = 3; 007415 aa 000003 2360 07 ldq 3,dl 007416 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 007417 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 2148 rsp, reduction_stack_ptr = addrel (parse_frame_ptr, size (parse_frame)); 007420 aa 000015 0760 07 adq 13,dl 007421 aa 7 00000 3521 06 epp2 pr7|0,ql 007422 aa 000000 0520 03 adwp2 0,du 007423 aa 6 00646 2521 00 spri2 pr6|422 007424 aa 6 00126 2521 00 spri2 pr6|86 rsp 007425 aa 7 00004 5421 00 sprp2 pr7|4 parse_frame.reduction_stack_ptr STATEMENT 1 ON LINE 2150 current_parseme = 0; 007426 aa 6 00132 4501 00 stz pr6|90 current_parseme STATEMENT 1 ON LINE 2151 parse_frame.current_parseme = 0; 007427 aa 7 00005 4501 00 stz pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2152 call apl_execute_lex_ (execute_value_ptr -> value_bead.data_pointer -> character_string_overlay, parse_frame.lexed_function_bead_ptr, was_error, 0, rsp); 007430 aa 6 00154 2361 00 ldq pr6|108 data_elements 007431 aa 524000 2760 03 orq 174080,du 007432 aa 6 00606 7561 00 stq pr6|390 007433 aa 6 00140 3715 20 epp5 pr6|96,* execute_value_ptr 007434 aa 5 00004 7651 00 lprp5 pr5|4 value_bead.data_pointer 007435 aa 6 00611 4501 00 stz pr6|393 007436 aa 5 00000 3521 00 epp2 pr5|0 character_string_overlay 007437 aa 6 00616 2521 00 spri2 pr6|398 007440 aa 7 00003 3521 00 epp2 pr7|3 parse_frame.lexed_function_bead_ptr 007441 aa 6 00620 2521 00 spri2 pr6|400 007442 aa 6 00143 3521 00 epp2 pr6|99 was_error 007443 aa 6 00622 2521 00 spri2 pr6|402 007444 aa 6 00611 3521 00 epp2 pr6|393 007445 aa 6 00624 2521 00 spri2 pr6|404 007446 aa 6 00126 3521 00 epp2 pr6|86 rsp 007447 aa 6 00626 2521 00 spri2 pr6|406 007450 aa 6 00606 3521 00 epp2 pr6|390 007451 aa 6 00630 2521 00 spri2 pr6|408 007452 aa 771166 3520 04 epp2 -3466,ic 000640 = 466000000000 007453 aa 6 00632 2521 00 spri2 pr6|410 007454 aa 771175 3520 04 epp2 -3459,ic 000651 = 514000000001 007455 aa 6 00634 2521 00 spri2 pr6|412 007456 aa 771164 3520 04 epp2 -3468,ic 000642 = 404000000021 007457 aa 6 00636 2521 00 spri2 pr6|414 007460 aa 771172 3520 04 epp2 -3462,ic 000652 = 464000000000 007461 aa 6 00640 2521 00 spri2 pr6|416 007462 aa 6 00614 6211 00 eax1 pr6|396 007463 aa 024000 4310 07 fld 10240,dl 007464 aa 6 00044 3701 20 epp4 pr6|36,* 007465 la 4 00214 3521 20 epp2 pr4|140,* apl_execute_lex_ 007466 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2154 if was_error then go to execute_error_s0; 007467 aa 6 00143 2351 00 lda pr6|99 was_error 007470 aa 400000 3150 03 cana 131072,du 007471 aa 773651 6010 04 tnz -2135,ic 003342 STATEMENT 1 ON LINE 2156 parse_frame.current_line_number = 1; 007472 aa 000001 2360 07 ldq 1,dl 007473 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 007474 aa 7 00007 7561 00 stq pr7|7 parse_frame.current_line_number STATEMENT 1 ON LINE 2157 go to start_line; 007475 aa 771461 7100 04 tra -3279,ic 001156 STATEMENT 1 ON LINE 2159 monadic_action (15): /* format */ call setup_monadic_operator_routine_call; 007476 aa 000602 6700 04 tsp4 386,ic 010300 STATEMENT 1 ON LINE 2161 call apl_monadic_format_ (operators_argument); 007477 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007500 aa 6 00544 2521 00 spri2 pr6|356 007501 aa 6 00542 6211 00 eax1 pr6|354 007502 aa 004000 4310 07 fld 2048,dl 007503 aa 6 00044 3701 20 epp4 pr6|36,* 007504 la 4 00046 3521 20 epp2 pr4|38,* apl_monadic_format_ 007505 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2162 call finish_monadic_operator_routine_call; 007506 aa 000626 6700 04 tsp4 406,ic 010334 STATEMENT 1 ON LINE 2163 go to operator_return (return_point); 007507 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007510 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2165 monadic_action (16): /* ibeam */ call setup_monadic_operator_routine_call; 007511 aa 000567 6700 04 tsp4 375,ic 010300 STATEMENT 1 ON LINE 2167 call apl_ibeam_ (operators_argument); 007512 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007513 aa 6 00544 2521 00 spri2 pr6|356 007514 aa 6 00542 6211 00 eax1 pr6|354 007515 aa 004000 4310 07 fld 2048,dl 007516 aa 6 00044 3701 20 epp4 pr6|36,* 007517 la 4 00240 3521 20 epp2 pr4|160,* apl_ibeam_ 007520 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2168 call finish_monadic_operator_routine_call; 007521 aa 000613 6700 04 tsp4 395,ic 010334 STATEMENT 1 ON LINE 2169 go to operator_return (return_point); 007522 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007523 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2171 monadic_action (17): /* assign to quad */ if rs (start - 1).semantics = null then go to value_error_s1; 007524 aa 6 00610 7251 00 lxl5 pr6|392 007525 aa 7 77772 2361 15 ldq pr7|-6,5 rs.semantics 007526 aa 004342 1160 04 cmpq 2274,ic 014070 = 007777000001 007527 aa 773456 6000 04 tze -2258,ic 003205 STATEMENT 1 ON LINE 2174 in_printer = "1"b; 007530 aa 400000 2350 03 lda 131072,du 007531 aa 6 00131 7551 00 sta pr6|89 in_printer STATEMENT 1 ON LINE 2175 call apl_print_value_ (rs (start - 1).semantics, "1"b, "1"b); 007532 aa 6 00606 7551 00 sta pr6|390 007533 aa 6 00611 7551 00 sta pr6|393 007534 aa 7 77772 3521 15 epp2 pr7|-6,5 rs.semantics 007535 aa 6 00550 2521 00 spri2 pr6|360 007536 aa 6 00606 3521 00 epp2 pr6|390 007537 aa 6 00552 2521 00 spri2 pr6|362 007540 aa 6 00611 3521 00 epp2 pr6|393 007541 aa 6 00554 2521 00 spri2 pr6|364 007542 aa 6 00546 6211 00 eax1 pr6|358 007543 aa 014000 4310 07 fld 6144,dl 007544 aa 6 00044 3701 20 epp4 pr6|36,* 007545 la 4 00066 3521 20 epp2 pr4|54,* apl_print_value_ 007546 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2176 in_printer = "0"b; 007547 aa 6 00131 4501 00 stz pr6|89 in_printer STATEMENT 1 ON LINE 2177 go to nop_operator; 007550 aa 000042 7100 04 tra 34,ic 007612 STATEMENT 1 ON LINE 2179 monadic_action (18): /* assign to quote quad */ if rs (start - 1).semantics = null then go to value_error_s1; 007551 aa 6 00610 7251 00 lxl5 pr6|392 007552 aa 7 77772 2361 15 ldq pr7|-6,5 rs.semantics 007553 aa 004315 1160 04 cmpq 2253,ic 014070 = 007777000001 007554 aa 773431 6000 04 tze -2279,ic 003205 STATEMENT 1 ON LINE 2182 in_printer = "1"b; 007555 aa 400000 2350 03 lda 131072,du 007556 aa 6 00131 7551 00 sta pr6|89 in_printer STATEMENT 1 ON LINE 2183 call apl_print_value_ (rs (start - 1).semantics, "0"b, "1"b); 007557 aa 000000 2350 07 lda 0,dl 007560 aa 6 00611 7551 00 sta pr6|393 007561 aa 400000 2350 03 lda 131072,du 007562 aa 6 00606 7551 00 sta pr6|390 007563 aa 7 77772 3521 15 epp2 pr7|-6,5 rs.semantics 007564 aa 6 00550 2521 00 spri2 pr6|360 007565 aa 6 00611 3521 00 epp2 pr6|393 007566 aa 6 00552 2521 00 spri2 pr6|362 007567 aa 6 00606 3521 00 epp2 pr6|390 007570 aa 6 00554 2521 00 spri2 pr6|364 007571 aa 6 00546 6211 00 eax1 pr6|358 007572 aa 014000 4310 07 fld 6144,dl 007573 aa 6 00044 3701 20 epp4 pr6|36,* 007574 la 4 00066 3521 20 epp2 pr4|54,* apl_print_value_ 007575 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2184 in_printer = "0"b; 007576 aa 6 00131 4501 00 stz pr6|89 in_printer STATEMENT 1 ON LINE 2185 go to nop_operator; 007577 aa 000013 7100 04 tra 11,ic 007612 STATEMENT 1 ON LINE 2187 monadic_action (19): /* assign to system variables */ call setup_monadic_operator_routine_call; 007600 aa 000500 6700 04 tsp4 320,ic 010300 STATEMENT 1 ON LINE 2189 call apl_system_variables_ (operators_argument); 007601 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007602 aa 6 00544 2521 00 spri2 pr6|356 007603 aa 6 00542 6211 00 eax1 pr6|354 007604 aa 004000 4310 07 fld 2048,dl 007605 aa 6 00044 3701 20 epp4 pr6|36,* 007606 la 4 00244 3521 20 epp2 pr4|164,* apl_system_variables_ 007607 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2190 if operators_argument.error_code ^= 0 then go to report_error_from_operator; 007610 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 007611 aa 773662 6010 04 tnz -2126,ic 003473 STATEMENT 1 ON LINE 2193 nop_operator: dont_interrupt_parse = "1"b; 007612 aa 400000 2350 03 lda 131072,du 007613 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 007614 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2195 print_final_value = "0"b; 007615 aa 6 00161 4501 00 stz pr6|113 print_final_value STATEMENT 1 ON LINE 2196 rs (put_result).semantics = rs (start - 1).semantics; 007616 aa 6 00156 2361 00 ldq pr6|110 put_result 007617 aa 000002 7360 00 qls 2 007620 aa 000000 6270 06 eax7 0,ql 007621 aa 6 00155 2361 00 ldq pr6|109 start 007622 aa 000002 7360 00 qls 2 007623 aa 6 00126 3715 20 epp5 pr6|86,* rsp 007624 aa 000000 6260 06 eax6 0,ql 007625 aa 5 77772 2361 06 ldq pr5|-6,ql rs.semantics 007626 aa 5 77776 7561 17 stq pr5|-2,7 rs.semantics STATEMENT 1 ON LINE 2197 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 007627 aa 5 77771 2351 16 lda pr5|-7,6 007630 aa 5 77775 7551 17 sta pr5|-3,7 STATEMENT 1 ON LINE 2198 go to operator_return (return_point); 007631 aa 6 00157 7251 00 lxl5 pr6|111 return_point 007632 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 2200 monadic_action (20): /* assign to system variable which ignores assignment */ go to nop_operator; 007633 aa 777757 7100 04 tra -17,ic 007612 STATEMENT 1 ON LINE 2203 monadic_action (21): /* monadic system functions */ call setup_monadic_operator_routine_call; 007634 aa 000444 6700 04 tsp4 292,ic 010300 STATEMENT 1 ON LINE 2205 parse_frame.current_parseme = current_parseme; 007635 aa 6 00132 2361 00 ldq pr6|90 current_parseme 007636 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 007637 aa 7 00005 7561 00 stq pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2206 call apl_system_functions_ (operators_argument); 007640 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 007641 aa 6 00544 2521 00 spri2 pr6|356 007642 aa 6 00542 6211 00 eax1 pr6|354 007643 aa 004000 4310 07 fld 2048,dl 007644 aa 6 00044 3701 20 epp4 pr6|36,* 007645 la 4 00246 3521 20 epp2 pr4|166,* apl_system_functions_ 007646 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2207 call finish_monadic_operator_routine_call; 007647 aa 000465 6700 04 tsp4 309,ic 010334 STATEMENT 1 ON LINE 2208 go to operator_return (return_point); 007650 aa 6 00157 7271 00 lxl7 pr6|111 return_point 007651 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2210 monadic_action (22): /* assign to stop/trace */ print_final_value = "0"b; 007652 aa 6 00161 4501 00 stz pr6|113 print_final_value STATEMENT 1 ON LINE 2212 if rs (start - 1).semantics = null then go to value_error_s2; 007653 aa 6 00610 7251 00 lxl5 pr6|392 007654 aa 7 77772 2361 15 ldq pr7|-6,5 rs.semantics 007655 aa 004213 1160 04 cmpq 2187,ic 014070 = 007777000001 007656 aa 773305 6000 04 tze -2363,ic 003163 STATEMENT 1 ON LINE 2215 temp_ptr = rs (start - 1).semantics; 007657 aa 7 77772 7651 15 lprp5 pr7|-6,5 rs.semantics 007660 aa 6 00150 6515 00 spri5 pr6|104 temp_ptr STATEMENT 1 ON LINE 2216 if rs (start).op1 = assign_to_stop_code then value_bead_ptr = addr (rs (start).semantics -> function_bead.stop_control_pointer); 007661 aa 6 00612 2361 00 ldq pr6|394 rs.op1 007662 aa 000160 1160 07 cmpq 112,dl 007663 aa 000005 6010 04 tnz 5,ic 007670 007664 aa 7 77776 7631 15 lprp3 pr7|-2,5 rs.semantics 007665 aa 3 00004 3515 00 epp1 pr3|4 function_bead.stop_control_pointer 007666 aa 6 00152 2515 00 spri1 pr6|106 value_bead_ptr 007667 aa 000004 7100 04 tra 4,ic 007673 STATEMENT 1 ON LINE 2218 else value_bead_ptr = addr (rs (start).semantics -> function_bead.trace_control_pointer); 007670 aa 7 77776 7631 15 lprp3 pr7|-2,5 rs.semantics 007671 aa 3 00005 3515 00 epp1 pr3|5 function_bead.trace_control_pointer 007672 aa 6 00152 2515 00 spri1 pr6|106 value_bead_ptr STATEMENT 1 ON LINE 2220 if temp_ptr -> value_bead.character_value then if temp_ptr -> value_bead.total_data_elements ^= 0 /* not '' */ then go to domain_error; 007673 aa 5 00000 2351 00 lda pr5|0 value_bead.character_value 007674 aa 000400 3150 03 cana 256,du 007675 aa 000003 6000 04 tze 3,ic 007700 007676 aa 5 00002 2361 00 ldq pr5|2 value_bead.total_data_elements 007677 aa 773245 6010 04 tnz -2395,ic 003144 STATEMENT 1 ON LINE 2225 if value_bead_ptr -> based_unaligned_ptr ^= null then call decrement_reference_count (value_bead_ptr -> based_unaligned_ptr); 007700 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 007701 aa 1 00000 00 0044 descb pr1|0,36 based_unaligned_ptr 007702 aa 6 00056 00 0044 descb pr6|46,36 007703 aa 6 00056 2351 00 lda pr6|46 007704 aa 000044 7730 00 lrl 36 007705 aa 004163 1160 04 cmpq 2163,ic 014070 = 007777000001 007706 aa 000007 6000 04 tze 7,ic 007715 007707 aa 1 00000 3521 00 epp2 pr1|0 based_unaligned_ptr 007710 aa 6 00550 2521 00 spri2 pr6|360 007711 aa 6 00546 3521 00 epp2 pr6|358 007712 aa 004000 4310 07 fld 2048,dl 007713 aa 2 00000 7571 00 staq pr2|0 007714 aa 001661 6700 04 tsp4 945,ic 011575 STATEMENT 1 ON LINE 2228 assignment_done = "0"b; 007715 aa 6 00100 4501 00 stz pr6|64 assignment_done STATEMENT 1 ON LINE 2230 if temp_ptr -> value_bead.total_data_elements = 0 then assignment_done = "1"b; 007716 aa 6 00150 3735 20 epp7 pr6|104,* temp_ptr 007717 aa 7 00002 2361 00 ldq pr7|2 value_bead.total_data_elements 007720 aa 000004 6010 04 tnz 4,ic 007724 007721 aa 400000 2350 03 lda 131072,du 007722 aa 6 00100 7551 00 sta pr6|64 assignment_done 007723 aa 000010 7100 04 tra 8,ic 007733 STATEMENT 1 ON LINE 2232 else if (temp_ptr -> value_bead.total_data_elements = 1 & temp_ptr -> value_bead.data_pointer -> numeric_datum (0) = 0.0e0) then assignment_done = "1"b; 007724 aa 000001 1160 07 cmpq 1,dl 007725 aa 000006 6010 04 tnz 6,ic 007733 007726 aa 7 00004 7651 00 lprp5 pr7|4 value_bead.data_pointer 007727 aa 5 00000 4331 00 dfld pr5|0 numeric_datum 007730 aa 000003 6010 04 tnz 3,ic 007733 007731 aa 400000 2350 03 lda 131072,du 007732 aa 6 00100 7551 00 sta pr6|64 assignment_done STATEMENT 1 ON LINE 2236 if ^assignment_done then do; 007733 aa 6 00100 2351 00 lda pr6|64 assignment_done 007734 aa 000032 6010 04 tnz 26,ic 007766 STATEMENT 1 ON LINE 2238 ws_info.dont_interrupt_parse = "0"b; 007735 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 007736 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2239 call apl_copy_value_ (rs (start - 1).semantics, value_bead_ptr -> based_unaligned_ptr); 007737 aa 6 00155 2361 00 ldq pr6|109 start 007740 aa 000002 7360 00 qls 2 007741 aa 6 00126 3535 20 epp3 pr6|86,* rsp 007742 aa 3 77772 3521 06 epp2 pr3|-6,ql rs.semantics 007743 aa 6 00550 2521 00 spri2 pr6|360 007744 aa 6 00152 3521 20 epp2 pr6|106,* based_unaligned_ptr 007745 aa 6 00552 2521 00 spri2 pr6|362 007746 aa 6 00546 6211 00 eax1 pr6|358 007747 aa 010000 4310 07 fld 4096,dl 007750 aa 6 00044 3701 20 epp4 pr6|36,* 007751 la 4 00230 3521 20 epp2 pr4|152,* apl_copy_value_ 007752 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2240 ws_info.dont_interrupt_parse = "1"b; 007753 aa 400000 2350 03 lda 131072,du 007754 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 007755 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2241 value_bead_ptr -> based_unaligned_ptr -> value_bead.label = "0"b; 007756 aa 6 00152 3715 20 epp5 pr6|106,* value_bead_ptr 007757 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 007760 aa 5 00000 00 0044 descb pr5|0,36 based_unaligned_ptr 007761 aa 6 00610 00 0044 descb pr6|392,36 based_unaligned_ptr 007762 aa 6 00610 7631 00 lprp3 pr6|392 based_unaligned_ptr 007763 aa 004063 2350 04 lda 2099,ic 014046 = 767777777777 007764 aa 3 00000 3551 00 ansa pr3|0 value_bead.label STATEMENT 1 ON LINE 2242 value_bead_ptr -> based_unaligned_ptr -> value_bead.reference_count = value_bead_ptr -> based_unaligned_ptr -> value_bead.reference_count + 1; 007765 aa 3 00001 0541 00 aos pr3|1 value_bead.reference_count STATEMENT 1 ON LINE 2244 end; STATEMENT 1 ON LINE 2246 call decrement_reference_count (rs (start).semantics); 007766 aa 6 00155 2361 00 ldq pr6|109 start 007767 aa 000002 7360 00 qls 2 007770 aa 6 00126 3735 20 epp7 pr6|86,* rsp 007771 aa 7 77776 3521 06 epp2 pr7|-2,ql rs.semantics 007772 aa 6 00550 2521 00 spri2 pr6|360 007773 aa 6 00546 3521 00 epp2 pr6|358 007774 aa 004000 4310 07 fld 2048,dl 007775 aa 2 00000 7571 00 staq pr2|0 007776 aa 001577 6700 04 tsp4 895,ic 011575 STATEMENT 1 ON LINE 2247 rs (put_result).semantics = rs (start - 1).semantics; 007777 aa 6 00156 2361 00 ldq pr6|110 put_result 010000 aa 000002 7360 00 qls 2 010001 aa 000000 6270 06 eax7 0,ql 010002 aa 6 00155 2361 00 ldq pr6|109 start 010003 aa 000002 7360 00 qls 2 010004 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010005 aa 000000 6260 06 eax6 0,ql 010006 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 010007 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 2248 unspec (rs (put_result).bits) = unspec (rs (start - 1).bits); 010010 aa 7 77771 2351 16 lda pr7|-7,6 010011 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 2249 go to operator_return (return_point); 010012 aa 6 00157 7251 00 lxl5 pr6|111 return_point 010013 ta 777777 7100 15 tra -1,5 STATEMENT 1 ON LINE 2251 monadic_action (23): /* monadic iota */ call setup_monadic_operator_routine_call; 010014 aa 000264 6700 04 tsp4 180,ic 010300 STATEMENT 1 ON LINE 2253 call apl_monadic_iota_ (operators_argument); 010015 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010016 aa 6 00544 2521 00 spri2 pr6|356 010017 aa 6 00542 6211 00 eax1 pr6|354 010020 aa 004000 4310 07 fld 2048,dl 010021 aa 6 00044 3701 20 epp4 pr6|36,* 010022 la 4 00224 3521 20 epp2 pr4|148,* apl_monadic_iota_ 010023 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2254 call finish_monadic_operator_routine_call; 010024 aa 000310 6700 04 tsp4 200,ic 010334 STATEMENT 1 ON LINE 2255 go to operator_return (return_point); 010025 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010026 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2257 monadic_action (24): /* monadic rho */ call setup_monadic_operator_routine_call; 010027 aa 000251 6700 04 tsp4 169,ic 010300 STATEMENT 1 ON LINE 2259 call apl_monadic_rho_ (operators_argument); 010030 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010031 aa 6 00544 2521 00 spri2 pr6|356 010032 aa 6 00542 6211 00 eax1 pr6|354 010033 aa 004000 4310 07 fld 2048,dl 010034 aa 6 00044 3701 20 epp4 pr6|36,* 010035 la 4 00226 3521 20 epp2 pr4|150,* apl_monadic_rho_ 010036 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2260 call finish_monadic_operator_routine_call; 010037 aa 000275 6700 04 tsp4 189,ic 010334 STATEMENT 1 ON LINE 2261 go to operator_return (return_point); 010040 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010041 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2263 monadic_action (25): /* monadic domino */ call setup_monadic_operator_routine_call; 010042 aa 000236 6700 04 tsp4 158,ic 010300 STATEMENT 1 ON LINE 2265 call apl_domino_operator_ (operators_argument); 010043 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010044 aa 6 00544 2521 00 spri2 pr6|356 010045 aa 6 00542 6211 00 eax1 pr6|354 010046 aa 004000 4310 07 fld 2048,dl 010047 aa 6 00044 3701 20 epp4 pr6|36,* 010050 la 4 00272 3521 20 epp2 pr4|186,* apl_domino_operator_ 010051 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2266 call finish_monadic_operator_routine_call; 010052 aa 000262 6700 04 tsp4 178,ic 010334 STATEMENT 1 ON LINE 2267 go to operator_return (return_point); 010053 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010054 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2269 monadic_action (26): /* roll */ call setup_monadic_operator_routine_call; 010055 aa 000223 6700 04 tsp4 147,ic 010300 STATEMENT 1 ON LINE 2271 call apl_random_ (operators_argument); 010056 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010057 aa 6 00544 2521 00 spri2 pr6|356 010060 aa 6 00542 6211 00 eax1 pr6|354 010061 aa 004000 4310 07 fld 2048,dl 010062 aa 6 00044 3701 20 epp4 pr6|36,* 010063 la 4 00306 3521 20 epp2 pr4|198,* apl_random_ 010064 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2272 call finish_monadic_operator_routine_call; 010065 aa 000247 6700 04 tsp4 167,ic 010334 STATEMENT 1 ON LINE 2273 go to operator_return (return_point); 010066 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010067 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2275 monadic_action (27): /* grade up */ call setup_monadic_operator_routine_call; 010070 aa 000210 6700 04 tsp4 136,ic 010300 STATEMENT 1 ON LINE 2277 if rs (start).semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 010071 aa 6 00155 2361 00 ldq pr6|109 start 010072 aa 000002 7360 00 qls 2 010073 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010074 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 010075 aa 004000 3150 03 cana 2048,du 010076 aa 6 00612 7561 00 stq pr6|394 010077 aa 000004 6000 04 tze 4,ic 010103 010100 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 010101 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 010102 aa 000004 7100 04 tra 4,ic 010106 STATEMENT 1 ON LINE 2279 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 010103 aa 7 77772 7651 06 lprp5 pr7|-6,ql rs.semantics 010104 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 010105 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2281 call apl_grade_up_ (operators_argument); 010106 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010107 aa 6 00544 2521 00 spri2 pr6|356 010110 aa 6 00542 6211 00 eax1 pr6|354 010111 aa 004000 4310 07 fld 2048,dl 010112 aa 6 00044 3701 20 epp4 pr6|36,* 010113 la 4 00310 3521 20 epp2 pr4|200,* apl_grade_up_ 010114 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2282 call finish_monadic_operator_routine_call; 010115 aa 000217 6700 04 tsp4 143,ic 010334 STATEMENT 1 ON LINE 2283 go to operator_return (return_point); 010116 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010117 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2285 monadic_action (28): /* grade down */ call setup_monadic_operator_routine_call; 010120 aa 000160 6700 04 tsp4 112,ic 010300 STATEMENT 1 ON LINE 2287 if rs (start).semantics_valid then operators_argument.dimension = rs_for_op (start).semantics; 010121 aa 6 00155 2361 00 ldq pr6|109 start 010122 aa 000002 7360 00 qls 2 010123 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010124 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 010125 aa 004000 3150 03 cana 2048,du 010126 aa 6 00612 7561 00 stq pr6|394 010127 aa 000004 6000 04 tze 4,ic 010133 010130 aa 7 77776 2361 06 ldq pr7|-2,ql rs_for_op.semantics 010131 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension 010132 aa 000004 7100 04 tra 4,ic 010136 STATEMENT 1 ON LINE 2289 else operators_argument.dimension = rs (start - 1).semantics -> value_bead.rhorho; 010133 aa 7 77772 7651 06 lprp5 pr7|-6,ql rs.semantics 010134 aa 5 00003 2361 00 ldq pr5|3 value_bead.rhorho 010135 aa 6 00202 7561 00 stq pr6|130 operators_argument.dimension STATEMENT 1 ON LINE 2291 call apl_grade_down_ (operators_argument); 010136 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010137 aa 6 00544 2521 00 spri2 pr6|356 010140 aa 6 00542 6211 00 eax1 pr6|354 010141 aa 004000 4310 07 fld 2048,dl 010142 aa 6 00044 3701 20 epp4 pr6|36,* 010143 la 4 00312 3521 20 epp2 pr4|202,* apl_grade_down_ 010144 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2292 call finish_monadic_operator_routine_call; 010145 aa 000167 6700 04 tsp4 119,ic 010334 STATEMENT 1 ON LINE 2293 go to operator_return (return_point); 010146 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010147 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 2295 monadic_action (29): /* monadic laminate (invalid) */ go to context_error_0; 010150 aa 772761 7100 04 tra -2575,ic 003131 STATEMENT 1 ON LINE 2298 monadic_action (30): /* monadic qCALL system function */ call setup_monadic_operator_routine_call; 010151 aa 000127 6700 04 tsp4 87,ic 010300 STATEMENT 1 ON LINE 2300 call apl_quadcall_ (operators_argument); 010152 aa 6 00176 3521 00 epp2 pr6|126 operators_argument 010153 aa 6 00544 2521 00 spri2 pr6|356 010154 aa 6 00542 6211 00 eax1 pr6|354 010155 aa 004000 4310 07 fld 2048,dl 010156 aa 6 00044 3701 20 epp4 pr6|36,* 010157 la 4 00314 3521 20 epp2 pr4|204,* apl_quadcall_ 010160 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2301 call finish_monadic_operator_routine_call; 010161 aa 000153 6700 04 tsp4 107,ic 010334 STATEMENT 1 ON LINE 2302 goto operator_return (return_point); 010162 aa 6 00157 7271 00 lxl7 pr6|111 return_point 010163 ta 777777 7100 17 tra -1,7 STATEMENT 1 ON LINE 3429 end /* apl_parse_ */; BEGIN PROCEDURE setup_dyadic_operator_routine_ca ENTRY TO setup_dyadic_operator_routine_ca STATEMENT 1 ON LINE 2305 setup_dyadic_operator_routine_call: proc; 010164 aa 6 00214 6501 00 spri4 pr6|140 STATEMENT 1 ON LINE 2308 if rs (start).semantics = null then go to value_error_s0; 010165 aa 6 00155 2361 00 ldq pr6|109 start 010166 aa 000002 7360 00 qls 2 010167 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010170 aa 000000 6270 06 eax7 0,ql 010171 aa 7 77776 2361 06 ldq pr7|-2,ql rs.semantics 010172 aa 003676 1160 04 cmpq 1982,ic 014070 = 007777000001 010173 aa 773001 6000 04 tze -2559,ic 003174 STATEMENT 1 ON LINE 2310 if rs (start - 2).semantics = null then go to value_error_s2; 010174 aa 7 77766 2361 17 ldq pr7|-10,7 rs.semantics 010175 aa 003673 1160 04 cmpq 1979,ic 014070 = 007777000001 010176 aa 772765 6000 04 tze -2571,ic 003163 STATEMENT 1 ON LINE 2313 operators_argument.value (1) = rs (start).semantics; 010177 aa 7 77776 2361 17 ldq pr7|-2,7 rs.semantics 010200 aa 6 00176 7561 00 stq pr6|126 operators_argument.value STATEMENT 1 ON LINE 2314 operators_argument.value (2) = rs (start - 2).semantics; 010201 aa 7 77766 2361 17 ldq pr7|-10,7 rs.semantics 010202 aa 6 00200 7561 00 stq pr6|128 operators_argument.value STATEMENT 1 ON LINE 2315 operators_argument.on_stack (1) = rs (start).bits.semantics_on_stack; 010203 aa 7 77775 2351 17 lda pr7|-3,7 rs.semantics_on_stack 010204 aa 000011 7350 00 als 9 010205 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 010206 aa 6 00177 7551 00 sta pr6|127 operators_argument.on_stack STATEMENT 1 ON LINE 2316 operators_argument.on_stack (2) = rs (start - 2).bits.semantics_on_stack; 010207 aa 6 00155 2361 00 ldq pr6|109 start 010210 aa 000002 1760 07 sbq 2,dl 010211 aa 000002 7360 00 qls 2 010212 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_on_stack 010213 aa 000011 7350 00 als 9 010214 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 010215 aa 6 00201 7551 00 sta pr6|129 operators_argument.on_stack STATEMENT 1 ON LINE 2317 operators_argument.op1 = rs (start - 1).bits.op1; 010216 aa 6 00155 2361 00 ldq pr6|109 start 010217 aa 000001 1760 07 sbq 1,dl 010220 aa 000002 7360 00 qls 2 010221 aa 7 77775 2351 06 lda pr7|-3,ql rs.op1 010222 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2318 operators_argument.error_code = 0; 010223 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 2320 dont_interrupt_parse = "0"b; 010224 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010225 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2321 if dirty_interrupt_pending then go to dirty_stop; 010226 aa 5 00107 2351 00 lda pr5|71 ws_info.dirty_interrupt_pending 010227 aa 773217 6010 04 tnz -2417,ic 003446 STATEMENT 1 ON LINE 2324 return; 010230 aa 6 00214 6101 00 rtcd pr6|140 STATEMENT 1 ON LINE 2326 end; END PROCEDURE setup_dyadic_operator_routine_ca BEGIN PROCEDURE finish_dyadic_operator_routine_c ENTRY TO finish_dyadic_operator_routine_c STATEMENT 1 ON LINE 2329 finish_dyadic_operator_routine_call: proc; 010231 aa 6 00222 6501 00 spri4 pr6|146 STATEMENT 1 ON LINE 2332 if operators_argument.error_code ^= 0 /* Operator discovered an error... */ then go to report_error_from_operator; 010232 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 010233 aa 773240 6010 04 tnz -2400,ic 003473 STATEMENT 1 ON LINE 2335 ws_info.dont_interrupt_parse = "1"b; 010234 aa 400000 2350 03 lda 131072,du 010235 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 010236 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2337 if ^operators_argument.on_stack (1) then call decrement_reference_count (rs (start).semantics); 010237 aa 6 00177 2351 00 lda pr6|127 operators_argument.on_stack 010240 aa 400000 3150 03 cana 131072,du 010241 aa 000012 6010 04 tnz 10,ic 010253 010242 aa 6 00155 2361 00 ldq pr6|109 start 010243 aa 000002 7360 00 qls 2 010244 aa 6 00126 3715 20 epp5 pr6|86,* rsp 010245 aa 5 77776 3521 06 epp2 pr5|-2,ql rs.semantics 010246 aa 6 00656 2521 00 spri2 pr6|430 010247 aa 6 00654 3521 00 epp2 pr6|428 010250 aa 004000 4310 07 fld 2048,dl 010251 aa 2 00000 7571 00 staq pr2|0 010252 aa 001323 6700 04 tsp4 723,ic 011575 STATEMENT 1 ON LINE 2340 if ^operators_argument.on_stack (2) then call decrement_reference_count (rs (start - 2).semantics); 010253 aa 6 00201 2351 00 lda pr6|129 operators_argument.on_stack 010254 aa 400000 3150 03 cana 131072,du 010255 aa 000012 6010 04 tnz 10,ic 010267 010256 aa 6 00155 2361 00 ldq pr6|109 start 010257 aa 000002 7360 00 qls 2 010260 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010261 aa 7 77766 3521 06 epp2 pr7|-10,ql rs.semantics 010262 aa 6 00656 2521 00 spri2 pr6|430 010263 aa 6 00654 3521 00 epp2 pr6|428 010264 aa 004000 4310 07 fld 2048,dl 010265 aa 2 00000 7571 00 staq pr2|0 010266 aa 001307 6700 04 tsp4 711,ic 011575 STATEMENT 1 ON LINE 2343 rs (put_result).semantics = operators_argument.result; 010267 aa 6 00156 2361 00 ldq pr6|110 put_result 010270 aa 000002 7360 00 qls 2 010271 aa 000000 6270 06 eax7 0,ql 010272 aa 6 00204 2361 00 ldq pr6|132 operators_argument.result 010273 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010274 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 2344 unspec (rs (put_result).bits) = computed_value_bits; 010275 aa 004400 2350 03 lda 2304,du 010276 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 2347 return; 010277 aa 6 00222 6101 00 rtcd pr6|146 STATEMENT 1 ON LINE 2349 end; END PROCEDURE finish_dyadic_operator_routine_c BEGIN PROCEDURE setup_monadic_operator_routine_c ENTRY TO setup_monadic_operator_routine_c STATEMENT 1 ON LINE 2351 setup_monadic_operator_routine_call: procedure; 010300 aa 6 00230 6501 00 spri4 pr6|152 STATEMENT 1 ON LINE 2354 if rs (start - 1).semantics = null then go to value_error_s1; 010301 aa 6 00155 2361 00 ldq pr6|109 start 010302 aa 000002 7360 00 qls 2 010303 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010304 aa 000000 6270 06 eax7 0,ql 010305 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 010306 aa 003562 1160 04 cmpq 1906,ic 014070 = 007777000001 010307 aa 772676 6000 04 tze -2626,ic 003205 STATEMENT 1 ON LINE 2357 operators_argument.value (1) = null; 010310 aa 003560 2360 04 ldq 1904,ic 014070 = 007777000001 010311 aa 6 00176 7561 00 stq pr6|126 operators_argument.value STATEMENT 1 ON LINE 2358 operators_argument.value (2) = rs (start - 1).semantics; 010312 aa 7 77772 2361 17 ldq pr7|-6,7 rs.semantics 010313 aa 6 00200 7561 00 stq pr6|128 operators_argument.value STATEMENT 1 ON LINE 2359 operators_argument.on_stack (1) = "0"b; 010314 aa 6 00177 4501 00 stz pr6|127 operators_argument.on_stack STATEMENT 1 ON LINE 2360 operators_argument.on_stack (2) = rs (start - 1).bits.semantics_on_stack; 010315 aa 6 00155 2361 00 ldq pr6|109 start 010316 aa 000001 1760 07 sbq 1,dl 010317 aa 000002 7360 00 qls 2 010320 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_on_stack 010321 aa 000011 7350 00 als 9 010322 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 010323 aa 6 00201 7551 00 sta pr6|129 operators_argument.on_stack STATEMENT 1 ON LINE 2361 operators_argument.op1 = rs (start).bits.op1; 010324 aa 7 77775 2351 17 lda pr7|-3,7 rs.op1 010325 aa 6 00203 5511 04 stba pr6|131,04 operators_argument.op1 STATEMENT 1 ON LINE 2362 operators_argument.error_code = 0; 010326 aa 6 00205 4501 00 stz pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 2364 dont_interrupt_parse = "0"b; 010327 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010330 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2365 if dirty_interrupt_pending then go to dirty_stop; 010331 aa 5 00107 2351 00 lda pr5|71 ws_info.dirty_interrupt_pending 010332 aa 773114 6010 04 tnz -2484,ic 003446 STATEMENT 1 ON LINE 2368 return; 010333 aa 6 00230 6101 00 rtcd pr6|152 STATEMENT 1 ON LINE 2370 end; END PROCEDURE setup_monadic_operator_routine_c BEGIN PROCEDURE finish_monadic_operator_routine_ ENTRY TO finish_monadic_operator_routine_ STATEMENT 1 ON LINE 2373 finish_monadic_operator_routine_call: proc; 010334 aa 6 00236 6501 00 spri4 pr6|158 STATEMENT 1 ON LINE 2376 if operators_argument.error_code ^= 0 /* Operator ran into a problem... */ then go to report_error_from_operator; 010335 aa 6 00205 2361 00 ldq pr6|133 operators_argument.error_code 010336 aa 773135 6010 04 tnz -2467,ic 003473 STATEMENT 1 ON LINE 2379 ws_info.dont_interrupt_parse = "1"b; 010337 aa 400000 2350 03 lda 131072,du 010340 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 010341 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2381 if ^operators_argument.on_stack (2) then call decrement_reference_count (rs (start - 1).semantics); 010342 aa 6 00201 2351 00 lda pr6|129 operators_argument.on_stack 010343 aa 400000 3150 03 cana 131072,du 010344 aa 000012 6010 04 tnz 10,ic 010356 010345 aa 6 00155 2361 00 ldq pr6|109 start 010346 aa 000002 7360 00 qls 2 010347 aa 6 00126 3715 20 epp5 pr6|86,* rsp 010350 aa 5 77772 3521 06 epp2 pr5|-6,ql rs.semantics 010351 aa 6 00666 2521 00 spri2 pr6|438 010352 aa 6 00664 3521 00 epp2 pr6|436 010353 aa 004000 4310 07 fld 2048,dl 010354 aa 2 00000 7571 00 staq pr2|0 010355 aa 001220 6700 04 tsp4 656,ic 011575 STATEMENT 1 ON LINE 2384 rs (put_result).semantics = operators_argument.result; 010356 aa 6 00156 2361 00 ldq pr6|110 put_result 010357 aa 000002 7360 00 qls 2 010360 aa 000000 6270 06 eax7 0,ql 010361 aa 6 00204 2361 00 ldq pr6|132 operators_argument.result 010362 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010363 aa 7 77776 7561 17 stq pr7|-2,7 rs.semantics STATEMENT 1 ON LINE 2385 unspec (rs (put_result).bits) = computed_value_bits; 010364 aa 004400 2350 03 lda 2304,du 010365 aa 7 77775 7551 17 sta pr7|-3,7 STATEMENT 1 ON LINE 2388 return; 010366 aa 6 00236 6101 00 rtcd pr6|158 STATEMENT 1 ON LINE 2390 end; END PROCEDURE finish_monadic_operator_routine_ BEGIN PROCEDURE restore_system_variable_value ENTRY TO restore_system_variable_value STATEMENT 1 ON LINE 2395 restore_system_variable_value: procedure (P_operator_bead_ptr, P_bead_ptr); 010367 aa 6 00244 6501 00 spri4 pr6|164 010370 aa 6 00246 2521 00 spri2 pr6|166 STATEMENT 1 ON LINE 2416 bead_ptr = P_bead_ptr; 010371 aa 2 00004 3735 20 epp7 pr2|4,* 010372 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 010373 aa 7 00000 00 0044 descb pr7|0,36 P_bead_ptr 010374 aa 6 00056 00 0044 descb pr6|46,36 010375 aa 6 00056 2351 00 lda pr6|46 010376 aa 000044 7730 00 lrl 36 010377 aa 6 00252 7561 00 stq pr6|170 bead_ptr STATEMENT 1 ON LINE 2418 if P_operator_bead_ptr -> operator_bead.op2 ^= 4 /* qLX */ then value = bead_ptr -> value_bead.data_pointer -> numeric_datum (0); 010400 aa 2 00002 3715 20 epp5 pr2|2,* P_operator_bead_ptr 010401 aa 5 00000 3715 20 epp5 pr5|0,* P_operator_bead_ptr 010402 aa 5 00001 2351 00 lda pr5|1 operator_bead.op2 010403 aa 000022 7350 00 als 18 010404 aa 000077 7330 00 lrs 63 010405 aa 000004 1160 07 cmpq 4,dl 010406 aa 000005 6000 04 tze 5,ic 010413 010407 aa 6 00252 7631 00 lprp3 pr6|170 bead_ptr 010410 aa 3 00004 7611 00 lprp1 pr3|4 value_bead.data_pointer 010411 aa 1 00000 4331 00 dfld pr1|0 numeric_datum 010412 aa 6 00254 4571 00 dfst pr6|172 value STATEMENT 1 ON LINE 2421 go to set_value (P_operator_bead_ptr -> operator_bead.op1); 010413 aa 5 00001 2351 00 lda pr5|1 operator_bead.op1 010414 aa 000033 7350 00 als 27 010415 aa 000077 7330 00 lrs 63 010416 ta 000155 7100 06 tra 109,ql STATEMENT 1 ON LINE 2423 set_value (2): /* qCT */ ws_info.fuzz = value; 010417 aa 6 00254 4331 00 dfld pr6|172 value 010420 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010421 aa 3 00006 4571 00 dfst pr3|6 ws_info.fuzz STATEMENT 1 ON LINE 2425 go to end_set_value; 010422 aa 000047 7100 04 tra 39,ic 010471 STATEMENT 1 ON LINE 2427 set_value (3): /* qIO */ ws_info.float_index_origin = value; 010423 aa 6 00254 4331 00 dfld pr6|172 value 010424 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010425 aa 3 00010 4571 00 dfst pr3|8 ws_info.float_index_origin STATEMENT 1 ON LINE 2429 ws_info.index_origin = fixed (value, 35); 010426 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 010427 aa 3 00004 7561 00 stq pr3|4 ws_info.index_origin STATEMENT 1 ON LINE 2430 go to end_set_value; 010430 aa 000041 7100 04 tra 33,ic 010471 STATEMENT 1 ON LINE 2432 set_value (4): /* qLX */ call decrement_reference_count (ws_info.latent_expression); 010431 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010432 aa 3 00025 3521 00 epp2 pr3|21 ws_info.latent_expression 010433 aa 6 00676 2521 00 spri2 pr6|446 010434 aa 6 00674 3521 00 epp2 pr6|444 010435 aa 004000 4310 07 fld 2048,dl 010436 aa 2 00000 7571 00 staq pr2|0 010437 aa 001136 6700 04 tsp4 606,ic 011575 STATEMENT 1 ON LINE 2434 bead_ptr -> general_bead.reference_count = bead_ptr -> general_bead.reference_count + 1; 010440 aa 6 00252 7671 00 lprp7 pr6|170 bead_ptr 010441 aa 7 00001 0541 00 aos pr7|1 general_bead.reference_count STATEMENT 1 ON LINE 2435 ws_info.latent_expression = bead_ptr; 010442 aa 6 00252 2361 00 ldq pr6|170 bead_ptr 010443 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010444 aa 5 00025 7561 00 stq pr5|21 ws_info.latent_expression STATEMENT 1 ON LINE 2436 go to end_set_value; 010445 aa 000024 7100 04 tra 20,ic 010471 STATEMENT 1 ON LINE 2438 set_value (5): /* qPP */ ws_info.digits = fixed (value, 35); 010446 aa 6 00254 4331 00 dfld pr6|172 value 010447 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 010450 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010451 aa 3 00002 7561 00 stq pr3|2 ws_info.digits STATEMENT 1 ON LINE 2440 go to end_set_value; 010452 aa 000017 7100 04 tra 15,ic 010471 STATEMENT 1 ON LINE 2442 set_value (6): /* qPW */ ws_info.width = fixed (value, 35); 010453 aa 6 00254 4331 00 dfld pr6|172 value 010454 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 010455 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010456 aa 3 00003 7561 00 stq pr3|3 ws_info.width STATEMENT 1 ON LINE 2444 go to end_set_value; 010457 aa 000012 7100 04 tra 10,ic 010471 STATEMENT 1 ON LINE 2446 set_value (7): /* qRL */ ws_info.random_link = fixed (value, 35); 010460 aa 6 00254 4331 00 dfld pr6|172 value 010461 aa 0 00654 7001 00 tsx0 pr0|428 fl2_to_fx1 010462 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010463 aa 3 00005 7561 00 stq pr3|5 ws_info.random_link STATEMENT 1 ON LINE 2448 go to end_set_value; 010464 aa 000005 7100 04 tra 5,ic 010471 STATEMENT 1 ON LINE 2450 set_value (16): /* qIT */ ws_info.integer_fuzz = value; 010465 aa 6 00254 4331 00 dfld pr6|172 value 010466 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010467 aa 3 00022 4571 00 dfst pr3|18 ws_info.integer_fuzz STATEMENT 1 ON LINE 2452 go to end_set_value; 010470 aa 000001 7100 04 tra 1,ic 010471 STATEMENT 1 ON LINE 2454 end_set_value: call decrement_reference_count (bead_ptr); 010471 aa 003267 3520 04 epp2 1719,ic 013760 = 000002000000 010472 aa 001103 6700 04 tsp4 579,ic 011575 STATEMENT 1 ON LINE 2456 return; 010473 aa 6 00244 6101 00 rtcd pr6|164 STATEMENT 1 ON LINE 2458 end restore_system_variable_value; END PROCEDURE restore_system_variable_value BEGIN PROCEDURE save_system_variable_value ENTRY TO save_system_variable_value STATEMENT 1 ON LINE 2464 save_system_variable_value: procedure (P_bead_ptr) returns (ptr); 010474 aa 6 00256 6501 00 spri4 pr6|174 010475 aa 6 00260 2521 00 spri2 pr6|176 STATEMENT 1 ON LINE 2489 bead_ptr = P_bead_ptr; 010476 aa 2 00002 3735 20 epp7 pr2|2,* P_bead_ptr 010477 aa 7 00000 3735 20 epp7 pr7|0,* P_bead_ptr 010500 aa 6 00264 5471 00 sprp7 pr6|180 bead_ptr STATEMENT 1 ON LINE 2494 go to get_value (bead_ptr -> operator_bead.op1); 010501 aa 6 00264 7651 00 lprp5 pr6|180 bead_ptr 010502 aa 5 00001 2351 00 lda pr5|1 operator_bead.op1 010503 aa 000033 7350 00 als 27 010504 aa 000077 7330 00 lrs 63 010505 ta 000174 7100 06 tra 124,ql STATEMENT 1 ON LINE 2496 get_value (2): /* qCT */ value = ws_info.fuzz; 010506 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010507 aa 3 00006 4331 00 dfld pr3|6 ws_info.fuzz 010510 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2498 go to end_get_value; 010511 aa 000037 7100 04 tra 31,ic 010550 STATEMENT 1 ON LINE 2500 get_value (3): /* qIO */ value = ws_info.float_index_origin; 010512 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010513 aa 3 00010 4331 00 dfld pr3|8 ws_info.float_index_origin 010514 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2502 go to end_get_value; 010515 aa 000033 7100 04 tra 27,ic 010550 STATEMENT 1 ON LINE 2504 get_value (4): /* qLX */ ws_info.latent_expression -> general_bead.reference_count = ws_info.latent_expression -> general_bead.reference_count + 1; 010516 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010517 aa 3 00025 7631 00 lprp3 pr3|21 ws_info.latent_expression 010520 aa 3 00001 0541 00 aos pr3|1 general_bead.reference_count STATEMENT 1 ON LINE 2507 return (ws_info.latent_expression); 010521 aa 6 00174 3515 20 epp1 pr6|124,* ws_info_ptr 010522 aa 1 00025 7611 00 lprp1 pr1|21 ws_info.latent_expression 010523 aa 2 00004 2515 20 spri1 pr2|4,* 010524 aa 6 00256 6101 00 rtcd pr6|174 STATEMENT 1 ON LINE 2509 get_value (5): /* qPP */ value = float (ws_info.digits, 63); 010525 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010526 aa 3 00002 2361 00 ldq pr3|2 ws_info.digits 010527 aa 0 00465 7001 00 tsx0 pr0|309 fx1_to_fl2 010530 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2511 go to end_get_value; 010531 aa 000017 7100 04 tra 15,ic 010550 STATEMENT 1 ON LINE 2513 get_value (6): /* qPW */ value = float (ws_info.width, 63); 010532 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010533 aa 3 00003 2361 00 ldq pr3|3 ws_info.width 010534 aa 0 00465 7001 00 tsx0 pr0|309 fx1_to_fl2 010535 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2515 go to end_get_value; 010536 aa 000012 7100 04 tra 10,ic 010550 STATEMENT 1 ON LINE 2517 get_value (7): /* qRL */ value = float (ws_info.random_link, 63); 010537 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010540 aa 3 00005 2361 00 ldq pr3|5 ws_info.random_link 010541 aa 0 00465 7001 00 tsx0 pr0|309 fx1_to_fl2 010542 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2519 go to end_get_value; 010543 aa 000005 7100 04 tra 5,ic 010550 STATEMENT 1 ON LINE 2521 get_value (16): /* qIT */ value = ws_info.integer_fuzz; 010544 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010545 aa 3 00022 4331 00 dfld pr3|18 ws_info.integer_fuzz 010546 aa 6 00272 4571 00 dfst pr6|186 value STATEMENT 1 ON LINE 2523 go to end_get_value; 010547 aa 000001 7100 04 tra 1,ic 010550 STATEMENT 1 ON LINE 2525 end_get_value: number_of_dimensions = 0; 010550 aa 6 00210 4501 00 stz pr6|136 number_of_dimensions STATEMENT 1 ON LINE 2527 data_elements = 1; 010551 aa 000001 2360 07 ldq 1,dl 010552 aa 6 00154 7561 00 stq pr6|108 data_elements STATEMENT 1 ON LINE 2528 n_words = size (value_bead) + size (numeric_datum) + 1; 010553 aa 000001 7360 00 qls 1 010554 aa 6 00702 7561 00 stq pr6|450 010555 aa 6 00210 2361 00 ldq pr6|136 number_of_dimensions 010556 aa 000005 0760 07 adq 5,dl 010557 aa 6 00702 0761 00 adq pr6|450 010560 aa 000001 0760 07 adq 1,dl 010561 aa 6 00270 7561 00 stq pr6|184 n_words STATEMENT 1 ON LINE 2529 call apl_allocate_words_ (n_words, bead_ptr); 010562 aa 6 00270 3521 00 epp2 pr6|184 n_words 010563 aa 6 00706 2521 00 spri2 pr6|454 010564 aa 6 00264 3521 00 epp2 pr6|180 bead_ptr 010565 aa 6 00710 2521 00 spri2 pr6|456 010566 aa 6 00704 6211 00 eax1 pr6|452 010567 aa 010000 4310 07 fld 4096,dl 010570 aa 6 00044 3701 20 epp4 pr6|36,* 010571 la 4 00324 3521 20 epp2 pr4|212,* apl_allocate_words_ 010572 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2531 string (bead_ptr -> value_bead.type) = numeric_value_type; 010573 aa 6 00264 7671 00 lprp7 pr6|180 bead_ptr 010574 aa 100200 2350 03 lda 32896,du 010575 aa 7 00000 5511 60 stba pr7|0,60 STATEMENT 1 ON LINE 2532 bead_ptr -> value_bead.total_data_elements = data_elements; 010576 aa 6 00154 2361 00 ldq pr6|108 data_elements 010577 aa 7 00002 7561 00 stq pr7|2 value_bead.total_data_elements STATEMENT 1 ON LINE 2533 bead_ptr -> value_bead.rhorho = 0; 010600 aa 7 00003 4501 00 stz pr7|3 value_bead.rhorho STATEMENT 1 ON LINE 2534 data_ptr = addrel (bead_ptr, size (value_bead)); 010601 aa 6 00210 2361 00 ldq pr6|136 number_of_dimensions 010602 aa 000005 0760 07 adq 5,dl 010603 aa 7 00000 3521 06 epp2 pr7|0,ql 010604 aa 000000 0520 03 adwp2 0,du 010605 aa 6 00266 2521 00 spri2 pr6|182 data_ptr STATEMENT 1 ON LINE 2535 if substr (rel (data_ptr), 18, 1) then data_ptr = addrel (data_ptr, 1); 010606 aa 2 00000 6351 00 eaa pr2|0 data_ptr 010607 aa 6 00703 7551 00 sta pr6|451 010610 aa 000001 3150 03 cana 1,du 010611 aa 6 00712 6535 00 spri7 pr6|458 010612 aa 000003 6000 04 tze 3,ic 010615 010613 aa 000001 0520 03 adwp2 1,du 010614 aa 6 00266 2521 00 spri2 pr6|182 data_ptr STATEMENT 1 ON LINE 2538 bead_ptr -> value_bead.data_pointer = data_ptr; 010615 aa 7 00004 5421 00 sprp2 pr7|4 value_bead.data_pointer STATEMENT 1 ON LINE 2539 data_ptr -> numeric_datum (0) = value; 010616 aa 6 00272 4331 00 dfld pr6|186 value 010617 aa 2 00000 4571 00 dfst pr2|0 numeric_datum STATEMENT 1 ON LINE 2540 return (bead_ptr); 010620 aa 6 00264 7651 00 lprp5 pr6|180 bead_ptr 010621 aa 6 00260 3535 20 epp3 pr6|176,* 010622 aa 3 00004 6515 20 spri5 pr3|4,* 010623 aa 6 00256 6101 00 rtcd pr6|174 STATEMENT 1 ON LINE 2542 end save_system_variable_value; END PROCEDURE save_system_variable_value BEGIN PROCEDURE print_value ENTRY TO print_value STATEMENT 1 ON LINE 2544 print_value: procedure; 010624 aa 6 00274 6501 00 spri4 pr6|188 STATEMENT 1 ON LINE 2553 if rs (current_parseme - 1).semantics_valid then if rs (current_parseme - 1).semantics ^= null then do; 010625 aa 6 00132 2361 00 ldq pr6|90 current_parseme 010626 aa 000001 1760 07 sbq 1,dl 010627 aa 000002 7360 00 qls 2 010630 aa 6 00126 3735 20 epp7 pr6|86,* rsp 010631 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 010632 aa 004000 3150 03 cana 2048,du 010633 aa 000070 6000 04 tze 56,ic 010723 010634 aa 6 00132 2361 00 ldq pr6|90 current_parseme 010635 aa 000002 7360 00 qls 2 010636 aa 6 00714 7561 00 stq pr6|460 010637 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 010640 aa 003230 1160 04 cmpq 1688,ic 014070 = 007777000001 010641 aa 000062 6000 04 tze 50,ic 010723 STATEMENT 1 ON LINE 2556 val_ptr = rs (current_parseme - 1).semantics; 010642 aa 6 00302 7561 00 stq pr6|194 val_ptr STATEMENT 1 ON LINE 2558 if ^print_final_value then if val_ptr -> general_bead.type.list_value then do; 010643 aa 6 00161 2351 00 lda pr6|113 print_final_value 010644 aa 000035 6010 04 tnz 29,ic 010701 010645 aa 6 00302 7651 00 lprp5 pr6|194 val_ptr 010646 aa 5 00000 2351 00 lda pr5|0 general_bead.list_value 010647 aa 001000 3150 03 cana 512,du 010650 aa 000031 6000 04 tze 25,ic 010701 STATEMENT 1 ON LINE 2561 do i = 1 to val_ptr -> list_bead.number_of_members; 010651 aa 5 00002 2361 00 ldq pr5|2 list_bead.number_of_members 010652 aa 6 00303 7561 00 stq pr6|195 010653 aa 000001 2360 07 ldq 1,dl 010654 aa 6 00165 7561 00 stq pr6|117 i 010655 aa 000000 0110 03 nop 0,du 010656 aa 6 00165 2361 00 ldq pr6|117 i 010657 aa 6 00303 1161 00 cmpq pr6|195 010660 aa 000021 6054 04 tpnz 17,ic 010701 STATEMENT 1 ON LINE 2562 if val_ptr -> list_bead.members (i).bits.op1 = 0 /* non-assignment */ & val_ptr -> list_bead.member_ptr (i) ^= null /* non-null list (i.e. not ;;) */ then print_final_value = "1"b; 010661 aa 6 00302 7671 00 lprp7 pr6|194 val_ptr 010662 aa 000001 7360 00 qls 1 010663 aa 7 00002 2351 06 lda pr7|2,ql list_bead.op1 010664 aa 000033 7350 00 als 27 010665 aa 6 00715 7561 00 stq pr6|461 010666 aa 000077 7330 00 lrs 63 010667 aa 6 00716 6535 00 spri7 pr6|462 010670 aa 000007 6010 04 tnz 7,ic 010677 010671 aa 6 00715 7271 00 lxl7 pr6|461 010672 aa 7 00001 2361 17 ldq pr7|1,7 list_bead.member_ptr 010673 aa 003175 1160 04 cmpq 1661,ic 014070 = 007777000001 010674 aa 000003 6000 04 tze 3,ic 010677 010675 aa 400000 2350 03 lda 131072,du 010676 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 2567 end; 010677 aa 6 00165 0541 00 aos pr6|117 i 010700 aa 777756 7100 04 tra -18,ic 010656 STATEMENT 1 ON LINE 2568 end; STATEMENT 1 ON LINE 2570 if print_final_value then do; 010701 aa 6 00161 2351 00 lda pr6|113 print_final_value 010702 aa 000021 6000 04 tze 17,ic 010723 STATEMENT 1 ON LINE 2572 in_printer = "1"b; 010703 aa 400000 2350 03 lda 131072,du 010704 aa 6 00131 7551 00 sta pr6|89 in_printer STATEMENT 1 ON LINE 2573 call apl_print_value_ (val_ptr, "1"b, "1"b); 010705 aa 6 00715 7551 00 sta pr6|461 010706 aa 6 00714 7551 00 sta pr6|460 010707 aa 6 00302 3521 00 epp2 pr6|194 val_ptr 010710 aa 6 00722 2521 00 spri2 pr6|466 010711 aa 6 00715 3521 00 epp2 pr6|461 010712 aa 6 00724 2521 00 spri2 pr6|468 010713 aa 6 00714 3521 00 epp2 pr6|460 010714 aa 6 00726 2521 00 spri2 pr6|470 010715 aa 6 00720 6211 00 eax1 pr6|464 010716 aa 014000 4310 07 fld 6144,dl 010717 aa 6 00044 3701 20 epp4 pr6|36,* 010720 la 4 00066 3521 20 epp2 pr4|54,* apl_print_value_ 010721 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2574 in_printer = "0"b; 010722 aa 6 00131 4501 00 stz pr6|89 in_printer STATEMENT 1 ON LINE 2575 end; STATEMENT 1 ON LINE 2576 end; STATEMENT 1 ON LINE 2578 end /* print_value */; 010723 aa 6 00274 6101 00 rtcd pr6|188 END PROCEDURE print_value BEGIN PROCEDURE read_executable_input_line ENTRY TO read_executable_input_line STATEMENT 1 ON LINE 2580 read_executable_input_line: proc; 010724 aa 6 00304 6501 00 spri4 pr6|196 STATEMENT 1 ON LINE 2596 read_again: have_a_line = "0"b; 010725 aa 6 00130 4501 00 stz pr6|88 have_a_line STATEMENT 1 ON LINE 2598 current_parseme = 0; 010726 aa 6 00132 4501 00 stz pr6|90 current_parseme STATEMENT 1 ON LINE 2599 parse_frame.current_parseme = 0; 010727 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 010730 aa 7 00005 4501 00 stz pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2600 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 010731 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010732 aa 5 00016 2361 00 ldq pr5|14 ws_info.value_stack_ptr 010733 aa 7 00013 7561 00 stq pr7|11 parse_frame.initial_value_stack_ptr STATEMENT 1 ON LINE 2601 parse_frame.lexed_function_bead_ptr = null; 010734 aa 003134 2360 04 ldq 1628,ic 014070 = 007777000001 010735 aa 7 00003 7561 00 stq pr7|3 parse_frame.lexed_function_bead_ptr STATEMENT 1 ON LINE 2602 parse_frame.number_of_ptrs, number_of_ptrs = 1; 010736 aa 000001 2360 07 ldq 1,dl 010737 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 010740 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 2607 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 010741 aa 000014 0760 07 adq 12,dl 010742 aa 7 00000 3521 06 epp2 pr7|0,ql 010743 aa 000000 0520 03 adwp2 0,du 010744 aa 6 00104 2521 00 spri2 pr6|68 input_buffer_ptr STATEMENT 1 ON LINE 2608 input_buffer.n_read = 0; 010745 aa 2 00000 4501 00 stz pr2|0 input_buffer.n_read STATEMENT 1 ON LINE 2609 ok_to_stop_control = "1"b; 010746 aa 400000 2350 03 lda 131072,du 010747 aa 6 00164 7551 00 sta pr6|116 ok_to_stop_control STATEMENT 1 ON LINE 2611 call check_for_interrupt_while_input; 010750 aa 000442 6700 04 tsp4 290,ic 011412 STATEMENT 1 ON LINE 2613 if parse_frame_type = suspended_frame_type then do; 010751 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 010752 aa 7 00001 2361 00 ldq pr7|1 parse_frame.parse_frame_type 010753 aa 000001 1160 07 cmpq 1,dl 010754 aa 000010 6010 04 tnz 8,ic 010764 STATEMENT 1 ON LINE 2615 prompt_ptr = addr (ws_info.immediate_input_prompt); 010755 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010756 aa 5 00120 3715 00 epp5 pr5|80 ws_info.immediate_input_prompt 010757 aa 6 00316 6515 00 spri5 pr6|206 prompt_ptr STATEMENT 1 ON LINE 2616 prompt_length = length (ws_info.immediate_input_prompt); 010760 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010761 aa 3 00120 2361 00 ldq pr3|80 ws_info.immediate_input_prompt 010762 aa 6 00314 7561 00 stq pr6|204 prompt_length STATEMENT 1 ON LINE 2617 end; 010763 aa 000007 7100 04 tra 7,ic 010772 STATEMENT 1 ON LINE 2618 else do; STATEMENT 1 ON LINE 2619 prompt_ptr = addr (ws_info.evaluated_input_prompt); 010764 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 010765 aa 5 00131 3715 00 epp5 pr5|89 ws_info.evaluated_input_prompt 010766 aa 6 00316 6515 00 spri5 pr6|206 prompt_ptr STATEMENT 1 ON LINE 2620 prompt_length = length (ws_info.evaluated_input_prompt); 010767 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 010770 aa 3 00131 2361 00 ldq pr3|89 ws_info.evaluated_input_prompt 010771 aa 6 00314 7561 00 stq pr6|204 prompt_length STATEMENT 1 ON LINE 2621 end; STATEMENT 1 ON LINE 2623 prompt_ptr = addrel (prompt_ptr, 1); 010772 aa 000001 1510 03 adwp5 1,du 010773 aa 6 00316 6515 00 spri5 pr6|206 prompt_ptr STATEMENT 1 ON LINE 2624 call iox_$put_chars (apl_static_$apl_output, prompt_ptr, prompt_length, (0)); 010774 aa 6 00730 4501 00 stz pr6|472 010775 aa 6 00044 3701 20 epp4 pr6|36,* 010776 la 4 00100 3521 20 epp2 pr4|64,* apl_static_$apl_output 010777 aa 6 00734 2521 00 spri2 pr6|476 011000 aa 6 00316 3521 00 epp2 pr6|206 prompt_ptr 011001 aa 6 00736 2521 00 spri2 pr6|478 011002 aa 6 00314 3521 00 epp2 pr6|204 prompt_length 011003 aa 6 00740 2521 00 spri2 pr6|480 011004 aa 6 00730 3521 00 epp2 pr6|472 011005 aa 6 00742 2521 00 spri2 pr6|482 011006 aa 6 00732 6211 00 eax1 pr6|474 011007 aa 020000 4310 07 fld 8192,dl 011010 la 4 00034 3521 20 epp2 pr4|28,* iox_$put_chars 011011 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2626 max_input_line = 4 * (65536 - binary (rel (input_buffer_ptr), 18)); 011012 aa 6 00104 6351 20 eaa pr6|68,* input_buffer_ptr 011013 aa 000066 7730 00 lrl 54 011014 aa 6 00730 7561 00 stq pr6|472 011015 aa 200000 2360 07 ldq 65536,dl 011016 aa 6 00730 1761 00 sbq pr6|472 011017 aa 000002 7360 00 qls 2 011020 aa 6 00107 7561 00 stq pr6|71 max_input_line STATEMENT 1 ON LINE 2628 call append_to_input_buffer; 011021 aa 000264 6700 04 tsp4 180,ic 011305 STATEMENT 1 ON LINE 2629 can_be_interrupted = "0"b; 011022 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011023 aa 7 00105 4501 00 stz pr7|69 ws_info.can_be_interrupted STATEMENT 1 ON LINE 2631 packed_temp_ptr = null; 011024 aa 003044 2360 04 ldq 1572,ic 014070 = 007777000001 011025 aa 6 00166 7561 00 stq pr6|118 packed_temp_ptr STATEMENT 1 ON LINE 2632 call apl_scan_ (input_buffer.line, 1, input_line_position, (0), scan_token_type, packed_temp_ptr); 011026 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011027 aa 526000 2760 03 orq 175104,du 011030 aa 6 00730 7561 00 stq pr6|472 011031 aa 000001 2360 07 ldq 1,dl 011032 aa 6 00731 7561 00 stq pr6|473 011033 aa 6 00744 4501 00 stz pr6|484 011034 aa 6 00104 3715 20 epp5 pr6|68,* input_buffer_ptr 011035 aa 5 00001 3521 00 epp2 pr5|1 input_buffer.line 011036 aa 6 00750 2521 00 spri2 pr6|488 011037 aa 6 00731 3521 00 epp2 pr6|473 011040 aa 6 00752 2521 00 spri2 pr6|490 011041 aa 6 00106 3521 00 epp2 pr6|70 input_line_position 011042 aa 6 00754 2521 00 spri2 pr6|492 011043 aa 6 00744 3521 00 epp2 pr6|484 011044 aa 6 00756 2521 00 spri2 pr6|494 011045 aa 6 00111 3521 00 epp2 pr6|73 scan_token_type 011046 aa 6 00760 2521 00 spri2 pr6|496 011047 aa 6 00166 3521 00 epp2 pr6|118 packed_temp_ptr 011050 aa 6 00762 2521 00 spri2 pr6|498 011051 aa 6 00730 3521 00 epp2 pr6|472 011052 aa 6 00764 2521 00 spri2 pr6|500 011053 aa 767562 3520 04 epp2 -4238,ic 000635 = 404000000025 011054 aa 6 00766 2521 00 spri2 pr6|502 011055 aa 6 00770 2521 00 spri2 pr6|504 011056 aa 6 00772 2521 00 spri2 pr6|506 011057 aa 767563 3520 04 epp2 -4237,ic 000642 = 404000000021 011060 aa 6 00774 2521 00 spri2 pr6|508 011061 aa 767557 3520 04 epp2 -4241,ic 000640 = 466000000000 011062 aa 6 00776 2521 00 spri2 pr6|510 011063 aa 6 00746 6211 00 eax1 pr6|486 011064 aa 030000 4310 07 fld 12288,dl 011065 aa 6 00044 3701 20 epp4 pr6|36,* 011066 la 4 00072 3521 20 epp2 pr4|58,* apl_scan_ 011067 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2634 if scan_token_type = 1 then if substr (input_buffer.line, input_line_position, 1) = QRightParen then do; 011070 aa 6 00111 2361 00 ldq pr6|73 scan_token_type 011071 aa 000001 1160 07 cmpq 1,dl 011072 aa 000130 6010 04 tnz 88,ic 011222 011073 aa 6 00106 2351 00 lda pr6|70 input_line_position 011074 aa 6 00104 3735 20 epp7 pr6|68,* input_buffer_ptr 011075 aa 000 100 100 505 mlr (pr,al),(pr),fill(000) 011076 aa 7 00000 60 0001 desc9a pr7|0(3),1 input_buffer.line 011077 aa 6 00730 00 0004 desc9a pr6|472,4 input_buffer.line 011100 aa 6 00730 2351 00 lda pr6|472 input_buffer.line 011101 aa 051000 1150 03 cmpa 20992,du 011102 aa 000052 6010 04 tnz 42,ic 011154 STATEMENT 1 ON LINE 2637 dont_interrupt_parse = "0"b; 011103 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 011104 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2638 if dirty_interrupt_pending then go to dirty_stop; 011105 aa 5 00107 2351 00 lda pr5|71 ws_info.dirty_interrupt_pending 011106 aa 772340 6010 04 tnz -2848,ic 003446 STATEMENT 1 ON LINE 2640 call apl_command_ (input_buffer.line, input_line_position, code); 011107 aa 7 00000 2361 00 ldq pr7|0 input_buffer.n_read 011110 aa 526000 2760 03 orq 175104,du 011111 aa 6 00744 7561 00 stq pr6|484 011112 aa 7 00001 3521 00 epp2 pr7|1 input_buffer.line 011113 aa 6 00750 2521 00 spri2 pr6|488 011114 aa 6 00106 3521 00 epp2 pr6|70 input_line_position 011115 aa 6 00752 2521 00 spri2 pr6|490 011116 aa 6 00162 3521 00 epp2 pr6|114 code 011117 aa 6 00754 2521 00 spri2 pr6|492 011120 aa 6 00744 3521 00 epp2 pr6|484 011121 aa 6 00756 2521 00 spri2 pr6|494 011122 aa 767513 3520 04 epp2 -4277,ic 000635 = 404000000025 011123 aa 6 00760 2521 00 spri2 pr6|496 011124 aa 767521 3520 04 epp2 -4271,ic 000645 = 404000000043 011125 aa 6 00762 2521 00 spri2 pr6|498 011126 aa 6 00746 6211 00 eax1 pr6|486 011127 aa 014000 4310 07 fld 6144,dl 011130 aa 6 00044 3701 20 epp4 pr6|36,* 011131 la 4 00222 3521 20 epp2 pr4|146,* apl_command_ 011132 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2641 dont_interrupt_parse = "1"b; 011133 aa 400000 2350 03 lda 131072,du 011134 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011135 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2643 if code = 0 then go to read_again; 011136 aa 6 00162 2361 00 ldq pr6|114 code 011137 aa 777566 6000 04 tze -138,ic 010725 STATEMENT 1 ON LINE 2646 if code = apl_error_table_$return_from_apl then go to return_statement; 011140 aa 6 00044 3701 20 epp4 pr6|36,* 011141 la 4 00150 1161 20 cmpq pr4|104,* apl_error_table_$return_from_apl 011142 aa 771766 6000 04 tze -3082,ic 003130 STATEMENT 1 ON LINE 2649 if code = apl_error_table_$ws_cleared then go to start_anew; 011143 la 4 00144 1161 20 cmpq pr4|100,* apl_error_table_$ws_cleared 011144 aa 767717 6000 04 tze -4145,ic 001063 STATEMENT 1 ON LINE 2652 parse_frame_ptr = ws_info.current_parse_frame_ptr; 011145 aa 7 00015 7651 00 lprp5 pr7|13 ws_info.current_parse_frame_ptr 011146 aa 6 00122 6515 00 spri5 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 2653 rsp = parse_frame.reduction_stack_ptr; 011147 aa 5 00004 7631 00 lprp3 pr5|4 parse_frame.reduction_stack_ptr 011150 aa 6 00126 2535 00 spri3 pr6|86 rsp STATEMENT 1 ON LINE 2655 if code = apl_error_table_$ws_loaded then go to ws_just_loaded; 011151 la 4 00146 1161 20 cmpq pr4|102,* apl_error_table_$ws_loaded 011152 aa 767721 6000 04 tze -4143,ic 001073 STATEMENT 1 ON LINE 2658 go to read_again; 011153 aa 777552 7100 04 tra -150,ic 010725 STATEMENT 1 ON LINE 2659 end; STATEMENT 1 ON LINE 2660 else if substr (input_buffer.line, input_line_position, 1) = QDel | substr (input_buffer.line, input_line_position, 1) = QDelTilde then do; 011154 aa 254000 1150 03 cmpa 88064,du 011155 aa 000003 6000 04 tze 3,ic 011160 011156 aa 231000 1150 03 cmpa 78336,du 011157 aa 000043 6010 04 tnz 35,ic 011222 STATEMENT 1 ON LINE 2663 dont_interrupt_parse = "0"b; 011160 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 011161 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2664 if dirty_interrupt_pending then go to dirty_stop; 011162 aa 5 00107 2351 00 lda pr5|71 ws_info.dirty_interrupt_pending 011163 aa 772263 6010 04 tnz -2893,ic 003446 STATEMENT 1 ON LINE 2666 call apl_editor_ (input_buffer.line, input_line_position, code); 011164 aa 7 00000 2361 00 ldq pr7|0 input_buffer.n_read 011165 aa 526000 2760 03 orq 175104,du 011166 aa 6 00730 7561 00 stq pr6|472 011167 aa 7 00001 3521 00 epp2 pr7|1 input_buffer.line 011170 aa 6 00750 2521 00 spri2 pr6|488 011171 aa 6 00106 3521 00 epp2 pr6|70 input_line_position 011172 aa 6 00752 2521 00 spri2 pr6|490 011173 aa 6 00162 3521 00 epp2 pr6|114 code 011174 aa 6 00754 2521 00 spri2 pr6|492 011175 aa 6 00730 3521 00 epp2 pr6|472 011176 aa 6 00756 2521 00 spri2 pr6|494 011177 aa 767436 3520 04 epp2 -4322,ic 000635 = 404000000025 011200 aa 6 00760 2521 00 spri2 pr6|496 011201 aa 767444 3520 04 epp2 -4316,ic 000645 = 404000000043 011202 aa 6 00762 2521 00 spri2 pr6|498 011203 aa 6 00746 6211 00 eax1 pr6|486 011204 aa 014000 4310 07 fld 6144,dl 011205 aa 6 00044 3701 20 epp4 pr6|36,* 011206 la 4 00062 3521 20 epp2 pr4|50,* apl_editor_ 011207 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2667 dont_interrupt_parse = "1"b; 011210 aa 400000 2350 03 lda 131072,du 011211 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011212 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2668 if code = apl_error_table_$return_from_apl then go to return_statement; 011213 aa 6 00162 2361 00 ldq pr6|114 code 011214 aa 6 00044 3701 20 epp4 pr6|36,* 011215 la 4 00150 1161 20 cmpq pr4|104,* apl_error_table_$return_from_apl 011216 aa 771712 6000 04 tze -3126,ic 003130 STATEMENT 1 ON LINE 2670 if code = apl_error_table_$ws_cleared then go to start_anew; 011217 la 4 00144 1161 20 cmpq pr4|100,* apl_error_table_$ws_cleared 011220 aa 767643 6000 04 tze -4189,ic 001063 STATEMENT 1 ON LINE 2672 go to read_again; 011221 aa 777504 7100 04 tra -188,ic 010725 STATEMENT 1 ON LINE 2673 end; STATEMENT 1 ON LINE 2677 in_constant = "0"b; 011222 aa 6 00312 4501 00 stz pr6|202 in_constant STATEMENT 1 ON LINE 2678 scan_for_constants_again: do input_line_position = input_line_position by 1 while (input_line_position <= input_buffer.n_read); 011223 aa 6 00106 2361 00 ldq pr6|70 input_line_position 011224 aa 6 00106 7561 00 stq pr6|70 input_line_position 011225 aa 000000 0110 03 nop 0,du 011226 aa 6 00106 2361 00 ldq pr6|70 input_line_position 011227 aa 6 00104 1161 20 cmpq pr6|68,* input_buffer.n_read 011230 aa 000023 6054 04 tpnz 19,ic 011253 STATEMENT 1 ON LINE 2680 if substr (input_buffer.line, input_line_position, 1) = QApostrophe then in_constant = ^in_constant; 011231 aa 6 00104 3735 20 epp7 pr6|68,* input_buffer_ptr 011232 aa 000 100 100 506 mlr (pr,ql),(pr),fill(000) 011233 aa 7 00000 60 0001 desc9a pr7|0(3),1 input_buffer.line 011234 aa 6 00730 00 0004 desc9a pr6|472,4 input_buffer.line 011235 aa 6 00730 2351 00 lda pr6|472 input_buffer.line 011236 aa 047000 1150 03 cmpa 19968,du 011237 aa 000005 6010 04 tnz 5,ic 011244 011240 aa 6 00312 2351 00 lda pr6|202 in_constant 011241 aa 0 00002 6751 00 era pr0|2 = 400000000000 011242 aa 6 00312 7551 00 sta pr6|202 in_constant 011243 aa 000006 7100 04 tra 6,ic 011251 STATEMENT 1 ON LINE 2682 else if ^in_constant then if substr (input_buffer.line, input_line_position, 1) = QLamp then go to exitloop; 011244 aa 6 00312 2351 00 lda pr6|202 in_constant 011245 aa 000004 6010 04 tnz 4,ic 011251 011246 aa 6 00730 2351 00 lda pr6|472 input_buffer.line 011247 aa 240000 1150 03 cmpa 81920,du 011250 aa 000003 6000 04 tze 3,ic 011253 STATEMENT 1 ON LINE 2685 end; 011251 aa 6 00106 0541 00 aos pr6|70 input_line_position 011252 aa 777754 7100 04 tra -20,ic 011226 STATEMENT 1 ON LINE 2687 exitloop: if in_constant /* constant extends to next line */ then do; 011253 aa 6 00312 2351 00 lda pr6|202 in_constant 011254 aa 000025 6000 04 tze 21,ic 011301 STATEMENT 1 ON LINE 2690 call check_for_interrupt_while_input; 011255 aa 000135 6700 04 tsp4 93,ic 011412 STATEMENT 1 ON LINE 2691 if max_input_line - input_buffer.n_read < 500 then call apl_system_error_ (apl_error_table_$too_much_input); 011256 aa 6 00107 2361 00 ldq pr6|71 max_input_line 011257 aa 6 00104 1761 20 sbq pr6|68,* input_buffer.n_read 011260 aa 000764 1160 07 cmpq 500,dl 011261 aa 000010 6050 04 tpl 8,ic 011271 011262 aa 6 00044 3701 20 epp4 pr6|36,* 011263 la 4 00126 3521 20 epp2 pr4|86,* apl_error_table_$too_much_input 011264 aa 6 00734 2521 00 spri2 pr6|476 011265 aa 6 00732 6211 00 eax1 pr6|474 011266 aa 004000 4310 07 fld 2048,dl 011267 la 4 00326 3521 20 epp2 pr4|214,* apl_system_error_ 011270 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2694 call append_to_input_buffer; 011271 aa 000014 6700 04 tsp4 12,ic 011305 STATEMENT 1 ON LINE 2695 can_be_interrupted = "0"b; 011272 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011273 aa 7 00105 4501 00 stz pr7|69 ws_info.can_be_interrupted STATEMENT 1 ON LINE 2696 input_line_position = input_buffer.n_read - n_read_more + 1; 011274 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011275 aa 6 00313 1761 00 sbq pr6|203 n_read_more 011276 aa 000001 0760 07 adq 1,dl 011277 aa 6 00106 7561 00 stq pr6|70 input_line_position STATEMENT 1 ON LINE 2698 go to scan_for_constants_again; 011300 aa 777723 7100 04 tra -45,ic 011223 STATEMENT 1 ON LINE 2699 end; STATEMENT 1 ON LINE 2701 parse_frame.current_line_number = 1; 011301 aa 000001 2360 07 ldq 1,dl 011302 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011303 aa 7 00007 7561 00 stq pr7|7 parse_frame.current_line_number STATEMENT 1 ON LINE 2702 return; 011304 aa 6 00304 6101 00 rtcd pr6|196 STATEMENT 1 ON LINE 2763 end /* read_executable_input_line */; BEGIN PROCEDURE append_to_input_buffer ENTRY TO append_to_input_buffer STATEMENT 1 ON LINE 2704 append_to_input_buffer: procedure; 011305 aa 6 00320 6501 00 spri4 pr6|208 STATEMENT 1 ON LINE 2720 user_input_attachment_known = "0"b; 011306 aa 6 00332 4501 00 stz pr6|218 user_input_attachment_known STATEMENT 1 ON LINE 2721 got_line = "0"b; 011307 aa 6 00326 4501 00 stz pr6|214 got_line STATEMENT 1 ON LINE 2723 do while (^got_line); 011310 aa 6 00326 2351 00 lda pr6|214 got_line 011311 aa 000076 6010 04 tnz 62,ic 011407 STATEMENT 1 ON LINE 2725 ws_info.dont_interrupt_parse = "0"b; 011312 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011313 aa 7 00100 4501 00 stz pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2726 input_read_ptr = addr (input_buffer_array (input_buffer.n_read + 1)); 011314 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011315 aa 6 00104 3715 20 epp5 pr6|68,* input_buffer_ptr 011316 aa 5 00001 3521 00 epp2 pr5|1 input_buffer_array 011317 aa 2 00000 5005 06 a9bd pr2|0,ql 011320 aa 6 00330 2521 00 spri2 pr6|216 input_read_ptr STATEMENT 1 ON LINE 2727 call iox_$get_line (apl_static_$apl_input, input_read_ptr, max_input_line - input_buffer.n_read, n_read_more, code); 011321 aa 6 00107 2361 00 ldq pr6|71 max_input_line 011322 aa 5 00000 1761 00 sbq pr5|0 input_buffer.n_read 011323 aa 6 01000 7561 00 stq pr6|512 011324 aa 6 00044 3701 20 epp4 pr6|36,* 011325 la 4 00076 3521 20 epp2 pr4|62,* apl_static_$apl_input 011326 aa 6 01004 2521 00 spri2 pr6|516 011327 aa 6 00330 3521 00 epp2 pr6|216 input_read_ptr 011330 aa 6 01006 2521 00 spri2 pr6|518 011331 aa 6 01000 3521 00 epp2 pr6|512 011332 aa 6 01010 2521 00 spri2 pr6|520 011333 aa 6 00313 3521 00 epp2 pr6|203 n_read_more 011334 aa 6 01012 2521 00 spri2 pr6|522 011335 aa 6 00162 3521 00 epp2 pr6|114 code 011336 aa 6 01014 2521 00 spri2 pr6|524 011337 aa 6 01002 6211 00 eax1 pr6|514 011340 aa 024000 4310 07 fld 10240,dl 011341 la 4 00032 3521 20 epp2 pr4|26,* iox_$get_line 011342 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2729 ws_info.dont_interrupt_parse = "1"b; 011343 aa 400000 2350 03 lda 131072,du 011344 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011345 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 2730 if code = 0 then got_line = "1"b; 011346 aa 6 00162 2361 00 ldq pr6|114 code 011347 aa 000003 6010 04 tnz 3,ic 011352 011350 aa 6 00326 7551 00 sta pr6|214 got_line 011351 aa 777737 7100 04 tra -33,ic 011310 STATEMENT 1 ON LINE 2732 else if code = error_table_$short_record /* no trailing NL */ then do; 011352 aa 6 00044 3701 20 epp4 pr6|36,* 011353 la 4 00206 1161 20 cmpq pr4|134,* error_table_$short_record 011354 aa 000012 6010 04 tnz 10,ic 011366 STATEMENT 1 ON LINE 2734 n_read_more = n_read_more + 1; 011355 aa 6 00313 0541 00 aos pr6|203 n_read_more STATEMENT 1 ON LINE 2735 substr (input_buffer.line, input_buffer.n_read + n_read_more, 1) = QNewLine; 011356 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011357 aa 6 00313 0761 00 adq pr6|203 n_read_more 011360 aa 6 00104 3715 20 epp5 pr6|68,* input_buffer_ptr 011361 aa 012 106 100 400 mlr (),(pr,ql),fill(012) 011362 aa 000000 00 0000 desc9a 0,0 011363 aa 5 00000 60 0001 desc9a pr5|0(3),1 input_buffer.line STATEMENT 1 ON LINE 2736 got_line = "1"b; 011364 aa 6 00326 7551 00 sta pr6|214 got_line STATEMENT 1 ON LINE 2737 end; 011365 aa 777723 7100 04 tra -45,ic 011310 STATEMENT 1 ON LINE 2738 else if code = error_table_$end_of_info then do; 011366 la 4 00202 1161 20 cmpq pr4|130,* error_table_$end_of_info 011367 aa 777721 6010 04 tnz -47,ic 011310 STATEMENT 1 ON LINE 2740 if user_input_attachment_known then call apl_system_error_ (apl_error_table_$cant_read_input); 011370 aa 6 00332 2351 00 lda pr6|218 user_input_attachment_known 011371 aa 000007 6000 04 tze 7,ic 011400 011372 la 4 00110 3521 20 epp2 pr4|72,* apl_error_table_$cant_read_input 011373 aa 6 01004 2521 00 spri2 pr6|516 011374 aa 6 01002 6211 00 eax1 pr6|514 011375 aa 004000 4310 07 fld 2048,dl 011376 la 4 00326 3521 20 epp2 pr4|214,* apl_system_error_ 011377 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2743 call reattach_user_input; 011400 aa 6 00056 6211 00 eax1 pr6|46 011401 aa 000000 4310 07 fld 0,dl 011402 aa 001336 3520 04 epp2 734,ic 012740 = 000140627000 011403 aa 0 00625 7001 00 tsx0 pr0|405 call_int_this STATEMENT 1 ON LINE 2744 user_input_attachment_known = "1"b; 011404 aa 400000 2350 03 lda 131072,du 011405 aa 6 00332 7551 00 sta pr6|218 user_input_attachment_known STATEMENT 1 ON LINE 2745 end; STATEMENT 1 ON LINE 2746 end; 011406 aa 777702 7100 04 tra -62,ic 011310 STATEMENT 1 ON LINE 2747 input_buffer.n_read = input_buffer.n_read + n_read_more; 011407 aa 6 00313 2361 00 ldq pr6|203 n_read_more 011410 aa 6 00104 0561 20 asq pr6|68,* input_buffer.n_read STATEMENT 1 ON LINE 2749 end /* append_to_input_buffer */; 011411 aa 6 00320 6101 00 rtcd pr6|208 END PROCEDURE append_to_input_buffer BEGIN PROCEDURE check_for_interrupt_while_input ENTRY TO check_for_interrupt_while_input STATEMENT 1 ON LINE 2751 check_for_interrupt_while_input: procedure; 011412 aa 6 00334 6501 00 spri4 pr6|220 STATEMENT 1 ON LINE 2754 can_be_interrupted = "1"b; 011413 aa 400000 2350 03 lda 131072,du 011414 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011415 aa 7 00105 7551 00 sta pr7|69 ws_info.can_be_interrupted STATEMENT 1 ON LINE 2755 if clean_interrupt_pending then do; 011416 aa 7 00106 2351 00 lda pr7|70 ws_info.clean_interrupt_pending 011417 aa 000042 6000 04 tze 34,ic 011461 STATEMENT 1 ON LINE 2757 call apl_error_ (apl_error_table_$interrupt, ""b, 0, "", packed_temp_ptr, 0); 011420 aa 000000 2350 07 lda 0,dl 011421 aa 6 01016 7551 00 sta pr6|526 011422 aa 6 01017 4501 00 stz pr6|527 011423 aa 6 01021 4501 00 stz pr6|529 011424 aa 6 00044 3701 20 epp4 pr6|36,* 011425 la 4 00136 3521 20 epp2 pr4|94,* apl_error_table_$interrupt 011426 aa 6 01024 2521 00 spri2 pr6|532 011427 aa 6 01016 3521 00 epp2 pr6|526 011430 aa 6 01026 2521 00 spri2 pr6|534 011431 aa 6 01017 3521 00 epp2 pr6|527 011432 aa 6 01030 2521 00 spri2 pr6|536 011433 aa 6 01020 3521 00 epp2 pr6|528 011434 aa 6 01032 2521 00 spri2 pr6|538 011435 aa 6 00166 3521 00 epp2 pr6|118 packed_temp_ptr 011436 aa 6 01034 2521 00 spri2 pr6|540 011437 aa 6 01021 3521 00 epp2 pr6|529 011440 aa 6 01036 2521 00 spri2 pr6|542 011441 aa 767204 3520 04 epp2 -4476,ic 000645 = 404000000043 011442 aa 6 01040 2521 00 spri2 pr6|544 011443 aa 767200 3520 04 epp2 -4480,ic 000643 = 514000000044 011444 aa 6 01042 2521 00 spri2 pr6|546 011445 aa 767175 3520 04 epp2 -4483,ic 000642 = 404000000021 011446 aa 6 01044 2521 00 spri2 pr6|548 011447 aa 6 01052 2521 00 spri2 pr6|554 011450 aa 767171 3520 04 epp2 -4487,ic 000641 = 524000000000 011451 aa 6 01046 2521 00 spri2 pr6|550 011452 aa 767166 3520 04 epp2 -4490,ic 000640 = 466000000000 011453 aa 6 01050 2521 00 spri2 pr6|552 011454 aa 6 01022 6211 00 eax1 pr6|530 011455 aa 030000 4310 07 fld 12288,dl 011456 la 4 00210 3521 20 epp2 pr4|136,* apl_error_ 011457 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2758 go to recover_from_error; 011460 aa 772464 7100 04 tra -2764,ic 004144 STATEMENT 1 ON LINE 2759 end; STATEMENT 1 ON LINE 2761 end /* check_for_interrupt_while_input */; 011461 aa 6 00334 6101 00 rtcd pr6|220 END PROCEDURE check_for_interrupt_while_input END PROCEDURE read_executable_input_line BEGIN PROCEDURE lex_input_line ENTRY TO lex_input_line STATEMENT 1 ON LINE 2765 lex_input_line: procedure (bv_code); 011462 aa 6 00342 6501 00 spri4 pr6|226 011463 aa 6 00344 2521 00 spri2 pr6|228 STATEMENT 1 ON LINE 2774 was_error = "0"b; 011464 aa 6 00143 4501 00 stz pr6|99 was_error STATEMENT 1 ON LINE 2775 parse_frame.number_of_ptrs, number_of_ptrs = 1 + divide (input_buffer.n_read + 3, 4, 21, 0); 011465 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011466 aa 000003 0760 07 adq 3,dl 011467 aa 000004 5060 07 div 4,dl 011470 aa 000001 0760 07 adq 1,dl 011471 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011472 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 011473 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 2776 parse_frame.reduction_stack_ptr, rsp = addrel (parse_frame_ptr, size (parse_frame)); 011474 aa 000015 0760 07 adq 13,dl 011475 aa 7 00000 3515 06 epp1 pr7|0,ql 011476 aa 000000 0510 03 adwp1 0,du 011477 aa 6 01054 2515 00 spri1 pr6|556 011500 aa 7 00004 5411 00 sprp1 pr7|4 parse_frame.reduction_stack_ptr 011501 aa 6 00126 2515 00 spri1 pr6|86 rsp STATEMENT 1 ON LINE 2777 call apl_line_lex_ (input_buffer.line, parse_frame.lexed_function_bead_ptr, was_error, 0, rsp); 011502 aa 6 00104 2361 20 ldq pr6|68,* input_buffer.n_read 011503 aa 526000 2760 03 orq 175104,du 011504 aa 6 01056 7561 00 stq pr6|558 011505 aa 6 01057 4501 00 stz pr6|559 011506 aa 6 00104 3735 20 epp7 pr6|68,* input_buffer_ptr 011507 aa 7 00001 3521 00 epp2 pr7|1 input_buffer.line 011510 aa 6 01062 2521 00 spri2 pr6|562 011511 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 011512 aa 5 00003 3521 00 epp2 pr5|3 parse_frame.lexed_function_bead_ptr 011513 aa 6 01064 2521 00 spri2 pr6|564 011514 aa 6 00143 3521 00 epp2 pr6|99 was_error 011515 aa 6 01066 2521 00 spri2 pr6|566 011516 aa 6 01057 3521 00 epp2 pr6|559 011517 aa 6 01070 2521 00 spri2 pr6|568 011520 aa 6 00126 3521 00 epp2 pr6|86 rsp 011521 aa 6 01072 2521 00 spri2 pr6|570 011522 aa 6 01056 3521 00 epp2 pr6|558 011523 aa 6 01074 2521 00 spri2 pr6|572 011524 aa 767114 3520 04 epp2 -4532,ic 000640 = 466000000000 011525 aa 6 01076 2521 00 spri2 pr6|574 011526 aa 767123 3520 04 epp2 -4525,ic 000651 = 514000000001 011527 aa 6 01100 2521 00 spri2 pr6|576 011530 aa 767112 3520 04 epp2 -4534,ic 000642 = 404000000021 011531 aa 6 01102 2521 00 spri2 pr6|578 011532 aa 767120 3520 04 epp2 -4528,ic 000652 = 464000000000 011533 aa 6 01104 2521 00 spri2 pr6|580 011534 aa 6 01060 6211 00 eax1 pr6|560 011535 aa 024000 4310 07 fld 10240,dl 011536 aa 6 00044 3701 20 epp4 pr6|36,* 011537 la 4 00212 3521 20 epp2 pr4|138,* apl_line_lex_ 011540 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 2778 if was_error then bv_code = 1; 011541 aa 6 00143 2351 00 lda pr6|99 was_error 011542 aa 400000 3150 03 cana 131072,du 011543 aa 000005 6000 04 tze 5,ic 011550 011544 aa 000001 2360 07 ldq 1,dl 011545 aa 6 00344 3735 20 epp7 pr6|228,* 011546 aa 7 00002 7561 20 stq pr7|2,* bv_code 011547 aa 000003 7100 04 tra 3,ic 011552 STATEMENT 1 ON LINE 2780 else bv_code = 0; 011550 aa 6 00344 3735 20 epp7 pr6|228,* 011551 aa 7 00002 4501 20 stz pr7|2,* bv_code STATEMENT 1 ON LINE 2781 return; 011552 aa 6 00342 6101 00 rtcd pr6|226 STATEMENT 1 ON LINE 2783 end lex_input_line; END PROCEDURE lex_input_line BEGIN PROCEDURE initialize_suspended_frame ENTRY TO initialize_suspended_frame STATEMENT 1 ON LINE 2785 initialize_suspended_frame: procedure; 011553 aa 6 00350 6501 00 spri4 pr6|232 STATEMENT 1 ON LINE 2788 parse_frame.parse_frame_type = suspended_frame_type; 011554 aa 000001 2360 07 ldq 1,dl 011555 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011556 aa 7 00001 7561 00 stq pr7|1 parse_frame.parse_frame_type STATEMENT 1 ON LINE 2790 parse_frame.number_of_ptrs, number_of_ptrs = 3; 011557 aa 000003 2360 07 ldq 3,dl 011560 aa 7 00014 7561 00 stq pr7|12 parse_frame.number_of_ptrs 011561 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 2791 parse_frame.reduction_stack_ptr, rsp = addrel (parse_frame_ptr, size (parse_frame)); 011562 aa 000015 0760 07 adq 13,dl 011563 aa 7 00000 3521 06 epp2 pr7|0,ql 011564 aa 000000 0520 03 adwp2 0,du 011565 aa 6 01106 2521 00 spri2 pr6|582 011566 aa 7 00004 5421 00 sprp2 pr7|4 parse_frame.reduction_stack_ptr 011567 aa 6 00126 2521 00 spri2 pr6|86 rsp STATEMENT 1 ON LINE 2792 parse_frame.initial_value_stack_ptr = ws_info.value_stack_ptr; 011570 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 011571 aa 7 00016 2361 00 ldq pr7|14 ws_info.value_stack_ptr 011572 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 011573 aa 5 00013 7561 00 stq pr5|11 parse_frame.initial_value_stack_ptr STATEMENT 1 ON LINE 2793 return; 011574 aa 6 00350 6101 00 rtcd pr6|232 STATEMENT 1 ON LINE 2795 end initialize_suspended_frame; END PROCEDURE initialize_suspended_frame BEGIN PROCEDURE decrement_reference_count ENTRY TO decrement_reference_count STATEMENT 1 ON LINE 2800 decrement_reference_count: procedure (bv_bead_ptr); 011575 aa 6 00356 6501 00 spri4 pr6|238 011576 aa 6 00360 2521 00 spri2 pr6|240 STATEMENT 1 ON LINE 2809 bv_bead_ptr -> general_bead.reference_count = bv_bead_ptr -> general_bead.reference_count - 1; 011577 aa 2 00002 3735 20 epp7 pr2|2,* 011600 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 011601 aa 7 00000 00 0044 descb pr7|0,36 bv_bead_ptr 011602 aa 6 01110 00 0044 descb pr6|584,36 bv_bead_ptr 011603 aa 6 01110 7651 00 lprp5 pr6|584 bv_bead_ptr 011604 aa 000001 3360 07 lcq 1,dl 011605 aa 5 00001 0561 00 asq pr5|1 general_bead.reference_count STATEMENT 1 ON LINE 2811 if bv_bead_ptr -> general_bead.reference_count < 1 then call apl_free_bead_ (bv_bead_ptr); 011606 aa 5 00001 2361 00 ldq pr5|1 general_bead.reference_count 011607 aa 000001 1160 07 cmpq 1,dl 011610 aa 000010 6050 04 tpl 8,ic 011620 011611 aa 2 00002 3521 20 epp2 pr2|2,* bv_bead_ptr 011612 aa 6 01114 2521 00 spri2 pr6|588 011613 aa 6 01112 6211 00 eax1 pr6|586 011614 aa 004000 4310 07 fld 2048,dl 011615 aa 6 00044 3701 20 epp4 pr6|36,* 011616 la 4 00320 3521 20 epp2 pr4|208,* apl_free_bead_ 011617 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 2814 bv_bead_ptr = null; 011620 aa 002250 2360 04 ldq 1192,ic 014070 = 007777000001 011621 aa 6 00056 7561 00 stq pr6|46 011622 aa 6 00360 3735 20 epp7 pr6|240,* 011623 aa 7 00002 3715 20 epp5 pr7|2,* 011624 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 011625 aa 6 00056 00 0044 descb pr6|46,36 011626 aa 5 00000 00 0044 descb pr5|0,36 bv_bead_ptr STATEMENT 1 ON LINE 2815 return; 011627 aa 6 00356 6101 00 rtcd pr6|238 STATEMENT 1 ON LINE 2817 end decrement_reference_count; END PROCEDURE decrement_reference_count BEGIN PROCEDURE clean_up_rs ENTRY TO clean_up_rs STATEMENT 1 ON LINE 2819 clean_up_rs: proc; 011630 aa 6 00364 6501 00 spri4 pr6|244 STATEMENT 1 ON LINE 2822 do current_parseme = current_parseme to 1 by -1; 011631 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011632 aa 6 00132 7561 00 stq pr6|90 current_parseme 011633 aa 000000 0110 03 nop 0,du 011634 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011635 aa 000001 1160 07 cmpq 1,dl 011636 aa 000046 6040 04 tmi 38,ic 011704 STATEMENT 1 ON LINE 2823 if rs (current_parseme).bits.has_list then call free_list_bead (rs (current_parseme).semantics); 011637 aa 000002 7360 00 qls 2 011640 aa 6 00126 3735 20 epp7 pr6|86,* rsp 011641 aa 7 77775 2351 06 lda pr7|-3,ql rs.has_list 011642 aa 002000 3150 03 cana 1024,du 011643 aa 000007 6000 04 tze 7,ic 011652 011644 aa 7 77776 3521 06 epp2 pr7|-2,ql rs.semantics 011645 aa 6 01120 2521 00 spri2 pr6|592 011646 aa 6 01116 3521 00 epp2 pr6|590 011647 aa 004000 4310 07 fld 2048,dl 011650 aa 2 00000 7571 00 staq pr2|0 011651 aa 000321 6700 04 tsp4 209,ic 012172 STATEMENT 1 ON LINE 2826 if rs (current_parseme).type = val_type then if rs (current_parseme).bits.semantics_valid then if rs (current_parseme).semantics ^= null then if ^rs (current_parseme).bits.semantics_on_stack then call decrement_reference_count (rs (current_parseme).semantics); 011652 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011653 aa 000002 7360 00 qls 2 011654 aa 6 00126 3735 20 epp7 pr6|86,* rsp 011655 aa 6 01124 7561 00 stq pr6|596 011656 aa 7 77774 2361 06 ldq pr7|-4,ql rs.type 011657 aa 000002 1160 07 cmpq 2,dl 011660 aa 000021 6010 04 tnz 17,ic 011701 011661 aa 6 01124 7271 00 lxl7 pr6|596 011662 aa 7 77775 2351 17 lda pr7|-3,7 rs.semantics_valid 011663 aa 004000 3150 03 cana 2048,du 011664 aa 000015 6000 04 tze 13,ic 011701 011665 aa 7 77776 2361 17 ldq pr7|-2,7 rs.semantics 011666 aa 002202 1160 04 cmpq 1154,ic 014070 = 007777000001 011667 aa 000012 6000 04 tze 10,ic 011701 011670 aa 7 77775 2351 17 lda pr7|-3,7 rs.semantics_on_stack 011671 aa 000400 3150 03 cana 256,du 011672 aa 000007 6010 04 tnz 7,ic 011701 011673 aa 7 77776 3521 17 epp2 pr7|-2,7 rs.semantics 011674 aa 6 01120 2521 00 spri2 pr6|592 011675 aa 6 01116 3521 00 epp2 pr6|590 011676 aa 004000 4310 07 fld 2048,dl 011677 aa 2 00000 7571 00 staq pr2|0 011700 aa 777675 6700 04 tsp4 -67,ic 011575 STATEMENT 1 ON LINE 2831 end; 011701 aa 000001 3360 07 lcq 1,dl 011702 aa 6 00132 0561 00 asq pr6|90 current_parseme 011703 aa 777731 7100 04 tra -39,ic 011634 STATEMENT 1 ON LINE 2833 parse_frame.current_parseme = 0; 011704 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011705 aa 7 00005 4501 00 stz pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2834 ws_info.value_stack_ptr = parse_frame.initial_value_stack_ptr; 011706 aa 7 00013 2361 00 ldq pr7|11 parse_frame.initial_value_stack_ptr 011707 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 011710 aa 5 00016 7561 00 stq pr5|14 ws_info.value_stack_ptr STATEMENT 1 ON LINE 2835 return; 011711 aa 6 00364 6101 00 rtcd pr6|244 STATEMENT 1 ON LINE 2837 end; END PROCEDURE clean_up_rs BEGIN PROCEDURE save_state ENTRY TO save_state STATEMENT 1 ON LINE 2839 save_state: proc; 011712 aa 6 00372 6501 00 spri4 pr6|250 STATEMENT 1 ON LINE 2842 parse_frame.current_parseme = current_parseme; 011713 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011714 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011715 aa 7 00005 7561 00 stq pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2843 parse_frame.current_lexeme = current_lexeme; 011716 aa 6 00133 2361 00 ldq pr6|91 current_lexeme 011717 aa 7 00006 7561 00 stq pr7|6 parse_frame.current_lexeme STATEMENT 1 ON LINE 2844 parse_frame.return_point = return_point; 011720 aa 6 00157 2361 00 ldq pr6|111 return_point 011721 aa 7 00010 7561 00 stq pr7|8 parse_frame.return_point STATEMENT 1 ON LINE 2845 parse_frame.put_result = put_result; 011722 aa 6 00156 2361 00 ldq pr6|110 put_result 011723 aa 7 00011 7561 00 stq pr7|9 parse_frame.put_result STATEMENT 1 ON LINE 2846 parse_frame.print_final_value = print_final_value; 011724 aa 6 00161 2351 00 lda pr6|113 print_final_value 011725 aa 7 00012 7551 00 sta pr7|10 parse_frame.print_final_value STATEMENT 1 ON LINE 2847 return; 011726 aa 6 00372 6101 00 rtcd pr6|250 STATEMENT 1 ON LINE 2849 end; END PROCEDURE save_state BEGIN PROCEDURE restore_state ENTRY TO restore_state STATEMENT 1 ON LINE 2851 restore_state: proc; 011727 aa 6 00400 6501 00 spri4 pr6|256 STATEMENT 1 ON LINE 2854 print_final_value = parse_frame.print_final_value; 011730 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011731 aa 7 00012 2351 00 lda pr7|10 parse_frame.print_final_value 011732 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 2855 was_branch = "0"b; 011733 aa 6 00114 4501 00 stz pr6|76 was_branch STATEMENT 1 ON LINE 2856 was_branch_value = "0"b; 011734 aa 6 00115 4501 00 stz pr6|77 was_branch_value STATEMENT 1 ON LINE 2857 trace_branch_line = "0"b; 011735 aa 6 00113 4501 00 stz pr6|75 trace_branch_line STATEMENT 1 ON LINE 2859 restore_state_after_execute: entry (); 011736 aa 000002 7100 04 tra 2,ic 011740 ENTRY TO restore_state_after_execute STATEMENT 1 ON LINE 2859 restore_state_after_execute: entry (); 011737 aa 6 00400 6501 00 spri4 pr6|256 STATEMENT 1 ON LINE 2862 current_parseme = parse_frame.current_parseme; 011740 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 011741 aa 7 00005 2361 00 ldq pr7|5 parse_frame.current_parseme 011742 aa 6 00132 7561 00 stq pr6|90 current_parseme STATEMENT 1 ON LINE 2863 current_lexeme = parse_frame.current_lexeme; 011743 aa 7 00006 2361 00 ldq pr7|6 parse_frame.current_lexeme 011744 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 2864 return_point = parse_frame.return_point; 011745 aa 7 00010 2361 00 ldq pr7|8 parse_frame.return_point 011746 aa 6 00157 7561 00 stq pr6|111 return_point STATEMENT 1 ON LINE 2865 put_result = parse_frame.put_result; 011747 aa 7 00011 2361 00 ldq pr7|9 parse_frame.put_result 011750 aa 6 00156 7561 00 stq pr6|110 put_result STATEMENT 1 ON LINE 2866 lexed_function_bead_ptr = parse_frame.lexed_function_bead_ptr; 011751 aa 7 00003 7651 00 lprp5 pr7|3 parse_frame.lexed_function_bead_ptr 011752 aa 6 00134 6515 00 spri5 pr6|92 lexed_function_bead_ptr STATEMENT 1 ON LINE 2867 ws_info.current_parse_frame_ptr = parse_frame_ptr; 011753 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 011754 aa 3 00015 5471 00 sprp7 pr3|13 ws_info.current_parse_frame_ptr STATEMENT 1 ON LINE 2868 rsp = parse_frame.reduction_stack_ptr; 011755 aa 7 00004 7611 00 lprp1 pr7|4 parse_frame.reduction_stack_ptr 011756 aa 6 00126 2515 00 spri1 pr6|86 rsp STATEMENT 1 ON LINE 2870 number_of_ptrs = 1; 011757 aa 000001 2360 07 ldq 1,dl 011760 aa 6 00207 7561 00 stq pr6|135 number_of_ptrs STATEMENT 1 ON LINE 2871 input_buffer_ptr = addrel (parse_frame_ptr, size (parse_frame) - 1); 011761 aa 000014 0760 07 adq 12,dl 011762 aa 6 00122 3521 66 epp2 pr6|82,*ql parse_frame_ptr 011763 aa 000000 0520 03 adwp2 0,du 011764 aa 6 00104 2521 00 spri2 pr6|68 input_buffer_ptr STATEMENT 1 ON LINE 2880 if return_point = 2 then do; 011765 aa 6 00157 2361 00 ldq pr6|111 return_point 011766 aa 000002 1160 07 cmpq 2,dl 011767 aa 000006 6010 04 tnz 6,ic 011775 STATEMENT 1 ON LINE 2882 start = current_parseme; 011770 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011771 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 2883 number_of_arguments = 2; 011772 aa 000002 2360 07 ldq 2,dl 011773 aa 6 00160 7561 00 stq pr6|112 number_of_arguments STATEMENT 1 ON LINE 2884 end; 011774 aa 000013 7100 04 tra 11,ic 012007 STATEMENT 1 ON LINE 2885 else do; STATEMENT 1 ON LINE 2886 start = current_parseme - 1; 011775 aa 6 00132 2361 00 ldq pr6|90 current_parseme 011776 aa 000001 1760 07 sbq 1,dl 011777 aa 6 00155 7561 00 stq pr6|109 start STATEMENT 1 ON LINE 2888 if return_point >= 8 then number_of_arguments = 0; 012000 aa 6 00157 2361 00 ldq pr6|111 return_point 012001 aa 000010 1160 07 cmpq 8,dl 012002 aa 000003 6040 04 tmi 3,ic 012005 012003 aa 6 00160 4501 00 stz pr6|112 number_of_arguments 012004 aa 000003 7100 04 tra 3,ic 012007 STATEMENT 1 ON LINE 2890 else number_of_arguments = 1; 012005 aa 000001 2360 07 ldq 1,dl 012006 aa 6 00160 7561 00 stq pr6|112 number_of_arguments STATEMENT 1 ON LINE 2891 end; STATEMENT 1 ON LINE 2893 return; 012007 aa 6 00400 6101 00 rtcd pr6|256 STATEMENT 1 ON LINE 2895 end; END PROCEDURE restore_state BEGIN PROCEDURE value_error_reporter ENTRY TO value_error_reporter STATEMENT 1 ON LINE 2897 value_error_reporter: proc (where); 012010 aa 6 00406 6501 00 spri4 pr6|262 012011 aa 6 00410 2521 00 spri2 pr6|264 STATEMENT 1 ON LINE 2902 operators_argument.error_code = apl_error_table_$value; 012012 aa 6 00044 3701 20 epp4 pr6|36,* 012013 la 4 00200 2361 20 ldq pr4|128,* apl_error_table_$value 012014 aa 6 00205 7561 00 stq pr6|133 operators_argument.error_code STATEMENT 1 ON LINE 2903 current_lexeme = where; 012015 aa 2 00002 2361 20 ldq pr2|2,* where 012016 aa 6 00133 7561 00 stq pr6|91 current_lexeme STATEMENT 1 ON LINE 2904 go to report_error; 012017 aa 771461 7100 04 tra -3279,ic 003500 STATEMENT 1 ON LINE 2906 end; END PROCEDURE value_error_reporter BEGIN PROCEDURE push_new_frame ENTRY TO push_new_frame STATEMENT 1 ON LINE 2908 push_new_frame: proc; 012020 aa 6 00414 6501 00 spri4 pr6|268 STATEMENT 1 ON LINE 2911 temp_ptr = addr (rs (current_parseme + 1)); 012021 aa 6 00132 2361 00 ldq pr6|90 current_parseme 012022 aa 000002 7360 00 qls 2 012023 aa 6 00126 3735 66 epp7 pr6|86,*ql rs 012024 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 2912 temp_ptr -> last_parse_frame_ptr = parse_frame_ptr; 012025 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 012026 aa 7 00000 5451 00 sprp5 pr7|0 parse_frame.last_parse_frame_ptr STATEMENT 1 ON LINE 2913 parse_frame_ptr = temp_ptr; 012027 aa 6 00122 6535 00 spri7 pr6|82 parse_frame_ptr STATEMENT 1 ON LINE 2914 ws_info.current_parse_frame_ptr = parse_frame_ptr; 012030 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 012031 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 012032 aa 5 00015 5471 00 sprp7 pr5|13 ws_info.current_parse_frame_ptr STATEMENT 1 ON LINE 2915 parse_frame.lexed_function_bead_ptr = null; 012033 aa 002035 2360 04 ldq 1053,ic 014070 = 007777000001 012034 aa 7 00003 7561 00 stq pr7|3 parse_frame.lexed_function_bead_ptr STATEMENT 1 ON LINE 2916 parse_frame.current_parseme = 0; 012035 aa 7 00005 4501 00 stz pr7|5 parse_frame.current_parseme STATEMENT 1 ON LINE 2917 current_parseme = 0; 012036 aa 6 00132 4501 00 stz pr6|90 current_parseme STATEMENT 1 ON LINE 2919 if fixed (rel (ws_info.current_parse_frame_ptr), 18) > max_parse_stack_depth then go to depth_error; 012037 aa 5 00015 2361 00 ldq pr5|13 ws_info.current_parse_frame_ptr 012040 aa 0 00374 3771 00 anaq pr0|252 = 000000000000 000000777777 012041 aa 176030 1160 07 cmpq 64536,dl 012042 aa 771314 6054 04 tpnz -3380,ic 003356 STATEMENT 1 ON LINE 2922 return; 012043 aa 6 00414 6101 00 rtcd pr6|268 STATEMENT 1 ON LINE 2924 end; END PROCEDURE push_new_frame BEGIN PROCEDURE append_to_list_bead ENTRY TO append_to_list_bead STATEMENT 1 ON LINE 2929 append_to_list_bead: proc (reduction); 012044 aa 6 00422 6501 00 spri4 pr6|274 012045 aa 6 00424 2521 00 spri2 pr6|276 STATEMENT 1 ON LINE 2942 if reduction.semantics_valid then if reduction.semantics -> general_bead.list_value then n_members = reduction.semantics -> list_bead.number_of_members + 1; 012046 aa 2 00002 3735 20 epp7 pr2|2,* 012047 aa 7 00001 2351 00 lda pr7|1 reduction.semantics_valid 012050 aa 004000 3150 03 cana 2048,du 012051 aa 000015 6000 04 tze 13,ic 012066 012052 aa 7 00002 7651 00 lprp5 pr7|2 reduction.semantics 012053 aa 5 00000 2351 00 lda pr5|0 general_bead.list_value 012054 aa 001000 3150 03 cana 512,du 012055 aa 6 01126 6515 00 spri5 pr6|598 012056 aa 000005 6000 04 tze 5,ic 012063 012057 aa 5 00002 2361 00 ldq pr5|2 list_bead.number_of_members 012060 aa 000001 0760 07 adq 1,dl 012061 aa 6 00211 7561 00 stq pr6|137 n_members 012062 aa 000006 7100 04 tra 6,ic 012070 STATEMENT 1 ON LINE 2945 else n_members = 2; 012063 aa 000002 2360 07 ldq 2,dl 012064 aa 6 00211 7561 00 stq pr6|137 n_members 012065 aa 000003 7100 04 tra 3,ic 012070 STATEMENT 1 ON LINE 2946 else n_members = 1; 012066 aa 000001 2360 07 ldq 1,dl 012067 aa 6 00211 7561 00 stq pr6|137 n_members STATEMENT 1 ON LINE 2948 temp_ptr = apl_push_stack_ (size (list_bead)); 012070 aa 000001 7360 00 qls 1 012071 aa 000003 0760 07 adq 3,dl 012072 aa 6 01125 7561 00 stq pr6|597 012073 aa 001657 3520 04 epp2 943,ic 013752 = 000004000000 012074 aa 001143 6700 04 tsp4 611,ic 013237 STATEMENT 1 ON LINE 2949 unspec (temp_ptr -> list_bead.type) = list_value_type; 012075 aa 001000 2350 03 lda 512,du 012076 aa 6 00150 3735 20 epp7 pr6|104,* 012077 aa 7 00000 5511 60 stba pr7|0,60 STATEMENT 1 ON LINE 2950 temp_ptr -> list_bead.reference_count = -1; 012100 aa 000001 3360 07 lcq 1,dl 012101 aa 6 00150 3715 20 epp5 pr6|104,* temp_ptr 012102 aa 5 00001 7561 00 stq pr5|1 list_bead.reference_count STATEMENT 1 ON LINE 2951 temp_ptr -> list_bead.number_of_members = n_members; 012103 aa 6 00211 2361 00 ldq pr6|137 n_members 012104 aa 5 00002 7561 00 stq pr5|2 list_bead.number_of_members STATEMENT 1 ON LINE 2953 if ^reduction.semantics_valid then do; 012105 aa 6 00424 3535 20 epp3 pr6|276,* 012106 aa 3 00002 3515 20 epp1 pr3|2,* 012107 aa 1 00001 2351 00 lda pr1|1 reduction.semantics_valid 012110 aa 004000 3150 03 cana 2048,du 012111 aa 000011 6010 04 tnz 9,ic 012122 STATEMENT 1 ON LINE 2955 reduction.semantics_valid = "1"b; 012112 aa 004000 2350 03 lda 2048,du 012113 aa 1 00001 2551 00 orsa pr1|1 reduction.semantics_valid STATEMENT 1 ON LINE 2956 reduction.semantics_on_stack = "1"b; 012114 aa 000400 2350 03 lda 256,du 012115 aa 1 00001 2551 00 orsa pr1|1 reduction.semantics_on_stack STATEMENT 1 ON LINE 2957 reduction.has_list = "1"b; 012116 aa 002000 2350 03 lda 1024,du 012117 aa 1 00001 2551 00 orsa pr1|1 reduction.has_list STATEMENT 1 ON LINE 2958 reduction.semantics = temp_ptr; 012120 aa 1 00002 5451 00 sprp5 pr1|2 reduction.semantics STATEMENT 1 ON LINE 2959 return; 012121 aa 6 00422 6101 00 rtcd pr6|274 STATEMENT 1 ON LINE 2960 end; STATEMENT 1 ON LINE 2962 if reduction.semantics -> general_bead.list_value then do i = 2 to temp_ptr -> list_bead.number_of_members; 012122 aa 1 00002 7671 00 lprp7 pr1|2 reduction.semantics 012123 aa 7 00000 2351 00 lda pr7|0 general_bead.list_value 012124 aa 001000 3150 03 cana 512,du 012125 aa 000025 6000 04 tze 21,ic 012152 012126 aa 6 00430 7561 00 stq pr6|280 012127 aa 000002 2360 07 ldq 2,dl 012130 aa 6 00165 7561 00 stq pr6|117 i 012131 aa 000000 0110 03 nop 0,du 012132 aa 6 00165 2361 00 ldq pr6|117 i 012133 aa 6 00430 1161 00 cmpq pr6|280 012134 aa 000031 6054 04 tpnz 25,ic 012165 STATEMENT 1 ON LINE 2964 unspec (temp_ptr -> list_bead.members (i)) = unspec (reduction.semantics -> list_bead.members (i - 1)); 012135 aa 000001 7360 00 qls 1 012136 aa 6 00424 3735 20 epp7 pr6|276,* 012137 aa 7 00002 3715 20 epp5 pr7|2,* 012140 aa 5 00002 7631 00 lprp3 pr5|2 reduction.semantics 012141 aa 000000 6270 06 eax7 0,ql 012142 aa 3 77777 2351 06 lda pr3|-1,ql 012143 aa 3 00000 2361 06 ldq pr3|0,ql 012144 aa 6 00150 3515 20 epp1 pr6|104,* temp_ptr 012145 aa 1 00001 7551 17 sta pr1|1,7 012146 aa 1 00002 7561 17 stq pr1|2,7 STATEMENT 1 ON LINE 2965 end; 012147 aa 6 00165 0541 00 aos pr6|117 i 012150 aa 777762 7100 04 tra -14,ic 012132 012151 aa 000014 7100 04 tra 12,ic 012165 STATEMENT 1 ON LINE 2966 else do; STATEMENT 1 ON LINE 2967 temp_ptr -> list_bead.member_ptr (2) = reduction.semantics; 012152 aa 1 00002 2361 00 ldq pr1|2 reduction.semantics 012153 aa 5 00005 7561 00 stq pr5|5 list_bead.member_ptr STATEMENT 1 ON LINE 2968 unspec (temp_ptr -> list_bead.bits (2)) = unspec (reduction.bits); 012154 aa 1 00001 2351 00 lda pr1|1 012155 aa 5 00006 7551 00 sta pr5|6 STATEMENT 1 ON LINE 2969 unspec (reduction.bits) = ""b; 012156 aa 1 00001 4501 00 stz pr1|1 STATEMENT 1 ON LINE 2970 reduction.semantics_valid = "1"b; 012157 aa 004000 2350 03 lda 2048,du 012160 aa 1 00001 2551 00 orsa pr1|1 reduction.semantics_valid STATEMENT 1 ON LINE 2971 reduction.semantics_on_stack = "1"b; 012161 aa 000400 2350 03 lda 256,du 012162 aa 1 00001 2551 00 orsa pr1|1 reduction.semantics_on_stack STATEMENT 1 ON LINE 2972 reduction.has_list = "1"b; 012163 aa 002000 2350 03 lda 1024,du 012164 aa 1 00001 2551 00 orsa pr1|1 reduction.has_list STATEMENT 1 ON LINE 2973 end; STATEMENT 1 ON LINE 2975 reduction.semantics = temp_ptr; 012165 aa 6 00150 3735 20 epp7 pr6|104,* temp_ptr 012166 aa 6 00424 3715 20 epp5 pr6|276,* 012167 aa 5 00002 3535 20 epp3 pr5|2,* 012170 aa 3 00002 5471 00 sprp7 pr3|2 reduction.semantics STATEMENT 1 ON LINE 2976 return; 012171 aa 6 00422 6101 00 rtcd pr6|274 STATEMENT 1 ON LINE 2978 end; END PROCEDURE append_to_list_bead BEGIN PROCEDURE free_list_bead ENTRY TO free_list_bead STATEMENT 1 ON LINE 2980 free_list_bead: proc (which); 012172 aa 6 00432 6501 00 spri4 pr6|282 012173 aa 6 00434 2521 00 spri2 pr6|284 STATEMENT 1 ON LINE 2986 do i = 1 to which -> list_bead.number_of_members; 012174 aa 2 00002 3735 20 epp7 pr2|2,* 012175 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 012176 aa 7 00000 00 0044 descb pr7|0,36 which 012177 aa 6 01130 00 0044 descb pr6|600,36 which 012200 aa 6 01130 7651 00 lprp5 pr6|600 which 012201 aa 5 00002 2361 00 ldq pr5|2 list_bead.number_of_members 012202 aa 6 00441 7561 00 stq pr6|289 012203 aa 000001 2360 07 ldq 1,dl 012204 aa 6 00440 7561 00 stq pr6|288 i 012205 aa 000000 0110 03 nop 0,du 012206 aa 6 00440 2361 00 ldq pr6|288 i 012207 aa 6 00441 1161 00 cmpq pr6|289 012210 aa 000030 6054 04 tpnz 24,ic 012240 STATEMENT 1 ON LINE 2987 if which -> list_bead.member_ptr (i) ^= null then if ^which -> list_bead.bits (i).semantics_on_stack then call decrement_reference_count (which -> list_bead.member_ptr (i)); 012211 aa 6 00434 3735 20 epp7 pr6|284,* 012212 aa 7 00002 3715 20 epp5 pr7|2,* 012213 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 012214 aa 5 00000 00 0044 descb pr5|0,36 which 012215 aa 6 01130 00 0044 descb pr6|600,36 which 012216 aa 6 01130 7631 00 lprp3 pr6|600 which 012217 aa 000001 7360 00 qls 1 012220 aa 6 01130 7561 00 stq pr6|600 012221 aa 3 00001 2361 06 ldq pr3|1,ql list_bead.member_ptr 012222 aa 001646 1160 04 cmpq 934,ic 014070 = 007777000001 012223 aa 000013 6000 04 tze 11,ic 012236 012224 aa 6 01130 7271 00 lxl7 pr6|600 012225 aa 3 00002 2351 17 lda pr3|2,7 list_bead.semantics_on_stack 012226 aa 000400 3150 03 cana 256,du 012227 aa 000007 6010 04 tnz 7,ic 012236 012230 aa 3 00001 3521 17 epp2 pr3|1,7 list_bead.member_ptr 012231 aa 6 01134 2521 00 spri2 pr6|604 012232 aa 6 01132 3521 00 epp2 pr6|602 012233 aa 004000 4310 07 fld 2048,dl 012234 aa 2 00000 7571 00 staq pr2|0 012235 aa 777340 6700 04 tsp4 -288,ic 011575 STATEMENT 1 ON LINE 2990 end; 012236 aa 6 00440 0541 00 aos pr6|288 i 012237 aa 777747 7100 04 tra -25,ic 012206 STATEMENT 1 ON LINE 2992 return; 012240 aa 6 00432 6101 00 rtcd pr6|282 STATEMENT 1 ON LINE 2994 end; END PROCEDURE free_list_bead BEGIN PROCEDURE restore_old_meanings ENTRY TO restore_old_meanings STATEMENT 1 ON LINE 2997 restore_old_meanings: procedure; 012241 aa 6 00442 6501 00 spri4 pr6|290 STATEMENT 1 ON LINE 3000 do i = 1 to lexed_function_bead_ptr -> lexed_function_bead.number_of_localized_symbols; 012242 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 012243 aa 7 00005 2361 00 ldq pr7|5 lexed_function_bead.number_of_localized_symbols 012244 aa 6 00450 7561 00 stq pr6|296 012245 aa 000001 2360 07 ldq 1,dl 012246 aa 6 00165 7561 00 stq pr6|117 i 012247 aa 000000 0110 03 nop 0,du 012250 aa 6 00165 2361 00 ldq pr6|117 i 012251 aa 6 00450 1161 00 cmpq pr6|296 012252 aa 000046 6054 04 tpnz 38,ic 012320 STATEMENT 1 ON LINE 3001 temp_ptr = lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (i); 012253 aa 6 00134 3735 20 epp7 pr6|92,* lexed_function_bead_ptr 012254 aa 7 00011 7671 06 lprp7 pr7|9,ql lexed_function_bead.localized_symbols 012255 aa 6 00150 6535 00 spri7 pr6|104 temp_ptr STATEMENT 1 ON LINE 3002 if temp_ptr ^= null then if temp_ptr -> general_bead.symbol then do; 012256 aa 6 00150 2371 00 ldaq pr6|104 temp_ptr 012257 aa 766407 6770 04 eraq -4857,ic 000666 = 077777000043 000001000000 012260 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 012261 aa 000035 6000 04 tze 29,ic 012316 012262 aa 7 00000 2351 00 lda pr7|0 general_bead.symbol 012263 aa 200000 3150 03 cana 65536,du 012264 aa 000020 6000 04 tze 16,ic 012304 STATEMENT 1 ON LINE 3005 if temp_ptr -> symbol_bead.meaning_pointer ^= null then call decrement_reference_count (temp_ptr -> symbol_bead.meaning_pointer); 012265 aa 7 00003 2361 00 ldq pr7|3 symbol_bead.meaning_pointer 012266 aa 001602 1160 04 cmpq 898,ic 014070 = 007777000001 012267 aa 000007 6000 04 tze 7,ic 012276 012270 aa 7 00003 3521 00 epp2 pr7|3 symbol_bead.meaning_pointer 012271 aa 6 01142 2521 00 spri2 pr6|610 012272 aa 6 01140 3521 00 epp2 pr6|608 012273 aa 004000 4310 07 fld 2048,dl 012274 aa 2 00000 7571 00 staq pr2|0 012275 aa 777300 6700 04 tsp4 -320,ic 011575 STATEMENT 1 ON LINE 3008 temp_ptr -> symbol_bead.meaning_pointer = parse_frame.old_meaning_ptrs (i); 012276 aa 6 00165 7271 00 lxl7 pr6|117 i 012277 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 012300 aa 7 00014 2361 17 ldq pr7|12,7 parse_frame.old_meaning_ptrs 012301 aa 6 00150 3715 20 epp5 pr6|104,* temp_ptr 012302 aa 5 00003 7561 00 stq pr5|3 symbol_bead.meaning_pointer STATEMENT 1 ON LINE 3009 end; 012303 aa 000013 7100 04 tra 11,ic 012316 STATEMENT 1 ON LINE 3010 else do; STATEMENT 1 ON LINE 3011 call restore_system_variable_value (temp_ptr, parse_frame.old_meaning_ptrs (i)); 012304 aa 6 00150 3521 00 epp2 pr6|104 temp_ptr 012305 aa 6 01150 2521 00 spri2 pr6|616 012306 aa 6 00165 7271 00 lxl7 pr6|117 i 012307 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 012310 aa 5 00014 3521 17 epp2 pr5|12,7 parse_frame.old_meaning_ptrs 012311 aa 6 01152 2521 00 spri2 pr6|618 012312 aa 6 01146 3521 00 epp2 pr6|614 012313 aa 010000 4310 07 fld 4096,dl 012314 aa 2 00000 7571 00 staq pr2|0 012315 aa 776052 6700 04 tsp4 -982,ic 010367 STATEMENT 1 ON LINE 3012 end; STATEMENT 1 ON LINE 3013 end; 012316 aa 6 00165 0541 00 aos pr6|117 i 012317 aa 777731 7100 04 tra -39,ic 012250 STATEMENT 1 ON LINE 3015 return; 012320 aa 6 00442 6101 00 rtcd pr6|290 STATEMENT 1 ON LINE 3017 end /* restore_old_meanings */; END PROCEDURE restore_old_meanings BEGIN PROCEDURE check_trace_vector ENTRY TO check_trace_vector STATEMENT 1 ON LINE 3019 check_trace_vector: procedure; 012321 aa 6 00452 6501 00 spri4 pr6|298 STATEMENT 1 ON LINE 3024 if ^was_branch then if this_statement_is_one (parse_frame.current_line_number, parse_frame.function_bead_ptr -> function_bead.trace_control_pointer) then do; 012322 aa 6 00114 2351 00 lda pr6|76 was_branch 012323 aa 000053 6010 04 tnz 43,ic 012376 012324 aa 6 00122 3735 20 epp7 pr6|82,* parse_frame_ptr 012325 aa 7 00002 7671 00 lprp7 pr7|2 parse_frame.function_bead_ptr 012326 aa 6 00122 3715 20 epp5 pr6|82,* parse_frame_ptr 012327 aa 5 00007 3521 00 epp2 pr5|7 parse_frame.current_line_number 012330 aa 6 01162 2521 00 spri2 pr6|626 012331 aa 7 00005 3521 00 epp2 pr7|5 function_bead.trace_control_pointer 012332 aa 6 01164 2521 00 spri2 pr6|628 012333 aa 6 01156 3521 00 epp2 pr6|622 012334 aa 6 01166 2521 00 spri2 pr6|630 012335 aa 6 01160 3521 00 epp2 pr6|624 012336 aa 014000 4310 07 fld 6144,dl 012337 aa 2 00000 7571 00 staq pr2|0 012340 aa 000037 6700 04 tsp4 31,ic 012377 012341 aa 6 01156 2351 00 lda pr6|622 012342 aa 400000 3150 03 cana 131072,du 012343 aa 000033 6000 04 tze 27,ic 012376 STATEMENT 1 ON LINE 3028 print_final_value = "1"b; 012344 aa 400000 2350 03 lda 131072,du 012345 aa 6 00161 7551 00 sta pr6|113 print_final_value STATEMENT 1 ON LINE 3029 if ^rs (current_parseme - 1).semantics_valid | rs (current_parseme - 1).semantics = null then call print_where_I_am (parse_frame_ptr, "0"b, "1"b); 012346 aa 6 00132 2361 00 ldq pr6|90 current_parseme 012347 aa 000001 1760 07 sbq 1,dl 012350 aa 000002 7360 00 qls 2 012351 aa 6 00126 3735 20 epp7 pr6|86,* rsp 012352 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_valid 012353 aa 004000 3150 03 cana 2048,du 012354 aa 000006 6000 04 tze 6,ic 012362 012355 aa 6 00132 2361 00 ldq pr6|90 current_parseme 012356 aa 000002 7360 00 qls 2 012357 aa 7 77772 2361 06 ldq pr7|-6,ql rs.semantics 012360 aa 001510 1160 04 cmpq 840,ic 014070 = 007777000001 012361 aa 000010 6010 04 tnz 8,ic 012371 012362 aa 000000 2350 07 lda 0,dl 012363 aa 6 01156 7551 00 sta pr6|622 012364 aa 400000 2350 03 lda 131072,du 012365 aa 6 01157 7551 00 sta pr6|623 012366 aa 001354 3520 04 epp2 748,ic 013742 = 000006000000 012367 aa 000070 6700 04 tsp4 56,ic 012457 012370 aa 000006 7100 04 tra 6,ic 012376 STATEMENT 1 ON LINE 3031 else call print_where_I_am (parse_frame_ptr, "0"b, "0"b); 012371 aa 000000 2350 07 lda 0,dl 012372 aa 6 01157 7551 00 sta pr6|623 012373 aa 6 01156 7551 00 sta pr6|622 012374 aa 001336 3520 04 epp2 734,ic 013732 = 000006000000 012375 aa 000062 6700 04 tsp4 50,ic 012457 STATEMENT 1 ON LINE 3032 end; STATEMENT 1 ON LINE 3034 end /* check_trace_vector */; 012376 aa 6 00452 6101 00 rtcd pr6|298 END PROCEDURE check_trace_vector BEGIN PROCEDURE this_statement_is_one ENTRY TO this_statement_is_one STATEMENT 1 ON LINE 3036 this_statement_is_one: procedure (P_line_number, P_ptr_to_vb) returns (bit (1) aligned); 012377 aa 6 00460 6501 00 spri4 pr6|304 012400 aa 6 00462 2521 00 spri2 pr6|306 STATEMENT 1 ON LINE 3052 ptr_to_vb = P_ptr_to_vb; 012401 aa 2 00004 3735 20 epp7 pr2|4,* 012402 aa 003 100 060 500 csl (pr),(pr),fill(0),bool(move) 012403 aa 7 00000 00 0044 descb pr7|0,36 P_ptr_to_vb 012404 aa 6 01172 00 0044 descb pr6|634,36 P_ptr_to_vb 012405 aa 6 01172 7651 00 lprp5 pr6|634 P_ptr_to_vb 012406 aa 6 00466 6515 00 spri5 pr6|310 ptr_to_vb STATEMENT 1 ON LINE 3053 x = P_line_number; 012407 aa 2 00002 2361 20 ldq pr2|2,* P_line_number 012410 aa 0 00465 7001 00 tsx0 pr0|309 fx1_to_fl2 012411 aa 6 00116 4571 00 dfst pr6|78 x STATEMENT 1 ON LINE 3055 do i = 0 by 1 while (i < ptr_to_vb -> value_bead.total_data_elements); 012412 aa 6 00165 4501 00 stz pr6|117 i 012413 aa 000000 0110 03 nop 0,du 012414 aa 6 00165 2361 00 ldq pr6|117 i 012415 aa 6 00466 3735 20 epp7 pr6|310,* ptr_to_vb 012416 aa 7 00002 1161 00 cmpq pr7|2 value_bead.total_data_elements 012417 aa 000035 6050 04 tpl 29,ic 012454 STATEMENT 1 ON LINE 3056 xx = ptr_to_vb -> value_bead.data_pointer -> numeric_datum (i); 012420 aa 7 00004 7651 00 lprp5 pr7|4 value_bead.data_pointer 012421 aa 000001 7360 00 qls 1 012422 aa 5 00000 4331 06 dfld pr5|0,ql numeric_datum 012423 aa 6 00120 4571 00 dfst pr6|80 xx STATEMENT 1 ON LINE 3057 if x = xx then return ("1"b); 012424 aa 6 00116 5171 00 dfcmp pr6|78 x 012425 aa 000005 6010 04 tnz 5,ic 012432 012426 aa 400000 2350 03 lda 131072,du 012427 aa 6 00462 3535 20 epp3 pr6|306,* 012430 aa 3 00006 7551 20 sta pr3|6,* 012431 aa 6 00460 6101 00 rtcd pr6|304 STATEMENT 1 ON LINE 3059 if abs (x - xx) < fuzz * abs (x + xx) then return ("1"b); 012432 aa 6 00116 4771 00 dfad pr6|78 x 012433 aa 000002 6050 04 tpl 2,ic 012435 012434 aa 000000 5130 00 fneg 0 012435 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 012436 aa 3 00006 4631 00 dfmp pr3|6 ws_info.fuzz 012437 aa 6 01174 4571 00 dfst pr6|636 012440 aa 6 00116 4331 00 dfld pr6|78 x 012441 aa 6 00120 5771 00 dfsb pr6|80 xx 012442 aa 000002 6050 04 tpl 2,ic 012444 012443 aa 000000 5130 00 fneg 0 012444 aa 6 01174 5171 00 dfcmp pr6|636 012445 aa 000005 6050 04 tpl 5,ic 012452 012446 aa 400000 2350 03 lda 131072,du 012447 aa 6 00462 3515 20 epp1 pr6|306,* 012450 aa 1 00006 7551 20 sta pr1|6,* 012451 aa 6 00460 6101 00 rtcd pr6|304 STATEMENT 1 ON LINE 3061 end; 012452 aa 6 00165 0541 00 aos pr6|117 i 012453 aa 777741 7100 04 tra -31,ic 012414 STATEMENT 1 ON LINE 3062 return ("0"b); 012454 aa 6 00462 3715 20 epp5 pr6|306,* 012455 aa 5 00006 4501 20 stz pr5|6,* 012456 aa 6 00460 6101 00 rtcd pr6|304 STATEMENT 1 ON LINE 3064 end /* this_statement_is_one */; END PROCEDURE this_statement_is_one BEGIN PROCEDURE print_where_I_am ENTRY TO print_where_I_am STATEMENT 1 ON LINE 3066 print_where_I_am: procedure (P_frame_ptr, P_add_arrow, P_add_nl); 012457 aa 6 00470 6501 00 spri4 pr6|312 012460 aa 6 00472 2521 00 spri2 pr6|314 STATEMENT 1 ON LINE 3093 sp = P_frame_ptr -> parse_frame.lexed_function_bead_ptr -> lexed_function_bead.name; 012461 aa 2 00002 3735 20 epp7 pr2|2,* P_frame_ptr 012462 aa 7 00000 3735 20 epp7 pr7|0,* P_frame_ptr 012463 aa 7 00003 7651 00 lprp5 pr7|3 parse_frame.lexed_function_bead_ptr 012464 aa 5 00002 7631 00 lprp3 pr5|2 lexed_function_bead.name 012465 aa 6 00506 2535 00 spri3 pr6|326 sp STATEMENT 1 ON LINE 3094 linex = length (sp -> symbol_bead.name); 012466 aa 3 00004 2361 00 ldq pr3|4 symbol_bead.name_length 012467 aa 6 00503 7561 00 stq pr6|323 linex STATEMENT 1 ON LINE 3095 substr (line, 1, linex) = sp -> symbol_bead.name; 012470 aa 6 00132 2361 00 ldq pr6|90 current_parseme 012471 aa 000002 7360 00 qls 2 012472 aa 6 00126 3515 66 epp1 pr6|86,*ql line 012473 aa 6 00503 2351 00 lda pr6|323 linex 012474 aa 3 00004 7271 00 lxl7 pr3|4 symbol_bead.name_length 012475 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 012476 aa 3 00005 00 0017 desc9a pr3|5,x7 symbol_bead.name 012477 aa 1 00000 00 0005 desc9a pr1|0,al line STATEMENT 1 ON LINE 3096 linex = linex + 1; 012500 aa 6 00503 0541 00 aos pr6|323 linex STATEMENT 1 ON LINE 3098 substr (line, linex, 1) = QLeftBracket; 012501 aa 6 00126 3715 66 epp5 pr6|86,*ql rs 012502 aa 6 00503 2351 00 lda pr6|323 linex 012503 aa 133 105 100 400 mlr (),(pr,al),fill(133) 012504 aa 000000 00 0000 desc9a 0,0 012505 aa 5 77777 60 0001 desc9a pr5|-1(3),1 line STATEMENT 1 ON LINE 3099 linex = linex + 1; 012506 aa 6 00503 0541 00 aos pr6|323 linex STATEMENT 1 ON LINE 3101 line_number = P_frame_ptr -> parse_frame.current_line_number; 012507 aa 000 100 301 500 btd (pr),(pr) 012510 aa 7 00007 00 0004 desc9a pr7|7,4 parse_frame.current_line_number 012511 aa 6 01176 01 0014 desc9ls pr6|638,12,0 012512 aa 100 004 024 500 mvne (pr),(ic),(pr) 012513 aa 6 01176 01 0014 desc9ls pr6|638,12,0 012514 aa 001217 00 0003 desc9a 655,3 013731 = 112070321000 012515 aa 6 00476 00 0013 desc9a pr6|318,11 line_number STATEMENT 1 ON LINE 3102 first_nonblank = verify (line_number, " "); 012516 aa 6 01201 7561 00 stq pr6|641 012517 aa 000 000 164 500 tct (pr) 012520 aa 6 00476 00 0013 desc9a pr6|318,11 line_number 012521 aa 0 76605 0001 00 arg pr0|-635 = 777777777777 012522 aa 6 00056 0001 00 arg pr6|46 012523 aa 6 00056 2361 00 ldq pr6|46 012524 aa 0 00242 3761 00 anq pr0|162 = 000777777777 012525 aa 000002 6070 04 ttf 2,ic 012527 012526 aa 000001 3360 07 lcq 1,dl 012527 aa 000001 0760 07 adq 1,dl 012530 aa 6 00501 7561 00 stq pr6|321 first_nonblank STATEMENT 1 ON LINE 3103 n_nonblank = length (line_number) - first_nonblank + 1; 012531 aa 000013 2360 07 ldq 11,dl 012532 aa 6 00501 1761 00 sbq pr6|321 first_nonblank 012533 aa 000001 0760 07 adq 1,dl 012534 aa 6 00504 7561 00 stq pr6|324 n_nonblank STATEMENT 1 ON LINE 3104 substr (line, linex, n_nonblank) = substr (line_number, first_nonblank, n_nonblank); 012535 aa 6 00503 2351 00 lda pr6|323 linex 012536 aa 6 00501 2361 00 ldq pr6|321 first_nonblank 012537 aa 000003 0750 07 ada 3,dl 012540 aa 5 77777 3735 00 epp7 pr5|-1 line 012541 aa 7 00000 5005 05 a9bd pr7|0,al 012542 aa 6 00504 2351 00 lda pr6|324 n_nonblank 012543 aa 040 140 100 546 mlr (pr,rl,ql),(pr,rl),fill(040) 012544 aa 6 00475 60 0005 desc9a pr6|317(3),al line_number 012545 aa 7 00000 00 0005 desc9a pr7|0,al line STATEMENT 1 ON LINE 3105 linex = linex + n_nonblank; 012546 aa 6 00504 2361 00 ldq pr6|324 n_nonblank 012547 aa 6 00503 0561 00 asq pr6|323 linex STATEMENT 1 ON LINE 3107 substr (line, linex, 1) = QRightBracket; 012550 aa 6 00503 2351 00 lda pr6|323 linex 012551 aa 135 105 100 400 mlr (),(pr,al),fill(135) 012552 aa 000000 00 0000 desc9a 0,0 012553 aa 5 77777 60 0001 desc9a pr5|-1(3),1 line STATEMENT 1 ON LINE 3108 linex = linex + 1; 012554 aa 6 00503 0541 00 aos pr6|323 linex STATEMENT 1 ON LINE 3110 if P_add_arrow then do; 012555 aa 6 01202 6515 00 spri5 pr6|642 012556 aa 2 00004 2351 20 lda pr2|4,* P_add_arrow 012557 aa 400000 3150 03 cana 131072,du 012560 aa 000012 6000 04 tze 10,ic 012572 STATEMENT 1 ON LINE 3112 substr (line, linex, 2) = " " || QRightArrow; 012561 aa 000256 2350 03 lda 174,du 012562 aa 040000 2750 03 ora 16384,du 012563 aa 6 00056 7551 00 sta pr6|46 012564 aa 6 00503 2361 00 ldq pr6|323 linex 012565 aa 040 106 100 500 mlr (pr),(pr,ql),fill(040) 012566 aa 6 00056 00 0002 desc9a pr6|46,2 012567 aa 5 77777 60 0002 desc9a pr5|-1(3),2 line STATEMENT 1 ON LINE 3113 linex = linex + 2; 012570 aa 000002 2360 07 ldq 2,dl 012571 aa 6 00503 0561 00 asq pr6|323 linex STATEMENT 1 ON LINE 3114 end; STATEMENT 1 ON LINE 3116 if ^P_add_nl then do; 012572 aa 2 00006 2351 20 lda pr2|6,* P_add_nl 012573 aa 400000 3150 03 cana 131072,du 012574 aa 000006 6010 04 tnz 6,ic 012602 STATEMENT 1 ON LINE 3118 substr (line, linex, 1) = " "; 012575 aa 6 00503 2361 00 ldq pr6|323 linex 012576 aa 040 106 100 400 mlr (),(pr,ql),fill(040) 012577 aa 000000 00 0000 desc9a 0,0 012600 aa 5 77777 60 0001 desc9a pr5|-1(3),1 line STATEMENT 1 ON LINE 3119 linex = linex + 1; 012601 aa 6 00503 0541 00 aos pr6|323 linex STATEMENT 1 ON LINE 3120 end; STATEMENT 1 ON LINE 3122 line_len = linex - 1; 012602 aa 6 00503 2361 00 ldq pr6|323 linex 012603 aa 000001 1760 07 sbq 1,dl 012604 aa 6 00502 7561 00 stq pr6|322 line_len STATEMENT 1 ON LINE 3123 call apl_print_string_ (line); 012605 aa 526000 2760 03 orq 175104,du 012606 aa 6 01201 7561 00 stq pr6|641 012607 aa 5 00000 3521 00 epp2 pr5|0 line 012610 aa 6 01206 2521 00 spri2 pr6|646 012611 aa 6 01201 3521 00 epp2 pr6|641 012612 aa 6 01210 2521 00 spri2 pr6|648 012613 aa 6 01204 6211 00 eax1 pr6|644 012614 aa 004000 4310 07 fld 2048,dl 012615 aa 6 00044 3701 20 epp4 pr6|36,* 012616 la 4 00070 3521 20 epp2 pr4|56,* apl_print_string_ 012617 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3125 if P_add_nl then call apl_flush_buffer_nl_; 012620 aa 6 00472 3735 20 epp7 pr6|314,* 012621 aa 7 00006 2351 20 lda pr7|6,* P_add_nl 012622 aa 400000 3150 03 cana 131072,du 012623 aa 000006 6000 04 tze 6,ic 012631 012624 aa 6 00056 6211 00 eax1 pr6|46 012625 aa 000000 4310 07 fld 0,dl 012626 aa 6 00044 3701 20 epp4 pr6|36,* 012627 la 4 00064 3521 20 epp2 pr4|52,* apl_flush_buffer_nl_ 012630 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3128 return; 012631 aa 6 00470 6101 00 rtcd pr6|312 STATEMENT 1 ON LINE 3130 end; END PROCEDURE print_where_I_am BEGIN PROCEDURE initial_interrupt ENTRY TO initial_interrupt STATEMENT 1 ON LINE 3132 initial_interrupt: procedure; 012632 aa 6 00100 6501 00 spri4 pr6|64 STATEMENT 1 ON LINE 3143 call reattach_user_input; 012633 aa 000001 7270 07 lxl7 1,dl 012634 aa 6 00056 6211 00 eax1 pr6|46 012635 aa 000000 4310 07 fld 0,dl 012636 aa 000102 3520 04 epp2 66,ic 012740 = 000140627000 012637 aa 0 00627 7001 00 tsx0 pr0|407 call_int_other STATEMENT 1 ON LINE 3144 call iox_$control (apl_static_$apl_input, "resetread", null, (0)); 012640 aa 766044 2370 04 ldaq -5084,ic 000704 = 162145163145 164162145141 012641 aa 6 00116 7571 00 staq pr6|78 012642 aa 144000 2350 03 lda 51200,du 012643 aa 6 00120 7551 00 sta pr6|80 012644 aa 766022 3734 24 epp7 -5102,ic* 012645 aa 6 00122 6535 00 spri7 pr6|82 012646 aa 6 00121 4501 00 stz pr6|81 012647 aa 6 00044 3701 20 epp4 pr6|36,* 012650 la 4 00076 3521 20 epp2 pr4|62,* apl_static_$apl_input 012651 aa 6 00126 2521 00 spri2 pr6|86 012652 aa 6 00116 3521 00 epp2 pr6|78 012653 aa 6 00130 2521 00 spri2 pr6|88 012654 aa 6 00122 3521 00 epp2 pr6|82 012655 aa 6 00132 2521 00 spri2 pr6|90 012656 aa 6 00121 3521 00 epp2 pr6|81 012657 aa 6 00134 2521 00 spri2 pr6|92 012660 aa 765772 3520 04 epp2 -5126,ic 000652 = 464000000000 012661 aa 6 00136 2521 00 spri2 pr6|94 012662 aa 6 00142 2521 00 spri2 pr6|98 012663 aa 765765 3520 04 epp2 -5131,ic 000650 = 524000000011 012664 aa 6 00140 2521 00 spri2 pr6|96 012665 aa 765760 3520 04 epp2 -5136,ic 000645 = 404000000043 012666 aa 6 00144 2521 00 spri2 pr6|100 012667 aa 6 00124 6211 00 eax1 pr6|84 012670 aa 020000 4310 07 fld 8192,dl 012671 la 4 00026 3521 20 epp2 pr4|22,* iox_$control 012672 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3146 if in_printer /* in apl_print_value_, stop typing and INTERRUPT now */ | can_be_interrupted & ^clean_interrupt_pending then do; 012673 aa 6 00040 3735 20 epp7 pr6|32,* 012674 aa 7 00131 2351 00 lda pr7|89 in_printer 012675 aa 000006 6010 04 tnz 6,ic 012703 012676 aa 7 00174 3715 20 epp5 pr7|124,* ws_info_ptr 012677 aa 5 00105 2351 00 lda pr5|69 ws_info.can_be_interrupted 012700 aa 000011 6000 04 tze 9,ic 012711 012701 aa 5 00106 2351 00 lda pr5|70 ws_info.clean_interrupt_pending 012702 aa 000007 6010 04 tnz 7,ic 012711 STATEMENT 1 ON LINE 3152 operators_argument.error_code = apl_error_table_$interrupt; 012703 aa 6 00044 3701 20 epp4 pr6|36,* 012704 la 4 00136 2361 20 ldq pr4|94,* apl_error_table_$interrupt 012705 aa 7 00205 7561 00 stq pr7|133 operators_argument.error_code STATEMENT 1 ON LINE 3153 go to report_error; 012706 aa 770572 3520 04 epp2 -3718,ic 003500 = 600122373520 012707 aa 000001 7270 07 lxl7 1,dl 012710 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3154 end; STATEMENT 1 ON LINE 3155 else if clean_interrupt_pending /* ignore multiple interrupts */ then return; 012711 aa 5 00106 2351 00 lda pr5|70 ws_info.clean_interrupt_pending 012712 aa 000002 6000 04 tze 2,ic 012714 012713 aa 6 00100 6101 00 rtcd pr6|64 STATEMENT 1 ON LINE 3160 clean_interrupt_pending = "1"b; 012714 aa 400000 2350 03 lda 131072,du 012715 aa 5 00106 7551 00 sta pr5|70 ws_info.clean_interrupt_pending STATEMENT 1 ON LINE 3162 call timer_manager_$alarm_call (four_seconds, relative_seconds, first_timer); 012716 aa 000167 3520 04 epp2 119,ic 013105 = 000140627000 012717 aa 000001 2360 07 ldq 1,dl 012720 aa 0 00653 7001 00 tsx0 pr0|427 make_label_var 012721 aa 6 00124 3521 00 epp2 pr6|84 cp.1079 012722 aa 0 00652 7001 00 tsx0 pr0|426 move_label_var 012723 aa 765277 3520 04 epp2 -5441,ic 000222 = 000000000000 012724 aa 6 00150 2521 00 spri2 pr6|104 012725 aa 765273 3520 04 epp2 -5445,ic 000220 = 600000000000 012726 aa 6 00152 2521 00 spri2 pr6|106 012727 aa 6 00124 3521 00 epp2 pr6|84 cp.1079 012730 aa 6 00154 2521 00 spri2 pr6|108 012731 aa 6 00146 6211 00 eax1 pr6|102 012732 aa 014000 4310 07 fld 6144,dl 012733 aa 6 00044 3701 20 epp4 pr6|36,* 012734 la 4 00012 3521 20 epp2 pr4|10,* timer_manager_$alarm_call 012735 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3164 return; 012736 aa 6 00100 6101 00 rtcd pr6|64 STATEMENT 1 ON LINE 3166 end; END PROCEDURE initial_interrupt BEGIN PROCEDURE reattach_user_input ENTRY TO reattach_user_input STATEMENT 1 ON LINE 3171 reattach_user_input: procedure; 012737 da 001453200000 012740 aa 000140 6270 00 eax7 96 012741 aa 7 00034 3521 20 epp2 pr7|28,* 012742 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 012743 aa 000000000000 012744 aa 000000000000 STATEMENT 1 ON LINE 3174 call iox_$detach_iocb (iox_$user_input, code); 012745 la 4 00102 3521 20 epp2 pr4|66,* iox_$user_input 012746 aa 6 00102 2521 00 spri2 pr6|66 012747 aa 6 00040 3735 20 epp7 pr6|32,* 012750 aa 7 00162 3521 00 epp2 pr7|114 code 012751 aa 6 00104 2521 00 spri2 pr6|68 012752 aa 6 00100 6211 00 eax1 pr6|64 012753 aa 010000 4310 07 fld 4096,dl 012754 la 4 00030 3521 20 epp2 pr4|24,* iox_$detach_iocb 012755 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3175 if code ^= 0 then if code = error_table_$not_closed then do; 012756 aa 6 00040 3735 20 epp7 pr6|32,* 012757 aa 7 00162 2361 00 ldq pr7|114 code 012760 aa 000026 6000 04 tze 22,ic 013006 012761 aa 6 00044 3701 20 epp4 pr6|36,* 012762 la 4 00204 1161 20 cmpq pr4|132,* error_table_$not_closed 012763 aa 000023 6010 04 tnz 19,ic 013006 STATEMENT 1 ON LINE 3178 call iox_$close (iox_$user_input, code); 012764 la 4 00102 3521 20 epp2 pr4|66,* iox_$user_input 012765 aa 6 00102 2521 00 spri2 pr6|66 012766 aa 7 00162 3521 00 epp2 pr7|114 code 012767 aa 6 00104 2521 00 spri2 pr6|68 012770 aa 6 00100 6211 00 eax1 pr6|64 012771 aa 010000 4310 07 fld 4096,dl 012772 la 4 00024 3521 20 epp2 pr4|20,* iox_$close 012773 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3179 call iox_$detach_iocb (iox_$user_input, code); 012774 aa 6 00044 3701 20 epp4 pr6|36,* 012775 la 4 00102 3521 20 epp2 pr4|66,* iox_$user_input 012776 aa 6 00102 2521 00 spri2 pr6|66 012777 aa 6 00040 3735 20 epp7 pr6|32,* 013000 aa 7 00162 3521 00 epp2 pr7|114 code 013001 aa 6 00104 2521 00 spri2 pr6|68 013002 aa 6 00100 6211 00 eax1 pr6|64 013003 aa 010000 4310 07 fld 4096,dl 013004 la 4 00030 3521 20 epp2 pr4|24,* iox_$detach_iocb 013005 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3180 end; STATEMENT 1 ON LINE 3181 call iox_$attach_ptr (iox_$user_input, "syn_ user_i/o", null, code); 013006 aa 765713 2350 04 lda -5173,ic 000721 = 163171156137 013007 aa 765713 2360 04 ldq -5173,ic 000722 = 040165163145 013010 aa 6 00100 7571 00 staq pr6|64 013011 aa 765712 2350 04 lda -5174,ic 000723 = 162137151057 013012 aa 157000 2360 03 ldq 56832,du 013013 aa 6 00102 7571 00 staq pr6|66 013014 aa 765652 3734 24 epp7 -5206,ic* 013015 aa 6 00106 6535 00 spri7 pr6|70 013016 aa 6 00044 3701 20 epp4 pr6|36,* 013017 la 4 00102 3521 20 epp2 pr4|66,* iox_$user_input 013020 aa 6 00112 2521 00 spri2 pr6|74 013021 aa 6 00100 3521 00 epp2 pr6|64 013022 aa 6 00114 2521 00 spri2 pr6|76 013023 aa 6 00106 3521 00 epp2 pr6|70 013024 aa 6 00116 2521 00 spri2 pr6|78 013025 aa 6 00040 3715 20 epp5 pr6|32,* 013026 aa 5 00162 3521 00 epp2 pr5|114 code 013027 aa 6 00120 2521 00 spri2 pr6|80 013030 aa 765622 3520 04 epp2 -5230,ic 000652 = 464000000000 013031 aa 6 00122 2521 00 spri2 pr6|82 013032 aa 6 00126 2521 00 spri2 pr6|86 013033 aa 765601 3520 04 epp2 -5247,ic 000634 = 524000000015 013034 aa 6 00124 2521 00 spri2 pr6|84 013035 aa 765610 3520 04 epp2 -5240,ic 000645 = 404000000043 013036 aa 6 00130 2521 00 spri2 pr6|88 013037 aa 6 00110 6211 00 eax1 pr6|72 013040 aa 020000 4310 07 fld 8192,dl 013041 la 4 00022 3521 20 epp2 pr4|18,* iox_$attach_ptr 013042 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3183 end /* reattach_user_input */; 013043 aa 0 00631 7101 00 tra pr0|409 return END PROCEDURE reattach_user_input BEGIN PROCEDURE reset_interrupt_info ENTRY TO reset_interrupt_info STATEMENT 1 ON LINE 3185 reset_interrupt_info: procedure; 013044 aa 6 00510 6501 00 spri4 pr6|328 STATEMENT 1 ON LINE 3188 call timer_manager_$reset_alarm_call (first_timer); 013045 aa 000040 3520 04 epp2 32,ic 013105 = 000140627000 013046 aa 6 01212 2521 00 spri2 pr6|650 cp.1079 013047 aa 6 01214 6521 00 spri6 pr6|652 cp.1079 013050 aa 6 01212 3521 00 epp2 pr6|650 cp.1079 013051 aa 6 01220 2521 00 spri2 pr6|656 013052 aa 6 01216 6211 00 eax1 pr6|654 013053 aa 004000 4310 07 fld 2048,dl 013054 aa 6 00044 3701 20 epp4 pr6|36,* 013055 la 4 00014 3521 20 epp2 pr4|12,* timer_manager_$reset_alarm_call 013056 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3189 call timer_manager_$reset_alarm_call (second_timer); 013057 aa 000064 3520 04 epp2 52,ic 013143 = 000120627000 013060 aa 6 01216 2521 00 spri2 pr6|654 cp.1079 013061 aa 6 01220 6521 00 spri6 pr6|656 cp.1079 013062 aa 6 01216 3521 00 epp2 pr6|654 cp.1079 013063 aa 6 01214 2521 00 spri2 pr6|652 013064 aa 6 01212 6211 00 eax1 pr6|650 013065 aa 004000 4310 07 fld 2048,dl 013066 aa 6 00044 3701 20 epp4 pr6|36,* 013067 la 4 00014 3521 20 epp2 pr4|12,* timer_manager_$reset_alarm_call 013070 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3190 ws_info.dont_interrupt_parse = "1"b; 013071 aa 400000 2350 03 lda 131072,du 013072 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 013073 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 3191 ws_info.dont_interrupt_operator = "0"b; 013074 aa 7 00101 4501 00 stz pr7|65 ws_info.dont_interrupt_operator STATEMENT 1 ON LINE 3192 ws_info.dont_interrupt_storage_manager = "0"b; 013075 aa 7 00102 4501 00 stz pr7|66 ws_info.dont_interrupt_storage_manager STATEMENT 1 ON LINE 3193 ws_info.dont_interrupt_command = "0"b; 013076 aa 7 00104 4501 00 stz pr7|68 ws_info.dont_interrupt_command STATEMENT 1 ON LINE 3194 ws_info.can_be_interrupted = "0"b; 013077 aa 7 00105 4501 00 stz pr7|69 ws_info.can_be_interrupted STATEMENT 1 ON LINE 3195 ws_info.clean_interrupt_pending = "0"b; 013100 aa 7 00106 4501 00 stz pr7|70 ws_info.clean_interrupt_pending STATEMENT 1 ON LINE 3196 ws_info.dirty_interrupt_pending = "0"b; 013101 aa 7 00107 4501 00 stz pr7|71 ws_info.dirty_interrupt_pending STATEMENT 1 ON LINE 3197 in_printer = "0"b; 013102 aa 6 00131 4501 00 stz pr6|89 in_printer STATEMENT 1 ON LINE 3199 return; 013103 aa 6 00510 6101 00 rtcd pr6|328 STATEMENT 1 ON LINE 3201 end; END PROCEDURE reset_interrupt_info BEGIN PROCEDURE first_timer ENTRY TO first_timer STATEMENT 1 ON LINE 3203 first_timer: procedure; 013104 da 001461200000 013105 aa 000140 6270 00 eax7 96 013106 aa 7 00034 3521 20 epp2 pr7|28,* 013107 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 013110 aa 000000000000 013111 aa 000000000000 STATEMENT 1 ON LINE 3211 dirty_interrupt_pending = "1"b; 013112 aa 400000 2350 03 lda 131072,du 013113 aa 6 00040 3735 20 epp7 pr6|32,* 013114 aa 7 00174 3715 20 epp5 pr7|124,* ws_info_ptr 013115 aa 5 00107 7551 00 sta pr5|71 ws_info.dirty_interrupt_pending STATEMENT 1 ON LINE 3212 signal apl_dirty_stop_; 013116 aa 000017 7260 07 lxl6 15,dl 013117 aa 765606 3520 04 epp2 -5242,ic 000725 = 141160154137 013120 aa 0 00716 7001 00 tsx0 pr0|462 signal STATEMENT 1 ON LINE 3214 call timer_manager_$alarm_call (ten_seconds, relative_seconds, second_timer); 013121 aa 000022 3520 04 epp2 18,ic 013143 = 000120627000 013122 aa 000001 2360 07 ldq 1,dl 013123 aa 0 00653 7001 00 tsx0 pr0|427 make_label_var 013124 aa 6 00106 3521 00 epp2 pr6|70 cp.1079 013125 aa 0 00652 7001 00 tsx0 pr0|426 move_label_var 013126 aa 765070 3520 04 epp2 -5576,ic 000216 = 000000000000 013127 aa 6 00114 2521 00 spri2 pr6|76 013130 aa 765070 3520 04 epp2 -5576,ic 000220 = 600000000000 013131 aa 6 00116 2521 00 spri2 pr6|78 013132 aa 6 00106 3521 00 epp2 pr6|70 cp.1079 013133 aa 6 00120 2521 00 spri2 pr6|80 013134 aa 6 00112 6211 00 eax1 pr6|74 013135 aa 014000 4310 07 fld 6144,dl 013136 aa 6 00044 3701 20 epp4 pr6|36,* 013137 la 4 00012 3521 20 epp2 pr4|10,* timer_manager_$alarm_call 013140 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3216 return; 013141 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3218 end; END PROCEDURE first_timer BEGIN PROCEDURE second_timer ENTRY TO second_timer STATEMENT 1 ON LINE 3221 second_timer: procedure; 013142 da 001470200000 013143 aa 000120 6270 00 eax7 80 013144 aa 7 00034 3521 20 epp2 pr7|28,* 013145 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 013146 aa 000000000000 013147 aa 000000000000 STATEMENT 1 ON LINE 3230 call apl_system_error_ (apl_error_table_$super_dirty_stop); 013150 la 4 00134 3521 20 epp2 pr4|92,* apl_error_table_$super_dirty_stop 013151 aa 6 00102 2521 00 spri2 pr6|66 013152 aa 6 00100 6211 00 eax1 pr6|64 013153 aa 004000 4310 07 fld 2048,dl 013154 la 4 00330 3521 20 epp2 pr4|216,* apl_system_error_ 013155 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3231 return; 013156 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3233 end second_timer; END PROCEDURE second_timer BEGIN PROCEDURE fill_in_arguments ENTRY TO fill_in_arguments STATEMENT 1 ON LINE 3235 fill_in_arguments: procedure (bv_rsp, from_which, to_where); 013157 aa 6 00516 6501 00 spri4 pr6|334 013160 aa 6 00520 2521 00 spri2 pr6|336 STATEMENT 1 ON LINE 3248 if bv_rsp -> rs (from_which).semantics_on_stack then do; 013161 aa 2 00004 2361 20 ldq pr2|4,* from_which 013162 aa 000002 7360 00 qls 2 013163 aa 2 00002 3735 20 epp7 pr2|2,* bv_rsp 013164 aa 7 00000 3735 20 epp7 pr7|0,* bv_rsp 013165 aa 7 77775 2351 06 lda pr7|-3,ql rs.semantics_on_stack 013166 aa 000400 3150 03 cana 256,du 013167 aa 000031 6000 04 tze 25,ic 013220 STATEMENT 1 ON LINE 3250 ws_info.dont_interrupt_parse = "0"b; 013170 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 013171 aa 5 00100 4501 00 stz pr5|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 3251 call apl_copy_value_ (bv_rsp -> rs (from_which).semantics, packed_temp_ptr); 013172 aa 7 77776 3521 06 epp2 pr7|-2,ql rs.semantics 013173 aa 6 01224 2521 00 spri2 pr6|660 013174 aa 6 00166 3521 00 epp2 pr6|118 packed_temp_ptr 013175 aa 6 01226 2521 00 spri2 pr6|662 013176 aa 6 01222 6211 00 eax1 pr6|658 013177 aa 010000 4310 07 fld 4096,dl 013200 aa 6 00044 3701 20 epp4 pr6|36,* 013201 la 4 00230 3521 20 epp2 pr4|152,* apl_copy_value_ 013202 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3252 ws_info.dont_interrupt_parse = "1"b; 013203 aa 400000 2350 03 lda 131072,du 013204 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 013205 aa 7 00100 7551 00 sta pr7|64 ws_info.dont_interrupt_parse STATEMENT 1 ON LINE 3253 bv_rsp -> rs (from_which).semantics = packed_temp_ptr; 013206 aa 6 00520 3715 20 epp5 pr6|336,* 013207 aa 5 00004 2361 20 ldq pr5|4,* from_which 013210 aa 000002 7360 00 qls 2 013211 aa 000000 6270 06 eax7 0,ql 013212 aa 6 00166 2361 00 ldq pr6|118 packed_temp_ptr 013213 aa 5 00002 3535 20 epp3 pr5|2,* bv_rsp 013214 aa 3 00000 3535 20 epp3 pr3|0,* bv_rsp 013215 aa 3 77776 7561 17 stq pr3|-2,7 rs.semantics STATEMENT 1 ON LINE 3254 bv_rsp -> rs (from_which).semantics_on_stack = "0"b; 013216 aa 000512 2350 04 lda 330,ic 013730 = 777377777777 013217 aa 3 77775 3551 17 ansa pr3|-3,7 rs.semantics_on_stack STATEMENT 1 ON LINE 3255 end; STATEMENT 1 ON LINE 3257 lexed_function_bead_ptr -> lexed_function_bead.localized_symbols (to_where) -> symbol_bead.meaning_pointer = bv_rsp -> rs (from_which).semantics; 013220 aa 6 00520 3735 20 epp7 pr6|336,* 013221 aa 7 00006 7271 20 lxl7 pr7|6,* to_where 013222 aa 6 00134 3715 20 epp5 pr6|92,* lexed_function_bead_ptr 013223 aa 5 00011 7671 17 lprp7 pr5|9,7 lexed_function_bead.localized_symbols 013224 aa 6 00520 3535 20 epp3 pr6|336,* 013225 aa 3 00004 2361 20 ldq pr3|4,* from_which 013226 aa 000002 7360 00 qls 2 013227 aa 3 00002 3515 20 epp1 pr3|2,* bv_rsp 013230 aa 1 00000 3515 20 epp1 pr1|0,* bv_rsp 013231 aa 000000 6260 06 eax6 0,ql 013232 aa 1 77776 2361 06 ldq pr1|-2,ql rs.semantics 013233 aa 7 00003 7561 00 stq pr7|3 symbol_bead.meaning_pointer STATEMENT 1 ON LINE 3259 bv_rsp -> rs (from_which).semantics -> general_bead.reference_count = bv_rsp -> rs (from_which).semantics -> general_bead.reference_count + 1; 013234 aa 1 77776 7671 16 lprp7 pr1|-2,6 rs.semantics 013235 aa 7 00001 0541 00 aos pr7|1 general_bead.reference_count STATEMENT 1 ON LINE 3262 return; 013236 aa 6 00516 6101 00 rtcd pr6|334 STATEMENT 1 ON LINE 3264 end fill_in_arguments; END PROCEDURE fill_in_arguments BEGIN PROCEDURE apl_push_stack_ ENTRY TO apl_push_stack_ STATEMENT 1 ON LINE 4 OF FILE 14 apl_push_stack_: procedure (P_n_words) returns (ptr); 013237 aa 6 00524 6501 00 spri4 pr6|340 013240 aa 6 00526 2521 00 spri2 pr6|342 STATEMENT 1 ON LINE 35 OF FILE 14 num_words = P_n_words; 013241 aa 2 00002 2361 20 ldq pr2|2,* P_n_words 013242 aa 6 00534 7561 00 stq pr6|348 num_words STATEMENT 1 ON LINE 37 OF FILE 14 if substr (unspec (num_words), 36, 1) = "1"b /* num_words odd */ then num_words = num_words + 1; 013243 aa 6 00534 2351 00 lda pr6|348 013244 aa 000043 7350 00 als 35 013245 aa 400000 1150 03 cmpa 131072,du 013246 aa 000002 6010 04 tnz 2,ic 013250 013247 aa 6 00534 0541 00 aos pr6|348 num_words STATEMENT 1 ON LINE 40 OF FILE 14 if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size then call apl_get_value_stack_ (num_words); 013250 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 013251 aa 7 00016 2361 00 ldq pr7|14 ws_info.value_stack_ptr 013252 aa 0 00374 3771 00 anaq pr0|252 = 000000000000 000000777777 013253 aa 6 00534 0761 00 adq pr6|348 num_words 013254 aa 7 00013 1161 00 cmpq pr7|11 ws_info.maximum_value_stack_size 013255 aa 000010 6044 04 tmoz 8,ic 013265 013256 aa 6 00534 3521 00 epp2 pr6|348 num_words 013257 aa 6 01234 2521 00 spri2 pr6|668 013260 aa 6 01232 6211 00 eax1 pr6|666 013261 aa 004000 4310 07 fld 2048,dl 013262 aa 6 00044 3701 20 epp4 pr6|36,* 013263 la 4 00332 3521 20 epp2 pr4|218,* apl_get_value_stack_ 013264 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 43 OF FILE 14 block_ptr = ws_info.value_stack_ptr; 013265 aa 6 00174 3735 20 epp7 pr6|124,* ws_info_ptr 013266 aa 7 00016 7671 00 lprp7 pr7|14 ws_info.value_stack_ptr 013267 aa 6 00532 6535 00 spri7 pr6|346 block_ptr STATEMENT 1 ON LINE 44 OF FILE 14 ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words); 013270 aa 6 00174 3715 20 epp5 pr6|124,* ws_info_ptr 013271 aa 5 00016 7651 00 lprp5 pr5|14 ws_info.value_stack_ptr 013272 aa 6 00534 2361 00 ldq pr6|348 num_words 013273 aa 5 00000 3521 06 epp2 pr5|0,ql 013274 aa 000000 0520 03 adwp2 0,du 013275 aa 6 00174 3535 20 epp3 pr6|124,* ws_info_ptr 013276 aa 3 00016 5421 00 sprp2 pr3|14 ws_info.value_stack_ptr STATEMENT 1 ON LINE 45 OF FILE 14 return (block_ptr); 013277 aa 6 00526 3515 20 epp1 pr6|342,* 013300 aa 1 00004 6535 20 spri7 pr1|4,* 013301 aa 6 00524 6101 00 rtcd pr6|340 STATEMENT 1 ON LINE 47 OF FILE 14 end apl_push_stack_; END PROCEDURE apl_push_stack_ BEGIN PROCEDURE apl_default_handler_ ENTRY TO apl_default_handler_ STATEMENT 1 ON LINE 3275 apl_default_handler_: procedure (mc_ptr, condition_name, wc_mc_ptr, info_ptr, continue_switch); 013302 da 001501200000 013303 aa 000220 6270 00 eax7 144 013304 aa 7 00034 3521 20 epp2 pr7|28,* 013305 aa 2 01050 2721 00 tsp2 pr2|552 int_entry_desc 013306 aa 000012000000 013307 aa 000000000000 013310 aa 6 00042 3735 20 epp7 pr6|34,* 013311 aa 7 00002 2361 20 ldq pr7|2,* 013312 aa 000002 6040 04 tmi 2,ic 013314 013313 aa 777777 3760 07 anq 262143,dl 013314 aa 0 00250 3761 00 anq pr0|168 = 000077777777 013315 aa 6 00156 7561 00 stq pr6|110 STATEMENT 1 ON LINE 3302 if ws_info.transparent_to_signals /* )E or something - we're not supposed to be here */ then if condition_name ^= "program_interrupt" /* but let pi's get back into APL */ then do; 013316 aa 6 00040 3715 20 epp5 pr6|32,* 013317 aa 5 00174 3535 20 epp3 pr5|124,* ws_info_ptr 013320 aa 3 00001 2351 00 lda pr3|1 ws_info.transparent_to_signals 013321 aa 000100 3150 03 cana 64,du 013322 aa 000014 6000 04 tze 12,ic 013336 013323 aa 6 00032 3515 20 epp1 pr6|26,* 013324 aa 1 00004 3735 20 epp7 pr1|4,* 013325 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013326 aa 7 00000 00 0006 desc9a pr7|0,ql condition_name 013327 aa 765411 00 0021 desc9a -5367,17 000736 = 160162157147 013330 aa 000004 6000 04 tze 4,ic 013334 STATEMENT 1 ON LINE 3305 continue_switch = "1"b; 013331 aa 400000 2350 03 lda 131072,du 013332 aa 1 00012 7551 20 sta pr1|10,* continue_switch STATEMENT 1 ON LINE 3306 return; 013333 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3307 end; STATEMENT 1 ON LINE 3308 else ws_info.transparent_to_signals = "0"b; 013334 aa 000373 2350 04 lda 251,ic 013727 = 777677777777 013335 aa 3 00001 3551 00 ansa pr3|1 ws_info.transparent_to_signals STATEMENT 1 ON LINE 3312 if condition_name = "quit" then do; 013336 aa 6 00032 3735 20 epp7 pr6|26,* 013337 aa 7 00004 3515 20 epp1 pr7|4,* 013340 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013341 aa 1 00000 00 0006 desc9a pr1|0,ql condition_name 013342 aa 765271 00 0004 desc9a -5447,4 000631 = 161165151164 013343 aa 000125 6010 04 tnz 85,ic 013470 STATEMENT 1 ON LINE 3314 if ws_info.switches.no_quit_handler then do; 013344 aa 3 00001 2351 00 lda pr3|1 ws_info.no_quit_handler 013345 aa 000004 3150 03 cana 4,du 013346 aa 000004 6000 04 tze 4,ic 013352 STATEMENT 1 ON LINE 3316 continue_switch = "1"b; 013347 aa 400000 2350 03 lda 131072,du 013350 aa 7 00012 7551 20 sta pr7|10,* continue_switch STATEMENT 1 ON LINE 3317 return; 013351 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3318 end; STATEMENT 1 ON LINE 3320 call iox_$control (apl_static_$apl_input, "process_quit", null, code); 013352 aa 765327 2350 04 lda -5417,ic 000701 = 160162157143 013353 aa 765327 2360 04 ldq -5417,ic 000702 = 145163163137 013354 aa 6 00160 7571 00 staq pr6|112 013355 aa 765326 2350 04 lda -5418,ic 000703 = 161165151164 013356 aa 6 00162 7551 00 sta pr6|114 013357 aa 765307 3514 24 epp1 -5433,ic* 013360 aa 6 00164 2515 00 spri1 pr6|116 013361 la 4 00076 3521 20 epp2 pr4|62,* apl_static_$apl_input 013362 aa 6 00170 2521 00 spri2 pr6|120 013363 aa 6 00160 3521 00 epp2 pr6|112 013364 aa 6 00172 2521 00 spri2 pr6|122 013365 aa 6 00164 3521 00 epp2 pr6|116 013366 aa 6 00174 2521 00 spri2 pr6|124 013367 aa 5 00162 3521 00 epp2 pr5|114 code 013370 aa 6 00176 2521 00 spri2 pr6|126 013371 aa 765261 3520 04 epp2 -5455,ic 000652 = 464000000000 013372 aa 6 00200 2521 00 spri2 pr6|128 013373 aa 6 00204 2521 00 spri2 pr6|132 013374 aa 765234 3520 04 epp2 -5476,ic 000630 = 524000000014 013375 aa 6 00202 2521 00 spri2 pr6|130 013376 aa 765247 3520 04 epp2 -5465,ic 000645 = 404000000043 013377 aa 6 00206 2521 00 spri2 pr6|134 013400 aa 6 00166 6211 00 eax1 pr6|118 013401 aa 020000 4310 07 fld 8192,dl 013402 la 4 00026 3521 20 epp2 pr4|22,* iox_$control 013403 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3322 if code ^= 0 /* if APL dim isn't there, we have to do it ourselves */ then do; 013404 aa 6 00040 3735 20 epp7 pr6|32,* 013405 aa 7 00162 2361 00 ldq pr7|114 code 013406 aa 000320 6000 04 tze 208,ic 013726 STATEMENT 1 ON LINE 3324 call iox_$control (apl_static_$apl_output, "resetwrite", null, (0)); 013407 aa 765267 2370 04 ldaq -5449,ic 000676 = 162145163145 164167162151 013410 aa 6 00160 7571 00 staq pr6|112 013411 aa 164145 2350 03 lda 59493,du 013412 aa 6 00162 7551 00 sta pr6|114 013413 aa 765253 3714 24 epp5 -5461,ic* 013414 aa 6 00164 6515 00 spri5 pr6|116 013415 aa 6 00163 4501 00 stz pr6|115 013416 aa 6 00044 3701 20 epp4 pr6|36,* 013417 la 4 00100 3521 20 epp2 pr4|64,* apl_static_$apl_output 013420 aa 6 00170 2521 00 spri2 pr6|120 013421 aa 6 00160 3521 00 epp2 pr6|112 013422 aa 6 00172 2521 00 spri2 pr6|122 013423 aa 6 00164 3521 00 epp2 pr6|116 013424 aa 6 00174 2521 00 spri2 pr6|124 013425 aa 6 00163 3521 00 epp2 pr6|115 013426 aa 6 00176 2521 00 spri2 pr6|126 013427 aa 765223 3520 04 epp2 -5485,ic 000652 = 464000000000 013430 aa 6 00200 2521 00 spri2 pr6|128 013431 aa 6 00204 2521 00 spri2 pr6|132 013432 aa 765175 3520 04 epp2 -5507,ic 000627 = 524000000012 013433 aa 6 00202 2521 00 spri2 pr6|130 013434 aa 765211 3520 04 epp2 -5495,ic 000645 = 404000000043 013435 aa 6 00206 2521 00 spri2 pr6|134 013436 aa 6 00166 6211 00 eax1 pr6|118 013437 aa 020000 4310 07 fld 8192,dl 013440 la 4 00026 3521 20 epp2 pr4|22,* iox_$control 013441 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3326 call iox_$put_chars (apl_static_$apl_output, addr (QNewLine), length (QNewLine), (0)); 013442 aa 764562 3734 04 epp7 -5774,ic 000224 = 012000000000 013443 aa 6 00164 6535 00 spri7 pr6|116 013444 aa 000001 2360 07 ldq 1,dl 013445 aa 6 00163 7561 00 stq pr6|115 013446 aa 6 00157 4501 00 stz pr6|111 013447 aa 6 00044 3701 20 epp4 pr6|36,* 013450 la 4 00100 3521 20 epp2 pr4|64,* apl_static_$apl_output 013451 aa 6 00170 2521 00 spri2 pr6|120 013452 aa 6 00164 3521 00 epp2 pr6|116 013453 aa 6 00172 2521 00 spri2 pr6|122 013454 aa 6 00163 3521 00 epp2 pr6|115 013455 aa 6 00174 2521 00 spri2 pr6|124 013456 aa 6 00157 3521 00 epp2 pr6|111 013457 aa 6 00176 2521 00 spri2 pr6|126 013460 aa 6 00166 6211 00 eax1 pr6|118 013461 aa 020000 4310 07 fld 8192,dl 013462 la 4 00034 3521 20 epp2 pr4|28,* iox_$put_chars 013463 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3327 signal apl_quit_; 013464 aa 000011 7260 07 lxl6 9,dl 013465 aa 765225 3520 04 epp2 -5483,ic 000712 = 141160154137 013466 aa 0 00716 7001 00 tsx0 pr0|462 signal STATEMENT 1 ON LINE 3328 end; STATEMENT 1 ON LINE 3329 end; 013467 aa 000237 7100 04 tra 159,ic 013726 STATEMENT 1 ON LINE 3331 else if condition_name = "program_interrupt" then go to recover_from_error; 013470 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013471 aa 1 00000 00 0006 desc9a pr1|0,ql condition_name 013472 aa 765246 00 0021 desc9a -5466,17 000736 = 160162157147 013473 aa 000004 6010 04 tnz 4,ic 013477 013474 aa 770450 3520 04 epp2 -3800,ic 004144 = 006700670004 013475 aa 000001 7270 07 lxl7 1,dl 013476 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3336 else if condition_name = "apl_system_error_" /* message already has been printed; just bomb out */ then go to recover_from_error; 013477 aa 6 00032 3735 20 epp7 pr6|26,* 013500 aa 7 00004 3715 20 epp5 pr7|4,* 013501 aa 6 00156 2351 00 lda pr6|110 013502 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013503 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013504 aa 765227 00 0021 desc9a -5481,17 000731 = 141160154137 013505 aa 000004 6010 04 tnz 4,ic 013511 013506 aa 770436 3520 04 epp2 -3810,ic 004144 = 006700670004 013507 aa 000001 7270 07 lxl7 1,dl 013510 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3339 else if condition_name = "apl_dirty_stop_" then do; 013511 aa 6 00032 3735 20 epp7 pr6|26,* 013512 aa 7 00004 3715 20 epp5 pr7|4,* 013513 aa 6 00156 2351 00 lda pr6|110 013514 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013515 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013516 aa 765211 00 0017 desc9a -5495,15 000725 = 141160154137 013517 aa 000016 6010 04 tnz 14,ic 013535 STATEMENT 1 ON LINE 3342 if dont_interrupt_parse then go to on_return; 013520 aa 6 00040 3535 20 epp3 pr6|32,* 013521 aa 3 00174 3515 20 epp1 pr3|124,* ws_info_ptr 013522 aa 1 00100 2351 00 lda pr1|64 ws_info.dont_interrupt_parse 013523 aa 000203 6010 04 tnz 131,ic 013726 STATEMENT 1 ON LINE 3344 if dont_interrupt_operator then go to on_return; 013524 aa 1 00101 2351 00 lda pr1|65 ws_info.dont_interrupt_operator 013525 aa 000201 6010 04 tnz 129,ic 013726 STATEMENT 1 ON LINE 3346 if dont_interrupt_storage_manager then go to on_return; 013526 aa 1 00102 2351 00 lda pr1|66 ws_info.dont_interrupt_storage_manager 013527 aa 000177 6010 04 tnz 127,ic 013726 STATEMENT 1 ON LINE 3348 if dont_interrupt_command then go to on_return; 013530 aa 1 00104 2351 00 lda pr1|68 ws_info.dont_interrupt_command 013531 aa 000175 6010 04 tnz 125,ic 013726 STATEMENT 1 ON LINE 3350 go to dirty_stop; 013532 aa 767714 3520 04 epp2 -4148,ic 003446 = 007376670004 013533 aa 000001 7270 07 lxl7 1,dl 013534 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3352 on_return: end; STATEMENT 1 ON LINE 3355 else if condition_name = "apl_quit_" /* DIM decided this attention was an "interrupt" */ then call initial_interrupt; 013535 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013536 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013537 aa 765155 00 0011 desc9a -5523,9 000712 = 141160154137 013540 aa 000003 6010 04 tnz 3,ic 013543 013541 aa 777071 6700 04 tsp4 -455,ic 012632 013542 aa 000164 7100 04 tra 116,ic 013726 STATEMENT 1 ON LINE 3358 else do; STATEMENT 1 ON LINE 3366 if ws_info.dont_interrupt_parse | ws_info.dont_interrupt_storage_manager | ws_info.dont_interrupt_operator | ws_info.dont_interrupt_command then do; 013543 aa 6 00040 3535 20 epp3 pr6|32,* 013544 aa 3 00174 3515 20 epp1 pr3|124,* ws_info_ptr 013545 aa 1 00100 2351 00 lda pr1|64 ws_info.dont_interrupt_parse 013546 aa 000007 6010 04 tnz 7,ic 013555 013547 aa 1 00102 2351 00 lda pr1|66 ws_info.dont_interrupt_storage_manager 013550 aa 000005 6010 04 tnz 5,ic 013555 013551 aa 1 00101 2351 00 lda pr1|65 ws_info.dont_interrupt_operator 013552 aa 000003 6010 04 tnz 3,ic 013555 013553 aa 1 00104 2351 00 lda pr1|68 ws_info.dont_interrupt_command 013554 aa 000004 6000 04 tze 4,ic 013560 STATEMENT 1 ON LINE 3369 continue_switch = "1"b; 013555 aa 400000 2350 03 lda 131072,du 013556 aa 7 00012 7551 20 sta pr7|10,* continue_switch STATEMENT 1 ON LINE 3370 return; 013557 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3371 end; STATEMENT 1 ON LINE 3376 if (condition_name = "fixedoverflow") | (condition_name = "overflow") | (condition_name = "zerodivide") then go to domain_error; 013560 aa 6 00156 2361 00 ldq pr6|110 013561 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013562 aa 5 00000 00 0006 desc9a pr5|0,ql condition_name 013563 aa 765134 00 0015 desc9a -5540,13 000715 = 146151170145 013564 aa 000004 6010 04 tnz 4,ic 013570 013565 aa 767357 3520 04 epp2 -4369,ic 003144 = 600044370120 013566 aa 000001 7270 07 lxl7 1,dl 013567 aa 0 00657 7101 00 tra pr0|431 tra_ext 013570 aa 6 00032 3735 20 epp7 pr6|26,* 013571 aa 7 00004 3715 20 epp5 pr7|4,* 013572 aa 6 00156 2351 00 lda pr6|110 013573 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013574 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013575 aa 765067 00 0010 desc9a -5577,8 000662 = 157166145162 013576 aa 000004 6010 04 tnz 4,ic 013602 013577 aa 767345 3520 04 epp2 -4379,ic 003144 = 600044370120 013600 aa 000001 7270 07 lxl7 1,dl 013601 aa 0 00657 7101 00 tra pr0|431 tra_ext 013602 aa 6 00032 3735 20 epp7 pr6|26,* 013603 aa 7 00004 3715 20 epp5 pr7|4,* 013604 aa 6 00156 2351 00 lda pr6|110 013605 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013606 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013607 aa 765066 00 0012 desc9a -5578,10 000673 = 172145162157 013610 aa 000004 6010 04 tnz 4,ic 013614 013611 aa 767333 3520 04 epp2 -4389,ic 003144 = 600044370120 013612 aa 000001 7270 07 lxl7 1,dl 013613 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3379 else if condition_name = "underflow" then do; 013614 aa 6 00032 3735 20 epp7 pr6|26,* 013615 aa 7 00004 3715 20 epp5 pr7|4,* 013616 aa 6 00156 2351 00 lda pr6|110 013617 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013620 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013621 aa 765051 00 0011 desc9a -5591,9 000670 = 165156144145 013622 aa 000004 6010 04 tnz 4,ic 013626 STATEMENT 1 ON LINE 3393 n_underflows = n_underflows + 1; 013623 aa 6 00040 3535 20 epp3 pr6|32,* 013624 aa 3 00110 0541 00 aos pr3|72 n_underflows STATEMENT 1 ON LINE 3395 end; 013625 aa 000101 7100 04 tra 65,ic 013726 STATEMENT 1 ON LINE 3397 else if condition_name = "error" then do; 013626 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013627 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013630 aa 765032 00 0005 desc9a -5606,5 000660 = 145162162157 013631 aa 000023 6010 04 tnz 19,ic 013654 STATEMENT 1 ON LINE 3399 oncode_number = oncode (); 013632 aa 6 00106 3521 00 epp2 pr6|70 oncode_number 013633 aa 6 00170 2521 00 spri2 pr6|120 013634 aa 6 00166 6211 00 eax1 pr6|118 013635 aa 004000 4310 07 fld 2048,dl 013636 aa 6 00044 3701 20 epp4 pr6|36,* 013637 la 4 00010 3521 20 epp2 pr4|8,* on_data_$get_oncode 013640 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 3400 if oncode_number > 0 then if oncode_number <= 100 /* 1-100 are math errors */ then go to domain_error; 013641 aa 6 00106 2361 00 ldq pr6|70 oncode_number 013642 aa 000006 6044 04 tmoz 6,ic 013650 013643 aa 000144 1160 07 cmpq 100,dl 013644 aa 000004 6054 04 tpnz 4,ic 013650 013645 aa 767277 3520 04 epp2 -4417,ic 003144 = 600044370120 013646 aa 000001 7270 07 lxl7 1,dl 013647 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3404 continue_switch = "1"b; 013650 aa 400000 2350 03 lda 131072,du 013651 aa 6 00032 3735 20 epp7 pr6|26,* 013652 aa 7 00012 7551 20 sta pr7|10,* continue_switch STATEMENT 1 ON LINE 3405 end; 013653 aa 000053 7100 04 tra 43,ic 013726 STATEMENT 1 ON LINE 3407 else if condition_name = "finish" /* signalled when process is being bumped */ then do; 013654 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013655 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013656 aa 765002 00 0006 desc9a -5630,6 000656 = 146151156151 013657 aa 000035 6010 04 tnz 29,ic 013714 STATEMENT 1 ON LINE 3409 if ^ws_info.restrict_save /* sigh */ then call apl_save_command_ ("continue", "", code); 013660 aa 6 00040 3535 20 epp3 pr6|32,* 013661 aa 3 00174 3515 20 epp1 pr3|124,* ws_info_ptr 013662 aa 1 00001 2351 00 lda pr1|1 ws_info.restrict_save 013663 aa 001000 3150 03 cana 512,du 013664 aa 000024 6010 04 tnz 20,ic 013710 013665 aa 764767 2370 04 ldaq -5641,ic 000654 = 143157156164 151156165145 013666 aa 6 00164 7571 00 staq pr6|116 013667 aa 6 00164 3521 00 epp2 pr6|116 013670 aa 6 00170 2521 00 spri2 pr6|120 013671 aa 6 00157 3521 00 epp2 pr6|111 013672 aa 6 00172 2521 00 spri2 pr6|122 013673 aa 3 00162 3521 00 epp2 pr3|114 code 013674 aa 6 00174 2521 00 spri2 pr6|124 013675 aa 764731 3520 04 epp2 -5671,ic 000626 = 524000000010 013676 aa 6 00176 2521 00 spri2 pr6|126 013677 aa 764742 3520 04 epp2 -5662,ic 000641 = 524000000000 013700 aa 6 00200 2521 00 spri2 pr6|128 013701 aa 764744 3520 04 epp2 -5660,ic 000645 = 404000000043 013702 aa 6 00202 2521 00 spri2 pr6|130 013703 aa 6 00166 6211 00 eax1 pr6|118 013704 aa 014000 4310 07 fld 6144,dl 013705 aa 6 00044 3701 20 epp4 pr6|36,* 013706 la 4 00334 3521 20 epp2 pr4|220,* apl_save_command_ 013707 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 3412 continue_switch = "1"b; 013710 aa 400000 2350 03 lda 131072,du 013711 aa 6 00032 3735 20 epp7 pr6|26,* 013712 aa 7 00012 7551 20 sta pr7|10,* continue_switch STATEMENT 1 ON LINE 3413 end; 013713 aa 000013 7100 04 tra 11,ic 013726 STATEMENT 1 ON LINE 3415 else if condition_name = "record_quota_overflow" /* hmm. if it's on the process dir, be careful! */ then go to ws_full_no_quota_error; 013714 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 013715 aa 5 00000 00 0005 desc9a pr5|0,al condition_name 013716 aa 765027 00 0025 desc9a -5609,21 000743 = 162145143157 013717 aa 000004 6010 04 tnz 4,ic 013723 013720 aa 767516 3520 04 epp2 -4274,ic 003436 = 400000235003 013721 aa 000001 7270 07 lxl7 1,dl 013722 aa 0 00657 7101 00 tra pr0|431 tra_ext STATEMENT 1 ON LINE 3423 else continue_switch = "1"b; 013723 aa 400000 2350 03 lda 131072,du 013724 aa 6 00032 3735 20 epp7 pr6|26,* 013725 aa 7 00012 7551 20 sta pr7|10,* continue_switch STATEMENT 1 ON LINE 3424 end; STATEMENT 1 ON LINE 3425 return; 013726 aa 0 00631 7101 00 tra pr0|409 return STATEMENT 1 ON LINE 3427 end /* apl_default_handler_ */; END PROCEDURE apl_default_handler_ END PROCEDURE apl_parse_ ----------------------------------------------------------- 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