COMPILATION LISTING OF SEGMENT simplify_offset Compiled by: Multics PL/I Compiler, Release 32c, of June 16, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 07/31/89 1352.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 /* This version of simplify_offset assumes that mod_bit, mod_byte, 12* mod_half, and bit_pointer operators do not appear in the tree */ 13 14 /* Modified: 10 April 1977 by RAB to eliminate use of mod_word operator 15* Modified: 26 November 1977 by RAB to fix 1690 16* Modified: 10 February 1978 by RAB to fix 1691 17* Modified: 25 August 1978 by RAB to help fix 1780 18* Modified: 5 September 1978 by RAB to fix 1782 19* Modified: 17 Jan 1979 by RAB to fix 1816 (fault with aligned unsigned subscript) 20* Modified: 23 April 1979 by PCK to implement 4-bit decimal 21* Modified: 23 May 1979 by RAB to fix 1820 (large lower bound in word 22* array causes bad code) 23**/ 24 25 simplify_offset: proc(pt,context); 26 27 dcl pt ptr; /* points at a reference node */ 28 29 dcl (f,p1,p2,p3,p4,r,s,s1,s2,s3,s4,sym,q,symref) ptr, 30 i fixed bin, 31 sign fixed bin(1), 32 (has_offset, ok_to_free) bit(1) aligned, 33 multiple fixed bin(31), 34 (bit_offset,c_bit_offset,factor) fixed bin(24), 35 (orig_c_offset,start_gen_storage,start_generation) fixed bin(24), 36 (n,fix_precision,lower_precision) fixed bin(24), 37 op_code bit(9) aligned, 38 (called_fix_exp, fractional_offset_to_be_added) bit(1) aligned, 39 fix_bin fixed bin based; 40 41 dcl convert_offset(0:5) init(36,1,4.5,9,18,36) fixed bin(7,1) int static options(constant); 42 dcl units_per_word(0:5) init(1,36,8,4,2,1) fixed bin(6) int static; 43 44 dcl (divide,max,min,mod,null,substr) builtin; 45 1 1 /* BEGIN INCLUDE FILE ... semant.incl.pl1 */ 1 2 1 3 /* Modified: 30 Aug 1979 by PCK to fix 1804 and 1823 */ 1 4 /* Modified: 26 Aug 1979 by PCK to implement by name assignment */ 1 5 1 6 1 7 declare alloc_semantics entry(pointer,pointer,pointer); 1 8 /* parameter 1: (input) block node pointer */ 1 9 /* parameter 2: (input) statement node pointer */ 1 10 /* parameter 3: (in/out) tree pointer */ 1 11 1 12 declare alloc_semantics$init_only entry(pointer,pointer,pointer); 1 13 /* parameter 1: (input) qualifier pointer */ 1 14 /* parameter 2: (input) statement node pointer */ 1 15 /* parameter 3: (input) symbol node pointer */ 1 16 1 17 declare builtin entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 1 18 returns(pointer); 1 19 /* parameter 1: (input) block node pointer */ 1 20 /* parameter 2: (input) statement node pointer */ 1 21 /* parameter 3: (input) tree pointer */ 1 22 /* parameter 4: (input) subscript pointer */ 1 23 /* parameter 5: (input) builtin symbol node pointer */ 1 24 /* parameter 6: (in/out) context */ 1 25 /* return: (output) tree pointer */ 1 26 1 27 declare check_star_extents entry(pointer,pointer); 1 28 /* parameter 1: (input) symbol node of procedure */ 1 29 /* parameter 2: (input) argument list pointer */ 1 30 1 31 declare compare_declaration entry(pointer,pointer,bit(1) aligned) reducible 1 32 returns(bit(1) aligned); 1 33 /* parameter 1: (input) reference or symbol node ptr */ 1 34 /* parameter 2: (input) symbol node ptr */ 1 35 /* parameter 3: (input) "1"b if aligned attribute ignored for string */ 1 36 /* return: (output) compare bit */ 1 37 1 38 declare context_processor entry(pointer,label); 1 39 /* parameter 1: (input) root block node pointer */ 1 40 1 41 declare declare entry(pointer); 1 42 /* parameter 1: (input) symbol node pointer */ 1 43 1 44 declare declare_structure entry(pointer); 1 45 /* parameter 1: (input) symbol node pointer */ 1 46 1 47 declare defined_reference entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 1 48 returns(pointer); 1 49 /* parameter 1: (input) block node pointer */ 1 50 /* parameter 2: (input) statement node pointer */ 1 51 /* parameter 3: (input) tree pointer */ 1 52 /* parameter 4: (input) subscript list pointer or null*/ 1 53 /* parameter 5: (input) symbol node pointer */ 1 54 /* parameter 6: (in/out) context */ 1 55 /* return: (output) tree pointer */ 1 56 1 57 declare do_semantics entry(pointer,pointer,pointer); 1 58 /* parameter 1: (input) block node pointer */ 1 59 /* parameter 2: (input) statement node pointer */ 1 60 /* parameter 3: (input) tree pointer */ 1 61 1 62 declare expand_assign entry(pointer,pointer,pointer,bit(36) aligned,pointer) 1 63 returns(pointer); 1 64 /* parameter 1: (input) block node pointer */ 1 65 /* parameter 2: (input) statement node pointer */ 1 66 /* parameter 3: (input) tree pointer */ 1 67 /* parameter 4: (in/out) context */ 1 68 /* parameter 5: (input) aggregate reference node ptr */ 1 69 /* return: (output) tree pointer */ 1 70 1 71 declare expand_by_name entry(pointer,pointer,pointer); 1 72 /* parameter 1: (input) block node pointer */ 1 73 /* parameter 2: (input) statement node pointer */ 1 74 /* parameter 3: (input/output) tree pointer */ 1 75 1 76 declare expand_infix entry(pointer,pointer,pointer,bit(36) aligned) 1 77 returns(pointer); 1 78 /* parameter 1: (input) block node pointer */ 1 79 /* parameter 2: (input) statement node pointer */ 1 80 /* parameter 3: (input) tree pointer */ 1 81 /* parameter 4: (in/out) context */ 1 82 /* return: (output) tree pointer */ 1 83 1 84 declare expand_initial entry(pointer,pointer,pointer); 1 85 /* parameter 1: (input) symbol node pointer */ 1 86 /* parameter 2: (input) statement node pointer */ 1 87 /* parameter 3: (input) locator */ 1 88 1 89 declare expand_prefix entry(pointer,pointer,pointer,bit(36) aligned) 1 90 returns(pointer); 1 91 /* parameter 1: (input) block node pointer */ 1 92 /* parameter 2: (input) statement node pointer */ 1 93 /* parameter 3: (input) tree pointer */ 1 94 /* parameter 4: (in/out) context */ 1 95 /* return: (output) tree pointer */ 1 96 1 97 declare expand_primitive entry(pointer,pointer,pointer,bit(36) aligned) 1 98 returns(pointer); 1 99 /* parameter 1: (input) block node pointer */ 1 100 /* parameter 2: (input) statement node pointer */ 1 101 /* parameter 3: (input) tree pointer */ 1 102 /* parameter 4: (input) context */ 1 103 /* return: (output) tree pointer */ 1 104 1 105 declare expression_semantics entry(pointer,pointer,pointer,bit(36) aligned) 1 106 returns(pointer); 1 107 /* parameter 1: (input) block node pointer */ 1 108 /* parameter 2: (input) statement node pointer */ 1 109 /* parameter 3: (input) tree pointer */ 1 110 /* parameter 4: (in/out) context */ 1 111 /* return: (output) tree pointer */ 1 112 1 113 declare fill_refer entry(pointer,pointer,bit(1) aligned) 1 114 returns(pointer); 1 115 /* parameter 1: (input) null,ref node,op node ptr */ 1 116 /* parameter 2: (input) null,ref node,op node ptr */ 1 117 /* parameter 3: (input) copy switch for param 2 */ 1 118 /* return: (output) ptr to processed tree */ 1 119 1 120 declare io_data_list_semantics$format_list_semantics entry(pointer,pointer,pointer); 1 121 /* parameter 1: (input) block node pointer */ 1 122 /* parameter 2: (input) statement node pointer */ 1 123 /* parameter 3: (in/out) tree pointer */ 1 124 1 125 declare function entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 126 returns(pointer); 1 127 /* parameter 1: (input) block node pointer */ 1 128 /* parameter 2: (input) statement node pointer */ 1 129 /* parameter 3: (input) tree pointer */ 1 130 /* parameter 4: (input) symbol node pointer */ 1 131 /* parameter 5: (in/out) context */ 1 132 /* return: (output) tree pointer */ 1 133 1 134 declare generic_selector entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 135 returns(pointer); 1 136 /* parameter 1: (input) block node pointer */ 1 137 /* parameter 2: (input) statement node pointer */ 1 138 /* parameter 3: (input) tree pointer */ 1 139 /* parameter 4: (input) pointer to argument list */ 1 140 /* parameter 5: (in/out) context */ 1 141 /* return: (output) tree pointer */ 1 142 1 143 declare io_data_list_semantics entry(pointer,pointer,pointer); 1 144 /* parameter 1: (input) block node pointer */ 1 145 /* parameter 2: (input) statement node pointer */ 1 146 /* parameter 3: (input) operator node pointer */ 1 147 1 148 declare io_semantics entry(pointer,pointer,pointer); 1 149 /* parameter 1: (input) block node pointer */ 1 150 /* parameter 2: (input) statement node pointer */ 1 151 /* parameter 3: (input) tree pointer */ 1 152 1 153 declare lookup entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 154 returns(bit(1) aligned); 1 155 /* parameter 1: (input) block node pointer */ 1 156 /* parameter 2: (input) stmnt|symbol node pointer */ 1 157 /* parameter 3: (input) token or reference node ptr */ 1 158 /* parameter 4: (output) symbol node pointer */ 1 159 /* parameter 5: (in/out) context */ 1 160 /* return: (output) symbol found bit */ 1 161 1 162 declare make_non_quick entry(pointer, bit (36) aligned); 1 163 /* parameter 1: (input) tree pointer */ 1 164 /* parameter 2: (input) reason why being made nonquick */ 1 165 1 166 declare match_arguments entry(pointer,pointer) reducible 1 167 returns(bit(1) aligned); 1 168 /* parameter 1: (input) reference or symbol node ptr */ 1 169 /* parameter 2: (input) reference or symbol node ptr */ 1 170 /* return: (output) compare bit */ 1 171 1 172 declare offset_adder entry(pointer,fixed binary(31),fixed binary(3),bit(1) aligned, 1 173 pointer,fixed binary(31),fixed binary(3),bit(1) aligned,bit(1)); 1 174 /* parameter 1: (in/out) tree pointer */ 1 175 /* parameter 2: (in/out) constant size */ 1 176 /* parameter 3: (in/out) units */ 1 177 /* parameter 4: (in/out) ON if units ^= word_, but tree in words */ 1 178 /* parameter 5: (input) tree pointer */ 1 179 /* parameter 6: (input) constant size */ 1 180 /* parameter 7: (input) units */ 1 181 /* parameter 8: (input) ON if units ^= word_, but tree in words */ 1 182 /* parameter 9: (input) ON if should not improve units */ 1 183 1 184 declare operator_semantics entry(pointer,pointer,pointer,bit(36) aligned) 1 185 returns(pointer); 1 186 /* parameter 1: (input) block node pointer */ 1 187 /* parameter 2: (input) statement node pointer */ 1 188 /* parameter 3: (input) tree pointer */ 1 189 /* parameter 4: (in/out) context */ 1 190 /* return: (output) tree pointer */ 1 191 1 192 declare propagate_bit entry(pointer,fixed binary(15)); 1 193 /* parameter 1: (input) symbol node pointer */ 1 194 /* parameter 2: (input) attribute number */ 1 195 1 196 declare semantic_translator$call_es entry(pointer,pointer,pointer,label,bit(1) aligned) 1 197 returns(pointer); 1 198 /* parameter 1: (input) block ptr */ 1 199 /* parameter 2: (input) statement ptr */ 1 200 /* parameter 3: (input) tree ptr */ 1 201 /* parameter 4: (input) failure label */ 1 202 /* parameter 5: (input) "1"b -- convert to integer */ 1 203 /* return: (output) tree ptr */ 1 204 1 205 declare simplify_expression entry(pointer,fixed bin,bit(1)aligned); 1 206 /* parameter 1: (in/out) tree pointer */ 1 207 /* parameter 2: (output) value of constant, if the entire tree 1 208* is simplified */ 1 209 /* parameter 3: (output) bit indicating if the tree has 1 210* been simplified */ 1 211 1 212 declare simplify_offset entry(pointer,bit(36) aligned); 1 213 /* parameter 1: (input) reference node pointer */ 1 214 /* parameter 2: (input) context */ 1 215 1 216 declare subscripter entry(pointer,pointer,pointer,pointer,pointer) 1 217 returns(pointer); 1 218 /* parameter 1: (input) block node pointer */ 1 219 /* parameter 2: (input) statement node pointer */ 1 220 /* parameter 3: (input) tree pointer */ 1 221 /* parameter 4: (in/out) subscript list pointer */ 1 222 /* parameter 5: (input) symbol node pointer */ 1 223 /* return: (output) reference node pointer */ 1 224 1 225 declare validate entry(pointer); 1 226 /* parameter 1: (input) symbol node pointer */ 1 227 2 1 /****^ ********************************************************* 2 2* * * 2 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 2 4* * * 2 5* ********************************************************* */ 2 6 2 7 /* BEGIN INCLUDE FILE ... language_utility.incl.pl1 */ 2 8 2 9 2 10 /****^ HISTORY COMMENTS: 2 11* 1) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu), 2 12* install(89-07-31,MR12.3-1066): 2 13* Removed the obsolete parameter source_line from the dcl of error_(). 2 14* END HISTORY COMMENTS */ 2 15 2 16 /* Modified: 6 Jun 1979 by PG to add rank and byte 2 17* * Modified: 9 Jul 1989 by RW updated the declaration of error_ 2 18* */ 2 19 2 20 declare adjust_count entry(pointer); 2 21 /* parameter 1: (input) any node pointer */ 2 22 2 23 declare bindec entry(fixed bin(31)) reducible 2 24 returns(character(12) aligned); 2 25 /* parameter 1: (input) bin value */ 2 26 /* return: (output) character value with blanks */ 2 27 2 28 declare bindec$vs entry(fixed bin(31)) reducible 2 29 returns(character(12) aligned varying); 2 30 /* parameter 1: (input) binary value */ 2 31 /* return: (output) char value without blanks */ 2 32 2 33 declare binoct entry(fixed bin(31)) reducible 2 34 returns(char(12) aligned); 2 35 /* parameter 1: (input) binary value */ 2 36 /* return: (output) char value with blanks */ 2 37 2 38 declare binary_to_octal_string entry(fixed bin(31)) reducible 2 39 returns(char(12) aligned); 2 40 /* parameter 1: (input) binary value */ 2 41 /* return: (output) right-aligned char value */ 2 42 2 43 declare binary_to_octal_var_string entry(fixed bin(31)) reducible 2 44 returns(char(12) varying aligned); 2 45 /* parameter 1: (input) binary value */ 2 46 /* returns: (output) char value without blanks */ 2 47 2 48 declare compare_expression entry(pointer,pointer) reducible 2 49 returns(bit(1) aligned); 2 50 /* parameter 1: (input) any node pointer */ 2 51 /* parameter 2: (input) any node pointer */ 2 52 /* return: (output) compare bit */ 2 53 2 54 declare constant_length entry (pointer, fixed bin (71)) 2 55 returns (bit (1) aligned); 2 56 /* parameter 1: (input) reference node pointer */ 2 57 /* parameter 2: (input) value of constant length */ 2 58 /* return: (output) "1"b if constant length */ 2 59 2 60 declare convert entry(pointer,bit(36) aligned) 2 61 returns(pointer); 2 62 /* parameter 1: (input) any node pointer */ 2 63 /* parameter 2: (input) target type */ 2 64 /* return: (output) target value tree pointer */ 2 65 2 66 declare convert$to_integer entry(pointer,bit(36)aligned) 2 67 returns(pointer); 2 68 /* parameter 1: (input) any node pointer */ 2 69 /* parameter 2: (input) target type */ 2 70 /* return: (output) target value tree pointer */ 2 71 2 72 declare convert$from_builtin entry(pointer,bit(36) aligned) 2 73 returns(pointer); 2 74 /* parameter 1: (input) any node pointer */ 2 75 /* parameter 2: (input) target type */ 2 76 /* return: (output) target value tree pointer */ 2 77 2 78 declare convert$validate entry(pointer,pointer); 2 79 /* parameter 1: (input) source value tree pointer */ 2 80 /* parameter 2: (input) target reference node pointer */ 2 81 2 82 declare convert$to_target_fb entry(pointer,pointer) 2 83 returns(pointer); 2 84 /* parameter 1: (input) source value tree pointer */ 2 85 /* parameter 2: (input) target reference node pointer */ 2 86 /* return: (output) target value tree pointer */ 2 87 2 88 declare convert$to_target entry(pointer,pointer) 2 89 returns(pointer); 2 90 /* parameter 1: (input) source value tree pointer */ 2 91 /* parameter 2: (input) target reference node pointer */ 2 92 /* return: (output) target value tree pointer */ 2 93 2 94 declare copy_expression entry(pointer unaligned) 2 95 returns(pointer); 2 96 /* parameter 1: (input) any node pointer */ 2 97 /* return: (output) any node pointer */ 2 98 2 99 declare copy_expression$copy_sons entry(pointer,pointer); 2 100 /* parameter 1: (input) father symbol node pointer */ 2 101 /* parameter 2: (input) stepfather symbol node ptr */ 2 102 2 103 declare copy_unique_expression entry(pointer) 2 104 returns(pointer); 2 105 /* parameter 1: (input) any node pointer */ 2 106 /* return: (output) any node pointer */ 2 107 2 108 declare create_array entry() 2 109 returns(pointer); 2 110 /* return: (output) array node pointer */ 2 111 2 112 declare create_block entry(bit(9) aligned,pointer) 2 113 returns(pointer); 2 114 /* parameter 1: (input) block type */ 2 115 /* parameter 2: (input) father block node pointer */ 2 116 /* return: (output) block node pointer */ 2 117 2 118 declare create_bound entry() 2 119 returns(pointer); 2 120 /* return: (output) bound node pointer */ 2 121 2 122 declare create_context entry(pointer,pointer) 2 123 returns(pointer); 2 124 /* parameter 1: (input) block node pointer */ 2 125 /* parameter 2: (input) token pointer */ 2 126 /* return: (output) context node pointer */ 2 127 2 128 declare create_cross_reference entry() 2 129 returns(pointer); 2 130 /* return: (output) cross reference node pointer */ 2 131 2 132 declare create_default entry 2 133 returns(pointer); 2 134 /* return: (output) default node pointer */ 2 135 2 136 declare create_identifier entry() 2 137 returns(pointer); 2 138 /* return: (output) token node pointer */ 2 139 2 140 declare create_label entry(pointer,pointer,bit(3) aligned) 2 141 returns(pointer); 2 142 /* parameter 1: (input) block node pointer */ 2 143 /* parameter 2: (input) token node pointer */ 2 144 /* parameter 3: (input) declare type */ 2 145 /* return: (output) label node pointer */ 2 146 2 147 declare create_list entry(fixed bin(15)) 2 148 returns(pointer); 2 149 /* parameter 1: (input) number of list elements */ 2 150 /* return: (output) list node pointer */ 2 151 2 152 declare create_operator entry(bit(9) aligned,fixed bin(15)) 2 153 returns(pointer); 2 154 /* parameter 1: (input) operator type */ 2 155 /* parameter 2: (input) number of operands */ 2 156 /* return: (output) operator node pointer */ 2 157 2 158 declare create_reference entry(pointer) 2 159 returns(pointer); 2 160 /* parameter 1: (input) symbol node pointer */ 2 161 /* return: (output) reference node pointer */ 2 162 2 163 declare create_statement entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 2 164 returns(pointer); 2 165 /* parameter 1: (input) statement type */ 2 166 /* parameter 2: (input) block node pointer */ 2 167 /* parameter 3: (input) label node pointer */ 2 168 /* parameter 4: (input) conditions */ 2 169 /* return: (output) statement node pointer */ 2 170 2 171 declare create_statement$prologue entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 2 172 returns(pointer); 2 173 /* parameter 1: (input) statement type */ 2 174 /* parameter 2: (input) block node pointer */ 2 175 /* parameter 3: (input) label node pointer */ 2 176 /* parameter 4: (input) conditions */ 2 177 /* return: (output) statement node pointer */ 2 178 2 179 declare create_storage entry(fixed bin(15)) 2 180 returns(pointer); 2 181 /* parameter 1: (input) number of words */ 2 182 /* return: (output) storage block pointer */ 2 183 2 184 declare create_symbol entry(pointer,pointer,bit(3) aligned) 2 185 returns(pointer); 2 186 /* parameter 1: (input) block node pointer */ 2 187 /* parameter 2: (input) token node pointer */ 2 188 /* parameter 3: (input) declare type */ 2 189 /* return: (output) symbol node pointer */ 2 190 2 191 declare create_token entry (character (*), bit (9) aligned) 2 192 returns (ptr); 2 193 /* parameter 1: (input) token string */ 2 194 /* parameter 2: (input) token type */ 2 195 /* return: (output) token node ptr */ 2 196 2 197 declare create_token$init_hash_table entry (); 2 198 2 199 declare create_token$protected entry (char (*), bit (9) aligned, bit (18) aligned) 2 200 returns (ptr); 2 201 /* parameter 1: (input) token string */ 2 202 /* parameter 2: (input) token type */ 2 203 /* parameter 3: (input) protected flag */ 2 204 /* return: (output) token node ptr */ 2 205 2 206 declare decbin entry(character(*) aligned) reducible 2 207 returns(fixed bin(31)); 2 208 /* parameter 1: (input) decimal character string */ 2 209 /* return: (output) binary value */ 2 210 2 211 declare declare_constant entry(bit(*) aligned,bit(36) aligned,fixed bin(31),fixed bin(15)) 2 212 returns(pointer); 2 213 /* parameter 1: (input) value */ 2 214 /* parameter 2: (input) type */ 2 215 /* parameter 3: (input) size */ 2 216 /* parameter 4: (input) scale */ 2 217 /* return: (output) reference node pointer */ 2 218 2 219 declare declare_constant$bit entry(bit(*) aligned) 2 220 returns(pointer); 2 221 /* parameter 1: (input) bit */ 2 222 /* return: (output) reference node pointer */ 2 223 2 224 declare declare_constant$char entry(character(*) aligned) 2 225 returns(pointer); 2 226 /* parameter 1: (input) character */ 2 227 /* return: (output) reference node pointer */ 2 228 2 229 declare declare_constant$desc entry(bit(*) aligned) 2 230 returns(pointer); 2 231 /* parameter 1: (input) descriptor bit value */ 2 232 /* return: (output) reference node pointer */ 2 233 2 234 declare declare_constant$integer entry(fixed bin(31)) /* note...should really be fixed bin(24) */ 2 235 returns(pointer); 2 236 /* parameter 1: (input) integer */ 2 237 /* return: (output) reference node pointer */ 2 238 2 239 declare declare_descriptor entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 240 returns(pointer); 2 241 /* parameter 1: (input) block node pointer */ 2 242 /* parameter 2: (input) statement node pointer */ 2 243 /* parameter 3: (input) symbol node pointer */ 2 244 /* parameter 4: (input) loc pointer */ 2 245 /* parameter 5: (input) array descriptor bit 2 246* cross_section bit */ 2 247 /* return: (output) reference node pointer */ 2 248 2 249 declare declare_descriptor$ctl entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 250 returns(pointer); 2 251 /* parameter 1: (input) block node pointer */ 2 252 /* parameter 2: (input) statement node pointer */ 2 253 /* parameter 3: (input) symbol node pointer */ 2 254 /* parameter 4: (input) loc pointer */ 2 255 /* parameter 5: (input) array descriptor bit 2 256* cross_section bit */ 2 257 /* return: (output) reference node pointer */ 2 258 2 259 declare declare_descriptor$param entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 260 returns(pointer); 2 261 /* parameter 1: (input) block node pointer */ 2 262 /* parameter 2: (input) statement node pointer */ 2 263 /* parameter 3: (input) symbol node pointer */ 2 264 /* parameter 4: (input) loc pointer */ 2 265 /* parameter 5: (input) array descriptor bit 2 266* cross_section bit */ 2 267 /* return: (output) reference node pointer */ 2 268 2 269 declare declare_integer entry(pointer) 2 270 returns(pointer); 2 271 /* parameter 1: (input) block node pointer */ 2 272 /* return: (output) reference node pointer */ 2 273 2 274 declare declare_picture entry(char(*)aligned,pointer,fixed bin(15)); 2 275 /* parameter 1: (input) picture string */ 2 276 /* parameter 2: (input) symbol node pointer */ 2 277 /* parameter 3: (output) error code, if any */ 2 278 2 279 declare declare_picture_temp entry(char(*) aligned,fixed bin(31),bit(1) aligned,bit(1) aligned) 2 280 returns(pointer); 2 281 /* parameter 1: (input) picture string */ 2 282 /* parameter 2: (input) scalefactor of picture */ 2 283 /* parameter 3: (input) ="1"b => complex picture */ 2 284 /* parameter 4: (input) ="1"b => unaligned temp */ 2 285 /* return: (output) reference node pointer */ 2 286 2 287 declare declare_pointer entry(pointer) 2 288 returns(pointer); 2 289 /* parameter 1: (input) block node pointer */ 2 290 /* return: (output) reference node pointer */ 2 291 2 292 declare declare_temporary entry(bit(36) aligned,fixed bin(31),fixed bin(15),pointer) 2 293 returns(pointer); 2 294 /* parameter 1: (input) type */ 2 295 /* parameter 2: (input) precision */ 2 296 /* parameter 3: (input) scale */ 2 297 /* parameter 4: (input) length */ 2 298 /* return: (output) reference node pointer */ 2 299 2 300 declare decode_node_id entry(pointer,bit(1) aligned) 2 301 returns(char(120) varying); 2 302 /* parameter 1: (input) node pointer */ 2 303 /* parameter 2: (input) ="1"b => capitals */ 2 304 /* return: (output) source line id */ 2 305 2 306 declare decode_source_id entry( 3 1 1 structure unaligned, 3 2 2 /* file_number */ bit(8), 3 3 2 /* line_number */ bit(14), 3 4 2 /* stmt_number */ bit(5), 2 307 2 308 bit(1) aligned) 2 309 returns(char(120) varying); 2 310 /* parameter 1: (input) source id */ 2 311 /* parameter 2: (input) ="1"b => capitals */ 2 312 /* return: (output) source line id */ 2 313 2 314 declare error entry(fixed bin(15),pointer,pointer); 2 315 /* parameter 1: (input) error number */ 2 316 /* parameter 2: (input) statement node pointer or null*/ 2 317 /* parameter 3: (input) token node pointer */ 2 318 2 319 declare error$omit_text entry(fixed bin(15),pointer,pointer); 2 320 /* parameter 1: (input) error number */ 2 321 /* parameter 2: (input) statement node pointer or null*/ 2 322 /* parameter 3: (input) token node pointer */ 2 323 2 324 declare error_ entry(fixed bin(15), 4 1 1 structure unaligned, 4 2 2 /* file_number */ bit(8), 4 3 2 /* line_number */ bit(14), 4 4 2 /* stmt_number */ bit(5), 2 325 2 326 pointer,fixed bin(8),fixed bin(23),fixed bin(11)); 2 327 /* parameter 1: (input) error number */ 2 328 /* parameter 2: (input) statement id */ 2 329 /* parameter 3: (input) any node pointer */ 2 330 /* parameter 4: (input) source segment */ 2 331 /* parameter 5: (input) source starting character */ 2 332 /* parameter 6: (input) source length */ 2 333 2 334 declare error_$no_text entry(fixed bin(15), 5 1 1 structure unaligned, 5 2 2 /* file_number */ bit(8), 5 3 2 /* line_number */ bit(14), 5 4 2 /* stmt_number */ bit(5), 2 335 2 336 pointer); 2 337 /* parameter 1: (input) error number */ 2 338 /* parameter 2: (input) statement id */ 2 339 /* parameter 3: (input) any node pointer */ 2 340 2 341 declare error_$initialize_error entry(); 2 342 2 343 declare error_$finish entry(); 2 344 2 345 declare free_node entry(pointer); 2 346 /* parameter 1: any node pointer */ 2 347 2 348 declare get_array_size entry(pointer,fixed bin(3)); 2 349 /* parameter 1: (input) symbol node pointer */ 2 350 /* parameter 2: (input) units */ 2 351 2 352 declare get_size entry(pointer); 2 353 /* parameter 1: (input) symbol node pointer */ 2 354 2 355 declare merge_attributes external entry(pointer,pointer) 2 356 returns(bit(1) aligned); 2 357 /* parameter 1: (input) target symbol node pointer */ 2 358 /* parameter 2: (input) source symbol node pointer */ 2 359 /* return: (output) "1"b if merge was unsuccessful */ 2 360 2 361 declare optimizer entry(pointer); 2 362 /* parameter 1: (input) root pointer */ 2 363 2 364 declare parse_error entry(fixed bin(15),pointer); 2 365 /* parameter 1: (input) error number */ 2 366 /* parameter 2: (input) any node pointer */ 2 367 2 368 declare parse_error$no_text entry(fixed bin(15),pointer); 2 369 /* parameter 1: (input) error number */ 2 370 /* parameter 2: (input) any node pointer */ 2 371 2 372 declare pl1_error_print$write_out 2 373 entry(fixed bin(15), 6 1 1 structure unaligned, 6 2 2 /* file_number */ bit(8), 6 3 2 /* line_number */ bit(14), 6 4 2 /* stmt_number */ bit(5), 2 374 2 375 pointer,fixed bin(11),fixed bin(31),fixed bin(31),fixed bin(15)); 2 376 /* parameter 1: (input) error number */ 2 377 /* parameter 2: (input) statement identification */ 2 378 /* parameter 3: (input) any node pointer */ 2 379 /* parameter 4: (input) source segment */ 2 380 /* parameter 5: (input) source character index */ 2 381 /* parameter 6: (input) source length */ 2 382 /* parameter 7: (input) source line */ 2 383 2 384 declare pl1_error_print$listing_segment 2 385 entry(fixed bin(15), 7 1 1 structure unaligned, 7 2 2 /* file_number */ bit(8), 7 3 2 /* line_number */ bit(14), 7 4 2 /* stmt_number */ bit(5), 2 386 2 387 pointer); 2 388 /* parameter 1: (input) error number */ 2 389 /* parameter 2: (input) statement identification */ 2 390 /* parameter 3: (input) token node pointer */ 2 391 2 392 declare pl1_print$varying entry(character(*) aligned varying); 2 393 /* parameter 1: (input) string */ 2 394 2 395 declare pl1_print$varying_nl entry(character(*) aligned varying); 2 396 /* parameter 1: (input) string */ 2 397 2 398 declare pl1_print$non_varying entry(character(*) aligned,fixed bin(31)); 2 399 /* parameter 1: (input) string */ 2 400 /* parameter 2: (input) string length or 0 */ 2 401 2 402 declare pl1_print$non_varying_nl entry(character(*) aligned,fixed bin(31)); 2 403 /* parameter 1: (input) string */ 2 404 /* parameter 2: (input) string length or 0 */ 2 405 2 406 declare pl1_print$string_pointer entry(pointer,fixed bin(31)); 2 407 /* parameter 1: (input) string pointer */ 2 408 /* parameter 2: (input) string size */ 2 409 2 410 declare pl1_print$string_pointer_nl entry(pointer,fixed bin(31)); 2 411 /* parameter 1: (input) string pointer */ 2 412 /* parameter 2: (input) string length or 0 */ 2 413 2 414 declare pl1_print$unaligned_nl entry(character(*) unaligned,fixed bin(31)); 2 415 /* parameter 1: (input) string */ 2 416 /* parameter 2: (input) length */ 2 417 2 418 declare pl1_print$for_lex entry (ptr, fixed bin (14), fixed bin (21), fixed bin (21), bit (1) aligned, bit (1) aligned); 2 419 /* parameter 1: (input) ptr to base of source segment */ 2 420 /* parameter 2: (input) line number */ 2 421 /* parameter 3: (input) starting offset in source seg */ 2 422 /* parameter 4: (input) number of chars to copy */ 2 423 /* parameter 5: (input) ON iff shd print line number */ 2 424 /* parameter 6: (input) ON iff line begins in comment */ 2 425 2 426 declare refer_extent entry(pointer,pointer); 2 427 /* parameter 1: (input/output) null,ref node,op node pointer */ 2 428 /* parameter 2: (input) null,ref node,op node pointer */ 2 429 2 430 declare reserve$clear entry() 2 431 returns(pointer); 2 432 /* return: (output) pointer */ 2 433 2 434 declare reserve$declare_lib entry(fixed bin(15)) 2 435 returns(pointer); 2 436 /* parameter 1: (input) builtin function number */ 2 437 /* return: (output) pointer */ 2 438 2 439 declare reserve$read_lib entry(fixed bin(15)) 2 440 returns(pointer); 2 441 /* parameter 1: (input) builtin function number */ 2 442 /* return: (output) pointer */ 2 443 2 444 declare semantic_translator entry(); 2 445 2 446 declare semantic_translator$abort entry(fixed bin(15),pointer); 2 447 /* parameter 1: (input) error number */ 2 448 /* parameter 2: (input) any node pointer */ 2 449 2 450 declare semantic_translator$error entry(fixed bin(15),pointer); 2 451 /* parameter 1: (input) error number */ 2 452 /* parameter 2: (input) any node pointer */ 2 453 2 454 declare share_expression entry(ptr) 2 455 returns(ptr); 2 456 /* parameter 1: (input) usually operator node pointer */ 2 457 /* return: (output) tree pointer or null */ 2 458 2 459 declare token_to_binary entry(ptr) reducible 2 460 returns(fixed bin(31)); 2 461 /* parameter 1: (input) token node pointer */ 2 462 /* return: (output) converted binary value */ 2 463 2 464 /* END INCLUDE FILE ... language_utility.incl.pl1 */ 1 228 1 229 /* END INCLUDE FILE ... semant.incl.pl1 */ 46 47 8 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 8 2 8 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 8 4 8 5 /* format: style3 */ 8 6 dcl 1 operator based aligned, 8 7 2 node_type bit (9) unaligned, 8 8 2 op_code bit (9) unaligned, 8 9 2 shared bit (1) unaligned, 8 10 2 processed bit (1) unaligned, 8 11 2 optimized bit (1) unaligned, 8 12 2 number fixed (14) unaligned, 8 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 8 14 8 15 dcl max_number_of_operands 8 16 fixed bin (15) int static options (constant) initial (32767); 8 17 8 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 48 9 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 9 2 9 3 dcl 1 reference based aligned, 9 4 2 node_type bit(9) unaligned, 9 5 2 array_ref bit(1) unaligned, 9 6 2 varying_ref bit(1) unaligned, 9 7 2 shared bit(1) unaligned, 9 8 2 put_data_sw bit(1) unaligned, 9 9 2 processed bit(1) unaligned, 9 10 2 units fixed(3) unaligned, 9 11 2 ref_count fixed(17) unaligned, 9 12 2 c_offset fixed(24), 9 13 2 c_length fixed(24), 9 14 2 symbol ptr unaligned, 9 15 2 qualifier ptr unaligned, 9 16 2 offset ptr unaligned, 9 17 2 length ptr unaligned, 9 18 2 subscript_list ptr unaligned, 9 19 /* these fields are used by the 645 code generator */ 9 20 2 address structure unaligned, 9 21 3 base bit(3), 9 22 3 offset bit(15), 9 23 3 op bit(9), 9 24 3 no_address bit(1), 9 25 3 inhibit bit(1), 9 26 3 ext_base bit(1), 9 27 3 tag bit(6), 9 28 2 info structure unaligned, 9 29 3 address_in structure, 9 30 4 b dimension(0:7) bit(1), 9 31 4 storage bit(1), 9 32 3 value_in structure, 9 33 4 a bit(1), 9 34 4 q bit(1), 9 35 4 aq bit(1), 9 36 4 string_aq bit(1), 9 37 4 complex_aq bit(1), 9 38 4 decimal_aq bit(1), 9 39 4 b dimension(0:7) bit(1), 9 40 4 storage bit(1), 9 41 4 indicators bit(1), 9 42 4 x dimension(0:7) bit(1), 9 43 3 other structure, 9 44 4 big_offset bit(1), 9 45 4 big_length bit(1), 9 46 4 modword_in_offset bit(1), 9 47 2 data_type fixed(5) unaligned, 9 48 2 bits structure unaligned, 9 49 3 padded_ref bit(1), 9 50 3 aligned_ref bit(1), 9 51 3 long_ref bit(1), 9 52 3 forward_ref bit(1), 9 53 3 ic_ref bit(1), 9 54 3 temp_ref bit(1), 9 55 3 defined_ref bit(1), 9 56 3 evaluated bit(1), 9 57 3 allocate bit(1), 9 58 3 allocated bit(1), 9 59 3 aliasable bit(1), 9 60 3 even bit(1), 9 61 3 perm_address bit(1), 9 62 3 aggregate bit(1), 9 63 3 hit_zero bit(1), 9 64 3 dont_save bit(1), 9 65 3 fo_in_qual bit(1), 9 66 3 hard_to_load bit(1), 9 67 2 relocation bit(12) unaligned, 9 68 2 more_bits structure unaligned, 9 69 3 substr bit(1), 9 70 3 padded_for_store_ref bit(1), 9 71 3 aligned_for_store_ref bit(1), 9 72 3 mbz bit(15), 9 73 2 store_ins bit(18) unaligned; 9 74 9 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 49 10 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 10 2 10 3 dcl 1 symbol based aligned, 10 4 2 node_type bit(9) unal, 10 5 2 source_id structure unal, 10 6 3 file_number bit(8), 10 7 3 line_number bit(14), 10 8 3 statement_number bit(5), 10 9 2 location fixed(18) unal unsigned, 10 10 2 allocated bit(1) unal, 10 11 2 dcl_type bit(3) unal, 10 12 2 reserved bit(6) unal, 10 13 2 pix unal, 10 14 3 pic_fixed bit(1) unal, 10 15 3 pic_float bit(1) unal, 10 16 3 pic_char bit(1) unal, 10 17 3 pic_scale fixed(7) unal, 10 18 3 pic_size fixed(7) unal, 10 19 2 level fixed(8) unal, 10 20 2 boundary fixed(3) unal, 10 21 2 size_units fixed(3) unal, 10 22 2 scale fixed(7) unal, 10 23 2 runtime bit(18) unal, 10 24 2 runtime_offset bit(18) unal, 10 25 2 block_node ptr unal, 10 26 2 token ptr unal, 10 27 2 next ptr unal, 10 28 2 multi_use ptr unal, 10 29 2 cross_references ptr unal, 10 30 2 initial ptr unal, 10 31 2 array ptr unal, 10 32 2 descriptor ptr unal, 10 33 2 equivalence ptr unal, 10 34 2 reference ptr unal, 10 35 2 general ptr unal, 10 36 2 father ptr unal, 10 37 2 brother ptr unal, 10 38 2 son ptr unal, 10 39 2 word_size ptr unal, 10 40 2 bit_size ptr unal, 10 41 2 dcl_size ptr unal, 10 42 2 symtab_size ptr unal, 10 43 2 c_word_size fixed(24), 10 44 2 c_bit_size fixed(24), 10 45 2 c_dcl_size fixed(24), 10 46 10 47 2 attributes structure aligned, 10 48 3 data_type structure unal, 10 49 4 structure bit(1) , 10 50 4 fixed bit(1), 10 51 4 float bit(1), 10 52 4 bit bit(1), 10 53 4 char bit(1), 10 54 4 ptr bit(1), 10 55 4 offset bit(1), 10 56 4 area bit(1), 10 57 4 label bit(1), 10 58 4 entry bit(1), 10 59 4 file bit(1), 10 60 4 arg_descriptor bit(1), 10 61 4 storage_block bit(1), 10 62 4 explicit_packed bit(1), /* options(packed) */ 10 63 4 condition bit(1), 10 64 4 format bit(1), 10 65 4 builtin bit(1), 10 66 4 generic bit(1), 10 67 4 picture bit(1), 10 68 10 69 3 misc_attributes structure unal, 10 70 4 dimensioned bit(1), 10 71 4 initialed bit(1), 10 72 4 aligned bit(1), 10 73 4 unaligned bit(1), 10 74 4 signed bit(1), 10 75 4 unsigned bit(1), 10 76 4 precision bit(1), 10 77 4 varying bit(1), 10 78 4 local bit(1), 10 79 4 decimal bit(1), 10 80 4 binary bit(1), 10 81 4 real bit(1), 10 82 4 complex bit(1), 10 83 4 variable bit(1), 10 84 4 reducible bit(1), 10 85 4 irreducible bit(1), 10 86 4 returns bit(1), 10 87 4 position bit(1), 10 88 4 internal bit(1), 10 89 4 external bit(1), 10 90 4 like bit(1), 10 91 4 member bit(1), 10 92 4 non_varying bit(1), 10 93 4 options bit(1), 10 94 4 variable_arg_list bit(1), /* options(variable) */ 10 95 4 alloc_in_text bit(1), /* options(constant) */ 10 96 10 97 3 storage_class structure unal, 10 98 4 auto bit(1), 10 99 4 based bit(1), 10 100 4 static bit(1), 10 101 4 controlled bit(1), 10 102 4 defined bit(1), 10 103 4 parameter bit(1), 10 104 4 param_desc bit(1), 10 105 4 constant bit(1), 10 106 4 temporary bit(1), 10 107 4 return_value bit(1), 10 108 10 109 3 file_attributes structure unal, 10 110 4 print bit(1), 10 111 4 input bit(1), 10 112 4 output bit(1), 10 113 4 update bit(1), 10 114 4 stream bit(1), 10 115 4 reserved_1 bit(1), 10 116 4 record bit(1), 10 117 4 sequential bit(1), 10 118 4 direct bit(1), 10 119 4 interactive bit(1), /* env(interactive) */ 10 120 4 reserved_2 bit(1), 10 121 4 reserved_3 bit(1), 10 122 4 stringvalue bit(1), /* env(stringvalue) */ 10 123 4 keyed bit(1), 10 124 4 reserved_4 bit(1), 10 125 4 environment bit(1), 10 126 10 127 3 compiler_developed structure unal, 10 128 4 aliasable bit(1), 10 129 4 packed bit(1), 10 130 4 passed_as_arg bit(1), 10 131 4 allocate bit(1), 10 132 4 set bit(1), 10 133 4 exp_extents bit(1), 10 134 4 refer_extents bit(1), 10 135 4 star_extents bit(1), 10 136 4 isub bit(1), 10 137 4 put_in_symtab bit(1), 10 138 4 contiguous bit(1), 10 139 4 put_data bit(1), 10 140 4 overlayed bit(1), 10 141 4 error bit(1), 10 142 4 symtab_processed bit(1), 10 143 4 overlayed_by_builtin bit(1), 10 144 4 defaulted bit(1), 10 145 4 connected bit(1); 10 146 10 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 50 11 1 dcl 1 array based aligned, 11 2 2 node_type bit(9) unaligned, 11 3 2 reserved bit(34) unaligned, 11 4 2 number_of_dimensions fixed(7) unaligned, 11 5 2 own_number_of_dimensions fixed(7) unaligned, 11 6 2 element_boundary fixed(3) unaligned, 11 7 2 size_units fixed(3) unaligned, 11 8 2 offset_units fixed(3) unaligned, 11 9 2 interleaved bit(1) unaligned, 11 10 2 c_element_size fixed(24), 11 11 2 c_element_size_bits fixed(24), 11 12 2 c_virtual_origin fixed(24), 11 13 2 element_size ptr unaligned, 11 14 2 element_size_bits ptr unaligned, 11 15 2 virtual_origin ptr unaligned, 11 16 2 symtab_virtual_origin ptr unaligned, 11 17 2 symtab_element_size ptr unaligned, 11 18 2 bounds ptr unaligned, 11 19 2 element_descriptor ptr unaligned; 11 20 11 21 dcl 1 bound based aligned, 11 22 2 node_type bit(9), 11 23 2 c_lower fixed(24), 11 24 2 c_upper fixed(24), 11 25 2 c_multiplier fixed(24), 11 26 2 c_desc_multiplier fixed(24), 11 27 2 lower ptr unaligned, 11 28 2 upper ptr unaligned, 11 29 2 multiplier ptr unaligned, 11 30 2 desc_multiplier ptr unaligned, 11 31 2 symtab_lower ptr unaligned, 11 32 2 symtab_upper ptr unaligned, 11 33 2 symtab_multiplier ptr unaligned, 11 34 2 next ptr unaligned; 51 12 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 12 2 12 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 12 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 12 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 12 6 /* Modified: 26 July 82 BIM wordno, segno */ 12 7 12 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 12 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 12 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 12 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 12 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 12 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 12 14 12 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 12 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 12 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 12 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 12 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 12 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 12 21 12 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 12 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 12 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 12 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 12 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 12 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 12 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 12 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 12 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 12 31 12 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 12 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 12 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 12 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 12 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 12 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 12 38 12 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 12 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 12 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 12 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 12 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 12 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 12 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 12 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 12 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 12 48 12 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 12 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 12 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 12 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 12 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 12 54 return_string initial("001100110"b), /* return string opnd(1) */ 12 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 12 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 12 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 12 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 12 59 std_return initial("001101011"b), /* return -no arguments- */ 12 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 12 61 free_ctl initial("001101101"b), /* free opnd(1) */ 12 62 stop initial("001101110"b), /* stop - terminate run unit */ 12 63 12 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 12 65* opnd(2) <- opnd(3) / 36 */ 12 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 12 67* opnd(2) <- opnd(3) / 4 */ 12 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 12 69* opnd(2) <- opnd(3) / 2 */ 12 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 12 71 12 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 12 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 12 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 12 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 12 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 12 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 12 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 12 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 12 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 12 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 12 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 12 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 12 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 12 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 12 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 12 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 12 88 12 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 12 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 12 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 12 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 12 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 12 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 12 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 12 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 12 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 12 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 12 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 12 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 12 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 12 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 12 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 12 104 12 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 12 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 12 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 12 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 12 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 12 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 12 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 12 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 12 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 12 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 12 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 12 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 12 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 12 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 12 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 12 120 12 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 12 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 12 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 12 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 12 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 12 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 12 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 12 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 12 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 12 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 12 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 12 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 12 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 12 134 12 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 12 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 12 137 12 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 12 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 12 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 12 141* opnd(2) is the file name 12 142* opnd(3) is the block */ 12 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 12 144* opnd(2) is the file name */ 12 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 12 146* opnd(2) is the file name */ 12 147 12 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 12 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 12 150* opnd(3) is old value, (4) is new value. */ 12 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 12 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 12 153 12 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 12 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 12 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 12 157* opnd(5) is the list */ 12 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 12 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 12 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 12 161 12 162 r_parn initial("011110001"b), /* format op code */ 12 163 l_parn initial("011110010"b), 12 164 r_format initial("011110011"b), 12 165 c_format initial("011110100"b), 12 166 f_format initial("011110101"b), 12 167 e_format initial("011110110"b), 12 168 b_format initial("011110111"b), 12 169 a_format initial("011111000"b), 12 170 x_format initial("011111001"b), 12 171 skip_format initial("011111010"b), 12 172 column_format initial("011111011"b), 12 173 page_format initial("011111100"b), 12 174 line_format initial("011111101"b), 12 175 picture_format initial("011111110"b), 12 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 12 177 12 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 12 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 12 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 12 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 12 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 12 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 12 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 12 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 12 186 record_io initial("100001000"b), /* perform record io operation */ 12 187 fortran_read initial("100001001"b), /* A complete read statement */ 12 188 fortran_write initial("100001010"b), /* A complete write statement */ 12 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 12 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 12 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 12 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 12 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 12 194 12 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 12 196 /* They are processed by the semantic translator. */ 12 197 12 198 return_value initial("100010010"b), /* return(opnd(1)) */ 12 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 12 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 12 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 12 202 /* opnd(3) is skip, opnd(4) is list */ 12 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 12 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 12 205 /* opnd(3) is skip,opnd(4) is line */ 12 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 12 207 open_file initial("100011001"b), 12 208 close_file initial("100011010"b), 12 209 read_file initial("100011011"b), 12 210 write_file initial("100011100"b), 12 211 locate_file initial("100011101"b), 12 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 12 213 /* opnd(2) is control variable ref */ 12 214 /* opnd(3) is specification operator */ 12 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 12 216 /* repeat opnd(4) while opnd(5) */ 12 217 /* opnd(6) is next specification */ 12 218 12 219 rewrite_file initial("100100000"b), 12 220 delete_file initial("100100001"b), 12 221 unlock_file initial("100100010"b), 12 222 lock_file initial("100100011"b), 12 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 12 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 12 225 nop initial("100100111"b), /* no-op */ 12 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 12 227 12 228 /* These operators are produced by the semantic translator in processing the math 12 229* builtin functions and are used as input to the code generator */ 12 230 12 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 12 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 12 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 12 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 12 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 12 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 12 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 12 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 12 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 12 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 12 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 12 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 12 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 12 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 12 245 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 12 246 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 12 247 12 248 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 12 249 12 250 bit(9) aligned internal static options(constant); 12 251 12 252 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 52 13 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 13 2 13 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 13 4 13 5 dcl ( block_node initial("000000001"b), 13 6 statement_node initial("000000010"b), 13 7 operator_node initial("000000011"b), 13 8 reference_node initial("000000100"b), 13 9 token_node initial("000000101"b), 13 10 symbol_node initial("000000110"b), 13 11 context_node initial("000000111"b), 13 12 array_node initial("000001000"b), 13 13 bound_node initial("000001001"b), 13 14 format_value_node initial("000001010"b), 13 15 list_node initial("000001011"b), 13 16 default_node initial("000001100"b), 13 17 machine_state_node initial("000001101"b), 13 18 source_node initial("000001110"b), 13 19 label_node initial("000001111"b), 13 20 cross_reference_node initial("000010000"b), 13 21 sf_par_node initial("000010001"b), 13 22 temporary_node initial("000010010"b), 13 23 label_array_element_node initial("000010011"b), 13 24 by_name_agg_node initial("000010100"b)) 13 25 bit(9) internal static aligned options(constant); 13 26 13 27 dcl 1 node based aligned, 13 28 2 type unal bit(9), 13 29 2 source_id unal structure, 13 30 3 file_number bit(8), 13 31 3 line_number bit(14), 13 32 3 statement_number bit(5); 13 33 13 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 53 14 1 /* BEGIN INCLUDE FILE ... system.incl.pl1 */ 14 2 14 3 /* Modified: 25 Apr 1979 by PCK to implemnt 4-bit decimal */ 14 4 14 5 dcl ( max_p_flt_bin_1 initial(27), 14 6 max_p_flt_bin_2 initial(63), 14 7 max_p_fix_bin_1 initial(35), 14 8 max_p_fix_bin_2 initial(71), 14 9 14 10 max_p_dec initial(59), 14 11 max_p_bin_or_dec initial (71), /* max (max_p_fix_bin_2, max_p_dec) */ 14 12 14 13 min_scale initial(-128), 14 14 max_scale initial(+127), 14 15 max_bit_string initial(9437184), 14 16 max_char_string initial(1048576), 14 17 max_area_size initial(262144), 14 18 min_area_size initial(28), 14 19 14 20 max_bit_string_constant initial (253), /* max length of bit literals */ 14 21 max_char_string_constant initial (254), /* max length of character literals */ 14 22 max_identifier_length initial (256), 14 23 max_number_of_dimensions initial (127), 14 24 14 25 max_length_precision initial(24), 14 26 max_offset_precision initial(24), /* 18 bits for word offset + 6 bits for bit offset */ 14 27 14 28 max_words_per_variable initial (262144), 14 29 14 30 bits_per_word initial(36), 14 31 bits_per_double initial(72), 14 32 packed_digits_per_character initial(2), 14 33 characters_per_half initial(2), 14 34 characters_per_word initial(4), 14 35 characters_per_double initial(8), 14 36 14 37 bits_per_character initial(9), 14 38 bits_per_half initial(18), 14 39 bits_per_decimal_digit initial(9), 14 40 bits_per_binary_exponent initial(8), 14 41 bits_per_packed_ptr initial(36), 14 42 words_per_packed_pointer initial(1), 14 43 14 44 words_per_fix_bin_1 initial(1), 14 45 words_per_fix_bin_2 initial(2), 14 46 words_per_flt_bin_1 initial(1), 14 47 words_per_flt_bin_2 initial(2), 14 48 words_per_varying_string_header initial(1), 14 49 words_per_offset initial(1), 14 50 words_per_pointer initial(2), 14 51 words_per_label_var initial(4), 14 52 words_per_entry_var initial(4), 14 53 words_per_file_var initial(4), 14 54 words_per_format initial(4), 14 55 words_per_condition_var initial(6), 14 56 14 57 max_index_register_value initial(262143), 14 58 max_signed_index_register_value initial(131071), 14 59 14 60 max_signed_xreg_precision initial(17), 14 61 max_uns_xreg_precision initial(18), 14 62 14 63 default_area_size initial(1024), 14 64 default_flt_bin_p initial(27), 14 65 default_fix_bin_p initial(17), 14 66 default_flt_dec_p initial(10), 14 67 default_fix_dec_p initial(7)) fixed bin(31) internal static options(constant); 14 68 14 69 dcl bits_per_digit initial(4.5) fixed bin(31,1) internal static options(constant); 14 70 14 71 dcl ( integer_type initial("010000000000000000000100000001100000"b), 14 72 dec_integer_type initial("010000000000000000000100000010100000"b), 14 73 pointer_type initial("000001000000000000000100000000000000"b), 14 74 real_type initial("001000000000000000000100000001100000"b), 14 75 complex_type initial("001000000000000000000100000001010000"b), 14 76 builtin_type initial("000000000000000010000000000000000000"b), 14 77 storage_block_type initial("000000000000100000000000000000000000"b), 14 78 arg_desc_type initial("000000000001000000000000000000000000"b), 14 79 local_label_var_type initial("000000001000000000000100000100001000"b), 14 80 entry_var_type initial("000000000100000000000000000000001000"b), 14 81 bit_type initial("000100000000000000000000000000000000"b), 14 82 char_type initial("000010000000000000000000000000000000"b)) bit(36) aligned int static 14 83 options(constant); 14 84 14 85 /* END INCLUDE FILE ... system.incl.pl1 */ 54 15 1 /* BEGIN INCLUDE FILE ... boundary.incl.pl1 */ 15 2 15 3 /* Modified: 26 Apr 1979 by PCK to implement 4-bit decimal */ 15 4 15 5 dcl ( bit_ init(1), 15 6 digit_ init(2), 15 7 character_ init(3), 15 8 half_ init(4), 15 9 word_ init(5), 15 10 mod2_ init(6), 15 11 mod4_ init(7)) fixed bin(3) int static options(constant); 15 12 15 13 /* END INCLUDE FILE ... boundary.incl.pl1 */ 55 16 1 /* BEGIN INCLUDE FILE ... semantic_bits.incl.pl1 */ 16 2 16 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 16 4 16 5 dcl context aligned bit(36), 16 6 this_context aligned bit(36); 16 7 16 8 dcl 1 def_context aligned based(addr(context)), 16 9 2 aggregate unaligned bit(1), 16 10 2 arg_list unaligned bit(1), 16 11 2 left_side unaligned bit(1), 16 12 2 return unaligned bit(1), 16 13 2 evaluate_offset unaligned bit(1), 16 14 2 top unaligned bit(1), 16 15 2 RHS_aggregate unaligned bit(1), 16 16 2 return_from_empty unaligned bit(1), 16 17 2 ignore_based unaligned bit(1), 16 18 2 ext_param unaligned bit(1), 16 19 2 cross_section unaligned bit(1), 16 20 2 string_unspec unaligned bit(1), 16 21 2 f_offset_to_be_added unaligned bit(1), 16 22 2 suppress_cross_ref unaligned bit(1), 16 23 2 by_name_assignment unaligned bit(1), 16 24 2 by_name_lookup unaligned bit(1), 16 25 2 pad unaligned bit(20); 16 26 16 27 dcl 1 def_this_context aligned like def_context based(addr(this_context)); 16 28 16 29 /* END INCLUDE FILE ... semantic_bits.incl.pl1 */ 56 57 58 /* */ 59 60 q = pt; 61 62 s = q -> reference.symbol; 63 64 has_offset, ok_to_free = "1"b; 65 66 /* following code attempts to reduce precision of length 67* expression; it checks if index register can be used 68* to hold length */ 69 70 p1 = q -> reference.length; 71 if p1 ^= null 72 then if p1 -> node.type = operator_node 73 then do; 74 if s -> symbol.dcl_size ^= null 75 then fix_precision = max_length_precision; 76 else if s -> symbol.c_dcl_size >= max_index_register_value 77 then fix_precision = max_length_precision; 78 else fix_precision = max_signed_xreg_precision; 79 80 /* ok to reduce precision of expression */ 81 82 if fix_precision = max_signed_xreg_precision 83 | p1 -> operand(1) -> reference.symbol -> symbol.c_dcl_size > max_p_fix_bin_1 84 then if p1 -> operator.op_code = assign 85 then do; 86 p2 = fix_exp((p1 -> operand(2))); 87 88 if fb_value(p2) 89 then if p2 -> symbol.c_dcl_size <= fix_precision 90 then if p2 -> symbol.scale = 0 91 then do; 92 q -> reference.length = p1 -> operand(2); 93 call free_op(p1); 94 end; 95 end; 96 else p2 = fix_exp(p1); 97 end; 98 99 /* following code uses modword_in_offset to discover if no further processing 100* of offset expression is possible */ 101 102 if q -> reference.modword_in_offset 103 then return; 104 /* following code attempts to simplify offset expressions of the form 105* 106* c 107* exp + c 108* exp - c 109* c + exp 110* 111* c1 * c2 112* c1 * (exp + c2) 113* c1 * (exp - c2) 114* c1 * (c2 + exp) 115* */ 116 117 p1 = q -> reference.offset; 118 if p1 = null 119 then do; 120 call check_addr; 121 goto ret; 122 end; 123 124 /* The following block of code is necessary because the 6180 will not allow 125* variable fractional offsets to be negative */ 126 127 orig_c_offset = q -> reference.c_offset; 128 129 fractional_offset_to_be_added = def_context.f_offset_to_be_added; 130 131 if q -> reference.units < word_ | fractional_offset_to_be_added 132 then do; 133 p2 = s -> symbol.reference; 134 if q -> reference.units = p2 -> reference.units 135 then start_gen_storage = p2 -> reference.c_offset; 136 else start_gen_storage = divide(convert_offset(p2 -> reference.units) * p2 -> reference.c_offset, 137 convert_offset(q -> reference.units),31,0); 138 orig_c_offset = max(start_gen_storage,orig_c_offset); 139 end; 140 141 /* *********************************************************************** */ 142 143 called_fix_exp = "0"b; 144 145 simplify: if p1 -> node.type ^= operator_node 146 then do; 147 148 s1 = p1 -> reference.symbol; 149 150 if fb1_const(s1) 151 then do; 152 q -> reference.offset = null; 153 q -> reference.c_offset = q -> reference.c_offset + s1 -> symbol.initial -> fix_bin; 154 call check_addr; 155 goto ret; 156 end; 157 158 goto ret; 159 end; 160 161 op_code = p1 -> operator.op_code; 162 163 if op_code = add 164 then do; 165 sign = 1; 166 goto l1; 167 end; 168 169 if op_code = sub 170 then do; 171 sign = -1; 172 173 l1: p2 = p1 -> operand(3); 174 if p2 -> node.type ^= reference_node then goto simp1; 175 176 s2 = p2 -> reference.symbol; 177 178 if fb1_const(s2) 179 then do; 180 181 /* eliminate the add or sub operator and absorb the constant */ 182 183 q -> reference.offset = check_exp((p1 -> operand(2))); 184 185 absorb: call free_op(p1); 186 p1 = q -> reference.offset; 187 188 q -> reference.c_offset = q -> reference.c_offset + sign * 189 s2 -> symbol.initial -> fix_bin; 190 goto simplify; 191 end; 192 193 simp1: if sign < 0 then goto check_sub; 194 195 p2 = p1 -> operand(2); 196 if p2 -> node.type ^= reference_node 197 then do; 198 199 /* The following code tries to improve the precision of the 200* offset expression to 17, 18, or 24 depending on the offset 201* units and the size of the variable */ 202 203 replace: 204 if called_fix_exp then goto rep; 205 206 lower_precision = max_signed_xreg_precision; 207 208 if q -> reference.units < word_ & ^ q -> reference.modword_in_offset 209 | fractional_offset_to_be_added 210 then do; 211 fix_precision = max_offset_precision; 212 if s -> symbol.dcl_size ^= null then goto set_bit; 213 if s -> symbol.c_dcl_size > max_index_register_value then goto set_bit; 214 if s -> symbol.c_dcl_size > max_signed_index_register_value 215 & fractional_offset_to_be_added 216 then lower_precision = max_uns_xreg_precision; 217 218 r = q; 219 sym = s; 220 start_generation = start_gen_storage; 221 222 check_again: 223 f = sym; 224 225 if sym -> symbol.member 226 then do; 227 228 /* can't reduce precision if member has offset 229* expression */ 230 231 if sym -> symbol.reference -> reference.offset ^= null 232 then goto set_bit; 233 234 if sym -> symbol.dimensioned 235 then do f = sym repeat f -> symbol.father 236 while(f -> symbol.array -> array.own_number_of_dimensions 237 ^= f -> symbol.array -> array.number_of_dimensions); 238 end; 239 end; 240 241 if f -> symbol.bit_size ^= null then go to set_bit; 242 243 /* the next block of code determines if the maximum 244* variable offset will fit in an index register. 245* The maximum offset is calculated in n. */ 246 247 n = f -> symbol.c_bit_size; 248 n = divide(n, convert_offset(q -> reference.units), 24, 0); 249 250 n = n + start_generation - q -> reference.c_offset; 251 252 if n >= max_index_register_value then goto set_bit; 253 if n >= max_signed_index_register_value 254 & fractional_offset_to_be_added 255 then lower_precision = max_uns_xreg_precision; 256 257 if sym -> symbol.defined 258 then do; 259 260 /* have to do same check on all those we are 261* defined on */ 262 263 r = r -> reference.qualifier; 264 if r -> node.type = operator_node 265 then r = r -> operand(1); 266 sym = r -> reference.symbol; 267 symref = sym -> symbol.reference; 268 269 if symref -> reference.c_offset ^= 0 270 then do; 271 if q -> reference.units = symref -> reference.units 272 then start_generation = symref -> reference.c_offset; 273 else start_generation = 274 divide(convert_offset(symref->reference.units) * symref->reference.c_offset, 275 convert_offset(q->reference.units), 31, 0); 276 end; 277 else start_generation = 0; 278 go to check_again; 279 end; 280 end; 281 282 fix_precision = lower_precision; 283 284 set_bit: called_fix_exp = "1"b; 285 286 if fix_precision = max_length_precision 287 then if p1 -> operand(1) -> reference.symbol -> symbol.c_dcl_size <= max_p_fix_bin_1 288 then go to rep; 289 290 if p1 -> operator.op_code = assign 291 then do; 292 p2 = fix_exp((p1 -> operand(2))); 293 if fb_value(p2) 294 then if p2 -> symbol.c_dcl_size <= fix_precision 295 then if p2 -> symbol.scale = 0 296 then do; 297 p2 = p1 -> operand(2); 298 call free_op(p1); 299 p1, q -> reference.offset = p2; 300 goto simplify; 301 end; 302 end; 303 else do; 304 if substr(p1 -> operator.op_code,1,5) = substr(mod_bit,1,5) 305 then p2 = p1 -> operand(3); else p2 = p1; 306 p2 = fix_exp(p2); 307 end; 308 309 goto rep; 310 end; 311 312 s2 = p2 -> reference.symbol; 313 314 if fb1_const(s2) 315 then do; 316 q -> reference.offset = check_exp((p1 -> operand(3))); 317 goto absorb; 318 end; 319 320 goto replace; 321 322 /* the following code tries to catch 323* exp - exp 324* which gets eliminated, 325* (exp1 + exp2) - exp1 326* which gets simplified, and 327* exp1 * exp2 - exp1 328* which gets converted to 329* (exp2 - 1) * exp1 330* with obvious simplifcation when exp2 is a constant */ 331 332 check_sub: 333 if compare_expression((p1 -> operand(2)),(p1 -> operand(3))) 334 then do; 335 call free_exp(p1); 336 p1 = null; 337 call check_addr; 338 goto rep; 339 end; 340 341 p2 = p1 -> operand(2); 342 if p2 -> node.type ^= operator_node then goto replace; 343 344 if p2 -> operator.op_code = add 345 then do; 346 if compare_expression((p2 -> operand(2)),(p1 -> operand(3))) 347 then do; 348 q -> reference.offset = check_exp((p2 -> operand(3))); 349 elim_sub: 350 call free_op(p1); 351 p2 = check_exp(p2); 352 call free_op(p2); 353 p1 = q -> reference.offset; 354 go to simplify; 355 end; 356 357 if compare_expression((p2 -> operand(3)),(p1 -> operand(3))) 358 then do; 359 q -> reference.offset = check_exp((p2 -> operand(2))); 360 go to elim_sub; 361 end; 362 363 go to replace; 364 end; 365 366 if p2 -> operator.op_code ^= mult then goto replace; 367 368 if ^ compare_expression((p2 -> operand(2)),(p1 -> operand(3))) then goto replace; 369 370 p3 = p2 -> operand(3); 371 if p3 -> node.type ^= reference_node 372 then do; 373 switch: p1 -> operator.op_code = mult; 374 p2 -> operator.op_code = sub; 375 p2 -> operand(2) = p3; 376 p2 -> operand(3) = declare_constant$integer(1); 377 378 p3 = p1 -> operand(1); 379 p1 -> operand(1) = p2 -> operand(1); 380 p2 -> operand(1) = p3; 381 goto replace; 382 end; 383 384 s3 = p3 -> reference.symbol; 385 if ^ fb1_const(s3) then goto switch; 386 387 p1 -> operand(2) = declare_constant$integer(s3 -> symbol.initial -> fix_bin - 1); 388 p1 -> operand(1) = p2 -> operand(1); 389 p1 -> operator.op_code = mult; 390 391 goto replace; 392 end; 393 394 if op_code ^= mult then goto replace; 395 396 p2 = p1 -> operand(2); 397 if p2 -> node.type ^= reference_node then goto check_mb; 398 399 s2 = p2 -> reference.symbol; 400 if ^ fb1_const(s2) then goto check_mb; 401 402 again: p3 = p1 -> operand(3); 403 if p3->node.type^=operator_node 404 then do; 405 s3 = p3->reference.symbol; 406 407 if fb1_const(s3) 408 then do; 409 q -> reference.offset = null; 410 q -> reference.c_offset = q -> reference.c_offset + s2 -> symbol.initial -> fix_bin * s3 -> symbol.initial -> fix_bin; 411 call free_op(p1); 412 call check_addr; 413 goto ret; 414 end; 415 else goto check_mb; 416 end; 417 418 if p3 -> operator.op_code = add then sign = 1; 419 else if p3 -> operator.op_code = sub then sign = -1; 420 else goto check_mb; 421 422 p4 = p3 -> operand(3); 423 if p4 -> node.type ^= reference_node then goto check_mb; 424 425 s4 = p4 -> reference.symbol; 426 if fb1_const(s4) 427 then do; 428 p1 -> operand(3) = p3 -> operand(2); 429 alter: call free_op(p3); 430 q -> reference.c_offset = q -> reference.c_offset + sign * 431 s2 -> symbol.initial -> fix_bin * s4 -> symbol.initial -> fix_bin; 432 goto again; 433 end; 434 435 if sign < 0 then goto check_mb; 436 437 p4 = p3 -> operand(2); 438 if p4 -> node.type ^= reference_node then goto check_mb; 439 440 s4 = p4 -> reference.symbol; 441 442 if fb1_const(s4) 443 then do; 444 p1 -> operand(3) = p3 -> operand(3); 445 goto alter; 446 end; 447 448 check_mb: if q -> reference.fo_in_qual then goto replace; 449 450 /* following code attempts to recognize references to items 451* which have a constant bit offset and a variable word offset; 452* the offset expression for this type of reference is 453* mult(t4,exp,multiple_of_bits_per_word) */ 454 455 if q -> reference.units >= word_ then goto replace; 456 457 if q -> reference.length ^= null then goto replace; 458 if s -> symbol.decimal then goto replace; 459 if s -> symbol.bit 460 then if q -> reference.c_length > bits_per_double 461 then goto replace; 462 else; 463 else if s -> symbol.char | s -> symbol.picture 464 then if q -> reference.c_length > characters_per_double 465 then goto replace; 466 467 if q -> reference.units = bit_ then factor = 1; 468 else factor = bits_per_character; 469 470 p3 = p1 -> operand(3); 471 if p3 -> node.type ^= reference_node then goto replace; 472 473 s3 = p3 -> reference.symbol; 474 if ^ fb1_const(s3) then goto replace; 475 476 bit_offset = s3 -> symbol.initial -> fix_bin * factor; 477 if mod(bit_offset,bits_per_word) ^= 0 then goto replace; 478 479 /* found it, mark the reference and eliminate 480* or change mult operator */ 481 482 multiple = divide(bit_offset,bits_per_word,31,0); 483 c_bit_offset = q -> reference.c_offset * factor; 484 485 if mod(c_bit_offset,bits_per_word) ^= 0 486 then do; 487 488 if multiple = 1 489 then do; 490 q -> reference.offset = check_exp((p1 -> operand(2))); 491 call free_op(p1); 492 p1 = q -> reference.offset; 493 end; 494 495 else p1 -> operand(3) = declare_constant$integer(multiple); 496 497 q -> reference.modword_in_offset = "1"b; 498 has_offset = "0"b; 499 end; 500 501 else do; 502 503 /* we probably shouldn't have gotten here, 504* but we'll improve units to word_ and 505* forget about marking the reference */ 506 507 q -> reference.c_offset = divide(c_bit_offset,bits_per_word,24,0); 508 q -> reference.units = word_; 509 510 if multiple = 1 511 then do; 512 q -> reference.offset = check_exp((p1 -> operand(2))); 513 call free_op(p1); 514 p1 = q -> reference.offset; 515 go to simplify; 516 end; 517 else p1 -> operand(3) = declare_constant$integer(multiple); 518 end; 519 520 if p1 -> node.type = operator_node 521 then goto replace; 522 523 rep: 524 q->reference.offset = p1; 525 526 ret: 527 if q -> reference.units = 0 528 then return; 529 530 if q -> reference.units = word_ 531 then do; 532 if has_offset 533 then if abs(q -> reference.c_offset) > max_index_register_value 534 then call restore_orig_c_offset; 535 return; 536 end; 537 538 if q->reference.units = bit_ 539 then if ^ s -> symbol.bit 540 then if s->symbol.char 541 | s->symbol.decimal 542 | s->symbol.picture 543 then do; 544 q->reference.units = character_; 545 q->reference.c_offset = divide(q->reference.c_offset,bits_per_character,17,0); 546 orig_c_offset = divide(orig_c_offset,bits_per_character,31,0); 547 548 p1 = q->reference.offset; 549 if p1=null 550 then go to check_neg; 551 552 if q->reference.modword_in_offset 553 then goto check_neg; 554 555 if p1->node.type=operator_node 556 then do; 557 if p1->operator.op_code=mult 558 then do i = 2 to 3; 559 p3 = p1->operand(i); 560 561 if p3->node.type=reference_node 562 then do; 563 s3 = p3->reference.symbol; 564 565 if fb1_const(s3) 566 then do; 567 bit_offset = s3->symbol.initial->fix_bin; 568 if bit_offset=bits_per_character 569 then do; 570 q->reference.offset = check_exp((p1->operand(5-i))); 571 call free_op(p1); 572 p1 = q->reference.offset; 573 574 goto simplify; 575 end; 576 else if mod(bit_offset,bits_per_character) = 0 577 then if p1->operand(1)->reference.ref_count <= 1 578 then do; 579 multiple = divide(bit_offset,bits_per_character,31,0); 580 p1->operand(i) = declare_constant$integer(multiple); 581 go to check_neg; 582 end; 583 end; 584 end; 585 end; 586 587 s1 = p1->operand(1)->reference.symbol; 588 end; 589 else s1 = p1->reference.symbol; 590 591 p2 = create_operator((div),3); 592 p2->operand(1) = declare_temporary((integer_type),(s1->symbol.c_dcl_size),0,null); 593 p2->operand(2) = p1; 594 p2->operand(3) = declare_constant$integer((bits_per_character)); 595 p2->operator.processed = "1"b; 596 597 q->reference.offset = p2; 598 599 end; 600 601 /* The following block of code is necessary because the 6180 will not allow 602* variable fractional offsets to be negative. To be specific, 603* negative character offsets may only appear in the a or q, and 604* negative bit offsets may not appear at all. We must protect 605* against negative variable offsets and against negative constant 606* offsets that are so large as to exceed the 15-bit constant address 607* portion of the instruction word. */ 608 609 check_neg: 610 if q -> reference.units = character_ & s -> symbol.decimal & s -> symbol.unaligned 611 then do; 612 call double_offset; 613 orig_c_offset = 2 * orig_c_offset; 614 end; 615 616 if has_offset 617 then if q -> reference.c_offset > orig_c_offset 618 | divide(q -> reference.c_offset,units_per_word(q->reference.units),19,0) <= -16383 619 then do; 620 if q -> reference.units = character_ | q -> reference.units = digit_ 621 then do; 622 q -> reference.big_offset = "1"b; 623 return; 624 end; 625 626 call restore_orig_c_offset; 627 end; 628 629 /* ************************************************************* */ 630 631 632 return; 633 634 check_addr: proc; 635 /* this code tries to improve addr(x) -> y_unaligned */ 636 637 has_offset = "0"b; 638 p2 = q -> reference.qualifier; 639 if p2 = null then return; 640 641 if p2 -> node.type ^= operator_node then return; 642 643 if p2 -> operator.op_code = addr_fun 644 then do; 645 q -> reference.fo_in_qual = "0"b; 646 p1, q -> reference.offset = null; 647 return; 648 end; 649 650 if p2 -> operator.op_code ^= addr_fun_bits then return; 651 652 /* if qual is unshared, someone else is also using it, 653* so altering it is unsafe. */ 654 655 if ^ p2 -> operand(1) -> reference.shared then return; 656 657 /* if the reference is an aggregate, simplify_offset may be 658* undone, so altering qualifier is unsafe. */ 659 660 if q -> reference.array_ref then return; 661 662 if s -> node.type = symbol_node 663 then if s -> symbol.structure 664 then return; 665 666 p3 = p2 -> operand(2); 667 668 if q -> reference.c_offset ^= 0 669 then if q -> reference.units ^= p3 -> reference.units 670 then return; 671 672 p1, q -> reference.offset = p3 -> reference.offset; 673 q -> reference.c_offset = q -> reference.c_offset + p3 -> reference.c_offset; 674 q -> reference.units = p3 -> reference.units; 675 q -> reference.fo_in_qual = p3 -> reference.fo_in_qual; 676 q -> reference.modword_in_offset = p3 -> reference.modword_in_offset; 677 678 if p3->reference.symbol->symbol.reference = p3 679 then p3, p2->operand(2) = copy_expression((p3)); 680 681 p3 -> reference.offset = null; 682 p3 -> reference.c_offset, p3 -> reference.units = 0; 683 p3 -> reference.modword_in_offset = "0"b; 684 685 p2 -> operator.op_code = addr_fun; 686 687 call check_char_units; 688 689 end; 690 691 check_exp: proc(off) returns(ptr); 692 693 /* check_exp is called when off is to replace the current q->reference.offset. 694* off is assumed to be contained in q->reference.offset. If q->reference.offset 695* is also contained in q->reference.length, then off's ref count must be 696* incremented. */ 697 698 dcl off ptr; 699 700 dcl p ptr; 701 702 p = off; 703 704 if p ^= null 705 then do; 706 if q -> reference.length ^= null 707 then if in_expression((q -> reference.offset),(q -> reference.length)) 708 then p = share_expression(p); 709 710 if p -> node.type = reference_node 711 then if p -> reference.symbol -> symbol.packed 712 then p = convert$to_integer(p,(integer_type)); 713 end; 714 715 return(p); 716 717 end; 718 719 720 in_expression: proc(p,pt) reducible returns(bit(1) aligned); 721 722 dcl (p,pt) ptr, 723 k fixed binary; 724 725 if p=pt then goto yes; 726 727 if pt -> node.type ^= operator_node then goto no; 728 729 do k = 1 to pt -> operator.number; 730 if pt -> operand(k) ^= null 731 then if in_expression(p,(pt -> operand(k))) 732 then go to yes; 733 end; 734 735 no: return("0"b); 736 737 yes: return("1"b); 738 end; 739 740 fb1_const: proc(pt) reducible returns(bit(1) aligned); 741 742 dcl (p,pt) ptr; 743 744 p = pt; 745 if ^ p -> symbol.constant then goto no; 746 if ^ p -> symbol.fixed then goto no; 747 if ^ p -> symbol.binary then goto no; 748 749 if p -> symbol.c_word_size = words_per_fix_bin_1 then return("1"b); 750 751 no: return("0"b); 752 end; 753 754 fb_value: proc(pt) reducible returns(bit(1) aligned); 755 756 dcl (p,pt) ptr; 757 758 p = pt; 759 if p = null then goto no; 760 761 if ^ p -> symbol.fixed then goto no; 762 if ^ p -> symbol.binary then goto no; 763 if ^ p -> symbol.real then goto no; 764 765 if p -> symbol.aligned | p -> symbol.constant then return("1"b); 766 767 no: return("0"b); 768 end; 769 770 fix_exp: proc(pt) returns(ptr); 771 772 dcl pt ptr; 773 774 dcl (p,s1,s2,s3,t) ptr; 775 776 p = pt; 777 if p -> node.type = reference_node then return(p -> reference.symbol); 778 779 t = p -> operand(1); 780 if t ^= null 781 then do; 782 s1 = t -> reference.symbol; 783 if ^ t -> reference.shared then goto back; 784 if ^ fb_value(s1) then goto back; 785 if s1 -> symbol.c_dcl_size <= fix_precision then goto back; 786 end; 787 788 /* output is fixed bin, but precision is too large. see if we can 789* reduce precision */ 790 791 if p -> operator.op_code = assign then goto ck2; 792 793 if p -> operator.op_code > mult then goto back; 794 795 s3 = fix_exp((p -> operand(3))); 796 797 if ^ fb_value(s3) then goto back; 798 if s3 -> symbol.c_dcl_size > max_p_fix_bin_1 then goto back; 799 800 ck2: s2 = fix_exp((p -> operand(2))); 801 802 if ^ fb_value(s2) then goto back; 803 if s2 -> symbol.c_dcl_size > max_p_fix_bin_1 then goto back; 804 805 /* both operands are fix single, reduce precision */ 806 807 p -> operator.processed = "1"b; 808 p -> operand(1) = declare_temporary((integer_type),(fix_precision), 809 0,null); 810 s1 = p -> operand(1) -> reference.symbol; 811 812 back: return(s1); 813 end; 814 815 free_op: proc(pt); 816 817 dcl (pt,r1) ptr; 818 819 r1 = pt -> operand(1); 820 if r1 -> reference.ref_count < 2 821 then if ok_to_free 822 then call free_node(pt); 823 else; 824 else do; 825 r1 -> reference.ref_count = r1 -> reference.ref_count - 1; 826 ok_to_free = "0"b; 827 end; 828 829 end; 830 831 free_exp: proc(exp); 832 833 dcl (exp,px,py) ptr, 834 j fixed bin; 835 836 px = exp; 837 do j = 1 to px -> operator.number; 838 py = px -> operand(j); 839 if py ^= null 840 then do; 841 if j = 1 842 then if py -> reference.ref_count > 1 843 then do; 844 py -> reference.ref_count = py -> reference.ref_count - 1; 845 return; 846 end; 847 848 if py -> node.type = operator_node 849 then call free_exp(py); 850 end; 851 end; 852 853 call free_node(px); 854 end; 855 856 check_char_units: proc; 857 858 dcl (new,o,s1) ptr; 859 860 if q -> reference.units = character_ 861 then if ^ s -> symbol.char 862 then if ^ s -> symbol.decimal 863 then if ^ s -> symbol.picture 864 then do; 865 q -> reference.units = bit_; 866 q -> reference.c_offset = q -> reference.c_offset * bits_per_character; 867 868 if q -> reference.offset ^= null 869 then if ^ q -> reference.modword_in_offset 870 then do; 871 o = q -> reference.offset; 872 if o -> node.type = operator_node 873 then s1 = o -> operand(1) -> reference.symbol; 874 else s1 = o -> reference.symbol; 875 876 new = create_operator((mult),3); 877 new -> operand(1) = declare_temporary((integer_type),s1 -> symbol.c_dcl_size + 4,0,null); 878 new -> operand(2) = declare_constant$integer((bits_per_character)); 879 new -> operand(3) = o; 880 new -> operator.processed = "1"b; 881 p1, q -> reference.offset = new; 882 end; 883 end; 884 885 end; 886 887 /* Convert off set from character_ to digit_ units for unaligned decimal variables */ 888 889 double_offset: 890 procedure; 891 892 declare (new,o,s1) pointer; 893 894 q -> reference.units = digit_; 895 q -> reference.c_offset = q -> reference.c_offset * packed_digits_per_character; 896 897 if q -> reference.offset ^= null 898 then if ^ q -> reference.modword_in_offset 899 then do; 900 o = q -> reference.offset; 901 902 if o -> node.type = operator_node 903 then s1 = o -> operand(1) -> reference.symbol; 904 else s1 = o -> reference.symbol; 905 906 new = create_operator((mult),3); 907 new -> operand(1) = declare_temporary((integer_type),s1 -> symbol.c_dcl_size + 1,0,null); 908 909 new -> operand(2) = declare_constant$integer((packed_digits_per_character)); 910 new -> operand(3) = o; 911 new -> operator.processed = "1"b; 912 p1, q -> reference.offset = new; 913 end; 914 915 end /* double_offset */; 916 917 /* makes orig_c_offset the new q -> reference.c_offset */ 918 919 restore_orig_c_offset: proc; 920 921 dcl (p1,p2,p3,p4) ptr; 922 dcl difference fixed bin(31); 923 dcl (prec2,prec3) fixed bin(24); 924 925 p2 = q -> reference.offset; 926 927 if p2 -> node.type = operator_node 928 then p4 = p2 -> operand(1); 929 else p4 = p2; 930 prec2 = p4 -> reference.symbol -> symbol.c_dcl_size; 931 932 difference = q -> reference.c_offset - orig_c_offset; 933 q -> reference.c_offset = orig_c_offset; 934 935 p1 = create_operator(add,3); 936 p1 -> operand(2) = p2; 937 p3, p1 -> operand(3) = declare_constant$integer(difference); 938 prec3 = p3 -> reference.symbol -> symbol.c_dcl_size; 939 p1 -> operand(1) = declare_temporary((integer_type), 940 min(max_p_fix_bin_1,max(prec2,prec3) + 1),0,null); 941 p1 -> operator.processed = "1"b; 942 943 q -> reference.offset = p1; 944 945 end /* restore_orig_c_offset */; 946 947 948 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/31/89 1339.0 simplify_offset.pl1 >spec>install>MR12.3-1066>simplify_offset.pl1 46 1 07/21/80 1546.3 semant.incl.pl1 >ldd>include>semant.incl.pl1 1-228 2 07/31/89 1332.6 language_utility.incl.pl1 >spec>install>MR12.3-1066>language_utility.incl.pl1 2-307 3 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-325 4 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-335 5 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-374 6 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-386 7 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 48 8 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 49 9 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 50 10 12/07/83 1701.7 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 51 11 05/06/74 1741.6 array.incl.pl1 >ldd>include>array.incl.pl1 52 12 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 53 13 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 54 14 12/07/83 1701.7 system.incl.pl1 >ldd>include>system.incl.pl1 55 15 10/25/79 1645.8 boundary.incl.pl1 >ldd>include>boundary.incl.pl1 56 16 07/21/80 1546.3 semantic_bits.incl.pl1 >ldd>include>semantic_bits.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. add 000001 constant bit(9) initial dcl 12-8 set ref 163 344 418 935* addr_fun constant bit(9) initial dcl 12-8 ref 643 685 addr_fun_bits constant bit(9) initial dcl 12-8 ref 650 aligned 31(21) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 765 array based structure level 1 dcl 11-1 in procedure "simplify_offset" array 12 based pointer level 2 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "simplify_offset" ref 234 234 array_ref 0(09) based bit(1) level 2 packed packed unaligned dcl 9-3 ref 660 assign constant bit(9) initial dcl 12-8 ref 82 290 791 attributes 31 based structure level 2 dcl 10-3 big_offset 11(33) based bit(1) level 4 packed packed unaligned dcl 9-3 set ref 622* binary 31(29) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 747 762 bit 31(03) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 459 538 bit_ constant fixed bin(3,0) initial dcl 15-5 ref 467 538 865 bit_offset 000141 automatic fixed bin(24,0) dcl 29 set ref 476* 477 482 567* 568 576 579 bit_size 23 based pointer level 2 packed packed unaligned dcl 10-3 ref 241 bits 12(06) based structure level 2 packed packed unaligned dcl 9-3 bits_per_character 004027 constant fixed bin(31,0) initial dcl 14-5 ref 468 545 546 568 576 579 594 866 878 bits_per_double constant fixed bin(31,0) initial dcl 14-5 ref 459 bits_per_word 004030 constant fixed bin(31,0) initial dcl 14-5 ref 477 482 485 507 c_bit_offset 000142 automatic fixed bin(24,0) dcl 29 set ref 483* 485 507 c_bit_size 27 based fixed bin(24,0) level 2 dcl 10-3 ref 247 c_dcl_size 30 based fixed bin(24,0) level 2 dcl 10-3 ref 76 82 88 213 214 286 293 592 785 798 803 877 907 930 938 c_length 2 based fixed bin(24,0) level 2 dcl 9-3 ref 459 463 c_offset 1 based fixed bin(24,0) level 2 dcl 9-3 set ref 127 134 136 153* 153 188* 188 250 269 271 273 410* 410 430* 430 483 507* 532 545* 545 616 616 668 673* 673 673 682* 866* 866 895* 895 932 933* c_word_size 26 based fixed bin(24,0) level 2 dcl 10-3 ref 749 called_fix_exp 000153 automatic bit(1) dcl 29 set ref 143* 203 284* char 31(04) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 463 538 860 character_ constant fixed bin(3,0) initial dcl 15-5 ref 544 609 620 860 characters_per_double constant fixed bin(31,0) initial dcl 14-5 ref 463 compare_expression 000010 constant entry external dcl 2-48 ref 332 346 357 368 compiler_developed 32(35) based structure level 3 packed packed unaligned dcl 10-3 constant 32(16) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 745 765 context parameter bit(36) dcl 16-5 set ref 25 129 convert$to_integer 000012 constant entry external dcl 2-66 ref 710 convert_offset 000010 constant fixed bin(7,1) initial array dcl 41 ref 136 136 248 273 273 copy_expression 000014 constant entry external dcl 2-94 ref 678 create_operator 000016 constant entry external dcl 2-152 ref 591 876 906 935 data_type 31 based structure level 3 packed packed unaligned dcl 10-3 dcl_size 24 based pointer level 2 packed packed unaligned dcl 10-3 ref 74 212 decimal 31(28) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 458 538 609 860 declare_constant$integer 000020 constant entry external dcl 2-234 ref 376 387 495 517 580 594 878 909 937 declare_temporary 000022 constant entry external dcl 2-292 ref 592 808 877 907 939 def_context based structure level 1 dcl 16-8 defined 32(13) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 257 difference 000262 automatic fixed bin(31,0) dcl 922 set ref 932* 937* digit_ constant fixed bin(3,0) initial dcl 15-5 ref 620 894 dimensioned 31(19) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 234 div constant bit(9) initial dcl 12-8 ref 591 divide builtin function dcl 44 ref 136 248 273 482 507 545 546 579 616 exp parameter pointer dcl 833 ref 831 836 f 000100 automatic pointer dcl 29 set ref 222* 234* 234 234* 238 241 247 f_offset_to_be_added 0(12) based bit(1) level 2 packed packed unaligned dcl 16-8 ref 129 factor 000143 automatic fixed bin(24,0) dcl 29 set ref 467* 468* 476 483 father 17 based pointer level 2 packed packed unaligned dcl 10-3 ref 238 fix_bin based fixed bin(17,0) dcl 29 ref 153 188 387 410 410 430 430 476 567 fix_precision 000150 automatic fixed bin(24,0) dcl 29 set ref 74* 76* 78* 82 88 211* 282* 286 293 785 808 fixed 31(01) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 746 761 fo_in_qual 12(22) based bit(1) level 3 packed packed unaligned dcl 9-3 set ref 448 645* 675* 675 fractional_offset_to_be_added 000154 automatic bit(1) dcl 29 set ref 129* 131 208 214 253 free_node 000024 constant entry external dcl 2-345 ref 820 853 has_offset 000136 automatic bit(1) dcl 29 set ref 64* 498* 532 616 637* i 000134 automatic fixed bin(17,0) dcl 29 set ref 557* 559 570 580* info 11 based structure level 2 packed packed unaligned dcl 9-3 initial 11 based pointer level 2 packed packed unaligned dcl 10-3 ref 153 188 387 410 410 430 430 476 567 integer_type 000000 constant bit(36) initial dcl 14-71 ref 592 710 808 877 907 939 j 000104 automatic fixed bin(17,0) dcl 833 set ref 837* 838 841* k 000100 automatic fixed bin(17,0) dcl 722 set ref 729* 730 730* length 6 based pointer level 2 packed packed unaligned dcl 9-3 set ref 70 92* 457 706 706 lower_precision 000151 automatic fixed bin(24,0) dcl 29 set ref 206* 214* 253* 282 max builtin function dcl 44 ref 138 939 939 max_index_register_value constant fixed bin(31,0) initial dcl 14-5 ref 76 213 252 532 max_length_precision constant fixed bin(31,0) initial dcl 14-5 ref 74 76 286 max_offset_precision constant fixed bin(31,0) initial dcl 14-5 ref 211 max_p_fix_bin_1 constant fixed bin(31,0) initial dcl 14-5 ref 82 286 798 803 939 939 max_signed_index_register_value constant fixed bin(31,0) initial dcl 14-5 ref 214 253 max_signed_xreg_precision constant fixed bin(31,0) initial dcl 14-5 ref 78 82 206 max_uns_xreg_precision constant fixed bin(31,0) initial dcl 14-5 ref 214 253 member 32(04) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 225 min builtin function dcl 44 ref 939 939 misc_attributes 31(19) based structure level 3 packed packed unaligned dcl 10-3 mod builtin function dcl 44 ref 477 485 576 mod_bit constant bit(9) initial dcl 12-8 ref 304 modword_in_offset 11(35) based bit(1) level 4 packed packed unaligned dcl 9-3 set ref 102 208 497* 552 676* 676 683* 868 897 mult constant bit(9) initial dcl 12-8 ref 366 373 389 394 557 793 876 906 multiple 000140 automatic fixed bin(31,0) dcl 29 set ref 482* 488 495* 510 517* 579* 580* n 000147 automatic fixed bin(24,0) dcl 29 set ref 247* 248* 248 250* 250 252 253 new 000236 automatic pointer dcl 892 in procedure "double_offset" set ref 906* 907 909 910 911 912 new 000222 automatic pointer dcl 858 in procedure "check_char_units" set ref 876* 877 878 879 880 881 node based structure level 1 dcl 13-27 null builtin function dcl 44 ref 71 74 118 152 212 231 241 336 409 457 549 592 592 639 646 681 704 706 730 759 780 808 808 839 868 877 877 897 907 907 939 939 number 0(21) based fixed bin(14,0) level 2 packed packed unaligned dcl 8-6 ref 729 837 number_of_dimensions 1(07) based fixed bin(7,0) level 2 packed packed unaligned dcl 11-1 ref 234 o 000224 automatic pointer dcl 858 in procedure "check_char_units" set ref 871* 872 872 874 879 o 000240 automatic pointer dcl 892 in procedure "double_offset" set ref 900* 902 902 904 910 off parameter pointer dcl 698 ref 691 702 offset 5 based pointer level 2 packed packed unaligned dcl 9-3 set ref 117 152* 183* 186 231 299* 316* 348* 353 359* 409* 490* 492 512* 514 523* 548 570* 572 597* 646* 672 672* 681* 706 868 871 881* 897 900 912* 925 943* ok_to_free 000137 automatic bit(1) dcl 29 set ref 64* 820 826* op_code 000152 automatic bit(9) dcl 29 in procedure "simplify_offset" set ref 161* 163 169 394 op_code 0(09) based bit(9) level 2 in structure "operator" packed packed unaligned dcl 8-6 in procedure "simplify_offset" set ref 82 161 290 304 344 366 373* 374* 389* 418 419 557 643 650 685* 791 793 operand 1 based pointer array level 2 packed packed unaligned dcl 8-6 set ref 82 86 92 173 183 195 264 286 292 297 304 316 332 332 341 346 346 348 357 357 359 368 368 370 375* 376* 378 379* 379 380* 387* 388* 388 396 402 422 428* 428 437 444* 444 470 490 495* 512 517* 559 570 576 580* 587 592* 593* 594* 655 666 678* 730 730 779 795 800 808* 810 819 838 872 877* 878* 879* 902 907* 909* 910* 927 936* 937* 939* operator based structure level 1 dcl 8-6 operator_node constant bit(9) initial dcl 13-5 ref 71 145 264 342 403 520 555 641 727 848 872 902 927 orig_c_offset 000144 automatic fixed bin(24,0) dcl 29 set ref 127* 138* 138 546* 546 613* 613 616 932 933 other 11(33) based structure level 3 packed packed unaligned dcl 9-3 own_number_of_dimensions 1(15) based fixed bin(7,0) level 2 packed packed unaligned dcl 11-1 ref 234 p 000172 automatic pointer dcl 700 in procedure "check_exp" set ref 702* 704 706* 706* 710 710 710* 710* 715 p parameter pointer dcl 722 in procedure "in_expression" set ref 720 725 730* p 000100 automatic pointer dcl 774 in procedure "fix_exp" set ref 776* 777 777 779 791 793 795 800 807 808 810 p 000202 automatic pointer dcl 742 in procedure "fb1_const" set ref 744* 745 746 747 749 p 000100 automatic pointer dcl 756 in procedure "fb_value" set ref 758* 759 761 762 763 765 765 p1 000252 automatic pointer dcl 921 in procedure "restore_orig_c_offset" set ref 935* 936 937 939 941 943 p1 000102 automatic pointer dcl 29 in procedure "simplify_offset" set ref 70* 71 71 82 82 86 92 93* 96* 117* 118 145 148 161 173 183 185* 186* 195 286 290 292 297 298* 299* 304 304 305 316 332 332 335* 336* 341 346 349* 353* 357 368 373 378 379 387 388 389 396 402 411* 428 444 470 490 491* 492* 495 512 513* 514* 517 520 523 548* 549 555 557 559 570 571* 572* 576 580 587 589 593 646* 672* 881* 912* p2 000104 automatic pointer dcl 29 in procedure "simplify_offset" set ref 86* 88* 88 88 96* 133* 134 134 136 136 173* 174 176 195* 196 292* 293* 293 293 297* 299 304* 305* 306* 306* 312 341* 342 344 346 348 351* 351* 352* 357 359 366 368 370 374 375 376 379 380 388 396* 397 399 591* 592 593 594 595 597 638* 639 641 643 650 655 666 678 685 p2 000254 automatic pointer dcl 921 in procedure "restore_orig_c_offset" set ref 925* 927 927 929 936 p3 000106 automatic pointer dcl 29 in procedure "simplify_offset" set ref 370* 371 375 378* 380 384 402* 403 405 418 419 422 428 429* 437 444 470* 471 473 559* 561 563 666* 668 672 673 674 675 676 678 678 678 678* 681 682 682 683 p3 000256 automatic pointer dcl 921 in procedure "restore_orig_c_offset" set ref 937* 938 p4 000260 automatic pointer dcl 921 in procedure "restore_orig_c_offset" set ref 927* 929* 930 p4 000110 automatic pointer dcl 29 in procedure "simplify_offset" set ref 422* 423 425 437* 438 440 packed 33 based bit(1) level 4 packed packed unaligned dcl 10-3 ref 710 packed_digits_per_character constant fixed bin(31,0) initial dcl 14-5 ref 895 909 picture 31(18) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 463 538 860 prec2 000263 automatic fixed bin(24,0) dcl 923 set ref 930* 939 939 prec3 000264 automatic fixed bin(24,0) dcl 923 set ref 938* 939 939 processed 0(19) based bit(1) level 2 packed packed unaligned dcl 8-6 set ref 595* 807* 880* 911* 941* pt parameter pointer dcl 722 in procedure "in_expression" ref 720 725 727 729 730 730 pt parameter pointer dcl 756 in procedure "fb_value" ref 754 758 pt parameter pointer dcl 27 in procedure "simplify_offset" ref 25 60 pt parameter pointer dcl 817 in procedure "free_op" set ref 815 819 820* pt parameter pointer dcl 742 in procedure "fb1_const" ref 740 744 pt parameter pointer dcl 772 in procedure "fix_exp" ref 770 776 px 000100 automatic pointer dcl 833 set ref 836* 837 838 853* py 000102 automatic pointer dcl 833 set ref 838* 839 841 844 844 848 848* q 000130 automatic pointer dcl 29 set ref 60* 62 70 92 102 117 127 131 134 136 152 153 153 183 186 188 188 208 208 218 248 250 271 273 299 316 348 353 359 409 410 410 430 430 448 455 457 459 463 467 483 490 492 497 507 508 512 514 523 526 530 532 538 544 545 545 548 552 570 572 597 609 616 616 616 620 620 622 638 645 646 660 668 668 672 673 673 674 675 676 706 706 706 860 865 866 866 868 868 871 881 894 895 895 897 897 900 912 925 932 933 943 qualifier 4 based pointer level 2 packed packed unaligned dcl 9-3 ref 263 638 r 000112 automatic pointer dcl 29 set ref 218* 263* 263 264 264* 264 266 r1 000212 automatic pointer dcl 817 set ref 819* 820 825 825 real 31(30) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 763 ref_count 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 9-3 set ref 576 820 825* 825 841 844* 844 reference based structure level 1 dcl 9-3 in procedure "simplify_offset" reference 15 based pointer level 2 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "simplify_offset" ref 133 231 267 678 reference_node constant bit(9) initial dcl 13-5 ref 174 196 371 397 423 438 471 561 710 777 s 000114 automatic pointer dcl 29 set ref 62* 74 76 133 212 213 214 219 458 459 463 463 538 538 538 538 609 609 662 662 860 860 860 s1 000116 automatic pointer dcl 29 in procedure "simplify_offset" set ref 148* 150* 153 587* 589* 592 s1 000242 automatic pointer dcl 892 in procedure "double_offset" set ref 902* 904* 907 s1 000102 automatic pointer dcl 774 in procedure "fix_exp" set ref 782* 784* 785 810* 812 s1 000226 automatic pointer dcl 858 in procedure "check_char_units" set ref 872* 874* 877 s2 000104 automatic pointer dcl 774 in procedure "fix_exp" set ref 800* 802* 803 s2 000120 automatic pointer dcl 29 in procedure "simplify_offset" set ref 176* 178* 188 312* 314* 399* 400* 410 430 s3 000122 automatic pointer dcl 29 in procedure "simplify_offset" set ref 384* 385* 387 405* 407* 410 473* 474* 476 563* 565* 567 s3 000106 automatic pointer dcl 774 in procedure "fix_exp" set ref 795* 797* 798 s4 000124 automatic pointer dcl 29 set ref 425* 426* 430 440* 442* scale 2(28) based fixed bin(7,0) level 2 packed packed unaligned dcl 10-3 ref 88 293 share_expression 000026 constant entry external dcl 2-454 ref 706 shared 0(11) based bit(1) level 2 packed packed unaligned dcl 9-3 ref 655 783 sign 000135 automatic fixed bin(1,0) dcl 29 set ref 165* 171* 188 193 418* 419* 430 435 start_gen_storage 000145 automatic fixed bin(24,0) dcl 29 set ref 134* 136* 138 220 start_generation 000146 automatic fixed bin(24,0) dcl 29 set ref 220* 250 271* 273* 277* storage_class 32(09) based structure level 3 packed packed unaligned dcl 10-3 structure 31 based bit(1) level 4 packed packed unaligned dcl 10-3 ref 662 sub constant bit(9) initial dcl 12-8 ref 169 374 419 substr builtin function dcl 44 ref 304 304 sym 000126 automatic pointer dcl 29 set ref 219* 222 225 231 234 234 257 266* 267 symbol 3 based pointer level 2 in structure "reference" packed packed unaligned dcl 9-3 in procedure "simplify_offset" ref 62 82 148 176 266 286 312 384 399 405 425 440 473 563 587 589 678 710 777 782 810 872 874 902 904 930 938 symbol based structure level 1 dcl 10-3 in procedure "simplify_offset" symbol_node constant bit(9) initial dcl 13-5 ref 662 symref 000132 automatic pointer dcl 29 set ref 267* 269 271 271 273 273 t 000110 automatic pointer dcl 774 set ref 779* 780 782 783 type based bit(9) level 2 packed packed unaligned dcl 13-27 ref 71 145 174 196 264 342 371 397 403 423 438 471 520 555 561 641 662 710 727 777 848 872 902 927 unaligned 31(22) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 609 units 0(14) based fixed bin(3,0) level 2 packed packed unaligned dcl 9-3 set ref 131 134 134 136 136 208 248 271 271 273 273 455 467 508* 526 530 538 544* 609 616 620 620 668 668 674* 674 682* 860 865* 894* units_per_word 000002 constant fixed bin(6,0) initial array dcl 42 ref 616 word_ constant fixed bin(3,0) initial dcl 15-5 ref 131 208 455 508 530 words_per_fix_bin_1 constant fixed bin(31,0) initial dcl 14-5 ref 749 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 12-8 abs_fun internal static bit(9) initial dcl 12-8 acos_fun internal static bit(9) initial dcl 12-8 acosd_fun internal static bit(9) initial dcl 12-8 addbitno_fun internal static bit(9) initial dcl 12-8 addcharno_fun internal static bit(9) initial dcl 12-8 addrel_fun internal static bit(9) initial dcl 12-8 adjust_count 000000 constant entry external dcl 2-20 alloc_semantics 000000 constant entry external dcl 1-7 alloc_semantics$init_only 000000 constant entry external dcl 1-12 allocation_fun internal static bit(9) initial dcl 12-8 allot_auto internal static bit(9) initial dcl 12-8 allot_based internal static bit(9) initial dcl 12-8 allot_ctl internal static bit(9) initial dcl 12-8 allot_var internal static bit(9) initial dcl 12-8 and_bits internal static bit(9) initial dcl 12-8 arg_desc_type internal static bit(36) initial dcl 14-71 array_node internal static bit(9) initial dcl 13-5 asin_fun internal static bit(9) initial dcl 12-8 asind_fun internal static bit(9) initial dcl 12-8 assign_by_name internal static bit(9) initial dcl 12-8 assign_round internal static bit(9) initial dcl 12-8 assign_size_ck internal static bit(9) initial dcl 12-8 assign_zero internal static bit(9) initial dcl 12-8 atan_fun internal static bit(9) initial dcl 12-8 atand_fun internal static bit(9) initial dcl 12-8 b_format internal static bit(9) initial dcl 12-8 baseno_fun internal static bit(9) initial dcl 12-8 baseptr_fun internal static bit(9) initial dcl 12-8 binary_to_octal_string 000000 constant entry external dcl 2-38 binary_to_octal_var_string 000000 constant entry external dcl 2-43 bindec 000000 constant entry external dcl 2-23 bindec$vs 000000 constant entry external dcl 2-28 binoct 000000 constant entry external dcl 2-33 bit_pointer internal static bit(9) initial dcl 12-8 bit_to_char internal static bit(9) initial dcl 12-8 bit_to_word internal static bit(9) initial dcl 12-8 bit_type internal static bit(36) initial dcl 14-71 bitno_fun internal static bit(9) initial dcl 12-8 bits_per_binary_exponent internal static fixed bin(31,0) initial dcl 14-5 bits_per_decimal_digit internal static fixed bin(31,0) initial dcl 14-5 bits_per_digit internal static fixed bin(31,1) initial dcl 14-69 bits_per_half internal static fixed bin(31,0) initial dcl 14-5 bits_per_packed_ptr internal static fixed bin(31,0) initial dcl 14-5 block_node internal static bit(9) initial dcl 13-5 bn_format internal static bit(9) initial dcl 12-8 bool_fun internal static bit(9) initial dcl 12-8 bound based structure level 1 dcl 11-21 bound_ck internal static bit(9) initial dcl 12-8 bound_node internal static bit(9) initial dcl 13-5 builtin 000000 constant entry external dcl 1-17 builtin_type internal static bit(36) initial dcl 14-71 by_name_agg_node internal static bit(9) initial dcl 13-5 byte_fun internal static bit(9) initial dcl 12-8 c_format internal static bit(9) initial dcl 12-8 cat_string internal static bit(9) initial dcl 12-8 ceil_fun internal static bit(9) initial dcl 12-8 char_to_word internal static bit(9) initial dcl 12-8 char_type internal static bit(36) initial dcl 14-71 characters_per_half internal static fixed bin(31,0) initial dcl 14-5 characters_per_word internal static fixed bin(31,0) initial dcl 14-5 charno_fun internal static bit(9) initial dcl 12-8 check_star_extents 000000 constant entry external dcl 1-27 clock_fun internal static bit(9) initial dcl 12-8 close_file internal static bit(9) initial dcl 12-8 codeptr_fun internal static bit(9) initial dcl 12-8 column_format internal static bit(9) initial dcl 12-8 compare_declaration 000000 constant entry external dcl 1-31 complex_fun internal static bit(9) initial dcl 12-8 complex_type internal static bit(36) initial dcl 14-71 conjg_fun internal static bit(9) initial dcl 12-8 constant_length 000000 constant entry external dcl 2-54 context_node internal static bit(9) initial dcl 13-5 context_processor 000000 constant entry external dcl 1-38 convert 000000 constant entry external dcl 2-60 convert$from_builtin 000000 constant entry external dcl 2-72 convert$to_target 000000 constant entry external dcl 2-88 convert$to_target_fb 000000 constant entry external dcl 2-82 convert$validate 000000 constant entry external dcl 2-78 copy_expression$copy_sons 000000 constant entry external dcl 2-99 copy_string internal static bit(9) initial dcl 12-8 copy_unique_expression 000000 constant entry external dcl 2-103 copy_words internal static bit(9) initial dcl 12-8 cos_fun internal static bit(9) initial dcl 12-8 cosd_fun internal static bit(9) initial dcl 12-8 create_array 000000 constant entry external dcl 2-108 create_block 000000 constant entry external dcl 2-112 create_bound 000000 constant entry external dcl 2-118 create_context 000000 constant entry external dcl 2-122 create_cross_reference 000000 constant entry external dcl 2-128 create_default 000000 constant entry external dcl 2-132 create_identifier 000000 constant entry external dcl 2-136 create_label 000000 constant entry external dcl 2-140 create_list 000000 constant entry external dcl 2-147 create_reference 000000 constant entry external dcl 2-158 create_statement 000000 constant entry external dcl 2-163 create_statement$prologue 000000 constant entry external dcl 2-171 create_storage 000000 constant entry external dcl 2-179 create_symbol 000000 constant entry external dcl 2-184 create_token 000000 constant entry external dcl 2-191 create_token$init_hash_table 000000 constant entry external dcl 2-197 create_token$protected 000000 constant entry external dcl 2-199 cross_reference_node internal static bit(9) initial dcl 13-5 dec_integer_type internal static bit(36) initial dcl 14-71 decbin 000000 constant entry external dcl 2-206 declare 000000 constant entry external dcl 1-41 declare_constant 000000 constant entry external dcl 2-211 declare_constant$bit 000000 constant entry external dcl 2-219 declare_constant$char 000000 constant entry external dcl 2-224 declare_constant$desc 000000 constant entry external dcl 2-229 declare_descriptor 000000 constant entry external dcl 2-239 declare_descriptor$ctl 000000 constant entry external dcl 2-249 declare_descriptor$param 000000 constant entry external dcl 2-259 declare_integer 000000 constant entry external dcl 2-269 declare_picture 000000 constant entry external dcl 2-274 declare_picture_temp 000000 constant entry external dcl 2-279 declare_pointer 000000 constant entry external dcl 2-287 declare_structure 000000 constant entry external dcl 1-44 decode_node_id 000000 constant entry external dcl 2-300 decode_source_id 000000 constant entry external dcl 2-306 def_this_context based structure level 1 dcl 16-27 default_area_size internal static fixed bin(31,0) initial dcl 14-5 default_fix_bin_p internal static fixed bin(31,0) initial dcl 14-5 default_fix_dec_p internal static fixed bin(31,0) initial dcl 14-5 default_flt_bin_p internal static fixed bin(31,0) initial dcl 14-5 default_flt_dec_p internal static fixed bin(31,0) initial dcl 14-5 default_node internal static bit(9) initial dcl 13-5 defined_reference 000000 constant entry external dcl 1-47 delete_file internal static bit(9) initial dcl 12-8 desc_size internal static bit(9) initial dcl 12-8 digit_to_bit internal static bit(9) initial dcl 12-8 do_fun internal static bit(9) initial dcl 12-8 do_semantics 000000 constant entry external dcl 1-57 do_spec internal static bit(9) initial dcl 12-8 e_format internal static bit(9) initial dcl 12-8 empty_area internal static bit(9) initial dcl 12-8 enable_on internal static bit(9) initial dcl 12-8 entry_var_type internal static bit(36) initial dcl 14-71 environmentptr_fun internal static bit(9) initial dcl 12-8 equal internal static bit(9) initial dcl 12-8 error 000000 constant entry external dcl 2-314 error$omit_text 000000 constant entry external dcl 2-319 error_ 000000 constant entry external dcl 2-324 error_$finish 000000 constant entry external dcl 2-343 error_$initialize_error 000000 constant entry external dcl 2-341 error_$no_text 000000 constant entry external dcl 2-334 ex_prologue internal static bit(9) initial dcl 12-8 exp internal static bit(9) initial dcl 12-8 exp_fun internal static bit(9) initial dcl 12-8 expand_assign 000000 constant entry external dcl 1-62 expand_by_name 000000 constant entry external dcl 1-71 expand_infix 000000 constant entry external dcl 1-76 expand_initial 000000 constant entry external dcl 1-84 expand_prefix 000000 constant entry external dcl 1-89 expand_primitive 000000 constant entry external dcl 1-97 expression_semantics 000000 constant entry external dcl 1-105 f_format internal static bit(9) initial dcl 12-8 fill_refer 000000 constant entry external dcl 1-113 floor_fun internal static bit(9) initial dcl 12-8 format_value_node internal static bit(9) initial dcl 13-5 fortran_read internal static bit(9) initial dcl 12-8 fortran_write internal static bit(9) initial dcl 12-8 free_based internal static bit(9) initial dcl 12-8 free_ctl internal static bit(9) initial dcl 12-8 free_var internal static bit(9) initial dcl 12-8 ftn_file_manip internal static bit(9) initial dcl 12-8 ftn_trans_loop internal static bit(9) initial dcl 12-8 function 000000 constant entry external dcl 1-125 generic_selector 000000 constant entry external dcl 1-134 get_array_size 000000 constant entry external dcl 2-348 get_data_trans internal static bit(9) initial dcl 12-8 get_edit_trans internal static bit(9) initial dcl 12-8 get_file internal static bit(9) initial dcl 12-8 get_list_trans internal static bit(9) initial dcl 12-8 get_size 000000 constant entry external dcl 2-352 get_string internal static bit(9) initial dcl 12-8 greater_or_equal internal static bit(9) initial dcl 12-8 greater_than internal static bit(9) initial dcl 12-8 half_ internal static fixed bin(3,0) initial dcl 15-5 half_to_word internal static bit(9) initial dcl 12-8 imag_fun internal static bit(9) initial dcl 12-8 index_after_fun internal static bit(9) initial dcl 12-8 index_before_fun internal static bit(9) initial dcl 12-8 index_fun internal static bit(9) initial dcl 12-8 index_rev_fun internal static bit(9) initial dcl 12-8 io_data_list_semantics 000000 constant entry external dcl 1-143 io_data_list_semantics$format_list_semantics 000000 constant entry external dcl 1-120 io_semantics 000000 constant entry external dcl 1-148 join internal static bit(9) initial dcl 12-8 jump internal static bit(9) initial dcl 12-8 jump_false internal static bit(9) initial dcl 12-8 jump_if_eq internal static bit(9) initial dcl 12-8 jump_if_ge internal static bit(9) initial dcl 12-8 jump_if_gt internal static bit(9) initial dcl 12-8 jump_if_le internal static bit(9) initial dcl 12-8 jump_if_lt internal static bit(9) initial dcl 12-8 jump_if_ne internal static bit(9) initial dcl 12-8 jump_true internal static bit(9) initial dcl 12-8 l_parn internal static bit(9) initial dcl 12-8 label_array_element_node internal static bit(9) initial dcl 13-5 label_node internal static bit(9) initial dcl 13-5 length_fun internal static bit(9) initial dcl 12-8 less_or_equal internal static bit(9) initial dcl 12-8 less_than internal static bit(9) initial dcl 12-8 line_format internal static bit(9) initial dcl 12-8 list_node internal static bit(9) initial dcl 13-5 local_label_var_type internal static bit(36) initial dcl 14-71 locate_file internal static bit(9) initial dcl 12-8 lock_file internal static bit(9) initial dcl 12-8 lock_fun internal static bit(9) initial dcl 12-8 log10_fun internal static bit(9) initial dcl 12-8 log2_fun internal static bit(9) initial dcl 12-8 log_fun internal static bit(9) initial dcl 12-8 lookup 000000 constant entry external dcl 1-153 loop internal static bit(9) initial dcl 12-8 machine_state_node internal static bit(9) initial dcl 13-5 make_desc internal static bit(9) initial dcl 12-8 make_non_quick 000000 constant entry external dcl 1-162 match_arguments 000000 constant entry external dcl 1-166 max_area_size internal static fixed bin(31,0) initial dcl 14-5 max_bit_string internal static fixed bin(31,0) initial dcl 14-5 max_bit_string_constant internal static fixed bin(31,0) initial dcl 14-5 max_char_string internal static fixed bin(31,0) initial dcl 14-5 max_char_string_constant internal static fixed bin(31,0) initial dcl 14-5 max_fun internal static bit(9) initial dcl 12-8 max_identifier_length internal static fixed bin(31,0) initial dcl 14-5 max_number_of_dimensions internal static fixed bin(31,0) initial dcl 14-5 max_number_of_operands internal static fixed bin(15,0) initial dcl 8-15 max_p_bin_or_dec internal static fixed bin(31,0) initial dcl 14-5 max_p_dec internal static fixed bin(31,0) initial dcl 14-5 max_p_fix_bin_2 internal static fixed bin(31,0) initial dcl 14-5 max_p_flt_bin_1 internal static fixed bin(31,0) initial dcl 14-5 max_p_flt_bin_2 internal static fixed bin(31,0) initial dcl 14-5 max_scale internal static fixed bin(31,0) initial dcl 14-5 max_words_per_variable internal static fixed bin(31,0) initial dcl 14-5 merge_attributes 000000 constant entry external dcl 2-355 min_area_size internal static fixed bin(31,0) initial dcl 14-5 min_fun internal static bit(9) initial dcl 12-8 min_scale internal static fixed bin(31,0) initial dcl 14-5 mod2_ internal static fixed bin(3,0) initial dcl 15-5 mod4_ internal static fixed bin(3,0) initial dcl 15-5 mod_byte internal static bit(9) initial dcl 12-8 mod_fun internal static bit(9) initial dcl 12-8 mod_half internal static bit(9) initial dcl 12-8 mod_word internal static bit(9) initial dcl 12-8 negate internal static bit(9) initial dcl 12-8 nop internal static bit(9) initial dcl 12-8 not_bits internal static bit(9) initial dcl 12-8 not_equal internal static bit(9) initial dcl 12-8 off_fun internal static bit(9) initial dcl 12-8 offset_adder 000000 constant entry external dcl 1-172 open_file internal static bit(9) initial dcl 12-8 operator_semantics 000000 constant entry external dcl 1-184 optimizer 000000 constant entry external dcl 2-361 or_bits internal static bit(9) initial dcl 12-8 pack internal static bit(9) initial dcl 12-8 page_format internal static bit(9) initial dcl 12-8 param_desc_ptr internal static bit(9) initial dcl 12-8 param_ptr internal static bit(9) initial dcl 12-8 parse_error 000000 constant entry external dcl 2-364 parse_error$no_text 000000 constant entry external dcl 2-368 picture_format internal static bit(9) initial dcl 12-8 pl1_error_print$listing_segment 000000 constant entry external dcl 2-384 pl1_error_print$write_out 000000 constant entry external dcl 2-372 pl1_mod_fun internal static bit(9) initial dcl 12-8 pl1_print$for_lex 000000 constant entry external dcl 2-418 pl1_print$non_varying 000000 constant entry external dcl 2-398 pl1_print$non_varying_nl 000000 constant entry external dcl 2-402 pl1_print$string_pointer 000000 constant entry external dcl 2-406 pl1_print$string_pointer_nl 000000 constant entry external dcl 2-410 pl1_print$unaligned_nl 000000 constant entry external dcl 2-414 pl1_print$varying 000000 constant entry external dcl 2-392 pl1_print$varying_nl 000000 constant entry external dcl 2-395 pointer_type internal static bit(36) initial dcl 14-71 prefix_plus internal static bit(9) initial dcl 12-8 propagate_bit 000000 constant entry external dcl 1-192 ptr_fun internal static bit(9) initial dcl 12-8 put_control internal static bit(9) initial dcl 12-8 put_data_trans internal static bit(9) initial dcl 12-8 put_edit_trans internal static bit(9) initial dcl 12-8 put_field internal static bit(9) initial dcl 12-8 put_field_chk internal static bit(9) initial dcl 12-8 put_file internal static bit(9) initial dcl 12-8 put_list_trans internal static bit(9) initial dcl 12-8 put_string internal static bit(9) initial dcl 12-8 r_format internal static bit(9) initial dcl 12-8 r_parn internal static bit(9) initial dcl 12-8 range_ck internal static bit(9) initial dcl 12-8 rank_fun internal static bit(9) initial dcl 12-8 read_file internal static bit(9) initial dcl 12-8 real_fun internal static bit(9) initial dcl 12-8 real_type internal static bit(36) initial dcl 14-71 record_io internal static bit(9) initial dcl 12-8 refer internal static bit(9) initial dcl 12-8 refer_extent 000000 constant entry external dcl 2-426 rel_fun internal static bit(9) initial dcl 12-8 repeat_fun internal static bit(9) initial dcl 12-8 reserve$clear 000000 constant entry external dcl 2-430 reserve$declare_lib 000000 constant entry external dcl 2-434 reserve$read_lib 000000 constant entry external dcl 2-439 return_bits internal static bit(9) initial dcl 12-8 return_string internal static bit(9) initial dcl 12-8 return_value internal static bit(9) initial dcl 12-8 return_words internal static bit(9) initial dcl 12-8 reverse_fun internal static bit(9) initial dcl 12-8 revert_on internal static bit(9) initial dcl 12-8 rewrite_file internal static bit(9) initial dcl 12-8 round_fun internal static bit(9) initial dcl 12-8 search_fun internal static bit(9) initial dcl 12-8 search_rev_fun internal static bit(9) initial dcl 12-8 segno_fun internal static bit(9) initial dcl 12-8 semantic_translator 000000 constant entry external dcl 2-444 semantic_translator$abort 000000 constant entry external dcl 2-446 semantic_translator$call_es 000000 constant entry external dcl 1-196 semantic_translator$error 000000 constant entry external dcl 2-450 setbitno_fun internal static bit(9) initial dcl 12-8 setcharno_fun internal static bit(9) initial dcl 12-8 sf_par_node internal static bit(9) initial dcl 13-5 sign_fun internal static bit(9) initial dcl 12-8 signal_on internal static bit(9) initial dcl 12-8 simplify_expression 000000 constant entry external dcl 1-205 simplify_offset 000000 constant entry external dcl 1-212 sin_fun internal static bit(9) initial dcl 12-8 sind_fun internal static bit(9) initial dcl 12-8 skip_format internal static bit(9) initial dcl 12-8 source_node internal static bit(9) initial dcl 13-5 sqrt_fun internal static bit(9) initial dcl 12-8 stack_ptr internal static bit(9) initial dcl 12-8 stackbaseptr_fun internal static bit(9) initial dcl 12-8 stackframeptr_fun internal static bit(9) initial dcl 12-8 stacq_fun internal static bit(9) initial dcl 12-8 statement_node internal static bit(9) initial dcl 13-5 std_arg_list internal static bit(9) initial dcl 12-8 std_call internal static bit(9) initial dcl 12-8 std_entry internal static bit(9) initial dcl 12-8 std_return internal static bit(9) initial dcl 12-8 stop internal static bit(9) initial dcl 12-8 storage_block_type internal static bit(36) initial dcl 14-71 stream_prep internal static bit(9) initial dcl 12-8 subscripter 000000 constant entry external dcl 1-216 tan_fun internal static bit(9) initial dcl 12-8 tand_fun internal static bit(9) initial dcl 12-8 temporary_node internal static bit(9) initial dcl 13-5 terminate_trans internal static bit(9) initial dcl 12-8 this_context automatic bit(36) dcl 16-5 token_node internal static bit(9) initial dcl 13-5 token_to_binary 000000 constant entry external dcl 2-459 translate_fun internal static bit(9) initial dcl 12-8 trunc_fun internal static bit(9) initial dcl 12-8 unlock_file internal static bit(9) initial dcl 12-8 unpack internal static bit(9) initial dcl 12-8 validate 000000 constant entry external dcl 1-225 vclock_fun internal static bit(9) initial dcl 12-8 verify_fun internal static bit(9) initial dcl 12-8 verify_ltrim_fun internal static bit(9) initial dcl 12-8 verify_rev_fun internal static bit(9) initial dcl 12-8 verify_rtrim_fun internal static bit(9) initial dcl 12-8 word_to_mod2 internal static bit(9) initial dcl 12-8 word_to_mod4 internal static bit(9) initial dcl 12-8 word_to_mod8 internal static bit(9) initial dcl 12-8 wordno_fun internal static bit(9) initial dcl 12-8 words_per_condition_var internal static fixed bin(31,0) initial dcl 14-5 words_per_entry_var internal static fixed bin(31,0) initial dcl 14-5 words_per_file_var internal static fixed bin(31,0) initial dcl 14-5 words_per_fix_bin_2 internal static fixed bin(31,0) initial dcl 14-5 words_per_flt_bin_1 internal static fixed bin(31,0) initial dcl 14-5 words_per_flt_bin_2 internal static fixed bin(31,0) initial dcl 14-5 words_per_format internal static fixed bin(31,0) initial dcl 14-5 words_per_label_var internal static fixed bin(31,0) initial dcl 14-5 words_per_offset internal static fixed bin(31,0) initial dcl 14-5 words_per_packed_pointer internal static fixed bin(31,0) initial dcl 14-5 words_per_pointer internal static fixed bin(31,0) initial dcl 14-5 words_per_varying_string_header internal static fixed bin(31,0) initial dcl 14-5 write_file internal static bit(9) initial dcl 12-8 x_format internal static bit(9) initial dcl 12-8 xor_bits internal static bit(9) initial dcl 12-8 NAMES DECLARED BY EXPLICIT CONTEXT. absorb 000347 constant label dcl 185 ref 317 again 001267 constant label dcl 402 ref 432 alter 001364 constant label dcl 429 ref 445 back 003076 constant label dcl 812 ref 783 784 785 793 797 798 802 803 check_addr 002215 constant entry internal dcl 634 ref 120 154 337 412 check_again 000437 constant label dcl 222 ref 278 check_char_units 003226 constant entry internal dcl 856 ref 687 check_exp 002401 constant entry internal dcl 691 ref 183 316 348 351 359 490 512 570 check_mb 001426 constant label dcl 448 ref 397 400 407 419 423 435 438 check_neg 002147 constant label dcl 609 ref 549 552 581 check_sub 000740 constant label dcl 332 ref 193 ck2 003003 constant label dcl 800 ref 791 double_offset 003400 constant entry internal dcl 889 ref 612 elim_sub 001046 constant label dcl 349 ref 360 fb1_const 002572 constant entry internal dcl 740 ref 150 178 314 385 400 407 426 442 474 565 fb_value 002621 constant entry internal dcl 754 ref 88 293 784 797 802 fix_exp 002663 constant entry internal dcl 770 ref 86 96 292 306 795 800 free_exp 003135 constant entry internal dcl 831 ref 335 848 free_op 003102 constant entry internal dcl 815 ref 93 185 298 349 352 411 429 491 513 571 in_expression 002502 constant entry internal dcl 720 ref 706 730 l1 000321 constant label dcl 173 ref 166 no 002660 constant label dcl 767 in procedure "fb_value" ref 759 761 762 763 no 002616 constant label dcl 751 in procedure "fb1_const" ref 745 746 747 no 002563 constant label dcl 735 in procedure "in_expression" ref 727 rep 001645 constant label dcl 523 ref 203 286 309 338 replace 000374 constant label dcl 203 ref 320 342 363 366 368 381 391 394 448 455 457 458 459 463 471 474 477 520 restore_orig_c_offset 003533 constant entry internal dcl 919 ref 532 626 ret 001650 constant label dcl 526 ref 121 155 158 413 set_bit 000600 constant label dcl 284 ref 212 213 231 241 252 simp1 000363 constant label dcl 193 ref 174 simplify 000256 constant label dcl 145 ref 190 300 354 515 574 simplify_offset 000034 constant entry external dcl 25 switch 001152 constant label dcl 373 ref 385 yes 002566 constant label dcl 737 ref 725 730 NAMES DECLARED BY CONTEXT OR IMPLICATION. abs builtin function ref 532 addr builtin function ref 129 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4206 4236 4032 4216 Length 4762 4032 30 507 153 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME simplify_offset 354 external procedure is an external procedure. check_addr internal procedure shares stack frame of external procedure simplify_offset. check_exp internal procedure shares stack frame of external procedure simplify_offset. in_expression 94 internal procedure calls itself recursively. fb1_const internal procedure shares stack frame of external procedure simplify_offset. fb_value 66 internal procedure is called by several nonquick procedures. fix_exp 102 internal procedure calls itself recursively. free_op internal procedure shares stack frame of external procedure simplify_offset. free_exp 92 internal procedure calls itself recursively. check_char_units internal procedure shares stack frame of external procedure simplify_offset. double_offset internal procedure shares stack frame of external procedure simplify_offset. restore_orig_c_offset internal procedure shares stack frame of external procedure simplify_offset. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fb_value 000100 p fb_value fix_exp 000100 p fix_exp 000102 s1 fix_exp 000104 s2 fix_exp 000106 s3 fix_exp 000110 t fix_exp free_exp 000100 px free_exp 000102 py free_exp 000104 j free_exp in_expression 000100 k in_expression simplify_offset 000100 f simplify_offset 000102 p1 simplify_offset 000104 p2 simplify_offset 000106 p3 simplify_offset 000110 p4 simplify_offset 000112 r simplify_offset 000114 s simplify_offset 000116 s1 simplify_offset 000120 s2 simplify_offset 000122 s3 simplify_offset 000124 s4 simplify_offset 000126 sym simplify_offset 000130 q simplify_offset 000132 symref simplify_offset 000134 i simplify_offset 000135 sign simplify_offset 000136 has_offset simplify_offset 000137 ok_to_free simplify_offset 000140 multiple simplify_offset 000141 bit_offset simplify_offset 000142 c_bit_offset simplify_offset 000143 factor simplify_offset 000144 orig_c_offset simplify_offset 000145 start_gen_storage simplify_offset 000146 start_generation simplify_offset 000147 n simplify_offset 000150 fix_precision simplify_offset 000151 lower_precision simplify_offset 000152 op_code simplify_offset 000153 called_fix_exp simplify_offset 000154 fractional_offset_to_be_added simplify_offset 000172 p check_exp 000202 p fb1_const 000212 r1 free_op 000222 new check_char_units 000224 o check_char_units 000226 s1 check_char_units 000236 new double_offset 000240 o double_offset 000242 s1 double_offset 000252 p1 restore_orig_c_offset 000254 p2 restore_orig_c_offset 000256 p3 restore_orig_c_offset 000260 p4 restore_orig_c_offset 000262 difference restore_orig_c_offset 000263 prec2 restore_orig_c_offset 000264 prec3 restore_orig_c_offset THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. unpk_to_pk call_ext_out call_int_this call_int_other return_mac mdfx1 ext_entry int_entry divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. compare_expression convert$to_integer copy_expression create_operator declare_constant$integer declare_temporary free_node share_expression NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000030 60 000041 62 000045 64 000047 70 000052 71 000054 74 000064 76 000072 78 000100 82 000102 86 000116 88 000130 92 000153 93 000157 95 000161 96 000162 102 000172 117 000176 118 000200 120 000204 121 000205 127 000206 129 000210 131 000215 133 000225 134 000230 136 000241 138 000251 143 000255 145 000256 148 000262 150 000265 152 000272 153 000275 154 000301 155 000302 158 000303 161 000304 163 000310 165 000312 166 000314 169 000315 171 000317 173 000321 174 000324 176 000330 178 000332 183 000337 185 000347 186 000351 188 000354 190 000362 193 000363 195 000365 196 000370 203 000374 206 000376 208 000400 211 000413 212 000415 213 000421 214 000424 218 000432 219 000434 220 000435 222 000437 225 000441 231 000444 234 000450 238 000467 241 000473 247 000477 248 000501 250 000513 252 000517 253 000521 257 000530 263 000534 264 000537 266 000545 267 000550 269 000552 271 000554 273 000565 276 000573 277 000574 278 000575 282 000576 284 000600 286 000602 290 000613 292 000620 293 000633 297 000656 298 000661 299 000663 300 000667 302 000670 304 000671 305 000705 306 000707 309 000716 312 000717 314 000721 316 000726 317 000736 320 000737 332 000740 335 000764 336 000772 337 000774 338 000775 341 000776 342 001001 344 001005 346 001013 348 001036 349 001046 351 001050 352 001052 353 001054 354 001057 357 001060 359 001104 360 001114 363 001115 366 001116 368 001120 370 001143 371 001146 373 001152 374 001155 375 001160 376 001163 378 001201 379 001204 380 001207 381 001210 384 001211 385 001213 387 001220 388 001241 389 001244 391 001246 394 001247 396 001251 397 001254 399 001260 400 001262 402 001267 403 001272 405 001276 407 001300 409 001305 410 001310 411 001322 412 001324 413 001325 418 001326 419 001337 422 001343 423 001345 425 001351 426 001353 428 001360 429 001364 430 001366 432 001400 435 001401 437 001403 438 001406 440 001412 442 001414 444 001421 445 001425 448 001426 455 001432 457 001437 458 001443 459 001447 462 001455 463 001456 467 001464 468 001472 470 001474 471 001477 473 001503 474 001505 476 001512 477 001517 482 001522 483 001525 485 001531 488 001533 490 001536 491 001546 492 001550 493 001553 495 001554 497 001570 498 001573 499 001574 507 001575 508 001600 510 001604 512 001607 513 001617 514 001621 515 001624 517 001625 520 001641 523 001645 526 001650 530 001654 532 001657 535 001671 538 001672 544 001703 545 001707 546 001713 548 001716 549 001720 552 001724 555 001727 557 001733 559 001745 561 001747 563 001753 565 001755 567 001762 568 001766 570 001770 571 002001 572 002003 574 002006 576 002007 579 002021 580 002024 581 002040 585 002041 587 002043 588 002047 589 002050 591 002052 592 002071 593 002123 594 002125 595 002143 597 002145 609 002147 612 002161 613 002162 616 002165 620 002203 622 002210 623 002212 626 002213 632 002214 634 002215 637 002216 638 002217 639 002222 641 002227 643 002234 645 002242 646 002245 647 002250 650 002251 655 002254 660 002261 662 002265 666 002276 668 002300 672 002315 673 002320 674 002323 675 002327 676 002333 678 002337 681 002362 682 002365 683 002372 685 002374 687 002377 689 002400 691 002401 702 002403 704 002406 706 002412 710 002447 715 002475 720 002501 725 002507 727 002514 729 002521 730 002533 733 002561 735 002563 737 002566 740 002572 744 002574 745 002577 746 002602 747 002605 749 002610 751 002616 754 002620 758 002626 759 002632 761 002636 762 002641 763 002644 765 002647 767 002660 770 002662 776 002670 777 002674 779 002703 780 002705 782 002711 783 002713 784 002716 785 002732 791 002737 793 002744 795 002747 797 002763 798 002777 800 003003 802 003017 803 003033 807 003037 808 003041 810 003073 812 003076 815 003102 819 003104 820 003110 823 003127 825 003130 826 003132 829 003133 831 003134 836 003142 837 003146 838 003157 839 003161 841 003165 844 003176 845 003200 848 003201 851 003214 853 003216 854 003225 856 003226 860 003227 865 003246 866 003252 868 003256 871 003264 872 003266 874 003276 876 003300 877 003317 878 003352 879 003370 880 003372 881 003374 885 003377 889 003400 894 003401 895 003405 897 003411 900 003417 902 003421 904 003431 906 003433 907 003452 909 003505 910 003523 911 003525 912 003527 915 003532 919 003533 925 003534 927 003537 929 003546 930 003547 932 003553 933 003557 935 003561 936 003576 937 003601 938 003616 939 003622 941 003661 943 003663 945 003665 ----------------------------------------------------------- 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