COMPILATION LISTING OF SEGMENT apl_editor_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1602.5 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* New version of the APL editor, written by William M. York, Summer 1979. */ 11 12 /* Modified 791207 by wmy to fix bug 426 ([Nq0] editing doesn't work) and 13* the following unreported bugs: 14* 1) Hitting QUIT while in line-editing mode can leave you in 15* read_back_output mode. 16* 2) Attempting to edit a pendent function reports the error properly, but 17* leaves you in the editor in an inconsistant state. 18* 3) When the header is deleted [q] mis-numbers the lines. 19* 4) [d0] will delete the header of a suspended function. 20* 5) Function is renumbered after lex reports errors, but line number 21* prompt is left as the old (sometimes no longer existing) line number. 22* Modified 791217 by PG to fix bug whereby [Nq0] was rejected in a suspended function. 23* Modified 800131 by PG to fix 442 (editor permitted user to add labels to a suspended fcn), 24* and 435 (editor would not permit system variables in the header of a new fcn). 25* Modified 800827 by WMY to add extensions to editor for context searching 26* and substitution. 27* Modified 810615 by WMY to add context_global_print and fix bugs 28**/ 29 30 apl_editor_: 31 procedure (header_line, header_line_pos, code); 32 33 dcl header_line char(*) parameter; 34 dcl header_line_pos fixed bin(21) parameter; 35 dcl code fixed bin(35) parameter; 36 37 /* Automatic */ 38 39 dcl input_buffer char(256); 40 dcl input_line_length fixed bin(21); 41 dcl character_pos fixed bin; 42 dcl character char(1); 43 dcl current_line_number fixed decimal (10, 5); 44 dcl line_pos fixed bin; 45 dcl (got_line, quit_force) bit(1) init ("0"b); 46 dcl saved_search_string char(128) varying init(""); 47 48 /* Internal Static */ 49 50 dcl whitespace_NL_string char(3) internal static options (constant) init (" 51 "); /* SPACE, TAB, NL */ 52 53 /* Based */ 54 55 dcl input_line char(input_line_length) based (addr (input_buffer)); 56 57 /* External */ 58 59 dcl (apl_error_table_$bad_function_header, 60 apl_error_table_$extra_text) 61 external fixed bin(35); 62 63 dcl (cleanup, apl_quit_) condition; 64 65 /* Entries */ 66 67 dcl apl_create_save_frame_ entry (); 68 dcl apl_segment_manager_$get entry () returns (pointer); 69 dcl apl_command_$from_editor entry (char(*), fixed bin(21), fixed bin(35)); 70 71 dcl (length, substr, verify) builtin; 72 73 /* Include Files */ 74 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 ---------------------------------- */ 75 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 ----------------------------------- */ 76 77 3 1 /* Begin include file apl_fuction_info.incl.pl1 */ 3 2 3 3 dcl 1 function_info, 3 4 2 edit_buffer_ptr pointer, 3 5 2 first_unused_char_in_buffer fixed bin, 3 6 2 name char(256) varying, 3 7 2 symbol_ptr ptr unaligned, 3 8 2 locked_function bit(1), 3 9 2 suspended_function bit(1), 3 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 3 11 2 saved_stop_vector ptr, 3 12 2 saved_trace_vector ptr, 3 13 2 number_of_lines fixed bin, 3 14 2 args(0:3) char(256) varying, 3 15 2 line_info(1:500), 3 16 3 line_number fixed decimal(10,5), 3 17 3 line_start fixed bin, 3 18 3 line_length fixed bin; 3 19 3 20 /* End include file apl_function_info.incl.pl1 */ 78 79 80 81 /* Program */ 82 83 code = 0; 84 85 function_info.first_unused_char_in_buffer = 1; 86 function_info.locked_function = "0"b; 87 function_info.suspended_function = "0"b; 88 function_info.saved_stop_vector = null (); 89 function_info.saved_trace_vector = null (); 90 function_info.number_of_lines = 0; 91 92 function_info.edit_buffer_ptr = apl_segment_manager_$get (); 93 94 call apl_create_save_frame_; 95 96 on cleanup 97 call apl_editor_cleanup (function_info); 98 99 character_pos = header_line_pos + 1; 100 call open_function (header_line, character_pos, function_info); 101 102 input_line_length = length (header_line) - character_pos + 1; 103 input_line = substr (header_line, character_pos); 104 character_pos = 1; 105 106 current_line_number = function_info.line_info(function_info.number_of_lines).line_number + 1; 107 108 /* All setup is done, we are ready to go */ 109 110 on apl_quit_ 111 goto internal_error_restart; 112 113 do while ("1"b); 114 115 got_line = "0"b; 116 do while (^got_line); 117 118 if character_pos > length (input_line) 119 then do; 120 121 /* This is the place where the error routine goes after reporting errors */ 122 123 internal_error_restart: 124 call prompt (current_line_number, function_info); 125 call read_line (input_buffer, input_line_length); 126 character_pos = 1; 127 end; 128 129 got_line = "1"b; 130 131 line_pos = verify (substr (input_line, character_pos), whitespace_NL_string); 132 if line_pos > 0 133 then character_pos = character_pos + line_pos - 1; 134 else do; 135 character_pos = length (input_line) + 1; 136 got_line = "0"b; 137 end; 138 end; /* do while (^got_line) */ 139 140 /* Could be del line, bracket line, APL command line, or 141* new line of function. */ 142 143 character = substr (input_line, character_pos, 1); 144 145 if character = QDel | character = QDelTilde 146 then do; 147 148 if quit_force 149 then call apl_editor_cleanup (function_info); 150 151 if character = QDelTilde 152 then function_info.locked_function = "1"b; 153 else function_info.locked_function = "0"b; 154 155 character_pos = character_pos + 1; 156 if character_pos < length (input_line) 157 then call error (apl_error_table_$extra_text, input_line, character_pos); 158 159 call close_function (function_info, current_line_number, code); 160 if code = 0 161 then call apl_editor_cleanup (function_info); 162 else if code ^= apl_error_table_$bad_function_header 163 then do; 164 quit_force = "1"b; 165 call error (0, "", 0); 166 end; 167 end; 168 else do; 169 170 quit_force = "0"b; 171 172 if character = QLeftBracket 173 then call process_bracket_contents (input_buffer, input_line_length, character_pos, current_line_number, function_info); 174 175 else if character = QRightParen 176 then do; 177 call apl_command_$from_editor (input_line, (character_pos), code); 178 character_pos = length (input_line) + 1; 179 end; 180 else if character = QPeriod 181 then call context_editor (input_buffer, input_line_length, character_pos, current_line_number, function_info, saved_search_string); 182 183 else do; 184 185 call process_new_function_line (input_line, character_pos, current_line_number, function_info); 186 187 current_line_number = increment_line_number (current_line_number); 188 end; 189 end; /* else do */ 190 end; /* do forever */ 191 192 apl_editor_return_point: 193 return; 194 195 open_function: 196 procedure (header_line, character_pos, function_info); 197 198 dcl header_line char(*) parameter; 199 dcl character_pos fixed bin parameter; 4 1 /* Begin include file apl_fuction_info.incl.pl1 */ 4 2 4 3 dcl 1 function_info, 4 4 2 edit_buffer_ptr pointer, 4 5 2 first_unused_char_in_buffer fixed bin, 4 6 2 name char(256) varying, 4 7 2 symbol_ptr ptr unaligned, 4 8 2 locked_function bit(1), 4 9 2 suspended_function bit(1), 4 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 4 11 2 saved_stop_vector ptr, 4 12 2 saved_trace_vector ptr, 4 13 2 number_of_lines fixed bin, 4 14 2 args(0:3) char(256) varying, 4 15 2 line_info(1:500), 4 16 3 line_number fixed decimal(10,5), 4 17 3 line_start fixed bin, 4 18 3 line_length fixed bin; 4 19 4 20 /* End include file apl_function_info.incl.pl1 */ 200 201 202 /* Automatic */ 203 204 dcl (header_start, header_length) fixed bin; 205 dcl complicated_header bit(1); 206 dcl last_frame_was_suspended bit(1); 207 dcl function_bead_ptr pointer; 208 dcl lexed_function_bead_ptr pointer; 209 dcl parse_frame_ptr pointer; 210 211 /* External */ 212 213 dcl (apl_error_table_$complicated_header_line, 214 apl_error_table_$non_function_edited, 215 apl_error_table_$locked_function_edited, 216 apl_error_table_$external_function_edited, 217 apl_error_table_$pendent_function_edited) fixed bin(35) external; 218 219 /* Entries */ 220 221 dcl apl_get_symbol_ entry (char(*), pointer unaligned, fixed bin); 222 223 /* Include Files */ 224 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 5 2 5 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 5 4 5 5 /* automatic */ 5 6 5 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 5 8 5 9 /* external static */ 5 10 5 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 5 12 2 static_ws_info_ptr unaligned pointer; 5 13 5 14 /* based */ 5 15 5 16 declare 1 ws_info aligned based (ws_info_ptr), 5 17 2 version_number fixed bin, /* version of this structure (3) */ 5 18 2 switches unaligned, /* mainly ws parameters */ 5 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 5 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 5 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 5 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 5 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 5 24 3 restrict_external_functions 5 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 5 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 5 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 5 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 5 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 5 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 5 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 5 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 5 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 5 34 3 compatibility_check_mode 5 35 bit, /* if 1, check for incompatible operators */ 5 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 5 37 /* remaining 20 bits not presently used */ 5 38 5 39 2 values, /* attributes of the workspace */ 5 40 3 digits fixed bin, /* number of digits of precision printed on output */ 5 41 3 width fixed bin, /* line length for formatted output */ 5 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 5 43 3 random_link fixed bin(35), /* seed for random number generator */ 5 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 5 45 3 float_index_origin float, /* the index origin in floating point */ 5 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 5 47 3 maximum_value_stack_size 5 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 5 49 5 50 2 pointers, /* pointers to various internal tables */ 5 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 5 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 5 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 5 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 5 55 5 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 5 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 5 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 5 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 5 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 5 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 5 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 5 63 2 signoff_lock character (32), 5 64 5 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 5 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 5 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 5 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 5 69 bit, /* munging his tables */ 5 70 3 unused_interrupt_bit bit, /* not presently used */ 5 71 3 dont_interrupt_command bit, 5 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 5 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 5 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 5 75 5 76 2 user_name char (32), /* process group id of user */ 5 77 2 immediate_input_prompt char (32) varying, /* normal input */ 5 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 5 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 5 80 2 vcpu_time aligned, 5 81 3 total fixed bin (71), 5 82 3 setup fixed bin (71), 5 83 3 parse fixed bin (71), 5 84 3 lex fixed bin (71), 5 85 3 operator fixed bin (71), 5 86 3 storage_manager fixed bin (71), 5 87 2 output_info aligned, /* data pertaining to output buffer */ 5 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 5 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 5 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 5 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 5 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 5 93 5 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 5 95 5 96 /* internal static */ 5 97 5 98 declare max_parse_stack_depth fixed bin int static init(64536); 5 99 5 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 225 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 6 2 6 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 6 4 2 type unaligned, 6 5 3 bead_type unaligned, 6 6 4 operator bit (1), /* ON if operator bead */ 6 7 4 symbol bit (1), /* ON if symbol bead */ 6 8 4 value bit (1), /* ON if value bead */ 6 9 4 function bit (1), /* ON if function bead */ 6 10 4 group bit (1), /* ON if group bead */ 6 11 4 label bit (1), /* ON if label bead */ 6 12 4 shared_variable bit (1), /* ON if shared variable bead */ 6 13 4 lexed_function bit (1), /* ON if lexed function bead */ 6 14 3 data_type unaligned, 6 15 4 list_value bit (1), /* ON if a list value bead */ 6 16 4 character_value bit (1), /* ON if a character value bead */ 6 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 6 18 4 integral_value bit (1), /* ON if an integral value bead */ 6 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 6 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 6 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 6 22 2 size bit (18) unaligned, /* Number of words this bead occupies 6 23* (used by bead storage manager) */ 6 24 2 reference_count fixed binary (29); /* Number of pointers which point 6 25* to this bead (used by bead manager) */ 6 26 6 27 6 28 /* constant strings for initing type field in various beads */ 6 29 6 30 declare ( 6 31 operator_type init("100000000000000000"b), 6 32 symbol_type init("010000000000000000"b), 6 33 value_type init("001000000000000000"b), 6 34 function_type init("000100000000000000"b), 6 35 group_type init("000010000000000000"b), 6 36 label_type init("001001000011000000"b), 6 37 shared_variable_type init("001000100000000000"b), 6 38 lexed_function_type init("000000010000000000"b), 6 39 6 40 list_value_type init("000000001000000000"b), 6 41 character_value_type init("001000000100000000"b), 6 42 numeric_value_type init("001000000010000000"b), 6 43 integral_value_type init("001000000011000000"b), 6 44 zero_or_one_value_type init("001000000011100000"b), 6 45 complex_value_type init("001000000000010000"b), 6 46 6 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 6 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 6 49 ) bit(18) internal static; 6 50 6 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 226 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 -------------------------------- */ 227 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 8 2 8 3 /* Explanation of fields: 8 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 8 5* symbol_bead.meaning_pointer points to current "value" of this name: 8 6* = null => unused (e.g. undefined variable) 8 7* -> group bead => group name 8 8* -> value bead => variable with a value 8 9* -> function bead => function name 8 10* -> label bead => localized label value 8 11* -> shared var bead => shared variable */ 8 12 8 13 declare 1 symbol_bead aligned based, 8 14 2 header aligned like general_bead, 8 15 2 hash_link_pointer pointer unaligned, 8 16 2 meaning_pointer pointer unaligned, 8 17 2 name_length fixed binary, 8 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 8 19 8 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 228 9 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 9 2 9 3 /* This bead is used by apl to store the source code for user-defined functions */ 9 4 9 5 declare 1 function_bead aligned based, 9 6 9 7 2 header aligned like general_bead, 9 8 9 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 9 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 9 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 9 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 9 13 2 text_length fixed bin(21), /* length of function text */ 9 14 2 text aligned char(data_elements refer (function_bead.text_length)); 9 15 /* the user's code exactly as typed in */ 9 16 9 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 229 10 1 /* ====== BEGIN INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 ========================== */ 10 2 10 3 /* this is the format of a user-defined function after it has been run 10 4* through apl_lex_, the first (left to right) parsing phase. */ 10 5 10 6 dcl 1 lexed_function_bead based aligned, 10 7 2 header like general_bead, /* type bits, etc. */ 10 8 10 9 2 name pointer unaligned, /* -> symbol bead which names the function */ 10 10 2 bits_for_parse unaligned like operator_bead.bits_for_parse, /* so can treat like system function */ 10 11 2 number_of_statements fixed bin, 10 12 2 number_of_localized_symbols fixed bin, /* including labels and parameter variables, return var */ 10 13 /* even if they aren't there, thus >_ 3 */ 10 14 2 number_of_labels fixed bin, 10 15 2 label_values_ptr pointer unaligned, /* -> label_values below */ 10 16 2 statement_map_ptr pointer unaligned, /* -> statement_map below */ 10 17 2 lexeme_array_ptr pointer unaligned, /* -> lexeme_array below */ 10 18 10 19 /* the first 3 localized symbols are always reserved for ReturnSymbol, LeftArgSymbol, RighArgSymbol respectively. 10 20* If some of these symbols are not present (e.g. monadic or value-less function), null pointers are used. 10 21* So beware!, there can be null ptrs in the localized_symbols array. */ 10 22 10 23 2 localized_symbols( (0) refer (lexed_function_bead.number_of_localized_symbols)) pointer unaligned, 10 24 /* first localized vars from header line, then labels */ 10 25 2 label_values ( (0) refer (lexed_function_bead.number_of_labels)) pointer unaligned, 10 26 /* ptrs to label-value beads for labels */ 10 27 2 statement_map ( (0) refer (lexed_function_bead.number_of_statements)) fixed bin(18), 10 28 /* index in lexeme_array of rightmost lexeme of each stmt */ 10 29 2 lexeme_array ( (0) refer (lexed_function_bead.number_of_labels) /* not really, but fake out compiler */ ) pointer unaligned; 10 30 /* the actual lexemes. Length of array is 10 31* statement_map(number_of_statements) */ 10 32 10 33 10 34 /* manifest constants for first 3 localized symbols */ 10 35 10 36 dcl (ReturnSymbol init(1), 10 37 LeftArgSymbol init(2), 10 38 RightArgSymbol init(3) 10 39 ) fixed binary static; 10 40 10 41 10 42 /* the last three parts of this bead are referenced separately, though ptrs earlier in the bead. 10 43* Here are declarations for them as level-1 structures */ 10 44 10 45 dcl 1 lexed_function_label_values_structure based aligned, 10 46 2 lexed_function_label_values ( 500 /* or so */ ) pointer unaligned, 10 47 10 48 statement_count fixed bin, 10 49 lexed_function_statement_map (statement_count) fixed bin(18) aligned based, 10 50 10 51 1 lexed_function_lexemes_structure based aligned, 10 52 2 lexed_function_lexeme_array ( 500 /* or so */ ) pointer unaligned; 10 53 10 54 /* ------ END INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 -------------------------- */ 230 11 1 /* ====== BEGIN INCLUDE SEGMENT apl_parse_frame.incl.pl1 ================================== */ 11 2 11 3 declare 1 parse_frame aligned based (parse_frame_ptr), 11 4 2 last_parse_frame_ptr ptr unaligned, /* pointer to last parse frame, or null */ 11 5 2 parse_frame_type fixed bin, /* suspended, function, eval input, etc. */ 11 6 2 function_bead_ptr ptr unaligned, /* ptr to function bead */ 11 7 2 lexed_function_bead_ptr ptr unaligned, /* ptr to lexed function bead */ 11 8 2 reduction_stack_ptr ptr unaligned, /* ptr to reduction stack for this frame */ 11 9 2 current_parseme fixed bin, /* element of reduction stack that is top of stack */ 11 10 2 current_lexeme fixed bin, /* element number of current lexeme */ 11 11 2 current_line_number fixed bin, /* line number being executed */ 11 12 2 return_point fixed bin, /* where to join the reductions on return */ 11 13 2 put_result fixed bin, /* where to put the value when returning to this frame */ 11 14 2 print_final_value bit(1) aligned, /* if true, print final value on line */ 11 15 2 initial_value_stack_ptr ptr unaligned, /* for cleaning up the value stack */ 11 16 2 number_of_ptrs fixed bin, /* number of old meaning ptrs */ 11 17 2 old_meaning_ptrs dim (number_of_ptrs refer (parse_frame.number_of_ptrs)) ptr unaligned; 11 18 /* old meanings for local variables. */ 11 19 11 20 declare number_of_ptrs fixed bin; 11 21 11 22 declare (suspended_frame_type init (1), /* for comparison with parse frame type */ 11 23 function_frame_type init (2), 11 24 evaluated_frame_type init (3), 11 25 execute_frame_type init (4), 11 26 save_frame_type init (5) 11 27 ) fixed bin internal static options (constant); 11 28 11 29 declare reductions_pointer pointer; 11 30 11 31 declare 11 32 1 reduction_stack aligned dim (1000) based (reductions_pointer), 11 33 2 type fixed bin, /* type of parseme */ 11 34 2 bits unaligned like operator_bead.bits_for_parse, 11 35 2 semantics ptr unaligned, 11 36 2 lexeme fixed bin, 11 37 11 38 1 reduction_stack_for_op aligned dim (1000) based (reductions_pointer), 11 39 2 type fixed bin, 11 40 2 bits unaligned like operator_bead.bits_for_parse, 11 41 2 semantics fixed bin, 11 42 2 lexeme fixed bin, 11 43 11 44 (eol_type init(0), /* parseme types - end of line */ 11 45 bol_type init(1), /* begining of line */ 11 46 val_type init(2), /* value */ 11 47 op_type init(3), /* op */ 11 48 open_paren_type init(4), 11 49 close_paren_type init(5), 11 50 open_bracket_type init(6), 11 51 close_subscript_type init(7), 11 52 close_rank_type init(8), 11 53 semi_colon_type init(9), 11 54 diamond_type init (10), 11 55 subscript_type init (11)) fixed bin internal static options (constant); 11 56 11 57 /* ------ END INCLUDE SEGMENT apl_parse_frame.incl.pl1 ---------------------------------- */ 231 232 233 /* Program */ 234 235 call parse_header_line (header_line, character_pos, header_start, header_length, complicated_header, function_info); 236 237 /* Lookup function name */ 238 239 call apl_get_symbol_ ((function_info.name), function_info.symbol_ptr, (0)); 240 241 /* If we just created the symbol_bead, hang on to it, otherwise 242* decrement it. */ 243 244 if function_info.symbol_ptr -> symbol_bead.reference_count > 1 245 then call decrement_reference_count (function_info.symbol_ptr); 246 247 function_bead_ptr = function_info.symbol_ptr -> symbol_bead.meaning_pointer; 248 249 if function_bead_ptr ^= null() 250 then do; 251 252 if complicated_header 253 then call report_error (apl_error_table_$complicated_header_line, header_line, header_start); 254 255 if ^(function_bead_ptr -> function_bead.function) 256 then do; 257 call report_error (apl_error_table_$non_function_edited, header_line, header_start); 258 call apl_editor_cleanup (function_info); 259 end; 260 261 if function_bead_ptr -> function_bead.class = 1 262 then do; 263 call report_error (apl_error_table_$locked_function_edited, header_line, header_start); 264 call apl_editor_cleanup (function_info); 265 end; 266 else if function_bead_ptr -> function_bead.class ^= 0 267 then do; 268 call report_error (apl_error_table_$external_function_edited, header_line, header_start); 269 call apl_editor_cleanup (function_info); 270 end; 271 272 lexed_function_bead_ptr = function_bead_ptr -> function_bead.lexed_function_bead_pointer; 273 274 if lexed_function_bead_ptr ^= null () 275 then do parse_frame_ptr = ws_info.current_parse_frame_ptr 276 repeat (parse_frame_ptr -> parse_frame.last_parse_frame_ptr) 277 while (parse_frame_ptr ^= null()); 278 279 if parse_frame.parse_frame_type = suspended_frame_type 280 then last_frame_was_suspended = "1"b; 281 else do; 282 283 if parse_frame.parse_frame_type = function_frame_type 284 then if parse_frame.lexed_function_bead_ptr = lexed_function_bead_ptr 285 then if ^last_frame_was_suspended 286 then do; 287 288 /* Not allowed to edit pendent functions, punt */ 289 call report_error (apl_error_table_$pendent_function_edited, header_line, header_start); 290 call apl_editor_cleanup (function_info); 291 end; 292 else function_info.suspended_function = "1"b; 293 last_frame_was_suspended = "0"b; 294 end; /* else do */ 295 end; /* do parse_frame_ptr */ 296 297 call assign_line_numbers (function_info); 298 299 end; /* if function_bead_ptr ^= null () */ 300 301 else do; 302 call make_new_function (function_info, substr (header_line, header_start, header_length)); 303 304 call assign_line_numbers (function_info); 305 end; 306 return; 307 308 end; /* open_function */ 309 310 close_function: 311 procedure (function_info, current_line_number, code); 312 12 1 /* Begin include file apl_fuction_info.incl.pl1 */ 12 2 12 3 dcl 1 function_info, 12 4 2 edit_buffer_ptr pointer, 12 5 2 first_unused_char_in_buffer fixed bin, 12 6 2 name char(256) varying, 12 7 2 symbol_ptr ptr unaligned, 12 8 2 locked_function bit(1), 12 9 2 suspended_function bit(1), 12 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 12 11 2 saved_stop_vector ptr, 12 12 2 saved_trace_vector ptr, 12 13 2 number_of_lines fixed bin, 12 14 2 args(0:3) char(256) varying, 12 15 2 line_info(1:500), 12 16 3 line_number fixed decimal(10,5), 12 17 3 line_start fixed bin, 12 18 3 line_length fixed bin; 12 19 12 20 /* End include file apl_function_info.incl.pl1 */ 313 314 dcl current_line_number fixed decimal(10, 5) parameter; 315 dcl code fixed bin(35) parameter; 316 317 /* Automatic */ 318 319 dcl character_pos fixed bin; 320 dcl line_count fixed bin; 321 dcl reported_si_damage bit (1) aligned; 322 dcl scratch_space_ptr pointer; 323 dcl function_bead_ptr pointer unaligned; 324 dcl lexed_function_bead_ptr pointer unaligned; 325 dcl function_name char(32) varying; 326 dcl parse_frame_ptr pointer; 327 dcl data_elements fixed bin; 328 dcl last_frame_was_suspended bit(1); 329 dcl bad_header bit(1); 330 dcl lex_errors_occurred bit(1) aligned; 331 332 /* Static */ 333 334 dcl unlocked_message char(28) static options (constant) init ("function has been unlocked. 335 "); 336 337 /* Based */ 338 339 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 340 341 /* External */ 342 343 dcl sys_info$max_seg_size external fixed bin; 344 dcl apl_static_$apl_output external pointer; 345 dcl apl_error_table_$bad_function_header external fixed bin(35); 346 dcl apl_error_table_$edited_pendent_fcn external fixed bin (35); 347 348 dcl (size, substr, string, null, lbound, addrel, divide) builtin; 349 350 /* Entries */ 351 352 dcl apl_allocate_words_ entry (fixed bin(24), pointer unaligned); 353 dcl apl_function_lex_ entry (char(*) aligned, ptr unaligned, bit(1) aligned, fixed bin(24), ptr); 354 dcl apl_get_symbol_ entry (char(*), pointer unaligned, fixed bin); 355 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 356 357 /* Include Files */ 358 13 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 13 2 13 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 13 4 13 5 /* automatic */ 13 6 13 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 13 8 13 9 /* external static */ 13 10 13 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 13 12 2 static_ws_info_ptr unaligned pointer; 13 13 13 14 /* based */ 13 15 13 16 declare 1 ws_info aligned based (ws_info_ptr), 13 17 2 version_number fixed bin, /* version of this structure (3) */ 13 18 2 switches unaligned, /* mainly ws parameters */ 13 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 13 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 13 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 13 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 13 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 13 24 3 restrict_external_functions 13 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 13 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 13 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 13 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 13 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 13 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 13 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 13 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 13 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 13 34 3 compatibility_check_mode 13 35 bit, /* if 1, check for incompatible operators */ 13 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 13 37 /* remaining 20 bits not presently used */ 13 38 13 39 2 values, /* attributes of the workspace */ 13 40 3 digits fixed bin, /* number of digits of precision printed on output */ 13 41 3 width fixed bin, /* line length for formatted output */ 13 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 13 43 3 random_link fixed bin(35), /* seed for random number generator */ 13 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 13 45 3 float_index_origin float, /* the index origin in floating point */ 13 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 13 47 3 maximum_value_stack_size 13 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 13 49 13 50 2 pointers, /* pointers to various internal tables */ 13 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 13 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 13 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 13 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 13 55 13 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 13 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 13 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 13 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 13 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 13 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 13 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 13 63 2 signoff_lock character (32), 13 64 13 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 13 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 13 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 13 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 13 69 bit, /* munging his tables */ 13 70 3 unused_interrupt_bit bit, /* not presently used */ 13 71 3 dont_interrupt_command bit, 13 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 13 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 13 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 13 75 13 76 2 user_name char (32), /* process group id of user */ 13 77 2 immediate_input_prompt char (32) varying, /* normal input */ 13 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 13 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 13 80 2 vcpu_time aligned, 13 81 3 total fixed bin (71), 13 82 3 setup fixed bin (71), 13 83 3 parse fixed bin (71), 13 84 3 lex fixed bin (71), 13 85 3 operator fixed bin (71), 13 86 3 storage_manager fixed bin (71), 13 87 2 output_info aligned, /* data pertaining to output buffer */ 13 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 13 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 13 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 13 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 13 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 13 93 13 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 13 95 13 96 /* internal static */ 13 97 13 98 declare max_parse_stack_depth fixed bin int static init(64536); 13 99 13 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 359 14 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 14 2 14 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 14 4 2 type unaligned, 14 5 3 bead_type unaligned, 14 6 4 operator bit (1), /* ON if operator bead */ 14 7 4 symbol bit (1), /* ON if symbol bead */ 14 8 4 value bit (1), /* ON if value bead */ 14 9 4 function bit (1), /* ON if function bead */ 14 10 4 group bit (1), /* ON if group bead */ 14 11 4 label bit (1), /* ON if label bead */ 14 12 4 shared_variable bit (1), /* ON if shared variable bead */ 14 13 4 lexed_function bit (1), /* ON if lexed function bead */ 14 14 3 data_type unaligned, 14 15 4 list_value bit (1), /* ON if a list value bead */ 14 16 4 character_value bit (1), /* ON if a character value bead */ 14 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 14 18 4 integral_value bit (1), /* ON if an integral value bead */ 14 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 14 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 14 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 14 22 2 size bit (18) unaligned, /* Number of words this bead occupies 14 23* (used by bead storage manager) */ 14 24 2 reference_count fixed binary (29); /* Number of pointers which point 14 25* to this bead (used by bead manager) */ 14 26 14 27 14 28 /* constant strings for initing type field in various beads */ 14 29 14 30 declare ( 14 31 operator_type init("100000000000000000"b), 14 32 symbol_type init("010000000000000000"b), 14 33 value_type init("001000000000000000"b), 14 34 function_type init("000100000000000000"b), 14 35 group_type init("000010000000000000"b), 14 36 label_type init("001001000011000000"b), 14 37 shared_variable_type init("001000100000000000"b), 14 38 lexed_function_type init("000000010000000000"b), 14 39 14 40 list_value_type init("000000001000000000"b), 14 41 character_value_type init("001000000100000000"b), 14 42 numeric_value_type init("001000000010000000"b), 14 43 integral_value_type init("001000000011000000"b), 14 44 zero_or_one_value_type init("001000000011100000"b), 14 45 complex_value_type init("001000000000010000"b), 14 46 14 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 14 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 14 49 ) bit(18) internal static; 14 50 14 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 360 15 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 15 2 15 3 declare 15 4 1 operator_bead aligned based, 15 5 15 6 2 type unaligned like general_bead.type, 15 7 15 8 2 bits_for_lex unaligned, 15 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 15 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 15 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 15 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 15 13 3 ignores_assignment bit(1), /* assignment has no effect */ 15 14 3 allow_subscripted_assignment 15 15 bit(1), /* system variable that can be subscripted assigned */ 15 16 3 pad bit(12), 15 17 15 18 2 bits_for_parse unaligned, 15 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 15 20* (op1 tells which) */ 15 21 3 quad bit(1), /* this is a quad type */ 15 22 3 system_variable bit(1), /* this is a system variable, not an op */ 15 23 3 dyadic bit(1), /* operator may be dyadic */ 15 24 3 monadic bit(1), /* operator may be monadic */ 15 25 3 function bit(1), /* operator is a user defined function */ 15 26 3 semantics_valid bit(1), /* if semantics has been set */ 15 27 3 has_list bit(1), /* semantics is a list */ 15 28 3 inner_product bit(1), /* op2 is valid */ 15 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 15 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 15 31 3 pad bit(7), 15 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 15 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 15 34 2 type_code fixed bin; /* for parse */ 15 35 15 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 361 16 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 16 2 16 3 /* Explanation of fields: 16 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 16 5* symbol_bead.meaning_pointer points to current "value" of this name: 16 6* = null => unused (e.g. undefined variable) 16 7* -> group bead => group name 16 8* -> value bead => variable with a value 16 9* -> function bead => function name 16 10* -> label bead => localized label value 16 11* -> shared var bead => shared variable */ 16 12 16 13 declare 1 symbol_bead aligned based, 16 14 2 header aligned like general_bead, 16 15 2 hash_link_pointer pointer unaligned, 16 16 2 meaning_pointer pointer unaligned, 16 17 2 name_length fixed binary, 16 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 16 19 16 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 362 17 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 17 2 17 3 /* This bead is used by apl to store the source code for user-defined functions */ 17 4 17 5 declare 1 function_bead aligned based, 17 6 17 7 2 header aligned like general_bead, 17 8 17 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 17 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 17 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 17 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 17 13 2 text_length fixed bin(21), /* length of function text */ 17 14 2 text aligned char(data_elements refer (function_bead.text_length)); 17 15 /* the user's code exactly as typed in */ 17 16 17 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 363 18 1 /* ====== BEGIN INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 ========================== */ 18 2 18 3 /* this is the format of a user-defined function after it has been run 18 4* through apl_lex_, the first (left to right) parsing phase. */ 18 5 18 6 dcl 1 lexed_function_bead based aligned, 18 7 2 header like general_bead, /* type bits, etc. */ 18 8 18 9 2 name pointer unaligned, /* -> symbol bead which names the function */ 18 10 2 bits_for_parse unaligned like operator_bead.bits_for_parse, /* so can treat like system function */ 18 11 2 number_of_statements fixed bin, 18 12 2 number_of_localized_symbols fixed bin, /* including labels and parameter variables, return var */ 18 13 /* even if they aren't there, thus >_ 3 */ 18 14 2 number_of_labels fixed bin, 18 15 2 label_values_ptr pointer unaligned, /* -> label_values below */ 18 16 2 statement_map_ptr pointer unaligned, /* -> statement_map below */ 18 17 2 lexeme_array_ptr pointer unaligned, /* -> lexeme_array below */ 18 18 18 19 /* the first 3 localized symbols are always reserved for ReturnSymbol, LeftArgSymbol, RighArgSymbol respectively. 18 20* If some of these symbols are not present (e.g. monadic or value-less function), null pointers are used. 18 21* So beware!, there can be null ptrs in the localized_symbols array. */ 18 22 18 23 2 localized_symbols( (0) refer (lexed_function_bead.number_of_localized_symbols)) pointer unaligned, 18 24 /* first localized vars from header line, then labels */ 18 25 2 label_values ( (0) refer (lexed_function_bead.number_of_labels)) pointer unaligned, 18 26 /* ptrs to label-value beads for labels */ 18 27 2 statement_map ( (0) refer (lexed_function_bead.number_of_statements)) fixed bin(18), 18 28 /* index in lexeme_array of rightmost lexeme of each stmt */ 18 29 2 lexeme_array ( (0) refer (lexed_function_bead.number_of_labels) /* not really, but fake out compiler */ ) pointer unaligned; 18 30 /* the actual lexemes. Length of array is 18 31* statement_map(number_of_statements) */ 18 32 18 33 18 34 /* manifest constants for first 3 localized symbols */ 18 35 18 36 dcl (ReturnSymbol init(1), 18 37 LeftArgSymbol init(2), 18 38 RightArgSymbol init(3) 18 39 ) fixed binary static; 18 40 18 41 18 42 /* the last three parts of this bead are referenced separately, though ptrs earlier in the bead. 18 43* Here are declarations for them as level-1 structures */ 18 44 18 45 dcl 1 lexed_function_label_values_structure based aligned, 18 46 2 lexed_function_label_values ( 500 /* or so */ ) pointer unaligned, 18 47 18 48 statement_count fixed bin, 18 49 lexed_function_statement_map (statement_count) fixed bin(18) aligned based, 18 50 18 51 1 lexed_function_lexemes_structure based aligned, 18 52 2 lexed_function_lexeme_array ( 500 /* or so */ ) pointer unaligned; 18 53 18 54 /* ------ END INCLUDE SEGMENT apl_lexed_function_bead.incl.pl1 -------------------------- */ 364 19 1 /* ====== BEGIN INCLUDE SEGMENT apl_parse_frame.incl.pl1 ================================== */ 19 2 19 3 declare 1 parse_frame aligned based (parse_frame_ptr), 19 4 2 last_parse_frame_ptr ptr unaligned, /* pointer to last parse frame, or null */ 19 5 2 parse_frame_type fixed bin, /* suspended, function, eval input, etc. */ 19 6 2 function_bead_ptr ptr unaligned, /* ptr to function bead */ 19 7 2 lexed_function_bead_ptr ptr unaligned, /* ptr to lexed function bead */ 19 8 2 reduction_stack_ptr ptr unaligned, /* ptr to reduction stack for this frame */ 19 9 2 current_parseme fixed bin, /* element of reduction stack that is top of stack */ 19 10 2 current_lexeme fixed bin, /* element number of current lexeme */ 19 11 2 current_line_number fixed bin, /* line number being executed */ 19 12 2 return_point fixed bin, /* where to join the reductions on return */ 19 13 2 put_result fixed bin, /* where to put the value when returning to this frame */ 19 14 2 print_final_value bit(1) aligned, /* if true, print final value on line */ 19 15 2 initial_value_stack_ptr ptr unaligned, /* for cleaning up the value stack */ 19 16 2 number_of_ptrs fixed bin, /* number of old meaning ptrs */ 19 17 2 old_meaning_ptrs dim (number_of_ptrs refer (parse_frame.number_of_ptrs)) ptr unaligned; 19 18 /* old meanings for local variables. */ 19 19 19 20 declare number_of_ptrs fixed bin; 19 21 19 22 declare (suspended_frame_type init (1), /* for comparison with parse frame type */ 19 23 function_frame_type init (2), 19 24 evaluated_frame_type init (3), 19 25 execute_frame_type init (4), 19 26 save_frame_type init (5) 19 27 ) fixed bin internal static options (constant); 19 28 19 29 declare reductions_pointer pointer; 19 30 19 31 declare 19 32 1 reduction_stack aligned dim (1000) based (reductions_pointer), 19 33 2 type fixed bin, /* type of parseme */ 19 34 2 bits unaligned like operator_bead.bits_for_parse, 19 35 2 semantics ptr unaligned, 19 36 2 lexeme fixed bin, 19 37 19 38 1 reduction_stack_for_op aligned dim (1000) based (reductions_pointer), 19 39 2 type fixed bin, 19 40 2 bits unaligned like operator_bead.bits_for_parse, 19 41 2 semantics fixed bin, 19 42 2 lexeme fixed bin, 19 43 19 44 (eol_type init(0), /* parseme types - end of line */ 19 45 bol_type init(1), /* begining of line */ 19 46 val_type init(2), /* value */ 19 47 op_type init(3), /* op */ 19 48 open_paren_type init(4), 19 49 close_paren_type init(5), 19 50 open_bracket_type init(6), 19 51 close_subscript_type init(7), 19 52 close_rank_type init(8), 19 53 semi_colon_type init(9), 19 54 diamond_type init (10), 19 55 subscript_type init (11)) fixed bin internal static options (constant); 19 56 19 57 /* ------ END INCLUDE SEGMENT apl_parse_frame.incl.pl1 ---------------------------------- */ 365 366 367 /* Program */ 368 369 code = 0; 370 371 data_elements = 0; 372 do line_count = lbound (function_info.line_info, 1) to function_info.number_of_lines; 373 data_elements = data_elements + function_info.line_info(line_count).line_length; 374 end; 375 376 call apl_allocate_words_ (size (function_bead), function_bead_ptr); 377 378 string (function_bead_ptr -> function_bead.type) = function_type; 379 function_bead_ptr -> function_bead.text_length = data_elements; 380 381 character_pos = 1; 382 do line_count = lbound (function_info.line_info, 1) to function_info.number_of_lines; 383 384 substr (function_bead_ptr -> function_bead.text, character_pos, function_info.line_info(line_count).line_length) = 385 substr (edit_buffer, function_info.line_info(line_count).line_start, function_info.line_info(line_count).line_length); 386 387 character_pos = character_pos + function_info.line_info(line_count).line_length; 388 end; 389 390 scratch_space_ptr = addrel (function_info.edit_buffer_ptr, divide (function_info.first_unused_char_in_buffer + 3, 4, 17, 0)); 391 392 call apl_function_lex_ (function_bead_ptr -> function_bead.text, lexed_function_bead_ptr, lex_errors_occurred, 0, scratch_space_ptr); 393 394 function_bead_ptr -> function_bead.lexed_function_bead_pointer = lexed_function_bead_ptr; 395 396 if lex_errors_occurred 397 then do; 398 399 code = -1; 400 401 if function_info.locked_function 402 then do; 403 404 function_bead_ptr -> function_bead.class = 0; 405 function_info.locked_function = "0"b; 406 407 call iox_$put_chars (apl_static_$apl_output, addr (unlocked_message), length (unlocked_message), 408 code); 409 end; 410 411 /* Find out if header is valid, and if so hack the meaning 412* pointer to save the function definition. */ 413 414 call parse_function_name_and_args (substr (edit_buffer, function_info.line_info(1).line_start, 415 function_info.line_info(1).line_length), 1, (0), function_name, (""), (""), (""), ("0"b), ("0"b), 416 bad_header); 417 418 if bad_header 419 then do; 420 code = apl_error_table_$bad_function_header; 421 return; 422 end; 423 424 call apl_get_symbol_ ((function_name), symbol_ptr, (0)); 425 426 function_info.symbol_ptr = symbol_ptr; /* remember symbol ptr */ 427 end; /* if lex_errors_occurred */ 428 429 else symbol_ptr = lexed_function_bead_ptr -> lexed_function_bead.name; 430 431 call decrement_reference_count (symbol_ptr -> symbol_bead.meaning_pointer); 432 symbol_ptr -> symbol_bead.meaning_pointer = function_bead_ptr; 433 function_bead_ptr -> function_bead.reference_count = 1; 434 435 /* Renumber all the lines if there were errors */ 436 437 if lex_errors_occurred 438 then do; 439 call assign_line_numbers (function_info); 440 current_line_number = function_info.line_info(function_info.number_of_lines).line_number + 1; 441 end; 442 443 last_frame_was_suspended = "0"b; 444 reported_si_damage = "0"b; 445 446 /* See if the function we have just finished editing successfully is on the SI. 447* We check now, as well as at the beginning, because the user could have renamed 448* the function while editing it. */ 449 450 if ^lex_errors_occurred 451 then do parse_frame_ptr = ws_info.current_parse_frame_ptr repeat (parse_frame.last_parse_frame_ptr) 452 while (parse_frame_ptr ^= null ()); 453 454 if parse_frame.parse_frame_type = suspended_frame_type 455 then last_frame_was_suspended = "1"b; 456 else do; 457 458 code = 0; 459 460 if parse_frame.parse_frame_type = function_frame_type 461 then if parse_frame.lexed_function_bead_ptr -> lexed_function_bead.name = symbol_ptr 462 then if last_frame_was_suspended 463 then do; 464 465 /* We have found a suspended instance of this function. See if 466* they match. We have prevented some kinds of errors by 467* refusing to let the user edit the header, but by renaming the 468* function, or by adding/deleting/reordering labels, he could 469* still screw us. */ 470 471 code = check_function_compatibility (parse_frame.lexed_function_bead_ptr, 472 lexed_function_bead_ptr); 473 474 if code = 0 475 then do; 476 call decrement_reference_count (parse_frame.function_bead_ptr); 477 call decrement_reference_count (parse_frame.lexed_function_bead_ptr); 478 479 parse_frame.function_bead_ptr = function_bead_ptr; 480 function_bead_ptr -> general_bead.reference_count = 481 function_bead_ptr -> general_bead.reference_count + 1; 482 483 parse_frame.lexed_function_bead_ptr = lexed_function_bead_ptr; 484 485 lexed_function_bead_ptr -> general_bead.reference_count = 486 lexed_function_bead_ptr -> general_bead.reference_count + 1; 487 end; 488 end; 489 else code = apl_error_table_$edited_pendent_fcn; 490 491 if code ^= 0 492 then do; 493 if ^reported_si_damage 494 then call report_error (code, "", 0); 495 496 reported_si_damage = "1"b; 497 end; 498 499 last_frame_was_suspended = "0"b; 500 end; 501 end; 502 503 if function_info.locked_function 504 then do; 505 506 function_bead_ptr -> function_bead.class = 1; 507 function_bead_ptr -> function_bead.stop_control_pointer = null (); 508 function_bead_ptr -> function_bead.trace_control_pointer = null (); 509 end; 510 else do; 511 512 function_bead_ptr -> function_bead.class = 0; 513 function_bead_ptr -> function_bead.stop_control_pointer = function_info.saved_stop_vector; 514 if function_info.saved_stop_vector ^= null () 515 then function_info.saved_stop_vector -> general_bead.reference_count = 516 function_info.saved_stop_vector -> general_bead.reference_count + 1; 517 518 function_bead_ptr -> function_bead.trace_control_pointer = function_info.saved_trace_vector; 519 if function_info.saved_trace_vector ^= null () 520 then function_info.saved_trace_vector -> general_bead.reference_count = 521 function_info.saved_trace_vector -> general_bead.reference_count + 1; 522 end; 523 524 return; 525 526 check_function_compatibility: 527 procedure (P_old_lfbp, P_new_lfbp) returns (fixed bin (35)); 528 529 /* parameters */ 530 531 declare (P_old_lfbp, P_new_lfbp) ptr unal parameter; 532 533 /* automatic */ 534 535 declare indx fixed bin (17), 536 new_labels_ptr ptr, 537 new_lfbp ptr, 538 old_labels_ptr ptr, 539 old_lfbp ptr; 540 541 /* external static */ 542 543 declare (apl_error_table_$labels_differ, 544 apl_error_table_$locals_differ, 545 apl_error_table_$n_labels_differ, 546 apl_error_table_$n_locals_differ) fixed bin (35) external static; 547 548 /* program */ 549 550 old_lfbp = P_old_lfbp; 551 new_lfbp = P_new_lfbp; 552 553 if (old_lfbp -> lexed_function_bead.number_of_labels = 554 new_lfbp -> lexed_function_bead.number_of_labels) 555 then if (old_lfbp -> lexed_function_bead.number_of_localized_symbols = 556 new_lfbp -> lexed_function_bead.number_of_localized_symbols) 557 then do; 558 559 /* We know they have the same number of locals, see if the names match */ 560 561 do indx = 1 to old_lfbp -> lexed_function_bead.number_of_localized_symbols - 562 old_lfbp -> lexed_function_bead.number_of_labels; 563 564 if old_lfbp -> lexed_function_bead.localized_symbols (indx) ^= 565 new_lfbp -> lexed_function_bead.localized_symbols (indx) 566 then return (apl_error_table_$locals_differ); 567 end; 568 569 /* We know they have the same number of labels. See if they are the same names, 570* in the same order. */ 571 572 old_labels_ptr = old_lfbp -> lexed_function_bead.label_values_ptr; 573 new_labels_ptr = new_lfbp -> lexed_function_bead.label_values_ptr; 574 575 do indx = 1 to old_lfbp -> lexed_function_bead.number_of_labels; 576 if old_labels_ptr -> lexed_function_label_values (indx) ^= 577 new_labels_ptr -> lexed_function_label_values (indx) 578 then return (apl_error_table_$labels_differ); 579 end; 580 581 return (0); 582 end; 583 else return (apl_error_table_$n_locals_differ); 584 585 return (apl_error_table_$n_labels_differ); 586 587 end check_function_compatibility; 588 589 end close_function; 590 591 process_bracket_contents: 592 procedure (input_buffer, input_line_length, character_pos, current_line_number, function_info); 593 594 dcl input_buffer char(*) parameter; 595 dcl input_line_length fixed bin(21); 596 dcl character_pos fixed bin parameter; 597 dcl current_line_number fixed decimal(10, 5) parameter; 20 1 /* Begin include file apl_fuction_info.incl.pl1 */ 20 2 20 3 dcl 1 function_info, 20 4 2 edit_buffer_ptr pointer, 20 5 2 first_unused_char_in_buffer fixed bin, 20 6 2 name char(256) varying, 20 7 2 symbol_ptr ptr unaligned, 20 8 2 locked_function bit(1), 20 9 2 suspended_function bit(1), 20 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 20 11 2 saved_stop_vector ptr, 20 12 2 saved_trace_vector ptr, 20 13 2 number_of_lines fixed bin, 20 14 2 args(0:3) char(256) varying, 20 15 2 line_info(1:500), 20 16 3 line_number fixed decimal(10,5), 20 17 3 line_start fixed bin, 20 18 3 line_length fixed bin; 20 19 20 20 /* End include file apl_function_info.incl.pl1 */ 598 599 600 /* Automatic */ 601 602 dcl (state, last_state) fixed bin; 603 604 dcl count fixed bin; 605 dcl (token_type, token_start) fixed bin; 606 dcl gotten_number fixed decimal (10,5); 607 dcl (left_number, right_number) fixed decimal (10,5); 608 609 /* Based */ 610 611 dcl input_line char(input_line_length) based (addr (input_buffer)); 612 613 /* External */ 614 615 dcl (apl_error_table_$empty_editor_brackets, 616 apl_error_table_$missing_quad_or_rb, 617 apl_error_table_$missing_number_or_rb, 618 apl_error_table_$missing_rb, 619 apl_error_table_$missing_number, 620 apl_error_table_$bad_token_in_brackets, 621 apl_error_table_$suspended_header, 622 apl_error_table_$extra_text) 623 fixed bin(35) external; 624 625 /* Internal Static */ 626 627 /* States: LB = Left Bracket, N = Number, Quad and Delta are themselves */ 628 629 dcl (LB init (0), 630 LB_N init (1), 631 LB_N_Quad init (2), 632 LB_N_Quad_N init (3), 633 LB_Quad init (4), 634 LB_Quad_N init (5), 635 LB_Delta init (6), 636 LB_Delta_N init (7), 637 Done init (8), 638 Empty_Brackets init (9), 639 Not_Quad_or_RB init (10), 640 Not_N_or_RB init (11), 641 Not_RB init (12), 642 Not_N init (13)) 643 fixed bin internal static options (constant); 644 645 dcl first_time_in_process bit (1) aligned initial ("1"b) internal static; 646 dcl state_table(0:7, 4) fixed bin internal static; 647 648 dcl (Number_Token init (1), 649 Quad_Token init (2), 650 Delta_Token init (3), 651 RB_Token init (4), 652 Bad_Token init (5)) 653 fixed bin internal static options (constant); 654 655 /* Program */ 656 657 if first_time_in_process 658 then do; 659 state_table(LB, Number_Token) = LB_N; 660 state_table(LB, Quad_Token) = LB_Quad; 661 state_table(LB, Delta_Token) = LB_Delta; 662 state_table(LB, RB_Token) = Empty_Brackets; 663 664 state_table(LB_N, Number_Token) = Not_Quad_or_RB; 665 state_table(LB_N, Quad_Token) = LB_N_Quad; 666 state_table(LB_N, Delta_Token) = Not_Quad_or_RB; 667 state_table(LB_N, RB_Token) = Done; 668 669 state_table(LB_N_Quad, Number_Token) = LB_N_Quad_N; 670 state_table(LB_N_Quad, Quad_Token) = Not_N_or_RB; 671 state_table(LB_N_Quad, Delta_Token) = Not_N_or_RB; 672 state_table(LB_N_Quad, RB_Token) = Done; 673 674 state_table(LB_N_Quad_N, Number_Token) = Not_RB; 675 state_table(LB_N_Quad_N, Quad_Token) = Not_RB; 676 state_table(LB_N_Quad_N, Delta_Token) = Not_RB; 677 state_table(LB_N_Quad_N, RB_Token) = Done; 678 679 state_table(LB_Quad, Number_Token) = LB_Quad_N; 680 state_table(LB_Quad, Quad_Token) = Not_N_or_RB; 681 state_table(LB_Quad, Delta_Token) = Not_N_or_RB; 682 state_table(LB_Quad, RB_Token) = Done; 683 684 state_table(LB_Quad_N, Number_Token) = Not_RB; 685 state_table(LB_Quad_N, Quad_Token) = Not_RB; 686 state_table(LB_Quad_N, Delta_Token) = Not_RB; 687 state_table(LB_Quad_N, RB_Token) = Done; 688 689 state_table(LB_Delta, Number_Token) = LB_Delta_N; 690 state_table(LB_Delta, Quad_Token) = Not_N; 691 state_table(LB_Delta, Delta_Token) = Not_N; 692 state_table(LB_Delta, RB_Token) = Not_N; 693 694 state_table(LB_Delta_N, Number_Token) = Not_RB; 695 state_table(LB_Delta_N, Quad_Token) = Not_RB; 696 state_table(LB_Delta_N, Delta_Token) = Not_RB; 697 state_table(LB_Delta_N, RB_Token) = Done; 698 699 first_time_in_process = "0"b; 700 end; 701 702 state = LB; 703 character_pos = character_pos + 1; /* flush the LB */ 704 705 process_another: 706 707 last_state = state; 708 709 call get_next_bracket_token (input_line, character_pos, token_type, token_start, gotten_number); 710 711 if token_type = Bad_Token 712 then call error (apl_error_table_$bad_token_in_brackets, input_line, token_start); 713 714 state = state_table (last_state, token_type); 715 716 go to new_state(state); 717 718 new_state(1): /* LB_N */ 719 720 /* If function is suspended, user is not allowed to edit header. 721* Check for left number = 0, and barf. If in any future changes, 722* a left number of 0 does not refer to line 0, this code will have 723* to be changed. */ 724 725 if gotten_number = 0 726 then if function_info.suspended_function 727 then call error (apl_error_table_$suspended_header, input_line, token_start); 728 729 left_number = gotten_number; 730 go to process_another; 731 732 new_state(7): /* LB_Delta_N */ 733 734 /* Check for attempt to delete header of suspended function */ 735 736 if gotten_number = 0 737 then if function_info.suspended_function 738 then call error (apl_error_table_$suspended_header, input_line, token_start); 739 740 new_state(3): /* LB_N_Quad_N */ 741 new_state(5): /* LB_Quad_N */ 742 743 right_number = gotten_number; 744 go to process_another; 745 746 new_state(2): /* LB_N_Quad */ 747 new_state(4): /* LB_Quad */ 748 new_state(6): /* LB_Delta */ 749 750 go to process_another; 751 752 new_state(8): /* Done */ 753 754 go to perform_action(last_state); 755 756 new_state(9): /* Empty_Brackets */ 757 758 call error (apl_error_table_$empty_editor_brackets, input_line, token_start); 759 760 new_state(10): /* Not_Quad_or_RB */ 761 762 call error (apl_error_table_$missing_quad_or_rb, input_line, token_start); 763 764 new_state(11): /* Not_N_or_RB */ 765 766 call error (apl_error_table_$missing_number_or_rb, input_line, token_start); 767 768 new_state(12): /* Not_RB */ 769 770 call error (apl_error_table_$missing_rb, input_line, token_start); 771 772 new_state(13): /* Not_N */ 773 774 call error (apl_error_table_$missing_number, input_line, token_start); 775 776 777 /* This is where the actual actions begin. The entire line has been parsed 778* so that we know exactly what to do. */ 779 780 perform_action(1): /* LB_N */ 781 782 current_line_number = left_number; 783 return; 784 785 perform_action(2): /* LB_N_Quad */ 786 787 call print_function_lines (left_number, 1, function_info); 788 current_line_number = left_number; 789 return; 790 791 perform_action(3): /* LB_N_Quad_N */ 792 793 if character_pos < length (input_line) 794 then call error (apl_error_table_$extra_text, input_line, character_pos); 795 796 call edit_one_line (input_buffer, input_line_length, character_pos, left_number, right_number, current_line_number, function_info); 797 return; 798 799 perform_action(4): /* LB_Quad */ 800 801 call print_function_lines (0, 2, function_info); 802 return; 803 804 perform_action(5): /* LB_Quad_N */ 805 806 call print_function_lines (right_number, 2, function_info); 807 return; 808 809 perform_action(7): /* LB_Delta_N */ 810 811 do count = lbound (function_info.line_info, 1) to function_info.number_of_lines 812 while (function_info.line_info(count).line_number < right_number); 813 end; 814 815 if count ^> function_info.number_of_lines 816 then if function_info.line_info(count).line_number = right_number 817 then do; 818 819 do count = count to function_info.number_of_lines - 1; 820 821 function_info.line_info(count) = function_info.line_info(count + 1); 822 end; 823 824 function_info.number_of_lines = function_info.number_of_lines - 1; 825 end; 826 827 current_line_number = right_number; 828 return; 829 830 get_next_bracket_token: 831 procedure (input_line, character_pos, token_type, token_start, gotten_number); 832 833 dcl input_line char(*) parameter; 834 dcl character_pos fixed bin parameter; 835 dcl token_type fixed bin parameter; 836 dcl token_start fixed bin parameter; 837 dcl gotten_number fixed decimal (10,5) parameter; 838 839 /* Automatic */ 840 841 dcl character char(1); 842 dcl number_length fixed bin; 843 dcl whitespace char(2) init (" "); /* space, tab */ 844 845 dcl conversion condition; 846 847 character_pos = character_pos + verify (substr (input_line, character_pos), whitespace) - 1; 848 849 token_start = character_pos; 850 851 character = substr (input_line, character_pos, 1); 852 853 if index ("0123456789.", character) ^= 0 854 then do; 855 856 number_length = verify (substr (input_line, character_pos), "0123456789.") - 1; 857 858 on conversion 859 goto got_bad_token; 860 861 gotten_number = fixed (substr (input_line, character_pos, number_length), 10, 5); 862 revert conversion; 863 864 character_pos = character_pos + number_length; 865 866 token_type = Number_Token; 867 end; 868 869 else do; 870 if character = QQuad 871 then token_type = Quad_Token; 872 873 else if character = QDelta 874 then token_type = Delta_Token; 875 876 else if character = QRightBracket 877 then token_type = RB_Token; 878 879 else do; 880 got_bad_token: 881 token_type = Bad_Token; 882 return; 883 end; 884 885 character_pos = character_pos + 1; 886 end; 887 888 end; /* get_next_bracket_token */ 889 890 end; /* process_bracket_contents */ 891 892 context_editor: 893 procedure (input_buffer, input_line_length, character_pos, current_line_number, function_info, saved_search_string); 894 895 dcl input_buffer char(*) parameter; 896 dcl input_line_length fixed bin(21); 897 dcl character_pos fixed bin parameter; 898 dcl current_line_number fixed decimal(10, 5) parameter; 21 1 /* Begin include file apl_fuction_info.incl.pl1 */ 21 2 21 3 dcl 1 function_info, 21 4 2 edit_buffer_ptr pointer, 21 5 2 first_unused_char_in_buffer fixed bin, 21 6 2 name char(256) varying, 21 7 2 symbol_ptr ptr unaligned, 21 8 2 locked_function bit(1), 21 9 2 suspended_function bit(1), 21 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 21 11 2 saved_stop_vector ptr, 21 12 2 saved_trace_vector ptr, 21 13 2 number_of_lines fixed bin, 21 14 2 args(0:3) char(256) varying, 21 15 2 line_info(1:500), 21 16 3 line_number fixed decimal(10,5), 21 17 3 line_start fixed bin, 21 18 3 line_length fixed bin; 21 19 21 20 /* End include file apl_function_info.incl.pl1 */ 899 900 dcl saved_search_string char(128) varying parameter; 901 902 /* Automatic */ 903 904 dcl char char(1); 905 906 /* Based */ 907 908 dcl input_line char(input_line_length) based (addr (input_buffer)); 909 910 /* External */ 911 912 dcl apl_error_table_$bad_context_request external fixed bin(35); 913 dcl apl_static_$apl_output external ptr; 914 915 /* Entries */ 916 917 dcl ioa_$ioa_switch entry() options(variable); 918 919 /* Include */ 920 22 1 /* ====== BEGIN INCLUDE SEGMENT apl_characters.incl.pl1 =================================== */ 22 2 22 3 /* 22 4* * This include file contains all the characters in the APL character set, 22 5* * declared char(1) [Instead of fixed bin as in the apl_character_codes.incl.pl1 file] 22 6* * 22 7* Modified 780913 by PG to add CentSign 22 8* Modified 790319 by PG to add CommaHyphen 22 9* */ 22 10 22 11 declare ( 22 12 QBell init(""), 22 13 QBackSpace init(""), 22 14 QTab init(" "), 22 15 QNewLine init(" 22 16 "), 22 17 QSpace init(" "), 22 18 QExclamation init("!"), 22 19 QDollar init("$"), 22 20 QApostrophe init("'"), 22 21 QLeftParen init("("), 22 22 QRightParen init(")"), 22 23 QStar init("*"), 22 24 QPlus init("+"), 22 25 QComma init(","), 22 26 QMinus init("-"), 22 27 QPeriod init("."), 22 28 QSlash init("/"), 22 29 QZero init("0"), 22 30 QOne init("1"), 22 31 QTwo init("2"), 22 32 QThree init("3"), 22 33 QFour init("4"), 22 34 QFive init("5"), 22 35 QSix init("6"), 22 36 QSeven init("7"), 22 37 QEight init("8"), 22 38 QNine init("9"), 22 39 QColon init(":"), 22 40 QSemiColon init(";"), 22 41 QLessThan init("<"), 22 42 QEqual init("="), 22 43 QGreaterThan init(">"), 22 44 QQuestion init("?"), 22 45 QLetterA_ init("A"), 22 46 QLetterB_ init("B"), 22 47 QLetterC_ init("C"), 22 48 QLetterD_ init("D"), 22 49 QLetterE_ init("E"), 22 50 QLetterF_ init("F"), 22 51 QLetterG_ init("G"), 22 52 QLetterH_ init("H"), 22 53 QLetterI_ init("I"), 22 54 QLetterJ_ init("J"), 22 55 QLetterK_ init("K"), 22 56 QLetterL_ init("L"), 22 57 QLetterM_ init("M"), 22 58 QLetterN_ init("N"), 22 59 QLetterO_ init("O"), 22 60 QLetterP_ init("P"), 22 61 QLetterQ_ init("Q"), 22 62 QLetterR_ init("R"), 22 63 QLetterS_ init("S"), 22 64 QLetterT_ init("T"), 22 65 QLetterU_ init("U"), 22 66 QLetterV_ init("V"), 22 67 QLetterW_ init("W"), 22 68 QLetterX_ init("X"), 22 69 QLetterY_ init("Y"), 22 70 QLetterZ_ init("Z"), 22 71 QLeftBracket init("["), 22 72 QBackSlash init("\"), 22 73 QRightBracket init("]"), 22 74 QUnderLine init("_"), 22 75 QLetterA init("a"), 22 76 QLetterB init("b"), 22 77 QLetterC init("c"), 22 78 QLetterD init("d"), 22 79 QLetterE init("e"), 22 80 QLetterF init("f"), 22 81 QLetterG init("g"), 22 82 QLetterH init("h"), 22 83 QLetterI init("i"), 22 84 QLetterJ init("j"), 22 85 QLetterK init("k"), 22 86 QLetterL init("l"), 22 87 QLetterM init("m"), 22 88 QLetterN init("n"), 22 89 QLetterO init("o"), 22 90 QLetterP init("p"), 22 91 QLetterQ init("q"), 22 92 QLetterR init("r"), 22 93 QLetterS init("s"), 22 94 QLetterT init("t"), 22 95 QLetterU init("u"), 22 96 QLetterV init("v"), 22 97 QLetterW init("w"), 22 98 QLetterX init("x"), 22 99 QLetterY init("y"), 22 100 QLetterZ init("z"), 22 101 QLeftBrace init("{"), 22 102 QVerticalBar init("|"), 22 103 QRightBrace init("}"), 22 104 QTilde init("~"), 22 105 QLessOrEqual init(""), 22 106 QGreaterOrEqual init(""), 22 107 QNotEqual init(""), 22 108 QOrSign init(""), 22 109 QAndSign init(""), 22 110 QDivision init(""), 22 111 QEpsilon init(""), 22 112 QUpArrow init(""), 22 113 QDownArrow init(""), 22 114 QCircle init(""), 22 115 QCeiling init(""), 22 116 QFloor init(""), 22 117 QDelta init(""), 22 118 QSmallCircle init(""), 22 119 QQuad init(""), 22 120 QCap init(""), 22 121 QDeCode init(""), 22 122 QEnCode init(""), 22 123 QLeftLump init(""), 22 124 QRightLump init(""), 22 125 QCup init(""), 22 126 QNorSign init(""), 22 127 QNandSign init(""), 22 128 QCircleHyphen init(""), 22 129 QSlashHyphen init(""), 22 130 QDelTilde init(""), 22 131 QCircleStar init(""), 22 132 QCircleBar init(""), 22 133 QCircleBackSlash init(""), 22 134 QCircleSlash init(""), 22 135 QGradeDown init(""), 22 136 QGradeUp init(""), 22 137 QLamp init(""), 22 138 QQuadQuote init(""), 22 139 QIBeam init(""), 22 140 QBackSlashHyphen init(""), 22 141 QDomino init(""), 22 142 QDiaresis init(""), 22 143 QOmega init(""), 22 144 QIota init(""), 22 145 QRho init(""), 22 146 QTimes init(""), 22 147 QAlpha init(""), 22 148 QUpperMinus init(""), 22 149 QDel init(""), 22 150 QLeftArrow init(""), 22 151 QRightArrow init(""), 22 152 QDiamond init(""), 22 153 QZero_ init(""), 22 154 QOne_ init(""), 22 155 QTwo_ init(""), 22 156 QThree_ init(""), 22 157 QFour_ init(""), 22 158 QFive_ init(""), 22 159 QSix_ init(""), 22 160 QSeven_ init(""), 22 161 QEight_ init(""), 22 162 QNine_ init(""), 22 163 QDelta_ init(""), 22 164 QMarkError init(""), 22 165 QExecuteSign init(""), 22 166 QFormatSign init(""), 22 167 QLeftTack init(""), 22 168 QRightTack init(""), 22 169 QLineFeed init(""), 22 170 QConditionalNewLine init(""), 22 171 QCentSign init(""), 22 172 QCommaHyphen init("") 22 173 ) char(1) internal static options (constant); 22 174 22 175 /* ------ END INCLUDE SEGMENT apl_characters.incl.pl1 ----------------------------------- */ 921 922 923 924 character_pos = character_pos + 1; 925 926 /* Line has at least a NL in it, so this substr won't fail */ 927 928 char = substr (input_line, character_pos, 1); 929 930 if char = QSlash 931 then call context_search (input_line, character_pos, current_line_number, function_info, saved_search_string, "0"b); 932 933 else if char = QLessThan /* reverse search */ 934 then do; 935 character_pos = character_pos + 1; 936 char = substr (input_line, character_pos, 1); 937 938 if char = QSlash 939 then call context_search (input_line, character_pos, current_line_number, function_info, saved_search_string, "1"b); 940 else call error (apl_error_table_$bad_context_request, input_line, character_pos); 941 end; 942 943 else if char = QLetterS 944 then call context_substitute (input_line, character_pos, current_line_number, function_info, saved_search_string); 945 946 else if char = QLetterG 947 then call context_global_print (input_line, character_pos, function_info, saved_search_string); 948 else call error (apl_error_table_$bad_context_request, input_line, character_pos); 949 950 if character_pos < length (input_line) 951 then do; 952 call ioa_$ioa_switch (apl_static_$apl_output, "extra text follows context request"); 953 call error (0, "", 0); 954 end; 955 956 return; 957 958 context_search: 959 procedure (input_line, character_pos, current_line_number, function_info, saved_search_string, reverse_search); 960 961 dcl input_line char(*) parameter; 962 dcl character_pos fixed bin parameter; 963 dcl current_line_number fixed decimal(10, 5) parameter; 23 1 /* Begin include file apl_fuction_info.incl.pl1 */ 23 2 23 3 dcl 1 function_info, 23 4 2 edit_buffer_ptr pointer, 23 5 2 first_unused_char_in_buffer fixed bin, 23 6 2 name char(256) varying, 23 7 2 symbol_ptr ptr unaligned, 23 8 2 locked_function bit(1), 23 9 2 suspended_function bit(1), 23 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 23 11 2 saved_stop_vector ptr, 23 12 2 saved_trace_vector ptr, 23 13 2 number_of_lines fixed bin, 23 14 2 args(0:3) char(256) varying, 23 15 2 line_info(1:500), 23 16 3 line_number fixed decimal(10,5), 23 17 3 line_start fixed bin, 23 18 3 line_length fixed bin; 23 19 23 20 /* End include file apl_function_info.incl.pl1 */ 964 965 dcl saved_search_string char(128) varying parameter; 966 dcl reverse_search bit(1) parameter; 967 968 /* Automatic */ 969 970 dcl search_string_start fixed bin; 971 dcl search_string char (128) varying; 972 dcl starting_line_idx fixed bin; 973 dcl increment fixed bin; 974 dcl end_of_first_half fixed bin; 975 dcl start_of_second_half fixed bin; 976 dcl idx fixed bin; 977 dcl line_idx fixed bin; 978 979 /* External */ 980 981 dcl apl_static_$apl_output external ptr; 982 dcl apl_error_table_$missing_slash external fixed bin(35); 983 dcl sys_info$max_seg_size external fixed bin; 984 985 /* Based */ 986 987 dcl edit_buffer char(sys_info$max_seg_size * 4) based (function_info.edit_buffer_ptr); 988 989 /* Entries */ 990 991 dcl ioa_$ioa_switch entry options (variable); 992 993 /* Program */ 994 995 character_pos = character_pos + 1; /* skip "/" */ 996 search_string_start = character_pos; 997 998 /* Move forward to next "/" */ 999 1000 idx = index (substr (input_line, character_pos), QSlash); 1001 1002 if idx = 0 1003 then do; 1004 character_pos = input_line_length + 1; 1005 call error (apl_error_table_$missing_slash, input_line, character_pos); 1006 end; 1007 1008 character_pos = character_pos + idx - 1; 1009 1010 search_string = substr (input_line, search_string_start, character_pos - search_string_start); /* drop trailing "/" */ 1011 1012 /* Hack empty search string to use previous */ 1013 1014 if search_string = "" 1015 then search_string = saved_search_string; 1016 else saved_search_string = search_string; 1017 1018 character_pos = character_pos + 1; /* move over slash */ 1019 1020 /* Get index into function line array of current line */ 1021 1022 call get_line_info_idx (current_line_number, starting_line_idx, function_info, code); 1023 1024 /* If code is not zero, the current_line does not exist. If we are 1025* past the end of the lines array, start at the beginning. */ 1026 1027 if code ^= 0 1028 then if starting_line_idx > function_info.number_of_lines 1029 then starting_line_idx = lbound (function_info.line_info, 1); 1030 1031 1032 /* Loop through lines looking for match starting at the line 1033* after (or before) and wrapping around at the bottom (or top) 1034* of the function. Set up the proper loop variables. */ 1035 1036 if reverse_search 1037 then do; 1038 increment = -1; 1039 end_of_first_half = 1; /* back to line 1 */ 1040 start_of_second_half = function_info.number_of_lines; 1041 end; 1042 else do; 1043 increment = 1; 1044 end_of_first_half = function_info.number_of_lines; 1045 start_of_second_half = 1; /* start again at top */ 1046 end; 1047 1048 do line_idx = starting_line_idx + increment to end_of_first_half by increment, 1049 start_of_second_half to starting_line_idx by increment; 1050 1051 /* Does current line match? */ 1052 1053 idx = index (substr (edit_buffer, function_info.line_info(line_idx).line_start, function_info.line_info(line_idx).line_length), search_string); 1054 1055 if idx ^= 0 1056 then do; 1057 1058 current_line_number = function_info.line_info(line_idx).line_number; 1059 call print_function_lines (current_line_number, 1, function_info); 1060 1061 return; 1062 end; 1063 end; 1064 1065 call ioa_$ioa_switch (apl_static_$apl_output, "search fails"); 1066 call error (0, "", 0); 1067 1068 end; /* context_search */ 1069 1070 context_substitute: 1071 procedure (input_line, character_pos, current_line_number, function_info, saved_search_string); 1072 1073 dcl input_line char(*) parameter; 1074 dcl character_pos fixed bin parameter; 1075 dcl current_line_number fixed decimal(10, 5) parameter; 24 1 /* Begin include file apl_fuction_info.incl.pl1 */ 24 2 24 3 dcl 1 function_info, 24 4 2 edit_buffer_ptr pointer, 24 5 2 first_unused_char_in_buffer fixed bin, 24 6 2 name char(256) varying, 24 7 2 symbol_ptr ptr unaligned, 24 8 2 locked_function bit(1), 24 9 2 suspended_function bit(1), 24 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 24 11 2 saved_stop_vector ptr, 24 12 2 saved_trace_vector ptr, 24 13 2 number_of_lines fixed bin, 24 14 2 args(0:3) char(256) varying, 24 15 2 line_info(1:500), 24 16 3 line_number fixed decimal(10,5), 24 17 3 line_start fixed bin, 24 18 3 line_length fixed bin; 24 19 24 20 /* End include file apl_function_info.incl.pl1 */ 1076 1077 dcl saved_search_string char(128) varying parameter; 1078 1079 /* Automatic */ 1080 1081 dcl string_start fixed bin; 1082 dcl (string1, string2) char(128) varying; 1083 dcl idx fixed bin; 1084 dcl verify_substitute bit(1) init ("0"b); 1085 dcl show_substitute bit(1) init ("0"b); 1086 dcl line_idx fixed bin; 1087 dcl (old_start, old_length) fixed bin; 1088 dcl first_free_char fixed bin; 1089 dcl old_tail_length fixed bin; 1090 dcl answer_buffer char(5); 1091 dcl answer_length fixed bin(21); 1092 dcl prompt_string char(14) varying; 1093 1094 /* Based */ 1095 1096 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 1097 1098 /* External */ 1099 1100 dcl apl_error_table_$missing_slash external fixed bin(35); 1101 dcl apl_error_table_$bad_substitute external fixed bin(35); 1102 dcl apl_static_$apl_output external ptr; 1103 dcl sys_info$max_seg_size fixed bin(35) ext static; 1104 1105 /* Entries */ 1106 1107 dcl ioa_$ioa_switch entry() options(variable); 1108 1109 /* Program */ 1110 1111 character_pos = character_pos + 1; /* skip "s" */ 1112 1113 if substr (input_line, character_pos, 1) ^= QSlash 1114 then call error (apl_error_table_$bad_substitute, input_line, character_pos); 1115 1116 character_pos = character_pos + 1; /* skip slash */ 1117 1118 string_start = character_pos; 1119 1120 /* find first terminating slash */ 1121 1122 idx = index (substr (input_line, character_pos), QSlash); 1123 1124 if idx = 0 1125 then do; 1126 character_pos = input_line_length + 1; 1127 call error (apl_error_table_$missing_slash, input_line, character_pos); 1128 end; 1129 1130 character_pos = character_pos + idx - 1; 1131 1132 string1 = substr (input_line, string_start, character_pos - string_start); 1133 1134 /* If string1 is empty use previous string */ 1135 1136 if string1 = "" 1137 then string1 = saved_search_string; 1138 else saved_search_string = string1; 1139 1140 character_pos = character_pos + 1; /* skip past slash */ 1141 1142 string_start = character_pos; 1143 1144 idx = index (substr (input_line, character_pos), QSlash); 1145 1146 if idx = 0 1147 then do; 1148 character_pos = input_line_length + 1; 1149 call error (apl_error_table_$missing_slash, input_line, character_pos); 1150 end; 1151 1152 character_pos = character_pos + idx - 1; 1153 1154 string2 = substr (input_line, string_start, character_pos - string_start); 1155 1156 character_pos = character_pos + 1; /* skip over "/" */ 1157 1158 /* Check for verification request */ 1159 1160 if length (input_line) >= character_pos 1161 then do; 1162 1163 char = substr (input_line, character_pos, 1); 1164 1165 if char = QQuestion 1166 then verify_substitute = "1"b; 1167 1168 if char = QLetterP 1169 then show_substitute = "1"b; 1170 1171 character_pos = character_pos + 1; 1172 1173 end; 1174 1175 /* look up line info index */ 1176 1177 call get_line_info_idx (current_line_number, line_idx, function_info, code); 1178 1179 if code ^= 0 1180 then do; 1181 call ioa_$ioa_switch (apl_static_$apl_output, "substitute fails - line is empty"); 1182 call error (0, "", 0); 1183 end; 1184 1185 old_start = function_info.line_info(line_idx).line_start; 1186 old_length = function_info.line_info(line_idx).line_length; 1187 1188 idx = index (substr (edit_buffer, old_start, old_length), string1); 1189 1190 if idx = 0 /* no string1 */ 1191 then do; 1192 call ioa_$ioa_switch (apl_static_$apl_output, "substitute fails - no match in line"); 1193 call error (0, "", 0); 1194 end; 1195 1196 /* Build new line in edit_buffer. This should really be done 1197* by some managing routine. */ 1198 1199 first_free_char = function_info.first_unused_char_in_buffer; 1200 1201 /* first add part of line before string1 */ 1202 1203 substr (edit_buffer, first_free_char, idx - 1) = substr (edit_buffer, old_start, idx - 1); 1204 1205 first_free_char = first_free_char + idx - 1; 1206 1207 /* now splice in string2 */ 1208 1209 substr (edit_buffer, first_free_char, length (string2)) = string2; 1210 1211 first_free_char = first_free_char + length (string2); 1212 1213 /* now add end of old line */ 1214 1215 old_tail_length = old_length - (idx + length (string1)) + 1; 1216 1217 substr (edit_buffer, first_free_char, old_tail_length) = substr (edit_buffer, old_start + (idx + length (string1)) - 1, old_tail_length); 1218 1219 first_free_char = first_free_char + old_tail_length; 1220 1221 if verify_substitute 1222 then do; 1223 1224 prompt_string = line_number_to_string (function_info.line_info(line_idx).line_number); 1225 1226 call ioa_$ioa_switch (apl_static_$apl_output, "^va^a", length (prompt_string), prompt_string, substr (edit_buffer, function_info.first_unused_char_in_buffer, first_free_char - function_info.first_unused_char_in_buffer)); 1227 1228 ask_if_substitute_is_ok: 1229 call ioa_$ioa_switch (apl_static_$apl_output, "ok? "); 1230 1231 call read_line (answer_buffer, answer_length); 1232 answer_length = answer_length - 1; /* drop NL */ 1233 1234 if substr (answer_buffer, 1, answer_length) = "no" 1235 then return; 1236 else if substr (answer_buffer, 1, answer_length) ^= "yes" 1237 then do; 1238 call ioa_$ioa_switch (apl_static_$apl_output, "please answer yes or no"); 1239 goto ask_if_substitute_is_ok; 1240 end; 1241 end; 1242 1243 /* At this point we know that the substitution has passed 1244* verification (if any) and should actually be done. This is 1245* accomplished by changing the function_info entry for the line 1246* to point at the newly constructed line. */ 1247 1248 function_info.line_info(line_idx).line_start = function_info.first_unused_char_in_buffer; 1249 function_info.line_info(line_idx).line_length = first_free_char - function_info.first_unused_char_in_buffer; 1250 function_info.first_unused_char_in_buffer = first_free_char; 1251 1252 if show_substitute 1253 then call print_function_lines (function_info.line_info(line_idx).line_number, 1, function_info); 1254 1255 return; 1256 1257 end; /* context_substitute */ 1258 1259 context_global_print: 1260 procedure (input_line, character_pos, function_info, saved_search_string); 1261 1262 dcl input_line char(*) parameter; 1263 dcl character_pos fixed bin parameter; 25 1 /* Begin include file apl_fuction_info.incl.pl1 */ 25 2 25 3 dcl 1 function_info, 25 4 2 edit_buffer_ptr pointer, 25 5 2 first_unused_char_in_buffer fixed bin, 25 6 2 name char(256) varying, 25 7 2 symbol_ptr ptr unaligned, 25 8 2 locked_function bit(1), 25 9 2 suspended_function bit(1), 25 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 25 11 2 saved_stop_vector ptr, 25 12 2 saved_trace_vector ptr, 25 13 2 number_of_lines fixed bin, 25 14 2 args(0:3) char(256) varying, 25 15 2 line_info(1:500), 25 16 3 line_number fixed decimal(10,5), 25 17 3 line_start fixed bin, 25 18 3 line_length fixed bin; 25 19 25 20 /* End include file apl_function_info.incl.pl1 */ 1264 1265 dcl saved_search_string char(128) varying parameter; 1266 1267 dcl string_start fixed bin; 1268 dcl idx fixed bin; 1269 dcl string char(128) varying; 1270 dcl first_idx fixed bin; 1271 dcl line_idx fixed bin; 1272 dcl line_start fixed bin; 1273 dcl line_length fixed bin; 1274 1275 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 1276 1277 dcl apl_error_table_$bad_global_print external fixed bin(35); 1278 dcl apl_error_table_$missing_slash external fixed bin(35); 1279 dcl sys_info$max_seg_size external fixed bin(35); 1280 1281 1282 character_pos = character_pos + 1; /* skip "g" */ 1283 1284 if substr (input_line, character_pos, 1) ^= QSlash 1285 then call error (apl_error_table_$bad_global_print, input_line, character_pos); 1286 1287 character_pos = character_pos + 1; /* skip slash */ 1288 1289 string_start = character_pos; 1290 1291 /* find first terminating slash */ 1292 1293 idx = index (substr (input_line, character_pos), QSlash); 1294 1295 if idx = 0 1296 then do; 1297 character_pos = input_line_length + 1; 1298 call error (apl_error_table_$missing_slash, input_line, character_pos); 1299 end; 1300 1301 character_pos = character_pos + idx - 1; 1302 1303 string = substr (input_line, string_start, character_pos - string_start); 1304 1305 /* If string is empty use previous string */ 1306 1307 if string = "" 1308 then string = saved_search_string; 1309 else saved_search_string = string; 1310 1311 character_pos = character_pos + 1; /* skip past slash */ 1312 1313 first_idx = lbound (function_info.line_info, 1); 1314 1315 do line_idx = first_idx to function_info.number_of_lines; 1316 1317 line_start = function_info.line_info(line_idx).line_start; 1318 line_length = function_info.line_info(line_idx).line_length; 1319 1320 idx = index (substr (edit_buffer, line_start, line_length), string); 1321 1322 if idx ^= 0 1323 then call print_function_lines (function_info.line_info(line_idx).line_number, 1, function_info); 1324 end; 1325 1326 return; 1327 1328 end; /* context_global_print */ 1329 1330 end; /* context_editor */ 1331 1332 process_new_function_line: 1333 procedure (initial_input_line, character_pos, current_line_number, function_info); 1334 1335 dcl initial_input_line char(*) parameter; 1336 dcl character_pos fixed bin parameter; 1337 dcl current_line_number fixed decimal(10, 5) parameter; 26 1 /* Begin include file apl_fuction_info.incl.pl1 */ 26 2 26 3 dcl 1 function_info, 26 4 2 edit_buffer_ptr pointer, 26 5 2 first_unused_char_in_buffer fixed bin, 26 6 2 name char(256) varying, 26 7 2 symbol_ptr ptr unaligned, 26 8 2 locked_function bit(1), 26 9 2 suspended_function bit(1), 26 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 26 11 2 saved_stop_vector ptr, 26 12 2 saved_trace_vector ptr, 26 13 2 number_of_lines fixed bin, 26 14 2 args(0:3) char(256) varying, 26 15 2 line_info(1:500), 26 16 3 line_number fixed decimal(10,5), 26 17 3 line_start fixed bin, 26 18 3 line_length fixed bin; 26 19 26 20 /* End include file apl_function_info.incl.pl1 */ 1338 1339 1340 /* Automatic */ 1341 1342 dcl input_buffer char(256); 1343 dcl input_line_length fixed bin(21); 1344 dcl (line_pos, del_pos) fixed bin; 1345 dcl (in_quotes, was_in_quotes, got_line, replacing_old_line) bit(1); 1346 dcl (count, line_info_idx) fixed bin; 1347 1348 /* Based */ 1349 1350 dcl input_line char(input_line_length) based (addr (input_buffer)); 1351 dcl edit_buffer char(sys_info$max_seg_size * 4) based (function_info.edit_buffer_ptr); 1352 1353 /* External */ 1354 1355 dcl sys_info$max_seg_size external fixed bin; 1356 dcl apl_error_table_$mismatched_editor_quotes external fixed bin(35); 1357 1358 dcl (length, substr, ltrim) builtin; 1359 1360 /* Program */ 1361 1362 call get_line_info_idx (current_line_number, line_info_idx, function_info, code); 1363 1364 if code = 0 1365 then replacing_old_line = "1"b; 1366 else do; 1367 replacing_old_line = "0"b; 1368 1369 /* There is no existing line for current_line_number, but 1370* line_info_idx points to where it should be. If that 1371* place is in the middle of existing lines, lines have to 1372* be moved to make room */ 1373 1374 if line_info_idx <= function_info.number_of_lines 1375 then do count = function_info.number_of_lines to line_info_idx by -1; 1376 function_info.line_info(count + 1) = function_info.line_info(count); 1377 end; 1378 1379 /* no else clause, line_info_idx is after the last existing 1380* line, so we can just add the line (note that all of this 1381* code assumes that we never get more lines than the 1382* line_info array is long. this should be fixed.) */ 1383 1384 end; /* else do */ 1385 1386 input_buffer = substr (initial_input_line, character_pos); 1387 input_line_length = length (substr (initial_input_line, character_pos)); 1388 1389 in_quotes = "0"b; 1390 was_in_quotes = "0"b; 1391 got_line = "0"b; 1392 1393 do while (^got_line); 1394 1395 del_pos = 0; 1396 do line_pos = 1 to length (input_line) - 1; 1397 1398 character = substr (input_line, line_pos, 1); 1399 1400 if character = QApostrophe 1401 then in_quotes = ^in_quotes; 1402 1403 if character = QDel | character = QDelTilde 1404 then del_pos = line_pos; 1405 end; 1406 1407 if ^was_in_quotes 1408 then function_info.line_info(line_info_idx).line_start = function_info.first_unused_char_in_buffer; 1409 1410 if del_pos ^= 0 1411 then do; 1412 1413 if in_quotes 1414 then call error (apl_error_table_$mismatched_editor_quotes, input_line, line_pos); 1415 1416 substr (edit_buffer, function_info.first_unused_char_in_buffer, del_pos) = 1417 substr (input_line, 1, del_pos - 1) || QNewLine; 1418 1419 function_info.first_unused_char_in_buffer = function_info.first_unused_char_in_buffer + del_pos; 1420 1421 got_line = "1"b; 1422 1423 character_pos = character_pos + del_pos - 1; 1424 end; 1425 else do; 1426 1427 if in_quotes 1428 then was_in_quotes = "1"b; 1429 else do; 1430 got_line = "1"b; 1431 character_pos = length (initial_input_line) + 1; 1432 end; 1433 1434 substr (edit_buffer, function_info.first_unused_char_in_buffer, length (input_line)) = ltrim (input_line); 1435 1436 function_info.first_unused_char_in_buffer = function_info.first_unused_char_in_buffer + length (ltrim (input_line)); 1437 1438 if ^got_line 1439 then call read_line (input_buffer, input_line_length); 1440 end; 1441 end; 1442 1443 function_info.line_info(line_info_idx).line_number = current_line_number; 1444 function_info.line_info(line_info_idx).line_length = function_info.first_unused_char_in_buffer - 1445 function_info.line_info(line_info_idx).line_start; 1446 1447 if ^replacing_old_line 1448 then function_info.number_of_lines = function_info.number_of_lines + 1; 1449 1450 return; 1451 end; /* process_new_function_line */ 1452 1453 parse_header_line: 1454 procedure (line_to_parse, character_pos, header_start, header_length, complicated_header, function_info); 1455 1456 dcl line_to_parse char(*) parameter; /* contains header line and maybe other stuff */ 1457 dcl character_pos fixed bin parameter; /* where we are in line */ 1458 dcl (header_start, header_length) fixed bin parameter;/* return info about actual header line */ 1459 dcl complicated_header bit(1) parameter; /* return: true if args or return var found */ 27 1 /* Begin include file apl_fuction_info.incl.pl1 */ 27 2 27 3 dcl 1 function_info, 27 4 2 edit_buffer_ptr pointer, 27 5 2 first_unused_char_in_buffer fixed bin, 27 6 2 name char(256) varying, 27 7 2 symbol_ptr ptr unaligned, 27 8 2 locked_function bit(1), 27 9 2 suspended_function bit(1), 27 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 27 11 2 saved_stop_vector ptr, 27 12 2 saved_trace_vector ptr, 27 13 2 number_of_lines fixed bin, 27 14 2 args(0:3) char(256) varying, 27 15 2 line_info(1:500), 27 16 3 line_number fixed decimal(10,5), 27 17 3 line_start fixed bin, 27 18 3 line_length fixed bin; 27 19 27 20 /* End include file apl_function_info.incl.pl1 */ 1460 1461 1462 /* Automatic */ 1463 1464 dcl (token_start, token_length) fixed bin; 1465 dcl (done, last_token_was_semicolon, ran_out_of_tokens, bad_header) bit(1); 1466 dcl code2 fixed bin(35); 1467 1468 /* Based */ 1469 1470 dcl character_array_kludge(length (line_to_parse)) char(1) based (addr (line_to_parse)); 1471 dcl token char(token_length) based (addr (character_array_kludge(token_start))); 1472 1473 /* Program */ 1474 1475 header_start = character_pos; 1476 1477 call parse_function_name_and_args (line_to_parse, character_pos, header_start, function_info.name, function_info.args(0), function_info.args(1), function_info.args(2), complicated_header, ran_out_of_tokens, bad_header); 1478 1479 if bad_header 1480 then call apl_editor_cleanup (function_info); 1481 1482 header_length = character_pos - header_start; 1483 1484 if ran_out_of_tokens 1485 then return; 1486 1487 /* Now process local variables */ 1488 1489 done = "0"b; 1490 do while (^done); 1491 1492 call get_header_token (line_to_parse, character_pos, token_start, token_length, code2); /* "token" depends on vals of token_(start length) */ 1493 1494 if code2 ^= 0 1495 then done = "1"b; 1496 1497 else if token = QLamp 1498 then do; 1499 character_pos = length (line_to_parse) + 1; 1500 done = "1"b; 1501 end; 1502 1503 else if token = QSemiColon 1504 then last_token_was_semicolon = "1"b; 1505 1506 else do; /* could be var or non-header stuff */ 1507 1508 if ^last_token_was_semicolon 1509 then do; 1510 character_pos = token_start; 1511 done = "1"b; 1512 end; 1513 1514 else do; /* we did see semi, this could be var name */ 1515 1516 call validate_identifier (token, code2); 1517 1518 if code2 ^= 0 1519 then do; 1520 character_pos = token_start; /* back up over token */ 1521 done = "1"b; 1522 end; 1523 1524 end; 1525 1526 last_token_was_semicolon = "0"b; 1527 1528 end; /* else do */ 1529 end; /* do while (^done)... */ 1530 1531 header_length = character_pos - header_start; 1532 return; 1533 1534 1535 end; /* parse_header_line */ 1536 1537 parse_function_name_and_args: 1538 procedure (line_to_parse, character_pos, header_start, function_name, right_arg, left_arg, return_arg, complicated_header, ran_out_of_tokens, bad_header); 1539 1540 dcl line_to_parse char(*) parameter; 1541 dcl character_pos fixed bin parameter; 1542 dcl header_start fixed bin parameter; 1543 dcl (function_name, right_arg, left_arg, return_arg) char(*) varying parameter; 1544 dcl (complicated_header, ran_out_of_tokens, bad_header) bit(1) parameter; 1545 1546 /* Automatic */ 1547 1548 dcl (id_number, phony_number_of_ids, last_identifier) fixed bin; 1549 dcl (found_left_arrow, done) bit(1); 1550 dcl old_character_pos fixed bin; 1551 dcl (token_start, token_length) fixed bin; 1552 dcl code fixed bin(35); 1553 1554 dcl 1 identifiers(4), 1555 2 name char(256) varying init ((4)(1)""), 1556 2 position fixed bin; 1557 1558 /* Based */ 1559 1560 dcl character_array_kludge(length (line_to_parse)) char(1) based (addr (line_to_parse)); 1561 dcl token char(token_length) based (addr (character_array_kludge(token_start))); 1562 1563 /* External */ 1564 1565 dcl (apl_error_table_$misplaced_left_arrow, 1566 apl_error_table_$missing_function_name) 1567 external fixed bin(35); 1568 1569 /* Program */ 1570 1571 function_name, right_arg, left_arg, return_arg = ""; 1572 complicated_header, ran_out_of_tokens, bad_header = "0"b; 1573 1574 done, found_left_arrow = "0"b; 1575 do id_number = 1 to 4 while (^ran_out_of_tokens & ^done); 1576 1577 old_character_pos = character_pos; 1578 1579 call get_header_token (line_to_parse, character_pos, token_start, token_length, code); 1580 if code ^= 0 /* no more tokens */ 1581 then ran_out_of_tokens = "1"b; 1582 else if token = QLamp 1583 then do; 1584 character_pos = length (line_to_parse) + 1; 1585 ran_out_of_tokens = "1"b; 1586 end; 1587 else do; 1588 if token = QLeftArrow 1589 then do; 1590 1591 /* Found a left arrow. First token must have 1592* been the return var. */ 1593 1594 if id_number ^= 2 1595 then do; 1596 call report_error (apl_error_table_$misplaced_left_arrow, line_to_parse, token_start); 1597 bad_header = "1"b; 1598 return; 1599 end; 1600 1601 call get_header_token (line_to_parse, character_pos, token_start, token_length, code); 1602 if code ^= 0 1603 then do; 1604 call report_error (apl_error_table_$missing_function_name, line_to_parse, character_pos); 1605 bad_header = "1"b; 1606 return; 1607 end; 1608 1609 found_left_arrow = "1"b; 1610 1611 end; /* if token = QLeftArrow */ 1612 1613 call validate_identifier (token, code); 1614 if code = 0 1615 then do; 1616 identifiers(id_number).name = token; 1617 identifiers(id_number).position = token_start; 1618 end; 1619 else do; 1620 character_pos = old_character_pos; 1621 done = "1"b; 1622 end; 1623 1624 end; /* else do; if token = QLeftArrow... */ 1625 1626 end; /* do id_number... */ 1627 1628 if identifiers(1).name = "" 1629 then do; 1630 call report_error (apl_error_table_$missing_function_name, line_to_parse, token_start); 1631 bad_header = "1"b; 1632 return; 1633 end; 1634 1635 header_start = identifiers(1).position; 1636 1637 if ran_out_of_tokens | done 1638 then last_identifier = id_number - 2; 1639 else last_identifier = id_number - 1; 1640 1641 if found_left_arrow 1642 then do; 1643 1644 /* First identifier was the return var. */ 1645 1646 return_arg = identifiers(1).name; 1647 complicated_header = "1"b; 1648 phony_number_of_ids = last_identifier - 1; /* subtract one for the return var */ 1649 end; 1650 else phony_number_of_ids = last_identifier; 1651 1652 /* Step through and figure out which identifiers are which header 1653* components. */ 1654 1655 if phony_number_of_ids = 3 /* left_arg function_name right_arg */ 1656 then do; 1657 1658 function_name = identifiers(last_identifier - 1).name; 1659 right_arg = identifiers(last_identifier).name; 1660 left_arg = identifiers(last_identifier - 2).name; 1661 complicated_header = "1"b; 1662 end; 1663 else if phony_number_of_ids = 2 /* function_name right_arg */ 1664 then do; 1665 1666 function_name = identifiers(last_identifier - 1).name; 1667 right_arg = identifiers(last_identifier).name; 1668 complicated_header = "1"b; 1669 end; 1670 else if phony_number_of_ids = 1 /* function_name */ 1671 then function_name = identifiers(last_identifier).name; 1672 1673 return; 1674 end; /* parse_function_name_and_args */ 1675 1676 get_header_token: 1677 procedure (line_to_parse, character_pos, token_start, token_length, code); 1678 1679 dcl line_to_parse char(*) parameter; 1680 dcl character_pos fixed bin parameter; 1681 dcl (token_start, token_length) fixed bin parameter; 1682 dcl code fixed bin(35); 1683 1684 /* Automatic */ 1685 1686 dcl new_pos fixed bin; 1687 1688 /* Static */ 1689 1690 dcl whitespace_string char(2) static options (constant) init (" "); /* SPACE, TAB */ 1691 dcl good_chars_in_identifier char(76) static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"); /* Last ones are QZero_ thru QNine_, QDelta, QQuad, QDelta_ and _ */ 1692 1693 /* Program */ 1694 1695 code = 0; 1696 1697 if character_pos > length (line_to_parse) 1698 then do; 1699 code = -1; 1700 return; 1701 end; 1702 else if substr (line_to_parse, character_pos, 1) = QNewLine 1703 then do; 1704 character_pos = character_pos + 1; 1705 code = -1; 1706 return; 1707 end; 1708 1709 new_pos = verify (substr (line_to_parse, character_pos), whitespace_string); 1710 1711 if new_pos = 0 /* nothing but whitespace */ 1712 then do; 1713 character_pos = character_pos + length (line_to_parse) + 1; 1714 code = -1; 1715 return; 1716 end; 1717 else character_pos = character_pos + new_pos - 1; 1718 1719 token_start = character_pos; 1720 1721 if index (good_chars_in_identifier, substr (line_to_parse, character_pos, 1)) ^= 0 1722 then do; 1723 1724 /* first char looks like identifier. find whole thing */ 1725 1726 new_pos = verify (substr (line_to_parse, character_pos), good_chars_in_identifier); 1727 1728 if new_pos = 0 /* identifier last thing on line */ 1729 then character_pos = length (line_to_parse) + 1; 1730 else character_pos = character_pos + new_pos - 1; 1731 end; 1732 else character_pos = character_pos + 1; /* all other tokens are 1 char */ 1733 1734 token_length = character_pos - token_start; 1735 return; 1736 end; /* get_header_token */ 1737 1738 1739 validate_identifier: 1740 procedure (token, code); 1741 1742 dcl token char(*) parameter; 1743 dcl code fixed bin(35) parameter; 1744 1745 /* Static */ 1746 1747 dcl good_chars_in_identifier char(76) static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_"); /* Last ones are QZero_ thru QNine_, QDelta, QQuad, QDelta_ and _ */ 1748 1749 /* Program */ 1750 1751 code = 0; 1752 1753 if verify (token, good_chars_in_identifier) ^= 0 1754 then code = -1; 1755 1756 return; 1757 end; /* validate_identifier */ 1758 1759 make_new_function: 1760 procedure (function_info, header_line); 1761 28 1 /* Begin include file apl_fuction_info.incl.pl1 */ 28 2 28 3 dcl 1 function_info, 28 4 2 edit_buffer_ptr pointer, 28 5 2 first_unused_char_in_buffer fixed bin, 28 6 2 name char(256) varying, 28 7 2 symbol_ptr ptr unaligned, 28 8 2 locked_function bit(1), 28 9 2 suspended_function bit(1), 28 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 28 11 2 saved_stop_vector ptr, 28 12 2 saved_trace_vector ptr, 28 13 2 number_of_lines fixed bin, 28 14 2 args(0:3) char(256) varying, 28 15 2 line_info(1:500), 28 16 3 line_number fixed decimal(10,5), 28 17 3 line_start fixed bin, 28 18 3 line_length fixed bin; 28 19 28 20 /* End include file apl_function_info.incl.pl1 */ 1762 1763 dcl header_line char(*) parameter; 1764 1765 /* Automatic */ 1766 1767 dcl data_elements fixed bin; 1768 dcl function_bead_ptr pointer unaligned; 1769 1770 /* Entries */ 1771 1772 dcl apl_allocate_words_ entry (fixed bin(24), pointer unaligned); 1773 1774 dcl (length, null, size, string, substr) builtin; 1775 1776 /* Include Files */ 1777 29 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 29 2 29 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 29 4 2 type unaligned, 29 5 3 bead_type unaligned, 29 6 4 operator bit (1), /* ON if operator bead */ 29 7 4 symbol bit (1), /* ON if symbol bead */ 29 8 4 value bit (1), /* ON if value bead */ 29 9 4 function bit (1), /* ON if function bead */ 29 10 4 group bit (1), /* ON if group bead */ 29 11 4 label bit (1), /* ON if label bead */ 29 12 4 shared_variable bit (1), /* ON if shared variable bead */ 29 13 4 lexed_function bit (1), /* ON if lexed function bead */ 29 14 3 data_type unaligned, 29 15 4 list_value bit (1), /* ON if a list value bead */ 29 16 4 character_value bit (1), /* ON if a character value bead */ 29 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 29 18 4 integral_value bit (1), /* ON if an integral value bead */ 29 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 29 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 29 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 29 22 2 size bit (18) unaligned, /* Number of words this bead occupies 29 23* (used by bead storage manager) */ 29 24 2 reference_count fixed binary (29); /* Number of pointers which point 29 25* to this bead (used by bead manager) */ 29 26 29 27 29 28 /* constant strings for initing type field in various beads */ 29 29 29 30 declare ( 29 31 operator_type init("100000000000000000"b), 29 32 symbol_type init("010000000000000000"b), 29 33 value_type init("001000000000000000"b), 29 34 function_type init("000100000000000000"b), 29 35 group_type init("000010000000000000"b), 29 36 label_type init("001001000011000000"b), 29 37 shared_variable_type init("001000100000000000"b), 29 38 lexed_function_type init("000000010000000000"b), 29 39 29 40 list_value_type init("000000001000000000"b), 29 41 character_value_type init("001000000100000000"b), 29 42 numeric_value_type init("001000000010000000"b), 29 43 integral_value_type init("001000000011000000"b), 29 44 zero_or_one_value_type init("001000000011100000"b), 29 45 complex_value_type init("001000000000010000"b), 29 46 29 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 29 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 29 49 ) bit(18) internal static; 29 50 29 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 1778 30 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 30 2 30 3 declare 30 4 1 operator_bead aligned based, 30 5 30 6 2 type unaligned like general_bead.type, 30 7 30 8 2 bits_for_lex unaligned, 30 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 30 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 30 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 30 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 30 13 3 ignores_assignment bit(1), /* assignment has no effect */ 30 14 3 allow_subscripted_assignment 30 15 bit(1), /* system variable that can be subscripted assigned */ 30 16 3 pad bit(12), 30 17 30 18 2 bits_for_parse unaligned, 30 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 30 20* (op1 tells which) */ 30 21 3 quad bit(1), /* this is a quad type */ 30 22 3 system_variable bit(1), /* this is a system variable, not an op */ 30 23 3 dyadic bit(1), /* operator may be dyadic */ 30 24 3 monadic bit(1), /* operator may be monadic */ 30 25 3 function bit(1), /* operator is a user defined function */ 30 26 3 semantics_valid bit(1), /* if semantics has been set */ 30 27 3 has_list bit(1), /* semantics is a list */ 30 28 3 inner_product bit(1), /* op2 is valid */ 30 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 30 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 30 31 3 pad bit(7), 30 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 30 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 30 34 2 type_code fixed bin; /* for parse */ 30 35 30 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 1779 31 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 31 2 31 3 /* This bead is used by apl to store the source code for user-defined functions */ 31 4 31 5 declare 1 function_bead aligned based, 31 6 31 7 2 header aligned like general_bead, 31 8 31 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 31 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 31 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 31 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 31 13 2 text_length fixed bin(21), /* length of function text */ 31 14 2 text aligned char(data_elements refer (function_bead.text_length)); 31 15 /* the user's code exactly as typed in */ 31 16 31 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 1780 32 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 32 2 32 3 /* Explanation of fields: 32 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 32 5* symbol_bead.meaning_pointer points to current "value" of this name: 32 6* = null => unused (e.g. undefined variable) 32 7* -> group bead => group name 32 8* -> value bead => variable with a value 32 9* -> function bead => function name 32 10* -> label bead => localized label value 32 11* -> shared var bead => shared variable */ 32 12 32 13 declare 1 symbol_bead aligned based, 32 14 2 header aligned like general_bead, 32 15 2 hash_link_pointer pointer unaligned, 32 16 2 meaning_pointer pointer unaligned, 32 17 2 name_length fixed binary, 32 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 32 19 32 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 1781 1782 1783 /* Program */ 1784 1785 1786 data_elements = length (header_line); 1787 1788 if substr (header_line, data_elements, 1) ^= QNewLine 1789 then data_elements = data_elements + 1; 1790 1791 call apl_allocate_words_ (size (function_bead), function_bead_ptr); 1792 1793 string (function_bead_ptr -> function_bead.type) = function_type; 1794 1795 function_bead_ptr -> function_bead.lexed_function_bead_pointer = null (); 1796 function_bead_ptr -> function_bead.class = 0; 1797 function_bead_ptr -> function_bead.stop_control_pointer = null (); 1798 function_bead_ptr -> function_bead.trace_control_pointer = null (); 1799 1800 function_bead_ptr -> function_bead.text_length = data_elements; 1801 1802 /* If we reserved room for NL, add one now */ 1803 1804 if data_elements > length (header_line) 1805 then function_bead_ptr -> function_bead.text = header_line || QNewLine; 1806 else function_bead_ptr -> function_bead.text = header_line; 1807 1808 function_info.symbol_ptr -> symbol_bead.meaning_pointer = function_bead_ptr; 1809 return; 1810 1811 end; /* make_new_function */ 1812 1813 assign_line_numbers: 1814 procedure (function_info); 1815 33 1 /* Begin include file apl_fuction_info.incl.pl1 */ 33 2 33 3 dcl 1 function_info, 33 4 2 edit_buffer_ptr pointer, 33 5 2 first_unused_char_in_buffer fixed bin, 33 6 2 name char(256) varying, 33 7 2 symbol_ptr ptr unaligned, 33 8 2 locked_function bit(1), 33 9 2 suspended_function bit(1), 33 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 33 11 2 saved_stop_vector ptr, 33 12 2 saved_trace_vector ptr, 33 13 2 number_of_lines fixed bin, 33 14 2 args(0:3) char(256) varying, 33 15 2 line_info(1:500), 33 16 3 line_number fixed decimal(10,5), 33 17 3 line_start fixed bin, 33 18 3 line_length fixed bin; 33 19 33 20 /* End include file apl_function_info.incl.pl1 */ 1816 1817 1818 /* Automatic */ 1819 1820 dcl function_bead_ptr pointer; 1821 dcl in_quotes bit(1); 1822 dcl (real_line_start, line_start) fixed bin; 1823 dcl (real_line_length, line_length) fixed bin; 1824 dcl line_pos fixed bin; 1825 dcl line_counter fixed bin; 1826 1827 /* Based */ 1828 1829 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 1830 1831 /* External */ 1832 1833 dcl sys_info$max_seg_size external fixed bin; 1834 1835 dcl (apl_error_table_$mismatched_editor_quotes, 1836 apl_error_table_$not_end_with_newline) 1837 external fixed bin(35); 1838 1839 /* Include files */ 1840 34 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 34 2 34 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 34 4 2 type unaligned, 34 5 3 bead_type unaligned, 34 6 4 operator bit (1), /* ON if operator bead */ 34 7 4 symbol bit (1), /* ON if symbol bead */ 34 8 4 value bit (1), /* ON if value bead */ 34 9 4 function bit (1), /* ON if function bead */ 34 10 4 group bit (1), /* ON if group bead */ 34 11 4 label bit (1), /* ON if label bead */ 34 12 4 shared_variable bit (1), /* ON if shared variable bead */ 34 13 4 lexed_function bit (1), /* ON if lexed function bead */ 34 14 3 data_type unaligned, 34 15 4 list_value bit (1), /* ON if a list value bead */ 34 16 4 character_value bit (1), /* ON if a character value bead */ 34 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 34 18 4 integral_value bit (1), /* ON if an integral value bead */ 34 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 34 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 34 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 34 22 2 size bit (18) unaligned, /* Number of words this bead occupies 34 23* (used by bead storage manager) */ 34 24 2 reference_count fixed binary (29); /* Number of pointers which point 34 25* to this bead (used by bead manager) */ 34 26 34 27 34 28 /* constant strings for initing type field in various beads */ 34 29 34 30 declare ( 34 31 operator_type init("100000000000000000"b), 34 32 symbol_type init("010000000000000000"b), 34 33 value_type init("001000000000000000"b), 34 34 function_type init("000100000000000000"b), 34 35 group_type init("000010000000000000"b), 34 36 label_type init("001001000011000000"b), 34 37 shared_variable_type init("001000100000000000"b), 34 38 lexed_function_type init("000000010000000000"b), 34 39 34 40 list_value_type init("000000001000000000"b), 34 41 character_value_type init("001000000100000000"b), 34 42 numeric_value_type init("001000000010000000"b), 34 43 integral_value_type init("001000000011000000"b), 34 44 zero_or_one_value_type init("001000000011100000"b), 34 45 complex_value_type init("001000000000010000"b), 34 46 34 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 34 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 34 49 ) bit(18) internal static; 34 50 34 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 1841 35 1 /* ====== BEGIN INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ================================== */ 35 2 35 3 /* Explanation of fields: 35 4* symbol_bead.hash_link_pointer points to next symbol in same hash bucket in the symbol table. 35 5* symbol_bead.meaning_pointer points to current "value" of this name: 35 6* = null => unused (e.g. undefined variable) 35 7* -> group bead => group name 35 8* -> value bead => variable with a value 35 9* -> function bead => function name 35 10* -> label bead => localized label value 35 11* -> shared var bead => shared variable */ 35 12 35 13 declare 1 symbol_bead aligned based, 35 14 2 header aligned like general_bead, 35 15 2 hash_link_pointer pointer unaligned, 35 16 2 meaning_pointer pointer unaligned, 35 17 2 name_length fixed binary, 35 18 2 name character (0 refer (symbol_bead.name_length)) unaligned; 35 19 35 20 /* ------ END INCLUDE SEGMENT apl_symbol_bead.incl.pl1 ---------------------------------- */ 1842 36 1 /* ====== BEGIN INCLUDE SEGMENT apl_function_bead.incl.pl1 ================================ */ 36 2 36 3 /* This bead is used by apl to store the source code for user-defined functions */ 36 4 36 5 declare 1 function_bead aligned based, 36 6 36 7 2 header aligned like general_bead, 36 8 36 9 2 lexed_function_bead_pointer unaligned pointer, /* null if unlexed or has errors, else -> lexed code */ 36 10 2 class fixed bin, /* 0=normal, 1=locked, 2=external zfn, 3=mfn, 4=dfn */ 36 11 2 stop_control_pointer unaligned ptr, /* points to stop value bead, or null (no stop control) */ 36 12 2 trace_control_pointer unaligned ptr, /* points to trace value bead, or null (no trace control) */ 36 13 2 text_length fixed bin(21), /* length of function text */ 36 14 2 text aligned char(data_elements refer (function_bead.text_length)); 36 15 /* the user's code exactly as typed in */ 36 16 36 17 /* ------ END INCLUDE SEGMENT apl_function_bead.incl.pl1 -------------------------------- */ 1843 1844 1845 /* Program */ 1846 1847 function_bead_ptr = function_info.symbol_ptr -> symbol_bead.meaning_pointer; 1848 in_quotes = "0"b; 1849 real_line_start, line_start = 1; 1850 real_line_length = 0; 1851 function_info.first_unused_char_in_buffer = 1; 1852 1853 do line_counter = 1 by 1 while (real_line_start <= (function_bead_ptr -> function_bead.text_length)); 1854 1855 line_length = index (substr (function_bead_ptr -> function_bead.text, line_start), QNewLine); 1856 if line_length = 0 1857 then do; 1858 call report_error (apl_error_table_$not_end_with_newline, substr (function_bead_ptr -> function_bead.text, line_start), function_bead_ptr -> function_bead.text_length - line_start + 2); 1859 call apl_editor_cleanup (function_info); 1860 end; 1861 1862 do line_pos = line_start to (line_start + line_length - 1); /* skip NL */ 1863 1864 if substr (function_bead_ptr -> function_bead.text, line_pos, 1) = QApostrophe 1865 then in_quotes = ^in_quotes; 1866 else if ^in_quotes 1867 then if substr (function_bead_ptr -> function_bead.text, line_pos, 1) = QLamp 1868 then line_pos = line_start + line_length; /* stop loop */ 1869 end; 1870 1871 real_line_length = real_line_length + line_length; 1872 1873 if in_quotes 1874 then do; 1875 line_start = line_start + line_length; 1876 line_counter = line_counter - 1; 1877 end; 1878 else do; 1879 1880 substr (edit_buffer, function_info.first_unused_char_in_buffer, real_line_length) = 1881 substr (function_bead_ptr -> function_bead.text, real_line_start, real_line_length); 1882 1883 function_info.line_info(line_counter).line_number = line_counter - 1; 1884 function_info.line_info(line_counter).line_start = first_unused_char_in_buffer; 1885 function_info.line_info(line_counter).line_length = real_line_length; 1886 1887 function_info.first_unused_char_in_buffer = function_info.first_unused_char_in_buffer + real_line_length; 1888 line_start, 1889 real_line_start = real_line_start + real_line_length; 1890 real_line_length = 0; 1891 end; 1892 end; /* do line_counter ... */ 1893 1894 if in_quotes 1895 then call error (apl_error_table_$mismatched_editor_quotes, substr (function_bead_ptr -> function_bead.text, line_start), length (substr (function_bead_ptr -> function_bead.text, line_start)) + 1); 1896 1897 function_info.number_of_lines = line_counter - 1; 1898 1899 return; 1900 end; /* assign_line_numbers */ 1901 1902 print_function_lines: 1903 procedure (first_line_number, print_type, function_info); 1904 1905 dcl first_line_number fixed decimal(10, 5) parameter; 1906 dcl print_type fixed bin parameter; /* 1 = one line, 2 = specified line to end */ 37 1 /* Begin include file apl_fuction_info.incl.pl1 */ 37 2 37 3 dcl 1 function_info, 37 4 2 edit_buffer_ptr pointer, 37 5 2 first_unused_char_in_buffer fixed bin, 37 6 2 name char(256) varying, 37 7 2 symbol_ptr ptr unaligned, 37 8 2 locked_function bit(1), 37 9 2 suspended_function bit(1), 37 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 37 11 2 saved_stop_vector ptr, 37 12 2 saved_trace_vector ptr, 37 13 2 number_of_lines fixed bin, 37 14 2 args(0:3) char(256) varying, 37 15 2 line_info(1:500), 37 16 3 line_number fixed decimal(10,5), 37 17 3 line_start fixed bin, 37 18 3 line_length fixed bin; 37 19 37 20 /* End include file apl_function_info.incl.pl1 */ 1907 1908 1909 /* Automatic */ 1910 1911 dcl (first_array_idx, last_array_idx) fixed bin; 1912 dcl count fixed bin; 1913 dcl output_line char(256) varying; 1914 dcl code fixed bin(35); 1915 1916 /* Based */ 1917 1918 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 1919 1920 /* External */ 1921 1922 dcl apl_static_$apl_output external ptr; 1923 dcl sys_info$max_seg_size external fixed bin; 1924 1925 dcl (length, substr, rtrim) builtin; 1926 1927 /* Entries */ 1928 1929 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 1930 1931 /* Program */ 1932 1933 do first_array_idx = lbound (function_info.line_info, 1) to function_info.number_of_lines 1934 while (function_info.line_info(first_array_idx).line_number < first_line_number); 1935 end; 1936 1937 if first_array_idx > function_info.number_of_lines 1938 then return; 1939 1940 if print_type = 1 1941 then if function_info.line_info(first_array_idx).line_number ^= first_line_number 1942 then return; 1943 else last_array_idx = first_array_idx; 1944 1945 if print_type = 2 1946 then last_array_idx = function_info.number_of_lines; 1947 1948 if first_line_number = 0 & print_type ^= 1 1949 then do; 1950 1951 output_line = " "; /* SP SP SP SP QDel SP */ 1952 1953 /* Make sure that there is a line 0 */ 1954 1955 if function_info.line_info(first_array_idx).line_number = 0 1956 then do; 1957 output_line = output_line || substr (edit_buffer, function_info.line_info(1).line_start, function_info.line_info(1).line_length); 1958 first_array_idx = first_array_idx + 1; 1959 end; 1960 else output_line = output_line || QNewLine; 1961 1962 call iox_$put_chars (apl_static_$apl_output, addrel (addr (output_line), 1), length (output_line), code); 1963 end; 1964 1965 do count = first_array_idx to last_array_idx; 1966 1967 if line_has_label (substr (edit_buffer, function_info.line_info(count).line_start, function_info.line_info(count).line_length)) 1968 then output_line = line_number_to_string_with_label (function_info.line_info(count).line_number); 1969 else output_line = line_number_to_string (function_info.line_info(count).line_number); 1970 1971 output_line = output_line || substr (edit_buffer, function_info.line_info(count).line_start, function_info.line_info(count).line_length); 1972 1973 call iox_$put_chars (apl_static_$apl_output, addrel (addr (output_line), 1), length (output_line), code); 1974 end; 1975 1976 if print_type ^= 1 1977 then do; 1978 1979 output_line = " 1980 "; 1981 call iox_$put_chars (apl_static_$apl_output, addrel (addr (output_line), 1), length (output_line), code); 1982 end; 1983 return; 1984 end; /* print_function_lines */ 1985 1986 edit_one_line: 1987 procedure (editor_input_buffer, editor_input_buffer_length, character_pos, left_number, right_number, current_line_number, function_info); 1988 1989 dcl editor_input_buffer char(*) parameter; 1990 dcl editor_input_buffer_length fixed bin(21); 1991 dcl character_pos fixed bin parameter; 1992 dcl (left_number, right_number) fixed decimal(10, 5) parameter; 1993 dcl current_line_number fixed decimal (10, 5) parameter; 38 1 /* Begin include file apl_fuction_info.incl.pl1 */ 38 2 38 3 dcl 1 function_info, 38 4 2 edit_buffer_ptr pointer, 38 5 2 first_unused_char_in_buffer fixed bin, 38 6 2 name char(256) varying, 38 7 2 symbol_ptr ptr unaligned, 38 8 2 locked_function bit(1), 38 9 2 suspended_function bit(1), 38 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 38 11 2 saved_stop_vector ptr, 38 12 2 saved_trace_vector ptr, 38 13 2 number_of_lines fixed bin, 38 14 2 args(0:3) char(256) varying, 38 15 2 line_info(1:500), 38 16 3 line_number fixed decimal(10,5), 38 17 3 line_start fixed bin, 38 18 3 line_length fixed bin; 38 19 38 20 /* End include file apl_function_info.incl.pl1 */ 1994 1995 1996 /* Automatic */ 1997 1998 dcl (count, idx) fixed bin; 1999 dcl (original_line, input_line, output_line) char (256); 2000 dcl (original_line_length, input_line_length, output_line_length) fixed bin(21); 2001 dcl line_info_idx fixed bin; 2002 dcl prompt_string char(14) varying; 2003 dcl integer_part fixed decimal (5); 2004 dcl first_insertion fixed bin; 2005 dcl amount_to_insert fixed bin; 2006 dcl character char(1); 2007 dcl old_mode char(32); 2008 dcl code fixed bin(35); 2009 2010 /* Static */ 2011 2012 dcl NL char(1) static options (constant) init (" 2013 "); 2014 dcl insertion_chars char(36) static options (constant) init ("0123456789abcdefghijklmnopqrstuvwxyz"); 2015 dcl insertion_table(0:36) fixed bin static options (constant) init (-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85, 90, 95, 100, 105, 110, 115, 120, 125, 130); 2016 2017 /* Based */ 2018 2019 dcl edit_buffer char(4 * sys_info$max_seg_size) based (function_info.edit_buffer_ptr); 2020 2021 /* External */ 2022 2023 dcl sys_info$max_seg_size external fixed bin; 2024 dcl apl_static_$apl_output external ptr; 2025 dcl (apl_error_table_$line_too_long_to_edit) 2026 external fixed bin(35); 2027 2028 /* Entries */ 2029 2030 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 2031 dcl continue_to_signal_ entry (fixed bin(35)); 2032 2033 dcl (substr, addr, copy, index, trunc, length) builtin; 2034 2035 /* Include Files */ 2036 39 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 39 2 39 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 39 4 39 5 /* automatic */ 39 6 39 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 39 8 39 9 /* external static */ 39 10 39 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 39 12 2 static_ws_info_ptr unaligned pointer; 39 13 39 14 /* based */ 39 15 39 16 declare 1 ws_info aligned based (ws_info_ptr), 39 17 2 version_number fixed bin, /* version of this structure (3) */ 39 18 2 switches unaligned, /* mainly ws parameters */ 39 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 39 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 39 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 39 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 39 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 39 24 3 restrict_external_functions 39 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 39 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 39 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 39 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 39 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 39 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 39 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 39 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 39 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 39 34 3 compatibility_check_mode 39 35 bit, /* if 1, check for incompatible operators */ 39 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 39 37 /* remaining 20 bits not presently used */ 39 38 39 39 2 values, /* attributes of the workspace */ 39 40 3 digits fixed bin, /* number of digits of precision printed on output */ 39 41 3 width fixed bin, /* line length for formatted output */ 39 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 39 43 3 random_link fixed bin(35), /* seed for random number generator */ 39 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 39 45 3 float_index_origin float, /* the index origin in floating point */ 39 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 39 47 3 maximum_value_stack_size 39 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 39 49 39 50 2 pointers, /* pointers to various internal tables */ 39 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 39 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 39 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 39 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 39 55 39 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 39 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 39 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 39 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 39 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 39 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 39 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 39 63 2 signoff_lock character (32), 39 64 39 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 39 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 39 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 39 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 39 69 bit, /* munging his tables */ 39 70 3 unused_interrupt_bit bit, /* not presently used */ 39 71 3 dont_interrupt_command bit, 39 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 39 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 39 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 39 75 39 76 2 user_name char (32), /* process group id of user */ 39 77 2 immediate_input_prompt char (32) varying, /* normal input */ 39 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 39 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 39 80 2 vcpu_time aligned, 39 81 3 total fixed bin (71), 39 82 3 setup fixed bin (71), 39 83 3 parse fixed bin (71), 39 84 3 lex fixed bin (71), 39 85 3 operator fixed bin (71), 39 86 3 storage_manager fixed bin (71), 39 87 2 output_info aligned, /* data pertaining to output buffer */ 39 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 39 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 39 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 39 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 39 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 39 93 39 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 39 95 39 96 /* internal static */ 39 97 39 98 declare max_parse_stack_depth fixed bin int static init(64536); 39 99 39 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 2037 2038 2039 /* Program */ 2040 2041 current_line_number = left_number; 2042 2043 call get_line_info_idx (left_number, line_info_idx, function_info, code); 2044 2045 if code ^= 0 /* no such line */ 2046 then return; 2047 2048 prompt_string = line_number_to_string (current_line_number); 2049 2050 original_line = prompt_string; 2051 original_line_length = length (prompt_string); 2052 2053 count = function_info.line_info(line_info_idx).line_length; 2054 2055 substr (original_line, original_line_length + 1, count) = substr (edit_buffer, function_info.line_info(line_info_idx).line_start, count); 2056 original_line_length = original_line_length + count; 2057 2058 /* If there are any newlines other than the trailing one, barf */ 2059 2060 idx = index (substr (original_line, 1, original_line_length - 1), NL); 2061 if idx ^= 0 2062 then call error (apl_error_table_$line_too_long_to_edit, substr (original_line, 1, idx), idx); 2063 2064 integer_part = trunc (right_number); 2065 2066 if integer_part ^= right_number /* right is not integer */ 2067 then return; /* should probably error out */ 2068 2069 if integer_part ^= 0 /* 0 is special case, skip all this code */ 2070 then do; 2071 2072 call iox_$put_chars (apl_static_$apl_output, addr (original_line), original_line_length, code); 2073 2074 output_line = ""; 2075 call iox_$put_chars (apl_static_$apl_output, addr (output_line), integer_part - 1, code); 2076 2077 call read_line (input_line, input_line_length); 2078 substr (input_line, input_line_length) = ""; /* flush NL, add spaces */ 2079 2080 output_line_length = 0; 2081 original_line_length = original_line_length - 1; /* flush NL */ 2082 first_insertion = 0; 2083 do count = 1 to original_line_length; 2084 2085 character = substr (input_line, count, 1); 2086 if character ^= QSlash 2087 then do; 2088 amount_to_insert = insertion_table (index (insertion_chars, character)); /* lookup insertion value for char */ 2089 2090 if amount_to_insert > 0 2091 then do; 2092 if first_insertion < 1 2093 then first_insertion = output_line_length + 1; 2094 output_line_length = output_line_length + amount_to_insert; /* insert the spaces */ 2095 end; 2096 2097 substr (output_line, output_line_length + 1, 1) = substr (original_line, count, 1); 2098 output_line_length = output_line_length + 1; 2099 2100 if output_line_length > ws_info.width 2101 then call error (apl_error_table_$line_too_long_to_edit, substr (output_line, 1, ws_info.width - 2), ws_info.width - 1); 2102 end; /* if character ^= QSlash */ 2103 2104 /* There is no else clause, as slash is supposed to delete 2105* a char. If we do nothing, the char will not get copied */ 2106 end; /* do count ... */ 2107 2108 if first_insertion < 1 2109 then first_insertion = output_line_length + 1; 2110 2111 if first_insertion < output_line_length 2112 then do; 2113 substr (output_line, output_line_length + 1, output_line_length - first_insertion + 1) = 2114 copy (QBackSpace, output_line_length - first_insertion + 1); 2115 output_line_length = output_line_length + (output_line_length - first_insertion + 1); 2116 end; 2117 2118 end; /* if integer_part ^= 0 */ 2119 2120 else do; 2121 output_line = original_line; 2122 output_line_length = original_line_length - 1; 2123 end; 2124 2125 old_mode = ""; 2126 2127 on apl_quit_ 2128 begin; 2129 call reset_read_back_output_mode (old_mode); 2130 call continue_to_signal_ (code); 2131 end; 2132 2133 call set_read_back_output_mode (old_mode); 2134 2135 call iox_$put_chars (apl_static_$apl_output, addr (output_line), output_line_length, code); 2136 2137 call read_line (input_line, input_line_length); 2138 2139 call reset_read_back_output_mode (old_mode); 2140 2141 revert apl_quit_; 2142 2143 editor_input_buffer = substr (input_line, 1, input_line_length); 2144 editor_input_buffer_length = input_line_length; 2145 character_pos = 1; 2146 2147 return; /* let main command loop deal with it */ 2148 2149 end; /* edit_one_line */ 2150 2151 increment_line_number: 2152 procedure (line_number) returns (fixed decimal(10, 5)); 2153 2154 dcl line_number fixed decimal(10, 5) parameter; 2155 2156 /* Automatic */ 2157 2158 dcl incremented_line_number fixed decimal(10, 5); 2159 dcl line_number_pic picture "99999v.99999"; 2160 dcl power fixed bin; 2161 2162 dcl (length, rtrim, after, fixed) builtin; 2163 2164 /* Program */ 2165 2166 line_number_pic = current_line_number; 2167 power = length (rtrim (after (line_number_pic, "."), "0")); 2168 incremented_line_number = fixed (line_number + 10 ** (-power), 10, 5); 2169 return (incremented_line_number); 2170 2171 end; /* increment_line_number */ 2172 2173 line_number_to_string: 2174 procedure (line_number) returns (char(14) varying); 2175 2176 dcl line_number fixed decimal(10, 5) parameter; 2177 2178 /* Automatic */ 2179 2180 dcl line_number_pic picture "zzzz9v.99999"; 2181 dcl return_string char(14) varying; 2182 dcl number_of_spaces fixed bin; 2183 2184 dcl (length, ltrim, rtrim, copy) builtin; 2185 2186 /* Program */ 2187 2188 number_of_spaces = 6; 2189 goto lnts_join; 2190 2191 line_number_to_string_with_label: 2192 entry (line_number) returns (char(14) varying); 2193 2194 number_of_spaces = 5; 2195 2196 lnts_join: 2197 line_number_pic = line_number; 2198 2199 return_string = "["; 2200 return_string = return_string || ltrim (line_number_pic); 2201 return_string = rtrim (rtrim (return_string, "0"), "."); 2202 if length (return_string) = 1 2203 then return_string = return_string || "0"; 2204 return_string = return_string || "] "; 2205 2206 if length (return_string) < number_of_spaces 2207 then return_string = return_string || copy (" ", number_of_spaces - length (return_string)); 2208 2209 return (return_string); 2210 end; /* line_number_to_string */ 2211 2212 line_has_label: 2213 procedure (line) returns (bit(1)); 2214 2215 dcl line char(*) parameter; 2216 2217 dcl current_pos fixed bin; 2218 dcl (token_start, token_length) fixed bin; 2219 2220 current_pos = 1; 2221 2222 call get_header_token (line, current_pos, token_start, token_length, code); 2223 if code ^= 0 2224 then return ("0"b); 2225 2226 if substr (line, token_start + token_length, 1) = QColon 2227 then return ("1"b); 2228 else return ("0"b); 2229 2230 end; /* line_has_label */ 2231 2232 prompt: 2233 procedure (current_line_number, function_info); 2234 2235 dcl current_line_number fixed decimal(10, 5) parameter; 40 1 /* Begin include file apl_fuction_info.incl.pl1 */ 40 2 40 3 dcl 1 function_info, 40 4 2 edit_buffer_ptr pointer, 40 5 2 first_unused_char_in_buffer fixed bin, 40 6 2 name char(256) varying, 40 7 2 symbol_ptr ptr unaligned, 40 8 2 locked_function bit(1), 40 9 2 suspended_function bit(1), 40 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 40 11 2 saved_stop_vector ptr, 40 12 2 saved_trace_vector ptr, 40 13 2 number_of_lines fixed bin, 40 14 2 args(0:3) char(256) varying, 40 15 2 line_info(1:500), 40 16 3 line_number fixed decimal(10,5), 40 17 3 line_start fixed bin, 40 18 3 line_length fixed bin; 40 19 40 20 /* End include file apl_function_info.incl.pl1 */ 2236 2237 2238 /* Automatic */ 2239 2240 dcl line_number_pic picture "99999v.99999"; 2241 dcl prompt_string char(14) varying; 2242 2243 /* External */ 2244 2245 dcl apl_static_$apl_output ptr external; 2246 2247 /* Entries */ 2248 2249 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 2250 2251 dcl (length, addr, addrel, rtrim) builtin; 2252 2253 /* Program */ 2254 2255 prompt_string = line_number_to_string (current_line_number); 2256 2257 call iox_$put_chars (apl_static_$apl_output, addrel (addr (prompt_string), 1), length (prompt_string), code); 2258 2259 return; 2260 end; /* prompt */ 2261 2262 read_line: 2263 procedure (input_buffer, input_line_length); 2264 2265 dcl input_buffer char(*) parameter; 2266 dcl input_line_length fixed bin(21) parameter; 2267 2268 /* Automatic */ 2269 2270 dcl got_line bit(1); 2271 dcl have_reattached_user_input bit(1); 2272 dcl code fixed bin(35); 2273 2274 /* External */ 2275 2276 dcl (error_table_$short_record, error_table_$end_of_info) fixed bin(35) external; 2277 dcl apl_error_table_$cant_read_input fixed bin(35) external; 2278 dcl apl_static_$apl_input pointer external; 2279 2280 /* Entries */ 2281 2282 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 2283 dcl apl_system_error_ entry (fixed bin(35)); 2284 2285 /* Program */ 2286 2287 have_reattached_user_input = "0"b; 2288 got_line = "0"b; 2289 2290 do while (^got_line); 2291 2292 call iox_$get_line (apl_static_$apl_input, addr (input_buffer), length (input_buffer), input_line_length, code); 2293 if code = 0 2294 then got_line = "1"b; 2295 else if code = error_table_$short_record 2296 then do; 2297 input_line_length = input_line_length + 1; 2298 substr (input_buffer, input_line_length, 1) = QNewLine; 2299 got_line = "1"b; 2300 end; 2301 else if code = error_table_$end_of_info 2302 then do; 2303 if have_reattached_user_input 2304 then call apl_system_error_ (apl_error_table_$cant_read_input); 2305 2306 call reattach_user_input; 2307 have_reattached_user_input = "1"b; 2308 end; 2309 else call apl_system_error_ (apl_error_table_$cant_read_input); 2310 end; 2311 return; 2312 2313 /* Small procedure to attach user_input back to user_i/o. Handles case where 2314* user_input is presently attached via syn_, and case where user_input is 2315* attached via regular IO module. */ 2316 2317 reattach_user_input: 2318 procedure; 2319 2320 dcl code fixed bin(35); 2321 2322 /* External */ 2323 2324 dcl iox_$user_input pointer external; 2325 dcl error_table_$not_closed fixed bin(35) external; 2326 2327 /* Entries */ 2328 2329 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 2330 dcl iox_$close entry (ptr, fixed bin (35)); 2331 dcl iox_$attach_ptr entry (ptr, char(*), ptr, fixed bin (35)); 2332 2333 /* Program */ 2334 2335 call iox_$detach_iocb (iox_$user_input, code); 2336 if code = error_table_$not_closed 2337 then do; /* means was vfile_ or something */ 2338 call iox_$close (iox_$user_input, code); 2339 call iox_$detach_iocb (iox_$user_input, code); 2340 end; 2341 call iox_$attach_ptr (iox_$user_input, "syn_ user_i/o", null (), code); 2342 2343 end; /* reattach_user_input */ 2344 end; /* read_line */ 2345 2346 set_read_back_output_mode: 2347 procedure (old_mode); 2348 2349 dcl old_mode char(*) parameter; 2350 2351 /* Automatic */ 2352 2353 dcl code fixed bin(35); 2354 2355 /* External */ 2356 2357 dcl apl_static_$apl_input external ptr; 2358 2359 /* Entries */ 2360 2361 dcl ipc_$mask_ev_calls entry (fixed bin(35)); 2362 dcl ipc_$unmask_ev_calls entry (fixed bin(35)); 2363 dcl iox_$control entry (ptr, char(*), ptr, fixed bin (35)); 2364 2365 /* Program */ 2366 2367 call ipc_$mask_ev_calls (code); 2368 2369 call iox_$control (apl_static_$apl_input, "read_back_output", addr (old_mode), code); 2370 if code ^= 0 2371 then call error (code, "", 0); 2372 2373 return; 2374 2375 reset_read_back_output_mode: 2376 entry (old_mode); 2377 2378 /* Check to see if there is anythingg to reset */ 2379 if old_mode = "" 2380 then return; 2381 2382 call iox_$control (apl_static_$apl_input, old_mode, (null ()), code); 2383 2384 call ipc_$unmask_ev_calls (code); 2385 2386 old_mode = ""; 2387 2388 return; 2389 end; /* set_read_back_output_mode */ 2390 2391 decrement_reference_count: 2392 procedure (bead_ptr); 2393 2394 dcl bead_ptr pointer unaligned parameter; 2395 2396 /* Entries */ 2397 2398 dcl apl_free_bead_ entry (pointer unaligned); 2399 2400 /* Include Files */ 2401 41 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 41 2 41 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 41 4 2 type unaligned, 41 5 3 bead_type unaligned, 41 6 4 operator bit (1), /* ON if operator bead */ 41 7 4 symbol bit (1), /* ON if symbol bead */ 41 8 4 value bit (1), /* ON if value bead */ 41 9 4 function bit (1), /* ON if function bead */ 41 10 4 group bit (1), /* ON if group bead */ 41 11 4 label bit (1), /* ON if label bead */ 41 12 4 shared_variable bit (1), /* ON if shared variable bead */ 41 13 4 lexed_function bit (1), /* ON if lexed function bead */ 41 14 3 data_type unaligned, 41 15 4 list_value bit (1), /* ON if a list value bead */ 41 16 4 character_value bit (1), /* ON if a character value bead */ 41 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 41 18 4 integral_value bit (1), /* ON if an integral value bead */ 41 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 41 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 41 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 41 22 2 size bit (18) unaligned, /* Number of words this bead occupies 41 23* (used by bead storage manager) */ 41 24 2 reference_count fixed binary (29); /* Number of pointers which point 41 25* to this bead (used by bead manager) */ 41 26 41 27 41 28 /* constant strings for initing type field in various beads */ 41 29 41 30 declare ( 41 31 operator_type init("100000000000000000"b), 41 32 symbol_type init("010000000000000000"b), 41 33 value_type init("001000000000000000"b), 41 34 function_type init("000100000000000000"b), 41 35 group_type init("000010000000000000"b), 41 36 label_type init("001001000011000000"b), 41 37 shared_variable_type init("001000100000000000"b), 41 38 lexed_function_type init("000000010000000000"b), 41 39 41 40 list_value_type init("000000001000000000"b), 41 41 character_value_type init("001000000100000000"b), 41 42 numeric_value_type init("001000000010000000"b), 41 43 integral_value_type init("001000000011000000"b), 41 44 zero_or_one_value_type init("001000000011100000"b), 41 45 complex_value_type init("001000000000010000"b), 41 46 41 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 41 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 41 49 ) bit(18) internal static; 41 50 41 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 2402 2403 2404 /* Program */ 2405 2406 if bead_ptr = null() 2407 then return; 2408 2409 bead_ptr -> general_bead.reference_count = bead_ptr -> general_bead.reference_count - 1; 2410 2411 if bead_ptr -> general_bead.reference_count < 1 2412 then do; 2413 2414 call apl_free_bead_ (bead_ptr); 2415 bead_ptr = null(); 2416 end; 2417 return; 2418 end; /* decrement_reference_count */ 2419 2420 get_line_info_idx: 2421 procedure (line_number, line_info_idx, function_info, code); 2422 2423 dcl line_number fixed decimal(10, 5) parameter; 2424 dcl line_info_idx fixed bin parameter; 42 1 /* Begin include file apl_fuction_info.incl.pl1 */ 42 2 42 3 dcl 1 function_info, 42 4 2 edit_buffer_ptr pointer, 42 5 2 first_unused_char_in_buffer fixed bin, 42 6 2 name char(256) varying, 42 7 2 symbol_ptr ptr unaligned, 42 8 2 locked_function bit(1), 42 9 2 suspended_function bit(1), 42 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 42 11 2 saved_stop_vector ptr, 42 12 2 saved_trace_vector ptr, 42 13 2 number_of_lines fixed bin, 42 14 2 args(0:3) char(256) varying, 42 15 2 line_info(1:500), 42 16 3 line_number fixed decimal(10,5), 42 17 3 line_start fixed bin, 42 18 3 line_length fixed bin; 42 19 42 20 /* End include file apl_function_info.incl.pl1 */ 2425 2426 dcl code fixed bin(35) parameter; 2427 2428 /* Program */ 2429 2430 code = 0; 2431 2432 do line_info_idx = 1 to function_info.number_of_lines 2433 while (function_info.line_info(line_info_idx).line_number < line_number); 2434 end; 2435 2436 if line_info_idx > function_info.number_of_lines 2437 then do; 2438 code = -1; 2439 return; 2440 end; 2441 2442 if function_info.line_info(line_info_idx).line_number ^= line_number 2443 then code = -1; 2444 2445 return; 2446 end; /* get_line_info_idx */ 2447 2448 error: 2449 procedure (code, source, position); 2450 2451 dcl code fixed bin(35) parameter; 2452 dcl source char(*) parameter; 2453 dcl position fixed bin parameter; 2454 2455 /* Automatic */ 2456 2457 dcl fatal bit(1); 2458 2459 /* Entries */ 2460 2461 dcl apl_error_ entry (fixed bin(35), bit(36) aligned, fixed bin, char(*), ptr unaligned, fixed bin); 2462 2463 /* Program */ 2464 2465 fatal = "1"b; 2466 go to error_join; 2467 2468 report_error: 2469 entry (code, source, position); 2470 2471 fatal = "0"b; 2472 2473 error_join: 2474 if code ^= 0 2475 then call apl_error_ (code, "0"b, position, source, null (), 0); 2476 2477 if fatal 2478 then goto internal_error_restart; 2479 else return; 2480 2481 end; /* error, report_error */ 2482 2483 apl_editor_cleanup: 2484 procedure (function_info); 2485 43 1 /* Begin include file apl_fuction_info.incl.pl1 */ 43 2 43 3 dcl 1 function_info, 43 4 2 edit_buffer_ptr pointer, 43 5 2 first_unused_char_in_buffer fixed bin, 43 6 2 name char(256) varying, 43 7 2 symbol_ptr ptr unaligned, 43 8 2 locked_function bit(1), 43 9 2 suspended_function bit(1), 43 10 2 pad bit(34), /* to avoid PL/I padded reference bug */ 43 11 2 saved_stop_vector ptr, 43 12 2 saved_trace_vector ptr, 43 13 2 number_of_lines fixed bin, 43 14 2 args(0:3) char(256) varying, 43 15 2 line_info(1:500), 43 16 3 line_number fixed decimal(10,5), 43 17 3 line_start fixed bin, 43 18 3 line_length fixed bin; 43 19 43 20 /* End include file apl_function_info.incl.pl1 */ 2486 2487 2488 /* Entries */ 2489 2490 dcl apl_segment_manager_$free entry (ptr); 2491 dcl apl_destroy_save_frame_update_ entry (); 2492 2493 /* Program */ 2494 2495 call apl_segment_manager_$free (function_info.edit_buffer_ptr); 2496 2497 call apl_destroy_save_frame_update_; 2498 2499 goto apl_editor_return_point; 2500 2501 end; /* apl_editor_cleanup */ 2502 2503 end; /* apl_editor_ */ SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1346.3 apl_editor_.pl1 >special_ldd>on>apl.1129>apl_editor_.pl1 75 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 76 2 03/27/82 0438.6 apl_characters.incl.pl1 >ldd>include>apl_characters.incl.pl1 78 3 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 200 4 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 225 5 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 226 6 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 227 7 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 228 8 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 229 9 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 230 10 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 231 11 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.incl.pl1 313 12 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 359 13 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 360 14 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 361 15 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 362 16 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 363 17 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 364 18 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 365 19 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.incl.pl1 598 20 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 899 21 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 921 22 03/27/82 0438.6 apl_characters.incl.pl1 >ldd>include>apl_characters.incl.pl1 964 23 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1076 24 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1264 25 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1338 26 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1460 27 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1762 28 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1778 29 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 1779 30 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 1780 31 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 1781 32 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 1816 33 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1841 34 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 1842 35 03/27/82 0439.2 apl_symbol_bead.incl.pl1 >ldd>include>apl_symbol_bead.incl.pl1 1843 36 03/27/82 0438.7 apl_function_bead.incl.pl1 >ldd>include>apl_function_bead.incl.pl1 1907 37 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 1994 38 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 2037 39 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 2236 40 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 2402 41 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 2425 42 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.incl.pl1 2486 43 03/27/82 0439.2 apl_function_info.incl.pl1 >ldd>include>apl_function_info.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. Bad_Token constant fixed bin(17,0) initial dcl 648 ref 711 880 Delta_Token constant fixed bin(17,0) initial dcl 648 ref 661 666 671 676 681 686 691 696 873 Done constant fixed bin(17,0) initial dcl 629 ref 667 672 677 682 687 697 Empty_Brackets constant fixed bin(17,0) initial dcl 629 ref 662 LB constant fixed bin(17,0) initial dcl 629 ref 659 660 661 662 702 LB_Delta constant fixed bin(17,0) initial dcl 629 ref 661 689 690 691 692 LB_Delta_N constant fixed bin(17,0) initial dcl 629 ref 689 694 695 696 697 LB_N constant fixed bin(17,0) initial dcl 629 ref 659 664 665 666 667 LB_N_Quad constant fixed bin(17,0) initial dcl 629 ref 665 669 670 671 672 LB_N_Quad_N constant fixed bin(17,0) initial dcl 629 ref 669 674 675 676 677 LB_Quad constant fixed bin(17,0) initial dcl 629 ref 660 679 680 681 682 LB_Quad_N constant fixed bin(17,0) initial dcl 629 ref 679 684 685 686 687 NL constant char(1) initial unaligned dcl 2012 ref 2060 Not_N constant fixed bin(17,0) initial dcl 629 ref 690 691 692 Not_N_or_RB constant fixed bin(17,0) initial dcl 629 ref 670 671 680 681 Not_Quad_or_RB constant fixed bin(17,0) initial dcl 629 ref 664 666 Not_RB constant fixed bin(17,0) initial dcl 629 ref 674 675 676 684 685 686 694 695 696 Number_Token constant fixed bin(17,0) initial dcl 648 ref 659 664 669 674 679 684 689 694 866 P_new_lfbp parameter pointer unaligned dcl 531 ref 526 551 P_old_lfbp parameter pointer unaligned dcl 531 ref 526 550 QApostrophe constant char(1) initial unaligned dcl 2-11 ref 1400 1864 QBackSpace constant char(1) initial unaligned dcl 2-11 ref 2113 QColon 014302 constant char(1) initial unaligned dcl 2-11 ref 2226 QDel constant char(1) initial unaligned dcl 2-11 ref 145 1403 QDelTilde constant char(1) initial unaligned dcl 2-11 ref 145 151 1403 QDelta constant char(1) initial unaligned dcl 2-11 ref 873 QLamp 014300 constant char(1) initial unaligned dcl 2-11 ref 1497 1582 1866 QLeftArrow 014277 constant char(1) initial unaligned dcl 2-11 ref 1588 QLeftBracket constant char(1) initial unaligned dcl 2-11 ref 172 QLessThan constant char(1) initial unaligned dcl 22-11 ref 933 QLetterG constant char(1) initial unaligned dcl 22-11 ref 946 QLetterP constant char(1) initial unaligned dcl 22-11 ref 1168 QLetterS constant char(1) initial unaligned dcl 22-11 ref 943 QNewLine 014303 constant char(1) initial unaligned dcl 2-11 ref 1416 1702 1788 1804 1855 1960 2298 QPeriod constant char(1) initial unaligned dcl 2-11 ref 180 QQuad constant char(1) initial unaligned dcl 2-11 ref 870 QQuestion constant char(1) initial unaligned dcl 22-11 ref 1165 QRightBracket constant char(1) initial unaligned dcl 2-11 ref 876 QRightParen constant char(1) initial unaligned dcl 2-11 ref 175 QSemiColon 014301 constant char(1) initial unaligned dcl 2-11 ref 1503 QSlash 014276 constant char(1) initial unaligned dcl 22-11 in procedure "context_editor" ref 930 938 1000 1113 1122 1144 1284 1293 QSlash 014276 constant char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" ref 2086 Quad_Token constant fixed bin(17,0) initial dcl 648 ref 660 665 670 675 680 685 690 695 870 RB_Token constant fixed bin(17,0) initial dcl 648 ref 662 667 672 677 682 687 692 697 876 addr builtin function dcl 2033 in procedure "edit_one_line" ref 2072 2072 2075 2075 2135 2135 addr builtin function dcl 2251 in procedure "prompt" ref 2257 2257 addrel builtin function dcl 348 in procedure "close_function" ref 390 addrel builtin function dcl 2251 in procedure "prompt" ref 2257 2257 after builtin function dcl 2162 ref 2167 amount_to_insert 000417 automatic fixed bin(17,0) dcl 2005 set ref 2088* 2090 2094 answer_buffer 006264 automatic char(5) unaligned dcl 1090 set ref 1231* 1234 1236 answer_length 006266 automatic fixed bin(21,0) dcl 1091 set ref 1231* 1232* 1232 1234 1236 apl_allocate_words_ 000224 constant entry external dcl 1772 in procedure "make_new_function" ref 1791 apl_allocate_words_ 000114 constant entry external dcl 352 in procedure "close_function" ref 376 apl_command_$from_editor 000064 constant entry external dcl 69 ref 177 apl_create_save_frame_ 000060 constant entry external dcl 67 ref 94 apl_destroy_save_frame_update_ 000326 constant entry external dcl 2491 ref 2497 apl_error_ 000322 constant entry external dcl 2461 ref 2473 apl_error_table_$bad_context_request 000156 external static fixed bin(35,0) dcl 912 set ref 940* 948* apl_error_table_$bad_function_header 000110 external static fixed bin(35,0) dcl 345 in procedure "close_function" ref 420 apl_error_table_$bad_function_header 000054 external static fixed bin(35,0) dcl 59 in procedure "apl_editor_" ref 162 apl_error_table_$bad_global_print 000206 external static fixed bin(35,0) dcl 1277 set ref 1284* apl_error_table_$bad_substitute 000176 external static fixed bin(35,0) dcl 1101 set ref 1113* apl_error_table_$bad_token_in_brackets 000150 external static fixed bin(35,0) dcl 615 set ref 711* apl_error_table_$cant_read_input 000266 external static fixed bin(35,0) dcl 2277 set ref 2303* 2309* apl_error_table_$complicated_header_line 000066 external static fixed bin(35,0) dcl 213 set ref 252* apl_error_table_$edited_pendent_fcn 000112 external static fixed bin(35,0) dcl 346 ref 489 apl_error_table_$empty_editor_brackets 000136 external static fixed bin(35,0) dcl 615 set ref 756* apl_error_table_$external_function_edited 000074 external static fixed bin(35,0) dcl 213 set ref 268* apl_error_table_$extra_text 000056 external static fixed bin(35,0) dcl 59 in procedure "apl_editor_" set ref 156* apl_error_table_$extra_text 000154 external static fixed bin(35,0) dcl 615 in procedure "process_bracket_contents" set ref 791* apl_error_table_$labels_differ 000126 external static fixed bin(35,0) dcl 543 ref 576 apl_error_table_$line_too_long_to_edit 000246 external static fixed bin(35,0) dcl 2025 set ref 2061* 2100* apl_error_table_$locals_differ 000130 external static fixed bin(35,0) dcl 543 ref 564 apl_error_table_$locked_function_edited 000072 external static fixed bin(35,0) dcl 213 set ref 263* apl_error_table_$mismatched_editor_quotes 000230 external static fixed bin(35,0) dcl 1835 in procedure "assign_line_numbers" set ref 1894* apl_error_table_$mismatched_editor_quotes 000216 external static fixed bin(35,0) dcl 1356 in procedure "process_new_function_line" set ref 1413* apl_error_table_$misplaced_left_arrow 000220 external static fixed bin(35,0) dcl 1565 set ref 1596* apl_error_table_$missing_function_name 000222 external static fixed bin(35,0) dcl 1565 set ref 1604* 1630* apl_error_table_$missing_number 000146 external static fixed bin(35,0) dcl 615 set ref 772* apl_error_table_$missing_number_or_rb 000142 external static fixed bin(35,0) dcl 615 set ref 764* apl_error_table_$missing_quad_or_rb 000140 external static fixed bin(35,0) dcl 615 set ref 760* apl_error_table_$missing_rb 000144 external static fixed bin(35,0) dcl 615 set ref 768* apl_error_table_$missing_slash 000174 external static fixed bin(35,0) dcl 1100 in procedure "context_substitute" set ref 1127* 1149* apl_error_table_$missing_slash 000210 external static fixed bin(35,0) dcl 1278 in procedure "context_global_print" set ref 1298* apl_error_table_$missing_slash 000166 external static fixed bin(35,0) dcl 982 in procedure "context_search" set ref 1005* apl_error_table_$n_labels_differ 000132 external static fixed bin(35,0) dcl 543 ref 585 apl_error_table_$n_locals_differ 000134 external static fixed bin(35,0) dcl 543 ref 583 apl_error_table_$non_function_edited 000070 external static fixed bin(35,0) dcl 213 set ref 257* apl_error_table_$not_end_with_newline 000232 external static fixed bin(35,0) dcl 1835 set ref 1858* apl_error_table_$pendent_function_edited 000076 external static fixed bin(35,0) dcl 213 set ref 289* apl_error_table_$suspended_header 000152 external static fixed bin(35,0) dcl 615 set ref 718* 732* apl_free_bead_ 000320 constant entry external dcl 2398 ref 2414 apl_function_lex_ 000116 constant entry external dcl 353 ref 392 apl_get_symbol_ 000120 constant entry external dcl 354 in procedure "close_function" ref 424 apl_get_symbol_ 000100 constant entry external dcl 221 in procedure "open_function" ref 239 apl_quit_ 000260 stack reference condition dcl 63 ref 110 2127 2141 apl_segment_manager_$free 000324 constant entry external dcl 2490 ref 2495 apl_segment_manager_$get 000062 constant entry external dcl 68 ref 92 apl_static_$apl_input 000310 external static pointer dcl 2357 in procedure "set_read_back_output_mode" set ref 2369* 2382* apl_static_$apl_input 000270 external static pointer dcl 2278 in procedure "read_line" set ref 2292* apl_static_$apl_output 000106 external static pointer dcl 344 in procedure "close_function" set ref 407* apl_static_$apl_output 000164 external static pointer dcl 981 in procedure "context_search" set ref 1065* apl_static_$apl_output 000160 external static pointer dcl 913 in procedure "context_editor" set ref 952* apl_static_$apl_output 000200 external static pointer dcl 1102 in procedure "context_substitute" set ref 1181* 1192* 1226* 1228* 1238* apl_static_$apl_output 000244 external static pointer dcl 2024 in procedure "edit_one_line" set ref 2072* 2075* 2135* apl_static_$apl_output 000256 external static pointer dcl 2245 in procedure "prompt" set ref 2257* apl_static_$apl_output 000234 external static pointer dcl 1922 in procedure "print_function_lines" set ref 1962* 1973* 1981* apl_static_$ws_info_ptr 000102 external static structure level 1 dcl 5-11 in procedure "open_function" apl_static_$ws_info_ptr 000124 external static structure level 1 dcl 13-11 in procedure "close_function" apl_static_$ws_info_ptr 000254 external static structure level 1 dcl 39-11 in procedure "edit_one_line" apl_system_error_ 000274 constant entry external dcl 2283 ref 2303 2309 args 113 parameter varying char(256) array level 2 dcl 27-3 set ref 1477* 1477* 1477* bad_header parameter bit(1) unaligned dcl 1544 in procedure "parse_function_name_and_args" set ref 1537 1572* 1597* 1605* 1631* bad_header 006507 automatic bit(1) unaligned dcl 1465 in procedure "parse_header_line" set ref 1477* 1479 bad_header 005770 automatic bit(1) unaligned dcl 329 in procedure "close_function" set ref 414* 418 bead_ptr parameter pointer unaligned dcl 2394 set ref 2391 2406 2409 2409 2411 2414* 2415* bead_type based structure level 4 packed unaligned dcl 9-5 bits_for_parse 1 based structure level 2 in structure "operator_bead" packed unaligned dcl 15-3 in procedure "close_function" bits_for_parse 1 based structure level 2 in structure "operator_bead" packed unaligned dcl 7-3 in procedure "open_function" char 006054 automatic char(1) unaligned dcl 904 set ref 928* 930 933 936* 938 943 946 1163* 1165 1168 character 000100 automatic char(1) unaligned dcl 841 in procedure "get_next_bracket_token" set ref 851* 853 870 873 876 character 000420 automatic char(1) unaligned dcl 2006 in procedure "edit_one_line" set ref 2085* 2086 2088 character 000202 automatic char(1) unaligned dcl 42 in procedure "apl_editor_" set ref 143* 145 145 151 172 175 180 1398* 1400 1403 1403 character_array_kludge based char(1) array unaligned dcl 1560 in procedure "parse_function_name_and_args" set ref 1582 1588 1613 1616 character_array_kludge based char(1) array unaligned dcl 1470 in procedure "parse_header_line" set ref 1497 1503 1516 character_pos parameter fixed bin(17,0) dcl 199 in procedure "open_function" set ref 195 235* character_pos parameter fixed bin(17,0) dcl 1336 in procedure "process_new_function_line" set ref 1332 1386 1387 1423* 1423 1431* character_pos parameter fixed bin(17,0) dcl 1680 in procedure "get_header_token" set ref 1676 1697 1702 1704* 1704 1709 1713* 1713 1717* 1717 1719 1721 1726 1728* 1730* 1730 1732* 1732 1734 character_pos parameter fixed bin(17,0) dcl 1457 in procedure "parse_header_line" set ref 1453 1475 1477* 1482 1492* 1499* 1510* 1520* 1531 character_pos 000201 automatic fixed bin(17,0) dcl 41 in procedure "apl_editor_" set ref 99* 100* 102 103 104* 118 126* 131 132* 132 135* 143 155* 155 156 156* 172* 177 178* 180* 185* character_pos parameter fixed bin(17,0) dcl 1541 in procedure "parse_function_name_and_args" set ref 1537 1577 1579* 1584* 1601* 1604* 1620* character_pos 005742 automatic fixed bin(17,0) dcl 319 in procedure "close_function" set ref 381* 384 387* 387 character_pos parameter fixed bin(17,0) dcl 1074 in procedure "context_substitute" set ref 1070 1111* 1111 1113 1113* 1116* 1116 1118 1122 1126* 1127* 1130* 1130 1132 1140* 1140 1142 1144 1148* 1149* 1152* 1152 1154 1156* 1156 1160 1163 1171* 1171 character_pos parameter fixed bin(17,0) dcl 596 in procedure "process_bracket_contents" set ref 591 703* 703 709* 791 791* 796* character_pos parameter fixed bin(17,0) dcl 1263 in procedure "context_global_print" set ref 1259 1282* 1282 1284 1284* 1287* 1287 1289 1293 1297* 1298* 1301* 1301 1303 1311* 1311 character_pos parameter fixed bin(17,0) dcl 834 in procedure "get_next_bracket_token" set ref 830 847* 847 847 849 851 856 861 864* 864 885* 885 character_pos parameter fixed bin(17,0) dcl 962 in procedure "context_search" set ref 958 995* 995 996 1000 1004* 1005* 1008* 1008 1010 1018* 1018 character_pos parameter fixed bin(17,0) dcl 1991 in procedure "edit_one_line" set ref 1986 2145* character_pos parameter fixed bin(17,0) dcl 897 in procedure "context_editor" set ref 892 924* 924 928 930* 935* 935 936 938* 940* 943* 946* 948* 950 class 3 based fixed bin(17,0) level 2 in structure "function_bead" dcl 31-5 in procedure "make_new_function" set ref 1796* class 3 based fixed bin(17,0) level 2 in structure "function_bead" dcl 17-5 in procedure "close_function" set ref 404* 506* 512* class 3 based fixed bin(17,0) level 2 in structure "function_bead" dcl 9-5 in procedure "open_function" ref 261 266 cleanup 000252 stack reference condition dcl 63 ref 96 code parameter fixed bin(35,0) dcl 2451 in procedure "error" set ref 2448 2468 2473 2473* code parameter fixed bin(35,0) dcl 1682 in procedure "get_header_token" set ref 1676 1695* 1699* 1705* 1714* code 000431 automatic fixed bin(35,0) dcl 2008 in procedure "edit_one_line" set ref 2043* 2045 2072* 2075* 2130* 2135* code parameter fixed bin(35,0) dcl 35 in procedure "apl_editor_" set ref 30 83* 159* 160 162 177* 1022* 1027 1177* 1179 1362* 1364 2222* 2223 2257* code 006644 automatic fixed bin(35,0) dcl 1914 in procedure "print_function_lines" set ref 1962* 1973* 1981* code parameter fixed bin(35,0) dcl 315 in procedure "close_function" set ref 310 369* 399* 407* 420* 458* 471* 474 489* 491 493* code parameter fixed bin(35,0) dcl 1743 in procedure "validate_identifier" set ref 1739 1751* 1753* code 000112 automatic fixed bin(35,0) dcl 2320 in procedure "reattach_user_input" set ref 2335* 2336 2338* 2339* 2341* code 000110 automatic fixed bin(35,0) dcl 1552 in procedure "parse_function_name_and_args" set ref 1579* 1580 1601* 1602 1613* 1614 code 000100 automatic fixed bin(35,0) dcl 2353 in procedure "set_read_back_output_mode" set ref 2367* 2369* 2370 2370* 2382* 2384* code parameter fixed bin(35,0) dcl 2426 in procedure "get_line_info_idx" set ref 2420 2430* 2438* 2442* code 000102 automatic fixed bin(35,0) dcl 2272 in procedure "read_line" set ref 2292* 2293 2295 2301 code2 006510 automatic fixed bin(35,0) dcl 1466 set ref 1492* 1494 1516* 1518 complicated_header parameter bit(1) unaligned dcl 1544 in procedure "parse_function_name_and_args" set ref 1537 1572* 1647* 1661* 1668* complicated_header 005722 automatic bit(1) unaligned dcl 205 in procedure "open_function" set ref 235* 252 complicated_header parameter bit(1) unaligned dcl 1459 in procedure "parse_header_line" set ref 1453 1477* continue_to_signal_ 000252 constant entry external dcl 2031 ref 2130 conversion 000104 stack reference condition dcl 845 ref 858 862 copy builtin function dcl 2033 in procedure "edit_one_line" ref 2113 copy builtin function dcl 2184 in procedure "line_number_to_string" ref 2206 count 006542 automatic fixed bin(17,0) dcl 1912 in procedure "print_function_lines" set ref 1965* 1967 1967 1967 1967 1967 1969 1971 1971* count 000100 automatic fixed bin(17,0) dcl 1998 in procedure "edit_one_line" set ref 2053* 2055 2055 2056 2083* 2085 2097* count 006030 automatic fixed bin(17,0) dcl 604 in procedure "process_bracket_contents" set ref 809* 809* 815 815 819* 819* 821 821* count 006467 automatic fixed bin(17,0) dcl 1346 in procedure "process_new_function_line" set ref 1374* 1376 1376* current_line_number parameter fixed dec(10,5) dcl 314 in procedure "close_function" set ref 310 440* current_line_number parameter fixed dec(10,5) dcl 1337 in procedure "process_new_function_line" set ref 1332 1362* 1443 current_line_number parameter fixed dec(10,5) dcl 963 in procedure "context_search" set ref 958 1022* 1058* 1059* current_line_number 000203 automatic fixed dec(10,5) dcl 43 in procedure "apl_editor_" set ref 106* 123* 159* 172* 180* 185* 187* 187* 2166 current_line_number parameter fixed dec(10,5) dcl 1075 in procedure "context_substitute" set ref 1070 1177* current_line_number parameter fixed dec(10,5) dcl 2235 in procedure "prompt" set ref 2232 2255* current_line_number parameter fixed dec(10,5) dcl 1993 in procedure "edit_one_line" set ref 1986 2041* 2048* current_line_number parameter fixed dec(10,5) dcl 898 in procedure "context_editor" set ref 892 930* 938* 943* current_line_number parameter fixed dec(10,5) dcl 597 in procedure "process_bracket_contents" set ref 591 780* 788* 796* 827* current_parse_frame_ptr 15 based pointer level 3 in structure "ws_info" packed unaligned dcl 5-16 in procedure "open_function" ref 274 current_parse_frame_ptr 15 based pointer level 3 in structure "ws_info" packed unaligned dcl 13-16 in procedure "close_function" ref 450 current_pos 000100 automatic fixed bin(17,0) dcl 2217 set ref 2220* 2222* data_elements 000100 automatic fixed bin(17,0) dcl 1767 in procedure "make_new_function" set ref 1786* 1788 1788* 1788 1791 1791 1800 1804 data_elements 005766 automatic fixed bin(17,0) dcl 327 in procedure "close_function" set ref 371* 373* 373 376 376 379 del_pos 006462 automatic fixed bin(17,0) dcl 1344 set ref 1395* 1403* 1410 1416 1416 1419 1423 divide builtin function dcl 348 ref 390 done 006504 automatic bit(1) unaligned dcl 1465 in procedure "parse_header_line" set ref 1489* 1490 1494* 1500* 1511* 1521* done 000104 automatic bit(1) unaligned dcl 1549 in procedure "parse_function_name_and_args" set ref 1574* 1575 1621* 1637 edit_buffer based char unaligned dcl 1096 in procedure "context_substitute" set ref 1188 1203* 1203 1209* 1217* 1217 1226 1226 edit_buffer based char unaligned dcl 1351 in procedure "process_new_function_line" set ref 1416* 1434* edit_buffer based char unaligned dcl 1918 in procedure "print_function_lines" ref 1957 1967 1967 1971 edit_buffer based char unaligned dcl 1275 in procedure "context_global_print" ref 1320 edit_buffer based char unaligned dcl 987 in procedure "context_search" ref 1053 edit_buffer based char unaligned dcl 339 in procedure "close_function" ref 384 414 414 edit_buffer based char unaligned dcl 2019 in procedure "edit_one_line" ref 2055 edit_buffer based char unaligned dcl 1829 in procedure "assign_line_numbers" set ref 1880* edit_buffer_ptr 000266 automatic pointer level 2 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 92* edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1416 1434 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 384 390 414 414 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 37-3 in procedure "print_function_lines" ref 1957 1967 1967 1971 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 38-3 in procedure "edit_one_line" set ref 2055 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 43-3 in procedure "apl_editor_cleanup" set ref 2495* edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 24-3 in procedure "context_substitute" set ref 1188 1203 1203 1209 1217 1217 1226 1226 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 25-3 in procedure "context_global_print" set ref 1320 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 23-3 in procedure "context_search" set ref 1053 edit_buffer_ptr parameter pointer level 2 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1880 editor_input_buffer parameter char unaligned dcl 1989 set ref 1986 2143* editor_input_buffer_length parameter fixed bin(21,0) dcl 1990 set ref 1986 2144* end_of_first_half 006130 automatic fixed bin(17,0) dcl 974 set ref 1039* 1044* 1048 error_table_$end_of_info 000264 external static fixed bin(35,0) dcl 2276 ref 2301 error_table_$not_closed 000300 external static fixed bin(35,0) dcl 2325 ref 2336 error_table_$short_record 000262 external static fixed bin(35,0) dcl 2276 ref 2295 fatal 000100 automatic bit(1) unaligned dcl 2457 set ref 2465* 2471* 2477 first_array_idx 006540 automatic fixed bin(17,0) dcl 1911 set ref 1933* 1933* 1937 1940 1943 1955 1958* 1958 1965 first_free_char 006261 automatic fixed bin(17,0) dcl 1088 set ref 1199* 1203 1205* 1205 1209 1211* 1211 1217 1219* 1219 1226 1226 1249 1250 first_idx 006345 automatic fixed bin(17,0) dcl 1270 set ref 1313* 1315 first_insertion 000416 automatic fixed bin(17,0) dcl 2004 set ref 2082* 2092 2092* 2108 2108* 2111 2113 2113 2115 first_line_number parameter fixed dec(10,5) dcl 1905 ref 1902 1933 1940 1948 first_time_in_process 000010 internal static bit(1) initial dcl 645 set ref 657 699* first_unused_char_in_buffer 2 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 390 first_unused_char_in_buffer 2 000266 automatic fixed bin(17,0) level 2 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 85* first_unused_char_in_buffer 2 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1851* 1880 1884 1887* 1887 first_unused_char_in_buffer 2 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1407 1416 1419* 1419 1434 1436* 1436 1444 first_unused_char_in_buffer 2 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 24-3 in procedure "context_substitute" set ref 1199 1226 1226 1226 1226 1248 1249 1250* fixed builtin function dcl 2162 ref 2168 found_left_arrow 000103 automatic bit(1) unaligned dcl 1549 set ref 1574* 1609* 1641 function 0(03) based bit(1) level 5 packed unaligned dcl 9-5 ref 255 function_bead based structure level 1 dcl 36-5 in procedure "assign_line_numbers" function_bead based structure level 1 dcl 9-5 in procedure "open_function" function_bead based structure level 1 dcl 17-5 in procedure "close_function" set ref 376 376 function_bead based structure level 1 dcl 31-5 in procedure "make_new_function" set ref 1791 1791 function_bead_ptr 2 based pointer level 2 in structure "parse_frame" packed unaligned dcl 19-3 in procedure "close_function" set ref 476* 479* function_bead_ptr 005724 automatic pointer dcl 207 in procedure "open_function" set ref 247* 249 255 261 266 272 function_bead_ptr 006520 automatic pointer dcl 1820 in procedure "assign_line_numbers" set ref 1847* 1853 1855 1858 1858 1858 1864 1866 1880 1894 1894 1894 function_bead_ptr 005750 automatic pointer unaligned dcl 323 in procedure "close_function" set ref 376* 378 379 384 392 394 404 432 433 479 480 480 506 507 508 512 513 518 function_bead_ptr 000101 automatic pointer unaligned dcl 1768 in procedure "make_new_function" set ref 1791* 1793 1795 1796 1797 1798 1800 1804 1806 1808 function_frame_type constant fixed bin(17,0) initial dcl 11-22 in procedure "open_function" ref 283 function_frame_type constant fixed bin(17,0) initial dcl 19-22 in procedure "close_function" ref 460 function_info parameter structure level 1 unaligned dcl 24-3 in procedure "context_substitute" set ref 1070 1177* 1252* function_info parameter structure level 1 unaligned dcl 21-3 in procedure "context_editor" set ref 892 930* 938* 943* 946* function_info parameter structure level 1 unaligned dcl 26-3 in procedure "process_new_function_line" set ref 1332 1362* function_info parameter structure level 1 unaligned dcl 12-3 in procedure "close_function" set ref 310 439* function_info parameter structure level 1 unaligned dcl 27-3 in procedure "parse_header_line" set ref 1453 1479* function_info 000266 automatic structure level 1 unaligned dcl 3-3 in procedure "apl_editor_" set ref 96* 100* 123* 148* 159* 160* 172* 180* 185* function_info parameter structure level 1 unaligned dcl 23-3 in procedure "context_search" set ref 958 1022* 1059* function_info parameter structure level 1 unaligned dcl 20-3 in procedure "process_bracket_contents" set ref 591 785* 796* 799* 804* function_info parameter structure level 1 unaligned dcl 42-3 in procedure "get_line_info_idx" ref 2420 function_info parameter structure level 1 unaligned dcl 4-3 in procedure "open_function" set ref 195 235* 258* 264* 269* 290* 297* 302* 304* function_info parameter structure level 1 unaligned dcl 25-3 in procedure "context_global_print" set ref 1259 1322* function_info parameter structure level 1 unaligned dcl 37-3 in procedure "print_function_lines" set ref 1902 function_info parameter structure level 1 unaligned dcl 28-3 in procedure "make_new_function" ref 1759 function_info parameter structure level 1 unaligned dcl 40-3 in procedure "prompt" ref 2232 function_info parameter structure level 1 unaligned dcl 33-3 in procedure "assign_line_numbers" set ref 1813 1859* function_info parameter structure level 1 unaligned dcl 43-3 in procedure "apl_editor_cleanup" set ref 2483 function_info parameter structure level 1 unaligned dcl 38-3 in procedure "edit_one_line" set ref 1986 2043* function_name parameter varying char dcl 1543 in procedure "parse_function_name_and_args" set ref 1537 1571* 1658* 1666* 1670* function_name 005752 automatic varying char(32) dcl 325 in procedure "close_function" set ref 414* 424 function_type constant bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" ref 1793 function_type constant bit(18) initial unaligned dcl 14-30 in procedure "close_function" ref 378 general_bead based structure level 1 dcl 6-3 in procedure "open_function" general_bead based structure level 1 dcl 14-3 in procedure "close_function" general_bead based structure level 1 dcl 34-3 in procedure "assign_line_numbers" general_bead based structure level 1 dcl 29-3 in procedure "make_new_function" general_bead based structure level 1 dcl 41-3 in procedure "decrement_reference_count" good_chars_in_identifier 000125 constant char(76) initial unaligned dcl 1691 in procedure "get_header_token" ref 1721 1726 good_chars_in_identifier 000102 constant char(76) initial unaligned dcl 1747 in procedure "validate_identifier" ref 1753 got_line 000100 automatic bit(1) unaligned dcl 2270 in procedure "read_line" set ref 2288* 2290 2293* 2299* got_line 000207 automatic bit(1) initial unaligned dcl 45 in procedure "apl_editor_" set ref 45* 115* 116 129* 136* got_line 006465 automatic bit(1) unaligned dcl 1345 in procedure "process_new_function_line" set ref 1391* 1393 1421* 1430* 1438 gotten_number parameter fixed dec(10,5) dcl 837 in procedure "get_next_bracket_token" set ref 830 861* gotten_number 006033 automatic fixed dec(10,5) dcl 606 in procedure "process_bracket_contents" set ref 709* 718 729 732 740 have_reattached_user_input 000101 automatic bit(1) unaligned dcl 2271 set ref 2287* 2303 2307* header based structure level 2 in structure "function_bead" dcl 31-5 in procedure "make_new_function" header based structure level 2 in structure "symbol_bead" dcl 8-13 in procedure "open_function" header based structure level 2 in structure "function_bead" dcl 9-5 in procedure "open_function" header based structure level 2 in structure "function_bead" dcl 17-5 in procedure "close_function" header_length parameter fixed bin(17,0) dcl 1458 in procedure "parse_header_line" set ref 1453 1482* 1531* header_length 005721 automatic fixed bin(17,0) dcl 204 in procedure "open_function" set ref 235* 302 302 header_line parameter char unaligned dcl 33 in procedure "apl_editor_" set ref 30 100* 102 103 header_line parameter char unaligned dcl 198 in procedure "open_function" set ref 195 235* 252* 257* 263* 268* 289* 302 302 header_line parameter char unaligned dcl 1763 in procedure "make_new_function" ref 1759 1786 1788 1804 1804 1806 header_line_pos parameter fixed bin(21,0) dcl 34 ref 30 99 header_start parameter fixed bin(17,0) dcl 1542 in procedure "parse_function_name_and_args" set ref 1537 1635* header_start parameter fixed bin(17,0) dcl 1458 in procedure "parse_header_line" set ref 1453 1475* 1477* 1482 1531 header_start 005720 automatic fixed bin(17,0) dcl 204 in procedure "open_function" set ref 235* 252* 257* 263* 268* 289* 302 302 id_number 000100 automatic fixed bin(17,0) dcl 1548 set ref 1575* 1594 1616 1617* 1637 1639 identifiers 000111 automatic structure array level 1 unaligned dcl 1554 idx 000101 automatic fixed bin(17,0) dcl 1998 in procedure "edit_one_line" set ref 2060* 2061 2061 2061 2061* idx 006303 automatic fixed bin(17,0) dcl 1268 in procedure "context_global_print" set ref 1293* 1295 1301 1320* 1322 idx 006253 automatic fixed bin(17,0) dcl 1083 in procedure "context_substitute" set ref 1122* 1124 1130 1144* 1146 1152 1188* 1190 1203 1203 1205 1215 1217 idx 006132 automatic fixed bin(17,0) dcl 976 in procedure "context_search" set ref 1000* 1002 1008 1053* 1055 in_quotes 006522 automatic bit(1) unaligned dcl 1821 in procedure "assign_line_numbers" set ref 1848* 1864* 1864 1866 1873 1894 in_quotes 006463 automatic bit(1) unaligned dcl 1345 in procedure "process_new_function_line" set ref 1389* 1400* 1400 1413 1427 increment 006127 automatic fixed bin(17,0) dcl 973 set ref 1038* 1043* 1048 1048 1048 incremented_line_number 006656 automatic fixed dec(10,5) dcl 2158 set ref 2168* 2169 index builtin function dcl 2033 ref 2060 2088 indx 006004 automatic fixed bin(17,0) dcl 535 set ref 561* 564 564* 575* 576 576* initial_input_line parameter char unaligned dcl 1335 ref 1332 1386 1387 1431 input_buffer 000100 automatic char(256) unaligned dcl 39 in procedure "apl_editor_" set ref 103 118 125* 131 135 143 156 156 172* 177 178 180* 185 input_buffer parameter char unaligned dcl 594 in procedure "process_bracket_contents" set ref 591 709 711 718 732 756 760 764 768 772 791 791 796* input_buffer parameter char unaligned dcl 895 in procedure "context_editor" set ref 892 928 930 936 938 940 943 946 948 950 input_buffer 006360 automatic char(256) unaligned dcl 1342 in procedure "process_new_function_line" set ref 1386* 1396 1398 1413 1416 1434 1434 1436 1438* input_buffer parameter char unaligned dcl 2265 in procedure "read_line" set ref 2262 2292 2292 2292 2292 2298* input_line based char unaligned dcl 1350 in procedure "process_new_function_line" set ref 1396 1398 1413* 1416 1434 1434 1436 input_line parameter char unaligned dcl 961 in procedure "context_search" set ref 958 1000 1005* 1010 input_line 000202 automatic char(256) unaligned dcl 1999 in procedure "edit_one_line" set ref 2077* 2078* 2085 2137* 2143 input_line parameter char unaligned dcl 1073 in procedure "context_substitute" set ref 1070 1113 1113* 1122 1127* 1132 1144 1149* 1154 1160 1163 input_line based char unaligned dcl 611 in procedure "process_bracket_contents" set ref 709* 711* 718* 732* 756* 760* 764* 768* 772* 791 791* input_line parameter char unaligned dcl 1262 in procedure "context_global_print" set ref 1259 1284 1284* 1293 1298* 1303 input_line parameter char unaligned dcl 833 in procedure "get_next_bracket_token" ref 830 847 851 856 861 input_line based char unaligned dcl 908 in procedure "context_editor" set ref 928 930* 936 938* 940* 943* 946* 948* 950 input_line based char unaligned dcl 55 in procedure "apl_editor_" set ref 103* 118 131 135 143 156 156* 177* 178 185* input_line_length parameter fixed bin(21,0) dcl 896 in procedure "context_editor" ref 892 928 930 930 936 938 938 940 940 943 943 946 946 948 948 950 1004 1126 1148 1297 input_line_length parameter fixed bin(21,0) dcl 2266 in procedure "read_line" set ref 2262 2292* 2297* 2297 2298 input_line_length 000200 automatic fixed bin(21,0) dcl 40 in procedure "apl_editor_" set ref 102* 103 118 125* 131 135 143 156 156 156 172* 177 177 178 180* 185 185 input_line_length parameter fixed bin(21,0) dcl 595 in procedure "process_bracket_contents" set ref 591 709 709 711 711 718 718 732 732 756 756 760 760 764 764 768 768 772 772 791 791 791 796* input_line_length 000403 automatic fixed bin(21,0) dcl 2000 in procedure "edit_one_line" set ref 2077* 2078 2137* 2143 2144 input_line_length 006460 automatic fixed bin(21,0) dcl 1343 in procedure "process_new_function_line" set ref 1387* 1396 1398 1413 1413 1416 1434 1434 1436 1438* insertion_chars 000071 constant char(36) initial unaligned dcl 2014 ref 2088 insertion_table 000024 constant fixed bin(17,0) initial array dcl 2015 ref 2088 integer_part 000414 automatic fixed dec(5,0) dcl 2003 set ref 2064* 2066 2069 2075 ioa_$ioa_switch 000162 constant entry external dcl 917 in procedure "context_editor" ref 952 ioa_$ioa_switch 000172 constant entry external dcl 991 in procedure "context_search" ref 1065 ioa_$ioa_switch 000204 constant entry external dcl 1107 in procedure "context_substitute" ref 1181 1192 1226 1228 1238 iox_$attach_ptr 000306 constant entry external dcl 2331 ref 2341 iox_$close 000304 constant entry external dcl 2330 ref 2338 iox_$control 000316 constant entry external dcl 2363 ref 2369 2382 iox_$detach_iocb 000302 constant entry external dcl 2329 ref 2335 2339 iox_$get_line 000272 constant entry external dcl 2282 ref 2292 iox_$put_chars 000240 constant entry external dcl 1929 in procedure "print_function_lines" ref 1962 1973 1981 iox_$put_chars 000122 constant entry external dcl 355 in procedure "close_function" ref 407 iox_$put_chars 000250 constant entry external dcl 2030 in procedure "edit_one_line" ref 2072 2075 2135 iox_$put_chars 000260 constant entry external dcl 2249 in procedure "prompt" ref 2257 iox_$user_input 000276 external static pointer dcl 2324 set ref 2335* 2338* 2339* 2341* ipc_$mask_ev_calls 000312 constant entry external dcl 2361 ref 2367 ipc_$unmask_ev_calls 000314 constant entry external dcl 2362 ref 2384 label_values_ptr 7 based pointer level 2 packed unaligned dcl 18-6 ref 572 573 last_array_idx 006541 automatic fixed bin(17,0) dcl 1911 set ref 1943* 1945* 1965 last_frame_was_suspended 005767 automatic bit(1) unaligned dcl 328 in procedure "close_function" set ref 443* 454* 460 499* last_frame_was_suspended 005723 automatic bit(1) unaligned dcl 206 in procedure "open_function" set ref 279* 283 293* last_identifier 000102 automatic fixed bin(17,0) dcl 1548 set ref 1637* 1639* 1648 1650 1658 1659 1660 1666 1667 1670 last_parse_frame_ptr based pointer level 2 in structure "parse_frame" packed unaligned dcl 19-3 in procedure "close_function" ref 501 last_parse_frame_ptr based pointer level 2 in structure "parse_frame" packed unaligned dcl 11-3 in procedure "open_function" ref 295 last_state 006027 automatic fixed bin(17,0) dcl 602 set ref 705* 714 752 last_token_was_semicolon 006505 automatic bit(1) unaligned dcl 1465 set ref 1503* 1508 1526* lbound builtin function dcl 348 ref 372 382 left_arg parameter varying char dcl 1543 set ref 1537 1571* 1660* left_number parameter fixed dec(10,5) dcl 1992 in procedure "edit_one_line" set ref 1986 2041 2043* left_number 006036 automatic fixed dec(10,5) dcl 607 in procedure "process_bracket_contents" set ref 729* 780 785* 788 796* length builtin function dcl 2184 in procedure "line_number_to_string" ref 2202 2206 2206 length builtin function dcl 1774 in procedure "make_new_function" ref 1786 1804 length builtin function dcl 2251 in procedure "prompt" ref 2257 2257 length builtin function dcl 71 in procedure "apl_editor_" ref 102 118 135 156 178 407 407 791 950 1160 1209 1211 1215 1217 1226 1226 1499 1584 1697 1713 1728 1894 2292 2292 length builtin function dcl 2033 in procedure "edit_one_line" ref 2051 length builtin function dcl 1925 in procedure "print_function_lines" ref 1962 1962 1973 1973 1981 1981 length builtin function dcl 1358 in procedure "process_new_function_line" ref 1387 1396 1431 1434 1436 length builtin function dcl 2162 in procedure "increment_line_number" ref 2167 lex_errors_occurred 005771 automatic bit(1) dcl 330 set ref 392* 396 437 450 lexed_function_bead based structure level 1 dcl 18-6 lexed_function_bead_pointer 2 based pointer level 2 in structure "function_bead" packed unaligned dcl 17-5 in procedure "close_function" set ref 394* lexed_function_bead_pointer 2 based pointer level 2 in structure "function_bead" packed unaligned dcl 9-5 in procedure "open_function" ref 272 lexed_function_bead_pointer 2 based pointer level 2 in structure "function_bead" packed unaligned dcl 31-5 in procedure "make_new_function" set ref 1795* lexed_function_bead_ptr 005751 automatic pointer unaligned dcl 324 in procedure "close_function" set ref 392* 394 429 471* 483 485 485 lexed_function_bead_ptr 005726 automatic pointer dcl 208 in procedure "open_function" set ref 272* 274 283 lexed_function_bead_ptr 3 based pointer level 2 in structure "parse_frame" packed unaligned dcl 11-3 in procedure "open_function" ref 283 lexed_function_bead_ptr 3 based pointer level 2 in structure "parse_frame" packed unaligned dcl 19-3 in procedure "close_function" set ref 460 471* 477* 483* lexed_function_label_values based pointer array level 2 packed unaligned dcl 18-45 ref 576 576 lexed_function_label_values_structure based structure level 1 dcl 18-45 line parameter char unaligned dcl 2215 set ref 2212 2222* 2226 line_count 005743 automatic fixed bin(17,0) dcl 320 set ref 372* 373* 382* 384 384 384 387* line_counter 006530 automatic fixed bin(17,0) dcl 1825 set ref 1853* 1876* 1876 1883 1883 1884 1885* 1897 line_idx 006256 automatic fixed bin(17,0) dcl 1086 in procedure "context_substitute" set ref 1177* 1185 1186 1224 1248 1249 1252 line_idx 006133 automatic fixed bin(17,0) dcl 977 in procedure "context_search" set ref 1048* 1053 1053 1058* line_idx 006346 automatic fixed bin(17,0) dcl 1271 in procedure "context_global_print" set ref 1315* 1317 1318 1322* line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 37-3 in procedure "print_function_lines" set ref 1933 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 25-3 in procedure "context_global_print" set ref 1313 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 12-3 in procedure "close_function" set ref 372 382 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 23-3 in procedure "context_search" set ref 1027 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 42-3 in procedure "get_line_info_idx" line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 26-3 in procedure "process_new_function_line" set ref 1376* 1376 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 33-3 in procedure "assign_line_numbers" line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 24-3 in procedure "context_substitute" line_info 517 000266 automatic structure array level 2 in structure "function_info" unaligned dcl 3-3 in procedure "apl_editor_" line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 20-3 in procedure "process_bracket_contents" set ref 809 821* 821 line_info 517 parameter structure array level 2 in structure "function_info" unaligned dcl 38-3 in procedure "edit_one_line" line_info_idx parameter fixed bin(17,0) dcl 2424 in procedure "get_line_info_idx" set ref 2420 2432* 2432* 2436 2442 line_info_idx 006470 automatic fixed bin(17,0) dcl 1346 in procedure "process_new_function_line" set ref 1362* 1374 1374 1407 1443 1444 1444 line_info_idx 000405 automatic fixed bin(17,0) dcl 2001 in procedure "edit_one_line" set ref 2043* 2053 2055 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 25-3 in procedure "context_global_print" set ref 1318 line_length 006350 automatic fixed bin(17,0) dcl 1273 in procedure "context_global_print" set ref 1318* 1320 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1444* line_length 006526 automatic fixed bin(17,0) dcl 1823 in procedure "assign_line_numbers" set ref 1855* 1856 1862 1866 1871 1875 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1885* line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 373 384 384 387 414 414 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 23-3 in procedure "context_search" set ref 1053 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 24-3 in procedure "context_substitute" set ref 1186 1249* line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 38-3 in procedure "edit_one_line" set ref 2053 line_length 523 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 37-3 in procedure "print_function_lines" ref 1957 1967 1967 1971 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1443* line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 42-3 in procedure "get_line_info_idx" ref 2432 2442 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 23-3 in procedure "context_search" set ref 1058 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1883* line_number parameter fixed dec(10,5) dcl 2423 in procedure "get_line_info_idx" ref 2420 2432 2442 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 25-3 in procedure "context_global_print" set ref 1322* line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 37-3 in procedure "print_function_lines" set ref 1933 1940 1955 1967* 1969* line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 440 line_number parameter fixed dec(10,5) dcl 2154 in procedure "increment_line_number" ref 2151 2168 line_number parameter fixed dec(10,5) dcl 2176 in procedure "line_number_to_string" ref 2173 2191 2196 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 20-3 in procedure "process_bracket_contents" set ref 809 815 line_number 517 000266 automatic fixed dec(10,5) array level 3 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 106 line_number 517 parameter fixed dec(10,5) array level 3 in structure "function_info" dcl 24-3 in procedure "context_substitute" set ref 1224* 1252* line_number_pic 000100 automatic picture(11) unaligned dcl 2180 in procedure "line_number_to_string" set ref 2196* 2200 line_number_pic 006661 automatic picture(11) unaligned dcl 2159 in procedure "increment_line_number" set ref 2166* 2167 line_pos 006461 automatic fixed bin(17,0) dcl 1344 in procedure "process_new_function_line" set ref 1396* 1398 1403* 1413* line_pos 006527 automatic fixed bin(17,0) dcl 1824 in procedure "assign_line_numbers" set ref 1862* 1864 1866 1866* line_pos 000206 automatic fixed bin(17,0) dcl 44 in procedure "apl_editor_" set ref 131* 132 132 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 38-3 in procedure "edit_one_line" set ref 2055 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 23-3 in procedure "context_search" set ref 1053 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1884* line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1407* 1444 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 25-3 in procedure "context_global_print" set ref 1317 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 37-3 in procedure "print_function_lines" ref 1957 1967 1967 1971 line_start 006347 automatic fixed bin(17,0) dcl 1272 in procedure "context_global_print" set ref 1317* 1320 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 384 414 414 line_start 006524 automatic fixed bin(17,0) dcl 1822 in procedure "assign_line_numbers" set ref 1849* 1855 1858 1858 1858 1862 1862 1866 1875* 1875 1888* 1894 1894 1894 line_start 522 parameter fixed bin(17,0) array level 3 in structure "function_info" dcl 24-3 in procedure "context_substitute" set ref 1185 1248* line_to_parse parameter char unaligned dcl 1456 in procedure "parse_header_line" set ref 1453 1477* 1492* 1497 1499 1503 1516 line_to_parse parameter char unaligned dcl 1679 in procedure "get_header_token" ref 1676 1697 1702 1709 1713 1721 1726 1728 line_to_parse parameter char unaligned dcl 1540 in procedure "parse_function_name_and_args" set ref 1537 1579* 1582 1584 1588 1596* 1601* 1604* 1613 1616 1630* localized_symbols 12 based pointer array level 2 packed unaligned dcl 18-6 ref 564 564 locked_function 105 000266 automatic bit(1) level 2 in structure "function_info" packed unaligned dcl 3-3 in procedure "apl_editor_" set ref 86* 151* 153* locked_function 105 parameter bit(1) level 2 in structure "function_info" packed unaligned dcl 12-3 in procedure "close_function" set ref 401 405* 503 ltrim builtin function dcl 2184 in procedure "line_number_to_string" ref 2200 ltrim builtin function dcl 1358 in procedure "process_new_function_line" ref 1434 1436 meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 8-13 in procedure "open_function" ref 247 meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 35-13 in procedure "assign_line_numbers" ref 1847 meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 32-13 in procedure "make_new_function" set ref 1808* meaning_pointer 3 based pointer level 2 in structure "symbol_bead" packed unaligned dcl 16-13 in procedure "close_function" set ref 431* 432* name 2 based pointer level 2 in structure "lexed_function_bead" packed unaligned dcl 18-6 in procedure "close_function" ref 429 460 name 3 parameter varying char(256) level 2 in structure "function_info" dcl 27-3 in procedure "parse_header_line" set ref 1477* name 000111 automatic varying char(256) initial array level 2 in structure "identifiers" dcl 1554 in procedure "parse_function_name_and_args" set ref 1554* 1554* 1554* 1554* 1616* 1628 1646 1658 1659 1660 1666 1667 1670 name 3 parameter varying char(256) level 2 in structure "function_info" dcl 4-3 in procedure "open_function" set ref 239 new_labels_ptr 006006 automatic pointer dcl 535 set ref 573* 576 new_lfbp 006010 automatic pointer dcl 535 set ref 551* 553 553 564 573 new_pos 000100 automatic fixed bin(17,0) dcl 1686 set ref 1709* 1711 1717 1726* 1728 1730 null builtin function dcl 348 in procedure "close_function" ref 450 507 508 514 519 null builtin function dcl 1774 in procedure "make_new_function" ref 1795 1797 1798 number_length 000101 automatic fixed bin(17,0) dcl 842 set ref 856* 861 864 number_of_labels 6 based fixed bin(17,0) level 2 dcl 18-6 ref 553 553 561 575 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 20-3 in procedure "process_bracket_contents" set ref 809 815 819 824* 824 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 33-3 in procedure "assign_line_numbers" set ref 1897* number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 37-3 in procedure "print_function_lines" ref 1933 1937 1945 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 25-3 in procedure "context_global_print" set ref 1315 number_of_lines 112 000266 automatic fixed bin(17,0) level 2 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 90* 106 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 42-3 in procedure "get_line_info_idx" ref 2432 2436 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 372 382 440 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 26-3 in procedure "process_new_function_line" set ref 1374 1374 1447* 1447 number_of_lines 112 parameter fixed bin(17,0) level 2 in structure "function_info" dcl 23-3 in procedure "context_search" set ref 1027 1040 1044 number_of_localized_symbols 5 based fixed bin(17,0) level 2 dcl 18-6 ref 553 553 561 number_of_spaces 000110 automatic fixed bin(17,0) dcl 2182 set ref 2188* 2194* 2206 2206 old_character_pos 000105 automatic fixed bin(17,0) dcl 1550 set ref 1577* 1620 old_labels_ptr 006012 automatic pointer dcl 535 set ref 572* 576 old_length 006260 automatic fixed bin(17,0) dcl 1087 set ref 1186* 1188 1215 old_lfbp 006014 automatic pointer dcl 535 set ref 550* 553 553 561 561 564 572 575 old_mode 000421 automatic char(32) unaligned dcl 2007 in procedure "edit_one_line" set ref 2125* 2129* 2133* 2139* old_mode parameter char unaligned dcl 2349 in procedure "set_read_back_output_mode" set ref 2346 2369 2369 2375 2379 2382* 2386* old_start 006257 automatic fixed bin(17,0) dcl 1087 set ref 1185* 1188 1203 1217 old_tail_length 006262 automatic fixed bin(17,0) dcl 1089 set ref 1215* 1217 1217 1219 operator_bead based structure level 1 dcl 7-3 in procedure "open_function" operator_bead based structure level 1 dcl 15-3 in procedure "close_function" original_line 000102 automatic char(256) unaligned dcl 1999 set ref 2050* 2055* 2060 2061 2061 2072 2072 2097 2121 original_line_length 000402 automatic fixed bin(21,0) dcl 2000 set ref 2051* 2055 2056* 2056 2060 2072* 2081* 2081 2083 2122 output_line 006543 automatic varying char(256) dcl 1913 in procedure "print_function_lines" set ref 1951* 1957* 1957 1960* 1960 1962 1962 1962 1962 1967* 1969* 1971* 1971 1973 1973 1973 1973 1979* 1981 1981 1981 1981 output_line 000302 automatic char(256) unaligned dcl 1999 in procedure "edit_one_line" set ref 2074* 2075 2075 2097* 2100 2100 2113* 2121* 2135 2135 output_line_length 000404 automatic fixed bin(21,0) dcl 2000 set ref 2080* 2092 2094* 2094 2097 2098* 2098 2100 2108 2111 2113 2113 2113 2115* 2115 2115 2122* 2135* parse_frame based structure level 1 dcl 19-3 in procedure "close_function" parse_frame based structure level 1 dcl 11-3 in procedure "open_function" parse_frame_ptr 005764 automatic pointer dcl 326 in procedure "close_function" set ref 450* 450* 454 460 460 471 476 477 479 483* 501 parse_frame_ptr 005730 automatic pointer dcl 209 in procedure "open_function" set ref 274* 274* 279 283 283* 295 parse_frame_type 1 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 11-3 in procedure "open_function" ref 279 283 parse_frame_type 1 based fixed bin(17,0) level 2 in structure "parse_frame" dcl 19-3 in procedure "close_function" ref 454 460 phony_number_of_ids 000101 automatic fixed bin(17,0) dcl 1548 set ref 1648* 1650* 1655 1663 1670 pointers 14 based structure level 2 in structure "ws_info" dcl 13-16 in procedure "close_function" pointers 14 based structure level 2 in structure "ws_info" dcl 5-16 in procedure "open_function" position parameter fixed bin(17,0) dcl 2453 in procedure "error" set ref 2448 2468 2473* position 101 000111 automatic fixed bin(17,0) array level 2 in structure "identifiers" dcl 1554 in procedure "parse_function_name_and_args" set ref 1617* 1635 power 006664 automatic fixed bin(17,0) dcl 2160 set ref 2167* 2168 print_type parameter fixed bin(17,0) dcl 1906 ref 1902 1940 1945 1948 1976 prompt_string 006674 automatic varying char(14) dcl 2241 in procedure "prompt" set ref 2255* 2257 2257 2257 2257 prompt_string 000406 automatic varying char(14) dcl 2002 in procedure "edit_one_line" set ref 2048* 2050 2051 prompt_string 006267 automatic varying char(14) dcl 1092 in procedure "context_substitute" set ref 1224* 1226 1226 1226* quit_force 000210 automatic bit(1) initial unaligned dcl 45 set ref 45* 148 164* 170* ran_out_of_tokens parameter bit(1) unaligned dcl 1544 in procedure "parse_function_name_and_args" set ref 1537 1572* 1575 1580* 1585* 1637 ran_out_of_tokens 006506 automatic bit(1) unaligned dcl 1465 in procedure "parse_header_line" set ref 1477* 1484 real_line_length 006525 automatic fixed bin(17,0) dcl 1823 set ref 1850* 1871* 1871 1880 1880 1885 1887 1888 1890* real_line_start 006523 automatic fixed bin(17,0) dcl 1822 set ref 1849* 1853 1880 1888 1888* reference_count 1 based fixed bin(29,0) level 3 in structure "symbol_bead" dcl 8-13 in procedure "open_function" ref 244 reference_count 1 based fixed bin(29,0) level 2 in structure "general_bead" dcl 14-3 in procedure "close_function" set ref 480* 480 485* 485 514* 514 519* 519 reference_count 1 based fixed bin(29,0) level 2 in structure "general_bead" dcl 41-3 in procedure "decrement_reference_count" set ref 2409* 2409 2411 reference_count 1 based fixed bin(29,0) level 3 in structure "function_bead" dcl 17-5 in procedure "close_function" set ref 433* replacing_old_line 006466 automatic bit(1) unaligned dcl 1345 set ref 1364* 1367* 1447 reported_si_damage 005744 automatic bit(1) dcl 321 set ref 444* 493 496* return_arg parameter varying char dcl 1543 set ref 1537 1571* 1646* return_string 000103 automatic varying char(14) dcl 2181 set ref 2199* 2200* 2200 2201* 2201 2202 2202* 2202 2204* 2204 2206 2206* 2206 2206 2209 reverse_search parameter bit(1) unaligned dcl 966 ref 958 1036 right_arg parameter varying char dcl 1543 set ref 1537 1571* 1659* 1667* right_number 006041 automatic fixed dec(10,5) dcl 607 in procedure "process_bracket_contents" set ref 740* 796* 804* 809 815 827 right_number parameter fixed dec(10,5) dcl 1992 in procedure "edit_one_line" ref 1986 2064 2066 rtrim builtin function dcl 2162 in procedure "increment_line_number" ref 2167 rtrim builtin function dcl 2184 in procedure "line_number_to_string" ref 2201 2201 saved_search_string 000211 automatic varying char(128) initial dcl 46 in procedure "apl_editor_" set ref 46* 180* saved_search_string parameter varying char(128) dcl 900 in procedure "context_editor" set ref 892 930* 938* 943* 946* saved_search_string parameter varying char(128) dcl 965 in procedure "context_search" set ref 958 1014 1016* saved_search_string parameter varying char(128) dcl 1265 in procedure "context_global_print" set ref 1259 1307 1309* saved_search_string parameter varying char(128) dcl 1077 in procedure "context_substitute" set ref 1070 1136 1138* saved_stop_vector 106 parameter pointer level 2 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 513 514 514 514 saved_stop_vector 106 000266 automatic pointer level 2 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 88* saved_trace_vector 110 000266 automatic pointer level 2 in structure "function_info" dcl 3-3 in procedure "apl_editor_" set ref 89* saved_trace_vector 110 parameter pointer level 2 in structure "function_info" dcl 12-3 in procedure "close_function" set ref 518 519 519 519 scratch_space_ptr 005746 automatic pointer dcl 322 set ref 390* 392* search_string 006065 automatic varying char(128) dcl 971 set ref 1010* 1014 1014* 1016 1053 search_string_start 006064 automatic fixed bin(17,0) dcl 970 set ref 996* 1010 1010 show_substitute 006255 automatic bit(1) initial unaligned dcl 1085 set ref 1085* 1168* 1252 size builtin function dcl 1774 in procedure "make_new_function" ref 1791 1791 size builtin function dcl 348 in procedure "close_function" ref 376 376 source parameter char unaligned dcl 2452 set ref 2448 2468 2473* start_of_second_half 006131 automatic fixed bin(17,0) dcl 975 set ref 1040* 1045* 1048 starting_line_idx 006126 automatic fixed bin(17,0) dcl 972 set ref 1022* 1027 1027* 1048 1048 state 006026 automatic fixed bin(17,0) dcl 602 set ref 702* 705 714* 716 state_table 000011 internal static fixed bin(17,0) array dcl 646 set ref 659* 660* 661* 662* 664* 665* 666* 667* 669* 670* 671* 672* 674* 675* 676* 677* 679* 680* 681* 682* 684* 685* 686* 687* 689* 690* 691* 692* 694* 695* 696* 697* 714 static_ws_info_ptr 000102 external static pointer level 2 in structure "apl_static_$ws_info_ptr" packed unaligned dcl 5-11 in procedure "open_function" ref 5-7 static_ws_info_ptr 000254 external static pointer level 2 in structure "apl_static_$ws_info_ptr" packed unaligned dcl 39-11 in procedure "edit_one_line" ref 39-7 static_ws_info_ptr 000124 external static pointer level 2 in structure "apl_static_$ws_info_ptr" packed unaligned dcl 13-11 in procedure "close_function" ref 13-7 stop_control_pointer 4 based pointer level 2 in structure "function_bead" packed unaligned dcl 17-5 in procedure "close_function" set ref 507* 513* stop_control_pointer 4 based pointer level 2 in structure "function_bead" packed unaligned dcl 31-5 in procedure "make_new_function" set ref 1797* string builtin function dcl 348 in procedure "close_function" set ref 378* string builtin function dcl 1774 in procedure "make_new_function" set ref 1793* string 006304 automatic varying char(128) dcl 1269 in procedure "context_global_print" set ref 1303* 1307 1307* 1309 1320 string1 006151 automatic varying char(128) dcl 1082 set ref 1132* 1136 1136* 1138 1188 1215 1217 string2 006212 automatic varying char(128) dcl 1082 set ref 1154* 1209 1209 1211 string_start 006150 automatic fixed bin(17,0) dcl 1081 in procedure "context_substitute" set ref 1118* 1132 1132 1142* 1154 1154 string_start 006302 automatic fixed bin(17,0) dcl 1267 in procedure "context_global_print" set ref 1289* 1303 1303 substr builtin function dcl 1774 in procedure "make_new_function" ref 1788 substr builtin function dcl 71 in procedure "apl_editor_" set ref 103 131 143 302 302 847 851 856 861 928 936 1000 1010 1053 1113 1122 1132 1144 1154 1163 1188 1203* 1203 1209* 1217* 1217 1226 1226 1234 1236 1284 1293 1303 1320 1702 1709 1721 1726 1855 1858 1858 1864 1866 1880* 1880 1894 1894 1894 2226 2298* substr builtin function dcl 348 in procedure "close_function" set ref 384* 384 414 414 substr builtin function dcl 2033 in procedure "edit_one_line" set ref 2055* 2055 2060 2061 2061 2078* 2085 2097* 2097 2100 2100 2113* 2143 substr builtin function dcl 1925 in procedure "print_function_lines" ref 1957 1967 1967 1971 substr builtin function dcl 1358 in procedure "process_new_function_line" set ref 1386 1387 1398 1416* 1416 1434* suspended_frame_type constant fixed bin(17,0) initial dcl 11-22 in procedure "open_function" ref 279 suspended_frame_type constant fixed bin(17,0) initial dcl 19-22 in procedure "close_function" ref 454 suspended_function 105(01) parameter bit(1) level 2 in structure "function_info" packed unaligned dcl 20-3 in procedure "process_bracket_contents" set ref 718 732 suspended_function 105(01) parameter bit(1) level 2 in structure "function_info" packed unaligned dcl 4-3 in procedure "open_function" set ref 292* suspended_function 105(01) 000266 automatic bit(1) level 2 in structure "function_info" packed unaligned dcl 3-3 in procedure "apl_editor_" set ref 87* symbol_bead based structure level 1 dcl 8-13 in procedure "open_function" symbol_bead based structure level 1 dcl 32-13 in procedure "make_new_function" symbol_bead based structure level 1 dcl 35-13 in procedure "assign_line_numbers" symbol_bead based structure level 1 dcl 16-13 in procedure "close_function" symbol_ptr 104 parameter pointer level 2 in structure "function_info" packed unaligned dcl 33-3 in procedure "assign_line_numbers" set ref 1847 symbol_ptr 104 parameter pointer level 2 in structure "function_info" packed unaligned dcl 4-3 in procedure "open_function" set ref 239* 244 244* 247 symbol_ptr 104 parameter pointer level 2 in structure "function_info" packed unaligned dcl 28-3 in procedure "make_new_function" ref 1808 symbol_ptr 104 parameter pointer level 2 in structure "function_info" packed unaligned dcl 12-3 in procedure "close_function" set ref 424* 426* 426 429* 431 432 460 sys_info$max_seg_size 000170 external static fixed bin(17,0) dcl 983 in procedure "context_search" ref 1053 sys_info$max_seg_size 000226 external static fixed bin(17,0) dcl 1833 in procedure "assign_line_numbers" ref 1880 sys_info$max_seg_size 000212 external static fixed bin(35,0) dcl 1279 in procedure "context_global_print" ref 1320 sys_info$max_seg_size 000104 external static fixed bin(17,0) dcl 343 in procedure "close_function" ref 384 414 414 sys_info$max_seg_size 000202 external static fixed bin(35,0) dcl 1103 in procedure "context_substitute" ref 1188 1203 1203 1209 1217 1217 1226 1226 sys_info$max_seg_size 000242 external static fixed bin(17,0) dcl 2023 in procedure "edit_one_line" ref 2055 sys_info$max_seg_size 000236 external static fixed bin(17,0) dcl 1923 in procedure "print_function_lines" ref 1957 1967 1967 1971 sys_info$max_seg_size 000214 external static fixed bin(17,0) dcl 1355 in procedure "process_new_function_line" ref 1416 1434 text 7 based char level 2 in structure "function_bead" dcl 31-5 in procedure "make_new_function" set ref 1804* 1806* text 7 based char level 2 in structure "function_bead" dcl 36-5 in procedure "assign_line_numbers" ref 1855 1858 1858 1864 1866 1880 1894 1894 1894 text 7 based char level 2 in structure "function_bead" dcl 17-5 in procedure "close_function" set ref 384* 392* text_length 6 based fixed bin(21,0) level 2 in structure "function_bead" dcl 36-5 in procedure "assign_line_numbers" ref 1853 1855 1858 1858 1858 1864 1866 1880 1894 1894 1894 text_length 6 based fixed bin(21,0) level 2 in structure "function_bead" dcl 17-5 in procedure "close_function" set ref 379* 384 392 392 text_length 6 based fixed bin(21,0) level 2 in structure "function_bead" dcl 31-5 in procedure "make_new_function" set ref 1800* 1804 1806 token parameter char unaligned dcl 1742 in procedure "validate_identifier" ref 1739 1753 token based char unaligned dcl 1561 in procedure "parse_function_name_and_args" set ref 1582 1588 1613* 1616 token based char unaligned dcl 1471 in procedure "parse_header_line" set ref 1497 1503 1516* token_length 006503 automatic fixed bin(17,0) dcl 1464 in procedure "parse_header_line" set ref 1492* 1497 1503 1516 1516 token_length 000107 automatic fixed bin(17,0) dcl 1551 in procedure "parse_function_name_and_args" set ref 1579* 1582 1588 1601* 1613 1613 1616 token_length 000102 automatic fixed bin(17,0) dcl 2218 in procedure "line_has_label" set ref 2222* 2226 token_length parameter fixed bin(17,0) dcl 1681 in procedure "get_header_token" set ref 1676 1734* token_start 006502 automatic fixed bin(17,0) dcl 1464 in procedure "parse_header_line" set ref 1492* 1497 1503 1510 1516 1520 token_start parameter fixed bin(17,0) dcl 836 in procedure "get_next_bracket_token" set ref 830 849* token_start 000101 automatic fixed bin(17,0) dcl 2218 in procedure "line_has_label" set ref 2222* 2226 token_start 006032 automatic fixed bin(17,0) dcl 605 in procedure "process_bracket_contents" set ref 709* 711* 718* 732* 756* 760* 764* 768* 772* token_start 000106 automatic fixed bin(17,0) dcl 1551 in procedure "parse_function_name_and_args" set ref 1579* 1582 1588 1596* 1601* 1613 1616 1617 1630* token_start parameter fixed bin(17,0) dcl 1681 in procedure "get_header_token" set ref 1676 1719* 1734 token_type parameter fixed bin(17,0) dcl 835 in procedure "get_next_bracket_token" set ref 830 866* 870* 873* 876* 880* token_type 006031 automatic fixed bin(17,0) dcl 605 in procedure "process_bracket_contents" set ref 709* 711 714 trace_control_pointer 5 based pointer level 2 in structure "function_bead" packed unaligned dcl 31-5 in procedure "make_new_function" set ref 1798* trace_control_pointer 5 based pointer level 2 in structure "function_bead" packed unaligned dcl 17-5 in procedure "close_function" set ref 508* 518* trunc builtin function dcl 2033 ref 2064 type based structure level 3 in structure "symbol_bead" packed unaligned dcl 32-13 in procedure "make_new_function" type based structure level 3 in structure "function_bead" packed unaligned dcl 9-5 in procedure "open_function" type based structure level 3 in structure "function_bead" packed unaligned dcl 17-5 in procedure "close_function" set ref 378* type based structure level 2 in structure "general_bead" packed unaligned dcl 14-3 in procedure "close_function" type based structure level 2 in structure "general_bead" packed unaligned dcl 29-3 in procedure "make_new_function" type based structure level 3 in structure "function_bead" packed unaligned dcl 31-5 in procedure "make_new_function" set ref 1793* type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "open_function" type based structure level 3 in structure "symbol_bead" packed unaligned dcl 8-13 in procedure "open_function" type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 18-6 in procedure "close_function" type based structure level 3 in structure "symbol_bead" packed unaligned dcl 16-13 in procedure "close_function" type based structure level 2 in structure "general_bead" packed unaligned dcl 6-3 in procedure "open_function" unlocked_message 000150 constant char(28) initial unaligned dcl 334 set ref 407 407 407 407 values 2 based structure level 2 dcl 39-16 verify builtin function dcl 71 ref 131 847 856 1709 1726 1753 verify_substitute 006254 automatic bit(1) initial unaligned dcl 1084 set ref 1084* 1165* 1221 was_in_quotes 006464 automatic bit(1) unaligned dcl 1345 set ref 1390* 1407 1427* whitespace 000102 automatic char(2) initial unaligned dcl 843 set ref 843* 847 whitespace_NL_string 000157 constant char(3) initial unaligned dcl 50 ref 131 whitespace_string constant char(2) initial unaligned dcl 1690 ref 1709 width 3 based fixed bin(17,0) level 3 dcl 39-16 ref 2100 2100 2100 2100 ws_info based structure level 1 dcl 13-16 in procedure "close_function" ws_info based structure level 1 dcl 39-16 in procedure "edit_one_line" ws_info based structure level 1 dcl 5-16 in procedure "open_function" ws_info_ptr 005732 automatic pointer initial dcl 5-7 in procedure "open_function" set ref 274 5-7* ws_info_ptr 000432 automatic pointer initial dcl 39-7 in procedure "edit_one_line" set ref 2100 2100 2100 2100 39-7* ws_info_ptr 005772 automatic pointer initial dcl 13-7 in procedure "close_function" set ref 450 13-7* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Binary internal static bit(1) initial dcl 1-16 LeftArgSymbol internal static fixed bin(17,0) initial dcl 18-36 in procedure "close_function" LeftArgSymbol internal static fixed bin(17,0) initial dcl 10-36 in procedure "open_function" NumberSize internal static fixed bin(4,0) initial dcl 1-25 QAlpha internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QAlpha internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QAndSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QAndSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QApostrophe internal static char(1) initial unaligned dcl 22-11 QBackSlash internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QBackSlash internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QBackSlashHyphen internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QBackSlashHyphen internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QBackSpace internal static char(1) initial unaligned dcl 22-11 QBell internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QBell internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCap internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCap internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCeiling internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCeiling internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCentSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCentSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircle internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircle internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCircleBackSlash internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircleBackSlash internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCircleBar internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircleBar internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCircleHyphen internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCircleHyphen internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircleSlash internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCircleSlash internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircleStar internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCircleStar internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QColon internal static char(1) initial unaligned dcl 22-11 QComma internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QComma internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCommaHyphen internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QCommaHyphen internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QConditionalNewLine internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QConditionalNewLine internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCup internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QCup internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDeCode internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDeCode internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDel internal static char(1) initial unaligned dcl 22-11 QDelTilde internal static char(1) initial unaligned dcl 22-11 QDelta internal static char(1) initial unaligned dcl 22-11 QDelta_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDelta_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDiamond internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDiamond internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDiaresis internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDiaresis internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDivision internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDivision internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDollar internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDollar internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDomino internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QDomino internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDownArrow internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QDownArrow internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QEight internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QEight internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QEight_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QEight_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QEnCode internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QEnCode internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QEpsilon internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QEpsilon internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QEqual internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QEqual internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QExclamation internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QExclamation internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QExecuteSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QExecuteSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFive internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFive internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QFive_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFive_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QFloor internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QFloor internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFormatSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFormatSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QFour internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFour internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QFour_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QFour_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QGradeDown internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QGradeDown internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QGradeUp internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QGradeUp internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QGreaterOrEqual internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QGreaterOrEqual internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QGreaterThan internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QGreaterThan internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QIBeam internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QIBeam internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QIota internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QIota internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLamp internal static char(1) initial unaligned dcl 22-11 QLeftArrow internal static char(1) initial unaligned dcl 22-11 QLeftBrace internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLeftBrace internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLeftBracket internal static char(1) initial unaligned dcl 22-11 QLeftLump internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLeftLump internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLeftParen internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLeftParen internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLeftTack internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLeftTack internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLessOrEqual internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLessOrEqual internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLessThan internal static char(1) initial unaligned dcl 2-11 QLetterA internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterA internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterA_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterA_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterB internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterB internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterB_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterB_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterC internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterC internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterC_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterC_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterD internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterD internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterD_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterD_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterE internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterE internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterE_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterE_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterF internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterF internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterF_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterF_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterG internal static char(1) initial unaligned dcl 2-11 QLetterG_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterG_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterH internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterH internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterH_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterH_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterI internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterI internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterI_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterI_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterJ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterJ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterJ_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterJ_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterK internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterK internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterK_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterK_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterL internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterL internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterL_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterL_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterM internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterM internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterM_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterM_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterN internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterN internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterN_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterN_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterO internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterO internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterO_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterO_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterP internal static char(1) initial unaligned dcl 2-11 QLetterP_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterP_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterQ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterQ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterQ_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterQ_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterR internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterR internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterR_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterR_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterS internal static char(1) initial unaligned dcl 2-11 QLetterS_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterS_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterT internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterT internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterT_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterT_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterU internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterU internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterU_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterU_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterV internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterV internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterV_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterV_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterW internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterW internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterW_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterW_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterX internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterX internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterX_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterX_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterY internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterY internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterY_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterY_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterZ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLetterZ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterZ_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QLetterZ_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLineFeed internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QLineFeed internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QMarkError internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QMarkError internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QMinus internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QMinus internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QNandSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QNandSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QNewLine internal static char(1) initial unaligned dcl 22-11 QNine internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QNine internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QNine_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QNine_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QNorSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QNorSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QNotEqual internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QNotEqual internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QOmega internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QOmega internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QOne internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QOne internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QOne_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QOne_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QOrSign internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QOrSign internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QPeriod internal static char(1) initial unaligned dcl 22-11 QPlus internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QPlus internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QQuad internal static char(1) initial unaligned dcl 22-11 QQuadQuote internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QQuadQuote internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QQuestion internal static char(1) initial unaligned dcl 2-11 QRho internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QRho internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QRightArrow internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QRightArrow internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QRightBrace internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QRightBrace internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QRightBracket internal static char(1) initial unaligned dcl 22-11 QRightLump internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QRightLump internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QRightParen internal static char(1) initial unaligned dcl 22-11 QRightTack internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QRightTack internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSemiColon internal static char(1) initial unaligned dcl 22-11 QSeven internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSeven internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSeven_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSeven_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSix internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSix internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSix_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSix_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSlashHyphen internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSlashHyphen internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSmallCircle internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QSmallCircle internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSpace internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QSpace internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QStar internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QStar internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QTab internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QTab internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QThree internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QThree internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QThree_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QThree_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QTilde internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QTilde internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QTimes internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QTimes internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QTwo internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QTwo internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QTwo_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QTwo_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QUnderLine internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QUnderLine internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QUpArrow internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QUpArrow internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QUpperMinus internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QUpperMinus internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QVerticalBar internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QVerticalBar internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QZero internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QZero internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" QZero_ internal static char(1) initial unaligned dcl 22-11 in procedure "context_editor" QZero_ internal static char(1) initial unaligned dcl 2-11 in procedure "apl_editor_" ReturnSymbol internal static fixed bin(17,0) initial dcl 18-36 in procedure "close_function" ReturnSymbol internal static fixed bin(17,0) initial dcl 10-36 in procedure "open_function" RightArgSymbol internal static fixed bin(17,0) initial dcl 10-36 in procedure "open_function" RightArgSymbol internal static fixed bin(17,0) initial dcl 18-36 in procedure "close_function" TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 bol_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" bol_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" character_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" character_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" character_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" character_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" character_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" close_paren_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" close_paren_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" close_rank_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" close_rank_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" close_subscript_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" close_subscript_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" complex_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" complex_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" complex_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" complex_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" complex_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" diamond_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" diamond_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" eol_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" eol_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" evaluated_frame_type internal static fixed bin(17,0) initial dcl 19-22 in procedure "close_function" evaluated_frame_type internal static fixed bin(17,0) initial dcl 11-22 in procedure "open_function" execute_frame_type internal static fixed bin(17,0) initial dcl 19-22 in procedure "close_function" execute_frame_type internal static fixed bin(17,0) initial dcl 11-22 in procedure "open_function" function_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" function_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" function_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" group_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" group_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" group_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" group_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" group_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" integral_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" integral_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" integral_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" integral_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" integral_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" label_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" label_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" label_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" label_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" label_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" lexed_function_bead based structure level 1 dcl 10-6 lexed_function_label_values_structure based structure level 1 dcl 10-45 lexed_function_lexemes_structure based structure level 1 dcl 10-45 in procedure "open_function" lexed_function_lexemes_structure based structure level 1 dcl 18-45 in procedure "close_function" lexed_function_statement_map based fixed bin(18,0) array dcl 18-45 in procedure "close_function" lexed_function_statement_map based fixed bin(18,0) array dcl 10-45 in procedure "open_function" lexed_function_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" lexed_function_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" lexed_function_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" lexed_function_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" lexed_function_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" line_number_pic automatic picture(11) unaligned dcl 2240 list_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" list_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" list_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" list_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" list_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" max_parse_stack_depth internal static fixed bin(17,0) initial dcl 39-98 in procedure "edit_one_line" max_parse_stack_depth internal static fixed bin(17,0) initial dcl 13-98 in procedure "close_function" max_parse_stack_depth internal static fixed bin(17,0) initial dcl 5-98 in procedure "open_function" not_integer_mask internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" not_integer_mask internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" not_integer_mask internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" not_integer_mask internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" not_integer_mask internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" not_zero_or_one_mask internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" not_zero_or_one_mask internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" not_zero_or_one_mask internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" not_zero_or_one_mask internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" not_zero_or_one_mask internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" number_of_ptrs automatic fixed bin(17,0) dcl 19-20 in procedure "close_function" number_of_ptrs automatic fixed bin(17,0) dcl 11-20 in procedure "open_function" numeric_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" numeric_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" numeric_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" numeric_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" numeric_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" op_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" op_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" open_bracket_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" open_bracket_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" open_paren_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" open_paren_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" operator_bead based structure level 1 dcl 30-3 operator_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" operator_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" operator_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" operator_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" operator_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" output_buffer based char unaligned dcl 5-94 in procedure "open_function" output_buffer based char unaligned dcl 13-94 in procedure "close_function" output_buffer based char unaligned dcl 39-94 in procedure "edit_one_line" reduction_stack based structure array level 1 dcl 11-31 in procedure "open_function" reduction_stack based structure array level 1 dcl 19-31 in procedure "close_function" reduction_stack_for_op based structure array level 1 dcl 11-31 in procedure "open_function" reduction_stack_for_op based structure array level 1 dcl 19-31 in procedure "close_function" reductions_pointer automatic pointer dcl 19-29 in procedure "close_function" reductions_pointer automatic pointer dcl 11-29 in procedure "open_function" rtrim builtin function dcl 2251 in procedure "prompt" rtrim builtin function dcl 1925 in procedure "print_function_lines" save_frame_type internal static fixed bin(17,0) initial dcl 11-22 in procedure "open_function" save_frame_type internal static fixed bin(17,0) initial dcl 19-22 in procedure "close_function" semi_colon_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" semi_colon_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" shared_variable_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" shared_variable_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" shared_variable_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" shared_variable_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" shared_variable_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" statement_count automatic fixed bin(17,0) dcl 18-45 in procedure "close_function" statement_count automatic fixed bin(17,0) dcl 10-45 in procedure "open_function" subscript_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" subscript_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" symbol_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" symbol_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" symbol_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" symbol_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" symbol_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" val_type internal static fixed bin(17,0) initial dcl 19-31 in procedure "close_function" val_type internal static fixed bin(17,0) initial dcl 11-31 in procedure "open_function" value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" zero_or_one_value_type internal static bit(18) initial unaligned dcl 41-30 in procedure "decrement_reference_count" zero_or_one_value_type internal static bit(18) initial unaligned dcl 6-30 in procedure "open_function" zero_or_one_value_type internal static bit(18) initial unaligned dcl 14-30 in procedure "close_function" zero_or_one_value_type internal static bit(18) initial unaligned dcl 34-30 in procedure "assign_line_numbers" zero_or_one_value_type internal static bit(18) initial unaligned dcl 29-30 in procedure "make_new_function" NAMES DECLARED BY EXPLICIT CONTEXT. apl_editor_ 000363 constant entry external dcl 30 apl_editor_cleanup 013173 constant entry internal dcl 2483 ref 96 148 160 258 264 269 290 1479 1859 apl_editor_return_point 001126 constant label dcl 192 ref 2499 ask_if_substitute_is_ok 005645 constant label dcl 1228 ref 1239 assign_line_numbers 010237 constant entry internal dcl 1813 ref 297 304 439 check_function_compatibility 002444 constant entry internal dcl 526 ref 471 close_function 001604 constant entry internal dcl 310 ref 159 context_editor 004075 constant entry internal dcl 892 ref 180 context_global_print 005774 constant entry internal dcl 1259 ref 946 context_search 004452 constant entry internal dcl 958 ref 930 938 context_substitute 005044 constant entry internal dcl 1070 ref 943 decrement_reference_count 012750 constant entry internal dcl 2391 ref 244 431 476 477 edit_one_line 011122 constant entry internal dcl 1986 ref 796 error 013064 constant entry internal dcl 2448 ref 156 165 711 718 732 756 760 764 768 772 791 940 948 953 1005 1066 1113 1127 1149 1182 1193 1284 1298 1413 1894 2061 2100 2370 error_join 013117 constant label dcl 2473 ref 2466 get_header_token 007732 constant entry internal dcl 1676 ref 1492 1579 1601 2222 get_line_info_idx 013010 constant entry internal dcl 2420 ref 1022 1177 1362 2043 get_next_bracket_token 003711 constant entry internal dcl 830 ref 709 got_bad_token 004067 constant label dcl 880 ref 858 increment_line_number 011722 constant entry internal dcl 2151 ref 187 internal_error_restart 000561 constant label dcl 123 ref 110 2477 line_has_label 012204 constant entry internal dcl 2212 ref 1967 line_number_to_string 012014 constant entry internal dcl 2173 ref 1224 1969 2048 2255 line_number_to_string_with_label 012025 constant entry internal dcl 2191 ref 1967 lnts_join 012034 constant label dcl 2196 ref 2189 make_new_function 010125 constant entry internal dcl 1759 ref 302 new_state 000000 constant label array(13) dcl 718 ref 716 open_function 001127 constant entry internal dcl 195 ref 100 parse_function_name_and_args 007060 constant entry internal dcl 1537 ref 414 1477 parse_header_line 006611 constant entry internal dcl 1453 ref 235 perform_action 000015 constant label array(7) dcl 780 ref 752 print_function_lines 010530 constant entry internal dcl 1902 ref 785 799 804 1059 1252 1322 process_another 003054 constant label dcl 705 ref 730 744 746 process_bracket_contents 002563 constant entry internal dcl 591 ref 172 process_new_function_line 006230 constant entry internal dcl 1332 ref 185 prompt 012307 constant entry internal dcl 2232 ref 123 read_line 012350 constant entry internal dcl 2262 ref 125 1231 1438 2077 2137 reattach_user_input 012464 constant entry internal dcl 2317 ref 2306 report_error 013103 constant entry internal dcl 2468 ref 252 257 263 268 289 493 1596 1604 1630 1858 reset_read_back_output_mode 012661 constant entry internal dcl 2375 ref 2129 2139 set_read_back_output_mode 012557 constant entry internal dcl 2346 ref 2133 validate_identifier 010071 constant entry internal dcl 1739 ref 1516 1613 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 103 118 131 135 143 156 156 177 178 185 407 407 709 711 718 732 756 760 764 768 772 791 791 928 930 936 938 940 943 946 948 950 1396 1398 1413 1416 1434 1434 1436 1497 1497 1503 1503 1516 1516 1582 1582 1588 1588 1613 1613 1616 1616 1962 1962 1973 1973 1981 1981 2292 2292 2369 2369 addrel builtin function ref 1962 1962 1973 1973 1981 1981 fixed builtin function ref 861 index builtin function ref 853 1000 1053 1122 1144 1188 1293 1320 1721 1855 lbound builtin function ref 809 1027 1313 1933 null builtin function ref 88 89 249 274 274 2341 2341 2382 2406 2415 2473 2473 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 15636 16166 14311 15646 Length 17760 14311 330 1556 1325 42 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_editor_ 4110 external procedure is an external procedure. on unit on line 96 70 on unit on unit on line 110 64 on unit open_function internal procedure shares stack frame of external procedure apl_editor_. close_function internal procedure shares stack frame of external procedure apl_editor_. check_function_compatibility internal procedure shares stack frame of external procedure apl_editor_. process_bracket_contents internal procedure shares stack frame of external procedure apl_editor_. get_next_bracket_token 234 internal procedure enables or reverts conditions. on unit on line 858 64 on unit context_editor internal procedure shares stack frame of external procedure apl_editor_. context_search internal procedure shares stack frame of external procedure apl_editor_. context_substitute internal procedure shares stack frame of external procedure apl_editor_. context_global_print internal procedure shares stack frame of external procedure apl_editor_. process_new_function_line internal procedure shares stack frame of external procedure apl_editor_. parse_header_line internal procedure shares stack frame of external procedure apl_editor_. parse_function_name_and_args 372 internal procedure is called during a stack extension. get_header_token 67 internal procedure is called by several nonquick procedures. validate_identifier 65 internal procedure is called by several nonquick procedures. make_new_function 76 internal procedure is called during a stack extension. assign_line_numbers internal procedure shares stack frame of external procedure apl_editor_. print_function_lines internal procedure shares stack frame of external procedure apl_editor_. edit_one_line 327 internal procedure enables or reverts conditions. on unit on line 2127 72 on unit increment_line_number internal procedure shares stack frame of external procedure apl_editor_. line_number_to_string 75 internal procedure is called by several nonquick procedures. line_has_label 92 internal procedure is called during a stack extension. prompt internal procedure shares stack frame of external procedure apl_editor_. read_line 118 internal procedure is called by several nonquick procedures. reattach_user_input internal procedure shares stack frame of internal procedure read_line. set_read_back_output_mode 92 internal procedure is called by several nonquick procedures. decrement_reference_count internal procedure shares stack frame of external procedure apl_editor_. get_line_info_idx 65 internal procedure is called by several nonquick procedures. error 96 internal procedure is called during a stack extension. apl_editor_cleanup 68 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 first_time_in_process process_bracket_contents 000011 state_table process_bracket_contents STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_editor_ 000100 input_buffer apl_editor_ 000200 input_line_length apl_editor_ 000201 character_pos apl_editor_ 000202 character apl_editor_ 000203 current_line_number apl_editor_ 000206 line_pos apl_editor_ 000207 got_line apl_editor_ 000210 quit_force apl_editor_ 000211 saved_search_string apl_editor_ 000266 function_info apl_editor_ 005720 header_start open_function 005721 header_length open_function 005722 complicated_header open_function 005723 last_frame_was_suspended open_function 005724 function_bead_ptr open_function 005726 lexed_function_bead_ptr open_function 005730 parse_frame_ptr open_function 005732 ws_info_ptr open_function 005742 character_pos close_function 005743 line_count close_function 005744 reported_si_damage close_function 005746 scratch_space_ptr close_function 005750 function_bead_ptr close_function 005751 lexed_function_bead_ptr close_function 005752 function_name close_function 005764 parse_frame_ptr close_function 005766 data_elements close_function 005767 last_frame_was_suspended close_function 005770 bad_header close_function 005771 lex_errors_occurred close_function 005772 ws_info_ptr close_function 006004 indx check_function_compatibility 006006 new_labels_ptr check_function_compatibility 006010 new_lfbp check_function_compatibility 006012 old_labels_ptr check_function_compatibility 006014 old_lfbp check_function_compatibility 006026 state process_bracket_contents 006027 last_state process_bracket_contents 006030 count process_bracket_contents 006031 token_type process_bracket_contents 006032 token_start process_bracket_contents 006033 gotten_number process_bracket_contents 006036 left_number process_bracket_contents 006041 right_number process_bracket_contents 006054 char context_editor 006064 search_string_start context_search 006065 search_string context_search 006126 starting_line_idx context_search 006127 increment context_search 006130 end_of_first_half context_search 006131 start_of_second_half context_search 006132 idx context_search 006133 line_idx context_search 006150 string_start context_substitute 006151 string1 context_substitute 006212 string2 context_substitute 006253 idx context_substitute 006254 verify_substitute context_substitute 006255 show_substitute context_substitute 006256 line_idx context_substitute 006257 old_start context_substitute 006260 old_length context_substitute 006261 first_free_char context_substitute 006262 old_tail_length context_substitute 006264 answer_buffer context_substitute 006266 answer_length context_substitute 006267 prompt_string context_substitute 006302 string_start context_global_print 006303 idx context_global_print 006304 string context_global_print 006345 first_idx context_global_print 006346 line_idx context_global_print 006347 line_start context_global_print 006350 line_length context_global_print 006360 input_buffer process_new_function_line 006460 input_line_length process_new_function_line 006461 line_pos process_new_function_line 006462 del_pos process_new_function_line 006463 in_quotes process_new_function_line 006464 was_in_quotes process_new_function_line 006465 got_line process_new_function_line 006466 replacing_old_line process_new_function_line 006467 count process_new_function_line 006470 line_info_idx process_new_function_line 006502 token_start parse_header_line 006503 token_length parse_header_line 006504 done parse_header_line 006505 last_token_was_semicolon parse_header_line 006506 ran_out_of_tokens parse_header_line 006507 bad_header parse_header_line 006510 code2 parse_header_line 006520 function_bead_ptr assign_line_numbers 006522 in_quotes assign_line_numbers 006523 real_line_start assign_line_numbers 006524 line_start assign_line_numbers 006525 real_line_length assign_line_numbers 006526 line_length assign_line_numbers 006527 line_pos assign_line_numbers 006530 line_counter assign_line_numbers 006540 first_array_idx print_function_lines 006541 last_array_idx print_function_lines 006542 count print_function_lines 006543 output_line print_function_lines 006644 code print_function_lines 006656 incremented_line_number increment_line_number 006661 line_number_pic increment_line_number 006664 power increment_line_number 006674 prompt_string prompt edit_one_line 000100 count edit_one_line 000101 idx edit_one_line 000102 original_line edit_one_line 000202 input_line edit_one_line 000302 output_line edit_one_line 000402 original_line_length edit_one_line 000403 input_line_length edit_one_line 000404 output_line_length edit_one_line 000405 line_info_idx edit_one_line 000406 prompt_string edit_one_line 000414 integer_part edit_one_line 000416 first_insertion edit_one_line 000417 amount_to_insert edit_one_line 000420 character edit_one_line 000421 old_mode edit_one_line 000431 code edit_one_line 000432 ws_info_ptr edit_one_line error 000100 fatal error get_header_token 000100 new_pos get_header_token get_next_bracket_token 000100 character get_next_bracket_token 000101 number_length get_next_bracket_token 000102 whitespace get_next_bracket_token line_has_label 000100 current_pos line_has_label 000101 token_start line_has_label 000102 token_length line_has_label line_number_to_string 000100 line_number_pic line_number_to_string 000103 return_string line_number_to_string 000110 number_of_spaces line_number_to_string make_new_function 000100 data_elements make_new_function 000101 function_bead_ptr make_new_function parse_function_name_and_args 000100 id_number parse_function_name_and_args 000101 phony_number_of_ids parse_function_name_and_args 000102 last_identifier parse_function_name_and_args 000103 found_left_arrow parse_function_name_and_args 000104 done parse_function_name_and_args 000105 old_character_pos parse_function_name_and_args 000106 token_start parse_function_name_and_args 000107 token_length parse_function_name_and_args 000110 code parse_function_name_and_args 000111 identifiers parse_function_name_and_args read_line 000100 got_line read_line 000101 have_reattached_user_input read_line 000102 code read_line 000112 code reattach_user_input set_read_back_output_mode 000100 code set_read_back_output_mode THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs unpk_to_pk call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return tra_ext enable shorten_stack ext_entry_desc int_entry int_entry_desc set_cs_eis index_cs_eis verify_eis any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_allocate_words_ apl_allocate_words_ apl_command_$from_editor apl_create_save_frame_ apl_destroy_save_frame_update_ apl_error_ apl_free_bead_ apl_function_lex_ apl_get_symbol_ apl_get_symbol_ apl_segment_manager_$free apl_segment_manager_$get apl_system_error_ continue_to_signal_ decimal_exp_ ioa_$ioa_switch ioa_$ioa_switch ioa_$ioa_switch iox_$attach_ptr iox_$close iox_$control iox_$detach_iocb iox_$get_line iox_$put_chars iox_$put_chars iox_$put_chars iox_$put_chars ipc_$mask_ev_calls ipc_$unmask_ev_calls THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$bad_context_request apl_error_table_$bad_function_header apl_error_table_$bad_function_header apl_error_table_$bad_global_print apl_error_table_$bad_substitute apl_error_table_$bad_token_in_brackets apl_error_table_$cant_read_input apl_error_table_$complicated_header_line apl_error_table_$edited_pendent_fcn apl_error_table_$empty_editor_brackets apl_error_table_$external_function_edited apl_error_table_$extra_text apl_error_table_$extra_text apl_error_table_$labels_differ apl_error_table_$line_too_long_to_edit apl_error_table_$locals_differ apl_error_table_$locked_function_edited apl_error_table_$mismatched_editor_quotes apl_error_table_$mismatched_editor_quotes apl_error_table_$misplaced_left_arrow apl_error_table_$missing_function_name apl_error_table_$missing_number apl_error_table_$missing_number_or_rb apl_error_table_$missing_quad_or_rb apl_error_table_$missing_rb apl_error_table_$missing_slash apl_error_table_$missing_slash apl_error_table_$missing_slash apl_error_table_$n_labels_differ apl_error_table_$n_locals_differ apl_error_table_$non_function_edited apl_error_table_$not_end_with_newline apl_error_table_$pendent_function_edited apl_error_table_$suspended_header apl_static_$apl_input apl_static_$apl_input apl_static_$apl_output apl_static_$apl_output apl_static_$apl_output apl_static_$apl_output apl_static_$apl_output apl_static_$apl_output apl_static_$apl_output apl_static_$ws_info_ptr apl_static_$ws_info_ptr apl_static_$ws_info_ptr error_table_$end_of_info error_table_$not_closed error_table_$short_record iox_$user_input sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 30 000357 45 000376 46 000400 83 000401 85 000403 86 000405 87 000407 88 000411 89 000413 90 000414 92 000415 94 000423 96 000430 99 000455 100 000461 102 000502 103 000506 104 000522 106 000524 110 000533 115 000552 116 000553 118 000556 123 000561 125 000563 126 000577 129 000601 131 000603 132 000622 135 000627 136 000632 138 000633 143 000634 145 000641 148 000650 151 000660 153 000666 155 000670 156 000671 159 000720 160 000733 162 000745 164 000750 165 000752 167 000774 170 000775 172 000776 175 001031 177 001033 178 001062 179 001065 180 001066 185 001074 187 001123 190 001125 192 001126 195 001127 5 7 001140 235 001143 239 001177 244 001233 247 001250 249 001255 252 001261 255 001306 257 001311 258 001334 261 001343 263 001347 264 001372 265 001401 266 001402 268 001404 269 001427 272 001436 274 001441 279 001454 283 001463 289 001473 290 001516 291 001525 292 001526 293 001532 295 001533 297 001536 299 001545 302 001546 304 001573 306 001603 310 001604 13 7 001606 369 001611 371 001612 372 001613 373 001623 374 001630 376 001632 378 001650 379 001653 381 001655 382 001657 384 001671 387 001705 388 001707 390 001711 392 001722 394 001761 396 001764 399 001767 401 001772 404 001776 405 001777 407 002001 414 002022 418 002117 420 002123 421 002127 424 002130 426 002164 427 002171 429 002172 431 002177 432 002210 433 002215 437 002220 439 002223 440 002231 443 002243 444 002244 450 002245 454 002260 458 002267 460 002271 471 002302 474 002314 476 002317 477 002326 479 002335 480 002340 483 002342 485 002344 488 002346 489 002347 491 002352 493 002355 496 002400 499 002402 501 002403 503 002406 506 002413 507 002416 508 002420 509 002421 512 002422 513 002424 514 002426 518 002434 519 002436 524 002443 526 002444 550 002446 551 002454 553 002462 561 002470 564 002477 567 002512 572 002514 573 002517 575 002522 576 002533 579 002546 581 002550 583 002553 585 002557 591 002563 657 002574 659 002577 660 002605 661 002612 662 002617 664 002624 665 002632 666 002637 667 002644 669 002651 670 002657 671 002664 672 002671 674 002676 675 002704 676 002711 677 002716 679 002723 680 002731 681 002736 682 002743 684 002750 685 002756 686 002763 687 002770 689 002775 690 003003 691 003010 692 003015 694 003022 695 003030 696 003035 697 003042 699 003047 702 003050 703 003052 705 003054 709 003056 711 003110 714 003140 716 003146 718 003147 729 003203 730 003210 732 003211 740 003245 744 003251 746 003252 752 003253 756 003255 760 003301 764 003326 768 003353 772 003400 780 003425 783 003434 785 003435 788 003452 789 003461 791 003462 796 003511 797 003551 799 003552 802 003572 804 003573 807 003610 809 003611 813 003633 815 003635 819 003650 821 003661 822 003672 824 003674 827 003700 828 003707 830 003710 843 003724 847 003726 849 003747 851 003750 853 003755 856 003766 858 004004 861 004023 862 004040 864 004041 866 004044 867 004046 870 004047 873 004055 876 004062 880 004067 882 004072 885 004073 888 004074 892 004075 924 004106 928 004110 930 004116 933 004165 935 004167 936 004170 938 004175 940 004242 941 004266 943 004267 946 004325 948 004357 950 004403 952 004407 953 004427 956 004451 958 004452 995 004463 996 004465 1000 004467 1002 004506 1004 004507 1005 004513 1008 004535 1010 004542 1014 004554 1016 004570 1018 004576 1022 004577 1027 004614 1036 004626 1038 004634 1039 004636 1040 004640 1041 004643 1043 004644 1044 004646 1045 004651 1048 004653 1053 004676 1055 004717 1058 004721 1059 004730 1061 004744 1063 004745 1065 005000 1066 005021 1068 005043 1070 005044 1084 005055 1085 005056 1111 005057 1113 005061 1116 005111 1118 005113 1122 005115 1124 005134 1126 005135 1127 005141 1130 005163 1132 005170 1136 005202 1138 005216 1140 005224 1142 005225 1144 005227 1146 005245 1148 005246 1149 005252 1152 005274 1154 005301 1156 005313 1160 005314 1163 005317 1165 005324 1168 005331 1171 005336 1177 005337 1179 005354 1181 005357 1182 005377 1185 005421 1186 005430 1188 005432 1190 005445 1192 005446 1193 005466 1199 005510 1203 005514 1205 005525 1209 005531 1211 005536 1215 005540 1217 005547 1219 005556 1221 005560 1224 005562 1226 005574 1228 005645 1231 005665 1232 005701 1234 005703 1236 005711 1238 005715 1239 005740 1248 005741 1249 005750 1250 005753 1252 005755 1255 005773 1259 005774 1282 006005 1284 006007 1287 006037 1289 006041 1293 006043 1295 006062 1297 006063 1298 006067 1301 006111 1303 006116 1307 006130 1309 006144 1311 006152 1313 006153 1315 006155 1317 006165 1318 006173 1320 006175 1322 006210 1324 006225 1326 006227 1332 006230 1362 006241 1364 006257 1367 006265 1374 006266 1376 006301 1377 006312 1386 006315 1387 006330 1389 006333 1390 006334 1391 006335 1393 006336 1395 006340 1396 006341 1398 006351 1400 006355 1403 006363 1405 006371 1407 006373 1410 006404 1413 006406 1416 006434 1419 006461 1421 006464 1423 006466 1424 006471 1427 006472 1430 006477 1431 006501 1434 006505 1436 006535 1438 006547 1441 006565 1443 006566 1444 006602 1447 006605 1450 006610 1453 006611 1475 006622 1477 006625 1479 006677 1482 006711 1484 006715 1489 006721 1490 006722 1492 006724 1494 006754 1497 006761 1499 006774 1500 006777 1501 007001 1503 007002 1508 007011 1510 007013 1511 007015 1512 007017 1516 007020 1518 007041 1520 007043 1521 007046 1526 007050 1529 007051 1531 007052 1532 007056 1537 007057 1554 007117 1571 007140 1572 007151 1574 007165 1575 007167 1577 007205 1579 007207 1580 007237 1582 007247 1584 007260 1585 007263 1586 007267 1588 007270 1594 007274 1596 007277 1597 007322 1598 007327 1601 007330 1602 007360 1604 007362 1605 007406 1606 007413 1609 007414 1613 007416 1614 007444 1616 007446 1617 007465 1618 007467 1620 007470 1621 007473 1626 007475 1628 007477 1630 007504 1631 007530 1632 007535 1635 007536 1637 007541 1639 007554 1641 007557 1646 007561 1647 007572 1648 007576 1649 007601 1650 007602 1655 007603 1658 007605 1659 007622 1660 007634 1661 007646 1662 007652 1663 007653 1666 007655 1667 007672 1668 007704 1669 007710 1670 007711 1673 007730 1676 007731 1695 007745 1697 007747 1699 007751 1700 007753 1702 007754 1704 007762 1705 007763 1706 007765 1709 007766 1711 010005 1713 010006 1714 010012 1715 010014 1717 010015 1719 010020 1721 010021 1726 010033 1728 010052 1730 010057 1731 010062 1732 010063 1734 010064 1735 010067 1739 010070 1751 010104 1753 010106 1756 010123 1759 010124 1786 010140 1788 010141 1791 010150 1793 010165 1795 010170 1796 010172 1797 010173 1798 010174 1800 010175 1804 010177 1806 010223 1808 010232 1809 010236 1813 010237 1847 010241 1848 010245 1849 010246 1850 010251 1851 010252 1853 010253 1855 010260 1856 010300 1858 010301 1859 010335 1862 010345 1864 010357 1866 010372 1869 010402 1871 010404 1873 010406 1875 010410 1876 010411 1877 010413 1880 010414 1883 010427 1884 010444 1885 010446 1887 010450 1888 010451 1890 010454 1892 010455 1894 010457 1897 010521 1899 010527 1902 010530 1933 010532 1935 010554 1937 010556 1940 010564 1943 010600 1945 010602 1948 010607 1951 010617 1955 010623 1957 010632 1958 010647 1959 010650 1960 010651 1962 010660 1965 010704 1967 010713 1969 010772 1971 011014 1973 011036 1974 011062 1976 011064 1979 011070 1981 011074 1983 011120 1986 011121 39 7 011135 2041 011137 2043 011150 2045 011165 2048 011167 2050 011201 2051 011205 2053 011207 2055 011216 2056 011225 2060 011226 2061 011241 2064 011272 2066 011300 2069 011304 2072 011310 2074 011327 2075 011332 2077 011360 2078 011375 2080 011406 2081 011407 2082 011411 2083 011412 2085 011421 2086 011425 2088 011430 2090 011442 2092 011443 2094 011451 2097 011453 2098 011460 2100 011461 2102 011523 2106 011524 2108 011526 2111 011534 2113 011536 2115 011555 2118 011557 2121 011560 2122 011563 2125 011566 2127 011571 2129 011605 2130 011617 2131 011627 2133 011630 2135 011641 2137 011660 2139 011675 2141 011706 2143 011707 2144 011716 2145 011717 2147 011721 2151 011722 2166 011724 2167 011730 2168 011756 2169 012004 2173 012013 2188 012021 2189 012023 2191 012024 2194 012032 2196 012034 2199 012042 2200 012046 2201 012073 2202 012123 2204 012135 2206 012147 2209 012173 2212 012203 2220 012217 2222 012221 2223 012253 2226 012265 2228 012302 2232 012307 2255 012311 2257 012321 2259 012346 2262 012347 2287 012363 2288 012364 2290 012365 2292 012370 2293 012414 2295 012421 2297 012424 2298 012426 2299 012433 2300 012435 2301 012436 2303 012440 2306 012450 2307 012451 2308 012453 2309 012454 2310 012462 2311 012463 2317 012464 2335 012465 2336 012476 2338 012502 2339 012512 2341 012523 2343 012555 2346 012556 2367 012572 2369 012600 2370 012633 2373 012657 2375 012660 2379 012674 2382 012703 2384 012732 2386 012741 2388 012747 2391 012750 2406 012752 2409 012762 2411 012765 2414 012770 2415 012777 2417 013006 2420 013007 2430 013015 2432 013017 2434 013040 2436 013042 2438 013046 2439 013050 2442 013051 2445 013062 2448 013063 2465 013077 2466 013101 2468 013102 2471 013116 2473 013117 2477 013164 2479 013171 2483 013172 2495 013200 2497 013207 2499 013214 ----------------------------------------------------------- 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