Posted By: Jovo (Jovo) on 'CZprogram'
Title: Pascal a velke bloky pameti
Date: Wed Jan 15 10:45:20 1997
{
Nazdar,
tohle je unita, ktera pracuje pod Pascalem s velkejma blokama pameti
(>64KB). Program se musi ladit pod BP.EXE a v menu Compile nastavit
target na PROTECTED !. BP bezi pod DPMI, proto je treba mit QEMM, nebo
dpmi16.ovl a ja uz nevim co.
Chyba je, ze to nejde primo krokovat (F8). Jedinej zpusob je v
Options/Tools/Turbo Debugger nastavit misto TD -> TDX a pak program
prelozit (F9) a pak na nej pustit TDX (shift+F4). Zaroven je dobry
v Options/Debugger nastavit jak Standalone ... tak Integrated ...
prokrokovani zdrojaku a ne prelozeneho kodu :)
Pak jen Malloc(pointer, velikost) / Free(pointer) a jede to.
Hlodla pamet se hned Zamkne. DPMI totiz muze swapovat na disk a proto
se pamet, kdyz se s ni nic nedela odemkne (GlobalLock, GlobalUnLock)
a kdyz je treba, pak se zamkne. Malloc hned zamyka, takze se o to
nemusite starat.
------------------------------------------------------------------------
Testovaci programek dole naplni pole 640*480 LongIntu a kazdej naplni
a pak je precte a porovna, jestli to sedi. Fachalo mi to pod BP.EXE 7.0
a EMM386. Zkusil jsem treba takove forky, jako je zapsat dva Wordy a pak
to precist jako LongInt a vono to fachalo ! Nooo, na 386/40 to byla hruza,
ale na Pentaku/100 to byly vteriny.
Kouknete se na proceduru AdjustPointer, NUTNE ji potrebuju zoptimalizovat !
Zkusil jsem udelat 32-bit .OBJ v ASM a slinkovat to, ale porad mi to hlasi
GPF, zrejme, ze to nema povolenej pristup do Cseg a Dseg nebo co. Pak jsem
to zkusil udelat pres
db $66 mov es,_index
a asi nejsem takovej machr, aby mi to chodilo :)
HEEEEELP ! PLEEEEEAAAASEEEEEE ! Optimalizujte to a postnete to sem.
Jovo.
{----------------------------------------------------------------------}
{ cut here }
unit memwrite;
{by JOVO 97,
- xhovor00@dcse.fee.vutbr.cz
- public domain, ale kdyz to budete chtit pouzit, tak skody zpusobene timto
kodem jdou na vas vrub a poslete mi trochu slivovice :) jako odmenu a
nebude-li slivka, tak mi dejte kredit.
- Jestli to modifikujete, tak mi to poslete, protoze bych rad dostal nejake
do ruky nejake optimalizace, tohle je jen first-thought code, i kdyz
facha
- co takhle WriteProm ( var p:pointer;var promenna;var count : byte);
ktera by psala promennou do pameti na zaklade odkazu a kolik
byte zapsat ? Hmm, to stoji za pokus.
}
interface
uses winapi;
{to je for, co :) }
type
short = shortint;
long = longint;
int = integer;
{jestli nekdo potrebuje vetsi presnost, tak sorry.
Type | Range | Digits | Bytes | Pocet/64KB
--------------------------------------------------------
short | -128..127 | 1 * | 65536
byte | 0..255 | 1 * | 65536
int | -32768..32767 | 2 * | 32768
word | 0..65535 | 2 * | 32768
long | -2147483648..2147483647 | 4 * | 16384
--------------------------------------------------------
real | 2.9e-39..1.7e38 | 11-12 | 6 | -----
single | 1.5e-45..3.4e38 | 7-8 | 4 * | 16384
double | 5.0e-324..1.7e308 | 15-16 | 8 * | 8192
extended | 3.4e-4932..1.1e4932 | 19-20 | 10 | ------
comp | -9.2e18..9.2e18 | 19-20 | 8 * | 8192
Jak vidno, pouze typy oznacene * jsou 'sude' - vleze se jich do
jednoho segmentu cely pocet. Kdybyste pak chteli zapsat napriklad
real (6B) na adresu 65535-1, tak se prvni 2B vlezou a 4B za nima
nechutne 'pretecou' -> GPF error jak blazen :)
}
real = double;
function Malloc(size:long):pointer;
{ = getmem
- alokuje a zamkne blok pameti}
function free(var p:pointer):Thandle;
{ = freemem, jenze je bez parametru (udavajici pocet uvolnovanych byte)
- uvolni a odemkne blok pameti}
{No, a tyhle procedurky a funkce zapisi Byte,Long,...,Real do pameti
na urcene misto. Prectete si popis u WRITESHORT}
procedure WriteShort(p:pointer;index:long;S:short);
function ReadShort(p:pointer;index:long):short;
procedure WriteByte(p:pointer;index:long;R:byte);
function ReadByte(p:pointer;index:long):byte;
procedure WriteInt(p:pointer;index:long;R:int);
function ReadInt(p:pointer;index:long):int;
procedure WriteWord(p:pointer;index:long;R:word);
function ReadWord(p:pointer;index:long):word;
procedure WriteLong(p:pointer;index:long;R:long);
function ReadLong(p:pointer;index:long):long;
procedure WriteReal(p:pointer;index:long;R:real);
function ReadReal(p:pointer;index:long):real;
implementation
{tak tohle jsou vnitrni konstanty a promenne}
const flags=GMEM_zeroinit;{cerstve hlodla pamet se vymaze nulama}
const Q = 65535; {viz adjust Pointer}
const __SB = sizeof(byte);{ uff }
__SS = sizeof(short);
__SI = sizeof(int);
__SW = sizeof(word);
__SL = sizeof(long);
__SR = sizeof(real);
safe = 56 ; {Kolik byte se alokuje navic na kazdy pointer, aby moh
clovek po alokaci 150ti Longu moh zapsat i ten 150tej a
nedockal se GPF error (216).
Experimentalne ziskane vysledky hodnoty SAFE:
byte :5 5*1 +0
word :11 5*2 +1
long :22 5*4 +2
real :34 5*6 +4
extended:56 5*10+6
Coz je zrejme Sizeof(typ)*5 + SizeOf(predchazejici Typ);
}
VAR
_PB:^Byte; {ukazatele, pres ktere se zapisuje a cte}
_PS:^Short;
_PI:^Int;
_PW:^Word;
_PL:^Long;
_PR:^Real;
_index:Long; {prepocitavaci index}
_p :pointer;{pointer, obema se ulehci zasobniku}
s,o:word;
function Malloc(size:long):pointer;
begin;
Malloc:=GlobalAllocPtr(flags,size+safe);
end;
function free(var p:pointer):Thandle;
begin;
free:=GlobalFreePtr(p);
end;
Function AdjustPointer:pointer;
{prepocte segment a offset pointru vzhledem k _indexu}
{const Q = 65535 }
begin;
asm
les di,_p
mov s,es
mov o,di
end;{ ziskani kam ukazuje p}
while _index>Q do {dokud preleza hranici 64KB...}
begin;
s:=s+SelectorInc; { ...zvedni segment o 8... }
_index:=_index-Q-1; {a zmensi ho o hranice-1, proc o -1 to nevim
ale facha to :) }
end;
AdjustPointer:=ptr(s,o+_index);{pak z seg a ofs vyrob pointer
a ten vrat}
end;
procedure WriteShort(p:pointer;index:long;S:short);
begin;
_index:=index*__SS;{index je v bytech, proto se musi vynasobit
velikosti toho ktereho typu. Tady to zrovna
neni treba, ale uz takovy typ word...}
_p := p; {pomocne prirazeni}
_PS:=AdjustPointer;{Prepocita pointer. Funkce GlobalAllocPtr alokuje
pamet jako po sobe jdouci segmenty. Jenze v sele
ktorech je neco navic (prava), takze kdyz
prelezeme
64KB hranici, neinkrementuje se segment, ale
musi se
k nemu pripocitat 8. To znamena, ze jestlize je
index 5x pres hranici 64KB, pak se SSSS:OOOO
prepocita
jako SSSS+8*5:OOOO a mame spravny index.}
_PS^:=S;{Zapise short.}
end;
function ReadShort(p:pointer;index:long):short;
begin;
_index:=index*__SS;_p := p;
_PS:=AdjustPointer;
ReadShort:=_PS^;
end;
procedure WriteByte(p:pointer;index:long;R:byte);
begin;
_index:=index*__SB;_p := p;
_PB:=AdjustPointer;
_PB^:=R;
end;
function ReadByte(p:pointer;index:long):byte;
begin;
_index:=index*__SB;_p := p;
_PB:=AdjustPointer;
ReadByte:=_PB^;
end;
procedure WriteInt(p:pointer;index:long;R:int);
begin;
_index:=index*__SI;_p := p;
_PI:=AdjustPointer;
_PI^:=R;
end;
function ReadInt(p:pointer;index:long):int;
begin;
_index:=index*__SI;_p := p;
_PI:=AdjustPointer;
ReadInt:=_PI^;
end;
procedure WriteWord(p:pointer;index:long;R:word);
begin;
_index:=index*__SW;_p := p;
_PW:=AdjustPointer;
_PW^:=R;
end;
function ReadWord(p:pointer;index:long):word;
begin;
_index:=index*__SW;_p := p;
_PW:=AdjustPointer;
ReadWord:=_PW^;
end;
procedure WriteLong(p:pointer;index:long;R:long);
begin;
_index:=index*__SL;_p := p;
_PL:=AdjustPointer;
_PL^:=R;
end;
function ReadLong(p:pointer;index:long):long;
begin;
_index:=index*__SL;_p := p;
_PL:=AdjustPointer;
ReadLong:=_PL^;
end;
procedure WriteReal(p:pointer;index:long;R:real);
begin;
_index:=index*__SR;_p := p;
_PR:=AdjustPointer;
_PR^:=R;
end;
function ReadReal(p:pointer;index:long):real;
begin;
_index:=index*__SR;_p := p;
_PR:=AdjustPointer;
ReadReal:=_PR^;
end;
{/////////////////////////////////////////////////////////////////////////////}
begin;
writeln('Pripocitavat se bude : ',SelectorInc);
if SelectorInc=$1000 then
begin;
writeln('...tato hodnota odpovida realnemu modu, ja chci DPMI !....');
halt(1);
end;
end.
{----------------------------------------------------------------------}
{ cut here }
program memwrite_test;
uses crt,memwrite;
procedure pam;
begin;
writeln(' volna pamet : ',maxavail,' Byte.');
end;
var p,p2:pointer;
pocet:long;
r:real;
L,base:long;
W:word;
begin;
clrscr;
pam;
w:=SizeOf(long);
pocet:=640*480;
writeln('Pocet = ',pocet,' velikost jednotky = ',w,' clekem = ',pocet*w,'
Byte');
P:=Malloc(pocet*w);{alokace}
pam;
if P=Nil then
begin;
writeln('malo pameti....');
halt;
end;
writeln('test start');
for l:=0 to pocet do writeLong(p,l,l);
{zapiseme longinty}
writeln('konec zapisu');
for l:=0 to pocet do
{a pak je cteme, jestli souhlasi}
if ReadLong(p,l)<>l then
begin;
writeln('L = ',L,' ziskana hodnota = ',ReadLong(p,l));
{a jestli neco nesouhlasi}
end;
writeln('test end');
Free(p);{uvolneni}
pam;
end.
{----------------------------------------------------------}
{No a to je vse, pratele.}