(* * * * * * * * * * * * * * * * * * *
 *
 * prog2-3.pas
 *
 * A slightly more comprehensive
 * Memory Display Utility
 *
 * * * * * * * * * * * * * * * * * * *)

program prog2_3;

uses    dos,
        crt,
        _globals,
        _mcb;



(*
 *
 *  Define a function to get the PSP
 *)
function get_prog_psp: WORD;

var
    regs:               registers;

begin

    regs.AH:= $51;

    MsDos(regs);

    get_prog_psp:= regs.BX;
end;


(*
 *  Define a function to get the DOS version
 *)

procedure getDosVersion(var maj_rev: WORD; var min_rev: WORD);

var
    regs:               registers;

begin
    regs.AL:= $01;
    regs.AH:= $30;
    MsDos(regs);

    maj_rev:= regs.AL;
    min_rev:= regs.AH;

end;

(*
 *  isFNameChar tells whether a character is a "reasonable" filename
 *  character. Filenames can have any character but we exercise some
 *  judgement over what characters are acceptable.
 *)
function isFNameChar(c: Char) : Boolean;

begin
    isFNameChar:= ((c >= 'a') and (c <= 'z')) or
                    ((c >= 'A') and (c <= 'Z')) or
                    ((c >= '0') and (c <= '9')) or
                    (c = '_') or
                    (c = '-') or
                    (c = '$');
end;

(* * * * * * * * * * * *
 * declare MCB
 * structures
 * * * * * * * * * * * *)
var
    mcbPtr:             MCB_McbPtr;
    ownerMcbPtr:        MCB_McbPtr;

    maj_rev:            Word;
    min_rev:            Word;

    help:               Boolean;

    tmpStr:             String;

    f2e:                BytePtr;
    seg2e:              Word;

    prog_psp:           Word;

    i:                  Word;

    temp:               WordPtr;
    envseg:             Word;
    env:                CharPtr;

    charCount:          Word;

    command:            String;
    expectCommand:      Boolean;
    done:               Boolean;

    vectorsPrinted:     Word;
    vecSeg:             Word;
    remainder:          Word;

