GEMini Atari

home *** CD-ROM | disk | FTP | other *** search

/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / proc.dpp < prev next >

Wrap

Modula Definition | 1993-10-23 | 22.7 KB | 419 lines

DEFINITION MODULE proc; (*****************************************************************************) (* Funktionen, die mit Prozessen zu tun haben. *) (* *) (* Ein Fehler ist immer dann aufgetreten, wenn bei Funktionen mit Typ INTEGER*) (* ein negativer Wert zurueckgegeben wird. *) (* Die genaue Fehlerursache kann bei Bedarf ueber "err.errno" und die ent- *) (* sprechenden Konstanten ermittelt werden. Die Funktionen veraendern "errno"*) (* nur dann, wenn ein Fehler aufgetreten ist, bei erfolgreicher Ausfuehrung *) (* wird "errno" nicht veraendert. *) (* *) (* "GEMDOS": *) (* Die Eigenschaften der Funktionen unter dem ``blanken'' "GEMDOS" sind z.T. *) (* stark eingeschraenkt; unter dem Stichwort "GEMDOS" ist deswegen immer *) (* angegeben, in wieweit die Funktion emuliert werden kann. Ist MiNT-Unter- *) (* stuetzung angegeben, so ist unter der Betriebssystemerweiterung "MiNT" *) (* eine bessere Unterstuetzung der Funktionen zu erwarten. *) (* *) (* Intern sind alle Pfadangaben auf die Laenge von 'PathName' begrenzt. Ist *) (* ein Pfad laenger (evtl. nach der Umwandlung vom "*IX"-Stil in den "DOS"- *) (* Stil), wird ein Fehler gemeldet, und 'errno' auf 'ENAMETOOLONG' gesetzt. *) (* --------------------------------------------------------------------------*) (* 14-Feb-93, Holger Kleinschmidt *) (*****************************************************************************) FROM types IMPORT (* TYPE *) UNSIGNEDLONG, WORDSET, uidT, gidT, pidT, clockT; FROM pSTRING IMPORT (* TYPE *) StrArray; (*=========================== "times()" =====================================*) TYPE TmsRec = RECORD tmsUtime : clockT; (* CPU-Zeit im Benutzercode *) tmsStime : clockT; (* CPU-Zeit im System *) tmsCUtime : clockT; (* CPU-Zeit im Benutzercode aller beendeten Unterpr.*) tmsCStime : clockT; (* CPU-Zeit im System aller beendeten Unterprozesse *) END; (*======================= "wait()", "waitpid()" =============================*) TYPE WaitVal = WORDSET; (* Repraesentation des Typs 'WaitVal' ist nicht zur Benutzung * ausserhalb des Moduls gedacht. * Konstanten sind nicht POSIX. *) CONST #if reverse_set wRetcode = WaitVal{0..7}; wTermsig = WaitVal{9..15}; wCoredump = 8; wStopval = WaitVal{8..15}; wStopsig = WaitVal{0..7}; WSTOPPED = WaitVal{9..15}; #else wRetcode = WaitVal{8..15}; wTermsig = WaitVal{0..6}; wCoredump = 7; wStopval = WaitVal{0..7}; wStopsig = WaitVal{8..15}; WSTOPPED = WaitVal{0..6}; #endif (* IF state * wStopval = WSTOPPED THEN * stoppedBy := VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wStopsig) DIV 256); * ... * ELSIF state * wTermsig <> WaitVal{} THEN * terminatedBy := VAL(CARDINAL,CAST(UNSIGNEDWORD,state * wTermsig)); * coreDumped := wCoredump IN state; * ... * ELSE * retCode := VAL(INTEGER,CAST(SIGNEDWORD,state * wRetcode) DIV 256); * ... * END; *) TYPE #if reverse_set WaitOptions = ( wait15, wait14, wait13, wait12, wait11, wait10, wait9, wait8, wait7, wait6, wait5, wait4, wait3, wait2, WUNTRACED, (* 0002H, auch gestoppte Unterprozesse beruecksichtigen *) WNOHANG (* 0001H, nicht auf Beendigung warten, sofort zurueck *) ); #else WaitOptions = ( WNOHANG, (* 0001H, nicht auf Beendigung warten, sofort zurueck *) WUNTRACED, (* 0002H, auch gestoppte Unterprozesse beruecksichtigen *) wait2, wait3, wait4, wait5, wait6, wait7, wait8, wait9, wait10, wait11, wait12, wait13, wait14, wait15 ); #endif WaitOption = PACKEDSET OF WaitOptions; (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*) PROCEDURE getpid ( ): pidT; PROCEDURE getppid ( ): pidT; (*-------------------------------------------------------------------------- | Liefert die Kennung des eigenen bzw. des uebergeordneten Prozesses. | | | | "GEMDOS": Ohne MiNT wird aus der Adresse der BasePage ein eindeutiger | | Wert berechnet. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE getuid ( ): uidT; PROCEDURE getgid ( ): gidT; PROCEDURE geteuid ( ): uidT; PROCEDURE getegid ( ): gidT; PROCEDURE setuid ((* EIN/ -- *) uid : uidT ): INTEGER; PROCEDURE setgid ((* EIN/ -- *) gid : gidT ): INTEGER; (*-------------------------------------------------------------------------- | Funktionen fuer das Abfragen und Setzen diverser Kennungen: | | "getuid/gid" : liefern reale Benutzer- bzw. Gruppenkennung des aufrufen-| | den Prozesses. | | "geteuid/gid" : liefern effektive Benutzer- bzw. Gruppenkennung des auf- | | rufenden Prozesses. | | "setuid/gid" : setzen reale und effektive Benutzer- bzw. Gruppenkennung | | des aufrufenden Prozesses auf <uid> bzw. <gid>. | | | | Die realen Kennungen identifizieren den Benutzer bzw. die Gruppe. | | | | Der Zugriff auf Systemressourcen (z.B. Dateien) wird ueber die effektiven| | Kennungen geregelt, die normalerweise gleich den realen Kennungen sind, | | es sei denn, es wird ein Programm ausgefuehrt, das die ``set user id'' | | oder ``set group id'' Bits im Modusfeld gesetzt hat, wodurch der ausfueh-| | rende Prozess als effektive Kennung die Kennung des Dateibesitzers und | | damit auch seine Zugriffsberechtigung bekommt. Die realen Kennungen | | werden hiedurch aber nicht beeinflusst. | | | | "GEMDOS": Ohne MiNT ziemlich sinnlos, aber wohl auch mit. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE getpgrp ( ): pidT; PROCEDURE setpgid ((* EIN/ -- *) pid : pidT; (* EIN/ -- *) pgid : pidT ): INTEGER; (*-------------------------------------------------------------------------- | "getpgrp()": ermittelt die Prozessgruppe des aufrufenden Prozesses. | | "setpgid()": Setzt die Prozessgruppe des Prozesses <pid> auf den Wert | | <pgid>. Wenn <pid> oder <pgid> Null sind, wird stattdessen | | die Prozesskennung des aufrufenden Prozesses eingesetzt. | | | | "GEMDOS": Ohne MiNT ziemlich sinnlos, aber wohl auch mit. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE fork ( ): pidT; (*-------------------------------------------------------------------------- | Der aktuelle Prozess wird in zwei gleichartige Prozesse aufgeteilt, aber | | mit getrenntem Speicherbereich und unterschiedlichen Prozesskennungen. | | Konnte der neue Prozess nicht erzeugt werden, wird dem aufrufenden Pro- | | zess ein Fehler gemeldet; sonst liefert die Funktion dem aufrufenden | | (= Parent) die (positive) Prozesskennung des neuen Prozesses (= Child) | | und dem neuen Prozess eine Null. | | | | "GEMDOS": Funktioniert nur unter MiNT, sonst wird ein Fehler gemeldet. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE execve ((* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray; (* EIN/ -- *) envp : StrArray ): INTEGER; PROCEDURE execv ((* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray ): INTEGER; PROCEDURE execvp ((* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray ): INTEGER; (*-------------------------------------------------------------------------- | Ersetzt den aufrufenden Prozess durch einen neuen, der aus dem Programm | | gebildet wird, dessen Dateiname <prg> ist. <args> und <env> sind Felder | | aus Zeigern auf Parameter und Environment-Variablen, sodass der neue | | Prozess diese als Elemente der Kommandozeile bzw. als Environment-Variab-| | len holen kann. | | Ist <envp> = NULL, wird das augenblickliche Environment vererbt. | | Falls ein Fehler auftritt, wird ein negativer Wert zurueckgeliefert, | | andernfalls kehrt die Funktion NICHT zum Aufrufer zurueck, da dieser | | durch das neue Programm ersetzt wurde. | | Mit der Kombination "fork()"&"execve()" koennen somit neue Prozesse | | gestartet werden. | | | | Spezielle Versionen von "execve()": | | | | "execv()" : es wird das augenblickliche Environment vererbt. | | "execvp()": das augenblickliche Environment wird vererbt, und <prg> wird | | in allen in PATH angegebenen Verzeichnissen gesucht. | | | | "GEMDOS": Da "fork()" nur unter MiNT laeuft, ist die Funktion ohne MiNT | | nicht sinnvoll. | | Die Kommandozeilenparameter werden dem neuen Programm ueber die| | normale Kommandozeile in der BasePage und das ARGV-Verfahren | | mitgeteilt. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE waitpid ((* EIN/ -- *) pid : pidT; (* -- /AUS *) VAR state : WaitVal; (* EIN/ -- *) options : WaitOption ): pidT; (*-------------------------------------------------------------------------- | Wartet auf die Beendigung oder das Stoppen eines vom aufrufenden Prozess | | gestarteten Unterprozesses. Als Funktionswert wird die 'pid' des ent- | | sprechenden Prozesses oder -1 bei einem Fehler (z.B. wenn keine Prozesse | | gestartet wurden) zurueckgeliefert. In <state> steht kodiert die Ursache | | der Beendigung oder des Stoppens (siehe Definition von 'WaitVal'). | | Mit <options> wird das Verhalten der Prozedur festgelegt (siehe Def. von | | 'WaitOptions'). | | Mit <pid> wird festgelegt, welche Unterprozesse beruecksichtigt werden | | sollen: | | | | <pid> = -1: alle Unterprozesse | | <pid> > 0: nur Unterprozess mit dieser Prozesskennung | | <pid> = 0: alle Unterprozesse mit der gleichen Prozessgruppenkennung | | wie der aufrufende Prozess | | <pid> < -1: alle Unterprozesse, die |<pid>| als Prozessgruppenkennung | | haben | | | | "GEMDOS": Funktioniert nur unter MiNT, sonst wird ein Fehler gemeldet. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE wait ((* -- /AUS *) VAR state : WaitVal ): pidT; (*-------------------------------------------------------------------------- | Aequivalent zu "waitpid(-1, state, WaitOption{})", es werden also keine | | gestoppten Unterprozesse beruecksichtigt. | | | | "GEMDOS": Funktioniert nur unter MiNT, sonst wird ein Fehler gemeldet. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE WIFEXITED ((* EIN/ -- *) state : WaitVal ): BOOLEAN; PROCEDURE WEXITSTATUS ((* EIN/ -- *) state : WaitVal ): INTEGER; PROCEDURE WIFSIGNALED ((* EIN/ -- *) state : WaitVal ): BOOLEAN; PROCEDURE WTERMSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL; PROCEDURE WIFSTOPPED ((* EIN/ -- *) state : WaitVal ): BOOLEAN; PROCEDURE WSTOPSIG ((* EIN/ -- *) state : WaitVal ): CARDINAL; (*-------------------------------------------------------------------------- | Diese Funktionen sind bei POSIX als Makros definiert. | | | | "WIFEXITED()" : TRUE, genau dann, wenn der Unterprozess ``normal'' been-| | det wurde, d.h. nicht durch ein Signal. | | "WEXITSTATUS()": Falls "WIFEXITED()" = TRUE, wird der Returncode des | | Unterprozesses geliefert. Dabei werden aber nur die | | unteren 8 Bit des Returncodes benutzt und vorzeichen- | | richtig erweitert. | | Wenn "WIFEXITED()" = FALSE, ist der Funktionswert nicht | | definiert ! | | "WIFSIGNALED()": TRUE, genau dann, wenn der Unterprozess durch ein Signal| | beendet wurde. | | "WTERMSIG()" : Falls "WIFSIGNALED()" = TRUE, wird der Ordinalwert des | | beendenden Signals geliefert. | | Wenn "WIFSIGNALED()" = FALSE,ist der Funktionswert nicht| | definiert ! | | "WIFSTOPPED()" : TRUE, genau dann, wenn der Unterprozess momentan ge- | | stoppt, aber nicht beendet ist (``Job Control''). | | "WSTOPSIG()" : Falls "WIFSTOPPED()" = TRUE, wird der Ordinalwert des | | Signals, das den Prozess gestoppt hat, geliefert. | | Wenn "WIFSTOPPED()" = FALSE, ist der Funktionswert nicht| | definiert ! | | | | Es sollten ausschliesslich diese Funktionen benutzt werden, um einen | | Status vom Typ 'WaitVal' zu analysieren. | --------------------------------------------------------------------------*) PROCEDURE times ((* -- /AUS *) VAR buf : TmsRec ): clockT; (*-------------------------------------------------------------------------- | Liefert Informationen ueber die vom Prozess und seine Unterprozesse ver- | | brauchte Zeit (siehe Def. von 'TmsRec'); die Zeiten sind in der Einheit | | 'sys.CLKTCK's / Sekunde angegeben. | | Als Funktionswert wird die vergangene Zeit seit einem beliebigen, aber | | festen Zeitpunkt in der Vergangenheit zurueckgeliefert; durch mehrmaligen| | Aufruf der Funktion koennen so Zeitdifferenzen gemessen werden. Auch hier| | ist die Einheit 'sys.CLKTCK's / Sekunde. | | | | "GEMDOS": Die im System verbrachte Zeit kann nicht festgestellt werden. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE Exit ((* EIN/ -- *) retval : INTEGER ); (*-------------------------------------------------------------------------- | Der aufrufende Prozess wird mit dem Returncode <retval> beendet. | | <retVal> sollte im Bereich [-128..127] liegen, da im Typ 'WaitVal' nur | | 8 Bit des Returncodes untergebracht werden koennen. | | Die Prozedur muesste eigentlich "_exit()" heissen! | --------------------------------------------------------------------------*) (*===========================================================================*) (* Die folgenden Funktionen haben NICHTS mit POSIX zu tun, sind jedoch fuer *) (* "PCDOS" und "GEMDOS" notwendig, um ein *IX-like Programmstarten zu *) (* ermoeglichen. Fuer *IX sind die Funktionen immerhin bequem. *) (*===========================================================================*) TYPE SpawnMode = ( pOVERLAY, (* Aufrufer wird durch neuen Prozess ersetzt (= exec)*) pNOWAIT, (* neuer Prozess laeuft parallel zum erzeugenden Prozess *) pWAIT (* Erzeugender Prozess wird unterbrochen *) ); (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*) PROCEDURE spawnve ((* EIN/ -- *) mode : SpawnMode; (* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray; (* EIN/ -- *) envp : StrArray ): INTEGER; (*-------------------------------------------------------------------------- | Diese Prozedur fasst die Prozeduren "fork()", "execve()" und "waitpid()" | | auf unterschiedliche Weise zusammen. | | | | <mode> = pOVERLAY: "spawnve()" entspricht "execve()" | | <mode> = pNOWAIT : es wird ein "fork()" ausgefuehrt, und dann <prg> mit | | "execve()" gestartet. | | Rueckgabewert ist entweder -1 und 'errno' wird gesetzt| | falls beim Aufruf von "spawnve()" etwas schiefgeht, | | oder die positive 'pid' des erzeugten Prozesses. | | <mode> = pWAIT : wie pNOWAIT, aber es wird mit "waitpid()" auf das Ende| | des erzeugten Prozesses gewartet. Falls beim Aufruf | | von "spawnve()" etwas schiefgeht, ist der Rueckgabe- | | wert gleich -1 und 'errno' wird gesetzt, ansonsten | | wird 'errno' auf Null gesetzt(!), und die unteren 16 | | Bit des Funktionswertes sind vom Typ 'WaitVal'. Da im | | oberen Byte von 'WaitVal' der Returncode des aufgeru- | | fenen Prozesses enthalten ist (falls der Prozess nicht| | durch ein Signal gestoppt oder terminiert wurde) und | | dieser auch negativ sein kann, und 'WaitVal' fuer den | | Funktionswert auch vorzeichenrichtig auf INTEGER- | | Groesse erweitert wird,muss ein Fehler von "spawnve()"| | durch Inspizieren von 'errno' ermittelt werden: | | | | ret := spawnve(pWAIT,...); | | IF errno <> 0 THEN | | (* "spawnve()"-Fehler *) | | ... | | | | "GEMDOS": Diese Prozedur laeuft fuer <mode> = 'pWAIT' oder 'pOVERLAY' | | auch ohne MiNT. | | ACHTUNG: Es wird wirklich nur das Programm ueber 'Pexec' ge- | | startet, es wird weder der Bildschirm geloescht, die Maus aus- | | geschaltet, noch der Critical-Error-Handler umgesetzt! Ehe man | | jetzt aber selbst daran geht dies zu tun, sollte man daran den-| | ken, dass es zum Chaos fuehrt, falls Prozesse parallel laufen | | (unter MiNT), da es nur einen Bildschirm, eine Maus und einen | | Error-Handler (vor MiNT 0.95) gibt! Das Problem laesst sich nur| | loesen, wenn TOS-Programme ihre Ausgaben in GEM-Fenster schrei-| | ben, wie dies unter MultiTOS der Fall sein wird. | | Wenn ein (Unter)Prozess keine Bidschirmausgaben macht, ist dies| | natuerlich kein Problem. | | Ohne MiNT wird Pexec mit Modus 0 (pWAIT) gestartet, sonst | | sind auch Modus 100 (pNOWAIT) und 200 (pOVERLAY) moeglich. | | ("MiNT"-Unterstuetzung.) | --------------------------------------------------------------------------*) PROCEDURE spawnv ((* EIN/ -- *) mode : SpawnMode; (* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray ): INTEGER; PROCEDURE spawnvp ((* EIN/ -- *) mode : SpawnMode; (* EIN/ -- *) REF prg : ARRAY OF CHAR; (* EIN/ -- *) argv : StrArray ): INTEGER; (*-------------------------------------------------------------------------- | Spezielle Versionen von "spawnve()": | | | | "spawnv()" : es wird das augenblickliche Environment vererbt. | | "spawnvp()" : das augenblickliche Environment wird vererbt, und <prg> | | wird in allen in PATH angegebenen Verzeichnissen gesucht. | --------------------------------------------------------------------------*) END proc.