Herb is a professor of economics at the University of Massachusetts, Thompson Hall, Amberst, MA 01003.
This article describes a Turbo Pascal 5.5 unit that implements the expanded memory equivalent of the Turbo Pascal dynamic memory functions getmem, freemen, memavail, and maxavail. The new functions -- xgetmem, xfreemem, xmemavail, and xmaxavail -- mirror their main memory counterparts as much as possible (see Table 1). However, the peculiarities of expanded memory do require some special treatment.
Table 1: The Xalloc unit interface section
Function Description
------------------------------------------------------------------------
type An address in memory is a pointer, but
xaddress = record in expanded memory, it must hold the
page : byte expanded memory page (page) and the
offset : word offset from the start of the page
end (offset). We call this an xaddress.
const xgetmem returns this page in an
nilpage = $ff; xaddress to indicate that the request
was denied.
function xalloc_init: boolean; Initializes the expanded memory
manager. Must be called before any
other routine in the unit. Returns
true if it's okay to use the model,
and false otherwise.
procedure xalloc_done; Releases all expanded memory. Invoked
as part of a program's exit procedure.
procedure xgetmem (var x: Requests a block of size bytes for
xaddress; size: word); variable x. The page and offset are
returned in x. Returns nilpage if
denied.
procedure xfreemem (var x: Returns the block of expanded memory to
xaddress; size : word); the pool.
function page_in (var x: Returns the address in memory of the
xaddress): pointer; block of expanded memory owned by
x. Since this function also moves the
page to main memory, it must be
called each time the variable x is
accessed, if there is a chance it
was paged out of memory.
function xmaxavail: Returns the maximum block size
longint; available.
function xmemavail: Returns the total amount of expanded
longint; memory available.
Expanded memory consists of pages, and a variable in expanded memory is identified by its page and the offset of the variable's storage in the page. We represent an expanded memory location by an xaddress record, consisting of a page and an offset; and xgetmem returns such an xaddress to the calling program. To access a variable in expanded memory, we must move the page of expanded memory into main memory and tell the calling program its location in main memory. This is accomplished by page_in, which takes the xaddress as an argument and returns the main memory address as a pointer. At the same time, it shuffles the proper page into main memory if it isn't already there.
It's very important to call page_in every time an expanded memory location or page is addressed, because some other routine may have shuffled it back out (through an interrupt, for example). The best way to ensure this is by building expanded memory management into the objects that use xalloc. For example, see the string-type object xline created in Listing One (page 121). The xalloc unit (see Listing Two , page 121) behaves in a manner almost identical to Turbo Pascal's memory manager. When a block of memory is requested by xgetmem, and if there are no "holes" in the expanded memory the unit controls, the block is taken from the heap -- the unused memory at the top of a page. If there is not enough room on the heap (there's actually a different heap for each page), a new page is allocated. When a block is deallocated by xfreemem, there are two possibilities: If the block is at the end of the heap, the heap is simply expanded; if the block is in the middle of an allocated block of memory, it is placed on a list of free memory "holes". Before checking the heap, xgetmem checks this array for a suitable block. If it finds one, the list of free memory holes is adjusted accordingly.
There are clear ways to improve the unit. One improvement is to switch automatically to main memory or disk, if expanded memory is not implemented or is exhausted. Another is to improve garbage collection and memory compaction.
_XALLOC: AN EXPANDED MEMORY MANAGER FOR TURBO PASCAL_ by Herbert Gintis[LISTING ONE]
<a name="0237_0006">
unit xlineobj;
{ Typical use:
program xtest;
uses xalloc,xlineobj;
var
s : xline;
begin
if not xalloc_init then halt;
s.init;
s.put_text('This goes into expanded memory');
writeln(s.get_text);
s.done;
xalloc_done;
end.
}
interface
uses xalloc;
type
xline = object
len : byte;
mem : xaddress;
constructor init;
destructor done; virtual;
procedure newsize(ncols : integer);
function get_text : string;
procedure put_text(s : string);
end;
implementation
var
xs : ^string;
constructor xline.init;
const
mincols = 8;
begin
xgetmem(mem,mincols);
len := mincols-1;
xs := xpage_in(mem);
xs^ := '';
end;
destructor xline.done;
begin
xfreemem(mem,len+1);
end;
procedure xline.newsize(ncols : integer);
begin
xfreemem(mem,len+1);
xgetmem(mem,ncols+1);
xs := xpage_in(mem);
len := ncols;
end;
function xline.get_text : string;
begin
xs := xpage_in(mem);
get_text := xs^;
end;
procedure xline.put_text(s : string);
begin
if length(s) <> len then newsize(length(s));
xs := xpage_in(mem);
xs^ := s;
end;
end.
<a name="0237_0007">
<a name="0237_0008">[LISTING TWO]<a name="0237_0008">
unit xalloc;
{-See the unit xlineobj.pas for typical use of this unit}
interface
const
nilpage = $ff;
type
xaddress = record
page : byte;
pos : word;
end;
function xalloc_init : boolean;
procedure xgetmem(var x : xaddress;size : word);
procedure xfreemem(var x : xaddress;size : word);
function xpage_in(var x : xaddress) : pointer;
function xmaxavail : longint;
function xmemavail : longint;
procedure xalloc_done;
implementation
uses crt,dos;
const
emm_int = $67;
dos_int = $21;
maxfreeblock = 4000;
xblocksize = $4000;
_get_frame = $41;
_unalloc_count = $42;
_alloc_pages = $43;
_map_page = $44;
_dealloc_pages = $45;
_change_alloc = $51;
type
xheap = array[0..1000] of word;
fblock = record
page : byte;
start,stop : word;
end;
fblockarray = array[1..maxfreeblock] of fblock;
var
regs : registers;
handle,tot_pages : word;
xheapptr : ^xheap;
xfreeptr : ^fblockarray;
last_page,lastptr : integer;
map : array[0..3] of integer;
frame : word;
function ems_installed : boolean;
const
device_name : string[8] = 'EMMXXXX0';
var
i : integer;
begin
ems_installed := false;
with regs do begin {check for ems present}
ah := $35; {get code segment pointed to by interrupt 67h}
al := emm_int;
intr(dos_int,regs);
for i := 1 to 8 do if device_name[i] <> chr(mem[es : i + 9]) then exit;
end;
ems_installed := true;
end;
function unalloc_count(var available : word): boolean;
begin
with regs do begin
ah := _unalloc_count;
intr(emm_int,regs);
available := bx;
unalloc_count := ah = 0 {return the error code}
end;
end;
function alloc_pages(needed: integer): boolean;
begin
with regs do begin
ah := _alloc_pages;
bx := needed;
intr(emm_int,regs);
handle := dx;
alloc_pages := (ah = 0); {return the error code}
end;
end;
function xdealloc_pages: boolean;
begin
with regs do begin
ah := _dealloc_pages;
dx := handle;
intr(emm_int,regs);
xdealloc_pages := (ah = 0); {return the error code}
end;
end;
function change_alloc(needed : integer) : boolean;
begin
with regs do begin
ah := _change_alloc;
bx := needed;
dx := handle;
intr(emm_int,regs);
change_alloc := (ah = 0); {return the error code}
end;
end;
function xmap_page(l_page,p_page: integer): boolean;
begin
xmap_page := true;
if map[p_page] <> l_page then with regs do begin
ah := _map_page;
al := p_page;
bx := l_page;
dx := handle;
intr(emm_int,regs);
xmap_page := (ah = 0);
if ah = 0 then map[p_page] := l_page;
end;
end;
function xpage_in(var x : xaddress) : pointer;
begin
if xmap_page(x.page,0) then xpage_in := ptr(frame,x.pos)
else xpage_in := nil;
end;
function xget_frame(var frame: word): boolean;
begin
with regs do begin
ah := _get_frame;
intr(emm_int,regs);
frame := bx;
xget_frame := (ah = 0); {return the error code}
end;
end;
procedure xgetmem(var x : xaddress;size : word);
var
i : integer;
begin
for i := 1 to lastptr do begin
with xfreeptr^[i] do begin
if size <= stop - start then begin
x.page := page;
x.pos := start;
inc(start,size);
if start = stop then begin
xfreeptr^[i] := xfreeptr^[lastptr];
dec(lastptr);
end;
exit;
end;
end;
end;
x.page := nilpage;
i := 0;
repeat
inc(i);
if i > tot_pages then exit;
if i > last_page then begin
inc(last_page);
if not change_alloc(last_page) then exit;
end;
until xblocksize - xheapptr^[pred(i)] > size;
with x do begin
page := pred(i);
pos := xheapptr^[page];
inc(xheapptr^[page],size);
end;
end;
procedure xfreemem(var x : xaddress;size : word);
var
i,xstop : integer;
begin
xstop := x.pos + size;
i := 0;
while i < lastptr do begin
inc(i);
with xfreeptr^[i] do begin
if x.page = page then begin
if x.pos >= start then begin
if x.pos <= stop then begin
x.pos := start;
if xstop < stop then xstop := stop;
xfreeptr^[i] := xfreeptr^[lastptr];
dec(lastptr);
dec(i)
end;
end
else if xstop >= start then begin
if xstop < stop then xstop := stop;
xfreeptr^[i] := xfreeptr^[lastptr];
dec(lastptr);
dec(i)
end;
end;
end;
end;
if lastptr > 0 then with xfreeptr^[lastptr] do
if start = stop then dec(lastptr);
if x.pos < xstop then begin
if xstop = xheapptr^[x.page] then xheapptr^[x.page] := x.pos
else begin
if lastptr < maxfreeblock then begin
inc(lastptr);
with xfreeptr^[lastptr] do begin
page := x.page;
start := x.pos;
stop := xstop;
end;
end;
end;
end;
end;
function xmemavail : longint;
var
s : longint;
i : integer;
begin
s := 0;
for i := 0 to pred(tot_pages) do inc(s,$4000 - xheapptr^[i]);
for i := 1 to lastptr do with xfreeptr^[i] do inc(s,stop - start);
xmemavail := s;
end;
function xmaxavail : longint;
var
s : longint;
i : integer;
begin
s := 0;
for i := 0 to pred(tot_pages) do
if $4000 - xheapptr^[i] > s then s := $4000 - xheapptr^[i];
for i := 1 to lastptr do with xfreeptr^[i] do
if stop - start > s then s := stop - start;
xmaxavail := s;
end;
procedure xalloc_done;
begin
if not xdealloc_pages then;
end;
function xalloc_init : boolean;
var
i : word;
begin
xalloc_init := false;
if not ems_installed then exit;
if not unalloc_count(tot_pages) then exit;
if tot_pages = 0 then exit;
if not xget_frame(frame) then exit;
getmem(xheapptr,tot_pages*sizeof(word));
if xheapptr = nil then exit;
new(xfreeptr);
if xfreeptr = nil then exit;
for i := 0 to pred(tot_pages) do xheapptr^[i] := 0;
if not alloc_pages(1) then exit;
xalloc_init := true;
lastptr := 0;
last_page := 1;
for i := 0 to 3 do map[i] := -1;
end;
end.
Copyright © 1991, Dr. Dobb's Journal
