runtime/src/WIN32/RTArgs.m3


Copyright (C) 1994, Digital Equipment Corp.
In Windows/NT, envp points at a null-terminated block of null-terminated strings

UNSAFE MODULE RTArgs;

IMPORT RTLinker, Ctypes, Cstdlib, M3toC, WinBase;

CONST
  NUL    = VAL (0, Ctypes.char);
  QUOTE  = VAL (ORD ('"'), Ctypes.char);
  BSLASH = VAL (ORD ('\134'), Ctypes.char);

VAR env_c : CARDINAL := 0;

PROCEDURE ArgC (): CARDINAL =
  BEGIN
    IF (RTLinker.info.argc < 0) THEN ParseArgs (); END;
    RETURN RTLinker.info.argc;
  END ArgC;

PROCEDURE ParseArgs () =
  (* This hack is necessary because a windows GUI program is passed
     its command line unparsed.  This code is executed before the
     runtime type system is initialized. *)
  VAR
    cp       : Ctypes.char_star := RTLinker.info.argv;
    n_args   : INTEGER;
    n_chars  : INTEGER;
    next     : Ctypes.char_star_star;
    argv     : Ctypes.char_star_star;
    args     : Ctypes.char_star;
    quoted   : BOOLEAN;
    fn_len   : INTEGER;
    filename : ARRAY [0..255] OF Ctypes.char;
    is_blank : ARRAY Ctypes.char OF BOOLEAN;
  BEGIN
    IF (cp = NIL) THEN
      RTLinker.info.argc := 0;
      RETURN;
    END;

    FOR c := FIRST (is_blank) TO LAST (is_blank) DO is_blank[c] := FALSE; END;
    is_blank [ORD (' ')]  := TRUE;
    is_blank [ORD ('\r')] := TRUE;
    is_blank [ORD ('\n')] := TRUE;
    is_blank [ORD ('\t')] := TRUE;

    (* get a bound on number of arguments *)
    n_args := 0;
    WHILE (cp^ # NUL) DO
      (* skip blanks *)
      WHILE is_blank[cp^] DO INC (cp, ADRSIZE (cp^)); END;
      IF (cp^ = NUL) THEN EXIT; END;
      INC (n_args);
      WHILE (NOT is_blank[cp^]) AND (cp^ # NUL) DO INC (cp, ADRSIZE (cp^)); END;
    END;
    n_chars := cp - RTLinker.info.argv;

    (* try getting the file name *)
    fn_len := MAX (0, WinBase.GetModuleFileName (NIL, ADR (filename[0]),
                                         BYTESIZE(filename)));
    INC (n_chars, fn_len + 1);

    (* allocate the new argv arrays *)
    argv := Cstdlib.malloc ((n_args+2) * BYTESIZE (ADDRESS));
    args := Cstdlib.malloc ((n_chars+1) * BYTESIZE (CHAR));

    (* add the file name to the arg vectors *)
    n_args := 1;  next := argv;
    next^ := args;
    INC (next, ADRSIZE (next^));
    FOR i := 0 TO fn_len-1 DO
      args^ := filename[i];
      INC (args, ADRSIZE (args^));
    END;
    args^ := NUL;  INC (args, ADRSIZE (args^));

    (* parse the command line *)
    cp := RTLinker.info.argv;
    WHILE (cp^ # NUL) DO

      (* skip blanks *)
      WHILE is_blank[cp^] DO INC (cp, ADRSIZE (cp^)); END;

      IF (cp^ = NUL) THEN EXIT; END;

      (* add an arg *)
      next^ := args;
      INC (next, ADRSIZE (next^));
      INC (n_args);

      (* copy an arg *)
      quoted := FALSE;
      WHILE (cp^ # NUL) DO
        IF (is_blank[cp^]) THEN
          IF (NOT quoted) THEN EXIT; END;
          args^ := cp^;
          INC (args, ADRSIZE (args^));
        ELSIF (cp^ = QUOTE) THEN
          quoted := NOT quoted;
        ELSIF (cp^ = BSLASH) THEN (* escape *)
          INC (cp, ADRSIZE (cp^));
          IF (cp^ # QUOTE) THEN
            args^ := BSLASH;
            INC (args, ADRSIZE (args^));
          END;
          IF (cp^ = NUL) THEN EXIT; END;
          args^ := cp^;
          INC (args, ADRSIZE (args^));
        ELSE
          args^ := cp^;
          INC (args, ADRSIZE (args^));
        END;
        INC (cp, ADRSIZE (cp^));
      END;
      args^ := NUL;  INC (args, ADRSIZE (args^));

    END;
    next^ := NIL;

    RTLinker.info.argv := argv;
    RTLinker.info.argc := n_args;
  END ParseArgs;

PROCEDURE GetArg (n: CARDINAL): TEXT =
  VAR p: Ctypes.char_star_star := RTLinker.info.argv + n * ADRSIZE (ADDRESS);
      a: ARRAY [0..1] OF INTEGER;
  BEGIN
    IF (n >= RTLinker.info.argc) THEN
      n := 2;  n := a[n];  (* force a subscript fault *)
    END;
    RETURN M3toC.StoT (p^);
  END GetArg;

PROCEDURE EnvC (): CARDINAL =
  VAR
    cnt  : CARDINAL := 0;
    envp : Ctypes.char_star := RTLinker.info.envp;
  BEGIN
    IF (env_c = 0) AND (envp # NIL) THEN
      WHILE envp^ # NUL DO
        (* skip over string *)
        WHILE envp^ # NUL DO INC (envp, ADRSIZE (CHAR)) END;
        INC (envp, ADRSIZE (CHAR));
        INC (cnt);
      END;
      env_c := cnt;
    END;
    RETURN env_c;
  END EnvC;

PROCEDURE GetEnv (n: CARDINAL): TEXT =
  VAR envp : Ctypes.char_star := RTLinker.info.envp;
      a: ARRAY [0..1] OF INTEGER;
  BEGIN
    IF (n >= EnvC ()) THEN
      n := 2;  n := a[n];  (* force a subscript fault *)
    END;
    FOR i := 0 TO n-1 DO
      WHILE envp^ # NUL DO INC (envp, ADRSIZE (CHAR)) END;
      INC (envp, ADRSIZE (CHAR));
    END;
    RETURN M3toC.StoT (envp);
  END GetEnv;

BEGIN
END RTArgs.