1------------------------------------------------------------------------------ 2-- "standard_additions" package contains the additions to the built in 3-- "standard.std" package. In the final version this package will be implicit. 4-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) 5------------------------------------------------------------------------------ 6package standard_additions is 7 8 function \?=\ (L, R : BOOLEAN) return BOOLEAN; 9 function \?/=\ (L, R : BOOLEAN) return BOOLEAN; 10 function \?<\ (L, R : BOOLEAN) return BOOLEAN; 11 function \?<=\ (L, R : BOOLEAN) return BOOLEAN; 12 function \?>\ (L, R : BOOLEAN) return BOOLEAN; 13 function \?>=\ (L, R : BOOLEAN) return BOOLEAN; 14 15 function MINIMUM (L, R : BOOLEAN) return BOOLEAN; 16 function MAXIMUM (L, R : BOOLEAN) return BOOLEAN; 17 18 function RISING_EDGE (signal S : BOOLEAN) return BOOLEAN; 19 function FALLING_EDGE (signal S : BOOLEAN) return BOOLEAN; 20 21 function \?=\ (L, R : BIT) return BIT; 22 function \?/=\ (L, R : BIT) return BIT; 23 function \?<\ (L, R : BIT) return BIT; 24 function \?<=\ (L, R : BIT) return BIT; 25 function \?>\ (L, R : BIT) return BIT; 26 function \?>=\ (L, R : BIT) return BIT; 27 28 function MINIMUM (L, R : BIT) return BIT; 29 function MAXIMUM (L, R : BIT) return BIT; 30 31 function \??\ (L : BIT) return BOOLEAN; 32 33 function RISING_EDGE (signal S : BIT) return BOOLEAN; 34 function FALLING_EDGE (signal S : BIT) return BOOLEAN; 35 36 function MINIMUM (L, R : CHARACTER) return CHARACTER; 37 function MAXIMUM (L, R : CHARACTER) return CHARACTER; 38 39 function MINIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL; 40 function MAXIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL; 41 42 function MINIMUM (L, R : INTEGER) return INTEGER; 43 function MAXIMUM (L, R : INTEGER) return INTEGER; 44 45 function MINIMUM (L, R : REAL) return REAL; 46 function MAXIMUM (L, R : REAL) return REAL; 47 48 function "mod" (L, R : TIME) return TIME; 49 function "rem" (L, R : TIME) return TIME; 50 51 function MINIMUM (L, R : TIME) return TIME; 52 function MAXIMUM (L, R : TIME) return TIME; 53 54 function MINIMUM (L, R : STRING) return STRING; 55 function MAXIMUM (L, R : STRING) return STRING; 56 57 function MINIMUM (L : STRING) return CHARACTER; 58 function MAXIMUM (L : STRING) return CHARACTER; 59 60 type BOOLEAN_VECTOR is array (NATURAL range <>) of BOOLEAN; 61 62 -- The predefined operations for this type are as follows: 63 64 function "and" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 65 function "or" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 66 function "nand" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 67 function "nor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 68 function "xor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 69 function "xnor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 70 71 function "not" (L : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 72 73 function "and" (L : BOOLEAN_VECTOR; R : BOOLEAN) 74 return BOOLEAN_VECTOR; 75 function "and" (L : BOOLEAN; R : BOOLEAN_VECTOR) 76 return BOOLEAN_VECTOR; 77 function "or" (L : BOOLEAN_VECTOR; R : BOOLEAN) 78 return BOOLEAN_VECTOR; 79 function "or" (L : BOOLEAN; R : BOOLEAN_VECTOR) 80 return BOOLEAN_VECTOR; 81 function "nand" (L : BOOLEAN_VECTOR; R : BOOLEAN) 82 return BOOLEAN_VECTOR; 83 function "nand" (L : BOOLEAN; R : BOOLEAN_VECTOR) 84 return BOOLEAN_VECTOR; 85 function "nor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 86 return BOOLEAN_VECTOR; 87 function "nor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 88 return BOOLEAN_VECTOR; 89 function "xor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 90 return BOOLEAN_VECTOR; 91 function "xor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 92 return BOOLEAN_VECTOR; 93 function "xnor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 94 return BOOLEAN_VECTOR; 95 function "xnor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 96 return BOOLEAN_VECTOR; 97 98 function and_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 99 function or_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 100 function nand_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 101 function nor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 102 function xor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 103 function xnor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN; 104 105 function "sll" (L : BOOLEAN_VECTOR; R : INTEGER) 106 return BOOLEAN_VECTOR; 107 function "srl" (L : BOOLEAN_VECTOR; R : INTEGER) 108 return BOOLEAN_VECTOR; 109 function "sla" (L : BOOLEAN_VECTOR; R : INTEGER) 110 return BOOLEAN_VECTOR; 111 function "sra" (L : BOOLEAN_VECTOR; R : INTEGER) 112 return BOOLEAN_VECTOR; 113 function "rol" (L : BOOLEAN_VECTOR; R : INTEGER) 114 return BOOLEAN_VECTOR; 115 function "ror" (L : BOOLEAN_VECTOR; R : INTEGER) 116 return BOOLEAN_VECTOR; 117 118-- function "=" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 119-- function "/=" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 120-- function "<" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 121-- function "<=" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 122-- function ">" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 123-- function ">=" (L, R : BOOLEAN_VECTOR) return BOOLEAN; 124 125 function \?=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN; 126 function \?/=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN; 127 128-- function "&" (L : BOOLEAN_VECTOR; R : BOOLEAN_VECTOR) 129 -- return BOOLEAN_VECTOR; 130-- function "&" (L : BOOLEAN_VECTOR; R : BOOLEAN) -- return BOOLEAN_VECTOR; 131-- function "&" (L : BOOLEAN; R : BOOLEAN_VECTOR) -- return BOOLEAN_VECTOR; 132-- function "&" (L : BOOLEAN; R : BOOLEAN) -- return BOOLEAN_VECTOR; 133 134 function MINIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 135 function MAXIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 136 137 function MINIMUM (L : BOOLEAN_VECTOR) return BOOLEAN; 138 function MAXIMUM (L : BOOLEAN_VECTOR) return BOOLEAN; 139 140 function "and" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 141 function "and" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 142 function "or" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 143 function "or" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 144 function "nand" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 145 function "nand" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 146 function "nor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 147 function "nor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 148 function "xor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 149 function "xor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 150 function "xnor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR; 151 function "xnor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR; 152 153 function and_reduce (L : BIT_VECTOR) return BIT; 154 function or_reduce (L : BIT_VECTOR) return BIT; 155 function nand_reduce (L : BIT_VECTOR) return BIT; 156 function nor_reduce (L : BIT_VECTOR) return BIT; 157 function xor_reduce (L : BIT_VECTOR) return BIT; 158 function xnor_reduce (L : BIT_VECTOR) return BIT; 159 160 function \?=\ (L, R : BIT_VECTOR) return BIT; 161 function \?/=\ (L, R : BIT_VECTOR) return BIT; 162 163 function MINIMUM (L, R : BIT_VECTOR) return BIT_VECTOR; 164 function MAXIMUM (L, R : BIT_VECTOR) return BIT_VECTOR; 165 166 function MINIMUM (L : BIT_VECTOR) return BIT; 167 function MAXIMUM (L : BIT_VECTOR) return BIT; 168 169 function TO_STRING (VALUE : BIT_VECTOR) return STRING; 170 171 alias TO_BSTRING is TO_STRING [BIT_VECTOR return STRING]; 172 alias TO_BINARY_STRING is TO_STRING [BIT_VECTOR return STRING]; 173 function TO_OSTRING (VALUE : BIT_VECTOR) return STRING; 174 alias TO_OCTAL_STRING is TO_OSTRING [BIT_VECTOR return STRING]; 175 function TO_HSTRING (VALUE : BIT_VECTOR) return STRING; 176 alias TO_HEX_STRING is TO_HSTRING [BIT_VECTOR return STRING]; 177 178 type INTEGER_VECTOR is array (NATURAL range <>) of INTEGER; 179 180 -- The predefined operations for this type are as follows: 181 function "=" (L, R : INTEGER_VECTOR) return BOOLEAN; 182 function "/=" (L, R : INTEGER_VECTOR) return BOOLEAN; 183 function "<" (L, R : INTEGER_VECTOR) return BOOLEAN; 184 function "<=" (L, R : INTEGER_VECTOR) return BOOLEAN; 185 function ">" (L, R : INTEGER_VECTOR) return BOOLEAN; 186 function ">=" (L, R : INTEGER_VECTOR) return BOOLEAN; 187 188-- function "&" (L : INTEGER_VECTOR; R : INTEGER_VECTOR) 189-- return INTEGER_VECTOR; 190-- function "&" (L : INTEGER_VECTOR; R : INTEGER) return INTEGER_VECTOR; 191-- function "&" (L : INTEGER; R : INTEGER_VECTOR) return INTEGER_VECTOR; 192-- function "&" (L : INTEGER; R : INTEGER) return INTEGER_VECTOR; 193 194 function MINIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR; 195 function MAXIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR; 196 197 function MINIMUM (L : INTEGER_VECTOR) return INTEGER; 198 function MAXIMUM (L : INTEGER_VECTOR) return INTEGER; 199 200 type REAL_VECTOR is array (NATURAL range <>) of REAL; 201 202 -- The predefined operations for this type are as follows: 203 function "=" (L, R : REAL_VECTOR) return BOOLEAN; 204 function "/=" (L, R : REAL_VECTOR) return BOOLEAN; 205 function "<" (L, R : REAL_VECTOR) return BOOLEAN; 206 function "<=" (L, R : REAL_VECTOR) return BOOLEAN; 207 function ">" (L, R : REAL_VECTOR) return BOOLEAN; 208 function ">=" (L, R : REAL_VECTOR) return BOOLEAN; 209 210-- function "&" (L : REAL_VECTOR; R : REAL_VECTOR) 211-- return REAL_VECTOR; 212-- function "&" (L : REAL_VECTOR; R : REAL) return REAL_VECTOR; 213-- function "&" (L : REAL; R : REAL_VECTOR) return REAL_VECTOR; 214-- function "&" (L : REAL; R : REAL) return REAL_VECTOR; 215 216 function MINIMUM (L, R : REAL_VECTOR) return REAL_VECTOR; 217 function MAXIMUM (L, R : REAL_VECTOR) return REAL_VECTOR; 218 219 function MINIMUM (L : REAL_VECTOR) return REAL; 220 function MAXIMUM (L : REAL_VECTOR) return REAL; 221 222 type TIME_VECTOR is array (NATURAL range <>) of TIME; 223 224 -- The predefined operations for this type are as follows: 225 function "=" (L, R : TIME_VECTOR) return BOOLEAN; 226 function "/=" (L, R : TIME_VECTOR) return BOOLEAN; 227 function "<" (L, R : TIME_VECTOR) return BOOLEAN; 228 function "<=" (L, R : TIME_VECTOR) return BOOLEAN; 229 function ">" (L, R : TIME_VECTOR) return BOOLEAN; 230 function ">=" (L, R : TIME_VECTOR) return BOOLEAN; 231 232-- function "&" (L : TIME_VECTOR; R : TIME_VECTOR) 233-- return TIME_VECTOR; 234-- function "&" (L : TIME_VECTOR; R : TIME) return TIME_VECTOR; 235-- function "&" (L : TIME; R : TIME_VECTOR) return TIME_VECTOR; 236-- function "&" (L : TIME; R : TIME) return TIME_VECTOR; 237 238 function MINIMUM (L, R : TIME_VECTOR) return TIME_VECTOR; 239 function MAXIMUM (L, R : TIME_VECTOR) return TIME_VECTOR; 240 241 function MINIMUM (L : TIME_VECTOR) return TIME; 242 function MAXIMUM (L : TIME_VECTOR) return TIME; 243 244 function MINIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND; 245 function MAXIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND; 246 247 function MINIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS; 248 function MAXIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS; 249 250 -- predefined TO_STRING operations on scalar types 251 function TO_STRING (VALUE : BOOLEAN) return STRING; 252 function TO_STRING (VALUE : BIT) return STRING; 253 function TO_STRING (VALUE : CHARACTER) return STRING; 254 function TO_STRING (VALUE : SEVERITY_LEVEL) return STRING; 255 function TO_STRING (VALUE : INTEGER) return STRING; 256 function TO_STRING (VALUE : REAL) return STRING; 257 function TO_STRING (VALUE : TIME) return STRING; 258 function TO_STRING (VALUE : FILE_OPEN_KIND) return STRING; 259 function TO_STRING (VALUE : FILE_OPEN_STATUS) return STRING; 260 261 -- predefined overloaded TO_STRING operations 262 function TO_STRING (VALUE : REAL; DIGITS : NATURAL) return STRING; 263 function TO_STRING (VALUE : REAL; FORMAT : STRING) return STRING; 264 function TO_STRING (VALUE : TIME; UNIT : TIME) return STRING; 265end package standard_additions; 266 267------------------------------------------------------------------------------ 268-- "standard_additions" package contains the additions to the built in 269-- "standard.std" package. In the final version this package will be implicit. 270-- Created for VHDL-200X par, David Bishop (dbishop@vhdl.org) 271------------------------------------------------------------------------------ 272use std.textio.all; 273package body standard_additions is 274 275 function \?=\ (L, R : BOOLEAN) return BOOLEAN is 276 begin 277 return L = R; 278 end function \?=\; 279 280 function \?/=\ (L, R : BOOLEAN) return BOOLEAN is 281 begin 282 return L /= R; 283 end function \?/=\; 284 285 function \?<\ (L, R : BOOLEAN) return BOOLEAN is 286 begin 287 return L < R; 288 end function \?<\; 289 290 function \?<=\ (L, R : BOOLEAN) return BOOLEAN is 291 begin 292 return L <= R; 293 end function \?<=\; 294 295 function \?>\ (L, R : BOOLEAN) return BOOLEAN is 296 begin 297 return L > R; 298 end function \?>\; 299 300 function \?>=\ (L, R : BOOLEAN) return BOOLEAN is 301 begin 302 return L >= R; 303 end function \?>=\; 304 305 function MINIMUM (L, R : BOOLEAN) return BOOLEAN is 306 begin 307 if L > R then return R; 308 else return L; 309 end if; 310 end function MINIMUM; 311 function MAXIMUM (L, R : BOOLEAN) return BOOLEAN is 312 begin 313 if L > R then return L; 314 else return R; 315 end if; 316 end function MAXIMUM; 317 318 function TO_STRING (VALUE : BOOLEAN) return STRING is 319 begin 320 return BOOLEAN'image(VALUE); 321 end function TO_STRING; 322 323 function RISING_EDGE (signal S : BOOLEAN) return BOOLEAN is 324 begin 325 return (s'event and (s = true) and (s'last_value = false)); 326 end function rising_edge; 327 328 function FALLING_EDGE (signal S : BOOLEAN) return BOOLEAN is 329 begin 330 return (s'event and (s = false) and (s'last_value = true)); 331 end function falling_edge; 332 333 function \?=\ (L, R : BIT) return BIT is 334 begin 335 if L = R then 336 return '1'; 337 else 338 return '0'; 339 end if; 340 end function \?=\; 341 342 function \?/=\ (L, R : BIT) return BIT is 343 begin 344 if L /= R then 345 return '1'; 346 else 347 return '0'; 348 end if; 349 end function \?/=\; 350 351 function \?<\ (L, R : BIT) return BIT is 352 begin 353 if L < R then 354 return '1'; 355 else 356 return '0'; 357 end if; 358 end function \?<\; 359 360 function \?<=\ (L, R : BIT) return BIT is 361 begin 362 if L <= R then 363 return '1'; 364 else 365 return '0'; 366 end if; 367 end function \?<=\; 368 369 function \?>\ (L, R : BIT) return BIT is 370 begin 371 if L > R then 372 return '1'; 373 else 374 return '0'; 375 end if; 376 end function \?>\; 377 378 function \?>=\ (L, R : BIT) return BIT is 379 begin 380 if L >= R then 381 return '1'; 382 else 383 return '0'; 384 end if; 385 end function \?>=\; 386 387 function MINIMUM (L, R : BIT) return BIT is 388 begin 389 if L > R then return R; 390 else return L; 391 end if; 392 end function MINIMUM; 393 394 function MAXIMUM (L, R : BIT) return BIT is 395 begin 396 if L > R then return L; 397 else return R; 398 end if; 399 end function MAXIMUM; 400 401 function TO_STRING (VALUE : BIT) return STRING is 402 begin 403 if VALUE = '1' then 404 return "1"; 405 else 406 return "0"; 407 end if; 408 end function TO_STRING; 409 410 function \??\ (L : BIT) return BOOLEAN is 411 begin 412 return L = '1'; 413 end function \??\; 414 415 function RISING_EDGE (signal S : BIT) return BOOLEAN is 416 begin 417 return (s'event and (s = '1') and (s'last_value = '0')); 418 end function rising_edge; 419 420 function FALLING_EDGE (signal S : BIT) return BOOLEAN is 421 begin 422 return (s'event and (s = '0') and (s'last_value = '1')); 423 end function falling_edge; 424 425 function MINIMUM (L, R : CHARACTER) return CHARACTER is 426 begin 427 if L > R then return R; 428 else return L; 429 end if; 430 end function MINIMUM; 431 432 function MAXIMUM (L, R : CHARACTER) return CHARACTER is 433 begin 434 if L > R then return L; 435 else return R; 436 end if; 437 end function MAXIMUM; 438 439 function TO_STRING (VALUE : CHARACTER) return STRING is 440 variable result : STRING (1 to 1); 441 begin 442 result (1) := VALUE; 443 return result; 444 end function TO_STRING; 445 446 function MINIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL is 447 begin 448 if L > R then return R; 449 else return L; 450 end if; 451 end function MINIMUM; 452 453 function MAXIMUM (L, R : SEVERITY_LEVEL) return SEVERITY_LEVEL is 454 begin 455 if L > R then return L; 456 else return R; 457 end if; 458 end function MAXIMUM; 459 460 function TO_STRING (VALUE : SEVERITY_LEVEL) return STRING is 461 begin 462 return SEVERITY_LEVEL'image(VALUE); 463 end function TO_STRING; 464 465 function MINIMUM (L, R : INTEGER) return INTEGER is 466 begin 467 if L > R then return R; 468 else return L; 469 end if; 470 end function MINIMUM; 471 472 function MAXIMUM (L, R : INTEGER) return INTEGER is 473 begin 474 if L > R then return L; 475 else return R; 476 end if; 477 end function MAXIMUM; 478 479 function TO_STRING (VALUE : INTEGER) return STRING is 480 begin 481 return INTEGER'image(VALUE); 482 end function TO_STRING; 483 484 function MINIMUM (L, R : REAL) return REAL is 485 begin 486 if L > R then return R; 487 else return L; 488 end if; 489 end function MINIMUM; 490 491 function MAXIMUM (L, R : REAL) return REAL is 492 begin 493 if L > R then return L; 494 else return R; 495 end if; 496 end function MAXIMUM; 497 498 function TO_STRING (VALUE : REAL) return STRING is 499 begin 500 return REAL'image (VALUE); 501 end function TO_STRING; 502 503 function TO_STRING (VALUE : REAL; DIGITS : NATURAL) return STRING is 504 begin 505 return to_string (VALUE, "%1." & INTEGER'image(DIGITS) & "f"); 506 end function TO_STRING; 507 508 function "mod" (L, R : TIME) return TIME is 509 variable lint, rint : INTEGER; 510 begin 511 lint := L / 1.0 ns; 512 rint := R / 1.0 ns; 513 return (lint mod rint) * 1.0 ns; 514 end function "mod"; 515 516 function "rem" (L, R : TIME) return TIME is 517 variable lint, rint : INTEGER; 518 begin 519 lint := L / 1.0 ns; 520 rint := R / 1.0 ns; 521 return (lint rem rint) * 1.0 ns; 522 end function "rem"; 523 524 function MINIMUM (L, R : TIME) return TIME is 525 begin 526 if L > R then return R; 527 else return L; 528 end if; 529 end function MINIMUM; 530 531 function MAXIMUM (L, R : TIME) return TIME is 532 begin 533 if L > R then return L; 534 else return R; 535 end if; 536 end function MAXIMUM; 537 538 function TO_STRING (VALUE : TIME) return STRING is 539 begin 540 return TIME'image (VALUE); 541 end function TO_STRING; 542 543 function MINIMUM (L, R : STRING) return STRING is 544 begin 545 if L > R then return R; 546 else return L; 547 end if; 548 end function MINIMUM; 549 550 function MAXIMUM (L, R : STRING) return STRING is 551 begin 552 if L > R then return L; 553 else return R; 554 end if; 555 end function MAXIMUM; 556 557 function MINIMUM (L : STRING) return CHARACTER is 558 variable result : CHARACTER := CHARACTER'high; 559 begin 560 for i in l'range loop 561 result := minimum (l(i), result); 562 end loop; 563 return result; 564 end function MINIMUM; 565 566 function MAXIMUM (L : STRING) return CHARACTER is 567 variable result : CHARACTER := CHARACTER'low; 568 begin 569 for i in l'range loop 570 result := maximum (l(i), result); 571 end loop; 572 return result; 573 end function MAXIMUM; 574 575 -- type BOOLEAN_VECTOR is array (NATURAL range <>) of BOOLEAN; 576 -- The predefined operations for this type are as follows: 577 function "and" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 578 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 579 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 580 variable result : BOOLEAN_VECTOR (1 to l'length); 581 begin 582 if (l'length /= r'length) then 583 assert false 584 report "STD.""and"": " 585 & "arguments of overloaded 'and' operator are not of the same length" 586 severity failure; 587 else 588 for i in result'range loop 589 result(i) := (lv(i) and rv(i)); 590 end loop; 591 end if; 592 return result; 593 end function "and"; 594 595 function "or" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 596 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 597 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 598 variable result : BOOLEAN_VECTOR (1 to l'length); 599 begin 600 if (l'length /= r'length) then 601 assert false 602 report "STD.""or"": " 603 & "arguments of overloaded 'or' operator are not of the same length" 604 severity failure; 605 else 606 for i in result'range loop 607 result(i) := (lv(i) or rv(i)); 608 end loop; 609 end if; 610 return result; 611 end function "or"; 612 613 function "nand" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 614 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 615 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 616 variable result : BOOLEAN_VECTOR (1 to l'length); 617 begin 618 if (l'length /= r'length) then 619 assert false 620 report "STD.""nand"": " 621 & "arguments of overloaded 'nand' operator are not of the same length" 622 severity failure; 623 else 624 for i in result'range loop 625 result(i) := (lv(i) nand rv(i)); 626 end loop; 627 end if; 628 return result; 629 end function "nand"; 630 631 function "nor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 632 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 633 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 634 variable result : BOOLEAN_VECTOR (1 to l'length); 635 begin 636 if (l'length /= r'length) then 637 assert false 638 report "STD.""nor"": " 639 & "arguments of overloaded 'nor' operator are not of the same length" 640 severity failure; 641 else 642 for i in result'range loop 643 result(i) := (lv(i) nor rv(i)); 644 end loop; 645 end if; 646 return result; 647 end function "nor"; 648 649 function "xor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 650 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 651 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 652 variable result : BOOLEAN_VECTOR (1 to l'length); 653 begin 654 if (l'length /= r'length) then 655 assert false 656 report "STD.""xor"": " 657 & "arguments of overloaded 'xor' operator are not of the same length" 658 severity failure; 659 else 660 for i in result'range loop 661 result(i) := (lv(i) xor rv(i)); 662 end loop; 663 end if; 664 return result; 665 end function "xor"; 666 667 function "xnor" (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 668 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 669 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 670 variable result : BOOLEAN_VECTOR (1 to l'length); 671 begin 672 if (l'length /= r'length) then 673 assert false 674 report "STD.""xnor"": " 675 & "arguments of overloaded 'xnor' operator are not of the same length" 676 severity failure; 677 else 678 for i in result'range loop 679 result(i) := (lv(i) xnor rv(i)); 680 end loop; 681 end if; 682 return result; 683 end function "xnor"; 684 685 function "not" (L : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 686 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 687 variable result : BOOLEAN_VECTOR (1 to l'length); 688 begin 689 for i in result'range loop 690 result(i) := not (lv(i)); 691 end loop; 692 return result; 693 end function "not"; 694 695 function "and" (L : BOOLEAN_VECTOR; R : BOOLEAN) 696 return BOOLEAN_VECTOR is 697 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 698 variable result : BOOLEAN_VECTOR (1 to l'length); 699 begin 700 for i in result'range loop 701 result(i) := lv(i) and r; 702 end loop; 703 return result; 704 end function "and"; 705 706 function "and" (L : BOOLEAN; R : BOOLEAN_VECTOR) 707 return BOOLEAN_VECTOR is 708 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 709 variable result : BOOLEAN_VECTOR (1 to r'length); 710 begin 711 for i in result'range loop 712 result(i) := l and rv(i); 713 end loop; 714 return result; 715 end function "and"; 716 717 function "or" (L : BOOLEAN_VECTOR; R : BOOLEAN) 718 return BOOLEAN_VECTOR is 719 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 720 variable result : BOOLEAN_VECTOR (1 to l'length); 721 begin 722 for i in result'range loop 723 result(i) := lv(i) or r; 724 end loop; 725 return result; 726 end function "or"; 727 728 function "or" (L : BOOLEAN; R : BOOLEAN_VECTOR) 729 return BOOLEAN_VECTOR is 730 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 731 variable result : BOOLEAN_VECTOR (1 to r'length); 732 begin 733 for i in result'range loop 734 result(i) := l or rv(i); 735 end loop; 736 return result; 737 end function "or"; 738 739 function "nand" (L : BOOLEAN_VECTOR; R : BOOLEAN) 740 return BOOLEAN_VECTOR is 741 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 742 variable result : BOOLEAN_VECTOR (1 to l'length); 743 begin 744 for i in result'range loop 745 result(i) := lv(i) nand r; 746 end loop; 747 return result; 748 end function "nand"; 749 750 function "nand" (L : BOOLEAN; R : BOOLEAN_VECTOR) 751 return BOOLEAN_VECTOR is 752 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 753 variable result : BOOLEAN_VECTOR (1 to r'length); 754 begin 755 for i in result'range loop 756 result(i) := l nand rv(i); 757 end loop; 758 return result; 759 end function "nand"; 760 761 function "nor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 762 return BOOLEAN_VECTOR is 763 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 764 variable result : BOOLEAN_VECTOR (1 to l'length); 765 begin 766 for i in result'range loop 767 result(i) := lv(i) nor r; 768 end loop; 769 return result; 770 end function "nor"; 771 772 function "nor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 773 return BOOLEAN_VECTOR is 774 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 775 variable result : BOOLEAN_VECTOR (1 to r'length); 776 begin 777 for i in result'range loop 778 result(i) := l nor rv(i); 779 end loop; 780 return result; 781 end function "nor"; 782 783 function "xor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 784 return BOOLEAN_VECTOR is 785 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 786 variable result : BOOLEAN_VECTOR (1 to l'length); 787 begin 788 for i in result'range loop 789 result(i) := lv(i) xor r; 790 end loop; 791 return result; 792 end function "xor"; 793 794 function "xor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 795 return BOOLEAN_VECTOR is 796 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 797 variable result : BOOLEAN_VECTOR (1 to r'length); 798 begin 799 for i in result'range loop 800 result(i) := l xor rv(i); 801 end loop; 802 return result; 803 end function "xor"; 804 805 function "xnor" (L : BOOLEAN_VECTOR; R : BOOLEAN) 806 return BOOLEAN_VECTOR is 807 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 808 variable result : BOOLEAN_VECTOR (1 to l'length); 809 begin 810 for i in result'range loop 811 result(i) := lv(i) xnor r; 812 end loop; 813 return result; 814 end function "xnor"; 815 816 function "xnor" (L : BOOLEAN; R : BOOLEAN_VECTOR) 817 return BOOLEAN_VECTOR is 818 alias rv : BOOLEAN_VECTOR (1 to r'length) is r; 819 variable result : BOOLEAN_VECTOR (1 to r'length); 820 begin 821 for i in result'range loop 822 result(i) := l xnor rv(i); 823 end loop; 824 return result; 825 end function "xnor"; 826 827 function and_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 828 variable result : BOOLEAN := true; 829 begin 830 for i in l'reverse_range loop 831 result := l(i) and result; 832 end loop; 833 return result; 834 end function and_reduce; 835 836 function or_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 837 variable result : BOOLEAN := false; 838 begin 839 for i in l'reverse_range loop 840 result := l(i) or result; 841 end loop; 842 return result; 843 end function or_reduce; 844 845 function nand_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 846 variable result : BOOLEAN := true; 847 begin 848 for i in l'reverse_range loop 849 result := l(i) and result; 850 end loop; 851 return not result; 852 end function nand_reduce; 853 854 function nor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 855 variable result : BOOLEAN := false; 856 begin 857 for i in l'reverse_range loop 858 result := l(i) or result; 859 end loop; 860 return not result; 861 end function nor_reduce; 862 863 function xor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 864 variable result : BOOLEAN := false; 865 begin 866 for i in l'reverse_range loop 867 result := l(i) xor result; 868 end loop; 869 return result; 870 end function xor_reduce; 871 872 function xnor_reduce (L : BOOLEAN_VECTOR) return BOOLEAN is 873 variable result : BOOLEAN := false; 874 begin 875 for i in l'reverse_range loop 876 result := l(i) xor result; 877 end loop; 878 return not result; 879 end function xnor_reduce; 880 881 function "sll" (L : BOOLEAN_VECTOR; R : INTEGER) 882 return BOOLEAN_VECTOR is 883 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 884 variable result : BOOLEAN_VECTOR (1 to l'length); 885 begin 886 if r >= 0 then 887 result(1 to l'length - r) := lv(r + 1 to l'length); 888 else 889 result := l srl -r; 890 end if; 891 return result; 892 end function "sll"; 893 894 function "srl" (L : BOOLEAN_VECTOR; R : INTEGER) 895 return BOOLEAN_VECTOR is 896 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 897 variable result : BOOLEAN_VECTOR (1 to l'length); 898 begin 899 if r >= 0 then 900 result(r + 1 to l'length) := lv(1 to l'length - r); 901 else 902 result := l sll -r; 903 end if; 904 return result; 905 end function "srl"; 906 907 function "sla" (L : BOOLEAN_VECTOR; R : INTEGER) 908 return BOOLEAN_VECTOR is 909 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 910 variable result : BOOLEAN_VECTOR (1 to l'length); 911 begin 912 for i in L'range loop 913 result (i) := L(L'high); 914 end loop; 915 if r >= 0 then 916 result(1 to l'length - r) := lv(r + 1 to l'length); 917 else 918 result := l sra -r; 919 end if; 920 return result; 921 end function "sla"; 922 923 function "sra" (L : BOOLEAN_VECTOR; R : INTEGER) 924 return BOOLEAN_VECTOR is 925 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 926 variable result : BOOLEAN_VECTOR (1 to l'length); 927 begin 928 for i in L'range loop 929 result (i) := L(L'low); 930 end loop; 931 if r >= 0 then 932 result(1 to l'length - r) := lv(r + 1 to l'length); 933 else 934 result := l sra -r; 935 end if; 936 return result; 937 end function "sra"; 938 939 function "rol" (L : BOOLEAN_VECTOR; R : INTEGER) 940 return BOOLEAN_VECTOR is 941 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 942 variable result : BOOLEAN_VECTOR (1 to l'length); 943 constant rm : INTEGER := r mod l'length; 944 begin 945 if r >= 0 then 946 result(1 to l'length - rm) := lv(rm + 1 to l'length); 947 result(l'length - rm + 1 to l'length) := lv(1 to rm); 948 else 949 result := l ror -r; 950 end if; 951 return result; 952 end function "rol"; 953 954 function "ror" (L : BOOLEAN_VECTOR; R : INTEGER) 955 return BOOLEAN_VECTOR is 956 alias lv : BOOLEAN_VECTOR (1 to l'length) is l; 957 variable result : BOOLEAN_VECTOR (1 to l'length); 958 constant rm : INTEGER := r mod l'length; 959 begin 960 if r >= 0 then 961 result(rm + 1 to l'length) := lv(1 to l'length - rm); 962 result(1 to rm) := lv(l'length - rm + 1 to l'length); 963 else 964 result := l rol -r; 965 end if; 966 return result; 967 end function "ror"; 968-- function "=" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 969-- function "/=" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 970-- function "<" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 971-- function "<=" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 972-- function ">" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 973-- function ">=" (L, R: BOOLEAN_VECTOR) return BOOLEAN; 974 975 function \?=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN is 976 begin 977 return L = R; 978 end function \?=\; 979 980 function \?/=\ (L, R : BOOLEAN_VECTOR) return BOOLEAN is 981 begin 982 return L /= R; 983 end function \?/=\; 984-- function "&" (L: BOOLEAN_VECTOR; R: BOOLEAN_VECTOR) 985-- return BOOLEAN_VECTOR; 986-- function "&" (L: BOOLEAN_VECTOR; R: BOOLEAN) return BOOLEAN_VECTOR; 987-- function "&" (L: BOOLEAN; R: BOOLEAN_VECTOR) return BOOLEAN_VECTOR; 988-- function "&" (L: BOOLEAN; R: BOOLEAN) return BOOLEAN_VECTOR; 989 990 function MINIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 991 begin 992 if L > R then return R; 993 else return L; 994 end if; 995 end function MINIMUM; 996 997 function MAXIMUM (L, R : BOOLEAN_VECTOR) return BOOLEAN_VECTOR is 998 begin 999 if L > R then return L; 1000 else return R; 1001 end if; 1002 end function MAXIMUM; 1003 1004 function MINIMUM (L : BOOLEAN_VECTOR) return BOOLEAN is 1005 variable result : BOOLEAN := BOOLEAN'high; 1006 begin 1007 for i in l'range loop 1008 result := minimum (l(i), result); 1009 end loop; 1010 return result; 1011 end function MINIMUM; 1012 1013 function MAXIMUM (L : BOOLEAN_VECTOR) return BOOLEAN is 1014 variable result : BOOLEAN := BOOLEAN'low; 1015 begin 1016 for i in l'range loop 1017 result := maximum (l(i), result); 1018 end loop; 1019 return result; 1020 end function MAXIMUM; 1021 1022 function "and" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1023 alias lv : BIT_VECTOR (1 to l'length) is l; 1024 variable result : BIT_VECTOR (1 to l'length); 1025 begin 1026 for i in result'range loop 1027 result(i) := lv(i) and r; 1028 end loop; 1029 return result; 1030 end function "and"; 1031 1032 function "and" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1033 alias rv : BIT_VECTOR (1 to r'length) is r; 1034 variable result : BIT_VECTOR (1 to r'length); 1035 begin 1036 for i in result'range loop 1037 result(i) := l and rv(i); 1038 end loop; 1039 return result; 1040 end function "and"; 1041 1042 function "or" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1043 alias lv : BIT_VECTOR (1 to l'length) is l; 1044 variable result : BIT_VECTOR (1 to l'length); 1045 begin 1046 for i in result'range loop 1047 result(i) := lv(i) or r; 1048 end loop; 1049 return result; 1050 end function "or"; 1051 1052 function "or" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1053 alias rv : BIT_VECTOR (1 to r'length) is r; 1054 variable result : BIT_VECTOR (1 to r'length); 1055 begin 1056 for i in result'range loop 1057 result(i) := l or rv(i); 1058 end loop; 1059 return result; 1060 end function "or"; 1061 1062 function "nand" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1063 alias lv : BIT_VECTOR (1 to l'length) is l; 1064 variable result : BIT_VECTOR (1 to l'length); 1065 begin 1066 for i in result'range loop 1067 result(i) := lv(i) and r; 1068 end loop; 1069 return not result; 1070 end function "nand"; 1071 1072 function "nand" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1073 alias rv : BIT_VECTOR (1 to r'length) is r; 1074 variable result : BIT_VECTOR (1 to r'length); 1075 begin 1076 for i in result'range loop 1077 result(i) := l and rv(i); 1078 end loop; 1079 return not result; 1080 end function "nand"; 1081 1082 function "nor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1083 alias lv : BIT_VECTOR (1 to l'length) is l; 1084 variable result : BIT_VECTOR (1 to l'length); 1085 begin 1086 for i in result'range loop 1087 result(i) := lv(i) or r; 1088 end loop; 1089 return not result; 1090 end function "nor"; 1091 1092 function "nor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1093 alias rv : BIT_VECTOR (1 to r'length) is r; 1094 variable result : BIT_VECTOR (1 to r'length); 1095 begin 1096 for i in result'range loop 1097 result(i) := l or rv(i); 1098 end loop; 1099 return not result; 1100 end function "nor"; 1101 1102 function "xor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1103 alias lv : BIT_VECTOR (1 to l'length) is l; 1104 variable result : BIT_VECTOR (1 to l'length); 1105 begin 1106 for i in result'range loop 1107 result(i) := lv(i) xor r; 1108 end loop; 1109 return result; 1110 end function "xor"; 1111 1112 function "xor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1113 alias rv : BIT_VECTOR (1 to r'length) is r; 1114 variable result : BIT_VECTOR (1 to r'length); 1115 begin 1116 for i in result'range loop 1117 result(i) := l xor rv(i); 1118 end loop; 1119 return result; 1120 end function "xor"; 1121 1122 function "xnor" (L : BIT_VECTOR; R : BIT) return BIT_VECTOR is 1123 alias lv : BIT_VECTOR (1 to l'length) is l; 1124 variable result : BIT_VECTOR (1 to l'length); 1125 begin 1126 for i in result'range loop 1127 result(i) := lv(i) xor r; 1128 end loop; 1129 return not result; 1130 end function "xnor"; 1131 1132 function "xnor" (L : BIT; R : BIT_VECTOR) return BIT_VECTOR is 1133 alias rv : BIT_VECTOR (1 to r'length) is r; 1134 variable result : BIT_VECTOR (1 to r'length); 1135 begin 1136 for i in result'range loop 1137 result(i) := l xor rv(i); 1138 end loop; 1139 return not result; 1140 end function "xnor"; 1141 1142 function and_reduce (L : BIT_VECTOR) return BIT is 1143 variable result : BIT := '1'; 1144 begin 1145 for i in l'reverse_range loop 1146 result := l(i) and result; 1147 end loop; 1148 return result; 1149 end function and_reduce; 1150 1151 function or_reduce (L : BIT_VECTOR) return BIT is 1152 variable result : BIT := '0'; 1153 begin 1154 for i in l'reverse_range loop 1155 result := l(i) or result; 1156 end loop; 1157 return result; 1158 end function or_reduce; 1159 1160 function nand_reduce (L : BIT_VECTOR) return BIT is 1161 variable result : BIT := '1'; 1162 begin 1163 for i in l'reverse_range loop 1164 result := l(i) and result; 1165 end loop; 1166 return not result; 1167 end function nand_reduce; 1168 1169 function nor_reduce (L : BIT_VECTOR) return BIT is 1170 variable result : BIT := '0'; 1171 begin 1172 for i in l'reverse_range loop 1173 result := l(i) or result; 1174 end loop; 1175 return not result; 1176 end function nor_reduce; 1177 1178 function xor_reduce (L : BIT_VECTOR) return BIT is 1179 variable result : BIT := '0'; 1180 begin 1181 for i in l'reverse_range loop 1182 result := l(i) xor result; 1183 end loop; 1184 return result; 1185 end function xor_reduce; 1186 1187 function xnor_reduce (L : BIT_VECTOR) return BIT is 1188 variable result : BIT := '0'; 1189 begin 1190 for i in l'reverse_range loop 1191 result := l(i) xor result; 1192 end loop; 1193 return not result; 1194 end function xnor_reduce; 1195 1196 function \?=\ (L, R : BIT_VECTOR) return BIT is 1197 begin 1198 if L = R then 1199 return '1'; 1200 else 1201 return '0'; 1202 end if; 1203 end function \?=\; 1204 1205 function \?/=\ (L, R : BIT_VECTOR) return BIT is 1206 begin 1207 if L /= R then 1208 return '1'; 1209 else 1210 return '0'; 1211 end if; 1212 end function \?/=\; 1213 1214 function MINIMUM (L, R : BIT_VECTOR) return BIT_VECTOR is 1215 begin 1216 if L > R then return R; 1217 else return L; 1218 end if; 1219 end function MINIMUM; 1220 1221 function MAXIMUM (L, R : BIT_VECTOR) return BIT_VECTOR is 1222 begin 1223 if L > R then return L; 1224 else return R; 1225 end if; 1226 end function MAXIMUM; 1227 1228 function MINIMUM (L : BIT_VECTOR) return BIT is 1229 variable result : BIT := BIT'high; 1230 begin 1231 for i in l'range loop 1232 result := minimum (l(i), result); 1233 end loop; 1234 return result; 1235 end function MINIMUM; 1236 1237 function MAXIMUM (L : BIT_VECTOR) return BIT is 1238 variable result : BIT := BIT'low; 1239 begin 1240 for i in l'range loop 1241 result := maximum (l(i), result); 1242 end loop; 1243 return result; 1244 end function MAXIMUM; 1245 1246 function TO_STRING (VALUE : BIT_VECTOR) return STRING is 1247 alias ivalue : BIT_VECTOR(1 to value'length) is value; 1248 variable result : STRING(1 to value'length); 1249 begin 1250 if value'length < 1 then 1251 return ""; 1252 else 1253 for i in ivalue'range loop 1254 if iValue(i) = '0' then 1255 result(i) := '0'; 1256 else 1257 result(i) := '1'; 1258 end if; 1259 end loop; 1260 return result; 1261 end if; 1262 end function to_string; 1263 1264-- alias TO_BSTRING is TO_STRING [BIT_VECTOR return STRING]; 1265-- alias TO_BINARY_STRING is TO_STRING [BIT_VECTOR return STRING]; 1266 1267 function TO_OSTRING (VALUE : BIT_VECTOR) return STRING is 1268 constant ne : INTEGER := (value'length+2)/3; 1269 constant pad : BIT_VECTOR(0 to (ne*3 - value'length) - 1) := (others => '0'); 1270 variable ivalue : BIT_VECTOR(0 to ne*3 - 1); 1271 variable result : STRING(1 to ne); 1272 variable tri : BIT_VECTOR(0 to 2); 1273 begin 1274 if value'length < 1 then 1275 return ""; 1276 end if; 1277 ivalue := pad & value; 1278 for i in 0 to ne-1 loop 1279 tri := ivalue(3*i to 3*i+2); 1280 case tri is 1281 when o"0" => result(i+1) := '0'; 1282 when o"1" => result(i+1) := '1'; 1283 when o"2" => result(i+1) := '2'; 1284 when o"3" => result(i+1) := '3'; 1285 when o"4" => result(i+1) := '4'; 1286 when o"5" => result(i+1) := '5'; 1287 when o"6" => result(i+1) := '6'; 1288 when o"7" => result(i+1) := '7'; 1289 end case; 1290 end loop; 1291 return result; 1292 end function to_ostring; 1293-- alias TO_OCTAL_STRING is TO_OSTRING [BIT_VECTOR return STRING]; 1294 1295 function TO_HSTRING (VALUE : BIT_VECTOR) return STRING is 1296 constant ne : INTEGER := (value'length+3)/4; 1297 constant pad : BIT_VECTOR(0 to (ne*4 - value'length) - 1) := (others => '0'); 1298 variable ivalue : BIT_VECTOR(0 to ne*4 - 1); 1299 variable result : STRING(1 to ne); 1300 variable quad : BIT_VECTOR(0 to 3); 1301 begin 1302 if value'length < 1 then 1303 return ""; 1304 end if; 1305 ivalue := pad & value; 1306 for i in 0 to ne-1 loop 1307 quad := ivalue(4*i to 4*i+3); 1308 case quad is 1309 when x"0" => result(i+1) := '0'; 1310 when x"1" => result(i+1) := '1'; 1311 when x"2" => result(i+1) := '2'; 1312 when x"3" => result(i+1) := '3'; 1313 when x"4" => result(i+1) := '4'; 1314 when x"5" => result(i+1) := '5'; 1315 when x"6" => result(i+1) := '6'; 1316 when x"7" => result(i+1) := '7'; 1317 when x"8" => result(i+1) := '8'; 1318 when x"9" => result(i+1) := '9'; 1319 when x"A" => result(i+1) := 'A'; 1320 when x"B" => result(i+1) := 'B'; 1321 when x"C" => result(i+1) := 'C'; 1322 when x"D" => result(i+1) := 'D'; 1323 when x"E" => result(i+1) := 'E'; 1324 when x"F" => result(i+1) := 'F'; 1325 end case; 1326 end loop; 1327 return result; 1328 end function to_hstring; 1329-- alias TO_HEX_STRING is TO_HSTRING [BIT_VECTOR return STRING]; 1330 1331-- type INTEGER_VECTOR is array (NATURAL range <>) of INTEGER; 1332 -- The predefined operations for this type are as follows: 1333 1334 function "=" (L, R : INTEGER_VECTOR) return BOOLEAN is 1335 begin 1336 if L'length /= R'length or L'length < 1 or R'length < 1 then 1337 return false; 1338 else 1339 for i in l'range loop 1340 if L(i) /= R(i) then 1341 return false; 1342 end if; 1343 end loop; 1344 return true; 1345 end if; 1346 end function "="; 1347 1348 function "/=" (L, R : INTEGER_VECTOR) return BOOLEAN is 1349 begin 1350 return not (L = R); 1351 end function "/="; 1352 1353 function "<" (L, R : INTEGER_VECTOR) return BOOLEAN is 1354 begin 1355 if L'length /= R'length then 1356 return L'length < R'length; 1357 else 1358 for i in l'range loop 1359 if L(i) /= R(i) then 1360 if L(i) < R(i) then 1361 return true; 1362 else 1363 return false; 1364 end if; 1365 end if; 1366 end loop; 1367 return false; 1368 end if; 1369 end function "<"; 1370 1371 function "<=" (L, R : INTEGER_VECTOR) return BOOLEAN is 1372 begin 1373 if L'length /= R'length then 1374 return L'length < R'length; 1375 else 1376 for i in l'range loop 1377 if L(i) /= R(i) then 1378 if L(i) < R(i) then 1379 return true; 1380 else 1381 return false; 1382 end if; 1383 end if; 1384 end loop; 1385 return true; 1386 end if; 1387 end function "<="; 1388 1389 function ">" (L, R : INTEGER_VECTOR) return BOOLEAN is 1390 begin 1391 if L'length /= R'length then 1392 return L'length > R'length; 1393 else 1394 for i in l'range loop 1395 if L(i) /= R(i) then 1396 if L(i) > R(i) then 1397 return true; 1398 else 1399 return false; 1400 end if; 1401 end if; 1402 end loop; 1403 return false; 1404 end if; 1405 end function ">"; 1406 1407 function ">=" (L, R : INTEGER_VECTOR) return BOOLEAN is 1408 begin 1409 if L'length /= R'length then 1410 return L'length > R'length; 1411 else 1412 for i in l'range loop 1413 if L(i) /= R(i) then 1414 if L(i) > R(i) then 1415 return true; 1416 else 1417 return false; 1418 end if; 1419 end if; 1420 end loop; 1421 return true; 1422 end if; 1423 end function ">="; 1424-- function "&" (L: INTEGER_VECTOR; R: INTEGER_VECTOR) 1425-- return INTEGER_VECTOR; 1426-- function "&" (L: INTEGER_VECTOR; R: INTEGER) return INTEGER_VECTOR; 1427-- function "&" (L: INTEGER; R: INTEGER_VECTOR) return INTEGER_VECTOR; 1428-- function "&" (L: INTEGER; R: INTEGER) return INTEGER_VECTOR; 1429 1430 function MINIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR is 1431 begin 1432 if L > R then return R; 1433 else return L; 1434 end if; 1435 end function MINIMUM; 1436 1437 function MAXIMUM (L, R : INTEGER_VECTOR) return INTEGER_VECTOR is 1438 begin 1439 if L > R then return L; 1440 else return R; 1441 end if; 1442 end function MAXIMUM; 1443 1444 function MINIMUM (L : INTEGER_VECTOR) return INTEGER is 1445 variable result : INTEGER := INTEGER'high; 1446 begin 1447 for i in l'range loop 1448 result := minimum (l(i), result); 1449 end loop; 1450 return result; 1451 end function MINIMUM; 1452 1453 function MAXIMUM (L : INTEGER_VECTOR) return INTEGER is 1454 variable result : INTEGER := INTEGER'low; 1455 begin 1456 for i in l'range loop 1457 result := maximum (l(i), result); 1458 end loop; 1459 return result; 1460 end function MAXIMUM; 1461 1462 -- type REAL_VECTOR is array (NATURAL range <>) of REAL; 1463 -- The predefined operations for this type are as follows: 1464 function "=" (L, R : REAL_VECTOR) return BOOLEAN is 1465 begin 1466 if L'length /= R'length or L'length < 1 or R'length < 1 then 1467 return false; 1468 else 1469 for i in l'range loop 1470 if L(i) /= R(i) then 1471 return false; 1472 end if; 1473 end loop; 1474 return true; 1475 end if; 1476 end function "="; 1477 1478 function "/=" (L, R : REAL_VECTOR) return BOOLEAN is 1479 begin 1480 return not (L = R); 1481 end function "/="; 1482 1483 function "<" (L, R : REAL_VECTOR) return BOOLEAN is 1484 begin 1485 if L'length /= R'length then 1486 return L'length < R'length; 1487 else 1488 for i in l'range loop 1489 if L(i) /= R(i) then 1490 if L(i) < R(i) then 1491 return true; 1492 else 1493 return false; 1494 end if; 1495 end if; 1496 end loop; 1497 return false; 1498 end if; 1499 end function "<"; 1500 1501 function "<=" (L, R : REAL_VECTOR) return BOOLEAN is 1502 begin 1503 if L'length /= R'length then 1504 return L'length < R'length; 1505 else 1506 for i in l'range loop 1507 if L(i) /= R(i) then 1508 if L(i) < R(i) then 1509 return true; 1510 else 1511 return false; 1512 end if; 1513 end if; 1514 end loop; 1515 return true; 1516 end if; 1517 end function "<="; 1518 1519 function ">" (L, R : REAL_VECTOR) return BOOLEAN is 1520 begin 1521 if L'length /= R'length then 1522 return L'length > R'length; 1523 else 1524 for i in l'range loop 1525 if L(i) /= R(i) then 1526 if L(i) > R(i) then 1527 return true; 1528 else 1529 return false; 1530 end if; 1531 end if; 1532 end loop; 1533 return false; 1534 end if; 1535 end function ">"; 1536 1537 function ">=" (L, R : REAL_VECTOR) return BOOLEAN is 1538 begin 1539 if L'length /= R'length then 1540 return L'length > R'length; 1541 else 1542 for i in l'range loop 1543 if L(i) /= R(i) then 1544 if L(i) > R(i) then 1545 return true; 1546 else 1547 return false; 1548 end if; 1549 end if; 1550 end loop; 1551 return true; 1552 end if; 1553 end function ">="; 1554-- function "&" (L: REAL_VECTOR; R: REAL_VECTOR) 1555-- return REAL_VECTOR; 1556-- function "&" (L: REAL_VECTOR; R: REAL) return REAL_VECTOR; 1557-- function "&" (L: REAL; R: REAL_VECTOR) return REAL_VECTOR; 1558-- function "&" (L: REAL; R: REAL) return REAL_VECTOR; 1559 1560 function MINIMUM (L, R : REAL_VECTOR) return REAL_VECTOR is 1561 begin 1562 if L > R then return R; 1563 else return L; 1564 end if; 1565 end function MINIMUM; 1566 1567 function MAXIMUM (L, R : REAL_VECTOR) return REAL_VECTOR is 1568 begin 1569 if L > R then return L; 1570 else return R; 1571 end if; 1572 end function MAXIMUM; 1573 1574 function MINIMUM (L : REAL_VECTOR) return REAL is 1575 variable result : REAL := REAL'high; 1576 begin 1577 for i in l'range loop 1578 result := minimum (l(i), result); 1579 end loop; 1580 return result; 1581 end function MINIMUM; 1582 1583 function MAXIMUM (L : REAL_VECTOR) return REAL is 1584 variable result : REAL := REAL'low; 1585 begin 1586 for i in l'range loop 1587 result := maximum (l(i), result); 1588 end loop; 1589 return result; 1590 end function MAXIMUM; 1591 1592 -- type TIME_VECTOR is array (NATURAL range <>) of TIME; 1593 -- The predefined implicit operations for this type are as follows: 1594 function "=" (L, R : TIME_VECTOR) return BOOLEAN is 1595 begin 1596 if L'length /= R'length or L'length < 1 or R'length < 1 then 1597 return false; 1598 else 1599 for i in l'range loop 1600 if L(i) /= R(i) then 1601 return false; 1602 end if; 1603 end loop; 1604 return true; 1605 end if; 1606 end function "="; 1607 1608 function "/=" (L, R : TIME_VECTOR) return BOOLEAN is 1609 begin 1610 return not (L = R); 1611 end function "/="; 1612 1613 function "<" (L, R : TIME_VECTOR) return BOOLEAN is 1614 begin 1615 if L'length /= R'length then 1616 return L'length < R'length; 1617 else 1618 for i in l'range loop 1619 if L(i) /= R(i) then 1620 if L(i) < R(i) then 1621 return true; 1622 else 1623 return false; 1624 end if; 1625 end if; 1626 end loop; 1627 return false; 1628 end if; 1629 end function "<"; 1630 1631 function "<=" (L, R : TIME_VECTOR) return BOOLEAN is 1632 begin 1633 if L'length /= R'length then 1634 return L'length < R'length; 1635 else 1636 for i in l'range loop 1637 if L(i) /= R(i) then 1638 if L(i) < R(i) then 1639 return true; 1640 else 1641 return false; 1642 end if; 1643 end if; 1644 end loop; 1645 return true; 1646 end if; 1647 end function "<="; 1648 1649 function ">" (L, R : TIME_VECTOR) return BOOLEAN is 1650 begin 1651 if L'length /= R'length then 1652 return L'length > R'length; 1653 else 1654 for i in l'range loop 1655 if L(i) /= R(i) then 1656 if L(i) > R(i) then 1657 return true; 1658 else 1659 return false; 1660 end if; 1661 end if; 1662 end loop; 1663 return false; 1664 end if; 1665 end function ">"; 1666 1667 function ">=" (L, R : TIME_VECTOR) return BOOLEAN is 1668 begin 1669 if L'length /= R'length then 1670 return L'length > R'length; 1671 else 1672 for i in l'range loop 1673 if L(i) /= R(i) then 1674 if L(i) > R(i) then 1675 return true; 1676 else 1677 return false; 1678 end if; 1679 end if; 1680 end loop; 1681 return true; 1682 end if; 1683 end function ">="; 1684-- function "&" (L: TIME_VECTOR; R: TIME_VECTOR) 1685-- return TIME_VECTOR; 1686-- function "&" (L: TIME_VECTOR; R: TIME) return TIME_VECTOR; 1687-- function "&" (L: TIME; R: TIME_VECTOR) return TIME_VECTOR; 1688-- function "&" (L: TIME; R: TIME) return TIME_VECTOR; 1689 1690 function MINIMUM (L, R : TIME_VECTOR) return TIME_VECTOR is 1691 begin 1692 if L > R then return R; 1693 else return L; 1694 end if; 1695 end function MINIMUM; 1696 1697 function MAXIMUM (L, R : TIME_VECTOR) return TIME_VECTOR is 1698 begin 1699 if L > R then return L; 1700 else return R; 1701 end if; 1702 end function MAXIMUM; 1703 1704 function MINIMUM (L : TIME_VECTOR) return TIME is 1705 variable result : TIME := TIME'high; 1706 begin 1707 for i in l'range loop 1708 result := minimum (l(i), result); 1709 end loop; 1710 return result; 1711 end function MINIMUM; 1712 1713 function MAXIMUM (L : TIME_VECTOR) return TIME is 1714 variable result : TIME := TIME'low; 1715 begin 1716 for i in l'range loop 1717 result := maximum (l(i), result); 1718 end loop; 1719 return result; 1720 end function MAXIMUM; 1721 1722 function MINIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND is 1723 begin 1724 if L > R then return R; 1725 else return L; 1726 end if; 1727 end function MINIMUM; 1728 1729 function MAXIMUM (L, R : FILE_OPEN_KIND) return FILE_OPEN_KIND is 1730 begin 1731 if L > R then return L; 1732 else return R; 1733 end if; 1734 end function MAXIMUM; 1735 1736 function TO_STRING (VALUE : FILE_OPEN_KIND) return STRING is 1737 begin 1738 return FILE_OPEN_KIND'image(VALUE); 1739 end function TO_STRING; 1740 1741 function MINIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS is 1742 begin 1743 if L > R then return R; 1744 else return L; 1745 end if; 1746 end function MINIMUM; 1747 1748 function MAXIMUM (L, R : FILE_OPEN_STATUS) return FILE_OPEN_STATUS is 1749 begin 1750 if L > R then return L; 1751 else return R; 1752 end if; 1753 end function MAXIMUM; 1754 1755 function TO_STRING (VALUE : FILE_OPEN_STATUS) return STRING is 1756 begin 1757 return FILE_OPEN_STATUS'image(VALUE); 1758 end function TO_STRING; 1759 1760 -- USED INTERNALLY! 1761 function justify ( 1762 value : in STRING; 1763 justified : in SIDE := right; 1764 field : in width := 0) 1765 return STRING is 1766 constant VAL_LEN : INTEGER := value'length; 1767 variable result : STRING (1 to field) := (others => ' '); 1768 begin -- function justify 1769 -- return value if field is too small 1770 if VAL_LEN >= field then 1771 return value; 1772 end if; 1773 if justified = left then 1774 result(1 to VAL_LEN) := value; 1775 elsif justified = right then 1776 result(field - VAL_LEN + 1 to field) := value; 1777 end if; 1778 return result; 1779 end function justify; 1780 1781 function TO_STRING (VALUE : TIME; UNIT : TIME) return STRING is 1782 variable L : LINE; -- pointer 1783 begin 1784 deallocate (L); 1785 write (L => L, 1786 VALUE => VALUE, 1787 UNIT => UNIT); 1788 return L.all; 1789 end function to_string; 1790 1791 function TO_STRING (VALUE : REAL; FORMAT : STRING) return STRING is 1792 constant czero : CHARACTER := '0'; -- zero 1793 constant half : REAL := 0.4999999999; -- almost 0.5 1794 -- Log10 funciton 1795 function log10 (arg : REAL) return INTEGER is 1796 variable i : INTEGER := 1; 1797 begin 1798 if ((arg = 0.0)) then 1799 return 0; 1800 elsif arg >= 1.0 then 1801 while arg >= 10.0**i loop 1802 i := i + 1; 1803 end loop; 1804 return (i-1); 1805 else 1806 while arg < 10.0**i loop 1807 i := i - 1; 1808 end loop; 1809 return i; 1810 end if; 1811 end function log10; 1812 -- purpose: writes a fractional real number into a line 1813 procedure writefrc ( 1814 variable L : inout LINE; -- LINE 1815 variable cdes : in CHARACTER; 1816 variable precision : in INTEGER; -- number of decimal places 1817 variable value : in REAL) is -- real value 1818 variable rvar : REAL; -- temp variable 1819 variable xint : INTEGER; 1820 variable xreal : REAL; 1821 begin 1822 xreal := (10.0**(-precision)); 1823 write (L, '.'); 1824 rvar := value; 1825 for i in 1 to precision loop 1826 rvar := rvar * 10.0; 1827 xint := INTEGER(rvar-0.49999999999); -- round 1828 write (L, xint); 1829 rvar := rvar - REAL(xint); 1830 xreal := xreal * 10.0; 1831 if (cdes = 'g') and (rvar < xreal) then 1832 exit; 1833 end if; 1834 end loop; 1835 end procedure writefrc; 1836 -- purpose: replace the "." with a "@", and "e" with "j" to get around 1837 -- read ("6.") and read ("2e") issues. 1838 function subdot ( 1839 constant format : STRING) 1840 return STRING is 1841 variable result : STRING (format'range); 1842 begin 1843 for i in format'range loop 1844 if (format(i) = '.') then 1845 result(i) := '@'; -- Because the parser reads 6.2 as REAL 1846 elsif (format(i) = 'e') then 1847 result(i) := 'j'; -- Because the parser read 2e as REAL 1848 elsif (format(i) = 'E') then 1849 result(i) := 'J'; -- Because the parser reads 2E as REAL 1850 else 1851 result(i) := format(i); 1852 end if; 1853 end loop; 1854 return result; 1855 end function subdot; 1856 -- purpose: find a . in a STRING 1857 function isdot ( 1858 constant format : STRING) 1859 return BOOLEAN is 1860 begin 1861 for i in format'range loop 1862 if (format(i) = '@') then 1863 return true; 1864 end if; 1865 end loop; 1866 return false; 1867 end function isdot; 1868 variable exp : INTEGER; -- integer version of baseexp 1869 variable bvalue : REAL; -- base value 1870 variable roundvar, tvar : REAL; -- Rounding values 1871 variable frcptr : INTEGER; -- integer version of number 1872 variable fwidth, dwidth : INTEGER; -- field width and decimal width 1873 variable dash, dot : BOOLEAN := false; 1874 variable cdes, ddes : CHARACTER := ' '; 1875 variable L : LINE; -- line type 1876 begin 1877 -- Perform the same function that "printf" does 1878 -- examples "%6.2f" "%-7e" "%g" 1879 if not (format(format'left) = '%') then 1880 report "to_string: Illegal format string """ & format & '"' 1881 severity error; 1882 return ""; 1883 end if; 1884 L := new STRING'(subdot(format)); 1885 read (L, ddes); -- toss the '%' 1886 case L.all(1) is 1887 when '-' => dash := true; 1888 when '@' => dash := true; -- in FP, a "-" and a "." are the same 1889 when 'f' => cdes := 'f'; 1890 when 'F' => cdes := 'F'; 1891 when 'g' => cdes := 'g'; 1892 when 'G' => cdes := 'G'; 1893 when 'j' => cdes := 'e'; -- parser reads 5e as real, thus we sub j 1894 when 'J' => cdes := 'E'; 1895 when '0'|'1'|'2'|'3'|'4'|'5'|'6'|'7'|'8'|'9' => null; 1896 when others => 1897 report "to_string: Illegal format string """ & format & '"' 1898 severity error; 1899 return ""; 1900 end case; 1901 if (dash or (cdes /= ' ')) then 1902 read (L, ddes); -- toss the next character 1903 end if; 1904 if (cdes = ' ') then 1905 if (isdot(L.all)) then -- if you see a . two numbers 1906 read (L, fwidth); -- read field width 1907 read (L, ddes); -- toss the next character . 1908 read (L, dwidth); -- read decimal width 1909 else 1910 read (L, fwidth); -- read field width 1911 dwidth := 6; -- the default decimal width is 6 1912 end if; 1913 read (L, cdes); 1914 if (cdes = 'j') then 1915 cdes := 'e'; -- because 2e reads as "REAL". 1916 elsif (cdes = 'J') then 1917 cdes := 'E'; 1918 end if; 1919 else 1920 if (cdes = 'E' or cdes = 'e') then 1921 fwidth := 10; -- default for e and E is %10.6e 1922 else 1923 fwidth := 0; -- default for f and g is %0.6f 1924 end if; 1925 dwidth := 6; 1926 end if; 1927 deallocate (L); -- reclame the pointer L. 1928-- assert (not debug) report "Format: " & format & " " 1929-- & INTEGER'image(fwidth) & "." & INTEGER'image(dwidth) & cdes 1930-- severity note; 1931 if (not (cdes = 'f' or cdes = 'F' or cdes = 'g' or cdes = 'G' 1932 or cdes = 'e' or cdes = 'E')) then 1933 report "to_string: Illegal format """ & format & '"' severity error; 1934 return ""; 1935 end if; 1936 if (VALUE < 0.0) then 1937 bvalue := -value; 1938 write (L, '-'); 1939 else 1940 bvalue := value; 1941 end if; 1942 case cdes is 1943 when 'e' | 'E' => -- 7.000E+01 1944 exp := log10(bvalue); 1945 roundvar := half*(10.0**(exp-dwidth)); 1946 bvalue := bvalue + roundvar; -- round 1947 exp := log10(bvalue); -- because we CAN overflow 1948 bvalue := bvalue * (10.0**(-exp)); -- result is D.XXXXXX 1949 frcptr := INTEGER(bvalue-half); -- Write a single digit. 1950 write (L, frcptr); 1951 bvalue := bvalue - REAL(frcptr); 1952 writefrc (-- Write out the fraction 1953 L => L, 1954 cdes => cdes, 1955 precision => dwidth, 1956 value => bvalue); 1957 write (L, cdes); -- e or E 1958 if (exp < 0) then 1959 write (L, '-'); 1960 else 1961 write (L, '+'); 1962 end if; 1963 exp := abs(exp); 1964 if (exp < 10) then -- we need another "0". 1965 write (L, czero); 1966 end if; 1967 write (L, exp); 1968 when 'f' | 'F' => -- 70.0 1969 exp := log10(bvalue); 1970 roundvar := half*(10.0**(-dwidth)); 1971 bvalue := bvalue + roundvar; -- round 1972 exp := log10(bvalue); -- because we CAN overflow 1973 if (exp < 0) then -- 0.X case 1974 write (L, czero); 1975 else -- loop because real'high > integer'high 1976 while (exp >= 0) loop 1977 frcptr := INTEGER(bvalue * (10.0**(-exp)) - half); 1978 write (L, frcptr); 1979 bvalue := bvalue - (REAL(frcptr) * (10.0**exp)); 1980 exp := exp-1; 1981 end loop; 1982 end if; 1983 writefrc ( 1984 L => L, 1985 cdes => cdes, 1986 precision => dwidth, 1987 value => bvalue); 1988 when 'g' | 'G' => -- 70 1989 exp := log10(bvalue); 1990 roundvar := half*(10.0**(exp-dwidth)); -- small number 1991 bvalue := bvalue + roundvar; -- round 1992 exp := log10(bvalue); -- because we CAN overflow 1993 frcptr := INTEGER(bvalue-half); 1994 tvar := bvalue-roundvar - REAL(frcptr); -- even smaller number 1995 if (exp < dwidth) 1996 and (tvar < roundvar and tvar > -roundvar) then 1997-- and ((bvalue-roundvar) = real(frcptr)) then 1998 write (L, frcptr); -- Just a short integer, write it. 1999 elsif (exp >= dwidth) or (exp < -4) then 2000 -- in "e" format (modified) 2001 bvalue := bvalue * (10.0**(-exp)); -- result is D.XXXXXX 2002 frcptr := INTEGER(bvalue-half); 2003 write (L, frcptr); 2004 bvalue := bvalue - REAL(frcptr); 2005 if (bvalue > (10.0**(1-dwidth))) then 2006 dwidth := dwidth - 1; 2007 writefrc ( 2008 L => L, 2009 cdes => cdes, 2010 precision => dwidth, 2011 value => bvalue); 2012 end if; 2013 if (cdes = 'G') then 2014 write (L, 'E'); 2015 else 2016 write (L, 'e'); 2017 end if; 2018 if (exp < 0) then 2019 write (L, '-'); 2020 else 2021 write (L, '+'); 2022 end if; 2023 exp := abs(exp); 2024 if (exp < 10) then 2025 write (L, czero); 2026 end if; 2027 write (L, exp); 2028 else 2029 -- in "f" format (modified) 2030 if (exp < 0) then 2031 write (L, czero); 2032 dwidth := maximum (dwidth, 4); -- if exp < -4 or > precision. 2033 bvalue := bvalue - roundvar; -- recalculate rounding 2034 roundvar := half*(10.0**(-dwidth)); 2035 bvalue := bvalue + roundvar; 2036 else 2037 write (L, frcptr); -- integer part (always small) 2038 bvalue := bvalue - (REAL(frcptr)); 2039 dwidth := dwidth - exp - 1; 2040 end if; 2041 if (bvalue > roundvar) then 2042 writefrc ( 2043 L => L, 2044 cdes => cdes, 2045 precision => dwidth, 2046 value => bvalue); 2047 end if; 2048 end if; 2049 when others => return ""; 2050 end case; 2051 -- You don't truncate real numbers. 2052-- if (dot) then -- truncate 2053-- if (L.all'length > fwidth) then 2054-- return justify (value => L.all (1 to fwidth), 2055-- justified => RIGHT, 2056-- field => fwidth); 2057-- else 2058-- return justify (value => L.all, 2059-- justified => RIGHT, 2060-- field => fwidth); 2061-- end if; 2062 if (dash) then -- fill to fwidth 2063 return justify (value => L.all, 2064 justified => left, 2065 field => fwidth); 2066 else 2067 return justify (value => L.all, 2068 justified => right, 2069 field => fwidth); 2070 end if; 2071 end function to_string; 2072 2073end package body standard_additions; 2074