gcc/m2/gm2-libs/RTint.mod

   1 (* RTint.mod provides users of the COROUTINES library with the.
   2
   3 Copyright (C) 2009-2023 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE RTint ;
  28
  29
  30 FROM M2RTS IMPORT Halt ;
  31 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  32 FROM RTco IMPORT select, initSemaphore, wait, signal ;
  33 FROM COROUTINES IMPORT PROTECTION ;
  34 FROM libc IMPORT printf, perror ;
  35 FROM Assertion IMPORT Assert ;
  36
  37 FROM Selective IMPORT InitSet, FdSet, Timeval, InitTime, KillTime, KillSet,
  38                       SetOfFd, FdIsSet, GetTime, FdZero, GetTimeOfDay, SetTime,
  39                       FdClr;
  40
  41 CONST
  42    Microseconds = 1000000 ;
  43    DebugTime    = 0 ;
  44    Debugging    = FALSE ;
  45
  46 TYPE
  47    VectorType = (input, output, time) ;
  48    Vector     = POINTER TO RECORD
  49                               type    : VectorType ;
  50                               priority: CARDINAL ;
  51                               arg     : ADDRESS ;
  52                               pending,
  53                               exists  : Vector ;
  54                               no      : CARDINAL ;
  55                               File    : INTEGER ;
  56                               rel,
  57                               abs     : Timeval ;
  58                               queued  : BOOLEAN ;
  59                            END ;
  60
  61 VAR
  62    VecNo      : CARDINAL ;
  63    Exists     : Vector ;
  64    Pending    : ARRAY [MIN(PROTECTION)..MAX(PROTECTION)] OF Vector ;
  65    lock       : INTEGER ;
  66    initialized: BOOLEAN ;
  67
  68
  69 (*
  70    Max - returns the maximum: i or j.
  71 *)
  72
  73 PROCEDURE Max (i, j: INTEGER) : INTEGER ;
  74 BEGIN
  75    IF i>j
  76    THEN
  77       RETURN i
  78    ELSE
  79       RETURN j
  80    END
  81 END Max ;
  82
  83
  84 (*
  85    Max - returns the minimum: i or j.
  86 *)
  87
  88 PROCEDURE Min (i, j: INTEGER) : INTEGER ;
  89 BEGIN
  90    IF i<j
  91    THEN
  92       RETURN i
  93    ELSE
  94       RETURN j
  95    END
  96 END Min ;
  97
  98
  99 (*
 100    FindVector - searches the exists list for a vector of type, t,
 101                 which is associated with file descriptor, fd.
 102 *)
 103
 104 PROCEDURE FindVector (fd: INTEGER; t: VectorType) : Vector ;
 105 VAR
 106    v: Vector ;
 107 BEGIN
 108    v := Exists ;
 109    WHILE v#NIL DO
 110       IF (v^.type=t) AND (v^.File=fd)
 111       THEN
 112          RETURN v
 113       END ;
 114       v := v^.exists
 115    END ;
 116    RETURN NIL
 117 END FindVector ;
 118
 119
 120 (*
 121    InitInputVector - returns an interrupt vector which is associated
 122                      with the file descriptor, fd.
 123 *)
 124
 125 PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
 126 VAR
 127    v: Vector ;
 128 BEGIN
 129    IF Debugging
 130    THEN
 131       printf("InitInputVector fd = %d priority = %d\n", fd, pri)
 132    END ;
 133    wait (lock) ;
 134    v := FindVector(fd, input) ;
 135    IF v=NIL
 136    THEN
 137       NEW(v) ;
 138       INC(VecNo) ;
 139       WITH v^ DO
 140          type     := input ;
 141          priority := pri ;
 142          arg      := NIL ;
 143          pending  := NIL ;
 144          exists   := Exists ;
 145          no       := VecNo ;
 146          File     := fd
 147       END ;
 148       Exists := v ;
 149       signal (lock) ;
 150       RETURN VecNo
 151    ELSE
 152       signal (lock) ;
 153       RETURN v^.no
 154    END
 155 END InitInputVector ;
 156
 157
 158 (*
 159    InitOutputVector - returns an interrupt vector which is associated
 160                       with the file descriptor, fd.
 161 *)
 162
 163 PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
 164 VAR
 165    v: Vector ;
 166 BEGIN
 167    wait (lock) ;
 168    v := FindVector (fd, output) ;
 169    IF v=NIL
 170    THEN
 171       NEW (v) ;
 172       IF v = NIL
 173       THEN
 174          HALT
 175       ELSE
 176          INC (VecNo) ;
 177          WITH v^ DO
 178             type     := output ;
 179             priority := pri ;
 180             arg      := NIL ;
 181             pending  := NIL ;
 182             exists   := Exists ;
 183             no       := VecNo ;
 184             File     := fd
 185          END ;
 186          Exists := v ;
 187          signal (lock) ;
 188          RETURN VecNo
 189       END
 190    ELSE
 191       signal (lock) ;
 192       RETURN v^.no
 193    END
 194 END InitOutputVector ;
 195
 196
 197 (*
 198    InitTimeVector - returns an interrupt vector associated with
 199                     the relative time.
 200 *)
 201
 202 PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
 203 VAR
 204    v: Vector ;
 205 BEGIN
 206    wait (lock) ;
 207    NEW (v) ;
 208    IF v = NIL
 209    THEN
 210       HALT
 211    ELSE
 212       INC (VecNo) ;
 213       Assert (micro<Microseconds) ;
 214       WITH v^ DO
 215          type     := time ;
 216          priority := pri ;
 217          arg      := NIL ;
 218          pending  := NIL ;
 219          exists   := Exists ;
 220          no       := VecNo ;
 221          rel      := InitTime(secs+DebugTime, micro) ;
 222          abs      := InitTime(0, 0) ;
 223          queued   := FALSE
 224       END ;
 225       Exists := v
 226    END ;
 227    signal (lock) ;
 228    RETURN VecNo
 229 END InitTimeVector ;
 230
 231
 232 (*
 233    FindVectorNo - searches the Exists list for vector, vec.
 234 *)
 235
 236 PROCEDURE FindVectorNo (vec: CARDINAL) : Vector ;
 237 VAR
 238    v: Vector ;
 239 BEGIN
 240    v := Exists ;
 241    WHILE (v#NIL) AND (v^.no#vec) DO
 242       v := v^.exists
 243    END ;
 244    RETURN v
 245 END FindVectorNo ;
 246
 247
 248 (*
 249    FindPendingVector - searches the pending list for vector, vec.
 250 *)
 251
 252 PROCEDURE FindPendingVector (vec: CARDINAL) : Vector ;
 253 VAR
 254    i: CARDINAL ;
 255    v: Vector ;
 256 BEGIN
 257    FOR i := MIN(PROTECTION) TO MAX(PROTECTION) DO
 258       v := Pending[i] ;
 259       WHILE (v#NIL) AND (v^.no#vec) DO
 260          v := v^.pending
 261       END ;
 262       IF (v#NIL) AND (v^.no=vec)
 263       THEN
 264          RETURN v
 265       END
 266    END ;
 267    RETURN NIL
 268 END FindPendingVector ;
 269
 270
 271 (*
 272    ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
 273                      at the new relative time.
 274 *)
 275
 276 PROCEDURE ReArmTimeVector (vec: CARDINAL;
 277                            micro, secs: CARDINAL) ;
 278 VAR
 279    v: Vector ;
 280 BEGIN
 281    Assert(micro<Microseconds) ;
 282    wait (lock) ;
 283    v := FindVectorNo(vec) ;
 284    IF v=NIL
 285    THEN
 286       Halt(__FILE__, __LINE__, __FUNCTION__,
 287            'cannot find vector supplied')
 288    ELSE
 289       WITH v^ DO
 290          SetTime (rel, secs + DebugTime, micro)
 291       END
 292    END ;
 293    signal (lock)
 294 END ReArmTimeVector ;
 295
 296
 297 (*
 298    GetTimeVector - assigns, micro, and, secs, with the remaining
 299                    time before this interrupt will expire.
 300                    This value is only updated when a Listen
 301                    occurs.
 302 *)
 303
 304 PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
 305 VAR
 306    v: Vector ;
 307 BEGIN
 308    wait (lock) ;
 309    v := FindVectorNo (vec) ;
 310    IF v=NIL
 311    THEN
 312       Halt(__FILE__, __LINE__, __FUNCTION__,
 313            'cannot find vector supplied')
 314    ELSE
 315       WITH v^ DO
 316          GetTime (rel, secs, micro) ;
 317          Assert (micro < Microseconds)
 318       END
 319    END ;
 320    signal (lock)
 321 END GetTimeVector ;
 322
 323
 324 (*
 325    AttachVector - adds the pointer, p, to be associated with the interrupt
 326                   vector. It returns the previous value attached to this
 327                   vector.
 328 *)
 329
 330 PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
 331 VAR
 332    v: Vector ;
 333    l: ADDRESS ;
 334 BEGIN
 335    wait (lock) ;
 336    v := FindVectorNo (vec) ;
 337    IF v=NIL
 338    THEN
 339       Halt (__FILE__, __LINE__, __FUNCTION__, 'cannot find vector supplied')
 340    ELSE
 341       l := v^.arg ;
 342       v^.arg := p ;
 343       IF Debugging
 344       THEN
 345          printf ("AttachVector %d with 0x%x\n", vec, p);
 346          DumpPendingQueue ;
 347       END ;
 348       signal (lock) ;
 349       RETURN l
 350    END
 351 END AttachVector ;
 352
 353
 354 (*
 355    IncludeVector - includes, vec, into the dispatcher list of
 356                    possible interrupt causes.
 357 *)
 358
 359 PROCEDURE IncludeVector (vec: CARDINAL) ;
 360 VAR
 361    v   : Vector ;
 362    m, s: CARDINAL ;
 363    r   : INTEGER ;
 364 BEGIN
 365    wait (lock) ;
 366    v := FindPendingVector (vec) ;
 367    IF v=NIL
 368    THEN
 369       v := FindVectorNo (vec) ;
 370       IF v = NIL
 371       THEN
 372          Halt (__FILE__, __LINE__, __FUNCTION__,
 373                'cannot find vector supplied') ;
 374       ELSE
 375          (* printf('including vector %d  (fd = %d)\n', vec, v^.File) ; *)
 376          v^.pending := Pending[v^.priority] ;
 377          Pending[v^.priority] := v ;
 378          IF (v^.type = time) AND (NOT v^.queued)
 379          THEN
 380             v^.queued := TRUE ;
 381             r := GetTimeOfDay (v^.abs) ;
 382             Assert (r=0) ;
 383             GetTime (v^.abs, s, m) ;
 384             Assert (m<Microseconds) ;
 385             AddTime (v^.abs, v^.rel) ;
 386             GetTime (v^.abs, s, m) ;
 387             Assert (m<Microseconds)
 388          END
 389       END
 390    ELSE
 391       IF Debugging
 392       THEN
 393          printf ('odd vector (%d) type (%d) arg (0x%x) is already attached to the pending queue\n',
 394                  vec, v^.type, v^.arg)
 395       END ;
 396       stop
 397    END ;
 398    signal (lock)
 399 END IncludeVector ;
 400
 401
 402 (*
 403    ExcludeVector - excludes, vec, from the dispatcher list of
 404                    possible interrupt causes.
 405 *)
 406
 407 PROCEDURE ExcludeVector (vec: CARDINAL) ;
 408 VAR
 409    v, u: Vector ;
 410 BEGIN
 411    wait (lock) ;
 412    v := FindPendingVector(vec) ;
 413    IF v=NIL
 414    THEN
 415       Halt (__FILE__, __LINE__, __FUNCTION__,
 416             'cannot find pending vector supplied')
 417    ELSE
 418       (* printf('excluding vector %d\n', vec) ; *)
 419       IF Pending[v^.priority]=v
 420       THEN
 421          Pending[v^.priority] := Pending[v^.priority]^.pending
 422       ELSE
 423          u := Pending[v^.priority] ;
 424          WHILE u^.pending#v DO
 425             u := u^.pending
 426          END ;
 427          u^.pending := v^.pending
 428       END ;
 429       IF v^.type=time
 430       THEN
 431          v^.queued := FALSE
 432       END
 433    END ;
 434    signal (lock)
 435 END ExcludeVector ;
 436
 437
 438 (*
 439    AddFd - adds the file descriptor, fd, to set, s, updating, max.
 440 *)
 441
 442 PROCEDURE AddFd (VAR s: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
 443 BEGIN
 444    max := Max (fd, max) ;
 445    IF s = NIL
 446    THEN
 447       s := InitSet () ;
 448       FdZero (s)
 449    END ;
 450    FdSet (fd, s)
 451    (* printf('%d, ', fd) *)
 452 END AddFd ;
 453
 454
 455 (*
 456    DumpPendingQueue - displays the pending queue.
 457 *)
 458
 459 PROCEDURE DumpPendingQueue ;
 460 VAR
 461    p   : PROTECTION ;
 462    v   : Vector ;
 463    s, m: CARDINAL ;
 464 BEGIN
 465    printf ("Pending queue\n");
 466    FOR p := MIN (PROTECTION) TO MAX (PROTECTION) DO
 467       printf ("[%d]  ", p);
 468       v := Pending[p] ;
 469       WHILE v#NIL DO
 470          IF (v^.type=input) OR (v^.type=output)
 471          THEN
 472             printf ("(fd=%d) (vec=%d)", v^.File, v^.no)
 473          ELSIF v^.type=time
 474          THEN
 475             GetTime(v^.rel, s, m) ;
 476             Assert (m<Microseconds) ;
 477             printf ("time (%u.%06u secs) (arg = 0x%x)\n", s, m, v^.arg)
 478          END ;
 479          v := v^.pending
 480       END ;
 481       printf (" \n")
 482    END
 483 END DumpPendingQueue ;
 484
 485
 486 PROCEDURE stop ;
 487 BEGIN
 488 END stop ;
 489
 490
 491 (*
 492    AddTime - t1 := t1 + t2
 493 *)
 494
 495 PROCEDURE AddTime (t1, t2: Timeval) ;
 496 VAR
 497    a, b, s, m: CARDINAL ;
 498 BEGIN
 499    GetTime (t1, s, m) ;
 500    Assert (m < Microseconds) ;
 501    GetTime (t2, a, b) ;
 502    Assert (b < Microseconds) ;
 503    INC (a, s) ;
 504    INC (b, m) ;
 505    IF b >= Microseconds
 506    THEN
 507       DEC (b, Microseconds) ;
 508       INC (a)
 509    END ;
 510    SetTime (t1, a, b)
 511 END AddTime ;
 512
 513
 514 (*
 515    IsGreaterEqual - returns TRUE if, a>=b
 516 *)
 517
 518 PROCEDURE IsGreaterEqual (a, b: Timeval) : BOOLEAN ;
 519 VAR
 520    as, am, bs, bm: CARDINAL ;
 521 BEGIN
 522    GetTime (a, as, am) ;
 523    Assert (am < Microseconds) ;
 524    GetTime (b, bs, bm) ;
 525    Assert (bm < Microseconds) ;
 526    RETURN (as > bs) OR ((as = bs) AND (am >= bm))
 527 END IsGreaterEqual ;
 528
 529
 530 (*
 531    SubTime - assigns, s and m, to a - b.
 532 *)
 533
 534 PROCEDURE SubTime (VAR s, m: CARDINAL; a, b: Timeval) ;
 535 VAR
 536    as, am,
 537    bs, bm: CARDINAL ;
 538 BEGIN
 539    GetTime (a, as, am) ;
 540    Assert (am < Microseconds) ;
 541    GetTime (b, bs, bm) ;
 542    Assert (bm < Microseconds) ;
 543    IF IsGreaterEqual (a, b)
 544    THEN
 545       s := as - bs ;
 546       IF am >= bm
 547       THEN
 548          m := am - bm ;
 549          Assert (m < Microseconds) ;
 550       ELSE
 551          Assert (s > 0) ;
 552          DEC (s) ;
 553          m := (Microseconds + am) - bm ;
 554          Assert (m < Microseconds)
 555       END
 556    ELSE
 557       s := 0 ;
 558       m := 0
 559    END
 560 END SubTime ;
 561
 562
 563 (*
 564    activatePending - activates the first interrupt pending and clears it.
 565 *)
 566
 567 PROCEDURE activatePending (untilInterrupt: BOOLEAN; call: DispatchVector; pri: CARDINAL;
 568                            maxFd: INTEGER; VAR i, o: SetOfFd; VAR t: Timeval; b4, after: Timeval) : BOOLEAN ;
 569 VAR
 570    r   : INTEGER ;
 571    p   : CARDINAL ;
 572    v   : Vector ;
 573    b4s,
 574    b4m,
 575    afs,
 576    afm,
 577    s, m: CARDINAL ;
 578 BEGIN
 579    wait (lock) ;
 580    p := MAX (PROTECTION) ;
 581    WHILE p > pri DO
 582       v := Pending[p] ;
 583       WHILE v # NIL DO
 584          WITH v^ DO
 585             CASE type OF
 586
 587             input :  IF (File < maxFd) AND (i # NIL) AND FdIsSet (File, i)
 588                      THEN
 589                         IF Debugging
 590                         THEN
 591                            printf ('read (fd=%d) is ready (vec=%d)\n', File, no) ;
 592                            DumpPendingQueue
 593                         END ;
 594                         FdClr (File, i) ;  (* so we dont activate this again from our select.  *)
 595                         signal (lock) ;
 596                         call (no, priority, arg) ;
 597                         RETURN TRUE
 598                      END |
 599             output:  IF (File < maxFd) AND (o#NIL) AND FdIsSet (File, o)
 600                      THEN
 601                         IF Debugging
 602                         THEN
 603                            printf ('write (fd=%d) is ready (vec=%d)\n', File, no) ;
 604                            DumpPendingQueue
 605                         END ;
 606                         FdClr (File, o) ;  (* so we dont activate this again from our select.  *)
 607                         signal (lock) ;
 608                         call (no, priority, arg) ;
 609                         RETURN TRUE
 610                      END |
 611             time  :  IF untilInterrupt AND (t # NIL)
 612                      THEN
 613                         r := GetTimeOfDay (after) ;
 614                         Assert (r=0) ;
 615                         IF Debugging
 616                         THEN
 617                            GetTime (t, s, m) ;
 618                            Assert (m < Microseconds) ;
 619                            GetTime (after, afs, afm) ;
 620                            Assert (afm < Microseconds) ;
 621                            GetTime (b4, b4s, b4m) ;
 622                            Assert (b4m < Microseconds) ;
 623                            printf ("waited %u.%06u + %u.%06u now is %u.%06u\n",
 624                                    s, m, b4s, b4m, afs, afm) ;
 625                         END ;
 626                         IF IsGreaterEqual (after, abs)
 627                         THEN
 628                            IF Debugging
 629                            THEN
 630                               DumpPendingQueue ;
 631                               printf ("time has expired calling dispatcher\n")
 632                            END ;
 633                            t := KillTime (t) ;  (* so we dont activate this again from our select.  *)
 634                            signal (lock) ;
 635                            IF Debugging
 636                            THEN
 637                               printf ("call (%d, %d, 0x%x)\n", no, priority, arg)
 638                            END ;
 639                            call (no, priority, arg) ;
 640                            RETURN TRUE
 641                         ELSIF Debugging
 642                         THEN
 643                            printf ("must wait longer as time has not expired\n")
 644                         END
 645                      END
 646             END
 647          END ;
 648          v := v^.pending
 649       END ;
 650       DEC (p)
 651    END ;
 652    signal (lock) ;
 653    RETURN FALSE
 654 END activatePending ;
 655
 656
 657 (*
 658    Listen - will either block indefinitely (until an interrupt)
 659             or alteratively will test to see whether any interrupts
 660             are pending.
 661             If a pending interrupt was found then, call, is called
 662             and then this procedure returns.
 663             It only listens for interrupts > pri.
 664 *)
 665
 666 PROCEDURE Listen (untilInterrupt: BOOLEAN;
 667                   call: DispatchVector;
 668                   pri: CARDINAL) ;
 669 VAR
 670    found: BOOLEAN ;
 671    r    : INTEGER ;
 672    after,
 673    b4,
 674    t    : Timeval ;
 675    v    : Vector ;
 676    i, o : SetOfFd ;
 677    b4s,
 678    b4m,
 679    afs,
 680    afm,
 681    s, m : CARDINAL ;
 682    maxFd: INTEGER ;
 683    p    : CARDINAL ;
 684 BEGIN
 685    wait (lock) ;
 686    IF pri < MAX (PROTECTION)
 687    THEN
 688       IF Debugging
 689       THEN
 690          DumpPendingQueue
 691       END ;
 692       maxFd := -1 ;
 693       t := NIL ;
 694       i := NIL ;
 695       o := NIL ;
 696       t := InitTime (MAX (INTEGER), 0) ;
 697       p := MAX (PROTECTION) ;
 698       found := FALSE ;
 699       WHILE p>pri DO
 700          v := Pending[p] ;
 701          WHILE v#NIL DO
 702             WITH v^ DO
 703                CASE type OF
 704
 705                input :  AddFd (i, maxFd, File) |
 706                output:  AddFd (o, maxFd, File) |
 707                time  :  IF IsGreaterEqual (t, abs)
 708                         THEN
 709                            GetTime (abs, s, m) ;
 710                            Assert (m<Microseconds) ;
 711                            IF Debugging
 712                            THEN
 713                               printf ("shortest delay is %u.%06u\n", s, m)
 714                            END ;
 715                            SetTime (t, s, m) ;
 716                            found := TRUE
 717                         END
 718
 719                END
 720             END ;
 721             v := v^.pending
 722          END ;
 723          DEC (p)
 724       END ;
 725       IF NOT untilInterrupt
 726       THEN
 727          SetTime (t, 0, 0)
 728       END ;
 729       IF untilInterrupt AND (i=NIL) AND (o=NIL) AND (NOT found)
 730       THEN
 731          Halt (__FILE__, __LINE__, __FUNCTION__,
 732                'deadlock found, no more processes to run and no interrupts active')
 733       END ;
 734       (* printf('timeval = 0x%x\n', t) ; *)
 735       (* printf('}\n') ; *)
 736       IF (NOT found) AND (maxFd=-1) AND (i=NIL) AND (o=NIL)
 737       THEN
 738          (* no file descriptors to be selected upon.  *)
 739          t := KillTime (t) ;
 740          signal (lock) ;
 741          RETURN
 742       ELSE
 743          GetTime (t, s, m) ;
 744          Assert (m<Microseconds) ;
 745          b4 := InitTime (0, 0) ;
 746          after := InitTime (0, 0) ;
 747          r := GetTimeOfDay (b4) ;
 748          Assert (r=0) ;
 749          SubTime (s, m, t, b4) ;
 750          SetTime (t, s, m) ;
 751          IF Debugging
 752          THEN
 753             printf ("select waiting for %u.%06u seconds\n", s, m)
 754          END ;
 755          signal (lock) ;
 756          REPEAT
 757             IF Debugging
 758             THEN
 759                printf ("select (.., .., .., %u.%06u)\n", s, m)
 760             END ;
 761             r := select (maxFd+1, i, o, NIL, t) ;
 762             IF r=-1
 763             THEN
 764                perror ("select") ;
 765                r := select (maxFd+1, i, o, NIL, NIL) ;
 766                IF r=-1
 767                THEN
 768                   perror ("select timeout argument is faulty")
 769                END ;
 770                r := select (maxFd+1, i, NIL, NIL, t) ;
 771                IF r=-1
 772                THEN
 773                   perror ("select output fd argument is faulty")
 774                END ;
 775                r := select (maxFd+1, NIL, o, NIL, t) ;
 776                IF r=-1
 777                THEN
 778                   perror ("select input fd argument is faulty")
 779                ELSE
 780                   perror ("select maxFD+1 argument is faulty")
 781                END
 782             END
 783          UNTIL r#-1
 784       END ;
 785       WHILE activatePending (untilInterrupt, call, pri,
 786                              maxFd+1, i, o, t, b4, after) DO
 787       END ;
 788       IF t#NIL
 789       THEN
 790          t := KillTime (t)
 791       END ;
 792       IF after#NIL
 793       THEN
 794          t := KillTime (after)
 795       END ;
 796       IF b4#NIL
 797       THEN
 798          t := KillTime (b4)
 799       END ;
 800       IF i#NIL
 801       THEN
 802          i := KillSet (i)
 803       END ;
 804       IF o#NIL
 805       THEN
 806          o := KillSet (o)
 807       END
 808    END ;
 809    signal (lock)
 810 END Listen ;
 811
 812
 813 (*
 814    init -
 815 *)
 816
 817 PROCEDURE init ;
 818 VAR
 819    p: PROTECTION ;
 820 BEGIN
 821    lock := initSemaphore (1) ;
 822    wait (lock) ;
 823    Exists := NIL ;
 824    FOR p := MIN(PROTECTION) TO MAX(PROTECTION) DO
 825       Pending[p] := NIL
 826    END ;
 827    initialized := TRUE ;
 828    signal (lock)
 829 END init ;
 830
 831
 832 (*
 833    Init -
 834 *)
 835
 836 PROCEDURE Init ;
 837 BEGIN
 838    IF NOT initialized
 839    THEN
 840       init
 841    END
 842 END Init ;
 843
 844
 845 BEGIN
 846    Init
 847 END RTint.