COMPILATION LISTING OF SEGMENT apl_ioa_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 11/29/83 1620.5 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 /* APL_IOA_ - APL Interface to Multics ioa_ subroutine. 11* 12* Written, coded, and debugged January 17, 1976 by Paul Green (200 lines in one day...!) 13* Modified 760118 by PG to pass numeric vectors as arrays, and character vectors as strings. 14* Modified 781115 by PG to pop list beads properly. 15**/ 16 17 apl_ioa_: 18 procedure (operators_argument); 19 20 /* parameters */ 21 22 /* see include file apl_operators_argument */ 23 24 /* automatic */ 25 26 dcl (add_nl, pad_arg, print_arg, list_given) bit (1) aligned, 27 (left, left_vb, lowest_vb, result, result_vb, right_vb) ptr, 28 (data_elements, left_data_elements, return_len) fixed bin (21), 29 (i, na, nd, n_values, number_of_args) fixed bin, 30 code fixed bin (35), 31 n_words fixed bin (19), 32 return_string char (256); 33 34 dcl 1 arglist aligned, 35 2 n_args fixed bin (17) unal, 36 2 flag bit (18) unal init ("000000000000000100"b), 37 2 n_desc fixed bin (17) unal, 38 2 pad bit (18) unal, 39 2 ptr (100) ptr; 40 41 dcl 1 desclist aligned, 42 2 desc (100), 43 3 type bit (8) unal, 44 3 n_dims bit (4) unal, 45 3 size fixed bin (23) unal; 46 47 /* based */ 48 49 dcl result_string char (return_len) based; 50 51 /* builtin */ 52 53 dcl (addr, addrel, null, size, string, translate, unspec) builtin; 54 55 /* entries */ 56 57 dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned), 58 iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 59 60 /* external static */ 61 62 dcl ((apl_error_table_$domain, 63 apl_error_table_$rank) fixed bin (35), 64 iox_$user_output ptr 65 ) external static; 66 67 /* internal static */ 68 69 dcl (character_descriptor init ("10101010"b), 70 float_bin_2_descriptor init ("10001000"b) 71 ) bit (18) internal static options (constant); 72 73 /* include files */ 74 1 1 /* ====== BEGIN INCLUDE SEGMENT apl_number_data.incl.pl1 ================================== */ 1 2 1 3 /* 1 4* This include file contains information about the machine representation of numbers. 1 5* In all programs numbers should simply be declared 'float'. 1 6* All default statements should be in this include file. 1 7* 1 8* This is the binary version. The manifest constant Binary should be used by programs 1 9* that need to know whether we are using binary or decimal. 1 10* */ 1 11 1 12 /* format: style3,initlm0,idind30 */ 1 13 1 14 default (float & ^decimal & ^binary & ^precision & ^constant) float binary (63); 1 15 1 16 declare ( 1 17 TheBiggestNumberWeveGot float initial (0.1701411834604692317e+39), 1 18 TheSmallestNumberWeveGot float initial (.1469367938527859385e-38), 1 19 Binary bit (1) aligned initial ("1"b) 1 20 ) internal static options (constant); 1 21 1 22 /* Number of characters in a number datum entry; used for copying float number arrays as strings. 1 23* (Obsolete! use array copies!) */ 1 24 1 25 declare NumberSize fixed binary precision (4) internal static initial (8); 1 26 1 27 /* ------ END INCLUDE SEGMENT apl_number_data.incl.pl1 ---------------------------------- */ 75 2 1 /* ====== BEGIN INCLUDE SEGMENT apl_characters.incl.pl1 =================================== */ 2 2 2 3 /* 2 4* * This include file contains all the characters in the APL character set, 2 5* * declared char(1) [Instead of fixed bin as in the apl_character_codes.incl.pl1 file] 2 6* * 2 7* Modified 780913 by PG to add CentSign 2 8* Modified 790319 by PG to add CommaHyphen 2 9* */ 2 10 2 11 declare ( 2 12 QBell init(""), 2 13 QBackSpace init(""), 2 14 QTab init(" "), 2 15 QNewLine init(" 2 16 "), 2 17 QSpace init(" "), 2 18 QExclamation init("!"), 2 19 QDollar init("$"), 2 20 QApostrophe init("'"), 2 21 QLeftParen init("("), 2 22 QRightParen init(")"), 2 23 QStar init("*"), 2 24 QPlus init("+"), 2 25 QComma init(","), 2 26 QMinus init("-"), 2 27 QPeriod init("."), 2 28 QSlash init("/"), 2 29 QZero init("0"), 2 30 QOne init("1"), 2 31 QTwo init("2"), 2 32 QThree init("3"), 2 33 QFour init("4"), 2 34 QFive init("5"), 2 35 QSix init("6"), 2 36 QSeven init("7"), 2 37 QEight init("8"), 2 38 QNine init("9"), 2 39 QColon init(":"), 2 40 QSemiColon init(";"), 2 41 QLessThan init("<"), 2 42 QEqual init("="), 2 43 QGreaterThan init(">"), 2 44 QQuestion init("?"), 2 45 QLetterA_ init("A"), 2 46 QLetterB_ init("B"), 2 47 QLetterC_ init("C"), 2 48 QLetterD_ init("D"), 2 49 QLetterE_ init("E"), 2 50 QLetterF_ init("F"), 2 51 QLetterG_ init("G"), 2 52 QLetterH_ init("H"), 2 53 QLetterI_ init("I"), 2 54 QLetterJ_ init("J"), 2 55 QLetterK_ init("K"), 2 56 QLetterL_ init("L"), 2 57 QLetterM_ init("M"), 2 58 QLetterN_ init("N"), 2 59 QLetterO_ init("O"), 2 60 QLetterP_ init("P"), 2 61 QLetterQ_ init("Q"), 2 62 QLetterR_ init("R"), 2 63 QLetterS_ init("S"), 2 64 QLetterT_ init("T"), 2 65 QLetterU_ init("U"), 2 66 QLetterV_ init("V"), 2 67 QLetterW_ init("W"), 2 68 QLetterX_ init("X"), 2 69 QLetterY_ init("Y"), 2 70 QLetterZ_ init("Z"), 2 71 QLeftBracket init("["), 2 72 QBackSlash init("\"), 2 73 QRightBracket init("]"), 2 74 QUnderLine init("_"), 2 75 QLetterA init("a"), 2 76 QLetterB init("b"), 2 77 QLetterC init("c"), 2 78 QLetterD init("d"), 2 79 QLetterE init("e"), 2 80 QLetterF init("f"), 2 81 QLetterG init("g"), 2 82 QLetterH init("h"), 2 83 QLetterI init("i"), 2 84 QLetterJ init("j"), 2 85 QLetterK init("k"), 2 86 QLetterL init("l"), 2 87 QLetterM init("m"), 2 88 QLetterN init("n"), 2 89 QLetterO init("o"), 2 90 QLetterP init("p"), 2 91 QLetterQ init("q"), 2 92 QLetterR init("r"), 2 93 QLetterS init("s"), 2 94 QLetterT init("t"), 2 95 QLetterU init("u"), 2 96 QLetterV init("v"), 2 97 QLetterW init("w"), 2 98 QLetterX init("x"), 2 99 QLetterY init("y"), 2 100 QLetterZ init("z"), 2 101 QLeftBrace init("{"), 2 102 QVerticalBar init("|"), 2 103 QRightBrace init("}"), 2 104 QTilde init("~"), 2 105 QLessOrEqual init(""), 2 106 QGreaterOrEqual init(""), 2 107 QNotEqual init(""), 2 108 QOrSign init(""), 2 109 QAndSign init(""), 2 110 QDivision init(""), 2 111 QEpsilon init(""), 2 112 QUpArrow init(""), 2 113 QDownArrow init(""), 2 114 QCircle init(""), 2 115 QCeiling init(""), 2 116 QFloor init(""), 2 117 QDelta init(""), 2 118 QSmallCircle init(""), 2 119 QQuad init(""), 2 120 QCap init(""), 2 121 QDeCode init(""), 2 122 QEnCode init(""), 2 123 QLeftLump init(""), 2 124 QRightLump init(""), 2 125 QCup init(""), 2 126 QNorSign init(""), 2 127 QNandSign init(""), 2 128 QCircleHyphen init(""), 2 129 QSlashHyphen init(""), 2 130 QDelTilde init(""), 2 131 QCircleStar init(""), 2 132 QCircleBar init(""), 2 133 QCircleBackSlash init(""), 2 134 QCircleSlash init(""), 2 135 QGradeDown init(""), 2 136 QGradeUp init(""), 2 137 QLamp init(""), 2 138 QQuadQuote init(""), 2 139 QIBeam init(""), 2 140 QBackSlashHyphen init(""), 2 141 QDomino init(""), 2 142 QDiaresis init(""), 2 143 QOmega init(""), 2 144 QIota init(""), 2 145 QRho init(""), 2 146 QTimes init(""), 2 147 QAlpha init(""), 2 148 QUpperMinus init(""), 2 149 QDel init(""), 2 150 QLeftArrow init(""), 2 151 QRightArrow init(""), 2 152 QDiamond init(""), 2 153 QZero_ init(""), 2 154 QOne_ init(""), 2 155 QTwo_ init(""), 2 156 QThree_ init(""), 2 157 QFour_ init(""), 2 158 QFive_ init(""), 2 159 QSix_ init(""), 2 160 QSeven_ init(""), 2 161 QEight_ init(""), 2 162 QNine_ init(""), 2 163 QDelta_ init(""), 2 164 QMarkError init(""), 2 165 QExecuteSign init(""), 2 166 QFormatSign init(""), 2 167 QLeftTack init(""), 2 168 QRightTack init(""), 2 169 QLineFeed init(""), 2 170 QConditionalNewLine init(""), 2 171 QCentSign init(""), 2 172 QCommaHyphen init("") 2 173 ) char(1) internal static options (constant); 2 174 2 175 /* ------ END INCLUDE SEGMENT apl_characters.incl.pl1 ----------------------------------- */ 76 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 --------------------------- */ 77 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 ---------------------------------- */ 78 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_operator_bead.incl.pl1 ================================ */ 5 2 5 3 declare 5 4 1 operator_bead aligned based, 5 5 5 6 2 type unaligned like general_bead.type, 5 7 5 8 2 bits_for_lex unaligned, 5 9 3 allow_brackets bit(1), /* operator may have dimension info in brackets */ 5 10 3 allow_product bit(1), /* operator may be used in inner and outer product */ 5 11 3 allow_reduction bit(1), /* operator may be used in reduction and scan */ 5 12 3 special_assignment bit(1), /* doesn't use standard assignment operator */ 5 13 3 ignores_assignment bit(1), /* assignment has no effect */ 5 14 3 allow_subscripted_assignment 5 15 bit(1), /* system variable that can be subscripted assigned */ 5 16 3 pad bit(12), 5 17 5 18 2 bits_for_parse unaligned, 5 19 3 stop_trace_control bit(1), /* next lexeme is function being stopped/traced 5 20* (op1 tells which) */ 5 21 3 quad bit(1), /* this is a quad type */ 5 22 3 system_variable bit(1), /* this is a system variable, not an op */ 5 23 3 dyadic bit(1), /* operator may be dyadic */ 5 24 3 monadic bit(1), /* operator may be monadic */ 5 25 3 function bit(1), /* operator is a user defined function */ 5 26 3 semantics_valid bit(1), /* if semantics has been set */ 5 27 3 has_list bit(1), /* semantics is a list */ 5 28 3 inner_product bit(1), /* op2 is valid */ 5 29 3 semantics_on_stack bit(1), /* semantics points to value stack */ 5 30 3 is_external_function bit(1), /* semantics points to function bead for ext function */ 5 31 3 pad bit(7), 5 32 3 op2 fixed bin(8) unaligned, /* secondary operator code */ 5 33 3 op1 fixed bin(8) unaligned, /* primary operator code */ 5 34 2 type_code fixed bin; /* for parse */ 5 35 5 36 /* ------ END INCLUDE SEGMENT apl_operator_bead.incl.pl1 -------------------------------- */ 79 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_list_bead.incl.pl1 ==================================== */ 6 2 6 3 declare n_members fixed bin, 6 4 6 5 1 list_bead aligned based, 6 6 2 header aligned like general_bead, 6 7 2 number_of_members fixed bin, 6 8 2 members dimension (n_members refer (list_bead.number_of_members)) aligned, 6 9 3 member_ptr unaligned pointer, 6 10 3 bits unaligned like operator_bead.bits_for_parse; 6 11 6 12 /* ------ END INCLUDE SEGMENT apl_list_bead.incl.pl1 ------------------------------------ */ 80 7 1 /* ====== BEGIN INCLUDE SEGMENT apl_value_bead.incl.pl1 =================================== */ 7 2 7 3 declare 7 4 number_of_dimensions fixed bin, 7 5 7 6 1 value_bead aligned based, 7 7 2 header aligned like general_bead, 7 8 2 total_data_elements fixed binary (21), /* length of ,[value] in APL */ 7 9 2 rhorho fixed binary, /* number of dimensions of value */ 7 10 2 data_pointer pointer unaligned, /* packed pointer to the data in value */ 7 11 2 rho fixed binary (21) dimension (number_of_dimensions refer (value_bead.rhorho)); 7 12 /* dimensions of value (zero-origin) */ 7 13 7 14 7 15 declare 1 character_data_structure aligned based, /* alignment trick for PL/I compiler */ 7 16 2 character_datum character (1) unaligned dimension (0:data_elements - 1); 7 17 /* actual elements of character array */ 7 18 7 19 declare character_string_overlay character (data_elements) aligned based; 7 20 /* to overlay on above structure */ 7 21 7 22 7 23 declare numeric_datum float aligned dimension (0:data_elements - 1) based; 7 24 /* actual elements of numeric array */ 7 25 7 26 declare complex_datum complex float aligned dimension (0:data_elements -1) based; 7 27 7 28 declare MAX_VALUE_BEAD_SIZE fixed bin (19) init (261120) int static options (constant); 7 29 7 30 /* ------ END INCLUDE SEGMENT apl_value_bead.incl.pl1 ----------------------------------- */ 81 8 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 8 2 8 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 8 4 8 5 /* automatic */ 8 6 8 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 8 8 8 9 /* external static */ 8 10 8 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 8 12 2 static_ws_info_ptr unaligned pointer; 8 13 8 14 /* based */ 8 15 8 16 declare 1 ws_info aligned based (ws_info_ptr), 8 17 2 version_number fixed bin, /* version of this structure (3) */ 8 18 2 switches unaligned, /* mainly ws parameters */ 8 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 8 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 8 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 8 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 8 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 8 24 3 restrict_external_functions 8 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 8 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 8 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 8 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 8 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 8 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 8 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 8 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 8 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 8 34 3 compatibility_check_mode 8 35 bit, /* if 1, check for incompatible operators */ 8 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 8 37 /* remaining 20 bits not presently used */ 8 38 8 39 2 values, /* attributes of the workspace */ 8 40 3 digits fixed bin, /* number of digits of precision printed on output */ 8 41 3 width fixed bin, /* line length for formatted output */ 8 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 8 43 3 random_link fixed bin(35), /* seed for random number generator */ 8 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 8 45 3 float_index_origin float, /* the index origin in floating point */ 8 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 8 47 3 maximum_value_stack_size 8 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 8 49 8 50 2 pointers, /* pointers to various internal tables */ 8 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 8 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 8 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 8 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 8 55 8 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 8 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 8 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 8 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 8 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 8 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 8 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 8 63 2 signoff_lock character (32), 8 64 8 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 8 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 8 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 8 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 8 69 bit, /* munging his tables */ 8 70 3 unused_interrupt_bit bit, /* not presently used */ 8 71 3 dont_interrupt_command bit, 8 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 8 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 8 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 8 75 8 76 2 user_name char (32), /* process group id of user */ 8 77 2 immediate_input_prompt char (32) varying, /* normal input */ 8 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 8 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 8 80 2 vcpu_time aligned, 8 81 3 total fixed bin (71), 8 82 3 setup fixed bin (71), 8 83 3 parse fixed bin (71), 8 84 3 lex fixed bin (71), 8 85 3 operator fixed bin (71), 8 86 3 storage_manager fixed bin (71), 8 87 2 output_info aligned, /* data pertaining to output buffer */ 8 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 8 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 8 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 8 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 8 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 8 93 8 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 8 95 8 96 /* internal static */ 8 97 8 98 declare max_parse_stack_depth fixed bin int static init(64536); 8 99 8 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 82 83 84 /* program */ 85 86 print_arg = "1"b; 87 pad_arg = "0"b; 88 add_nl = "1"b; 89 go to begin; 90 91 apl_ioa_$rs: 92 entry (operators_argument); 93 94 print_arg = "0"b; 95 pad_arg = "0"b; 96 add_nl = "1"b; 97 go to begin; 98 99 apl_ioa_$rsnnl: 100 entry (operators_argument); 101 102 print_arg = "0"b; 103 pad_arg = "0"b; 104 add_nl = "0"b; 105 go to begin; 106 107 apl_ioa_$nnl: 108 entry (operators_argument); 109 110 print_arg = "1"b; 111 pad_arg = "0"b; 112 add_nl = "0"b; 113 go to begin; 114 115 begin: 116 right_vb = operators_argument (2).value; 117 118 if right_vb -> general_bead.value 119 then do; 120 list_given = "0"b; 121 n_values = 1; 122 end; 123 else if right_vb -> general_bead.list_value 124 then do; 125 list_given = "1"b; 126 n_values = right_vb -> list_bead.number_of_members; 127 end; 128 else go to domain_error_right; 129 130 left_vb = operators_argument (1).value; 131 132 if ^left_vb -> general_bead.value 133 then go to domain_error_left; 134 135 if ^left_vb -> value_bead.character_value 136 then go to domain_error_left; 137 138 if (left_vb -> value_bead.total_data_elements > 1) & (left_vb -> value_bead.rhorho ^= 1) 139 then go to rank_error_left; 140 141 left = left_vb -> value_bead.data_pointer; 142 data_elements, left_data_elements = left_vb -> value_bead.total_data_elements; 143 144 number_of_args = 1 + n_values; /* 1 for control string, N for values */ 145 146 /* Translate UpperMinus to Circumflex in the control string...give apl user a break. */ 147 148 n_words = size (character_string_overlay); 149 result_vb = apl_push_stack_ (n_words); 150 151 result_vb -> character_string_overlay = translate (left -> character_string_overlay, "^", QUpperMinus); 152 arglist.ptr (1) = result_vb; 153 154 if ^list_given 155 then arglist.ptr (2) = right_vb -> value_bead.data_pointer; 156 else do i = 1 to n_values; 157 arglist.ptr (1+i) = right_vb -> list_bead.member_ptr (i) -> value_bead.data_pointer; 158 end; 159 160 desclist.desc (1).type = character_descriptor; 161 desclist.desc (1).n_dims = "0000"b; 162 desclist.desc (1).size = left_data_elements; 163 164 nd = 1; /* this is the index of the current descriptor */ 165 na = number_of_args + 1; /* index of current ptr */ 166 arglist.ptr (na) = addr (desclist.desc (1)); /* store ptr to descriptor for ctl string */ 167 168 if ^list_given 169 then do; 170 if right_vb -> value_bead.numeric_value 171 then call generate_numeric_descriptor (right_vb); 172 else do; 173 na = na + 1; 174 nd = nd + 1; 175 arglist.ptr (na) = addr (desclist.desc (nd)); 176 desclist.desc (nd).type = character_descriptor; 177 desclist.desc (nd).n_dims = "0000"b; 178 desclist.desc (nd).size = right_vb -> value_bead.total_data_elements; 179 end; 180 end; 181 else do i = 1 to n_values; 182 if right_vb -> list_bead.member_ptr (i) -> value_bead.numeric_value 183 then call generate_numeric_descriptor ((right_vb -> list_bead.member_ptr (i))); 184 else do; 185 na = na + 1; 186 nd = nd + 1; 187 arglist.ptr (na) = addr (desclist.desc (nd)); 188 desclist.desc (nd).type = character_descriptor; 189 desclist.desc (nd).n_dims = "0000"b; 190 desclist.desc (nd).size = right_vb -> list_bead.member_ptr (i) -> value_bead.total_data_elements; 191 end; 192 end; 193 194 arglist.n_args = number_of_args * 2; /* Multics convention...! */ 195 arglist.n_desc = number_of_args * 2; 196 call ioa_$general_rs (addr (arglist), 1, 2, return_string, return_len, pad_arg, add_nl); 197 198 if operators_argument.operands (2).on_stack /* Pop args off stack */ 199 then if list_given 200 then do; 201 202 /* The list_bead is always higher than the value_beads it points to. Its members were 203* evaluated in right-to-left (n_members to 1 by -1) order, so that members with higher 204* subscripts are lower on the value stack. */ 205 206 lowest_vb = right_vb; /* initially, this is lowest guy on stack */ 207 do i = 1 to n_values; 208 if right_vb -> list_bead.bits (i).semantics_on_stack 209 then lowest_vb = right_vb -> list_bead.member_ptr (i); 210 end; 211 ws_info.value_stack_ptr = lowest_vb; 212 end; 213 else ws_info.value_stack_ptr = right_vb; 214 else if operators_argument.operands (1).on_stack 215 then ws_info.value_stack_ptr = left_vb; 216 217 if print_arg 218 then do; 219 call iox_$put_chars (iox_$user_output, addr (return_string), return_len, code); 220 operators_argument.result = null; 221 end; 222 else do; 223 data_elements = return_len; 224 number_of_dimensions = 1; 225 n_words = size (value_bead) + size (character_string_overlay); 226 result_vb = apl_push_stack_ (n_words); 227 228 string (result_vb -> value_bead.type) = character_value_type; 229 result_vb -> value_bead.total_data_elements = data_elements; 230 result_vb -> value_bead.rhorho = 1; 231 result_vb -> value_bead.rho (1) = data_elements; 232 result = addrel (result_vb, size (value_bead)); 233 result_vb -> value_bead.data_pointer = result; 234 235 result -> result_string = return_string; 236 operators_argument.result = result_vb; 237 end; 238 return; 239 240 domain_error_left: 241 domain_error_right: 242 operators_argument.error_code = apl_error_table_$domain; 243 return; 244 245 rank_error_left: 246 operators_argument.error_code = apl_error_table_$rank; 247 return; 248 249 generate_numeric_descriptor: 250 procedure (bv_vb_ptr); 251 252 /* parameters */ 253 254 dcl bv_vb_ptr ptr parameter; 255 256 /* program */ 257 258 na = na + 1; /* step to next arg ptr */ 259 nd = nd + 1; /* step to next descriptor */ 260 arglist.ptr (na) = addr (desclist.desc (nd)); 261 desclist.desc (nd).type = float_bin_2_descriptor; 262 desclist.desc (nd).n_dims = "0001"b; /* numbers are always arrays... */ 263 desclist.desc (nd).size = 63; /* precision is 63 */ 264 nd = nd + 1; 265 unspec (desclist.desc (nd)) = ""b; 266 desclist.desc (nd).size = 1; /* LB is always 1 */ 267 nd = nd + 1; 268 unspec (desclist.desc (nd)) = ""b; 269 desclist.desc (nd).size = bv_vb_ptr -> value_bead.total_data_elements; /* UB is TDE */ 270 nd = nd + 1; 271 unspec (desclist.desc (nd)) = ""b; 272 desclist.desc (nd).size = 2; /* MULT is 2 words */ 273 return; 274 275 end generate_numeric_descriptor; 276 9 1 /* ====== BEGIN INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 =============================== */ 9 2 9 3 /* format: style3 */ 9 4 apl_push_stack_: 9 5 procedure (P_n_words) returns (ptr); 9 6 9 7 /* Function to (1) double-word align ws_info.value_stack_ptr, and 9 8* (2) make sure allocation request will fit on current value stack. 9 9* 9 10* Written 770413 by PG 9 11* Modified 780210 by PG to round allocations up to an even number of words. 9 12**/ 9 13 9 14 /* parameters */ 9 15 9 16 declare P_n_words fixed bin (19) parameter; 9 17 9 18 /* automatic */ 9 19 9 20 declare block_ptr ptr, 9 21 num_words fixed bin (19); 9 22 9 23 /* builtins */ 9 24 9 25 declare (addrel, binary, rel, substr, unspec) 9 26 builtin; 9 27 9 28 /* entries */ 9 29 9 30 declare apl_get_value_stack_ 9 31 entry (fixed bin (19)); 9 32 9 33 /* program */ 9 34 9 35 num_words = P_n_words; 9 36 9 37 if substr (unspec (num_words), 36, 1) = "1"b /* num_words odd */ 9 38 then num_words = num_words + 1; 9 39 9 40 if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size 9 41 then call apl_get_value_stack_ (num_words); 9 42 9 43 block_ptr = ws_info.value_stack_ptr; 9 44 ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words); 9 45 return (block_ptr); 9 46 9 47 end apl_push_stack_; 9 48 9 49 /* ------ END INCLUDE SEGMENT apl_push_stack_fcn.incl.pl1 ------------------------------- */ 277 278 end /* apl_ioa_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1549.4 apl_ioa_.pl1 >special_ldd>on>apl.1129>apl_ioa_.pl1 75 1 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 76 2 03/27/82 0438.6 apl_characters.incl.pl1 >ldd>include>apl_characters.incl.pl1 77 3 03/27/82 0439.0 apl_operators_argument.incl.pl1 >ldd>include>apl_operators_argument.incl.pl1 78 4 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 79 5 03/27/82 0439.0 apl_operator_bead.incl.pl1 >ldd>include>apl_operator_bead.incl.pl1 80 6 03/27/82 0438.7 apl_list_bead.incl.pl1 >ldd>include>apl_list_bead.incl.pl1 81 7 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 82 8 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 277 9 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 9-16 ref 9-4 9-35 QUpperMinus constant char(1) initial unaligned dcl 2-11 ref 151 add_nl 000100 automatic bit(1) dcl 26 set ref 88* 96* 104* 112* 196* addr builtin function dcl 53 ref 166 175 187 196 196 219 219 260 addrel builtin function dcl 53 in procedure "apl_ioa_" ref 232 addrel builtin function dcl 9-25 in procedure "apl_push_stack_" ref 9-44 apl_error_table_$domain 000014 external static fixed bin(35,0) dcl 62 ref 240 apl_error_table_$rank 000016 external static fixed bin(35,0) dcl 62 ref 245 apl_get_value_stack_ 000024 constant entry external dcl 9-30 ref 9-40 apl_static_$ws_info_ptr 000022 external static structure level 1 dcl 8-11 arglist 000232 automatic structure level 1 dcl 34 set ref 196 196 bead_type based structure level 3 packed unaligned dcl 4-3 binary builtin function dcl 9-25 ref 9-40 bits 4 based structure array level 3 packed unaligned dcl 6-3 bits_for_parse 1 based structure level 2 packed unaligned dcl 5-3 block_ptr 000734 automatic pointer dcl 9-20 set ref 9-43* 9-45 bv_vb_ptr parameter pointer dcl 254 ref 249 269 character_descriptor constant bit(18) initial unaligned dcl 69 ref 160 176 188 character_string_overlay based char dcl 7-19 set ref 148 151* 151 225 character_value 0(09) based bit(1) level 5 packed unaligned dcl 7-3 set ref 135 character_value_type constant bit(18) initial unaligned dcl 4-30 ref 228 code 000130 automatic fixed bin(35,0) dcl 26 set ref 219* data_elements 000120 automatic fixed bin(21,0) dcl 26 set ref 142* 148 148 151 151 223* 225 225 229 231 data_pointer 4 based pointer level 2 packed unaligned dcl 7-3 set ref 141 154 157 233* data_type 0(08) based structure level 4 in structure "value_bead" packed unaligned dcl 7-3 in procedure "apl_ioa_" data_type 0(08) based structure level 3 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_ioa_" desc 000544 automatic structure array level 2 dcl 41 set ref 166 175 187 260 265* 268* 271* desclist 000544 automatic structure level 1 dcl 41 error_code 7 parameter fixed bin(35,0) level 2 dcl 3-3 set ref 240* 245* flag 0(18) 000232 automatic bit(18) initial level 2 packed unaligned dcl 34 set ref 34* float_bin_2_descriptor constant bit(18) initial unaligned dcl 69 ref 261 general_bead based structure level 1 dcl 4-3 header based structure level 2 dcl 7-3 i 000123 automatic fixed bin(17,0) dcl 26 set ref 156* 157 157* 181* 182 182 190* 207* 208 208* ioa_$general_rs 000010 constant entry external dcl 57 ref 196 iox_$put_chars 000012 constant entry external dcl 57 ref 219 iox_$user_output 000020 external static pointer dcl 62 set ref 219* left 000104 automatic pointer dcl 26 set ref 141* 151 left_data_elements 000121 automatic fixed bin(21,0) dcl 26 set ref 142* 162 left_vb 000106 automatic pointer dcl 26 set ref 130* 132 135 138 138 141 142 214 list_bead based structure level 1 dcl 6-3 list_given 000103 automatic bit(1) dcl 26 set ref 120* 125* 154 168 198 list_value 0(08) based bit(1) level 4 packed unaligned dcl 4-3 ref 123 lowest_vb 000110 automatic pointer dcl 26 set ref 206* 208* 211 maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 8-16 ref 9-40 member_ptr 3 based pointer array level 3 packed unaligned dcl 6-3 ref 157 182 182 190 208 members 3 based structure array level 2 dcl 6-3 n_args 000232 automatic fixed bin(17,0) level 2 packed unaligned dcl 34 set ref 194* n_desc 1 000232 automatic fixed bin(17,0) level 2 packed unaligned dcl 34 set ref 195* n_dims 0(08) 000544 automatic bit(4) array level 3 packed unaligned dcl 41 set ref 161* 177* 189* 262* n_values 000126 automatic fixed bin(17,0) dcl 26 set ref 121* 126* 144 156 181 207 n_words 000131 automatic fixed bin(19,0) dcl 26 set ref 148* 149* 225* 226* na 000124 automatic fixed bin(17,0) dcl 26 set ref 165* 166 173* 173 175 185* 185 187 258* 258 260 nd 000125 automatic fixed bin(17,0) dcl 26 set ref 164* 174* 174 175 176 177 178 186* 186 187 188 189 190 259* 259 260 261 262 263 264* 264 265 266 267* 267 268 269 270* 270 271 272 null builtin function dcl 53 ref 220 num_words 000736 automatic fixed bin(19,0) dcl 9-20 set ref 9-35* 9-37 9-37* 9-37 9-40 9-40* 9-44 number_of_args 000127 automatic fixed bin(17,0) dcl 26 set ref 144* 165 194 195 number_of_dimensions 000710 automatic fixed bin(17,0) dcl 7-3 set ref 224* 225 232 number_of_members 2 based fixed bin(17,0) level 2 dcl 6-3 ref 126 numeric_value 0(10) based bit(1) level 5 packed unaligned dcl 7-3 set ref 170 182 on_stack 1 parameter bit(1) array level 3 dcl 3-3 ref 198 214 operands parameter structure array level 2 dcl 3-3 operator_bead based structure level 1 dcl 5-3 operators_argument parameter structure level 1 dcl 3-3 set ref 17 91 99 107 pad_arg 000101 automatic bit(1) dcl 26 set ref 87* 95* 103* 111* 196* pointers 14 based structure level 2 dcl 8-16 print_arg 000102 automatic bit(1) dcl 26 set ref 86* 94* 102* 110* 217 ptr 2 000232 automatic pointer array level 2 dcl 34 set ref 152* 154* 157* 166* 175* 187* 260* rel builtin function dcl 9-25 ref 9-40 result 000112 automatic pointer dcl 26 in procedure "apl_ioa_" set ref 232* 233 235 result 6 parameter pointer level 2 in structure "operators_argument" packed unaligned dcl 3-3 in procedure "apl_ioa_" set ref 220* 236* result_string based char unaligned dcl 49 set ref 235* result_vb 000114 automatic pointer dcl 26 set ref 149* 151 152 226* 228 229 230 231 232 233 236 return_len 000122 automatic fixed bin(21,0) dcl 26 set ref 196* 219* 223 235 return_string 000132 automatic char(256) unaligned dcl 26 set ref 196* 219 219 235 rho 5 based fixed bin(21,0) array level 2 dcl 7-3 set ref 231* rhorho 3 based fixed bin(17,0) level 2 dcl 7-3 set ref 138 230* right_vb 000116 automatic pointer dcl 26 set ref 115* 118 123 126 154 157 170 170* 178 182 182 190 206 208 208 213 semantics_on_stack 4(09) based bit(1) array level 4 packed unaligned dcl 6-3 ref 208 size 0(12) 000544 automatic fixed bin(23,0) array level 3 in structure "desclist" packed unaligned dcl 41 in procedure "apl_ioa_" set ref 162* 178* 190* 263* 266* 269* 272* size builtin function dcl 53 in procedure "apl_ioa_" ref 148 225 225 232 static_ws_info_ptr 000022 external static pointer level 2 packed unaligned dcl 8-11 ref 8-7 string builtin function dcl 53 set ref 228* substr builtin function dcl 9-25 ref 9-37 total_data_elements 2 based fixed bin(21,0) level 2 dcl 7-3 set ref 138 142 178 190 229* 269 translate builtin function dcl 53 ref 151 type based structure level 2 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_ioa_" type based structure level 3 in structure "list_bead" packed unaligned dcl 6-3 in procedure "apl_ioa_" type based structure level 3 in structure "value_bead" packed unaligned dcl 7-3 in procedure "apl_ioa_" set ref 228* type 000544 automatic bit(8) array level 3 in structure "desclist" packed unaligned dcl 41 in procedure "apl_ioa_" set ref 160* 176* 188* 261* unspec builtin function dcl 9-25 in procedure "apl_push_stack_" ref 9-37 unspec builtin function dcl 53 in procedure "apl_ioa_" set ref 265* 268* 271* value 0(02) based bit(1) level 4 in structure "general_bead" packed unaligned dcl 4-3 in procedure "apl_ioa_" ref 118 132 value parameter pointer array level 3 in structure "operators_argument" packed unaligned dcl 3-3 in procedure "apl_ioa_" ref 115 130 value_bead based structure level 1 dcl 7-3 set ref 225 232 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 8-16 set ref 211* 213* 214* 9-40 9-43 9-44* 9-44 values 2 based structure level 2 dcl 8-16 ws_info based structure level 1 dcl 8-16 ws_info_ptr 000712 automatic pointer initial dcl 8-7 set ref 211 213 214 8-7* 9-40 9-40 9-43 9-44 9-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 7-28 NumberSize internal static fixed bin(4,0) initial dcl 1-25 QAlpha internal static char(1) initial unaligned dcl 2-11 QAndSign internal static char(1) initial unaligned dcl 2-11 QApostrophe internal static char(1) initial unaligned dcl 2-11 QBackSlash internal static char(1) initial unaligned dcl 2-11 QBackSlashHyphen internal static char(1) initial unaligned dcl 2-11 QBackSpace internal static char(1) initial unaligned dcl 2-11 QBell internal static char(1) initial unaligned dcl 2-11 QCap internal static char(1) initial unaligned dcl 2-11 QCeiling internal static char(1) initial unaligned dcl 2-11 QCentSign internal static char(1) initial unaligned dcl 2-11 QCircle internal static char(1) initial unaligned dcl 2-11 QCircleBackSlash internal static char(1) initial unaligned dcl 2-11 QCircleBar internal static char(1) initial unaligned dcl 2-11 QCircleHyphen internal static char(1) initial unaligned dcl 2-11 QCircleSlash internal static char(1) initial unaligned dcl 2-11 QCircleStar internal static char(1) initial unaligned dcl 2-11 QColon internal static char(1) initial unaligned dcl 2-11 QComma internal static char(1) initial unaligned dcl 2-11 QCommaHyphen internal static char(1) initial unaligned dcl 2-11 QConditionalNewLine internal static char(1) initial unaligned dcl 2-11 QCup internal static char(1) initial unaligned dcl 2-11 QDeCode internal static char(1) initial unaligned dcl 2-11 QDel internal static char(1) initial unaligned dcl 2-11 QDelTilde internal static char(1) initial unaligned dcl 2-11 QDelta internal static char(1) initial unaligned dcl 2-11 QDelta_ internal static char(1) initial unaligned dcl 2-11 QDiamond internal static char(1) initial unaligned dcl 2-11 QDiaresis internal static char(1) initial unaligned dcl 2-11 QDivision internal static char(1) initial unaligned dcl 2-11 QDollar internal static char(1) initial unaligned dcl 2-11 QDomino internal static char(1) initial unaligned dcl 2-11 QDownArrow internal static char(1) initial unaligned dcl 2-11 QEight internal static char(1) initial unaligned dcl 2-11 QEight_ internal static char(1) initial unaligned dcl 2-11 QEnCode internal static char(1) initial unaligned dcl 2-11 QEpsilon internal static char(1) initial unaligned dcl 2-11 QEqual internal static char(1) initial unaligned dcl 2-11 QExclamation internal static char(1) initial unaligned dcl 2-11 QExecuteSign internal static char(1) initial unaligned dcl 2-11 QFive internal static char(1) initial unaligned dcl 2-11 QFive_ internal static char(1) initial unaligned dcl 2-11 QFloor internal static char(1) initial unaligned dcl 2-11 QFormatSign internal static char(1) initial unaligned dcl 2-11 QFour internal static char(1) initial unaligned dcl 2-11 QFour_ internal static char(1) initial unaligned dcl 2-11 QGradeDown internal static char(1) initial unaligned dcl 2-11 QGradeUp internal static char(1) initial unaligned dcl 2-11 QGreaterOrEqual internal static char(1) initial unaligned dcl 2-11 QGreaterThan internal static char(1) initial unaligned dcl 2-11 QIBeam internal static char(1) initial unaligned dcl 2-11 QIota internal static char(1) initial unaligned dcl 2-11 QLamp internal static char(1) initial unaligned dcl 2-11 QLeftArrow internal static char(1) initial unaligned dcl 2-11 QLeftBrace internal static char(1) initial unaligned dcl 2-11 QLeftBracket internal static char(1) initial unaligned dcl 2-11 QLeftLump internal static char(1) initial unaligned dcl 2-11 QLeftParen internal static char(1) initial unaligned dcl 2-11 QLeftTack internal static char(1) initial unaligned dcl 2-11 QLessOrEqual internal static char(1) initial unaligned dcl 2-11 QLessThan internal static char(1) initial unaligned dcl 2-11 QLetterA internal static char(1) initial unaligned dcl 2-11 QLetterA_ internal static char(1) initial unaligned dcl 2-11 QLetterB internal static char(1) initial unaligned dcl 2-11 QLetterB_ internal static char(1) initial unaligned dcl 2-11 QLetterC internal static char(1) initial unaligned dcl 2-11 QLetterC_ internal static char(1) initial unaligned dcl 2-11 QLetterD internal static char(1) initial unaligned dcl 2-11 QLetterD_ internal static char(1) initial unaligned dcl 2-11 QLetterE internal static char(1) initial unaligned dcl 2-11 QLetterE_ internal static char(1) initial unaligned dcl 2-11 QLetterF internal static char(1) initial unaligned dcl 2-11 QLetterF_ internal static char(1) initial unaligned dcl 2-11 QLetterG internal static char(1) initial unaligned dcl 2-11 QLetterG_ internal static char(1) initial unaligned dcl 2-11 QLetterH internal static char(1) initial unaligned dcl 2-11 QLetterH_ internal static char(1) initial unaligned dcl 2-11 QLetterI internal static char(1) initial unaligned dcl 2-11 QLetterI_ internal static char(1) initial unaligned dcl 2-11 QLetterJ internal static char(1) initial unaligned dcl 2-11 QLetterJ_ internal static char(1) initial unaligned dcl 2-11 QLetterK internal static char(1) initial unaligned dcl 2-11 QLetterK_ internal static char(1) initial unaligned dcl 2-11 QLetterL internal static char(1) initial unaligned dcl 2-11 QLetterL_ internal static char(1) initial unaligned dcl 2-11 QLetterM internal static char(1) initial unaligned dcl 2-11 QLetterM_ internal static char(1) initial unaligned dcl 2-11 QLetterN internal static char(1) initial unaligned dcl 2-11 QLetterN_ internal static char(1) initial unaligned dcl 2-11 QLetterO internal static char(1) initial unaligned dcl 2-11 QLetterO_ internal static char(1) initial unaligned dcl 2-11 QLetterP internal static char(1) initial unaligned dcl 2-11 QLetterP_ internal static char(1) initial unaligned dcl 2-11 QLetterQ internal static char(1) initial unaligned dcl 2-11 QLetterQ_ internal static char(1) initial unaligned dcl 2-11 QLetterR internal static char(1) initial unaligned dcl 2-11 QLetterR_ internal static char(1) initial unaligned dcl 2-11 QLetterS internal static char(1) initial unaligned dcl 2-11 QLetterS_ internal static char(1) initial unaligned dcl 2-11 QLetterT internal static char(1) initial unaligned dcl 2-11 QLetterT_ internal static char(1) initial unaligned dcl 2-11 QLetterU internal static char(1) initial unaligned dcl 2-11 QLetterU_ internal static char(1) initial unaligned dcl 2-11 QLetterV internal static char(1) initial unaligned dcl 2-11 QLetterV_ internal static char(1) initial unaligned dcl 2-11 QLetterW internal static char(1) initial unaligned dcl 2-11 QLetterW_ internal static char(1) initial unaligned dcl 2-11 QLetterX internal static char(1) initial unaligned dcl 2-11 QLetterX_ internal static char(1) initial unaligned dcl 2-11 QLetterY internal static char(1) initial unaligned dcl 2-11 QLetterY_ internal static char(1) initial unaligned dcl 2-11 QLetterZ internal static char(1) initial unaligned dcl 2-11 QLetterZ_ internal static char(1) initial unaligned dcl 2-11 QLineFeed internal static char(1) initial unaligned dcl 2-11 QMarkError internal static char(1) initial unaligned dcl 2-11 QMinus internal static char(1) initial unaligned dcl 2-11 QNandSign internal static char(1) initial unaligned dcl 2-11 QNewLine internal static char(1) initial unaligned dcl 2-11 QNine internal static char(1) initial unaligned dcl 2-11 QNine_ internal static char(1) initial unaligned dcl 2-11 QNorSign internal static char(1) initial unaligned dcl 2-11 QNotEqual internal static char(1) initial unaligned dcl 2-11 QOmega internal static char(1) initial unaligned dcl 2-11 QOne internal static char(1) initial unaligned dcl 2-11 QOne_ internal static char(1) initial unaligned dcl 2-11 QOrSign internal static char(1) initial unaligned dcl 2-11 QPeriod internal static char(1) initial unaligned dcl 2-11 QPlus internal static char(1) initial unaligned dcl 2-11 QQuad internal static char(1) initial unaligned dcl 2-11 QQuadQuote internal static char(1) initial unaligned dcl 2-11 QQuestion internal static char(1) initial unaligned dcl 2-11 QRho internal static char(1) initial unaligned dcl 2-11 QRightArrow internal static char(1) initial unaligned dcl 2-11 QRightBrace internal static char(1) initial unaligned dcl 2-11 QRightBracket internal static char(1) initial unaligned dcl 2-11 QRightLump internal static char(1) initial unaligned dcl 2-11 QRightParen internal static char(1) initial unaligned dcl 2-11 QRightTack internal static char(1) initial unaligned dcl 2-11 QSemiColon internal static char(1) initial unaligned dcl 2-11 QSeven internal static char(1) initial unaligned dcl 2-11 QSeven_ internal static char(1) initial unaligned dcl 2-11 QSix internal static char(1) initial unaligned dcl 2-11 QSix_ internal static char(1) initial unaligned dcl 2-11 QSlash internal static char(1) initial unaligned dcl 2-11 QSlashHyphen internal static char(1) initial unaligned dcl 2-11 QSmallCircle internal static char(1) initial unaligned dcl 2-11 QSpace internal static char(1) initial unaligned dcl 2-11 QStar internal static char(1) initial unaligned dcl 2-11 QTab internal static char(1) initial unaligned dcl 2-11 QThree internal static char(1) initial unaligned dcl 2-11 QThree_ internal static char(1) initial unaligned dcl 2-11 QTilde internal static char(1) initial unaligned dcl 2-11 QTimes internal static char(1) initial unaligned dcl 2-11 QTwo internal static char(1) initial unaligned dcl 2-11 QTwo_ internal static char(1) initial unaligned dcl 2-11 QUnderLine internal static char(1) initial unaligned dcl 2-11 QUpArrow internal static char(1) initial unaligned dcl 2-11 QVerticalBar internal static char(1) initial unaligned dcl 2-11 QZero internal static char(1) initial unaligned dcl 2-11 QZero_ internal static char(1) initial unaligned dcl 2-11 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 1-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 1-16 character_data_structure based structure level 1 dcl 7-15 complex_datum based complex float bin(63) array dcl 7-26 complex_value_type internal static bit(18) initial unaligned dcl 4-30 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 8-98 n_members automatic fixed bin(17,0) dcl 6-3 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_datum based float bin(63) array dcl 7-23 numeric_value_type internal static bit(18) initial unaligned dcl 4-30 operator_type internal static bit(18) initial unaligned dcl 4-30 output_buffer based char unaligned dcl 8-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_ioa_ 000050 constant entry external dcl 17 apl_ioa_$nnl 000116 constant entry external dcl 107 apl_ioa_$rs 000065 constant entry external dcl 91 apl_ioa_$rsnnl 000102 constant entry external dcl 99 apl_push_stack_ 000670 constant entry internal dcl 9-4 ref 149 226 begin 000131 constant label dcl 115 ref 89 97 105 113 domain_error_left 000607 constant label dcl 240 ref 132 135 domain_error_right 000607 constant label dcl 240 ref 123 generate_numeric_descriptor 000617 constant entry internal dcl 249 ref 170 182 rank_error_left 000613 constant label dcl 245 ref 138 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1330 1356 1154 1340 Length 1732 1154 26 340 154 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_ioa_ 522 external procedure is an external procedure. generate_numeric_descriptor internal procedure shares stack frame of external procedure apl_ioa_. apl_push_stack_ internal procedure shares stack frame of external procedure apl_ioa_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_ioa_ 000100 add_nl apl_ioa_ 000101 pad_arg apl_ioa_ 000102 print_arg apl_ioa_ 000103 list_given apl_ioa_ 000104 left apl_ioa_ 000106 left_vb apl_ioa_ 000110 lowest_vb apl_ioa_ 000112 result apl_ioa_ 000114 result_vb apl_ioa_ 000116 right_vb apl_ioa_ 000120 data_elements apl_ioa_ 000121 left_data_elements apl_ioa_ 000122 return_len apl_ioa_ 000123 i apl_ioa_ 000124 na apl_ioa_ 000125 nd apl_ioa_ 000126 n_values apl_ioa_ 000127 number_of_args apl_ioa_ 000130 code apl_ioa_ 000131 n_words apl_ioa_ 000132 return_string apl_ioa_ 000232 arglist apl_ioa_ 000544 desclist apl_ioa_ 000710 number_of_dimensions apl_ioa_ 000712 ws_info_ptr apl_ioa_ 000734 block_ptr apl_push_stack_ 000736 num_words apl_push_stack_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_get_value_stack_ ioa_$general_rs iox_$put_chars THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$domain apl_error_table_$rank apl_static_$ws_info_ptr iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000036 8 7 000040 17 000045 86 000056 87 000060 88 000061 89 000062 91 000063 94 000073 95 000074 96 000075 97 000077 99 000100 102 000110 103 000111 104 000112 105 000113 107 000114 110 000124 111 000126 112 000127 113 000130 115 000131 118 000135 120 000140 121 000141 122 000143 123 000144 125 000147 126 000151 130 000153 132 000155 135 000160 138 000163 141 000171 142 000173 144 000176 148 000201 149 000205 151 000207 152 000216 154 000217 156 000225 157 000235 158 000242 160 000244 161 000250 162 000252 164 000254 165 000256 166 000261 168 000264 170 000266 173 000274 174 000275 175 000276 176 000303 177 000307 178 000311 180 000315 181 000316 182 000325 185 000343 186 000344 187 000345 188 000352 189 000356 190 000360 192 000363 194 000365 195 000372 196 000375 198 000442 206 000451 207 000453 208 000463 210 000473 211 000475 212 000500 213 000501 214 000505 217 000513 219 000515 220 000534 221 000540 223 000541 224 000543 225 000545 226 000555 228 000557 229 000562 230 000565 231 000567 232 000571 233 000576 235 000577 236 000603 238 000606 240 000607 243 000612 245 000613 247 000616 249 000617 258 000621 259 000622 260 000623 261 000630 262 000634 263 000640 264 000643 265 000644 266 000646 267 000651 268 000652 269 000654 270 000661 271 000662 272 000664 273 000667 9 4 000670 9 35 000672 9 37 000674 9 40 000701 9 43 000716 9 44 000721 9 45 000730 ----------------------------------------------------------- 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