begin

    (*
     *  Check help flag and set on '/h' command line
     *  parameter
     *)
    tmpStr:= paramStr(1);
    help:= (paramCount <> 0) and
                    (tmpStr[1] = '/') and
                    ((tmpStr[2] = 'H') or
                        (tmpStr[2] = 'h') or
                        (tmpStr[2] = '?'));

    (*
     *  Get DOS version
     *)
    getDosVersion(maj_rev, min_rev);

    (*
     *  Get pointer to int 2eh (points into command com code).
     *  We'll use this to figure out whether a vector is hooked by
     *  COMMAND.COM
     *)
    f2e:= BytePtr(getVecPointer($2e));
    seg2e:= Seg(f2e^) + (Ofs(f2e^) shr 4);

    (*
     * get program psp
     *)
    prog_psp:= get_prog_psp;

    (*
     * fill Mem Cntl
     * block with info
     *)
    mcbPtr:= getMcbPointer;

    (*
     *  Put out first header line:
     *)
    TextBackground(Cyan);
    TextColor(Black);
    write(
    '          Clementine''s Memory Display Program V2.0    DOS Rev ',
    maj_rev:2, '.', min_rev:1,
    '              ');

    (*
     *  Reset the attributes to normal:
     *)
    TextBackground(Black);
    TextColor(White);


    if help then begin

        (*
         * place the cursor

        writeln;
        writeln;

        (*
         *  Print help messages
         *)
        writeln('Program Syntax: prog2-3 [option]');
        writeln;
        writeln('Options:');
        writeln('   /H  => Help information');
        writeln('   /?  => Help information');

        (*
         * place the cursor
         *)
        writeln;
        writeln;

        (*
         * exit to DOS
         *)
        Halt;
        end;


    (*
     *  Put out second header line:
     *)
    TextBackground(LightGray);
    TextColor(Black);
    write(
    'PSP   SIZE  PROGRAM     COMMAND  LINE               HOOKED  VECTORS             ');

    (*
     *  Reset attributes.
     *)
    TextBackground(Black);
    TextColor(White);

    (*
     *  Loop and print MCB information
     *)
    repeat

        (*
         *  Get the owner's MCB address.
         *)
        ownerMcbPtr:= Ptr(mcbPtr^.owner_psp - 1, 0);

        (*
         *  Print out the basic information
         *)
        write(hex(mcbPtr^.owner_psp, 4),'³',
                (DWord(mcbPtr^.size_paragraphs) shl 4):6, '³');


        expectCommand:= True;

        (*
         *  If vector 2eh points within this block then
         *  it's COMMAND.COM
         *)
        if (seg2e >= Seg(mcbPtr^)) and
                (seg2e <= Seg(mcbPtr^) + (mcbPtr^.size_paragraphs)) or
                (seg2e >= Seg(ownerMcbPtr^)) and
                (seg2e <= Seg(ownerMcbPtr^)) then begin
            write('COMMAND ');
            expectCommand:= False;
            end

        (*
         *  If PSP is 0 then it's free
         *)
        else if mcbPtr^.owner_psp = 0 then begin
            write('(FREE)  ');
            expectCommand:= False;
            end

        (*
         *  If PSP is 8 then it's config
         *)
        else if mcbPtr^.owner_psp = $08 then begin

            write('(SYSTEM)');
            expectCommand:= False;
            end

        (*
         *  If we're running DOS 4.0 or better, then we can
         *  look in the owner's MCB structure for program name
         *)
        else if maj_rev >= 4 then begin
            i:= 0;
            while (i < 8) and isFNameChar(ownerMcbPtr^.file_name[i]) do begin
                write(ownerMcbPtr^.file_name[i]);
                i:= i + 1;
                end;
            if i = 0 then begin
                write('(N/A)   ');
                end
            else begin
                while i < 8 do begin
                    write(' ');
                    i:= i + 1;
                    end;
                end;
            end

        (*
         *  Otherwise print the program name from the owner psp
         *)
        else begin

            (*
             *  Get environment segment pointer
             *)
            temp:= WordPtr(Ptr(mcbPtr^.owner_psp, $2c));

            (*
             *  Get program environment segment
             *)
            envseg:= temp^;

            (*
             *  Set pointer to environment
             *)
            env:= Ptr(envseg,0);

            (*
             *  Search environment for the program name
             *
             *  Scan to the double delimiter.
             *)
            while (env^ <> Chr(0)) or (CharPtr(DWord(env)+1)^ <> Chr(0)) do begin
                env:= CharPtr(DWord(env)+1);
                end;

            (*
             *  Skip the double delimiter:
             *)
            env:= CharPtr(DWord(env)+2);

            (*
             *  Search for executable filename.
             *)
            while env^ <> '.' do begin
                env:= CharPtr(DWord(env)+1);
                end;

            (*
             *  Backspace to backslash which precedes the
             *  executable filename
             *)
            while env^ <> '\' do begin
                env:= CharPtr(DWord(env)-1);
                end;


            (*
             *  Point to the first letter of the filename
             *)
            env:= CharPtr(DWord(env)+1);

            (*
             *  Print the text up to the dot
             *)
            charCount:= 0;
            while env^ <> '.' do begin
                write(env^);
                env:= CharPtr(DWord(env)+1);
                charCount:= charCount + 1;
                end;

            for i:= charCount+1 to 8 do begin
                write(' ');
                end;
            end;

        write('³');

        if expectCommand then begin
            (*
             *  Copy the command line.
             *)
            command:= StrPtr(Ptr(mcbPtr^.owner_psp, $80))^;

            (*
             *  Shorten the command line to 20 if necessary
             *)
            if Ord(command[0]) > 20 then begin
                command[0]:= Chr(20);
                end;

            (*
             *  Print it out
             *)
            write(command);

            (*
             *  Pad with spaces
             *)
            for i:= Ord(command[0])+1 to 20 do begin
                write(' ');
                end;
            end
        else begin
            write('                    ');
            end;


        write('³ ');


        (*
         *  Now let's see if we have hooked vectors:
         *)
        vectorsPrinted:= 0;
        for i:= 0 to 255 do begin
            vecSeg:= Seg(BytePtr(getVecPointer(i))^);
            if (vecSeg >= Seg(mcbPtr^)) and
                    (vecSeg <= Seg(mcbPtr^) + mcbPtr^.size_paragraphs) then begin
                (*
                 *  See if we've filled the line:
                 *)
                if (vectorsPrinted > 0) and
                        (vectorsPrinted mod 12 = 0) then begin
                    write(' ');
                    write('    ³      ³        ³                    ³ ');
                    end;
                write(hex(i,2), ' ');
                vectorsPrinted:= vectorsPrinted + 1;
                end;
            end;

        (*
         *  Clear the rest of the line and advance to next line
         *)
        if vectorsPrinted = 0 then begin    
            remainder:= 37;
            end
        else begin
            remainder:= 37 - 3 * (((vectorsPrinted + 11) mod 12) + 1);
            end;
        for i:= 1 to remainder do begin
            write(' ');
            end;



        (*
         *  If we've reached the 'Z', we're at the end.
         *  Otherwise go to the next block
         *)
        if mcbPtr^.chain_status = 'Z' then begin
            done:= True;
            end
        else begin
            mcbPtr:= Ptr(Seg(mcbPtr^) + mcbPtr^.size_paragraphs + 1, 0);
            done:= False;
            end;

    until done;


    writeln(
    'ÄÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

end.