Path: utzoo!mnetor!uunet!mcvax!unido!tub!tmpmbx!mcshh!snake
From: snake@mcshh.UUCP (Michael Koehler)
Newsgroups: comp.lang.pascal
Subject: src
Message-ID: <7@mcshh.UUCP>
Date: 24 Feb 88 19:46:06 GMT
Lines: 61
Keywords: source pas...


program clearmem;
  {-clear all memory above this program}
var
  smin,omin,smax,omax,s,finalbytes:integer;
  fillbyte:byte;
  rmin,rmax,r:real;
  lastvar:integer;

function stackptr:integer;
  {-return the current stack pointer}
var
  sptr:integer;
begin
  inline(
    $8B/$C4/$89/$46/<sptr
  );
  stackptr:=sptr;
end; {stackptr}

function cardinal(i:integer):real;
  {-return real 0..65535}
var
  r:real;
begin
  r:=i;
  if r<0 then r:=r+65536.0;
  cardinal:=r;
end; {cardinal}

function realaddr(s,o:integer):real;
  {-return the real offset into memory}
begin
  realaddr:=16.0*cardinal(s)+cardinal(o);
end; {realaddr}

begin
  omin:=ofs(lastvar);
  smax:=sseg;
  omax:=stackptr-$100;
  rmax:=realaddr(smax,omax);
  writeln;
  write('Enter byte to use for clearing: ');
  readln(fillbyte);
  s:=dseg;
  while realaddr(s,omin)<(rmax-16384.0) do begin
    fillchar(mem[s:omin],16384,fillbyte);
    s:=s+$400;
  end;
  s:=s-$400;
  finalbytes:=trunc(rmax-realaddr(s,omin));
  fillchar(mem[s:omin],finalbytes,fillbyte);
end.



(snake@mcshh.UUCP)

-- 
VOICE :(040) 5602608
---------------------