1(* Ulm's Oberon Library 2 Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany 3 ---------------------------------------------------------------------------- 4 Ulm's Oberon Library is free software; you can redistribute it 5 and/or modify it under the terms of the GNU Library General Public 6 License as published by the Free Software Foundation; either version 7 2 of the License, or (at your option) any later version. 8 9 Ulm's Oberon Library is distributed in the hope that it will be 10 useful, but WITHOUT ANY WARRANTY; without even the implied warranty 11 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Library General Public License for more details. 13 14 You should have received a copy of the GNU Library General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 17 ---------------------------------------------------------------------------- 18 E-mail contact: oberon@mathematik.uni-ulm.de 19 ---------------------------------------------------------------------------- 20 $Id: Print.om,v 1.3 2004/05/21 12:08:43 borchert Exp $ 21 ---------------------------------------------------------------------------- 22 $Log: Print.om,v $ 23 Revision 1.3 2004/05/21 12:08:43 borchert 24 bug fix: NaNs and other invalid floating point numbers weren't 25 checked for 26 27 Revision 1.2 1996/09/18 07:47:41 borchert 28 support of SYSTEM.INT16 added 29 30 Revision 1.1 1994/02/23 07:46:28 borchert 31 Initial revision 32 33 ---------------------------------------------------------------------------- 34 AFB 6/89 35 ---------------------------------------------------------------------------- 36*) 37 38MODULE ulmPrint; 39 40 (* formatted printing; 41 Print.F[0-9] prints to Streams.stdout 42 43 formats are close to those of printf(3) 44 *) 45 46 IMPORT Events := ulmEvents, IEEE := ulmIEEE, Priorities := ulmPriorities, Reals := ulmReals, RelatedEvents := ulmRelatedEvents, StreamDisciplines := ulmStreamDisciplines, 47 Streams := ulmStreams, SYS := SYSTEM, Types := ulmTypes; 48 49 CONST 50 tooManyArgs* = 0; (* too many arguments given *) 51 tooFewArgs* = 1; (* too few arguments given *) 52 badFormat* = 2; (* syntax error in format string *) 53 badArgumentSize* = 3; (* bad size of argument *) 54 errors* = 4; 55 TYPE 56 FormatString* = ARRAY 128 OF CHAR; 57 ErrorCode* = Types.Int8; 58 ErrorEvent* = POINTER TO ErrorEventRec; 59 ErrorEventRec* = 60 RECORD 61 (Events.EventRec) 62 errorcode*: ErrorCode; 63 format*: FormatString; 64 errpos*: Types.Int32; 65 nargs*: Types.Int32; 66 END; 67 VAR 68 error*: Events.EventType; 69 errormsg*: ARRAY errors OF Events.Message; 70 71 (* === private part ============================================= *) 72 73 PROCEDURE InitErrorHandling; 74 BEGIN 75 Events.Define(error); Events.SetPriority(error, Priorities.liberrors); 76 errormsg[tooManyArgs] := "too many arguments given"; 77 errormsg[tooFewArgs] := "too few arguments given"; 78 errormsg[badFormat] := "syntax error in format string"; 79 errormsg[badArgumentSize] := 80 "size of argument doesn't conform to the corresponding format element"; 81 END InitErrorHandling; 82 83 PROCEDURE Out(out: Streams.Stream; VAR fmt: ARRAY OF CHAR; nargs: Types.Int32; 84 VAR p1,p2,p3,p4,p5,p6,p7,p8,p9: ARRAY OF SYS.BYTE; 85 errors: RelatedEvents.Object); 86 CONST 87 maxargs = 9; (* maximal number of arguments *) 88 maxargsize = SIZE(Types.Real64); (* maximal arg size (except strings) *) 89 fmtcmd = "%"; 90 escape = "\"; 91 VAR 92 arglen: ARRAY maxargs OF Types.Int32; 93 nextarg: Types.Int32; 94 fmtindex: Types.Int32; 95 fmtchar: CHAR; 96 hexcharval: Types.Int32; 97 98 PROCEDURE Error(errorcode: ErrorCode); 99 VAR 100 event: ErrorEvent; 101 BEGIN 102 NEW(event); 103 event.type := error; 104 event.message := errormsg[errorcode]; 105 event.errorcode := errorcode; 106 COPY(fmt, event.format); 107 event.errpos := fmtindex; 108 event.nargs := nargs; 109 RelatedEvents.Raise(errors, event); 110 END Error; 111 112 PROCEDURE Next() : BOOLEAN; 113 BEGIN 114 IF fmtindex < LEN(fmt) THEN 115 fmtchar := fmt[fmtindex]; INC(fmtindex); 116 IF fmtchar = 0X THEN 117 fmtindex := LEN(fmt); 118 RETURN FALSE 119 ELSE 120 RETURN TRUE 121 END; 122 ELSE 123 RETURN FALSE 124 END; 125 END Next; 126 127 PROCEDURE Unget; 128 BEGIN 129 IF (fmtindex > 0) & (fmtindex < LEN(fmt)) THEN 130 DEC(fmtindex); fmtchar := fmt[fmtindex]; 131 ELSE 132 fmtchar := 0X; 133 END; 134 END Unget; 135 136 PROCEDURE Write(byte: SYS.BYTE); 137 BEGIN 138 IF Streams.WriteByte(out, byte) THEN 139 INC(out.count); 140 END; 141 END Write; 142 143 PROCEDURE WriteLn; 144 VAR 145 lineterm: StreamDisciplines.LineTerminator; 146 i: Types.Int32; 147 BEGIN 148 StreamDisciplines.GetLineTerm(out, lineterm); 149 Write(lineterm[0]); 150 i := 1; 151 WHILE (i < LEN(lineterm)) & (lineterm[i] # 0X) DO 152 Write(lineterm[i]); INC(i); 153 END; 154 END WriteLn; 155 156 PROCEDURE Int(VAR int: Types.Int32; base: Types.Int32) : BOOLEAN; 157 158 PROCEDURE ValidDigit(ch: CHAR) : BOOLEAN; 159 BEGIN 160 RETURN (ch >= "0") & (ch <= "9") OR 161 (base = 16) & (CAP(ch) >= "A") & (CAP(ch) <= "F") 162 END ValidDigit; 163 164 BEGIN 165 int := 0; 166 REPEAT 167 int := int * base; 168 IF (fmtchar >= "0") & (fmtchar <= "9") THEN 169 INC(int, ORD(fmtchar) - ORD("0")); 170 ELSIF (base = 16) & 171 (CAP(fmtchar) >= "A") & (CAP(fmtchar) <= "F") THEN 172 INC(int, 10 + ORD(CAP(fmtchar)) - ORD("A")); 173 ELSE 174 RETURN FALSE 175 END; 176 UNTIL ~Next() OR ~ValidDigit(fmtchar); 177 RETURN TRUE 178 END Int; 179 180 PROCEDURE SetSize; 181 VAR 182 index: Types.Int32; 183 BEGIN 184 index := 0; 185 WHILE index < nargs DO 186 CASE index OF 187 | 0: arglen[index] := LEN(p1); 188 | 1: arglen[index] := LEN(p2); 189 | 2: arglen[index] := LEN(p3); 190 | 3: arglen[index] := LEN(p4); 191 | 4: arglen[index] := LEN(p5); 192 | 5: arglen[index] := LEN(p6); 193 | 6: arglen[index] := LEN(p7); 194 | 7: arglen[index] := LEN(p8); 195 | 8: arglen[index] := LEN(p9); 196 ELSE 197 END; 198 INC(index); 199 END; 200 END SetSize; 201 202 PROCEDURE Access(par: Types.Int32; at: Types.Int32) : SYS.BYTE; 203 BEGIN 204 CASE par OF 205 | 0: RETURN p1[at] 206 | 1: RETURN p2[at] 207 | 2: RETURN p3[at] 208 | 3: RETURN p4[at] 209 | 4: RETURN p5[at] 210 | 5: RETURN p6[at] 211 | 6: RETURN p7[at] 212 | 7: RETURN p8[at] 213 | 8: RETURN p9[at] 214 ELSE 215 END; 216 END Access; 217 218 PROCEDURE Convert(from: Types.Int32; VAR to: ARRAY OF SYS.BYTE); 219 VAR i: Types.Int32; 220 BEGIN 221 i := 0; 222 WHILE i < arglen[from] DO 223 to[i] := Access(from, i); INC(i); 224 END; 225 END Convert; 226 227 PROCEDURE GetInt(index: Types.Int32; VAR long: Types.Int32) : BOOLEAN; 228 (* access index-th parameter (counted from 0); 229 fails if arglen[index] > SYS.SIZE(Types.Int32) 230 *) 231 VAR 232 short: Types.Int8; 233 int16: SYS.INT16; 234 int: Types.Int32; 235 236 BEGIN 237 IF arglen[index] = SIZE(Types.Int8) THEN 238 Convert(index, short); long := short; 239 ELSIF arglen[index] = SIZE(SYS.INT16) THEN 240 Convert(index, int16); long := int16; 241 ELSIF arglen[index] = SIZE(Types.Int32) THEN 242 Convert(index, int); long := int; 243 ELSIF arglen[index] = SIZE(Types.Int32) THEN 244 Convert(index, long); 245 ELSE 246 Error(badArgumentSize); 247 RETURN FALSE 248 END; 249 RETURN TRUE 250 END GetInt; 251 252 PROCEDURE Format() : BOOLEAN; 253 254 VAR 255 fillch: CHAR; (* filling character *) 256 insert: BOOLEAN; (* insert between sign and 1st digit *) 257 sign: BOOLEAN; (* sign even positive values *) 258 leftaligned: BOOLEAN; (* output left aligned *) 259 width, scale: Types.Int32; 260 261 PROCEDURE NextArg(VAR index: Types.Int32) : BOOLEAN; 262 BEGIN 263 IF nextarg < nargs THEN 264 index := nextarg; INC(nextarg); RETURN TRUE 265 ELSE 266 RETURN FALSE 267 END; 268 END NextArg; 269 270 PROCEDURE Flags() : BOOLEAN; 271 BEGIN 272 fillch := " "; insert := FALSE; sign := FALSE; 273 leftaligned := FALSE; 274 REPEAT 275 CASE fmtchar OF 276 | "+": sign := TRUE; 277 | "0": fillch := "0"; insert := TRUE; 278 | "-": leftaligned := TRUE; 279 | "^": insert := TRUE; 280 | "\": IF ~Next() THEN RETURN FALSE END; fillch := fmtchar; 281 ELSE 282 RETURN TRUE 283 END; 284 UNTIL ~Next(); 285 Error(badFormat); 286 RETURN FALSE (* unexpected end *) 287 END Flags; 288 289 PROCEDURE FetchInt(VAR int: Types.Int32) : BOOLEAN; 290 VAR 291 index: Types.Int32; 292 BEGIN 293 RETURN (fmtchar = "*") & Next() & 294 NextArg(index) & GetInt(index, int) OR 295 Int(int, 10) & (int >= 0) 296 END FetchInt; 297 298 PROCEDURE Width() : BOOLEAN; 299 BEGIN 300 IF (fmtchar >= "0") & (fmtchar <= "9") OR (fmtchar = "*") THEN 301 IF FetchInt(width) THEN 302 RETURN TRUE 303 END; 304 Error(badFormat); RETURN FALSE 305 ELSE 306 width := 0; 307 RETURN TRUE 308 END; 309 END Width; 310 311 PROCEDURE Scale() : BOOLEAN; 312 BEGIN 313 IF fmtchar = "." THEN 314 IF Next() & FetchInt(scale) THEN 315 RETURN TRUE 316 ELSE 317 Error(badFormat); RETURN FALSE 318 END; 319 ELSE 320 scale := -1; RETURN TRUE 321 END; 322 END Scale; 323 324 PROCEDURE Conversion() : BOOLEAN; 325 326 PROCEDURE Fill(cnt: Types.Int32); 327 (* cnt: space used by normal output *) 328 VAR i: Types.Int32; 329 BEGIN 330 IF cnt < width THEN 331 i := width - cnt; 332 WHILE i > 0 DO 333 Write(fillch); 334 DEC(i); 335 END; 336 END; 337 END Fill; 338 339 PROCEDURE FillLeft(cnt: Types.Int32); 340 BEGIN 341 IF ~leftaligned THEN 342 Fill(cnt); 343 END; 344 END FillLeft; 345 346 PROCEDURE FillRight(cnt: Types.Int32); 347 BEGIN 348 IF leftaligned THEN 349 Fill(cnt); 350 END; 351 END FillRight; 352 353 PROCEDURE WriteBool(true, false: ARRAY OF CHAR) : BOOLEAN; 354 VAR index: Types.Int32; val: Types.Int32; 355 356 PROCEDURE WriteString(VAR s: ARRAY OF CHAR); 357 VAR i, len: Types.Int32; 358 BEGIN 359 len := 0; 360 WHILE (len < LEN(s)) & (s[len] # 0X) DO 361 INC(len); 362 END; 363 FillLeft(len); 364 i := 0; 365 WHILE i < len DO 366 Write(s[i]); INC(i); 367 END; 368 FillRight(len); 369 END WriteString; 370 371 BEGIN 372 IF NextArg(index) & GetInt(index, val) THEN 373 IF val = 0 THEN 374 WriteString(false); RETURN TRUE 375 ELSIF val = 1 THEN 376 WriteString(true); RETURN TRUE 377 END; 378 END; 379 RETURN FALSE 380 END WriteBool; 381 382 PROCEDURE WriteChar() : BOOLEAN; 383 VAR 384 val: Types.Int32; 385 index: Types.Int32; 386 BEGIN 387 IF NextArg(index) & GetInt(index, val) & 388 (val >= 0) & (val <= ORD(MAX(CHAR))) THEN 389 FillLeft(1); 390 Write(CHR(val)); 391 FillRight(1); 392 RETURN TRUE 393 END; 394 RETURN FALSE 395 END WriteChar; 396 397 PROCEDURE WriteInt(base: Types.Int32) : BOOLEAN; 398 VAR 399 index: Types.Int32; 400 val: Types.Int32; 401 neg: BOOLEAN; (* set by Convert *) 402 buf: ARRAY 12 OF CHAR; (* filled by Convert *) 403 i: Types.Int32; 404 len: Types.Int32; (* space needed for val *) 405 signcnt: Types.Int32; (* =1 if sign printed; else 0 *) 406 signch: CHAR; 407 408 PROCEDURE Convert; 409 VAR 410 index: Types.Int32; 411 digit: Types.Int32; 412 BEGIN 413 neg := val < 0; 414 index := 0; 415 REPEAT 416 digit := val MOD base; 417 val := val DIV base; 418 IF neg & (digit > 0) THEN 419 digit := base - digit; 420 INC(val); 421 END; 422 IF digit < 10 THEN 423 buf[index] := CHR(ORD("0") + digit); 424 ELSE 425 buf[index] := CHR(ORD("A") + digit - 10); 426 END; 427 INC(index); 428 UNTIL val = 0; 429 len := index; 430 END Convert; 431 432 BEGIN (* WriteInt *) 433 IF NextArg(index) & GetInt(index, val) THEN 434 Convert; 435 IF sign OR neg THEN 436 signcnt := 1; 437 IF neg THEN 438 signch := "-"; 439 ELSE 440 signch := "+"; 441 END; 442 ELSE 443 signcnt := 0; 444 END; 445 IF insert & (signcnt = 1) THEN 446 Write(signch); 447 END; 448 FillLeft(len+signcnt); 449 IF ~insert & (signcnt = 1) THEN 450 Write(signch); 451 END; 452 i := len; 453 WHILE i > 0 DO 454 DEC(i); Write(buf[i]); 455 END; 456 FillRight(len+signcnt); 457 RETURN TRUE 458 END; 459 RETURN FALSE 460 END WriteInt; 461 462 PROCEDURE WriteReal(format: CHAR) : BOOLEAN; 463 (* format either "f", "e", or "g" *) 464 CONST 465 defaultscale = 6; 466 VAR 467 index: Types.Int32; 468 lr: Types.Real64; 469 r: Types.Real32; 470 shortint: Types.Int8; int: Types.Int32; longint: Types.Int32; 471 int16: SYS.INT16; 472 long: BOOLEAN; 473 exponent: Types.Int32; 474 mantissa: Types.Real64; 475 digits: ARRAY Reals.maxlongdignum OF CHAR; 476 neg: BOOLEAN; 477 ndigits: Types.Int32; 478 decpt: Types.Int32; 479 480 PROCEDURE Print(decpt: Types.Int32; withexp: BOOLEAN; exp: Types.Int32); 481 (* decpt: position of decimal point 482 = 0: just before the digits 483 > 0: after decpt digits 484 < 0: ABS(decpt) zeroes before digits needed 485 *) 486 VAR 487 needed: Types.Int32; (* space needed *) 488 index: Types.Int32; 489 count: Types.Int32; 490 491 PROCEDURE WriteExp(exp: Types.Int32); 492 CONST 493 base = 10; 494 VAR 495 power: Types.Int32; 496 digit: Types.Int32; 497 BEGIN 498 IF long THEN 499 Write("D"); 500 ELSE 501 Write("E"); 502 END; 503 IF exp < 0 THEN 504 Write("-"); exp := - exp; 505 ELSE 506 Write("+"); 507 END; 508 IF long THEN 509 power := 1000; 510 ELSE 511 power := 100; 512 END; 513 WHILE power > 0 DO 514 digit := (exp DIV power) MOD base; 515 Write(CHR(digit+ORD("0"))); 516 power := power DIV base; 517 END; 518 END WriteExp; 519 520 BEGIN (* Print *) 521 (* leading digits *) 522 IF decpt > 0 THEN 523 needed := decpt; 524 ELSE 525 needed := 1; 526 END; 527 IF neg OR sign THEN 528 INC(needed); 529 END; 530 IF withexp OR (scale # 0) THEN 531 INC(needed); (* decimal point *) 532 END; 533 IF withexp THEN 534 INC(needed, 2); (* E[+-] *) 535 IF long THEN 536 INC(needed, 4); 537 ELSE 538 INC(needed, 3); 539 END; 540 END; 541 INC(needed, scale); 542 543 FillLeft(needed); 544 IF neg THEN 545 Write("-"); 546 ELSIF sign THEN 547 Write("+"); 548 END; 549 IF decpt <= 0 THEN 550 Write("0"); 551 ELSE 552 index := 0; 553 WHILE index < decpt DO 554 IF index < ndigits THEN 555 Write(digits[index]); 556 ELSE 557 Write("0"); 558 END; 559 INC(index); 560 END; 561 END; 562 IF withexp OR (scale > 0) THEN 563 Write("."); 564 END; 565 IF scale > 0 THEN 566 count := scale; 567 index := decpt; 568 WHILE (index < 0) & (count > 0) DO 569 Write("0"); INC(index); DEC(count); 570 END; 571 WHILE (index < ndigits) & (count > 0) DO 572 Write(digits[index]); INC(index); DEC(count); 573 END; 574 WHILE count > 0 DO 575 Write("0"); DEC(count); 576 END; 577 END; 578 IF withexp THEN 579 WriteExp(exp); 580 END; 581 FillRight(needed); 582 END Print; 583 584 BEGIN (* WriteReal *) 585 IF NextArg(index) THEN 586 IF arglen[index] = SIZE(Types.Real64) THEN 587 long := TRUE; 588 Convert(index, lr); 589 ELSIF arglen[index] = SIZE(Types.Real32) THEN 590 long := FALSE; 591 Convert(index, r); 592 lr := r; 593 ELSIF arglen[index] = SIZE(Types.Int32) THEN 594 long := FALSE; 595 Convert(index, longint); 596 lr := longint; 597 ELSIF arglen[index] = SIZE(Types.Int32) THEN 598 long := FALSE; 599 Convert(index, int); 600 lr := int; 601 ELSIF arglen[index] = SIZE(SYS.INT16) THEN 602 long := FALSE; 603 Convert(index, int16); 604 lr := int16; 605 ELSIF arglen[index] = SIZE(Types.Int8) THEN 606 long := FALSE; 607 Convert(index, shortint); 608 lr := shortint; 609 ELSE 610 Error(badArgumentSize); RETURN FALSE 611 END; 612 IF scale = -1 THEN 613 scale := defaultscale; 614 END; 615 (* check for NaNs and other invalid numbers *) 616 IF ~IEEE.Valid(lr) THEN 617 IF IEEE.NotANumber(lr) THEN 618 Write("N"); Write("a"); Write("N"); 619 RETURN TRUE 620 ELSE 621 IF lr < 0 THEN 622 Write("-"); 623 ELSE 624 Write("+"); 625 END; 626 Write("i"); Write("n"); Write("f"); 627 END; 628 RETURN TRUE 629 END; 630 (* real value in `lr' *) 631 Reals.ExpAndMan(lr, long, 10, exponent, mantissa); 632 CASE format OF 633 | "e": ndigits := SHORT(scale)+1; 634 | "f": ndigits := SHORT(scale)+exponent+1; 635 IF ndigits <= 0 THEN 636 ndigits := 1; 637 END; 638 | "g": ndigits := SHORT(scale); 639 ELSE 640 END; 641 Reals.Digits(mantissa, 10, digits, neg, 642 (* force = *) format # "g", ndigits); 643 decpt := 1; 644 CASE format OF 645 | "e": Print(decpt, (* withexp = *) TRUE, exponent); 646 | "f": INC(decpt, exponent); 647 Print(decpt, (* withexp = *) FALSE, 0); 648 | "g": IF (exponent < -4) OR (exponent > scale) THEN 649 scale := ndigits-1; 650 Print(decpt, (* withexp = *) TRUE, exponent); 651 ELSE 652 INC(decpt, exponent); 653 scale := ndigits-1; 654 DEC(scale, exponent); 655 IF scale < 0 THEN 656 scale := 0; 657 END; 658 Print(decpt, (* withexp = *) FALSE, 0); 659 END; 660 ELSE 661 END; 662 RETURN TRUE 663 ELSE 664 RETURN FALSE 665 END; 666 END WriteReal; 667 668 PROCEDURE WriteString() : BOOLEAN; 669 VAR 670 index: Types.Int32; 671 i: Types.Int32; 672 byte: SYS.BYTE; 673 len: Types.Int32; 674 BEGIN 675 IF NextArg(index) THEN 676 len := 0; 677 WHILE (len < arglen[index]) & 678 ((scale = -1) OR (len < scale)) & 679 ((*CHR*)SYS.VAL(CHAR, Access(index, len)) # 0X) DO 680 INC(len); 681 END; 682 FillLeft(len); 683 i := 0; 684 WHILE i < len DO 685 byte := Access(index, i); 686 Write(byte); 687 INC(i); 688 END; 689 FillRight(len); 690 RETURN TRUE 691 END; 692 RETURN FALSE 693 END WriteString; 694 695 BEGIN (* Conversion *) 696 CASE fmtchar OF 697 | "b": RETURN WriteBool("TRUE", "FALSE") 698 | "c": RETURN WriteChar() 699 | "d": RETURN WriteInt(10) 700 | "e", 701 "f", 702 "g": RETURN WriteReal(fmtchar) 703 | "j": RETURN WriteBool("ja", "nein") 704 | "o": RETURN WriteInt(8) 705 | "s": RETURN WriteString() 706 | "x": RETURN WriteInt(16) 707 | "y": RETURN WriteBool("yes", "no") 708 ELSE 709 Error(badFormat); RETURN FALSE 710 END; 711 END Conversion; 712 713 BEGIN 714 IF ~Next() THEN RETURN FALSE END; 715 IF fmtchar = fmtcmd THEN Write(fmtcmd); RETURN TRUE END; 716 RETURN Flags() & Width() & Scale() & Conversion() 717 END Format; 718 719 BEGIN 720 out.count := 0; out.error := FALSE; 721 SetSize; 722 nextarg := 0; 723 fmtindex := 0; 724 WHILE Next() DO 725 IF fmtchar = fmtcmd THEN 726 IF ~Format() THEN 727 RETURN 728 END; 729 ELSIF (fmtchar = "\") & Next() THEN 730 CASE fmtchar OF 731 | "0".."9", "A".."F": 732 IF ~Int(hexcharval, 16) THEN 733 (* Error(s, BadFormat); *) RETURN 734 END; 735 Unget; 736 Write(CHR(hexcharval)); 737 | "b": Write(08X); (* back space *) 738 | "e": Write(1BX); (* escape *) 739 | "f": Write(0CX); (* form feed *) 740 | "n": WriteLn; 741 | "q": Write("'"); 742 | "Q": Write(22X); (* double quote: " *) 743 | "r": Write(0DX); (* carriage return *) 744 | "t": Write(09X); (* horizontal tab *) 745 | "&": Write(07X); (* bell *) 746 ELSE 747 Write(fmtchar); 748 END; 749 ELSE 750 Write(fmtchar); 751 END; 752 END; 753 IF nextarg < nargs THEN 754 Error(tooManyArgs); 755 ELSIF nextarg > nargs THEN 756 Error(tooFewArgs); 757 END; 758 END Out; 759 760 (* === public part ============================================== *) 761 762 PROCEDURE F*(fmt: ARRAY OF CHAR); 763 VAR x: Types.Int32; 764 BEGIN 765 Out(Streams.stdout, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); 766 END F; 767 768 PROCEDURE F1*(fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE); 769 VAR x: Types.Int32; 770 BEGIN 771 Out(Streams.stdout, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL); 772 END F1; 773 774 PROCEDURE F2*(fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE); 775 VAR x: Types.Int32; 776 BEGIN 777 Out(Streams.stdout, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL); 778 END F2; 779 780 PROCEDURE F3*(fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE); 781 VAR x: Types.Int32; 782 BEGIN 783 Out(Streams.stdout, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL); 784 END F3; 785 786 PROCEDURE F4*(fmt: ARRAY OF CHAR; p1, p2, p3, p4: ARRAY OF SYS.BYTE); 787 VAR x: Types.Int32; 788 BEGIN 789 Out(Streams.stdout, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL); 790 END F4; 791 792 PROCEDURE F5*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE); 793 VAR x: Types.Int32; 794 BEGIN 795 Out(Streams.stdout, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL); 796 END F5; 797 798 PROCEDURE F6*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE); 799 VAR x: Types.Int32; 800 BEGIN 801 Out(Streams.stdout, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL); 802 END F6; 803 804 PROCEDURE F7*(fmt: ARRAY OF CHAR; p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE); 805 VAR x: Types.Int32; 806 BEGIN 807 Out(Streams.stdout, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL); 808 END F7; 809 810 PROCEDURE F8*(fmt: ARRAY OF CHAR; 811 p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE); 812 VAR x: Types.Int32; 813 BEGIN 814 Out(Streams.stdout, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL); 815 END F8; 816 817 PROCEDURE F9*(fmt: ARRAY OF CHAR; 818 p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE); 819 BEGIN 820 Out(Streams.stdout, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL); 821 END F9; 822 823 824 PROCEDURE S*(out: Streams.Stream; fmt: ARRAY OF CHAR); 825 VAR x: Types.Int32; 826 BEGIN 827 Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); 828 END S; 829 830 PROCEDURE S1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE); 831 VAR x: Types.Int32; 832 BEGIN 833 Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, NIL); 834 END S1; 835 836 PROCEDURE S2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE); 837 VAR x: Types.Int32; 838 BEGIN 839 Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, NIL); 840 END S2; 841 842 PROCEDURE S3*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2, p3: ARRAY OF SYS.BYTE); 843 VAR x: Types.Int32; 844 BEGIN 845 Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, NIL); 846 END S3; 847 848 PROCEDURE S4*(out: Streams.Stream; fmt: ARRAY OF CHAR; 849 p1, p2, p3, p4: ARRAY OF SYS.BYTE); 850 VAR x: Types.Int32; 851 BEGIN 852 Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, NIL); 853 END S4; 854 855 PROCEDURE S5*(out: Streams.Stream; fmt: ARRAY OF CHAR; 856 p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE); 857 VAR x: Types.Int32; 858 BEGIN 859 Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, NIL); 860 END S5; 861 862 PROCEDURE S6*(out: Streams.Stream; fmt: ARRAY OF CHAR; 863 p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE); 864 VAR x: Types.Int32; 865 BEGIN 866 Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, NIL); 867 END S6; 868 869 PROCEDURE S7*(out: Streams.Stream; fmt: ARRAY OF CHAR; 870 p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE); 871 VAR x: Types.Int32; 872 BEGIN 873 Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, NIL); 874 END S7; 875 876 PROCEDURE S8*(out: Streams.Stream; fmt: ARRAY OF CHAR; 877 p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE); 878 VAR x: Types.Int32; 879 BEGIN 880 Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, NIL); 881 END S8; 882 883 PROCEDURE S9*(out: Streams.Stream; fmt: ARRAY OF CHAR; 884 p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE); 885 BEGIN 886 Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, NIL); 887 END S9; 888 889 890 PROCEDURE SE*(out: Streams.Stream; fmt: ARRAY OF CHAR; 891 errors: RelatedEvents.Object); 892 VAR x: Types.Int32; 893 BEGIN 894 Out(out, fmt, 0, x,x,x,x,x,x,x,x,x, NIL); 895 END SE; 896 897 PROCEDURE SE1*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1: ARRAY OF SYS.BYTE; 898 errors: RelatedEvents.Object); 899 VAR x: Types.Int32; 900 BEGIN 901 Out(out, fmt, 1, p1, x,x,x,x,x,x,x,x, errors); 902 END SE1; 903 904 PROCEDURE SE2*(out: Streams.Stream; fmt: ARRAY OF CHAR; p1, p2: ARRAY OF SYS.BYTE; 905 errors: RelatedEvents.Object); 906 VAR x: Types.Int32; 907 BEGIN 908 Out(out, fmt, 2, p1,p2, x,x,x,x,x,x,x, errors); 909 END SE2; 910 911 PROCEDURE SE3*(out: Streams.Stream; fmt: ARRAY OF CHAR; 912 p1, p2, p3: ARRAY OF SYS.BYTE; 913 errors: RelatedEvents.Object); 914 VAR x: Types.Int32; 915 BEGIN 916 Out(out, fmt, 3, p1,p2,p3, x,x,x,x,x,x, errors); 917 END SE3; 918 919 PROCEDURE SE4*(out: Streams.Stream; fmt: ARRAY OF CHAR; 920 p1, p2, p3, p4: ARRAY OF SYS.BYTE; 921 errors: RelatedEvents.Object); 922 VAR x: Types.Int32; 923 BEGIN 924 Out(out, fmt, 4, p1,p2,p3,p4, x,x,x,x,x, errors); 925 END SE4; 926 927 PROCEDURE SE5*(out: Streams.Stream; fmt: ARRAY OF CHAR; 928 p1, p2, p3, p4, p5: ARRAY OF SYS.BYTE; 929 errors: RelatedEvents.Object); 930 VAR x: Types.Int32; 931 BEGIN 932 Out(out, fmt, 5, p1,p2,p3,p4,p5, x,x,x,x, errors); 933 END SE5; 934 935 PROCEDURE SE6*(out: Streams.Stream; fmt: ARRAY OF CHAR; 936 p1, p2, p3, p4, p5, p6: ARRAY OF SYS.BYTE; 937 errors: RelatedEvents.Object); 938 VAR x: Types.Int32; 939 BEGIN 940 Out(out, fmt, 6, p1,p2,p3,p4,p5,p6, x,x,x, errors); 941 END SE6; 942 943 PROCEDURE SE7*(out: Streams.Stream; fmt: ARRAY OF CHAR; 944 p1, p2, p3, p4, p5, p6, p7: ARRAY OF SYS.BYTE; 945 errors: RelatedEvents.Object); 946 VAR x: Types.Int32; 947 BEGIN 948 Out(out, fmt, 7, p1,p2,p3,p4,p5,p6,p7, x,x, errors); 949 END SE7; 950 951 PROCEDURE SE8*(out: Streams.Stream; fmt: ARRAY OF CHAR; 952 p1, p2, p3, p4, p5, p6, p7, p8: ARRAY OF SYS.BYTE; 953 errors: RelatedEvents.Object); 954 VAR x: Types.Int32; 955 BEGIN 956 Out(out, fmt, 8, p1,p2,p3,p4,p5,p6,p7,p8, x, errors); 957 END SE8; 958 959 PROCEDURE SE9*(out: Streams.Stream; fmt: ARRAY OF CHAR; 960 p1, p2, p3, p4, p5, p6, p7, p8, p9: ARRAY OF SYS.BYTE; 961 errors: RelatedEvents.Object); 962 BEGIN 963 Out(out, fmt, 9, p1,p2,p3,p4,p5,p6,p7,p8,p9, errors); 964 END SE9; 965 966BEGIN 967 InitErrorHandling; 968END ulmPrint. 969