COMPILATION LISTING OF SEGMENT check_short_strings Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1540.3 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* Check the alignment attribute of all short string parameters in the called 12* and calling program and insure that the attributes match. This is done 13* only if the argument is a member of a structure and starts on a word 14* boundary. This tool only checks programs for some cases of invalid PL/I 15* that happened to work before PL/I Release 26, but will no longer work 16* starting with PL/I Release 26. 17* 18* Written 2 June 1980 by PCK. 19* Modified 16 June 1980 by M. N. Davidoff to invoke the compiler. 20* Modified 7 July 1980 by M. N. Davidoff to check if get_entry_arg_descs_ returns a zero code and null pointers. 21* Modified 9 July 1980 by M. N. Davidoff to add ALLOW_EXL. 22**/ 23 /* format: style3 */ 24 check_short_strings: 25 procedure options (variable); 26 27 /* automatic */ 28 29 dcl arg_count fixed bin; 30 dcl arg_length fixed bin (21); 31 dcl arg_ptr ptr; 32 dcl argument_no fixed bin; 33 dcl argx fixed bin; 34 dcl 1 auto_area_info aligned like area_info; 35 dcl code fixed bin (35); 36 dcl source_dname char (168); 37 dcl source_ename char (32); 38 39 /* based */ 40 41 dcl arg_string char (arg_length) based (arg_ptr); 42 43 /* builtin */ 44 45 dcl (after, addr, before, codeptr, hbound, index, mod, null, reverse, rtrim, unspec) 46 builtin; 47 48 /* condition */ 49 50 dcl cleanup condition; 51 52 /* internal static */ 53 54 dcl ALLOW_EXL bit (1) aligned internal static options (constant) initial ("0"b); 55 dcl command char (19) internal static options (constant) initial ("check_short_strings"); 56 57 /* external static */ 58 59 dcl error_table_$badopt fixed bin (35) external static; 60 dcl pl1$pl1_release char (3) varying external static; 61 dcl pl1_stat_$root ptr external static; 62 dcl sys_info$max_seg_size 63 fixed bin (19) external static; 64 65 /* entry */ 66 67 dcl change_wdir_ entry (char (168) aligned, fixed bin (35)); 68 dcl com_err_ entry options (variable); 69 dcl com_err_$suppress_name 70 entry options (variable); 71 dcl cu_$arg_count entry (fixed bin); 72 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 73 dcl define_area_ entry (ptr, fixed bin (35)); 74 dcl delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35)); 75 dcl expand_pathname_$add_suffix 76 entry (char (*), char (*), char (*), char (*), fixed bin (35)); 77 dcl get_entry_arg_descs_ 78 entry (ptr, fixed bin, (*) ptr, fixed bin (35)); 79 dcl get_pdir_ entry () returns (char (168)); 80 dcl get_wdir_ entry () returns (char (168)); 81 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 82 dcl ioa_ entry options (variable); 83 dcl pl1 entry options (variable); 84 dcl pl1$clean_up entry options (variable); 85 dcl release_area_ entry (ptr); 86 1 1 /* BEGIN INCLUDE FILE ... block.incl.pl1 */ 1 2 /* Modified 22 Ocober 1980 by M. N. Davidoff to increase max block.number to 511 */ 1 3 /* format: style3,idind30 */ 1 4 1 5 declare 1 block aligned based, 1 6 2 node_type bit (9) unaligned, 1 7 2 source_id structure unaligned, 1 8 3 file_number bit (8), 1 9 3 line_number bit (14), 1 10 3 statement_number bit (5), 1 11 2 father ptr unaligned, 1 12 2 brother ptr unaligned, 1 13 2 son ptr unaligned, 1 14 2 declaration ptr unaligned, 1 15 2 end_declaration ptr unaligned, 1 16 2 default ptr unaligned, 1 17 2 end_default ptr unaligned, 1 18 2 context ptr unaligned, 1 19 2 prologue ptr unaligned, 1 20 2 end_prologue ptr unaligned, 1 21 2 main ptr unaligned, 1 22 2 end_main ptr unaligned, 1 23 2 return_values ptr unaligned, 1 24 2 return_count ptr unaligned, 1 25 2 plio_ps ptr unaligned, 1 26 2 plio_fa ptr unaligned, 1 27 2 plio_ffsb ptr unaligned, 1 28 2 plio_ssl ptr unaligned, 1 29 2 plio_fab2 ptr unaligned, 1 30 2 block_type bit (9) unaligned, 1 31 2 prefix bit (12) unaligned, 1 32 2 like_attribute bit (1) unaligned, 1 33 2 no_stack bit (1) unaligned, 1 34 2 get_data bit (1) unaligned, 1 35 2 flush_at_call bit (1) unaligned, 1 36 2 processed bit (1) unaligned, 1 37 2 text_displayed bit (1) unaligned, 1 38 2 number fixed bin (9) unsigned unaligned, 1 39 2 free_temps dimension (3) ptr, /* these fields are used by the code generator */ 1 40 2 temp_list ptr, 1 41 2 entry_list ptr, 1 42 2 o_and_s ptr, 1 43 2 why_nonquick aligned, 1 44 3 auto_adjustable_storage bit (1) unaligned, 1 45 3 returns_star_extents bit (1) unaligned, 1 46 3 stack_extended_by_args bit (1) unaligned, 1 47 3 invoked_by_format bit (1) unaligned, 1 48 3 format_statement bit (1) unaligned, 1 49 3 io_statements bit (1) unaligned, 1 50 3 assigned_to_entry_var bit (1) unaligned, 1 51 3 condition_statements bit (1) unaligned, 1 52 3 no_owner bit (1) unaligned, 1 53 3 recursive_call bit (1) unaligned, 1 54 3 options_non_quick bit (1) unaligned, 1 55 3 options_variable bit (1) unaligned, 1 56 3 never_referenced bit (1) unaligned, 1 57 3 pad_nonquick bit (5) unaligned, 1 58 2 prologue_flag bit (1) unaligned, 1 59 2 options_main bit (1) unaligned, 1 60 2 pad bit (16) unaligned, 1 61 2 number_of_entries fixed bin (17), 1 62 2 level fixed bin (17), 1 63 2 last_auto_loc fixed bin (17), 1 64 2 symbol_block fixed bin (17), 1 65 2 entry_info fixed bin (18), 1 66 2 enter structure unaligned, 1 67 3 start fixed bin (17), 1 68 3 end fixed bin (17), 1 69 2 leave structure unaligned, 1 70 3 start fixed bin (17), 1 71 3 end fixed bin (17), 1 72 2 owner ptr; 1 73 1 74 declare max_block_number fixed bin internal static options (constant) initial (511); 1 75 1 76 /* END INCLUDE FILE ... block.incl.pl1 */ 87 2 1 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 2 2 2 3 dcl 1 statement based aligned, 2 4 2 node_type bit(9) unaligned, 2 5 2 source_id structure unaligned, 2 6 3 file_number bit(8), 2 7 3 line_number bit(14), 2 8 3 statement_number bit(5), 2 9 2 next ptr unaligned, 2 10 2 back ptr unaligned, 2 11 2 root ptr unaligned, 2 12 2 labels ptr unaligned, 2 13 2 reference_list ptr unaligned, 2 14 2 state_list ptr unaligned, 2 15 2 reference_count fixed(17) unaligned, 2 16 2 ref_count_copy fixed(17) unaligned, 2 17 2 object structure unaligned, 2 18 3 start fixed(17), 2 19 3 finish fixed(17), 2 20 2 source structure unaligned, 2 21 3 segment fixed(11), 2 22 3 start fixed(23), 2 23 3 length fixed(11), 2 24 2 prefix bit(12) unaligned, 2 25 2 optimized bit(1) unaligned, 2 26 2 free_temps bit(1) unaligned, 2 27 2 LHS_in_RHS bit(1) unaligned, 2 28 2 statement_type bit(9) unaligned, 2 29 2 bits structure unaligned, 2 30 3 processed bit(1) unaligned, 2 31 3 put_in_profile bit(1) unaligned, 2 32 3 generated bit(1) unaligned, 2 33 3 snap bit(1) unaligned, 2 34 3 system bit(1) unaligned, 2 35 3 irreducible bit(1) unaligned, 2 36 3 checked bit(1) unaligned, 2 37 3 save_temps bit(1) unaligned, 2 38 3 suppress_warnings bit(1) unaligned, 2 39 3 force_nonquick bit(1) unaligned, 2 40 3 expanded_by_name bit(1) unaligned, 2 41 3 pad bit(25) unaligned; 2 42 2 43 /* END INCLUDE FILE ... statement.incl.pl1 */ 88 3 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 3 2 3 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 3 4 3 5 /* format: style3 */ 3 6 dcl 1 operator based aligned, 3 7 2 node_type bit (9) unaligned, 3 8 2 op_code bit (9) unaligned, 3 9 2 shared bit (1) unaligned, 3 10 2 processed bit (1) unaligned, 3 11 2 optimized bit (1) unaligned, 3 12 2 number fixed (14) unaligned, 3 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 3 14 3 15 dcl max_number_of_operands 3 16 fixed bin (15) int static options (constant) initial (32767); 3 17 3 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 89 4 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 4 2 4 3 dcl 1 reference based aligned, 4 4 2 node_type bit(9) unaligned, 4 5 2 array_ref bit(1) unaligned, 4 6 2 varying_ref bit(1) unaligned, 4 7 2 shared bit(1) unaligned, 4 8 2 put_data_sw bit(1) unaligned, 4 9 2 processed bit(1) unaligned, 4 10 2 units fixed(3) unaligned, 4 11 2 ref_count fixed(17) unaligned, 4 12 2 c_offset fixed(24), 4 13 2 c_length fixed(24), 4 14 2 symbol ptr unaligned, 4 15 2 qualifier ptr unaligned, 4 16 2 offset ptr unaligned, 4 17 2 length ptr unaligned, 4 18 2 subscript_list ptr unaligned, 4 19 /* these fields are used by the 645 code generator */ 4 20 2 address structure unaligned, 4 21 3 base bit(3), 4 22 3 offset bit(15), 4 23 3 op bit(9), 4 24 3 no_address bit(1), 4 25 3 inhibit bit(1), 4 26 3 ext_base bit(1), 4 27 3 tag bit(6), 4 28 2 info structure unaligned, 4 29 3 address_in structure, 4 30 4 b dimension(0:7) bit(1), 4 31 4 storage bit(1), 4 32 3 value_in structure, 4 33 4 a bit(1), 4 34 4 q bit(1), 4 35 4 aq bit(1), 4 36 4 string_aq bit(1), 4 37 4 complex_aq bit(1), 4 38 4 decimal_aq bit(1), 4 39 4 b dimension(0:7) bit(1), 4 40 4 storage bit(1), 4 41 4 indicators bit(1), 4 42 4 x dimension(0:7) bit(1), 4 43 3 other structure, 4 44 4 big_offset bit(1), 4 45 4 big_length bit(1), 4 46 4 modword_in_offset bit(1), 4 47 2 data_type fixed(5) unaligned, 4 48 2 bits structure unaligned, 4 49 3 padded_ref bit(1), 4 50 3 aligned_ref bit(1), 4 51 3 long_ref bit(1), 4 52 3 forward_ref bit(1), 4 53 3 ic_ref bit(1), 4 54 3 temp_ref bit(1), 4 55 3 defined_ref bit(1), 4 56 3 evaluated bit(1), 4 57 3 allocate bit(1), 4 58 3 allocated bit(1), 4 59 3 aliasable bit(1), 4 60 3 even bit(1), 4 61 3 perm_address bit(1), 4 62 3 aggregate bit(1), 4 63 3 hit_zero bit(1), 4 64 3 dont_save bit(1), 4 65 3 fo_in_qual bit(1), 4 66 3 hard_to_load bit(1), 4 67 2 relocation bit(12) unaligned, 4 68 2 more_bits structure unaligned, 4 69 3 substr bit(1), 4 70 3 padded_for_store_ref bit(1), 4 71 3 aligned_for_store_ref bit(1), 4 72 3 mbz bit(15), 4 73 2 store_ins bit(18) unaligned; 4 74 4 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 90 5 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 5 2 5 3 dcl 1 symbol based aligned, 5 4 2 node_type bit(9) unal, 5 5 2 source_id structure unal, 5 6 3 file_number bit(8), 5 7 3 line_number bit(14), 5 8 3 statement_number bit(5), 5 9 2 location fixed(18) unal unsigned, 5 10 2 allocated bit(1) unal, 5 11 2 dcl_type bit(3) unal, 5 12 2 reserved bit(6) unal, 5 13 2 pix unal, 5 14 3 pic_fixed bit(1) unal, 5 15 3 pic_float bit(1) unal, 5 16 3 pic_char bit(1) unal, 5 17 3 pic_scale fixed(7) unal, 5 18 3 pic_size fixed(7) unal, 5 19 2 level fixed(8) unal, 5 20 2 boundary fixed(3) unal, 5 21 2 size_units fixed(3) unal, 5 22 2 scale fixed(7) unal, 5 23 2 runtime bit(18) unal, 5 24 2 runtime_offset bit(18) unal, 5 25 2 block_node ptr unal, 5 26 2 token ptr unal, 5 27 2 next ptr unal, 5 28 2 multi_use ptr unal, 5 29 2 cross_references ptr unal, 5 30 2 initial ptr unal, 5 31 2 array ptr unal, 5 32 2 descriptor ptr unal, 5 33 2 equivalence ptr unal, 5 34 2 reference ptr unal, 5 35 2 general ptr unal, 5 36 2 father ptr unal, 5 37 2 brother ptr unal, 5 38 2 son ptr unal, 5 39 2 word_size ptr unal, 5 40 2 bit_size ptr unal, 5 41 2 dcl_size ptr unal, 5 42 2 symtab_size ptr unal, 5 43 2 c_word_size fixed(24), 5 44 2 c_bit_size fixed(24), 5 45 2 c_dcl_size fixed(24), 5 46 5 47 2 attributes structure aligned, 5 48 3 data_type structure unal, 5 49 4 structure bit(1) , 5 50 4 fixed bit(1), 5 51 4 float bit(1), 5 52 4 bit bit(1), 5 53 4 char bit(1), 5 54 4 ptr bit(1), 5 55 4 offset bit(1), 5 56 4 area bit(1), 5 57 4 label bit(1), 5 58 4 entry bit(1), 5 59 4 file bit(1), 5 60 4 arg_descriptor bit(1), 5 61 4 storage_block bit(1), 5 62 4 unused_1 bit(1), 5 63 4 condition bit(1), 5 64 4 format bit(1), 5 65 4 builtin bit(1), 5 66 4 generic bit(1), 5 67 4 picture bit(1), 5 68 5 69 3 misc_attributes structure unal, 5 70 4 dimensioned bit(1), 5 71 4 initialed bit(1), 5 72 4 aligned bit(1), 5 73 4 unaligned bit(1), 5 74 4 signed bit(1), 5 75 4 unsigned bit(1), 5 76 4 precision bit(1), 5 77 4 varying bit(1), 5 78 4 local bit(1), 5 79 4 decimal bit(1), 5 80 4 binary bit(1), 5 81 4 real bit(1), 5 82 4 complex bit(1), 5 83 4 variable bit(1), 5 84 4 reducible bit(1), 5 85 4 irreducible bit(1), 5 86 4 returns bit(1), 5 87 4 position bit(1), 5 88 4 internal bit(1), 5 89 4 external bit(1), 5 90 4 like bit(1), 5 91 4 member bit(1), 5 92 4 non_varying bit(1), 5 93 4 options bit(1), 5 94 4 variable_arg_list bit(1), /* options(variable) */ 5 95 4 alloc_in_text bit(1), /* options(constant) */ 5 96 5 97 3 storage_class structure unal, 5 98 4 auto bit(1), 5 99 4 based bit(1), 5 100 4 static bit(1), 5 101 4 controlled bit(1), 5 102 4 defined bit(1), 5 103 4 parameter bit(1), 5 104 4 param_desc bit(1), 5 105 4 constant bit(1), 5 106 4 temporary bit(1), 5 107 4 return_value bit(1), 5 108 5 109 3 file_attributes structure unal, 5 110 4 print bit(1), 5 111 4 input bit(1), 5 112 4 output bit(1), 5 113 4 update bit(1), 5 114 4 stream bit(1), 5 115 4 reserved_1 bit(1), 5 116 4 record bit(1), 5 117 4 sequential bit(1), 5 118 4 direct bit(1), 5 119 4 interactive bit(1), /* env(interactive) */ 5 120 4 reserved_2 bit(1), 5 121 4 reserved_3 bit(1), 5 122 4 stringvalue bit(1), /* env(stringvalue) */ 5 123 4 keyed bit(1), 5 124 4 reserved_4 bit(1), 5 125 4 environment bit(1), 5 126 5 127 3 compiler_developed structure unal, 5 128 4 aliasable bit(1), 5 129 4 packed bit(1), 5 130 4 passed_as_arg bit(1), 5 131 4 allocate bit(1), 5 132 4 set bit(1), 5 133 4 exp_extents bit(1), 5 134 4 refer_extents bit(1), 5 135 4 star_extents bit(1), 5 136 4 isub bit(1), 5 137 4 put_in_symtab bit(1), 5 138 4 contiguous bit(1), 5 139 4 put_data bit(1), 5 140 4 overlayed bit(1), 5 141 4 error bit(1), 5 142 4 symtab_processed bit(1), 5 143 4 overlayed_by_builtin bit(1), 5 144 4 defaulted bit(1), 5 145 4 connected bit(1); 5 146 5 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 91 6 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 6 2 6 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 6 4 6 5 dcl ( block_node initial("000000001"b), 6 6 statement_node initial("000000010"b), 6 7 operator_node initial("000000011"b), 6 8 reference_node initial("000000100"b), 6 9 token_node initial("000000101"b), 6 10 symbol_node initial("000000110"b), 6 11 context_node initial("000000111"b), 6 12 array_node initial("000001000"b), 6 13 bound_node initial("000001001"b), 6 14 format_value_node initial("000001010"b), 6 15 list_node initial("000001011"b), 6 16 default_node initial("000001100"b), 6 17 machine_state_node initial("000001101"b), 6 18 source_node initial("000001110"b), 6 19 label_node initial("000001111"b), 6 20 cross_reference_node initial("000010000"b), 6 21 sf_par_node initial("000010001"b), 6 22 temporary_node initial("000010010"b), 6 23 label_array_element_node initial("000010011"b), 6 24 by_name_agg_node initial("000010100"b)) 6 25 bit(9) internal static aligned options(constant); 6 26 6 27 dcl 1 node based aligned, 6 28 2 type unal bit(9), 6 29 2 source_id unal structure, 6 30 3 file_number bit(8), 6 31 3 line_number bit(14), 6 32 3 statement_number bit(5); 6 33 6 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 92 7 1 /* BEGIN INCLUDE FILE ... token.incl.pl1 */ 7 2 7 3 dcl 1 token based aligned, 7 4 2 node_type bit(9) unaligned, 7 5 2 type bit(9) unaligned, 7 6 2 loc bit(18) unaligned, /* symtab offset for identifiers, "p" flag for constants */ 7 7 2 declaration ptr unaligned, 7 8 2 next ptr unaligned, 7 9 2 size fixed(9), 7 10 2 string char(n refer(token.size)); 7 11 7 12 /* END INCLUDE FILE ... token.incl.pl1 */ 93 8 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 8 2 8 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 8 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 8 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 8 6 8 7 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 8 8 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 8 9 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 8 10 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 8 11 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 8 12 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 8 13 8 14 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 8 15 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 8 16 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 8 17 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 8 18 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 8 19 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 8 20 8 21 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 8 22 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 8 23 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 8 24 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 8 25 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 8 26 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 8 27 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 8 28 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 8 29 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 8 30 8 31 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 8 32 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 8 33 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 8 34 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 8 35 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 8 36 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 8 37 8 38 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 8 39 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 8 40 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 8 41 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 8 42 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 8 43 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 8 44 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 8 45 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 8 46 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 8 47 8 48 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 8 49 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 8 50 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 8 51 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 8 52 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 8 53 return_string initial("001100110"b), /* return string opnd(1) */ 8 54 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 8 55 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 8 56 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 8 57 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 8 58 std_return initial("001101011"b), /* return -no arguments- */ 8 59 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 8 60 free_ctl initial("001101101"b), /* free opnd(1) */ 8 61 stop initial("001101110"b), /* stop - terminate run unit */ 8 62 8 63 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 8 64* opnd(2) <- opnd(3) / 36 */ 8 65 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 8 66* opnd(2) <- opnd(3) / 4 */ 8 67 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 8 68* opnd(2) <- opnd(3) / 2 */ 8 69 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 8 70 8 71 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 8 72 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 8 73 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 8 74 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 8 75 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 8 76 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 8 77 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 8 78 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 8 79 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 8 80 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 8 81 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 8 82 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 8 83 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 8 84 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 8 85 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 8 86 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 8 87 8 88 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 8 89 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 8 90 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 8 91 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 8 92 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 8 93 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 8 94 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 8 95 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 8 96 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 8 97 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 8 98 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 8 99 8 100 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 8 101 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 8 102 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 8 103 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 8 104 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 8 105 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 8 106 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 8 107 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 8 108 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 8 109 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 8 110 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 8 111 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 8 112 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 8 113 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 8 114 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 8 115 8 116 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 8 117 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 8 118 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 8 119 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 8 120 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 8 121 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 8 122 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 8 123 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 8 124 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 8 125 8 126 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 8 127 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 8 128 8 129 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 8 130 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 8 131 enable_on initial("011010100"b), /* opnd(1) is the cond name 8 132* opnd(2) is the file name 8 133* opnd(3) is the block */ 8 134 revert_on initial("011010101"b), /* opnd(1) is the cond name, 8 135* opnd(2) is the file name */ 8 136 signal_on initial("011010110"b), /* opnd(1) is the cond name 8 137* opnd(2) is the file name */ 8 138 8 139 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 8 140 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 8 141* opnd(3) is old value, (4) is new value. */ 8 142 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 8 143 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 8 144 8 145 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 8 146 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 8 147 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 8 148* opnd(5) is the list */ 8 149 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 8 150 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 8 151 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 8 152 8 153 r_parn initial("011110001"b), /* format op code */ 8 154 l_parn initial("011110010"b), 8 155 r_format initial("011110011"b), 8 156 c_format initial("011110100"b), 8 157 f_format initial("011110101"b), 8 158 e_format initial("011110110"b), 8 159 b_format initial("011110111"b), 8 160 a_format initial("011111000"b), 8 161 x_format initial("011111001"b), 8 162 skip_format initial("011111010"b), 8 163 column_format initial("011111011"b), 8 164 page_format initial("011111100"b), 8 165 line_format initial("011111101"b), 8 166 picture_format initial("011111110"b), 8 167 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 8 168 8 169 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 8 170 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 8 171 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 8 172 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 8 173 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 8 174 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 8 175 terminate_trans initial("100000110"b), /* terminate stream transmission */ 8 176 stream_prep initial("100000111"b), /* initiate stream transmission */ 8 177 record_io initial("100001000"b), /* perform record io operation */ 8 178 fortran_read initial("100001001"b), /* A complete read statement */ 8 179 fortran_write initial("100001010"b), /* A complete write statement */ 8 180 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 8 181 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 8 182 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 8 183 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 8 184 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 8 185 8 186 /* These operators are produced by the parse but are not used as input to the code generator. */ 8 187 /* They are processed by the semantic translator. */ 8 188 8 189 return_value initial("100010010"b), /* return(opnd(1)) */ 8 190 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 8 191 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 8 192 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 8 193 /* opnd(3) is skip, opnd(4) is list */ 8 194 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 8 195 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 8 196 /* opnd(3) is skip,opnd(4) is line */ 8 197 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 8 198 open_file initial("100011001"b), 8 199 close_file initial("100011010"b), 8 200 read_file initial("100011011"b), 8 201 write_file initial("100011100"b), 8 202 locate_file initial("100011101"b), 8 203 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 8 204 /* opnd(2) is control variable ref */ 8 205 /* opnd(3) is specification operator */ 8 206 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 8 207 /* repeat opnd(4) while opnd(5) */ 8 208 /* opnd(6) is next specification */ 8 209 8 210 rewrite_file initial("100100000"b), 8 211 delete_file initial("100100001"b), 8 212 unlock_file initial("100100010"b), 8 213 lock_file initial("100100011"b), 8 214 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 8 215 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 8 216 nop initial("100100111"b), /* no-op */ 8 217 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 8 218 8 219 /* These operators are produced by the semantic translator in processing the math 8 220* builtin functions and are used as input to the code generator */ 8 221 8 222 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 8 223 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 8 224 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 8 225 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 8 226 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 8 227 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 8 228 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 8 229 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 8 230 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 8 231 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 8 232 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 8 233 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 8 234 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 8 235 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 8 236 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 8 237 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 8 238 8 239 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 8 240 8 241 bit(9) aligned internal static options(constant); 8 242 8 243 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 94 9 1 /* BEGIN INCLUDE FILE ... list.incl.pl1 */ 9 2 9 3 /* Modified 26 June 81 by EBush to add max_list_elements */ 9 4 9 5 9 6 dcl 1 list based aligned, 9 7 2 node_type bit(9) unaligned, 9 8 2 reserved bit(12) unaligned, 9 9 2 number fixed(14) unaligned, 9 10 2 element dimension(n refer(list.number)) ptr unaligned; 9 11 9 12 dcl max_list_elements fixed bin(17) internal static options (constant) 9 13 init(16383); 9 14 9 15 /* END INCLUDE FILE ... list.incl.pl1 */ 95 10 1 /* BEGIN INCLUDE FILE ... cgsystem.incl.pl1 */ 10 2 10 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 10 4 10 5 dcl ( bits_per_char init(9), 10 6 bits_per_half init(18), 10 7 bits_per_word init(36), 10 8 bits_per_two_words init(72), 10 9 bits_per_four_words init(144), 10 10 bits_per_words(2) init(36,72), 10 11 packed_digits_per_char init(2), 10 12 chars_per_word init(4), 10 13 packed_digits_per_word init(8), 10 14 10 15 break_even_bits init(216), 10 16 break_even_words init(6), 10 17 10 18 label_size init(4), 10 19 10 20 convert_size(13:14) init(9,1), 10 21 max_offset(13:14) init(27,35), 10 22 max_short_size(13:14) init(8,72), 10 23 10 24 units_per_word(0:5) init(1,36,8,4,2,1), 10 25 10 26 max_dec_scale init(32), 10 27 min_dec_scale init(-31), 10 28 max_p_xreg init(18), 10 29 max_p_fix_bin_1 init(35), 10 30 max_p_flt_bin_1 init(27), 10 31 max_p_fix_dec init(59), 10 32 max_length_p init(24), 10 33 default_fix_bin_p init(17)) fixed bin(8) int static options(constant); 10 34 10 35 dcl (convert_offset(0:5) init(36,1,4.5,9,18,36), 10 36 bits_per_packed_digit init(4.5)) fixed bin(8,1) int static options(constant); 10 37 10 38 dcl max_index_register_value init(262143) fixed bin(31) int static options(constant); 10 39 10 40 /* END INCLUDE FILE ... cgsystem.incl.pl1 */ 10 41 96 11 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 11 2 11 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 11 4 11 5 dcl area_infop ptr; 11 6 11 7 dcl 1 area_info aligned based (area_infop), 11 8 2 version fixed bin, /* version number for this structure is 1 */ 11 9 2 control aligned like area_control, /* control bits for the area */ 11 10 2 owner char (32) unal, /* creator of the area */ 11 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 11 12 2 size fixed bin (18), /* size of the area in words */ 11 13 2 version_of_area fixed bin, /* version of area (returned only) */ 11 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 11 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 11 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 11 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 11 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 11 19 11 20 dcl 1 area_control aligned based, 11 21 2 extend bit (1) unal, /* says area is extensible */ 11 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 11 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 11 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 11 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 11 26 2 system bit (1) unal, /* says area is managed by system */ 11 27 2 pad bit (30) unal; 11 28 11 29 /* END INCLUDE FILE area_info.incl.pl1 */ 97 12 1 /* BEGIN INCLUDE FILE ... arg_descriptor.incl.pl1 12 2* 12 3* James R. Davis 1 Mar 79 */ 12 4 12 5 dcl 1 arg_descriptor based (arg_descriptor_ptr) aligned, 12 6 2 flag bit (1) unal, 12 7 2 type fixed bin (6) unsigned unal, 12 8 2 packed bit (1) unal, 12 9 2 number_dims fixed bin (4) unsigned unal, 12 10 2 size fixed bin (24) unsigned unal; 12 11 12 12 dcl 1 fixed_arg_descriptor based (arg_descriptor_ptr) aligned, 12 13 2 flag bit (1) unal, 12 14 2 type fixed bin (6) unsigned unal, 12 15 2 packed bit (1) unal, 12 16 2 number_dims fixed bin (4) unsigned unal, 12 17 2 scale fixed bin (11) unal, 12 18 2 precision fixed bin (12) unsigned unal; 12 19 12 20 dcl arg_descriptor_ptr ptr; 12 21 12 22 /* END INCLUDE file .... arg_descriptor.incl.pl1 */ 98 99 100 /* program */ 101 102 if rtrim (pl1$pl1_release, "abcdefghijklmnopqrstuvwxyz") ^= "26" & (^ALLOW_EXL | pl1$pl1_release ^= "EXL") 103 then do; 104 call com_err_ (0, command, "Only PL/I Release 26^[ or EXL PL/I^] may be used. PL/I ^a", ALLOW_EXL, 105 pl1$pl1_release); 106 return; 107 end; 108 109 call cu_$arg_count (arg_count); 110 argument_no = 0; 111 do argx = 1 to arg_count; 112 call cu_$arg_ptr (argx, arg_ptr, arg_length, code); 113 if code ^= 0 114 then do; 115 call com_err_ (code, command, "Argument ^d.", argx); 116 return; 117 end; 118 119 if index (arg_string, "-") = 1 120 then do; 121 call com_err_ (error_table_$badopt, command, "^a", arg_string); 122 return; 123 end; 124 125 else do; 126 argument_no = argument_no + 1; 127 128 if argument_no = 1 129 then do; 130 call expand_pathname_$add_suffix (arg_string, "pl1", source_dname, source_ename, code); 131 if code ^= 0 132 then do; 133 call com_err_ (code, command, "^a", arg_string); 134 return; 135 end; 136 end; 137 end; 138 end; 139 140 if argument_no ^= 1 141 then do; 142 call com_err_$suppress_name (0, command, "Usage: ^a path", command); 143 return; 144 end; 145 146 unspec (auto_area_info) = ""b; 147 auto_area_info.version = area_info_version_1; 148 auto_area_info.owner = command; 149 auto_area_info.areap = null; 150 auto_area_info.no_freeing = "1"b; 151 auto_area_info.size = sys_info$max_seg_size; 152 153 on cleanup call cleanup_procedure; 154 155 call define_area_ (addr (auto_area_info), code); 156 if code ^= 0 157 then do; 158 call com_err_ (code, command, "From define_area_."); 159 return; 160 end; 161 162 call ioa_ ("Checking ^a", source_ename); 163 164 call compile_program (code); 165 if code ^= 0 166 then do; 167 call cleanup_procedure; 168 return; 169 end; 170 171 call traverse_blocks (pl1_stat_$root); 172 173 call cleanup_procedure; 174 175 return; 176 177 /* Compile the program in the process directory. */ 178 179 compile_program: 180 procedure (code); 181 182 dcl code fixed bin (35); /* (Output) */ 183 184 dcl object_seg_ename char (32); 185 dcl working_dir char (168) aligned; 186 dcl process_dir char (168) internal static initial (""); 187 188 code = 0; 189 190 if process_dir = "" 191 then process_dir = get_pdir_ (); 192 193 object_seg_ename = reverse (after (reverse (rtrim (source_ename)), reverse (".pl1"))); 194 working_dir = get_wdir_ (); 195 196 on cleanup 197 begin; 198 call change_wdir_ (working_dir, code); 199 call delete_$path (process_dir, object_seg_ename, "000100"b, command, code); 200 end; 201 202 call change_wdir_ ((process_dir), code); 203 if code ^= 0 204 then do; 205 call com_err_ (code, command, "Changing working directory to ^a.", process_dir); 206 return; 207 end; 208 209 call pl1 (rtrim (source_dname) || ">" || rtrim (source_ename), "-debug"); 210 211 call change_wdir_ (working_dir, code); 212 if code ^= 0 213 then do; 214 call com_err_ (code, command, "Changing working directory to ^a.", working_dir); 215 return; 216 end; 217 218 call delete_$path (process_dir, object_seg_ename, "000100"b, command, code); 219 if code ^= 0 220 then do; 221 call com_err_ (code, command, "Deleting ^a>^a.", process_dir, object_seg_ename); 222 return; 223 end; 224 end compile_program; 225 226 /* Walk block tree */ 227 228 traverse_blocks: 229 procedure (P_cur_block); 230 231 dcl P_cur_block ptr; /* (Input) */ 232 233 dcl cur_block ptr; 234 235 cur_block = P_cur_block; 236 237 call traverse_statements (cur_block -> block.prologue); 238 call traverse_statements (cur_block -> block.main); 239 240 do cur_block = cur_block -> block.son repeat cur_block -> block.brother while (cur_block ^= null); 241 call traverse_blocks (cur_block); 242 end; 243 244 return; 245 246 /* Walk a list of statements */ 247 248 traverse_statements: 249 procedure (P_cur_statement); 250 251 dcl P_cur_statement ptr unaligned; /* (Input) */ 252 253 dcl cur_statement ptr; 254 255 do cur_statement = P_cur_statement repeat cur_statement -> statement.next while (cur_statement ^= null); 256 call traverse_computation_tree (cur_statement -> statement.root); 257 end; 258 259 return; 260 261 /* Walk computation tree */ 262 263 traverse_computation_tree: 264 procedure (tree); 265 266 dcl tree ptr unaligned; /* (Input) */ 267 268 dcl operand_index fixed bin; 269 270 if tree = null 271 then return; 272 273 if tree -> node.type = operator_node 274 then if tree -> operator.op_code = std_call 275 then call check_call_operator (tree); 276 277 else do operand_index = 1 to tree -> operator.number; 278 call traverse_computation_tree (tree -> operator.operand (operand_index)); 279 end; 280 281 else if tree -> node.type = reference_node 282 then do; 283 call traverse_computation_tree (tree -> reference.offset); 284 call traverse_computation_tree (tree -> reference.length); 285 call traverse_computation_tree (tree -> reference.qualifier); 286 end; 287 288 return; 289 290 /* Check the call operator for any short unaligned strings in a structure that 291* are passed by reference */ 292 293 check_call_operator: 294 procedure (tree); 295 296 dcl tree ptr unaligned; /* (Input) */ 297 298 dcl s ptr; 299 300 /* exclude entry valued functions */ 301 302 if tree -> operator.operand (2) -> node.type ^= reference_node 303 then return; 304 305 s = tree -> operator.operand (2) -> reference.symbol; 306 307 /* exclude entry variables, internal procedures, and options(variable) procedures */ 308 309 if s -> symbol.variable | s -> symbol.internal | s -> symbol.options & s -> symbol.variable_arg_list 310 then return; 311 312 if tree -> operator.operand (3) = null 313 then return; 314 315 call check_arg_list (tree -> operator.operand (3) -> operator.operand (2)); 316 317 return; 318 319 /* Check argument list for unaligned short strings passed by reference with 320* fractional offsets of zero that are members of structures */ 321 322 check_arg_list: 323 procedure (arg_list); 324 325 dcl arg_list ptr unaligned; /* (Input) */ 326 327 dcl argument ptr; 328 dcl arg_index fixed bin; 329 330 do arg_index = 1 to arg_list -> list.number; 331 argument = arg_list -> list.element (arg_index); 332 333 if argument -> node.type = reference_node 334 then if (argument -> reference.symbol -> symbol.bit | argument -> reference.symbol -> symbol.char) 335 & argument -> reference.symbol -> symbol.non_varying 336 & argument -> reference.symbol -> symbol.unaligned & argument -> reference.symbol -> symbol.member 337 & ^argument -> reference.symbol -> symbol.temporary & ^argument -> reference.long_ref 338 & mod (argument -> reference.c_offset, units_per_word (argument -> reference.units)) = 0 339 then call check_parameter; 340 end; 341 342 return; 343 344 /* Check parameter, if possible, for called entry */ 345 346 check_parameter: 347 procedure; 348 349 /* automatic */ 350 351 dcl entry_name char (32); 352 dcl entry_point_name char (256); 353 dcl entry_point_ptr ptr; 354 355 /* based */ 356 357 dcl cst_storage area (auto_area_info.size) based (auto_area_info.areap); 358 dcl 1 expected aligned based, 359 2 no_args fixed bin, 360 2 descs (64) ptr; 361 362 /* symbol.reserved_1 and symbol.reserved_2 are just unused bits in the symbol node that we are borrowing. They are guaranteed 363* to be zero by pl1_nodes_template_ when we start. */ 364 365 if s -> symbol.reserved_2 366 then return; 367 368 if ^s -> symbol.reserved_1 369 then do; 370 entry_name = before (s -> symbol.token -> token.string, "$"); 371 372 entry_point_name = after (s -> symbol.token -> token.string, "$"); 373 if entry_point_name = "" 374 then entry_point_name = entry_name; 375 376 call hcs_$make_ptr (codeptr (check_short_strings), entry_name, entry_point_name, entry_point_ptr, code); 377 if code ^= 0 378 then do; 379 s -> symbol.reserved_2 = "1"b; 380 call com_err_ (code, command, "Getting a pointer to ^a.", s -> symbol.token -> token.string); 381 return; 382 end; 383 384 allocate expected in (cst_storage) set (s -> symbol.general); 385 386 call get_entry_arg_descs_ (entry_point_ptr, s -> symbol.general -> expected.no_args, 387 s -> symbol.general -> expected.descs, code); 388 if code ^= 0 389 then do; 390 s -> symbol.reserved_2 = "1"b; 391 call com_err_ (code, command, "Getting entry descriptors for ^a.", 392 s -> symbol.token -> token.string); 393 return; 394 end; 395 396 s -> symbol.reserved_1 = "1"b; 397 end; 398 399 if arg_index > s -> symbol.general -> expected.no_args 400 then do; 401 s -> symbol.reserved_2 = "1"b; 402 call com_err_ (0, command, "Call of ^a has too many arguments.", s -> symbol.token -> token.string); 403 return; 404 end; 405 406 if arg_index > hbound (s -> symbol.general -> expected.descs, 1) 407 then do; 408 call com_err_ (0, command, "Call of ^a exceeds internal limit of ^d arguments.", 409 s -> symbol.token -> token.string, hbound (s -> symbol.general -> expected.descs, 1)); 410 return; 411 end; 412 413 if s -> symbol.general -> expected.descs (arg_index) = null 414 then do; 415 s -> symbol.reserved_2 = "1"b; 416 call com_err_ (0, command, "Obsolete object segment format. ^a", s -> symbol.token -> token.string); 417 return; 418 end; 419 420 /* Verify that the descriptors are version 2 (version 1 is no problem) */ 421 422 if ^s -> symbol.general -> expected.descs (arg_index) -> arg_descriptor.flag 423 then return; 424 425 /* Check to see that the called program expects an unaligned (packed) string */ 426 427 if ^s -> symbol.general -> expected.descs (arg_index) -> arg_descriptor.packed 428 then do; 429 s -> symbol.reserved_2 = "1"b; 430 call com_err_ (0, command, "Call of ^a has a short string parameter mismatch.", 431 s -> symbol.token -> token.string); 432 return; 433 end; 434 end check_parameter; 435 436 end check_arg_list; 437 438 end check_call_operator; 439 440 end traverse_computation_tree; 441 442 end traverse_statements; 443 444 end traverse_blocks; 445 446 /* Free temporary storage. */ 447 448 cleanup_procedure: 449 procedure; 450 451 call pl1$clean_up; 452 call release_area_ (auto_area_info.areap); 453 end cleanup_procedure; 454 455 end check_short_strings; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1455.6 check_short_strings.pl1 >dumps>old>recomp>check_short_strings.pl1 87 1 08/13/81 2043.5 block.incl.pl1 >ldd>include>block.incl.pl1 88 2 07/21/80 1546.3 statement.incl.pl1 >ldd>include>statement.incl.pl1 89 3 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 90 4 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 91 5 07/21/80 1546.3 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 92 6 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 93 7 09/14/77 1705.7 token.incl.pl1 >ldd>include>token.incl.pl1 94 8 07/21/80 1546.3 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 95 9 08/13/81 2211.5 list.incl.pl1 >ldd>include>list.incl.pl1 96 10 10/25/79 1645.8 cgsystem.incl.pl1 >ldd>include>cgsystem.incl.pl1 97 11 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.incl.pl1 98 12 06/28/79 1204.8 arg_descriptor.incl.pl1 >ldd>include>arg_descriptor.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. ALLOW_EXL 000053 constant bit(1) initial dcl 54 set ref 102 104* P_cur_block parameter pointer dcl 231 ref 228 235 P_cur_statement parameter pointer unaligned dcl 251 ref 248 255 addr builtin function dcl 45 ref 155 155 after builtin function dcl 45 ref 193 372 area_control based structure level 1 dcl 11-20 area_info based structure level 1 dcl 11-7 area_info_version_1 constant fixed bin(17,0) initial dcl 11-3 ref 147 areap 16 000106 automatic pointer level 2 dcl 34 set ref 149* 384 452* arg_count 000100 automatic fixed bin(17,0) dcl 29 set ref 109* 111 arg_descriptor based structure level 1 dcl 12-5 arg_index 000140 automatic fixed bin(17,0) dcl 328 set ref 330* 331* 399 406 413 422 427 arg_length 000101 automatic fixed bin(21,0) dcl 30 set ref 112* 119 121 121 130 130 133 133 arg_list parameter pointer unaligned dcl 325 ref 322 330 331 arg_ptr 000102 automatic pointer dcl 31 set ref 112* 119 121 130 133 arg_string based char unaligned dcl 41 set ref 119 121* 130* 133* argument 000136 automatic pointer dcl 327 set ref 331* 333 333 333 333 333 333 333 333 333 333 argument_no 000104 automatic fixed bin(17,0) dcl 32 set ref 110* 126* 126 128 140 argx 000105 automatic fixed bin(17,0) dcl 33 set ref 111* 112* 115* attributes 31 based structure level 2 dcl 5-3 auto_area_info 000106 automatic structure level 1 dcl 34 set ref 146* 155 155 before builtin function dcl 45 ref 370 bit 31(03) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 bits 12(06) based structure level 2 packed unaligned dcl 4-3 block based structure level 1 dcl 1-5 brother 2 based pointer level 2 packed unaligned dcl 1-5 ref 242 c_offset 1 based fixed bin(24,0) level 2 dcl 4-3 ref 333 change_wdir_ 000072 constant entry external dcl 67 ref 198 202 211 char 31(04) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 cleanup 000216 stack reference condition dcl 50 ref 153 196 code parameter fixed bin(35,0) dcl 182 in procedure "compile_program" set ref 179 188* 198* 199* 202* 203 205* 211* 212 214* 218* 219 221* code 000132 automatic fixed bin(35,0) dcl 35 in procedure "check_short_strings" set ref 112* 113 115* 130* 131 133* 155* 156 158* 164* 165 376* 377 380* 386* 388 391* codeptr builtin function dcl 45 ref 376 376 com_err_ 000074 constant entry external dcl 68 ref 104 115 121 133 158 205 214 221 380 391 402 408 416 430 com_err_$suppress_name 000076 constant entry external dcl 69 ref 142 command 000006 constant char(19) initial unaligned dcl 55 set ref 104* 115* 121* 133* 142* 142* 148 158* 199* 205* 214* 218* 221* 380* 391* 402* 408* 416* 430* control 1 000106 automatic structure level 2 dcl 34 cst_storage based area dcl 357 ref 384 cu_$arg_count 000100 constant entry external dcl 71 ref 109 cu_$arg_ptr 000102 constant entry external dcl 72 ref 112 cur_block 000100 automatic pointer dcl 233 set ref 235* 237 238 240* 240 240* 241* 242 cur_statement 000110 automatic pointer dcl 253 set ref 255* 255* 256* 257 data_type 31 based structure level 3 packed unaligned dcl 5-3 define_area_ 000104 constant entry external dcl 73 ref 155 delete_$path 000106 constant entry external dcl 74 ref 199 218 descs 2 based pointer array level 2 dcl 358 set ref 386* 406 408 408 413 422 427 element 1 based pointer array level 2 packed unaligned dcl 9-6 ref 331 entry_name 000166 automatic char(32) unaligned dcl 351 set ref 370* 373 376* entry_point_name 000176 automatic char(256) unaligned dcl 352 set ref 372* 373 373* 376* entry_point_ptr 000276 automatic pointer dcl 353 set ref 376* 386* error_table_$badopt 000062 external static fixed bin(35,0) dcl 59 set ref 121* expand_pathname_$add_suffix 000110 constant entry external dcl 75 ref 130 expected based structure level 1 dcl 358 set ref 384 file_attributes 32(19) based structure level 3 packed unaligned dcl 5-3 flag based bit(1) level 2 packed unaligned dcl 12-5 ref 422 general 16 based pointer level 2 packed unaligned dcl 5-3 set ref 384* 386 386 399 406 408 408 413 422 427 get_entry_arg_descs_ 000112 constant entry external dcl 77 ref 386 get_pdir_ 000114 constant entry external dcl 79 ref 190 get_wdir_ 000116 constant entry external dcl 80 ref 194 hbound builtin function dcl 45 ref 406 408 408 hcs_$make_ptr 000120 constant entry external dcl 81 ref 376 index builtin function dcl 45 ref 119 internal 32(01) based bit(1) level 4 packed unaligned dcl 5-3 ref 309 ioa_ 000122 constant entry external dcl 82 ref 162 length 6 based pointer level 2 packed unaligned dcl 4-3 set ref 284* list based structure level 1 dcl 9-6 long_ref 12(08) based bit(1) level 3 packed unaligned dcl 4-3 ref 333 main 13 based pointer level 2 packed unaligned dcl 1-5 set ref 238* member 32(04) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 misc_attributes 31(19) based structure level 3 packed unaligned dcl 5-3 mod builtin function dcl 45 ref 333 next 1 based pointer level 2 packed unaligned dcl 2-3 ref 257 no_args based fixed bin(17,0) level 2 dcl 358 set ref 386* 399 no_freeing 1(04) 000106 automatic bit(1) level 3 packed unaligned dcl 34 set ref 150* node based structure level 1 dcl 6-27 non_varying 32(05) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 null builtin function dcl 45 ref 149 240 255 270 312 413 number 0(21) based fixed bin(14,0) level 2 in structure "list" packed unaligned dcl 9-6 in procedure "check_short_strings" ref 330 number 0(21) based fixed bin(14,0) level 2 in structure "operator" packed unaligned dcl 3-6 in procedure "check_short_strings" ref 277 object_seg_ename 000100 automatic char(32) unaligned dcl 184 set ref 193* 199* 218* 221* offset 5 based pointer level 2 packed unaligned dcl 4-3 set ref 283* op_code 0(09) based bit(9) level 2 packed unaligned dcl 3-6 ref 273 operand 1 based pointer array level 2 packed unaligned dcl 3-6 set ref 278* 302 305 312 315 315* operand_index 000100 automatic fixed bin(17,0) dcl 268 set ref 277* 278* operator based structure level 1 dcl 3-6 operator_node constant bit(9) initial dcl 6-5 ref 273 options 32(06) based bit(1) level 4 packed unaligned dcl 5-3 ref 309 owner 2 000106 automatic char(32) level 2 packed unaligned dcl 34 set ref 148* packed 0(07) based bit(1) level 2 packed unaligned dcl 12-5 ref 427 pl1 000124 constant entry external dcl 83 ref 209 pl1$clean_up 000126 constant entry external dcl 84 ref 451 pl1$pl1_release 000064 external static varying char(3) dcl 60 set ref 102 102 104* pl1_stat_$root 000066 external static pointer dcl 61 set ref 171* process_dir 000010 internal static char(168) initial unaligned dcl 186 set ref 190 190* 199* 202 205* 218* 221* prologue 11 based pointer level 2 packed unaligned dcl 1-5 set ref 237* qualifier 4 based pointer level 2 packed unaligned dcl 4-3 set ref 285* reference based structure level 1 dcl 4-3 reference_node constant bit(9) initial dcl 6-5 ref 281 302 333 release_area_ 000130 constant entry external dcl 85 ref 452 reserved_1 32(24) based bit(1) level 4 packed unaligned dcl 5-3 set ref 368 396* reserved_2 32(29) based bit(1) level 4 packed unaligned dcl 5-3 set ref 365 379* 390* 401* 415* 429* reverse builtin function dcl 45 ref 193 193 193 root 3 based pointer level 2 packed unaligned dcl 2-3 set ref 256* rtrim builtin function dcl 45 ref 102 193 209 209 s 000126 automatic pointer dcl 298 set ref 305* 309 309 309 309 365 368 370 372 379 380 384 386 386 390 391 396 399 401 402 406 408 408 408 413 415 416 422 427 429 430 size 3 based fixed bin(9,0) level 2 in structure "token" dcl 7-3 in procedure "check_short_strings" ref 370 372 380 380 391 391 402 402 408 408 416 416 430 430 size 13 000106 automatic fixed bin(18,0) level 2 in structure "auto_area_info" dcl 34 in procedure "check_short_strings" set ref 151* son 3 based pointer level 2 packed unaligned dcl 1-5 ref 240 source_dname 000133 automatic char(168) unaligned dcl 36 set ref 130* 209 source_ename 000205 automatic char(32) unaligned dcl 37 set ref 130* 162* 193 209 statement based structure level 1 dcl 2-3 std_call constant bit(9) initial dcl 8-7 ref 273 storage_class 32(09) based structure level 3 packed unaligned dcl 5-3 string 4 based char level 2 dcl 7-3 set ref 370 372 380* 391* 402* 408* 416* 430* symbol 3 based pointer level 2 in structure "reference" packed unaligned dcl 4-3 in procedure "check_short_strings" ref 305 333 333 333 333 333 333 symbol based structure level 1 dcl 5-3 in procedure "check_short_strings" sys_info$max_seg_size 000070 external static fixed bin(19,0) dcl 62 ref 151 temporary 32(17) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 token 5 based pointer level 2 in structure "symbol" packed unaligned dcl 5-3 in procedure "check_short_strings" ref 370 372 380 391 402 408 416 430 token based structure level 1 dcl 7-3 in procedure "check_short_strings" tree parameter pointer unaligned dcl 266 in procedure "traverse_computation_tree" set ref 263 270 273 273 273* 277 278 281 283 284 285 tree parameter pointer unaligned dcl 296 in procedure "check_call_operator" ref 293 302 305 312 315 type based bit(9) level 2 packed unaligned dcl 6-27 ref 273 281 302 333 unaligned 31(22) based bit(1) level 4 packed unaligned dcl 5-3 ref 333 units 0(14) based fixed bin(3,0) level 2 packed unaligned dcl 4-3 ref 333 units_per_word 000000 constant fixed bin(8,0) initial array dcl 10-5 ref 333 unspec builtin function dcl 45 set ref 146* variable 31(32) based bit(1) level 4 packed unaligned dcl 5-3 ref 309 variable_arg_list 32(07) based bit(1) level 4 packed unaligned dcl 5-3 ref 309 version 000106 automatic fixed bin(17,0) level 2 dcl 34 set ref 147* working_dir 000110 automatic char(168) dcl 185 set ref 194* 198* 211* 214* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 8-7 abs_fun internal static bit(9) initial dcl 8-7 acos_fun internal static bit(9) initial dcl 8-7 acosd_fun internal static bit(9) initial dcl 8-7 add internal static bit(9) initial dcl 8-7 addr_fun internal static bit(9) initial dcl 8-7 addr_fun_bits internal static bit(9) initial dcl 8-7 addrel_fun internal static bit(9) initial dcl 8-7 allocation_fun internal static bit(9) initial dcl 8-7 allot_auto internal static bit(9) initial dcl 8-7 allot_based internal static bit(9) initial dcl 8-7 allot_ctl internal static bit(9) initial dcl 8-7 allot_var internal static bit(9) initial dcl 8-7 and_bits internal static bit(9) initial dcl 8-7 area_infop automatic pointer dcl 11-5 arg_descriptor_ptr automatic pointer dcl 12-20 array_node internal static bit(9) initial dcl 6-5 asin_fun internal static bit(9) initial dcl 8-7 asind_fun internal static bit(9) initial dcl 8-7 assign internal static bit(9) initial dcl 8-7 assign_by_name internal static bit(9) initial dcl 8-7 assign_round internal static bit(9) initial dcl 8-7 assign_size_ck internal static bit(9) initial dcl 8-7 assign_zero internal static bit(9) initial dcl 8-7 atan_fun internal static bit(9) initial dcl 8-7 atand_fun internal static bit(9) initial dcl 8-7 b_format internal static bit(9) initial dcl 8-7 baseno_fun internal static bit(9) initial dcl 8-7 baseptr_fun internal static bit(9) initial dcl 8-7 bit_pointer internal static bit(9) initial dcl 8-7 bit_to_char internal static bit(9) initial dcl 8-7 bit_to_word internal static bit(9) initial dcl 8-7 bits_per_char internal static fixed bin(8,0) initial dcl 10-5 bits_per_four_words internal static fixed bin(8,0) initial dcl 10-5 bits_per_half internal static fixed bin(8,0) initial dcl 10-5 bits_per_packed_digit internal static fixed bin(8,1) initial dcl 10-35 bits_per_two_words internal static fixed bin(8,0) initial dcl 10-5 bits_per_word internal static fixed bin(8,0) initial dcl 10-5 bits_per_words internal static fixed bin(8,0) initial array dcl 10-5 block_node internal static bit(9) initial dcl 6-5 bn_format internal static bit(9) initial dcl 8-7 bool_fun internal static bit(9) initial dcl 8-7 bound_ck internal static bit(9) initial dcl 8-7 bound_node internal static bit(9) initial dcl 6-5 break_even_bits internal static fixed bin(8,0) initial dcl 10-5 break_even_words internal static fixed bin(8,0) initial dcl 10-5 by_name_agg_node internal static bit(9) initial dcl 6-5 byte_fun internal static bit(9) initial dcl 8-7 c_format internal static bit(9) initial dcl 8-7 cat_string internal static bit(9) initial dcl 8-7 ceil_fun internal static bit(9) initial dcl 8-7 char_to_word internal static bit(9) initial dcl 8-7 chars_per_word internal static fixed bin(8,0) initial dcl 10-5 clock_fun internal static bit(9) initial dcl 8-7 close_file internal static bit(9) initial dcl 8-7 codeptr_fun internal static bit(9) initial dcl 8-7 column_format internal static bit(9) initial dcl 8-7 complex_fun internal static bit(9) initial dcl 8-7 conjg_fun internal static bit(9) initial dcl 8-7 context_node internal static bit(9) initial dcl 6-5 convert_offset internal static fixed bin(8,1) initial array dcl 10-35 convert_size internal static fixed bin(8,0) initial array dcl 10-5 copy_string internal static bit(9) initial dcl 8-7 copy_words internal static bit(9) initial dcl 8-7 cos_fun internal static bit(9) initial dcl 8-7 cosd_fun internal static bit(9) initial dcl 8-7 cross_reference_node internal static bit(9) initial dcl 6-5 default_fix_bin_p internal static fixed bin(8,0) initial dcl 10-5 default_node internal static bit(9) initial dcl 6-5 delete_file internal static bit(9) initial dcl 8-7 desc_size internal static bit(9) initial dcl 8-7 digit_to_bit internal static bit(9) initial dcl 8-7 div internal static bit(9) initial dcl 8-7 do_fun internal static bit(9) initial dcl 8-7 do_spec internal static bit(9) initial dcl 8-7 e_format internal static bit(9) initial dcl 8-7 empty_area internal static bit(9) initial dcl 8-7 enable_on internal static bit(9) initial dcl 8-7 environmentptr_fun internal static bit(9) initial dcl 8-7 equal internal static bit(9) initial dcl 8-7 ex_prologue internal static bit(9) initial dcl 8-7 exp internal static bit(9) initial dcl 8-7 exp_fun internal static bit(9) initial dcl 8-7 f_format internal static bit(9) initial dcl 8-7 fixed_arg_descriptor based structure level 1 dcl 12-12 floor_fun internal static bit(9) initial dcl 8-7 format_value_node internal static bit(9) initial dcl 6-5 fortran_read internal static bit(9) initial dcl 8-7 fortran_write internal static bit(9) initial dcl 8-7 free_based internal static bit(9) initial dcl 8-7 free_ctl internal static bit(9) initial dcl 8-7 free_var internal static bit(9) initial dcl 8-7 ftn_file_manip internal static bit(9) initial dcl 8-7 ftn_trans_loop internal static bit(9) initial dcl 8-7 get_data_trans internal static bit(9) initial dcl 8-7 get_edit_trans internal static bit(9) initial dcl 8-7 get_file internal static bit(9) initial dcl 8-7 get_list_trans internal static bit(9) initial dcl 8-7 get_string internal static bit(9) initial dcl 8-7 greater_or_equal internal static bit(9) initial dcl 8-7 greater_than internal static bit(9) initial dcl 8-7 half_to_word internal static bit(9) initial dcl 8-7 imag_fun internal static bit(9) initial dcl 8-7 index_after_fun internal static bit(9) initial dcl 8-7 index_before_fun internal static bit(9) initial dcl 8-7 index_fun internal static bit(9) initial dcl 8-7 index_rev_fun internal static bit(9) initial dcl 8-7 join internal static bit(9) initial dcl 8-7 jump internal static bit(9) initial dcl 8-7 jump_false internal static bit(9) initial dcl 8-7 jump_if_eq internal static bit(9) initial dcl 8-7 jump_if_ge internal static bit(9) initial dcl 8-7 jump_if_gt internal static bit(9) initial dcl 8-7 jump_if_le internal static bit(9) initial dcl 8-7 jump_if_lt internal static bit(9) initial dcl 8-7 jump_if_ne internal static bit(9) initial dcl 8-7 jump_true internal static bit(9) initial dcl 8-7 l_parn internal static bit(9) initial dcl 8-7 label_array_element_node internal static bit(9) initial dcl 6-5 label_node internal static bit(9) initial dcl 6-5 label_size internal static fixed bin(8,0) initial dcl 10-5 length_fun internal static bit(9) initial dcl 8-7 less_or_equal internal static bit(9) initial dcl 8-7 less_than internal static bit(9) initial dcl 8-7 line_format internal static bit(9) initial dcl 8-7 list_node internal static bit(9) initial dcl 6-5 locate_file internal static bit(9) initial dcl 8-7 lock_file internal static bit(9) initial dcl 8-7 lock_fun internal static bit(9) initial dcl 8-7 log10_fun internal static bit(9) initial dcl 8-7 log2_fun internal static bit(9) initial dcl 8-7 log_fun internal static bit(9) initial dcl 8-7 loop internal static bit(9) initial dcl 8-7 machine_state_node internal static bit(9) initial dcl 6-5 make_desc internal static bit(9) initial dcl 8-7 max_block_number internal static fixed bin(17,0) initial dcl 1-74 max_dec_scale internal static fixed bin(8,0) initial dcl 10-5 max_fun internal static bit(9) initial dcl 8-7 max_index_register_value internal static fixed bin(31,0) initial dcl 10-38 max_length_p internal static fixed bin(8,0) initial dcl 10-5 max_list_elements internal static fixed bin(17,0) initial dcl 9-12 max_number_of_operands internal static fixed bin(15,0) initial dcl 3-15 max_offset internal static fixed bin(8,0) initial array dcl 10-5 max_p_fix_bin_1 internal static fixed bin(8,0) initial dcl 10-5 max_p_fix_dec internal static fixed bin(8,0) initial dcl 10-5 max_p_flt_bin_1 internal static fixed bin(8,0) initial dcl 10-5 max_p_xreg internal static fixed bin(8,0) initial dcl 10-5 max_short_size internal static fixed bin(8,0) initial array dcl 10-5 min_dec_scale internal static fixed bin(8,0) initial dcl 10-5 min_fun internal static bit(9) initial dcl 8-7 mod_bit internal static bit(9) initial dcl 8-7 mod_byte internal static bit(9) initial dcl 8-7 mod_fun internal static bit(9) initial dcl 8-7 mod_half internal static bit(9) initial dcl 8-7 mod_word internal static bit(9) initial dcl 8-7 mult internal static bit(9) initial dcl 8-7 negate internal static bit(9) initial dcl 8-7 nop internal static bit(9) initial dcl 8-7 not_bits internal static bit(9) initial dcl 8-7 not_equal internal static bit(9) initial dcl 8-7 off_fun internal static bit(9) initial dcl 8-7 open_file internal static bit(9) initial dcl 8-7 or_bits internal static bit(9) initial dcl 8-7 pack internal static bit(9) initial dcl 8-7 packed_digits_per_char internal static fixed bin(8,0) initial dcl 10-5 packed_digits_per_word internal static fixed bin(8,0) initial dcl 10-5 page_format internal static bit(9) initial dcl 8-7 param_desc_ptr internal static bit(9) initial dcl 8-7 param_ptr internal static bit(9) initial dcl 8-7 picture_format internal static bit(9) initial dcl 8-7 pl1_mod_fun internal static bit(9) initial dcl 8-7 prefix_plus internal static bit(9) initial dcl 8-7 ptr_fun internal static bit(9) initial dcl 8-7 put_control internal static bit(9) initial dcl 8-7 put_data_trans internal static bit(9) initial dcl 8-7 put_edit_trans internal static bit(9) initial dcl 8-7 put_field internal static bit(9) initial dcl 8-7 put_field_chk internal static bit(9) initial dcl 8-7 put_file internal static bit(9) initial dcl 8-7 put_list_trans internal static bit(9) initial dcl 8-7 put_string internal static bit(9) initial dcl 8-7 r_format internal static bit(9) initial dcl 8-7 r_parn internal static bit(9) initial dcl 8-7 range_ck internal static bit(9) initial dcl 8-7 rank_fun internal static bit(9) initial dcl 8-7 read_file internal static bit(9) initial dcl 8-7 real_fun internal static bit(9) initial dcl 8-7 record_io internal static bit(9) initial dcl 8-7 refer internal static bit(9) initial dcl 8-7 rel_fun internal static bit(9) initial dcl 8-7 repeat_fun internal static bit(9) initial dcl 8-7 return_bits internal static bit(9) initial dcl 8-7 return_string internal static bit(9) initial dcl 8-7 return_value internal static bit(9) initial dcl 8-7 return_words internal static bit(9) initial dcl 8-7 reverse_fun internal static bit(9) initial dcl 8-7 revert_on internal static bit(9) initial dcl 8-7 rewrite_file internal static bit(9) initial dcl 8-7 round_fun internal static bit(9) initial dcl 8-7 search_fun internal static bit(9) initial dcl 8-7 search_rev_fun internal static bit(9) initial dcl 8-7 sf_par_node internal static bit(9) initial dcl 6-5 sign_fun internal static bit(9) initial dcl 8-7 signal_on internal static bit(9) initial dcl 8-7 sin_fun internal static bit(9) initial dcl 8-7 sind_fun internal static bit(9) initial dcl 8-7 skip_format internal static bit(9) initial dcl 8-7 source_node internal static bit(9) initial dcl 6-5 sqrt_fun internal static bit(9) initial dcl 8-7 stack_ptr internal static bit(9) initial dcl 8-7 stackbaseptr_fun internal static bit(9) initial dcl 8-7 stackframeptr_fun internal static bit(9) initial dcl 8-7 stacq_fun internal static bit(9) initial dcl 8-7 statement_node internal static bit(9) initial dcl 6-5 std_arg_list internal static bit(9) initial dcl 8-7 std_entry internal static bit(9) initial dcl 8-7 std_return internal static bit(9) initial dcl 8-7 stop internal static bit(9) initial dcl 8-7 stream_prep internal static bit(9) initial dcl 8-7 sub internal static bit(9) initial dcl 8-7 symbol_node internal static bit(9) initial dcl 6-5 tan_fun internal static bit(9) initial dcl 8-7 tand_fun internal static bit(9) initial dcl 8-7 temporary_node internal static bit(9) initial dcl 6-5 terminate_trans internal static bit(9) initial dcl 8-7 token_node internal static bit(9) initial dcl 6-5 translate_fun internal static bit(9) initial dcl 8-7 trunc_fun internal static bit(9) initial dcl 8-7 unlock_file internal static bit(9) initial dcl 8-7 unpack internal static bit(9) initial dcl 8-7 vclock_fun internal static bit(9) initial dcl 8-7 verify_fun internal static bit(9) initial dcl 8-7 verify_ltrim_fun internal static bit(9) initial dcl 8-7 verify_rev_fun internal static bit(9) initial dcl 8-7 verify_rtrim_fun internal static bit(9) initial dcl 8-7 word_to_mod2 internal static bit(9) initial dcl 8-7 word_to_mod4 internal static bit(9) initial dcl 8-7 word_to_mod8 internal static bit(9) initial dcl 8-7 write_file internal static bit(9) initial dcl 8-7 x_format internal static bit(9) initial dcl 8-7 xor_bits internal static bit(9) initial dcl 8-7 NAMES DECLARED BY EXPLICIT CONTEXT. check_arg_list 002013 constant entry internal dcl 322 ref 315 check_call_operator 001743 constant entry internal dcl 293 ref 273 check_parameter 002106 constant entry internal dcl 346 ref 333 check_short_strings 000246 constant entry external dcl 24 ref 376 376 cleanup_procedure 002625 constant entry internal dcl 448 ref 153 167 173 compile_program 001014 constant entry internal dcl 179 ref 164 traverse_blocks 001503 constant entry internal dcl 228 ref 171 241 traverse_computation_tree 001605 constant entry internal dcl 263 ref 256 278 283 284 285 traverse_statements 001554 constant entry internal dcl 248 ref 237 238 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3372 3524 3052 3402 Length 4172 3052 132 432 317 52 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME check_short_strings 190 external procedure is an external procedure. on unit on line 153 64 on unit compile_program 202 internal procedure enables or reverts conditions. on unit on line 196 94 on unit traverse_blocks 88 internal procedure calls itself recursively. traverse_statements internal procedure shares stack frame of internal procedure traverse_blocks. traverse_computation_tree 263 internal procedure calls itself recursively. check_call_operator internal procedure shares stack frame of internal procedure traverse_computation_tree. check_arg_list internal procedure shares stack frame of internal procedure traverse_computation_tree. check_parameter internal procedure shares stack frame of internal procedure traverse_computation_tree. cleanup_procedure 68 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 process_dir compile_program STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_short_strings 000100 arg_count check_short_strings 000101 arg_length check_short_strings 000102 arg_ptr check_short_strings 000104 argument_no check_short_strings 000105 argx check_short_strings 000106 auto_area_info check_short_strings 000132 code check_short_strings 000133 source_dname check_short_strings 000205 source_ename check_short_strings compile_program 000100 object_seg_ename compile_program 000110 working_dir compile_program traverse_blocks 000100 cur_block traverse_blocks 000110 cur_statement traverse_statements traverse_computation_tree 000100 operand_index traverse_computation_tree 000126 s check_call_operator 000136 argument check_arg_list 000140 arg_index check_arg_list 000166 entry_name check_parameter 000176 entry_point_name check_parameter 000276 entry_point_ptr check_parameter THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return mod_fx1 enable shorten_stack ext_entry int_entry reverse_cs set_cs_eis alloc_based index_after_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. change_wdir_ com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr define_area_ delete_$path expand_pathname_$add_suffix get_entry_arg_descs_ get_pdir_ get_wdir_ hcs_$make_ptr ioa_ pl1 pl1$clean_up release_area_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt pl1$pl1_release pl1_stat_$root sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 24 000245 102 000253 104 000301 106 000335 109 000336 110 000344 111 000345 112 000354 113 000371 115 000373 116 000425 119 000426 121 000442 122 000474 126 000475 128 000476 130 000501 131 000537 133 000541 134 000573 138 000574 140 000576 142 000601 143 000632 146 000633 147 000636 148 000640 149 000643 150 000645 151 000647 153 000652 155 000674 156 000707 158 000711 159 000740 162 000741 164 000762 165 000770 167 000772 168 000776 171 000777 173 001006 175 001012 179 001013 188 001021 190 001023 193 001035 194 001075 196 001110 198 001124 199 001136 200 001173 202 001174 203 001211 205 001214 206 001244 209 001245 211 001336 212 001351 214 001354 215 001404 218 001405 219 001440 221 001443 222 001500 224 001501 228 001502 235 001510 237 001514 238 001522 240 001531 241 001540 242 001547 244 001553 248 001554 255 001556 256 001570 257 001577 259 001603 263 001604 270 001612 273 001623 277 001646 278 001657 279 001674 281 001677 283 001701 284 001710 285 001725 288 001742 293 001743 302 001745 305 001762 309 001764 312 001777 315 002003 317 002012 322 002013 330 002015 331 002033 333 002043 340 002103 342 002105 346 002106 365 002107 368 002114 370 002117 372 002131 373 002147 376 002156 377 002212 379 002216 380 002221 381 002255 384 002256 386 002266 388 002316 390 002322 391 002325 393 002361 396 002362 399 002365 401 002373 402 002376 403 002433 406 002434 408 002436 410 002502 413 002503 415 002511 416 002514 417 002551 422 002552 427 002557 429 002562 430 002565 432 002622 434 002623 448 002624 451 002632 452 002636 453 002646 ----------------------------------------------------------- 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