THIS FILE IS DAMAGED COMPILATION LISTING OF SEGMENT expand_prefix 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 1357.8 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 expand_prefix: proc(blk,stmnt,tree,context) returns(ptr); 12 13 dcl (blk,stmnt,tree,a) ptr; 14 dcl opcode bit(9) aligned; 15 dcl n fixed bin(15); 16 dcl (string,null) builtin; 17 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 */ 18 19 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 */ 20 9 1 /* BEGIN INCLUDE FILE ... semantic_bits.incl.pl1 */ 9 2 9 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 9 4 9 5 dcl context aligned bit(36), 9 6 this_context aligned bit(36); 9 7 9 8 dcl 1 def_context aligned based(addr(context)), 9 9 2 aggregate unaligned bit(1), 9 10 2 arg_list unaligned bit(1), 9 11 2 left_side unaligned bit(1), 9 12 2 return unaligned bit(1), 9 13 2 evaluate_offset unaligned bit(1), 9 14 2 top unaligned bit(1), 9 15 2 RHS_aggregate unaligned bit(1), 9 16 2 return_from_empty unaligned bit(1), 9 r0 *@r0*r0p&r>FFrziris.dump.comp.control r>FF-G`H$8hrzSwÈ@r*@r>H8(r*r>P@6r*r>XH*r>`P*r>hX*@r>`*r>&yڦGĥxx(rzppub_01.control yڦGG`H1$(rzSwÈr*yڦ(r*@yڦ6r*yڦ*yڦ*yڦ*@yڦ*yڦ,p& $H$rzdvpub.incr.control $H4Gw>$$rzSwÈr*@ $(r* $ 6r* $* $ * $$*@ $* $&_I44a,Fspare.dump _IzG2$RaQSwÈZr*_bR(r*_jZ6r*_rb*@_zj*_r*_z*@_*_,&_oIrzEspare.comp.control _oIyG`H$rzSwÈr*@_o(r*_o6r*_o*_o*_o*@_o*_o N&IՔ6rzretv_err.12/16/92.1157 I.Ge$  F6rz SwÈ r* & (r* . 6r*@ 6 &* > .* F 6*@ >* &I V V6rz Nretv_err.12/16/92.1219 IBG=$ t 6rzSwÈ |r* t(r* |6r*@ * * *@ * N&'Kr 6rz retv_err.04/28/93.1010 'KsdGQ-$ 6rzFSwÈ r*' (r*' 6r*@' *' *'  *@' *' h &KrM  6rz ]retv_err.04/28/93.1029 KsdGQ$ 0 `6rz SwÈ 8r* @ 0(r* H 86r*@ P @* X H* ` P*@ X* &{LQ݁ p p6rz hUretv_err.09/21/93.1528 {LV[G $ 6rz<SwÈ r*{ (r*{ 6r*@{ *{ *{ *@{ *{ $ h&cMgP rz vlist.comp.control cMIJG~$ rzSwÈ r*@c (r*c  6r*/ 10 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 10 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 10 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 10 54 return_string initial("001100110"b), /* return string opnd(1) */ 10 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 10 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 10 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 10 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 10 59 std_return initial("001101011"b), /* return -no arguments- */ 10 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 10 61 free_ctl initial("001101101"b), /* free opnd(1) */ 10 62 stop initial("001101110"b), /* stop - terminate run unit */ 10 63 10 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 10 65* opnd(2) <- opnd(3) / 36 */ 10 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 10 67* opnd(2) <- opnd(3) / 4 */ 10 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 10 69* opnd(2) <- opnd(3) / 2 */ 10 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 10 71 10 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 10 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 10 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 10 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 10 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 10 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 10 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 10 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 10 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 10 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 10 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 10 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 10 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 10 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 10 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 10 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 10 88 10 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 10 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 10 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 10 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 10 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 10 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 10 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 10 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 10 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 10 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 10 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 10 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 10 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 10 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 10 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 10 104 10 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 10 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 10 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 10 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 10 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 10 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 10 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 10 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 10 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 10 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 10 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 10 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 10 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 10 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 10 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 10 120 10 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 10 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 10 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 10 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 10 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 10 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 10 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 10 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 10 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 10 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 10 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 10 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 10 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 10 134 10 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 10 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 10 137 10 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 10 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 10 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 10 141* opnd(2) is the file name 10 142* opnd(3) is the block */ 10 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 10 144* opnd(2) is the file name */ 10 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 10 146* opnd(2) is the file name */ 10 147 10 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 10 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 10 150* opnd(3) is old value, (4) is new value. */ 10 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 10 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 10 153 10 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 10 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 10 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 10 157* opnd(5) is the list */ 10 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 10 159 allot_based initiaqPErz>sys_vols.incr.control qPRyåGL$ $rzSwÈ,*qP4$D*qP<,*qPD4 *qPL<r*@qPTD(r*qP\L6r*qPdT*qPl\*qPtd*qP|l*qPt*qP|*qP &qQErzSvroot.comp.control qQRGZ$ rzSwÈ*qQD*qQ*qQ *qQr*@qQ(r*qQ6r*qQ*qQ*qQ*qQ*qQp&=TiEa pv.names =TiE!tG $0haSwÈ8*=Ti@0r*=TiH8(r*=TiP@6r*=TiXH*=Ti`P*=TihX*=Ti`*=Ti &]VEFxxap5vabb.dump ]VE!G$a?SwÈr*]V(r*]V6r*]V*@]V*]V*@]V*]V*]V4p&̞Erz!vabb.incr.control ̞E!G $,rzSwÈr*@̞ (r*̞6r*̞ *̞$*̞,*̞$*̞&sE<<rz4rvabb.cons.control sE!G $ZrzSwÈbr*@sjZ(r*srb6r*szj*sr*sz*s*s4&Erzgvabb.comp.control RyæG&$rzSwÈr*@(r*6r*****N&.**operator.operand(2); 32 opcode = tree->operator.op_code; 33 if a->node.type = reference_node 34 then a = expand_primitive(blk,stmnt,a,this_context); 35 else if a->node.type = operator_node 36 then if a->operator.op_code = std_call 37 then a = expand_primitive(blk,stmnt,(a->operator.operand(1)),"0"b); 38 call apply_prefix(a); 39 return(a); 40 41 /* subroutine to create scalar operators applied to each scalar component of the aggregate. */ 42 43 apply_prefix: proc(e); 44 45 dcl (p,e,t) ptr; 46 dcl n fixed bin(15); 47 48 if e->node.type = operator_node 49 then do; 50 if e->operator.op_code = loop 51 then do; 52 t = e->operand(1); 53 call apply_prefix(t); 54 e->operand(1) = t; 55 return; 56 end; 57 if e->operator.op_code = join 58 then do; 59 do n = 1 to e->operator.number; 60 t = e->operand(n); 61 call apply_prefix(t); 62 e->operand(n) = t; 63 end; 64 return; 65 end; 66 end; 67 p = create_operator(opcode,2); 68 p->operator.operand(2) = e; 69 e = p; 70 e = operator_semantics(blk,stmnt,e,"0"b); 71 return; 72 end apply_prefix; 73 74 end expand_prefix; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/31/89 1338.5 expand_prefix.pl1 >spec>install>MR12.3-1066>expand_prefix.pl1 18 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 20 8 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 21 9 07/21/80 1546.3 semantic_bits.incl.pl1 >ldd>include>semantic_bits.incl.pl1 23 10 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 25 11 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.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. a 000100 automatic pointer dcl 13 set ref 31* 33 33* 33* 35 35 35* 35 38* 39 blk parameter pointer dcl 13 set ref 11 33* 35* 70* by_name_assignment 0(14) based bit(1) level 2 in structure "def_this_context" packed packed unaligned dcl 9-27 in procedure "expand_prefix" set ref 29* by_name_assignment 0(14) based bit(1) level 2 in structure "def_context" packed packed unaligned dcl 9-8 in procedure "expand_prefix" ref 29 context parameter bit(36) dcl 9-5 set ref 11 29 create_operator 000014 constant entry external dcl 2-152 ref 67 def_context based structure level 1 dcl 9-8 def_this_context based structure level 1 dcl 9-27 e parameter pointer dcl 45 set ref 43 48 50 52 54 57 59 60 62 68 69* 70* 70* expand_primitive 000010 constant entry external dcl 1-97 ref 33 35 join constant bit(9) initial dcl 10-8 ref 57 loop constant bit(9) initial dcl 10-8 ref 50 n 000104 automatic fixed bin(15,0) dcl 46 set ref 59* 60 62* node based structure level 1 dcl 11-27 number 0(21) based fixed bin(14,0) level 2 packed packed unaligned dcl 8-6 ref 59 op_code 0(09) based bit(9) level 2 packed packed unaligned dcl 8-6 ref 32 35 50 57 opcode 000102 automatic bit(9) dcl 14 set ref 32* 67* operand 1 based pointer array level 2 packed packed unaligned dcl 8-6 set ref 31 35 52 54* 60 62* 68* operator based structure level 1 dcl 8-6 operator_node constant bit(9) initial dcl 11-5 ref 35 48 operator_semantics 000012 constant entry external dcl 1-184 ref 70 p 000100 automatic pointer dcl 45 set ref 67* 68 69 reference_node constant bit(9) initial dcl 11-5 ref 33 std_call constant bit(9) initial dcl 10-8 ref 35 stmnt parameter pointer dcl 13 set ref 11 33* 35* 70* t 000102 automatic pointer dcl 45 set ref 52* 53* 54 60* 61* 62 this_context 000103 automatic bit(36) dcl 9-5 set ref 28* 29 33* tree parameter pointer dcl 13 ref 11 31 32 type based bit(9) level 2 packed packed unaligned dcl 11-27 ref 33 35 48 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 10-8 abs_fun internal static bit(9) initial dcl 10-8 acos_fun internal static bit(9) initial dcl 10-8 acosd_fun internal static bit(9) initial dcl 10-8 add internal static bit(9) initial dcl 10-8 addbitno_fun internal static bit(9) initial dcl 10-8 addcharno_fun internal static bit(9) initial dcl 10-8 addr_fun internal static bit(9) initial dcl 10-8 addr_fun_bits internal static bit(9) initial dcl 10-8 addrel_fun internal static bit(9) initial dcl 10-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 10-8 allot_auto internal static bit(9) initial dcl 10-8 allot_based internal static bit(9) initial dcl 10-8 allot_ctl internal static bit(9) initial dcl 10-8 allot_var internal static bit(9) initial dcl 10-8 and_bits internal static bit(9) initial dcl 10-8 array_node internal static bit(9) initial dcl 11-5 asin_fun internal static bit(9) initial dcl 10-8 asind_fun internal static bit(9) initial dcl 10-8 assign internal static bit(9) initial dcl 10-8 assign_by_name internal static bit(9) initial dcl 10-8 assign_round internal static bit(9) initial dcl 10-8 assign_size_ck internal static bit(9) initial dcl 10-8 assign_zero internal static bit(9) initial dcl 10-8 atan_fun internal static bit(9) initial dcl 10-8 atand_fun internal static bit(9) initial dcl 10-8 b_format internal static bit(9) initial dcl 10-8 baseno_fun internal static bit(9) initial dcl 10-8 baseptr_fun internal static bit(9) initial dcl 10-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 10-8 bit_to_char internal static bit(9) initial dcl 10-8 bit_to_word internal static bit(9) initial dcl 10-8 bitno_fun internal static bit(9) initial dcl 10-8 block_node internal static bit(9) initial dcl 11-5 bn_format internal static bit(9) initial dcl 10-8 bool_fun internal static bit(9) initial dcl 10-8 bound_ck internal static bit(9) initial dcl 10-8 bound_node internal static bit(9) initial dcl 11-5 builtin 000000 constant entry external dcl 1-17 by_name_agg_node internal static bit(9) initial dcl 11-5 byte_fun internal static bit(9) initial dcl 10-8 c_format internal static bit(9) initial dcl 10-8 cat_string internal static bit(9) initial dcl 10-8 ceil_fun internal static bit(9) initial dcl 10-8 char_to_word internal static bit(9) initial dcl 10-8 charno_fun internal static bit(9) initial dcl 10-8 check_star_extents 000000 constant entry external dcl 1-27 clock_fun internal static bit(9) initial dcl 10-8 close_file internal static bit(9) initial dcl 10-8 codeptr_fun internal static bit(9) initial dcl 10-8 column_format @SwÈ ~2rRrDB8@ X fBR!,SwXeSwÂ:&H &``RyTTrzLdmpr_err.incr.04/12/95.1434 ``RyáGQ$ rzSwÈ9Daemon SwÈrTOperator SwÈHSysAdmin SwÈFSysDaemon SwÈ^SysMaint SwÈFudge SwÈInitializer SwÈKrans SwÈOke SwÈOpr SwÈ &Rosin SwÈSherwood SwÈ( Volume_Dumper SwÈ6IVolume_Reloader SwÈD(QVolume_Retriever SwÈ6WAAnderson SwÈ&qE~ZZrzR6Volume_Dumper.profile qE!>G$ xrz SwÈ*qx*q *qr*@q(r*q6r*q*q*q*q*q6R&qErzfVolume_Dumper.value qE!@Gw$ .rzSwÈ*q*qr*@q(r*q6r*q*q&*q.*q&*q&qE>>6rz6Volume_Retriever.profile qE!EGQ$ \6rz SwÈd*ql\*qtd *q|lr*qt(r*q|6r*@q*q*q*q*q*6&qE aold.start_up.ec qE!rGQ$ " a SwÈ*q*q *qr*q(r*q6r*q *q*q *q"*q*q&qE22rz*nroot_a.comp.control qE!zGw3$ PrzSwÈX*q`PD*qhX*qp`r*@qxh(r*qp6r*qx*q*q*q*q*&qE7rz root_a.dump qE!|GL$ rzZSwÈ*qD*q*qr*@q(r*q6r*q*q*@q*q*q&qErzroot_b.comp.control qE!GLF$ <rzSwÈD*qL<D*qTD*q\Lr*@qdT(r*ql\6r*qtd*q|l*qt*q|*q&qE9rzroot_b.dump qE!G8$ rzZSwÈ*qD*q*qr*@q(r*q6r*q*q*@q*q*qx&qE  rz;root_c.comp.control qE!Gk$ (przSwÈ0*q8(D*q@0*qH8r*@qP@(r*qXH6r*q`P*qhX*qp`*qh*q&qE;rzx<root_c.dump qE!G$ rzZSwÈ*qD*q*qr*@q(r*q6r*q*q*@q*q*qdx&qErzrpv.comp.control qE!GI$ \rzSwÈ*q$D*q,*q4$r*@q<,(r*qD46r*qL<*qTD*q\L*qT*q&qE=llrzd}rpv.dump qE!G$ rz?SwÈ*qD*q*qr*@q(r*q6r*q*q*@q*q*q`d&qE arstart_up.ec qE!G$ XaSwÈ*qD*q*q  *q(*q0 r*q8((r*q@06r*qH8*qP@*qXH*qP*q&qEhhrz`sys_vols.comp.control qE!G`H$ rzSwÈ*qD*q*q *qr*@q(r*q6r*q*q*q*q*q*q`&qMƊzsys_vols.dump qM<Gg external dcl 1-84 expand_prefix 000000 constant entry external dcl 1-89 expression_semantics 000000 constant entry external dcl 1-105 f_format internal static bit(9) initial dcl 10-8 fill_refer 000000 constant entry external dcl 1-113 floor_fun internal static bit(9) initial dcl 10-8 format_value_node internal static bit(9) initial dcl 11-5 fortran_read internal static bit(9) initial dcl 10-8 fortran_write internal static bit(9) initial dcl 10-8 free_based internal static bit(9) initial dcl 10-8 free_ctl internal static bit(9) initial dcl 10-8 free_node 000000 constant entry external dcl 2-345 free_var internal static bit(9) initial dcl 10-8 ftn_file_manip internal static bit(9) initial dcl 10-8 ftn_trans_loop internal static bit(9) initial dcl 10-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 10-8 get_edit_trans internal static bit(9) initial dcl 10-8 get_file internal static bit(9) initial dcl 10-8 get_list_trans internal static bit(9) initial dcl 10-8 get_size 000000 constant entry external dcl 2-352 get_string internal static bit(9) initial dcl 10-8 greater_or_equal internal static bit(9) initial dcl 10-8 greater_than internal static bit(9) initial dcl 10-8 half_to_word internal static bit(9) initial dcl 10-8 imag_fun internal static bit(9) initial dcl 10-8 index_after_fun internal static bit(9) initial dcl 10-8 index_before_fun internal static bit(9) initial dcl 10-8 index_fun internal static bit(9) initial dcl 10-8 index_rev_fun internal static bit(9) initial dcl 10-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 jump internal static bit(9) initial dcl 10-8 jump_false internal static bit(9) initial dcl 10-8 jump_if_eq internal static bit(9) initial dcl 10-8 jump_if_ge internal static bit(9) initial dcl 10-8 jump_if_gt internal static bit(9) initial dcl 10-8 jump_if_le internal static bit(9) initial dcl 10-8 jump_if_lt internal static bit(9) initial dcl 10-8 jump_if_ne |*z R*z &z Ea Daemon.pdt.bad z E{G$Fa6SwÂ>*@z 6F|*z >R*z f&qIVVDaN%Daemon.pdt qIG$aSwÂ^|*@qt|*q|R*q&oEI9a Daemon.pmf oEIG >$a#SwÂN|*@SwÇr*@SwÆR*@j|:Xr*@j|**oEN&{k=ZGoaInternet.01/23/91 {k=ZGo=2 *a~2rSwÂRetriever SwÂr*@{k=Z*@{k=Z&*@{k=Z.|*@{k=Z&r*@{k=Z>*SwÂ6*SwÂN*@SwÂF*@SwÂ"*@SwÈtD*q2N&qGonnzf6fData_Management qGo;22z~2rSwÂr*@q2*@qData_Management SwÂR*@qRRosin SwÂ*z 6*z ^*q*R*oER*@SwÈ**@{k=Z|(Multics SwÂ.R*@{k=ZSysAdmon SwÂD*@Z"DPrint_Dump SwÂ*oEf&j|Go:pap21Internet j|R)9c :a~2rSwÂ`*@j|Xh*@j|`~*@j|:2 in j|hr*@j|~|*@j|D*@j|*mx2&mxEaproject_start_up.ec mxE؈Gw$a\SwÂr*mx*@mxR*mx&oEEanew.pmf oEE؅Gw$ a#Sw *@oER*oE*oE*r*@SwÈR*@Z"*@{k=Z*@q*@j|EaB"tty_arc2 ODg[ u$a &SwÂp*@OR*Ohm@j|*z *z *q*mx*oE*oEr*@SwÇstatic bit(9) initial dcl 10-8 page_format internal static bit(9) initial dcl 10-8 param_desc_ptr internal static bit(9) initial dcl 10-8 param_ptr internal static bit(9) initial dcl 10-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 10-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 10-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 prefix_plus internal static bit(9) initial dcl 10-8 propagate_bit 000000 constant entry external dcl 1-192 ptr_fun internal static bit(9) initial dcl 10-8 put_control internal static bit(9) initial dcl 10-8 put_data_trans internal static bit(9) initial dcl 10-8 put_edit_trans internal static bit(9) initial dcl 10-8 put_field internal static bit(9) initial dcl 10-8 put_field_chk internal static bit(9) initial dcl 10-8 put_file internal static bit(9) initial dcl 10-8 put_list_trans internal static bit(9) initial dcl 10-8 put_string internal static bit(9) initial dcl 10-8 r_format internal static bit(9) initial dcl 10-8 r_parn internal static bit(9) initial dcl 10-8 range_ck internal static bit(9) initial dcl 10-8 rank_fun internal static bit(9) initial dcl 10-8 read_file internal static bit(9) initial dcl 10-8 real_fun internal static bit(9) initial dcl 10-8 record_io internal static bit(9) initial dcl 10-8 refer internal static bit(9) initial dcl 10-8 refer_extent 000000 constant entry external dcl 2-426 rel_fun internal static bit(9) initial dcl 10-8 repeat_fun internal static bit(9) initial dcl 10-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 10-8 return_string internal static bit(9) initial dcl 10-8 return_value internal static bit(9) initial dcl 10-8 return_words internal static bit(9) initial dcl 10-8 reverse_fun internal static bit(9) initial dcl 10-8 revert_on internal static bit(9) initial dcl 10-8 rewrite_file internal static bit(9) initial dcl 10-8 round_fun internal static bit(9) initial dcl 10-8 search_fun internal static bit(9) initial dcl 10-8 search_rev_fun internal static bit(9) initial dcl 10-8 segno_fun internal static bit(9) initial dcl 10-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 10-8 setcharno_fun internal static bit(9) initial dcl 10-8 sf_par_node internal static bit(9) initial dcl 11-5 share_expression 000000 constant entry external dcl 2-454 sign_fun internal static bit(9) initial dcl 10-8 signal_on internal static bit(9) initial dcl 10-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 10-8 sind_fun internal static bit(9) initial dcl 10-8 skip_format internal static bit(9) initial dcl 10-8 source_node internal static bit(9) initial dcl 11-5 sqrt_fun internal static bit(9) initial dcl 10-8 stack_ptr internal static bit(9) initial dcl 10-8 stackbaseptr_fun internal static bit(9) initial dcl 10-8 stackframeptr_fun internal static bit(9) initial dcl 10-8 stacq_fun internal static bit(9) initial dcl 10-8 statement_node internal static bit(9) initial dcl 11-5 std_arg_list internal static bit(9) initial dcl 10-8 std_entry internal static bit(9) initial dcl 10-8 std_return internal static bit(9) initial dcl 10-8 stop internal static bit(9) initial dcl 10-8 stream_prep internal static bit(9) initial dcl 10-8 string builtin function dcl 16 sub internal static bit(9) initial dcl 10-8 subscripter 000000 constant entry external dcl 1-216 symbol_node internal static bit(9) initial dcl 11-5 tan_fun internal static bit(9) initial dcl 10-8 tand_fun internal static bit(9) initial dcl 10-8 temporary_node internal static bit(9) initial dcl 11-5 terminate_trans internal static bit(9) initial dcl 10-8 token_node internal static bit(9) initial dcl 11-5 token_to_binary 000000 constant entry external dcl 2-459 translate_fun internal static bit(9) initial dcl 10-8 trunc_fun internal static bit(9) initial dcl 10-8 unlock_file internal static bit(9) initial dcl 10-8 unpack internal static bit(9) initial dcl 10-8 validate 000000 constant entry external dcl 1-225 vclock_fun internal static bit(9) initial dcl 10-8 verify_fun internal static bit(9) initial dcl 10-8 verify_ltrim_fun internal static bit(9) initial dcl 10-8 verify_rev_fun internal static bit(9) initial dcl 10-8 verify_rtrim_fun internal static bit(9) initial dcl 10-8 word_to_mod2 internal static bit(9) initial dcl 10-8 word_to_mod4 internal static bit(9) initial dcl 10-8 word_to_mod8 internal static bit(9) initial dcl 10-8 wordno_fun internal static bit(9) initial dcl 10-8 write_file internal static bit(9) initial dcl 10-8 x_format internal static bit(9) initial dcl 10-8 xor_bits internal static bit(9) initial dcl 10-8 NAMES DECLARED BY EXPLICIT CONTEXT. apply_prefix 000127 constant entry internal dcl 43 ref 38 53 61 expand_prefix 000014 constant entry external dcl 11 NAME DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 29 29 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 360 376 275 370 Length 1000 275 16 365 63 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME expand_prefix 84 external procedure is an external procedure. apply_prefix 112 internal procedure calls itself recursively. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME apply_prefix 000100 p apply_prefix 000102 t apply_prefix 000104 n apply_prefix expand_prefix 000100 a expand_prefix 000102 opcode expand_prefix 000103 this_context expand_prefix THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out call_int_this call_int_other return_mac ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. create_operator expand_primitive operator_semantics NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000007 28 000021 29 000022 31 000027 32 000033 33 000037 35 000063 38 000114 39 000122 43 000126 48 000134 50 000142 52 000150 53 000153 54 000162 55 000167 57 000170 59 000172 60 000203 61 000207 62 000216 63 000223 64 000225 67 000226 68 000243 69 000250 70 000251 71 000274 ----------------------------------------------------------- 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