| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549 |
- Listing:
- 1 (* Release 3.10 *)
- 2 (*-------------------------------------------------------------------------*
- 3 * *
- 4 * MSTORAGE.MOD - Dynamic allocations for mixed M2/C, and overlay model *
- 5 * *
- 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
- 7 * All Rights Reserved *
- 8 * *
- 9 *--------------------------------------------------------------------------*)
- 10
- 11 (*%F _fdata *)
- 12 (*# call(seg_name => null) *)
- 13 (*# data(seg_name => null) *)
- 14 (*%E *)
- 15 (*# module(implementation=>off) *)
- 16 (*# check(stack=>off,
- 17 index=>off,
- 18 range=>off,
- 19 overflow=>off,
- 20 nil_ptr=>off) *)
- 21
- 22 IMPLEMENTATION MODULE Storage;
- 23
- 24 (*
- 25 Version of STORAGE.MOD for DOS Overlay, Dynalink and mixed-language
- 26 libraries
- 27 *)
- 28
- 29 IMPORT SYSTEM, Lib, CoreMem, CoreSig, CoreMain;
- 30 (*%T _mthread *)
- 31 IMPORT Process;
- 32 (*%E *)
- 33
- 34 CONST
- 35 _DLLOVL = (_DLL OR _OVL) AND NOT _OS2;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 36
- 37 CONST
- 38 EndMarker = 0FFFFH;
- 39 Align = 4;
- 40
- 41
- 42 (* This is DOS ONLY *)
- 43
- 44 PROCEDURE FarMakeHeap( Source : CARDINAL; (* base segment of heap *)
- 45 Size : CARDINAL (* size in paragraphs *)
- 46 ) : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 47 VAR
- 48 storage,first,last : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 49 BEGIN
- 50 (*%T _mthread *)
- 51 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 52 (*%E *)
- 53 storage := [Source:0];
- ***** ^ not supported yet
- ***** ^ not supported yet
- 54 first := [Source+1:0];
- ***** ^ not supported yet
- ***** ^ not supported yet
- 55 last := [Source+Size-1:0];
- ***** ^ not supported yet
- ***** ^ not supported yet
- 56 storage^.next := first;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 57 storage^.size := 0;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 58 first^.next := last;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 59 last^.next := storage;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 60 first^.size := Size-2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 61 last^.size := EndMarker;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 62 (*%T _mthread *)
- 63 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 64 (*%E *)
- 65 RETURN storage;
- ***** ^ not supported yet
- 66 END FarMakeHeap;
- ***** ^ not supported yet
- 67
- 68
- 69 PROCEDURE FarHeapAllocate(Source : FarHeapRecPtr; (* source heap *)
- ***** ^ undeclared identifier
- 70 VAR A : FarADDRESS; (* result *)
- ***** ^ undeclared identifier
- 71 Size : CARDINAL); (* request size in paragraphs *)
- 72
- 73 VAR
- 74 res,prev,split : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 75 BEGIN
- 76 IF Source = MainHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 77 A:=CoreMem.halloc(LONGCARD(Size)<<4);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ arithmetic operand must be numeric
- 78 IF A = SYSTEM.FarNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 79 IF Check THEN
- ***** ^ undeclared identifier
- 80 Lib.RunTimeError(CoreSig._FatalErrorPos(), 90H, 'FarHeapAllocate : Out Of Space');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 81 ELSE
- 82 A := FarNIL;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 83 RETURN;
- 84 END;
- 85 END;
- 86 RETURN;
- 87 END;
- 88 (*%T _mthread *)
- 89 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 90 (*%E *)
- 91 IF Size=0 THEN INC(Size) END ;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 92 prev := Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 93 WHILE prev^.next^.size < Size DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 94 prev := prev^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 95 END;
- 96 res := prev^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 97 IF res^.size = EndMarker THEN (* heap run out of space *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 98 SYSTEM.EI ;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 99 IF Check THEN
- ***** ^ undeclared identifier
- 100 Lib.RunTimeError(CoreSig._FatalErrorPos(), 90H, 'FarHeapAllocate : Out Of Space');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 101 ELSE
- 102 A := FarNIL;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 103 RETURN;
- 104 END;
- 105 END;
- 106 IF res^.size = Size THEN (* block correct size *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- 107 prev^.next := res^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 108 ELSE (* split block, bottom half returned, top half linked to free chain *)
- 109 split := [CARDINAL(Seg(res^))+Size:0];
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 110 prev^.next := split;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 111 split^.next := res^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 112 split^.size := res^.size - Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 113 END;
- 114 (*%T _mthread *)
- 115 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 116 (*%E *)
- 117 A := FarADR(res^);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 118 END FarHeapAllocate;
- ***** ^ not supported yet
- 119
- 120
- 121 PROCEDURE FarHeapAvail(Source: FarHeapRecPtr) : CARDINAL;
- ***** ^ undeclared identifier
- 122 (* returns the largest block size available for allocation in paragraphs *)
- 123 VAR
- 124 size : CARDINAL;
- 125 p : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 126 BEGIN
- 127 IF Source = MainHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 128 size := CARDINAL(CoreMem._fblockavail() DIV 16);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 129 IF size # 0 THEN
- 130 DEC(size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 131 END;
- 132 RETURN size;
- 133 END;
- 134 (*%T _mthread *)
- 135 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 136 (*%E *)
- 137 p := Source^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 138 size := 0;
- 139 WHILE p^.size <> EndMarker DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 140 IF p^.size>size THEN size := p^.size END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 141 p := p^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 142 END;
- 143 (*%T _mthread *)
- 144 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 145 (*%E *)
- 146 RETURN size;
- 147 END FarHeapAvail;
- ***** ^ not supported yet
- 148
- 149
- 150 PROCEDURE FarHeapTotalAvail(Source: FarHeapRecPtr) : CARDINAL;
- ***** ^ undeclared identifier
- 151 (* returns the total block size available for allocation in paragraphs *)
- 152 VAR
- 153 size : CARDINAL;
- 154 p : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 155 BEGIN
- 156 IF Source = MainHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 157 RETURN CARDINAL(CoreMem.farcoreleft()>>4);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ arithmetic operand must be numeric
- 158 END;
- 159 (*%T _mthread *)
- 160 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 161 (*%E *)
- 162 p := Source^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 size := 0;
- 164 WHILE p^.size <> EndMarker DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- 165 INC(size,p^.size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 p := p^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 167 END;
- 168 (*%T _mthread *)
- 169 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 170 (*%E *)
- 171 RETURN size;
- 172 END FarHeapTotalAvail;
- ***** ^ not supported yet
- 173
- 174
- 175
- 176 PROCEDURE FarHeapDeallocate(Source : FarHeapRecPtr; (* source heap *)
- ***** ^ undeclared identifier
- 177 VAR A: FarADDRESS;
- ***** ^ undeclared identifier
- 178 Size : CARDINAL ); (* size of block
- 179 in paragraphs *)
- 180 VAR
- 181 target,prev,split : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 182 tseg : CARDINAL;
- 183 BEGIN
- 184 IF Source = MainHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 185 CoreMem._ffree(A);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 186 RETURN;
- 187 END;
- 188 IF (CARDINAL(Seg(A^))=0)OR(CARDINAL(Ofs(A^))<>0) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 189 Lib.RunTimeError(CoreSig._FatalErrorPos(), 91H, 'FarHeapDeallocate : Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 190 END;
- 191 (*%T _mthread *)
- 192 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 193 (*%E *)
- 194 IF Size=0 THEN INC(Size) END ;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 195 target := A;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 196 prev := Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 197 tseg := Seg(target^);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 198 WHILE CARDINAL(Seg(prev^.next^)) < tseg DO
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 199 prev := prev^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 200 END;
- 201 IF CARDINAL(Seg(prev^))+prev^.size = tseg THEN (* amalgamate with prev *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 202 prev^.size := prev^.size + Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 203 target := prev;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 204 ELSIF CARDINAL(Seg(prev^))+prev^.size > tseg THEN (* Heap corrupt *)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 205 SYSTEM.EI;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 206 Lib.RunTimeError(CoreSig._FatalErrorPos(), 92H, 'FarHeapDeallocate : Heap Corrupt');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 207 ELSE
- 208 (* link after prev *)
- 209 target^.next := prev^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 210 prev^.next := target;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 211 target^.size := Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 212 END;
- 213 IF (target^.next^.size <> EndMarker)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 214 AND (CARDINAL(Seg(target^.next^)) = CARDINAL(Seg(target^))+target^.size) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 215 (* amalgamate with next block *)
- 216 target^.size := target^.size+target^.next^.size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 217 target^.next := target^.next^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 218 END;
- 219 A := SYSTEM.FarNIL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 220 (*%T _mthread *)
- 221 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 222 (*%E *)
- 223 END FarHeapDeallocate;
- ***** ^ not supported yet
- 224
- 225
- 226 PROCEDURE FarHeapChangeAlloc(Source : FarHeapRecPtr; (* source heap *)
- ***** ^ undeclared identifier
- 227 A : FarADDRESS; (* block to change *)
- ***** ^ undeclared identifier
- 228 OldSize, (* old size of block *)
- 229 NewSize : CARDINAL) (* new size of block *)
- 230 (* in paragraphs *)
- 231 : BOOLEAN; (* if sucessful *)
- 232
- 233 (* This procedure attempts to change the size of an allocated block
- 234 It returns TRUE if succeeded (only expansion can fail)
- 235 *)
- 236
- 237 VAR
- 238 target,prev,
- 239 split : FarHeapRecPtr;
- ***** ^ undeclared identifier
- 240 tseg : CARDINAL;
- 241 result : BOOLEAN;
- 242 extendsize : CARDINAL;
- 243 Res : FarADDRESS;
- ***** ^ undeclared identifier
- 244 BEGIN
- 245 IF Source = MainHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 246 Res := CoreMem.hrealloc(A, LONGCARD(NewSize)<<4);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ arithmetic operand must be numeric
- 247 IF Res = SYSTEM.FarNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 248 RETURN FALSE;
- 249 ELSE
- 250 A := Res;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 251 RETURN TRUE;
- 252 END;
- 253 END;
- 254 IF (CARDINAL(Seg(A^))=0)OR(CARDINAL(Ofs(A^))<>0) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 255 Lib.RunTimeError(CoreSig._FatalErrorPos(), 93H, 'FarHeapChangeAlloc : Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 256 END;
- 257 IF OldSize = NewSize THEN RETURN TRUE END;
- 258 IF OldSize > NewSize THEN
- 259 target := [CARDINAL(Seg(A^))+NewSize:0];
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 260 FarHeapDeallocate(Source,target,OldSize-NewSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 261 RETURN TRUE;
- 262 END;
- 263 extendsize := NewSize-OldSize;
- 264 (*%T _mthread *)
- 265 Process.Lock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 266 (*%E *)
- 267 target := A;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 268 prev := Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 269 tseg := Seg(target^);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 270 WHILE CARDINAL(Seg(prev^.next^)) < tseg DO
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 271 prev := prev^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 272 END;
- 273 IF (prev^.next^.size <> EndMarker) AND
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 274 (CARDINAL(Seg(prev^.next^)) = CARDINAL(Seg(target^))+OldSize) AND
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 275 (extendsize <= prev^.next^.size) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 276 IF (extendsize = prev^.next^.size) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 277 prev^.next := prev^.next^.next
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 278 ELSE
- 279 split := [CARDINAL(Seg(target^))+NewSize:0];
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 280 split^.next := prev^.next^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 281 split^.size := prev^.next^.size - extendsize;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 282 prev^.next := split;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 283 END;
- 284 result := TRUE;
- 285 ELSE
- 286 result := FALSE;
- 287 END;
- 288 (*%T _mthread *)
- 289 Process.Unlock;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 290 (*%E *)
- 291 RETURN result;
- 292 END FarHeapChangeAlloc;
- ***** ^ not supported yet
- 293
- 294
- 295
- 296 PROCEDURE FarHeapChangeSize(Source : FarHeapRecPtr; (* source heap *)
- ***** ^ undeclared identifier
- 297 VAR A : FarADDRESS; (* block to change *)
- ***** ^ undeclared identifier
- 298 OldSize, (* old size of block *)
- 299 NewSize : CARDINAL ); (* new size of block
- 300 in paragraphs *)
- 301
- 302 (*
- 303 This procedure will change the size of an allocated block
- 304 avoiding any copy of data if possible
- 305 calls HeapChangeAlloc
- 306 *)
- 307
- 308 VAR
- 309 na : FarADDRESS;
- ***** ^ undeclared identifier
- 310 BEGIN
- 311 IF NOT FarHeapChangeAlloc ( Source, A, OldSize, NewSize ) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 312 FarHeapAllocate(Source,na,NewSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 313 IF na # FarNIL THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 314 Lib.FarWordMove(A, na, OldSize*8);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 315 FarHeapDeallocate(Source,A,OldSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 316 END;
- 317 A := na;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 318 END;
- 319 END FarHeapChangeSize;
- ***** ^ not supported yet
- 320
- 321
- 322 PROCEDURE FarAllocate(VAR a: FarADDRESS; size: CARDINAL);
- ***** ^ undeclared identifier
- 323
- 324 VAR
- 325 Res: FarADDRESS;
- ***** ^ undeclared identifier
- 326 BEGIN
- 327 IF size = 0 THEN size := 2 END;
- 328 IF ClearOnAllocate THEN
- ***** ^ undeclared identifier
- 329 Res := CoreMem._fcalloc(1, size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 330 ELSE
- 331 Res := CoreMem._fmalloc(size);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 332 END;
- 333 IF Res = FarNIL THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 334 IF Check THEN
- ***** ^ undeclared identifier
- 335 Lib.RunTimeError(CoreSig._FatalErrorPos(), 94H, 'FarAllocate : Out Of Memory');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 336 END;
- 337 END;
- 338 a := Res;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 339 END FarAllocate;
- ***** ^ not supported yet
- 340
- 341
- 342 PROCEDURE FarDeallocate(VAR a: FarADDRESS; size: CARDINAL);
- ***** ^ undeclared identifier
- 343
- 344 BEGIN
- 345 CoreMem._ffree(a);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 346 a:= SYSTEM.FarNIL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 347 END FarDeallocate;
- ***** ^ not supported yet
- 348
- 349
- 350 PROCEDURE FarAvailable(size: CARDINAL) : BOOLEAN;
- 351 VAR
- 352 ps, rs: LONGCARD;
- ***** ^ undeclared identifier
- 353
- 354 BEGIN
- 355 (*%T _DLLOVL*)
- 356 RETURN TRUE; (* Overlay loader takes resposibility *)
- 357 (*%E*)
- 358 (*%F _DLLOVL*)
- 359 ps := CoreMem._fblockavail();
- 360 rs := LONGCARD(size+2);
- 361 RETURN ps >= rs;
- 362 (*%E*)
- 363 END FarAvailable;
- ***** ^ not supported yet
- 364
- 365 PROCEDURE NearMakeHeap(Source: NearADDRESS; Size: CARDINAL): NearHeapRecPtr;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 366 (* ========== *)
- 367 VAR Storage, FirstFree: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 368 BEGIN
- 369 Size := (Size DIV Align) * Align;
- 370 IF Size < Align*3 THEN
- 371 Lib.RunTimeError(CoreSig._FatalErrorPos(), 95H, 'NearMakeHeap: Size Too Small');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 372 END;
- 373 IF Source = SYSTEM.NearNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 374 Lib.RunTimeError(CoreSig._FatalErrorPos(), 89H, 'NearMakeHeap: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 375 END;
- 376 Storage := NearHeapRecPtr(Source);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 377 FirstFree := NearHeapRecPtr(CARDINAL(Source)+CARDINAL(Align));
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 378 Storage^.size := Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 379 Storage^.next := FirstFree;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 380 FirstFree^.size := Size - Align;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 381 FirstFree^.next := SYSTEM.NearNIL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 382 RETURN Storage;
- ***** ^ not supported yet
- 383 END NearMakeHeap;
- ***** ^ not supported yet
- 384
- 385 PROCEDURE NearHeapAllocate(Source: NearHeapRecPtr; VAR A: NearADDRESS; Size: CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 386 (* ======== *)
- 387 VAR Base, Free, New: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 388 BEGIN
- 389 IF Source = SYSTEM.NearNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 390 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8AH, 'NearHeapAllocate: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 391 END;
- 392 IF Source = NearHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 393 NearAllocate(A, Size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 394 RETURN;
- 395 END;
- 396 IF Size < Align THEN
- 397 Size := Align;
- 398 ELSE
- 399 Size := ( (Size+Align-1) DIV Align) * Align;
- 400 IF Size = 0 THEN
- 401 Size:=MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 402 END;
- 403 END;
- 404 Base := Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 405 LOOP
- 406 Free := Base^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 407 IF Free = SYSTEM.NearNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 408 IF Check THEN
- ***** ^ undeclared identifier
- 409 Lib.RunTimeError(CoreSig._FatalErrorPos(), 96H, 'NearHeapAllocate: Out Of Memory');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 410 END;
- 411 A := SYSTEM.NearNIL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 412 RETURN;
- 413 ELSIF Free^.size >= Size THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 414 EXIT;
- 415 END;
- 416 Base := Free;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 417 END;
- 418 IF Free^.size = Size THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 419 Base^.next := Free^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 420 ELSE
- 421 New := NearHeapRecPtr(CARDINAL(Free)+Size);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 422 Base^.next := New;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 423 New^.size := Free^.size - Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 424 New^.next := Free^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 425 END;
- 426 IF ClearOnAllocate THEN
- ***** ^ undeclared identifier
- 427 Lib.WordFill ( ADR(Free^) , Size DIV 2 , 0 );
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 428 END;
- 429 A := NearADDRESS(Free);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 430 END NearHeapAllocate;
- ***** ^ not supported yet
- 431
- 432 PROCEDURE NearHeapDeallocate(Source: NearHeapRecPtr; VAR A: NearADDRESS; Size: CARDINAL );
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 433
- 434 VAR
- 435 Curr, Base, Free: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 436
- 437 BEGIN
- 438 IF (Source = SYSTEM.NearNIL) OR (A = SYSTEM.NearNIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 439 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8BH, 'NearHeapDeallocate: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 440 END;
- 441 IF Source = NearHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 442 NearDeallocate(A, Size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 443 RETURN;
- 444 END;
- 445 IF Size < Align THEN
- 446 Size := Align;
- 447 ELSE
- 448 Size := ( (Size+Align-1) DIV Align) * Align;
- 449 IF Size = 0 THEN
- 450 Size:=MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 451 END;
- 452 END;
- 453 Curr := NearHeapRecPtr(A);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 454 A := SYSTEM.NearNIL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 455 Base:=Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 456 LOOP
- 457 Free := Base^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 458 IF (Free = SYSTEM.NearNIL) OR (CARDINAL(Curr) < CARDINAL(Free)) THEN EXIT; END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 459 Base := Free;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 460 END;
- 461 IF CARDINAL(Base) + Base^.size = CARDINAL(Curr) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 462 INC ( Base^.size , Size );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 463 Curr := Base;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 464 ELSE
- 465 Base^.next := Curr;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 466 Curr^.next := Free;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 467 Curr^.size := Size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 468 END;
- 469 IF (Free # SYSTEM.NearNIL) AND (CARDINAL(Curr) + Curr^.size = CARDINAL(Free)) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 470 INC ( Curr^.size, Free^.size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 471 Curr^.next := Free^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 472 END;
- 473 END NearHeapDeallocate;
- ***** ^ not supported yet
- 474
- 475 PROCEDURE NearHeapAvail(Source: NearHeapRecPtr): CARDINAL;
- ***** ^ undeclared identifier
- 476
- 477 VAR
- 478 Curr: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 479 Size, av: CARDINAL;
- 480 BEGIN
- 481 IF Source = SYSTEM.NearNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 482 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8CH, 'NearHeapAvail: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 483 END;
- 484 IF Source = NearHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 485 av := CoreMem._memmax();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 486 IF av <= 4 THEN
- 487 av := 0;
- 488 ELSE
- 489 DEC(av, 4);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 490 END;
- 491 RETURN av;
- 492 END;
- 493 Curr := Source^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 494 Size := 0;
- 495 WHILE Curr # SYSTEM.NearNIL DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 496 IF Size < Curr^.size THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 497 Size := Curr^.size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 498 END;
- 499 Curr := Curr^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 500 END;
- 501 RETURN Size;
- 502 END NearHeapAvail;
- ***** ^ not supported yet
- 503
- 504
- 505 PROCEDURE NearHeapTotalAvail(Source: NearHeapRecPtr): CARDINAL;
- ***** ^ undeclared identifier
- 506
- 507 VAR
- 508 Curr: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 509 Size: CARDINAL;
- 510 BEGIN
- 511 IF Source = SYSTEM.NearNIL THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 512 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8DH, 'NearHeapTotalAvail: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 513 END;
- 514 IF Source = NearHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 515 RETURN CoreMem.nearcoreleft();
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 516 END;
- 517 Curr := Source^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 518 Size := 0;
- 519 WHILE Curr # SYSTEM.NearNIL DO
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 520 INC ( Size , Curr^.size );
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 521 Curr := Curr^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 522 END;
- 523 RETURN Size;
- 524 END NearHeapTotalAvail;
- ***** ^ not supported yet
- 525
- 526
- 527 PROCEDURE Merge(LowRec, HighRec: NearHeapRecPtr);
- ***** ^ undeclared identifier
- 528
- 529 BEGIN
- 530 IF (LowRec = SYSTEM.NearNIL) AND (HighRec = SYSTEM.NearNIL) AND
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 531 (NearHeapRecPtr(CARDINAL(LowRec)+LowRec^.size) = HighRec) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 532 LowRec^.next:=HighRec^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 533 INC(LowRec^.size, HighRec^.size);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 534 END;
- 535 END Merge;
- ***** ^ not supported yet
- 536
- 537 PROCEDURE NearHeapChangeSize(Source: NearHeapRecPtr; VAR A: NearADDRESS;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 538 OldSize, NewSize : CARDINAL);
- 539
- 540 VAR
- 541 OldA: NearADDRESS;
- ***** ^ undeclared identifier
- 542 BEGIN
- 543 IF (Source = SYSTEM.NearNIL) OR (A = SYSTEM.NearNIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 544 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8EH, 'NearHeapChangeSize: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 545 END;
- 546 IF NearHeapChangeAlloc(Source, A, OldSize, NewSize) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 547 RETURN;
- 548 END;
- 549 OldA := A;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 550 NearHeapAllocate(Source, A, NewSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 551 IF A # NearNIL THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 552 Lib.WordMove(ADR(OldA^), ADR(A^), OldSize DIV 2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 553 NearHeapDeallocate(Source, OldA, OldSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 554 END;
- 555 END NearHeapChangeSize;
- ***** ^ not supported yet
- 556
- 557 PROCEDURE NearHeapChangeAlloc(Source: NearHeapRecPtr; A: NearADDRESS;
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 558 OldSize, NewSize : CARDINAL): BOOLEAN;
- 559
- 560 VAR
- 561 Curr, SplitRec, NextRec, PrevRec, NewRec: NearHeapRecPtr;
- ***** ^ undeclared identifier
- 562 Temp: NearHeapRec;
- ***** ^ undeclared identifier
- 563 SplitSize: CARDINAL;
- 564 T: NearADDRESS;
- ***** ^ undeclared identifier
- 565 BEGIN
- 566 IF (Source = SYSTEM.NearNIL) OR (A = SYSTEM.NearNIL) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 567 Lib.RunTimeError(CoreSig._FatalErrorPos(), 8FH, 'NearHeapChangeAlloc: Invalid Argument');
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 568 END;
- 569 IF Source = NearHeap THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 570 T := CoreMem._nexpand(A, NewSize);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 571 IF T # NearNIL THEN
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 572 A := T;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 573 RETURN TRUE;
- 574 ELSE
- 575 RETURN FALSE;
- 576 END;
- 577 END;
- 578 IF NewSize < Align THEN
- 579 NewSize := Align;
- 580 ELSE
- 581 NewSize := ( (NewSize+Align-1) DIV Align) * Align;
- 582 IF NewSize = 0 THEN
- 583 NewSize:=MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 584 END;
- 585 END;
- 586 IF OldSize < Align THEN
- 587 OldSize := Align;
- 588 ELSE
- 589 OldSize := ( (OldSize+Align-1) DIV Align) * Align;
- 590 IF OldSize = 0 THEN
- 591 OldSize:=MAX(CARDINAL);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 592 END;
- 593 END;
- 594 IF OldSize = NewSize THEN RETURN TRUE END;
- 595 Curr:=NearHeapRecPtr(A);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 596 NextRec:=Source;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 597 LOOP
- 598 PrevRec:=NextRec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 599 NextRec:=NextRec^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 600 IF (NextRec = SYSTEM.NearNIL) OR (CARDINAL(NextRec) > CARDINAL(Curr)) THEN EXIT END;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 601 END;
- 602 IF OldSize > NewSize THEN
- 603 SplitSize:=OldSize-NewSize;
- 604 SplitRec:=NearHeapRecPtr(CARDINAL(Curr)+NewSize);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 605 SplitRec^.size:=SplitSize;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 606 SplitRec^.next:=NextRec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 607 PrevRec^.next:=SplitRec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 608 Merge(SplitRec, NextRec);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 609 RETURN TRUE;
- 610 END;
- 611 IF (NextRec # SYSTEM.NearNIL) AND (NearHeapRecPtr(CARDINAL(Curr)+OldSize) = NextRec) THEN (* Next Block is free *)
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 612 Temp.size := OldSize+NextRec^.size;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 613 Temp.next := NextRec^.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 614 IF Temp.size = NewSize THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 615 PrevRec^.next := Temp.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 616 ELSE
- 617 NewRec := NearHeapRecPtr(CARDINAL(Curr)+NewSize);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 618 PrevRec^.next := NewRec;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 619 NewRec^.size := Temp.size-NewSize;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 620 NewRec^.next := Temp.next;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 621 END;
- 622 RETURN TRUE;
- 623 ELSE
- 624 RETURN FALSE;
- 625 END;
- 626 END NearHeapChangeAlloc;
- ***** ^ not supported yet
- 627
- 628 (*%F _DLL *)
- 629 PROCEDURE NearDeallocate(VAR a: NearADDRESS; size: CARDINAL);
- 630
- 631 BEGIN
- 632 CoreMem._nfree(a);
- 633 a:= NearADDRESS(NIL);
- 634 END NearDeallocate;
- 635
- 636 PROCEDURE NearAllocate(VAR a: NearADDRESS; size: CARDINAL);
- 637
- 638 VAR
- 639 Res: NearADDRESS;
- 640 BEGIN
- 641 IF size = 0 THEN size := 2 END;
- 642 IF ClearOnAllocate THEN
- 643 Res := CoreMem._ncalloc(1, size);
- 644 ELSE
- 645 Res := CoreMem._nmalloc(size);
- 646 END;
- 647 IF Res = NearNIL THEN
- 648 IF Check THEN
- 649 Lib.RunTimeError(CoreSig._FatalErrorPos(), 98H, 'NearAllocate: Out Of Memory');
- 650 END;
- 651 END;
- 652 a := Res;
- 653 END NearAllocate;
- 654
- 655 PROCEDURE NearAvailable(size: CARDINAL) : BOOLEAN;
- 656 VAR
- 657 ps : CARDINAL;
- 658 BEGIN
- 659 ps := CoreMem._memmax();
- 660 RETURN ps >= (size+4);
- 661 END NearAvailable;
- 662 (*%E *)
- 663
- 664 (*%T _DLL *)
- 665 PROCEDURE NearAllocate(VAR a: NearADDRESS; size: CARDINAL);
- ***** ^ undeclared identifier
- 666
- 667 BEGIN
- 668 a := NearNIL;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 669 END NearAllocate;
- ***** ^ not supported yet
- 670
- 671
- 672 PROCEDURE NearDeallocate(VAR a: NearADDRESS; size: CARDINAL);
- ***** ^ undeclared identifier
- 673
- 674 BEGIN
- 675 END NearDeallocate;
- ***** ^ not supported yet
- 676
- 677
- 678 PROCEDURE NearAvailable(size: CARDINAL) : BOOLEAN;
- 679
- 680 BEGIN
- 681 RETURN FALSE;
- 682 END NearAvailable;
- ***** ^ not supported yet
- 683 (*%E *)
- 684
- 685 PROCEDURE SegAllocate(Size: CARDINAL): CARDINAL;
- 686
- 687 BEGIN
- 688 RETURN Seg(CoreMem.halloc(LONGCARD(Size))^);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 689 END SegAllocate;
- ***** ^ not supported yet
- 690
- 691 PROCEDURE SegDeallocate(Sel: CARDINAL; Size: CARDINAL);
- 692
- 693 VAR
- 694 S: FarADDRESS;
- ***** ^ undeclared identifier
- 695 BEGIN
- 696 S := [Sel: 0];
- ***** ^ not supported yet
- ***** ^ not supported yet
- 697 CoreMem.hfree(S);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 698 END SegDeallocate;
- ***** ^ not supported yet
- 699
- 700 BEGIN
- 701 NearHeap := NearHeapRecPtr(0FFFFH);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 702 MainHeap := FarHeapRecPtr(CoreMain._getheapbase());
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 703 Check := TRUE;
- ***** ^ undeclared identifier
- 704 ClearOnAllocate := FALSE;
- ***** ^ undeclared identifier
- 705 END Storage.
- ***** ^ not supported yet
- 838 errors
|