gcc/m2/gm2-libs/RTint.mod

   1 (* RTint.mod provides users of the COROUTINES library with the.
   2
   3 Copyright (C) 2009-2024 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
 101                 which is associated with file descriptor, fd.
 102 *)
 103
 104 PROCEDURE FindVector (fd: INTEGER; type: VectorType) : Vector ;
 105 VAR
 106    vec: Vector ;
 107 BEGIN
 108    vec := Exists ;
 109    WHILE vec#NIL DO
 110       IF (vec^.type=type) AND (vec^.File=fd)
 111       THEN
 112          RETURN vec
 113       END ;
 114       vec := vec^.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    vptr: Vector ;
 128 BEGIN
 129    IF Debugging
 130    THEN
 131       printf("InitInputVector fd = %d priority = %d\n", fd, pri)
 132    END ;
 133    wait (lock) ;
 134    vptr := FindVector(fd, input) ;
 135    IF vptr = NIL
 136    THEN
 137       NEW (vptr) ;
 138       INC (VecNo) ;
 139       WITH vptr^ 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 := vptr ;
 149       signal (lock) ;
 150       RETURN VecNo
 151    ELSE
 152       signal (lock) ;
 153       RETURN vptr^.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    vptr: Vector ;
 166 BEGIN
 167    wait (lock) ;
 168    vptr := FindVector (fd, output) ;
 169    IF vptr = NIL
 170    THEN
 171       NEW (vptr) ;
 172       IF vptr = NIL
 173       THEN
 174          HALT
 175       ELSE
 176          INC (VecNo) ;
 177          WITH vptr^ 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 := vptr ;
 187          signal (lock) ;
 188          RETURN VecNo
 189       END
 190    ELSE
 191       signal (lock) ;
 192       RETURN vptr^.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    vptr: Vector ;
 205 BEGIN
 206    wait (lock) ;
 207    NEW (vptr) ;
 208    IF vptr = NIL
 209    THEN
 210       HALT
 211    ELSE
 212       INC (VecNo) ;
 213       Assert (micro<Microseconds) ;
 214       WITH vptr^ 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 := vptr
 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    vptr: Vector ;
 239 BEGIN
 240    vptr := Exists ;
 241    WHILE (vptr#NIL) AND (vptr^.no#vec) DO
 242       vptr := vptr^.exists
 243    END ;
 244    RETURN vptr
 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    pri : CARDINAL ;
 255    vptr: Vector ;
 256 BEGIN
 257    FOR pri := MIN(PROTECTION) TO MAX(PROTECTION) DO
 258       vptr := Pending[pri] ;
 259       WHILE (vptr#NIL) AND (vptr^.no#vec) DO
 260          vptr := vptr^.pending
 261       END ;
 262       IF (vptr#NIL) AND (vptr^.no=vec)
 263       THEN
 264          RETURN vptr
 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    vptr: Vector ;
 280 BEGIN
 281    Assert (micro<Microseconds) ;
 282    wait (lock) ;
 283    vptr := FindVectorNo (vec) ;
 284    IF vptr = NIL
 285    THEN
 286       Halt ('cannot find vector supplied',
 287             __FILE__, __FUNCTION__, __LINE__)
 288    ELSE
 289       WITH vptr^ 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    vptr: Vector ;
 307 BEGIN
 308    wait (lock) ;
 309    vptr := FindVectorNo (vec) ;
 310    IF vptr=NIL
 311    THEN
 312       Halt ('cannot find vector supplied',
 313             __FILE__, __FUNCTION__, __LINE__)
 314    ELSE
 315       WITH vptr^ 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 ptr 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; ptr: ADDRESS) : ADDRESS ;
 331 VAR
 332    vptr   : Vector ;
 333    prevArg: ADDRESS ;
 334 BEGIN
 335    wait (lock) ;
 336    vptr := FindVectorNo (vec) ;
 337    IF vptr = NIL
 338    THEN
 339       Halt ( 'cannot find vector supplied',
 340             __FILE__, __FUNCTION__, __LINE__)
 341    ELSE
 342       prevArg := vptr^.arg ;
 343       vptr^.arg := ptr ;
 344       IF Debugging
 345       THEN
 346          printf ("AttachVector %d with %p\n", vec, ptr);
 347          DumpPendingQueue ;
 348       END ;
 349       signal (lock) ;
 350       RETURN prevArg
 351    END
 352 END AttachVector ;
 353
 354
 355 (*
 356    IncludeVector - includes, vec, into the dispatcher list of
 357                    possible interrupt causes.
 358 *)
 359
 360 PROCEDURE IncludeVector (vec: CARDINAL) ;
 361 VAR
 362    vptr      : Vector ;
 363    micro, sec: CARDINAL ;
 364    result    : INTEGER ;
 365 BEGIN
 366    wait (lock) ;
 367    vptr := FindPendingVector (vec) ;
 368    IF vptr = NIL
 369    THEN
 370       vptr := FindVectorNo (vec) ;
 371       IF vptr = NIL
 372       THEN
 373          Halt ('cannot find vector supplied',
 374                __FILE__, __FUNCTION__, __LINE__)
 375       ELSE
 376          (* printf('including vector %d  (fd = %d)\n', vec, v^.File) ; *)
 377          vptr^.pending := Pending[vptr^.priority] ;
 378          Pending[vptr^.priority] := vptr ;
 379          IF (vptr^.type = time) AND (NOT vptr^.queued)
 380          THEN
 381             vptr^.queued := TRUE ;
 382             result := GetTimeOfDay (vptr^.abs) ;
 383             Assert (result=0) ;
 384             GetTime (vptr^.abs, sec, micro) ;
 385             Assert (micro<Microseconds) ;
 386             AddTime (vptr^.abs, vptr^.rel) ;
 387             GetTime (vptr^.abs, sec, micro) ;
 388             Assert (micro<Microseconds)
 389          END
 390       END
 391    ELSE
 392       IF Debugging
 393       THEN
 394          printf ('odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\n',
 395                  vec, vptr^.type, vptr^.arg)
 396       END
 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    vptr, uptr: Vector ;
 410 BEGIN
 411    wait (lock) ;
 412    vptr := FindPendingVector (vec) ;
 413    IF vptr = NIL
 414    THEN
 415       Halt ('cannot find pending vector supplied',
 416             __FILE__, __FUNCTION__, __LINE__)
 417    ELSE
 418       (* printf('excluding vector %d\n', vec) ; *)
 419       IF Pending[vptr^.priority] = vptr
 420       THEN
 421          Pending[vptr^.priority] := Pending[vptr^.priority]^.pending
 422       ELSE
 423          uptr := Pending[vptr^.priority] ;
 424          WHILE uptr^.pending#vptr DO
 425             uptr := uptr^.pending
 426          END ;
 427          uptr^.pending := vptr^.pending
 428       END ;
 429       IF vptr^.type=time
 430       THEN
 431          vptr^.queued := FALSE
 432       END
 433    END ;
 434    signal (lock)
 435 END ExcludeVector ;
 436
 437
 438 (*
 439    AddFd - adds the file descriptor fd to set updating max.
 440 *)
 441
 442 PROCEDURE AddFd (VAR set: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
 443 BEGIN
 444    IF (fd<0)
 445    THEN
 446       RETURN
 447    END ;
 448    max := Max (fd, max) ;
 449    IF set = NIL
 450    THEN
 451       set := InitSet () ;
 452       FdZero (set)
 453    END ;
 454    FdSet (fd, set)
 455    (* printf('%d, ', fd) *)
 456 END AddFd ;
 457
 458
 459 (*
 460    DumpPendingQueue - displays the pending queue.
 461 *)
 462
 463 PROCEDURE DumpPendingQueue ;
 464 VAR
 465    pri  : PROTECTION ;
 466    vptr : Vector ;
 467    sec,
 468    micro: CARDINAL ;
 469 BEGIN
 470    printf ("Pending queue\n");
 471    FOR pri := MIN (PROTECTION) TO MAX (PROTECTION) DO
 472       printf ("[%d]  ", pri);
 473       vptr := Pending[pri] ;
 474       WHILE vptr # NIL DO
 475          IF (vptr^.type=input) OR (vptr^.type=output)
 476          THEN
 477             printf ("(fd=%d) (vec=%d)", vptr^.File, vptr^.no)
 478          ELSIF vptr^.type=time
 479          THEN
 480             GetTime (vptr^.rel, sec, micro) ;
 481             Assert (micro < Microseconds) ;
 482             printf ("time (%u.%06u secs) (arg = %p)\n",
 483                     sec, micro, vptr^.arg)
 484          END ;
 485          vptr := vptr^.pending
 486       END ;
 487       printf (" \n")
 488    END
 489 END DumpPendingQueue ;
 490
 491
 492 (*
 493    AddTime - t1 := t1 + t2
 494 *)
 495
 496 PROCEDURE AddTime (t1, t2: Timeval) ;
 497 VAR
 498    a, b, s, m: CARDINAL ;
 499 BEGIN
 500    GetTime (t1, s, m) ;
 501    Assert (m < Microseconds) ;
 502    GetTime (t2, a, b) ;
 503    Assert (b < Microseconds) ;
 504    INC (a, s) ;
 505    INC (b, m) ;
 506    IF b >= Microseconds
 507    THEN
 508       DEC (b, Microseconds) ;
 509       INC (a)
 510    END ;
 511    SetTime (t1, a, b)
 512 END AddTime ;
 513
 514
 515 (*
 516    IsGreaterEqual - returns TRUE if, a>=b
 517 *)
 518
 519 PROCEDURE IsGreaterEqual (a, b: Timeval) : BOOLEAN ;
 520 VAR
 521    as, am, bs, bm: CARDINAL ;
 522 BEGIN
 523    GetTime (a, as, am) ;
 524    Assert (am < Microseconds) ;
 525    GetTime (b, bs, bm) ;
 526    Assert (bm < Microseconds) ;
 527    RETURN (as > bs) OR ((as = bs) AND (am >= bm))
 528 END IsGreaterEqual ;
 529
 530
 531 (*
 532    SubTime - assigns, s and m, to a - b.
 533 *)
 534
 535 PROCEDURE SubTime (VAR s, m: CARDINAL; a, b: Timeval) ;
 536 VAR
 537    as, am,
 538    bs, bm: CARDINAL ;
 539 BEGIN
 540    GetTime (a, as, am) ;
 541    Assert (am < Microseconds) ;
 542    GetTime (b, bs, bm) ;
 543    Assert (bm < Microseconds) ;
 544    IF IsGreaterEqual (a, b)
 545    THEN
 546       s := as - bs ;
 547       IF am >= bm
 548       THEN
 549          m := am - bm ;
 550          Assert (m < Microseconds) ;
 551       ELSE
 552          Assert (s > 0) ;
 553          DEC (s) ;
 554          m := (Microseconds + am) - bm ;
 555          Assert (m < Microseconds)
 556       END
 557    ELSE
 558       s := 0 ;
 559       m := 0
 560    END
 561 END SubTime ;
 562
 563
 564 (*
 565    activatePending - activates the first interrupt pending and clears it.
 566 *)
 567
 568 PROCEDURE activatePending (untilInterrupt: BOOLEAN; call: DispatchVector; pri: CARDINAL;
 569                            maxFd: INTEGER; VAR inSet, outSet: SetOfFd; VAR timeval: Timeval; b4, after: Timeval) : BOOLEAN ;
 570 VAR
 571    result: INTEGER ;
 572    p     : CARDINAL ;
 573    vec   : Vector ;
 574    b4s,
 575    b4m,
 576    afs,
 577    afm,
 578    sec,
 579    micro : CARDINAL ;
 580 BEGIN
 581    wait (lock) ;
 582    p := MAX (PROTECTION) ;
 583    WHILE p > pri DO
 584       vec := Pending[p] ;
 585       WHILE vec # NIL DO
 586          WITH vec^ DO
 587             CASE type OF
 588
 589             input :  IF (File < maxFd) AND (inSet # NIL) AND FdIsSet (File, inSet)
 590                      THEN
 591                         IF Debugging
 592                         THEN
 593                            printf ('read (fd=%d) is ready (vec=%d)\n', File, no) ;
 594                            DumpPendingQueue
 595                         END ;
 596                         FdClr (File, inSet) ;  (* so we dont activate this again from our select.  *)
 597                         signal (lock) ;
 598                         call (no, priority, arg) ;
 599                         RETURN TRUE
 600                      END |
 601             output:  IF (File < maxFd) AND (outSet#NIL) AND FdIsSet (File, outSet)
 602                      THEN
 603                         IF Debugging
 604                         THEN
 605                            printf ('write (fd=%d) is ready (vec=%d)\n', File, no) ;
 606                            DumpPendingQueue
 607                         END ;
 608                         FdClr (File, outSet) ;  (* so we dont activate this again from our select.  *)
 609                         signal (lock) ;
 610                         call (no, priority, arg) ;
 611                         RETURN TRUE
 612                      END |
 613             time  :  IF untilInterrupt AND (timeval # NIL)
 614                      THEN
 615                         result := GetTimeOfDay (after) ;
 616                         Assert (result=0) ;
 617                         IF Debugging
 618                         THEN
 619                            GetTime (timeval, sec, micro) ;
 620                            Assert (micro < Microseconds) ;
 621                            GetTime (after, afs, afm) ;
 622                            Assert (afm < Microseconds) ;
 623                            GetTime (b4, b4s, b4m) ;
 624                            Assert (b4m < Microseconds) ;
 625                            printf ("waited %u.%06u + %u.%06u now is %u.%06u\n",
 626                                    sec, micro, b4s, b4m, afs, afm) ;
 627                         END ;
 628                         IF IsGreaterEqual (after, abs)
 629                         THEN
 630                            IF Debugging
 631                            THEN
 632                               DumpPendingQueue ;
 633                               printf ("time has expired calling dispatcher\n")
 634                            END ;
 635                            timeval := KillTime (timeval) ;  (* so we dont activate this again from our select.  *)
 636                            signal (lock) ;
 637                            IF Debugging
 638                            THEN
 639                               printf ("call (%d, %d, 0x%x)\n", no, priority, arg)
 640                            END ;
 641                            call (no, priority, arg) ;
 642                            RETURN TRUE
 643                         ELSIF Debugging
 644                         THEN
 645                            printf ("must wait longer as time has not expired\n")
 646                         END
 647                      END
 648             END
 649          END ;
 650          vec := vec^.pending
 651       END ;
 652       DEC (p)
 653    END ;
 654    signal (lock) ;
 655    RETURN FALSE
 656 END activatePending ;
 657
 658
 659 (*
 660    Listen - will either block indefinitely (until an interrupt)
 661             or alteratively will test to see whether any interrupts
 662             are pending.
 663             If a pending interrupt was found then, call, is called
 664             and then this procedure returns.
 665             It only listens for interrupts > pri.
 666 *)
 667
 668 PROCEDURE Listen (untilInterrupt: BOOLEAN;
 669                   call: DispatchVector;
 670                   pri: CARDINAL) ;
 671 VAR
 672    found  : BOOLEAN ;
 673    result : INTEGER ;
 674    zero,
 675    after,
 676    b4,
 677    timeval: Timeval ;
 678    vec    : Vector ;
 679    inSet,
 680    outSet : SetOfFd ;
 681    sec,
 682    micro  : CARDINAL ;
 683    maxFd  : INTEGER ;
 684    p      : CARDINAL ;
 685 BEGIN
 686    wait (lock) ;
 687    IF pri < MAX (PROTECTION)
 688    THEN
 689       IF Debugging
 690       THEN
 691          DumpPendingQueue
 692       END ;
 693       maxFd := -1 ;
 694       timeval := NIL ;
 695       inSet := NIL ;
 696       outSet := NIL ;
 697       timeval := InitTime (MAX (INTEGER), 0) ;
 698       p := MAX (PROTECTION) ;
 699       found := FALSE ;
 700       WHILE p>pri DO
 701          vec := Pending[p] ;
 702          WHILE vec#NIL DO
 703             WITH vec^ DO
 704                CASE type OF
 705
 706                input :  AddFd (inSet, maxFd, File) |
 707                output:  AddFd (outSet, maxFd, File) |
 708                time  :  IF IsGreaterEqual (timeval, abs)
 709                         THEN
 710                            GetTime (abs, sec, micro) ;
 711                            Assert (micro < Microseconds) ;
 712                            IF Debugging
 713                            THEN
 714                               printf ("shortest delay is %u.%06u\n", sec, micro)
 715                            END ;
 716                            SetTime (timeval, sec, micro) ;
 717                            found := TRUE
 718                         END
 719
 720                END
 721             END ;
 722             vec := vec^.pending
 723          END ;
 724          DEC (p)
 725       END ;
 726       IF NOT untilInterrupt
 727       THEN
 728          SetTime (timeval, 0, 0)
 729       END ;
 730       IF untilInterrupt AND (((inSet=NIL) AND (outSet=NIL)) OR (maxFd=-1)) AND (NOT found)
 731       THEN
 732          Halt ('deadlock found, no more processes to run and no interrupts active',
 733                __FILE__, __FUNCTION__, __LINE__)
 734       END ;
 735       (* printf('timeval = 0x%x\n', timeval) ; *)
 736       (* printf('}\n') ; *)
 737       IF (NOT found) AND (maxFd=-1)
 738       THEN
 739          (* no file descriptors to be selected upon.  *)
 740          timeval := KillTime (timeval) ;
 741          signal (lock) ;
 742          RETURN
 743       ELSE
 744          GetTime (timeval, sec, micro) ;
 745          Assert (micro < Microseconds) ;
 746          zero := InitTime (0, 0) ;
 747          b4 := InitTime (0, 0) ;
 748          after := InitTime (0, 0) ;
 749          result := GetTimeOfDay (b4) ;
 750          Assert (result=0) ;
 751          SubTime (sec, micro, timeval, b4) ;
 752          SetTime (timeval, sec, micro) ;
 753          IF Debugging
 754          THEN
 755             printf ("select waiting for %u.%06u seconds\n", sec, micro)
 756          END ;
 757          signal (lock) ;
 758          REPEAT
 759             IF Debugging
 760             THEN
 761                printf ("select (.., .., .., %u.%06u)\n", sec, micro)
 762             END ;
 763             IF maxFd<0
 764             THEN
 765                result := select (0, NIL, NIL, NIL, timeval)
 766             ELSE
 767                result := select (maxFd+1, inSet, outSet, NIL, timeval)
 768             END ;
 769             IF result=-1
 770             THEN
 771                IF Debugging
 772                THEN
 773                   perror ("select failed : ") ;
 774                END ;
 775                result := select (maxFd+1, inSet, outSet, NIL, zero) ;
 776                IF result#-1
 777                THEN
 778                    GetTime (timeval, sec, micro) ;
 779                    IF Debugging
 780                    THEN
 781                      printf ("(nfds : %d timeval: %u.%06u) : \n", maxFd, sec, micro) ;
 782                    END ;
 783                    perror ("select timeout argument was faulty : ")
 784                ELSE
 785                   result := select (maxFd+1, inSet, NIL, NIL, timeval) ;
 786                   IF result#-1
 787                   THEN
 788                      perror ("select output fd argument was faulty : ")
 789                   ELSE
 790                      result := select (maxFd+1, NIL, outSet, NIL, timeval) ;
 791                      IF result#-1
 792                      THEN
 793                         perror ("select input fd argument was faulty : ")
 794                      ELSE
 795                         IF maxFd=-1
 796                         THEN
 797                            result := select (0, NIL, NIL, NIL, timeval) ;
 798                            IF result=-1
 799                            THEN
 800                               IF Debugging
 801                               THEN
 802                                  perror ("select does not accept nfds == 0 ") ;
 803                               END ;
 804                               result := 0
 805                            END
 806                         ELSE
 807                            perror ("select maxFD+1 argument was faulty : ") ;
 808                         END
 809                      END
 810                   END
 811                END
 812             END
 813          UNTIL result#-1
 814       END ;
 815       WHILE activatePending (untilInterrupt, call, pri,
 816                              maxFd+1, inSet, outSet, timeval, b4, after) DO
 817       END ;
 818       IF timeval#NIL
 819       THEN
 820          timeval := KillTime (timeval)
 821       END ;
 822       IF zero#NIL
 823       THEN
 824          zero := KillTime (zero)
 825       END ;
 826       IF after#NIL
 827       THEN
 828          after := KillTime (after)
 829       END ;
 830       IF b4#NIL
 831       THEN
 832          b4 := KillTime (b4)
 833       END ;
 834       IF inSet#NIL
 835       THEN
 836          inSet := KillSet (inSet)
 837       END ;
 838       IF outSet#NIL
 839       THEN
 840          outSet := KillSet (outSet)
 841       END
 842    END ;
 843    signal (lock)
 844 END Listen ;
 845
 846
 847 (*
 848    init -
 849 *)
 850
 851 PROCEDURE init ;
 852 VAR
 853    p: PROTECTION ;
 854 BEGIN
 855    lock := initSemaphore (1) ;
 856    wait (lock) ;
 857    Exists := NIL ;
 858    FOR p := MIN(PROTECTION) TO MAX(PROTECTION) DO
 859       Pending[p] := NIL
 860    END ;
 861    initialized := TRUE ;
 862    signal (lock)
 863 END init ;
 864
 865
 866 (*
 867    Init -
 868 *)
 869
 870 PROCEDURE Init ;
 871 BEGIN
 872    IF NOT initialized
 873    THEN
 874       init
 875    END
 876 END Init ;
 877
 878
 879 BEGIN
 880    Init
 881 END RTint.