COMPILATION LISTING OF SEGMENT vrmu_compare_values Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/21/84 1435.6 mst Wed Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 vrmu_compare_values: proc (value1_ptr, desc1_ptr, value2_ptr, desc2_ptr, operator, result, code); 19 20 /* DESCRIPTION */ 21 22 /* 23* This routine accepts two pointers to some data values and two pointers to the 24* Multics descriptors describing those values, it compares them with respect 25* to the input relational operator. Eithr a result ("1"b or "0"b) or an error code 26* is returned. Character strings may be compared only against other character 27* strings either or both of which may be varying. The same for bit strings. Complex 28* numeric data types may be compared only against other complex data types, also 29* only the operators equal and not_equal may be used, any other operator will 30* cause an error. Real numeric data types may be compared only against other real 31* numeric data types. Any other combination of data types will generate an error. 32* Numeric comparisons are performed by converting the operands into complex/real 33* float decimal (59). 34* 35* All errors are reported to the user via sub_err_ as well as in the returned 36* error code. 37* 38* The internal procedure error performs a non-local goto to compare_values_exit 39* to exit this routine. 40* 41* 42*%page; 43* HISTORY: 44* 45* 16-aug_79 NSDavids Original coding 46* 47* Modified by Jim Gray - - Dec. 1979, to add packed decimal data 48* type capability 49* 50* Modified March 25, 1980 by R. Lackey to remove calls to 51* mdbm_util_ 52* 53* Modified November 24, 1980 by M. Pierret to align result for 54* efficiency 55* 56* 81-05-19 Jim Gray : changed the "&" to "|" in the complex and 57* real data type cases, so that any complex or real number 58* comparisons can be handled. 59* 60* 81-05-20 Jim Gray : added a case for doing bit-char type compares 61* by converting the bit operand to char, and doing a char-char 62* compare. Also added data type to error message for conversion 63* errors. 64* 65* 81-05-23 Jim Gray : added special case for fixed bin, equal 66* scale, comaprisons, for performance improvment, by avoiding calls 67* to mu_convert for this case. This was originally coded by M. 68* Pierret. I adopted it, and made some corrections to the original 69* code, and put it in the subroutine compare_fb_fb. 70* 71* 81-05-23 B Jim Gray : added special case for float bin 72* comparisons, done in a manner similar to the fixed bin case 73* above. 74* 75* 82-09-10 Roger Lackey : Changed to vrmu_compare_values and reformated 76* changed all calls to mu_* to vrmu_* 77* 78* 83-03-27 Roger Lackey : Changed the operator index values from what mrds 79* used to search_specification operator values 1-7 80* Old New 81* 1 1 = 82* 2 5 ^= 83* 3 7 < 84* 4 6 <= 85* 5 2 > 86* 6 3 >= 87* 88**/ 89 90 /* vrmu_compare_values: proc (value1_ptr, desc1_ptr, value2_ptr, desc2_ptr, operator, result, code); */ 91 92 /* PARAMETERS */ 93 94 dcl value1_ptr ptr; /* (input) pointer to first operand */ 95 dcl desc1_ptr ptr; /* (input) pointer to descriptor of first operand */ 96 dcl value2_ptr ptr; /* (input) ditto for the second operand */ 97 dcl desc2_ptr ptr; /* (input) ditto ditto */ 98 dcl operator fixed bin; /* (input) the relational operator */ 99 /* 1 = */ 100 /* 2 > */ 101 /* 3 >= */ 102 /* 4 ^ NOT VALID operator */ 103 /* 5 ^= */ 104 /* 6 <= */ 105 /* 7 < */ 106 dcl result bit (1) aligned; /* (output) true if comparison was true */ 107 dcl code fixed bin (35); /* (output) error code */ 108 109 code = 0; /* make sure we don't return garbage */ 110 result = "0"b; 111 112 desc1 = desc1_ptr -> desc; /* get our own copy of the descriptors */ 113 desc2 = desc2_ptr -> desc; 114 115 if desc1.type = CHAR_VAR | desc1.type = BIT_VAR /* make varying strings look like non-varying */ 116 then do; 117 operand1_ptr = addr (value1_ptr -> varying_string.data); /* move operand pointer over one word */ 118 string (desc1.size) = substr (value1_ptr -> varying_string.size, 13); 119 /* modify descriptor to show accutal string length */ 120 desc1_type = desc1_type - 1; /* modify type to non-varying */ 121 end; 122 else operand1_ptr = value1_ptr; 123 124 if desc2.type = CHAR_VAR | desc2.type = BIT_VAR 125 then do; 126 operand2_ptr = addr (value2_ptr -> varying_string.data); 127 string (desc2.size) = substr (value2_ptr -> varying_string.size, 13); 128 desc2_type = desc2_type - 1; 129 end; 130 else operand2_ptr = value2_ptr; 131 132 if (operator < 1 | operator > 7) | operator = 4 /* make sure we have a legal operator */ 133 then call error (mrds_error_$inv_operator, ltrim (char (operator)) || " is not a valid operator code"); 134 135 136 137 /* Do the comparison */ 138 139 140 if desc1.type = CHAR & desc2.type = CHAR 141 then call compare_char_char (operand1_ptr, string (desc1.size), operand2_ptr, string (desc2.size), 142 operator, result); 143 144 145 else 146 if desc1.type = BIT & desc2.type = BIT 147 then call compare_bit_bit (operand1_ptr, string (desc1.size), operand2_ptr, string (desc2.size), operator, result); 148 149 150 else 151 if COMPLEX (desc1_type) | COMPLEX (desc2_type) /* CHANGE 81-05-19 : allow any complex number comparison */ 152 then do; 153 call vrmu_convert (operand1_ptr, addr (desc1), addr (cfld59a1), addr (CFLD59A_DESC), code); 154 if code ^= 0 155 then call error (code, "Could not convert a " || vrmu_display_descriptor (desc1_ptr) || 156 " value to a complex float decimal (59) data type"); 157 call vrmu_convert (operand2_ptr, addr (desc2), addr (cfld59a2), addr (CFLD59A_DESC), code); 158 if code ^= 0 159 then call error (code, "Could not convert a " || 160 vrmu_display_descriptor (desc2_ptr) || " value to a complex float decimal (59) data type"); 161 call compare_c59_c59 (cfld59a1, cfld59a2, operator, result); 162 end; 163 164 165 else 166 if REAL (desc1_type) | REAL (desc2_type) /* CHANGE 81-05-19 : allow any real number comparison */ 167 then do; 168 169 /* BEGIN CHANGE 81-05-23 ********************************************** */ 170 171 if FIXED_BIN (desc1_type) & FIXED_BIN (desc2_type) & 172 desc1.scale = desc2.scale then 173 call compare_fb_fb (); 174 else if FLOAT_BIN (desc1_type) & FLOAT_BIN (desc2_type) then 175 call compare_flb_flb (); 176 177 /* END CHANGE 81-05-23 ************************************************ */ 178 179 else do; 180 call vrmu_convert (operand1_ptr, addr (desc1), addr (rfld59a1), addr (RFLD59A_DESC), code); 181 if code ^= 0 182 then call error (code, "Could not convert a " || vrmu_display_descriptor (desc1_ptr) || 183 " value to a real float decimal (59) data type"); 184 call vrmu_convert (operand2_ptr, addr (desc2), addr (rfld59a2), addr (RFLD59A_DESC), code); 185 if code ^= 0 186 then call error (code, "Could not convert a " || 187 vrmu_display_descriptor (desc2_ptr) || " value to a real float decimal (59) data type"); 188 call compare_r59_r59 (rfld59a1, rfld59a2, operator, result); 189 end; 190 end; 191 192 193 /* BEGIN CHANGE 81-05-20 ******************************************** */ 194 195 else if (desc1.type = BIT & desc2.type = CHAR) | (desc1.type = CHAR & desc2.type = BIT) then do; 196 197 /* do bit-char comparisons as char-char comaprisons, 198* after converting the bit oeprand to character */ 199 200 if desc1.type = BIT then do; 201 bit_temp_size = bin (string (desc1.size)); 202 char_temp = char (operand1_ptr -> bit_temp); 203 char_temp_size = addr (char_temp) -> overlay.fb24; 204 205 temp_ptr = addr (char_temp); 206 call compare_char_char (addrel (temp_ptr, 1), char_temp_size, 207 operand2_ptr, string (desc2.size), 208 operator, result); 209 end; 210 else do; 211 bit_temp_size = bin (string (desc2.size)); 212 char_temp = char (operand2_ptr -> bit_temp); 213 char_temp_size = addr (char_temp) -> overlay.fb24; 214 temp_ptr = addr (char_temp); 215 call compare_char_char (operand1_ptr, string (desc1.size), 216 addrel (temp_ptr, 1), char_temp_size, 217 operator, result); 218 end; 219 end; 220 221 /* END CHANGE 81-05-20 *********************************************** */ 222 223 224 else call error (mrds_error_$inv_comparison, "The data types " || vrmu_display_descriptor (desc1_ptr) || 225 " and " || vrmu_display_descriptor (desc2_ptr) || " cannot be compared"); 226 227 228 compare_values_exit: 229 return; 230 231 compare_char_char: proc (c_operand1_ptr, c_operand1_size, c_operand2_ptr, c_operand2_size, c_operator, c_result); 232 233 /* PARAMETERS */ 234 235 dcl c_operand1_ptr ptr; 236 dcl c_operand1_size bit (24); 237 dcl c_operand2_ptr ptr; 238 dcl c_operand2_size bit (24); 239 dcl c_operator fixed bin; 240 dcl c_result bit (1) aligned; 241 242 /* BASED */ 243 244 dcl c_operand1 char (bin (c_operand1_size)) based (c_operand1_ptr); 245 dcl c_operand2 char (bin (c_operand2_size)) based (c_operand2_ptr); 246 247 248 goto c_compare (c_operator); /* value of c_operator was checked when 249* compare_values was entered */ 250 251 252 c_compare (1): /* operator: = */ 253 if c_operand1 = c_operand2 254 then c_result = "1"b; 255 else c_result = "0"b; 256 goto c_exit; 257 258 c_compare (2): /* operator: > */ 259 if c_operand1 > c_operand2 260 then c_result = "1"b; 261 else c_result = "0"b; 262 goto c_exit; 263 264 c_compare (3): /* operator: >= */ 265 if c_operand1 >= c_operand2 266 then c_result = "1"b; 267 else c_result = "0"b; 268 goto c_exit; 269 270 c_compare (5): /* operator: ^= */ 271 if c_operand1 ^= c_operand2 272 then c_result = "1"b; 273 else c_result = "0"b; 274 goto c_exit; 275 276 c_compare (6): /* operator: <= */ 277 if c_operand1 <= c_operand2 278 then c_result = "1"b; 279 else c_result = "0"b; 280 goto c_exit; 281 282 c_compare (7): /* operator: < */ 283 if c_operand1 < c_operand2 284 then c_result = "1"b; 285 else c_result = "0"b; 286 goto c_exit; 287 288 c_exit: return; 289 290 end /* compare_char_char */; 291 292 compare_bit_bit: proc (b_operand1_ptr, b_operand1_size, b_operand2_ptr, b_operand2_size, b_operator, b_result); 293 294 /* PARAMETERS */ 295 296 dcl b_operand1_ptr ptr; 297 dcl b_operand1_size bit (24); 298 dcl b_operand2_ptr ptr; 299 dcl b_operand2_size bit (24); 300 dcl b_operator fixed bin; 301 dcl b_result bit (1) aligned; 302 303 /* BASED */ 304 305 dcl b_operand1 bit (bin (b_operand1_size)) based (b_operand1_ptr); 306 dcl b_operand2 bit (bin (b_operand2_size)) based (b_operand2_ptr); 307 308 309 goto b_compare (b_operator); /* value of b_operator was checked when 310* compare_values was entered */ 311 312 313 b_compare (1): /* operator: = */ 314 if b_operand1 = b_operand2 315 then b_result = "1"b; 316 else b_result = "0"b; 317 goto b_exit; 318 319 b_compare (2): /* operator: > */ 320 if b_operand1 > b_operand2 321 then b_result = "1"b; 322 else b_result = "0"b; 323 goto b_exit; 324 325 b_compare (3): /* operator: >= */ 326 if b_operand1 >= b_operand2 327 then b_result = "1"b; 328 else b_result = "0"b; 329 goto b_exit; 330 331 b_compare (5): /* operator: ^= */ 332 if b_operand1 ^= b_operand2 333 then b_result = "1"b; 334 else b_result = "0"b; 335 goto b_exit; 336 337 b_compare (6): /* operator: <= */ 338 if b_operand1 <= b_operand2 339 then b_result = "1"b; 340 else b_result = "0"b; 341 goto b_exit; 342 343 b_compare (7): /* operator: < */ 344 if b_operand1 < b_operand2 345 then b_result = "1"b; 346 else b_result = "0"b; 347 goto b_exit; 348 349 b_exit: return; 350 351 end /* compare_bit_bit */; 352 353 compare_c59_c59: proc (cx_operand1, cx_operand2, cx_operator, cx_result); 354 355 /* PARAMETERS */ 356 357 dcl cx_operand1 complex float decimal (59) aligned; 358 dcl cx_operand2 complex float decimal (59) aligned; 359 dcl cx_operator fixed bin; 360 dcl cx_result bit (1) aligned; 361 362 363 364 goto cx_compare (cx_operator); /* value of cx_operator was checked when 365* compare_values was entered */ 366 367 368 cx_compare (1): /* operator: = */ 369 if cx_operand1 = cx_operand2 370 then cx_result = "1"b; 371 else cx_result = "0"b; 372 goto cx_exit; 373 374 cx_compare (2): /* operator: > */ 375 call error (mrds_error_$inv_operator, "The relational operator > is not allowed for complex data types"); 376 goto cx_exit; 377 378 cx_compare (3): /* operator: >= */ 379 call error (mrds_error_$inv_operator, "The relational operator >= is not allowed for complex data types"); 380 goto cx_exit; 381 382 cx_compare (5): /* operator: ^= */ 383 if cx_operand1 ^= cx_operand2 384 then cx_result = "1"b; 385 else cx_result = "0"b; 386 goto cx_exit; 387 388 cx_compare (6): /* operator: <= */ 389 call error (mrds_error_$inv_operator, "The relational operator <= is not allowed for complex data types"); 390 goto cx_exit; 391 392 cx_compare (7): /* operator: < */ 393 call error (mrds_error_$inv_operator, "The relational operator < is not allowed for complex data types"); 394 goto cx_exit; 395 396 cx_exit: return; 397 398 end /* compare_c59_c59 */; 399 400 compare_r59_r59: proc (r_operand1, r_operand2, r_operator, r_result); 401 402 /* PARAMETERS */ 403 404 dcl r_operand1 real float decimal (59) aligned; 405 dcl r_operand2 real float decimal (59) aligned; 406 dcl r_operator fixed bin; 407 dcl r_result bit (1) aligned; 408 409 410 411 goto r_compare (r_operator); /* value of r_operator was checked when 412* compare_values was entered */ 413 414 415 r_compare (1): /* operator: = */ 416 if r_operand1 = r_operand2 417 then r_result = "1"b; 418 else r_result = "0"b; 419 goto r_exit; 420 421 r_compare (2): /* operator: > */ 422 if r_operand1 > r_operand2 423 then r_result = "1"b; 424 else r_result = "0"b; 425 goto r_exit; 426 427 r_compare (3): /* operator: >= */ 428 if r_operand1 >= r_operand2 429 then r_result = "1"b; 430 else r_result = "0"b; 431 goto r_exit; 432 433 r_compare (5): /* operator: ^= */ 434 if r_operand1 ^= r_operand2 435 then r_result = "1"b; 436 else r_result = "0"b; 437 goto r_exit; 438 439 r_compare (6): /* operator: <= */ 440 if r_operand1 <= r_operand2 441 then r_result = "1"b; 442 else r_result = "0"b; 443 goto r_exit; 444 445 r_compare (7): /* operator: < */ 446 if r_operand1 < r_operand2 447 then r_result = "1"b; 448 else r_result = "0"b; 449 goto r_exit; 450 451 r_exit: return; 452 453 end /* compare_r59_r59 */; 454 455 /* BEGIN CHANGE 81-05-23 **************************************************** */ 456 457 compare_fb_fb: procedure (); 458 459 /* Comparison of special cased fixed binary values, with equal scales */ 460 461 dcl fb35a fixed bin (35) aligned based; /* for picking up packed, with prec < 36 */ 462 dcl fb71a fixed bin (71) aligned based; /* for picking up packed, with prec < 71, but >= 36 */ 463 dcl fixed_bin_operand1 fixed bin (71); /* first value to compare */ 464 dcl fixed_bin_operand2 fixed bin (71); /* second value to compare */ 465 dcl bit_operand1 bit (bit_operand1_len) based (operand1_ptr); /* gets significant digits */ 466 dcl bit_operand2 bit (bit_operand2_len) based (operand2_ptr); /* gets significant digits */ 467 dcl bit_operand1_len fixed bin; /* length of significant digit portion */ 468 dcl bit_operand2_len fixed bin; /* length of significant digit portion */ 469 470 if desc1.packed 471 then do; 472 bit_operand1_len = bin (desc1.precision) + 1; 473 if substr (bit_operand1, 1, 1) 474 then unspec (fixed_bin_operand1) = copy ("1"b, 71 - bin (desc1.precision)) || bit_operand1; 475 else unspec (fixed_bin_operand1) = copy ("0"b, 71 - bin (desc1.precision)) || bit_operand1; 476 end; 477 else if bin (desc1.precision) < 36 478 then fixed_bin_operand1 = operand1_ptr -> fb35a; 479 else fixed_bin_operand1 = operand1_ptr -> fb71a; 480 481 if desc2.packed 482 then do; 483 bit_operand2_len = bin (desc2.precision) + 1; 484 if substr (bit_operand2, 1, 1) 485 then unspec (fixed_bin_operand2) = copy ("1"b, 71 - bin (desc2.precision)) || bit_operand2; 486 else unspec (fixed_bin_operand2) = copy ("0"b, 71 - bin (desc2.precision)) || bit_operand2; 487 end; 488 else if bin (desc2.precision) < 36 489 then fixed_bin_operand2 = operand2_ptr -> fb35a; 490 else fixed_bin_operand2 = operand2_ptr -> fb71a; 491 492 493 494 goto FB_COMPARE (operator); 495 496 FB_COMPARE (1): /* operator: = */ 497 if fixed_bin_operand1 = fixed_bin_operand2 498 then result = "1"b; 499 else result = "0"b; 500 goto END_FB_COMPARE; 501 502 FB_COMPARE (2): /* operator: > */ 503 if fixed_bin_operand1 > fixed_bin_operand2 504 then result = "1"b; 505 else result = "0"b; 506 goto END_FB_COMPARE; 507 508 FB_COMPARE (3): /* operator: >= */ 509 if fixed_bin_operand1 >= fixed_bin_operand2 510 then result = "1"b; 511 else result = "0"b; 512 goto END_FB_COMPARE; 513 514 FB_COMPARE (5): /* operator: ^= */ 515 if fixed_bin_operand1 ^= fixed_bin_operand2 516 then result = "1"b; 517 else result = "0"b; 518 goto END_FB_COMPARE; 519 520 FB_COMPARE (6): /* operator: <= */ 521 if fixed_bin_operand1 <= fixed_bin_operand2 522 then result = "1"b; 523 else result = "0"b; 524 goto END_FB_COMPARE; 525 526 FB_COMPARE (7): /* operator: < */ 527 if fixed_bin_operand1 < fixed_bin_operand2 528 then result = "1"b; 529 else result = "0"b; 530 goto END_FB_COMPARE; 531 532 END_FB_COMPARE: 533 534 end; 535 536 /* END CHANGE 81-05-23 ************************************************** */ 537 538 /* BEGIN CHANGE 81-05-23 B **************************************************** */ 539 540 compare_flb_flb: procedure (); 541 542 /* Comparison of special cased float binary values, with equal scales */ 543 544 dcl flb27a float bin (27) aligned based; /* for picking up packed, with prec <= 27 */ 545 dcl flb63a float bin (63) aligned based; /* for picking up packed, with prec < 63, but >= 27 */ 546 dcl float_bin_operand1 float bin (63); /* first value to compare */ 547 dcl float_bin_operand2 float bin (63); /* second value to compare */ 548 dcl 1 bit_operand1 unal based (operand1_ptr), /* gets significant digits */ 549 2 exponent bit (8) unal, 550 2 mantissa bit (bit_operand1_len); 551 dcl 1 bit_operand2 unal based (operand2_ptr), /* gets significant digits */ 552 2 exponent bit (8) unal, 553 2 mantissa bit (bit_operand2_len); 554 dcl bit_operand1_len float bin; /* length of significant digit portion */ 555 dcl bit_operand2_len float bin; /* length of significant digit portion */ 556 557 if desc1.packed 558 then do; 559 bit_operand1_len = bin (desc1.precision) + 1; 560 if substr (bit_operand1.mantissa, 1, 1) 561 then unspec (float_bin_operand1) = string (bit_operand1) || copy ("1"b, 63 - bin (desc1.precision)); 562 else unspec (float_bin_operand1) = string (bit_operand1) || copy ("0"b, 63 - bin (desc1.precision)); 563 end; 564 else if bin (desc1.precision) <= 27 565 then float_bin_operand1 = operand1_ptr -> flb27a; 566 else float_bin_operand1 = operand1_ptr -> flb63a; 567 568 if desc2.packed 569 then do; 570 bit_operand2_len = bin (desc2.precision) + 1; 571 if substr (bit_operand2.mantissa, 1, 1) 572 then unspec (float_bin_operand2) = string (bit_operand2) || copy ("1"b, 63 - bin (desc2.precision)); 573 else unspec (float_bin_operand2) = string (bit_operand2) || copy ("0"b, 63 - bin (desc2.precision)); 574 end; 575 else if bin (desc2.precision) <= 27 576 then float_bin_operand2 = operand2_ptr -> flb27a; 577 else float_bin_operand2 = operand2_ptr -> flb63a; 578 579 goto FLB_COMPARE (operator); 580 581 FLB_COMPARE (1): /* operator: = */ 582 if float_bin_operand1 = float_bin_operand2 583 then result = "1"b; 584 else result = "0"b; 585 goto END_FLB_COMPARE; 586 587 588 FLB_COMPARE (2): /* operator: > */ 589 if float_bin_operand1 > float_bin_operand2 590 then result = "1"b; 591 else result = "0"b; 592 goto END_FLB_COMPARE; 593 594 FLB_COMPARE (3): /* operator: >= */ 595 if float_bin_operand1 >= float_bin_operand2 596 then result = "1"b; 597 else result = "0"b; 598 goto END_FLB_COMPARE; 599 600 FLB_COMPARE (5): /* operator: ^= */ 601 if float_bin_operand1 ^= float_bin_operand2 602 then result = "1"b; 603 else result = "0"b; 604 goto END_FLB_COMPARE; 605 606 FLB_COMPARE (6): /* operator: <= */ 607 if float_bin_operand1 <= float_bin_operand2 608 then result = "1"b; 609 else result = "0"b; 610 goto END_FLB_COMPARE; 611 612 FLB_COMPARE (7): /* operator: < */ 613 if float_bin_operand1 < float_bin_operand2 614 then result = "1"b; 615 else result = "0"b; 616 goto END_FLB_COMPARE; 617 618 END_FLB_COMPARE: 619 620 end; 621 622 /* END CHANGE 81-05-23 B ************************************************** */ 623 624 error: proc (error_code, message); 625 626 /* PARAMETERS */ 627 628 dcl error_code fixed bin (35); 629 dcl message char (*); 630 631 632 /* MULTICS ROUTINES */ 633 634 dcl sub_err_ entry options (variable); 635 636 637 /* AUTOMATIC */ 638 639 dcl retval fixed bin (35); /* needed to make sub_err_ happy */ 640 641 642 643 code = error_code; /* code is global */ 644 645 call sub_err_ (error_code, "compare_value", "c", null (), retval, message); 646 647 goto compare_values_exit; /* NON LOCAL GOTO TO EXIT COMPARE_VALUES */ 648 649 end /* error */; 650 651 652 653 654 /* BASED */ 655 656 dcl 01 varying_string based, 657 02 size bit (36), /* first word is length */ 658 02 data bit (36); /* rest is data */ 659 660 dcl 01 desc based, /* a multics descriptor */ 661 02 version bit (1) unal, 662 02 type bit (6) unal, 663 02 packed bit (1) unal, 664 02 dims bit (4) unal, 665 02 size, 666 03 scale bit (12) unal, 667 03 precision bit (12) unal; 668 669 dcl desc1_type unsigned fixed bin (6) based (addr (desc1.type)) unal; 670 dcl desc2_type unsigned fixed bin (6) based (addr (desc2.type)) unal; 671 672 dcl bit_temp bit (bit_temp_size) based; /* overlay for doing bit-char compares */ 673 674 dcl 1 overlay based, /* overlay for count field of varying string */ 675 2 unused bit (12), 676 2 fb24 bit (24); /* only need 24 bits worth */ 677 678 /* CONSTANTS */ 679 680 dcl CHAR bit (6) init ("010101"b) internal static options (constant); 681 dcl CHAR_VAR bit (6) init ("010110"b) internal static options (constant); 682 dcl BIT bit (6) init ("010011"b) internal static options (constant); 683 dcl BIT_VAR bit (6) init ("010100"b) internal static options (constant); 684 dcl CFLD59A_DESC bit (36) init ("100110000000000000000000000000111011"b) internal static options (constant); 685 dcl RFLD59A_DESC bit (36) init ("100101000000000000000000000000111011"b) internal static options (constant); 686 dcl REAL (63) bit (1) internal static options (constant) /* true if tuple is real */ 687 init ((4) ("1"b), (4) ("0"b), (2) ("1"b), (2) ("0"b), (30) ("0"b), (2) ("1"b), (19) ("0"b)); 688 dcl COMPLEX (63) bit (1) internal static options (constant) /* true if type is complex */ 689 init ((4) ("0"b), (4) ("1"b), (2) ("0"b), (2) ("1"b), (32) ("0"b), (2) ("1"b), (17) ("0"b)); 690 dcl FIXED_BIN (63) bit (1) int static options (constant) /* true if fixed bin value */ 691 init ((2) ("1"b), (61) ("0"b)); 692 dcl FLOAT_BIN (63) bit (1) int static options (constant) /* true if float bin value */ 693 init ((2) ("0"b), (2) ("1"b), (59) ("0"b)); 694 dcl vrmu_display_descriptor entry (ptr) returns (char (120) varying); 695 dcl mrds_error_$inv_comparison fixed bin (35) external static; 696 dcl mrds_error_$inv_operator fixed bin (35) external static; 697 698 /* AUTOMATIC */ 699 700 dcl 01 desc1 like desc; 701 dcl 01 desc2 like desc; 702 dcl operand1_ptr ptr; /* pointer toward what will be used as first operand */ 703 dcl operand2_ptr ptr; /* pointer toward what will be used as second operand */ 704 dcl cfld59a1 complex float decimal (59) aligned; /* place for the first operand if its complex */ 705 dcl cfld59a2 complex float decimal (59) aligned; /* ditto for the second operand */ 706 dcl rfld59a1 real float decimal (59) aligned; /* place for the first operand if its real */ 707 dcl rfld59a2 real float decimal (59) aligned; /* ditto for the second operand */ 708 dcl bit_temp_size fixed bin (24); /* bit length of overlay for bit_char compare */ 709 dcl char_temp char (4096) varying; /* place for char version of bit string */ 710 dcl char_temp_size bit (24); /* temp for char-char compare routine parameter */ 711 712 /* MRDS ROUTINES */ 713 714 dcl vrmu_convert entry (ptr, ptr, ptr, ptr, fixed bin (35)); 715 716 dcl (addr, addrel, bin, char, copy, ltrim, null, string, substr, unspec) builtin; 717 dcl temp_ptr ptr; 718 719 720 end vrmu_compare_values; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/21/84 0934.0 vrmu_compare_values.pl1 >special_ldd>online>mrds_install>vrmu_compare_values.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. BIT constant bit(6) initial unaligned dcl 682 ref 145 145 195 195 200 BIT_VAR constant bit(6) initial unaligned dcl 683 ref 115 124 CFLD59A_DESC 000070 constant bit(36) initial unaligned dcl 684 set ref 153 153 157 157 CHAR constant bit(6) initial unaligned dcl 680 ref 140 140 195 195 CHAR_VAR constant bit(6) initial unaligned dcl 681 ref 115 124 COMPLEX 000056 constant bit(1) initial array unaligned dcl 688 ref 150 150 FIXED_BIN 000054 constant bit(1) initial array unaligned dcl 690 ref 171 171 FLOAT_BIN 000052 constant bit(1) initial array unaligned dcl 692 ref 174 174 REAL 000060 constant bit(1) initial array unaligned dcl 686 ref 165 165 RFLD59A_DESC 000065 constant bit(36) initial unaligned dcl 685 set ref 180 180 184 184 addr builtin function dcl 716 ref 117 120 120 126 128 128 150 150 153 153 153 153 153 153 157 157 157 157 157 157 165 165 171 171 174 174 180 180 180 180 180 180 184 184 184 184 184 184 203 205 213 214 addrel builtin function dcl 716 ref 206 206 215 215 b_operand1 based bit unaligned dcl 305 ref 313 319 325 331 337 343 b_operand1_ptr parameter pointer dcl 296 ref 292 313 319 325 331 337 343 b_operand1_size parameter bit(24) unaligned dcl 297 ref 292 313 319 325 331 337 343 b_operand2 based bit unaligned dcl 306 ref 313 319 325 331 337 343 b_operand2_ptr parameter pointer dcl 298 ref 292 313 319 325 331 337 343 b_operand2_size parameter bit(24) unaligned dcl 299 ref 292 313 319 325 331 337 343 b_operator parameter fixed bin(17,0) dcl 300 ref 292 309 b_result parameter bit(1) dcl 301 set ref 292 313* 316* 319* 322* 325* 328* 331* 334* 337* 340* 343* 346* bin builtin function dcl 716 ref 201 211 252 252 258 258 264 264 270 270 276 276 282 282 313 313 319 319 325 325 331 331 337 337 343 343 472 473 475 477 483 484 486 488 559 560 562 564 570 571 573 575 bit_operand1 based structure level 1 packed unaligned dcl 548 in procedure "compare_flb_flb" ref 560 562 bit_operand1 based bit unaligned dcl 465 in procedure "compare_fb_fb" ref 473 473 475 bit_operand1_len 002314 automatic fixed bin(17,0) dcl 467 in procedure "compare_fb_fb" set ref 472* 473 473 475 bit_operand1_len 002330 automatic float bin(27) dcl 554 in procedure "compare_flb_flb" set ref 559* 560 560 562 bit_operand2 based structure level 1 packed unaligned dcl 551 in procedure "compare_flb_flb" ref 571 573 bit_operand2 based bit unaligned dcl 466 in procedure "compare_fb_fb" ref 484 484 486 bit_operand2_len 002331 automatic float bin(27) dcl 555 in procedure "compare_flb_flb" set ref 570* 571 571 573 bit_operand2_len 002315 automatic fixed bin(17,0) dcl 468 in procedure "compare_fb_fb" set ref 483* 484 484 486 bit_temp based bit unaligned dcl 672 ref 202 212 bit_temp_size 000244 automatic fixed bin(24,0) dcl 708 set ref 201* 202 211* 212 c_operand1 based char unaligned dcl 244 ref 252 258 264 270 276 282 c_operand1_ptr parameter pointer dcl 235 ref 231 252 258 264 270 276 282 c_operand1_size parameter bit(24) unaligned dcl 236 ref 231 252 258 264 270 276 282 c_operand2 based char unaligned dcl 245 ref 252 258 264 270 276 282 c_operand2_ptr parameter pointer dcl 237 ref 231 252 258 264 270 276 282 c_operand2_size parameter bit(24) unaligned dcl 238 ref 231 252 258 264 270 276 282 c_operator parameter fixed bin(17,0) dcl 239 ref 231 248 c_result parameter bit(1) dcl 240 set ref 231 252* 255* 258* 261* 264* 267* 270* 273* 276* 279* 282* 285* cfld59a1 000106 automatic complex float dec(59) dcl 704 set ref 153 153 161* cfld59a2 000145 automatic complex float dec(59) dcl 705 set ref 157 157 161* char builtin function dcl 716 ref 132 202 212 char_temp 000245 automatic varying char(4096) dcl 709 set ref 202* 203 205 212* 213 214 char_temp_size 002246 automatic bit(24) unaligned dcl 710 set ref 203* 206* 213* 215* code parameter fixed bin(35,0) dcl 107 set ref 18 109* 153* 154 154* 157* 158 158* 180* 181 181* 184* 185 185* 643* copy builtin function dcl 716 ref 473 475 484 486 560 562 571 573 cx_operand1 parameter complex float dec(59) dcl 357 ref 353 368 382 cx_operand2 parameter complex float dec(59) dcl 358 ref 353 368 382 cx_operator parameter fixed bin(17,0) dcl 359 ref 353 364 cx_result parameter bit(1) dcl 360 set ref 353 368* 371* 382* 385* data 1 based bit(36) level 2 packed unaligned dcl 656 set ref 117 126 desc based structure level 1 packed unaligned dcl 660 ref 112 113 desc1 000100 automatic structure level 1 packed unaligned dcl 700 set ref 112* 153 153 180 180 desc1_ptr parameter pointer dcl 95 set ref 18 112 154* 181* 224* desc1_type based fixed bin(6,0) unsigned unaligned dcl 669 set ref 120* 120 150 165 171 174 desc2 000101 automatic structure level 1 packed unaligned dcl 701 set ref 113* 157 157 184 184 desc2_ptr parameter pointer dcl 97 set ref 18 113 158* 185* 224* desc2_type based fixed bin(6,0) unsigned unaligned dcl 670 set ref 128* 128 150 165 171 174 error_code parameter fixed bin(35,0) dcl 628 set ref 624 643 645* fb24 0(12) based bit(24) level 2 packed unaligned dcl 674 ref 203 213 fb35a based fixed bin(35,0) dcl 461 ref 477 488 fb71a based fixed bin(71,0) dcl 462 ref 479 490 fixed_bin_operand1 002310 automatic fixed bin(71,0) dcl 463 set ref 473* 475* 477* 479* 496 502 508 514 520 526 fixed_bin_operand2 002312 automatic fixed bin(71,0) dcl 464 set ref 484* 486* 488* 490* 496 502 508 514 520 526 flb27a based float bin(27) dcl 544 ref 564 575 flb63a based float bin(63) dcl 545 ref 566 577 float_bin_operand1 002324 automatic float bin(63) dcl 546 set ref 560* 562* 564* 566* 581 588 594 600 606 612 float_bin_operand2 002326 automatic float bin(63) dcl 547 set ref 571* 573* 575* 577* 581 588 594 600 606 612 ltrim builtin function dcl 716 ref 132 mantissa 0(08) based bit level 2 in structure "bit_operand1" packed unaligned dcl 548 in procedure "compare_flb_flb" ref 560 mantissa 0(08) based bit level 2 in structure "bit_operand2" packed unaligned dcl 551 in procedure "compare_flb_flb" ref 571 message parameter char unaligned dcl 629 set ref 624 645* mrds_error_$inv_comparison 000012 external static fixed bin(35,0) dcl 695 set ref 224* mrds_error_$inv_operator 000014 external static fixed bin(35,0) dcl 696 set ref 132* 374* 378* 388* 392* null builtin function dcl 716 ref 645 645 operand1_ptr 000102 automatic pointer dcl 702 set ref 117* 122* 140* 145* 153* 180* 202 215* 473 473 475 477 479 560 560 562 564 566 operand2_ptr 000104 automatic pointer dcl 703 set ref 126* 130* 140* 145* 157* 184* 206* 212 484 484 486 488 490 571 571 573 575 577 operator parameter fixed bin(17,0) dcl 98 set ref 18 132 132 132 132 140* 145* 161* 188* 206* 215* 494 579 overlay based structure level 1 packed unaligned dcl 674 packed 0(07) 000101 automatic bit(1) level 2 in structure "desc2" packed unaligned dcl 701 in procedure "vrmu_compare_values" set ref 481 568 packed 0(07) 000100 automatic bit(1) level 2 in structure "desc1" packed unaligned dcl 700 in procedure "vrmu_compare_values" set ref 470 557 precision 0(24) 000100 automatic bit(12) level 3 in structure "desc1" packed unaligned dcl 700 in procedure "vrmu_compare_values" set ref 472 473 475 477 559 560 562 564 precision 0(24) 000101 automatic bit(12) level 3 in structure "desc2" packed unaligned dcl 701 in procedure "vrmu_compare_values" set ref 483 484 486 488 570 571 573 575 r_operand1 parameter float dec(59) dcl 404 ref 400 415 421 427 433 439 445 r_operand2 parameter float dec(59) dcl 405 ref 400 415 421 427 433 439 445 r_operator parameter fixed bin(17,0) dcl 406 ref 400 411 r_result parameter bit(1) dcl 407 set ref 400 415* 418* 421* 424* 427* 430* 433* 436* 439* 442* 445* 448* result parameter bit(1) dcl 106 set ref 18 110* 140* 145* 161* 188* 206* 215* 496* 499* 502* 505* 508* 511* 514* 517* 520* 523* 526* 529* 581* 584* 588* 591* 594* 597* 600* 603* 606* 609* 612* 615* retval 000100 automatic fixed bin(35,0) dcl 639 set ref 645* rfld59a1 000204 automatic float dec(59) dcl 706 set ref 180 180 188* rfld59a2 000224 automatic float dec(59) dcl 707 set ref 184 184 188* scale 0(12) 000101 automatic bit(12) level 3 in structure "desc2" packed unaligned dcl 701 in procedure "vrmu_compare_values" set ref 171 scale 0(12) 000100 automatic bit(12) level 3 in structure "desc1" packed unaligned dcl 700 in procedure "vrmu_compare_values" set ref 171 size 0(12) 000100 automatic structure level 2 in structure "desc1" packed unaligned dcl 700 in procedure "vrmu_compare_values" set ref 118* 140 140 145 145 201 215 215 size based bit(36) level 2 in structure "varying_string" packed unaligned dcl 656 in procedure "vrmu_compare_values" ref 118 127 size 0(12) 000101 automatic structure level 2 in structure "desc2" packed unaligned dcl 701 in procedure "vrmu_compare_values" set ref 127* 140 140 145 145 206 206 211 string builtin function dcl 716 set ref 118* 127* 140 140 140 140 145 145 145 145 201 206 206 211 215 215 560 562 571 573 sub_err_ 000020 constant entry external dcl 634 ref 645 substr builtin function dcl 716 ref 118 127 473 484 560 571 temp_ptr 002250 automatic pointer dcl 717 set ref 205* 206 206 214* 215 215 type 0(01) 000101 automatic bit(6) level 2 in structure "desc2" packed unaligned dcl 701 in procedure "vrmu_compare_values" set ref 124 124 128 128 140 145 150 165 171 174 195 195 type 0(01) 000100 automatic bit(6) level 2 in structure "desc1" packed unaligned dcl 700 in procedure "vrmu_compare_values" set ref 115 115 120 120 140 145 150 165 171 174 195 195 200 unspec builtin function dcl 716 set ref 473* 475* 484* 486* 560* 562* 571* 573* value1_ptr parameter pointer dcl 94 ref 18 117 118 122 value2_ptr parameter pointer dcl 96 ref 18 126 127 130 varying_string based structure level 1 packed unaligned dcl 656 vrmu_convert 000016 constant entry external dcl 714 ref 153 157 180 184 vrmu_display_descriptor 000010 constant entry external dcl 694 ref 154 158 181 185 224 224 NAMES DECLARED BY EXPLICIT CONTEXT. END_FB_COMPARE 003202 constant label dcl 532 ref 500 506 512 518 524 530 END_FLB_COMPARE 003561 constant label dcl 618 ref 585 592 598 604 610 616 FB_COMPARE 000034 constant label array(7) dcl 496 ref 494 FLB_COMPARE 000043 constant label array(7) dcl 581 ref 579 b_compare 000007 constant label array(7) dcl 313 ref 309 b_exit 002417 constant label dcl 349 ref 317 323 329 335 341 347 c_compare 000000 constant label array(7) dcl 252 ref 248 c_exit 002132 constant label dcl 288 ref 256 262 268 274 280 286 compare_bit_bit 002133 constant entry internal dcl 292 ref 145 compare_c59_c59 002420 constant entry internal dcl 353 ref 161 compare_char_char 001646 constant entry internal dcl 231 ref 140 206 215 compare_fb_fb 002676 constant entry internal dcl 457 ref 171 compare_flb_flb 003203 constant entry internal dcl 540 ref 174 compare_r59_r59 002567 constant entry internal dcl 400 ref 188 compare_values_exit 001644 constant label dcl 228 ref 647 cx_compare 000016 constant label array(7) dcl 368 ref 364 cx_exit 002566 constant label dcl 396 ref 372 376 380 386 390 394 error 003563 constant entry internal dcl 624 ref 132 154 158 181 185 224 374 378 388 392 r_compare 000025 constant label array(7) dcl 415 ref 411 r_exit 002675 constant label dcl 451 ref 419 425 431 437 443 449 vrmu_compare_values 000274 constant entry external dcl 18 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3756 4000 3654 3766 Length 4176 3654 22 162 102 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME vrmu_compare_values 1540 external procedure is an external procedure. compare_char_char internal procedure shares stack frame of external procedure vrmu_compare_values. compare_bit_bit internal procedure shares stack frame of external procedure vrmu_compare_values. compare_c59_c59 internal procedure shares stack frame of external procedure vrmu_compare_values. compare_r59_r59 internal procedure shares stack frame of external procedure vrmu_compare_values. compare_fb_fb internal procedure shares stack frame of external procedure vrmu_compare_values. compare_flb_flb internal procedure shares stack frame of external procedure vrmu_compare_values. error 100 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME error 000100 retval error vrmu_compare_values 000100 desc1 vrmu_compare_values 000101 desc2 vrmu_compare_values 000102 operand1_ptr vrmu_compare_values 000104 operand2_ptr vrmu_compare_values 000106 cfld59a1 vrmu_compare_values 000145 cfld59a2 vrmu_compare_values 000204 rfld59a1 vrmu_compare_values 000224 rfld59a2 vrmu_compare_values 000244 bit_temp_size vrmu_compare_values 000245 char_temp vrmu_compare_values 002246 char_temp_size vrmu_compare_values 002250 temp_ptr vrmu_compare_values 002310 fixed_bin_operand1 compare_fb_fb 002312 fixed_bin_operand2 compare_fb_fb 002314 bit_operand1_len compare_fb_fb 002315 bit_operand2_len compare_fb_fb 002324 float_bin_operand1 compare_flb_flb 002326 float_bin_operand2 compare_flb_flb 002330 bit_operand1_len compare_flb_flb 002331 bit_operand2_len compare_flb_flb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_e_as alloc_cs alloc_bs cat_realloc_cs cat_realloc_bs call_ext_out_desc call_ext_out call_int_this_desc return fl2_to_fx1 tra_ext shorten_stack ext_entry int_entry_desc any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. sub_err_ vrmu_convert vrmu_display_descriptor THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mrds_error_$inv_comparison mrds_error_$inv_operator LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000266 109 000301 110 000303 112 000304 113 000312 115 000317 117 000327 118 000333 120 000336 121 000346 122 000347 124 000352 126 000362 127 000366 128 000371 129 000401 130 000402 132 000405 140 000467 145 000542 150 000605 153 000626 154 000654 157 000732 158 000761 161 001037 162 001055 165 001056 171 001066 174 001111 180 001124 181 001152 184 001230 185 001257 188 001335 190 001353 195 001354 200 001364 201 001367 202 001372 203 001414 205 001420 206 001422 209 001451 211 001452 212 001455 213 001477 214 001503 215 001505 219 001534 224 001535 228 001644 231 001646 248 001650 252 001652 255 001705 256 001706 258 001707 261 001743 262 001744 264 001745 267 002000 268 002001 270 002002 273 002035 274 002036 276 002037 279 002073 280 002074 282 002075 285 002130 286 002131 288 002132 292 002133 309 002135 313 002137 316 002172 317 002173 319 002174 322 002230 323 002231 325 002232 328 002265 329 002266 331 002267 334 002322 335 002323 337 002324 340 002360 341 002361 343 002362 346 002415 347 002416 349 002417 353 002420 364 002422 368 002424 371 002441 372 002442 374 002443 376 002463 378 002464 380 002504 382 002505 385 002522 386 002523 388 002524 390 002544 392 002545 394 002565 396 002566 400 002567 411 002571 415 002573 418 002604 419 002605 421 002606 424 002617 425 002620 427 002621 430 002632 431 002633 433 002634 436 002645 437 002646 439 002647 442 002660 443 002661 445 002662 448 002673 449 002674 451 002675 457 002676 470 002677 472 002702 473 002707 475 002742 476 002770 477 002772 479 003005 481 003007 483 003012 484 003017 486 003052 487 003100 488 003102 490 003115 494 003117 496 003122 499 003130 500 003131 502 003132 505 003140 506 003141 508 003142 511 003150 512 003151 514 003152 517 003160 518 003161 520 003162 523 003170 524 003171 526 003172 529 003200 530 003201 532 003202 540 003203 557 003204 559 003207 560 003216 562 003263 563 003323 564 003325 566 003337 568 003341 570 003344 571 003353 573 003420 574 003460 575 003462 577 003474 579 003476 581 003501 584 003507 585 003510 588 003511 591 003517 592 003520 594 003521 597 003527 598 003530 600 003531 603 003537 604 003540 606 003541 609 003547 610 003550 612 003551 615 003557 616 003560 618 003561 624 003562 643 003576 645 003603 647 003647 ----------------------------------------------------------- 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