Topspeed_JPI/TS-V3/SRC/STORAGE.LST

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