home *** CD-ROM | disk | FTP | other *** search
- {************************************************************************
-
- * maps system memory blocks for PCDOS 3.0 and higher. *
-
- * may work on other versions of DOS but hasn't been tested. *
-
- * copyright (c) K. Kokkonen, TurboPower Software. *
-
- * released to the public domain for personal, non-commercial use only. *
-
- * written 1/2/86. *
-
- * telephone : 408-378-3672, CompuServe : 72457,2131. *
-
- * requires Turbo version 3 to compile *
-
- * BE SURE to compile with mAx dynamic memory = A000 *
-
- * limited to environment sizes of 255 bytes (default is 128 bytes) *
-
- ************************************************************************}
-
-
-
- PROGRAM MapMem;
-
- {-look at the system memory map using DOS memory control blocks}
-
-
-
- TYPE
-
- address = RECORD
-
- offset,segment : Integer;
-
- END;
-
-
- VAR
-
- mcbseg : Integer; {potential segment address of an MCB}
-
- nextseg : Integer; {computed segment address for the next MCB}
-
- prevseg : Integer; {segment address of the previous PSP}
-
- pspadd : Integer; {segment address of the current PSP}
-
- mcblen : Integer; {size of the current memory block in paragraphs}
-
- gotfirst : Boolean; {true after first MCB is found}
-
- gotlast : Boolean; {true after last MCB is found}
-
- idbyte : Byte; {byte that DOS uses to identify an MCB}
-
- vectors : ARRAY[0..$FF] OF address ABSOLUTE 0:0;
-
-
-
- PROCEDURE ShowTheBlock(VAR mcbseg,prevseg,nextseg : Integer;
-
- VAR gotfirst,gotlast : Boolean);
-
- {-display information regarding the memory block}
-
- TYPE
-
- pathname = STRING[64];
-
- hexstring = STRING[4];
-
- VAR
-
- st : pathname;
-
-
-
- FUNCTION Hex(i : Integer): hexstring;
-
- {-return the hex equivalent of an integer}
-
- CONST
-
- hc : STRING[16] = '0123456789ABCDEF';
-
- VAR
-
- l,h : Byte;
-
- BEGIN
-
- l := Lo(i); h := Hi(i);
-
- Hex :=
-
- hc[Succ(h SHR 4)]+hc[Succ(h AND $F)]+hc[Succ(l SHR 4)]+hc[Succ(l AND $F)];
-
- END;{hex}
-
-
-
- FUNCTION Cardinal(i : Integer): Real;
-
- {-return an unsigned integer 0..65535}
-
- VAR
-
- r : Real;
-
- BEGIN
-
- r := i;
-
- IF r<0 THEN r := r+65536.0;
-
- Cardinal := r;
-
- END;{cardinal}
-
-
-
- FUNCTION Owner(startadd : Integer): pathname;
-
- {-return the name of the owner program of an MCB}
-
- VAR
-
- e : STRING[255];
-
- i : Integer;
-
- t : pathname;
-
-
-
- PROCEDURE StripPathname(VAR pname : pathname);
-
- {-remove leading drive or path name from the input}
-
- VAR
-
- spos,cpos,rpos : Byte;
-
- BEGIN
-
- spos := Pos('\',pname);
-
- cpos := Pos(':',pname);
-
- IF spos+cpos = 0 THEN Exit;
-
- IF spos<>0 THEN
- BEGIN
-
- {find the last slash in the pathname}
-
- rpos := Length(pname);
-
- WHILE (rpos>0) AND (pname[rpos]<>'\') DO
- rpos := Pred(rpos);
-
- END
- ELSE
-
- rpos := cpos;
-
- Delete(pname,1,rpos);
-
- END;{strippathname}
-
-
-
- BEGIN
-
- {get the environment string to scan}
-
- e[0] := #255;
-
- Move(Mem[startadd:0],e[1],255);
-
-
-
- {find end of the standard environment}
-
- i := Pos(#0#0,e);
-
- IF i = 0 THEN
- BEGIN
-
- {something's wrong, exit gracefully}
-
- Owner := '';
-
- Exit;
-
- END;
-
-
-
- {end of environment found, get the program name that follows it}
-
- t := '';
-
- i := i+5;
-
- REPEAT
-
- t := t+Chr(Mem[startadd:i]);
-
- i := Succ(i);
-
- UNTIL Chr(Mem[startadd:i]) = #0;
-
- StripPathname(t);
-
- Owner := t;
-
-
-
- END;{owner}
-
-
-
- PROCEDURE WriteHooks(start,stop : Integer);
-
- {-show the trapped interrupt vectors}
-
- VAR
-
- v : Byte;
-
- vadd,sadd,eadd : Real;
-
-
-
- FUNCTION RealAdd(a : address) : Real;
-
- {-return the real equivalent of an address (pointer)}
-
- BEGIN
-
- WITH a DO
-
- RealAdd := 16.0*Cardinal(segment)+Cardinal(offset);
-
- END;{realadd}
-
-
-
- BEGIN{writehooks}
-
- sadd := 16.0*Cardinal(start);
-
- eadd := 16.0*Cardinal(stop);
-
- FOR v := 0 TO $40 DO
- BEGIN
-
- vadd := RealAdd(vectors[v]);
-
- IF (vadd >= sadd) AND (vadd <= eadd) THEN
-
- Write(Copy(Hex(v),3,2),' ');
-
- END;
-
- END;{writehooks}
-
-
-
- BEGIN{showtheblock}
-
-
-
- mcblen := MemW[mcbseg:3]; {size of the MCB in paragraphs}
-
- nextseg := Succ(mcbseg+mcblen); {where the next MCB should be}
-
- pspadd := MemW[mcbseg:1]; {address of program segment prefix for MCB}
-
-
-
- IF (gotlast OR (Mem[nextseg:0] = $4D)) AND (pspadd<>0) THEN
- BEGIN
-
- {found part of MCB chain}
-
-
-
- IF gotlast OR (pspadd = prevseg) THEN
- BEGIN
-
-
-
- {this is the MCB for the program, not for its environment}
-
- Write(
-
- ' ',Hex(mcbseg),' ', {MCB address}
-
- Hex(pspadd),' ', {PSP address}
-
- Hex(mcblen),' ', {size of block in paragraphs}
-
- 16.0*Cardinal(mcblen):6:0,' '); {size of block in bytes}
-
-
-
- {get the program owning this block by scanning the environment}
-
- IF gotfirst THEN
-
- st := Owner(MemW[pspadd:$2C])
-
- ELSE
-
- st := '(DOS)';
-
- WHILE Length(st)<13 DO
- st := st+' ';
-
- Write(st);
-
-
-
- {show any interrupt vectors trapped by the program}
-
- IF gotfirst THEN
-
- WriteHooks(pspadd,nextseg);
-
-
-
- WriteLn;
-
- gotfirst := True;
-
- END;
-
- prevseg := pspadd;
-
- END;
-
- END;{showtheblock}
-
-
-
- BEGIN{main}
-
-
-
- WriteLn;
-
- WriteLn(' Allocated Memory Map');
-
- WriteLn;
-
- WriteLn('MCB adr PSP adr paras bytes owner hooked vectors');
-
- WriteLn('------- ------- ------- ------- ---------- -----------------------------');
-
-
-
- {start above the Basic work area, could probably start even higher}
-
- mcbseg := $50;
-
- prevseg := 0;
-
- gotfirst := False;
-
- gotlast := False;
-
-
-
- {scan all memory until the last block is found}
-
- WHILE mcbseg<>$A000 DO
- BEGIN
-
- idbyte := Mem[mcbseg:0];
-
- IF idbyte = $4D THEN
- BEGIN
-
- {an allocated block}
-
- ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
-
- IF gotfirst THEN
- mcbseg := nextseg
- ELSE
- mcbseg := Succ(mcbseg);
-
- END
- ELSE
- IF (idbyte = $5A) AND gotfirst THEN
- BEGIN
-
- {last block, exit}
-
- gotlast := True;
-
- ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
-
- mcbseg := $A000;
-
- END
- ELSE
-
- {still looking for first block, try every paragraph boundary}
-
- mcbseg := Succ(mcbseg);
-
- END; {while}
-
-
-
- END.{main}
-
-
-
-