20-Mar-84 20:48:17-PST,5273;000000000001
Return-Path: <b-davis@utah-cs>
Received: FROM utah-cs BY USC-ISIB.ARPA WITH TCP ; 20 Mar 84 20:46:17 PST
Received: by utah-cs.ARPA (4.19/3.33.3)
	id AA24179; Tue, 20 Mar 84 21:40:08 mst
Date: Tue, 20 Mar 84 21:40:08 mst
From: b-davis@utah-cs (Brad Davis)
Message-Id: <8403210440.AA24179@utah-cs.ARPA>
To: info-ibmpc@usc-isib
Subject: New Tools for MS-Pascal


I have three routines that the readers might be interested in.

	ENV (const s1: lstring; var s2: lstring);
		Returns the value of s1 from the current
		enviroment.  See the SET command.  If
		s1 were COMSPEC then s2 probably would be
		C:\COMMAND.COM for an XT.

	ARGC : integer;
		Returns the count of the parameters on the 
		command line.  Counts the program name as
		one of the parameters, e.g.  C>FOO BAR  would
		return 2.

	ARGV (i: integer; var s: lstring);
		I is the position of the parameter to return.
		In the example above ARGV(1,s) would return
		BAR in s.  Since MS-DOS doesn't give the 
		program name like UNIX, ARGV(0,s) would give
		the null string in s.  


ARGC and ARGV match the Berkely Pascal conventions for the same
named pre-declared routines.  They also match the C conventions
for the parameters to main().

All you need to do to use them is to declare them external in
your program and link them to your program.  If you have any 
questions just write.


				Brad Davis

P.S.  Sorry if the code is cryptic.  I usually don't spend time
      commenting my hacks.  I will answer any questions anyone
      might have.


------------------------------------------------------------------------
{$DEBUG-}
INTERFACE;
UNIT
    command_line(argc,argv,env);

    function argc: integer;
    procedure argv(num: integer; var s: lstring);
    procedure env(var inps,outs: lstring);

END;
IMPLEMENTATION OF command_line;
CONST
    CR = chr(13);
    PARAM = #80;
    ENVOFF = #2C;
TYPE
    smallstring = lstring(40);
    alphaarray = super array[0..*] of smallstring;
VAR
    doparse: boolean;
    doenv: boolean;
    parsecnt: integer;
    envcnt: integer;
    arguments: ^alphaarray;
    environment: ^alphaarray;
    CESXQQ [EXTERN]: WORD;
VALUE
    doparse := true;
    doenv:= true;

    procedure parsecommand;
    var
        i,j,k: integer;
        doskip: boolean;
        a: ads of lstring(255);
    begin
        doparse := false;
        a.s := CESXQQ;
        a.r := PARAM;
        parsecnt := 1;
        i := 1;
        while i <= (ord(a^.len)) do begin
            while a^[i] = ' ' do i := i + 1;
            parsecnt := parsecnt + 1;
            while (a^[i] <> ' ') and (a^[i] <> CR) do i := i + 1;
        end;
        new(arguments,parsecnt-1);
        i := 1;
        arguments^[0] := null;  { MS-DOS doesn't give us the program name }
        j := 0;
        while i <= (ord(a^.len)) do begin
            while a^[i] = ' ' do i := i + 1;
            j := j + 1;
            k := 1;
            while (a^[i] <> ' ') and (a^[i] <> CR) do begin
                arguments^[j][k] := a^[i];
                i := i + 1;
                k := k + 1;
            end;
            arguments^[j].len := wrd(k-1);
        end;
    end;

    procedure getenvironment;
    var
        i,j,k: integer;
        a: adsmem;
        offset: ads of word;
    begin
        doenv := false;
        offset.s := CESXQQ;
        offset.r := ENVOFF;
        a.s := offset^;
        a.r := 0;
        i := 0;
        envcnt := 0;
        while a^[wrd(i)] <> 0 do begin
            envcnt := envcnt + 1;
            while a^[wrd(i)] <> 0 do i := i + 1;
            i := i + 1;
        end;
        new(environment,envcnt);
        i := 0;
        j := 0;
        while a^[wrd(i)] <> 0 do begin
            k := 1;
            while a^[wrd(i)] <> 0 do begin
                environment^[j][k] := chr(a^[wrd(i)]);
                i := i + 1;
                k := k + 1;
            end;
            environment^[j].len := wrd(k-1);
            j := j + 1;
            i := i + 1;
        end;
    end;

    function argc{: integer};
    begin
        if doparse then parsecommand;
        argc := parsecnt;
    end;

    procedure argv{num: integer; var s: lstring};
    begin
        if doparse then parsecommand;
        if num < parsecnt then
            movel(adr arguments^[num],adr s,arguments^[num].len+1)
        else
            s.len := 0;
    end;

    procedure env{var inps,outs: lstring};
    var
        i,j: integer;
        s1,s2: lstring(255);
    begin
        if doenv then getenvironment;
        for i := 1 to ord(inps.len) do
            if (inps[i] >= 'a') and (inps[i] <= 'z') then
                s1[i] := chr(ord(inps[i]) - ord('a') + ord('A'))
            else
                s1[i] := inps[i];
        s1.len := inps.len;
        outs.len := 0;
        for i := 0 to envcnt-1 do begin
            s2 := environment^[i];
            j := positn('=',s2,1);
            delete(s2,j,ord(s2.len)-j+1);
            if s2 = s1 then begin
                movel(adr environment^[i],adr outs,environment^[i].len+1);
                delete(outs,1,j);
            end;
        end;
    end;

END.