Parent: [c017f0] (diff)

Download this file

ArgAccess.mod.m2cc    221 lines (193 with data), 8.2 kB

IMPLEMENTATION MODULE ArgAccess;

  (*========================================================================*)
  (* WICHTIG: BITTE NUR DIE DATEI ArgAccess.mod.m2cc EDITIEREN !!!          *)
  (*========================================================================*)
  (* Zugriff auf Komanndozeilenargumente und die Programmumgebung           *)
  (* Access to command line arguments programm environment                  *)
  (*                                                                        *)
  (* Es sind 2 Versionen enthalten die mit                                  *)
  (*                                                                        *)
  (*   m2cc -D __{Parameter}__ < ArgAccess.mod.m2cc > ArgAccess.mod         *)
  (*                                                                        *)
  (* mit Parameter = {XDS|GM2} erzeugt werden koennen.                      *)
  (*                                                                        *)
  (*   XDS   : Parameter werden fuer den XDS Modula-2 Compilter gesetzt     *)
  (*   GM2   : Parameter werden fuer den GNU Modula-2 Compilter gesetzt     *)
  (*                                                                        *)
  (* There are two version contained, one for XDS and one for GNU M2.       *)
  (* They can be generated by the command line shown above                  *)
#ifdef __XDS__
  (* Version fuer XDS Modula-2                                              *)
#endif
#ifdef __GM2__
  (* Version fuer GNU Modula-2                                              *)
#endif
  (*------------------------------------------------------------------------*)
  (* Letzte Bearbeitung                                                     *)
  (*                                                                        *)
  (* 28.08.97, MRi: Implemenatation                                         *)
  (* 09.01.15, MRi: Anpassung an XDS / GM2 ISO Compiler                     *)
  (* 14.02.15, MRi: Aufraeumen                                              *)
  (* 24.09.16, MRi: ProgEnv.ProgramName(CommandLine) in HoleArgumente       *)
  (*                fuer XDS eingefuegt damit Argument 0 der Programm-      *)
  (*                name ist wie bei Mocka/MtC/GM2                          *)
  (* 25.09.16, MRi: Kleinere Korrektur (wg. Aenderung vom Vortag)           *)
  (* 20.04.17, MRi: Prozeduren Rd{Int|Real}FromArgList eingefuegt           *)
  (* 30.05.17, MRi: ArgL,ArgTable ins Definitionsmodul verschoben           *)
  (* 17.01.18, MRi: Korrektur in HoleArgumente (LOOP eliminert)             *)
  (*------------------------------------------------------------------------*)
  (* Implementation : Michael Riedl                                         *)
  (* Licence        : GNU Lesser General Public License (LGPL)              *)
  (*------------------------------------------------------------------------*)

  (* $Id: ArgAccess.mod.m2cc,v 1.1 2018/01/14 15:30:34 mriedl Exp $ *)

FROM SYSTEM      IMPORT TSIZE,ADDRESS,ADR;
FROM Storage     IMPORT ALLOCATE;
                 IMPORT UnixLib;
FROM ProgramArgs IMPORT IsArgPresent,ArgChan,NextArg;
FROM IOConsts    IMPORT ReadResults;
FROM IOResult    IMPORT ReadResult;
                 IMPORT TextIO;
FROM ConvTypes   IMPORT ConvResults;
FROM NumConvert  IMPORT StringToInt;
FROM RealConvert IMPORT StringToReal;
                 IMPORT StringsLib;
                 IMPORT Errors;
#ifdef __XDS__
                 IMPORT ProgEnv;
#endif

CONST NoGetenv = FALSE;
      debug    = TRUE;

VAR   ArgVect  : ArgTable;
      ArgC     : SHORTCARD;

TYPE  ArgStr   = ARRAY [0..ArgL] OF CHAR;

PROCEDURE GetArgCount () : CARDINAL;


BEGIN
      RETURN ArgC;
END GetArgCount;

PROCEDURE GetArgument (    ArgNum   : CARDINAL;
                       VAR Argument : ARRAY OF CHAR);

          VAR i : SHORTCARD;
