Sign in to follow this  
Weny Sky

TP7 - allocation memory more than 512kB

Recommended Posts

Weny Sky    122
Hi There! Is possible allocate as a whole more than 512 Kb memory vin Turbo Pascal 7.0? I must make database to school and 512 kB is too little :( thx for help

Share this post


Link to post
Share on other sites
darookie    1441
You would need to use either XMS or EMS memory for that. I'm not sure if this works on Windows NT (e.g. Windows 2000 and later). I have written two TP7 units (10+ years ago[smile]) that deal with this - let me now if you want to try them out. I would translate the comments to English then an post these here.

[edit]
I just tested it on Windows XP - XMS seems to work (at least up to 1MiB).
[/edit]

Share this post


Link to post
Share on other sites
darookie    1441

unit xms;
{ THIS UNIT IS COPYRIGHT 1995,96 BY PATRICK LEVIN.
IT'S FREE FOR USE AS LONG AS IT ISN'T COMMERCIAL.
}

interface

const
ERR_NOERR = $00; { kein Fehler }
ERR_NOTIMPLEMENTED = $80; { angegebene Funktion nicht bekannt }
ERR_VDISKFOUND = $81; { VDISK-RAMDISK entdeckt }
ERR_A20 = $82; { Fehler auf Adressleitung A20 }
ERR_GENERAL = $8E; { allgemeiner Treiberfehler }
ERR_UNRECOVERABLE = $8F; { nicht-behebbarer Fehler }
ERR_HMANOTEXIST = $90; { keine HMA vorhanden }
ERR_HMAINUSE = $91; { HMA bereits vergeben }
ERR_HMAMINSIZE = $92; { zu wenig Platz in HMA }
ERR_HMANOTALLOCED = $93; { HMA nicht allokiert }
ERR_A20STILLON = $94; { Adressleitung A20 noch an }
ERR_OUTOMEMORY = $A0; { kein extended Memory mehr frei }
ERR_OUTOHANDLES = $A1; { alle XMS-Handles belegt }
ERR_INVALIDHANDLE = $A2; { ungltiges Handle }
ERR_SHINVALID = $A3; { Source-Handle ungltig }
ERR_SOINVALID = $A4; { Source-Offset ungltig }
ERR_DHINVALID = $A5; { Destination-Handle ungltig }
ERR_DOINVALID = $A6; { Destination-Offset ungltig }
ERR_LENINVALID = $A7; { ungltige L„nge fr Move- Funktion }
ERR_OVERLAP = $A8; { verbotene šberlappung }
ERR_PARITY = $A9; { Par„tits-Fehler }
ERR_EMBUNLOCKED = $AA; { UMB ist nicht gesperrt }
ERR_EMBLOCKED = $AB; { UMB ist noch gesperrt }
ERR_LOCKOVERFLOW = $AC; { šberlauf des UMB-Sperrz„hlers }
ERR_LOCKFAIL = $AD; { UMB kann nicht gesperrt werden }
ERR_UMBSIZETOOBIG = $B0; { kleinerer UMB verfgbar }
ERR_NOUMBS = $B1; { kein UMB mehr verfgbar }
ERR_INVALIDUMB = $B2; { UMB-Segmentadresse ist ungltig }

var XMS_Avail : boolean;
SegXMM,OfsXMM : word;
PtrXMM : pointer;

const
XMM_Error : integer = 0;

function GetEMB (size: word): integer;
procedure FreeEMB (Handle: integer);
procedure ChangeEMBSize (Handle: integer;Newsize: word);
procedure CopyMem (SourceHandle: integer;SourceOfs: longint;
DestHandle: integer;DestOfs,Count: longint);
function GetPhyAdr(segment,offset: word): longint;
function GetHMA( LenB : word ) : boolean;
procedure ReleaseHMA;
function GetXMMErr: string; { (c) patrick levin }
function FreeXMS: integer; { (c) patrick levin }

implementation
{ procedure Init
==============
in : -
out : XMM_Error, XMS_Avail,
SegXMM, OfsXMM

XMS_Avail=true, wenn
XMS verfgbar
XMM_Error h„lt Fehlerwert,
wenn HIMEM.SYS nicht installiert
Init stellt fest, ob ein XMM
und XMS vorhanden sind und
setzt einen Zeiger auf d. XMM
}
procedure Init;assembler;
asm
mov ax,4300h{ mov ax,$4300-> Fkt.nummer v. HIMEM.SYS ( Anmerkungen P.L. ) }
int 2Fh { int 47 -> Multiplexeraufruf }
cmp al,80h { -> HIMEM gibt als einziger 80h zurck (andere FFh)}
je @Ok
mov XMS_Avail,0
jmp @Ende
@Ok:
mov ax,4310h { mov ax,$4310 -> Fkt.nummer Adr. ermitteln }
int 2Fh { Multiplexer aufrufen }
mov SegXMM,es { Far Pointer als ES:BX }
mov OfsXMM,bx
mov XMS_Avail,1
@Ende:
end;

{ Function GetEMB
===============
in : Size
out : Handle des EMB,
XMM_Error

Size gibt die Gr"áe des EMB
in KByte an
Handle ist das EMB-Handle f.
die anderen Funktionen
GetEMB allokiert Speicher im XMS
}
function GetEMB (size: word): integer;assembler;
asm
mov ah,9 { Fkt.nummer f. HIMEM }
mov dx,size { Gr"áe in DX ablegen }
call ds:[PtrXMM] { HIMEM ber Far Call aufrufen }
cmp ax,1 { alles Ok ? }
je @Ok
mov bh,0 { nein, HiByte l"schen }
mov XMM_Error,bx { Fehlerwert aus BX in XMM_Error laden }
jmp @Ende { Ende }
@Ok:
mov XMM_Error,0 { kein Fehler }
mov ax,dx { Handle in Ergebnisregister AX eintragen }
@Ende:
end;

{ procedure FreeEMB
=================
in : Handle
out : XMM_Error

Handle ist das, zuvor mit
GetEMB ermittelte Handle d. EMB
FreeEMB gibt allokierten Speicher
wieder frei
}
procedure FreeEMB (Handle: integer);assembler;
asm
mov ah,$A { -> ah s„he leicht bescheuert aus }
mov dx,Handle { Handle in DX laden }
call ds:[PtrXMM] { HIMEM ber Far Call aufrufen }
cmp ax,1 { alles Ok ? }
je @Ende
mov bh,0 { nein, Fehlerwert aus bx in XMM_Error laden }
mov XMM_Error,bx
@Ende:
end;

{ procedure ChangeEMBSize
=======================
in : Handle,NewSize
out : XMM_Error, Handle

NewSize ist d. neue Gr"áe des
bereits allokierten EMB
ChangeEMBSize „ndert die Gr"áe
allokierter EMBs
}
procedure ChangeEMBSize (Handle: integer;Newsize: word);assembler;
asm
mov ah,$F { Fkt.nummer f. HIMEM }
mov bx,Newsize { Gr"áe nach BX laden }
mov dx,Handle { Handle nach DX landen }
call ds:[PtrXMM] { HIMEM ber Far Call }
cmp ax,1 { alles Ok ? }
je @Ok
mov bh,0 { nein, Fehler aus BX }
mov XMM_Error,bx
jmp @Ende
@Ok:
mov XMM_Error,0 { Fehler auf null setzen}
mov ax,dx { Handle aus DX nach AX }
@Ende:
end;

{ procedure CopyMem
=================
in : SourceHandle, SourceOfs,
DestHandle, DestOfs, Count
out : XMM_Error

CopyMem kopiert den EMB m. SourceHandle
und d. Adr. SourceOfs in den EMB m.
DestHandle und der Adresse DestOfs
}
procedure CopyMem (SourceHandle: integer;SourceOfs: longint;
DestHandle: integer;DestOfs,Count: longint);
var SegXMMRec,OfsXMMRec: word;
XMMRec: record
Counter: longint;
SrceHdl: integer;
Source : longint;
DestHdl: integer;
Destina: longint;
end;
begin
with XMMRec do begin
Counter := Count;
SrceHdl := SourceHandle;
Source := SourceOfs;
DestHdl := DestHandle;
Destina := DestOfs;
end;
SegXMMRec := Seg(XMMRec);
OfsXMMRec := Ofs(XMMRec);
XMM_Error := 0;
asm
push ds
mov ax,ds
mov es,ax
mov ax,SegXMMRec
mov ds,ax
mov si,OfsXMMRec
mov ah,$b
call es:[PtrXMM]
cmp ax,1
je @Ende
mov bh,0
mov SegXMMRec,bx
@Ende:
pop ds
end;
XMM_Error:=SegXMMRec;
end;

{ function GetHMA
===============
in : Anzahl zu allokierender Bytes
out : true, wenn HMA zur Verfgung
gestellt wurde, sonst false

TSR-Programme sollten nur genau den
Speicher allokieren, den sie tat-
s„chlich brauchen, andere $FFFF
}
function GetHMA( LenB : word ) : boolean; assembler;
asm
mov dx, lenB
mov ah, 01h
call ds:[PtrXMM]
cmp ax,1
jne @Err
mov XMM_Error,0
mov ax,00h
jmp @Ende
@Err:
xor bh,bh
mov XMM_Error,bx
mov AX,01h
@Ende:
end;

{ procedure ReleaseHMA
====================
in : -
out : XMM_Error<>0, wenn HMA
nicht allokiert wurde

ReleaseHMA sollte vor Beendigung
eines Programms, das die HMA
benutzte, aufgerufen werden, damit
nachfolgende Programme die HMA nut-
zen k"nnen
}
procedure ReleaseHMA; assembler;
asm
mov ah,02h
call ds:[PtrXMM]
cmp bx,0
je @Ok
xor bh,bh
mov XMM_Error,bx
jmp @TheEnd
@Ok:
mov XMM_Error,0
@TheEnd:
end;


{ function GetXMMErr
==================
in : -
out : Fehlermeldungstring
}
function GetXMMErr: string;
begin
case XMM_Error of
ERR_NOERR : GetXMMErr:='Kein Fehler.';
ERR_NOTIMPLEMENTED : GetXMMErr:='Unbekannte Funktion.';
ERR_VDISKFOUND : GetXMMErr:='VDISK - RAMDISK entdeckt.';
ERR_A20 : GetXMMErr:='Fehler auf A20 Adressleitung.';
ERR_GENERAL : GetXMMErr:='Allgemeiner Treiberfehler.';
ERR_UNRECOVERABLE : GetXMMErr:='Nicht-behebbarer Fehler.';
ERR_HMANOTEXIST : GetXMMErr:='Kein HMA gefunden.';
ERR_HMAINUSE : GetXMMErr:='HMA bereits vergeben.';
ERR_HMAMINSIZE : GetXMMErr:='Nicht genug Platz in HMA.';
ERR_HMANOTALLOCED : GetXMMErr:='HMA nicht allokiert.';
ERR_A20STILLON : GetXMMErr:='Adressleitung A20 ist noch aktiv.';
ERR_OUTOMEMORY : GetXMMErr:='Kein EMB verfgbar.';
ERR_OUTOHANDLES : GetXMMErr:='Kein Handle mehr verfgbar.';
ERR_INVALIDHANDLE : GetXMMErr:='Ungltiges Handle.';
ERR_SHINVALID : GetXMMErr:='Ungltiges Source-Handle.';
ERR_SOINVALID : GetXMMErr:='Ungltige Source-Adresse.';
ERR_DHINVALID : GetXMMErr:='Ungltiges Destination-Handle.';
ERR_DOINVALID : GetXMMErr:='Ungltige Destination-Adresse.';
ERR_LENINVALID : GetXMMErr:='Ungltige Anzahl von Bytes fr CopyMem.';
ERR_OVERLAP : GetXMMErr:='Verbotene šberlappung von Adressen.';
ERR_PARITY : GetXMMErr:='Parit„tsfehler.';
ERR_EMBUNLOCKED : GetXMMErr:='Nicht gesperrter UMB.';
ERR_EMBLOCKED : GetXMMErr:='UMB gesperrt.';
ERR_LOCKOVERFLOW : GetXMMErr:='UMB Sperrz„hler šberlauf.';
ERR_LOCKFAIL : GetXMMErr:='UMB kann nicht gesperrt werden.';
ERR_UMBSIZETOOBIG : GetXMMErr:='UMB zu groá.';
ERR_NOUMBS : GetXMMErr:='Kein UMB verfgbar.';
ERR_INVALIDUMB : GetXMMErr:='Ungltige UMB-Segmentadresse.';
else GetXMMErr:='Unbekannter Fehler.';
end;
end;

function FreeXMS: integer; assembler;
asm
mov ah,08h
call ds:[PtrXMM]
mov ax,dx
cmp bx,80h
jb @Ok
xor bh,bh
mov XMM_Error,bx
jmp @TheEnd
@Ok:
mov XMM_Error,ERR_NOERR
@TheEnd:
end;

function GetPhyAdr(segment,offset: word): longint;
begin GetPhyAdr:=longint(segment) shl 16 or offset;end;
{ Initialisierungsteil }
begin
Init; { XMS berprfen, Fehler setzen }
PtrXMM:=Ptr(SegXMM,OfsXMM);{ Zeiger auf XMM initialisieren }
end.



You can use the function GetEMB to allocate a memory block on XMS memory and use the returned handle with CopyMem to copy memory to and from this block. To convert a TP heap pointer to a longint handle, you just cast it:

{ from heap to xms }
CopyMem( 0, longint(heapPtr), xmsHandle, xmsOffset, numberOfBytes );
{ xms to heap }
CopyMem( xmsHandle, xmsOffsetm, 0, longint(heapPtr), numberOfBytes );


HTH,
Pat.











Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

Sign in to follow this