home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / m2posx14 / src / proc.ipp < prev    next >
Encoding:
Modula Implementation  |  1994-05-31  |  49.7 KB  |  1,940 lines
  1. IMPLEMENTATION MODULE proc;
  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. (* 31-Mai-94, Holger Kleinschmidt                                            *)
  17. (*****************************************************************************)
  18.  
  19. VAL_INTRINSIC
  20. CAST_IMPORT
  21. INLINE_CODE_IMPORT
  22. PTR_ARITH_IMPORT
  23.  
  24. FROM SYSTEM IMPORT
  25. (* TYPE *) ADDRESS,
  26. (* PROC *) ADR, TSIZE;
  27. #ifdef MM2
  28. FROM SYSTEM IMPORT (* PROC *) CADR;
  29. FROM MOSCtrl IMPORT (* VAR  *) ActMOSProcess, BaseProcess;
  30. #endif
  31.  
  32. FROM PORTAB IMPORT
  33. (* CONST*) NULL,
  34. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, ANYLONG,
  35.            WORDSET;
  36.  
  37. FROM types IMPORT
  38. (* CONST*) EOS, SUFFIXSEP, DDIRSEP, XDIRSEP, MAXSTR, PATHMAX,
  39. (* TYPE *) int, unsigned, long, sizeT, uidT, gidT, pidT, clockT, StrArray,
  40.            StrPtr, StrRange, ArrayRange;
  41.  
  42. FROM MEMBLK IMPORT
  43. (* PROC *) memalloc, memdealloc, memset;
  44.  
  45. FROM pLONGSET IMPORT
  46. (* PROC *) INlong, INCLlong, EXCLlong, MASKlong;
  47.  
  48. FROM OSCALLS IMPORT
  49. (* PROC *) Pgetpid, Pgetppid, Pgetuid, Pgetgid, Pgeteuid, Pgetegid, Psetuid,
  50.            Psetgid, Pgetpgrp, Psetpgrp, Pfork, Pwait3, Pwaitpid, Malloc, Mfree,
  51.            Mshrink, Pexec, Pterm, Prusage, Fclose, Fattrib, Fselect, Dgetdrv,
  52.            Dsetdrv, Dsetpath, Fcntl, Fopen, Fforce;
  53.  
  54. FROM ctype IMPORT
  55. (* PROC *) tocard, todigit;
  56.  
  57. FROM cstr IMPORT
  58. (* PROC *) strlen, strcpy, strncpy, strrchr, strlwr, Token;
  59.  
  60. FROM pSTRING IMPORT
  61. (* PROC *) SLEN;
  62.  
  63. FROM cmdline IMPORT
  64. (* VAR  *) environ,
  65. (* PROC *) getenv, GetEnvVar;
  66.  
  67. IMPORT e;
  68.  
  69. FROM DosSupport IMPORT
  70. (* CONST*) TOSEXT, DINCR, XDECR, MinHandle, MaxHandle, MINSIG, MAXSIG,
  71. (* TYPE *) FileType, HandleRange, FileAttributes, FileAttribute, DosHandler,
  72. (* VAR  *) FD, SIGMASK, SIGPENDING, SIGHANDLER,
  73. (* PROC *) CompletePath, UnixToDos, DosToUnix, IsTerm;
  74.  
  75. FROM DosSystem IMPORT
  76. (* TYPE *) CmdLine, BasePtr, BasePage,
  77. (* VAR  *) BASEP,
  78. (* PROC *) SysClock, DosPid, DgetcwdAvail, MiNTVersion;
  79.  
  80. FROM sig IMPORT
  81. (* CONST*) NSIG, SIGCHLD,
  82. (* PROC *) raise;
  83.  
  84. (*==========================================================================*)
  85.  
  86. CONST
  87.   EOKL = LIC(0);
  88.  
  89. CONST
  90.   BPSIZE = 256; (* Groesse einer Basepage *)
  91.  
  92. TYPE
  93.   LONGfdset = RECORD
  94.     CASE TAG_COLON BOOLEAN OF
  95.       FALSE: fdset  : fdSet;
  96.      |TRUE : fdlong : UNSIGNEDLONG;
  97.     END;
  98.   END;
  99.  
  100. (* Lokale Umdefinition der Basepage fuer "tfork()" *)
  101. TYPE
  102.   BPtr  = POINTER TO BPage;
  103.   BPage = RECORD
  104.     lowtpa : ADDRESS;
  105.     hitpa  : ADDRESS;
  106.     tbase  : PROC;
  107.     tlen   : UNSIGNEDLONG;
  108.     dbase  : ADDRESS;
  109.     dlen   : UNSIGNEDLONG;
  110.     bbase  : ADDRESS;
  111.     blen   : UNSIGNEDLONG;
  112.     dta    : ADDRESS;
  113.     parent : BPtr;
  114.     res1   : UNSIGNEDLONG;
  115.     env    : ADDRESS;
  116.     res2   : ARRAY [0..49] OF ANYLONG;
  117.     (* Die restlichen zwei Langworte der Kommandozeile
  118.        (die leer ist) dienen als Zwischenspeicher fuer
  119.        die Uebergabe des ``Thread'' und dessen Parameter.
  120.      *)
  121.     tProc  : ThreadProc;
  122.     tArg   : ANYLONG;
  123.   END;
  124.  
  125. TYPE
  126.   WaitCode =  RECORD
  127.     CASE TAG_COLON BOOLEAN OF
  128.       FALSE: long : SIGNEDLONG;
  129.      |TRUE : pid  : UNSIGNEDWORD;
  130.              term : SIGNEDWORD;
  131.     END;
  132.   END;
  133.  
  134. CONST
  135.   MAXLOGIN = 32;
  136.  
  137. VAR
  138.   loginbuf  : ARRAY [0..MAXLOGIN] OF CHAR;
  139.   MiNT      : BOOLEAN; (* Ist MiNT vorhanden ? *)
  140.   hasDgetcwd: BOOLEAN; (* Wird Dgetcwd unterstuetzt *)
  141.   DefExt    : ARRAY [0..29] OF CHAR;
  142.   DefPath   : ARRAY [0..1] OF CHAR;
  143.   Delim     : ARRAY [0..2] OF CHAR;
  144.   nulp      : ARRAY [0..15] OF CHAR;
  145.   Stacksize : CARDINAL;
  146.   CHILDTIME : UNSIGNEDLONG;
  147.   WAITTIME  : UNSIGNEDLONG;
  148.   WAITVAL   : WaitCode;
  149.   errnoADR  : ADDRESS;
  150.   tforkADR  : ADDRESS;
  151.   mintADR   : ADDRESS;
  152.   saveADR   : ADDRESS;
  153. #if (defined LPRM2) || (defined SPCM2)
  154.   regsave   : ARRAY [0..3] OF ADDRESS;
  155. #elif (defined TDIM2)
  156.   regsave   : ARRAY [0..2] OF ADDRESS;
  157. #elif (defined HM2)
  158.   regsave   : ARRAY [0..12] OF ADDRESS;
  159. #elif (defined MM2)
  160.   regsave   : ARRAY [0..10] OF ADDRESS;
  161.   bpsave1   : ADDRESS;
  162.   bpsave2   : ADDRESS;
  163. #endif
  164.  
  165. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  166.  
  167. PROCEDURE chdir ((* EIN/ -- *) REF dir : ARRAY OF CHAR ): int;
  168.  
  169. VAR old   : CARDINAL;
  170.     res   : INTEGER;
  171.     drvs  : UNSIGNEDLONG;
  172.     dot   : BOOLEAN;
  173.     done  : BOOLEAN;
  174.     start : UNSIGNEDWORD;
  175.     stack : ADDRESS;
  176.     msize : CARDINAL;
  177.     path0 : StrPtr;
  178.  
  179. BEGIN
  180.  msize := SLEN(dir) + DINCR;
  181.  memalloc(VAL(sizeT,msize), stack, path0);
  182.  UnixToDos(CAST(StrPtr,REFADR(dir)), msize - DINCR, VAL(StrRange,msize), path0,
  183.            dot, done);
  184.  IF NOT done THEN
  185.    memdealloc(stack);
  186.    RETURN(-1);
  187.  END;
  188.  
  189.  (* aktuelles Laufwerk merken, fuer Fehlerfall *)
  190.  old := Dgetdrv();
  191.  
  192.  start := 0;
  193.  IF path0^[0] = 0C THEN
  194.    path0^[0] := DDIRSEP;
  195.    path0^[1] := 0C;
  196.  ELSIF path0^[1] = ':' THEN
  197.    (* neues Laufwerk setzen *)
  198.    drvs  := Dsetdrv(tocard(path0^[0]) - 10);
  199.    start := 2;
  200.  END;
  201.  
  202.  (* Pfad ohne Laufwerksangabe setzen *)
  203.  IF Dsetpath(ADDADR(path0, start), res) THEN
  204.    res := 0;
  205.  ELSE
  206.    e.errno := res;
  207.    drvs    := Dsetdrv(old);
  208.    res     := -1;
  209.  END;
  210.  memdealloc(stack);
  211.  RETURN(res);
  212. END chdir;
  213.  
  214. (*---------------------------------------------------------------------------*)
  215.  
  216. PROCEDURE getcwd ((* EIN/ -- *) buf    : StrPtr;
  217.                   (* EIN/ -- *) bufsiz : sizeT  ): StrPtr;
  218.  
  219. VAR err   : INTEGER;
  220.     dlen  : INTEGER;
  221.     xlen  : INTEGER;
  222.     str1  : ARRAY [0..0] OF CHAR;
  223.     stack : ADDRESS;
  224.     msize : StrRange;
  225.     path0 : StrPtr;
  226.  
  227. BEGIN
  228.  IF VAL(sizeT,MAXSTR) < bufsiz THEN
  229.    bufsiz := VAL(sizeT,MAXSTR);
  230.  END;
  231.  msize := VAL(StrRange,bufsiz) + XDECR;
  232.  IF NOT hasDgetcwd AND (msize < PATHMAX) THEN
  233.    (* mindestens PATHMAX Zeichen Puffer fuer TOS bereitstellen *)
  234.    msize := PATHMAX;
  235.  END;
  236.  memalloc(VAL(sizeT,msize), stack, path0);
  237.  str1[0] := 0C;
  238.  IF CompletePath(CAST(StrPtr,ADR(str1)), msize, path0, dlen, err) THEN
  239.    DosToUnix(path0, VAL(StrRange,bufsiz), buf, dlen, xlen);
  240.    memdealloc(stack);
  241.    IF VAL(sizeT,xlen) < bufsiz THEN
  242.      RETURN(buf);
  243.    ELSE
  244.      e.errno := e.ERANGE;
  245.      RETURN(NULL);
  246.    END;
  247.  ELSIF err = e.eRANGE THEN
  248.    e.errno := e.ERANGE;
  249.  ELSE
  250.    e.errno := err;
  251.  END;
  252.  memdealloc(stack);
  253.  RETURN(NULL);
  254. END getcwd;
  255.  
  256. (*--------------------------------------------------------------------------*)
  257.  
  258. PROCEDURE getlogin ( ): StrPtr;
  259. BEGIN
  260.  IF GetEnvVar("LOGNAME", loginbuf) THEN
  261.    (* 'LOGNAME' existiert und hat einen Wert *)
  262.    loginbuf[MAXLOGIN] := 0C;
  263.  ELSIF Pgetuid() <= 0 THEN
  264.    loginbuf := "root";
  265.  ELSE
  266.    RETURN(NULL);
  267.  END;
  268.  RETURN(ADR(loginbuf));
  269. END getlogin;
  270.  
  271. (*--------------------------------------------------------------------------*)
  272.  
  273. PROCEDURE getpid ( ): pidT;
  274.  
  275. VAR pid : INTEGER;
  276.  
  277. BEGIN
  278.  pid := Pgetpid();
  279.  IF pid < 0 THEN
  280.    (* Aufruf wird nicht unterstuetzt *)
  281.    RETURN(DosPid(BASEP));
  282.  ELSE
  283.    RETURN(pid);
  284.  END;
  285. END getpid;
  286.  
  287. (*---------------------------------------------------------------------------*)
  288.  
  289. PROCEDURE getppid ( ): pidT;
  290.  
  291. VAR pid : INTEGER;
  292.  
  293. BEGIN
  294.  pid := Pgetppid();
  295.  IF pid < 0 THEN
  296.    (* Aufruf wird nicht unterstuetzt *)
  297.    RETURN(DosPid(BASEP^.pParent));
  298.  ELSE
  299.    RETURN(pid);
  300.  END;
  301. END getppid;
  302.  
  303. (*---------------------------------------------------------------------------*)
  304.  
  305. PROCEDURE getuid ( ): uidT;
  306.  
  307. VAR uid : INTEGER;
  308.  
  309. BEGIN
  310.  uid := Pgetuid();
  311.  IF uid < 0 THEN
  312.    (* Aufruf wird nicht unterstuetzt *)
  313.    RETURN(0);
  314.  ELSE
  315.    RETURN(VAL(uidT,uid));
  316.  END;
  317. END getuid;
  318.  
  319. (*---------------------------------------------------------------------------*)
  320.  
  321. PROCEDURE getgid ( ): gidT;
  322.  
  323. VAR gid : INTEGER;
  324.  
  325. BEGIN
  326.  gid := Pgetgid();
  327.  IF gid < 0 THEN
  328.    (* Aufruf wird nicht unterstuetzt *)
  329.    RETURN(0);
  330.  ELSE
  331.    RETURN(VAL(gidT,gid));
  332.  END;
  333. END getgid;
  334.  
  335. (*---------------------------------------------------------------------------*)
  336.  
  337. PROCEDURE geteuid ( ): uidT;
  338.  
  339. VAR uid : INTEGER;
  340.  
  341. BEGIN
  342.  uid := Pgeteuid();
  343.  IF uid < 0 THEN
  344.    (* Aufruf wird nicht unterstuetzt *)
  345.    RETURN(0);
  346.  ELSE
  347.    RETURN(VAL(uidT,uid));
  348.  END;
  349. END geteuid;
  350.  
  351. (*---------------------------------------------------------------------------*)
  352.  
  353. PROCEDURE getegid ( ): gidT;
  354.  
  355. VAR gid : INTEGER;
  356.  
  357. BEGIN
  358.  gid := Pgetegid();
  359.  IF gid < 0 THEN
  360.    (* Aufruf wird nicht unterstuetzt *)
  361.    RETURN(0);
  362.  ELSE
  363.    RETURN(VAL(gidT,gid));
  364.  END;
  365. END getegid;
  366.  
  367. (*---------------------------------------------------------------------------*)
  368.  
  369. PROCEDURE setuid ((* EIN/ -- *) uid : uidT ): int;
  370.  
  371. VAR res : INTEGER;
  372.  
  373. BEGIN
  374.  IF Psetuid(uid, res) THEN
  375.    RETURN(0);
  376.  ELSIF res <> e.eINVFN THEN
  377.    (* Aufruf wird unterstuetzt, anderer Fehler *)
  378.    IF res = e.eACCDN THEN
  379.      e.errno := e.EPERM;
  380.    ELSE
  381.      e.errno := res;
  382.    END;
  383.    RETURN(-1);
  384.  ELSIF uid = 0 THEN
  385.    RETURN(0);
  386.  ELSE
  387.    e.errno := e.EINVAL;
  388.    RETURN(-1);
  389.  END;
  390. END setuid;
  391.  
  392. (*---------------------------------------------------------------------------*)
  393.  
  394. PROCEDURE setgid ((* EIN/ -- *) gid : gidT ): int;
  395.  
  396. VAR res : INTEGER;
  397.  
  398. BEGIN
  399.  IF Psetgid(gid, res) THEN
  400.    RETURN(0);
  401.  ELSIF res <> e.eINVFN THEN
  402.    (* Aufruf wird unterstuetzt, anderer Fehler *)
  403.    IF res = e.eACCDN THEN
  404.      e.errno := e.EPERM;
  405.    ELSE
  406.      e.errno := res;
  407.    END;
  408.    RETURN(-1);
  409.  ELSIF gid = 0 THEN
  410.    RETURN(0);
  411.  ELSE
  412.    e.errno := e.EINVAL;
  413.    RETURN(-1);
  414.  END;
  415. END setgid;
  416.  
  417. (*---------------------------------------------------------------------------*)
  418.  
  419. PROCEDURE seteuid ((* EIN/ -- *) uid : uidT ): int;
  420. BEGIN
  421.  RETURN(setuid(uid));
  422. END seteuid;
  423.  
  424. (*---------------------------------------------------------------------------*)
  425.  
  426. PROCEDURE setegid ((* EIN/ -- *) gid : gidT ): int;
  427. BEGIN
  428.  RETURN(setgid(gid));
  429. END setegid;
  430.  
  431. (*---------------------------------------------------------------------------*)
  432.  
  433. PROCEDURE setreuid ((* EIN/ -- *) ruid : uidT;
  434.                     (* EIN/ -- *) euid : uidT ): int;
  435. BEGIN
  436.  RETURN(setuid(euid));
  437. END setreuid;
  438.  
  439. (*---------------------------------------------------------------------------*)
  440.  
  441. PROCEDURE setregid ((* EIN/ -- *) rgid : gidT;
  442.                     (* EIN/ -- *) egid : gidT ): int;
  443. BEGIN
  444.  RETURN(setgid(egid));
  445. END setregid;
  446.  
  447. (*---------------------------------------------------------------------------*)
  448.  
  449. PROCEDURE getpgrp ( ): pidT;
  450.  
  451. VAR pid : INTEGER;
  452.  
  453. BEGIN
  454.  pid := Pgetpgrp();
  455.  IF pid < 0 THEN
  456.    (* Aufruf wird nicht unterstuetzt *)
  457.    RETURN(DosPid(BASEP));
  458.  ELSE
  459.    RETURN(pid);
  460.  END;
  461. END getpgrp;
  462.  
  463. (*---------------------------------------------------------------------------*)
  464.  
  465. PROCEDURE setpgid ((* EIN/ -- *) pid  : pidT;
  466.                    (* EIN/ -- *) pgid : pidT ): int;
  467.  
  468. VAR PID : INTEGER;
  469.  
  470. BEGIN
  471.  IF (pid < 0) OR (pgid < 0) THEN
  472.    e.errno := e.EINVAL;
  473.    RETURN(-1);
  474.  END;
  475.  
  476.  IF pgid = 0 THEN
  477.    PID := Pgetpid();
  478.  ELSE
  479.    PID := pgid;
  480.  END;
  481.  
  482.  IF PID >= 0 THEN
  483.    IF Psetpgrp(pid, PID, PID) THEN
  484.      RETURN(0);
  485.    ELSIF PID <> e.eINVFN THEN
  486.      (* 'Pgetpgrp'-Aufruf wird unterstuetzt, anderer Fehler *)
  487.      IF PID = e.eACCDN THEN
  488.        e.errno := e.ESRCH;
  489.      ELSE
  490.        e.errno := PID;
  491.      END;
  492.      RETURN(-1);
  493.    END;
  494.  END;
  495.  
  496.  (* 'Pgetpid'- und/oder 'Pgetpgrp'-Aufruf wird nicht unterstuetzt *)
  497.  PID := DosPid(BASEP);
  498.  IF    ((pid  = 0) OR (pid  = PID))
  499.    AND ((pgid = 0) OR (pgid = PID))
  500.  THEN
  501.    RETURN(0);
  502.  ELSE
  503.    e.errno := e.EINVAL;
  504.    RETURN(-1);
  505.  END;
  506. END setpgid;
  507.  
  508. (*--------------------------------------------------------------------------*)
  509.  
  510. PROCEDURE setsid ( ): pidT;
  511.  
  512. CONST TIOCGPGRP = 5406H; (* ('T'<<8)|6 *)
  513.       TIOCSPGRP = 5407H; (* ('T'<<8)|7 *)
  514.       RDWR = 2;
  515.  
  516. VAR pgrp : INTEGER;
  517.     pid  : INTEGER;
  518.     nulh : INTEGER;
  519.     arg  : SIGNEDLONG;
  520.     lres : SIGNEDLONG;
  521.     res  : INTEGER;
  522.     void : BOOLEAN;
  523.  
  524. BEGIN
  525.  pgrp := Pgetpgrp();
  526.  pid  := Pgetpid();
  527.  IF (pgrp < 0) OR (pid < 0) OR (pgrp = pid) THEN
  528.    (* Prozess ist bereits ``process group leader'', darf
  529.     * kein "setsid()" ausfuehren.
  530.     * (Oder die Aufrufe werden nicht unterstuetzt)
  531.     *)
  532.    e.errno := e.EPERM;
  533.    RETURN(-1);
  534.  END;
  535.  
  536.  IF IsTerm(-1) THEN
  537.    (* Wenn das Kontrollterminal dieser Prozessgruppe zugeordent ist,
  538.     * Prozessgruppe loeschen.
  539.     *)
  540.    IF Fcntl(-1, ADR(arg), TIOCGPGRP, lres) THEN
  541.      IF arg = VAL(SIGNEDLONG,pgrp) THEN
  542.        arg := 0;
  543.        IF NOT Fcntl(-1, ADR(arg), TIOCSPGRP, lres) THEN
  544.          e.errno := INT(lres);
  545.          RETURN(-1);
  546.        END;
  547.      END;
  548.    ELSE
  549.      e.errno := INT(lres);
  550.      RETURN(-1);
  551.    END;
  552.    (* Kontrollterminal auf /dev/null umlenken *)
  553.    IF Fopen(ADR(nulp), RDWR, nulh) THEN
  554.      void := Fforce(-1, nulh, res);
  555.      void := Fclose(nulh, res);
  556.      FD[VAL(HandleRange,-1)].ftype := unknown;
  557.    ELSE
  558.      e.errno := nulh;
  559.      RETURN(-1);
  560.    END;
  561.  END;
  562.  
  563.  (* Neue Prozessgruppe hat die Kennung des aufrufenden Prozesses. *)
  564.  IF Psetpgrp(0, 0, pgrp) THEN
  565.    RETURN(pgrp);
  566.  ELSE
  567.    IF pgrp = e.eACCDN THEN
  568.      e.errno := e.ESRCH;
  569.    ELSE
  570.      e.errno := pgrp;
  571.    END;
  572.    RETURN(-1);
  573.  END;
  574. END setsid;
  575.  
  576. (*--------------------------------------------------------------------------*)
  577.  
  578. PROCEDURE fork ( ): pidT;
  579.  
  580. VAR pid : INTEGER;
  581.  
  582. BEGIN
  583.  pid := Pfork();
  584.  IF pid >= 0 THEN
  585.    RETURN(pid);
  586.  ELSE
  587.    e.errno := pid;
  588.    RETURN(-1);
  589.  END;
  590. END fork;
  591.  
  592. (*---------------------------------------------------------------------------*)
  593.  
  594. PROCEDURE MakeWaitVal ((* EIN/ -- *) retCode : SIGNEDWORD ): SIGNEDWORD;
  595.  
  596. CONST SIGINT = 2;
  597.  
  598. VAR __REG__ exit : UNSIGNEDWORD;
  599.     __REG__ sig  : UNSIGNEDWORD;
  600.     __REG__ ret  : WORDSET;
  601.  
  602. BEGIN
  603.  IF retCode = -32 THEN
  604.    (* Programm wurde durch 'Ctrl-C' abgebrochen *)
  605.    exit := 0;
  606.    sig  := SIGINT;
  607.  ELSE
  608.    ret  := CAST(WORDSET,retCode);
  609. #if reverse_set
  610.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{8..15});
  611.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{1..7}) DIV 256);
  612. #else
  613.    exit := CAST(UNSIGNEDWORD,ret * WORDSET{0..7});
  614.    sig  := VAL(UNSIGNEDWORD,CAST(UNSIGNEDWORD,ret * WORDSET{8..14}) DIV 256);
  615. #endif
  616.  END;
  617.  IF sig >= NSIG THEN
  618.    (* Kann kein Signal sein *)
  619.    sig := 0;
  620.  END;
  621.  IF (sig <> 0) AND (exit <> 0) AND (exit <> 127) THEN
  622.    (* normaler Returncode, kein Signal *)
  623.    sig := 0;
  624.  END;
  625.  IF (exit = 127) AND (sig <> 0) THEN
  626.    (* Prozess gestoppt *)
  627.    RETURN(retCode); (* ist schon entsprechend kodiert *)
  628.  ELSE
  629.    (* Prozess terminiert, evtl. durch Signal *)
  630.    RETURN(VAL(SIGNEDWORD,exit * 256 + sig));
  631.  END;
  632. END MakeWaitVal;
  633.  
  634. (*---------------------------------------------------------------------------*)
  635.  
  636. PROCEDURE SetStacksize ((* EIN/ -- *) stacksize : CARDINAL);
  637. BEGIN
  638.  IF stacksize < MINSTACKSIZE THEN
  639.    Stacksize := BPSIZE + MINSTACKSIZE;
  640.  ELSE
  641.    Stacksize := BPSIZE + stacksize;
  642.  END;
  643. END SetStacksize;
  644.  
  645. (*---------------------------------------------------------------------------*)
  646.  
  647. __STACKCHECK_OFF__
  648. #if (defined HM2)
  649. (*$E+ lokale Prozedur als Parameter *)
  650. #endif
  651. PROCEDURE startup;
  652. (* Diese Prozedur ist die erste Anweisung, die nach dem "Pexec()" in
  653.  * "tfork()" ausgefuehrt wird. An ihrer Stelle staende normalerweise
  654.  * die Initialisierungsroutine eines gestarteten Programms. Aus diesem
  655.  * Grund hat auch lediglich Register A7 einen definierten Wert! A7 zeigt
  656.  * auf das Ende der TPA, und ueber 4(A7) ist die Adresse der eigenen Basepage
  657.  * erreichbar.
  658.  * Falls der M2-Compiler beim Beginn der Prozedur erwartet, dass
  659.  * bestimmte Register definierte Werte haben (z.B. Megamax: A3 ist der
  660.  * Parameterstack!), muessen diese Register entsprechend gesetzt werden,
  661.  * bevor auf sie zugegriffen wird.
  662.  *)
  663. VAR b : BPtr;
  664.  
  665. BEGIN
  666. #if (defined MM2)
  667.   CODE(202DH,0008H); (* move.l 8(A5),D0 *)
  668. #elif (defined HM2) || (defined TDIM2)
  669.   CODE(202EH,0008H); (* move.l 8(A6),D0 *)
  670. #elif (defined LPRM2) || (defined SPCM2)
  671.   INLINE(202EH,000CH); (* move.l 12(A6),D0 *)
  672. #endif
  673.   GETREGADR(0, b);
  674. #ifdef MM2
  675.   (* A3 auf Stackanfang setzen, direkt hinter die Basepage *)
  676.   SETREG(11, ADDADR(b, BPSIZE));
  677. #endif
  678.  
  679.   WITH b^ DO
  680.     Pterm(tProc(tArg));
  681.   END;
  682. END startup;
  683. #if (defined HM2)
  684. (*$E=*)
  685. #endif
  686. __STACKCHECK_PREV__
  687.  
  688. (*---------------------------------------------------------------------------*)
  689.  
  690. PROCEDURE tfork ((* EIN/ -- *) func : ThreadProc;
  691.                  (* EIN/ -- *) arg  : ANYLONG    ): int;
  692.  
  693. VAR b       : BPtr;
  694.     pid     : SIGNEDLONG;
  695.     ret     : SIGNEDLONG;
  696.     err     : INTEGER;
  697.     ch      : CHAR;
  698.     done    : BOOLEAN;
  699.     void    : BOOLEAN;
  700.     start   : UNSIGNEDLONG;
  701.     base    : BasePtr;
  702.     mask    : UNSIGNEDLONG;
  703.     pending : UNSIGNEDLONG;
  704.     handler : DosHandler;
  705.  
  706. BEGIN
  707.   ch := 0C;
  708.   IF Pexec(5, NULL, ADR(ch), NULL, ret) THEN
  709.     b    := CAST(BPtr,MAKEADR(ret));
  710.     void := Mshrink(b, VAL(SIGNEDLONG,Stacksize), err);
  711.  
  712.     WITH b^ DO WITH BASEP^ DO
  713.       (* Das Setzen des TPA-Endes ist wichtig fuer das
  714.        * nachfolgende "Pexec()", dorthin wird naemlich der
  715.        * Stack (A7) des neuen Prozesses gesetzt !
  716.        *)
  717.       hitpa := ADDADR(b, Stacksize);
  718.       tbase := startup;
  719.       tlen  := pTlen; (* ? *)
  720.       bbase := pBbase;
  721.       blen  := pBlen;
  722.       dbase := pDbase;
  723.       dlen  := pDlen;
  724.  
  725.       (* Parameter in der unbenoetigten Basepage-Kommandozeile uebergeben *)
  726.       tProc  := func;
  727.       tArg   := arg;
  728.     END; END;
  729.     IF MiNT THEN
  730.       done := Pexec(104, NULL, b, NULL, pid);
  731.     ELSE
  732.       (* Programm hat eine neue Basepage, deshalb die alte merken *)
  733.       base  := BASEP;
  734.       BASEP := CAST(BasePtr,b);
  735.  
  736.       (* Dos-Emulations-Variablen fuer Signale sichern *)
  737.       mask    := SIGMASK;
  738.       pending := SIGPENDING;
  739.       handler := SIGHANDLER;
  740.       (* keine Signale blockiert *)
  741.       SIGMASK := 0;
  742.  
  743.       start := SysClock();
  744.       done  := Pexec(4, NULL, b, NULL, pid);
  745.  
  746.       (* Jetzt gilt wieder die alte Basepage *)
  747.       BASEP := base;
  748.  
  749.       (* Die alten Signalhandler gelten wieder *)
  750.       SIGMASK    := mask;
  751.       SIGPENDING := pending;
  752.       SIGHANDLER := handler;
  753.  
  754.       IF done THEN
  755.         WAITTIME := SysClock() - start;
  756.         INC(CHILDTIME, WAITTIME);
  757.         WAITVAL.term := VAL(SIGNEDWORD,pid);
  758.         (* Aus der Basepageadresse eine Prozesskennung berechnen *)
  759.         pid := VAL(SIGNEDLONG,DosPid(b));
  760.         WAITVAL.pid := VAL(UNSIGNEDWORD,pid);
  761.         err := raise(SIGCHLD);
  762.       END;
  763.     END;
  764.     (* Der Speicher fuer Basepage und Environment gehoert dem
  765.      * aufrufenden Prozess; er wird deshalb nicht automatisch nach
  766.      * Beendigung des Unterprozesses freigegeben.
  767.      *)
  768.     void := Mfree(b^.env, err);
  769.     void := Mfree(b, err);
  770.  
  771.     IF done THEN
  772.       RETURN(INT(pid)); (* Eine gueltige Prozesskennung ist immer positiv *)
  773.     ELSE
  774.       e.errno := INT(pid);
  775.       RETURN(-1);
  776.     END;
  777.   ELSE
  778.     e.errno := INT(ret);
  779.     RETURN(-1);
  780.   END;
  781. END tfork;
  782.  
  783. (*---------------------------------------------------------------------------*)
  784.  
  785. #if (defined LPRM2) || (defined SPCM2)
  786.  
  787. PROCEDURE vfork ( ): pidT;
  788. BEGIN
  789. (*
  790.   movea.l (SP)+,A6       ; alter Framepointer vom Stack retten
  791.   movea.l (SP)+,A3       ; alte Modulbasis vom Stack retten
  792.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  793. ;; SETREG(8, mintADR);
  794.   tst.b   (A0)
  795.   beq.s   tos
  796.   move.w  #$0113,-(SP)   ; Pvfork
  797.   trap    #1             ;
  798.   addq.l  #2,SP          ;
  799.   tst.w   D0
  800.   bmi.s   err
  801.   bra.s   ende
  802. tos:
  803.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  804.   nop                    ;;
  805.   movem.l A1/A3/A5-A6,(A0)
  806.   subq.l  #2,SP          ; Platz fuer Funktionswert
  807.   pea     child(PC)      ; tfork(child, saveADR);
  808.   pea     (A0)           ;
  809.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  810.   nop                    ;;
  811.   jsr     (A0)
  812.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  813.   nop                    ;;
  814.   move.w  (SP)+,D0
  815.   movem.l (A0),A1/A3/A5-A6
  816.   bmi.s   err
  817.   bra.s   ende
  818.  
  819. child:
  820.   addq.l  #4,SP          ; RTN-Adresse weg
  821.   movea.l (SP)+,A0       ; a0 := saveADR
  822.   movem.l (A0),A1/A3/A5-A6
  823.   moveq   #0,D0
  824.   bra.s   ende
  825.  
  826. err:
  827.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  828.   nop                    ;;
  829.   move.w  D0,(A0)        ; e.errno setzen
  830.   moveq   #-1,D0
  831.  
  832. ende:
  833.   move.w  D0,(SP)
  834.   movea.l A3,A4          ; alte Modulbasis setzen
  835.   jmp     (A1)
  836. *)
  837.  CODE(2C5FH,265FH,225FH);
  838.  SETREG(8, mintADR);
  839.  CODE(4A10H,670EH,3F3CH,0113H,4E41H,548FH,4A40H,6B32H,6038H);
  840.  SETREG(8, saveADR);
  841.  CODE(48D0H,6A00H,558FH,487AH,0018H,4850H);
  842.  SETREG(8, tforkADR);
  843.  CODE(4E90H);
  844.  SETREG(8, saveADR);
  845.  CODE(301FH,4CD0H,6A00H,6B0EH,6014H,588FH,205FH,4CD0H,6A00H,7000H,6008H);
  846.  SETREG(8, errnoADR);
  847.  CODE(3080H,70FFH,3E80H,284BH,4ED1H);
  848. END vfork;
  849.  
  850. #elif (defined TDIM2)
  851.  
  852. __PROCFRAME_OFF__
  853. PROCEDURE vfork ( ): pidT;
  854. BEGIN
  855. (*
  856.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  857. ;; SETREG(8, mintADR);
  858.   tst.b   (A0)
  859.   beq.s   tos
  860.   move.w  #$0113,-(SP)   ; Pvfork
  861.   trap    #1             ;
  862.   addq.l  #2,SP          ;
  863.   tst.w   D0
  864.   bmi.s   err
  865.   bra.s   ende
  866. tos:
  867.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  868.   nop                    ;;
  869.   nop                    ;;
  870.   movem.l A1/A5/A6,(A0)
  871.   subq.l  #2,SP          ; Platz fuer Funktionswert
  872.   pea     child(PC)      ; tfork(child, saveADR);
  873.   pea     (A0)           ;
  874.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  875.   nop                    ;;
  876.   nop                    ;;
  877.   jsr     (A0)
  878.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  879.   nop                    ;;
  880.   nop                    ;;
  881.   addq.l  #8,SP
  882.   move.w  (SP)+,D0
  883.   movem.l (A0),A1/A5/A6
  884.   bmi.s   err
  885.   bra.s   ende
  886.  
  887. child:
  888.   addq.l  #4,SP          ; RTN-Adresse weg
  889.   movea.l (SP)+,A0       ; a0 := saveADR
  890.   movem.l (A0),A1/A5/A6
  891.   moveq   #0,D0
  892.   bra.s   ende
  893.  
  894. err:
  895.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  896.   nop                    ;;
  897.   nop                    ;;
  898.   move.w  D0,(A0)        ; e.errno setzen
  899.   moveq   #-1,D0
  900.  
  901. ende:
  902.   move.w  D0,(SP)
  903.   jmp     (A1)
  904. *)
  905.  CODE(225FH);
  906.  SETREG(8, mintADR);
  907.  CODE(4A10H,670EH,3F3CH,0113H,4E41H,548FH,4A40H,6B3AH,6042H);
  908.  SETREG(8, saveADR);
  909.  CODE(48D0H,6200H,558FH,487AH,001EH,4850H);
  910.  SETREG(8, tforkADR);
  911.  CODE(4E90H);
  912.  SETREG(8, saveADR);
  913.  CODE(508FH,301FH,4CD0H,6200H,6B0EH,6016H,588FH,205FH,4CD0H,6200H,7000H,600AH);
  914.  SETREG(8, errnoADR);
  915.  CODE(3080H,70FFH,3E80H,4ED1H);
  916. END vfork;
  917. __PROCFRAME_ON__
  918.  
  919. #elif (defined HM2)
  920.  
  921. PROCEDURE vfork ( ): pidT;
  922. BEGIN
  923. (*
  924. ; HM
  925.   move.l  (SP)+,D1       ; Modulbasis vom Stack retten
  926.   movea.l (SP)+,A6       ; Frame-Pointer vom Stack retten
  927.   movea.l (SP)+,A1       ; RTN-Adresse vom Stack retten
  928. ;; SETREG(8, mintADR);
  929.   tst.b   (A0)
  930.   beq.s   tos
  931.   movea.l D1,A5
  932.   move.w  #$0113,-(SP)   ; Pvfork
  933.   trap    #1             ;
  934.   addq.l  #2,SP          ;
  935.   move.l  A5,D1
  936.   tst.w   D0
  937.   bmi.s   err
  938.   bra.s   ende
  939. tos:
  940.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  941.   nop                    ;;
  942.   movem.l D1-D7/A1-A6,(A0)
  943.   pea     (A0)
  944.   pea     child(PC)      ; tfork(child, saveADR);
  945.   nop                    ;; durch SETREG(8, tforkADR); ersetzt
  946.   nop                    ;;
  947.   jsr     (A0)
  948.   nop                    ;; durch SETREG(8, saveADR); ersetzt
  949.   nop                    ;;
  950.   movem.l (A0),D1-D7/A1-A6
  951.   tst.w   D0
  952.   bmi.s   err
  953.   bra.s   ende
  954.  
  955. child:
  956.   addq.l  #4,SP          ; RTN-Adresse weg
  957.   movea.l (SP)+,A0       ; a0 := saveADR
  958.   movem.l (A0),D1-D7/A1-A6
  959.   moveq   #0,D0
  960.   bra.s   ende
  961.  
  962. err:
  963.   nop                    ;; durch SETREG(8, errnoADR); ersetzt
  964.   nop                    ;;
  965. #ifdef __LONG_WHOLE__
  966.   move.l  D0,(A0)        ; e.errno setzen
  967. #else
  968.   move.w  D0,(A0)        ; e.errno setzen
  969. #endif
  970.   moveq   #-1,D0
  971. ende
  972.   movea.l D1,A5          ; alte Modulbasis setzen
  973.   jmp     (A1)
  974. *)
  975.  
  976.  CODE(221FH,2C5FH,225FH);
  977.  SETREG(8, mintADR);
  978.  CODE(4A10H,6712H,2A41H,3F3CH,0113H,4E41H,548FH,220DH,4A40H,6B30H,6036H);
  979.  SETREG(8, saveADR);
  980.  CODE(48D0H,7EFEH,4850H,487AH,0016H);
  981.  SETREG(8, tforkADR);
  982.  CODE(4E90H);
  983.  SETREG(8, saveADR);
  984.  CODE(4CD0H,7EFEH,4A40H,6B0EH,6014H,588FH,205FH,4CD0H,7EFEH,7000H,6008H);
  985.  SETREG(8, errnoADR);
  986. #ifdef __LONG_WHOLE__
  987.  CODE(2080H);
  988. #else
  989.  CODE(3080H);
  990. #endif
  991.  CODE(70FFH,2A41H,4ED1H);
  992. END vfork;
  993.  
  994. #elif (defined MM2)
  995.  
  996. #warning *** vfork does not work with MM2 and plain TOS
  997.  
  998. __PROCFRAME_OFF__
  999. PROCEDURE vfork ( ): pidT;
  1000. BEGIN
  1001.  ASSEMBLER
  1002.    MOVEA.L (A7)+, A1
  1003.    MOVE.L  ActMOSProcess, bpsave1
  1004.    MOVE.L  BaseProcess, bpsave2
  1005.    TST.W   MiNT
  1006.    BEQ.S   tos
  1007.    MOVE.W  #$0113, -(A7)
  1008.    TRAP    #1
  1009.    ADDQ.L  #2, A7
  1010.    TST.W   D0
  1011.    BMI.S   err
  1012.    BEQ.S   clear
  1013.    MOVE.L  bpsave1, ActMOSProcess
  1014.    MOVE.L  bpsave2, BaseProcess
  1015.    BRA.S   ende
  1016.  clear:
  1017.    CLR.L   ActMOSProcess
  1018.    CLR.L   BaseProcess
  1019.    BRA.S   ende
  1020.  
  1021.  tos:
  1022.    MOVEM.L D3-D7/A1/A3-A6, regsave
  1023.    LEA     child(PC), A0
  1024.    MOVE.L  A0, (A3)+
  1025.    MOVE.L  #regsave, (A3)+
  1026. #ifdef __RES_ON_STACK__
  1027.    JSR     tfork
  1028. #ifdef __LONG_WHOLE__
  1029.    MOVE.L  -(A3), D0
  1030. #else
  1031.    MOVE.W  -(A3), D0
  1032. #endif
  1033. #else
  1034.    JSR     tfork/
  1035. #endif
  1036.    MOVEM.L regsave, D3-D7/A1/A3-A6
  1037.    TST.W   D0
  1038.    BMI.S   err
  1039.    BRA.S   ende
  1040.  
  1041.  child:
  1042.    ADDQ.L  #4, A7
  1043.    MOVEA.L -(A3), A0
  1044.    MOVEM.L (A0), D3-D7/A1/A3-A6
  1045.    MOVEQ   #0, D0
  1046.    BRA.S   ende
  1047.  
  1048.  err:
  1049. #ifdef __LONG_WHOLE__
  1050.    MOVE.L  D0, e.errno
  1051. #else
  1052.    MOVE.W  D0, e.errno
  1053. #endif
  1054.    MOVEQ   #-1, D0
  1055.  
  1056.  ende:
  1057. #ifdef __RES_ON_STACK__
  1058. #ifdef __LONG_WHOLE__
  1059.    MOVE.L  D0, (A3)+
  1060. #else
  1061.    MOVE.W  D0, (A3)+
  1062. #endif
  1063. #endif
  1064.    JMP     (A1)
  1065.  END;
  1066. END vfork;
  1067. __PROCFRAME_ON__
  1068. #endif
  1069.  
  1070. (*---------------------------------------------------------------------------*)
  1071.  
  1072. PROCEDURE wait ((* -- /AUS *) VAR state : WaitVal ): pidT;
  1073.  
  1074. VAR res  : WaitCode;
  1075.     done : BOOLEAN;
  1076.  
  1077. BEGIN
  1078.  state := WaitVal{};
  1079.  done  := Pwait3(WORDSET{}, NULL, res.long);
  1080.  IF NOT done AND (INT(res.long) = e.eINVFN) THEN
  1081.    (* Aufruf wird nicht unterstuetzt *)
  1082.    res          := WAITVAL;
  1083.    done         := res.long >= EOKL;
  1084.    WAITVAL.long := e.ECHILD;
  1085.    WAITTIME     := 0;
  1086.  END;
  1087.  IF NOT done THEN
  1088.    e.errno := INT(res.long);
  1089.    RETURN(-1);
  1090.  END;
  1091.  state := CAST(WaitVal,MakeWaitVal(res.term));
  1092.  RETURN(VAL(pidT,res.pid));
  1093. END wait;
  1094.  
  1095. (*---------------------------------------------------------------------------*)
  1096.  
  1097. PROCEDURE waitpid ((* EIN/ -- *)     pid     : pidT;
  1098.                    (* -- /AUS *) VAR state   : WaitVal;
  1099.                    (* EIN/ -- *)     options : WaitOption ): pidT;
  1100.  
  1101. VAR res  : WaitCode;
  1102.     done : BOOLEAN;
  1103.  
  1104. BEGIN
  1105.  state := WaitVal{};
  1106.  done  := Pwaitpid(pid, options, NULL, res.long);
  1107.  IF NOT done AND (INT(res.long) = e.eINVFN) THEN
  1108.    (* Aufruf wird nicht unterstuetzt *)
  1109.    IF (pid <> -1) AND (pid <> 0) THEN
  1110.      e.errno := e.EINVAL;
  1111.      RETURN(-1);
  1112.    END;
  1113.    res          := WAITVAL;
  1114.    done         := res.long >= EOKL;
  1115.    WAITVAL.long := e.ECHILD;
  1116.    WAITTIME     := 0;
  1117.  END;
  1118.  IF NOT done THEN
  1119.    e.errno := INT(res.long);
  1120.    RETURN(-1);
  1121.  END;
  1122.  state := CAST(WaitVal,MakeWaitVal(res.term));
  1123.  RETURN(VAL(pidT,res.pid));
  1124. END waitpid;
  1125.  
  1126. (*---------------------------------------------------------------------------*)
  1127.  
  1128. PROCEDURE wait3 ((* -- /AUS *) VAR state   : WaitVal;
  1129.                  (* EIN/ -- *)     options : WaitOption;
  1130.                  (* -- /AUS *) VAR usage   : RusageRec   ): pidT;
  1131.  
  1132. VAR res  : WaitCode;
  1133.     done : BOOLEAN;
  1134.     rsc  : ARRAY [0..1] OF SIGNEDLONG;
  1135.  
  1136. BEGIN
  1137.  state := WaitVal{};
  1138.  done  := Pwait3(options, ADR(rsc), res.long);
  1139.  IF NOT done AND (INT(res.long) = e.eINVFN) THEN
  1140.    (* Aufruf wird nicht unterstuetzt *)
  1141.    res          := WAITVAL;
  1142.    done         := res.long >= EOKL;
  1143.    WAITVAL.long := e.ECHILD;
  1144.    rsc[0]       := WAITTIME * VAL(UNSIGNEDLONG,5);
  1145.    rsc[1]       := 0;
  1146.    WAITTIME     := 0;
  1147.  END;
  1148.  IF NOT done THEN
  1149.    e.errno := INT(res.long);
  1150.    RETURN(-1);
  1151.  END;
  1152.  state := CAST(WaitVal,MakeWaitVal(res.term));
  1153.  memset(ADR(usage), 0, VAL(sizeT,TSIZE(RusageRec)));
  1154.  WITH usage DO
  1155.    WITH ruUtime DO
  1156.      tvSec  :=  rsc[0] DIV VAL(SIGNEDLONG,1000);
  1157.      tvUSec := (rsc[0] MOD VAL(SIGNEDLONG,1000)) * VAL(SIGNEDLONG,1000);
  1158.    END;
  1159.    WITH ruStime DO
  1160.      tvSec  :=  rsc[1] DIV VAL(SIGNEDLONG,1000);
  1161.      tvUSec := (rsc[1] MOD VAL(SIGNEDLONG,1000)) * VAL(SIGNEDLONG,1000);
  1162.    END;
  1163.    ruNvcsw := 1; (* ? *)
  1164.  END;
  1165.  RETURN(VAL(pidT,res.pid));
  1166. END wait3;
  1167.  
  1168. (*---------------------------------------------------------------------------*)
  1169.  
  1170. PROCEDURE wait4 ((* EIN/ -- *)     pid     : pidT;
  1171.                  (* -- /AUS *) VAR state   : WaitVal;
  1172.                  (* EIN/ -- *)     options : WaitOption;
  1173.                  (* -- /AUS *) VAR usage   : RusageRec   ): pidT;
  1174.  
  1175. VAR res  : WaitCode;
  1176.     done : BOOLEAN;
  1177.     rsc  : ARRAY [0..1] OF SIGNEDLONG;
  1178.  
  1179. BEGIN
  1180.  IF pid < 0 THEN
  1181.    e.errno := e.EINVAL;
  1182.    RETURN(-1);
  1183.  ELSIF pid = 0 THEN
  1184.    pid := -1;
  1185.  END;
  1186.  state := WaitVal{};
  1187.  done  := Pwaitpid(pid, options, ADR(rsc), res.long);
  1188.  IF NOT done AND (INT(res.long) = e.eINVFN) THEN
  1189.    (* Aufruf wird nicht unterstuetzt *)
  1190.    IF pid <> -1 THEN
  1191.      e.errno := e.EINVAL;
  1192.      RETURN(-1);
  1193.    END;
  1194.    res          := WAITVAL;
  1195.    done         := res.long >= EOKL;
  1196.    WAITVAL.long := e.ECHILD;
  1197.    rsc[0]       := WAITTIME * VAL(UNSIGNEDLONG,5);
  1198.    rsc[1]       := 0;
  1199.    WAITTIME     := 0;
  1200.  END;
  1201.  IF NOT done THEN
  1202.    e.errno := INT(res.long);
  1203.    RETURN(-1);
  1204.  END;
  1205.  state := CAST(WaitVal,MakeWaitVal(res.term));
  1206.  memset(ADR(usage), 0, VAL(sizeT,TSIZE(RusageRec)));
  1207.  WITH usage DO
  1208.    WITH ruUtime DO
  1209.      tvSec  :=  rsc[0] DIV VAL(SIGNEDLONG,1000);
  1210.      tvUSec := (rsc[0] MOD VAL(SIGNEDLONG,1000)) * VAL(SIGNEDLONG,1000);
  1211.    END;
  1212.    WITH ruStime DO
  1213.      tvSec  :=  rsc[1] DIV VAL(SIGNEDLONG,1000);
  1214.      tvUSec := (rsc[1] MOD VAL(SIGNEDLONG,1000)) * VAL(SIGNEDLONG,1000);
  1215.    END;
  1216.    ruNvcsw := 1; (* ? *)
  1217.  END;
  1218.  RETURN(VAL(pidT,res.pid));
  1219. END wait4;
  1220.  
  1221. (*---------------------------------------------------------------------------*)
  1222.  
  1223. PROCEDURE WIFEXITED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  1224. BEGIN
  1225.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig = WaitVal{}));
  1226. END WIFEXITED;
  1227.  
  1228. (*---------------------------------------------------------------------------*)
  1229.  
  1230. PROCEDURE WEXITSTATUS ((* EIN/ -- *) state : WaitVal ): int;
  1231. BEGIN
  1232.  RETURN(INT(CAST(SIGNEDWORD,state * wRetcode) DIV 256));
  1233. END WEXITSTATUS;
  1234.  
  1235. (*---------------------------------------------------------------------------*)
  1236.  
  1237. PROCEDURE WIFSIGNALED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  1238. BEGIN
  1239.  RETURN((state * wStopval <> WSTOPPED) AND (state * wTermsig <> WaitVal{}));
  1240. END WIFSIGNALED;
  1241.  
  1242. (*---------------------------------------------------------------------------*)
  1243.  
  1244. PROCEDURE WTERMSIG ((* EIN/ -- *) state : WaitVal ): int;
  1245. BEGIN
  1246.  RETURN(INT(CAST(UNSIGNEDWORD,state * wTermsig)));
  1247. END WTERMSIG;
  1248.  
  1249. (*---------------------------------------------------------------------------*)
  1250.  
  1251. PROCEDURE WIFSTOPPED ((* EIN/ -- *) state : WaitVal ): BOOLEAN;
  1252. BEGIN
  1253.  RETURN(state * wStopval = WSTOPPED);
  1254. END WIFSTOPPED;
  1255.  
  1256. (*---------------------------------------------------------------------------*)
  1257.  
  1258. PROCEDURE WSTOPSIG ((* EIN/ -- *) state : WaitVal ): int;
  1259. BEGIN
  1260.  RETURN(INT(CAST(UNSIGNEDWORD,state * wStopsig) DIV 256));
  1261. END WSTOPSIG;
  1262.  
  1263. (*---------------------------------------------------------------------------*)
  1264.  
  1265. PROCEDURE FDZERO ((* -- /AUS *) VAR fdset : fdSet );
  1266. BEGIN
  1267.  fdset[0] := WORDSET{};
  1268.  fdset[1] := WORDSET{};
  1269. END FDZERO;
  1270.  
  1271. (*---------------------------------------------------------------------------*)
  1272.  
  1273. PROCEDURE FDSET ((* EIN/ -- *)     fd    : int;
  1274.                  (* -- /AUS *) VAR fdset : fdSet );
  1275.  
  1276. VAR cast : LONGfdset;
  1277.  
  1278. BEGIN
  1279.  IF (fd >= 0) AND (fd < FDSETSIZE) THEN
  1280.    cast.fdset := fdset;
  1281.    INCLlong(cast.fdlong, VAL(UNSIGNEDWORD,fd));
  1282.    fdset := cast.fdset;
  1283.  END;
  1284. END FDSET;
  1285.  
  1286. (*---------------------------------------------------------------------------*)
  1287.  
  1288. PROCEDURE FDCLR ((* EIN/ -- *)     fd    : int;
  1289.                  (* -- /AUS *) VAR fdset : fdSet );
  1290.  
  1291. VAR cast : LONGfdset;
  1292.  
  1293. BEGIN
  1294.  IF (fd >= 0) AND (fd < FDSETSIZE) THEN
  1295.    cast.fdset := fdset;
  1296.    EXCLlong(cast.fdlong, VAL(UNSIGNEDWORD,fd));
  1297.    fdset := cast.fdset;
  1298.  END;
  1299. END FDCLR;
  1300.  
  1301. (*---------------------------------------------------------------------------*)
  1302.  
  1303. PROCEDURE FDISSET ((* EIN/ -- *) fd    : int;
  1304.                    (* EIN/ -- *) fdset : fdSet ): BOOLEAN;
  1305.  
  1306. VAR cast : LONGfdset;
  1307.  
  1308. BEGIN
  1309.  IF (fd >= 0) AND (fd < FDSETSIZE) THEN
  1310.    cast.fdset := fdset;
  1311.    RETURN(INlong(VAL(UNSIGNEDWORD,fd), cast.fdlong));
  1312.  ELSE
  1313.    RETURN(FALSE);
  1314.  END;
  1315. END FDISSET;
  1316.  
  1317. (*---------------------------------------------------------------------------*)
  1318.  
  1319. PROCEDURE select ((* EIN/ -- *) width     : int;
  1320.                   (* EIN/ -- *) readfds   : FdSetPtr;
  1321.                   (* EIN/ -- *) writefds  : FdSetPtr;
  1322.                   (* EIN/ -- *) exceptfds : FdSetPtr;
  1323.                   (* EIN/ -- *) timeout   : TimevalPtr ): int;
  1324.  
  1325. VAR         mrfds  : LONGfdset;
  1326.             mwfds  : LONGfdset;
  1327.             mxfds  : LONGfdset;
  1328.             res    : INTEGER;
  1329.             done   : BOOLEAN;
  1330.     __REG__ tmout  : UNSIGNEDLONG;
  1331.     __REG__ mtmout : CARDINAL;
  1332.  
  1333. BEGIN
  1334.  IF width < 0 THEN
  1335.    e.errno := e.EINVAL;
  1336.    RETURN(-1);
  1337.  END;
  1338.  
  1339.  IF readfds <> NULL THEN
  1340.    mrfds.fdset := readfds^;
  1341.    IF width < FDSETSIZE THEN
  1342.      MASKlong(VAL(UNSIGNEDWORD,width), mrfds.fdlong);
  1343.      readfds^ := mrfds.fdset;
  1344.    END;
  1345.  END;
  1346.  IF writefds <> NULL THEN
  1347.    mwfds.fdset := writefds^;
  1348.    IF width < FDSETSIZE THEN
  1349.      MASKlong(VAL(UNSIGNEDWORD,width), mwfds.fdlong);
  1350.      writefds^ := mwfds.fdset;
  1351.    END;
  1352.  END;
  1353.  IF exceptfds <> NULL THEN
  1354.    mxfds.fdset := exceptfds^;
  1355.    IF width < FDSETSIZE THEN
  1356.      MASKlong(VAL(UNSIGNEDWORD,width), mxfds.fdlong);
  1357.    END;
  1358.    exceptfds^ := mxfds.fdset;
  1359.  END;
  1360.  
  1361.  IF timeout <> NULL THEN
  1362.    WITH timeout^ DO
  1363.      tmout := CAST(UNSIGNEDLONG,  tvSec  *   VAL(long,1000)
  1364.                                 + tvUSec DIV VAL(long,1000));
  1365.    END;
  1366.    IF tmout = VAL(UNSIGNEDLONG,0) THEN
  1367.      tmout := 1;
  1368.    END;
  1369.  ELSE
  1370.    tmout := 0; (* Kein Timeout, beliebig lange warten *)
  1371.  END;
  1372.  
  1373.  LOOP
  1374.    IF tmout > VAL(UNSIGNEDLONG,65535) THEN
  1375.      mtmout := 65535;
  1376.    ELSE
  1377.      mtmout := VAL(CARDINAL,tmout);
  1378.    END;
  1379.    DEC(tmout, VAL(UNSIGNEDLONG,mtmout));
  1380.    IF NOT Fselect(mtmout, readfds, writefds, exceptfds, res) THEN
  1381.      e.errno := res;
  1382.      RETURN(-1);
  1383.    ELSIF (res > 0) OR (tmout = VAL(UNSIGNEDLONG,0)) THEN
  1384.      (* Mindestens eine Datei ist bereit oder Timeout abgelaufen *)
  1385.      RETURN(res);
  1386.    END;
  1387.    IF readfds <> NULL THEN
  1388.      readfds^ := mrfds.fdset;
  1389.    END;
  1390.    IF writefds <> NULL THEN
  1391.      writefds^ := mwfds.fdset;
  1392.    END;
  1393.    IF exceptfds <> NULL THEN
  1394.      exceptfds^ := mxfds.fdset;
  1395.    END;
  1396.  END; (* LOOP *)
  1397. END select;
  1398.  
  1399. (*---------------------------------------------------------------------------*)
  1400.  
  1401. PROCEDURE Spawn ((* EIN/ -- *) mode : SpawnMode;
  1402.                  (* EIN/ -- *) prg  : StrPtr;
  1403.                  (* EIN/ -- *) argv : StrArray;
  1404.                  (* EIN/ -- *) envp : StrArray  ): INTEGER;
  1405.  
  1406. CONST MaxStr = 10;
  1407.  
  1408. VAR         envPtr     : StrPtr;
  1409.     __REG__ argPtr     : StrPtr;
  1410.     __REG__ cmdIdx     : StrRange;
  1411.     __REG__ envIdx     : StrRange;
  1412.     __REG__ i          : ArrayRange;
  1413.             args       : ArrayRange;
  1414.             envs       : ArrayRange;
  1415.             val        : ArrayRange;
  1416.             pexec      : CARDINAL;
  1417.             res        : INTEGER;
  1418.             void       : INTEGER;
  1419.             lres       : SIGNEDLONG;
  1420.             childStart : UNSIGNEDLONG;
  1421.             null       : BOOLEAN;
  1422.             done       : BOOLEAN;
  1423.             cmdLine    : CmdLine; (* Zwischenspeicher und Kommandozeile *)
  1424.             fd         : HandleRange;
  1425.  
  1426. PROCEDURE argcpy (arg : StrPtr; envIdx : StrRange): StrRange;
  1427. VAR __REG__ i : StrRange;
  1428.     __REG__ c : CHAR;
  1429. BEGIN
  1430.  i := 0;
  1431.  REPEAT
  1432.    c := arg^[i];
  1433.    envPtr^[envIdx] := c;
  1434.    INC(i);
  1435.    INC(envIdx);
  1436.  UNTIL c = 0C;
  1437.  RETURN(envIdx);
  1438. END argcpy;
  1439.  
  1440. BEGIN
  1441.  e.errno := 0;
  1442.  pexec := 0;
  1443.  IF MiNT THEN
  1444.    IF mode = pNOWAIT THEN
  1445.      pexec := 100;
  1446.    ELSIF mode = pOVERLAY THEN
  1447.      pexec := 200;
  1448.    END;
  1449.  ELSIF mode = pNOWAIT THEN
  1450.    e.errno := e.EINVAL;
  1451.    RETURN(-1);
  1452.  END;
  1453.  
  1454.  IF (argv = NULL) OR (argv^[0] = NULL) THEN
  1455.    e.errno := e.EFAULT;
  1456.    RETURN(-1);
  1457.  END;
  1458.  
  1459.  IF envp = NULL THEN
  1460.    envp := environ;
  1461.  END;
  1462.  
  1463.  (* Laenge des benoetigten Environments berechnen.
  1464.   * Dazu gehoeren entweder das uebergebene oder das aktuelle
  1465.   * Environment und die Kommandozeilenargumente einschliesslich
  1466.   * dem Programmnamen.
  1467.   *)
  1468.  lres := 0;
  1469.  i    := 0;
  1470.  null := FALSE;
  1471.  WHILE argv^[i] <> NULL DO
  1472.    res := INT(strlen(argv^[i]));
  1473.    IF res = 0 THEN
  1474.      null := TRUE;
  1475.      (* Bei einem leeren Argument muss der Platz fuer den Index
  1476.       * in der ARGV-Variable beruecksichtigt werden.
  1477.       * Es werden maximal 9999 Argumente korrekt bearbeitet.
  1478.       *)
  1479.      IF i > 1000 THEN
  1480.        res := 7; (* vier Ziffern & Komma Index + Leerzeichen + Nullbyte *)
  1481.      ELSIF i > 100 THEN
  1482.        res := 6;
  1483.      ELSIF i > 10 THEN
  1484.        res := 5;
  1485.      ELSE
  1486.        res := 4;
  1487.      END;
  1488.    ELSE
  1489.      INC(res); (* wegen Nullbyte *)
  1490.    END;
  1491.    INC(i);
  1492.    INC(lres, VAL(SIGNEDLONG,res));
  1493.  END;
  1494.  args := i;
  1495.  
  1496.  i := 0;
  1497.  WHILE envp^[i] <> NULL DO
  1498.    INC(lres, VAL(SIGNEDLONG,strlen(envp^[i]))+VAL(SIGNEDLONG,1));
  1499.    INC(i);
  1500.  END;
  1501.  envs := i;
  1502.  INC(lres, 20); (* Platz fuer "ARGV=NULL:" & sicherheitshalber etwas mehr *)
  1503.  
  1504.  (* Benoetigten Speicher anfordern.
  1505.   * Wenn nicht genuegend Speicher vorhanden ist, mit Fehlermeldung abbrechen.
  1506.   *)
  1507.  IF NOT Malloc(lres, envPtr) THEN
  1508.    e.errno := e.E2BIG;
  1509.    RETURN(-1);
  1510.  END;
  1511.  envIdx := 0;
  1512.  
  1513.  (* Das Environment mit den Variablen auffuellen *)
  1514.  i := 0;
  1515.  WHILE i < envs DO
  1516.    envIdx := argcpy(envp^[i], envIdx);
  1517.    INC(i);
  1518.  END;
  1519.  
  1520.  (* Kommandozeile mit ARGV-Verfahren ins Environment schreiben.
  1521.   * Beginn der eigentlichen Argumente (nach dem Programmnamen) merken,
  1522.   * fuer die Uebertragung in die Basepage-Kommandozeile.
  1523.   *)
  1524.  IF null THEN
  1525.    cmdLine := "ARGV=NULL:";
  1526.  ELSE
  1527.    cmdLine := "ARGV=";
  1528.  END;
  1529.  envIdx := argcpy(CAST(StrPtr,ADR(cmdLine)), envIdx);
  1530.  IF null THEN
  1531.    DEC(envIdx);
  1532.    cmdLine[MaxStr] := 0C;
  1533.    i := 0;
  1534.    WHILE i < args DO
  1535.      IF argv^[i]^[0] = 0C THEN
  1536.        cmdIdx := MaxStr - 1;
  1537.        val    := i;
  1538.        REPEAT
  1539.          cmdLine[cmdIdx] := todigit(VAL(CARDINAL,val MOD 10));
  1540.          val             := val DIV 10;
  1541.          DEC(cmdIdx);
  1542.        UNTIL val = 0;
  1543.        envIdx := argcpy(CAST(StrPtr,ADR(cmdLine[cmdIdx+1])), envIdx);
  1544.        envPtr^[envIdx-1] := ',';
  1545.      END;
  1546.      INC(i);
  1547.    END;
  1548.    (* das letzte Komma ist zuviel *)
  1549.    envPtr^[envIdx-1] := 0C;
  1550.  END;
  1551.  
  1552.  cmdLine := " ";
  1553.  i       := 0;
  1554.  WHILE i < args DO
  1555.    IF argv^[i]^[0] = 0C THEN
  1556.      envIdx := argcpy(CAST(StrPtr,ADR(cmdLine)), envIdx);
  1557.    ELSE
  1558.      envIdx := argcpy(argv^[i], envIdx);
  1559.    END;
  1560.    INC(i);
  1561.  END;
  1562.  envPtr^[envIdx]   := 0C; (* Ende des Environments kennzeichnen *)
  1563.  envPtr^[envIdx+1] := 0C; (* Falls es keine Argumente gab *)
  1564.  
  1565.  (* Soviel der Argumente wie moeglich in die Basepage-Kommandozeile
  1566.   * uebertragen. ARGV-Verfahren durch den sonst ungueltigen
  1567.   * Kommandozeilenlaengenwert 127 signalisieren.
  1568.   *)
  1569.  cmdLine[0] := CHR(127);
  1570.  i      := 1;
  1571.  cmdIdx := 1;
  1572.  WHILE (i < args) AND (cmdIdx <= 124) DO
  1573.    envIdx := 0;
  1574.    argPtr := argv^[i]; INC(i);
  1575.    IF argPtr^[0] = 0C THEN
  1576.      (* Leeres Argument *)
  1577.      cmdLine[cmdIdx]   := "'";
  1578.      cmdLine[cmdIdx+1] := "'";
  1579.      INC(cmdIdx, 2);
  1580.    ELSE
  1581.      (* Argument kopieren *)
  1582.      REPEAT
  1583.        cmdLine[cmdIdx] := argPtr^[envIdx];
  1584.        INC(envIdx);
  1585.        INC(cmdIdx);
  1586.      UNTIL (argPtr^[envIdx] = 0C) OR (cmdIdx > 124);
  1587.    END;
  1588.  
  1589.    (* cmdIdx <= 126 ist gesichert *)
  1590.    IF i < args THEN
  1591.      (* Ende des Arguments erreicht *)
  1592.      cmdLine[cmdIdx] := ' ';
  1593.      INC(cmdIdx);
  1594.    ELSE
  1595.      (* Ende der Argumentliste erreicht *)
  1596.      cmdLine[cmdIdx] := 0C;
  1597.    END;
  1598.  END;
  1599.  
  1600.  (* Die restliche Kommandozeile wird geloescht. *)
  1601.  IF cmdIdx > 125 THEN
  1602.    cmdIdx := 125;
  1603.  END;
  1604.  WHILE cmdIdx < 128 DO
  1605.    cmdLine[cmdIdx] := 0C;
  1606.    INC(cmdIdx);
  1607.  END;
  1608.  
  1609.  (* Unter TOS alle offenen Dateien schliessen, bei denen das 'FdCloExec'-Flag
  1610.   * gesetzt ist. Kein WITH verwenden, da sonst evtl. keine Registervariable
  1611.   * fuer Pointer mehr uebrig (MM2).
  1612.   *)
  1613.  IF NOT MiNT THEN
  1614.    FOR fd := MinHandle TO MaxHandle DO
  1615.      IF FD[fd].cloex THEN
  1616.        done := Fclose(INT(fd), res);
  1617.        FD[fd].ftype := unknown;
  1618.        FD[fd].cloex := FALSE;
  1619.      END;
  1620.    END;
  1621.  END;
  1622.  
  1623.  childStart := SysClock();
  1624.  done := Pexec(pexec, prg, ADR(cmdLine), envPtr, lres);
  1625.  INC(CHILDTIME, SysClock() - childStart);
  1626.  
  1627.  null := Mfree(envPtr, res);
  1628.  res  := INT(lres);
  1629.  IF NOT done THEN
  1630.    (* Wenn "Pexec" selbst fehlschlaegt, gibts einen negativen 32-Bit-Wert. *)
  1631.    e.errno  := res;
  1632.    RETURN(-1);
  1633.  ELSIF mode = pOVERLAY THEN (* nur TOS *)
  1634.    (* Ohne MiNT muss selbst fuer die Beendigung des laufenden
  1635.     * Prozesses gesorgt werden. Mit MiNT kehrt der ``Pexec''-Aufruf
  1636.     * erst gar nicht zurueck!
  1637.     *)
  1638.    Pterm(res);
  1639.  ELSIF mode = pWAIT THEN
  1640.    IF NOT MiNT THEN
  1641.      void := raise(SIGCHLD);
  1642.    END;
  1643.    RETURN(INT(MakeWaitVal(CAST(SIGNEDWORD,VAL(UNSIGNEDWORD,CAST(CARDINAL,res))))));
  1644.  ELSE (* nur MiNT *)
  1645.    (* Bei pNOWAIT wird die (positive) Prozess-ID zurueckgegeben *)
  1646.    RETURN(res);
  1647.  END;
  1648. END Spawn;
  1649.  
  1650. (*---------------------------------------------------------------------------*)
  1651.  
  1652. PROCEDURE SpawnThis ((* EIN/ -- *)     mode : SpawnMode;
  1653.                      (* EIN/ -- *) VAR prg  : ARRAY OF CHAR;
  1654.                      (* EIN/ -- *)     argv : StrArray;
  1655.                      (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  1656.  
  1657. VAR path0 : StrPtr;
  1658.     msize : CARDINAL;
  1659.     done  : BOOLEAN;
  1660.     void  : BOOLEAN;
  1661.     stack : ADDRESS;
  1662.     ret   : INTEGER;
  1663.  
  1664. BEGIN
  1665.  msize := SLEN(prg) + DINCR;
  1666.  memalloc(VAL(sizeT,msize), stack, path0);
  1667.  UnixToDos(CAST(StrPtr,ADR(prg)), msize - DINCR, VAL(StrRange,msize), path0,
  1668.            void, done);
  1669.  IF done THEN
  1670.    ret := Spawn(mode, path0, argv, envp);
  1671.  ELSE
  1672.    ret := -1;
  1673.  END;
  1674.  memdealloc(stack);
  1675.  RETURN(ret);
  1676. END SpawnThis;
  1677.  
  1678. (*---------------------------------------------------------------------------*)
  1679.  
  1680. PROCEDURE spawnv ((* EIN/ -- *)     mode : SpawnMode;
  1681.                   (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1682.                   (* EIN/ -- *)     argv : StrArray      ): int;
  1683. BEGIN
  1684.  RETURN(SpawnThis(mode, prg, argv, environ));
  1685. END spawnv;
  1686.  
  1687. (*---------------------------------------------------------------------------*)
  1688.  
  1689. PROCEDURE spawnve ((* EIN/ -- *)     mode : SpawnMode;
  1690.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1691.                    (* EIN/ -- *)     argv : StrArray;
  1692.                    (* EIN/ -- *)     envp : StrArray      ): int;
  1693. BEGIN
  1694.  RETURN(SpawnThis(mode, prg, argv, envp));
  1695. END spawnve;
  1696.  
  1697. (*---------------------------------------------------------------------------*)
  1698.  
  1699. PROCEDURE execv ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1700.                  (* EIN/ -- *)     argv : StrArray      ): int;
  1701. BEGIN
  1702.  RETURN(SpawnThis(pOVERLAY, prg, argv, environ));
  1703. END execv;
  1704.  
  1705. (*---------------------------------------------------------------------------*)
  1706.  
  1707. PROCEDURE execve ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1708.                   (* EIN/ -- *)     argv : StrArray;
  1709.                   (* EIN/ -- *)     envp : StrArray      ): int;
  1710. BEGIN
  1711.  RETURN(SpawnThis(pOVERLAY, prg, argv, envp));
  1712. END execve;
  1713.  
  1714. (*---------------------------------------------------------------------------*)
  1715.  
  1716. PROCEDURE SpawnFind ((* EIN/ -- *)     mode : SpawnMode;
  1717.                      (* EIN/ -- *) VAR prg  : ARRAY OF CHAR;
  1718.                      (* EIN/ -- *)     argv : StrArray;
  1719.                      (* EIN/ -- *)     envp : StrArray      ): INTEGER;
  1720. (**)
  1721. VAR path   : StrPtr;
  1722.     tmp    : StrPtr;
  1723.     path0  : StrPtr;
  1724.     ext    : StrPtr;
  1725.     file   : StrPtr;
  1726.     pToken : StrPtr;
  1727.     eToken : StrPtr;
  1728.     fLen   : StrRange;
  1729.     pLen   : StrRange;
  1730.     pIdx   : StrRange;
  1731.     p1, p2 : StrRange;
  1732.     eLen   : StrRange;
  1733.     eIdx   : StrRange;
  1734.     e1, e2 : StrRange;
  1735.     msize  : StrRange;
  1736.     done   : BOOLEAN;
  1737.     void   : BOOLEAN;
  1738.     stack1 : ADDRESS;
  1739.     stack2 : ADDRESS;
  1740.     stack3 : ADDRESS;
  1741.     ws     : WORDSET;
  1742.     ret    : INTEGER;
  1743.  
  1744. BEGIN
  1745.  msize := VAL(StrRange,SLEN(prg) + DINCR);
  1746.  memalloc(VAL(sizeT,msize), stack1, path);
  1747.  UnixToDos(CAST(StrPtr,ADR(prg)), VAL(CARDINAL,msize - DINCR), msize, path,
  1748.            void, done);
  1749.  IF NOT done THEN
  1750.    memdealloc(stack1);
  1751.    RETURN(-1);
  1752.  END;
  1753.  ext := strrchr(path, SUFFIXSEP);
  1754.  tmp := strrchr(path, DDIRSEP);
  1755.  
  1756.  IF tmp <> NULL THEN
  1757.    (* <path> enthaelt einen Pfad -> nur dort suchen *)
  1758.    tmp^[0] := 0C; (* Pfad von Dateiname und Extension trennen *)
  1759.    file    := ADDADR(tmp, 1);
  1760.  ELSE
  1761.    file := path;
  1762.    path := getenv("PATH");
  1763.    IF path = NULL THEN
  1764.      (* <path> hat keinen Pfad und "PATH" existiert nicht.
  1765.       * -> nur in 'DefPath' suchen.
  1766.       *)
  1767.      path := CAST(StrPtr,ADR(DefPath));
  1768.    END;
  1769.  END;
  1770.  
  1771.  IF DIFADR(ext, tmp) > VAL(SIGNEDLONG,0) THEN
  1772.    (* <file> hat eine Extension -> nur diese probieren *)
  1773.    ext^[0] := 0C; (* Dateiname von Extension trennen *)
  1774.    ext     := ADDADR(ext, 1);
  1775.  ELSE
  1776.    ext := getenv("TOSEXT");
  1777.    IF ext = NULL THEN
  1778.      (* <file> hat keine Extension und "TOSEXT" existiert nicht.
  1779.       * -> Extensionen aus 'DefExt' probieren.
  1780.       *)
  1781.      ext := CAST(StrPtr,ADR(DefExt));
  1782.    END;
  1783.  END;
  1784.  
  1785.  fLen := VAL(StrRange,strlen(file));
  1786.  IF fLen = 0 THEN
  1787.    e.errno := e.ENOENT;
  1788.    memdealloc(stack1);
  1789.    RETURN(-1);
  1790.  END;
  1791.  
  1792.  (* path^: Liste der zu durchsuchenden Pfade
  1793.   * file^: Dateiname ohne Pfad und Extension
  1794.   *  ext^: Liste der auszuprobierenden Extensionen
  1795.   *)
  1796.  
  1797.  (* Schleife ueber die Pfade *)
  1798.  pIdx := 0; p1 := 0;
  1799.  WHILE Token(path, CAST(StrPtr,ADR(Delim)), pIdx, p1, p2, pLen, pToken) DO
  1800.    IF pLen = 0 THEN
  1801.      (* leerer Pfad bedeutet: aktuelles Verzeichnis *)
  1802.      pToken := CAST(StrPtr,ADR(DefPath));
  1803.      pLen   := 1;
  1804.    END;
  1805.    msize := pLen + DINCR + 1 + fLen;
  1806.    memalloc(VAL(sizeT,msize), stack2, tmp);
  1807.    UnixToDos(pToken, pLen, pLen + DINCR, tmp, void, done);
  1808.    IF NOT done THEN
  1809.      memdealloc(stack1);
  1810.      RETURN(-1);
  1811.    END;
  1812.    pLen := VAL(StrRange,strlen(tmp));
  1813.    IF (pLen > 0) AND (tmp^[pLen-1] <> DDIRSEP) THEN
  1814.      tmp^[pLen] := DDIRSEP;
  1815.      INC(pLen);
  1816.    END;
  1817.    strcpy(CAST(StrPtr,ADR(tmp^[pLen])), file);
  1818.    INC(pLen, fLen);
  1819.  
  1820.    (* Schleife ueber die Extensionen *)
  1821.    eIdx := 0; e1 := 0;
  1822.    WHILE Token(ext, CAST(StrPtr,ADR(Delim)), eIdx, e1, e2, eLen, eToken) DO
  1823.      IF eLen > 0 THEN
  1824.        memalloc(VAL(sizeT,msize + 1 + eLen), stack3, path0);
  1825.        strcpy(path0, tmp);
  1826.        path0^[pLen] := '.';
  1827.        strncpy(CAST(StrPtr,ADR(path0^[pLen+1])), eToken, VAL(sizeT,eLen));
  1828.        (* Extension in Kleinbuchstaben *)
  1829.        strlwr(CAST(StrPtr,ADR(path0^[pLen+1])));
  1830.        path0^[pLen+1+eLen] := 0C;
  1831.      ELSE
  1832.        path0 := tmp;
  1833.      END;
  1834.  
  1835.      IF Fattrib(path0, 0, 0, ws) THEN
  1836.        ret := Spawn(mode, path0, argv, envp);
  1837.        memdealloc(stack1);
  1838.        RETURN(ret);
  1839.      END;
  1840.      IF eLen > 0 THEN
  1841.        memdealloc(stack3);
  1842.      END;
  1843.    END;
  1844.    (* Zum Schluss nochmal ohne Extension probieren *)
  1845.    IF Fattrib(tmp, 0, 0, ws) THEN
  1846.      ret := Spawn(mode, tmp, argv, envp);
  1847.      memdealloc(stack1);
  1848.      RETURN(ret);
  1849.    END;
  1850.    memdealloc(stack2);
  1851.  END;
  1852.  e.errno := e.ENOENT;
  1853.  memdealloc(stack1);
  1854.  RETURN(-1);
  1855. END SpawnFind;
  1856.  
  1857. (*---------------------------------------------------------------------------*)
  1858.  
  1859. PROCEDURE spawnvp ((* EIN/ -- *)     mode : SpawnMode;
  1860.                    (* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1861.                    (* EIN/ -- *)     argv : StrArray      ): int;
  1862. BEGIN
  1863.  RETURN(SpawnFind(mode, prg, argv, environ));
  1864. END spawnvp;
  1865.  
  1866. (*---------------------------------------------------------------------------*)
  1867.  
  1868. PROCEDURE execvp ((* EIN/ -- *) REF prg  : ARRAY OF CHAR;
  1869.                   (* EIN/ -- *)     argv : StrArray      ): int;
  1870. BEGIN
  1871.  RETURN(SpawnFind(pOVERLAY, prg, argv, environ));
  1872. END execvp;
  1873.  
  1874. (*---------------------------------------------------------------------------*)
  1875.  
  1876. PROCEDURE Exit ((* EIN/ -- *) retval : int );
  1877. BEGIN
  1878.  Pterm(retval);
  1879. END Exit;
  1880.  
  1881. (*---------------------------------------------------------------------------*)
  1882.  
  1883. PROCEDURE times ((* -- /AUS *) VAR buf : TmsRec ): clockT;
  1884.  
  1885. VAR clock : UNSIGNEDLONG;
  1886.     usage : ARRAY [0..7] OF SIGNEDLONG;
  1887.  
  1888. BEGIN
  1889.  clock := SysClock();
  1890.  IF Prusage(ADR(usage)) >= 0 THEN
  1891.    WITH buf DO
  1892.      tmsUtime  := usage[1] DIV VAL(SIGNEDLONG,5);
  1893.      tmsStime  := usage[0] DIV VAL(SIGNEDLONG,5);
  1894.      tmsCUtime := usage[3] DIV VAL(SIGNEDLONG,5);
  1895.      tmsCStime := usage[2] DIV VAL(SIGNEDLONG,5);
  1896.    END;
  1897.  ELSE
  1898.    WITH buf DO
  1899.      tmsUtime  := VAL(clockT,clock - CHILDTIME);
  1900.      tmsStime  := 0; (* nicht feststellbar *)
  1901.      tmsCUtime := VAL(clockT,CHILDTIME);
  1902.      tmsCStime := 0; (* nicht feststellbar *)
  1903.    END;
  1904.  END;
  1905.  RETURN(VAL(clockT,clock));
  1906. END times;
  1907.  
  1908. (*---------------------------------------------------------------------------*)
  1909.  
  1910. PROCEDURE clock ( ): clockT;
  1911.  
  1912. VAR tms : TmsRec;
  1913.  
  1914. BEGIN
  1915.  IF times(tms) < VAL(clockT,0) THEN
  1916.    RETURN(-1);
  1917.  ELSE
  1918.    RETURN(tms.tmsUtime + tms.tmsStime);
  1919.  END;
  1920. END clock;
  1921.  
  1922. (*===========================================================================*)
  1923.  
  1924. BEGIN (* proc *)
  1925.  MiNT         := MiNTVersion() > 0;
  1926.  nulp         := "u:\dev\null";
  1927.  hasDgetcwd   := DgetcwdAvail();
  1928.  DefExt       := TOSEXT;
  1929.  DefPath      := ".";
  1930.  Delim        := ",;";
  1931.  CHILDTIME    := 0;
  1932.  WAITTIME     := 0;
  1933.  WAITVAL.long := e.ECHILD;
  1934.  Stacksize    := BPSIZE + MINSTACKSIZE;
  1935.  errnoADR     := ADR(e.errno);
  1936.  mintADR      := ADR(MiNT);
  1937.  saveADR      := ADR(regsave);
  1938.  tforkADR     := PROCADR(tfork);
  1939. END proc.
  1940.