BEGIN
      IF (ArgVect = NIL) THEN
        Argument[0]:=0C;
        IF (ArgC # MAX(SHORTCARD)) THEN
          Errors.ErrOut(" ArgVect = NIL but ArgC != 256 ");
        END;
        RETURN;
      END;
      IF (ArgNum  > VAL(CARDINAL,ArgC)) OR (ArgVect^[ArgNum] = NIL) THEN
        Argument[0]:=0C;
      ELSE
        i:=0;
        REPEAT
          Argument[i] := ArgVect^[ArgNum]^[i]; INC(i);
        UNTIL (ArgVect^[ArgNum]^[i] = 0C) OR (i = HIGH(Argument)) OR (i >= ArgL);
        Argument[i]:=0C;
      END;
END GetArgument;

PROCEDURE FindEnvStr(    SuchStr : ARRAY OF CHAR;
                     VAR EnvStr  : ARRAY OF CHAR);

          (*  StrPtr = POINTER TO ARRAY [0..1023] OF CHAR; *)
          VAR EnvStrPtr : UnixLib.StrPtr;
BEGIN
      IF NoGetenv THEN
        EnvStr[0]:=0C;
      ELSE
        EnvStrPtr:=UnixLib.getenv(ADR(SuchStr));
        StringsLib.Copy(EnvStr,EnvStrPtr^);
      END;
END FindEnvStr;

PROCEDURE HoleArgumente();

      (*--------------------------------------------------------------------*)
      (* Lese Programmargumente ein / get program arguments                 *)
      (* Unfortunatel IOChan.ChanId is not rewindable, otherwise code could *)
      (* be much simpler not needing the CommanLine string which is located *)
      (* on the stack (used within PROCEDURE) for not consuming memory      *)
      (* for utmost no use.                                                 *)
      (*--------------------------------------------------------------------*)

      CONST ArgNotAvailable = "No arguments present";

      VAR   ArgI        : ArgStr;
            ArgLenI     : ARRAY [0..ArgL] OF SHORTCARD;
            i,j,k       : SHORTCARD;
            CommandLine : ARRAY [0..1023] OF CHAR;
            rRes        : ReadResults;
BEGIN
#ifdef __GM2__
      i:=0; CommandLine[0]:=0C;
#endif
#ifdef __XDS__
      (* XDS does not provide the actual program name as argument 0 for un- *)
      (* known reasons - this is fixed whith the following code             *)
      ProgEnv.ProgramName(CommandLine);
      ArgLenI[0]:=StringsLib.Length(CommandLine) + 1; (* Including 0C *)
      StringsLib.Append(CommandLine," ");
      i:=1;
#endif

      WHILE IsArgPresent() DO
        (* TO DO : Check that length of CommandLine is not exceeded *)
        TextIO.ReadToken(ArgChan(),ArgI);
        rRes := ReadResult(ArgChan());
        IF (rRes = allRight) AND (ArgI[0] # 0C) THEN
          IF (i > 0) THEN StringsLib.Append(CommandLine," "); END;
          StringsLib.Append(CommandLine,ArgI);
          ArgLenI[i]:=StringsLib.Length(ArgI) + 1; (* Including 0C *)
          INC(i);
        END;
        NextArg();
      END; (* WHILE *)
      IF (i =0) THEN
        ArgC:=MAX(SHORTCARD);
        ArgVect:=NIL;
        RETURN;
      END;

      ArgC:=i;
      k:=0;
      ALLOCATE(ArgVect,(ArgC+1)*TSIZE(ADDRESS));
      FOR i:=0 TO ArgC-1 DO
        ALLOCATE(ArgVect^[i],ArgLenI[i]*TSIZE(CHAR));
        j:=0;
        REPEAT
          ArgI[j]:=CommandLine[k];
          INC(j); INC(k);
        UNTIL (CommandLine[k] = " ") OR (CommandLine[k] = 0C);
        ArgI[j]:=0C;
        StringsLib.Copy(ArgVect^[i]^,ArgI);
        IF (CommandLine[k] # 0C) THEN
          REPEAT INC(k); UNTIL (CommandLine[k] # " ");
        END;
      END;
END HoleArgumente;

PROCEDURE RdIntFromArgList(    iarg : CARDINAL;
                           VAR i    : INTEGER;
                           VAR ok   : BOOLEAN);

          VAR result : ConvResults;
              Arg    : ARRAY [0..63] OF CHAR;
BEGIN
      IF (iarg <= GetArgCount()) THEN
        GetArgument(iarg,Arg);
        StringToInt(Arg,i,result);
        ok:= (result = strAllRight);
      ELSE
        ok:=FALSE;
      END;
      IF NOT ok THEN i:=MAX(INTEGER); END;
END RdIntFromArgList;

PROCEDURE RdRealFromArgList(    iarg : CARDINAL;
                            VAR x    : LONGREAL;
                            VAR ok   : BOOLEAN);

          VAR result : ConvResults;
              Arg    : ARRAY [0..63] OF CHAR;
BEGIN
      IF (iarg <= GetArgCount()) THEN
        GetArgument(iarg,Arg);
        StringToReal(Arg,x,result);
        ok:= (result = strAllRight);
      ELSE
        ok:=FALSE;
      END;
      IF NOT ok THEN x:=MAX(LONGREAL); END;
END RdRealFromArgList;

BEGIN (* Lese Kommandozeilenparameter ein / get command line *)

      ArgC:=0;

      HoleArgumente();

END ArgAccess.