COMPILATION LISTING OF SEGMENT apl_reverse_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1615.4 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 apl_reverse_: 11 procedure (operators_argument); 12 13 /* 14* * apl_reverse_ performs the monadic o| operator 15* * 16* * written 7/28/73 by DAM 17* * modified 2/2/74 by G. Gordon Benedict to handle a scalar, and to optimize inner loop 18* Modified 780211 by PG to fix bug 278 by calling apl_push_stack_. 19* */ 20 21 /* automatic */ 22 23 dcl right_vb pointer, /* -> value_bead of operand */ 24 right pointer, /* -> value array of operand */ 25 characters bit(1), /* "1"b if operand is character, "0"b if numeric */ 26 rhorho fixed bin, /* rhorho of operand and result */ 27 data_elements fixed bin(21), /* size in elements of operand and result */ 28 coord fixed bin, /* dimension along which to reverse */ 29 rev_rho fixed bin(21), /* extent along that dimension */ 30 result_vb pointer, /* -> value_bead of result */ 31 result pointer, /* -> value array of result */ 32 n_words fixed bin(19), /* size of result in words */ 33 i fixed bin, /* random do-loop index */ 34 middle_adj_minus_middle fixed bin (21), /* factored from inner loop */ 35 inner_upper_bound fixed bin (21), /* upper bound of inner loop */ 36 innersize fixed bin(21), /* times reduction of rho to right of coord, exclusive */ 37 middlesize fixed bin(21), /* ditto, inclusive */ 38 middle_adj fixed bin(21), /* correct adjustment to find reflected position of (middle) 39* is (middle_adj-middle) */ 40 midpoint fixed bin(21), /* halfway along coord */ 41 (outer, middle, inner) fixed bin(21), /* three do-loop indices for going through operand and 42* result and doing the reverse */ 43 apl_number float, /* numeric temp */ 44 apl_character char(1); /* character temp */ 45 46 /* builtins */ 47 48 declare (addr, addrel, divide, fixed, rel, size, string, substr, unspec) builtin; 49 50 /* external static */ 51 52 dcl (apl_error_table_$rank, 53 apl_error_table_$domain, 54 apl_error_table_$operator_subscript_range, 55 apl_error_table_$length) fixed bin(35) external; 56 57 /* include files */ 58 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 ---------------------------------- */ 59 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 2 2 2 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 2 4 2 5 /* automatic */ 2 6 2 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 2 8 2 9 /* external static */ 2 10 2 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 2 12 2 static_ws_info_ptr unaligned pointer; 2 13 2 14 /* based */ 2 15 2 16 declare 1 ws_info aligned based (ws_info_ptr), 2 17 2 version_number fixed bin, /* version of this structure (3) */ 2 18 2 switches unaligned, /* mainly ws parameters */ 2 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 2 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 2 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 2 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 2 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 2 24 3 restrict_external_functions 2 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 2 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 2 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 2 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 2 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 2 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 2 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 2 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 2 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 2 34 3 compatibility_check_mode 2 35 bit, /* if 1, check for incompatible operators */ 2 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 2 37 /* remaining 20 bits not presently used */ 2 38 2 39 2 values, /* attributes of the workspace */ 2 40 3 digits fixed bin, /* number of digits of precision printed on output */ 2 41 3 width fixed bin, /* line length for formatted output */ 2 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 2 43 3 random_link fixed bin(35), /* seed for random number generator */ 2 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 2 45 3 float_index_origin float, /* the index origin in floating point */ 2 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 2 47 3 maximum_value_stack_size 2 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 2 49 2 50 2 pointers, /* pointers to various internal tables */ 2 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 2 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 2 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 2 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 2 55 2 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 2 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 2 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 2 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 2 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 2 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 2 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 2 63 2 signoff_lock character (32), 2 64 2 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 2 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 2 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 2 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 2 69 bit, /* munging his tables */ 2 70 3 unused_interrupt_bit bit, /* not presently used */ 2 71 3 dont_interrupt_command bit, 2 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 2 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 2 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 2 75 2 76 2 user_name char (32), /* process group id of user */ 2 77 2 immediate_input_prompt char (32) varying, /* normal input */ 2 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 2 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 2 80 2 vcpu_time aligned, 2 81 3 total fixed bin (71), 2 82 3 setup fixed bin (71), 2 83 3 parse fixed bin (71), 2 84 3 lex fixed bin (71), 2 85 3 operator fixed bin (71), 2 86 3 storage_manager fixed bin (71), 2 87 2 output_info aligned, /* data pertaining to output buffer */ 2 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 2 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 2 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 2 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 2 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 2 93 2 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 2 95 2 96 /* internal static */ 2 97 2 98 declare max_parse_stack_depth fixed bin int static init(64536); 2 99 2 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 60 3 1 /* ====== BEGIN INCLUDE SEGEMENT apl_operators_argument.incl.pl1 =========================== */ 3 2 3 3 declare 1 operators_argument aligned, 3 4 2 operands (2) aligned, /* these are the operands to the operator to be executed. 3 5* if operand (1).value is null, operator is monadic */ 3 6 3 value pointer unaligned, /* a pointer to the value bead for this operand */ 3 7 3 on_stack bit (1) aligned, /* ON if this value resides on the value stack */ 3 8 2 operator aligned, /* information about the operator to be executed */ 3 9 3 dimension fixed bin, /* (optional) dimension along which to operate */ 3 10 3 padding bit (18) unaligned, /* unused part of operator bead */ 3 11 3 op2 fixed bin (8) unal, /* a modifier for op1, or a 2nd operator if inner product */ 3 12 3 op1 fixed bin (8) unal, /* code for the actual operator to be executed */ 3 13 2 result pointer unal, /* (output) set by operator to point to result bead in stack */ 3 14 2 error_code fixed bin (35), /* (output) set before signaling apl_operator_error_ */ 3 15 2 where_error fixed bin; /* parseme index of where error was - parse sets to operator */ 3 16 3 17 /* ------ END INCLUDE SEGMENT apl_operators_argument.incl.pl1 --------------------------- */ 61 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 4 2 4 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 4 4 2 type unaligned, 4 5 3 bead_type unaligned, 4 6 4 operator bit (1), /* ON if operator bead */ 4 7 4 symbol bit (1), /* ON if symbol bead */ 4 8 4 value bit (1), /* ON if value bead */ 4 9 4 function bit (1), /* ON if function bead */ 4 10 4 group bit (1), /* ON if group bead */ 4 11 4 label bit (1), /* ON if label bead */ 4 12 4 shared_variable bit (1), /* ON if shared variable bead */ 4 13 4 lexed_function bit (1), /* ON if lexed function bead */ 4 14 3 data_type unaligned, 4 15 4 list_value bit (1), /* ON if a list value bead */ 4 16 4 character_value bit (1), /* ON if a character value bead */ 4 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 4 18 4 integral_value bit (1), /* ON if an integral value bead */ 4 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 4 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 4 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 4 22 2 size bit (18) unaligned, /* Number of words this bead occupies 4 23* (used by bead storage manager) */ 4 24 2 reference_count fixed binary (29); /* Number of pointers which point 4 25* to this bead (used by bead manager) */ 4 26 4 27 4 28 /* constant strings for initing type field in various beads */ 4 29 4 30 declare ( 4 31 operator_type init("100000000000000000"b), 4 32 symbol_type init("010000000000000000"b), 4 33 value_type init("001000000000000000"b), 4 34 function_type init("000100000000000000"b), 4 35 group_type init("000010000000000000"b), 4 36 label_type init("001001000011000000"b), 4 37 shared_variable_type init("001000100000000000"b), 4 38 lexed_function_type init("000000010000000000"b), 4 39 4 40 list_value_type init("000000001000000000"b), 4 41 character_value_type init("001000000100000000"b), 4 42 numeric_value_type init("001000000010000000"b), 4 43 integral_value_type init("001000000011000000"b), 4 44 zero_or_one_value_type init("001000000011100000"b), 4 45 complex_value_type init("001000000000010000"b), 4 46 4 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 4 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 4 49 ) bit(18) internal static; 4 50 4 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 62 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 5 2 5 3 declare 5 4 number_of_dimensions fixed bin, 5 5 5 6 1 value_bead aligned based, 5 7 2 header aligned like general_bead, 5 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 5 9 2 rhorho fixed binary, /* number of dimensions of value */ 5 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 5 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 5 12 /* dimensions of value (zero-origin) */ 5 13 5 14 5 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 5 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 5 17 /* actual elements of character array */ 5 18 5 19 declare character_string_overlay character (data_elements) aligned based; 5 20 /* to overlay on above structure */ 5 21 5 22 5 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 5 24 /* actual elements of numeric array */ 5 25 5 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 5 27 5 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 5 29 5 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 63 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 6 2 6 3 declare 6 4 1 operator_bead aligned based, 6 5 6 6 2 type unaligned like general_bead.type, 6 7 6 8 2 bits_for_lex unaligned, 6 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 6 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 6 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 6 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 6 13 3 ignores_assignment bit(1), /* assignment has no effect */ 6 14 3 allow_subscripted_assignment 6 15 bit(1), /* system variable that can be subscripted assigned */ 6 16 3 pad bit(12), 6 17 6 18 2 bits_for_parse unaligned, 6 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 6 20* (op1 tells which) */ 6 21 3 quad bit(1), /* this is a quad type */ 6 22 3 system_variable bit(1), /* this is a system variable, not an op */ 6 23 3 dyadic bit(1), /* operator may be dyadic */ 6 24 3 monadic bit(1), /* operator may be monadic */ 6 25 3 function bit(1), /* operator is a user defined function */ 6 26 3 semantics_valid bit(1), /* if semantics has been set */ 6 27 3 has_list bit(1), /* semantics is a list */ 6 28 3 inner_product bit(1), /* op2 is valid */ 6 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 6 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 6 31 3 pad bit(7), 6 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 6 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 6 34 2 type_code fixed bin; /* for parse */ 6 35 6 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 64 65 66 /* program */ 67 68 right_vb = operands(2).value; 69 right = right_vb -> value_bead.data_pointer; 70 characters = right_vb -> value_bead.data_type.character_value; 71 72 rhorho = right_vb -> value_bead.rhorho; 73 data_elements = right_vb -> value_bead.total_data_elements; 74 coord = operators_argument.dimension; 75 if rhorho = 0 then do; /* scalar -- coord can be 0 or 1 */ 76 if coord > 1 then goto rank_error; /* rank in subscript brackets too large */ 77 end; 78 else do; 79 if coord > rhorho then go to rank_error; 80 rev_rho = right_vb -> value_bead.rho(coord); 81 end; 82 83 /* if on stack, do in place. Otherwise allocate result on stack */ 84 85 if operators_argument.operands (2).on_stack 86 then do; 87 result_vb = right_vb; 88 result = right; 89 end; 90 else do; 91 number_of_dimensions = rhorho; 92 n_words = size(value_bead); 93 if characters then n_words = n_words + size(character_string_overlay); 94 else n_words = n_words + (size(numeric_datum) + 1); 95 result_vb = apl_push_stack_ (n_words); 96 97 string(result_vb -> value_bead.type) = string(right_vb -> value_bead.type); 98 result_vb -> value_bead.total_data_elements = data_elements; 99 result_vb -> value_bead.rhorho = rhorho; 100 if rhorho > 0 then /* avoid silly IPR for zero length move */ 101 unspec(result_vb -> value_bead.rho(*)) = unspec(right_vb -> value_bead.rho(*)); 102 103 result = addr(result_vb -> value_bead.rho(rhorho+1)); 104 if ^ characters then if substr(rel(result), 18, 1) then result = addrel(result, 1); 105 result_vb -> value_bead.data_pointer = result; 106 end; 107 108 109 operators_argument.result = result_vb; 110 111 /* if we have a scalar or one-element matrix (of any dimension) just return it */ 112 113 if data_elements = 1 then do; /* effective scalar */ 114 if operators_argument.operands (2).on_stack then return; /* already there */ 115 result -> numeric_datum (0) = 116 right -> numeric_datum (0); /* copy scalar from argument to result */ 117 return; 118 end; 119 120 if data_elements = 0 then return; /* null vector, nothing to do */ 121 122 /* set up do-loop parameters */ 123 124 innersize = 1; 125 do i = coord by 1 while (i < rhorho); 126 innersize = innersize * (result_vb -> value_bead.rho(i+1)); 127 end; 128 middlesize = innersize * rev_rho; 129 middle_adj = middlesize - innersize; 130 midpoint = innersize * divide(rev_rho+1, 2, 21, 0); 131 132 /* now perform the actual reverse operation */ 133 /* this code works whether the operation is being done in place or 134* by copying from a bead onto the stack, but for different reasons in 135* the two cases. */ 136 137 do outer = 0 by middlesize while (outer < data_elements); 138 139 inner_upper_bound = outer + innersize; /* set upper bound of next loop */ 140 141 do middle = 0 by innersize while (middle < midpoint); 142 143 middle_adj_minus_middle = middle_adj - middle; /* just factor from loop below */ 144 145 do inner = outer by 1 while (inner < inner_upper_bound); 146 147 if ^ characters then do; /* exchange two numbers */ 148 apl_number = right -> numeric_datum(inner+middle); 149 result -> numeric_datum(inner+middle) = right -> numeric_datum(inner+middle_adj_minus_middle); 150 result -> numeric_datum(inner+middle_adj_minus_middle) = apl_number; 151 end; 152 else do; /* exchange two characters */ 153 apl_character = right -> character_datum(inner+middle); 154 result -> character_datum(inner+middle) = right -> character_datum(inner+middle_adj_minus_middle); 155 result -> character_datum(inner+middle_adj_minus_middle) = apl_character; 156 157 end; 158 end; 159 end; 160 end; 161 162 return; 163 164 rank_error: 165 operators_argument.error_code = apl_error_table_$operator_subscript_range; 166 return; 167 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 =============================== */ 7 2 7 3 /* format: style3 */ 7 4 apl_push_stack_: 7 5 procedure (P_n_words) returns (ptr); 7 6 7 7 /* Function to (1) double-word align ws_info.value_stack_ptr, and 7 8* (2) make sure allocation request will fit on current value stack. 7 9* 7 10* Written 770413 by PG 7 11* Modified 780210 by PG to round allocations up to an even number of words. 7 12**/ 7 13 7 14 /* parameters */ 7 15 7 16 declare P_n_words fixed bin (19) parameter; 7 17 7 18 /* automatic */ 7 19 7 20 declare block_ptr ptr, 7 21 num_words fixed bin (19); 7 22 7 23 /* builtins */ 7 24 7 25 declare (addrel, binary, rel, substr, unspec) 7 26 builtin; 7 27 7 28 /* entries */ 7 29 7 30 declare apl_get_value_stack_ 7 31 entry (fixed bin (19)); 7 32 7 33 /* program */ 7 34 7 35 num_words = P_n_words; 7 36 7 37 if substr (unspec (num_words), 36, 1) = "1"b /* num_words odd */ 7 38 then num_words = num_words + 1; 7 39 7 40 if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size 7 41 then call apl_get_value_stack_ (num_words); 7 42 7 43 block_ptr = ws_info.value_stack_ptr; 7 44 ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words); 7 45 return (block_ptr); 7 46 7 47 end apl_push_stack_; 7 48 7 49 /* ------ END INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 ------------------------------- */ 168 169 end /* apl_reverse_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1347.1 apl_reverse_.pl1 >special_ldd>on>apl.1129>apl_reverse_.pl1 59 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 60 2 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 61 3 03/27/82 0439.0 apl_operators_argument.incl.pl1 >ldd>include>apl_operators_argument.incl.pl1 62 4 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 63 5 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 64 6 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 168 7 03/27/82 0429.8 apl_push_stack_fcn.incl.pl1 >ldd>include>apl_push_stack_fcn.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. P_n_words parameter fixed bin(19,0) dcl 7-16 ref 7-4 7-35 addr builtin function dcl 48 ref 103 addrel builtin function dcl 48 in procedure "apl_reverse_" ref 104 addrel builtin function dcl 7-25 in procedure "apl_push_stack_" ref 7-44 apl_character 000134 automatic char(1) unaligned dcl 23 set ref 153* 155 apl_error_table_$operator_subscript_range 000010 external static fixed bin(35,0) dcl 52 ref 164 apl_get_value_stack_ 000014 constant entry external dcl 7-30 ref 7-40 apl_number 000132 automatic float bin(63) dcl 23 set ref 148* 150 apl_static_$ws_info_ptr 000012 external static structure level 1 dcl 2-11 binary builtin function dcl 7-25 ref 7-40 block_ptr 000152 automatic pointer dcl 7-20 set ref 7-43* 7-45 character_data_structure based structure level 1 dcl 5-15 character_datum based char(1) array level 2 packed unaligned dcl 5-15 set ref 153 154* 154 155* character_string_overlay based char dcl 5-19 ref 93 character_value 0(09) based bit(1) level 5 packed unaligned dcl 5-3 set ref 70 characters 000104 automatic bit(1) unaligned dcl 23 set ref 70* 93 104 147 coord 000107 automatic fixed bin(17,0) dcl 23 set ref 74* 76 79 80 125 data_elements 000106 automatic fixed bin(21,0) dcl 23 set ref 73* 93 93 94 98 113 120 137 data_pointer 4 based pointer level 2 packed unaligned dcl 5-3 set ref 69 105* data_type 0(08) based structure level 4 packed unaligned dcl 5-3 dimension 4 parameter fixed bin(17,0) level 3 dcl 3-3 ref 74 divide builtin function dcl 48 ref 130 error_code 7 parameter fixed bin(35,0) level 2 dcl 3-3 set ref 164* general_bead based structure level 1 dcl 4-3 header based structure level 2 dcl 5-3 i 000117 automatic fixed bin(17,0) dcl 23 set ref 125* 125* 126* inner 000130 automatic fixed bin(21,0) dcl 23 set ref 145* 145* 148 149 149 150 153 154 154 155* inner_upper_bound 000121 automatic fixed bin(21,0) dcl 23 set ref 139* 145 innersize 000122 automatic fixed bin(21,0) dcl 23 set ref 124* 126* 126 128 129 130 139 141 maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 2-16 ref 7-40 middle 000127 automatic fixed bin(21,0) dcl 23 set ref 141* 141* 143 148 149 153 154* middle_adj 000124 automatic fixed bin(21,0) dcl 23 set ref 129* 143 middle_adj_minus_middle 000120 automatic fixed bin(21,0) dcl 23 set ref 143* 149 150 154 155 middlesize 000123 automatic fixed bin(21,0) dcl 23 set ref 128* 129 137 midpoint 000125 automatic fixed bin(21,0) dcl 23 set ref 130* 141 n_words 000116 automatic fixed bin(19,0) dcl 23 set ref 92* 93* 93 94* 94 95* num_words 000154 automatic fixed bin(19,0) dcl 7-20 set ref 7-35* 7-37 7-37* 7-37 7-40 7-40* 7-44 number_of_dimensions 000140 automatic fixed bin(17,0) dcl 5-3 set ref 91* 92 numeric_datum based float bin(63) array dcl 5-23 set ref 94 115* 115 148 149* 149 150* on_stack 1 parameter bit(1) array level 3 dcl 3-3 ref 85 114 operands parameter structure array level 2 dcl 3-3 operator 4 parameter structure level 2 dcl 3-3 operators_argument parameter structure level 1 dcl 3-3 set ref 10 outer 000126 automatic fixed bin(21,0) dcl 23 set ref 137* 137* 139 145* pointers 14 based structure level 2 dcl 2-16 rel builtin function dcl 7-25 in procedure "apl_push_stack_" ref 7-40 rel builtin function dcl 48 in procedure "apl_reverse_" ref 104 result 000114 automatic pointer dcl 23 in procedure "apl_reverse_" set ref 88* 103* 104 104* 104 105 115 149 150 154 155 result 6 parameter pointer level 2 in structure "operators_argument" packed unaligned dcl 3-3 in procedure "apl_reverse_" set ref 109* result_vb 000112 automatic pointer dcl 23 set ref 87* 95* 97 98 99 100 103 105 109 126 rev_rho 000110 automatic fixed bin(21,0) dcl 23 set ref 80* 128 130 rho 5 based fixed bin(21,0) array level 2 dcl 5-3 set ref 80 100* 100 103 126 rhorho 3 based fixed bin(17,0) level 2 in structure "value_bead" dcl 5-3 in procedure "apl_reverse_" set ref 72 99* 100 100 rhorho 000105 automatic fixed bin(17,0) dcl 23 in procedure "apl_reverse_" set ref 72* 75 79 91 99 100 103 125 right 000102 automatic pointer dcl 23 set ref 69* 88 115 148 149 153 154 right_vb 000100 automatic pointer dcl 23 set ref 68* 69 70 72 73 80 87 97 100 size builtin function dcl 48 ref 92 93 94 static_ws_info_ptr 000012 external static pointer level 2 packed unaligned dcl 2-11 ref 2-7 string builtin function dcl 48 set ref 97* 97 substr builtin function dcl 48 in procedure "apl_reverse_" ref 104 substr builtin function dcl 7-25 in procedure "apl_push_stack_" ref 7-37 total_data_elements 2 based fixed bin(21,0) level 2 dcl 5-3 set ref 73 98* type based structure level 2 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_reverse_" type based structure level 3 in structure "value_bead" packed unaligned dcl 5-3 in procedure "apl_reverse_" set ref 97* 97 unspec builtin function dcl 7-25 in procedure "apl_push_stack_" ref 7-37 unspec builtin function dcl 48 in procedure "apl_reverse_" set ref 100* 100 value parameter pointer array level 3 packed unaligned dcl 3-3 ref 68 value_bead based structure level 1 dcl 5-3 set ref 92 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 2-16 set ref 7-40 7-43 7-44* 7-44 values 2 based structure level 2 dcl 2-16 ws_info based structure level 1 dcl 2-16 ws_info_ptr 000136 automatic pointer initial dcl 2-7 set ref 2-7* 7-40 7-40 7-43 7-44 7-44 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Binary internal static bit(1) initial dcl 1-16 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 5-28 NumberSize internal static fixed bin(4,0) initial dcl 1-25 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 apl_error_table_$domain external static fixed bin(35,0) dcl 52 apl_error_table_$length external static fixed bin(35,0) dcl 52 apl_error_table_$rank external static fixed bin(35,0) dcl 52 character_value_type internal static bit(18) initial unaligned dcl 4-30 complex_datum based complex float bin(63) array dcl 5-26 complex_value_type internal static bit(18) initial unaligned dcl 4-30 fixed builtin function dcl 48 function_type internal static bit(18) initial unaligned dcl 4-30 group_type internal static bit(18) initial unaligned dcl 4-30 integral_value_type internal static bit(18) initial unaligned dcl 4-30 label_type internal static bit(18) initial unaligned dcl 4-30 lexed_function_type internal static bit(18) initial unaligned dcl 4-30 list_value_type internal static bit(18) initial unaligned dcl 4-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 2-98 not_integer_mask internal static bit(18) initial unaligned dcl 4-30 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 4-30 numeric_value_type internal static bit(18) initial unaligned dcl 4-30 operator_bead based structure level 1 dcl 6-3 operator_type internal static bit(18) initial unaligned dcl 4-30 output_buffer based char unaligned dcl 2-94 shared_variable_type internal static bit(18) initial unaligned dcl 4-30 symbol_type internal static bit(18) initial unaligned dcl 4-30 value_type internal static bit(18) initial unaligned dcl 4-30 zero_or_one_value_type internal static bit(18) initial unaligned dcl 4-30 NAMES DECLARED BY EXPLICIT CONTEXT. apl_push_stack_ 000334 constant entry internal dcl 7-4 ref 95 apl_reverse_ 000032 constant entry external dcl 10 rank_error 000331 constant label dcl 164 set ref 76 79 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 474 512 406 504 Length 1022 406 16 273 66 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_reverse_ 118 external procedure is an external procedure. apl_push_stack_ internal procedure shares stack frame of external procedure apl_reverse_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_reverse_ 000100 right_vb apl_reverse_ 000102 right apl_reverse_ 000104 characters apl_reverse_ 000105 rhorho apl_reverse_ 000106 data_elements apl_reverse_ 000107 coord apl_reverse_ 000110 rev_rho apl_reverse_ 000112 result_vb apl_reverse_ 000114 result apl_reverse_ 000116 n_words apl_reverse_ 000117 i apl_reverse_ 000120 middle_adj_minus_middle apl_reverse_ 000121 inner_upper_bound apl_reverse_ 000122 innersize apl_reverse_ 000123 middlesize apl_reverse_ 000124 middle_adj apl_reverse_ 000125 midpoint apl_reverse_ 000126 outer apl_reverse_ 000127 middle apl_reverse_ 000130 inner apl_reverse_ 000132 apl_number apl_reverse_ 000134 apl_character apl_reverse_ 000136 ws_info_ptr apl_reverse_ 000140 number_of_dimensions apl_reverse_ 000152 block_ptr apl_push_stack_ 000154 num_words apl_push_stack_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_get_value_stack_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$operator_subscript_range apl_static_$ws_info_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000027 2 7 000037 68 000041 69 000045 70 000047 72 000053 73 000055 74 000057 75 000061 76 000063 77 000066 79 000067 80 000071 85 000074 87 000077 88 000100 89 000101 91 000102 92 000104 93 000106 94 000115 95 000121 97 000123 98 000126 99 000131 100 000133 103 000145 104 000150 105 000160 109 000161 113 000165 114 000170 115 000173 117 000175 120 000176 124 000200 125 000202 126 000207 127 000214 128 000216 129 000221 130 000223 137 000230 139 000237 141 000241 143 000247 145 000252 147 000257 148 000261 149 000266 150 000274 151 000276 153 000277 154 000305 155 000315 158 000320 159 000322 160 000325 162 000330 164 000331 166 000333 7 4 000334 7 35 000336 7 37 000340 7 40 000345 7 43 000362 7 44 000365 7 45 000374 ----------------------------------------------------------- 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