[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]
{
Sean Palmer
> I did not mean to imply that I expected a library that could provide
> access to XMS With simple Pointer dereferences. I understand the
> difficulty of accessing >1MB from a Real-mode Program. I would be
> happy(ECSTATIC in fact) if I could find a library that would allow an
> allocation to XMS, returning a handle to the block, and allow
> access(copying) of the block via a Procedure call. Of course, the
> catch is that the library would have to be able to deal With random
> allocations and deallocations-like a heap manager For XMS. I know that
> there are VMM's out there that can do this-I just can't get my hands
> on one!
Try this:
turbo pascal 6.0 source
}
Unit xms; {this Unit won't handle blocks bigger than 64k}
Interface
Function installed : Boolean;
Function init(Var h : Word; z : Word) : Boolean; {alloc xms}
Procedure avail(Var total, largest : Word); {how much free?}
Function save(h, z : Word; Var s) : Boolean; {move main to xms}
Function load(h, z : Word; Var s) : Boolean; {move xms to main}
Procedure free(h : Word); {dispose xms}
Function lock(h : Word) : LongInt;
Function unlock(h : Word) : Boolean;
Function getInfo(h : Word; Var lockCount, handlesLeft : Byte;
Var sizeK : Word) : Boolean;
Function resize(h, sizeK : Word) : Boolean;
Implementation
{Error codes, returned in BL reg}
Const
FuncNotImplemented = $80; {Function is not implemented}
VDiskDeviceDetected = $81; {a VDISK compatible device found}
A20Error = $82; {an A20 error occurred}
GeneralDriverError = $8E; {general driver error}
UnrecoverableError = $8F; {unrecoverable driver error}
HmaDoesNotExist = $90; {high memory area does not exist}
HmaAlreadyInUse = $91; {high memory area already in use}
HmaSizeTooSmall = $92; {size requested less than /HMAMIN}
HmaNotAllocated = $93; {high memory area not allocated}
A20StillEnabled = $94; {A20 line is still enabled}
AllExtMemAllocated = $A0; {all extended memory is allocated}
OutOfExtMemHandles = $A1; {extended memory handles exhausted}
InvalidHandle = $A2; {invalid handle}
InvalidSourceHandle = $A3; {invalid source handle}
InvalidSourceOffset = $A4; {invalid source offset}
InvalidDestHandle = $A5; {invalid destination handle}
InvalidDestOffset = $A6; {invalid destination offset}
InvalidLength = $A7; {invalid length}
OverlapInMoveReq = $A8; {overlap in move request}
ParityErrorDetected = $A9; {parity error detected}
BlockIsNotLocked = $AA; {block is not locked}
BlockIsLocked = $AB; {block is locked}
LockCountOverflowed = $AC; {lock count overflowed}
LockFailed = $AD; {lock failed}
SmallerUMBAvailable = $B0; {a smaller upper memory block is avail}
NoUMBAvailable = $B1; {no upper memory blocks are available}
InvalidUMBSegment = $B2; {invalid upper memory block segment}
xmsProc : Pointer = nil; {entry point For xms driver, nil if none}
Var
copyRec : Record
size : LongInt; {Bytes to move (must be even)}
srcH : Word; {handle (0=conventional mem)}
srcP : Pointer;
dstH : Word;
dstP : Pointer;
end;
Function installed : Boolean;
begin
installed := (xmsProc <> nil);
end;
Function init(Var h : Word; z : Word) : Boolean; Assembler;
Asm
mov dx, z
test dx, $3FF
jz @S
add dx, $400
@S: {allow For partial K's}
mov cl, 10
shr dx, cl {convert to K}
mov ah, 9
call xmsProc {allocate XMS block}
cmp ax, 1
je @S2
xor al, al
@S2:
les di, h
mov es:[di], dx
end;
Procedure avail(Var total, largest : Word); Assembler;
Asm
mov ah, 8
call xmsProc {query free xms}
les di, total
mov es:[di], dx
les di, largest
mov es:[di], ax
end;
Function copy : Boolean; Assembler;
Asm {internal}
push ds
mov si, offset copyRec {it's in DS, right?}
mov ah, $B
call xmsProc {copy memory}
cmp ax,1
je @S
xor al,al
@S:
pop ds
end;
Function save(h, z : Word; Var s) : Boolean;
begin
if odd(z) then
inc(z);
With copyRec do
begin
size := z;
srcH := 0;
srcP := @s; {source, from main memory}
dstH := h;
dstP := ptr(0,0); {dest, to xms block}
end;
save := copy;
end;
Function load(h, z : Word; Var s) : Boolean;
begin
if odd(z) then
inc(z);
With copyRec do
begin
size := z;
srcH := h;
srcP := ptr(0,0); {source, from xms block}
dstH := 0;
dstP := @s; {dest, to main memory}
end;
load := copy;
end;
Procedure free(h : Word); Assembler;
Asm
mov dx, h
mov ah, $A
call xmsProc
end;
Function lock(h : Word) : LongInt; Assembler;
Asm
mov ah, $C
mov dx, h
call xmsProc {lock xms block}
cmp ax, 1
je @OK
xor bx, bx
xor dx, dx
@OK: {set block to nil (0) if err}
mov ax, bx
end;
Function unlock(h : Word) : Boolean; Assembler;
Asm
mov ah, $D
mov dx, h
call xmsProc {unlock xms block}
cmp ax, 1
je @S
xor al, al
@S:
end;
Function getInfo(h : Word; Var lockCount, handlesLeft : Byte;
Var sizeK : Word) : Boolean; Assembler;
Asm
mov ah, $E
mov dx, h
call xmsProc {get xms handle info}
cmp ax, 1
je @S
xor al, al
@S:
les di, lockCount
mov es:[di], bh
les di, handlesLeft
mov es:[di], bl
les di, sizeK
mov es:[di], dx
end;
Function resize(h, sizeK : Word) : Boolean; Assembler;
Asm
mov ah, $F
mov dx, h
mov bx, sizeK
call xmsProc {resize XMS block}
cmp ax ,1
je @S
xor al, al
@S:
end;
begin
Asm {there is a possibility these ints will trash the ds register}
mov ax, $4300 {load check Function For xms driver}
int $2F {call multiplex int}
cmp al, $80
jne @X
mov ax, $4310
int $2F {get adr of entry point->es:bx}
mov Word ptr xmsProc, bx
mov Word ptr xmsProc+2, es
@X:
end;
end.
[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]