home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / proc.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  21.3 KB  |  895 lines
  1. IMPLEMENTATION MODULE proc;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* Basiert auf der MiNTLIB von Eric R. Smith                                 *)
  5. (* --------------------------------------------------------------------------*)
  6. (* STATUS: OK                                                                *)
  7. (* --------------------------------------------------------------------------*)
  8. (* 14-Feb-93, Holger Kleinschmidt                                            *)
  9. (*****************************************************************************)
  10.  
  11. VAL_INTRINSIC
  12. CAST_IMPORT
  13. OSCALL_IMPORT
  14.  
  15. FROM SYSTEM IMPORT
  16. (* TYPE *) ADDRESS,
  17. (* PROC *) ADR;
  18.  
  19. FROM pSTRING IMPORT
  20. (* CONST*) EOS,
  21. (* TYPE *) StrArray, StrPtr, StrRange, ArrayRange,
  22. (* PROC *) LenC, COPY, ASSIGN, TOKEN, SLEN, APPEND, APPENDCHR, RPOSCHR,
  23.            RPOSCHRSET;
  24.  
  25. FROM cmdline IMPORT
  26. (* VAR  *) environ,
  27. (* PROC *) GetEnvVar;
  28.  
  29. FROM types IMPORT
  30. (* CONST*) NULL, PATHMAX, SUFFIXSEP, DDIRSEP, XDIRSEP,
  31. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, FileName,
  32.            WORDSET, PathName, uidT, gidT, pidT, clockT;
  33.  
  34. FROM err IMPORT
  35. (* CONST*) eOK, eACCDN, EFAULT, EINVAL, ENOSYS, ENOMEM, ENOENT, ECHILD, E2BIG,
  36.            EPERM,
  37. (* VAR  *) errno;
  38.  
  39. FROM DosFile IMPORT
  40. (* CONST*) EXECSUFFIX,
  41. (* PROC *) UnixToDos;
  42.  
  43. FROM DosSystem IMPORT
  44. (* TYPE *) CmdLine, BasePtr, BasePage,
  45. (* VAR  *) PID, PPID,
  46. (* PROC *) SysClock;
  47. #if MINT
  48. FROM DosSystem IMPORT MiNTVersion;
  49. #endif
  50.  
  51. FROM file IMPORT
  52. (* CONST*) sIFMT, sIFREG,
  53. (* TYPE *) StatRec, modeT,
  54. (* PROC *) stat;
  55.  
  56. #include "oscalls.m2h"
  57.  
  58. (*==========================================================================*)
  59.  
  60. CONST EOKL = LIC(0);
  61.  
  62. VAR
  63. #if MINT
  64.   MiNT      : CARDINAL;
  65. #endif
  66.   CHILDTIME : UNSIGNEDLONG;
  67.  
  68. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  69.  
  70. PROCEDURE getpid ( ): pidT;
  71. (*T*)
  72. VAR base : BasePtr;
  73. #if MINT
  74.     wres : UNSIGNEDWORD;
  75. #endif
  76. BEGIN
  77. #if MINT
  78.  IF MiNT > 0 THEN
  79.    Pgetpid(wres);
  80.    RETURN(VAL(pidT,wres));
  81.  ELSE
  82. #endif
  83.    RETURN(VAL(pidT,PID));
  84. #if MINT
  85.  END;
  86. #endif
  87. END getpid;
  88.  
  89. (*---------------------------------------------------------------------------*)
  90.  
  91. PROCEDURE getppid ( ): pidT;
  92. (*T*)
  93. VAR base : BasePtr;
  94. #if MINT
  95.     wres : UNSIGNEDWORD;
  96. #endif
  97. BEGIN
  98. #if MINT
  99.  IF MiNT > 0 THEN
  100.    Pgetppid(wres);
  101.    RETURN(VAL(pidT,wres));
  102.  ELSE
  103. #endif
  104.    RETURN(VAL(pidT,PPID));
  105. #if MINT
  106.  END;
  107. #endif
  108. END getppid;
  109.  
  110. (*---------------------------------------------------------------------------*)
  111.  
  112. PROCEDURE getuid ( ): uidT;
  113. (*T*)
  114. #if MINT
  115. VAR wres : UNSIGNEDWORD;
  116. #endif
  117. BEGIN
  118. #if MINT
  119.  IF MiNT > 0 THEN
  120.    Pgetuid(wres);
  121.    RETURN(VAL(uidT,wres));
  122.  ELSE
  123. #endif
  124.    RETURN(0);
  125. #if MINT
  126.  END;
  127. #endif
  128. END getuid;
  129.  
  130. (*---------------------------------------------------------------------------*)
  131.  
  132. PROCEDURE getgid ( ): gidT;
  133. (*T*)
  134. #if MINT
  135. VAR wres : UNSIGNEDWORD;
  136. #endif
  137. BEGIN
  138. #if MINT
  139.  IF MiNT > 0 THEN
  140.    Pgetgid(wres);
  141.    RETURN(VAL(gidT,wres));
  142.  ELSE
  143. #endif
  144.    RETURN(0);
  145. #if MINT
  146.  END;
  147. #endif
  148. END getgid;
  149.  
  150. (*---------------------------------------------------------------------------*)
  151.  
  152. PROCEDURE geteuid ( ): uidT;
  153. (*T*)
  154. #if MINT
  155. VAR wres : UNSIGNEDWORD;
  156. #endif
  157. BEGIN
  158. #if MINT
  159.  IF MiNT > 0 THEN
  160.    IF MiNT >= 95 THEN
  161.      Pgeteuid(wres);
  162.    ELSE
  163.      Pgetuid(wres);
  164.    END;
  165.    RETURN(VAL(uidT,wres));
  166.  ELSE
  167. #endif
  168.    RETURN(0);
  169. #if MINT
  170.  END;
  171. #endif
  172. END geteuid;
  173.  
  174. (*---------------------------------------------------------------------------*)
  175.  
  176. PROCEDURE getegid ( ): gidT;
  177. (*T*)
  178. #if MINT
  179. VAR wres : UNSIGNEDWORD;
  180. #endif
  181. BEGIN
  182. #if MINT
  183.  IF MiNT > 0 THEN
  184.    IF MiNT >= 95 THEN
  185.      Pgetegid(wres);
  186.    ELSE
  187.      Pgetgid(wres);
  188.    END;
  189.    RETURN(VAL(gidT,wres));
  190.  ELSE
  191. #endif
  192.    RETURN(0);
  193. #if MINT
  194.  END;
  195. #endif
  196. END getegid;
  197.  
  198. (*---------------------------------------------------------------------------*)
  199.  
  200. PROCEDURE setuid ((* EIN/ -- *) uid : uidT ): INTEGER;
  201. (*T*)
  202. #if MINT
  203. VAR wres : SIGNEDWORD;
  204. #endif
  205. BEGIN
  206. #if MINT
  207.  IF MiNT > 0 THEN
  208.    Psetuid(VAL(UNSIGNEDWORD,uid), wres);
  209.    IF wres < eOK THEN
  210.      IF wres = eACCDN THEN
  211.        errno := EPERM;
  212.      ELSE
  213.        errno := INT(wres);
  214.      END;
  215.      RETURN(-1);
  216.    ELSE
  217.      RETURN(0);
  218.    END;
  219.  ELSE
  220. #endif
  221.    IF uid = 0 THEN
  222.      RETURN(0);
  223.    ELSE
  224.      errno := EINVAL;
  225.      RETURN(-1);
  226.    END;
  227. #if MINT
  228.  END;
  229. #endif
  230. END setuid;
  231.  
  232. (*---------------------------------------------------------------------------*)
  233.  
  234. PROCEDURE setgid ((* EIN/ -- *) gid : gidT ): INTEGER;
  235. (*T*)
  236. #if MINT
  237. VAR wres : SIGNEDWORD;
  238. #endif
  239. BEGIN
  240. #if MINT
  241.  IF MiNT > 0 THEN
  242.    Psetgid(VAL(UNSIGNEDWORD,gid), wres);
  243.    IF wres < eOK THEN
  244.      IF wres = eACCDN THEN
  245.        errno := EPERM;
  246.      ELSE
  247.        errno := INT(wres);
  248.      END;
  249.      RETURN(-1);
  250.    ELSE
  251.      RETURN(0);
  252.    END;
  253.  ELSE
  254. #endif
  255.    IF gid = 0 THEN
  256.      RETURN(0);
  257.    ELSE
  258.      errno := EINVAL;
  259.      RETURN(-1);
  260.    END;
  261. #if MINT
  262.  END;
  263. #endif
  264. END setgid;
  265.  
  266. (*---------------------------------------------------------------------------*)
  267.  
  268. PROCEDURE getpgrp ( ): pidT;
  269. (*T*)
  270. #if MINT
  271. VAR wres : UNSIGNEDWORD;
  272. #endif
  273. BEGIN
  274. #if MINT
  275.  IF MiNT > 0 THEN
  276.    Pgetpgrp(wres);
  277.    RETURN(VAL(pidT,wres));
  278.  ELSE
  279. #endif
  280.    RETURN(VAL(pidT,PID));
  281. #if MINT
  282.  END;
  283. #endif
  284. END getpgrp;
  285.  
  286. (*---------------------------------------------------------------------------*)
  287.  
  288. PROCEDURE setpgid ((* EIN/ -- *) pid  : pidT;
  289.                    (* EIN/ -- *) pgid : pidT ): INTEGER;
  290. (**)
  291. #if MINT
  292. VAR wres : SIGNEDWORD;
  293. #endif
  294. BEGIN
  295. #if MINT
  296.  IF MiNT > 0 THEN
  297.    Psetpgrp(VAL(SIGNEDWORD,pid), VAL(SIGNEDWORD,pgid), wres);
  298.    IF wres < eOK THEN
  299.      IF wres = eACCDN THEN
  300.        errno := EPERM;
  301.      ELSE
  302.        errno := INT(wres);
  303.      END;
  304.      RETURN(-1);
  305.    ELSE
  306.      RETURN(0);
  307.    END;
  308.  ELSE
  309. #endif
  310.    IF    ((pid  = 0) OR (pid  = VAL(pidT,PID)))
  311.      AND ((pgid = 0) OR (pgid = VAL(pidT,PID)))
  312.    THEN
  313.      RETURN(0);
  314.    ELSE
  315.      errno := EINVAL;
  316.      RETURN(-1);
  317.    END;
  318. #if MINT
  319.  END;
  320. #endif
  321. END setpgid;
  322.  
  323. (*--------------------------------------------------------------------------*)
  324.  
  325. PROCEDURE fork ( ): pidT;
  326. (*T*)
  327. VAR wres : SIGNEDWORD;
  328.  
  329. BEGIN
  330. #if MINT
  331.  IF MiNT > 0 THEN
  332.    Pfork(wres);
  333.    IF wres < eOK THEN
  334.      errno := INT(wres);
  335.      RETURN(-1);
  336.    ELSE
  337.      RETURN(VAL(pidT,wres));
  338.    END;
  339.  END;
  340. #endif
  341.  errno := ENOSYS;
  342.  RETURN(-1);
  343. END fork;
  344.  
  345. (*---------------------------------------------------------------------------*)
  346.  
  347. PROCEDURE MakeWaitCode ((* EIN/ -- *) retCode : SIGNEDWORD ): SIGNEDWORD;
  348. (*T*)
  349. CONST SIGINT = 2;
  350.  
  351. VAR exit : UNSIGNEDWORD;
  352.     sig  : UNSIGNEDWORD;
  353.     ret  : WORDSET;
  354.  
  355. BEGIN
  356.  IF retCode = -32 THEN
  357.    (* Programm wurde durch 'Ctrl-C' abgebrochen *)
  358.    exit := 0;
  359.    sig  := SIGINT;
  360.  ELSE
  361.    ret  := CAST(WORDSET,retCode);
  362. #if reverse_set
  363.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{8..15});
  364.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{1..7}) DIV 256);
  365. #else
  366.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{0..7});
  367.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{8..14}) DIV 256);
  368. #endif
  369.  END;
  370.  IF (sig <> 0) AND (exit <> 0) AND (exit <> 127) THEN
  371.    (* normaler Returncode, kein Signal *)
  372.    sig := 0;
  373.  END;
  374.  IF (exit = 127) AND (sig <> 0) THEN
  375.    (* Prozess gestoppt *)
  376.    RETURN(retCode); (* ist schon entsprechend kodiert *)
  377.  ELSE
  378.    (* Prozess terminiert, evtl. durch Signal *)
  379.    RETURN(VAL(SIGNEDWORD,exit * 256 + sig));
  380.  END;
  381. END MakeWaitCode;
  382.  
  383. (*---------------------------------------------------------------------------*)
  384.  
  385. PROCEDURE wait ((* -- /AUS *) VAR state : WaitVal ): pidT;
  386. (*T*)
  387. #if MINT
  388. VAR res : RECORD
  389.            CASE TAG_COLON BOOLEAN OF
  390.              FALSE: long : SIGNEDLONG;
  391.             |TRUE : pid  : UNSIGNEDWORD;
  392.                     term : SIGNEDWORD;
  393.            END;
  394.           END;
  395. #endif
  396. BEGIN
  397.  state := WaitVal{};
  398. #if MINT
  399.  IF MiNT = 0 THEN
  400. #endif
  401.    errno := ECHILD;
  402.    RETURN(-1);
  403. #if MINT
  404.  ELSE
  405.    Pwait3(0, LC(0), res.long);
  406.  END;
  407.  IF res.long < EOKL THEN
  408.    errno := INT(res.long);
  409.    RETURN(-1);
  410.  END;
  411.  state := CAST(WaitVal,MakeWaitCode(res.term));
  412.  RETURN(VAL(pidT,res.pid));
  413. #endif
  414. END wait;
  415.  
  416. (*---------------------------------------------------------------------------*)
  417.  
  418. PROCEDURE waitpid ((* EIN/ -- *)     pid     : pidT;
  419.                    (* -- /AUS *) VAR state   : WaitVal;
  420.                    (* EIN/ -- *)     options : WaitOption ): pidT;
  421. (*T*)
  422. #if MINT
  423. VAR res : RECORD
  424.            CASE TAG_COLON BOOLEAN OF
  425.              FALSE: long : SIGNEDLONG;
  426.             |TRUE : pid  : UNSIGNEDWORD;
  427.                     term : SIGNEDWORD;
  428.            END;
  429.           END;
  430. #endif
  431. BEGIN
  432.  state := WaitVal{};
  433. #if MINT
  434.  IF MiNT = 0 THEN
  435. #endif
  436.    errno := ECHILD;
  437.    RETURN(-1);
  438. #if MINT
  439.  ELSIF MiNT < 96 THEN
  440.    IF (pid <> -1) AND (pid <> 0) THEN
  441.      errno := EINVAL;
  442.      RETURN(-1);
  443.    END;
  444.    Pwait3(CAST(UNSIGNEDWORD,options), LC(0), res.long);
  445.  ELSE
  446.    Pwaitpid(VAL(SIGNEDWORD,pid), CAST(UNSIGNEDWORD,options), LC(0), res.long);
  447.  END;
  448.  IF res.long < EOKL THEN
  449.    errno := INT(res.long);
  450.    RETURN(-1);
  451.  END;
  452.  state := CAST(WaitVal,MakeWaitCode(res.term));
  453.  RETURN(VAL(pidT,res.pid));
  454. #endif
  455. END waitpid;
  456.  
  457. (*---------------------------------------------------------------------------*)
  458.  
  459. PROCEDURE WIFEXITED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  460. BEGIN
  461.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig = WaitVal{}));
  462. END WIFEXITED;
  463.  
  464. (*---------------------------------------------------------------------------*)
  465.  
  466. PROCEDURE WEXITSTATUS ((* EIN/ -- *) state : WaitVal ): INTEGER;
  467. BEGIN
  468.  RETURN(INT(CAST(SIGNEDWORD,state * wRetcode) DIV 256));
  469. END WEXITSTATUS;
  470.  
  471. (*---------------------------------------------------------------------------*)
  472.  
  473. PROCEDURE WIFSIGNALED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  474. BEGIN
  475.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig <> WaitVal{}));
  476. END WIFSIGNALED;
  477.  
  478. (*---------------------------------------------------------------------------*)
  479.  
  480. PROCEDURE WTERMSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL;
  481. BEGIN
  482.  RETURN(VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wTermsig)));
  483. END WTERMSIG;
  484.  
  485. (*---------------------------------------------------------------------------*)
  486.  
  487. PROCEDURE WIFSTOPPED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  488. BEGIN
  489.  RETURN(state * wStopval = WSTOPPED);
  490. END WIFSTOPPED;
  491.  
  492. (*---------------------------------------------------------------------------*)
  493.  
  494. PROCEDURE WSTOPSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL;
  495. BEGIN
  496.  RETURN(VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wStopsig) DIV 256));
  497. END WSTOPSIG;
  498.  
  499. (*---------------------------------------------------------------------------*)
  500.  
  501. PROCEDURE Spawn ((* EIN/ -- *)     mode : SpawnMode;
  502. #if has_REF
  503.                  (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  504. #else
  505.                  (* EIN/ -- *) VAR prg  : ARRAY OF CHAR;
  506. #endif
  507.                  (* EIN/ -- *)     argv : StrArray;
  508.                  (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  509. (*T*)
  510. VAR envLen     : UNSIGNEDLONG;
  511.     argPtr     : StrPtr;
  512.     envPtr     : StrPtr;
  513.     mem        : ADDRESS;
  514.     arg        : ArrayRange;
  515.     envIdx     : StrRange;
  516.     envCmd     : StrRange;
  517.     cmdIdx     : StrRange;
  518.     pexec      : UNSIGNEDWORD;
  519.     res        : INTEGER;
  520.     wres       : SIGNEDWORD;
  521.     lres       : SIGNEDLONG;
  522.     childStart : UNSIGNEDLONG;
  523.     dot        : BOOLEAN;
  524.     done       : BOOLEAN;
  525.     ARGV       : ARRAY [0..5] OF CHAR;
  526.     cmdLine    : CmdLine;
  527.     path0      : PathName;
  528.  
  529. PROCEDURE argcpy (arg : StrPtr);
  530. VAR i : StrRange;
  531.     c : CHAR;
  532. BEGIN
  533.  i := 0;
  534.  REPEAT
  535.    c := arg^[i];
  536.    envPtr^[envIdx] := c;
  537.    INC(i);
  538.    INC(envIdx);
  539.  UNTIL c = 0C;
  540. END argcpy;
  541.  
  542. BEGIN
  543.  errno := 0;
  544.  pexec := 0;
  545. #if MINT
  546.  IF MiNT > 0 THEN
  547.    IF mode = pNOWAIT THEN
  548.      pexec := 100;
  549.    ELSIF mode = pOVERLAY THEN
  550.      pexec := 200;
  551.    END;
  552.  ELSIF mode = pNOWAIT THEN
  553. #else
  554.  IF mode = pNOWAIT THEN
  555. #endif
  556.    errno := EINVAL;
  557.    RETURN(-1);
  558.  END;
  559.  
  560.  IF (argv = NULL) OR (argv^[0] = NULL) THEN
  561.    errno := EFAULT;
  562.    RETURN(-1);
  563.  END;
  564.  UnixToDos(prg, path0, dot, done);
  565.  IF NOT done THEN
  566.    RETURN(-1);
  567.  END;
  568.  
  569.  IF envp = NULL THEN
  570.    envp := environ;
  571.  END;
  572.  
  573.  (* Laenge des benoetigten Environments berechnen.
  574.   * Dazu gehoeren entweder das uebergebene oder das aktuelle
  575.   * Environment und die Kommandozeilenargumente einschliesslich
  576.   * des Programmnamens.
  577.   *)
  578.  envLen := 0;
  579.  arg    := 0;
  580.  WHILE argv^[arg] <> NULL DO
  581.    INC(envLen, VAL(UNSIGNEDLONG,LenC(argv^[arg])+1));
  582.    (* + 1, wegen abschliessendem Nullbyte *)
  583.    INC(arg);
  584.  END;
  585.  
  586.  arg := 0;
  587.  WHILE envp^[arg] <> NULL DO
  588.    INC(envLen, VAL(UNSIGNEDLONG,LenC(envp^[arg])+1));
  589.    INC(arg);
  590.  END;
  591.  INC(envLen, 20); (* Platz fuer "ARGV=" & sicherheitshalber etwas mehr *)
  592.  
  593.  (* Benoetigten Speicher anfordern.
  594.   * Wenn nicht genuegend Speicher vorhanden ist, mit Fehlermeldung abbrechen.
  595.   *)
  596.  Malloc(envLen, mem);
  597.  IF mem = NULL THEN
  598.    errno := E2BIG;
  599.    RETURN(-1);
  600.  END;
  601.  envPtr := CAST(StrPtr,mem);
  602.  envIdx := 0;
  603.  
  604.  (* Das Environment mit den Variablen auffuellen *)
  605.  arg := 0;
  606.  WHILE envp^[arg] <> NULL DO
  607.    argcpy(envp^[arg]);
  608.    INC(arg);
  609.  END;
  610.  
  611.  (* Kommandozeile mit ARGV-Verfahren ins Environment schreiben.
  612.   * Beginn der eigentlichen Argumente (nach dem Programmnamen) merken,
  613.   * fuer die Uebertragung in die Basepage-Kommandozeile.
  614.   *)
  615.  ARGV := "ARGV=";
  616.  argcpy(CAST(StrPtr,ADR(ARGV)));
  617.  argcpy(argv^[0]); (* Programmname *)
  618.  envCmd := envIdx; (* Beginn der Argumente *)
  619.  arg := 1;
  620.  WHILE argv^[arg] <> NULL DO
  621.    argcpy(argv^[arg]);
  622.    INC(arg);
  623.  END;
  624.  envPtr^[envIdx]   := 0C; (* Ende des Environments kennzeichnen *)
  625.  envPtr^[envIdx+1] := 0C; (* Falls es keine Argumente gab *)
  626.  
  627.  (* Soviel der Argumente wie moeglich in die Basepage-Kommandozeile
  628.   * uebertragen. ARGV-Verfahren durch den sonst ungueltigen
  629.   * Kommandozeilenlaengenwert 127 signalisieren.
  630.   *)
  631.  cmdLine[0] := CHR(127);
  632.  cmdIdx     := 1;
  633.  WHILE cmdIdx <= 124 DO
  634.    IF envPtr^[envCmd] <> 0C THEN
  635.      cmdLine[cmdIdx] := envPtr^[envCmd];
  636.    ELSIF envPtr^[envCmd+1] <> 0C THEN
  637.      cmdLine[cmdIdx] := ' ';
  638.    ELSE
  639.      cmdLine[cmdIdx] := 0C;
  640.      cmdIdx := 125;
  641.    END;
  642.    INC(cmdIdx);
  643.    INC(envCmd);
  644.  END;
  645.  cmdLine[125] := 0C;
  646.  
  647.  childStart := SysClock();
  648.  Pexec(pexec,ADR(path0),ADR(cmdLine),envPtr,lres);
  649.  INC(CHILDTIME, SysClock() - childStart);
  650.  
  651.  Mfree(envPtr, wres);
  652.  res  := INT(lres);
  653.  wres := VAL(SIGNEDWORD,res);
  654.  IF lres < EOKL THEN
  655.    (* Wenn "Pexec" selbst fehlschlaegt, gibts einen
  656.     * negativen 32-Bit-Wert.
  657.     *)
  658.    errno := res;
  659.    RETURN(-1);
  660.  ELSIF mode = pOVERLAY THEN
  661.    (* Ohne MiNT muss selbst fuer die Beendigung des laufenden
  662.     * Prozesses gesorgt werden. Mit MiNT kehrt der ``Pexec''-Aufruf
  663.     * erst gar nicht zurueck!
  664.     *)
  665.    Pterm(wres);
  666.  ELSIF mode = pWAIT THEN
  667.    RETURN(INT(MakeWaitCode(wres)));
  668.  ELSE
  669.    (* Bei pNOWAIT wird die (positive) Prozess-ID zurueckgegeben *)
  670.    RETURN(res);
  671.  END;
  672. END Spawn;
  673.  
  674. (*---------------------------------------------------------------------------*)
  675.  
  676. PROCEDURE spawnv ((* EIN/ -- *)     mode : SpawnMode;
  677.                   (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  678.                   (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  679. (*T*)
  680. BEGIN
  681.  RETURN(Spawn(mode, prg, argv, environ));
  682. END spawnv;
  683.  
  684. (*---------------------------------------------------------------------------*)
  685.  
  686. PROCEDURE spawnve ((* EIN/ -- *)     mode : SpawnMode;
  687.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  688.                    (* EIN/ -- *)     argv : StrArray;
  689.                    (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  690. (*T*)
  691. BEGIN
  692.  RETURN(Spawn(mode, prg, argv, envp));
  693. END spawnve;
  694.  
  695. (*---------------------------------------------------------------------------*)
  696. #if has_REF
  697. PROCEDURE FindExec ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  698. #else
  699. PROCEDURE FindExec ((* EIN/ -- *) VAR file : ARRAY OF CHAR;
  700. #endif
  701.                     (* -- /AUS *) VAR path : ARRAY OF CHAR ): BOOLEAN;
  702. (*T*)
  703. CONST
  704.   DEFAULTPATH = ".";
  705. #if no_MIN_MAX
  706.   MAXCARD = CAST(CARDINAL,-1);
  707. #else
  708.   MAXCARD = MAX(CARDINAL);
  709. #endif
  710.  
  711. VAR  sIdx,dIdx : INTEGER;
  712.      dtIdx     : CARDINAL;
  713.      stIdx     : CARDINAL;
  714.      fLen      : CARDINAL;
  715.      pLen      : CARDINAL;
  716.      l11, l12  : CARDINAL;
  717.      l21, l22  : CARDINAL;
  718.      st        : StatRec;
  719.      ext       : FileName;
  720.      suffices  : PathName;
  721.      dirs      : PathName;
  722.  
  723. BEGIN
  724.  sIdx := RPOSCHR(0, SUFFIXSEP, file);
  725.  dIdx := RPOSCHRSET(0, "\/", file);
  726.  
  727.  IF dIdx >= 0 THEN
  728.    (* <file> enthaelt einen Pfad -> nur dort suchen.
  729.     * Der Pfad wird aus <file> entfernt.
  730.     *)
  731.    COPY(0, dIdx, file, dirs);
  732.    COPY(dIdx+1, MAXCARD, file, file);
  733.  ELSIF NOT GetEnvVar("PATH", dirs) THEN
  734.    (* <file> hat keinen Pfad und "PATH" existiert nicht.
  735.     * -> nur in 'DEFAULTPATH' suchen.
  736.     *)
  737.    dirs := DEFAULTPATH;
  738.  END;
  739.  
  740.  IF sIdx > dIdx THEN
  741.    (* <file> hat eine Extension -> nur diese probieren.
  742.     * Die Extension wird aus <file> entfernt.
  743.     *)
  744.    COPY(sIdx+1, MAXCARD, file, suffices);
  745.    COPY(0, sIdx, file, file);
  746.  ELSIF NOT GetEnvVar("SUFFIX", suffices) THEN
  747.    (* <file> hat keine Extension und "SUFFIX" existiert nicht.
  748.     * -> Extensionen aus 'EXECSUFFIX' probieren.
  749.     *)
  750.    ASSIGN(EXECSUFFIX, suffices);
  751.  END;
  752.  
  753.  (* Jetzt enthaelt 'dirs' alle zu durchsuchenden Verzeichnisse,
  754.   * 'suffices' alle auszuprobierenden Extensionen und 'file'
  755.   * den ``nackten'' Dateinamen ohne Pfad und Extension.
  756.   *)
  757.  APPENDCHR(".", file); (* Punkt fuer Extension *)
  758.  
  759.  dtIdx := 0; l11 := 0;
  760.  
  761.  (* Jedes Verzeichnis mit allen Extensionen durchprobieren *)
  762.  WHILE TOKEN(dirs, ";,", dtIdx, l11, l12, path) DO
  763.    pLen := SLEN(path);
  764.    IF     (pLen > 0) AND (pLen < PATHMAX-1)
  765.       AND (path[pLen-1] <> DDIRSEP) AND (path[pLen-1] <> XDIRSEP)
  766.    THEN
  767.      path[pLen] := DDIRSEP;
  768.      INC(pLen);
  769.      path[pLen] := EOS;
  770.    END;
  771.    APPEND(file, path); (* 'path': Pfad + Dateiname + Punkt *)
  772.    pLen := SLEN(path);
  773.  
  774.    stIdx := 0; l21 := 0;
  775.    WHILE TOKEN(suffices, ";,", stIdx, l21, l22, ext) DO
  776.      (* Jetzt wird probiert, ob eine Datei mit einer der angegebenen
  777.       * Extensionen im Verzeichnis existiert. Das 'x-Bit' wird nicht
  778.       * beruecksichtigt.
  779.       *)
  780.      IF ext[0] = EOS THEN
  781.        (* Auch ohne Extension versuchen *)
  782.        path[pLen-1] := EOS; (* Ohne Punkt *)
  783.      ELSE
  784.        APPEND(ext, path);   (* Extension anhaengen *)
  785.      END;
  786.      IF (stat(path, st) = 0) AND (st.stMode * sIFMT = sIFREG) THEN
  787.        RETURN(TRUE);
  788.      END;
  789.      path[pLen-1] := '.';   (* Punkt fuer Extension wieder an seinen Platz *)
  790.      path[pLen]   := EOS;   (* Extension wieder entfernen *)
  791.    END;
  792.  END;
  793.  RETURN(FALSE);
  794. END FindExec;
  795.  
  796. (*---------------------------------------------------------------------------*)
  797.  
  798. PROCEDURE spawnvp ((* EIN/ -- *)     mode : SpawnMode;
  799.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  800.                    (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  801. (*T*)
  802. VAR path0 : PathName;
  803. BEGIN
  804.  IF FindExec(prg, path0) THEN
  805.    RETURN(Spawn(mode, path0, argv, environ));
  806.  ELSE
  807.    errno := ENOENT;
  808.    RETURN(-1);
  809.  END;
  810. END spawnvp;
  811.  
  812. (*---------------------------------------------------------------------------*)
  813.  
  814. PROCEDURE execve ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  815.                   (* EIN/ -- *)     argv : StrArray;
  816.                   (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  817. (*T*)
  818. BEGIN
  819.  RETURN(Spawn(pOVERLAY, prg, argv, envp));
  820. END execve;
  821.  
  822. (*---------------------------------------------------------------------------*)
  823.  
  824. PROCEDURE execv ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  825.                  (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  826. (*T*)
  827. BEGIN
  828.  RETURN(Spawn(pOVERLAY, prg, argv, environ));
  829. END execv;
  830.  
  831. (*---------------------------------------------------------------------------*)
  832.  
  833. PROCEDURE execvp ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  834.                   (* EIN/ -- *)     argv : StrArray      ): INTEGER;
  835. (*T*)
  836. VAR path0 : PathName;
  837. BEGIN
  838.  IF FindExec(prg, path0) THEN
  839.    RETURN(Spawn(pOVERLAY, path0, argv, environ));
  840.  ELSE
  841.    errno := ENOENT;
  842.    RETURN(-1);
  843.  END;
  844. END execvp;
  845.  
  846. (*---------------------------------------------------------------------------*)
  847.  
  848. PROCEDURE Exit ((* EIN/ -- *) retval : INTEGER );
  849. (*T*)
  850. BEGIN
  851.  Pterm(VAL(SIGNEDWORD,retval));
  852. END Exit;
  853.  
  854. (*---------------------------------------------------------------------------*)
  855.  
  856. PROCEDURE times ((* -- /AUS *) VAR buf : TmsRec ): clockT;
  857. (**)
  858. VAR clock : UNSIGNEDLONG;
  859. #if MINT
  860.     usage : ARRAY [0..7] OF UNSIGNEDLONG;
  861. #endif
  862. BEGIN
  863.  clock := SysClock();
  864. #if MINT
  865.  IF MiNT > 0 THEN
  866.    Prusage(ADR(usage));
  867.    WITH buf DO
  868.      tmsUtime  := usage[1] DIV LC(5);
  869.      tmsStime  := usage[0] DIV LC(5);
  870.      tmsCUtime := usage[3] DIV LC(5);
  871.      tmsCStime := usage[2] DIV LC(5);
  872.    END;
  873.  ELSE
  874. #endif
  875.    WITH buf DO
  876.      tmsUtime  := VAL(clockT,clock - CHILDTIME);
  877.      tmsStime  := 0; (* nicht feststellbar *)
  878.      tmsCUtime := VAL(clockT,CHILDTIME);
  879.      tmsCStime := 0; (* nicht feststellbar *)
  880.    END;
  881. #if MINT
  882.  END;
  883. #endif
  884.  RETURN(VAL(clockT,clock));
  885. END times;
  886.  
  887. (*===========================================================================*)
  888.  
  889. BEGIN
  890. #if MINT
  891.  MiNT      := MiNTVersion();
  892. #endif
  893.  CHILDTIME := 0;
  894. END proc.
  895.