home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / m2posx14 / src / sig.ipp < prev    next >
Encoding:
Modula Implementation  |  1994-05-14  |  21.7 KB  |  822 lines
  1. IMPLEMENTATION MODULE sig;
  2. __IMP_SWITCHES__
  3. __DEBUG__
  4. #ifdef HM2
  5. #ifdef __LONG_WHOLE__
  6. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  7. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  8. #else
  9. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  10. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  11. #endif
  12. #endif
  13. (*****************************************************************************)
  14. (* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
  15. (* --------------------------------------------------------------------------*)
  16. (* 14-Mai-94, Holger Kleinschmidt                                            *)
  17. (*****************************************************************************)
  18.  
  19. VAL_INTRINSIC
  20. CAST_IMPORT
  21.  
  22. FROM SYSTEM IMPORT
  23. (* TYPE *) ADDRESS,
  24. (* PROC *) ADR;
  25.  
  26. FROM PORTAB IMPORT
  27. (* CONST*) NULL,
  28. (* TYPE *) UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, WORDSETRANGE, WORDSET;
  29.  
  30. FROM types IMPORT
  31. (* CONST*) ClkTck,
  32. (* TYPE *) int, unsigned, signedlong, pidT;
  33.  
  34. IMPORT e;
  35.  
  36. FROM pLONGSET IMPORT
  37. (* PROC *) UNIONlong, DIFFlong, INCLlong, EXCLlong, INlong;
  38.  
  39. FROM DosSystem IMPORT
  40. (* VAR  *) BASEP,
  41. (* PROC *) SysClock, DosPid, MiNTVersion;
  42.  
  43. FROM DosSupport IMPORT
  44. (* CONST*) MINSIG, MAXSIG,
  45. (* VAR  *) SIGMASK, SIGPENDING, SIGHANDLER;
  46.  
  47. FROM OSCALLS IMPORT
  48. (* PROC *) Pkill, Psigpause, Psigblock, Psigsetmask, Psigpending, Pause,
  49.            Psignal, Psigaction, Pterm, Talarm, Tmalarm, Fselect, Pgetpid,
  50.            Syield, Pgetpgrp;
  51.  
  52. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  53.  
  54. TYPE
  55.   LONGsigset = RECORD
  56.     CASE TAG_COLON BOOLEAN OF
  57.       FALSE: sigset  : sigsetT;
  58.      |TRUE : siglong : UNSIGNEDLONG;
  59.     END;
  60.   END;
  61.  
  62. VAR
  63.   MiNT    : BOOLEAN;
  64.   hasMask : BOOLEAN; (* Werden 'Psigblock' und 'Psigsetmask' unterstuetzt ? *)
  65.  
  66. #if !((defined HM2) || (defined TDIM2))
  67. VAR
  68.   Wrapper : RECORD
  69.     code1 : UNSIGNEDLONG;
  70.     code2 : UNSIGNEDWORD;
  71.     code3 : UNSIGNEDWORD;
  72.     call  : SigHandler;
  73.     code4 : UNSIGNEDWORD;
  74.   END;
  75. #endif
  76.  
  77. VAR
  78.   Catch : UNSIGNEDWORD;
  79.  
  80. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  81.  
  82. PROCEDURE sigemptyset ((* -- /AUS *) VAR set : sigsetT );
  83. BEGIN
  84.  set[0] := WORDSET{};
  85.  set[1] := WORDSET{};
  86. END sigemptyset;
  87.  
  88. (*---------------------------------------------------------------------------*)
  89.  
  90. PROCEDURE sigfillset ((* -- /AUS *) VAR set : sigsetT );
  91. BEGIN
  92.  set[0] := WORDSET{0..15};
  93.  set[1] := WORDSET{0..15};
  94. END sigfillset;
  95.  
  96. (*---------------------------------------------------------------------------*)
  97.  
  98. PROCEDURE sigaddset ((* EIN/AUS *) VAR set : sigsetT;
  99.                      (* EIN/ -- *)     sig : int     ): int;
  100.  
  101. VAR cast : LONGsigset;
  102.  
  103. BEGIN
  104.  IF (sig < 0) OR (sig >= NSIG) THEN
  105.    e.errno := e.EINVAL;
  106.    RETURN(-1);
  107.  END;
  108.  cast.sigset := set;
  109.  INCLlong(cast.siglong, VAL(UNSIGNEDWORD,sig));
  110.  set := cast.sigset;
  111.  RETURN(0);
  112. END sigaddset;
  113.  
  114. (*---------------------------------------------------------------------------*)
  115.  
  116. PROCEDURE sigdelset ((* EIN/AUS *) VAR set : sigsetT;
  117.                      (* EIN/ -- *)     sig : int     ): int;
  118.  
  119. VAR cast : LONGsigset;
  120.  
  121. BEGIN
  122.  IF (sig < 0) OR (sig >= NSIG) THEN
  123.    e.errno := e.EINVAL;
  124.    RETURN(-1);
  125.  END;
  126.  cast.sigset := set;
  127.  EXCLlong(cast.siglong, VAL(UNSIGNEDWORD,sig));
  128.  set := cast.sigset;
  129.  RETURN(0);
  130. END sigdelset;
  131.  
  132. (*---------------------------------------------------------------------------*)
  133.  
  134. PROCEDURE sigismember ((* EIN/ -- *) set : sigsetT;
  135.                        (* EIN/ -- *) sig : int     ): int;
  136.  
  137. VAR cast : LONGsigset;
  138.  
  139. BEGIN
  140.  IF (sig < 0) OR (sig >= NSIG) THEN
  141.    e.errno := e.EINVAL;
  142.    RETURN(-1);
  143.  END;
  144.  cast.sigset := set;
  145.  RETURN(INT(INlong(VAL(UNSIGNEDWORD,sig), cast.siglong)));
  146. END sigismember;
  147.  
  148. (*---------------------------------------------------------------------------*)
  149. #if (defined HM2)
  150. (*$E+*)
  151. #endif
  152. (* Ohne MiNT fuer alle Compiler, mit MiNT nur fuer LPR, SPC und MM
  153.  * noetig.
  154.  *)
  155. PROCEDURE dispatch ((* EIN/ -- *) sig : UNSIGNEDLONG );
  156. VAR handler : SignalHandler;
  157. BEGIN
  158.  handler.long := SIGHANDLER[VAL(UNSIGNEDWORD,sig)].HANDLER;
  159.  handler.proc(sig);
  160. END dispatch;
  161. #if (defined HM2)
  162. (*$E=*)
  163. #endif
  164. (*---------------------------------------------------------------------------*)
  165.  
  166. PROCEDURE kill ((* EIN/ -- *) pid : pidT;
  167.                 (* EIN/ -- *) sig : int  ): int;
  168.  
  169. VAR handler  : SignalHandler;
  170.     res      : INTEGER;
  171.     savemask : UNSIGNEDLONG;
  172.  
  173. BEGIN
  174.  IF (sig < 0) OR (sig >= NSIG) THEN
  175.    e.errno := e.EINVAL;
  176.    RETURN(-1);
  177.  END;
  178.  IF Pkill(pid, sig, res) THEN
  179.    RETURN(0);
  180.  ELSIF res <> e.eINVFN THEN
  181.    (* 'Pkill'-Aufruf wird unterstuetzt, anderer Fehler *)
  182.    e.errno := res;
  183.    RETURN(-1);
  184.  ELSE
  185.    (* 'Pkill'-Aufruf wird nicht unterstuetzt *)
  186.    IF (pid < 0) OR (pid > 0) AND (pid <> DosPid(BASEP)) THEN
  187.      e.errno := e.ESRCH;
  188.      RETURN(-1);
  189.    END;
  190.    handler.long := SIGHANDLER[VAL(UNSIGNEDWORD,sig)].HANDLER;
  191.    IF (sig = SIGNULL) OR (handler.long = SigIgn) THEN
  192.      (* Signal wird ignoriert *)
  193.      RETURN(0);
  194.    ELSIF (sig <> SIGKILL) (* kann nicht maskiert werden *)
  195.      AND (sig <> SIGSTOP) (* -""- *)
  196.      AND (sig <> SIGCONT) (* -""- *)
  197.      AND INlong(VAL(UNSIGNEDWORD,sig), SIGMASK)
  198.    THEN
  199.      (* Falls Signal in der Signalmaske gesetzt -> nur vermerken *)
  200.      INCLlong(SIGPENDING, VAL(UNSIGNEDWORD,sig));
  201.      RETURN(0);
  202.    ELSE
  203.      EXCLlong(SIGPENDING, VAL(UNSIGNEDWORD,sig));
  204.      IF handler.long = SigDfl THEN
  205.        (* Kein Handler installiert -> Defaultaktion *)
  206.        IF (sig=SIGCONT) OR (sig=SIGCHLD) OR (sig=SIGWINCH) OR (sig=SIGFPE) THEN
  207.          (* Defaultaktion: Signal ignorieren *)
  208.          RETURN(0);
  209.        ELSE
  210.          (* Defaultaktion: Programm beenden *)
  211.          Pterm(VAL(CARDINAL,sig) * 256); (* Signal in obere 8 Bit *)
  212.        END;
  213.      ELSE
  214.        (* Installierten Signalhandler ausfuehren, Signalmaske solange
  215.         * aendern.
  216.         *)
  217.        savemask := SIGMASK;
  218.        SIGMASK  := UNIONlong(SIGMASK, SIGHANDLER[VAL(UNSIGNEDWORD,sig)].MASK);
  219.        (* Zusaetzlich ist das behandelte Signal blockiert *)
  220.        INCLlong(SIGMASK, VAL(UNSIGNEDWORD,sig));
  221.  
  222.        handler.proc(VAL(UNSIGNEDLONG,sig));
  223.  
  224.        (* Alte Signalmaske wiederherstellen *)
  225.        SIGMASK := savemask;
  226.        RETURN(0);
  227.      END;
  228.    END;
  229.  END;
  230. END kill;
  231.  
  232. (*---------------------------------------------------------------------------*)
  233.  
  234. PROCEDURE DeliverUnblocked;
  235. (**)
  236. VAR __REG__ unblocked : UNSIGNEDLONG;
  237.     __REG__ sig       : UNSIGNEDWORD;
  238.     __REG__ void      : INTEGER;
  239.  
  240. BEGIN
  241.  unblocked := DIFFlong(SIGPENDING, SIGMASK);
  242.  IF unblocked <> VAL(UNSIGNEDLONG,0) THEN
  243.    FOR sig := 1 TO NSIG - 1 DO
  244.      IF INlong(sig, unblocked) THEN
  245.        void := kill(0, INT(sig));
  246.      END;
  247.    END;
  248.  END;
  249. END DeliverUnblocked;
  250.  
  251. (*---------------------------------------------------------------------------*)
  252.  
  253. PROCEDURE signal ((* EIN/ -- *)     sig     : int;
  254.                   (* EIN/ -- *)     handler : SignalHandler;
  255.                   (* -- /AUS *) VAR old     : SignalHandler ): int;
  256.  
  257. VAR func : ADDRESS;
  258.     prev : ADDRESS;
  259.     void : INTEGER;
  260.  
  261. BEGIN
  262.  IF (sig < 0) OR (sig >= NSIG) THEN
  263.    e.errno  := e.EINVAL;
  264.    old.long := SigErr;
  265.    RETURN(-1);
  266.  END;
  267.  
  268. #if !((defined HM2) || (defined TDIM2))
  269.  WITH handler DO WITH SIGHANDLER[VAL(UNSIGNEDWORD,sig)] DO
  270.    old.long := HANDLER;
  271.    HANDLER  := long;
  272.    IF (long = SigDfl) OR (long = SigIgn) THEN
  273.      func := CAST(ADDRESS,long);
  274.    ELSE
  275.      func := ADR(Wrapper);
  276.    END;
  277.  END; END;
  278. #else
  279.  func := CAST(ADDRESS,handler.long);
  280. #endif
  281.  
  282.  IF Psignal(sig, func, prev) THEN
  283. #if !((defined HM2) || (defined TDIM2))
  284.    IF prev <> ADR(Wrapper) THEN
  285.      old.long := CAST(SIGNEDLONG,prev);
  286.    END;
  287. #else
  288.    old.long := CAST(SIGNEDLONG,prev);
  289. #endif
  290.    RETURN(0);
  291.  ELSIF CAST(SIGNEDLONG,prev) <> VAL(SIGNEDLONG,e.eINVFN) THEN
  292.    (* 'Psignal'-Aufruf wird unterstuetzt, anderer Fehler *)
  293. #if !((defined HM2) || (defined TDIM2))
  294.    (* Geaenderten Handler restaurieren *)
  295.    SIGHANDLER[VAL(UNSIGNEDWORD,sig)].HANDLER := old.long;
  296. #endif
  297.    e.errno  := INT(CAST(SIGNEDLONG,prev));
  298.    old.long := SigErr;
  299.    RETURN(-1);
  300.  ELSE
  301.    (* 'Psignal'-Aufruf wird nicht unterstuetzt *)
  302.    WITH SIGHANDLER[VAL(UNSIGNEDWORD,sig)] DO
  303. #if (defined HM2) || (defined TDIM2)
  304.      old.long := HANDLER;
  305.      HANDLER  := handler.long;
  306. #endif
  307.      MASK     := 0;
  308.    END;
  309.    (* Blockierung fuer behandeltes Signal aufheben und evtl. anstehendes
  310.     * Signal ausfuehren.
  311.     *)
  312.    EXCLlong(SIGMASK, VAL(UNSIGNEDWORD,sig));
  313.    DeliverUnblocked;
  314.  
  315.    RETURN(0);
  316.  END;
  317. END signal;
  318.  
  319. (*---------------------------------------------------------------------------*)
  320.  
  321. PROCEDURE sigaction ((* EIN/ -- *) sig  : int;
  322.                      (* EIN/ -- *) act  : SigactionPtr;
  323.                      (* EIN/ -- *) oact : SigactionPtr ): int;
  324.  
  325. VAR oldh : SIGNEDLONG;
  326.     tmp  : SigactionRec;
  327.     res  : INTEGER;
  328.     mask : LONGsigset;
  329.  
  330. BEGIN
  331.  IF (sig < 0) OR (sig >= NSIG) THEN
  332.    e.errno  := e.EINVAL;
  333.    RETURN(-1);
  334.  END;
  335.  
  336. #if !((defined HM2) || (defined TDIM2))
  337.  WITH SIGHANDLER[VAL(UNSIGNEDWORD,sig)] DO
  338.    oldh := HANDLER;
  339.    IF act <> NULL THEN
  340.      (* act^ nicht veraendern, nur eine Kopie *)
  341.      tmp := act^;
  342.      act := CAST(SigactionPtr,ADR(tmp));
  343.      WITH tmp.saHandler DO
  344.        HANDLER := long;
  345.        IF (long <> SigDfl) AND (long <> SigIgn) THEN
  346.          long := CAST(SIGNEDLONG,ADR(Wrapper));
  347.        END;
  348.      END;
  349.    END;
  350.  END;
  351. #endif
  352.  
  353.  IF Psigaction(sig, act, oact, res) THEN
  354. #if !((defined HM2) || (defined TDIM2))
  355.    IF oact <> NULL THEN
  356.      WITH oact^.saHandler DO
  357.        IF CAST(ADDRESS,long) = ADR(Wrapper) THEN
  358.          long := oldh;
  359.        END;
  360.      END;
  361.    END;
  362. #endif
  363.    RETURN(0);
  364.  ELSIF res <> e.eINVFN THEN
  365.    (* 'Psigaction'-Aufruf wird unterstuetzt, anderer Fehler *)
  366. #if !((defined HM2) || (defined TDIM2))
  367.    (* Geaenderten Handler restaurieren *)
  368.    SIGHANDLER[VAL(UNSIGNEDWORD,sig)].HANDLER := oldh;
  369. #endif
  370.    e.errno := res;
  371.    RETURN(-1);
  372.  ELSE
  373.    (* 'Psigaction'-Aufruf wird nicht unterstuetzt *)
  374.    WITH SIGHANDLER[VAL(UNSIGNEDWORD,sig)] DO
  375.      IF oact <> NULL THEN
  376.        WITH oact^ DO
  377. #if (defined HM2) || (defined TDIM2)
  378.          saHandler.long := HANDLER;
  379. #else
  380.          saHandler.long := oldh;
  381. #endif
  382.          saFlags        := CAST(SaFlags,FLAGS);
  383.          mask.siglong   := MASK;
  384.          saMask         := mask.sigset;
  385.        END;
  386.      END;
  387.  
  388.      IF act <> NULL THEN
  389.        WITH act^ DO
  390. #if (defined HM2) || (defined TDIM2)
  391.          HANDLER := saHandler.long;
  392. #endif
  393.          FLAGS   := CAST(WORDSET,saFlags);
  394.          (* Innerhalb des Handlers zusaetzlich die angegebene Signalmaske
  395.           * beruecksichtigen.
  396.           *)
  397.          mask.sigset := saMask;
  398.          MASK        := mask.siglong;
  399.        END;
  400.      END;
  401.    END; (* WITH SIGHANDLER *)
  402.  
  403.    (* Blockierung fuer behandeltes Signal aufheben und evtl. anstehendes
  404.     * Signal ausfuehren.
  405.     *)
  406.    EXCLlong(SIGMASK, VAL(UNSIGNEDWORD,sig));
  407.    DeliverUnblocked;
  408.  
  409.    RETURN(0);
  410.  END;
  411. END sigaction;
  412.  
  413. (*---------------------------------------------------------------------------*)
  414.  
  415. PROCEDURE raise ((* EIN/ -- *) sig : int ): int;
  416.  
  417. VAR pid : INTEGER;
  418.  
  419. BEGIN
  420.  pid := Pgetpid();
  421.  IF pid < 0 THEN
  422.    (* 'Pgetpid'-Aufruf wird nicht unterstuetzt *)
  423.    RETURN(kill(0, sig));
  424.  ELSE
  425.    RETURN(kill(pid, sig));
  426.  END;
  427. END raise;
  428.  
  429. (*---------------------------------------------------------------------------*)
  430.  
  431. PROCEDURE killpg ((* EIN/ -- *) pgrp : pidT;
  432.                   (* EIN/ -- *) sig  : int ): int;
  433.  
  434. BEGIN
  435.  IF pgrp < 0 THEN
  436.    e.errno := e.EINVAL;
  437.    RETURN(-1);
  438.  END;
  439.  IF Pgetpgrp() <> e.eINVFN THEN
  440.    (* Prozessgruppen werden unterstuetzt *)
  441.    RETURN(kill(-pgrp, sig));
  442.  ELSE
  443.    RETURN(kill(pgrp, sig));
  444.  END;
  445. END killpg;
  446.  
  447. (*---------------------------------------------------------------------------*)
  448.  
  449. PROCEDURE sigprocmask ((* EIN/ -- *) how  : SigBlockType;
  450.                        (* EIN/ -- *) set  : SigsetPtr;
  451.                        (* EIN/ -- *) oset : SigsetPtr    ): int;
  452.  
  453. VAR old  : UNSIGNEDLONG;
  454.     mask : LONGsigset;
  455.     cast : LONGsigset;
  456.  
  457. BEGIN
  458.  mask.siglong := SIGMASK;
  459.  CASE how OF
  460.    SigBlock:
  461.      IF hasMask THEN
  462.        IF set = NULL THEN
  463.          mask.siglong := 0;
  464.        ELSE
  465.          mask.sigset  := set^;
  466.        END;
  467.        mask.siglong := Psigblock(mask.siglong);
  468.        IF oset <> NULL THEN
  469.          oset^ := mask.sigset;
  470.        END;
  471.      ELSE
  472.        IF oset <> NULL THEN
  473.          oset^ := mask.sigset;
  474.        END;
  475.        IF set <> NULL THEN
  476.          cast.sigset := set^;
  477.          SIGMASK := UNIONlong(SIGMASK, cast.siglong);
  478.        END;
  479.      END;
  480.   |SigUnBlock:
  481.      IF hasMask THEN
  482.        mask.siglong := Psigblock(0);
  483.      END;
  484.      IF oset <> NULL THEN
  485.        oset^ := mask.sigset;
  486.      END;
  487.      IF set <> NULL THEN
  488.        cast.sigset  := set^;
  489.        mask.siglong := DIFFlong(mask.siglong, cast.siglong);
  490.        IF hasMask THEN
  491.          old := Psigsetmask(mask.siglong);
  492.        ELSE
  493.          SIGMASK := mask.siglong;
  494.          DeliverUnblocked;
  495.        END;
  496.      END;
  497.  ELSE (* SigSetMask *)
  498.      IF hasMask THEN
  499.        IF set = NULL THEN
  500.          mask.siglong := Psigblock(0);
  501.        ELSE
  502.          mask.sigset  := set^;
  503.          mask.siglong := Psigsetmask(mask.siglong);
  504.        END;
  505.        IF oset <> NULL THEN
  506.          oset^ := mask.sigset;
  507.        END;
  508.      ELSE
  509.        IF oset <> NULL THEN
  510.          oset^ := mask.sigset;
  511.        END;
  512.        IF set <> NULL THEN
  513.          mask.sigset  := set^;
  514.          SIGMASK := mask.siglong;
  515.          DeliverUnblocked;
  516.        END;
  517.      END;
  518.  END;
  519.  RETURN(0);
  520. END sigprocmask;
  521.  
  522. (*---------------------------------------------------------------------------*)
  523.  
  524. PROCEDURE sigpending ((* -- /AUS *) VAR set : sigsetT ): int;
  525.  
  526. VAR pending : LONGsigset;
  527.     res     : SIGNEDLONG;
  528.  
  529. BEGIN
  530.  res := Psigpending();
  531.  IF res < VAL(SIGNEDLONG,0) THEN
  532.    (* 'Psigpending'-Aufruf wird nicht unterstuetzt *)
  533.    pending.siglong := SIGPENDING;
  534.  ELSE
  535.    pending.siglong := res;
  536.  END;
  537.  set := pending.sigset;
  538.  RETURN(0);
  539. END sigpending;
  540.  
  541. (*---------------------------------------------------------------------------*)
  542.  
  543. PROCEDURE pause;
  544.  
  545. VAR void : INTEGER;
  546.  
  547. BEGIN
  548.  void    := Pause();
  549.  e.errno := e.EINTR;
  550. END pause;
  551.  
  552. (*---------------------------------------------------------------------------*)
  553.  
  554. PROCEDURE sigsuspend ((* EIN/ -- *) sigmask : sigsetT );
  555.  
  556. VAR mask : LONGsigset;
  557.     old  : UNSIGNEDLONG;
  558.  
  559. BEGIN
  560.  mask.sigset := sigmask;
  561.  IF Psigpause(mask.siglong) < 0 THEN
  562.    (* 'Psigpause'-Aufruf wird nicht unterstuetzt *)
  563.    old     := SIGMASK;
  564.    SIGMASK := mask.siglong;
  565.    DeliverUnblocked;
  566.    SIGMASK := old;
  567.  END;
  568.  e.errno := e.EINTR;
  569. END sigsuspend;
  570.  
  571. (*---------------------------------------------------------------------------*)
  572.  
  573. PROCEDURE alarm ((* EIN/ -- *) sec : unsigned ): unsigned;
  574.  
  575. CONST MAXSEC = LC(2147483);
  576.  
  577. VAR secs : SIGNEDLONG;
  578.     rem  : SIGNEDLONG;
  579.  
  580. BEGIN
  581.  IF VAL(UNSIGNEDLONG,sec) > MAXSEC THEN
  582.    (* sonst gibts Ueberlauf in MiNT *)
  583.    sec := VAL(unsigned,MAXSEC);
  584.  END;
  585.  rem := Talarm(VAL(SIGNEDLONG,sec));
  586.  IF rem < VAL(SIGNEDLONG,0) THEN
  587.    (* 'Talarm'-Aufruf wird nicht unterstuetzt *)
  588.    RETURN(0);
  589.  ELSE
  590.    RETURN(VAL(CARDINAL,rem));
  591.  END;
  592. END alarm;
  593.  
  594. (*---------------------------------------------------------------------------*)
  595.  
  596. PROCEDURE sleep ((* EIN/ -- *) seconds : unsigned ): unsigned;
  597.  
  598. CONST MAXSEC = LC(2147483);
  599.  
  600. VAR until      : UNSIGNEDLONG;
  601.     voidB      : BOOLEAN;
  602.     voidL      : UNSIGNEDLONG;
  603.     voidA      : ADDRESS;
  604.     alarmSecs  : SIGNEDLONG;
  605.     secs       : SIGNEDLONG;
  606.     remain     : SIGNEDLONG;
  607.     oldHandler : ADDRESS;
  608.     oldMask    : UNSIGNEDLONG;
  609.     cast       : LONGsigset;
  610.     res        : INTEGER;
  611.  
  612. BEGIN
  613.  IF seconds = 0 THEN
  614.    RETURN(0);
  615.  END;
  616.  IF VAL(UNSIGNEDLONG,seconds) > MAXSEC THEN
  617.    (* sonst gibts Ueberlauf in MiNT *)
  618.    seconds := VAL(CARDINAL,MAXSEC);
  619.  END;
  620.  secs := VAL(SIGNEDLONG,seconds);
  621.  IF MiNT THEN
  622.    (* Das folgende Algorithmus stammt aus der MiNTLib: *)
  623.    alarmSecs := Talarm(0);
  624.    oldMask   := Psigblock(0FFFFFFFFH);
  625.    voidB     := Psignal(ORD(SIGALRM), ADR(Catch), oldHandler);
  626.    voidL     := Psigblock(0FFFFFFFFH);
  627.    until     := SysClock() DIV ClkTck + VAL(UNSIGNEDLONG,seconds);
  628.    IF (alarmSecs > VAL(SIGNEDLONG,0)) AND (alarmSecs < secs) THEN
  629.      voidL := Talarm(alarmSecs);
  630.    ELSE
  631.      voidL := Talarm(secs);
  632.    END;
  633.    EXCLlong(oldMask, VAL(UNSIGNEDWORD,SIGALRM));
  634.    res       := Psigpause(oldMask);
  635.    alarmSecs := Talarm(0);
  636.    voidB     := Psignal(ORD(SIGALRM), ADR(Catch), voidA);
  637.    res       := Syield();
  638.    voidL     := Psigblock(0FFFFFFFFH);
  639.    remain    := CAST(SIGNEDLONG,until) - CAST(SIGNEDLONG,SysClock() DIV ClkTck);
  640.    IF alarmSecs > VAL(SIGNEDLONG,0) THEN
  641.      DEC(alarmSecs, secs - remain);
  642.      IF alarmSecs > VAL(SIGNEDLONG,0) THEN
  643.        voidL := Talarm(alarmSecs);
  644.      ELSE
  645.        voidB := Pkill(Pgetpid(), ORD(SIGALRM), res);
  646.      END;
  647.    END;
  648.    voidB := Psignal(ORD(SIGALRM), oldHandler, voidA);
  649.    voidL := Psigsetmask(oldMask);
  650.    res   := Syield();
  651.    IF remain > VAL(SIGNEDLONG,0) THEN
  652.      RETURN(VAL(CARDINAL,remain));
  653.    ELSE
  654.      RETURN(0);
  655.    END;
  656.  ELSE
  657.    until := SysClock() + VAL(UNSIGNEDLONG,seconds) * ClkTck;
  658.    REPEAT
  659.    UNTIL SysClock() >= until;
  660.    RETURN(0);
  661.  END;
  662. END sleep;
  663.  
  664. (*---------------------------------------------------------------------------*)
  665.  
  666. PROCEDURE usleep ((* EIN/ -- *) useconds : signedlong ): signedlong;
  667.  
  668. VAR until      : UNSIGNEDLONG;
  669.     voidB      : BOOLEAN;
  670.     voidL      : UNSIGNEDLONG;
  671.     voidA      : ADDRESS;
  672.     alarmMSecs : SIGNEDLONG;
  673.     mSecs      : SIGNEDLONG;
  674.     remain     : SIGNEDLONG;
  675.     oldHandler : ADDRESS;
  676.     oldMask    : UNSIGNEDLONG;
  677.     cast       : LONGsigset;
  678.     res        : INTEGER;
  679.  
  680. BEGIN
  681.  mSecs := useconds DIV VAL(SIGNEDLONG,1000);
  682.  IF mSecs <= VAL(SIGNEDLONG,0) THEN
  683.    RETURN(0);
  684.  END;
  685.  (* 'useconds': Zeit in Millisekunden *)
  686.  IF MiNT THEN
  687.    (* Das folgende Algorithmus stammt aus der MiNTLib: *)
  688.    alarmMSecs := Tmalarm(0);
  689.    oldMask    := Psigblock(0FFFFFFFFH);
  690.    voidB      := Psignal(ORD(SIGALRM), ADR(Catch), oldHandler);
  691.    voidL      := Psigblock(0FFFFFFFFH);
  692.    until      := SysClock() * VAL(UNSIGNEDLONG,5) + CAST(UNSIGNEDLONG,mSecs);
  693.    IF (alarmMSecs > VAL(SIGNEDLONG,0)) AND (alarmMSecs < mSecs) THEN
  694.      voidL := Tmalarm(alarmMSecs);
  695.    ELSE
  696.      voidL := Tmalarm(mSecs);
  697.    END;
  698.    EXCLlong(oldMask, VAL(UNSIGNEDWORD,SIGALRM));
  699.    res        := Psigpause(oldMask);
  700.    alarmMSecs := Tmalarm(0);
  701.    voidB      := Psignal(ORD(SIGALRM), ADR(Catch), voidA);
  702.    res        := Syield();
  703.    voidL      := Psigblock(0FFFFFFFFH);
  704.    remain     := CAST(SIGNEDLONG,until) - CAST(SIGNEDLONG,SysClock() * LC(5));
  705.    IF alarmMSecs > VAL(SIGNEDLONG,0) THEN
  706.      DEC(alarmMSecs, mSecs - remain);
  707.      IF alarmMSecs > VAL(SIGNEDLONG,0) THEN
  708.        voidL := Tmalarm(alarmMSecs);
  709.      ELSE
  710.        voidB := Pkill(Pgetpid(), ORD(SIGALRM), res);
  711.      END;
  712.    END;
  713.    voidB := Psignal(ORD(SIGALRM), oldHandler, voidA);
  714.    voidL := Psigsetmask(oldMask);
  715.    res   := Syield();
  716.    IF remain > VAL(SIGNEDLONG,0) THEN
  717.      RETURN(VAL(UNSIGNEDLONG,remain) * VAL(UNSIGNEDLONG,1000));
  718.    ELSE
  719.      RETURN(0);
  720.    END;
  721.  ELSE
  722.    until := SysClock() + VAL(UNSIGNEDLONG,mSecs) DIV LC(5);
  723.    REPEAT
  724.    UNTIL SysClock() >= until;
  725.  END;
  726.  RETURN(0);
  727. END usleep;
  728.  
  729. (*---------------------------------------------------------------------------*)
  730.  
  731. PROCEDURE sigmask ((* EIN/ -- *) sig : int ): UNSIGNEDLONG;
  732.  
  733. VAR cast : LONGsigset;
  734.  
  735. BEGIN
  736.  cast.siglong := 0H;
  737.  INCLlong(cast.siglong, VAL(UNSIGNEDWORD,sig));
  738.  RETURN(cast.siglong);
  739. END sigmask;
  740.  
  741. (*---------------------------------------------------------------------------*)
  742.  
  743. PROCEDURE sigsetmask ((* EIN/ -- *) mask : UNSIGNEDLONG ): UNSIGNEDLONG;
  744.  
  745. VAR old : UNSIGNEDLONG;
  746.  
  747. BEGIN
  748.  IF hasMask THEN
  749.    RETURN(Psigsetmask(mask));
  750.  ELSE
  751.    (* 'Psigsetmask'-Aufruf wird nicht unterstuetzt *)
  752.    old     := SIGMASK;
  753.    SIGMASK := mask;
  754.    DeliverUnblocked;
  755.    RETURN(old);
  756.  END;
  757. END sigsetmask;
  758.  
  759. (*---------------------------------------------------------------------------*)
  760.  
  761. PROCEDURE sigblock ((* EIN/ -- *) mask : UNSIGNEDLONG ): UNSIGNEDLONG;
  762.  
  763. VAR old : UNSIGNEDLONG;
  764.  
  765. BEGIN
  766.  IF hasMask THEN
  767.    RETURN(Psigblock(mask));
  768.  ELSE
  769.    (* 'Psigblock'-Aufruf wird nicht unterstuetzt *)
  770.    old     := SIGMASK;
  771.    SIGMASK := UNIONlong(SIGMASK, mask);
  772.    RETURN(old);
  773.  END;
  774. END sigblock;
  775.  
  776. (*---------------------------------------------------------------------------*)
  777.  
  778. PROCEDURE sigpause ((* EIN/ -- *) mask : UNSIGNEDLONG );
  779. (**)
  780. VAR old : UNSIGNEDLONG;
  781.  
  782. BEGIN
  783.  IF Psigpause(mask) < 0 THEN
  784.    (* 'Psigpause'-Aufruf wird nicht unterstuetzt *)
  785.    old     := SIGMASK;
  786.    SIGMASK := mask;
  787.    DeliverUnblocked;
  788.    SIGMASK := old;
  789.  END;
  790.  e.errno := e.EINTR;
  791. END sigpause;
  792.  
  793. (*===========================================================================*)
  794.  
  795. CONST
  796.   EINVFN = 0FFFFFFE0H; (* = e.EINVFN als (UN)SIGNEDLONG-Konstante *)
  797.  
  798. BEGIN (* sig *)
  799.  MiNT    := MiNTVersion() > 0;
  800.  hasMask := Psigblock(0) <> EINVFN;
  801.  (* Wenn der 'Psigblock'-Aufruf unterstuetzt wird, kann dieses Bitmuster
  802.   * nicht auftreten, weil SIGSTOP (Bit 17) und SIGCONT (Bit 19) nicht
  803.   * blockiert werden/sein koennen. Es wird angenommen, dass das Ergebnis
  804.   * des Tests auch fuer 'Psigsetmask' gilt.
  805.   *)
  806.  
  807. #if !((defined HM2) || (defined TDIM2))
  808.  WITH Wrapper DO
  809.    code1 := 202F0004H; (* move.l  4(SP),D0 *)
  810. #ifdef MM2
  811.    code2 := 26C0H;     (* move.l  D0,(A3)+ *)
  812. #else
  813.    code2 := 2F00H;     (* move.l  D0,-(SP) *)
  814. #endif
  815.    code3 := 4EB9H;     (* jsr ... *)
  816.    call  := dispatch;  (* ... dispatch *)
  817.    code4 := 4E75H;     (* rts *)
  818.  END;
  819. #endif
  820.  Catch := 4E75H; (* rts, ein sehr einfacher Signalhandler... *)
  821. END sig.
  822.