COMPILATION LISTING OF SEGMENT apl_lex_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1607.7 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 /* format: style3 */ 11 apl_lex_: 12 procedure; 13 14 /* 15* * apl_lex_ 16* * 17* * This module converts a character string into a lexed_function bead. 18* * It is called after a function is edited, by the QuadFX function, by the execute operator, 19* * and when a function is called that had not yet been lexed after a )LOAD. 20* * 21* * apl_lex_ is the first pass of the APL parser. It does a left to right scan 22* * and produces a lexed_function bead which includes an array of packed pointers 23* * called lexemes. Each lexeme points to a value bead, a symbol bead, or an operator bead. 24* * The second pass of the parser is a right to left scan of the lexemes done at run time 25* * 26* * Entries: 27* * apl_line_lex_ processes a line of evaluated input 28* * apl_function_lex_ processes the definition of a function, including the header line 29* * apl_scan_ gets next token in a character string - for editor and apl_command_ 30* * apl_execute_lex_ same as apl_line_lex_ except errors work differently. Used by the execute operator 31* * canonicalize_apl_line_ canonicalizes spacing and number format in apl lines - used by editor, etc. 32* */ 33 34 35 /* 36* * written 6/20/73 by D A Moon 37* * debugged by DAM at various times during 7/73 38* * apl_scan_ added 7/25/73 by DAM 39* * facilities for the execute operator added 8/7/73 by DAM 40* * modified 8/20/73 by DAM for bug fixing and localization of system variables 41* * Modified 740131 by PG for better error message for misused -> 42* * Modified 740320 by PG to use PL/I EIS conversion routines 43* * Modified July 1974 to fix illegal machine op on outer product with left bracket by G. Gordon Benedict 44* * Modified 741009 by PG to make unbalanced quotes error msg work. 45* * Modified 770106 by PG to add apl_editor_scan_ and fix unbalanced parens to work (bug 193). 46* Modified 780310 by PG to fix bug 314 (not checking for duplicate labels). 47* Modified 780403 by PG to fix bug 318 (fix to 314 broke code to re-lex functions for error position). 48* Modified 780504 by PG to add diamond processing 49* Modified 780613 by PG to fix bug 323 (lex looped if given stmts (between diamonds) of zero length.) 50* Modified 780909 by PG to fix bug 326 (F-<.IQ 1 caused lex to loop & fault), 51* and to diagnose identifiers beginning with an underscore. 52* Modified 780920 by PG to permit -> after semicolons, and to diagnose 53* mixed diamonds and semicolons. 54* Modified 781107 by PG to add argument list processing. 55* Modified 790327 by WMY to fix bug 388, result of lexing a function with no body. 56* A null lexed_function_bead_ptr was returned, now a lexed_funciton_bead 57* with no statements is returned. 58* Modified 800129 by PG to implement localized system variables. 59* Modified 811211 by H. Hoover (UofC) to add qCALL system function. 60* */ 61 62 /* declarations */ 63 64 dcl line_type bit (2) aligned, 65 Diamond_type bit (2) aligned int static init ("01"b), 66 Semicolon_type bit (2) aligned int static init ("10"b); 67 dcl stmt_length_map (100) fixed bin; 68 dcl stmt_number fixed bin; 69 dcl (first_lexeme, line_len, lx, output_index) 70 fixed bin; 71 dcl done bit (1) aligned; 72 dcl parse_frame_ptr ptr; 73 dcl esw fixed bin, /* entry switch */ 74 apl_line_lex_ fixed bin static init (1), /* values for esw */ 75 apl_function_lex_ fixed bin static init (2), /* .. */ 76 apl_scan_ fixed bin static init (0), /* .. */ 77 apl_execute_lex_ fixed bin static init (3), /* .. */ 78 /* canonicalize_apl_line_ fixed bin static init(4), unused for now */ 79 next_lexeme fixed bin, /* type of the next lexeme to be emitted */ 80 lexeme ptr unaligned, /* next lexeme to be emitted */ 81 last_lexeme fixed bin, /* type of the last lexeme that was emitted */ 82 /* type codes which may be the value of next_lexeme, last_lexeme */ 83 BeginOfLine fixed bin static init (1), /* no last lexeme, new line has been started */ 84 OperatorLexeme fixed bin static init (2), 85 ValueLexeme fixed bin static init (4), /* a parenthesized expression */ 86 OpenParenLexeme fixed bin static init (5), /* left paren or left bracket */ 87 ConstantLexeme fixed bin static init (6), /* a numeric or character constant. Has not yet been emitted, 88* but is sitting in stack_value_ptr -> value_bead */ 89 NameLexeme fixed bin static init (7), /* a symbol (name, identifier) */ 90 /* may also be SemiColon */ 91 error_suppress bit (1), /* "1"b to suppress error messages - used by apl_execute_lex_ */ 92 char_index fixed bin (20), /* 0-origin index in the variable text, which is input string */ 93 line_no fixed bin, /* current statement number */ 94 line_index fixed bin (20), /* value of char_index at start of this line */ 95 space_left_in_stack fixed bin, /* number of words left in value stack, if counts down to 0 may 96* have to switch segments */ 97 value_stack_popper ptr, /* saved value of ws_info.value_stack_ptr upon entry */ 98 value_stack_space ptr, /* -> stuff we have pushed onto value stack. 99* may be different from value_stack_popper if we have switched stack segs */ 100 lexeme_index fixed bin, /* index in temp_lexeme_array of next lexeme to be emitted */ 101 1 lexeme_array_alignment_structure 102 aligned based (value_stack_space), 103 2 emission_array (lexeme_index), /* array of emissions */ 104 3 temp_lexeme_array 105 pointer unaligned, /* lexeme */ 106 3 source_pos fixed bin, /* value of char_index afterfirst char of token was read */ 107 temp_lexeme_size fixed bin static init (2), /* size(emission_array(1)) is not allowed and does not work */ 108 char_count fixed bin; /* when this counts up to 0, the end of the string 'text' has been reached */ 109 110 /* parenthesis stuff */ 111 112 dcl paren_level fixed bin, /* index into paren_stack, 0 if top level */ 113 1 paren_stack_structure 114 (1000 /* or so */) aligned based (paren_stack_ptr), 115 2 paren_stack fixed bin, /* type of paen - codes dcl'ed below */ 116 2 paren_loc fixed bin (21), /* value of char_index at left paren */ 117 paren_stack_ptr pointer, /* at begin of line, set above statement_map */ 118 P_S_Parens fixed bin static init (1), /* paren_stack: () */ 119 P_S_Brackets fixed bin static init (2), /* paren_stack: [] */ 120 P_S_Opr_Brackets fixed bin static init (3), 121 /* paren_stack: [] after operator */ 122 P_S_qCALL_Parens fixed bin static init (4); 123 /* paren_stack: () after qCALL system function */ 124 125 dcl code fixed bin (35), /* status code used to generate error messages */ 126 n fixed bin, /* temp */ 127 begin_subscript_calc 128 fixed bin, /* index in temp_lexeme_array of thing getting subscripted-assigned */ 129 chr fixed bin (9), /* APL character code for current character */ 130 temp_ptr ptr unaligned, 131 template_ptr ptr unaligned, /* for making lexed function bead */ 132 hack_ptr pointer aligned, /* see assign: */ 133 NL character static init (" 134 "), 135 ( 136 function_being_lexed, /* -> symbol bead for function name from header line, or null */ 137 left_arg_symbol, /* -> symbol bead for what it says */ 138 right_arg_symbol, /* .. */ 139 return_value_symbol 140 ) /* .. */ pointer unaligned initial (null), 141 name_index fixed bin, /* 0-origin index in the following */ 142 1 name_buffer_array_alignment_structure 143 based (name_buffer_ptr) aligned, 144 /* buffer for building up names of symbols */ 145 2 name_buffer_array 146 (0:(1000) /* or so */) fixed bin (8) unaligned, 147 /* overlay on character string */ 148 1 name_buffer_alignme_structure 149 aligned based (name_buffer_ptr), 150 2 name_buffer char (name_index) unaligned, 151 name_buffer_ptr pointer; /* resides in parse stack above paren_stack */ 152 153 154 /* stuff for number conversion */ 155 156 dcl apl_number_for_size float; /* used only with the size builtin */ 157 158 dcl apl_number float bin (63), 159 number_buffer float decimal (34), 160 1 overlay_on_number_buffer 161 based (addr (number_buffer)) aligned, 162 2 sign char (1) unaligned, /* ascii code "+" or "-" */ 163 2 digit (0:33) fixed bin (8) unaligned, 164 /* ascii code from chr for "0" - "9" */ 165 2 must_be_zero bit (1) unaligned, 166 2 exponent fixed bin (7) unaligned, 167 (expona, exponb) fixed bin, 168 magic_rounding_constant 169 float decimal (32) static initial (1.0000000000000000000542101080243e0), 170 decimal_zero float dec (34) aligned static init (0e0), 171 /* has to be named constant due to PL/I compiler bug */ 172 negative_exponent bit (1), 173 stack_value_ptr ptr; /* -> value bead sitting in stack above lexeme_array */ 174 175 176 /* statement & label map */ 177 178 dcl 1 statement_map (1:1000 /* or so */) aligned based (statement_map_ptr), 179 /* in parse stack */ 180 2 lexeme_index fixed bin, /* index in lexeme_array of last lexeme for line */ 181 2 label pointer unaligned, /* null or -> symbol bead for label on this line (only 1 label per line!) */ 182 statement_map_ptr pointer; 183 184 /* localized symbols table */ 185 186 dcl 1 MY aligned based (parse_stack_space), 187 2 localized_symbols 188 (number_of_localized_symbols) pointer unaligned; 189 190 191 dcl (number_of_localized_symbols, number_of_labels) 192 fixed bin; 193 194 195 /* form of data in parse stack is: 196* 197* localized_symbols array 198* 199* statement_map 200* 201* paren_stack 202* 203**/ 204 205 /* builtins */ 206 207 dcl (abs, addr, addrel, binary, bit, decimal, fixed, hbound, index, lbound, length, mod, null, rel, size, string, 208 substr, unspec) builtin; 209 210 211 /* more misc dcl */ 212 213 dcl fatal bit (1), 214 ll fixed bin, 215 i fixed bin, 216 apl_error_ entry (fixed bin (35), bit (36) aligned, fixed bin, char (*), pointer unaligned, fixed bin), 217 apl_get_symbol_ entry (char (*), pointer unaligned, fixed bin), 218 apl_allocate_words_ entry (fixed bin (18), pointer unaligned), 219 apl_free_bead_ entry (pointer unaligned), /* only call this if reference count has decremented to zero */ 220 apl_copy_value_ entry (pointer unaligned, pointer unaligned); 221 222 223 /* external static */ 224 225 dcl ( 226 apl_error_table_$mixed_diamonds_and_semicolons, 227 apl_error_table_$underscore_cant_begin_id, 228 apl_error_table_$too_short_execute, 229 apl_error_table_$too_many_statements, 230 apl_error_table_$duplicate_label, 231 apl_error_table_$more_than_one_line_execute, 232 apl_error_table_$u_mism_ur_quotes, 233 apl_error_table_$bad_subsc_assign_sys_var, 234 apl_error_table_$extra_decimal_point, 235 apl_error_table_$cant_be_localized, 236 apl_error_table_$random_char, 237 apl_error_table_$ill_scan, 238 apl_error_table_$ill_reduction, 239 apl_error_table_$lex_screwed_up, 240 apl_error_table_$not_end_with_newline, 241 apl_error_table_$ill_outer_prod, 242 apl_error_table_$ill_inner_prod, 243 apl_error_table_$misplaced_diamond, 244 apl_error_table_$misplaced_semicolon, 245 apl_error_table_$excess_right_parens, 246 apl_error_table_$mismatched_parens, 247 apl_error_table_$ill_opr_brackets, 248 apl_error_table_$misplaced_brackets, 249 apl_error_table_$excess_right_brackets, 250 apl_error_table_$not_end_with_value, 251 apl_error_table_$ill_small_circle, 252 apl_error_table_$unknown_system_name, 253 apl_error_table_$ws_full_in_lex, 254 apl_error_table_$constant_mism, 255 apl_error_table_$mism_quotes, 256 apl_error_table_$ill_paren_level, 257 apl_error_table_$not_allowed_inner_prod, 258 apl_error_table_$not_allowed_outer_prod, 259 apl_error_table_$more_than_one_line, 260 apl_error_table_$badass, 261 apl_error_table_$lone_upper_minus, 262 apl_error_table_$lone_period, 263 apl_error_table_$excess_label, 264 apl_error_table_$random_char_in_hdr, 265 apl_error_table_$need_name, 266 apl_error_table_$only_1_return_value, 267 apl_error_table_$need_semicolon, 268 apl_error_table_$misplaced_right_arrow 269 ) fixed bin (35) external; 270 271 /* include files */ 272 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 ---------------------------------- */ 273 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 2 2 2 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 2 4 2 type unaligned, 2 5 3 bead_type unaligned, 2 6 4 operator bit (1), /* ON if operator bead */ 2 7 4 symbol bit (1), /* ON if symbol bead */ 2 8 4 value bit (1), /* ON if value bead */ 2 9 4 function bit (1), /* ON if function bead */ 2 10 4 group bit (1), /* ON if group bead */ 2 11 4 label bit (1), /* ON if label bead */ 2 12 4 shared_variable bit (1), /* ON if shared variable bead */ 2 13 4 lexed_function bit (1), /* ON if lexed function bead */ 2 14 3 data_type unaligned, 2 15 4 list_value bit (1), /* ON if a list value bead */ 2 16 4 character_value bit (1), /* ON if a character value bead */ 2 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 2 18 4 integral_value bit (1), /* ON if an integral value bead */ 2 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 2 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 2 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 2 22 2 size bit (18) unaligned, /* Number of words this bead occupies 2 23* (used by bead storage manager) */ 2 24 2 reference_count fixed binary (29); /* Number of pointers which point 2 25* to this bead (used by bead manager) */ 2 26 2 27 2 28 /* constant strings for initing type field in various beads */ 2 29 2 30 declare ( 2 31 operator_type init("100000000000000000"b), 2 32 symbol_type init("010000000000000000"b), 2 33 value_type init("001000000000000000"b), 2 34 function_type init("000100000000000000"b), 2 35 group_type init("000010000000000000"b), 2 36 label_type init("001001000011000000"b), 2 37 shared_variable_type init("001000100000000000"b), 2 38 lexed_function_type init("000000010000000000"b), 2 39 2 40 list_value_type init("000000001000000000"b), 2 41 character_value_type init("001000000100000000"b), 2 42 numeric_value_type init("001000000010000000"b), 2 43 integral_value_type init("001000000011000000"b), 2 44 zero_or_one_value_type init("001000000011100000"b), 2 45 complex_value_type init("001000000000010000"b), 2 46 2 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 2 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 2 49 ) bit(18) internal static; 2 50 2 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 274 3 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 3 2 3 3 declare 3 4 number_of_dimensions fixed bin, 3 5 3 6 1 value_bead aligned based, 3 7 2 header aligned like general_bead, 3 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 3 9 2 rhorho fixed binary, /* number of dimensions of value */ 3 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 3 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 3 12 /* dimensions of value (zero-origin) */ 3 13 3 14 3 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 3 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 3 17 /* actual elements of character array */ 3 18 3 19 declare character_string_overlay character (data_elements) aligned based; 3 20 /* to overlay on above structure */ 3 21 3 22 3 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 3 24 /* actual elements of numeric array */ 3 25 3 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 3 27 3 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 3 29 3 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 275 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 4 2 4 3 declare 4 4 1 operator_bead aligned based, 4 5 4 6 2 type unaligned like general_bead.type, 4 7 4 8 2 bits_for_lex unaligned, 4 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 4 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 4 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 4 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 4 13 3 ignores_assignment bit(1), /* assignment has no effect */ 4 14 3 allow_subscripted_assignment 4 15 bit(1), /* system variable that can be subscripted assigned */ 4 16 3 pad bit(12), 4 17 4 18 2 bits_for_parse unaligned, 4 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 4 20* (op1 tells which) */ 4 21 3 quad bit(1), /* this is a quad type */ 4 22 3 system_variable bit(1), /* this is a system variable, not an op */ 4 23 3 dyadic bit(1), /* operator may be dyadic */ 4 24 3 monadic bit(1), /* operator may be monadic */ 4 25 3 function bit(1), /* operator is a user defined function */ 4 26 3 semantics_valid bit(1), /* if semantics has been set */ 4 27 3 has_list bit(1), /* semantics is a list */ 4 28 3 inner_product bit(1), /* op2 is valid */ 4 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 4 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 4 31 3 pad bit(7), 4 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 4 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 4 34 2 type_code fixed bin; /* for parse */ 4 35 4 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 276 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_character_codes.incl.pl1 ============================== */ 5 2 5 3 /* Defines symbol names for the character codes. 5 4* Modified by PG on 8/9/73 to add LeftBrace, RightBrace, Diamond, LeftTack, RightTack, and Bell, 5 5* to remove Quad_, and to add the special characters MarkError, LineFeed, and ConditionalNewLine. */ 5 6 /* Modified 780913 by PG to add CentSign */ 5 7 /* Modified 790319 by PG to add CommaHyphen */ 5 8 5 9 dcl ( 5 10 Bell init(7), 5 11 BackSpace init(8), 5 12 Tab init(9), 5 13 NewLine init(10), 5 14 Space init(32), 5 15 Exclamation init(33), 5 16 Dollar init(36), /* /S */ 5 17 Apostrophe init(39), /* his = quote */ 5 18 LeftParen init(40), 5 19 RightParen init(41), 5 20 Star init(42), 5 21 Plus init(43), 5 22 Comma init(44), 5 23 Minus init(45), 5 24 Period init(46), 5 25 Slash init(47), 5 26 Zero init(48), /* why not? */ 5 27 One init(49), 5 28 Two init(50), 5 29 Three init(51), 5 30 Four init(52), 5 31 Five init(53), 5 32 Six init(54), 5 33 Seven init(55), 5 34 Eight init(56), 5 35 Nine init(57), 5 36 Colon init(58), 5 37 SemiColon init(59), 5 38 LessThan init(60), 5 39 Equal init(61), 5 40 GreaterThan init(62), 5 41 Question init(63), 5 42 LetterA_ init(65), 5 43 LetterB_ init(66), 5 44 LetterC_ init(67), 5 45 LetterD_ init(68), 5 46 LetterE_ init(69), 5 47 LetterF_ init(70), 5 48 LetterG_ init(71), 5 49 LetterH_ init(72), 5 50 LetterI_ init(73), 5 51 LetterJ_ init(74), 5 52 LetterK_ init(75), 5 53 LetterL_ init(76), 5 54 LetterM_ init(77), 5 55 LetterN_ init(78), 5 56 LetterO_ init(79), 5 57 LetterP_ init(80), 5 58 LetterQ_ init(81), 5 59 LetterR_ init(82), 5 60 LetterS_ init(83), 5 61 LetterT_ init(84), 5 62 LetterU_ init(85), 5 63 LetterV_ init(86), 5 64 LetterW_ init(87), 5 65 LetterX_ init(88), 5 66 LetterY_ init(89), 5 67 LetterZ_ init(90), 5 68 LeftBracket init(91), 5 69 BackSlash init(92), 5 70 RightBracket init(93), 5 71 UnderLine init(95), 5 72 LetterA init(97), 5 73 LetterB init(98), 5 74 LetterC init(99), 5 75 LetterD init(100), 5 76 LetterE init(101), 5 77 LetterF init(102), 5 78 LetterG init(103), 5 79 LetterH init(104), 5 80 LetterI init(105), 5 81 LetterJ init(106), 5 82 LetterK init(107), 5 83 LetterL init(108), 5 84 LetterM init(109), 5 85 LetterN init(110), 5 86 LetterO init(111), 5 87 LetterP init(112), 5 88 LetterQ init(113), 5 89 LetterR init(114), 5 90 LetterS init(115), 5 91 LetterT init(116), 5 92 LetterU init(117), 5 93 LetterV init(118), 5 94 LetterW init(119), 5 95 LetterX init(120), 5 96 LetterY init(121), 5 97 LetterZ init(122), 5 98 LeftBrace init(123), 5 99 VerticalBar init(124), 5 100 RightBrace init(125), 5 101 Tilde init(126), 5 102 5 103 /* here is where we leave ascii behind */ 5 104 5 105 LessOrEqual init(128), 5 106 GreaterOrEqual init(129), 5 107 NotEqual init(130), 5 108 OrSign init(131), 5 109 AndSign init(132), 5 110 Division init(133), 5 111 Epsilon init(134), 5 112 UpArrow init(135), 5 113 DownArrow init(136), 5 114 Circle init(137), 5 115 Ceiling init(138), 5 116 Floor init(139), 5 117 Delta init(140), 5 118 SmallCircle init(141), 5 119 Quad init(142), 5 120 Cap init(143), 5 121 DeCode init(144), 5 122 EnCode init(145), 5 123 LeftLump init(146), 5 124 RightLump init(147), 5 125 Cup init(148), 5 126 NorSign init(149), 5 127 NandSign init(150), 5 128 CircleHyphen init(151), 5 129 SlashHyphen init(152), 5 130 DelTilde init(153), 5 131 CircleStar init(154), 5 132 CircleBar init(155), 5 133 CircleBackSlash init(156), 5 134 CircleSlash init(157), 5 135 GradeDown init(158), 5 136 GradeUp init(159), 5 137 Lamp init(160), 5 138 QuadQuote init(161), 5 139 IBeam init(162), 5 140 BackSlashHyphen init(163), 5 141 Domino init(164), 5 142 Diaresis init(165), 5 143 Omega init(166), 5 144 Iota init(167), 5 145 Rho init(168), 5 146 Times init(169), 5 147 Alpha init(170), 5 148 UpperMinus init(171), 5 149 Del init(172), 5 150 LeftArrow init(173), 5 151 RightArrow init(174), 5 152 Diamond init(175), 5 153 Zero_ init(176), /* underlined numbers... */ 5 154 One_ init(177), 5 155 Two_ init(178), 5 156 Three_ init(179), 5 157 Four_ init(180), 5 158 Five_ init(181), 5 159 Six_ init(182), 5 160 Seven_ init(183), 5 161 Eight_ init(184), 5 162 Nine_ init(185), 5 163 Delta_ init(186), /* underlined Delta */ 5 164 MarkError init(187), /* special character: means mark next char */ 5 165 ExecuteSign init(188), 5 166 FormatSign init(189), 5 167 LeftTack init(190), 5 168 RightTack init(191), 5 169 Linefeed init(192), /* special character */ 5 170 ConditionalNewLine init(193), /* special character */ 5 171 CentSign init(194), 5 172 CommaHyphen init(195) 5 173 ) fixed bin static options (constant); 5 174 5 175 /* ------ END INCLUDE SEGMENT apl_character_codes.incl.pl1 ------------------------------ */ 277 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_lex_pseudo_chars.incl.pl1 ============================= */ 6 2 6 3 /* These are codes which are used by the lex as if they were characters, 6 4* for purposes of looking up in the char_index table in apl_lex_tables_. 6 5* In this way these codes lead to operator beads. 6 6* However these codes are not characters but special pseudo-characters 6 7* generated by the lex from multi-character sequences. 6 8* At present these codes start at 200 (decimal), which is a little above 6 9* the end of the regular characters. 6 10* 6/18/73 DAM 6 11* Modified 740131 by PG for new system variables. 6 12* Modified 781115 by PG to add SemiColonCons. 6 13* Modified 790207 by William M. York to add file system functions. 6 14* Modified 811211 by H. Hoover (UofC) to add QuadCALL & QuadCALLSemicolon. 6 15**/ 6 16 6 17 6 18 dcl ( 6 19 SDelta init(201), 6 20 TDelta init(202), 6 21 QuadCT init(203), 6 22 QuadIO init(204), 6 23 QuadLX init(205), 6 24 QuadPP init(206), 6 25 QuadPW init(207), 6 26 QuadRL init(208), 6 27 QuadAI init(209), 6 28 QuadLC init(210), 6 29 QuadTS init(211), 6 30 QuadTT init(212), 6 31 QuadUL init(213), 6 32 QuadWA init(214), 6 33 QuadWU init(215), /* extra */ 6 34 QuadCS init(216), /* extra */ 6 35 AssignSub init(217), 6 36 AssignIgnore init(218), 6 37 RightOprBracket init(219), 6 38 QuadCR init(220), 6 39 QuadFX init(221), 6 40 QuadEX init(222), 6 41 QuadNL init(223), 6 42 QuadNC init(224), 6 43 QuadDL init(225), 6 44 QuadSVO init(226), 6 45 QuadSVC init(227), 6 46 QuadSVQ init(228), 6 47 QuadSVR init(229), 6 48 QuadIT init(230), 6 49 QuadEC init(231), 6 50 QuadAF init(232), 6 51 SemiColonCons init(233), 6 52 QuadFADDACL init(234), 6 53 QuadFAPPEND init(235), 6 54 QuadFCREATE init(236), 6 55 QuadFDELETEACL init(237), 6 56 QuadFDROP init(238), 6 57 QuadFERASE init(239), 6 58 QuadFHOLD init(240), 6 59 QuadFLIB init(241), 6 60 QuadFLIM init(242), 6 61 QuadFLISTACL init(243), 6 62 QuadFNAMES init(244), 6 63 QuadFNUMS init(245), 6 64 QuadFRDCI init(246), 6 65 QuadFREAD init(247), 6 66 QuadFRENAME init(248), 6 67 QuadFREPLACE init(249), 6 68 QuadFSETACL init(250), 6 69 QuadFSIZE init(251), 6 70 QuadFSTIE init(252), 6 71 QuadFTIE init(253), 6 72 QuadFUNTIE init(254), 6 73 QuadCALL init(255), 6 74 QuadCALLSemicolon init(256) 6 75 ) fixed binary internal static; 6 76 6 77 /* ------ END INCLUDE SEGMENT apl_lex_pseudo_chars.incl.pl1 ----------------------------- */ 278 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 7 2 7 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 7 4 7 5 /* automatic */ 7 6 7 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 7 8 7 9 /* external static */ 7 10 7 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 7 12 2 static_ws_info_ptr unaligned pointer; 7 13 7 14 /* based */ 7 15 7 16 declare 1 ws_info aligned based (ws_info_ptr), 7 17 2 version_number fixed bin, /* version of this structure (3) */ 7 18 2 switches unaligned, /* mainly ws parameters */ 7 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 7 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 7 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 7 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 7 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 7 24 3 restrict_external_functions 7 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 7 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 7 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 7 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 7 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 7 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 7 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 7 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 7 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 7 34 3 compatibility_check_mode 7 35 bit, /* if 1, check for incompatible operators */ 7 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 7 37 /* remaining 20 bits not presently used */ 7 38 7 39 2 values, /* attributes of the workspace */ 7 40 3 digits fixed bin, /* number of digits of precision printed on output */ 7 41 3 width fixed bin, /* line length for formatted output */ 7 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 7 43 3 random_link fixed bin(35), /* seed for random number generator */ 7 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 7 45 3 float_index_origin float, /* the index origin in floating point */ 7 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 7 47 3 maximum_value_stack_size 7 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 7 49 7 50 2 pointers, /* pointers to various internal tables */ 7 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 7 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 7 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 7 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 7 55 7 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 7 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 7 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 7 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 7 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 7 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 7 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 7 63 2 signoff_lock character (32), 7 64 7 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 7 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 7 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 7 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 7 69 bit, /* munging his tables */ 7 70 3 unused_interrupt_bit bit, /* not presently used */ 7 71 3 dont_interrupt_command bit, 7 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 7 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 7 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 7 75 7 76 2 user_name char (32), /* process group id of user */ 7 77 2 immediate_input_prompt char (32) varying, /* normal input */ 7 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 7 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 7 80 2 vcpu_time aligned, 7 81 3 total fixed bin (71), 7 82 3 setup fixed bin (71), 7 83 3 parse fixed bin (71), 7 84 3 lex fixed bin (71), 7 85 3 operator fixed bin (71), 7 86 3 storage_manager fixed bin (71), 7 87 2 output_info aligned, /* data pertaining to output buffer */ 7 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 7 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 7 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 7 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 7 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 7 93 7 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 7 95 7 96 /* internal static */ 7 97 7 98 declare max_parse_stack_depth fixed bin int static init(64536); 7 99 7 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 279 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_table_.incl.pl1 ============================== */ 8 2 8 3 /* this is the structure of the data base apl_operator_table_, as seen by the apl_lex_ module */ 8 4 /* 6/18/73, DAM */ 8 5 8 6 dcl 1 apl_operator_table_$apl_operator_table_ external static aligned, 8 7 2 op_index (0 : (511) /* or so */ ) fixed bin; /* indexed by char code or pseudo char code */ 8 8 8 9 8 10 dcl 1 apl_operator_table_$operator_bead_table external static aligned, /* table of beads, indexed by op_index */ 8 11 2 operator_bead_table(0 : 1000 /* or so */ ) like operator_bead; 8 12 8 13 8 14 dcl apl_operator_table_$inner_product_table external static aligned, /* hundreds of beads for all possible 8 15* inner products */ 8 16 1 the_inner_product_table aligned based(addr(apl_operator_table_$inner_product_table)), 8 17 2 inner_product_max_code fixed bin, /* max index allowed in this table (both dimensions, its square ) */ 8 18 2 inner_product_table (0 : the_inner_product_table.inner_product_max_code, 8 19 0 : the_inner_product_table.inner_product_max_code) like operator_bead; 8 20 8 21 8 22 /*** here are some dummy declarations which are just used to avoid using addrel. 8 23* they are the declarations showing how several related operator beads are grouped together 8 24* in operator_bead_table ***/ 8 25 8 26 /* scalar operator allowing reduction and inner and outer product */ 8 27 8 28 dcl 1 scalar_op based aligned, 8 29 2 first_operator_bead like operator_bead, /* operator by itself */ 8 30 2 slash_operator_bead like operator_bead, /* simple reduction */ 8 31 2 slash_hyphen_operator_bead like operator_bead, /* reduction on first dimension */ 8 32 2 backslash_operator_bead like operator_bead, /* scan */ 8 33 2 backslash_hyphen_operator_bead like operator_bead, /* scan on first dimension */ 8 34 2 outer_product_operator_bead like operator_bead; /* degree.OP */ 8 35 /* inner product stuff is elsewhere, in inner_product_table */ 8 36 8 37 8 38 /* mixed operator that allows brackets */ 8 39 8 40 dcl 1 mixed_op based aligned, 8 41 2 first_operator_bead like operator_bead, /* with no brackets */ 8 42 2 brackets_operator_bead like operator_bead; /* OP[dim] form. */ 8 43 8 44 8 45 /* system variable that may be meaningfully assigned into */ 8 46 /* this includes Quad and QuadQuote as well as QuadIO, SDelta, TDelta, etc. */ 8 47 8 48 dcl 1 system_var_op based aligned, 8 49 2 reference_to like operator_bead, /* op bead for referring to it */ 8 50 2 assignment_to like operator_bead, /* op bead for assigning into it */ 8 51 2 subscripted_assignment_to like operator_bead; /* op bead for QuadLX[n] -<- m, and things like that */ 8 52 /* only present if allow_subscripted_assignment bit is on */ 8 53 8 54 /* ------ END INCLUDE SEGMENT apl_operator_table_.incl.pl1 ------------------------------ */ 280 9 1 /* ====== BEGIN INCLUDE SEGMENT apl_lex_tables_.incl.pl1 ================================== */ 9 2 9 3 /* generated automatically by make_apl_lex_tables_.teco, which was written 7/25/73 by DAM */ 9 4 /* Modified 740131 by PG for new system variables */ 9 5 /* Modified 790207 by Willaim M. York to add file system functions */ 9 6 /* Modified 811211 by H. Hoover (UofC) to add QuadCALL function. */ 9 7 9 8 /* char_type table has syntactic types, indexed by character code 9 9* for safety, the table is a full 512 entries long. After all, it's only 1/2 a page! 9 10* 9 11*The types are: 9 12* 9 13* 0 random char 9 14* 1 alphabetic: letters except E, underlined letters, underline, delta, 9 15* underlined delta, underlined numbers, underlined quad (if they exist) 9 16* 2 E 9 17* 3 Quad 9 18* 4 QuadQuote 9 19* 5 digits 0-9 9 20* 6 UpperMinus 9 21* 7 period = decimal point 9 22* 8 Slash, SlashHyphen, BackSlash, BackSlashHyphen 9 23* 9 Lamp 9 24* 10 NewLine 9 25* 11 blank = Space, Tab 9 26* 12 Apostrophe (string quote) 9 27* 13 Colon 9 28* 14 "functional" operator - like Plus, Times, CircleBackSlash, etc. 9 29* 15 RightArrow 9 30* 16 Degree (upper J) 9 31* 17 SemiColon 9 32* 18 LeftParen 9 33* 19 LeftBracket 9 34* 20 RightParen 9 35* 21 RightBracket 9 36* 22 LeftArrow 9 37* 23 Diamond 9 38* 9 39**/ 9 40 9 41 9 42 dcl char_type (0:511) fixed bin static init( 9 43 (9) 0, 9 44 11, /* Tab */ 9 45 10, /* NewLine */ 9 46 (21) 0, 9 47 11, /* Space */ 9 48 14, /* Exclamation */ 9 49 (5) 0, 9 50 12, /* Apostrophe */ 9 51 18, /* LeftParen */ 9 52 20, /* RightParen */ 9 53 14, /* Star */ 9 54 14, /* Plus */ 9 55 14, /* Comma */ 9 56 14, /* Minus */ 9 57 7, /* Period */ 9 58 8, /* Slash */ 9 59 5, /* Zero */ 9 60 5, /* One */ 9 61 5, /* Two */ 9 62 5, /* Three */ 9 63 5, /* Four */ 9 64 5, /* Five */ 9 65 5, /* Six */ 9 66 5, /* Seven */ 9 67 5, /* Eight */ 9 68 5, /* Nine */ 9 69 13, /* Colon */ 9 70 17, /* SemiColon */ 9 71 14, /* LessThan */ 9 72 14, /* Equal */ 9 73 14, /* GreaterThan */ 9 74 14, /* Question */ 9 75 0, 9 76 1, /* LetterA_ */ 9 77 1, /* LetterB_ */ 9 78 1, /* LetterC_ */ 9 79 1, /* LetterD_ */ 9 80 1, /* LetterE_ */ 9 81 1, /* LetterF_ */ 9 82 1, /* LetterG_ */ 9 83 1, /* LetterH_ */ 9 84 1, /* LetterI_ */ 9 85 1, /* LetterJ_ */ 9 86 1, /* LetterK_ */ 9 87 1, /* LetterL_ */ 9 88 1, /* LetterM_ */ 9 89 1, /* LetterN_ */ 9 90 1, /* LetterO_ */ 9 91 1, /* LetterP_ */ 9 92 1, /* LetterQ_ */ 9 93 1, /* LetterR_ */ 9 94 1, /* LetterS_ */ 9 95 1, /* LetterT_ */ 9 96 1, /* LetterU_ */ 9 97 1, /* LetterV_ */ 9 98 1, /* LetterW_ */ 9 99 1, /* LetterX_ */ 9 100 1, /* LetterY_ */ 9 101 1, /* LetterZ_ */ 9 102 19, /* LeftBracket */ 9 103 8, /* BackSlash */ 9 104 21, /* RightBracket */ 9 105 0, 9 106 1, /* UnderLine */ 9 107 0, 9 108 1, /* LetterA */ 9 109 1, /* LetterB */ 9 110 1, /* LetterC */ 9 111 1, /* LetterD */ 9 112 2, /* LetterE */ 9 113 1, /* LetterF */ 9 114 1, /* LetterG */ 9 115 1, /* LetterH */ 9 116 1, /* LetterI */ 9 117 1, /* LetterJ */ 9 118 1, /* LetterK */ 9 119 1, /* LetterL */ 9 120 1, /* LetterM */ 9 121 1, /* LetterN */ 9 122 1, /* LetterO */ 9 123 1, /* LetterP */ 9 124 1, /* LetterQ */ 9 125 1, /* LetterR */ 9 126 1, /* LetterS */ 9 127 1, /* LetterT */ 9 128 1, /* LetterU */ 9 129 1, /* LetterV */ 9 130 1, /* LetterW */ 9 131 1, /* LetterX */ 9 132 1, /* LetterY */ 9 133 1, /* LetterZ */ 9 134 0, 9 135 14, /* VerticalBar */ 9 136 0, 9 137 14, /* Tilde */ 9 138 0, 9 139 14, /* LessOrEqual */ 9 140 14, /* GreaterOrEqual */ 9 141 14, /* NotEqual */ 9 142 14, /* OrSign */ 9 143 14, /* AndSign */ 9 144 14, /* Division */ 9 145 14, /* Epsilon */ 9 146 14, /* UpArrow */ 9 147 14, /* DownArrow */ 9 148 14, /* Circle */ 9 149 14, /* Ceiling */ 9 150 14, /* Floor */ 9 151 1, /* Delta */ 9 152 16, /* SmallCircle */ 9 153 3, /* Quad */ 9 154 0, 9 155 14, /* DeCode */ 9 156 14, /* EnCode */ 9 157 0, 9 158 0, 9 159 0, 9 160 14, /* NorSign */ 9 161 14, /* NandSign */ 9 162 14, /* CircleHyphen */ 9 163 8, /* SlashHyphen */ 9 164 0, 9 165 14, /* CircleStar */ 9 166 14, /* CircleBar */ 9 167 14, /* CircleBackSlash */ 9 168 0, 9 169 14, /* GradeDown */ 9 170 14, /* GradeUp */ 9 171 9, /* Lamp */ 9 172 4, /* QuadQuote */ 9 173 14, /* IBeam */ 9 174 8, /* BackSlashHyphen */ 9 175 14, /* Domino */ 9 176 0, 9 177 0, 9 178 14, /* Iota */ 9 179 14, /* Rho */ 9 180 14, /* Times */ 9 181 0, 9 182 6, /* UpperMinus */ 9 183 0, 9 184 22, /* LeftArrow */ 9 185 15, /* RightArrow */ 9 186 23, /* Diamond */ 9 187 1, /* Zero_ */ 9 188 1, /* One_ */ 9 189 1, /* Two_ */ 9 190 1, /* Three_ */ 9 191 1, /* Four_ */ 9 192 1, /* Five_ */ 9 193 1, /* Six_ */ 9 194 1, /* Seven_ */ 9 195 1, /* Eight_ */ 9 196 1, /* Nine_ */ 9 197 1, /* Delta_ */ 9 198 0, 9 199 14, /* ExecuteSign */ 9 200 14, /* FormatSign */ 9 201 (5) 0, /* LeftTack - CentSign */ 9 202 14, /* CommaHyphen */ 9 203 (316) 0); 9 204 9 205 /* table of names of system-variables. Note - the funny 9 206* character in these character strings is a Quad. 9 207* Generated from apl_system_names.src */ 9 208 9 209 dcl system_names (203:256) char(11) aligned static init( 9 210 "ˇct", /* 203 */ 9 211 "ˇio", /* 204 */ 9 212 "ˇlx", /* 205 */ 9 213 "ˇpp", /* 206 */ 9 214 "ˇpw", /* 207 */ 9 215 "ˇrl", /* 208 */ 9 216 "ˇai", /* 209 */ 9 217 "ˇlc", /* 210 */ 9 218 "ˇts", /* 211 */ 9 219 "ˇtt", /* 212 */ 9 220 "ˇul", /* 213 */ 9 221 "ˇwa", /* 214 */ 9 222 "ˇwu", /* 215 */ 9 223 "ˇcs", /* 216 */ 9 224 "xxx", /* 217 */ 9 225 "xxx", /* 218 */ 9 226 "xxx", /* 219 */ 9 227 "ˇcr", /* 220 */ 9 228 "ˇfx", /* 221 */ 9 229 "ˇex", /* 222 */ 9 230 "ˇnl", /* 223 */ 9 231 "ˇnc", /* 224 */ 9 232 "ˇdl", /* 225 */ 9 233 "ˇsvo", /* 226 */ 9 234 "ˇsvc", /* 227 */ 9 235 "ˇsvq", /* 228 */ 9 236 "ˇsvr", /* 229 */ 9 237 "ˇit", /* 230 */ 9 238 "ˇec", /* 231 */ 9 239 "ˇaf", /* 232 */ 9 240 "xxx", /* 233 (semicolon cons) */ 9 241 "ˇfaddacl", /* 234 */ 9 242 "ˇfappend", /* 235 */ 9 243 "ˇfcreate", /* 236 */ 9 244 "ˇfdeleteacl", /* 237 */ 9 245 "ˇfdrop", /* 238 */ 9 246 "ˇferase", /* 239 */ 9 247 "ˇfhold", /* 240 */ 9 248 "ˇflib", /* 241 */ 9 249 "ˇflim", /* 242 */ 9 250 "ˇflistacl", /* 243 */ 9 251 "ˇfnames", /* 244 */ 9 252 "ˇfnums", /* 245 */ 9 253 "ˇfrdci", /* 246 */ 9 254 "ˇfread", /* 247 */ 9 255 "ˇfrename", /* 248 */ 9 256 "ˇfreplace", /* 249 */ 9 257 "ˇfsetacl", /* 250 */ 9 258 "ˇfsize", /* 251 */ 9 259 "ˇfstie", /* 252 */ 9 260 "ˇftie", /* 253 */ 9 261 "ˇfuntie", /* 254 */ 9 262 "ˇcall", /* 255 */ 9 263 "xxx"); /* 256 (QuadCALLSemicolon) */ 9 264 9 265 /* ------ END INCLUDE SEGMENT apl_lex_tables_.incl.pl1 ---------------------------------- */ 281 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 -------------------------- */ 282 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 ---------------------------------- */ 283 284 285 /**** entry point to lex a line of evaluated input ****/ 286 287 apl_line_lex_: 288 entry (text, lex_return_pointer, errors_occurred, a_bad_lexeme_index, parse_stack_space); 289 290 dcl text char (*) aligned parameter, /* string to be lexically analyzed */ 291 lex_return_pointer pointer unaligned, /* this return argument usually -> lexed_function bead, 292* but in the case of lexing for errors, -> error_mark_structure */ 293 errors_occurred bit (1) aligned parameter, /* return argument - "1"b if lex has printed 1 or more error msgs */ 294 a_bad_lexeme_index fixed bin parameter, /* 0 for normal lexing, > 0 implies this is index of lexeme 295* at which error ocurred, so source is to be marked (lexing for errors) */ 296 1 error_mark_structure 297 aligned based (parse_stack_space), 298 2 error_line_number 299 fixed bin, 300 2 error_line_index 301 fixed bin (21), /* pl1 (1-origin) index of start of line in error */ 302 2 error_index_within_line 303 fixed bin, /* pl1 (1-origin) index of character within line to be marked */ 304 2 length_of_line fixed bin, /* number of characters in erroneous line, including newline at end */ 305 parse_stack_space pointer aligned parameter; /* -> space I can use on parse stack */ 306 307 308 /* apl_line_lex_ begin executable code */ 309 310 error_suppress = "0"b; 311 esw = apl_line_lex_; 312 go to line_execute_lex_join; 313 314 315 apl_execute_lex_: 316 entry (text, lex_return_pointer, errors_occurred, a_bad_lexeme_index, parse_stack_space); 317 318 esw = apl_execute_lex_; 319 error_suppress = ^ws_info.long_error_mode; /* suppress syntax errors unless long mode */ 320 line_execute_lex_join: 321 errors_occurred = "0"b; 322 last_lexeme = BeginOfLine; /* don't get the idea that this statement is superfluous */ 323 char_index = 0; 324 lexeme_index = 1; 325 line_no = 0; 326 call setup_value_stack; 327 number_of_localized_symbols = 0; 328 number_of_labels = 0; 329 statement_map_ptr = parse_stack_space; /* no local symbols table */ 330 char_count = -length (text) - 1; 331 go to start_line; 332 333 process_newline: 334 snail (10): 335 if paren_level ^= 0 336 then go to barf_at_ill_paren_level; /* make some error checks */ 337 if last_lexeme = OperatorLexeme 338 then do; /***** write around pl1 compiler bug in packed to unpacked pointer comparison ****/ 339 temp_ptr = addr (operator_bead_table (op_index (RightArrow))); 340 if lexeme = temp_ptr 341 then ; /* special case, allow RightArrow alone on a line */ 342 else go to barf_at_not_end_with_value; 343 end; 344 else if last_lexeme = ConstantLexeme 345 then call convert_constant; 346 statement_map (line_no).lexeme_index = lexeme_index - 1; 347 348 /* If we are lexing for errors, see if we have found the erroneous line. */ 349 350 if a_bad_lexeme_index ^= 0 351 then if a_bad_lexeme_index < lexeme_index 352 then do; 353 error_mark_structure.error_line_number = line_no; 354 error_mark_structure.error_line_index = line_index + 1; 355 356 /* Correct the lexeme index to account for any diamond reordering present */ 357 358 lx = a_bad_lexeme_index; 359 360 if line_no > 1 361 then first_lexeme = statement_map (line_no - 1).lexeme_index; 362 else first_lexeme = 0; 363 364 lx = lx - first_lexeme; 365 366 do stmt_number = stmt_number by -1 to 1 while (lx > stmt_length_map (stmt_number)); 367 lx = lx - stmt_length_map (stmt_number); 368 end; 369 370 stmt_number = stmt_number - 1; /* we have found the right statement...skip it */ 371 372 do stmt_number = stmt_number by -1 to 1; 373 lx = lx + stmt_length_map (stmt_number); 374 end; 375 376 error_mark_structure.error_index_within_line = source_pos (lx + first_lexeme) - line_index; 377 error_mark_structure.length_of_line = char_index - line_index; 378 lex_return_pointer = addr (error_mark_structure); 379 return; 380 end; 381 382 start_line: 383 line_type = "00"b; 384 stmt_number = 1; 385 stmt_length_map (1) = 0; 386 line_no = line_no + 1; 387 paren_level = 0; 388 line_index = char_index; /* save start of line */ 389 lexeme = addr (operator_bead_table (op_index (NewLine))); 390 /* put out a beginning of line lexeme */ 391 next_lexeme = BeginOfLine; 392 statement_map (line_no).label = null; /* assume line will be unlabeled */ 393 paren_stack_ptr = addr (statement_map (line_no + 1)); 394 /* put paren stack above statement map */ 395 go to hrund_emit; 396 397 start_new_lexeme: 398 snail (11): 399 char_count = char_count + 1; 400 if char_count = 0 401 then if esw = apl_execute_lex_ 402 then go to process_newline; /* forge a newline at end of execute string */ 403 else go to end_of_text; /* but for any other entry, this is the end */ 404 else if char_count > 0 405 then go to end_of_text; /* newline has already been forged, so now text ends */ 406 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 407 char_index = char_index + 1; 408 go to snail (char_type (chr)); 409 410 /* snail(0) = barf_at_random_char 411* snail(1) = start_name 412* snail(2) = " 413* snail(3) = " 414* snail(5) = start_number 415* snail(6) = start_negative_number 416* snail(9) = skip_over_comment 417* snail(10) = process_newline 418* snail(11) = start_new_lexeme skip over blanks 419* snail(12) = process_char_constant 420* snail(13) = barf_at_random_char 421* snail(14) = hrund_emit_operator 422* snail(22) = assign 423* the remaining snails follow */ 424 425 snail (4): /* QuadQuote */ 426 next_lexeme = NameLexeme; /* sort of a name */ 427 go to get_hrund_emit; 428 429 snail (8): /* scan & reduction - or maybe expand & compress */ 430 if last_lexeme ^= OperatorLexeme 431 then go to hrund_emit_operator; 432 if ^(lexeme -> operator_bead.allow_reduction) 433 then go to barf_at_ill_reduction; 434 if chr = Slash 435 then lexeme = addr (lexeme -> scalar_op.slash_operator_bead); 436 else if chr = BackSlash 437 then lexeme = addr (lexeme -> scalar_op.backslash_operator_bead); 438 else if chr = SlashHyphen 439 then lexeme = addr (lexeme -> scalar_op.slash_hyphen_operator_bead); 440 else if chr = BackSlashHyphen 441 then lexeme = addr (lexeme -> scalar_op.backslash_hyphen_operator_bead); 442 else go to ulose; /* tables screwed up */ 443 go to hrund_replace; 444 445 snail (15): /* generate a branch from RightArrow */ 446 if (last_lexeme ^= BeginOfLine) & (last_lexeme ^= Diamond) & (last_lexeme ^= SemiColon) 447 then go to misplaced_right_arrow; 448 else go to hrund_emit_operator; 449 450 451 snail (16): /* process SmallCircle, which may only be used to 452* introduce an outer product */ 453 skip_blanks_for_SmallCircle: 454 char_count = char_count + 1; 455 if char_count = 0 456 then go to unexpected_end_of_text; 457 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 458 char_index = char_index + 1; 459 if char_type (chr) = 11 460 then go to skip_blanks_for_SmallCircle; /* allow blanks */ 461 if char_type (chr) ^= 7 462 then go to barf_at_ill_small_circle; /* must be period */ 463 /* do outer product - chr = "." */ 464 465 doprod (11): /* outer product */ 466 char_count = char_count + 1; 467 if char_count = 0 468 then go to unexpected_end_of_text; 469 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 470 char_index = char_index + 1; 471 go to doprod (char_type (chr)); 472 473 doprod (14): /* got operator to take outer product of */ 474 lexeme = addr (operator_bead_table (op_index (chr))); 475 if ^(lexeme -> operator_bead.allow_product) 476 then go to barf_at_not_allowed_outer_prod; 477 lexeme = addr (lexeme -> scalar_op.outer_product_operator_bead); 478 next_lexeme = OperatorLexeme; 479 go to hrund_emit; 480 481 doprod (0): 482 doprod (1): 483 doprod (2): 484 doprod (3): 485 doprod (4): 486 doprod (5): 487 doprod (6): 488 doprod (7): 489 doprod (8): 490 doprod (9): 491 doprod (10): 492 doprod (12): 493 doprod (13): 494 doprod (15): 495 doprod (16): 496 doprod (17): 497 doprod (18): 498 doprod (19): 499 doprod (20): 500 doprod (21): 501 doprod (22): 502 doprod (23): 503 code = apl_error_table_$ill_outer_prod; 504 go to error; 505 506 snail (7): /* process dot (except outer-product dot) */ 507 /* operator followed by dot -- might be inner product, but 508* could be start of a number. Have to look ahead a little */ 509 if char_count < -1 510 then if char_type (fixed (unspec (substr (text, char_index + 1, 1)), 9)) = 5 511 then go to start_number_with_decimal_point; 512 else if last_lexeme ^= OperatorLexeme 513 then go to barf_at_lone_period; 514 else if last_lexeme ^= OperatorLexeme 515 then go to barf_at_lone_period; 516 if ^(lexeme -> operator_bead.allow_product) 517 then do; /* left opeator does not permit inner product. */ 518 /* back up and mark it. */ 519 520 do while (char_index > line_index); /* don't overdo things... */ 521 char_count = char_count - 1; 522 char_index = char_index - 1; 523 chr = binary (unspec (substr (text, char_index, 1)), 9); 524 if char_type (chr) ^= 11 /* blanks */ 525 then go to barf_at_not_allowed_inner_prod; 526 end; 527 go to barf_at_not_allowed_inner_prod; /* should not get here */ 528 end; 529 530 skip_blanks_for_inner_prod: 531 char_count = char_count + 1; 532 if char_count = 0 533 then go to unexpected_end_of_text; 534 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 535 char_index = char_index + 1; 536 if char_type (chr) = 11 537 then go to skip_blanks_for_inner_prod; 538 539 if char_type (chr) ^= 14 540 then go to barf_at_ill_inner_prod; 541 542 /* definitely an inner product, chr = right operator */ 543 544 temp_ptr = addr (operator_bead_table (op_index (chr))); 545 546 /* lexeme -> left opr, temp_ptr -> right opr */ 547 548 if ^(temp_ptr -> operator_bead.allow_product) 549 then go to barf_at_not_allowed_inner_prod; 550 551 /* inner product is OK. Dig up the correct inner-product bead */ 552 553 lexeme = 554 addr (inner_product_table (fixed (lexeme -> operator_bead.op1, 17), fixed (temp_ptr -> operator_bead.op1, 17))) 555 ; 556 go to hrund_replace; /* write over the lexeme of the left operator */ 557 558 559 snail (17): /* semicolon */ 560 if paren_level = 0 /* top level? */ 561 then do; 562 if line_type = Diamond_type 563 then do; 564 code = apl_error_table_$mixed_diamonds_and_semicolons; 565 go to error; 566 end; 567 568 line_type = Semicolon_type; 569 end; 570 else do; /* within some sort of brackets or parens */ 571 if paren_stack (paren_level) = P_S_Opr_Brackets 572 then go to barf_at_misplaced_semicolon; 573 574 if paren_stack (paren_level) = P_S_Parens 575 /* Argument List */ 576 then do; 577 next_lexeme = OperatorLexeme; 578 lexeme = addr (operator_bead_table (op_index (SemiColonCons))); 579 go to hrund_emit; 580 end; 581 if paren_stack (paren_level) = P_S_qCALL_Parens 582 /* qCALL argument List */ 583 then do; 584 next_lexeme = OperatorLexeme; 585 lexeme = addr (operator_bead_table (op_index (QuadCALLSemicolon))); 586 go to hrund_emit; 587 end; 588 end; 589 590 next_lexeme = SemiColon; /* Mixed Output */ 591 go to get_hrund_emit; 592 593 594 snail (23): /* diamond */ 595 if paren_level ^= 0 596 then go to barf_at_misplaced_diamond; 597 598 if line_type = Semicolon_type 599 then do; 600 code = apl_error_table_$mixed_diamonds_and_semicolons; 601 go to error; 602 end; 603 604 line_type = Diamond_type; 605 stmt_number = stmt_number + 1; 606 607 if stmt_number > hbound (stmt_length_map, 1) 608 then do; 609 code = apl_error_table_$too_many_statements; 610 go to error; 611 end; 612 613 stmt_length_map (stmt_number) = 0; 614 next_lexeme = Diamond; 615 go to get_hrund_emit; 616 617 snail (18): /* left parenthesis */ 618 paren_level = paren_level + 1; 619 paren_stack (paren_level) = P_S_Parens; 620 paren_loc (paren_level) = char_index; 621 next_lexeme = OpenParenLexeme; 622 if last_lexeme = NameLexeme 623 then if temp_lexeme_array (lexeme_index - 1) = addr (operator_bead_table (op_index (QuadCALL))) 624 then paren_stack (paren_level) = P_S_qCALL_Parens; 625 go to get_hrund_emit; 626 627 snail (20): /* right parenthesis */ 628 if paren_level = 0 629 then go to barf_at_excess_right_parens; 630 if paren_stack (paren_level) ^= P_S_Parens & paren_stack (paren_level) ^= P_S_qCALL_Parens 631 then go to barf_at_mismatched_parens; 632 if last_lexeme = OperatorLexeme 633 then go to barf_at_not_end_with_value; 634 if last_lexeme = OpenParenLexeme 635 then go to barf_at_not_end_with_value; 636 637 paren_level = paren_level - 1; 638 next_lexeme = ValueLexeme; 639 go to get_hrund_emit; 640 641 642 snail (19): /* left bracket */ 643 if last_lexeme = OperatorLexeme 644 then if lexeme -> operator_bead.allow_brackets 645 then do; 646 647 /* brackets after mixed operator */ 648 649 paren_level = paren_level + 1; 650 paren_stack (paren_level) = P_S_Opr_Brackets; 651 paren_loc (paren_level) = char_index; 652 last_lexeme = OpenParenLexeme; 653 temp_lexeme_array (lexeme_index - 1) = addr (lexeme -> mixed_op.brackets_operator_bead); 654 go to get_hrund_emit; /* left opr bracket same as left bracket */ 655 end; 656 else go to barf_at_ill_opr_brackets; /* brackets after operator, but operator doesn't want them */ 657 else if last_lexeme = BeginOfLine 658 then go to barf_at_brackets_beginning; 659 else if last_lexeme = OpenParenLexeme 660 then go to barf_at_brackets_beginning; 661 else if last_lexeme = SemiColon 662 then go to barf_at_brackets_beginning; 663 else if last_lexeme = Diamond 664 then go to barf_at_brackets_beginning; 665 666 /* a valid use of brackets for subscripting */ 667 668 paren_level = paren_level + 1; 669 paren_stack (paren_level) = P_S_Brackets; 670 paren_loc (paren_level) = char_index; 671 next_lexeme = OpenParenLexeme; 672 go to get_hrund_emit; 673 674 675 snail (21): /* right bracket */ 676 if paren_level = 0 677 then go to barf_at_excess_right_brackets; 678 if paren_stack (paren_level) ^= P_S_Brackets 679 then if paren_stack (paren_level) ^= P_S_Opr_Brackets 680 then go to barf_at_mismatched_parens; 681 else do; /* opr brackets */ 682 next_lexeme = OperatorLexeme; 683 lexeme = addr (operator_bead_table (op_index (RightOprBracket))); 684 /* funny bracket for rank spec. */ 685 if last_lexeme = OpenParenLexeme 686 then go to barf_at_not_end_with_value; 687 /* empty brackets not allowed */ 688 else if last_lexeme = OperatorLexeme 689 then go to barf_at_not_end_with_value; 690 end; 691 else do; /* regular brackets */ 692 next_lexeme = ValueLexeme; 693 lexeme = addr (operator_bead_table (op_index (RightBracket))); 694 if last_lexeme = OperatorLexeme 695 then go to barf_at_not_end_with_value; 696 end; 697 698 paren_level = paren_level - 1; 699 go to hrund_emit; 700 701 /*** routines for emitting lexemes ***/ 702 703 hrund_replace: /* write new OperatorLexeme over old, last_lexeme need not be changed. For inner product, etc. */ 704 temp_lexeme_array (lexeme_index - 1) = lexeme; 705 go to start_new_lexeme; 706 707 708 709 hrund_emit_operator: 710 snail (14): 711 next_lexeme = OperatorLexeme; 712 get_hrund_emit: 713 lexeme = addr (operator_bead_table (op_index (chr))); 714 hrund_emit: /* emit lexeme, set last_lexeme, and re-enter main loop on next character */ 715 call emission; 716 go to start_new_lexeme; 717 718 emission: 719 proc; 720 721 if last_lexeme = ConstantLexeme 722 then call convert_constant; /* get constant off stack and into value bead, emit ptr to 723* value bead. This makes room avail to emit next ptr */ 724 725 space_left_in_stack = space_left_in_stack - temp_lexeme_size; 726 if space_left_in_stack < 0 727 then go to value_stack_exceeded; 728 temp_lexeme_array (lexeme_index) = lexeme; 729 source_pos (lexeme_index) = char_index; /* assume was one-character token */ 730 if char_count >= 0 731 then source_pos (lexeme_index) = source_pos (lexeme_index) + 1; 732 /* adjust for forged newline, which 733* didn't bump char_index. Happens mainly 734* in names */ 735 lexeme_index = lexeme_index + 1; 736 stmt_length_map (stmt_number) = stmt_length_map (stmt_number) + 1; 737 last_lexeme = next_lexeme; 738 end emission; 739 740 741 742 convert_constant: 743 proc; 744 745 if stack_value_ptr -> value_bead.total_data_elements = 1 746 then /* scalar */ 747 stack_value_ptr -> value_bead.rhorho = 0; 748 else stack_value_ptr -> value_bead.rho (1) = stack_value_ptr -> value_bead.total_data_elements; 749 750 if a_bad_lexeme_index ^= 0 751 then temp_ptr = null; 752 else call apl_copy_value_ ((stack_value_ptr), temp_ptr); 753 /* take value bead off stack, put in heap */ 754 755 /* now emit temp_ptr. already know about lexeme_index, space_left_in_stack, etc. */ 756 757 temp_lexeme_array (lexeme_index - 1) = temp_ptr; 758 last_lexeme = ValueLexeme; 759 space_left_in_stack = 760 maximum_value_stack_size - fixed (rel (value_stack_space), 18) - lexeme_index * temp_lexeme_size; 761 762 end convert_constant; 763 764 /*** name lexer ***/ 765 766 snail (1): /* alphabetic, underscore, delta, and underscored versions of these */ 767 if chr = UnderLine 768 then do; 769 code = apl_error_table_$underscore_cant_begin_id; 770 go to error; 771 end; 772 773 snail (2): /* E */ 774 snail (3): /* Quad */ 775 name_buffer_ptr = addr (paren_stack (paren_level + 1)); 776 /* put name buffer at top of parse stack */ 777 name_index = 0; /* start at beginning of name buffer */ 778 779 nm (1): /* letter, etc. */ 780 nm (2): /* E */ 781 nm (5): /* digit */ 782 /* legal name constituents come here */ 783 name_buffer_array (name_index) = chr; /* drop character into name */ 784 name_index = name_index + 1; 785 786 char_count = char_count + 1; 787 if char_count >= 0 788 then begin; 789 go to case (esw); 790 case (1): 791 case (2): 792 go to unexpected_end_of_text; /* line, function is system error */ 793 794 case (3): 795 chr = NewLine; /* execute is similar except don't adjust char_count */ 796 end; 797 else do; 798 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 799 char_index = char_index + 1; 800 end; 801 go to nm (char_type (chr)); 802 803 nm (0): 804 nm (3): 805 nm (4): 806 nm (6): 807 nm (7): 808 nm (8): 809 nm (9): 810 nm (10): 811 nm (11): 812 nm (12): 813 nm (13): 814 nm (14): 815 nm (15): 816 nm (16): 817 nm (17): 818 nm (18): 819 nm (19): 820 nm (20): 821 nm (21): 822 nm (22): 823 nm (23): /* break character found. Name has ended. Make a lexeme for it */ 824 if name_buffer_array (0) = Quad 825 then if name_index = 1 826 then lexeme = addr (operator_bead_table (op_index (Quad))); 827 else do; /* system name */ 828 do n = lbound (system_names, 1) to hbound (system_names, 1); 829 if system_names (n) = name_buffer 830 then do; 831 lexeme = addr (operator_bead_table (op_index (n))); 832 go to emit_name; 833 end; 834 end; 835 go to barf_at_unknown_system_name; /* not in table */ 836 end; 837 838 else if name_index > 2 /* stop/trace control */ 839 then if name_buffer_array (1) = Delta 840 then if name_buffer_array (0) = LetterT 841 then go to trace_control; 842 else if name_buffer_array (0) = LetterS 843 then go to stop_control; 844 else go to pl1_loss; 845 else go to pl1_loss; 846 else 847 pl1_loss: /* because & loses in if */ 848 do; /* not a special name, look up in symbol table and check for label */ 849 850 if a_bad_lexeme_index ^= 0 851 then lexeme = null; 852 else call apl_get_symbol_ (name_buffer, lexeme, (0)); 853 if esw = apl_function_lex_ 854 then if chr = Colon 855 then if last_lexeme = BeginOfLine 856 then do; /* process label */ 857 if statement_map (line_no).label ^= null 858 then go to barf_at_excess_label; 859 if lexeme ^= null /* protect loop if we are just re-lexing for errors */ 860 then do n = 1 to line_no - 1; 861 if statement_map (n).label = lexeme 862 then go to duplicate_label; 863 end; 864 statement_map (line_no).label = lexeme; 865 /* store ptr to symbol bead in stmt map */ 866 number_of_labels = number_of_labels + 1; 867 go to start_new_lexeme; 868 end; 869 end; 870 871 emit_name: /* emit name lexeme then look at chr again */ 872 next_lexeme = NameLexeme; 873 call emission; 874 source_pos (lexeme_index - 1) = source_pos (lexeme_index - 1) - name_index; 875 /* -> beginning of name */ 876 go to snail (char_type (chr)); 877 878 879 880 stop_control: 881 call s_t_emit_name; 882 lexeme = addr (operator_bead_table (op_index (SDelta))); 883 go to emit_name; /* put out funny lexeme which looks like system-variable */ 884 885 trace_control: 886 call s_t_emit_name; 887 lexeme = addr (operator_bead_table (op_index (TDelta))); 888 go to emit_name; /* put out funny lexeme which looks like a system variable */ 889 890 891 s_t_emit_name: 892 proc; 893 894 if a_bad_lexeme_index ^= 0 895 then lexeme = null; 896 else call apl_get_symbol_ (substr (name_buffer, 3), lexeme, (0)); 897 /* get ptr to symbol bead for fcn */ 898 next_lexeme = NameLexeme; /* first put out name of function, then SD or TD lexeme */ 899 call emission; 900 source_pos (lexeme_index - 1) = source_pos (lexeme_index - 1) - name_index; 901 /* -> beginning of name */ 902 end s_t_emit_name; 903 904 /*** character constants ***/ 905 906 snail (12): 907 if last_lexeme ^= ConstantLexeme 908 then do; /* start a value bead in the stack */ 909 910 source_pos (lexeme_index) = char_index; 911 lexeme_index = lexeme_index + 1; /* as if we has emitted the constant-lexeme already */ 912 stmt_length_map (stmt_number) = stmt_length_map (stmt_number) + 1; 913 stack_value_ptr = addr (temp_lexeme_array (lexeme_index)); 914 last_lexeme = ConstantLexeme; 915 number_of_dimensions = 1; 916 space_left_in_stack = space_left_in_stack - size (value_bead); 917 /* = size of empty value bead with one rho vector entry */ 918 if space_left_in_stack < 0 919 then go to value_stack_exceeded; 920 921 string (stack_value_ptr -> value_bead.type) = character_value_type; 922 /* don't worry about size field - never looked at since in stack */ 923 stack_value_ptr -> value_bead.reference_count = -1; 924 stack_value_ptr -> value_bead.total_data_elements = 0; 925 /* start out as '', the null string */ 926 stack_value_ptr -> value_bead.rhorho = 1; 927 /* .. */ 928 /* don't worry about rho(1), will be set by convert_constant */ 929 /* also convert_constant will take care of the scalar case */ 930 stack_value_ptr -> value_bead.data_pointer = addr (stack_value_ptr -> value_bead.rho (2)); 931 /* first free loc */ 932 n = -1; /* set up byte ctr to append new word */ 933 end; 934 else if stack_value_ptr -> value_bead.data_type.character_value 935 then /* OK to append to prev string */ 936 n = -1 - mod (stack_value_ptr -> value_bead.total_data_elements, 4); 937 /* mod 4 char ctr, -4 to -1 */ 938 else go to barf_at_constant_mism; /* not OK to append to prev # */ 939 940 /* now append characters of quoted string to stack_value_ptr -> value_bead */ 941 942 char_constant_loop: 943 char_count = char_count + 1; 944 if char_count = 0 945 then go to unexpected_eot_char_constant; 946 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 947 char_index = char_index + 1; 948 if chr = Apostrophe 949 then do; /* may be end of string or insertion of quote into string */ 950 char_count = char_count + 1; 951 if char_count = 0 952 then if esw = apl_execute_lex_ 953 then do; 954 chr = NewLine; 955 go to process_newline; 956 end; 957 else go to unexpected_eot_char_constant; 958 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 959 char_index = char_index + 1; 960 if chr ^= Apostrophe 961 then go to snail (char_type (chr)); /* end of string */ 962 end; /* two quotes, fall through to put one into string */ 963 964 /* drop chr into string */ 965 966 n = n + 1; 967 if n = 0 968 then do; 969 n = -4; /* append new word to value bead */ 970 space_left_in_stack = space_left_in_stack - 1; 971 if space_left_in_stack < 0 972 then go to value_stack_exceeded; 973 end; 974 975 unspec (stack_value_ptr -> value_bead.data_pointer 976 -> character_datum (stack_value_ptr -> value_bead.total_data_elements)) = bit (fixed (chr, 9), 9); 977 stack_value_ptr -> value_bead.total_data_elements = stack_value_ptr -> value_bead.total_data_elements + 1; 978 go to char_constant_loop; 979 980 /*** numeric constant processing ***/ 981 982 983 start_negative_number: 984 snail (6): 985 number_buffer = decimal_zero; /* zero out digit(0:33), must_be_zero */ 986 sign = "-"; 987 char_count = char_count + 1; 988 if char_count = 0 989 then go to barf_at_lone_upper_minus; 990 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 991 char_index = char_index + 1; 992 if char_type (chr) = 5 993 then go to number_proc; 994 else if chr = Period 995 then go to dec_point_join; 996 else go to barf_at_lone_upper_minus; 997 998 999 start_number: 1000 snail (5): 1001 number_buffer = decimal_zero; 1002 number_proc: 1003 if esw ^= apl_scan_ 1004 then call numsetup; 1005 1006 1007 expona = -(1 + hbound (digit, 1) + 1); /* digit counter and exponent offset */ 1008 1009 if chr ^= Zero 1010 then go to numip (5); 1011 1012 /* gobble leading zeroes */ 1013 1014 numiplz: 1015 char_count = char_count + 1; 1016 if char_count = 0 1017 then begin; 1018 go to case (esw); 1019 case (1): 1020 case (2): 1021 go to unexpected_end_of_text; 1022 case (0): 1023 case (3): 1024 chr = NewLine; 1025 end; 1026 else do; 1027 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1028 char_index = char_index + 1; 1029 end; 1030 if chr = Zero 1031 then go to numiplz; 1032 else if chr = Period 1033 then do; 1034 if esw ^= apl_scan_ 1035 then string (stack_value_ptr -> value_bead.type) = 1036 string (stack_value_ptr -> value_bead.type) & not_integer_mask; 1037 else token_type = 4; 1038 1039 exponb = expona; 1040 go to numfplz; 1041 end; 1042 else go to numip (char_type (chr)); /* not leading-char, process it */ 1043 1044 numip (5): /* add another digit to integer part */ 1045 digit (expona + 1 + hbound (digit, 1) + 1) = chr; 1046 expona = expona + 1; 1047 if expona = 0 1048 then go to eat_up_long_number_ip; 1049 1050 char_count = char_count + 1; 1051 if char_count = 0 1052 then begin; 1053 go to case (esw); 1054 case (1): 1055 case (2): 1056 go to unexpected_end_of_text; 1057 case (0): 1058 case (3): 1059 chr = NewLine; 1060 end; 1061 else do; 1062 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1063 char_index = char_index + 1; 1064 end; 1065 go to numip (char_type (chr)); 1066 1067 numip (7): /* decimal point ends integer part, begins fraction part */ 1068 if esw ^= apl_scan_ 1069 then string (stack_value_ptr -> value_bead.type) = string (stack_value_ptr -> value_bead.type) & not_integer_mask; 1070 /* decimal point means not an integer (not always, e.g. 1.0, but assume always anyway) */ 1071 else token_type = 4; 1072 1073 exponb = expona; 1074 go to numfp_join; 1075 1076 numfp (5): /* add another digit to fraction part */ 1077 digit (exponb + 1 + hbound (digit, 1) + 1) = chr; 1078 exponb = exponb + 1; 1079 if exponb = 0 1080 then go to eat_up_long_number_fp; 1081 numfp_join: 1082 char_count = char_count + 1; 1083 if char_count = 0 1084 then begin; 1085 go to case (esw); 1086 case (1): 1087 case (2): 1088 go to unexpected_end_of_text; 1089 case (0): 1090 case (3): 1091 chr = NewLine; 1092 end; 1093 else do; 1094 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1095 char_index = char_index + 1; 1096 end; 1097 go to numfp (char_type (chr)); 1098 1099 1100 numip (2): 1101 numfp (2): 1102 numhp1 (2): 1103 numhp2 (2): /* E seen - begin exponent */ 1104 if esw ^= apl_scan_ 1105 then string (stack_value_ptr -> value_bead.type) = string (stack_value_ptr -> value_bead.type) & not_integer_mask; 1106 else token_type = 4; /* if there is an exponent, decide that it is not an integer */ 1107 exponb = 0; /* expona = number of digits of integer part - (1+hbound(digit,1)+1) */ 1108 /* exponb gets exponent */ 1109 negative_exponent = "0"b; /* assume no upper minus after E */ 1110 1111 char_count = char_count + 1; 1112 if char_count = 0 1113 then begin; 1114 go to case (esw); 1115 case (1): 1116 case (2): 1117 go to unexpected_end_of_text; 1118 case (0): 1119 case (3): 1120 chr = NewLine; 1121 end; 1122 else do; 1123 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1124 char_index = char_index + 1; 1125 end; 1126 if chr = UpperMinus 1127 then negative_exponent = "1"b; 1128 else go to numep (char_type (chr)); 1129 1130 numep_getc: 1131 char_count = char_count + 1; 1132 if char_count = 0 1133 then begin; 1134 go to case (esw); 1135 case (1): 1136 case (2): 1137 go to unexpected_end_of_text; 1138 case (0): 1139 case (3): 1140 chr = NewLine; 1141 end; 1142 else do; 1143 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1144 char_index = char_index + 1; 1145 end; 1146 go to numep (char_type (chr)); 1147 1148 numep (5): /* add digit to exponent */ 1149 exponb = exponb * 10 + chr - Zero; 1150 go to numep_getc; 1151 1152 numep (0): 1153 numep (1): 1154 numep (2): 1155 numep (3): 1156 numep (4): 1157 numep (6): 1158 numep (8): 1159 numep (9): 1160 numep (10): 1161 numep (11): 1162 numep (12): 1163 numep (13): 1164 numep (14): 1165 numep (15): 1166 numep (16): 1167 numep (17): 1168 numep (18): 1169 numep (19): 1170 numep (20): 1171 numep (21): 1172 numep (22): 1173 numep (23): /* finish exponent (break chr seen) */ 1174 if negative_exponent 1175 then exponb = -exponb; 1176 1177 expona = expona + exponb; /* set expona as if 0's given instead of E, fall through */ 1178 1179 numip (0): 1180 numip (1): 1181 numip (3): 1182 numip (4): 1183 numip (6): 1184 numip (8): 1185 numip (9): 1186 numip (10): 1187 numip (11): 1188 numip (12): 1189 numip (13): 1190 numip (14): 1191 numip (15): 1192 numip (16): 1193 numip (17): 1194 numip (18): 1195 numip (19): 1196 numip (20): 1197 numip (21): 1198 numip (22): 1199 numip (23): 1200 numfp (0): 1201 numfp (1): 1202 numfp (3): 1203 numfp (4): 1204 numfp (6): 1205 numfp (8): 1206 numfp (9): 1207 numfp (10): 1208 numfp (11): 1209 numfp (12): 1210 numfp (13): 1211 numfp (14): 1212 numfp (15): 1213 numfp (16): 1214 numfp (17): 1215 numfp (18): 1216 numfp (19): 1217 numfp (20): 1218 numfp (21): 1219 numfp (22): 1220 numfp (23): 1221 numhp1 (0): 1222 numhp1 (1): 1223 numhp1 (3): 1224 numhp1 (4): 1225 numhp1 (6): 1226 numhp1 (8): 1227 numhp1 (9): 1228 numhp1 (10): 1229 numhp1 (11): 1230 numhp1 (12): 1231 numhp1 (13): 1232 numhp1 (14): 1233 numhp1 (15): 1234 numhp1 (16): 1235 numhp1 (17): 1236 numhp1 (18): 1237 numhp1 (19): 1238 numhp1 (20): 1239 numhp1 (21): 1240 numhp1 (22): 1241 numhp1 (23): 1242 numhp2 (0): 1243 numhp2 (1): 1244 numhp2 (3): 1245 numhp2 (4): 1246 numhp2 (6): 1247 numhp2 (8): 1248 numhp2 (9): 1249 numhp2 (10): 1250 numhp2 (11): 1251 numhp2 (12): 1252 numhp2 (13): 1253 numhp2 (14): 1254 numhp2 (15): 1255 numhp2 (16): 1256 numhp2 (17): 1257 numhp2 (18): 1258 numhp2 (19): 1259 numhp2 (20): 1260 numhp2 (21): 1261 numhp2 (22): 1262 numhp2 (23): 1263 number_finish: /* finish number (break chr seen) */ 1264 /* put in expona as the exponent */ 1265 expona = expona + 1; /* fudge,fudge, wonderful fudge from fudgetown! */ 1266 1267 if expona > 127 1268 then go to substitute_infinity; /* next statement would raise size condition */ 1269 if expona < -127 1270 then go to substitute_zero; /* ... */ 1271 exponent = expona; /* pack exponent into decimal number */ 1272 1273 if abs (number_buffer) > decimal (TheBiggestNumberWeveGot) 1274 then go to substitute_infinity; 1275 else if abs (number_buffer) < decimal (TheSmallestNumberWeveGot) 1276 then go to substitute_zero; /* OK, number_buffer may now be assigned to numeric_datum without raising any conditions or otherwise losing */ 1277 1278 apl_number = binary (number_buffer * magic_rounding_constant, 63); 1279 1280 num_spit_out: 1281 if esw = apl_scan_ 1282 then go to end_number_scan; 1283 space_left_in_stack = space_left_in_stack - size (apl_number_for_size); 1284 if space_left_in_stack < 0 1285 then go to value_stack_exceeded; 1286 1287 stack_value_ptr -> value_bead.data_pointer -> numeric_datum (stack_value_ptr -> value_bead.total_data_elements) = 1288 apl_number; 1289 if stack_value_ptr -> value_bead.data_type.zero_or_one_value 1290 then /* some possibility that might be 0 or 1 */ 1291 if apl_number ^= 0.0e0 1292 then if apl_number ^= 1.0e0 1293 then /* so see whether or not it really is */ 1294 stack_value_ptr -> value_bead.data_type.zero_or_one_value = "0"b; 1295 stack_value_ptr -> value_bead.total_data_elements = stack_value_ptr -> value_bead.total_data_elements + 1; 1296 go to snail (char_type (chr)); /* number has been emitted, look at break chr again */ 1297 1298 1299 1300 start_number_with_decimal_point: 1301 number_buffer = decimal_zero; 1302 dec_point_join: 1303 expona, exponb = -(1 + hbound (digit, 1) + 1); 1304 if esw ^= apl_scan_ 1305 then do; 1306 call numsetup; 1307 string (stack_value_ptr -> value_bead.type) = 1308 string (stack_value_ptr -> value_bead.type) & not_integer_mask; 1309 end; 1310 else token_type = 4; 1311 1312 numfplz: /* skip over leading zeroes in fraction part */ 1313 char_count = char_count + 1; 1314 if char_count = 0 1315 then begin; 1316 go to case (esw); 1317 case (1): 1318 case (2): 1319 go to unexpected_end_of_text; 1320 case (0): 1321 case (3): 1322 chr = NewLine; 1323 end; 1324 else do; 1325 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1326 char_index = char_index + 1; 1327 end; 1328 if chr ^= Zero 1329 then go to numfp (char_type (chr)); 1330 expona = expona - 1; /* adjust for zero being thrown away */ 1331 go to numfplz; 1332 1333 1334 /* come here when numeric underflow */ 1335 1336 substitute_zero: 1337 apl_number = 0.0e0; 1338 go to num_spit_out; 1339 1340 /* come here when numeric overflow */ 1341 1342 substitute_infinity: 1343 if sign = "-" 1344 then apl_number = -TheBiggestNumberWeveGot; 1345 else apl_number = TheBiggestNumberWeveGot; 1346 go to num_spit_out; 1347 1348 1349 /* come here if two decimal points in a number */ 1350 1351 numep (7): 1352 numfp (7): 1353 numhp2 (7): 1354 if esw = apl_scan_ 1355 then go to end_number_scan; 1356 code = apl_error_table_$extra_decimal_point; 1357 go to error; 1358 1359 1360 /* come here to eat up extra digits if the loser types more than 60 or so */ 1361 1362 numhp1 (5): 1363 expona = expona + 1; /* these digits are still to the left of a decimal point */ 1364 eat_up_long_number_ip: 1365 char_count = char_count + 1; 1366 if char_count = 0 1367 then begin; 1368 go to case (esw); 1369 case (1): 1370 case (2): 1371 go to unexpected_end_of_text; 1372 case (0): 1373 case (3): 1374 chr = NewLine; 1375 go to number_finish; 1376 end; 1377 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1378 char_index = char_index + 1; 1379 go to numhp1 (char_type (chr)); 1380 1381 1382 eat_up_long_number_fp: 1383 numhp2 (5): 1384 numhp1 (7): /* eat digits to right of decimal point */ 1385 char_count = char_count + 1; 1386 if char_count = 0 1387 then begin; 1388 go to case (esw); 1389 case (1): 1390 case (2): 1391 go to unexpected_end_of_text; 1392 case (0): 1393 case (3): 1394 chr = NewLine; 1395 go to number_finish; 1396 end; 1397 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 1398 char_index = char_index + 1; 1399 go to numhp2 (char_type (chr)); 1400 1401 numsetup: 1402 proc; 1403 1404 if last_lexeme ^= ConstantLexeme 1405 then do; /* make value bead, as with char constant */ 1406 1407 source_pos (lexeme_index) = char_index; /* as if we had already emitted the constant-lexeme */ 1408 lexeme_index = lexeme_index + 1; 1409 stmt_length_map (stmt_number) = stmt_length_map (stmt_number) + 1; 1410 stack_value_ptr = addr (temp_lexeme_array (lexeme_index)); 1411 last_lexeme = ConstantLexeme; 1412 1413 number_of_dimensions = 1; 1414 if space_left_in_stack < size (value_bead) + 1 1415 then go to value_stack_exceeded; 1416 1417 string (stack_value_ptr -> value_bead.type) = zero_or_one_value_type; 1418 /* some bits may get cleared later */ 1419 /* don't worry about fields not assigned here, see char const comments */ 1420 stack_value_ptr -> value_bead.reference_count = -1; 1421 stack_value_ptr -> value_bead.total_data_elements = 0; 1422 stack_value_ptr -> value_bead.rhorho = 1; 1423 1424 /* set data_pointer to next double word. */ 1425 1426 temp_ptr = addr (stack_value_ptr -> value_bead.rho (2)); 1427 /* next available word. */ 1428 if substr (rel (temp_ptr), 18, 1) /* if on an odd word boundary */ 1429 then temp_ptr = addrel (temp_ptr, 1); /* then make it even */ 1430 1431 stack_value_ptr -> value_bead.data_pointer = temp_ptr; 1432 1433 space_left_in_stack = 1434 maximum_value_stack_size - fixed (rel (stack_value_ptr -> value_bead.data_pointer), 18); 1435 end; 1436 else if stack_value_ptr -> value_bead.data_type.numeric_value 1437 then ; /* OK to append to prev number */ 1438 else go to barf_at_constant_mism; /* not OK to append to prev string */ 1439 end numsetup; 1440 1441 /*** routine called to get at least half a segment of value stack space. 1442* anyone who tries to lex a function bigger than this is crazy! 1443* ***/ 1444 1445 setup_value_stack: 1446 proc; 1447 1448 dcl apl_get_next_value_stack_seg_ 1449 entry (fixed bin (21)); 1450 1451 value_stack_popper = ws_info.value_stack_ptr; /* so can restore ws_info.value_stack_ptr on return */ 1452 space_left_in_stack = maximum_value_stack_size - fixed (rel (value_stack_popper), 18); 1453 if space_left_in_stack < 32768 1454 then do; /* this seg is too small, get another one */ 1455 call apl_get_next_value_stack_seg_ (32768); 1456 value_stack_space = ws_info.value_stack_ptr; 1457 space_left_in_stack = maximum_value_stack_size - fixed (rel (value_stack_space), 18); 1458 end; 1459 else value_stack_space = value_stack_popper; /* if keeping same seg */ 1460 end setup_value_stack; 1461 1462 snail (9): /* skip over comment */ 1463 call for_illumination_only; 1464 go to process_newline; 1465 1466 /*** hirsute apl assignment operator gets all kinds of help from this phase of parse so 1467* runtime parser will not have to do as much work ***/ 1468 1469 snail (22): 1470 if last_lexeme = NameLexeme 1471 then if lexeme = null 1472 then go to hrund_emit_operator; /* if lexing for errors, will be null ptr */ 1473 else if lexeme -> general_bead.type.symbol 1474 then go to hrund_emit_operator; /* assignment to user variable, easy - just emit -<- lexeme */ 1475 else if lexeme -> general_bead.type.operator 1476 then do; /* assignment to system variable */ 1477 if lexeme -> operator_bead.ignores_assignment 1478 then lexeme = addr (operator_bead_table (op_index (AssignIgnore))); 1479 else if lexeme -> operator_bead.special_assignment 1480 then lexeme = addr (lexeme -> system_var_op.assignment_to); 1481 else go to ulose; 1482 1483 last_lexeme = OperatorLexeme; 1484 go to hrund_replace; 1485 end; 1486 else go to ulose; 1487 1488 else if last_lexeme = ValueLexeme /***** then if lexeme = addr(operator_bead_table(op_index(RightBracket))) then do; *****/ 1489 then do; /**** this kludge is due to bad code by PL/I for pointer compare packed ****/ 1490 hack_ptr = lexeme; 1491 if hack_ptr = addr (operator_bead_table (op_index (RightBracket))) 1492 then do; 1493 1494 /* subscripted assignment - first step is to find the left end of the subscript calculation */ 1495 1496 /***** the following code has been hacked up because of bad code generated by the PL/I compiler 1497* for comparing a packed pointer with the addr of something *****/ 1498 1499 n = 0; 1500 do begin_subscript_calc = lexeme_index - 1 by -1; 1501 /* look back */ 1502 hack_ptr = temp_lexeme_array (begin_subscript_calc); 1503 /* copy to avoid ptr compare bug and also because 1504* optimizer did not optimize repeated references */ 1505 if hack_ptr = addr (operator_bead_table (op_index (RightBracket))) 1506 then n = n + 1; 1507 else if hack_ptr = addr (operator_bead_table (op_index (RightOprBracket))) 1508 then n = n + 1; 1509 else if hack_ptr = addr (operator_bead_table (op_index (RightParen))) 1510 then n = n + 1; 1511 else if hack_ptr = addr (operator_bead_table (op_index (LeftParen))) 1512 then n = n - 1; 1513 else if hack_ptr = addr (operator_bead_table (op_index (LeftBracket))) 1514 then n = n - 1; 1515 if n = 0 1516 then go to exitloop_for_subscript_calc; 1517 end; 1518 exitloop_for_subscript_calc: /* begin_subscript_calc -> "[" lexeme */ 1519 begin_subscript_calc = begin_subscript_calc - 1; 1520 /* lexeme being subscripted */ 1521 lexeme = temp_lexeme_array (begin_subscript_calc); 1522 if lexeme = null 1523 then go to subscripted_assign_user_var; 1524 /* bug when lexing for errors */ 1525 if lexeme -> general_bead.type.operator 1526 then if lexeme -> operator_bead.allow_subscripted_assignment 1527 then temp_lexeme_array (begin_subscript_calc) = 1528 addr (lexeme -> system_var_op.subscripted_assignment_to); 1529 1530 else if lexeme -> operator_bead.ignores_assignment 1531 then temp_lexeme_array (begin_subscript_calc) = 1532 addr (operator_bead_table (op_index (AssignIgnore))); 1533 else do; 1534 char_index = source_pos (begin_subscript_calc); 1535 /* get marker at right place */ 1536 go to barf_at_bad_subscripted_assignment_to_system_variable; 1537 end; 1538 else if lexeme -> general_bead.type.symbol 1539 then do; /* subscripted assignment to user variable */ 1540 subscripted_assign_user_var: /* move subscript to right of the assignment lexeme. */ 1541 space_left_in_stack = space_left_in_stack - temp_lexeme_size; 1542 if space_left_in_stack < 0 1543 then go to value_stack_exceeded; 1544 1545 begin_subscript_calc = begin_subscript_calc + 1; 1546 /* -> leftmost thing to be moved to right */ 1547 do i = lexeme_index by -1 while (i ^= begin_subscript_calc); 1548 /* Move Right to Left loop */ 1549 emission_array (i) = emission_array (i - 1); 1550 end; 1551 temp_lexeme_array (begin_subscript_calc) = 1552 addr (operator_bead_table (op_index (AssignSub))); 1553 /* insert subscripted assignment operator to 1554* the left of the brakcet subscript calculation */ 1555 source_pos (begin_subscript_calc) = char_index; 1556 lexeme_index = lexeme_index + 1; 1557 /* one more lexeme has been emitted here */ 1558 stmt_length_map (stmt_number) = stmt_length_map (stmt_number) + 1; 1559 end; 1560 else go to barf_at_badass; 1561 1562 end; /* end of subscripted-assignment do */ 1563 else go to barf_at_badass; 1564 end; /****** end of hack_ptr do, due to PL/I compiler bug ******/ 1565 else go to barf_at_badass; /* assignment preceded by some random lexeme */ 1566 1567 temp_lexeme_array (lexeme_index - 1) = addr (operator_bead_table (op_index (RightOprBracket))); 1568 last_lexeme = OperatorLexeme; /* assignment looks to right like monadic operator, with rank qualifier */ 1569 go to start_new_lexeme; 1570 1571 /*** all has been lexed, make a lexed_function_bead ***/ 1572 1573 end_of_text: 1574 if esw ^= apl_execute_lex_ 1575 then if char_index ^= line_index 1576 then go to barf_at_not_end_with_newline; 1577 1578 /** if errors occurred, don't make a lexed_function_bead since our caller won't look at it anyway **/ 1579 1580 if errors_occurred 1581 then go to die_die_die; 1582 1583 lexeme_index = lexeme_index - 1; /* flush extra begin-line lexeme */ 1584 1585 if esw = apl_line_lex_ 1586 then if line_no ^= 2 1587 then go to barf_at_more_than_one_line; 1588 else ; 1589 else if esw = apl_execute_lex_ 1590 then if line_no ^= 2 1591 then go to barf_at_more_than_one_line_execute; 1592 1593 /* allocate lexed_function_bead */ 1594 1595 if a_bad_lexeme_index ^= 0 1596 then go to ulose; /* shouldn't get here! ought to have encountered 1597* the bad lexeme by now */ 1598 call apl_allocate_words_ (size (lexed_function_bead) + number_of_localized_symbols + 3 + 2 * number_of_labels 1599 + lexeme_index + line_no - 1 - 1, lex_return_pointer); 1600 1601 string (lex_return_pointer -> lexed_function_bead.type) = lexed_function_type; 1602 1603 lex_return_pointer -> lexed_function_bead.name = function_being_lexed; 1604 lex_return_pointer -> lexed_function_bead.number_of_statements = line_no - 1; 1605 lex_return_pointer -> lexed_function_bead.number_of_localized_symbols = 1606 number_of_localized_symbols + number_of_labels + 3; 1607 lex_return_pointer -> lexed_function_bead.number_of_labels = number_of_labels; 1608 lex_return_pointer -> lexed_function_bead.label_values_ptr = 1609 addr (lex_return_pointer -> lexed_function_bead.label_values); 1610 lex_return_pointer -> lexed_function_bead.statement_map_ptr = 1611 addr (lex_return_pointer -> lexed_function_bead.statement_map); 1612 lex_return_pointer -> lexed_function_bead.lexeme_array_ptr = 1613 addr (lex_return_pointer -> lexed_function_bead.lexeme_array); 1614 lex_return_pointer -> lexed_function_bead.localized_symbols (ReturnSymbol) = return_value_symbol; 1615 lex_return_pointer -> lexed_function_bead.localized_symbols (LeftArgSymbol) = left_arg_symbol; 1616 lex_return_pointer -> lexed_function_bead.localized_symbols (RightArgSymbol) = right_arg_symbol; 1617 do n = 1 by 1 while (n <= number_of_localized_symbols); 1618 lex_return_pointer -> lexed_function_bead.localized_symbols (n + 3) = MY.localized_symbols (n); 1619 end; 1620 1621 if number_of_labels ^= 0 1622 then do; 1623 1624 /* set up label_values */ 1625 1626 1627 template_ptr = addr (number_buffer); 1628 1629 /* initialize label template outside the loop, except the actual value, stored in apl_number */ 1630 1631 string (template_ptr -> value_bead.type) = label_type; 1632 template_ptr -> value_bead.total_data_elements = 1; 1633 template_ptr -> value_bead.rhorho = 0; 1634 template_ptr -> value_bead.data_pointer = addr (apl_number); 1635 1636 n = number_of_localized_symbols + 3; 1637 do i = 1 by 1 while (i < line_no); /* scan statement map for labels */ 1638 if statement_map (i).label ^= null 1639 then do; /* aha! a label */ 1640 n = n + 1; 1641 lex_return_pointer -> lexed_function_bead.localized_symbols (n) = statement_map (i).label; 1642 apl_number = i; /* convert line number label is on to APL number */ 1643 call apl_copy_value_ (template_ptr, 1644 lex_return_pointer -> lexed_function_bead.label_values_ptr 1645 -> lexed_function_label_values (n - number_of_localized_symbols - 3)); 1646 end; 1647 end; 1648 1649 if n ^= lex_return_pointer -> lexed_function_bead.number_of_localized_symbols 1650 then /* whoops */ 1651 go to ulose; 1652 1653 end; /*** end of if number_of_labels ^= 0 then do ***/ 1654 1655 /* set up statement map */ 1656 1657 statement_count = line_no - 1; /* set up dimension of lexed_function_statement_map */ 1658 1659 do n = 1 by 1 while (n < line_no); 1660 lex_return_pointer -> lexed_function_bead.statement_map_ptr -> lexed_function_statement_map (n) = 1661 statement_map (n).lexeme_index; 1662 end; 1663 1664 /* now set up the actual lexeme array */ 1665 1666 first_lexeme = 1; 1667 do i = 1 by 1 while (i < line_no); /* step thru each line */ 1668 output_index = statement_map (i).lexeme_index; 1669 /* new line begins same place as old */ 1670 line_len = output_index - first_lexeme + 1; 1671 1672 /* Each line begins with a BOL. It doesn't get moved. It will have the same 1673* position in the output (lexemes are conserved). */ 1674 1675 first_lexeme = first_lexeme + 1; /* don't copy BOL */ 1676 1677 do while (first_lexeme <= statement_map (i).lexeme_index); 1678 n = 0; 1679 done = "0"b; 1680 do lx = first_lexeme to statement_map (i).lexeme_index while (^done); 1681 if temp_lexeme_array (lx) -> general_bead.type.operator 1682 then if temp_lexeme_array (lx) -> operator_bead.type_code = diamond_type 1683 then done = "1"b; 1684 else n = n + 1; 1685 else n = n + 1; 1686 end; 1687 1688 /* At this point n is the number of lexemes before the 1689* diamond, if any */ 1690 1691 do lx = n - 1 to 0 by -1; /* copy lexemes backwards */ 1692 lex_return_pointer -> lexed_function_bead.lexeme_array_ptr 1693 -> lexed_function_lexeme_array (output_index) = temp_lexeme_array (first_lexeme + lx); 1694 output_index = output_index - 1; 1695 end; 1696 1697 /* If there is a diamond, copy it */ 1698 1699 first_lexeme = first_lexeme + n; 1700 1701 if first_lexeme <= statement_map (i).lexeme_index 1702 then do; 1703 lex_return_pointer -> lexed_function_bead.lexeme_array_ptr 1704 -> lexed_function_lexeme_array (output_index) = temp_lexeme_array (first_lexeme); 1705 output_index = output_index - 1; 1706 first_lexeme = first_lexeme + 1; 1707 end; 1708 end; 1709 1710 lex_return_pointer -> lexed_function_bead.lexeme_array_ptr -> lexed_function_lexeme_array (output_index) = 1711 temp_lexeme_array (output_index); 1712 end; 1713 1714 ws_info.value_stack_ptr = value_stack_popper; /* pop our temporary storage off the value stack */ 1715 1716 /*** set up bits_for_parse field ***/ 1717 1718 unspec (lex_return_pointer -> lexed_function_bead.bits_for_parse) = ""b; 1719 lex_return_pointer -> lexed_function_bead.bits_for_parse.function = "1"b; 1720 lex_return_pointer -> lexed_function_bead.bits_for_parse.op1 = 99; 1721 if right_arg_symbol ^= null 1722 then if left_arg_symbol ^= null 1723 then lex_return_pointer -> lexed_function_bead.bits_for_parse.dyadic = "1"b; 1724 else lex_return_pointer -> lexed_function_bead.bits_for_parse.monadic = "1"b; 1725 1726 return; /* done!! */ 1727 1728 /*** here are some error routines ***/ 1729 1730 misplaced_right_arrow: 1731 code = apl_error_table_$misplaced_right_arrow; 1732 go to error; 1733 1734 snail (0): 1735 snail (13): 1736 code = apl_error_table_$random_char; 1737 go to error; 1738 1739 barf_at_ill_reduction: 1740 if chr ^= Slash & chr ^= SlashHyphen 1741 then code = apl_error_table_$ill_scan; 1742 else code = apl_error_table_$ill_reduction; 1743 go to error; 1744 1745 ulose: 1746 code = apl_error_table_$lex_screwed_up; 1747 go to fatal_error; 1748 1749 1750 barf_at_not_end_with_newline: 1751 unexpected_end_of_text: 1752 if esw = apl_execute_lex_ 1753 then do; 1754 code = apl_error_table_$too_short_execute; 1755 go to error; 1756 end; 1757 code = apl_error_table_$not_end_with_newline; 1758 go to fatal_error; 1759 barf_at_ill_inner_prod: 1760 code = apl_error_table_$ill_inner_prod; 1761 go to error; 1762 1763 barf_at_misplaced_diamond: 1764 code = apl_error_table_$misplaced_diamond; 1765 go to error; 1766 1767 barf_at_misplaced_semicolon: 1768 code = apl_error_table_$misplaced_semicolon; 1769 go to error; 1770 1771 barf_at_excess_right_parens: 1772 code = apl_error_table_$excess_right_parens; 1773 go to error; 1774 1775 barf_at_mismatched_parens: 1776 code = apl_error_table_$mismatched_parens; 1777 go to error; 1778 1779 barf_at_ill_opr_brackets: 1780 code = apl_error_table_$ill_opr_brackets; 1781 go to error; 1782 1783 barf_at_brackets_beginning: 1784 code = apl_error_table_$misplaced_brackets; 1785 go to error; 1786 1787 barf_at_excess_right_brackets: 1788 code = apl_error_table_$excess_right_brackets; 1789 go to error; 1790 1791 barf_at_not_end_with_value: 1792 code = apl_error_table_$not_end_with_value; 1793 go to error; 1794 1795 barf_at_ill_small_circle: 1796 code = apl_error_table_$ill_small_circle; 1797 go to error; 1798 1799 barf_at_unknown_system_name: 1800 code = apl_error_table_$unknown_system_name; 1801 go to err_back_over_name; 1802 1803 value_stack_exceeded: 1804 code = apl_error_table_$ws_full_in_lex; 1805 go to fatal_error; 1806 1807 barf_at_constant_mism: 1808 code = apl_error_table_$constant_mism; 1809 go to error; 1810 1811 unexpected_eot_char_constant: 1812 begin; 1813 go to case (esw); 1814 case (2): 1815 if error_suppress 1816 then go to case (3); /* entry was apl_function_lex_no_messages_, diff. error */ 1817 code = apl_error_table_$mism_quotes; 1818 go to fatal_error; 1819 case (1): 1820 case (3): /* is user error rather than system error */ 1821 code = apl_error_table_$u_mism_ur_quotes; 1822 go to error; 1823 1824 end; 1825 1826 barf_at_ill_paren_level: 1827 char_count = char_count - (char_index - paren_loc (1)); 1828 char_index = paren_loc (1); /* location of left-most unbalanced paren */ 1829 code = apl_error_table_$ill_paren_level; 1830 go to error; 1831 1832 barf_at_not_allowed_inner_prod: 1833 code = apl_error_table_$not_allowed_inner_prod; 1834 go to error; 1835 1836 barf_at_not_allowed_outer_prod: 1837 code = apl_error_table_$not_allowed_outer_prod; 1838 go to error; 1839 1840 barf_at_more_than_one_line: 1841 code = apl_error_table_$more_than_one_line; 1842 go to fatal_error; 1843 1844 barf_at_more_than_one_line_execute: 1845 code = apl_error_table_$more_than_one_line_execute; 1846 go to error; 1847 1848 barf_at_badass: 1849 code = apl_error_table_$badass; 1850 go to error; 1851 1852 barf_at_bad_subscripted_assignment_to_system_variable: 1853 code = apl_error_table_$bad_subsc_assign_sys_var; 1854 go to error; 1855 1856 barf_at_lone_upper_minus: 1857 if esw = apl_scan_ 1858 then go to scan0 (0); 1859 code = apl_error_table_$lone_upper_minus; 1860 go to error; 1861 1862 barf_at_bad_localization: 1863 code = apl_error_table_$cant_be_localized; 1864 go to fatal_error; 1865 1866 barf_at_lone_period: 1867 code = apl_error_table_$lone_period; 1868 go to error; 1869 1870 barf_at_excess_label: 1871 code = apl_error_table_$excess_label; 1872 go to error; 1873 1874 duplicate_label: 1875 code = apl_error_table_$duplicate_label; 1876 go to error; 1877 1878 /*** routines transferred to by the above barfs ***/ 1879 1880 err_back_over_name: /* back up to beginning of identifier */ 1881 do while ("1"b); 1882 char_count = char_count - 1; 1883 char_index = char_index - 1; 1884 if char_index = 0 1885 then go to err_hack; /* reached begin of text */ 1886 n = char_type (fixed (unspec (substr (text, char_index - 1 + 1, 1)))); 1887 if n ^= 1 1888 then if n ^= 2 1889 then if n ^= 3 1890 then if n ^= 5 1891 then go to err_hack; /* found break char preceding name */ 1892 end; /* keep looping */ 1893 1894 err_hack: /* exitloop for the preceding loop */ 1895 char_count = char_count + 1; 1896 char_index = char_index + 1; /* as if the chr to be marked had just been read */ 1897 1898 /* fall into error */ 1899 1900 1901 error: /* barf and go on to the next line looking for more errors */ 1902 fatal = "0"b; 1903 if error_suppress 1904 then go to die_die_die; /* if not allowed to print messages, just go tell caller. 1905* don't even bother to check for any more errors */ 1906 go to handle_lex_error; 1907 1908 fatal_error: /* error from which lex cannot recover */ 1909 fatal = "1"b; 1910 1911 handle_lex_error: /* find length of the current line */ 1912 begin; 1913 go to case (esw); 1914 1915 case (1): 1916 case (2): 1917 ll = index (substr (text, char_index - 1 + 1), NL) - 1; 1918 if ll < 0 1919 then ll = length (substr (text, char_index - 1 + 1)); 1920 ll = ll + char_index - line_index /* +1-1*/; 1921 go to endcase; 1922 1923 case (3): 1924 ll = -char_count - 1 + char_index - line_index; 1925 if char_count >= 0 1926 then ll = ll + 1; /* reached end of execute, forged NewLine 1927* was not counted in char_index */ 1928 1929 endcase: 1930 end; 1931 1932 call apl_error_ (code, ""b, char_index - line_index /* +1-1 */, substr (text, line_index + 1, ll), 1933 /* the losing line */ 1934 function_being_lexed, line_no); 1935 1936 if fatal 1937 then do; /* crap out of lex */ 1938 die_die_die: 1939 errors_occurred = "1"b; /* tell our caller that we have printed some error messages */ 1940 call cleanup; 1941 lex_return_pointer = null; 1942 if esw = apl_function_lex_ 1943 then if error_suppress 1944 then if error_line_number_arg = 0 1945 then error_line_number_arg = line_no; 1946 return; 1947 end; 1948 1949 errors_occurred = "1"b; /* tell our caller that we have printed some error messages */ 1950 1951 /* nonfatal error, advance to next line and continue lexing */ 1952 1953 char_count = char_count + ll - char_index + line_index; 1954 char_index = line_index + ll; 1955 go to start_line; 1956 1957 /*** get rid of all the beads we generated ***/ 1958 1959 cleanup: 1960 proc; 1961 1962 do i = lbound (MY.localized_symbols, 1) by 1 while (i <= hbound (MY.localized_symbols, 1)); 1963 call wash (MY.localized_symbols (i)); 1964 end; 1965 1966 if last_lexeme = ConstantLexeme 1967 then n = hbound (temp_lexeme_array, 1) - 1; /* last lexeme has not yet been stored into */ 1968 else n = hbound (temp_lexeme_array, 1); 1969 1970 do i = lbound (temp_lexeme_array, 1) by 1 while (i < n); 1971 /* yes, < not <= ! */ 1972 call wash (temp_lexeme_array (i)); 1973 end; 1974 1975 call wash (function_being_lexed); 1976 call wash (left_arg_symbol); 1977 call wash (right_arg_symbol); 1978 call wash (return_value_symbol); 1979 ws_info.value_stack_ptr = value_stack_popper; 1980 return; 1981 1982 wash: 1983 procedure (temp_ptr); 1984 1985 /* parameters */ 1986 1987 dcl temp_ptr ptr unal parameter; 1988 1989 /* program */ 1990 1991 if temp_ptr ^= null 1992 then if ^temp_ptr -> general_bead.type.operator 1993 then do; 1994 temp_ptr -> general_bead.reference_count = temp_ptr -> general_bead.reference_count - 1; 1995 if temp_ptr -> general_bead.reference_count < 1 1996 then call apl_free_bead_ (temp_ptr); 1997 end; 1998 1999 end wash; 2000 2001 end cleanup; 2002 2003 /*** special entry point used by QuadFX ***/ 2004 2005 apl_function_lex_no_messages_: 2006 entry (text, lex_return_pointer, errors_occurred, a_bad_lexeme_index, parse_stack_space, error_line_number_arg); 2007 2008 dcl error_line_number_arg 2009 fixed bin; /* returns number of the argument that lost */ 2010 2011 error_line_number_arg = 0; /* initialize */ 2012 error_suppress = "1"b; 2013 go to join_with_apl_function_lex_; 2014 2015 /*** this entry is for lexing a function. It knows about header lines, labels, etc. ***/ 2016 2017 apl_function_lex_: 2018 entry (text, lex_return_pointer, errors_occurred, a_bad_lexeme_index, parse_stack_space); 2019 2020 2021 error_suppress = "0"b; 2022 join_with_apl_function_lex_: 2023 esw = apl_function_lex_; 2024 char_count = -length (text) - 1; 2025 errors_occurred = "0"b; 2026 last_lexeme = BeginOfLine; 2027 char_index = 0; 2028 lexeme_index = 1; 2029 line_no = 0; /* in case of error in header line */ 2030 line_index = 0; /* in case of error in header line */ 2031 call setup_value_stack; 2032 number_of_labels = 0; 2033 char_count = -length (text) - 1; 2034 2035 /*** process header line, producing localized_symbols table, and 2036* setting the automatic variables function_being_lexed, left_arg_symbol, right_arg_symbol, return_value_symbol ***/ 2037 2038 number_of_localized_symbols = 0; 2039 lexeme = null; 2040 return_value_symbol = null; /* assume none will show up */ 2041 2042 hdr1_loop: 2043 hdr1 (11): /* to ignore blanks at begin of header line */ 2044 char_count = char_count + 1; 2045 if char_count = 0 2046 then go to unexpected_end_of_text; 2047 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2048 char_index = char_index + 1; 2049 2050 go to hdr1 (char_type (chr)); 2051 2052 hdr1 (0): 2053 hdr1 (3): 2054 hdr1 (4): 2055 hdr1 (5): 2056 hdr1 (6): 2057 hdr1 (7): 2058 hdr1 (8): 2059 hdr1 (12): 2060 hdr1 (13): 2061 hdr1 (14): 2062 hdr1 (15): 2063 hdr1 (16): 2064 hdr1 (18): 2065 hdr1 (19): 2066 hdr1 (20): 2067 hdr1 (21): 2068 hdr1 (23): 2069 hdr2 (0): 2070 hdr2 (3): 2071 hdr2 (4): 2072 hdr2 (5): 2073 hdr2 (6): 2074 hdr2 (7): 2075 hdr2 (8): 2076 hdr2 (12): 2077 hdr2 (13): 2078 hdr2 (14): 2079 hdr2 (15): 2080 hdr2 (16): 2081 hdr2 (18): 2082 hdr2 (19): 2083 hdr2 (20): 2084 hdr2 (21): 2085 hdr2 (23): 2086 hdr3 (0): 2087 hdr3 (3): 2088 hdr3 (4): 2089 hdr3 (5): 2090 hdr3 (6): 2091 hdr3 (7): 2092 hdr3 (8): 2093 hdr3 (12): 2094 hdr3 (13): 2095 hdr3 (14): 2096 hdr3 (15): 2097 hdr3 (16): 2098 hdr3 (18): 2099 hdr3 (19): 2100 hdr3 (20): 2101 hdr3 (21): 2102 hdr3 (22): 2103 hdr3 (23): 2104 hdr4 (0): 2105 hdr4 (3): 2106 hdr4 (4): 2107 hdr4 (5): 2108 hdr4 (6): 2109 hdr4 (7): 2110 hdr4 (8): 2111 hdr4 (12): 2112 hdr4 (13): 2113 hdr4 (14): 2114 hdr4 (15): 2115 hdr4 (16): 2116 hdr4 (18): 2117 hdr4 (19): 2118 hdr4 (20): 2119 hdr4 (21): 2120 hdr4 (22): 2121 hdr4 (23): 2122 hdr5 (0): 2123 hdr5 (4): 2124 hdr5 (5): 2125 hdr5 (6): 2126 hdr5 (7): 2127 hdr5 (8): 2128 hdr5 (12): 2129 hdr5 (13): 2130 hdr5 (14): 2131 hdr5 (15): 2132 hdr5 (16): 2133 hdr5 (18): 2134 hdr5 (19): 2135 hdr5 (20): 2136 hdr5 (21): 2137 hdr5 (22): 2138 hdr5 (23): /* moby dispatch table */ 2139 code = apl_error_table_$random_char_in_hdr; 2140 go to fatal_error; 2141 2142 hdr1 (17): 2143 hdr1 (22): /* semicolon, left arrow */ 2144 code = apl_error_table_$need_name; 2145 go to fatal_error; 2146 2147 2148 hdr1 (9): /* lamp - just as a hack allow comments and blank lines before the header */ 2149 call for_illumination_only; 2150 hdr1 (10): /* NewLine */ 2151 go to hdr1_loop; 2152 2153 2154 hdr1 (1): 2155 hdr1 (2): /* begin of name - parse it and stick it in lexeme - may be return_value or fcn_name */ 2156 call parse_name_in_header_line; 2157 go to hdr2 (char_type (chr)); /* look at chr that ended name */ 2158 2159 /* HEADER 2 LOOP BEGINS HERE */ 2160 2161 hdr2 (11): 2162 char_count = char_count + 1; 2163 if char_count = 0 2164 then go to unexpected_end_of_text; 2165 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2166 char_index = char_index + 1; 2167 2168 go to hdr2 (char_type (chr)); 2169 2170 hdr2 (9): /* lamp - skip comment and trun into semicolon */ 2171 call for_illumination_only; 2172 2173 hdr2 (10): /* newline - there was nothing on the header line but the name of the function */ 2174 hdr2 (17): /* semicolon - similar except local vars to be done */ 2175 function_being_lexed = lexeme; 2176 left_arg_symbol, right_arg_symbol = null; 2177 go to look_for_local_var_dcls; /* which will check whether chr = NewLine or SemiColon */ 2178 2179 hdr2 (22): /* LeftArrow - lexeme is symbol whose value is value of fcn */ 2180 if return_value_symbol = null 2181 then return_value_symbol = lexeme; 2182 else do; 2183 code = apl_error_table_$only_1_return_value; 2184 go to fatal_error; 2185 end; 2186 go to hdr1_loop; /* and go on in same state (just about) */ 2187 2188 2189 hdr2 (1): 2190 hdr2 (2): /* another symbol follows. There are two cases: 2191* 1) one more symbol follows. It is right_arg_symbol and this one is fcn name 2192* 2) two more symbols follow. This one is left_arg_symbol and they are right_arg_symbol and fcn_name 2193* */ 2194 temp_ptr = lexeme; /* hold this one in my hand until I know which case holds */ 2195 2196 call parse_name_in_header_line; 2197 go to hdr3 (char_type (chr)); 2198 2199 /** now search for the break character of this name **/ 2200 2201 /* HEADER 3 LOOP BEGINS HERE */ 2202 2203 hdr3 (11): 2204 char_count = char_count + 1; 2205 if char_count = 0 2206 then go to unexpected_end_of_text; 2207 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2208 char_index = char_index + 1; 2209 go to hdr3 (char_type (chr)); 2210 2211 hdr3 (9): /* lamp - end it all. skip over comment and fall into newline case */ 2212 call for_illumination_only; 2213 2214 hdr3 (10): /* newline - temp_ptr = fcn name and lexeme = right arg symbol */ 2215 hdr3 (17): /* semicolon which is similar to newline */ 2216 function_being_lexed = temp_ptr; 2217 right_arg_symbol = lexeme; 2218 left_arg_symbol = null; 2219 go to look_for_local_var_dcls; /* which checks for semicolon or newline */ 2220 2221 2222 hdr3 (1): 2223 hdr3 (2): /* case 2 - another name follows. deposit the first two and then pick up the third one */ 2224 left_arg_symbol = temp_ptr; 2225 function_being_lexed = lexeme; 2226 call parse_name_in_header_line; 2227 go to hdr4 (char_type (chr)); 2228 2229 2230 /* HEADER 4 LOOP BEGINS HERE */ 2231 2232 hdr4 (11): /* and scan up to following newline or semicolon */ 2233 char_count = char_count + 1; 2234 if char_count = 0 2235 then go to unexpected_end_of_text; 2236 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2237 char_index = char_index + 1; 2238 go to hdr4 (char_type (chr)); 2239 2240 hdr4 (1): 2241 hdr4 (2): /* still another name? that's no good */ 2242 code = apl_error_table_$need_semicolon; 2243 go to fatal_error; 2244 2245 hdr4 (9): /* lamp - skip over comment and trun into newline */ 2246 call for_illumination_only; 2247 2248 hdr4 (10): /* new line - store final arg symbol */ 2249 hdr4 (17): /* semicolon is sort of like newline */ 2250 right_arg_symbol = lexeme; 2251 go to look_for_local_var_dcls; 2252 2253 /* HEADER 5 LOOP BEGINS HERE */ 2254 2255 hdr5 (11): 2256 hdr5 (17): /* skip extraneous blanks and semicolons */ 2257 char_count = char_count + 1; 2258 if char_count = 0 2259 then go to unexpected_end_of_text; 2260 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2261 char_index = char_index + 1; 2262 2263 look_for_local_var_dcls: /* enter here with chr = SemiColon or NewLine */ 2264 go to hdr5 (char_type (chr)); 2265 2266 hdr5 (9): /* lamp - skip over comment and turn into NewLine */ 2267 call for_illumination_only; 2268 2269 hdr5 (10): /* newline - this ends the header line */ 2270 statement_map_ptr = addr (MY.localized_symbols (number_of_localized_symbols + 1)); 2271 go to start_line; /* this is probably the right place to join with the apl_line_lex_ code */ 2272 2273 2274 hdr5 (1): 2275 hdr5 (2): 2276 hdr5 (3): /* seen the beginning of a name - this is a localized variable */ 2277 call parse_name_in_header_line; 2278 2279 number_of_localized_symbols = number_of_localized_symbols + 1; 2280 MY.localized_symbols (number_of_localized_symbols) = lexeme; 2281 2282 nugatory_system_variable_localization: /* abnormal exit from call to parse_name_in_header_line */ 2283 go to hdr5 (char_type (chr)); 2284 2285 /*** routine to gobble up a name in the header line. Similar to the one for names everwhere else ***/ 2286 2287 parse_name_in_header_line: 2288 proc; 2289 2290 name_buffer_ptr = addr (MY.localized_symbols (number_of_localized_symbols + 1)); 2291 /* first free loc on parse stack */ 2292 name_index = 0; 2293 2294 hnm (1): 2295 hnm (2): 2296 hnm (5): 2297 name_buffer_array (name_index) = chr; 2298 name_index = name_index + 1; 2299 2300 char_count = char_count + 1; 2301 if char_count = 0 2302 then go to unexpected_end_of_text; 2303 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2304 char_index = char_index + 1; 2305 go to hnm (char_type (chr)); 2306 2307 hnm (0): 2308 hnm (3): 2309 hnm (4): 2310 hnm (6): 2311 hnm (7): 2312 hnm (8): 2313 hnm (9): 2314 hnm (10): 2315 hnm (11): 2316 hnm (12): 2317 hnm (13): 2318 hnm (14): 2319 hnm (15): 2320 hnm (16): 2321 hnm (17): 2322 hnm (18): 2323 hnm (19): 2324 hnm (20): 2325 hnm (21): 2326 hnm (22): 2327 hnm (23): /* char found that's not allowed in name. name has ended. our caller will figure out what to do with chr */ 2328 if name_buffer_array (0) = Quad 2329 then do; /* localization of system variable is only case that can 2330* come here */ 2331 do n = lbound (system_names, 1) to hbound (system_names, 1); 2332 if system_names (n) = name_buffer 2333 then do; 2334 if ^operator_bead_table (op_index (n)).system_variable 2335 then go to barf_at_bad_localization; 2336 2337 /** localizing system variable, put pointer to operator bead **/ 2338 2339 if operator_bead_table (op_index (n)).ignores_assignment 2340 then go to nugatory_system_variable_localization; 2341 /* take abnormal exit if trivial */ 2342 2343 lexeme = addr (operator_bead_table (op_index (n))); 2344 return; 2345 end; 2346 end; 2347 go to barf_at_bad_localization; 2348 end; 2349 2350 else if a_bad_lexeme_index ^= 0 2351 then lexeme = null; 2352 else call apl_get_symbol_ (name_buffer, lexeme, (0)); 2353 /* don't worry about quad names, stop-trace control, etc. */ 2354 return; 2355 end parse_name_in_header_line; 2356 2357 /*** lamp munger ***/ 2358 2359 for_illumination_only: 2360 proc; /* this proc changes Lamp into NewLine */ 2361 2362 do while (chr ^= NewLine); 2363 char_count = char_count + 1; 2364 if char_count = 0 2365 then if esw = apl_execute_lex_ 2366 then chr = NewLine; 2367 else go to unexpected_end_of_text; 2368 else do; 2369 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2370 char_index = char_index + 1; 2371 end; 2372 end; 2373 end for_illumination_only; 2374 2375 2376 dcl data_elements fixed bin static init (0); /* just to satisfy GGB's include file */ 2377 2378 /***** simple lexer for use of outside world *****/ 2379 2380 2381 apl_scan_: 2382 entry (text, initial_scan_pos, scan_pos, scan_length, token_type, scan_number_ptr_structure); 2383 2384 /* dcl text char(*) aligned; */ 2385 dcl initial_scan_pos fixed bin (21), /* (Input) where to start looking at text */ 2386 scan_pos fixed bin (21), /* (Output) index of first char of token */ 2387 scan_length fixed bin (21), /* (Output) number of characters in token */ 2388 token_type fixed bin, /* (Output) 0=no token found, 1=random char, 2= name, 2389* 3 = positive integer, 4 = some random number */ 2390 1 scan_number_ptr_structure 2391 aligned, /* (Input) null or pointer to place to put number if token_type>=3 */ 2392 2 scan_number_ptr pointer unaligned; 2393 2394 dcl editor_scan bit (1) aligned; 2395 2396 editor_scan = "0"b; 2397 go to scan_begin; 2398 2399 apl_editor_scan_: 2400 entry (text, initial_scan_pos, scan_pos, scan_length, token_type, scan_number_ptr_structure); 2401 2402 editor_scan = "1"b; 2403 2404 scan_begin: 2405 esw = apl_scan_; 2406 char_index = initial_scan_pos - 1; 2407 char_count = -length (text) - 2 + initial_scan_pos; 2408 2409 token_type = 0; 2410 scan_length = 0; /* assuming will find no token */ 2411 2412 /* skip leading blanks */ 2413 scan0 (11): 2414 scan0 (10): 2415 char_count = char_count + 1; 2416 if char_count = 0 2417 then go to scan_end; 2418 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2419 char_index = char_index + 1; 2420 2421 if editor_scan & chr = Delta 2422 then i = 14; /* Make Delta a token by itself */ 2423 else i = char_type (chr); /* Normal case (Delta is an alphabetic */ 2424 2425 go to scan0 (i); 2426 2427 scan0 (1): 2428 scan0 (2): /* scan a name */ 2429 token_type = 2; 2430 scan_pos = char_index; 2431 2432 scanm (1): 2433 scanm (2): 2434 scanm (5): 2435 char_count = char_count + 1; 2436 if char_count = 0 2437 then do; 2438 scan_length = char_index - scan_pos + 1; 2439 return; 2440 end; 2441 chr = fixed (unspec (substr (text, char_index + 1, 1)), 9); 2442 char_index = char_index + 1; 2443 2444 if editor_scan & chr = Delta 2445 then i = 14; /* Make Delta a token by itself */ 2446 else i = char_type (chr); /* Normal case (Delta is an alphabetic */ 2447 2448 go to scanm (i); 2449 2450 scanm (0): 2451 scanm (3): 2452 scanm (4): 2453 scanm (6): 2454 scanm (7): 2455 scanm (8): 2456 scanm (9): 2457 scanm (10): 2458 scanm (11): 2459 scanm (12): 2460 scanm (13): 2461 scanm (14): 2462 scanm (15): 2463 scanm (16): 2464 scanm (17): 2465 scanm (18): 2466 scanm (19): 2467 scanm (20): 2468 scanm (21): 2469 scanm (22): 2470 scanm (23): 2471 scan_length = char_index - scan_pos; 2472 return; 2473 2474 2475 2476 /* number scanning */ 2477 2478 scan0 (5): 2479 token_type = 3; 2480 scan_pos = char_index; 2481 go to start_number; 2482 2483 scan0 (6): 2484 token_type = 4; 2485 scan_pos = char_index; 2486 go to start_negative_number; 2487 2488 scan0 (7): 2489 token_type = 4; 2490 scan_pos = char_index; 2491 go to start_number_with_decimal_point; 2492 2493 end_number_scan: /* return here when done with number */ 2494 if scan_number_ptr ^= null 2495 then scan_number_ptr -> numeric_datum (0) = apl_number; 2496 scan_length = char_index - scan_pos; 2497 if char_count >= 0 2498 then scan_length = scan_length + 1; /* char_index was not bumped for the 2499* pseudo NewLine supplied at end of text */ 2500 return; 2501 2502 2503 /* come here when random character is encountered while scanning */ 2504 2505 scan0 (3): 2506 scan0 (0): 2507 scan0 (4): 2508 scan0 (8): 2509 scan0 (9): 2510 scan0 (12): 2511 scan0 (13): 2512 scan0 (14): 2513 scan0 (15): 2514 scan0 (16): 2515 scan0 (17): 2516 scan0 (18): 2517 scan0 (19): 2518 scan0 (20): 2519 scan0 (21): 2520 scan0 (22): 2521 scan0 (23): 2522 token_type = 1; 2523 scan_length = 1; /* random char is token by itself */ 2524 scan_pos = char_index; 2525 return; 2526 2527 /* come here when end of text is reached by scan */ 2528 2529 scan_end: 2530 if token_type >= 3 2531 then go to end_number_scan; 2532 scan_pos = char_index; 2533 return; /* rest has already been set up (for no token) */ 2534 2535 2536 /**** put apl_canonicalize_line_ here sometime when I feel like writing it ****/ 2537 2538 2539 end /* apl_lex_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1346.6 apl_lex_.pl1 >special_ldd>on>apl.1129>apl_lex_.pl1 273 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 274 2 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 275 3 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 276 4 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 277 5 03/27/82 0438.6 apl_character_codes.incl.pl1 >ldd>include>apl_character_codes.incl.pl1 278 6 11/29/83 1348.0 apl_lex_pseudo_chars.incl.pl1 >special_ldd>on>apl.1129>apl_lex_pseudo_chars.incl.pl1 279 7 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 280 8 03/27/82 0439.0 apl_operator_table_.incl.pl1 >ldd>include>apl_operator_table_.incl.pl1 281 9 11/29/83 1348.0 apl_lex_tables_.incl.pl1 >special_ldd>on>apl.1129>apl_lex_tables_.incl.pl1 282 10 03/27/82 0438.7 apl_lexed_function_bead.incl.pl1 >ldd>include>apl_lexed_function_bead.incl.pl1 283 11 03/27/82 0439.0 apl_parse_frame.incl.pl1 >ldd>include>apl_parse_frame.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. Apostrophe constant fixed bin(17,0) initial dcl 5-9 ref 948 960 AssignIgnore constant fixed bin(17,0) initial dcl 6-18 ref 1477 1530 AssignSub constant fixed bin(17,0) initial dcl 6-18 ref 1551 BackSlash constant fixed bin(17,0) initial dcl 5-9 ref 436 BackSlashHyphen constant fixed bin(17,0) initial dcl 5-9 ref 440 BeginOfLine constant fixed bin(17,0) initial dcl 73 ref 322 391 445 657 853 2026 Colon constant fixed bin(17,0) initial dcl 5-9 ref 853 ConstantLexeme constant fixed bin(17,0) initial dcl 73 ref 344 721 906 914 1404 1411 1966 Delta constant fixed bin(17,0) initial dcl 5-9 ref 838 2421 2444 Diamond constant fixed bin(17,0) initial dcl 5-9 ref 445 614 663 Diamond_type constant bit(2) initial dcl 64 ref 562 604 LeftArgSymbol constant fixed bin(17,0) initial dcl 10-36 ref 1615 LeftBracket constant fixed bin(17,0) initial dcl 5-9 ref 1513 LeftParen constant fixed bin(17,0) initial dcl 5-9 ref 1511 LetterS constant fixed bin(17,0) initial dcl 5-9 ref 842 LetterT constant fixed bin(17,0) initial dcl 5-9 ref 838 MY based structure level 1 dcl 186 NL constant char(1) initial unaligned dcl 125 ref 1915 NameLexeme constant fixed bin(17,0) initial dcl 73 ref 425 622 871 898 1469 NewLine constant fixed bin(17,0) initial dcl 5-9 ref 389 794 954 1022 1057 1089 1118 1138 1320 1372 1392 2362 2364 OpenParenLexeme constant fixed bin(17,0) initial dcl 73 ref 621 634 652 659 671 685 OperatorLexeme constant fixed bin(17,0) initial dcl 73 ref 337 429 478 512 514 577 584 632 642 682 688 694 709 1483 1568 P_S_Brackets constant fixed bin(17,0) initial dcl 112 ref 669 678 P_S_Opr_Brackets constant fixed bin(17,0) initial dcl 112 ref 571 650 678 P_S_Parens constant fixed bin(17,0) initial dcl 112 ref 574 619 630 P_S_qCALL_Parens constant fixed bin(17,0) initial dcl 112 ref 581 622 630 Period constant fixed bin(17,0) initial dcl 5-9 ref 994 1032 Quad constant fixed bin(17,0) initial dcl 5-9 ref 803 803 2307 QuadCALL constant fixed bin(17,0) initial dcl 6-18 ref 622 QuadCALLSemicolon constant fixed bin(17,0) initial dcl 6-18 ref 585 ReturnSymbol constant fixed bin(17,0) initial dcl 10-36 ref 1614 RightArgSymbol constant fixed bin(17,0) initial dcl 10-36 ref 1616 RightArrow constant fixed bin(17,0) initial dcl 5-9 ref 339 RightBracket constant fixed bin(17,0) initial dcl 5-9 ref 693 1491 1505 RightOprBracket constant fixed bin(17,0) initial dcl 6-18 ref 683 1507 1567 RightParen constant fixed bin(17,0) initial dcl 5-9 ref 1509 SDelta constant fixed bin(17,0) initial dcl 6-18 ref 882 SemiColon constant fixed bin(17,0) initial dcl 5-9 ref 445 590 661 SemiColonCons constant fixed bin(17,0) initial dcl 6-18 ref 578 Semicolon_type constant bit(2) initial dcl 64 ref 568 598 Slash constant fixed bin(17,0) initial dcl 5-9 ref 434 1739 SlashHyphen constant fixed bin(17,0) initial dcl 5-9 ref 438 1739 TDelta constant fixed bin(17,0) initial dcl 6-18 ref 887 TheBiggestNumberWeveGot 002116 constant float bin(63) initial dcl 1-16 ref 1273 1342 1345 TheSmallestNumberWeveGot 002114 constant float bin(63) initial dcl 1-16 ref 1275 UnderLine constant fixed bin(17,0) initial dcl 5-9 ref 766 UpperMinus constant fixed bin(17,0) initial dcl 5-9 ref 1126 ValueLexeme constant fixed bin(17,0) initial dcl 73 ref 638 692 758 1488 Zero constant fixed bin(17,0) initial dcl 5-9 ref 1009 1030 1148 1328 a_bad_lexeme_index parameter fixed bin(17,0) dcl 290 ref 287 315 350 350 358 750 850 894 1595 2005 2017 2350 abs builtin function dcl 207 ref 1273 1275 addr builtin function dcl 207 ref 339 378 389 393 434 436 438 440 473 477 544 553 553 553 578 585 622 653 683 693 712 773 803 831 882 887 913 930 986 1007 1044 1044 1076 1076 1271 1302 1342 1410 1426 1477 1479 1491 1505 1507 1509 1511 1513 1525 1530 1551 1567 1608 1610 1612 1627 1634 2269 2290 2343 addrel builtin function dcl 207 ref 1428 allow_brackets 0(18) based bit(1) level 3 packed unaligned dcl 4-3 ref 642 allow_product 0(19) based bit(1) level 3 packed unaligned dcl 4-3 ref 475 516 548 allow_reduction 0(20) based bit(1) level 3 packed unaligned dcl 4-3 ref 432 allow_subscripted_assignment 0(23) based bit(1) level 3 packed unaligned dcl 4-3 ref 1525 apl_allocate_words_ 000014 constant entry external dcl 213 ref 1598 apl_copy_value_ 000020 constant entry external dcl 213 ref 752 1643 apl_error_ 000010 constant entry external dcl 213 ref 1932 apl_error_table_$bad_subsc_assign_sys_var 000040 external static fixed bin(35,0) dcl 225 ref 1852 apl_error_table_$badass 000126 external static fixed bin(35,0) dcl 225 ref 1848 apl_error_table_$cant_be_localized 000044 external static fixed bin(35,0) dcl 225 ref 1862 apl_error_table_$constant_mism 000112 external static fixed bin(35,0) dcl 225 ref 1807 apl_error_table_$duplicate_label 000032 external static fixed bin(35,0) dcl 225 ref 1874 apl_error_table_$excess_label 000134 external static fixed bin(35,0) dcl 225 ref 1870 apl_error_table_$excess_right_brackets 000100 external static fixed bin(35,0) dcl 225 ref 1787 apl_error_table_$excess_right_parens 000070 external static fixed bin(35,0) dcl 225 ref 1771 apl_error_table_$extra_decimal_point 000042 external static fixed bin(35,0) dcl 225 ref 1356 apl_error_table_$ill_inner_prod 000062 external static fixed bin(35,0) dcl 225 ref 1759 apl_error_table_$ill_opr_brackets 000074 external static fixed bin(35,0) dcl 225 ref 1779 apl_error_table_$ill_outer_prod 000060 external static fixed bin(35,0) dcl 225 ref 481 apl_error_table_$ill_paren_level 000116 external static fixed bin(35,0) dcl 225 ref 1829 apl_error_table_$ill_reduction 000052 external static fixed bin(35,0) dcl 225 ref 1742 apl_error_table_$ill_scan 000050 external static fixed bin(35,0) dcl 225 ref 1739 apl_error_table_$ill_small_circle 000104 external static fixed bin(35,0) dcl 225 ref 1795 apl_error_table_$lex_screwed_up 000054 external static fixed bin(35,0) dcl 225 ref 1745 apl_error_table_$lone_period 000132 external static fixed bin(35,0) dcl 225 ref 1866 apl_error_table_$lone_upper_minus 000130 external static fixed bin(35,0) dcl 225 ref 1859 apl_error_table_$mism_quotes 000114 external static fixed bin(35,0) dcl 225 ref 1817 apl_error_table_$mismatched_parens 000072 external static fixed bin(35,0) dcl 225 ref 1775 apl_error_table_$misplaced_brackets 000076 external static fixed bin(35,0) dcl 225 ref 1783 apl_error_table_$misplaced_diamond 000064 external static fixed bin(35,0) dcl 225 ref 1763 apl_error_table_$misplaced_right_arrow 000146 external static fixed bin(35,0) dcl 225 ref 1730 apl_error_table_$misplaced_semicolon 000066 external static fixed bin(35,0) dcl 225 ref 1767 apl_error_table_$mixed_diamonds_and_semicolons 000022 external static fixed bin(35,0) dcl 225 ref 564 600 apl_error_table_$more_than_one_line 000124 external static fixed bin(35,0) dcl 225 ref 1840 apl_error_table_$more_than_one_line_execute 000034 external static fixed bin(35,0) dcl 225 ref 1844 apl_error_table_$need_name 000140 external static fixed bin(35,0) dcl 225 ref 2142 apl_error_table_$need_semicolon 000144 external static fixed bin(35,0) dcl 225 ref 2240 apl_error_table_$not_allowed_inner_prod 000120 external static fixed bin(35,0) dcl 225 ref 1832 apl_error_table_$not_allowed_outer_prod 000122 external static fixed bin(35,0) dcl 225 ref 1836 apl_error_table_$not_end_with_newline 000056 external static fixed bin(35,0) dcl 225 ref 1757 apl_error_table_$not_end_with_value 000102 external static fixed bin(35,0) dcl 225 ref 1791 apl_error_table_$only_1_return_value 000142 external static fixed bin(35,0) dcl 225 ref 2183 apl_error_table_$random_char 000046 external static fixed bin(35,0) dcl 225 ref 1734 apl_error_table_$random_char_in_hdr 000136 external static fixed bin(35,0) dcl 225 ref 2052 apl_error_table_$too_many_statements 000030 external static fixed bin(35,0) dcl 225 ref 609 apl_error_table_$too_short_execute 000026 external static fixed bin(35,0) dcl 225 ref 1754 apl_error_table_$u_mism_ur_quotes 000036 external static fixed bin(35,0) dcl 225 ref 1819 apl_error_table_$underscore_cant_begin_id 000024 external static fixed bin(35,0) dcl 225 ref 769 apl_error_table_$unknown_system_name 000106 external static fixed bin(35,0) dcl 225 ref 1799 apl_error_table_$ws_full_in_lex 000110 external static fixed bin(35,0) dcl 225 ref 1803 apl_execute_lex_ constant fixed bin(17,0) initial dcl 73 ref 318 400 951 1573 1589 1750 2364 apl_free_bead_ 000016 constant entry external dcl 213 ref 1995 apl_function_lex_ constant fixed bin(17,0) initial dcl 73 ref 853 1942 2022 apl_get_next_value_stack_seg_ 000160 constant entry external dcl 1448 ref 1455 apl_get_symbol_ 000012 constant entry external dcl 213 ref 852 896 2352 apl_line_lex_ constant fixed bin(17,0) initial dcl 73 ref 311 1585 apl_number 000316 automatic float bin(63) dcl 158 set ref 1278* 1287 1289 1289 1336* 1342* 1345* 1634 1642* 2493 apl_number_for_size automatic float bin(63) dcl 156 ref 1283 apl_operator_table_$apl_operator_table_ 000152 external static structure level 1 dcl 8-6 apl_operator_table_$inner_product_table 000156 external static fixed bin(17,0) dcl 8-14 set ref 553 553 apl_operator_table_$operator_bead_table 000154 external static structure level 1 dcl 8-10 apl_scan_ constant fixed bin(17,0) initial dcl 73 ref 1002 1034 1067 1100 1280 1304 1351 1856 2404 apl_static_$ws_info_ptr 000150 external static structure level 1 dcl 7-11 assignment_to 3 based structure level 2 dcl 8-48 set ref 1479 backslash_hyphen_operator_bead 14 based structure level 2 dcl 8-28 set ref 440 backslash_operator_bead 11 based structure level 2 dcl 8-28 set ref 436 bead_type based structure level 3 packed unaligned dcl 2-3 begin_subscript_calc 000300 automatic fixed bin(17,0) dcl 125 set ref 1500* 1502* 1518* 1518 1521 1525 1530 1534 1545* 1545 1547 1551 1555 binary builtin function dcl 207 ref 523 1278 bit builtin function dcl 207 ref 975 bits_for_lex 0(18) based structure level 2 in structure "operator_bead" packed unaligned dcl 4-3 in procedure "apl_lex_" bits_for_lex 0(18) 000154 external static structure array level 3 in structure "apl_operator_table_$operator_bead_table" packed unaligned dcl 8-10 in procedure "apl_lex_" bits_for_parse 4 based structure level 3 in structure "mixed_op" packed unaligned dcl 8-40 in procedure "apl_lex_" bits_for_parse 7 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 15 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 1 000154 external static structure array level 3 in structure "apl_operator_table_$operator_bead_table" packed unaligned dcl 8-10 in procedure "apl_lex_" bits_for_parse 12 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 4 based structure level 3 in structure "system_var_op" packed unaligned dcl 8-48 in procedure "apl_lex_" bits_for_parse 1 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 7 based structure level 3 in structure "system_var_op" packed unaligned dcl 8-48 in procedure "apl_lex_" bits_for_parse 3 based structure level 2 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_lex_" set ref 1718* bits_for_parse 1 based structure level 2 in structure "operator_bead" packed unaligned dcl 4-3 in procedure "apl_lex_" bits_for_parse 20 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 2 based structure array level 3 in structure "the_inner_product_table" packed unaligned dcl 8-14 in procedure "apl_lex_" bits_for_parse 4 based structure level 3 in structure "scalar_op" packed unaligned dcl 8-28 in procedure "apl_lex_" bits_for_parse 1 based structure level 3 in structure "mixed_op" packed unaligned dcl 8-40 in procedure "apl_lex_" bits_for_parse 1 based structure level 3 in structure "system_var_op" packed unaligned dcl 8-48 in procedure "apl_lex_" brackets_operator_bead 3 based structure level 2 dcl 8-40 set ref 653 char_count 000271 automatic fixed bin(17,0) dcl 73 set ref 330* 397* 397 400 404 451* 451 455 465* 465 467 506 521* 521 530* 530 532 730 786* 786 787 942* 942 944 950* 950 951 987* 987 988 1014* 1014 1016 1050* 1050 1051 1081* 1081 1083 1111* 1111 1112 1130* 1130 1132 1312* 1312 1314 1364* 1364 1366 1382* 1382 1386 1826* 1826 1882* 1882 1894* 1894 1923 1925 1953* 1953 2024* 2033* 2042* 2042 2045 2161* 2161 2163 2203* 2203 2205 2232* 2232 2234 2255* 2255 2258 2300* 2300 2301 2363* 2363 2364 2407* 2413* 2413 2416 2432* 2432 2436 2497 char_index 000260 automatic fixed bin(20,0) dcl 73 set ref 323* 377 388 406 407* 407 457 458* 458 469 470* 470 506 520 522* 522 523 534 535* 535 620 651 670 729 798 799* 799 910 946 947* 947 958 959* 959 990 991* 991 1027 1028* 1028 1062 1063* 1063 1094 1095* 1095 1123 1124* 1124 1143 1144* 1144 1325 1326* 1326 1377 1378* 1378 1397 1398* 1398 1407 1534* 1555 1573 1826 1828* 1883* 1883 1884 1886 1896* 1896 1915 1918 1920 1923 1932 1953 1954* 2027* 2047 2048* 2048 2165 2166* 2166 2207 2208* 2208 2236 2237* 2237 2260 2261* 2261 2303 2304* 2304 2369 2370* 2370 2406* 2418 2419* 2419 2430 2438 2441 2442* 2442 2450 2480 2485 2490 2496 2524 2532 char_type 001113 constant fixed bin(17,0) initial array dcl 9-42 ref 408 459 461 471 506 524 536 539 801 876 960 992 1032 1065 1097 1126 1146 1296 1328 1379 1399 1886 2050 2157 2168 2197 2209 2227 2238 2263 2282 2305 2423 2446 character_data_structure based structure level 1 dcl 3-15 character_datum based char(1) array level 2 packed unaligned dcl 3-15 set ref 975* character_value 0(09) based bit(1) level 5 packed unaligned dcl 3-3 set ref 934 character_value_type constant bit(18) initial unaligned dcl 2-30 ref 921 chr 000301 automatic fixed bin(9,0) dcl 125 set ref 406* 408 434 436 438 440 457* 459 461 469* 471 473 523* 524 534* 536 539 544 712 766 779 794* 798* 801 853 876 946* 948 954* 958* 960 960 975 990* 992 994 1009 1022* 1027* 1030 1032 1032 1044 1057* 1062* 1065 1076 1089* 1094* 1097 1118* 1123* 1126 1126 1138* 1143* 1146 1148 1296 1320* 1325* 1328 1328 1372* 1377* 1379 1392* 1397* 1399 1739 1739 2047* 2050 2157 2165* 2168 2197 2207* 2209 2227 2236* 2238 2260* 2263 2282 2294 2303* 2305 2362 2364* 2369* 2418* 2421 2423 2441* 2444 2446 code 000276 automatic fixed bin(35,0) dcl 125 set ref 481* 564* 600* 609* 769* 1356* 1730* 1734* 1739* 1742* 1745* 1754* 1757* 1759* 1763* 1767* 1771* 1775* 1779* 1783* 1787* 1791* 1795* 1799* 1803* 1807* 1817* 1819* 1829* 1832* 1836* 1840* 1844* 1848* 1852* 1859* 1862* 1866* 1870* 1874* 1932* 2052* 2142* 2183* 2240* data_pointer 4 based pointer level 2 packed unaligned dcl 3-3 set ref 930* 975 1287 1431* 1433 1634* data_type 0(08) based structure level 4 packed unaligned dcl 3-3 decimal builtin function dcl 207 ref 1273 1275 decimal_zero 002120 constant float dec(34) initial dcl 158 ref 983 999 1300 diamond_type constant fixed bin(17,0) initial dcl 11-31 ref 1681 digit 0(09) based fixed bin(8,0) array level 2 packed unaligned dcl 158 set ref 1007 1044* 1044 1076* 1076 1302 done 000252 automatic bit(1) dcl 71 set ref 1679* 1680 1681* dyadic 3(03) based bit(1) level 3 packed unaligned dcl 10-6 set ref 1721* editor_scan 000351 automatic bit(1) dcl 2394 set ref 2396* 2402* 2421 2444 emission_array based structure array level 2 dcl 73 set ref 1549* 1549 error_index_within_line 2 based fixed bin(17,0) level 2 dcl 290 set ref 376* error_line_index 1 based fixed bin(21,0) level 2 dcl 290 set ref 354* error_line_number based fixed bin(17,0) level 2 dcl 290 set ref 353* error_line_number_arg parameter fixed bin(17,0) dcl 2008 set ref 1942 1942* 2005 2011* error_mark_structure based structure level 1 dcl 290 set ref 378 error_suppress 000257 automatic bit(1) unaligned dcl 73 set ref 310* 319* 1814 1903 1942 2012* 2021* errors_occurred parameter bit(1) dcl 290 set ref 287 315 320* 1580 1938* 1949* 2005 2017 2025* esw 000253 automatic fixed bin(17,0) dcl 73 set ref 311* 318* 400 789 853 951 1002 1018 1034 1053 1067 1085 1100 1114 1134 1280 1304 1316 1351 1368 1388 1573 1585 1589 1750 1813 1856 1913 1942 2022* 2364 2404* expona 000331 automatic fixed bin(17,0) dcl 158 set ref 1007* 1039 1044 1046* 1046 1047 1073 1177* 1177 1179* 1179 1267 1269 1271 1302* 1330* 1330 1362* 1362 exponb 000332 automatic fixed bin(17,0) dcl 158 set ref 1039* 1073* 1076 1078* 1078 1079 1107* 1148* 1148 1152* 1152 1177 1302* exponent 10(28) based fixed bin(7,0) level 2 packed unaligned dcl 158 set ref 1271* fatal 000342 automatic bit(1) unaligned dcl 213 set ref 1901* 1908* 1936 first_lexeme 000246 automatic fixed bin(17,0) dcl 69 set ref 360* 362* 364 376 1666* 1670 1675* 1675 1677 1680 1692 1699* 1699 1701 1703 1706* 1706 fixed builtin function dcl 207 ref 406 457 469 506 534 553 553 759 798 946 958 975 990 1027 1062 1094 1123 1143 1325 1377 1397 1433 1452 1457 1886 2047 2165 2207 2236 2260 2303 2369 2418 2441 function 3(05) based bit(1) level 3 packed unaligned dcl 10-6 set ref 1719* function_being_lexed 000306 automatic pointer initial unaligned dcl 125 set ref 125* 1603 1932* 1975* 2173* 2214* 2225* general_bead based structure level 1 dcl 2-3 hack_ptr 000304 automatic pointer dcl 125 set ref 1490* 1491 1502* 1505 1507 1509 1511 1513 hbound builtin function dcl 207 ref 607 828 1007 1044 1076 1302 1962 1966 1968 2331 header based structure level 2 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_lex_" header based structure level 2 in structure "value_bead" dcl 3-3 in procedure "apl_lex_" i 000344 automatic fixed bin(17,0) dcl 213 set ref 1547* 1547* 1549 1549* 1637* 1637* 1638 1641 1642* 1667* 1667* 1668 1677 1680 1701* 1962* 1962* 1963* 1970* 1970* 1972* 2421* 2423* 2425 2444* 2446* 2448 ignores_assignment 0(22) 000154 external static bit(1) array level 4 in structure "apl_operator_table_$operator_bead_table" packed unaligned dcl 8-10 in procedure "apl_lex_" set ref 2339 ignores_assignment 0(22) based bit(1) level 3 in structure "operator_bead" packed unaligned dcl 4-3 in procedure "apl_lex_" ref 1477 1530 index builtin function dcl 207 ref 1915 initial_scan_pos parameter fixed bin(21,0) dcl 2385 ref 2381 2399 2406 2407 inner_product_max_code based fixed bin(17,0) level 2 dcl 8-14 ref 553 inner_product_table 1 based structure array level 2 dcl 8-14 set ref 553 label 1 based pointer array level 2 packed unaligned dcl 178 set ref 392* 857 861 864* 1638 1641 label_type constant bit(18) initial unaligned dcl 2-30 ref 1631 label_values based pointer array level 2 packed unaligned dcl 10-6 set ref 1608 label_values_ptr 7 based pointer level 2 packed unaligned dcl 10-6 set ref 1608* 1643 last_lexeme 000256 automatic fixed bin(17,0) dcl 73 set ref 322* 337 344 429 445 445 445 512 514 622 632 634 642 652* 657 659 661 663 685 688 694 721 737* 758* 853 906 914* 1404 1411* 1469 1483* 1488 1568* 1966 2026* lbound builtin function dcl 207 ref 828 1962 1970 2331 left_arg_symbol 000307 automatic pointer initial unaligned dcl 125 set ref 125* 1615 1721 1976* 2176* 2218* 2222* length builtin function dcl 207 ref 330 1918 2024 2033 2407 length_of_line 3 based fixed bin(17,0) level 2 dcl 290 set ref 377* lex_return_pointer parameter pointer unaligned dcl 290 set ref 287 315 378* 1598* 1601 1603 1604 1605 1607 1608 1608 1610 1610 1612 1612 1614 1615 1616 1618 1641 1643 1649 1660 1692 1703 1710 1718 1719 1720 1721 1724 1941* 2005 2017 lexed_function_bead based structure level 1 dcl 10-6 set ref 1598 lexed_function_label_values based pointer array level 2 packed unaligned dcl 10-45 set ref 1643* lexed_function_label_values_structure based structure level 1 dcl 10-45 lexed_function_lexeme_array based pointer array level 2 packed unaligned dcl 10-45 set ref 1692* 1703* 1710* lexed_function_lexemes_structure based structure level 1 dcl 10-45 lexed_function_statement_map based fixed bin(18,0) array dcl 10-45 set ref 1660* lexed_function_type constant bit(18) initial unaligned dcl 2-30 ref 1601 lexeme 000255 automatic pointer unaligned dcl 73 set ref 340 389* 432 434* 434 436* 436 438* 438 440* 440 473* 475 477* 477 516 553* 553 578* 585* 642 653 683* 693* 703 712* 728 803* 831* 850* 852* 859 861 864 882* 887* 894* 896* 1469 1473 1475 1477 1477* 1479 1479* 1479 1490 1521* 1522 1525 1525 1525 1530 1538 2039* 2173 2179 2189 2217 2225 2248 2280 2343* 2350* 2352* lexeme_array based pointer array level 2 packed unaligned dcl 10-6 set ref 1612 lexeme_array_alignment_structure based structure level 1 dcl 73 lexeme_array_ptr 11 based pointer level 2 packed unaligned dcl 10-6 set ref 1612* 1692 1703 1710 lexeme_index based fixed bin(17,0) array level 2 in structure "statement_map" dcl 178 in procedure "apl_lex_" set ref 346* 360 1660 1668 1677 1680 1701 lexeme_index 000270 automatic fixed bin(17,0) dcl 73 in procedure "apl_lex_" set ref 324* 346 350 622 653 703 728 729 730 730 735* 735 757 759 874 874 900 900 910 911* 911 913 1407 1408* 1408 1410 1500 1547 1556* 1556 1567 1583* 1583 1598 1966 1968 2028* line_index 000262 automatic fixed bin(20,0) dcl 73 set ref 354 376 377 388* 520 1573 1920 1923 1932 1932 1932 1953 1954 2030* line_len 000247 automatic fixed bin(17,0) dcl 69 set ref 1670* line_no 000261 automatic fixed bin(17,0) dcl 73 set ref 325* 346 353 360 360 386* 386 392 393 857 859 864 1585 1589 1598 1604 1637 1657 1659 1667 1932* 1942 2029* line_type 000100 automatic bit(2) dcl 64 set ref 382* 562 568* 598 604* ll 000343 automatic fixed bin(17,0) dcl 213 set ref 1915* 1918 1918* 1920* 1920 1923* 1925* 1925 1932 1932 1953 1954 localized_symbols 12 based pointer array level 2 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_lex_" set ref 1614* 1615* 1616* 1618* 1641* localized_symbols based pointer array level 2 in structure "MY" packed unaligned dcl 186 in procedure "apl_lex_" set ref 1618 1962 1962 1963* 2269 2280* 2290 long_error_mode 1 based bit(1) level 3 packed unaligned dcl 7-16 ref 319 lx 000250 automatic fixed bin(17,0) dcl 69 set ref 358* 364* 364 366 367* 367 373* 373 376 1680* 1681 1681* 1691* 1692* magic_rounding_constant 002131 constant float dec(32) initial dcl 158 ref 1278 maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 7-16 ref 759 1433 1452 1457 mixed_op based structure level 1 dcl 8-40 mod builtin function dcl 207 ref 934 monadic 3(04) based bit(1) level 3 packed unaligned dcl 10-6 set ref 1724* n 000277 automatic fixed bin(17,0) dcl 125 set ref 828* 829 831* 859* 861* 932* 934* 966* 966 967 969* 1499* 1505* 1505 1507* 1507 1509* 1509 1511* 1511 1513* 1513 1515 1617* 1617* 1618 1618* 1636* 1640* 1640 1641 1643 1649 1659* 1659* 1660 1660* 1678* 1684* 1684 1685* 1685 1691 1699 1886* 1887 1887 1887 1887 1966* 1968* 1970 2331* 2332 2334 2339 2343* name 2 based pointer level 2 packed unaligned dcl 10-6 set ref 1603* name_buffer based char level 2 packed unaligned dcl 125 set ref 829 852* 896 896 2332 2352* name_buffer_alignme_structure based structure level 1 dcl 125 name_buffer_array based fixed bin(8,0) array level 2 packed unaligned dcl 125 set ref 779* 803 838 838 842 2294* 2307 name_buffer_array_alignment_structure based structure level 1 dcl 125 name_buffer_ptr 000314 automatic pointer dcl 125 set ref 773* 779 803 829 838 838 842 852 896 896 2290* 2294 2307 2332 2352 name_index 000312 automatic fixed bin(17,0) dcl 125 set ref 777* 779 784* 784 803 829 838 852 852 874 896 896 900 2292* 2294 2298* 2298 2332 2352 2352 negative_exponent 000333 automatic bit(1) unaligned dcl 158 set ref 1109* 1126* 1152 next_lexeme 000254 automatic fixed bin(17,0) dcl 73 set ref 391* 425* 478* 577* 584* 590* 614* 621* 638* 671* 682* 692* 709* 737 871* 898* not_integer_mask constant bit(18) initial unaligned dcl 2-30 ref 1034 1067 1100 1307 null builtin function dcl 207 ref 125 125 125 125 392 750 850 857 859 894 1469 1522 1638 1721 1721 1941 1991 2039 2040 2176 2179 2218 2350 2493 number_buffer 000320 automatic float dec(34) dcl 158 set ref 983* 986 999* 1007 1044 1044 1076 1076 1271 1273 1275 1278 1300* 1302 1342 1627 number_of_dimensions 000345 automatic fixed bin(17,0) dcl 3-3 set ref 915* 916 1413* 1414 number_of_labels 000341 automatic fixed bin(17,0) dcl 191 in procedure "apl_lex_" set ref 328* 866* 866 1598 1605 1607 1621 2032* number_of_labels 6 based fixed bin(17,0) level 2 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_lex_" set ref 1607* 1610 1612 number_of_localized_symbols 5 based fixed bin(17,0) level 2 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_lex_" set ref 1605* 1608 1610 1612 1649 number_of_localized_symbols 000340 automatic fixed bin(17,0) dcl 191 in procedure "apl_lex_" set ref 327* 1598 1605 1617 1636 1643 1962 2038* 2269 2279* 2279 2280 2290 number_of_statements 4 based fixed bin(17,0) level 2 dcl 10-6 set ref 1604* 1612 numeric_datum based float bin(63) array dcl 3-23 set ref 1287* 2493* numeric_value 0(10) based bit(1) level 5 packed unaligned dcl 3-3 set ref 1436 op1 1(27) based fixed bin(8,0) level 3 in structure "operator_bead" packed unaligned dcl 4-3 in procedure "apl_lex_" ref 553 553 op1 3(27) based fixed bin(8,0) level 3 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_lex_" set ref 1720* op_index 000152 external static fixed bin(17,0) array level 2 dcl 8-6 ref 339 389 473 544 578 585 622 683 693 712 803 831 882 887 1477 1491 1505 1507 1509 1511 1513 1530 1551 1567 2334 2339 2343 operator based bit(1) level 4 packed unaligned dcl 2-3 ref 1475 1525 1681 1991 operator_bead based structure level 1 dcl 4-3 operator_bead_table 000154 external static structure array level 2 dcl 8-10 set ref 339 389 473 544 578 585 622 683 693 712 803 831 882 887 1477 1491 1505 1507 1509 1511 1513 1530 1551 1567 2343 outer_product_operator_bead 17 based structure level 2 dcl 8-28 set ref 477 output_index 000251 automatic fixed bin(17,0) dcl 69 set ref 1668* 1670 1692 1694* 1694 1703 1705* 1705 1710 1710 overlay_on_number_buffer based structure level 1 dcl 158 paren_level 000272 automatic fixed bin(17,0) dcl 112 set ref 333 387* 559 571 574 581 594 617* 617 619 620 622 627 630 630 637* 637 649* 649 650 651 668* 668 669 670 675 678 678 698* 698 773 paren_loc 1 based fixed bin(21,0) array level 2 dcl 112 set ref 620* 651* 670* 1826 1828 paren_stack based fixed bin(17,0) array level 2 dcl 112 set ref 571 574 581 619* 622* 630 630 650* 669* 678 678 773 paren_stack_ptr 000274 automatic pointer dcl 112 set ref 393* 571 574 581 619 620 622 630 630 650 651 669 670 678 678 773 1826 1828 paren_stack_structure based structure array level 1 dcl 112 parse_stack_space parameter pointer dcl 290 ref 287 315 329 353 354 376 377 378 1618 1962 1962 1963 2005 2017 2269 2280 2290 pointers 14 based structure level 2 dcl 7-16 reference_count 1 based fixed bin(29,0) level 3 in structure "value_bead" dcl 3-3 in procedure "apl_lex_" set ref 923* 1420* reference_count 1 based fixed bin(29,0) level 2 in structure "general_bead" dcl 2-3 in procedure "apl_lex_" set ref 1994* 1994 1995 rel builtin function dcl 207 ref 759 1428 1433 1452 1457 return_value_symbol 000311 automatic pointer initial unaligned dcl 125 set ref 125* 1614 1978* 2040* 2179 2179* rho 5 based fixed bin(21,0) array level 2 dcl 3-3 set ref 748* 930 1426 rhorho 3 based fixed bin(17,0) level 2 dcl 3-3 set ref 745* 926* 1422* 1633* right_arg_symbol 000310 automatic pointer initial unaligned dcl 125 set ref 125* 1616 1721 1977* 2176* 2217* 2248* scalar_op based structure level 1 dcl 8-28 scan_length parameter fixed bin(21,0) dcl 2385 set ref 2381 2399 2410* 2438* 2450* 2496* 2497* 2497 2523* scan_number_ptr parameter pointer level 2 packed unaligned dcl 2385 ref 2493 2493 scan_number_ptr_structure parameter structure level 1 dcl 2385 ref 2381 2399 scan_pos parameter fixed bin(21,0) dcl 2385 set ref 2381 2399 2430* 2438 2450 2480* 2485* 2490* 2496 2524* 2532* sign based char(1) level 2 packed unaligned dcl 158 set ref 986* 1342 size builtin function dcl 207 ref 916 1283 1414 1598 slash_hyphen_operator_bead 6 based structure level 2 dcl 8-28 set ref 438 slash_operator_bead 3 based structure level 2 dcl 8-28 set ref 434 source_pos 1 based fixed bin(17,0) array level 3 dcl 73 set ref 376 729* 730* 730 874* 874 900* 900 910* 1407* 1534 1555* space_left_in_stack 000263 automatic fixed bin(17,0) dcl 73 set ref 725* 725 726 759* 916* 916 918 970* 970 971 1283* 1283 1284 1414 1433* 1452* 1453 1457* 1540* 1540 1542 special_assignment 0(21) based bit(1) level 3 packed unaligned dcl 4-3 ref 1479 stack_value_ptr 000334 automatic pointer dcl 158 set ref 745 745 748 748 752 913* 921 923 924 926 930 930 934 934 975 975 977 977 1034 1034 1067 1067 1100 1100 1287 1287 1289 1289 1295 1295 1307 1307 1410* 1417 1420 1421 1422 1426 1431 1433 1436 statement_count 000350 automatic fixed bin(17,0) dcl 10-45 set ref 1657* statement_map based fixed bin(18,0) array level 2 in structure "lexed_function_bead" dcl 10-6 in procedure "apl_lex_" set ref 1610 statement_map based structure array level 1 dcl 178 in procedure "apl_lex_" set ref 393 statement_map_ptr 10 based pointer level 2 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_lex_" set ref 1610* 1660 statement_map_ptr 000336 automatic pointer dcl 178 in procedure "apl_lex_" set ref 329* 346 360 392 393 857 861 864 1638 1641 1660 1668 1677 1680 1701 2269* static_ws_info_ptr 000150 external static pointer level 2 packed unaligned dcl 7-11 ref 7-7 stmt_length_map 000101 automatic fixed bin(17,0) array dcl 67 set ref 366 367 373 385* 607 613* 736* 736 912* 912 1409* 1409 1558* 1558 stmt_number 000245 automatic fixed bin(17,0) dcl 68 set ref 366* 366 366* 367* 370* 370 372* 372* 373* 384* 605* 605 607 613 736 736 912 912 1409 1409 1558 1558 string builtin function dcl 207 set ref 921* 1034* 1034 1067* 1067 1100* 1100 1307* 1307 1417* 1601* 1631* subscripted_assignment_to 6 based structure level 2 dcl 8-48 set ref 1525 substr builtin function dcl 207 ref 406 457 469 506 523 534 798 896 896 946 958 990 1027 1062 1094 1123 1143 1325 1377 1397 1428 1886 1915 1918 1932 1932 2047 2165 2207 2236 2260 2303 2369 2418 2441 switches 1 based structure level 2 packed unaligned dcl 7-16 symbol 0(01) based bit(1) level 4 packed unaligned dcl 2-3 ref 1473 1538 system_names 000651 constant char(11) initial array dcl 9-209 ref 828 828 829 2331 2331 2332 system_var_op based structure level 1 dcl 8-48 system_variable 1(02) 000154 external static bit(1) array level 4 packed unaligned dcl 8-10 set ref 2334 temp_lexeme_array based pointer array level 3 packed unaligned dcl 73 set ref 622 653* 703* 728* 757* 913 1410 1502 1521 1525* 1530* 1551* 1567* 1681 1681 1692 1703 1710 1966 1968 1970 1972* temp_lexeme_size constant fixed bin(17,0) initial dcl 73 ref 725 759 1540 temp_ptr parameter pointer unaligned dcl 1987 in procedure "wash" set ref 1982 1991 1991 1994 1994 1995 1995* temp_ptr 000302 automatic pointer unaligned dcl 125 in procedure "apl_lex_" set ref 339* 340 544* 548 553 750* 752* 757 1426* 1428 1428* 1428 1431 2189* 2214 2222 template_ptr 000303 automatic pointer unaligned dcl 125 set ref 1627* 1631 1632 1633 1634 1643* text parameter char dcl 290 ref 287 315 330 406 457 469 506 523 534 798 946 958 990 1027 1062 1094 1123 1143 1325 1377 1397 1886 1915 1918 1932 1932 2005 2017 2024 2033 2047 2165 2207 2236 2260 2303 2369 2381 2399 2407 2418 2441 the_inner_product_table based structure level 1 dcl 8-14 token_type parameter fixed bin(17,0) dcl 2385 set ref 1037* 1071* 1106* 1310* 2381 2399 2409* 2427* 2478* 2483* 2488* 2505* 2529 total_data_elements 2 based fixed bin(21,0) level 2 dcl 3-3 set ref 745 748 924* 934 975 977* 977 1287 1295* 1295 1421* 1632* type based structure level 2 in structure "general_bead" packed unaligned dcl 2-3 in procedure "apl_lex_" type based structure level 3 in structure "lexed_function_bead" packed unaligned dcl 10-6 in procedure "apl_lex_" set ref 1601* type based structure level 3 in structure "value_bead" packed unaligned dcl 3-3 in procedure "apl_lex_" set ref 921* 1034* 1034 1067* 1067 1100* 1100 1307* 1307 1417* 1631* type_code 2 based fixed bin(17,0) level 2 dcl 4-3 ref 1681 unspec builtin function dcl 207 set ref 406 457 469 506 523 534 798 946 958 975* 990 1027 1062 1094 1123 1143 1325 1377 1397 1718* 1886 2047 2165 2207 2236 2260 2303 2369 2418 2441 value_bead based structure level 1 dcl 3-3 set ref 916 1414 value_stack_popper 000264 automatic pointer dcl 73 set ref 1451* 1452 1459 1714 1979 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 7-16 set ref 1451 1456 1714* 1979* value_stack_space 000266 automatic pointer dcl 73 set ref 376 622 653 703 728 729 730 730 757 759 874 874 900 900 910 913 1407 1410 1456* 1457 1459* 1502 1521 1525 1530 1534 1549 1549 1551 1555 1567 1681 1681 1692 1703 1710 1966 1968 1970 1972 values 2 based structure level 2 dcl 7-16 ws_info based structure level 1 dcl 7-16 ws_info_ptr 000346 automatic pointer initial dcl 7-7 set ref 319 1714 7-7* 759 1433 1451 1452 1456 1457 1979 zero_or_one_value 0(12) based bit(1) level 5 packed unaligned dcl 3-3 set ref 1289 1289* zero_or_one_value_type constant bit(18) initial unaligned dcl 2-30 ref 1417 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Alpha internal static fixed bin(17,0) initial dcl 5-9 AndSign internal static fixed bin(17,0) initial dcl 5-9 BackSpace internal static fixed bin(17,0) initial dcl 5-9 Bell internal static fixed bin(17,0) initial dcl 5-9 Binary internal static bit(1) initial dcl 1-16 Cap internal static fixed bin(17,0) initial dcl 5-9 Ceiling internal static fixed bin(17,0) initial dcl 5-9 CentSign internal static fixed bin(17,0) initial dcl 5-9 Circle internal static fixed bin(17,0) initial dcl 5-9 CircleBackSlash internal static fixed bin(17,0) initial dcl 5-9 CircleBar internal static fixed bin(17,0) initial dcl 5-9 CircleHyphen internal static fixed bin(17,0) initial dcl 5-9 CircleSlash internal static fixed bin(17,0) initial dcl 5-9 CircleStar internal static fixed bin(17,0) initial dcl 5-9 Comma internal static fixed bin(17,0) initial dcl 5-9 CommaHyphen internal static fixed bin(17,0) initial dcl 5-9 ConditionalNewLine internal static fixed bin(17,0) initial dcl 5-9 Cup internal static fixed bin(17,0) initial dcl 5-9 DeCode internal static fixed bin(17,0) initial dcl 5-9 Del internal static fixed bin(17,0) initial dcl 5-9 DelTilde internal static fixed bin(17,0) initial dcl 5-9 Delta_ internal static fixed bin(17,0) initial dcl 5-9 Diaresis internal static fixed bin(17,0) initial dcl 5-9 Division internal static fixed bin(17,0) initial dcl 5-9 Dollar internal static fixed bin(17,0) initial dcl 5-9 Domino internal static fixed bin(17,0) initial dcl 5-9 DownArrow internal static fixed bin(17,0) initial dcl 5-9 Eight internal static fixed bin(17,0) initial dcl 5-9 Eight_ internal static fixed bin(17,0) initial dcl 5-9 EnCode internal static fixed bin(17,0) initial dcl 5-9 Epsilon internal static fixed bin(17,0) initial dcl 5-9 Equal internal static fixed bin(17,0) initial dcl 5-9 Exclamation internal static fixed bin(17,0) initial dcl 5-9 ExecuteSign internal static fixed bin(17,0) initial dcl 5-9 Five internal static fixed bin(17,0) initial dcl 5-9 Five_ internal static fixed bin(17,0) initial dcl 5-9 Floor internal static fixed bin(17,0) initial dcl 5-9 FormatSign internal static fixed bin(17,0) initial dcl 5-9 Four internal static fixed bin(17,0) initial dcl 5-9 Four_ internal static fixed bin(17,0) initial dcl 5-9 GradeDown internal static fixed bin(17,0) initial dcl 5-9 GradeUp internal static fixed bin(17,0) initial dcl 5-9 GreaterOrEqual internal static fixed bin(17,0) initial dcl 5-9 GreaterThan internal static fixed bin(17,0) initial dcl 5-9 IBeam internal static fixed bin(17,0) initial dcl 5-9 Iota internal static fixed bin(17,0) initial dcl 5-9 Lamp internal static fixed bin(17,0) initial dcl 5-9 LeftArrow internal static fixed bin(17,0) initial dcl 5-9 LeftBrace internal static fixed bin(17,0) initial dcl 5-9 LeftLump internal static fixed bin(17,0) initial dcl 5-9 LeftTack internal static fixed bin(17,0) initial dcl 5-9 LessOrEqual internal static fixed bin(17,0) initial dcl 5-9 LessThan internal static fixed bin(17,0) initial dcl 5-9 LetterA internal static fixed bin(17,0) initial dcl 5-9 LetterA_ internal static fixed bin(17,0) initial dcl 5-9 LetterB internal static fixed bin(17,0) initial dcl 5-9 LetterB_ internal static fixed bin(17,0) initial dcl 5-9 LetterC internal static fixed bin(17,0) initial dcl 5-9 LetterC_ internal static fixed bin(17,0) initial dcl 5-9 LetterD internal static fixed bin(17,0) initial dcl 5-9 LetterD_ internal static fixed bin(17,0) initial dcl 5-9 LetterE internal static fixed bin(17,0) initial dcl 5-9 LetterE_ internal static fixed bin(17,0) initial dcl 5-9 LetterF internal static fixed bin(17,0) initial dcl 5-9 LetterF_ internal static fixed bin(17,0) initial dcl 5-9 LetterG internal static fixed bin(17,0) initial dcl 5-9 LetterG_ internal static fixed bin(17,0) initial dcl 5-9 LetterH internal static fixed bin(17,0) initial dcl 5-9 LetterH_ internal static fixed bin(17,0) initial dcl 5-9 LetterI internal static fixed bin(17,0) initial dcl 5-9 LetterI_ internal static fixed bin(17,0) initial dcl 5-9 LetterJ internal static fixed bin(17,0) initial dcl 5-9 LetterJ_ internal static fixed bin(17,0) initial dcl 5-9 LetterK internal static fixed bin(17,0) initial dcl 5-9 LetterK_ internal static fixed bin(17,0) initial dcl 5-9 LetterL internal static fixed bin(17,0) initial dcl 5-9 LetterL_ internal static fixed bin(17,0) initial dcl 5-9 LetterM internal static fixed bin(17,0) initial dcl 5-9 LetterM_ internal static fixed bin(17,0) initial dcl 5-9 LetterN internal static fixed bin(17,0) initial dcl 5-9 LetterN_ internal static fixed bin(17,0) initial dcl 5-9 LetterO internal static fixed bin(17,0) initial dcl 5-9 LetterO_ internal static fixed bin(17,0) initial dcl 5-9 LetterP internal static fixed bin(17,0) initial dcl 5-9 LetterP_ internal static fixed bin(17,0) initial dcl 5-9 LetterQ internal static fixed bin(17,0) initial dcl 5-9 LetterQ_ internal static fixed bin(17,0) initial dcl 5-9 LetterR internal static fixed bin(17,0) initial dcl 5-9 LetterR_ internal static fixed bin(17,0) initial dcl 5-9 LetterS_ internal static fixed bin(17,0) initial dcl 5-9 LetterT_ internal static fixed bin(17,0) initial dcl 5-9 LetterU internal static fixed bin(17,0) initial dcl 5-9 LetterU_ internal static fixed bin(17,0) initial dcl 5-9 LetterV internal static fixed bin(17,0) initial dcl 5-9 LetterV_ internal static fixed bin(17,0) initial dcl 5-9 LetterW internal static fixed bin(17,0) initial dcl 5-9 LetterW_ internal static fixed bin(17,0) initial dcl 5-9 LetterX internal static fixed bin(17,0) initial dcl 5-9 LetterX_ internal static fixed bin(17,0) initial dcl 5-9 LetterY internal static fixed bin(17,0) initial dcl 5-9 LetterY_ internal static fixed bin(17,0) initial dcl 5-9 LetterZ internal static fixed bin(17,0) initial dcl 5-9 LetterZ_ internal static fixed bin(17,0) initial dcl 5-9 Linefeed internal static fixed bin(17,0) initial dcl 5-9 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 3-28 MarkError internal static fixed bin(17,0) initial dcl 5-9 Minus internal static fixed bin(17,0) initial dcl 5-9 NandSign internal static fixed bin(17,0) initial dcl 5-9 Nine internal static fixed bin(17,0) initial dcl 5-9 Nine_ internal static fixed bin(17,0) initial dcl 5-9 NorSign internal static fixed bin(17,0) initial dcl 5-9 NotEqual internal static fixed bin(17,0) initial dcl 5-9 NumberSize internal static fixed bin(4,0) initial dcl 1-25 Omega internal static fixed bin(17,0) initial dcl 5-9 One internal static fixed bin(17,0) initial dcl 5-9 One_ internal static fixed bin(17,0) initial dcl 5-9 OrSign internal static fixed bin(17,0) initial dcl 5-9 Plus internal static fixed bin(17,0) initial dcl 5-9 QuadAF internal static fixed bin(17,0) initial dcl 6-18 QuadAI internal static fixed bin(17,0) initial dcl 6-18 QuadCR internal static fixed bin(17,0) initial dcl 6-18 QuadCS internal static fixed bin(17,0) initial dcl 6-18 QuadCT internal static fixed bin(17,0) initial dcl 6-18 QuadDL internal static fixed bin(17,0) initial dcl 6-18 QuadEC internal static fixed bin(17,0) initial dcl 6-18 QuadEX internal static fixed bin(17,0) initial dcl 6-18 QuadFADDACL internal static fixed bin(17,0) initial dcl 6-18 QuadFAPPEND internal static fixed bin(17,0) initial dcl 6-18 QuadFCREATE internal static fixed bin(17,0) initial dcl 6-18 QuadFDELETEACL internal static fixed bin(17,0) initial dcl 6-18 QuadFDROP internal static fixed bin(17,0) initial dcl 6-18 QuadFERASE internal static fixed bin(17,0) initial dcl 6-18 QuadFHOLD internal static fixed bin(17,0) initial dcl 6-18 QuadFLIB internal static fixed bin(17,0) initial dcl 6-18 QuadFLIM internal static fixed bin(17,0) initial dcl 6-18 QuadFLISTACL internal static fixed bin(17,0) initial dcl 6-18 QuadFNAMES internal static fixed bin(17,0) initial dcl 6-18 QuadFNUMS internal static fixed bin(17,0) initial dcl 6-18 QuadFRDCI internal static fixed bin(17,0) initial dcl 6-18 QuadFREAD internal static fixed bin(17,0) initial dcl 6-18 QuadFRENAME internal static fixed bin(17,0) initial dcl 6-18 QuadFREPLACE internal static fixed bin(17,0) initial dcl 6-18 QuadFSETACL internal static fixed bin(17,0) initial dcl 6-18 QuadFSIZE internal static fixed bin(17,0) initial dcl 6-18 QuadFSTIE internal static fixed bin(17,0) initial dcl 6-18 QuadFTIE internal static fixed bin(17,0) initial dcl 6-18 QuadFUNTIE internal static fixed bin(17,0) initial dcl 6-18 QuadFX internal static fixed bin(17,0) initial dcl 6-18 QuadIO internal static fixed bin(17,0) initial dcl 6-18 QuadIT internal static fixed bin(17,0) initial dcl 6-18 QuadLC internal static fixed bin(17,0) initial dcl 6-18 QuadLX internal static fixed bin(17,0) initial dcl 6-18 QuadNC internal static fixed bin(17,0) initial dcl 6-18 QuadNL internal static fixed bin(17,0) initial dcl 6-18 QuadPP internal static fixed bin(17,0) initial dcl 6-18 QuadPW internal static fixed bin(17,0) initial dcl 6-18 QuadQuote internal static fixed bin(17,0) initial dcl 5-9 QuadRL internal static fixed bin(17,0) initial dcl 6-18 QuadSVC internal static fixed bin(17,0) initial dcl 6-18 QuadSVO internal static fixed bin(17,0) initial dcl 6-18 QuadSVQ internal static fixed bin(17,0) initial dcl 6-18 QuadSVR internal static fixed bin(17,0) initial dcl 6-18 QuadTS internal static fixed bin(17,0) initial dcl 6-18 QuadTT internal static fixed bin(17,0) initial dcl 6-18 QuadUL internal static fixed bin(17,0) initial dcl 6-18 QuadWA internal static fixed bin(17,0) initial dcl 6-18 QuadWU internal static fixed bin(17,0) initial dcl 6-18 Question internal static fixed bin(17,0) initial dcl 5-9 Rho internal static fixed bin(17,0) initial dcl 5-9 RightBrace internal static fixed bin(17,0) initial dcl 5-9 RightLump internal static fixed bin(17,0) initial dcl 5-9 RightTack internal static fixed bin(17,0) initial dcl 5-9 Seven internal static fixed bin(17,0) initial dcl 5-9 Seven_ internal static fixed bin(17,0) initial dcl 5-9 Six internal static fixed bin(17,0) initial dcl 5-9 Six_ internal static fixed bin(17,0) initial dcl 5-9 SmallCircle internal static fixed bin(17,0) initial dcl 5-9 Space internal static fixed bin(17,0) initial dcl 5-9 Star internal static fixed bin(17,0) initial dcl 5-9 Tab internal static fixed bin(17,0) initial dcl 5-9 Three internal static fixed bin(17,0) initial dcl 5-9 Three_ internal static fixed bin(17,0) initial dcl 5-9 Tilde internal static fixed bin(17,0) initial dcl 5-9 Times internal static fixed bin(17,0) initial dcl 5-9 Two internal static fixed bin(17,0) initial dcl 5-9 Two_ internal static fixed bin(17,0) initial dcl 5-9 UpArrow internal static fixed bin(17,0) initial dcl 5-9 VerticalBar internal static fixed bin(17,0) initial dcl 5-9 Zero_ internal static fixed bin(17,0) initial dcl 5-9 bol_type internal static fixed bin(17,0) initial dcl 11-31 character_string_overlay based char dcl 3-19 close_paren_type internal static fixed bin(17,0) initial dcl 11-31 close_rank_type internal static fixed bin(17,0) initial dcl 11-31 close_subscript_type internal static fixed bin(17,0) initial dcl 11-31 complex_datum based complex float bin(63) array dcl 3-26 complex_value_type internal static bit(18) initial unaligned dcl 2-30 data_elements internal static fixed bin(17,0) initial dcl 2376 eol_type internal static fixed bin(17,0) initial dcl 11-31 evaluated_frame_type internal static fixed bin(17,0) initial dcl 11-22 execute_frame_type internal static fixed bin(17,0) initial dcl 11-22 function_frame_type internal static fixed bin(17,0) initial dcl 11-22 function_type internal static bit(18) initial unaligned dcl 2-30 group_type internal static bit(18) initial unaligned dcl 2-30 integral_value_type internal static bit(18) initial unaligned dcl 2-30 list_value_type internal static bit(18) initial unaligned dcl 2-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 7-98 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 2-30 number_of_ptrs automatic fixed bin(17,0) dcl 11-20 numeric_value_type internal static bit(18) initial unaligned dcl 2-30 op_type internal static fixed bin(17,0) initial dcl 11-31 open_bracket_type internal static fixed bin(17,0) initial dcl 11-31 open_paren_type internal static fixed bin(17,0) initial dcl 11-31 operator_type internal static bit(18) initial unaligned dcl 2-30 output_buffer based char unaligned dcl 7-94 parse_frame based structure level 1 dcl 11-3 parse_frame_ptr automatic pointer dcl 72 reduction_stack based structure array level 1 dcl 11-31 reduction_stack_for_op based structure array level 1 dcl 11-31 reductions_pointer automatic pointer dcl 11-29 save_frame_type internal static fixed bin(17,0) initial dcl 11-22 semi_colon_type internal static fixed bin(17,0) initial dcl 11-31 shared_variable_type internal static bit(18) initial unaligned dcl 2-30 subscript_type internal static fixed bin(17,0) initial dcl 11-31 suspended_frame_type internal static fixed bin(17,0) initial dcl 11-22 symbol_type internal static bit(18) initial unaligned dcl 2-30 val_type internal static fixed bin(17,0) initial dcl 11-31 value_type internal static bit(18) initial unaligned dcl 2-30 NAMES DECLARED BY EXPLICIT CONTEXT. apl_editor_scan_ 007064 constant entry external dcl 2399 apl_execute_lex_ 002234 constant entry external dcl 315 apl_function_lex_ 006531 constant entry external dcl 2017 apl_function_lex_no_messages_ 006506 constant entry external dcl 2005 apl_lex_ 002176 constant entry external dcl 11 apl_line_lex_ 002212 constant entry external dcl 287 apl_scan_ 007044 constant entry external dcl 2381 barf_at_bad_localization 006236 constant label dcl 1862 ref 2334 2347 barf_at_bad_subscripted_assignment_to_system_variable 006224 constant label dcl 1852 ref 1536 barf_at_badass 006220 constant label dcl 1848 ref 1488 1491 1538 barf_at_brackets_beginning 006115 constant label dcl 1783 ref 657 659 661 663 barf_at_constant_mism 006145 constant label dcl 1807 ref 934 1436 barf_at_excess_label 006246 constant label dcl 1870 ref 857 barf_at_excess_right_brackets 006121 constant label dcl 1787 ref 675 barf_at_excess_right_parens 006101 constant label dcl 1771 ref 627 barf_at_ill_inner_prod 006065 constant label dcl 1759 ref 539 barf_at_ill_opr_brackets 006111 constant label dcl 1779 ref 642 barf_at_ill_paren_level 006165 constant label dcl 1826 ref 333 barf_at_ill_reduction 006031 constant label dcl 1739 ref 432 barf_at_ill_small_circle 006131 constant label dcl 1795 set ref 461 barf_at_lone_period 006242 constant label dcl 1866 ref 512 514 barf_at_lone_upper_minus 006230 constant label dcl 1856 ref 988 996 barf_at_mismatched_parens 006105 constant label dcl 1775 ref 630 678 barf_at_misplaced_diamond 006071 constant label dcl 1763 ref 594 barf_at_misplaced_semicolon 006075 constant label dcl 1767 ref 571 barf_at_more_than_one_line 006210 constant label dcl 1840 ref 1585 barf_at_more_than_one_line_execute 006214 constant label dcl 1844 ref 1589 barf_at_not_allowed_inner_prod 006201 constant label dcl 1832 ref 524 527 548 barf_at_not_allowed_outer_prod 006205 constant label dcl 1836 ref 475 barf_at_not_end_with_newline 006052 constant label dcl 1750 ref 1573 barf_at_not_end_with_value 006125 constant label dcl 1791 ref 340 632 634 685 688 694 barf_at_unknown_system_name 006135 constant label dcl 1799 ref 835 case 000616 constant label array(3) dcl 1915 in begin block on line 1911 ref 1913 case 000607 constant label array(0:3) dcl 1389 in begin block on line 1386 ref 1388 case 000613 constant label array(3) dcl 1814 in begin block on line 1811 ref 1813 1814 case 000550 constant label array(3) dcl 790 in begin block on line 787 ref 789 case 000603 constant label array(0:3) dcl 1369 in begin block on line 1366 ref 1368 case 000577 constant label array(0:3) dcl 1317 in begin block on line 1314 ref 1316 case 000557 constant label array(0:3) dcl 1054 in begin block on line 1051 ref 1053 case 000563 constant label array(0:3) dcl 1086 in begin block on line 1083 ref 1085 case 000553 constant label array(0:3) dcl 1019 in begin block on line 1016 ref 1018 case 000573 constant label array(0:3) dcl 1135 in begin block on line 1132 ref 1134 case 000567 constant label array(0:3) dcl 1115 in begin block on line 1112 ref 1114 char_constant_loop 003735 constant label dcl 942 set ref 978 cleanup 007621 constant entry internal dcl 1959 ref 1940 convert_constant 007323 constant entry internal dcl 742 ref 344 721 dec_point_join 004533 constant label dcl 1302 ref 994 die_die_die 006437 constant label dcl 1938 ref 1580 1903 doprod 000030 constant label array(0:23) dcl 465 ref 471 duplicate_label 006252 constant label dcl 1874 ref 861 eat_up_long_number_fp 004662 constant label dcl 1382 ref 1079 eat_up_long_number_ip 004634 constant label dcl 1364 ref 1047 emission 007270 constant entry internal dcl 718 ref 714 873 899 emit_name 003620 constant label dcl 871 ref 832 883 888 end_number_scan 007233 constant label dcl 2493 ref 1280 1351 2529 end_of_text 005234 constant label dcl 1573 ref 403 404 endcase 006361 constant label dcl 1929 ref 1921 err_back_over_name 006256 constant label dcl 1880 ref 1801 err_hack 006307 constant label dcl 1894 ref 1884 1887 error 006311 constant label dcl 1901 ref 504 565 601 610 770 1357 1732 1737 1743 1755 1761 1765 1769 1773 1777 1781 1785 1789 1793 1797 1809 1822 1830 1834 1838 1846 1850 1854 1860 1868 1872 1876 exitloop_for_subscript_calc 005101 constant label dcl 1518 set ref 1515 fatal_error 006315 constant label dcl 1908 ref 1747 1758 1805 1818 1842 1864 2140 2145 2184 2243 for_illumination_only 010101 constant entry internal dcl 2359 ref 1462 2148 2170 2211 2245 2266 get_hrund_emit 003340 constant label dcl 712 ref 427 591 615 625 639 654 672 handle_lex_error 006317 constant label dcl 1911 ref 1906 hdr1 000300 constant label array(0:23) dcl 2042 ref 2050 hdr1_loop 006575 constant label dcl 2042 ref 2150 2186 hdr2 000440 constant label array(0:23) dcl 2052 set ref 2157 2168 hdr3 000410 constant label array(0:23) dcl 2052 set ref 2197 2209 hdr4 000360 constant label array(0:23) dcl 2052 ref 2227 2238 hdr5 000330 constant label array(0:23) dcl 2052 ref 2263 2282 hnm 000621 constant label array(0:23) dcl 2294 ref 2305 hrund_emit 003346 constant label dcl 714 ref 395 479 579 586 699 hrund_emit_operator 003336 constant label dcl 709 ref 429 448 1469 1473 hrund_replace 003325 constant label dcl 703 ref 443 556 1484 join_with_apl_function_lex_ 006546 constant label dcl 2022 ref 2013 line_execute_lex_join 002257 constant label dcl 320 ref 312 look_for_local_var_dcls 007011 constant label dcl 2263 ref 2177 2219 2251 misplaced_right_arrow 006021 constant label dcl 1730 ref 445 nm 000060 constant label array(0:23) dcl 779 ref 801 nugatory_system_variable_localization 007033 constant label dcl 2282 ref 2339 num_spit_out 004474 constant label dcl 1280 ref 1338 1346 number_finish 004411 constant label dcl 1179 ref 1375 1395 number_proc 004070 constant label dcl 1002 ref 992 numep 000250 constant label array(0:23) dcl 1148 ref 1126 1146 numep_getc 004347 constant label dcl 1130 ref 1150 numfp 000140 constant label array(0:23) dcl 1076 ref 1097 1328 numfp_join 004252 constant label dcl 1081 ref 1074 numfplz 004554 constant label dcl 1312 ref 1040 1331 numhp1 000220 constant label array(0:23) dcl 1100 ref 1379 numhp2 000170 constant label array(0:23) dcl 1100 ref 1399 numip 000110 constant label array(0:23) dcl 1044 ref 1009 1032 1065 numiplz 004102 constant label dcl 1014 ref 1030 numsetup 007462 constant entry internal dcl 1401 ref 1002 1306 parse_name_in_header_line 007742 constant entry internal dcl 2287 ref 2154 2196 2226 2274 pl1_loss 003514 constant label dcl 846 ref 838 844 process_newline 002302 constant label dcl 333 ref 400 955 1464 s_t_emit_name 007404 constant entry internal dcl 891 ref 880 885 scan0 000470 constant label array(0:23) dcl 2413 ref 1856 2425 scan_begin 007102 constant label dcl 2404 ref 2397 scan_end 007261 constant label dcl 2529 ref 2416 scanm 000520 constant label array(0:23) dcl 2432 ref 2448 setup_value_stack 007556 constant entry internal dcl 1445 ref 326 2031 skip_blanks_for_SmallCircle 002570 constant label dcl 451 ref 459 skip_blanks_for_inner_prod 002734 constant label dcl 530 ref 536 snail 000000 constant label array(0:23) dcl 333 ref 408 876 960 1296 start_line 002442 constant label dcl 382 ref 331 1955 2271 start_negative_number 004033 constant label dcl 983 ref 2486 start_new_lexeme 002473 constant label dcl 397 ref 705 716 867 1569 start_number 004065 constant label dcl 999 ref 2481 start_number_with_decimal_point 004530 constant label dcl 1300 ref 506 2491 stop_control 003634 constant label dcl 880 ref 842 subscripted_assign_user_var 005152 constant label dcl 1540 ref 1522 substitute_infinity 004612 constant label dcl 1342 ref 1267 1273 substitute_zero 004607 constant label dcl 1336 ref 1269 1275 trace_control 003644 constant label dcl 885 ref 838 ulose 006046 constant label dcl 1745 ref 440 1475 1479 1595 1649 unexpected_end_of_text 006052 constant label dcl 1750 ref 455 467 532 790 1019 1054 1086 1115 1135 1317 1369 1389 2045 2163 2205 2234 2258 2301 2364 unexpected_eot_char_constant 006151 constant label dcl 1811 ref 944 951 value_stack_exceeded 006141 constant label dcl 1803 ref 726 918 971 1284 1414 1542 wash 007707 constant entry internal dcl 1982 ref 1963 1972 1975 1976 1977 1978 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11130 11312 10161 11140 Length 12134 10161 162 605 747 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_lex_ 456 external procedure is an external procedure. emission internal procedure shares stack frame of external procedure apl_lex_. convert_constant internal procedure shares stack frame of external procedure apl_lex_. begin block on line 787 begin block shares stack frame of external procedure apl_lex_. s_t_emit_name internal procedure shares stack frame of external procedure apl_lex_. begin block on line 1016 begin block shares stack frame of external procedure apl_lex_. begin block on line 1051 begin block shares stack frame of external procedure apl_lex_. begin block on line 1083 begin block shares stack frame of external procedure apl_lex_. begin block on line 1112 begin block shares stack frame of external procedure apl_lex_. begin block on line 1132 begin block shares stack frame of external procedure apl_lex_. begin block on line 1314 begin block shares stack frame of external procedure apl_lex_. begin block on line 1366 begin block shares stack frame of external procedure apl_lex_. begin block on line 1386 begin block shares stack frame of external procedure apl_lex_. numsetup internal procedure shares stack frame of external procedure apl_lex_. setup_value_stack internal procedure shares stack frame of external procedure apl_lex_. begin block on line 1811 begin block shares stack frame of external procedure apl_lex_. begin block on line 1911 begin block shares stack frame of external procedure apl_lex_. cleanup internal procedure shares stack frame of external procedure apl_lex_. wash internal procedure shares stack frame of external procedure apl_lex_. parse_name_in_header_line internal procedure shares stack frame of external procedure apl_lex_. for_illumination_only internal procedure shares stack frame of external procedure apl_lex_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_lex_ 000100 line_type apl_lex_ 000101 stmt_length_map apl_lex_ 000245 stmt_number apl_lex_ 000246 first_lexeme apl_lex_ 000247 line_len apl_lex_ 000250 lx apl_lex_ 000251 output_index apl_lex_ 000252 done apl_lex_ 000253 esw apl_lex_ 000254 next_lexeme apl_lex_ 000255 lexeme apl_lex_ 000256 last_lexeme apl_lex_ 000257 error_suppress apl_lex_ 000260 char_index apl_lex_ 000261 line_no apl_lex_ 000262 line_index apl_lex_ 000263 space_left_in_stack apl_lex_ 000264 value_stack_popper apl_lex_ 000266 value_stack_space apl_lex_ 000270 lexeme_index apl_lex_ 000271 char_count apl_lex_ 000272 paren_level apl_lex_ 000274 paren_stack_ptr apl_lex_ 000276 code apl_lex_ 000277 n apl_lex_ 000300 begin_subscript_calc apl_lex_ 000301 chr apl_lex_ 000302 temp_ptr apl_lex_ 000303 template_ptr apl_lex_ 000304 hack_ptr apl_lex_ 000306 function_being_lexed apl_lex_ 000307 left_arg_symbol apl_lex_ 000310 right_arg_symbol apl_lex_ 000311 return_value_symbol apl_lex_ 000312 name_index apl_lex_ 000314 name_buffer_ptr apl_lex_ 000316 apl_number apl_lex_ 000320 number_buffer apl_lex_ 000331 expona apl_lex_ 000332 exponb apl_lex_ 000333 negative_exponent apl_lex_ 000334 stack_value_ptr apl_lex_ 000336 statement_map_ptr apl_lex_ 000340 number_of_localized_symbols apl_lex_ 000341 number_of_labels apl_lex_ 000342 fatal apl_lex_ 000343 ll apl_lex_ 000344 i apl_lex_ 000345 number_of_dimensions apl_lex_ 000346 ws_info_ptr apl_lex_ 000350 statement_count apl_lex_ 000351 editor_scan apl_lex_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_cs unpk_to_pk call_ext_out_desc call_ext_out return mod_fx1 shorten_stack ext_entry ext_entry_desc real_to_real_rd THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_allocate_words_ apl_copy_value_ apl_error_ apl_free_bead_ apl_get_next_value_stack_seg_ apl_get_symbol_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$bad_subsc_assign_sys_var apl_error_table_$badass apl_error_table_$cant_be_localized apl_error_table_$constant_mism apl_error_table_$duplicate_label apl_error_table_$excess_label apl_error_table_$excess_right_brackets apl_error_table_$excess_right_parens apl_error_table_$extra_decimal_point apl_error_table_$ill_inner_prod apl_error_table_$ill_opr_brackets apl_error_table_$ill_outer_prod apl_error_table_$ill_paren_level apl_error_table_$ill_reduction apl_error_table_$ill_scan apl_error_table_$ill_small_circle apl_error_table_$lex_screwed_up apl_error_table_$lone_period apl_error_table_$lone_upper_minus apl_error_table_$mism_quotes apl_error_table_$mismatched_parens apl_error_table_$misplaced_brackets apl_error_table_$misplaced_diamond apl_error_table_$misplaced_right_arrow apl_error_table_$misplaced_semicolon apl_error_table_$mixed_diamonds_and_semicolons apl_error_table_$more_than_one_line apl_error_table_$more_than_one_line_execute apl_error_table_$need_name apl_error_table_$need_semicolon apl_error_table_$not_allowed_inner_prod apl_error_table_$not_allowed_outer_prod apl_error_table_$not_end_with_newline apl_error_table_$not_end_with_value apl_error_table_$only_1_return_value apl_error_table_$random_char apl_error_table_$random_char_in_hdr apl_error_table_$too_many_statements apl_error_table_$too_short_execute apl_error_table_$u_mism_ur_quotes apl_error_table_$underscore_cant_begin_id apl_error_table_$unknown_system_name apl_error_table_$ws_full_in_lex apl_operator_table_$apl_operator_table_ apl_operator_table_$inner_product_table apl_operator_table_$operator_bead_table apl_static_$ws_info_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 125 002163 7 7 002170 11 002175 287 002204 310 002226 311 002227 312 002231 315 002232 318 002250 319 002252 320 002257 322 002261 323 002263 324 002264 325 002266 326 002267 327 002270 328 002271 329 002272 330 002276 331 002301 333 002302 337 002304 339 002307 340 002315 343 002320 344 002321 346 002324 350 002333 353 002341 354 002344 358 002350 360 002352 362 002360 364 002361 366 002363 367 002375 368 002377 370 002402 372 002404 373 002411 374 002413 376 002416 377 002430 378 002433 379 002441 382 002442 384 002443 385 002445 386 002446 387 002447 388 002450 389 002452 391 002460 392 002462 393 002470 395 002472 397 002473 400 002474 403 002501 404 002502 406 002503 407 002515 408 002516 425 002520 427 002522 429 002523 432 002526 434 002533 436 002541 438 002546 440 002553 443 002557 445 002560 448 002567 451 002570 455 002571 457 002573 458 002605 459 002606 461 002611 465 002613 467 002614 469 002616 470 002630 471 002631 473 002633 475 002640 477 002646 478 002650 479 002652 481 002653 504 002656 506 002657 512 002676 514 002701 516 002702 520 002706 521 002711 522 002713 523 002715 524 002727 526 002732 527 002733 530 002734 532 002735 534 002737 535 002751 536 002752 539 002755 544 002757 548 002765 553 002771 556 003013 559 003014 562 003016 564 003021 565 003024 568 003025 569 003027 571 003030 574 003036 577 003040 578 003042 579 003050 581 003051 584 003053 585 003055 586 003063 590 003064 591 003066 594 003067 598 003071 600 003074 601 003077 604 003100 605 003102 607 003103 609 003106 610 003111 613 003112 614 003113 615 003115 617 003116 619 003117 620 003125 621 003127 622 003131 625 003154 627 003155 630 003157 632 003167 634 003172 637 003174 638 003176 639 003200 642 003201 649 003211 650 003212 651 003220 652 003222 653 003224 654 003231 657 003232 659 003234 661 003236 663 003240 668 003242 669 003243 670 003251 671 003253 672 003255 675 003256 678 003260 682 003270 683 003272 685 003300 688 003303 690 003305 692 003306 693 003310 694 003316 696 003321 698 003322 699 003324 703 003325 705 003335 709 003336 712 003340 714 003346 716 003350 766 003351 769 003354 770 003357 773 003360 777 003364 779 003365 784 003377 786 003400 787 003401 789 003403 790 003405 794 003406 787 003410 798 003411 799 003423 801 003424 803 003426 828 003445 829 003453 831 003463 832 003471 834 003472 835 003474 836 003475 838 003476 842 003511 844 003513 850 003514 852 003522 853 003547 857 003560 859 003566 861 003601 863 003606 864 003610 866 003616 867 003617 871 003620 873 003622 874 003623 876 003631 880 003634 882 003635 883 003643 885 003644 887 003645 888 003653 906 003654 910 003657 911 003665 912 003666 913 003670 914 003674 915 003676 916 003700 918 003704 921 003706 923 003710 924 003712 926 003713 930 003715 932 003717 933 003721 934 003722 942 003735 944 003736 946 003740 947 003752 948 003753 950 003755 951 003756 954 003763 955 003765 958 003766 959 003776 960 003777 966 004003 967 004004 969 004006 970 004010 971 004012 975 004014 977 004031 978 004032 983 004033 986 004036 987 004040 988 004041 990 004043 991 004055 992 004056 994 004061 996 004064 999 004065 1002 004070 1007 004073 1009 004077 1014 004102 1016 004103 1018 004105 1019 004107 1022 004110 1016 004112 1027 004113 1028 004125 1030 004126 1032 004130 1034 004134 1037 004144 1039 004147 1040 004151 1044 004152 1046 004165 1047 004166 1050 004170 1051 004171 1053 004173 1054 004175 1057 004176 1051 004200 1062 004201 1063 004213 1065 004214 1067 004216 1071 004226 1073 004231 1074 004233 1076 004234 1078 004247 1079 004250 1081 004252 1083 004253 1085 004255 1086 004257 1089 004260 1083 004262 1094 004263 1095 004275 1097 004276 1100 004300 1106 004310 1107 004313 1109 004314 1111 004315 1112 004316 1114 004320 1115 004322 1118 004323 1112 004325 1123 004326 1124 004340 1126 004341 1130 004347 1132 004350 1134 004352 1135 004354 1138 004355 1132 004357 1143 004360 1144 004372 1146 004373 1148 004375 1150 004402 1152 004403 1177 004407 1179 004411 1267 004412 1269 004415 1271 004417 1273 004422 1275 004444 1278 004460 1280 004474 1283 004476 1284 004500 1287 004502 1289 004512 1295 004524 1296 004525 1300 004530 1302 004533 1304 004540 1306 004542 1307 004543 1309 004550 1310 004551 1312 004554 1314 004555 1316 004557 1317 004561 1320 004562 1314 004564 1325 004565 1326 004577 1328 004600 1330 004604 1331 004606 1336 004607 1338 004611 1342 004612 1345 004622 1346 004624 1351 004625 1356 004627 1357 004632 1362 004633 1364 004634 1366 004635 1368 004637 1369 004641 1372 004642 1375 004644 1377 004645 1378 004657 1379 004660 1382 004662 1386 004663 1388 004665 1389 004667 1392 004670 1395 004672 1397 004673 1398 004705 1399 004706 1462 004710 1464 004711 1469 004712 1473 004720 1475 004724 1477 004727 1479 004742 1483 004750 1484 004752 1488 004753 1490 004755 1491 004757 1499 004771 1500 004772 1502 004776 1505 005003 1507 005017 1509 005032 1511 005045 1513 005061 1515 005074 1517 005076 1518 005101 1521 005103 1522 005111 1525 005113 1530 005127 1534 005142 1536 005145 1537 005146 1538 005147 1540 005152 1542 005154 1545 005156 1547 005157 1549 005165 1550 005174 1551 005177 1555 005211 1556 005213 1558 005214 1559 005216 1567 005217 1568 005231 1569 005233 1573 005234 1580 005242 1583 005246 1585 005250 1588 005256 1589 005257 1595 005264 1598 005266 1601 005312 1603 005322 1604 005324 1605 005333 1607 005337 1608 005341 1610 005344 1612 005355 1614 005370 1615 005401 1616 005412 1617 005423 1618 005434 1619 005447 1621 005451 1627 005453 1631 005455 1632 005460 1633 005462 1634 005463 1636 005465 1637 005470 1638 005477 1640 005505 1641 005506 1642 005516 1643 005521 1647 005541 1649 005543 1657 005554 1659 005557 1660 005565 1662 005601 1666 005603 1667 005605 1668 005611 1670 005615 1675 005620 1677 005621 1678 005632 1679 005633 1680 005634 1681 005645 1684 005662 1685 005664 1686 005665 1691 005667 1692 005674 1694 005711 1695 005713 1699 005716 1701 005720 1703 005727 1705 005743 1706 005745 1708 005746 1710 005747 1712 005764 1714 005766 1718 005771 1719 006000 1720 006002 1721 006004 1724 006016 1726 006020 1730 006021 1732 006024 1734 006025 1737 006030 1739 006031 1742 006042 1743 006045 1745 006046 1747 006051 1750 006052 1754 006055 1755 006060 1757 006061 1758 006064 1759 006065 1761 006070 1763 006071 1765 006074 1767 006075 1769 006100 1771 006101 1773 006104 1775 006105 1777 006110 1779 006111 1781 006114 1783 006115 1785 006120 1787 006121 1789 006124 1791 006125 1793 006130 1795 006131 1797 006134 1799 006135 1801 006140 1803 006141 1805 006144 1807 006145 1809 006150 1813 006151 1814 006153 1817 006155 1818 006160 1819 006161 1822 006164 1826 006165 1828 006173 1829 006175 1830 006200 1832 006201 1834 006204 1836 006205 1838 006207 1840 006210 1842 006213 1844 006214 1846 006217 1848 006220 1850 006223 1852 006224 1854 006227 1856 006230 1859 006232 1860 006235 1862 006236 1864 006241 1866 006242 1868 006245 1870 006246 1872 006251 1874 006252 1876 006255 1882 006256 1883 006260 1884 006262 1886 006264 1887 006276 1892 006306 1894 006307 1896 006310 1901 006311 1903 006312 1906 006314 1908 006315 1913 006317 1915 006321 1918 006341 1920 006345 1921 006350 1923 006351 1925 006356 1932 006361 1936 006434 1938 006437 1940 006442 1941 006443 1942 006452 1946 006463 1949 006464 1953 006467 1954 006474 1955 006477 2005 006500 2011 006522 2012 006524 2013 006526 2017 006527 2021 006545 2022 006546 2024 006550 2025 006553 2026 006555 2027 006557 2028 006560 2029 006562 2030 006563 2031 006564 2032 006565 2033 006566 2038 006571 2039 006572 2040 006574 2042 006575 2045 006576 2047 006600 2048 006612 2050 006613 2052 006615 2140 006620 2142 006621 2145 006624 2148 006625 2150 006626 2154 006627 2157 006630 2161 006633 2163 006634 2165 006636 2166 006650 2168 006651 2170 006653 2173 006654 2176 006656 2177 006661 2179 006662 2183 006670 2184 006673 2186 006674 2189 006675 2196 006677 2197 006700 2203 006703 2205 006704 2207 006706 2208 006720 2209 006721 2211 006723 2214 006724 2217 006726 2218 006730 2219 006732 2222 006733 2225 006735 2226 006737 2227 006740 2232 006743 2234 006744 2236 006746 2237 006760 2238 006761 2240 006763 2243 006766 2245 006767 2248 006770 2251 006772 2255 006773 2258 006774 2260 006776 2261 007010 2263 007011 2266 007014 2269 007015 2271 007022 2274 007023 2279 007024 2280 007025 2282 007033 2381 007036 2396 007060 2397 007061 2399 007062 2402 007100 2404 007102 2406 007104 2407 007110 2409 007114 2410 007115 2413 007116 2416 007117 2418 007121 2419 007133 2421 007134 2423 007143 2425 007145 2427 007146 2430 007150 2432 007152 2436 007153 2438 007155 2439 007162 2441 007163 2442 007175 2444 007176 2446 007205 2448 007207 2450 007210 2472 007213 2478 007214 2480 007216 2481 007220 2483 007221 2485 007223 2486 007225 2488 007226 2490 007230 2491 007232 2493 007233 2496 007242 2497 007245 2500 007250 2505 007251 2523 007254 2524 007256 2525 007260 2529 007261 2532 007265 2533 007267 718 007270 721 007271 725 007275 726 007277 728 007301 729 007307 730 007311 735 007315 736 007316 737 007320 738 007322 742 007323 745 007324 748 007332 750 007333 752 007341 757 007353 758 007361 759 007363 762 007403 891 007404 894 007405 896 007413 898 007447 899 007452 900 007453 902 007461 1401 007462 1404 007463 1407 007466 1408 007474 1409 007475 1410 007477 1411 007503 1413 007505 1414 007507 1417 007512 1420 007514 1421 007516 1422 007517 1426 007521 1428 007523 1431 007537 1433 007541 1435 007551 1436 007552 1439 007555 1445 007556 1451 007557 1452 007562 1453 007571 1455 007573 1456 007604 1457 007607 1458 007616 1459 007617 1460 007620 1959 007621 1962 007622 1963 007627 1964 007641 1966 007643 1968 007652 1970 007654 1972 007661 1973 007671 1975 007673 1976 007675 1977 007677 1978 007701 1979 007703 1980 007706 1982 007707 1991 007711 1994 007725 1995 007727 1999 007741 2287 007742 2290 007743 2292 007750 2294 007751 2298 007763 2300 007764 2301 007765 2303 007767 2304 010001 2305 010002 2307 010004 2331 010010 2332 010015 2334 010025 2339 010035 2343 010040 2344 010042 2346 010043 2347 010045 2350 010046 2352 010053 2354 010100 2359 010101 2362 010102 2363 010105 2364 010106 2369 010116 2370 010130 2372 010131 2373 010132 ----------------------------------------------------------- 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