1 /****^ ********************************************************* 2 * * 3 * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4 * * 5 ********************************************************* */ 6 7 /* BEGIN INCLUDE FILE ... language_utility.incl.pl1 */ 8 9 10 /****^ HISTORY COMMENTS: 11 1) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu), 12 install(89-07-31,MR12.3-1066): 13 Removed the obsolete parameter source_line from the dcl of error_(). 14 END HISTORY COMMENTS */ 15 16 /* Modified: 6 Jun 1979 by PG to add rank and byte 17 * Modified: 9 Jul 1989 by RW updated the declaration of error_ 18 */ 19 20 declare adjust_count entry(pointer); 21 /* parameter 1: (input) any node pointer */ 22 23 declare bindec entry(fixed bin(31)) reducible 24 returns(character(12) aligned); 25 /* parameter 1: (input) bin value */ 26 /* return: (output) character value with blanks */ 27 28 declare bindec$vs entry(fixed bin(31)) reducible 29 returns(character(12) aligned varying); 30 /* parameter 1: (input) binary value */ 31 /* return: (output) char value without blanks */ 32 33 declare binoct entry(fixed bin(31)) reducible 34 returns(char(12) aligned); 35 /* parameter 1: (input) binary value */ 36 /* return: (output) char value with blanks */ 37 38 declare binary_to_octal_string entry(fixed bin(31)) reducible 39 returns(char(12) aligned); 40 /* parameter 1: (input) binary value */ 41 /* return: (output) right-aligned char value */ 42 43 declare binary_to_octal_var_string entry(fixed bin(31)) reducible 44 returns(char(12) varying aligned); 45 /* parameter 1: (input) binary value */ 46 /* returns: (output) char value without blanks */ 47 48 declare compare_expression entry(pointer,pointer) reducible 49 returns(bit(1) aligned); 50 /* parameter 1: (input) any node pointer */ 51 /* parameter 2: (input) any node pointer */ 52 /* return: (output) compare bit */ 53 54 declare constant_length entry (pointer, fixed bin (71)) 55 returns (bit (1) aligned); 56 /* parameter 1: (input) reference node pointer */ 57 /* parameter 2: (input) value of constant length */ 58 /* return: (output) "1"b if constant length */ 59 60 declare convert entry(pointer,bit(36) aligned) 61 returns(pointer); 62 /* parameter 1: (input) any node pointer */ 63 /* parameter 2: (input) target type */ 64 /* return: (output) target value tree pointer */ 65 66 declare convert$to_integer entry(pointer,bit(36)aligned) 67 returns(pointer); 68 /* parameter 1: (input) any node pointer */ 69 /* parameter 2: (input) target type */ 70 /* return: (output) target value tree pointer */ 71 72 declare convert$from_builtin entry(pointer,bit(36) aligned) 73 returns(pointer); 74 /* parameter 1: (input) any node pointer */ 75 /* parameter 2: (input) target type */ 76 /* return: (output) target value tree pointer */ 77 78 declare convert$validate entry(pointer,pointer); 79 /* parameter 1: (input) source value tree pointer */ 80 /* parameter 2: (input) target reference node pointer */ 81 82 declare convert$to_target_fb entry(pointer,pointer) 83 returns(pointer); 84 /* parameter 1: (input) source value tree pointer */ 85 /* parameter 2: (input) target reference node pointer */ 86 /* return: (output) target value tree pointer */ 87 88 declare convert$to_target entry(pointer,pointer) 89 returns(pointer); 90 /* parameter 1: (input) source value tree pointer */ 91 /* parameter 2: (input) target reference node pointer */ 92 /* return: (output) target value tree pointer */ 93 94 declare copy_expression entry(pointer unaligned) 95 returns(pointer); 96 /* parameter 1: (input) any node pointer */ 97 /* return: (output) any node pointer */ 98 99 declare copy_expression$copy_sons entry(pointer,pointer); 100 /* parameter 1: (input) father symbol node pointer */ 101 /* parameter 2: (input) stepfather symbol node ptr */ 102 103 declare copy_unique_expression entry(pointer) 104 returns(pointer); 105 /* parameter 1: (input) any node pointer */ 106 /* return: (output) any node pointer */ 107 108 declare create_array entry() 109 returns(pointer); 110 /* return: (output) array node pointer */ 111 112 declare create_block entry(bit(9) aligned,pointer) 113 returns(pointer); 114 /* parameter 1: (input) block type */ 115 /* parameter 2: (input) father block node pointer */ 116 /* return: (output) block node pointer */ 117 118 declare create_bound entry() 119 returns(pointer); 120 /* return: (output) bound node pointer */ 121 122 declare create_context entry(pointer,pointer) 123 returns(pointer); 124 /* parameter 1: (input) block node pointer */ 125 /* parameter 2: (input) token pointer */ 126 /* return: (output) context node pointer */ 127 128 declare create_cross_reference entry() 129 returns(pointer); 130 /* return: (output) cross reference node pointer */ 131 132 declare create_default entry 133 returns(pointer); 134 /* return: (output) default node pointer */ 135 136 declare create_identifier entry() 137 returns(pointer); 138 /* return: (output) token node pointer */ 139 140 declare create_label entry(pointer,pointer,bit(3) aligned) 141 returns(pointer); 142 /* parameter 1: (input) block node pointer */ 143 /* parameter 2: (input) token node pointer */ 144 /* parameter 3: (input) declare type */ 145 /* return: (output) label node pointer */ 146 147 declare create_list entry(fixed bin(15)) 148 returns(pointer); 149 /* parameter 1: (input) number of list elements */ 150 /* return: (output) list node pointer */ 151 152 declare create_operator entry(bit(9) aligned,fixed bin(15)) 153 returns(pointer); 154 /* parameter 1: (input) operator type */ 155 /* parameter 2: (input) number of operands */ 156 /* return: (output) operator node pointer */ 157 158 declare create_reference entry(pointer) 159 returns(pointer); 160 /* parameter 1: (input) symbol node pointer */ 161 /* return: (output) reference node pointer */ 162 163 declare create_statement entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 164 returns(pointer); 165 /* parameter 1: (input) statement type */ 166 /* parameter 2: (input) block node pointer */ 167 /* parameter 3: (input) label node pointer */ 168 /* parameter 4: (input) conditions */ 169 /* return: (output) statement node pointer */ 170 171 declare create_statement$prologue entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 172 returns(pointer); 173 /* parameter 1: (input) statement type */ 174 /* parameter 2: (input) block node pointer */ 175 /* parameter 3: (input) label node pointer */ 176 /* parameter 4: (input) conditions */ 177 /* return: (output) statement node pointer */ 178 179 declare create_storage entry(fixed bin(15)) 180 returns(pointer); 181 /* parameter 1: (input) number of words */ 182 /* return: (output) storage block pointer */ 183 184 declare create_symbol entry(pointer,pointer,bit(3) aligned) 185 returns(pointer); 186 /* parameter 1: (input) block node pointer */ 187 /* parameter 2: (input) token node pointer */ 188 /* parameter 3: (input) declare type */ 189 /* return: (output) symbol node pointer */ 190 191 declare create_token entry (character (*), bit (9) aligned) 192 returns (ptr); 193 /* parameter 1: (input) token string */ 194 /* parameter 2: (input) token type */ 195 /* return: (output) token node ptr */ 196 197 declare create_token$init_hash_table entry (); 198 199 declare create_token$protected entry (char (*), bit (9) aligned, bit (18) aligned) 200 returns (ptr); 201 /* parameter 1: (input) token string */ 202 /* parameter 2: (input) token type */ 203 /* parameter 3: (input) protected flag */ 204 /* return: (output) token node ptr */ 205 206 declare decbin entry(character(*) aligned) reducible 207 returns(fixed bin(31)); 208 /* parameter 1: (input) decimal character string */ 209 /* return: (output) binary value */ 210 211 declare declare_constant entry(bit(*) aligned,bit(36) aligned,fixed bin(31),fixed bin(15)) 212 returns(pointer); 213 /* parameter 1: (input) value */ 214 /* parameter 2: (input) type */ 215 /* parameter 3: (input) size */ 216 /* parameter 4: (input) scale */ 217 /* return: (output) reference node pointer */ 218 219 declare declare_constant$bit entry(bit(*) aligned) 220 returns(pointer); 221 /* parameter 1: (input) bit */ 222 /* return: (output) reference node pointer */ 223 224 declare declare_constant$char entry(character(*) aligned) 225 returns(pointer); 226 /* parameter 1: (input) character */ 227 /* return: (output) reference node pointer */ 228 229 declare declare_constant$desc entry(bit(*) aligned) 230 returns(pointer); 231 /* parameter 1: (input) descriptor bit value */ 232 /* return: (output) reference node pointer */ 233 234 declare declare_constant$integer entry(fixed bin(31)) /* note...should really be fixed bin(24) */ 235 returns(pointer); 236 /* parameter 1: (input) integer */ 237 /* return: (output) reference node pointer */ 238 239 declare declare_descriptor entry(pointer,pointer,pointer,pointer,bit(2) aligned) 240 returns(pointer); 241 /* parameter 1: (input) block node pointer */ 242 /* parameter 2: (input) statement node pointer */ 243 /* parameter 3: (input) symbol node pointer */ 244 /* parameter 4: (input) loc pointer */ 245 /* parameter 5: (input) array descriptor bit 246 cross_section bit */ 247 /* return: (output) reference node pointer */ 248 249 declare declare_descriptor$ctl entry(pointer,pointer,pointer,pointer,bit(2) aligned) 250 returns(pointer); 251 /* parameter 1: (input) block node pointer */ 252 /* parameter 2: (input) statement node pointer */ 253 /* parameter 3: (input) symbol node pointer */ 254 /* parameter 4: (input) loc pointer */ 255 /* parameter 5: (input) array descriptor bit 256 cross_section bit */ 257 /* return: (output) reference node pointer */ 258 259 declare declare_descriptor$param entry(pointer,pointer,pointer,pointer,bit(2) aligned) 260 returns(pointer); 261 /* parameter 1: (input) block node pointer */ 262 /* parameter 2: (input) statement node pointer */ 263 /* parameter 3: (input) symbol node pointer */ 264 /* parameter 4: (input) loc pointer */ 265 /* parameter 5: (input) array descriptor bit 266 cross_section bit */ 267 /* return: (output) reference node pointer */ 268 269 declare declare_integer entry(pointer) 270 returns(pointer); 271 /* parameter 1: (input) block node pointer */ 272 /* return: (output) reference node pointer */ 273 274 declare declare_picture entry(char(*)aligned,pointer,fixed bin(15)); 275 /* parameter 1: (input) picture string */ 276 /* parameter 2: (input) symbol node pointer */ 277 /* parameter 3: (output) error code, if any */ 278 279 declare declare_picture_temp entry(char(*) aligned,fixed bin(31),bit(1) aligned,bit(1) aligned) 280 returns(pointer); 281 /* parameter 1: (input) picture string */ 282 /* parameter 2: (input) scalefactor of picture */ 283 /* parameter 3: (input) ="1"b => complex picture */ 284 /* parameter 4: (input) ="1"b => unaligned temp */ 285 /* return: (output) reference node pointer */ 286 287 declare declare_pointer entry(pointer) 288 returns(pointer); 289 /* parameter 1: (input) block node pointer */ 290 /* return: (output) reference node pointer */ 291 292 declare declare_temporary entry(bit(36) aligned,fixed bin(31),fixed bin(15),pointer) 293 returns(pointer); 294 /* parameter 1: (input) type */ 295 /* parameter 2: (input) precision */ 296 /* parameter 3: (input) scale */ 297 /* parameter 4: (input) length */ 298 /* return: (output) reference node pointer */ 299 300 declare decode_node_id entry(pointer,bit(1) aligned) 301 returns(char(120) varying); 302 /* parameter 1: (input) node pointer */ 303 /* parameter 2: (input) ="1"b => capitals */ 304 /* return: (output) source line id */ 305 306 declare decode_source_id entry( 307 %include source_id_descriptor; 308 bit(1) aligned) 309 returns(char(120) varying); 310 /* parameter 1: (input) source id */ 311 /* parameter 2: (input) ="1"b => capitals */ 312 /* return: (output) source line id */ 313 314 declare error entry(fixed bin(15),pointer,pointer); 315 /* parameter 1: (input) error number */ 316 /* parameter 2: (input) statement node pointer or null*/ 317 /* parameter 3: (input) token node pointer */ 318 319 declare error$omit_text entry(fixed bin(15),pointer,pointer); 320 /* parameter 1: (input) error number */ 321 /* parameter 2: (input) statement node pointer or null*/ 322 /* parameter 3: (input) token node pointer */ 323 324 declare error_ entry(fixed bin(15), 325 %include source_id_descriptor; 326 pointer,fixed bin(8),fixed bin(23),fixed bin(11)); 327 /* parameter 1: (input) error number */ 328 /* parameter 2: (input) statement id */ 329 /* parameter 3: (input) any node pointer */ 330 /* parameter 4: (input) source segment */ 331 /* parameter 5: (input) source starting character */ 332 /* parameter 6: (input) source length */ 333 334 declare error_$no_text entry(fixed bin(15), 335 %include source_id_descriptor; 336 pointer); 337 /* parameter 1: (input) error number */ 338 /* parameter 2: (input) statement id */ 339 /* parameter 3: (input) any node pointer */ 340 341 declare error_$initialize_error entry(); 342 343 declare error_$finish entry(); 344 345 declare free_node entry(pointer); 346 /* parameter 1: any node pointer */ 347 348 declare get_array_size entry(pointer,fixed bin(3)); 349 /* parameter 1: (input) symbol node pointer */ 350 /* parameter 2: (input) units */ 351 352 declare get_size entry(pointer); 353 /* parameter 1: (input) symbol node pointer */ 354 355 declare merge_attributes external entry(pointer,pointer) 356 returns(bit(1) aligned); 357 /* parameter 1: (input) target symbol node pointer */ 358 /* parameter 2: (input) source symbol node pointer */ 359 /* return: (output) "1"b if merge was unsuccessful */ 360 361 declare optimizer entry(pointer); 362 /* parameter 1: (input) root pointer */ 363 364 declare parse_error entry(fixed bin(15),pointer); 365 /* parameter 1: (input) error number */ 366 /* parameter 2: (input) any node pointer */ 367 368 declare parse_error$no_text entry(fixed bin(15),pointer); 369 /* parameter 1: (input) error number */ 370 /* parameter 2: (input) any node pointer */ 371 372 declare pl1_error_print$write_out 373 entry(fixed bin(15), 374 %include source_id_descriptor; 375 pointer,fixed bin(11),fixed bin(31),fixed bin(31),fixed bin(15)); 376 /* parameter 1: (input) error number */ 377 /* parameter 2: (input) statement identification */ 378 /* parameter 3: (input) any node pointer */ 379 /* parameter 4: (input) source segment */ 380 /* parameter 5: (input) source character index */ 381 /* parameter 6: (input) source length */ 382 /* parameter 7: (input) source line */ 383 384 declare pl1_error_print$listing_segment 385 entry(fixed bin(15), 386 %include source_id_descriptor; 387 pointer); 388 /* parameter 1: (input) error number */ 389 /* parameter 2: (input) statement identification */ 390 /* parameter 3: (input) token node pointer */ 391 392 declare pl1_print$varying entry(character(*) aligned varying); 393 /* parameter 1: (input) string */ 394 395 declare pl1_print$varying_nl entry(character(*) aligned varying); 396 /* parameter 1: (input) string */ 397 398 declare pl1_print$non_varying entry(character(*) aligned,fixed bin(31)); 399 /* parameter 1: (input) string */ 400 /* parameter 2: (input) string length or 0 */ 401 402 declare pl1_print$non_varying_nl entry(character(*) aligned,fixed bin(31)); 403 /* parameter 1: (input) string */ 404 /* parameter 2: (input) string length or 0 */ 405 406 declare pl1_print$string_pointer entry(pointer,fixed bin(31)); 407 /* parameter 1: (input) string pointer */ 408 /* parameter 2: (input) string size */ 409 410 declare pl1_print$string_pointer_nl entry(pointer,fixed bin(31)); 411 /* parameter 1: (input) string pointer */ 412 /* parameter 2: (input) string length or 0 */ 413 414 declare pl1_print$unaligned_nl entry(character(*) unaligned,fixed bin(31)); 415 /* parameter 1: (input) string */ 416 /* parameter 2: (input) length */ 417 418 declare pl1_print$for_lex entry (ptr, fixed bin (14), fixed bin (21), fixed bin (21), bit (1) aligned, bit (1) aligned); 419 /* parameter 1: (input) ptr to base of source segment */ 420 /* parameter 2: (input) line number */ 421 /* parameter 3: (input) starting offset in source seg */ 422 /* parameter 4: (input) number of chars to copy */ 423 /* parameter 5: (input) ON iff shd print line number */ 424 /* parameter 6: (input) ON iff line begins in comment */ 425 426 declare refer_extent entry(pointer,pointer); 427 /* parameter 1: (input/output) null,ref node,op node pointer */ 428 /* parameter 2: (input) null,ref node,op node pointer */ 429 430 declare reserve$clear entry() 431 returns(pointer); 432 /* return: (output) pointer */ 433 434 declare reserve$declare_lib entry(fixed bin(15)) 435 returns(pointer); 436 /* parameter 1: (input) builtin function number */ 437 /* return: (output) pointer */ 438 439 declare reserve$read_lib entry(fixed bin(15)) 440 returns(pointer); 441 /* parameter 1: (input) builtin function number */ 442 /* return: (output) pointer */ 443 444 declare semantic_translator entry(); 445 446 declare semantic_translator$abort entry(fixed bin(15),pointer); 447 /* parameter 1: (input) error number */ 448 /* parameter 2: (input) any node pointer */ 449 450 declare semantic_translator$error entry(fixed bin(15),pointer); 451 /* parameter 1: (input) error number */ 452 /* parameter 2: (input) any node pointer */ 453 454 declare share_expression entry(ptr) 455 returns(ptr); 456 /* parameter 1: (input) usually operator node pointer */ 457 /* return: (output) tree pointer or null */ 458 459 declare token_to_binary entry(ptr) reducible 460 returns(fixed bin(31)); 461 /* parameter 1: (input) token node pointer */ 462 /* return: (output) converted binary value */ 463 464 /* END INCLUDE FILE ... language_utility.incl.pl1 */