home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / cmdline.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  12.9 KB  |  436 lines
  1. IMPLEMENTATION MODULE cmdline;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* STATUS: OK                                                                *)
  5. (* --------------------------------------------------------------------------*)
  6. (* 12-Feb-93, Holger Kleinschmidt                                            *)
  7. (*****************************************************************************)
  8.  
  9. /* Folgende Zeile in 'C'-Kommentarklammern setzen, falls der Programmname
  10.  * nicht ueber "shel_read()" ermittelt werden soll, wenn kein ARGV-Verfahren
  11.  * benutzt wurde.
  12.  * Da das Ermitteln des Programmnamens auf diese Weise fuer TOS-Programme
  13.  * nicht ganz ``sauber'' ist, sollten die Kommentarklammern normalerweise
  14.  * gesetzt sein!
  15.  * Die GEM-Aufrufe sind fuer die GEM-Bibliothek ``crystal'' von
  16.  * Ulrich Kaiser ausgelegt, wer eine andere GEM-Bibliothek verwendet, muss
  17.  * die Aufrufe entsprechend anpassen.
  18.  */
  19.  
  20. /*
  21. #define USE_AES_FOR_ARGV0
  22. */
  23.  
  24. VAL_INTRINSIC
  25. CAST_IMPORT
  26. OSCALL_IMPORT
  27.  
  28. FROM SYSTEM IMPORT
  29. (* TYPE *) ADDRESS,
  30. (* PROC *) ADR, TSIZE;
  31.  
  32. FROM types IMPORT
  33. (* CONST*) NULL,
  34. (* TYPE *) UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG;
  35.  
  36. FROM CTYPE IMPORT
  37. (* PROC *) ISSPACE;
  38.  
  39. FROM DosSystem IMPORT
  40. (* TYPE *) BasePtr, BasePage, CmdLine,
  41. (* PROC *) GetBasePage;
  42.  
  43. FROM pSTRING IMPORT
  44. (* CONST*) EOS,
  45. (* TYPE *) StrRange, ArrayRange, StrPtr, StrArray,
  46. (* PROC *) EQUALN, AssignCToM2;
  47.  
  48. #ifdef USE_AES_FOR_ARGV0
  49. FROM AES IMPORT
  50. (* PROC *) Version;
  51.  
  52. FROM ApplMgr IMPORT
  53. (* PROC *) ApplInit, ApplExit;
  54.  
  55. FROM ShelMgr IMPORT
  56. (* PROC *) ShelRead;
  57. #endif
  58.  
  59. #include "oscalls.m2h"
  60.  
  61. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  62.  
  63. VAR
  64. (* Variablen mit Dauerinformation *)
  65.  
  66.   dta     : ARRAY [0..43] OF CHAR; (* Platz fuer Default-DTA *)
  67.   basePtr : BasePtr;   (* -> BasePage des Programms *)
  68.   ARGV    : StrArray;  (* -> Feld von Zeigern auf die Kommando-Argumente *)
  69.   ENVP    : StrArray;  (* -> Feld von Zeigern auf die Environment-Variablen *)
  70.   ARGC    : CARDINAL;  (* Anzahl der Kommando-Argumente *)
  71.   prgName : CmdLine;   (* Name des Programms, falls feststellbar *)
  72.   cmdBuf  : CmdLine;   (* Arbeitskopie der Basepage-Kommandozeile *)
  73.   null    : StrPtr;
  74.  
  75. (* Verschiedenes, bei Modulinitialisierung benutzt *)
  76.  
  77.   ENV     : BOOLEAN;   (* Programm hat ein Environment *)
  78.   EXARG   : BOOLEAN;   (* ARGV-Verfahren wird benutzt *)
  79.   envSize : CARDINAL;
  80.   cmdLen  : StrRange;
  81.   i       : ArrayRange;
  82.   args    : ArrayRange;
  83.   vars    : ArrayRange;
  84.   c       : CHAR;
  85.   mem     : ADDRESS;
  86.   envPtr  : StrPtr;
  87.   cmdPtr  : StrPtr;
  88.   envIdx  : StrRange;
  89.   argIdx  : StrRange;
  90.   srcIdx  : StrRange;
  91.   dstIdx  : StrRange;
  92. #ifdef USE_AES_FOR_ARGV0
  93.   AUTO    : BOOLEAN;
  94. #endif
  95.  
  96. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  97.  
  98. PROCEDURE main ((* -- /AUS *) VAR argc : ArrayRange;
  99.                 (* -- /AUS *) VAR argv : StrArray   );
  100. (*T*)
  101. BEGIN
  102.  argc := ARGC;
  103.  argv := ARGV;
  104. END main;
  105.  
  106. (*---------------------------------------------------------------------------*)
  107.  
  108. PROCEDURE getenv ((* EIN/ -- *) REF var : ARRAY OF CHAR ): StrPtr;
  109. (*T*)
  110. VAR varIdx : StrRange;
  111.     varPtr : StrPtr;
  112.     val    : ArrayRange;
  113.  
  114. BEGIN
  115.  val    := 0;
  116.  varPtr := ENVP^[0];
  117.  WHILE varPtr <> NULL DO
  118.    varIdx := 0;
  119.    WHILE (VAL(CARDINAL,varIdx) <= VAL(CARDINAL,HIGH(var)))
  120.      AND (var[VAL(CARDINAL,varIdx)] <> 0C)
  121.      AND (var[VAL(CARDINAL,varIdx)] = varPtr^[varIdx])
  122.    DO
  123.      INC(varIdx);
  124.    END;
  125.  
  126.    IF (   (VAL(CARDINAL,varIdx) > VAL(CARDINAL,HIGH(var)))
  127.        OR (var[VAL(CARDINAL,varIdx)] = 0C))
  128.       AND (varPtr^[varIdx] = '=')
  129.    THEN
  130.      RETURN(CAST(StrPtr,ADR(varPtr^[varIdx+1])));
  131.    END;
  132.  
  133.    INC(val);
  134.    varPtr := ENVP^[val];
  135.  END;
  136.  
  137.  RETURN(NULL);
  138. END getenv;
  139.  
  140. (*---------------------------------------------------------------------------*)
  141.  
  142. PROCEDURE ArgCount ( ): CARDINAL;
  143. (*T*)
  144. BEGIN
  145.  RETURN(ARGC);
  146. END ArgCount;
  147.  
  148. (*---------------------------------------------------------------------------*)
  149.  
  150. PROCEDURE GetArg ((* EIN/ -- *)     i   : CARDINAL;
  151.                   (* -- /AUS *) VAR arg : ARRAY OF CHAR );
  152. (*T*)
  153. BEGIN
  154.  IF i < ARGC THEN
  155.    AssignCToM2(ARGV^[VAL(ArrayRange,i)], arg);
  156.  ELSE
  157.    arg[0] := EOS;
  158.  END;
  159. END GetArg;
  160.  
  161. (*---------------------------------------------------------------------------*)
  162.  
  163. PROCEDURE GetEnvVar ((* EIN/ -- *) REF var : ARRAY OF CHAR;
  164.                      (* -- /AUS *) VAR val : ARRAY OF CHAR ): BOOLEAN;
  165. (*T*)
  166. BEGIN
  167.  AssignCToM2(getenv(var), val);
  168.  RETURN(val[0] <> EOS);
  169. END GetEnvVar;
  170.  
  171. (*===========================================================================*)
  172.  
  173. BEGIN (* pCMDLINE *)
  174.   GetBasePage(basePtr);
  175.  
  176.   EXARG  := FALSE;
  177.   ARGC   := 0;
  178.   args   := 0;
  179.   vars   := 0;
  180.   null   := NULL;
  181.   ARGV   := CAST(StrArray,ADR(null));
  182.   ENVP   := CAST(StrArray,ADR(null));
  183.   envPtr := basePtr^.pEnv;
  184.  
  185.   Fsetdta(ADR(dta));  (* damit bleibt die Kommandozeile ungeschoren *)
  186.   basePtr^.pDta := ADR(dta);
  187.  
  188.  
  189.   ENV := (envPtr <> NULL) AND (envPtr^[0] <> 0C);
  190.   IF ENV THEN
  191.     (* Zuerst wird nach ARGV gesucht, und, falls vorhanden, abgetrennt,
  192.      * sodass der Rest einheitlich als Environment behandelt werden
  193.      * kann. Das ARGV-Verfahren benutzt naemlich nicht das Standardformat
  194.      * fuer Environmentvariablen und darf nicht bei der evtl. noetigen
  195.      * Formatkorrektur des Environments beruecksichtigt werden.
  196.      *)
  197.     envIdx := 0;
  198.     LOOP
  199.       IF EXARG THEN
  200.         INC(args);
  201.       ELSE
  202.         IF    (envPtr^[envIdx]   = 'A')
  203.           AND (envPtr^[envIdx+1] = 'R')
  204.           AND (envPtr^[envIdx+2] = 'G')
  205.           AND (envPtr^[envIdx+3] = 'V')
  206.           AND (envPtr^[envIdx+4] = '=')
  207.         THEN
  208.           envPtr^[envIdx]   := 0C;
  209.           envPtr^[envIdx+1] := 0C; (* Falls ARGV erste Variable *)
  210.           IF MWCStyle OR (basePtr^.pCmdlin[0] = CHR(127)) THEN
  211.             EXARG := TRUE;
  212.             INC(envIdx, 5);
  213.             WHILE envPtr^[envIdx] <> 0C DO
  214.               INC(envIdx);
  215.             END;
  216.             INC(envIdx); (* Hier beginnt der Programmname *)
  217.             IF envPtr^[envIdx] = 0C THEN
  218.               EXARG := FALSE;
  219.               EXIT; (* Environment zuende: kein ARGV *)
  220.             ELSE
  221.               argIdx := envIdx;
  222.               args   := 1;
  223.             END;
  224.           ELSE
  225.             EXIT; (* ARGV entspricht nicht dem Atari-Standard *)
  226.           END;
  227.         END;
  228.       END;
  229.       WHILE envPtr^[envIdx] <> 0C DO
  230.         INC(envIdx);
  231.       END;
  232.       INC(envIdx);
  233.       IF envPtr^[envIdx] = 0C THEN EXIT; END;
  234.     END; (* LOOP *)
  235.   END; (* IF ENV *)
  236.  
  237.   IF args = 0 THEN
  238.     args    := 1; (* mindestens Programmname *)
  239.     prgName := "";
  240.     cmdBuf  := basePtr^.pCmdlin;
  241.  
  242. #ifdef USE_AES_FOR_ARGV0
  243. #  warning ...using AES for argv[0]
  244.  
  245.     AUTO := FALSE;
  246.     IF Version() = 0 THEN
  247.       IF ApplInit() < 0 THEN
  248.         AUTO := Version() = 0;
  249.       ELSE
  250.         ApplExit;
  251.       END;
  252.     END;
  253.  
  254.     IF NOT AUTO THEN
  255.       (* AES bereits initialisiert *)
  256.       ShelRead(prgName, cmdBuf);
  257.       IF NOT EQUALN(ORD(cmdBuf[0])+1, cmdBuf, basePtr^.pCmdlin) THEN
  258.         (* Plausibilitaetstest: Wenn die Kommandozeile nicht mit der aus
  259.          * der Basepage uebereinstimmt, ist dieses Programm vermutlich
  260.          * nicht mit "ShelWrite" gestartet worden, und die Ergebnisse
  261.          * von "ShelRead()" stimmen nicht.
  262.          * Dieser Test klappt nicht immer: z.B. nicht, wenn aufrufendes
  263.          * Programm (per ShelWrite gestartet) und aufgerufenes
  264.          * Programm (durch Pexec) ohne Argumente gestartet werden,
  265.          * dann sind naemlich auch beide Kommandozeilen gleich.
  266.          *)
  267.         prgName := "";
  268.         cmdBuf  := basePtr^.pCmdlin;
  269.       END;
  270.     END;
  271. #endif
  272.  
  273.     (* Kommandozeile untersuchen, falls kein (korrektes) ARGV-Verfahren
  274.      * verwendet wurde.
  275.      * Es wird angenommen, dass im ersten Byte der Kommandozeile die
  276.      * korrekte Laenge der Kommandozeile steht (ist das sicher?)!
  277.      *
  278.      * Zuerst muss die Anzahl der Argumente ermittelt werden.
  279.      *)
  280.     cmdLen := ORD(cmdBuf[0]);  (* Laenge der Kommandozeile *)
  281.     IF cmdLen > 124 THEN
  282.       cmdLen := 124;           (* max. 124 Zeichen ausschl. Laengenbyte *)
  283.     END;
  284.  
  285.     dstIdx := 0;
  286.     srcIdx := 1;               (* Laengenbyte ueberspringen *)
  287.     (* Ueberfluessige Leerzeichen zwischen den Argumenten entfernt;
  288.      * dafuer werden sie mit Nullbyte abgeschlossen. Dieses wird aber
  289.      * nur in einer Kopie der Basepage-Kommandozeile vorgenommen.
  290.      *)
  291.     REPEAT
  292.       WHILE (srcIdx <= cmdLen) AND ISSPACE(cmdBuf[srcIdx]) DO
  293.         (* Leerzeichen vor dem Argument entfernen.
  294.          * Entfernt auch das abschliessende CR des Desktops.
  295.          *)
  296.         INC(srcIdx);
  297.       END;
  298.       IF cmdBuf[srcIdx] < ' ' THEN
  299.         (* Controlzeichen (z.B. 0C) beendet auch die Kommandozeile *)
  300.         srcIdx := cmdLen + 1;
  301.       END;
  302.       IF  srcIdx <= cmdLen  THEN
  303.         WHILE (srcIdx <= cmdLen) AND (cmdBuf[srcIdx] > ' ')  DO
  304.           (* Argument ohne Leerzeichen nach vorne schieben *)
  305.           cmdBuf[dstIdx] := cmdBuf[srcIdx];
  306.           INC(srcIdx);
  307.           INC(dstIdx);
  308.         END;
  309.         cmdBuf[dstIdx] := 0C; (* Argument durch Nullbyte abschliessen *)
  310.         INC(srcIdx);          (* Argumentende ueberspringen *)
  311.         INC(dstIdx);
  312.         INC(args);
  313.       END;
  314.     UNTIL srcIdx > cmdLen;
  315.   END; (* IF args = 0 *)
  316.  
  317.   IF ENV THEN
  318.     (* Jetzt muss das Environment evtl. korrigiert werden, da der
  319.      * Desktop die Variablen in einem anderen Format als ueblich
  320.      * ablegt (z.B.: "PATH=",0C,"A:\",0C, statt "PATH=A:\",0C).
  321.      * Gleichzeitig wird die Anzahl der Variablen ermittelt.
  322.      *)
  323.     srcIdx := 0;
  324.     dstIdx := 0;
  325.     REPEAT
  326.       REPEAT
  327.         (* Variablenname kopieren, dabei evtl. nach vorne verschieben *)
  328.         c := envPtr^[srcIdx];
  329.         envPtr^[dstIdx] := c;
  330.         INC(srcIdx);
  331.         INC(dstIdx);
  332.       UNTIL (c = 0C) OR (c = '=');
  333.  
  334.       IF (c = '=') THEN
  335.         (* Variable hat evtl. einen Wert *)
  336.         IF (envPtr^[srcIdx] = 0C) AND (envPtr^[srcIdx+1] <> 0C) THEN
  337.           envIdx := srcIdx;
  338.           REPEAT
  339.             INC(envIdx);
  340.             c := envPtr^[envIdx];
  341.           UNTIL (c = 0C) OR (c = '=');
  342.           IF c = 0C THEN
  343.             (* eingeschobenes Nullbyte ignorieren *)
  344.             INC(srcIdx);
  345.           END;
  346.         END;
  347.         REPEAT
  348.           (* Variablenwert kopieren, einschliesslich abschl. NullByte *)
  349.           c := envPtr^[srcIdx];
  350.           envPtr^[dstIdx] := c;
  351.           INC(srcIdx);
  352.           INC(dstIdx);
  353.         UNTIL c = 0C;
  354.       END;
  355.       INC(vars);
  356.     UNTIL envPtr^[srcIdx] = 0C;
  357.     envPtr^[dstIdx] := 0C; (* Environment beendet *)
  358.   END; (* IF ENV *)
  359.  
  360.   envSize := VAL(CARDINAL,(args + vars + 2)) * VAL(CARDINAL,TSIZE(StrPtr));
  361.   (* + 2 wegen Nullpointer *)
  362.   Malloc(VAL(UNSIGNEDLONG, envSize), mem);
  363.   IF mem = NULL THEN
  364.     args := 0;
  365.     vars := 0;
  366.   ELSE
  367.     ENVP := CAST(StrArray,mem);
  368.     IF ENV THEN
  369.       envIdx := 0;
  370.       FOR i := 0 TO vars - 1 DO  (* !vars > 0 ist gesichert *)
  371.         ENVP^[i] := CAST(StrPtr,ADR(envPtr^[envIdx]));
  372.         REPEAT
  373.           INC(envIdx);
  374.         UNTIL envPtr^[envIdx] = 0C;
  375.         INC(envIdx); (* Die Null *)
  376.       END;
  377.     END; (* IF ENV *)
  378.     ENVP^[vars] := NULL;
  379.  
  380.     ARGV := CAST(StrArray,ADR(ENVP^[vars+1]));
  381.     IF EXARG THEN
  382.       envIdx := argIdx;
  383.       FOR i := 0 TO args - 1 DO  (* !args > 0 ist gesichert *)
  384.         ARGV^[i] := CAST(StrPtr,ADR(envPtr^[envIdx]));
  385.         REPEAT
  386.           INC(envIdx);
  387.         UNTIL envPtr^[envIdx] = 0C;
  388.         INC(envIdx);
  389.       END;
  390.  
  391.       (* Soviel wie moeglich vom ARGV-Environment in die Basepage-Kommandozeile
  392.        * kopieren, falls dies vom Aufrufer nicht getan wurde. Der Programmname
  393.        * wird uebersprungen.
  394.        *)
  395.       WITH basePtr^ DO
  396.         pCmdlin[0] := CHR(127);
  397.         IF args <= 1 THEN
  398.           (* Nur Programmname, keine Argumente *)
  399.           pCmdlin[1] := 0C;
  400.         ELSE
  401.           srcIdx := 0;
  402.           dstIdx := 1;
  403.           cmdPtr := ARGV^[1];
  404.           WHILE dstIdx <= 124 DO
  405.             IF cmdPtr^[srcIdx] <> 0C THEN
  406.               pCmdlin[dstIdx] := cmdPtr^[srcIdx];
  407.             ELSIF cmdPtr^[srcIdx+1] <> 0C THEN
  408.               pCmdlin[dstIdx] := ' ';
  409.             ELSE
  410.               pCmdlin[dstIdx] := 0C;
  411.               dstIdx := 125;
  412.             END;
  413.             INC(dstIdx);
  414.             INC(srcIdx);
  415.           END;
  416.           pCmdlin[125] := 0C;
  417.         END;
  418.       END; (* WITH *)
  419.     ELSE (* NOT EXARG *)
  420.       ARGV^[0] := CAST(StrPtr,ADR(prgName));
  421.       srcIdx   := 0;
  422.       FOR i := 1 TO args - 1 DO
  423.         ARGV^[i] := CAST(StrPtr,ADR(cmdBuf[srcIdx]));
  424.         REPEAT
  425.           INC(srcIdx);
  426.         UNTIL cmdBuf[srcIdx] = 0C;
  427.         INC(srcIdx);
  428.       END;
  429.     END;
  430.     ARGV^[args] := NULL;
  431.   END; (* IF mem = NULL *)
  432.  
  433.   ARGC    := VAL(CARDINAL,args);
  434.   environ := ENVP;
  435. END cmdline.
  436.