Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * STORAGE.MOD - Dynamic memory allocation * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*%F _fdata *) 12 (*# call(seg_name=>null),data(seg_name=>null) *) 13 (*%E *) 14 (*%T _fdata *) 15 (*# call(ds_entry=>null) *) 16 (*%E *) 17 (*# module(implementation=>off) *) 18 (*# check(stack=>off,index=>off,range=>off,overflow=>off,nil_ptr=>off) *) 19 20 IMPLEMENTATION MODULE Storage; 21 22 (* 23 N.B. See also MSTORAGE.MOD, which replaces this module in the 24 DOS multi-language libraries, and in DOS overlay and DLL models 25 *) 26 27 IMPORT SYSTEM, Lib, CoreMain, CoreSig, ModCore; 28 (*%T _OS2 *) 29 IMPORT CoreMem, Dos; 30 (*%T _mthread *) 31 IMPORT Process; 32 (*%E *) 33 (*%E *) 34 35 CONST 36 EndMarker = 0FFFFH; 37 Align = 4; 38 39 (*%F _OS2 *) 40 VAR 41 NearHeapSetup : BOOLEAN; 42 FarHeapSetup : BOOLEAN; 43 LastBlock : FarHeapRecPtr; 44 (*%E _OS2 *) 45 46 (*%F _OS2 *) 47 (*# save,call(reg_param=>(ax)) *) 48 PROCEDURE FarHeapShrink():CARDINAL; 49 VAR 50 Curr,Prev,New : FarHeapRecPtr; 51 BEGIN 52 Curr := MainHeap; 53 Prev := FarNIL; 54 WHILE Curr^.size # EndMarker DO 55 Prev := Curr; 56 Curr := Curr^.next; 57 END; (*WHILE*) 58 New := [Seg(Prev^) + Prev^.size:0]; 59 LastBlock := Prev; 60 IF (New = Curr) & (Prev^.size > 4) THEN (* Last free block is last block *) 61 ModCore.AdjustMem(Seg(Prev^) + 4); 62 RETURN 0; 63 END; (*IF*) 64 RETURN 1; 65 END FarHeapShrink; 66 (*# restore *) 67 (*%E _OS2 *) 68 69 (*%F _OS2 *) 70 (*# save,call(reg_param=>(ax)) *) 71 PROCEDURE FarHeapRestore; 72 BEGIN 73 ModCore.AdjustMem(0); 74 LastBlock := LastBlock^.next; 75 LastBlock^.size := EndMarker; 76 LastBlock^.next := MainHeap; 77 END FarHeapRestore; 78 (*# restore *) 79 (*%E _OS2 *) 80 81 (*%F _OS2 *) 82 (*# save,call(reg_param=>(ax)) *) 83 PROCEDURE FarHeapFix(Space:CARDINAL); 84 VAR 85 Curr,Prev,New : FarHeapRecPtr; 86 BEGIN 87 Curr := MainHeap; 88 Prev := FarNIL; 89 WHILE Curr^.size # EndMarker DO 90 Prev := Curr; 91 Curr := Curr^.next; 92 END; (*WHILE*) 93 New := [Seg(Prev^) + Prev^.size:0]; 94 LastBlock := Prev; 95 IF (New = Curr) & (Prev^.size > Space + 4) THEN (* Last free block is last block *) 96 Prev^.size := Space; 97 New := [Seg(Prev^) + Space:0]; 98 Prev^.next := New; 99 New^.size := EndMarker; 100 New^.next := MainHeap; 101 ModCore.AdjustMem(Seg(Prev^)+Space+4); 102 END; (*IF*) 103 END FarHeapFix; 104 (*# restore *) 105 (*%E _OS2 *) 106 107 (*%F _OS2 *) 108 PROCEDURE InitFarHeap():FarHeapRecPtr; 109 TYPE 110 (*# save, data(near_ptr=>off) *) 111 CPtr = POINTER TO CARDINAL; 112 (*# restore *) 113 VAR 114 P : CPtr; 115 Size,Start : CARDINAL; 116 BEGIN 117 FarHeapSetup := TRUE; 118 CoreMain._shr_mem := FarHeapShrink; 119 CoreMain._fix_mem := FarHeapFix; 120 CoreMain._res_mem := FarHeapRestore; 121 CoreMain._fmodmemsetup := TRUE; 122 P := [Lib.PSP:2 CPtr]; 123 Start := ModCore._getheapmem(); 124 Size := P^ - Start; 125 MainHeap:=FarMakeHeap(Start, Size); 126 RETURN MainHeap; 127 END InitFarHeap; 128 (*%E _OS2 *) 129 130 (*%F _OS2 *) 131 PROCEDURE InitNearHeap(): NearHeapRecPtr; 132 133 VAR 134 Size, Start: CARDINAL; 135 BEGIN 136 NearHeapSetup := TRUE; 137 Size := CoreMain._heap_size; 138 Start := CARDINAL(ADR(CoreMain._near_heap_start)); 139 IF LONGCARD(Size) + LONGCARD(Start) > 0FFFEH THEN 140 Size := 0FFFEH - Start; 141 END; 142 NearHeap := NearMakeHeap(NearADR(CoreMain._near_heap_start), Size); 143 RETURN NearHeap; 144 END InitNearHeap; 145 (*%E _OS2 *) 146 147 (*%F _OS2 *) 148 PROCEDURE FarMakeHeap(Source:CARDINAL;Size:CARDINAL):FarHeapRecPtr; 149 VAR 150 storage,first,last: FarHeapRecPtr; 151 ie : CARDINAL; 152 BEGIN 153 (*%T _mthread *) 154 ie := SYSTEM.GetFlags(); 155 SYSTEM.DI; 156 (*%E *) 157 storage := [Source:0]; 158 first := [Source+1:0]; 159 last := [Source+Size-1:0]; 160 storage^.next := first; 161 storage^.size := 0; 162 first^.next := last; 163 last^.next := storage; 164 first^.size := Size-2; 165 last^.size := EndMarker; 166 (*%T _mthread *) 167 SYSTEM.SetFlags(ie);; 168 (*%E *) 169 RETURN storage; 170 END FarMakeHeap; 171 (*%E _OS2 *) 172 173 (*%F _OS2 *) 174 PROCEDURE FarHeapAllocate(Source:FarHeapRecPtr;VAR A:FarADDRESS;Size:CARDINAL); 175 VAR 176 res,prev,split : FarHeapRecPtr; 177 ie : CARDINAL; 178 BEGIN 179 (*%T _mthread *) 180 ie := SYSTEM.GetFlags(); 181 SYSTEM.DI; 182 (*%E *) 183 IF ~FarHeapSetup & (Source = MainHeap) THEN 184 Source := InitFarHeap(); 185 END; (*IF*) 186 IF Size = 0 THEN 187 INC(Size); 188 END; (*IF*) 189 prev := Source; 190 WHILE prev^.next^.size < Size DO 191 prev := prev^.next; 192 END; (*WHILE *) 193 res := prev^.next; 194 IF res^.size = EndMarker THEN (* heap run out of space *) 195 (*%T _mthread *) 196 SYSTEM.EI; 197 (*%E *) 198 IF Check THEN 199 Lib.RunTimeError(CoreSig._FatalErrorPos(),90H,'FarHeapAllocate : Out Of Space'); 200 END; (*IF*) 201 A := FarNIL; 202 (*%T _mthread *) 203 SYSTEM.SetFlags(ie);; 204 (*%E *) 205 RETURN; 206 END; (*IF*) 207 IF res^.size = Size THEN (* block correct size *) 208 prev^.next := res^.next; 209 ELSE (* split block, bottom half returned, top half linked to free chain *) 210 split := [Seg(res^) + Size:0]; 211 prev^.next := split; 212 split^.next := res^.next; 213 split^.size := res^.size - Size; 214 END; (*IF*) 215 (*%T _mthread *) 216 SYSTEM.SetFlags(ie);; 217 (*%E *) 218 A := FarADR(res^); 219 END FarHeapAllocate; 220 (*%E _OS2 *) 221 222 (*%F _OS2 *) 223 PROCEDURE FarHeapAvail(Source: FarHeapRecPtr) : CARDINAL; 224 (* returns the largest block size available for allocation in paragraphs *) 225 VAR 226 size : CARDINAL; 227 p : FarHeapRecPtr; 228 ie : CARDINAL; 229 BEGIN 230 (*%T _mthread *) 231 ie := SYSTEM.GetFlags(); 232 SYSTEM.DI; 233 (*%E *) 234 IF ~FarHeapSetup & (Source = MainHeap) THEN 235 Source := InitFarHeap(); 236 END; (*IF*) 237 p := Source^.next; 238 size := 0; 239 WHILE p^.size # EndMarker DO 240 IF p^.size > size THEN 241 size := p^.size; 242 END; (*IF*) 243 p := p^.next; 244 END; (*WHILE*) 245 (*%T _mthread *) 246 SYSTEM.SetFlags(ie);; 247 (*%E *) 248 RETURN size; 249 END FarHeapAvail; 250 (*%E _OS2 *) 251 252 (*%F _OS2 *) 253 PROCEDURE FarHeapTotalAvail(Source:FarHeapRecPtr):CARDINAL; 254 (* Returns the total heap available for allocation in paragraphs *) 255 VAR 256 size : CARDINAL; 257 p : FarHeapRecPtr; 258 ie : CARDINAL; 259 BEGIN 260 (*%T _mthread *) 261 ie := SYSTEM.GetFlags(); 262 SYSTEM.DI; 263 (*%E *) 264 IF ~FarHeapSetup & (Source = MainHeap) THEN 265 Source := InitFarHeap(); 266 END; (*IF*) 267 p := Source^.next; 268 size := 0; 269 WHILE p^.size # EndMarker DO 270 INC(size,p^.size); 271 p := p^.next; 272 END; (*WHILE*) 273 (*%T _mthread *) 274 SYSTEM.SetFlags(ie);; 275 (*%E *) 276 RETURN size; 277 END FarHeapTotalAvail; 278 (*%E _OS2 *) 279 280 (*%F _OS2 *) 281 PROCEDURE FarHeapDeallocate(Source:FarHeapRecPtr;VAR A:FarADDRESS;Size:CARDINAL); 282 VAR 283 target,prev,split : FarHeapRecPtr; 284 tseg : CARDINAL; 285 ie : CARDINAL; 286 BEGIN 287 IF (Seg(A^) = 0) OR (Ofs(A^) # 0) THEN 288 Lib.RunTimeError(CoreSig._FatalErrorPos(),91H,'FarHeapDeallocate : Invalid Argument'); 289 END; (*IF*) 290 (*%T _mthread *) 291 ie := SYSTEM.GetFlags(); 292 SYSTEM.DI; 293 (*%E *) 294 IF Size = 0 THEN 295 INC(Size); 296 END; (*IF*) 297 target := A; 298 prev := Source; 299 tseg := Seg(target^); 300 WHILE Seg(prev^.next^) < tseg DO 301 prev := prev^.next; 302 END; (*WHILE*) 303 IF Seg(prev^) + prev^.size = tseg THEN (* amalgamate with prev *) 304 prev^.size := prev^.size + Size; 305 target := prev; 306 ELSIF Seg(prev^) + prev^.size > tseg THEN (* Heap corrupt *) 307 (*%T _mthread *) 308 SYSTEM.EI; 309 (*%E *) 310 Lib.RunTimeError(CoreSig._FatalErrorPos(),92H,'FarHeapDeallocate : Heap Corrupt'); 311 ELSE (* link after prev *) 312 target^.next := prev^.next; 313 prev^.next := target; 314 target^.size := Size; 315 END; (*IF*) 316 IF (target^.next^.size # EndMarker) & (Seg(target^.next^) = Seg(target^) + target^.size) THEN 317 (* amalgamate with next block *) 318 target^.size := target^.size+target^.next^.size; 319 target^.next := target^.next^.next; 320 END; (*IF*) 321 A := SYSTEM.FarNIL; 322 (*%T _mthread *) 323 SYSTEM.SetFlags(ie);; 324 (*%E *) 325 END FarHeapDeallocate; 326 (*%E _OS2 *) 327 328 (*%F _OS2 *) 329 PROCEDURE FarHeapChangeAlloc(Source : FarHeapRecPtr; (* source heap *) 330 A : FarADDRESS; (* block to change *) 331 OldSize, (* old size of block *) 332 NewSize : CARDINAL) (* new size of block *) 333 (* in paragraphs *) 334 : BOOLEAN; (* if sucessful *) 335 336 (* This procedure attempts to change the size of an allocated block 337 It returns TRUE if succeeded (only expansion can fail) 338 *) 339 340 VAR 341 target,prev, 342 split : FarHeapRecPtr; 343 tseg : CARDINAL; 344 result : BOOLEAN; 345 extendsize : CARDINAL; 346 Res : FarADDRESS; 347 ie: CARDINAL; 348 BEGIN 349 IF (CARDINAL(Seg(A^))=0)OR(CARDINAL(Ofs(A^))<>0) THEN 350 Lib.RunTimeError(CoreSig._FatalErrorPos(), 93H, 'FarHeapChangeAlloc : Invalid Argument'); 351 END; 352 IF OldSize = NewSize THEN RETURN TRUE END; 353 IF OldSize > NewSize THEN 354 target := [CARDINAL(Seg(A^))+NewSize:0]; 355 FarHeapDeallocate(Source,target,OldSize-NewSize); 356 RETURN TRUE; 357 END; 358 extendsize := NewSize-OldSize; 359 (*%T _mthread *) 360 ie := SYSTEM.GetFlags(); SYSTEM.DI; 361 (*%E *) 362 target := A; 363 prev := Source; 364 tseg := Seg(target^); 365 WHILE CARDINAL(Seg(prev^.next^)) < tseg DO 366 prev := prev^.next; 367 END; 368 IF (prev^.next^.size <> EndMarker) AND 369 (CARDINAL(Seg(prev^.next^)) = CARDINAL(Seg(target^))+OldSize) AND 370 (extendsize <= prev^.next^.size) THEN 371 IF (extendsize = prev^.next^.size) THEN 372 prev^.next := prev^.next^.next 373 ELSE 374 split := [CARDINAL(Seg(target^))+NewSize:0]; 375 split^.next := prev^.next^.next; 376 split^.size := prev^.next^.size - extendsize; 377 prev^.next := split; 378 END; 379 result := TRUE; 380 ELSE 381 result := FALSE; 382 END; 383 (*%T _mthread *) 384 SYSTEM.SetFlags(ie);; 385 (*%E *) 386 RETURN result; 387 END FarHeapChangeAlloc; 388 (*%E _OS2 *) 389 390 (*%F _OS2 *) 391 PROCEDURE FarHeapChangeSize(Source:FarHeapRecPtr;VAR A:FarADDRESS;OldSize,NewSize:CARDINAL); 392 (* This procedure will change the size of an allocated block avoiding*) 393 (* any copy of data if possible. Calls HeapChangeAlloc. *) 394 VAR 395 na : FarADDRESS; 396 BEGIN 397 IF ~FarHeapChangeAlloc(Source,A,OldSize,NewSize) THEN 398 FarHeapAllocate(Source,na,NewSize); 399 IF na # FarNIL THEN 400 Lib.FarWordMove(A,na,OldSize * 8); 401 FarHeapDeallocate(Source,A,OldSize); 402 END; (*IF*) 403 A := na; 404 END; (*IF*) 405 END FarHeapChangeSize; 406 (*%E _OS2 *) 407 408 (*%F _OS2 *) 409 PROCEDURE FarAllocate(VAR a:FarADDRESS;size:CARDINAL); 410 VAR 411 ps : CARDINAL; 412 BEGIN 413 IF size > 0FFF0H THEN 414 ps := 1000H; 415 ELSE 416 ps := (size + 15) DIV 16; 417 END; (*IF*) 418 FarHeapAllocate(MainHeap,a,ps); 419 IF ClearOnAllocate & (a # FarNIL) THEN 420 Lib.FarWordFill(a,ps*8,0); 421 END; (*IF*) 422 END FarAllocate; 423 (*%E _OS2 *) 424 425 (*%F _OS2 *) 426 PROCEDURE FarDeallocate(VAR a:FarADDRESS;size:CARDINAL); 427 VAR 428 ps : CARDINAL; 429 BEGIN 430 IF size > 0FFF0H THEN 431 ps := 1000H; 432 ELSE 433 ps := (size + 15) DIV 16; 434 END; (*IF*) 435 FarHeapDeallocate(MainHeap,a,ps); 436 END FarDeallocate; 437 (*%E _OS2 *) 438 439 (*%F _OS2 *) 440 PROCEDURE FarAvailable(size:CARDINAL):BOOLEAN; 441 VAR 442 ps : CARDINAL; 443 BEGIN 444 IF size = 0 THEN 445 ps := 1; 446 ELSIF size > 0FFF0H THEN 447 ps := 1000H; 448 ELSE 449 ps := (size + 15) DIV 16; 450 END; (*IF*) 451 RETURN ps <= FarHeapAvail(MainHeap); 452 END FarAvailable; 453 (*%E _OS2 *) 454 455 (*%T _OS2 *) 456 PROCEDURE FarMakeHeap( Source : CARDINAL; (* base segment of heap *) 457 Size : CARDINAL (* size in paragraphs *) 458 ) : FarHeapRecPtr; ***** ^ undeclared identifier 459 BEGIN 460 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarMakeHeap : Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 461 RETURN FarNIL; ***** ^ undeclared identifier 462 END FarMakeHeap; ***** ^ not supported yet 463 464 465 PROCEDURE FarHeapAllocate(Source : FarHeapRecPtr; (* source heap *) ***** ^ undeclared identifier 466 VAR A : FarADDRESS; (* result *) ***** ^ undeclared identifier 467 Size : CARDINAL); (* request size in paragraphs *) 468 469 BEGIN 470 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapAllocate : Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 471 END FarHeapAllocate; ***** ^ not supported yet 472 473 474 PROCEDURE FarHeapAvail(Source: FarHeapRecPtr) : CARDINAL; ***** ^ undeclared identifier 475 (* returns the largest block size available for allocation in paragraphs *) 476 477 BEGIN 478 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapAvail : Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 479 RETURN 0; 480 END FarHeapAvail; ***** ^ not supported yet 481 482 483 PROCEDURE FarHeapTotalAvail(Source: FarHeapRecPtr) : CARDINAL; ***** ^ undeclared identifier 484 485 BEGIN 486 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapTotalAvail : Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 487 RETURN 0; 488 END FarHeapTotalAvail; ***** ^ not supported yet 489 490 491 492 PROCEDURE FarHeapDeallocate(Source : FarHeapRecPtr; (* source heap *) ***** ^ undeclared identifier 493 VAR A: FarADDRESS; ***** ^ undeclared identifier 494 Size : CARDINAL ); (* size of block 495 in paragraphs *) 496 BEGIN 497 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapDeallocate: Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 498 END FarHeapDeallocate; ***** ^ not supported yet 499 500 501 PROCEDURE FarHeapChangeAlloc(Source : FarHeapRecPtr; (* source heap *) ***** ^ undeclared identifier 502 A : FarADDRESS; (* block to change *) ***** ^ undeclared identifier 503 OldSize, (* old size of block *) 504 NewSize : CARDINAL) (* new size of block *) 505 (* in paragraphs *) 506 : BOOLEAN; (* if sucessful *) 507 508 (* This procedure attempts to change the size of an allocated block 509 It returns TRUE if succeeded (only expansion can fail) 510 *) 511 512 BEGIN 513 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapChangeAlloc: Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 514 RETURN FALSE; 515 END FarHeapChangeAlloc; ***** ^ not supported yet 516 517 518 519 PROCEDURE FarHeapChangeSize(Source : FarHeapRecPtr; (* source heap *) ***** ^ undeclared identifier 520 VAR A : FarADDRESS; (* block to change *) ***** ^ undeclared identifier 521 OldSize, (* old size of block *) 522 NewSize : CARDINAL ); (* new size of block 523 in paragraphs *) 524 525 (* 526 This procedure will change the size of an allocated block 527 avoiding any copy of data if possible 528 calls HeapChangeAlloc 529 *) 530 531 BEGIN 532 Lib.RunTimeError(CoreSig._FatalErrorPos(), 099H, 'FarHeapChangeSize: Not Supported Under OS2 *)'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 533 END FarHeapChangeSize; ***** ^ not supported yet 534 535 536 PROCEDURE FarAllocate(VAR a: FarADDRESS; size: CARDINAL); ***** ^ undeclared identifier 537 538 VAR 539 Res: FarADDRESS; ***** ^ undeclared identifier 540 BEGIN 541 IF size = 0 THEN size := 2 END; 542 IF ClearOnAllocate THEN ***** ^ undeclared identifier 543 Res := CoreMem._fcalloc(1, size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 544 ELSE 545 Res := CoreMem._fmalloc(size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 546 END; 547 IF Res = FarNIL THEN ***** ^ not supported yet ***** ^ undeclared identifier 548 IF Check THEN ***** ^ undeclared identifier 549 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 550 END; 551 END; 552 a := Res; ***** ^ not supported yet ***** ^ not supported yet 553 END FarAllocate; ***** ^ not supported yet 554 555 556 PROCEDURE FarDeallocate(VAR a: FarADDRESS; size: CARDINAL); ***** ^ undeclared identifier 557 558 BEGIN 559 CoreMem._ffree(a); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 560 a:= SYSTEM.FarNIL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 561 END FarDeallocate; ***** ^ not supported yet 562 563 564 PROCEDURE FarAvailable(size: CARDINAL) : BOOLEAN; 565 566 BEGIN 567 RETURN TRUE; 568 END FarAvailable; ***** ^ not supported yet 569 (*%E *) 570 571 PROCEDURE NearMakeHeap(Source: NearADDRESS; Size: CARDINAL): NearHeapRecPtr; ***** ^ undeclared identifier ***** ^ undeclared identifier 572 (* ========== *) 573 VAR Storage, FirstFree: NearHeapRecPtr; ***** ^ undeclared identifier 574 BEGIN 575 Size := (Size DIV Align) * Align; 576 IF Size < Align*3 THEN 577 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 578 END; 579 IF Source = SYSTEM.NearNIL THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 580 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 581 END; 582 Storage := NearHeapRecPtr(Source); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 583 FirstFree := NearHeapRecPtr(CARDINAL(Source)+CARDINAL(Align)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 584 Storage^.size := Size; ***** ^ not supported yet ***** ^ not supported yet 585 Storage^.next := FirstFree; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 586 FirstFree^.size := Size - Align; ***** ^ not supported yet ***** ^ not supported yet 587 FirstFree^.next := SYSTEM.NearNIL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 588 RETURN Storage; ***** ^ not supported yet 589 END NearMakeHeap; ***** ^ not supported yet 590 591 PROCEDURE NearHeapAllocate(Source: NearHeapRecPtr; VAR A: NearADDRESS; Size: CARDINAL); ***** ^ undeclared identifier ***** ^ undeclared identifier 592 (* ======== *) 593 VAR 594 Base, Free, New: NearHeapRecPtr; ***** ^ undeclared identifier 595 (*%T _OS2 *) 596 Res: NearADDRESS; ***** ^ undeclared identifier 597 (*%E *) 598 BEGIN 599 (*%F _OS2 *) 600 (*%F _DLL *) 601 IF (NOT NearHeapSetup) AND (Source = NearHeap) THEN 602 Source := InitNearHeap(); 603 END; 604 (*%E *) 605 (*%E *) 606 (*%T _OS2 *) 607 IF Source = NearHeap THEN ***** ^ not supported yet ***** ^ undeclared identifier 608 IF Size = 0 THEN Size := 2 END; 609 IF ClearOnAllocate THEN ***** ^ undeclared identifier 610 Res := CoreMem._ncalloc(1, Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 611 ELSE 612 Res := CoreMem._nmalloc(Size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 613 END; 614 IF Res = NearNIL THEN ***** ^ not supported yet ***** ^ undeclared identifier 615 IF Check THEN ***** ^ undeclared identifier 616 Lib.RunTimeError(CoreSig._FatalErrorPos(), 98H, 'NearAllocate: Out Of Memory'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 617 END; 618 END; 619 A := Res; ***** ^ not supported yet ***** ^ not supported yet 620 RETURN; 621 END; 622 (*%E *) 623 IF Source = SYSTEM.NearNIL THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 624 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 625 END; 626 IF Size < Align THEN 627 Size := Align; 628 ELSE 629 Size := ( (Size+Align-1) DIV Align) * Align; 630 IF Size = 0 THEN 631 Size:=MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 632 END; 633 END; 634 Base := Source; ***** ^ not supported yet ***** ^ not supported yet 635 LOOP 636 Free := Base^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 637 IF Free = SYSTEM.NearNIL THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 638 IF Check THEN ***** ^ undeclared identifier 639 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 640 ELSE 641 A := SYSTEM.NearNIL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 642 RETURN; 643 END; 644 ELSIF Free^.size >= Size THEN ***** ^ not supported yet ***** ^ not supported yet 645 EXIT; 646 END; 647 Base := Free; ***** ^ not supported yet ***** ^ not supported yet 648 END; 649 IF Free^.size = Size THEN ***** ^ not supported yet ***** ^ not supported yet 650 Base^.next := Free^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 651 ELSE 652 New := NearHeapRecPtr(CARDINAL(Free)+Size); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 653 Base^.next := New; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 654 New^.size := Free^.size - Size; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 655 New^.next := Free^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 656 END; 657 IF ClearOnAllocate THEN ***** ^ undeclared identifier 658 Lib.WordFill ( ADR(Free^) , Size DIV 2 , 0 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 659 END; 660 A := NearADDRESS(Free); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 661 END NearHeapAllocate; ***** ^ not supported yet 662 663 PROCEDURE NearHeapDeallocate(Source: NearHeapRecPtr; VAR A: NearADDRESS; Size: CARDINAL ); ***** ^ undeclared identifier ***** ^ undeclared identifier 664 665 VAR 666 Curr, Base, Free: NearHeapRecPtr; ***** ^ undeclared identifier 667 668 BEGIN 669 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 670 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 671 END; 672 (*%T _OS2 *) 673 IF Source = NearHeap THEN ***** ^ not supported yet ***** ^ undeclared identifier 674 CoreMem._nfree(A); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 675 A:= NearADDRESS(NIL); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 676 RETURN; 677 END; 678 (*%E *) 679 IF Size < Align THEN 680 Size := Align; 681 ELSE 682 Size := ( (Size+Align-1) DIV Align) * Align; 683 IF Size = 0 THEN 684 Size:=MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 685 END; 686 END; 687 Curr := NearHeapRecPtr(A); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 688 A := SYSTEM.NearNIL; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 689 Base:=Source; ***** ^ not supported yet ***** ^ not supported yet 690 LOOP 691 Free := Base^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 692 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 693 Base := Free; ***** ^ not supported yet ***** ^ not supported yet 694 END; 695 IF CARDINAL(Base) + Base^.size = CARDINAL(Curr) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 696 INC ( Base^.size , Size ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 697 Curr := Base; ***** ^ not supported yet ***** ^ not supported yet 698 ELSE 699 Base^.next := Curr; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 700 Curr^.next := Free; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 701 Curr^.size := Size; ***** ^ not supported yet ***** ^ not supported yet 702 END; 703 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 704 INC ( Curr^.size, Free^.size); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 705 Curr^.next := Free^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 706 END; 707 END NearHeapDeallocate; ***** ^ not supported yet 708 709 PROCEDURE NearHeapAvail(Source: NearHeapRecPtr): CARDINAL; ***** ^ undeclared identifier 710 711 VAR 712 Curr: NearHeapRecPtr; ***** ^ undeclared identifier 713 Size, av: CARDINAL; 714 BEGIN 715 (*%F _OS2 *) 716 (*%F _DLL *) 717 IF (NOT NearHeapSetup) AND (Source = NearHeap) THEN 718 Source := InitNearHeap(); 719 END; 720 (*%E *) 721 (*%E *) 722 (*%T _OS2 *) 723 IF Source = NearHeap THEN ***** ^ not supported yet ***** ^ undeclared identifier 724 av := CoreMem._memmax(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 725 IF av <= 4 THEN 726 av := 0; 727 ELSE 728 DEC(av, 4); ***** ^ undeclared identifier ***** ^ not supported yet 729 END; 730 RETURN av; 731 END; 732 (*%E *) 733 IF Source = SYSTEM.NearNIL THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 734 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 735 END; 736 Curr := Source^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 737 Size := 0; 738 WHILE Curr # SYSTEM.NearNIL DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 739 IF Size < Curr^.size THEN ***** ^ not supported yet ***** ^ not supported yet 740 Size := Curr^.size; ***** ^ not supported yet ***** ^ not supported yet 741 END; 742 Curr := Curr^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 743 END; 744 RETURN Size; 745 END NearHeapAvail; ***** ^ not supported yet 746 747 748 PROCEDURE NearHeapTotalAvail(Source: NearHeapRecPtr): CARDINAL; ***** ^ undeclared identifier 749 750 VAR 751 Curr: NearHeapRecPtr; ***** ^ undeclared identifier 752 Size: CARDINAL; 753 BEGIN 754 (*%F _OS2 *) 755 (*%F _DLL *) 756 IF (NOT NearHeapSetup) AND (Source = NearHeap) THEN 757 Source := InitNearHeap(); 758 END; 759 (*%E *) 760 (*%E *) 761 (*%T _OS2 *) 762 IF Source = NearHeap THEN ***** ^ not supported yet ***** ^ undeclared identifier 763 RETURN CoreMem.nearcoreleft(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 764 END; 765 (*%E *) 766 IF Source = SYSTEM.NearNIL THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 767 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 768 END; 769 Curr := Source^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 770 Size := 0; 771 WHILE Curr # SYSTEM.NearNIL DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 772 INC ( Size , Curr^.size ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 773 Curr := Curr^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 774 END; 775 RETURN Size; 776 END NearHeapTotalAvail; ***** ^ not supported yet 777 778 779 PROCEDURE Merge(LowRec, HighRec: NearHeapRecPtr); ***** ^ undeclared identifier 780 781 BEGIN 782 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 783 (NearHeapRecPtr(CARDINAL(LowRec)+LowRec^.size) = HighRec) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 784 LowRec^.next:=HighRec^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 785 INC(LowRec^.size, HighRec^.size); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 786 END; 787 END Merge; ***** ^ not supported yet 788 789 PROCEDURE NearHeapChangeSize(Source: NearHeapRecPtr; VAR A: NearADDRESS; ***** ^ undeclared identifier ***** ^ undeclared identifier 790 OldSize, NewSize : CARDINAL); 791 792 VAR 793 OldA: NearADDRESS; ***** ^ undeclared identifier 794 BEGIN 795 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 796 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 797 END; 798 IF NearHeapChangeAlloc(Source, A, OldSize, NewSize) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 799 RETURN; 800 END; 801 OldA := A; ***** ^ not supported yet ***** ^ not supported yet 802 NearHeapAllocate(Source, A, NewSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 803 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 804 NearHeapDeallocate(Source, OldA, OldSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 805 END NearHeapChangeSize; ***** ^ not supported yet 806 807 PROCEDURE NearHeapChangeAlloc(Source: NearHeapRecPtr; A: NearADDRESS; ***** ^ undeclared identifier ***** ^ undeclared identifier 808 OldSize, NewSize : CARDINAL): BOOLEAN; 809 810 VAR 811 Curr, SplitRec, NextRec, PrevRec, NewRec: NearHeapRecPtr; ***** ^ undeclared identifier 812 Temp: NearHeapRec; ***** ^ undeclared identifier 813 SplitSize: CARDINAL; 814 (*%T _OS2 *) 815 T: NearADDRESS; ***** ^ undeclared identifier 816 (*%E *) 817 BEGIN 818 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 819 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 820 END; 821 (*%T _OS2 *) 822 IF Source = NearHeap THEN ***** ^ not supported yet ***** ^ undeclared identifier 823 T := CoreMem._nexpand(A, NewSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 824 RETURN T # NearNIL; ***** ^ not supported yet ***** ^ undeclared identifier 825 END; 826 (*%E *) 827 IF NewSize < Align THEN 828 NewSize := Align; 829 ELSE 830 NewSize := ( (NewSize+Align-1) DIV Align) * Align; 831 IF NewSize = 0 THEN 832 NewSize:=MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 833 END; 834 END; 835 IF OldSize < Align THEN 836 OldSize := Align; 837 ELSE 838 OldSize := ( (OldSize+Align-1) DIV Align) * Align; 839 IF OldSize = 0 THEN 840 OldSize:=MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 841 END; 842 END; 843 IF OldSize = NewSize THEN RETURN TRUE END; 844 Curr:=NearHeapRecPtr(A); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 845 NextRec:=Source; ***** ^ not supported yet ***** ^ not supported yet 846 LOOP 847 PrevRec:=NextRec; ***** ^ not supported yet ***** ^ not supported yet 848 NextRec:=NextRec^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 849 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 850 END; 851 IF OldSize > NewSize THEN 852 SplitSize:=OldSize-NewSize; 853 SplitRec:=NearHeapRecPtr(CARDINAL(Curr)+NewSize); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 854 SplitRec^.size:=SplitSize; ***** ^ not supported yet ***** ^ not supported yet 855 SplitRec^.next:=NextRec; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 856 PrevRec^.next:=SplitRec; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 857 Merge(SplitRec, NextRec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 858 RETURN TRUE; 859 END; 860 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 861 Temp.size := OldSize+NextRec^.size; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 862 Temp.next := NextRec^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 863 IF Temp.size = NewSize THEN ***** ^ not supported yet ***** ^ not supported yet 864 PrevRec^.next := Temp.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 865 ELSE 866 NewRec := NearHeapRecPtr(CARDINAL(Curr)+NewSize); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 867 PrevRec^.next := NewRec; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 868 NewRec^.size := Temp.size-NewSize; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 869 NewRec^.next := Temp.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 870 END; 871 RETURN TRUE; 872 ELSE 873 RETURN FALSE; 874 END; 875 END NearHeapChangeAlloc; ***** ^ not supported yet 876 877 878 (*%F _DLL *) 879 PROCEDURE NearAllocate(VAR a: NearADDRESS; size: CARDINAL); 880 881 BEGIN 882 NearHeapAllocate(NearHeap,a,size); 883 END NearAllocate; 884 885 886 PROCEDURE NearDeallocate(VAR a: NearADDRESS; size: CARDINAL); 887 888 BEGIN 889 NearHeapDeallocate(NearHeap,a,size); 890 END NearDeallocate; 891 892 893 PROCEDURE NearAvailable(size: CARDINAL) : BOOLEAN; 894 895 BEGIN 896 RETURN size <= NearHeapAvail(NearHeap); 897 END NearAvailable; 898 (*%E *) 899 900 (*%T _DLL *) 901 PROCEDURE NearAllocate(VAR a: NearADDRESS; size: CARDINAL); ***** ^ undeclared identifier 902 903 BEGIN 904 a := NearNIL; ***** ^ not supported yet ***** ^ undeclared identifier 905 END NearAllocate; ***** ^ not supported yet 906 907 908 PROCEDURE NearDeallocate(VAR a: NearADDRESS; size: CARDINAL); ***** ^ undeclared identifier 909 910 BEGIN 911 END NearDeallocate; ***** ^ not supported yet 912 913 914 PROCEDURE NearAvailable(size: CARDINAL) : BOOLEAN; 915 916 BEGIN 917 RETURN FALSE; 918 END NearAvailable; ***** ^ not supported yet 919 (*%E *) 920 921 922 (*%F _OS2 *) 923 PROCEDURE SegAllocate(Size: CARDINAL): CARDINAL; 924 925 VAR 926 S: FarADDRESS; 927 BEGIN 928 FarAllocate(S, Size); 929 RETURN Seg(S^); 930 END SegAllocate; 931 932 PROCEDURE SegDeallocate(Sel: CARDINAL; Size: CARDINAL); 933 934 VAR 935 S: FarADDRESS; 936 BEGIN 937 S := [Sel: 0]; 938 FarDeallocate(S, Size); 939 END SegDeallocate; 940 (*%E *) 941 942 (*%T _OS2 *) 943 PROCEDURE SegAllocate(Size: CARDINAL): CARDINAL; 944 945 VAR 946 S: CARDINAL; 947 BEGIN 948 IF Dos.AllocSeg(Size, S, 0) = 0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 949 RETURN S; 950 END; 951 RETURN 0; 952 END SegAllocate; ***** ^ not supported yet 953 954 PROCEDURE SegDeallocate(Sel: CARDINAL; Size: CARDINAL); 955 956 BEGIN 957 IF Dos.FreeSeg(Sel) # 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 958 END SegDeallocate; ***** ^ not supported yet 959 (*%E *) 960 961 BEGIN 962 Check := TRUE; ***** ^ undeclared identifier 963 ClearOnAllocate := FALSE; ***** ^ undeclared identifier 964 NearHeap := NearHeapRecPtr(0FFFFH); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 965 (*%F _OS2 *) 966 MainHeap := [SYSTEM.HeapBase: 0]; 967 NearHeapSetup := FALSE; 968 FarHeapSetup := FALSE; 969 (*%E *) 970 END Storage. ***** ^ not supported yet 537 errors