COMPILATION LISTING OF SEGMENT apl_iox_ 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.7 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* *********************************************************** */ 6 7 /* APL External Functions to access the full (ycch) panoply 8* of iox stream files 9**/ 10 11 /* stolen from apl_read_segment_ 1/28/80 BIM */ 12 13 /* ************************************************************** 14* * for the first implementation, we support the following: * 15* * attach_name * 16* * open * 17* * get_chars * 18* * get_line * 19* * put_chars * 20* * close * 21* * detach_iocb * 22* * * 23* * packed pointers are left around in fixed bin (35)'s * 24* ************************************************************** */ 25 26 27 /* ******************************************************************* 28* * APL Definitions and calling sequences: * 29* * attach_name * 30* * )DFN IOX_ATTACH_NAME APL_IOX_$ATTACH_NAME * 31* * IOCB<-Switch_name IOX_ATTACH_NAME Attach_description * 32* * * 33* * open * 34* * )DFN IOX_OPEN APL_IOX_$OPEN * 35* * OpenMode IOX_OPEN IOCB (character name of it, long or short) * 36* * * 37* * get_chars * 38* * )DFN IOX_GET_CHARS APL_IOX_$GET_CHARS * 39* * RESULT<-HowMany IOX_GET_CHARS IOCB * 40* * * 41* * get_line * 42* * )MFN IOX_GET_LINE APL_IOX_$GET_LINE * 43* * RESULT<-IOX_GET_LINE IOCB * 44* * * 45* * close * 46* * )MFN IOX_CLOSE APL_IOX_$CLOSE * 47* * IOX_CLOSE IOCB * 48* * * 49* * detach_iocb * 50* * )MFN IOX_DETACH_IOCB APL_IOX_$DETACH_IOCB * 51* ******************************************************************* */ 52 53 apl_iox_$attach_name: 54 procedure (operators_argument); 55 56 /* automatic */ 57 58 declare code fixed bin (35), /* Multics status code */ 59 attach_description char (512), 60 i fixed bin, 61 get_line_flag bit (1), 62 max_size fixed bin (21), 63 ql fixed bin (21), 64 integer fixed bin (35), 65 n_words fixed bin (19), /* number of words to allocate on value stack */ 66 found_mode bit (1), 67 iox_mode char (24), 68 switch_name char (32), 69 iocbp ptr, packed_iocbp ptr unal, 70 result ptr, /* pointer to result data array */ 71 result_vb ptr, /* pointer to result value bead */ 72 right ptr, /* pointer to right data array */ 73 right_vb ptr, /* pointer to right value bead */ 74 left ptr, 75 left_vb ptr; 76 /* based */ 77 78 declare right_arg_string char (data_elements) based (right); 79 declare right_arg_integer fixed bin (35) based (right); 80 declare left_arg_string char (data_elements) based (left); 81 declare float_overlay float bin (63) based aligned; 82 declare line_buffer char (ql) based (apl_iox_temp_seg_ptr_); 83 84 /* builtins */ 85 86 declare (addrel, divide, null, size, string) builtin; 87 88 /* entries */ 89 90 dcl get_entry entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)) variable; 91 dcl (get_temp_segment_, release_temp_segment_) entry (char (*), pointer, fixed bin (35)); 92 93 /* external */ 94 dcl apl_iox_temp_seg_ptr_ ext static ptr init (null()); 95 dcl sys_info$max_seg_size fixed bin (19) external static; 96 /* errors */ 97 98 dcl error_table_$end_of_info fixed bin (35) ext static; 99 /* include files */ 100 1 1 /* --------------- BEGIN include file iox_dcls.incl.pl1 --------------- */ 1 2 1 3 /* Written 05/04/78 by C. D. Tavares */ 1 4 /* Fixed declaration of iox_$find_iocb_n 05/07/80 by R. Holmstedt */ 1 5 /* Modified 5/83 by S. Krupp to add declarations for: iox_$open_file, 1 6* iox_$close_file, iox_$detach and iox_$attach_loud entries. */ 1 7 1 8 dcl iox_$attach_name entry (char (*), pointer, char (*), pointer, fixed bin (35)), 1 9 iox_$attach_ptr entry (pointer, char (*), pointer, fixed bin (35)), 1 10 iox_$close entry (pointer, fixed bin (35)), 1 11 iox_$control entry (pointer, char (*), pointer, fixed bin (35)), 1 12 iox_$delete_record entry (pointer, fixed bin (35)), 1 13 iox_$destroy_iocb entry (pointer, fixed bin (35)), 1 14 iox_$detach_iocb entry (pointer, fixed bin (35)), 1 15 iox_$err_not_attached entry options (variable), 1 16 iox_$err_not_closed entry options (variable), 1 17 iox_$err_no_operation entry options (variable), 1 18 iox_$err_not_open entry options (variable), 1 19 iox_$find_iocb entry (char (*), pointer, fixed bin (35)), 1 20 iox_$find_iocb_n entry (fixed bin, ptr, fixed bin(35)), 1 21 iox_$get_chars entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 1 22 iox_$get_line entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 1 23 iox_$look_iocb entry (char (*), pointer, fixed bin (35)), 1 24 iox_$modes entry (pointer, char (*), char (*), fixed bin (35)), 1 25 iox_$move_attach entry (pointer, pointer, fixed bin (35)), 1 26 iox_$open entry (pointer, fixed bin, bit (1) aligned, fixed bin (35)), 1 27 iox_$position entry (pointer, fixed bin, fixed bin (21), fixed bin (35)), 1 28 iox_$propagate entry (pointer), 1 29 iox_$put_chars entry (pointer, pointer, fixed bin (21), fixed bin (35)), 1 30 iox_$read_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 1 31 iox_$read_length entry (pointer, fixed bin (21), fixed bin (35)), 1 32 iox_$read_record entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 1 33 iox_$rewrite_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 1 34 iox_$seek_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 1 35 iox_$write_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 1 36 iox_$open_file entry(ptr, fixed bin, char(*), bit(1) aligned, fixed bin(35)), 1 37 iox_$close_file entry(ptr, char(*), fixed bin(35)), 1 38 iox_$detach entry(ptr, char(*), fixed bin(35)), 1 39 iox_$attach_loud entry(ptr, char(*), ptr, fixed bin(35)); 1 40 1 41 dcl (iox_$user_output, 1 42 iox_$user_input, 1 43 iox_$user_io, 1 44 iox_$error_output) external static pointer; 1 45 1 46 /* ---------------- END include file iox_dcls.incl.pl1 ---------------- */ 101 2 1 /* Begin include file ..... iox_modes.incl.pl1 */ 2 2 2 3 /* Written by C. D. Tavares, 03/17/75 */ 2 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 2 5 2 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 2 7 ("stream_input", "stream_output", "stream_input_output", 2 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 2 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 2 10 "direct_input", "direct_output", "direct_update"); 2 11 2 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 2 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 2 14 2 15 dcl (Stream_input initial (1), 2 16 Stream_output initial (2), 2 17 Stream_input_output initial (3), 2 18 Sequential_input initial (4), 2 19 Sequential_output initial (5), 2 20 Sequential_input_output initial (6), 2 21 Sequential_update initial (7), 2 22 Keyed_sequential_input initial (8), 2 23 Keyed_sequential_output initial (9), 2 24 Keyed_sequential_update initial (10), 2 25 Direct_input initial (11), 2 26 Direct_output initial (12), 2 27 Direct_update initial (13)) fixed bin int static options (constant); 2 28 2 29 /* End include file ..... iox_modes.incl.pl1 */ 102 3 1 /* ====== BEGIN INCLUDE SEGMENT apl_external_function.incl.pl1 ============================ */ 3 2 3 3 /* This include segment contains all of the Version 2 apl declarations necessary for an external apl 3 4* function to interface to apl. */ 3 5 3 6 /* automatic */ 3 7 3 8 declare data_elements fixed binary (21); /* number of elements for arrays */ 3 9 3 10 /* entries */ 3 11 3 12 declare apl_allocate_words_ entry (fixed binary (19), unaligned pointer); 3 13 /* param 1 (input) number of words to allocate */ 3 14 /* param 2 (output) word-aligned packed pointer to allocated bead, 3 15* with general_bead.size and general_bead.reference_count set. */ 3 16 3 17 declare apl_free_words_ entry (fixed binary (19), unaligned pointer); 3 18 /* param 1 (input) number of words to free */ 3 19 /* param 2 (input) word-aligned packed pointer to bead to be freed. */ 3 20 3 21 declare apl_free_bead_ entry (unaligned pointer); 3 22 /* param 1 (input) word-aligned packed pointer to bead to be freed. */ 3 23 /* if reference count is non-zero, a system error will result. */ 3 24 3 25 declare apl_get_value_stack_ entry (fixed binary (19)); 3 26 /* param 1 (input) number of words needed in a value stack. */ 3 27 /* (implicit) (output) sets ws_info.value_stack_ptr to point to new value stack. */ 3 28 3 29 declare apl_subsystem_ entry (fixed bin (35), bit (*) aligned, char (*), char (*), char (*), char (*), 3 30 fixed bin (35)); 3 31 /* param 1 (input) user number */ 3 32 /* param 2 (input) control switches (1 like ws_info.switches) */ 3 33 /* param 3 (input) initial ws pathname */ 3 34 /* param 4 (input) terminal conversion table to use */ 3 35 /* param 5 (output) user-specified signoff lock ("*" = no lock) */ 3 36 /* param 6 (output) 0 = normal termination, 3 37* apl_error_table_$off_hold = )OFF HOLD, 3 38* apl_error_table_$cant_load_ws = could not load initial ws */ 3 39 3 40 declare apl_system_error_ entry (fixed bin (35)); 3 41 /* param 1 (input) status code of error to be printed. */ 3 42 /* system errors will not return to caller. */ 3 43 3 44 /* external static */ 3 45 3 46 declare (apl_error_table_$cant_load_ws, /* status code returned by apl_subsystem_ if ws not found */ 3 47 apl_error_table_$domain, /* status code for DOMAIN ERROR */ 3 48 apl_error_table_$function, /* status code for FUNCTION ERROR - IN EXTERNAL FUNCTION */ 3 49 apl_error_table_$index, /* status code for INDEX ERROR */ 3 50 apl_error_table_$length, /* status code for LENGTH ERROR */ 3 51 apl_error_table_$no_type_bits, /* status code for SYSTEM ERROR - VALUE HAS NO TYPE BITS */ 3 52 apl_error_table_$rank, /* status code for RANK ERROR */ 3 53 apl_error_table_$result_size, /* status code for RESULT SIZE ERROR - OBJECT WOULD BE LARGER THAN A SEGMENT */ 3 54 apl_error_table_$system_error, /* status code for SYSTEM ERROR */ 3 55 apl_error_table_$off_hold) /* status code returned by apl_subsystem_ after )OFF HOLD */ 3 56 fixed binary (35) external static; 3 57 3 58 /* include files */ 3 59 4 1 /* ====== BEGIN INCLUDE SEGMENT apl_number_data.incl.pl1 ================================== */ 4 2 4 3 /* 4 4* This include file contains information about the machine representation of numbers. 4 5* In all programs numbers should simply be declared 'float'. 4 6* All default statements should be in this include file. 4 7* 4 8* This is the binary version. The manifest constant Binary should be used by programs 4 9* that need to know whether we are using binary or decimal. 4 10* */ 4 11 4 12 /* format: style3,initlm0,idind30 */ 4 13 4 14 default (float & ^decimal & ^binary & ^precision & ^constant) float binary (63); 4 15 4 16 declare ( 4 17 TheBiggestNumberWeveGot float initial (0.1701411834604692317e+39), 4 18 TheSmallestNumberWeveGot float initial (.1469367938527859385e-38), 4 19 Binary bit (1) aligned initial ("1"b) 4 20 ) internal static options (constant); 4 21 4 22 /* Number of characters in a number datum entry; used for copying float number arrays as strings. 4 23* (Obsolete! use array copies!) */ 4 24 4 25 declare NumberSize fixed binary precision (4) internal static initial (8); 4 26 4 27 /* ------ END INCLUDE SEGMENT apl_number_data.incl.pl1 ---------------------------------- */ 3 60 5 1 /* ====== BEGIN INCLUDE SEGMENT apl_ws_info.incl.pl1 ====================================== */ 5 2 5 3 /* This structure contains all of the global data (or pointers to it) for the APL subsystem */ 5 4 5 5 /* automatic */ 5 6 5 7 declare ws_info_ptr ptr initial (apl_static_$ws_info_ptr.static_ws_info_ptr); 5 8 5 9 /* external static */ 5 10 5 11 declare 1 apl_static_$ws_info_ptr external static aligned structure, 5 12 2 static_ws_info_ptr unaligned pointer; 5 13 5 14 /* based */ 5 15 5 16 declare 1 ws_info aligned based (ws_info_ptr), 5 17 2 version_number fixed bin, /* version of this structure (3) */ 5 18 2 switches unaligned, /* mainly ws parameters */ 5 19 3 long_error_mode bit, /* if 1, long Multics format, else APL/360 format */ 5 20 3 debug_mode bit, /* if 1, system error causes escape to command level */ 5 21 3 canonicalize_mode bit, /* if 1, the editor canonicalizes user input */ 5 22 3 restrict_exec_command bit, /* if 1, the )EXEC command may not be used */ 5 23 3 restrict_debug_command bit, /* if 1, the )DEBUG command may not be used */ 5 24 3 restrict_external_functions 5 25 bit, /* if 1, the )ZFN, )MFN, and )DFN commands may not be used */ 5 26 3 restrict_load bit, /* if 1, the )LOAD and )COPY commands may not be used */ 5 27 3 restrict_load_directory bit, /* if 1, no directory allowed in )LOAD or )COPY pathnames */ 5 28 3 restrict_save bit, /* if 1, the )SAVE command may not be used */ 5 29 3 restrict_save_directory bit, /* if 1, no directory allowed in )SAVE pathnames */ 5 30 3 off_hold bit, /* if 1, )OFF HOLD was typed, else just )OFF */ 5 31 3 transparent_to_signals bit, /* if 1, any conditions slip right past APL */ 5 32 3 meter_mode bit, /* if 1, metering may be done, else speed is all-important */ 5 33 3 restrict_msg_command bit, /* if 1, the )MSG command may not be used. */ 5 34 3 compatibility_check_mode 5 35 bit, /* if 1, check for incompatible operators */ 5 36 3 no_quit_handler bit, /* if 1, do not trap QUITs. */ 5 37 /* remaining 20 bits not presently used */ 5 38 5 39 2 values, /* attributes of the workspace */ 5 40 3 digits fixed bin, /* number of digits of precision printed on output */ 5 41 3 width fixed bin, /* line length for formatted output */ 5 42 3 index_origin fixed bin, /* the index origin (0 or 1) */ 5 43 3 random_link fixed bin(35), /* seed for random number generator */ 5 44 3 fuzz float, /* comparison tolerance (relative fuzz) */ 5 45 3 float_index_origin float, /* the index origin in floating point */ 5 46 3 number_of_symbols fixed bin, /* the number of symbol_beads currently in existence */ 5 47 3 maximum_value_stack_size 5 48 fixed bin (18), /* maximum number of words in one segment of value stack */ 5 49 5 50 2 pointers, /* pointers to various internal tables */ 5 51 3 symbol_table_ptr unaligned pointer, /* -> symbol_table (apl_symbol_table.incl.pl1) */ 5 52 3 current_parse_frame_ptr unaligned pointer, /* -> topmost parse frame */ 5 53 3 value_stack_ptr unaligned pointer, /* -> next free location on value stack */ 5 54 3 alloc_free_info_ptr unaligned pointer, /* -> apl_storage_mngr_ data (apl_storage_system_data.incl.pl1) */ 5 55 5 56 2 time_invoked fixed bin(71), /* clock time that APL was entered */ 5 57 2 integer_fuzz float, /* the absolute fuzz used in checking for integers */ 5 58 2 user_number fixed bin(35), /* number under which the user is signed on */ 5 59 2 latent_expression unaligned pointer, /* -> value_bead for QuadLX */ 5 60 2 lock char(32), /* the lock currently set on this workspace (password) */ 5 61 2 wsid char(100), /* the workspace identification: name, number name, or clear ws */ 5 62 2 last_error_code fixed bin(35), /* last code passed to apl_error_ */ 5 63 2 signoff_lock character (32), 5 64 5 65 2 interrupt_info aligned, /* bits used by apl_interpreter_ to tell when to abort */ 5 66 3 dont_interrupt_parse bit, /* if 1, don't do a dirty stop because the parser is running */ 5 67 3 dont_interrupt_operator bit, /* if 1, don't do a dirty stop because an operator is running */ 5 68 3 dont_interrupt_storage_manager /* if 1, don't stop because apl_storage_mngr_ is */ 5 69 bit, /* munging his tables */ 5 70 3 unused_interrupt_bit bit, /* not presently used */ 5 71 3 dont_interrupt_command bit, 5 72 3 can_be_interrupted bit, /* if 1, OK to do a clean stop (we are between lines, reading) */ 5 73 3 clean_interrupt_pending bit, /* interrupt occured, break cleanly (between lines) */ 5 74 3 dirty_interrupt_pending bit, /* interrupt occured, break as soon as not inhibited */ 5 75 5 76 2 user_name char (32), /* process group id of user */ 5 77 2 immediate_input_prompt char (32) varying, /* normal input */ 5 78 2 evaluated_input_prompt char (32) varying, /* quad input */ 5 79 2 character_input_prompt char (32) varying, /* quad-quote input */ 5 80 2 vcpu_time aligned, 5 81 3 total fixed bin (71), 5 82 3 setup fixed bin (71), 5 83 3 parse fixed bin (71), 5 84 3 lex fixed bin (71), 5 85 3 operator fixed bin (71), 5 86 3 storage_manager fixed bin (71), 5 87 2 output_info aligned, /* data pertaining to output buffer */ 5 88 3 output_buffer_ptr unal ptr, /* ptr to output buffer */ 5 89 3 output_buffer_len fixed bin (21), /* length (bytes) of output buffer */ 5 90 3 output_buffer_pos fixed bin (21), /* index of next byte to write in */ 5 91 3 output_buffer_ll fixed bin (21), /* print positions used up so far */ 5 92 2 tab_width fixed bin (21); /* number of columns a tabs moves cursor */ 5 93 5 94 declare output_buffer char (ws_info.output_buffer_len) based (ws_info.output_buffer_ptr); 5 95 5 96 /* internal static */ 5 97 5 98 declare max_parse_stack_depth fixed bin int static init(64536); 5 99 5 100 /* ------ END INCLUDE SEGMENT apl_ws_info.incl.pl1 -------------------------------------- */ 3 61 6 1 /* ====== BEGIN INCLUDE SEGMENT apl_bead_format.incl.pl1 ================================== */ 6 2 6 3 declare 1 general_bead aligned based, /* The Venerable Bead */ 6 4 2 type unaligned, 6 5 3 bead_type unaligned, 6 6 4 operator bit (1), /* ON if operator bead */ 6 7 4 symbol bit (1), /* ON if symbol bead */ 6 8 4 value bit (1), /* ON if value bead */ 6 9 4 function bit (1), /* ON if function bead */ 6 10 4 group bit (1), /* ON if group bead */ 6 11 4 label bit (1), /* ON if label bead */ 6 12 4 shared_variable bit (1), /* ON if shared variable bead */ 6 13 4 lexed_function bit (1), /* ON if lexed function bead */ 6 14 3 data_type unaligned, 6 15 4 list_value bit (1), /* ON if a list value bead */ 6 16 4 character_value bit (1), /* ON if a character value bead */ 6 17 4 numeric_value bit (1), /* ON if a numeric value bead */ 6 18 4 integral_value bit (1), /* ON if an integral value bead */ 6 19 4 zero_or_one_value bit (1), /* ON if a boolean value bead */ 6 20 4 complex_value bit (1), /* ON if a complex, numeric value bead */ 6 21 3 unused_bits bit (4) unaligned, /* pad to 18 bits (for future use) */ 6 22 2 size bit (18) unaligned, /* Number of words this bead occupies 6 23* (used by bead storage manager) */ 6 24 2 reference_count fixed binary (29); /* Number of pointers which point 6 25* to this bead (used by bead manager) */ 6 26 6 27 6 28 /* constant strings for initing type field in various beads */ 6 29 6 30 declare ( 6 31 operator_type init("100000000000000000"b), 6 32 symbol_type init("010000000000000000"b), 6 33 value_type init("001000000000000000"b), 6 34 function_type init("000100000000000000"b), 6 35 group_type init("000010000000000000"b), 6 36 label_type init("001001000011000000"b), 6 37 shared_variable_type init("001000100000000000"b), 6 38 lexed_function_type init("000000010000000000"b), 6 39 6 40 list_value_type init("000000001000000000"b), 6 41 character_value_type init("001000000100000000"b), 6 42 numeric_value_type init("001000000010000000"b), 6 43 integral_value_type init("001000000011000000"b), 6 44 zero_or_one_value_type init("001000000011100000"b), 6 45 complex_value_type init("001000000000010000"b), 6 46 6 47 not_integer_mask init("111111111110011111"b), /* to clear integral, zero_or_one bits */ 6 48 not_zero_or_one_mask init("111111111111011111"b) /* to clear zero_or_one bit */ 6 49 ) bit(18) internal static; 6 50 6 51 /* ------ END INCLUDE SEGMENT apl_bead_format.incl.pl1 ---------------------------------- */ 3 62 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 ----------------------------------- */ 3 63 8 1 /* ====== BEGIN INCLUDE SEGEMENT apl_operators_argument.incl.pl1 =========================== */ 8 2 8 3 declare 1 operators_argument aligned, 8 4 2 operands (2) aligned, /* these are the operands to the operator to be executed. 8 5* if operand (1).value is null, operator is monadic */ 8 6 3 value pointer unaligned, /* a pointer to the value bead for this operand */ 8 7 3 on_stack bit (1) aligned, /* ON if this value resides on the value stack */ 8 8 2 operator aligned, /* information about the operator to be executed */ 8 9 3 dimension fixed bin, /* (optional) dimension along which to operate */ 8 10 3 padding bit (18) unaligned, /* unused part of operator bead */ 8 11 3 op2 fixed bin (8) unal, /* a modifier for op1, or a 2nd operator if inner product */ 8 12 3 op1 fixed bin (8) unal, /* code for the actual operator to be executed */ 8 13 2 result pointer unal, /* (output) set by operator to point to result bead in stack */ 8 14 2 error_code fixed bin (35), /* (output) set before signaling apl_operator_error_ */ 8 15 2 where_error fixed bin; /* parseme index of where error was - parse sets to operator */ 8 16 8 17 /* ------ END INCLUDE SEGMENT apl_operators_argument.incl.pl1 --------------------------- */ 3 64 3 65 3 66 /* ------ END INCLUDE SEGMENT apl_external_function.incl.pl1 ---------------------------- */ 103 104 105 /* program -- attach_name entrypoint */ 106 107 right_vb = operators_argument.operands (2).value; /* Get ptr to right argument */ 108 if ^right_vb -> value_bead.value /* Make sure argument is a value bead */ 109 then go to domain_error_right; 110 111 if ^right_vb -> value_bead.character_value /* Make sure argument is character */ 112 then go to domain_error_right; 113 114 right = right_vb -> value_bead.data_pointer; /* Point to data array */ 115 data_elements = right_vb -> value_bead.total_data_elements; 116 117 attach_description = right_arg_string; 118 119 left_vb = operators_argument.operands (1).value; /* Get ptr to left argument */ 120 if ^left_vb -> value_bead.value /* Make sure argument is a value bead */ 121 then go to domain_error_left; 122 123 if ^left_vb -> value_bead.character_value /* Make sure argument is character */ 124 then go to domain_error_left; 125 126 left = left_vb -> value_bead.data_pointer; /* Point to data array */ 127 data_elements = left_vb -> value_bead.total_data_elements; 128 if data_elements > 32 then goto length_error_left; 129 switch_name = left_arg_string; 130 131 call POP_ARGS; 132 133 call iox_$attach_name (switch_name, iocbp, attach_description, null (), code); 134 if code ^= 0 then goto set_code; 135 call get_temp_segment_ ("apl_iox_", apl_iox_temp_seg_ptr_, code); 136 packed_iocbp = iocbp; 137 unspec (integer) = unspec (packed_iocbp); 138 139 /* put result on value stack */ 140 /* Calculate size of result bead. Note that result data array */ 141 /* must be double-word aligned. */ 142 143 number_of_dimensions = 0; /* for attach we return scalar */ 144 data_elements = 1; 145 n_words = size (float_overlay); 146 call ALLOCATE_RESULT ("1"b); 147 148 /* Give result bead the correct type */ 149 150 string (result_vb -> value_bead.type) = integral_value_type; 151 152 /* The result value bead is all set up. Perform the operation */ 153 154 result -> float_overlay = integer; 155 156 operators_argument.result = result_vb; 157 return; 158 159 rank_error_left: 160 operators_argument.where_error = operators_argument.where_error + 2; 161 rank_error_right: 162 operators_argument.where_error = operators_argument.where_error - 1; 163 operators_argument.error_code = apl_error_table_$rank; 164 return; 165 166 domain_error_right: 167 operators_argument.where_error = operators_argument.where_error - 1; /* Mark right operand */ 168 operators_argument.error_code = apl_error_table_$domain; 169 return; 170 171 domain_error_left: 172 operators_argument.where_error = operators_argument.where_error + 1; /* Mark right operand */ 173 operators_argument.error_code = apl_error_table_$domain; 174 return; 175 176 length_error_left: 177 operators_argument.where_error = operators_argument.where_error + 1; /* Mark right operand */ 178 operators_argument.error_code = apl_error_table_$length; 179 return; 180 181 set_code: 182 operators_argument.error_code = code; 183 return; 184 185 open: entry (operators_argument); 186 187 call PICKUP_IOCB; /* right arg is IOCBP */ 188 left_vb = operators_argument.operands (1).value; /* Get ptr to left argument */ 189 if ^left_vb -> value_bead.value /* Make sure argument is a value bead */ 190 then go to domain_error_left; 191 192 if ^left_vb -> value_bead.character_value /* Make sure argument is character */ 193 then go to domain_error_left; 194 195 left = left_vb -> value_bead.data_pointer; /* Point to data array */ 196 data_elements = left_vb -> value_bead.total_data_elements; 197 if data_elements > 24 then goto length_error_left; 198 iox_mode = left_arg_string; 199 200 call POP_ARGS; 201 202 found_mode = ""b; 203 do i = 1 to 13 while (^found_mode); 204 if iox_modes (i) = iox_mode | short_iox_modes (i) = iox_mode then found_mode = "1"b; 205 end; 206 if ^found_mode then goto domain_error_left; 207 call iox_$open (iocbp, i - 1, ""b, code); 208 if code ^= 0 then goto set_code; 209 return; /* no value to return on open */ 210 211 get_line: entry (operators_argument); 212 213 get_line_flag = "1"b; 214 max_size = sys_info$max_seg_size * 4; /* can't get bigger */ 215 get_entry =iox_$get_line; 216 goto GET_COMMON; 217 218 get_chars: 219 entry (operators_argument); 220 221 get_line_flag = ""b; 222 get_entry = iox_$get_chars; 223 left_vb = operators_argument.operands (1).value; /* Get ptr to left argument */ 224 if ^left_vb -> value_bead.value /* Make sure argument is a value bead */ 225 then go to domain_error_left; 226 if ^left_vb -> value_bead.integral_value /*cant read 1/2 char */ 227 then go to domain_error_left; 228 229 left = left_vb -> value_bead.data_pointer; 230 if left_vb -> value_bead.rhorho > 0 then goto rank_error_left; 231 data_elements = left_vb -> value_bead.total_data_elements; 232 max_size = left -> numeric_datum (0); 233 234 GET_COMMON: 235 call PICKUP_IOCB; 236 call POP_ARGS; 237 call get_entry (iocbp, apl_iox_temp_seg_ptr_, max_size, ql, code); 238 239 /****************************************************** 240* * this should take long record into account, but * 241* * i dont see how we could get more thana segment * 242* * of line... * 243* ******************************************************/ 244 245 if code ^= 0 & code ^= error_table_$end_of_info then goto set_code; 246 if code = error_table_$end_of_info then do; 247 number_of_dimensions = 2; /* indicate eof */ 248 data_elements = 0; 249 n_words = 0; 250 call ALLOCATE_RESULT (""b); 251 result_vb -> value_bead.rho (*) = 0; 252 string (result_vb -> value_bead.type) = character_value_type; 253 operators_argument.result = result_vb; 254 return; 255 end; 256 else do; /* normal return, return the line */ 257 if get_line_flag then do; /* clean up after things */ 258 ql = ql - 1; /* dont return the NL */ 259 ql = length (rtrim (line_buffer, "")); 260 end; 261 262 number_of_dimensions = 1; 263 data_elements = ql; 264 n_words = size (character_string_overlay); 265 call ALLOCATE_RESULT (""b); 266 result_vb -> value_bead.rho (1) = ql; 267 string (result_vb -> value_bead.type) = character_value_type; 268 result -> character_string_overlay = substr (line_buffer, 1, ql); 269 operators_argument.result = result_vb; 270 return; 271 end; 272 273 put_chars: 274 entry (operators_argument); 275 276 call PICKUP_IOCB; 277 278 left_vb = operators_argument.operands (1).value; 279 280 if ^left_vb -> value_bead.value 281 then go to domain_error_left; 282 283 if ^left_vb -> value_bead.character_value 284 then go to domain_error_left; 285 286 data_elements = left_vb -> value_bead.total_data_elements; 287 left = left_vb -> value_bead.data_pointer; 288 289 call POP_ARGS; 290 291 if data_elements = 0 292 then return; 293 294 call iox_$put_chars (iocbp, left, data_elements, code); 295 296 /* No result */ 297 298 operators_argument.error_code = code; 299 return; 300 301 close: entry (operators_argument); 302 303 call PICKUP_IOCB; 304 call POP_ARGS; 305 call iox_$close (iocbp, code); 306 if code ^= 0 then goto set_code; 307 return; 308 309 detach_iocb: entry (operators_argument); 310 311 call PICKUP_IOCB; 312 call POP_ARGS; 313 call iox_$detach_iocb (iocbp, code); 314 if code ^= 0 then goto set_code; 315 if apl_iox_temp_seg_ptr_ ^= null() then 316 call release_temp_segment_ ("apl_iox_", apl_iox_temp_seg_ptr_, 317 code); 318 return; 319 320 /* Internal procedures */ 321 322 ALLOCATE_RESULT: 323 proc (maligned); 324 325 326 dcl maligned bit (1); 327 328 n_words = n_words + size (value_bead) + 1; 329 result_vb = apl_push_stack_ (n_words); 330 331 /* Set pointer to data array. */ 332 333 result = addrel (result_vb, size (value_bead)); 334 if maligned then 335 if substr (rel (result), 18, 1) then 336 result = addrel (result, 1); 337 338 /* Initialize new value bead. */ 339 340 result_vb -> value_bead.total_data_elements = data_elements; 341 result_vb -> value_bead.rhorho = number_of_dimensions; 342 result_vb -> value_bead.data_pointer = result; 343 344 end; 345 346 PICKUP_IOCB: proc; 347 right_vb = operators_argument.operands (2).value; /* Get ptr to right argument */ 348 if ^right_vb -> value_bead.value /* Make sure argument is a value bead */ 349 then go to domain_error_right; 350 351 if ^right_vb -> value_bead.integral_value 352 then go to domain_error_right; 353 354 right = right_vb -> value_bead.data_pointer; /* Point to data array */ 355 if right_vb -> rhorho ^= 0 then goto rank_error_right; 356 357 data_elements = right_vb -> value_bead.total_data_elements; 358 359 integer = right -> float_overlay; /* integer */ 360 unspec (packed_iocbp) = unspec (integer); /* ppointer */ 361 iocbp = packed_iocbp; /* whew -- back to pointer */ 362 363 return; 364 end; 365 366 367 POP_ARGS: proc; 368 369 370 /* Pop args off value stack, if necessary. */ 371 372 if operators_argument.operands (2).on_stack 373 then ws_info.value_stack_ptr = right_vb; 374 else if operators_argument.operands (1).on_stack 375 then ws_info.value_stack_ptr = left_vb; 376 return; 377 end; 378 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 ------------------------------- */ 379 380 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/29/83 1558.0 apl_iox_.pl1 >special_ldd>on>apl.1129>apl_iox_.pl1 101 1 05/23/83 0916.6 iox_dcls.incl.pl1 >ldd>include>iox_dcls.incl.pl1 102 2 02/02/78 1229.7 iox_modes.incl.pl1 >ldd>include>iox_modes.incl.pl1 103 3 03/27/82 0438.7 apl_external_function.incl.pl1 >ldd>include>apl_external_function.incl.pl1 3-60 4 03/27/82 0429.8 apl_number_data.incl.pl1 >ldd>include>apl_number_data.incl.pl1 3-61 5 03/27/82 0439.2 apl_ws_info.incl.pl1 >ldd>include>apl_ws_info.incl.pl1 3-62 6 03/27/82 0438.5 apl_bead_format.incl.pl1 >ldd>include>apl_bead_format.incl.pl1 3-63 7 03/27/82 0439.2 apl_value_bead.incl.pl1 >ldd>include>apl_value_bead.incl.pl1 3-64 8 03/27/82 0439.0 apl_operators_argument.incl.pl1 >ldd>include>apl_operators_argument.incl.pl1 379 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 addrel builtin function dcl 86 in procedure "apl_iox_$attach_name" ref 333 334 addrel builtin function dcl 9-25 in procedure "apl_push_stack_" ref 9-44 apl_error_table_$domain 000040 external static fixed bin(35,0) dcl 3-46 ref 168 173 apl_error_table_$length 000042 external static fixed bin(35,0) dcl 3-46 ref 178 apl_error_table_$rank 000044 external static fixed bin(35,0) dcl 3-46 ref 163 apl_get_value_stack_ 000050 constant entry external dcl 9-30 ref 9-40 apl_iox_temp_seg_ptr_ 000014 external static pointer initial dcl 94 set ref 135* 237* 259 268 315 315* apl_static_$ws_info_ptr 000046 external static structure level 1 dcl 5-11 attach_description 000101 automatic char(512) unaligned dcl 58 set ref 117* 133* bead_type based structure level 4 packed unaligned dcl 7-3 binary builtin function dcl 9-25 ref 9-40 block_ptr 000410 automatic pointer dcl 9-20 set ref 9-43* 9-45 character_string_overlay based char dcl 7-19 set ref 264 268* character_value 0(09) based bit(1) level 5 packed unaligned dcl 7-3 set ref 111 123 192 283 character_value_type constant bit(18) initial unaligned dcl 6-30 ref 252 267 code 000100 automatic fixed bin(35,0) dcl 58 set ref 133* 134 135* 181 207* 208 237* 245 245 246 294* 298 305* 306 313* 314 315* data_elements 000352 automatic fixed bin(21,0) dcl 3-8 set ref 115* 117 127* 128 129 144* 196* 197 198 231* 248* 263* 264 264 268 286* 291 294* 340 357* data_pointer 4 based pointer level 2 packed unaligned dcl 7-3 set ref 114 126 195 229 287 342* 354 data_type 0(08) based structure level 4 packed unaligned dcl 7-3 error_code 7 parameter fixed bin(35,0) level 2 dcl 8-3 set ref 163* 168* 173* 178* 181* 298* error_table_$end_of_info 000020 external static fixed bin(35,0) dcl 98 ref 245 246 float_overlay based float bin(63) dcl 81 set ref 145 154* 359 found_mode 000307 automatic bit(1) unaligned dcl 58 set ref 202* 203 204* 206 general_bead based structure level 1 dcl 6-3 get_entry 000346 automatic entry variable dcl 90 set ref 215* 222* 237 get_line_flag 000302 automatic bit(1) unaligned dcl 58 set ref 213* 221* 257 get_temp_segment_ 000010 constant entry external dcl 91 ref 135 header based structure level 2 dcl 7-3 i 000301 automatic fixed bin(17,0) dcl 58 set ref 203* 204 204* 207 integer 000305 automatic fixed bin(35,0) dcl 58 set ref 137* 154 359* 360 integral_value 0(11) based bit(1) level 5 packed unaligned dcl 7-3 set ref 226 351 integral_value_type constant bit(18) initial unaligned dcl 6-30 ref 150 iocbp 000326 automatic pointer dcl 58 set ref 133* 136 207* 237* 294* 305* 313* 361* iox_$attach_name 000022 constant entry external dcl 1-8 ref 133 iox_$close 000024 constant entry external dcl 1-8 ref 305 iox_$detach_iocb 000026 constant entry external dcl 1-8 ref 313 iox_$get_chars 000030 constant entry external dcl 1-8 ref 222 iox_$get_line 000032 constant entry external dcl 1-8 ref 215 iox_$open 000034 constant entry external dcl 1-8 ref 207 iox_$put_chars 000036 constant entry external dcl 1-8 ref 294 iox_mode 000310 automatic char(24) unaligned dcl 58 set ref 198* 204 204 iox_modes 000015 constant char(24) initial array dcl 2-6 ref 204 left 000342 automatic pointer dcl 58 set ref 126* 129 195* 198 229* 232 287* 294* left_arg_string based char unaligned dcl 80 ref 129 198 left_vb 000344 automatic pointer dcl 58 set ref 119* 120 123 126 127 188* 189 192 195 196 223* 224 226 229 230 231 278* 280 283 286 287 374 line_buffer based char unaligned dcl 82 ref 259 268 maligned parameter bit(1) unaligned dcl 326 ref 322 334 max_size 000303 automatic fixed bin(21,0) dcl 58 set ref 214* 232* 237* maximum_value_stack_size 13 based fixed bin(18,0) level 3 dcl 5-16 ref 9-40 n_words 000306 automatic fixed bin(19,0) dcl 58 set ref 145* 249* 264* 328* 328 329* null builtin function dcl 86 ref 133 133 315 num_words 000412 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_dimensions 000356 automatic fixed bin(17,0) dcl 7-3 set ref 143* 247* 262* 328 333 341 numeric_datum based float bin(63) array dcl 7-23 ref 232 on_stack 1 parameter bit(1) array level 3 dcl 8-3 ref 372 374 operands parameter structure array level 2 dcl 8-3 operators_argument parameter structure level 1 dcl 8-3 set ref 53 185 211 218 273 301 309 packed_iocbp 000330 automatic pointer unaligned dcl 58 set ref 136* 137 360* 361 pointers 14 based structure level 2 dcl 5-16 ql 000304 automatic fixed bin(21,0) dcl 58 set ref 237* 258* 258 259* 259 263 266 268 268 rel builtin function dcl 9-25 ref 9-40 release_temp_segment_ 000012 constant entry external dcl 91 ref 315 result 6 parameter pointer level 2 in structure "operators_argument" packed unaligned dcl 8-3 in procedure "apl_iox_$attach_name" set ref 156* 253* 269* result 000332 automatic pointer dcl 58 in procedure "apl_iox_$attach_name" set ref 154 268 333* 334 334* 334 342 result_vb 000334 automatic pointer dcl 58 set ref 150 156 251 252 253 266 267 269 329* 333 340 341 342 rho 5 based fixed bin(21,0) array level 2 dcl 7-3 set ref 251* 266* rhorho 3 based fixed bin(17,0) level 2 dcl 7-3 set ref 230 251 341* 355 right 000336 automatic pointer dcl 58 set ref 114* 117 354* 359 right_arg_string based char unaligned dcl 78 ref 117 right_vb 000340 automatic pointer dcl 58 set ref 107* 108 111 114 115 347* 348 351 354 355 357 372 short_iox_modes 000000 constant char(4) initial array dcl 2-12 ref 204 size builtin function dcl 86 ref 145 264 328 333 static_ws_info_ptr 000046 external static pointer level 2 packed unaligned dcl 5-11 ref 5-7 string builtin function dcl 86 set ref 150* 252* 267* substr builtin function dcl 9-25 ref 9-37 switch_name 000316 automatic char(32) unaligned dcl 58 set ref 129* 133* sys_info$max_seg_size 000016 external static fixed bin(19,0) dcl 95 ref 214 total_data_elements 2 based fixed bin(21,0) level 2 dcl 7-3 set ref 115 127 196 231 286 340* 357 type based structure level 3 packed unaligned dcl 7-3 set ref 150* 252* 267* unspec builtin function dcl 9-25 ref 9-37 value parameter pointer array level 3 in structure "operators_argument" packed unaligned dcl 8-3 in procedure "apl_iox_$attach_name" ref 107 119 188 223 278 347 value 0(02) based bit(1) level 5 in structure "value_bead" packed unaligned dcl 7-3 in procedure "apl_iox_$attach_name" set ref 108 120 189 224 280 348 value_bead based structure level 1 dcl 7-3 set ref 328 333 value_stack_ptr 16 based pointer level 3 packed unaligned dcl 5-16 set ref 372* 374* 9-40 9-43 9-44* 9-44 values 2 based structure level 2 dcl 5-16 where_error 10 parameter fixed bin(17,0) level 2 dcl 8-3 set ref 159* 159 161* 161 166* 166 171* 171 176* 176 ws_info based structure level 1 dcl 5-16 ws_info_ptr 000354 automatic pointer initial dcl 5-7 set ref 5-7* 372 374 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 4-16 Direct_input internal static fixed bin(17,0) initial dcl 2-15 Direct_output internal static fixed bin(17,0) initial dcl 2-15 Direct_update internal static fixed bin(17,0) initial dcl 2-15 Keyed_sequential_input internal static fixed bin(17,0) initial dcl 2-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 2-15 Keyed_sequential_update internal static fixed bin(17,0) initial dcl 2-15 MAX_VALUE_BEAD_SIZE internal static fixed bin(19,0) initial dcl 7-28 NumberSize internal static fixed bin(4,0) initial dcl 4-25 Sequential_input internal static fixed bin(17,0) initial dcl 2-15 Sequential_input_output internal static fixed bin(17,0) initial dcl 2-15 Sequential_output internal static fixed bin(17,0) initial dcl 2-15 Sequential_update internal static fixed bin(17,0) initial dcl 2-15 Stream_input internal static fixed bin(17,0) initial dcl 2-15 Stream_input_output internal static fixed bin(17,0) initial dcl 2-15 Stream_output internal static fixed bin(17,0) initial dcl 2-15 TheBiggestNumberWeveGot internal static float bin(63) initial dcl 4-16 TheSmallestNumberWeveGot internal static float bin(63) initial dcl 4-16 apl_allocate_words_ 000000 constant entry external dcl 3-12 apl_error_table_$cant_load_ws external static fixed bin(35,0) dcl 3-46 apl_error_table_$function external static fixed bin(35,0) dcl 3-46 apl_error_table_$index external static fixed bin(35,0) dcl 3-46 apl_error_table_$no_type_bits external static fixed bin(35,0) dcl 3-46 apl_error_table_$off_hold external static fixed bin(35,0) dcl 3-46 apl_error_table_$result_size external static fixed bin(35,0) dcl 3-46 apl_error_table_$system_error external static fixed bin(35,0) dcl 3-46 apl_free_bead_ 000000 constant entry external dcl 3-21 apl_free_words_ 000000 constant entry external dcl 3-17 apl_get_value_stack_ 000000 constant entry external dcl 3-25 apl_subsystem_ 000000 constant entry external dcl 3-29 apl_system_error_ 000000 constant entry external dcl 3-40 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 6-30 divide builtin function dcl 86 function_type internal static bit(18) initial unaligned dcl 6-30 group_type internal static bit(18) initial unaligned dcl 6-30 iox_$attach_loud 000000 constant entry external dcl 1-8 iox_$attach_ptr 000000 constant entry external dcl 1-8 iox_$close_file 000000 constant entry external dcl 1-8 iox_$control 000000 constant entry external dcl 1-8 iox_$delete_record 000000 constant entry external dcl 1-8 iox_$destroy_iocb 000000 constant entry external dcl 1-8 iox_$detach 000000 constant entry external dcl 1-8 iox_$err_no_operation 000000 constant entry external dcl 1-8 iox_$err_not_attached 000000 constant entry external dcl 1-8 iox_$err_not_closed 000000 constant entry external dcl 1-8 iox_$err_not_open 000000 constant entry external dcl 1-8 iox_$error_output external static pointer dcl 1-41 iox_$find_iocb 000000 constant entry external dcl 1-8 iox_$find_iocb_n 000000 constant entry external dcl 1-8 iox_$look_iocb 000000 constant entry external dcl 1-8 iox_$modes 000000 constant entry external dcl 1-8 iox_$move_attach 000000 constant entry external dcl 1-8 iox_$open_file 000000 constant entry external dcl 1-8 iox_$position 000000 constant entry external dcl 1-8 iox_$propagate 000000 constant entry external dcl 1-8 iox_$read_key 000000 constant entry external dcl 1-8 iox_$read_length 000000 constant entry external dcl 1-8 iox_$read_record 000000 constant entry external dcl 1-8 iox_$rewrite_record 000000 constant entry external dcl 1-8 iox_$seek_key 000000 constant entry external dcl 1-8 iox_$user_input external static pointer dcl 1-41 iox_$user_io external static pointer dcl 1-41 iox_$user_output external static pointer dcl 1-41 iox_$write_record 000000 constant entry external dcl 1-8 label_type internal static bit(18) initial unaligned dcl 6-30 lexed_function_type internal static bit(18) initial unaligned dcl 6-30 list_value_type internal static bit(18) initial unaligned dcl 6-30 max_parse_stack_depth internal static fixed bin(17,0) initial dcl 5-98 not_integer_mask internal static bit(18) initial unaligned dcl 6-30 not_zero_or_one_mask internal static bit(18) initial unaligned dcl 6-30 numeric_value_type internal static bit(18) initial unaligned dcl 6-30 operator_type internal static bit(18) initial unaligned dcl 6-30 output_buffer based char unaligned dcl 5-94 right_arg_integer based fixed bin(35,0) dcl 79 shared_variable_type internal static bit(18) initial unaligned dcl 6-30 symbol_type internal static bit(18) initial unaligned dcl 6-30 value_type internal static bit(18) initial unaligned dcl 6-30 zero_or_one_value_type internal static bit(18) initial unaligned dcl 6-30 NAMES DECLARED BY EXPLICIT CONTEXT. ALLOCATE_RESULT 001144 constant entry internal dcl 322 ref 146 250 265 GET_COMMON 000630 constant label dcl 234 ref 216 PICKUP_IOCB 001205 constant entry internal dcl 346 ref 187 234 276 303 311 POP_ARGS 001236 constant entry internal dcl 367 ref 131 200 236 289 304 312 apl_iox_$attach_name 000204 constant entry external dcl 53 apl_push_stack_ 001257 constant entry internal dcl 9-4 ref 329 close 001043 constant entry external dcl 301 detach_iocb 001071 constant entry external dcl 309 domain_error_left 000410 constant label dcl 171 ref 120 123 189 192 206 224 226 280 283 domain_error_right 000400 constant label dcl 166 ref 108 111 348 351 get_chars 000572 constant entry external dcl 218 get_line 000547 constant entry external dcl 211 length_error_left 000417 constant label dcl 176 ref 128 197 open 000435 constant entry external dcl 185 put_chars 000770 constant entry external dcl 273 rank_error_left 000364 constant label dcl 159 ref 230 rank_error_right 000370 constant label dcl 161 ref 355 set_code 000426 constant label dcl 181 ref 134 208 245 306 314 NAMES DECLARED BY CONTEXT OR IMPLICATION. length builtin function ref 259 rel builtin function ref 334 rtrim builtin function ref 259 substr builtin function ref 268 334 unspec builtin function set ref 137 137 360* 360 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1624 1676 1342 1634 Length 2300 1342 52 366 262 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME apl_iox_$attach_name 302 external procedure is an external procedure. ALLOCATE_RESULT internal procedure shares stack frame of external procedure apl_iox_$attach_name. PICKUP_IOCB internal procedure shares stack frame of external procedure apl_iox_$attach_name. POP_ARGS internal procedure shares stack frame of external procedure apl_iox_$attach_name. apl_push_stack_ internal procedure shares stack frame of external procedure apl_iox_$attach_name. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apl_iox_$attach_name 000100 code apl_iox_$attach_name 000101 attach_description apl_iox_$attach_name 000301 i apl_iox_$attach_name 000302 get_line_flag apl_iox_$attach_name 000303 max_size apl_iox_$attach_name 000304 ql apl_iox_$attach_name 000305 integer apl_iox_$attach_name 000306 n_words apl_iox_$attach_name 000307 found_mode apl_iox_$attach_name 000310 iox_mode apl_iox_$attach_name 000316 switch_name apl_iox_$attach_name 000326 iocbp apl_iox_$attach_name 000330 packed_iocbp apl_iox_$attach_name 000332 result apl_iox_$attach_name 000334 result_vb apl_iox_$attach_name 000336 right apl_iox_$attach_name 000340 right_vb apl_iox_$attach_name 000342 left apl_iox_$attach_name 000344 left_vb apl_iox_$attach_name 000346 get_entry apl_iox_$attach_name 000352 data_elements apl_iox_$attach_name 000354 ws_info_ptr apl_iox_$attach_name 000356 number_of_dimensions apl_iox_$attach_name 000410 block_ptr apl_push_stack_ 000412 num_words apl_push_stack_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 call_var call_ext_out_desc call_ext_out return fl2_to_fx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. apl_get_value_stack_ get_temp_segment_ iox_$attach_name iox_$close iox_$detach_iocb iox_$get_chars iox_$get_line iox_$open iox_$put_chars release_temp_segment_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. apl_error_table_$domain apl_error_table_$length apl_error_table_$rank apl_iox_temp_seg_ptr_ apl_static_$ws_info_ptr error_table_$end_of_info sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 5 7 000174 53 000201 107 000212 108 000216 111 000221 114 000224 115 000226 117 000230 119 000233 120 000235 123 000240 126 000243 127 000245 128 000247 129 000251 131 000254 133 000255 134 000307 135 000311 136 000334 137 000336 143 000340 144 000341 145 000343 146 000345 150 000351 154 000354 156 000357 157 000363 159 000364 161 000370 163 000374 164 000377 166 000400 168 000404 169 000407 171 000410 173 000413 174 000416 176 000417 178 000422 179 000425 181 000426 183 000432 185 000433 187 000443 188 000444 189 000447 192 000452 195 000455 196 000457 197 000461 198 000463 200 000466 202 000467 203 000470 204 000477 205 000515 206 000517 207 000521 208 000542 209 000544 211 000545 213 000555 214 000557 215 000563 216 000567 218 000570 221 000600 222 000601 223 000606 224 000611 226 000614 229 000617 230 000621 231 000623 232 000625 234 000630 236 000631 237 000632 245 000651 246 000656 247 000661 248 000663 249 000664 250 000665 251 000671 252 000703 253 000705 254 000710 257 000711 258 000713 259 000715 262 000731 263 000733 264 000735 265 000740 266 000744 267 000747 268 000751 269 000762 270 000765 273 000766 276 000776 278 000777 280 001002 283 001005 286 001010 287 001012 289 001014 291 001015 294 001017 298 001034 299 001040 301 001041 303 001051 304 001052 305 001053 306 001064 307 001066 309 001067 311 001077 312 001100 313 001101 314 001112 315 001114 318 001143 322 001144 328 001146 329 001153 333 001155 334 001162 340 001176 341 001201 342 001203 344 001204 346 001205 347 001206 348 001212 351 001215 354 001220 355 001222 357 001224 359 001226 360 001231 361 001233 363 001235 367 001236 372 001237 374 001250 376 001256 9 4 001257 9 35 001261 9 37 001263 9 40 001270 9 43 001305 9 44 001310 9 45 001317 ----------------------------------------------------------- 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