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.}