home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 9 Archive / 09-Archive.zip / lxlt121s.zip / lxLite_src / os2exe.pas < prev    next >
Pascal/Delphi Source File  |  1997-08-17  |  108KB  |  3,402 lines
  1. (****************************************************************************)
  2. (*  Title:       os2exe.pas                                                 *)
  3. (*  Description: OS/2 executables handling object: supports loading of      *)
  4. (*               both NE and LX files; supports writing of LX files only    *)
  5. (*                                                                          *)
  6. (*        Copyright (c) FRIENDS software, 1996   No Rights Reserved         *)
  7. (****************************************************************************)
  8. {&AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-}
  9. Unit os2exe;
  10.  
  11. Interface uses use32, exe286, exe386, miscUtil, SysLib, Collect, Streams;
  12.  
  13. const
  14. { tLX object error codes }
  15.  lxeOK            = 0;
  16.  lxeReadError     = 1;
  17.  lxeWriteError    = 2;
  18.  lxeBadFormat     = 3;
  19.  lxeBadRevision   = 4;
  20.  lxeBadOrdering   = 5;
  21.  lxeInvalidCPU    = 6;
  22.  lxeBadOS         = 7;
  23.  lxeNotLoadable   = 8;        {Module is not loadable}
  24.  lxeUnkEntBundle  = 9;        {Unknown entry bundle type}
  25.  lxeUnkPageFlags  = 10;       {Unknown page flags}
  26.  lxeInvalidPage   = 11;       {PageSize > 0 and Page is nil}
  27.  lxeNoMemory      = 12;
  28.  lxeInvalidStub   = 13;
  29.  lxeEAreadError   = 14;
  30.  lxeEAwriteError  = 15;
  31.  lxeIsNEformat    = 16;       {File is in `new` exe format}
  32.  lxeIsLXformat    = 17;       {File cannot be loaded via ^.LoadNE}
  33.  lxeBadFixupTable = 18;       {Invalid record in fixup table encountered}
  34.  lxeBoundApp      = 19;       {NE file will lose functionality (is bound)}
  35.  lxeNoLongFnames  = 20;       {NE does not support long file names}
  36.  lxeIncompatNEseg = 21;       {NE contains segments with incompatible flags}
  37.  lxeBadSegment    = 22;       {NE contains an invalid segment definition}
  38.  lxeResourcesInNE = 23;       {NE contains resources (see lneIgnoreRsrc)}
  39.  
  40. { tLX.LoadNE flags definition }
  41.  lneIgnoreBound   = $01;      { OK to convert bound executables }
  42.  lneIgnoreLngName = $02;      { OK to convert apps not aware of long fnames }
  43.  lneIgnoreRsrc    = $04;      { OK to convert apps with resources }
  44.                               { (Dos16GetResource does not work for LX) }
  45.  
  46. { tLX.Save flags definition }
  47.  svfAlignFirstObj = $00000003;{First object alignment AND mask}
  48.  svfFOalnShift    = $00000000;{Align 1st object on lxPageShift bound}
  49.  svfFOalnNone     = $00000001;{Do not align 1st object at all}
  50.  svfFOalnSector   = $00000002;{Align 1st object on sector bound}
  51.  svfAlignEachObj  = $0000000C;{Other objects alignment AND mask}
  52.  svfEOalnShift    = $00000000;{Align objects on lxPageShift bound}
  53.  svfEOalnSector   = $00000008;{Align objects on sector bound}
  54. { tLX.Pack flags definistion }
  55.  pkfRunLengthLvl  = $00000003;{Run-length pack method mask}
  56.  pkfRunLengthMin  = $00000000;{Find only 1-length repeated data}
  57.  pkfRunLengthMid  = $00000001;{Find data patterns up to 16 chars length}
  58.  pkfRunLengthMax  = $00000002;{Find ALL matching data (VERY SLOW!)}
  59.  pkfFixupsLvl     = $00000030;{Fixups packing method mask}
  60.  pkfFixupsVer2    = $00000000;{Pack fixups with an 2.x compatible method}
  61.  pkfFixupsVer4    = $00000010;{Pack fixups with an 4.x (and 3.x?) compatible method}
  62.  pkfFixupsMax     = $00000030;{Pack fixups at maximum possible level(slow!)}
  63.  pkfRunLength     = $01000000;{Pack using run-length packing}
  64.  pkfLempelZiv     = $02000000;{Pack using kinda Lempel-Ziv(WARP ONLY!)}
  65.  pkfFixups        = $04000000;{Pack fixups}
  66. type
  67.  pFixupCollection = ^tFixupCollection;
  68.  tFixupCollection = object(tCollection)
  69.   procedure FreeItem(Item: Pointer); virtual;
  70.   function  GetItem(var S : tStream) : Pointer; virtual;
  71.   procedure PutItem(var S : tStream; Item : Pointer); virtual;
  72.  end;
  73.  
  74.  pEntryPoint = ^tEntryPoint;
  75.  tEntryPoint = record
  76.   Ordinal : Word;                     { Bundle ordinal }
  77.   BndType : Byte;                     { Bundle type }
  78.   Obj     : Word16;                   { object number }
  79.   Entry   : tLXentryPoint;
  80.  end;
  81. { Collection of entry points }
  82.  pEntryCollection = ^tEntryCollection;
  83.  tEntryCollection = object(tCollection)
  84.   procedure FreeItem(Item: Pointer); virtual;
  85.  end;
  86.  
  87.  pNamedEntryCollection = ^tNamedEntryCollection;
  88.  tNamedEntryCollection = object(tSortedCollection)
  89.   procedure FreeItem(Item: Pointer); virtual;
  90.   function  Compare(Key1, Key2 : Pointer) : Integer; virtual;
  91.  end;
  92.  
  93.  pArrOfOT = ^tArrOfOT;
  94.  tArrOfOT = array[1..999] of tObjTblRec;
  95.  pArrOfOM = ^tArrOfOM;
  96.  tArrOfOM = array[1..999] of tObjMapRec;
  97.  pArrOfRS = ^tArrOfRS;
  98.  tArrOfRS = array[1..999] of tResource;
  99.  pArrOfMD = ^tArrOfMD;
  100.  tArrOfMD = array[1..999] of tDirTabRec;
  101.  tProgressFunc = function(Current,Max : Longint) : boolean;
  102.  pLX = ^tLX;
  103.  tLX = object(tObject)
  104.   Stub        : pByteArray;
  105.   StubSize    : Longint;
  106.   TimeStamp   : Longint;
  107.   FileAttr    : Longint;
  108.   Header      : tLXheader;
  109.   ObjTable    : pArrOfOT;
  110.   ObjMap      : pArrOfOM;
  111.   RsrcTable   : pArrOfRS;
  112.   ResNameTbl  : pNamedEntryCollection;
  113.   NResNameTbl : pNamedEntryCollection;
  114.   EntryTbl    : pEntryCollection;
  115.   ModDirTbl   : pArrOfMD;
  116.   PerPageCRC  : pLongArray;
  117.   FixRecSize  : pLongArray;
  118.   FixRecTbl   : pPointerArray;
  119.   ImpModTbl   : pStringCollection;
  120.   ImpProcTbl  : pStringCollection;
  121.   Pages       : pPointerArray;
  122.   PageOrder   : pLongArray;
  123.   DebugInfo   : pByteArray;
  124.   Overlay     : pByteArray;
  125.   OverlaySize : Longint;
  126.   EA          : pEAcollection;
  127.   constructor Create;
  128.   procedure   Initialize; virtual;
  129.   function    LoadLX(const fName : string) : Byte;
  130.   function    LoadNE(const fName : string; loadFlags : byte) : Byte;
  131.   function    Save(const fName : string; saveFlags : Longint) : Byte;
  132.   procedure   FreeModule;
  133.  {Unpack a single page}
  134.   function    UnpackPage(PageNo : Integer) : boolean;
  135.   procedure   Unpack;
  136.   procedure   Pack(packFlags : longint; Progress : tProgressFunc);
  137.   function    BundleRecSize(BndType : Byte) : Longint;
  138.   function    SetFixups(PageNo : Longint; Fixups : pFixupCollection) : boolean;
  139.   function    FixupsSize(Fixups : pFixupCollection) : longint;
  140.  {GetFixups needs unpacked page if v4.x chained fixups are used}
  141.   function    GetFixups(PageNo : Longint; Fixups : pFixupCollection) : boolean;
  142.  {PackFixups() will unpack all pages if pkfFixupsVer4 is used}
  143.   procedure   PackFixups(packFlags : longint);
  144.   procedure   ApplyFixups;
  145.   procedure   DeletePage(PageNo : Longint);
  146.   procedure   MinimizePage(PageNo : Longint);
  147.   function    UsedPage(PageNo : Longint) : boolean;
  148.   procedure   RemoveEmptyPages;
  149.   function    isPacked(newAlign,newStubSize,packFlags,saveFlags,oldDbgOfs : longint;
  150.                var NewSize : longint) : boolean;
  151.   destructor  Destroy;virtual;
  152.  end;
  153.  
  154. Implementation uses Dos, os2base;
  155.  
  156. procedure tFixupCollection.FreeItem;
  157. begin
  158.  with pLXreloc(Item)^ do
  159.   if (sType and nrChain <> 0) and (targetCount > 0)
  160.    then FreeMem(targets, targetCount * sizeOf(Word16));
  161.  Dispose(pLXreloc(Item));
  162. end;
  163.  
  164. function tFixupCollection.GetItem;
  165. var
  166.  Fx : pLXreloc;
  167. begin
  168.  New(Fx);
  169.  S.Get(Fx^, sizeOf(tLXreloc));
  170.  with pLXreloc(Fx)^ do
  171.   if (sType and nrChain <> 0) and (targetCount > 0)
  172.    then begin
  173.          GetMem(targets, targetCount * sizeOf(Word16));
  174.          S.Get(targets^, targetCount * sizeOf(Word16));
  175.         end;
  176.  GetItem := Fx;
  177. end;
  178.  
  179. procedure tFixupCollection.PutItem;
  180. begin
  181.  with pLXreloc(Item)^ do
  182.   begin
  183.    S.Put(Item^, sizeOf(tLXreloc));
  184.    if (sType and nrChain <> 0) and (targetCount > 0)
  185.     then S.Put(targets^, targetCount * sizeOf(Word16));
  186.   end;
  187. end;
  188.  
  189. procedure tEntryCollection.FreeItem;
  190. begin
  191.  Dispose(pEntryPoint(Item));
  192. end;
  193.  
  194. procedure tNamedEntryCollection.FreeItem;
  195. begin
  196.  DisposeStr(pNameTblRec(Item)^.Name);
  197.  Dispose(pNameTblRec(Item));
  198. end;
  199.  
  200. function tNamedEntryCollection.Compare;
  201. begin
  202.  if pNameTblRec(Key1)^.Ord > pNameTblRec(Key2)^.Ord
  203.   then Compare := +1
  204.   else
  205.  if pNameTblRec(Key1)^.Ord < pNameTblRec(Key2)^.Ord
  206.   then Compare := -1
  207.   else Compare := 0;
  208. end;
  209.  
  210. {*************************** Pack/Unpack procedures *************************}
  211.  
  212. Function UnpackMethod1(var srcData, destData; srcDataSize : Longint;
  213.                        var dstDataSize : longint) : boolean;
  214. var
  215.  src     : tByteArray absolute srcData;
  216.  dst     : tByteArray absolute destData;
  217.  sOf,dOf : Longint;
  218.  nI,cB   : Word16;
  219.  
  220. Function srcAvail(N : Longint) : boolean;
  221. begin
  222.  srcAvail := sOf + N <= srcDataSize;
  223. end;
  224.  
  225. Function dstAvail(N : Longint) : boolean;
  226. begin
  227.  dstAvail := dOf + N <= dstDataSize;
  228. end;
  229.  
  230. begin
  231.  UnpackMethod1 := FALSE;
  232.  sOf := 0; dOf := 0;
  233.  repeat
  234.   if not srcAvail(1) then break;
  235.   if not srcAvail(2) then exit;
  236.   nI := pWord16(@src[sOf])^; Inc(sOf, 2);
  237.   if nI = 0 then break;
  238.   if not srcAvail(2) then exit;
  239.   cB := pWord16(@src[sOf])^; Inc(sOf, 2);
  240.   if srcAvail(cB) and dstAvail(cB * nI)
  241.    then if nI > 0
  242.          then begin
  243.                linearMove(src[sOf], dst[dOf], cB);
  244.                linearMove(dst[dOf], dst[dOf + cB], cB * pred(nI));
  245.                Inc(dOf, cB * nI);
  246.               end
  247.          else
  248.    else exit;
  249.   Inc(sOf, cB);
  250.  until dOf >= dstDataSize;
  251.  FillChar(dst[dOf], dstDataSize - dOf, 0);
  252.  dstDataSize := dOf;
  253.  UnpackMethod1 := TRUE;
  254. end;
  255.  
  256. Function UnpackMethod2(var srcData, destData; srcDataSize : Longint;
  257.                        var dstDataSize : Longint) : boolean;
  258. var
  259.  src   : tByteArray absolute srcData;
  260.  dst   : tByteArray absolute destData;
  261.  B1,B2 : Byte;
  262.  sOf,dOf,
  263.  bOf   : Longint;
  264.  
  265. Function srcAvail(N : Longint) : boolean;
  266. begin
  267.  srcAvail := sOf + N <= srcDataSize;
  268. end;
  269.  
  270. Function dstAvail(N : Longint) : boolean;
  271. begin
  272.  dstAvail := dOf + N <= dstDataSize;
  273. end;
  274.  
  275. begin
  276.  UnpackMethod2 := FALSE;
  277.  sOf := 0; dOf := 0;
  278.  repeat
  279.   if not srcAvail(1) then break;
  280.   B1 := src[sOf];
  281.   case B1 and 3 of
  282.    0 : if B1 = 0
  283.         then if srcAvail(2)
  284.               then if src[succ(sOf)] = 0
  285.                     then begin Inc(sOf, 2); break; end
  286.                     else if srcAvail(3) and dstAvail(src[succ(sOf)])
  287.                           then begin
  288.                                 FillChar(dst[dOf], src[succ(sOf)], src[sOf+2]);
  289.                                 Inc(sOf, 3); Inc(dOf, src[sOf-2]);
  290.                                end
  291.                           else exit
  292.               else exit
  293.         else if srcAvail(succ(B1 shr 2)) and dstAvail(B1 shr 2)
  294.               then begin
  295.                     linearMove(src[succ(sOf)], dst[dOf], B1 shr 2);
  296.                     Inc(dOf, B1 shr 2);
  297.                     Inc(sOf, succ(B1 shr 2));
  298.                    end
  299.               else exit;
  300.    1 : begin
  301.         if not srcAvail(2) then exit;
  302.         bOf := pWord16(@src[sOf])^ shr 7;
  303.         B2 := (B1 shr 4) and 7 + 3;
  304.         B1 := (B1 shr 2) and 3;
  305.         if srcAvail(2 + B1) and dstAvail(B1 + B2) and (dOf + B1 - bOf >= 0)
  306.          then begin
  307.                linearMove(src[sOf + 2], dst[dOf], B1);
  308.                Inc(dOf, B1); Inc(sOf, 2 + B1);
  309.                linearMove(dst[dOf - bOf], dst[dOf], B2);
  310.                Inc(dOf, B2);
  311.               end
  312.          else exit;
  313.        end;
  314.    2 : begin
  315.         if not srcAvail(2) then exit;
  316.         bOf := pWord16(@src[sOf])^ shr 4;
  317.         B1 := (B1 shr 2) and 3 + 3;
  318.         if dstAvail(B1) and (dOf - bOf >= 0)
  319.          then begin
  320.                linearMove(dst[dOf - bOf], dst[dOf], B1);
  321.                Inc(dOf, B1); Inc(sOf, 2);
  322.               end
  323.          else exit;
  324.        end;
  325.    3 : begin
  326.         if not srcAvail(3) then exit;
  327.         B2 := (pWord16(@src[sOf])^ shr 6) and $3F;
  328.         B1 := (src[sOf] shr 2) and $0F;
  329.         bOf := pWord16(@src[succ(sOf)])^ shr 4;
  330.         if srcAvail(3 + B1) and dstAvail(B1 + B2) and (dOf + B1 - bOf >= 0)
  331.          then begin
  332.                linearMove(src[sOf + 3], dst[dOf], B1);
  333.                Inc(dOf, B1); Inc(sOf, 3 + B1);
  334.                linearMove(dst[dOf - bOf], dst[dOf], B2);
  335.                Inc(dOf, B2);
  336.               end
  337.          else exit;
  338.        end;
  339.   end;
  340.  until dOf >= dstDataSize;
  341.  FillChar(dst[dOf], dstDataSize - dOf, 0);
  342.  dstDataSize := dOf;
  343.  UnpackMethod2 := TRUE;
  344. end;
  345.  
  346. function PackMethod1(var srcData,dstData; srcDataSize : longint;
  347.                      var dstDataSize : Longint; packLevel : byte) : boolean;
  348. var
  349.  sOf,dOf,tOf,
  350.  MatchOff,
  351.  MatchCnt,
  352.  MatchLen : Longint;
  353.  src      : tByteArray absolute srcData;
  354.  dst      : tByteArray absolute dstData;
  355.  
  356. {&uses ebx,esi,edi}
  357. { Trick: In FRAME- state BP register is not altered so we can }
  358. { address external data via [bp+XX]; however we must address }
  359. { it via var[bp][-4] because compiler thinks that BP is modified }
  360. function Search : boolean; assembler;
  361. asm             cld
  362.                 mov     esi,srcData
  363.                 mov     edi,esi
  364.                 add     edi,tOf[-4] {!!! and so on !!!}
  365.                 add     esi,sOf[-4]
  366.                 xor     eax,eax
  367.                 movzx   ecx,packLevel
  368.                 cmp     cl,255
  369.                 je      @@setStart
  370.                 mov     ebx,edi
  371.                 sub     ebx,esi
  372.                 cmp     ebx,ecx
  373.                 jbe     @@setStart
  374.                 mov     eax,ebx
  375.                 sub     eax,ecx
  376. @@setStart:     mov     MatchOff[-4],eax
  377.                 add     esi,eax
  378. @@nextPatt:     push    esi
  379.                 push    edi
  380.                 mov     eax,srcDataSize
  381.                 sub     eax,tOf[-4]
  382.                 mov     ebx,edi
  383.                 sub     ebx,esi
  384.                 cmp     ebx,eax
  385.                 ja      @@noMatch
  386.                 xor     edx,edx
  387.                 div     ebx
  388.                 mov     edx,eax                 {EDX = EAX = max matches}
  389. @@nextMatch:    mov     ecx,ebx                 {EBX = ECX = pattern length}
  390.                 repe    cmpsb
  391.                 jne     @@notEQ
  392.                 dec     eax
  393.                 jnz     @@nextMatch
  394. @@notEQ:        cmp     eax,edx
  395.                 je      @@noMatch
  396.                 sub     eax,edx
  397.                 neg     eax
  398.                 inc     eax                     {EAX = number of actual matches}
  399.                 mov     edx,ebx
  400.                 db      $0F,$AF,$D8             {imul    ebx,eax}
  401.                 sub     ebx,2+2
  402.                 jc      @@noMatch
  403.                 cmp     ebx,edx
  404.                 jbe     @@noMatch
  405.                 mov     MatchCnt[-4],eax
  406.                 mov     MatchLen[-4],edx
  407.                 pop     esi
  408.                 pop     edi
  409.                 mov     al,1
  410.                 jmp     @@locEx
  411. @@noMatch:      pop     edi
  412.                 pop     esi
  413.                 inc     esi
  414.                 inc     MatchOff[-4]
  415.                 cmp     esi,edi
  416.                 jb      @@nextPatt
  417.                 mov     al,0
  418. @@locEx:
  419. end;
  420. {&uses none}
  421.  
  422. function dstAvail(N : Longint) : boolean;
  423. begin
  424.  dstAvail := dOf + N <= dstDataSize;
  425. end;
  426.  
  427. function PutNonpackedData : boolean;
  428. begin
  429.  PutNonpackedData := TRUE;
  430.  if MatchOff > 0
  431.   then if dstAvail(2+2+MatchOff)
  432.         then begin
  433.               pWord16(@dst[dOf])^ := 1; Inc(dOf, 2);
  434.               pWord16(@dst[dOf])^ := MatchOff; Inc(dOf, 2);
  435.               Move(src[sOf], dst[dOf], MatchOff);
  436.               Inc(dOf, MatchOff); Inc(sOf, MatchOff);
  437.              end
  438.         else PutNonpackedData := FALSE;
  439. end;
  440.  
  441. begin
  442.  PackMethod1 := FALSE;
  443.  sOf := 0; dOf := 0;
  444.  repeat
  445.   tOf := succ(sOf);
  446.   While tOf < srcDataSize do
  447.    begin
  448.     if Search
  449.      then begin
  450.            if (not PutNonpackedData) or
  451.               (not dstAvail(2+2+MatchLen)) then exit;
  452.            pWord16(@dst[dOf])^ := MatchCnt; Inc(dOf, 2);
  453.            pWord16(@dst[dOf])^ := MatchLen; Inc(dOf, 2);
  454.            linearMove(src[sOf], dst[dOf], MatchLen);
  455.            Inc(sOf, MatchCnt * MatchLen); Inc(dOf, MatchLen);
  456.            break;
  457.           end
  458.      else Inc(tOf);
  459.    end;
  460.  until tOf >= srcDataSize;
  461.  MatchOff := srcDataSize - sOf;
  462.  if (not PutNonpackedData) or (sOf <= dOf)
  463.   then exit;
  464.  if not dstAvail(2) then exit;
  465.  pWord16(@dst[dOf])^ := 0; Inc(dOf, 2);
  466.  if (dOf >= $FFC) { OS2KRNL limit !!! }
  467.   then exit;
  468.  dstDataSize := dOf;
  469.  PackMethod1 := TRUE;
  470. end;
  471.  
  472. function PackMethod2(var srcData,dstData; srcDataSize : longint; var dstDataSize : Longint) : boolean;
  473. label skip,locEx;
  474. var
  475.  Chain       : pWord16Array;
  476.  ChainHead   : pWord16Array;
  477.  sOf,dOf,tOf,I,J,
  478.  maxMatchLen,
  479.  maxMatchPos : Longint;
  480.  src         : tByteArray absolute srcData;
  481.  dst         : tByteArray absolute dstData;
  482.  
  483. {&uses esi,edi,ebx}
  484. function Search : boolean; assembler;
  485. asm             cld
  486.                 mov     edx,srcDataSize
  487.                 sub     edx,tOf[-4]
  488.                 mov     al,0
  489.                 cmp     edx,2
  490.                 jbe     @@locEx
  491.                 mov     esi,srcData
  492.                 mov     edi,esi
  493.                 add     esi,tOf[-4]
  494.                 mov     ax,[esi]
  495.                 and     eax,0FFFh
  496.                 shl     eax,1
  497.                 add     eax,ChainHead[-4]
  498.                 and     maxMatchLen[-4],0
  499.  
  500. @@nextSearch:   push    esi
  501.                 movsx   edi,word ptr [eax]
  502.                 cmp     edi,-1
  503.                 je      @@endOfChain
  504.                 mov     eax,edi
  505.                 shl     eax,1
  506.                 add     eax,Chain[-4]
  507.                 add     edi,srcData
  508.                 mov     ecx,edx
  509.                 repe    cmpsb
  510.                 jz      @@maxLen
  511.                 pop     esi
  512.                 sub     ecx,edx
  513.                 neg     ecx
  514.                 sub     edi,ecx
  515.                 dec     ecx
  516.                 cmp     ecx,maxMatchLen[-4]
  517.                 jbe     @@nextSearch
  518.                 sub     edi,srcData
  519.                 mov     maxMatchLen[-4],ecx
  520.                 mov     maxMatchPos[-4],edi
  521.                 mov     ebx,tOf[-4]
  522.                 dec     ebx
  523.                 cmp     ebx,edi                 {Prefer RL encoding since it}
  524.                 jne     @@nextSearch            {packs longer strings}
  525.                 cmp     ecx,63                  {Strings up to 63 chars are always}
  526.                 jbe     @@nextSearch            {packed effectively enough}
  527.                 push    esi
  528.                 jmp     @@endOfChain
  529.  
  530. @@maxLen:       sub     edi,edx
  531.                 sub     edi,srcData
  532.                 mov     maxMatchLen[-4],edx
  533.                 mov     maxMatchPos[-4],edi
  534.  
  535. @@endOfChain:   mov     al,0
  536.                 cmp     maxMatchLen[-4],3
  537.                 jb      @@noMatch
  538.                 inc     al
  539. @@noMatch:      pop     esi
  540. @@locEx:
  541. end;
  542. {&uses none}
  543.  
  544. function dstAvail(N : Longint) : boolean;
  545. begin
  546.  dstAvail := dOf + N <= dstDataSize;
  547. end;
  548.  
  549. procedure Register(sOf, Count : Longint);
  550. var
  551.  I : Longint;
  552. begin
  553.  While (Count > 0) and (sOf < pred(srcDataSize)) do
  554.   begin
  555.    I := pWord16(@src[sOf])^ and $FFF;
  556.    Chain^[sOf] := ChainHead^[I];
  557.    ChainHead^[I] := sOf;
  558.    Inc(sOf); Dec(Count);
  559.   end;
  560. end;
  561.  
  562. procedure Deregister(sOf : Longint);
  563. var
  564.  I : Longint;
  565. begin
  566.  I := pWord16(@src[sOf])^ and $FFF;
  567.  ChainHead^[I] := Chain^[sOf];
  568. end;
  569.  
  570. begin
  571.  PackMethod2 := FALSE;
  572.  GetMem(Chain, srcDataSize * 2);
  573.  GetMem(ChainHead, (1 shl 12) * 2);
  574.  FillChar(ChainHead^, (1 shl 12) * 2, $FF);
  575.  sOf := 0; dOf := 0;
  576.  repeat
  577.   tOf := sOf;
  578.   while tOf < srcDataSize do
  579.    if Search
  580.     then begin
  581.           if (maxMatchPos = pred(tOf))
  582.            then begin
  583.                  if tOf > sOf then
  584.                   begin
  585.                    Inc(maxMatchLen);
  586.                    Dec(tOf); Deregister(tOf);
  587.                   end;
  588.                  if maxMatchLen = 3 then goto skip;
  589.                  while sOf < tOf do
  590.                   begin
  591.                    I := MinL(tOf - sOf, 63);
  592.                    if not dstAvail(succ(I)) then goto locEx;
  593.                    dst[dOf] := I shl 2;
  594.                    linearMove(src[sOf], dst[succ(dOf)], I);
  595.                    Inc(sOf, I); Inc(dOf, succ(I));
  596.                   end;
  597.                  while maxMatchLen > 3 do
  598.                   begin
  599.                    if not dstAvail(3) then goto locEx;
  600.                    I := MinL(maxMatchLen, 255);
  601.                    dst[dOf] := 0;
  602.                    dst[dOf+1] := I;
  603.                    dst[dOf+2] := src[sOf];
  604.                    Register(sOf, I);
  605.                    Inc(sOf, I); Inc(dOf, 3);
  606.                    Dec(maxMatchLen, I);
  607.                   end;
  608.                 end
  609.            else begin
  610.                  if (tOf - maxMatchPos < 512) and (maxMatchLen <= 10)
  611.                   then J := 3
  612.                   else
  613.                  if (maxMatchLen <= 6)
  614.                   then J := 0
  615.                   else J := 15;
  616.                  while (sOf < tOf - J) do
  617.                   begin
  618.                    I := MinL(tOf - sOf, 63);
  619.                    if not dstAvail(succ(I)) then goto locEx;
  620.                    dst[dOf] := I shl 2;
  621.                    linearMove(src[sOf], dst[succ(dOf)], I);
  622.                    Inc(sOf, I); Inc(dOf, succ(I));
  623.                   end;
  624.                  case byte(J) of
  625.                   3  : begin
  626.                         if not dstAvail(2 + tOf - sOf) then goto locEx;
  627.                         pWord16(@dst[dOf])^ := 1 + (tOf - sOf) shl 2 +
  628.                          (maxMatchLen - 3) shl 4 + (tOf - maxMatchPos) shl 7;
  629.                         linearMove(src[sOf], dst[dOf + 2], tOf - sOf);
  630.                         Register(tOf, maxMatchLen);
  631.                         Inc(dOf, 2 + tOf - sOf);
  632.                         sOf := tOf + maxMatchLen;
  633.                        end;
  634.                   0  : begin
  635.                         if not dstAvail(2) then goto locEx;
  636.                         pWord16(@dst[dOf])^ := 2 + (maxMatchLen - 3) shl 2 +
  637.                          (tOf - maxMatchPos) shl 4;
  638.                         Register(tOf, maxMatchLen);
  639.                         Inc(dOf, 2);
  640.                         sOf := tOf + maxMatchLen;
  641.                        end;
  642.                   15 : begin
  643.                         if not dstAvail(3 + tOf - sOf) then goto locEx;
  644.                         J := MinL(maxMatchLen, 63);
  645.                         pWord16(@dst[dOf])^ := 3 + (tOf - sOf) shl 2 +
  646.                          (J shl 6) + (tOf - maxMatchPos) shl 12;
  647.                         dst[dOf + 2] := (tOf - maxMatchPos) shr 4;
  648.                         linearMove(src[sOf], dst[dOf + 3], tOf - sOf);
  649.                         Register(tOf, J);
  650.                         Inc(dOf, 3 + tOf - sOf);
  651.                         sOf := tOf + J;
  652.                        end;
  653.                  end;
  654.                 end;
  655.           break;
  656.          end
  657.     else begin
  658. skip:     Register(tOf, 1);
  659.           Inc(tOf);
  660.          end;
  661.  until tOf >= srcDataSize;
  662.  if not dstAvail(srcDataSize - sOf + 2) then goto locEx;
  663.  while sOf < srcDataSize do
  664.   begin
  665.    I := MinL(srcDataSize - sOf, 63);
  666.    if not dstAvail(succ(I)) then goto locEx;
  667.    dst[dOf] := I shl 2;
  668.    linearMove(src[sOf], dst[succ(dOf)], I);
  669.    Inc(sOf, I); Inc(dOf, succ(I));
  670.   end;
  671.  pWord16(@dst[dOf])^ := 0; Inc(dOf, 2); {Put end-of-page flag}
  672.  if (dOf >= srcDataSize) or (dOf >= $FFC) { OS2KRNL limit !!! }
  673.   then goto locEx;
  674.  PackMethod2 := TRUE;
  675.  dstDataSize := dOf;
  676. locEx:
  677.  FreeMem(ChainHead, (1 shl 12) * 2);
  678.  FreeMem(Chain, srcDataSize * 2);
  679. end;
  680.  
  681. {********************* LX executable object implementation ******************}
  682.  
  683. constructor tLX.Create;
  684. begin
  685.  Initialize;
  686. end;
  687.  
  688. procedure tLX.Initialize;
  689. begin
  690.  Zero;
  691.  Header.lxMagicID := lxMagic;
  692. {Header.lxBOrder := lxLEBO;}
  693. {Header.lxWOrder := lxLEWO;}
  694. {Header.lxLevel := 0;}             {commented out since they`re already zeros}
  695.  Header.lxCpu := lxCPU386;
  696.  Header.lxOS := 1;
  697.  Header.lxPageShift := 2;
  698.  Header.lxPageSize := lx386PageSize;
  699. end;
  700.  
  701. {* Two utility procedures for the QuickSort routine: *}
  702. {* compare two pages and exchange two pages (below). *}
  703. Function lxCmpPages(var Buff; N1,N2 : longint) : boolean;
  704. var
  705.  L1,L2 : Longint;
  706. begin
  707.  lxCmpPages := TRUE;
  708.  with tLX(Buff) do
  709.   begin
  710.    with ObjMap^[PageOrder^[N1]] do
  711.     case PageFlags of
  712.      pgValid     : L1 := Header.lxDataPageOfs + PageDataOffset shl Header.lxPageShift;
  713.      pgIterData,
  714.      pgIterData2 : L1 := Header.lxIterMapOfs + PageDataOffset shl Header.lxPageShift;
  715.      pgInvalid,
  716.      pgZeroed    : L1 := $7FFFFFFF;
  717.     end;
  718.    with ObjMap^[PageOrder^[N2]] do
  719.     case PageFlags of
  720.      pgValid     : L2 := Header.lxDataPageOfs + PageDataOffset shl Header.lxPageShift;
  721.      pgIterData,
  722.      pgIterData2 : L2 := Header.lxIterMapOfs + PageDataOffset shl Header.lxPageShift;
  723.      pgInvalid,
  724.      pgZeroed    : L2 := $7FFFFFFF;
  725.     end;
  726.    if (L1 >= L2) or ((L1 = L2) and (N1 >= N2)) then exit;
  727.   end;
  728.  lxCmpPages := FALSE;
  729. end;
  730.  
  731. Procedure lxXchgPages(var Buff; N1,N2 : longint);
  732. begin
  733.  with tLX(Buff) do
  734.   XchgL(PageOrder^[N1], PageOrder^[N2]);
  735. end;
  736.  
  737. function tLX.LoadLX;
  738. label locEx;
  739. var
  740.  F       : File;
  741.  fSz,lastData,
  742.  I,J,L,M : Longint;
  743.  S       : String;
  744.  NTR     : pNameTblRec;
  745.  ETR     : tEntryTblRec;
  746.  EP      : pEntryPoint;
  747.  Res     : Byte;
  748.  tmpBuff : pByteArray;
  749.  
  750. Procedure UpdateLast;
  751. var
  752.  A : Longint;
  753. begin
  754.  A := FilePos(F);
  755.  if (lastData < A)
  756.   then if (A <= fSz)
  757.         then lastData := A
  758.         else lastData := fSz;
  759. end;
  760.  
  761. begin
  762.  freeModule;
  763.  Res := lxeReadError;
  764.  Assign(F, fName);
  765.  New(EA, Fetch(fName));
  766.  if EA = nil then begin Res := lxeEAreadError; GoTo locEx; end;
  767.  I := FileMode; FileMode := open_share_DenyWrite;
  768.  GetFAttr(F, FileAttr); Reset(F, 1); FileMode := I;
  769.  if inOutRes <> 0 then GoTo locEx;
  770.  Res := lxeBadFormat;
  771.  L := 0; lastData := 0;
  772.  fSz := FileSize(F);
  773.  GetFTime(F, TimeStamp);
  774.  repeat
  775.   if (fSz - FilePos(F)) < sizeOf(Header) then GoTo locEx;
  776.   FillChar(Header, sizeOf(Header), 0);
  777.   BlockRead(F, Header, sizeOf(Header));
  778.   if inOutRes <> 0 then GoTo locEx;
  779.   case Header.lxMagicID of
  780.    lxMagic   : break;
  781.    neMagic   : begin Res := lxeIsNEformat; GoTo locEx; end;
  782.    exeMagic1,
  783.    exeMagic2 : begin
  784.                 if pLongArray(@header)^[$0F] <= L then GoTo locEx;
  785.                 L := pLongArray(@header)^[$0F];
  786.                 if L > fSz - sizeOf(Header) then GoTo locEx;
  787.                 Seek(F, L); {Skip DOS stub}
  788.                end;
  789.    else GoTo locEx;
  790.   end;
  791.  until FALSE;
  792.  if (Header.lxBOrder <> lxLEBO) or (Header.lxWOrder <> lxLEBO)
  793.   then begin Res := lxeBadOrdering; GoTo locEx; end;
  794.  if (Header.lxCPU < lxCPU286) or (Header.lxCPU > lxCPUP5)
  795.   then begin Res := lxeInvalidCPU; GoTo locEx; end;
  796.  if (Header.lxLevel <> 0)
  797.   then begin Res := lxeBadRevision; GoTo locEx; end;
  798.  if (Header.lxOS <> 1)  {Not for OS/2}
  799.   then begin Res := lxeBadOS; GoTo locEx; end;
  800.  if (Header.lxMFlags and lxNoLoad <> 0)
  801.   then begin Res := lxeNotLoadable; GoTo locEx; end;
  802.  if (Header.lxPageSize <> lx386PageSize)
  803.   then begin Res := lxeBadFormat; GoTo locEx; end;
  804.  
  805. { Read in DOS stub }
  806.  stubSize := L; Seek(F, 0);
  807.  GetMem(Stub, stubSize);
  808.  BlockRead(F, Stub^, stubSize);
  809.  updateLast;
  810.  
  811. { Read Object Table }
  812.  if (Header.lxObjTabOfs <> 0) and (StubSize + Header.lxObjTabOfs < fSz)
  813.   then begin
  814.         Seek(F, StubSize + Header.lxObjTabOfs);
  815.         GetMem(ObjTable, Header.lxObjCnt * sizeOf(tObjTblRec));
  816.         BlockRead(F, ObjTable^, Header.lxObjCnt * sizeOf(tObjTblRec));
  817.         updateLast;
  818.         J := 0;
  819.         For I := 1 to Header.lxObjCnt do
  820.          with ObjTable^[I] do
  821.           begin
  822.            L := pred(oPageMap + oMapSize);
  823.            if L > J then J := L;
  824.           end;
  825.         if Header.lxMPages > J  { Fix for some poor-constructed executables }
  826.          then Header.lxMPages := J;
  827.        end
  828.   else begin
  829.         Header.lxObjTabOfs := 0;
  830.         Header.lxObjCnt := 0;
  831.        end;
  832.  
  833. { Read Object Page Map Table }
  834.  if (Header.lxObjTabOfs <> 0) and (StubSize + Header.lxObjTabOfs < fSz)
  835.   then begin
  836.         Seek(F, StubSize + Header.lxObjMapOfs);
  837.         GetMem(ObjMap, Header.lxMpages * sizeOf(tObjMapRec));
  838.         BlockRead(F, ObjMap^, Header.lxMpages * sizeOf(tObjMapRec));
  839.         updateLast;
  840.        end
  841.   else begin
  842.         Header.lxObjMapOfs := 0;
  843.         Header.lxMpages := 0;
  844.        end;
  845.  
  846.  if (Header.lxRsrcTabOfs <> 0) and (StubSize + Header.lxRsrcTabOfs < fSz)
  847.   then begin
  848.         Seek(F, StubSize + Header.lxRsrcTabOfs);
  849.         GetMem(RsrcTable, Header.lxRsrcCnt * sizeOf(tResource));
  850.         BlockRead(F, RsrcTable^, Header.lxRsrcCnt * sizeOf(tResource));
  851.         updateLast;
  852.        end
  853.   else begin
  854.         Header.lxRsrcTabOfs := 0;
  855.         Header.lxRsrcCnt := 0;
  856.        end;
  857.  
  858.  New(ResNameTbl, Create(16, 16));
  859.  if (Header.lxResTabOfs <> 0) and (StubSize + Header.lxResTabOfs < fSz)
  860.   then begin
  861.         Seek(F, StubSize + Header.lxResTabOfs);
  862.         repeat
  863.          BlockRead(F, S, sizeOf(Byte));
  864.          if S = '' then break;
  865.          BlockRead(F, S[1], length(S));
  866.          New(NTR);
  867.          NTR^.Name := NewStr(S);
  868.          BlockRead(F, NTR^.Ord, sizeOf(Word16));
  869.          ResNameTbl^.Insert(NTR);
  870.         until inOutRes <> 0;
  871.         updateLast;
  872.        end
  873.   else Header.lxResTabOfs := 0;
  874.  
  875.  New(NResNameTbl, Create(16, 16));
  876.  if (Header.lxNResTabOfs <> 0) and (Header.lxNResTabOfs < fSz)
  877.   then begin
  878.         Seek(F, Header.lxNResTabOfs);
  879.         repeat
  880.          BlockRead(F, S, sizeOf(Byte));
  881.          if S = '' then break;
  882.          BlockRead(F, S[1], length(S));
  883.          New(NTR);
  884.          NTR^.Name := NewStr(S);
  885.          BlockRead(F, NTR^.Ord, sizeOf(Word16));
  886.          NResNameTbl^.Insert(NTR);
  887.         until inOutRes <> 0;
  888.         updateLast;
  889.        end
  890.   else Header.lxNResTabOfs := 0;
  891.  
  892.  New(EntryTbl, Create(16, 16));
  893.  if (Header.lxEntTabOfs <> 0) and (StubSize + Header.lxEntTabOfs < fSz)
  894.   then begin
  895.         Seek(F, StubSize + Header.lxEntTabOfs);
  896.         M := 1;
  897.         repeat
  898.          ETR.Count := 0;
  899.          BlockRead(F, ETR.Count, sizeOf(ETR.Count));
  900.          if ETR.Count = 0 then break;
  901.          BlockRead(F, ETR.BndType, sizeOf(ETR.BndType));
  902.          L := BundleRecSize(ETR.BndType);
  903.          if L = -1 then begin Res := lxeUnkEntBundle; GoTo locEx; end;
  904.          if L <> 0 then BlockRead(F, ETR.Obj, sizeOf(ETR.Obj));
  905.          if ETR.BndType = btEmpty
  906.           then begin Inc(M, ETR.Count); Continue; end;
  907.          J := ETR.Count * L;
  908.          GetMem(tmpBuff, J);
  909.          BlockRead(F, tmpBuff^, J);
  910.          For I := 1 to ETR.Count do
  911.           begin
  912.            New(EP);
  913.            EP^.Ordinal := M;
  914.            EP^.BndType := ETR.BndType;
  915.            EP^.Obj := ETR.Obj;
  916.            FillChar(EP^.Entry, sizeOf(EP^.Entry), 0);
  917.            Move(tmpBuff^[pred(I) * L], EP^.Entry, L);
  918.            EntryTbl^.Insert(EP); Inc(M);
  919.           end;
  920.          FreeMem(tmpBuff, J);
  921.         until inOutRes <> 0;
  922.         updateLast;
  923.        end
  924.   else Header.lxEntTabOfs := 0;
  925.  
  926.  if (Header.lxDirTabOfs <> 0) and (StubSize + Header.lxDirTabOfs < fSz)
  927.   then begin
  928.         Seek(F, StubSize + Header.lxDirTabOfs);
  929.         GetMem(ModDirTbl, Header.lxDirCnt * sizeOf(tResource));
  930.         BlockRead(F, ModDirTbl^, Header.lxDirCnt * sizeOf(tResource));
  931.         updateLast;
  932.        end
  933.   else begin
  934.         Header.lxDirTabOfs := 0;
  935.         Header.lxDirCnt := 0;
  936.        end;
  937.  
  938.  if (Header.lxPageSumOfs <> 0) and (StubSize + Header.lxPageSumOfs < fSz)
  939.   then begin
  940.         Seek(F, StubSize + Header.lxPageSumOfs);
  941.         GetMem(PerPageCRC, Header.lxMpages * sizeOf(Longint));
  942.         BlockRead(F, PerPageCRC^, Header.lxMpages * sizeOf(Longint));
  943.         updateLast;
  944.        end
  945.   else Header.lxPageSumOfs := 0;
  946.  
  947.  if (Header.lxFPageTabOfs <> 0) and (StubSize + Header.lxFPageTabOfs < fSz)
  948.   then begin
  949.         Seek(F, StubSize + Header.lxFPageTabOfs);
  950.         GetMem(FixRecSize, succ(Header.lxMpages) * sizeOf(Longint));
  951.         BlockRead(F, FixRecSize^, succ(Header.lxMpages) * sizeOf(Longint));
  952.         updateLast;
  953.        end
  954.   else Header.lxFPageTabOfs := 0;
  955.  if FixRecSize = nil
  956.   then begin
  957.         FreeMem(FixRecSize, succ(Header.lxMpages) * sizeOf(Longint));
  958.         FixRecSize := nil;
  959.         Res := lxeBadFixupTable;
  960.         Goto locEx;
  961.        end;
  962.  
  963.  For I := 1 to Header.lxMPages do
  964.   if FixRecSize^[I] < FixRecSize^[pred(I)]
  965.    then if FixRecSize^[I] = 0
  966.          then FixRecSize^[I] := FixRecSize^[pred(I)]
  967.          else begin
  968.                FreeMem(FixRecSize, succ(Header.lxMpages) * sizeOf(Longint));
  969.                FixRecSize := nil;
  970.                Res := lxeBadFixupTable;
  971.                Goto locEx;
  972.               end;
  973.  
  974.  if (Header.lxFRecTabOfs <> 0) and (StubSize + Header.lxFRecTabOfs < fSz)
  975.   then begin
  976.         Seek(F, StubSize + Header.lxFRecTabOfs + FixRecSize^[0]);
  977.  
  978.       { convert fixup page offsets to sizes of individual fixups }
  979.         For I := Header.lxMPages downto 1 do
  980.          Dec(FixRecSize^[I], FixRecSize^[pred(I)]);
  981.         GetMem(FixRecTbl, Header.lxMpages * sizeOf(Longint));
  982.         Move(FixRecSize^[1], FixRecTbl^, Header.lxMpages * sizeOf(Longint));
  983.         FreeMem(FixRecSize, succ(Header.lxMpages) * sizeOf(Longint));
  984.         FixRecSize := Pointer(FixRecTbl);
  985.  
  986.         GetMem(FixRecTbl, Header.lxMpages * sizeOf(Longint));
  987.         For I := 1 to Header.lxMpages do {Read fixups for each page}
  988.          begin
  989.           L := FixRecSize^[pred(I)];
  990.           GetMem(FixRecTbl^[pred(I)], L);
  991.           BlockRead(F, FixRecTbl^[pred(I)]^, L);
  992.          end;
  993.         updateLast;
  994.        end
  995.   else Header.lxFRecTabOfs := 0;
  996.  
  997.  New(ImpModTbl, Create(16, 16));
  998.  if (Header.lxImpModOfs <> 0) and (StubSize + Header.lxImpModOfs < fSz)
  999.   then begin
  1000.         Seek(F, StubSize + Header.lxImpModOfs);
  1001.         For I := 1 to Header.lxImpModCnt do
  1002.          begin
  1003.           BlockRead(F, S, sizeOf(Byte));
  1004.           BlockRead(F, S[1], length(S));
  1005.           ImpModTbl^.AtInsert(ImpModTbl^.Count, NewStr(S));
  1006.          end;
  1007.         updateLast;
  1008.        end
  1009.   else Header.lxImpModOfs := 0;
  1010.  
  1011.  New(ImpProcTbl, Create(16, 16));
  1012.  if (Header.lxImpProcOfs <> 0) and (StubSize + Header.lxImpProcOfs < fSz)
  1013.   then begin
  1014.         Seek(F, StubSize + Header.lxImpProcOfs);
  1015.         I := Header.lxFPageTabOfs + Header.lxFixupSize - Header.lxImpProcOfs;
  1016.         While I > 0 do
  1017.          begin
  1018.           BlockRead(F, S, sizeOf(Byte));
  1019.           BlockRead(F, S[1], length(S));
  1020.           ImpProcTbl^.AtInsert(ImpProcTbl^.Count, NewStr(S));
  1021.           Dec(I, succ(length(S)));
  1022.          end;
  1023.         updateLast;
  1024.        end
  1025.   else Header.lxImpProcOfs := 0;
  1026.  
  1027.  GetMem(Pages, Header.lxMpages * sizeOf(Pointer));
  1028.  FillChar(Pages^, Header.lxMpages * sizeOf(Pointer), 0);
  1029.  GetMem(PageOrder, Header.lxMpages * sizeOf(Longint));
  1030.  For I := 1 to Header.lxMpages do
  1031.   with ObjMap^[I] do
  1032.    begin
  1033.     PageOrder^[pred(I)] := I;
  1034.     case PageFlags of
  1035.      pgValid     : L := Header.lxDataPageOfs;
  1036.      pgIterData,
  1037.      pgIterData2 : L := Header.lxIterMapOfs;
  1038.      pgInvalid,
  1039.      pgZeroed    : begin
  1040.                     PageDataOffset := 0;
  1041.                     L := -1;
  1042.                    end;
  1043.      else{pgRange} begin Res := lxeUnkPageFlags; GoTo locEx; end;
  1044.     end;
  1045.     if L <> -1
  1046.      then begin
  1047.            Inc(L, PageDataOffset shl Header.lxPageShift);
  1048.            if (L > fSz)
  1049.             then if UsedPage(I)
  1050.                   then goto locEx
  1051.                   else begin
  1052.                         PageSize := 0;
  1053.                         PageDataOffset := 0;
  1054.                         PageFlags := pgInvalid;
  1055.                        end
  1056.             else begin
  1057.                   Seek(F, L);
  1058.                   GetMem(Pages^[pred(I)], PageSize);
  1059.                   BlockRead(F, Pages^[pred(I)]^, PageSize);
  1060.                   updateLast;
  1061.                  end;
  1062.           end;
  1063.    end;
  1064. { Now sort the pages in the order they come in the file }
  1065.  QuickSort(Self, 0, pred(Header.lxMpages), 0, lxCmpPages, lxXchgPages);
  1066.  
  1067. { Fix for some cut-down executables (FASTECHO/2) }
  1068.  I := fSz - Header.lxDebugInfoOfs;
  1069.  if (I < Header.lxDebugLen)
  1070.   then begin
  1071.         Header.lxDebugLen := I;
  1072.         if Header.lxDebugLen = 0
  1073.          then Header.lxDebugLen := 0;
  1074.        end;
  1075.  
  1076.  if (Header.lxDebugInfoOfs <> 0) and (Header.lxDebugInfoOfs < fSz)
  1077.   then begin
  1078.         Seek(F, Header.lxDebugInfoOfs);
  1079.         GetMem(DebugInfo, Header.lxDebugLen);
  1080.         BlockRead(F, DebugInfo^, Header.lxDebugLen);
  1081.         updateLast;
  1082.        end
  1083.   else begin
  1084.         Header.lxDebugInfoOfs := 0;
  1085.         Header.lxDebugLen := 0;
  1086.        end;
  1087.  
  1088.  if lastData < fSz
  1089.   then begin
  1090.         OverlaySize := fSz - lastData;
  1091.         GetMem(Overlay, OverlaySize);
  1092.         Seek(F, lastData);
  1093.         BlockRead(F, Overlay^, OverlaySize);
  1094.        end;
  1095.  
  1096.  if inOutRes <> 0 then GoTo locEx;
  1097.  
  1098.  Res := lxeOK;
  1099. locEx:
  1100.  if ioResult <> 0 then Res := lxeReadError;
  1101.  if Res <> lxeOK then freeModule;
  1102.  LoadLX := Res;
  1103.  Close(F); inOutRes := 0;
  1104. end;
  1105.  
  1106. { Load file in `new` executable format and convert it on-the-fly into LX }
  1107. function tLX.LoadNE;
  1108. label
  1109.  locEx;
  1110. var
  1111.  F         : File;
  1112.  neHdr     : tNEheader;
  1113.  fSz,lastData,
  1114.  siz,buffPos,
  1115.  I,J,K,L,M : Longint;
  1116.  S         : String;
  1117.  NTR       : pNameTblRec;
  1118.  ETR       : tEntryTblRec;
  1119.  EP        : pEntryPoint;
  1120.  Res       : Byte;
  1121.  ImportP,
  1122.  ImportM   : pCollection;
  1123.  tmpBuff,
  1124.  Buff      : pByteArray;
  1125.  neSeg     : pNEseg;
  1126.  neRes     : tNEresource;
  1127.  ModRefTbl : pWord16Array;
  1128.  
  1129. Procedure UpdateLast;
  1130. var
  1131.  A : Longint;
  1132. begin
  1133.  A := FilePos(F);
  1134.  if (lastData < A)
  1135.   then if (A <= fSz)
  1136.         then lastData := A
  1137.         else lastData := fSz;
  1138. end;
  1139.  
  1140. function ConvertRelocations(ObjNo : Longint) : boolean;
  1141. var
  1142.  Count   : Word16;
  1143.  tmpB,
  1144.  tmpPtr  : pByteArray;
  1145.  I,J,K,L : Longint;
  1146.  Fixup   : array[0..15] of pFixupCollection;
  1147.  tmpF,
  1148.  tmpF1   : pLXreloc;
  1149.  pW      : pWord16;
  1150.  pB1,pB2 : pByte;
  1151.  
  1152. procedure AddTObjMod(O : Word16);
  1153. begin
  1154.  tmpF^.Flags := tmpF^.Flags or nr16objMod and (not nr8bitOrd);
  1155.  tmpF^.ObjMod := O;
  1156. end;
  1157.  
  1158. procedure locFree;
  1159. var
  1160.  I,J : Integer;
  1161.  P   : pByte;
  1162. begin
  1163.  FreeMem(tmpB, Count * 8);
  1164.  For I := 0 to 15 do
  1165.   if Fixup[I] <> nil
  1166.    then Dispose(Fixup[I], Destroy);
  1167. end;
  1168.  
  1169. function GetChain(Offs : Word) : Word;
  1170. var
  1171.  L : Word;
  1172. begin
  1173.  with ObjTable^[ObjNo], ObjMap^[oPageMap + J] do
  1174.   if Offs < pred(Header.lxPageSize)
  1175.    then if (pred(PageSize) < Offs)
  1176.          then L := 0
  1177.          else begin
  1178.                pW := @pByteArray(Pages^[pred(oPageMap + J)])^[Offs];
  1179.                if (pred(PageSize) = Offs)
  1180.                 then begin
  1181.                       L := pByte(pW)^;
  1182.                       pByte(pW)^ := 0;
  1183.                      end
  1184.                 else begin
  1185.                       L := pW^;
  1186.                       pW^ := 0;
  1187.                      end;
  1188.               end
  1189.    else begin
  1190.          if (pred(PageSize) < Offs)
  1191.           then L := 0
  1192.           else begin
  1193.                 pB1 := @pByteArray(Pages^[pred(oPageMap + J)])^[Offs];
  1194.                 L := pB1^; pB1^ := 0;
  1195.                end;
  1196.          if (ObjMap^[oPageMap + J + 1].PageSize > 0)
  1197.           then begin
  1198.                 pB2 := @pByteArray(Pages^[oPageMap + J])^[0];
  1199.                 L := L or Word(pB2^) * 256; pB2^ := 0;
  1200.                end;
  1201.         end;
  1202.  GetChain := L;
  1203. end;
  1204.  
  1205. begin
  1206.  ConvertRelocations := FALSE;
  1207.  Seek(F, neSeg^.Sector shl neHdr.neAlign + neSeg^.cbSeg);
  1208.  BlockRead(F, Count, sizeOf(Count));
  1209.  GetMem(tmpB, Count * 8);
  1210.  BlockRead(F, tmpB^, Count * 8);
  1211.  updateLast;
  1212.  For I := 0 to 15 do
  1213.   begin
  1214.    New(Fixup[I], Create(Count, 1));
  1215.    if Fixup[I] = nil then begin locFree; exit; end;
  1216.   end;
  1217.  TmpPtr := TmpB;
  1218.  For I := 1 to Count do
  1219.   begin
  1220.    if memScanFwd(TmpPtr^, 8, 0) < 8
  1221.     then with pNEreloc(TmpPtr)^ do
  1222.           begin
  1223.            if (sType and (not nerSType) <> 0) or
  1224.               (flags and (not (nerRTyp or nerAdd)) <> 0)
  1225.             then begin locFree; exit; end;
  1226.            New(tmpF);
  1227.            tmpF^.sType := sType or nrAlias;
  1228.            tmpF^.Flags := Flags;
  1229.            tmpF^.sOffs := sOff;
  1230.            case Flags and nerRTyp of
  1231.             nerRInt : if rel.segNo <> 255
  1232.                        then begin
  1233.                              AddTObjMod(rel.segNo);
  1234.                              tmpF^.Target.intRef := rel.Entry;
  1235.                             end
  1236.                        else begin
  1237.                              AddTObjMod(rel.Entry);
  1238.                              tmpF^.Flags := tmpF^.Flags and (not nerRTyp) or nrRent;
  1239.                             end;
  1240.             nerROrd : begin
  1241.                        AddTObjMod(rel.ModIndx);
  1242.                        tmpF^.Target.extRef.Ord := rel.Proc;
  1243.                       end;
  1244.             nerRNam : begin
  1245.                        K := 0;
  1246.                        For J := 1 to ImportM^.Count do
  1247.                         if Word16(ImportM^.At(pred(J))) = rel.ModIndx
  1248.                          then begin
  1249.                                AddTObjMod(J);
  1250.                                Inc(K); break;
  1251.                               end;
  1252.                        For J := 1 to ImportP^.Count do
  1253.                         if Word16(ImportP^.At(pred(J))) = rel.Proc
  1254.                          then begin
  1255.                                L := 0;
  1256.                                if J > 1
  1257.                                 then repeat
  1258.                                       Dec(J);
  1259.                                       Inc(L, succ(length(pString(ImpProcTbl^.At(pred(J)))^)));
  1260.                                      until J <= 1;
  1261.                                tmpF^.Flags := tmpF^.Flags or nr32bitOff;
  1262.                                tmpF^.Target.extRef.Proc := L;
  1263.                                Inc(K); break;
  1264.                               end;
  1265.                        if K <> 2 then begin Dispose(tmpF); locFree; Exit; end;
  1266.                       end;
  1267.             nerROsf : begin
  1268.                     { Ignore OS fixups since they are not used in OS/2 - thanks Vallat! }
  1269.                        Dispose(tmpF);
  1270.                        tmpF := nil;
  1271.                       end;
  1272.            end;
  1273.  
  1274.          { handle fixup chains }
  1275.            if tmpF <> nil
  1276.             then repeat
  1277.                   case sType and nerSType of
  1278.                    nerSByte  : J := 1; { lo byte (8-bits)}
  1279.                    nerSSeg,            { 16-bit segment (16-bits) }
  1280.                    nerSoff   : J := 2; { 16-bit offset (16-bits) }
  1281.                    nerSPtr,            { 16:16 pointer (32-bits) }
  1282.                    nerOff32,           { 32-bit offset (32-bits) }
  1283.                    nerSOff32 : J := 4; { 32-bit self-relative offset (32-bits) }
  1284.                    nerPtr48  : J := 6; { 16:32 pointer (48-bits) }
  1285.                    else begin Dispose(tmpF); locFree; exit; end;
  1286.                   end;
  1287.  
  1288.                   K := pred(tmpF^.sOffs + J) div Header.lxPageSize;
  1289.                   J := tmpF^.sOffs div Header.lxPageSize;
  1290.  
  1291.                   Dec(tmpF^.sOffs, J * Header.lxPageSize);
  1292.  
  1293.                   if Flags and nerAdd <> 0 {Handle additive fixups}
  1294.                    then tmpF^.addFixup := GetChain(tmpF^.sOffs);
  1295.  
  1296.                   Fixup[J]^.Insert(tmpF);
  1297.                   if K <> J                        { If fixup crosses page boundary }
  1298.                    then begin
  1299.                          New(tmpF1);
  1300.                          Move(tmpF^, tmpF1^, sizeOf(tmpF1^));
  1301.                          Dec(tmpF1^.sOffs, Header.lxPageSize);
  1302.                          Fixup[K]^.Insert(tmpF1);
  1303.                         end;
  1304.                   if (sType and nerSType = nerSByte) or
  1305.                      (Flags and nerAdd <> 0)
  1306.                    then break;
  1307.                   L := GetChain(tmpF^.sOffs);
  1308.                   if L < $FFFF
  1309.                    then begin
  1310.                          New(tmpF1);
  1311.                          Move(tmpF^, tmpF1^, sizeOf(tmpF1^));
  1312.                          tmpF := tmpF1;
  1313.                          tmpF^.sOffs := L;
  1314.                         end
  1315.                    else break;
  1316.                  until FALSE;
  1317.           end;
  1318.    Inc(word(TmpPtr), 8);
  1319.   end;
  1320.  with ObjTable^[ObjNo] do
  1321.   For I := 0 to pred(oMapSize) do
  1322.    if not SetFixups(oPageMap + I, Fixup[I])
  1323.     then begin locFree; exit; end;
  1324.  locFree;
  1325.  ConvertRelocations := TRUE;
  1326. end;
  1327.  
  1328. begin
  1329.  freeModule;
  1330.  Res := lxeReadError;
  1331.  Assign(F, fName);
  1332.  New(EA, Fetch(fName));
  1333.  if EA = nil then begin Res := lxeEAreadError; GoTo locEx; end;
  1334.  I := FileMode; FileMode := open_share_DenyWrite;
  1335.  GetFAttr(F, FileAttr); Reset(F, 1); FileMode := I;
  1336.  if inOutRes <> 0 then GoTo locEx;
  1337.  Res := lxeBadFormat;
  1338.  L := 0; lastData := 0;
  1339.  fSz := FileSize(F);
  1340.  GetFTime(F, TimeStamp);
  1341.  repeat
  1342.   FillChar(neHdr, sizeOf(neHdr), 0);
  1343.   BlockRead(F, neHdr, sizeOf(neHdr));
  1344.   if inOutRes <> 0 then GoTo locEx;
  1345.   case neHdr.neMagic of
  1346.    lxMagic   : begin Res := lxeIsLXformat; GoTo locEx; end;
  1347.    neMagic   : break;
  1348.    exeMagic1,
  1349.    exeMagic2 : begin
  1350.                 if pLongArray(@neHdr)^[$0F] <= L then GoTo locEx;
  1351.                 L := pLongArray(@neHdr)^[$0F];
  1352.                 if L > fSz - sizeOf(neHdr) then GoTo locEx;
  1353.                 Seek(F, L); {Skip DOS stub}
  1354.                end;
  1355.    else GoTo locEx;
  1356.   end;
  1357.  until FALSE;
  1358.  if (not (neHdr.neExeTyp in [neUnknown,neOS2]))  {Not for OS/2}
  1359.   then begin Res := lxeBadOS; GoTo locEx; end;
  1360.  if (loadFlags and lneIgnoreBound = 0) and (neHdr.neFlags and neBound <> 0)
  1361.   then begin Res := lxeBoundApp; GoTo locEx; end;
  1362.  if (loadFlags and lneIgnoreLngName = 0) and (neHdr.neFlagsOthers and neLongFileNames = 0)
  1363.   then begin Res := lxeNoLongFnames; GoTo locEx; end;
  1364.  
  1365. { Read in DOS stub }
  1366.  stubSize := L; Seek(F, 0);
  1367.  GetMem(Stub, stubSize);
  1368.  BlockRead(F, Stub^, stubSize);
  1369.  updateLast;
  1370.  
  1371. { Convert header }
  1372.  with Header,neHdr do
  1373.   begin
  1374.    if neFlags and neI386 <> 0
  1375.     then lxCpu := lxCPU386
  1376.     else lxCpu := lxCPU286;
  1377.    lxMflags := neFlags and (neNotP + neIerr + neAppTyp + nePPLI);
  1378.    lxObjCnt := neCSeg;
  1379.    lxPageSize := lx386PageSize;
  1380.    lxPageShift := neAlign;
  1381.    lxRsrcCnt := neCRes;
  1382.    lxStartObj := neCSIP shr 16;         { Object # for instruction pointer }
  1383.    lxEIP := Word16(neCSIP);
  1384.    lxStackObj := neSSSP shr 16;         { Object # for stack pointer }
  1385.    lxESP := Word16(neSSSP);
  1386.    lxAutoData := neAutoData;            { Object # for automatic data object }
  1387.    lxHeapSize := neHeap;                { Size of heap - for 16-bit apps }
  1388.    lxStackSize := neStack;
  1389.   end;
  1390.  
  1391.  if (neHdr.neSegTab <> 0) and (stubSize + neHdr.neSegTab < fSz)
  1392.   then begin
  1393.         GetMem(neSeg, neHdr.neCSeg * sizeOf(tNEseg));
  1394.         Seek(F, stubSize + neHdr.neSegTab);
  1395.         BlockRead(F, neSeg^, neHdr.neCSeg * sizeOf(tNEseg));
  1396.         buff := Pointer(neSeg);
  1397.         UpdateLast;
  1398.        end
  1399.   else if neHdr.neCSeg <> 0 then GoTo locEx;
  1400.  
  1401. { Convert NE segments into LX pages }
  1402. { First count how many pages we`ll got }
  1403.  For I := 1 to neHdr.neCSeg do
  1404.   begin
  1405.    if (neSeg^.Flags and nesType > nesData) or
  1406.       (neSeg^.Flags and nesGDT <> 0) or
  1407.       (neSeg^.Flags and nesHuge <> 0)
  1408.     then begin
  1409.           FreeMem(buff, neHdr.neCSeg * sizeOf(tNEseg));
  1410.           Res := lxeIncompatNEseg;
  1411.           GoTo locEx;
  1412.          end;
  1413.    L := neSeg^.MinAlloc; if L = 0 then L := $10000;
  1414.    if (Header.lxESP = 0) and (Header.lxStackSize <> 0) and
  1415.       (I = Header.lxStackObj)
  1416.     then Inc(L, Header.lxStackSize);
  1417.    while L > 0 do
  1418.     begin
  1419.      Inc(Header.lxMpages);
  1420.      if L > Header.lxPageSize then Dec(L, Header.lxPageSize) else break;
  1421.     end;
  1422.    Inc(longint(neSeg), sizeOf(tNEseg));
  1423.   end;
  1424.  
  1425.  GetMem(FixRecSize, Header.lxMpages * sizeOf(Longint));
  1426.  GetMem(FixRecTbl, Header.lxMpages * sizeOf(Longint));
  1427.  FillChar(FixRecSize^, Header.lxMpages * sizeOf(Longint), 0);
  1428.  
  1429.  GetMem(ObjTable, neHdr.neCSeg * sizeOf(tObjTblRec));
  1430.  GetMem(Pages, sizeOf(Pointer) * Header.lxMpages);
  1431.  GetMem(PageOrder, Header.lxMpages * sizeOf(Longint));
  1432.  GetMem(ObjMap, sizeOf(tObjMapRec) * Header.lxMpages);
  1433.  
  1434. { Set page order to sequential }
  1435.  For I := 1 to Header.lxMpages do PageOrder^[pred(I)] := I;
  1436.  
  1437. { Now split segments into 4k pages }
  1438.  Pointer(neSeg) := buff; J := 0;
  1439.  For I := 1 to neHdr.neCSeg do
  1440.   begin
  1441.    with ObjTable^[I] do
  1442.     begin
  1443.      oSize := neSeg^.MinAlloc; if oSize = 0 then oSize := $10000;
  1444.      oBase := I * $10000;
  1445.      oPageMap := succ(J);
  1446.      oReserved := 0;
  1447.      oFlags := objAlias16 + objRead;
  1448.      L := neSeg^.Flags;
  1449.      if L and nesType = nesCode
  1450.       then oFlags := oFlags + objExec
  1451.       else oFlags := oFlags + objWrite;
  1452.      if L and nesShared <> 0
  1453.       then oFlags := oFlags + objShared;
  1454.      if L and nesPreload <> 0
  1455.       then oFlags := oFlags + objPreload;
  1456.      if L and nesExRdOnly <> 0
  1457.       then if oFlags and objExec <> 0
  1458.             then oFlags := oFlags and (not objRead)
  1459.             else oFlags := oFlags and (not objWrite);
  1460.      {Relocations will be converted later (see far below)}
  1461.      if L and nesConform <> 0
  1462.       then oFlags := oFlags or objConform;
  1463.      if L and nesDPL <> nesDPL
  1464.       then oFlags := oFlags or objIOPL;
  1465.      if L and nesDiscard <> 0
  1466.       then oFlags := oFlags or objDiscard;
  1467.      if L and nes32bit <> 0
  1468.       then oFlags := oFlags or objBigDef;
  1469.      siz := neSeg^.cbSeg;
  1470.      if (siz = 0) and (neSeg^.Sector <> 0) then siz := $10000;
  1471.      L := oSize;
  1472.      if neSeg^.Flags and nesIter <> 0
  1473.       then M := oSize + siz {size of temporary buffer}
  1474.       else M := siz;
  1475.      if (Header.lxESP = 0) and (Header.lxStackSize <> 0) and
  1476.         (I = Header.lxStackObj)
  1477.       then begin { Increment object size by stack size }
  1478.             Inc(L, Header.lxStackSize);
  1479.             Inc(oSize, Header.lxStackSize);
  1480.             Header.lxStackSize := 0;
  1481.             Header.lxESP := L;
  1482.            end;
  1483.      Seek(F, neSeg^.Sector shl neHdr.neAlign);
  1484.      GetMem(tmpBuff, M);
  1485.      BlockRead(F, tmpBuff^[M - siz], siz);
  1486.      updateLast;
  1487.      if neSeg^.Flags and nesIter <> 0
  1488.       then begin
  1489.             K := M - siz;
  1490.             if not UnpackMethod1(tmpBuff^[M - siz], tmpBuff^, siz, K)
  1491.              then begin
  1492.                    FreeMem(tmpBuff, M);
  1493.                    Res := lxeBadSegment;
  1494.                    Goto locEx;
  1495.                   end;
  1496.             siz := K;
  1497.            end;
  1498.      if siz > L
  1499.       then begin
  1500.             FreeMem(tmpBuff, M);
  1501.             Res := lxeBadSegment;
  1502.             Goto locEx;
  1503.            end;
  1504.     end;
  1505.    buffPos := 0;
  1506.    while L > 0 do
  1507.     begin
  1508.      if siz >= Header.lxPageSize then K := Header.lxPageSize else K := siz;
  1509.      with ObjMap^[succ(J)] do
  1510.       begin
  1511.        PageSize := K;
  1512.        PageFlags := pgValid;
  1513.        PageDataOffset := (neSeg^.Sector shl neHdr.neAlign) shr Header.lxPageShift;
  1514.       end;
  1515.      GetMem(Pages^[J], K);
  1516.      Move(tmpBuff^[buffPos], Pages^[J]^, K);
  1517.      Dec(siz, K); Inc(buffPos, K);
  1518.      if L > Header.lxPageSize then Dec(L, Header.lxPageSize) else L := 0;
  1519.      Inc(J);
  1520.     end;
  1521.    FreeMem(tmpBuff, M);
  1522.    with ObjTable^[I] do
  1523.     oMapSize := succ(J - oPageMap);
  1524.    Inc(longint(neSeg), sizeOf(tNEseg));
  1525.   end;
  1526.  
  1527. { Convert resident name table }
  1528.  New(ResNameTbl, Create(16, 16));
  1529.  if (neHdr.neResTab <> 0) and (stubSize + neHdr.neResTab < fSz)
  1530.   then begin
  1531.         Seek(F, stubSize + neHdr.neResTab);
  1532.         repeat
  1533.          BlockRead(F, S, sizeOf(Byte));
  1534.          if S = '' then break;
  1535.          BlockRead(F, S[1], length(S));
  1536.          New(NTR);
  1537.          NTR^.Name := NewStr(S);
  1538.          BlockRead(F, NTR^.Ord, sizeOf(Word16));
  1539.          ResNameTbl^.Insert(NTR);
  1540.         until inOutRes <> 0;
  1541.         updateLast;
  1542.        end;
  1543.  
  1544. { Convert non-resident name table }
  1545.  New(NResNameTbl, Create(16, 16));
  1546.  if (neHdr.neNResTab <> 0) and (stubSize + neHdr.neNResTab < fSz)
  1547.   then begin
  1548.         Seek(F, neHdr.neNResTab);
  1549.         repeat
  1550.          BlockRead(F, S, sizeOf(Byte));
  1551.          if S = '' then break;
  1552.          BlockRead(F, S[1], length(S));
  1553.          New(NTR);
  1554.          NTR^.Name := NewStr(S);
  1555.          BlockRead(F, NTR^.Ord, sizeOf(Word16));
  1556.          NResNameTbl^.Insert(NTR);
  1557.         until inOutRes <> 0;
  1558.         updateLast;
  1559.        end;
  1560.  
  1561. { Convert Entry Table }
  1562.  New(EntryTbl, Create(16, 16));
  1563.  if (neHdr.neCbEntTab <> 0) and (stubSize + neHdr.neEntTab < fSz)
  1564.   then begin
  1565.         Seek(F, stubSize + neHdr.neEntTab);
  1566.         L := neHdr.neCbEntTab; M := 1;
  1567.         repeat
  1568.          BlockRead(F, ETR.Count, sizeOf(ETR.Count));
  1569.          ETR.Obj := 0;
  1570.          BlockRead(F, ETR.Obj, 1);
  1571.          Dec(L, 1 + sizeOf(ETR.Count));
  1572.          if (ETR.Count = 0) or (L <= 0) then break;
  1573.          ETR.BndType := btEntry16;
  1574.          case ETR.Obj of
  1575.           $00 : Inc(M, ETR.Count);
  1576.           $FE : begin Res := lxeUnkEntBundle; Goto locEx; end;
  1577.           $FF : begin { Bundle of moveable entries }
  1578.                  GetMem(tmpBuff, ETR.Count * 6);
  1579.                  BlockRead(F, tmpBuff^, ETR.Count * 6);
  1580.                  Dec(L, ETR.Count * 6);
  1581.                  For I := 1 to ETR.Count do
  1582.                   begin
  1583.                    New(EP);
  1584.                    with pNEentryBundle(@tmpBuff^[pred(I) * 6])^, EP^ do
  1585.                     begin
  1586.                      Ordinal := M; Inc(M);
  1587.                      BndType := btEntry16;
  1588.                      Obj := Ref.movSegNo;
  1589.                      Entry.e16Flags := Flags;
  1590.                      Entry.e16Ofs := Ref.movOfs;
  1591.                     end;
  1592.                    EntryTbl^.Insert(EP);
  1593.                   end;
  1594.                  FreeMem(tmpBuff, ETR.Count * 6);
  1595.                 end;
  1596.           else begin
  1597.                 J := ETR.Count * fixEnt16;
  1598.                 GetMem(tmpBuff, J);
  1599.                 BlockRead(F, tmpBuff^, J);
  1600.                 Dec(L, J);
  1601.                 For I := 1 to ETR.Count do
  1602.                  begin
  1603.                   New(EP);
  1604.                   with pNEentryBundle(@tmpBuff^[pred(I) * fixEnt16])^, EP^ do
  1605.                    begin
  1606.                     Ordinal := M; Inc(M);
  1607.                     BndType := btEntry16;
  1608.                     Obj := ETR.Obj;
  1609.                     Entry.e16Flags := Flags;
  1610.                     Entry.e16Ofs := Ref.fixOfs;
  1611.                    end;
  1612.                   EntryTbl^.Insert(EP);
  1613.                  end;
  1614.                 FreeMem(tmpBuff, J);
  1615.                end;
  1616.          end;
  1617.         until (inOutRes <> 0) or (L <= 0);
  1618.         updateLast;
  1619.        end;
  1620.  
  1621. { Temporary read Module Reference Table }
  1622.  GetMem(ModRefTbl, neHdr.neCMod * sizeOf(Word16));
  1623.  if (neHdr.neModTab <> 0) and (stubSize + neHdr.neModTab < fSz)
  1624.   then begin
  1625.         Seek(F, stubSize + neHdr.neModTab);
  1626.         BlockRead(F, ModRefTbl^, neHdr.neCMod * sizeOf(Word16));
  1627.         updateLast;
  1628.        end;
  1629.  
  1630. { Convert Imported Names table }
  1631.  New(ImpModTbl, Create(16, 16));
  1632.  New(ImpProcTbl, Create(16, 16));
  1633.  New(ImportP, Create(16, 16));
  1634.  New(ImportM, Create(16, 16));
  1635.  if (neHdr.neImpTab <> 0) and (stubSize + neHdr.neImpTab < fSz)
  1636.   then begin
  1637.         Seek(F, stubSize + neHdr.neImpTab);
  1638.         I := neHdr.neEntTab - neHdr.neImpTab; L := 0;
  1639.         While (inOutRes = 0) and (I > 0) do
  1640.          begin
  1641.           BlockRead(F, S, sizeOf(Byte));
  1642.           BlockRead(F, S[1], length(S));
  1643.           K := 0;
  1644.           For J := 1 to neHdr.neCMod do
  1645.            if ModRefTbl^[pred(J)] = L
  1646.             then begin K := J; break; end;
  1647.           if S <> ''
  1648.            then
  1649.           if K <> 0
  1650.            then begin
  1651.                  ImpModTbl^.AtInsert(ImpModTbl^.Count, NewStr(S));
  1652.                  ImportM^.Insert(Pointer(K));
  1653.                 end
  1654.            else begin
  1655.                  ImpProcTbl^.AtInsert(ImpProcTbl^.Count, NewStr(S));
  1656.                  ImportP^.Insert(Pointer(L));
  1657.                 end;
  1658.           Inc(L, succ(length(S)));
  1659.           Dec(I, succ(length(S)));
  1660.          end;
  1661.         updateLast;
  1662.        end;
  1663.  
  1664. { Convert segment relocation info }
  1665.  Pointer(neSeg) := buff;
  1666.  For I := 1 to neHdr.neCSeg do
  1667.   begin
  1668.    if neSeg^.Flags and nesReloc <> 0
  1669.     then if not ConvertRelocations(I)
  1670.           then begin
  1671.                 Res := lxeBadFixupTable;
  1672.                 neSeg := nil;
  1673.                 break;
  1674.                end;
  1675.    Inc(longint(neSeg), sizeOf(tNEseg));
  1676.   end;
  1677.  packFixups(pkfFixups + pkfFixupsVer2);
  1678.  
  1679.  ImportM^.DeleteAll; Dispose(ImportM, Destroy);
  1680.  ImportP^.DeleteAll; Dispose(ImportP, Destroy);
  1681. { Free Module Reference Table }
  1682.  FreeMem(ModRefTbl, neHdr.neCMod * sizeOf(Word16));
  1683. { Free segment table }
  1684.  FreeMem(buff, neHdr.neCSeg * sizeOf(tNEseg));
  1685.  if neSeg = nil then Goto locEx; { ConvertRelocations() failed }
  1686.  
  1687. { Convert resource table }
  1688.  if (neHdr.neRsrcTab <> 0) and (stubSize + neHdr.neRsrcTab < fSz)
  1689.   then begin
  1690.         if (neHdr.neCRes > 0) and (loadFlags and lneIgnoreRsrc = 0)
  1691.          then begin Res := lxeResourcesInNE; Goto locEx; end;
  1692.         GetMem(RsrcTable, neHdr.neCRes * sizeOf(tResource));
  1693.         Seek(F, stubSize + neHdr.neRsrcTab);
  1694.         For I := 1 to neHdr.neCRes do
  1695.          with RsrcTable^[I] do
  1696.           begin
  1697.            J := neHdr.neCseg - neHdr.neCRes + I;   {Number of resource object}
  1698.            BlockRead(F, neRes, sizeOf(neRes));
  1699.            resType := neRes.resType;
  1700.            resName := neRes.resID;
  1701.            resObj  := J;
  1702.            resOffs := 0;   {since resources are located in different segments}
  1703.            with ObjTable^[J] do
  1704.             begin
  1705.              resSize := oSize;
  1706.              oFlags := oFlags or objResource;
  1707.             end;
  1708.           end;
  1709.         updateLast;
  1710.        end;
  1711.  
  1712.  if lastData < fSz
  1713.   then begin
  1714.         OverlaySize := fSz - lastData;
  1715.         GetMem(Overlay, OverlaySize);
  1716.         Seek(F, lastData);
  1717.         BlockRead(F, Overlay^, OverlaySize);
  1718.         if pWord16(Overlay)^ = neDebugMagic
  1719.          then begin
  1720.                DebugInfo := Overlay;
  1721.                Header.lxDebugLen := OverlaySize;
  1722.                Overlay := nil; OverlaySize := 0;
  1723.               end;
  1724.        end;
  1725.  
  1726.  if inOutRes <> 0 then GoTo locEx;
  1727.  Res := lxeOK;
  1728. locEx:
  1729.  if ioResult <> 0 then Res := lxeReadError;
  1730.  if Res <> lxeOK then freeModule;
  1731.  LoadNE := Res;
  1732.  Close(F); inOutRes := 0;
  1733. end;
  1734.  
  1735. function tLX.Save;
  1736. label locEx;
  1737. var
  1738.  F     : File;
  1739.  Res   : Byte;
  1740.  I,J,
  1741.  K,L   : Longint;
  1742.  pL    : pLong;
  1743.  NTR   : pNameTblRec;
  1744.  ETR   : tEntryTblRec;
  1745.  EP,NP : pEntryPoint;
  1746.  ZeroB : pByteArray;
  1747.  ZeroL : Longint;
  1748.  pS    : pString;
  1749. begin
  1750. { The following fields in Header must be set up before Save: }
  1751. { lxMpages      lxStartObj   lxEIP         lxStackObj
  1752.   lxESP         lxPageSize   lxPageShift   lxObjCnt
  1753.   lxRsrcCnt     lxDirCnt     lxAutoData }
  1754.  Header.lxFixupSum := 0;
  1755.  Header.lxLdrSum := 0;
  1756.  Header.lxNResSum := 0;
  1757.  {lxInstPreload := 0;{*}
  1758.  {lxInstDemand := 0;{*}
  1759.  {lxHeapSize := 0;{*}
  1760.  if SaveFlags and svfAlignEachObj = svfEOalnSector
  1761.   then begin
  1762.         SaveFlags := (SaveFlags and not svfAlignFirstObj) or svfFOalnSector;
  1763.         if Header.lxPageShift < 9 then Header.lxPageShift := 9;
  1764.        end;
  1765.  if (SaveFlags and svfAlignFirstObj = svfFOalnSector) and (Header.lxPageShift < 9)
  1766.   then ZeroL := 512
  1767.   else ZeroL := 1 shl Header.lxPageShift;
  1768.  
  1769. { Check LX flags }
  1770.  with Header do
  1771.   if ((lxMFlags and (lxLibInit or lxLibTerm) <> 0)) and
  1772.      ((lxStartObj = 0) or (lxStartObj >= lxObjCnt) or (lxEIP >= ObjTable^[lxStartObj].oSize))
  1773.    then lxMFlags := lxMFlags and (not (lxLibInit or lxLibTerm));
  1774.  
  1775.  GetMem(ZeroB, ZeroL);
  1776.  if ZeroB = nil then begin Res := lxeNoMemory; GoTo locEx; end;
  1777.  FillChar(ZeroB^, ZeroL, 0);
  1778.  
  1779.  Res := lxeOK; I := FileMode;
  1780.  FileMode := open_access_ReadWrite or open_share_DenyReadWrite;
  1781.  Assign(F, fName); SetFattr(F, 0); inOutRes := 0;
  1782.  Rewrite(F, 1); FileMode := I; if inOutRes <> 0 then Goto locEx;
  1783.  
  1784. { Write stub to file. }
  1785.  if (StubSize <> 0) and ((Stub = nil) or (StubSize < $40))
  1786.   then begin Res := lxeInvalidStub; Goto locEx; end;
  1787.  if (Stub <> nil)
  1788.   then begin
  1789.         pLongArray(Stub)^[$0F] := StubSize;
  1790.         BlockWrite(F, Stub^, StubSize);
  1791.        end;
  1792.  
  1793. { Temporary skip header }
  1794.  Seek(F, StubSize + sizeOf(Header));
  1795.  
  1796. { Write Object Table }
  1797.  if ObjTable <> nil
  1798.   then begin
  1799.         Header.lxObjTabOfs := FilePos(F) - StubSize;
  1800.         BlockWrite(F, ObjTable^, Header.lxObjCnt * sizeOf(tObjTblRec));
  1801.        end
  1802.   else Header.lxObjTabOfs := 0;
  1803.  
  1804. { Temporary skip Object Page Map Table }
  1805.  Seek(F, FilePos(F) + Header.lxMpages * sizeOf(tObjMapRec));
  1806.  
  1807. { Write resource table }
  1808.  if RsrcTable <> nil
  1809.   then begin
  1810.         Header.lxRsrcTabOfs := FilePos(F) - StubSize;
  1811.         BlockWrite(F, RsrcTable^, Header.lxRsrcCnt * sizeOf(tResource));
  1812.        end
  1813.   else Header.lxRsrcTabOfs := 0;
  1814.  
  1815. { Write resident name table }
  1816.  Header.lxResTabOfs := FilePos(F) - StubSize;
  1817.  For I := 1 to ResNameTbl^.Count do
  1818.   begin
  1819.    NTR := ResNameTbl^.At(pred(I));
  1820.    BlockWrite(F, NTR^.Name^, succ(length(NTR^.Name^)));
  1821.    BlockWrite(F, NTR^.Ord, sizeOf(Word16));
  1822.   end;
  1823.  I := 0; BlockWrite(F, I, sizeOf(Byte));
  1824.  
  1825. { Write module entry table }
  1826.  Header.lxEntTabOfs := FilePos(F) - StubSize;
  1827.  I := 1;
  1828.  While I <= EntryTbl^.Count do
  1829.   begin
  1830.    J := I;
  1831.    EP := pEntryPoint(EntryTbl^.At(pred(I)));
  1832.    if I > 1
  1833.     then begin
  1834.           NP := pEntryPoint(EntryTbl^.At(I-2));
  1835.           K := pred(EP^.Ordinal - NP^.Ordinal);
  1836.          end
  1837.     else K := pred(EP^.Ordinal);
  1838.    While K > 0 do
  1839.     begin
  1840.      ETR.Count := MinL(K, 255);
  1841.      ETR.BndType := btEmpty;
  1842.      BlockWrite(F, ETR, sizeOf(ETR.Count) + sizeOf(ETR.BndType));
  1843.      Dec(K, ETR.Count);
  1844.     end;
  1845.    K := EP^.Ordinal;
  1846.    repeat
  1847.     Inc(J); Inc(K);
  1848.     if (J > EntryTbl^.Count) or (J - I >= 255)
  1849.      then break;
  1850.     NP := pEntryPoint(EntryTbl^.At(pred(J)));
  1851.    until (NP^.Ordinal <> K) or
  1852.          (EP^.BndType <> NP^.BndType) or
  1853.         ((EP^.BndType <> btEmpty) and
  1854.          (EP^.Obj <> NP^.Obj));
  1855.    K := BundleRecSize(EP^.BndType);
  1856.    ETR.Count := J - I;
  1857.    ETR.BndType := EP^.BndType;
  1858.    ETR.Obj := EP^.Obj;
  1859.    if ETR.BndType = btEmpty
  1860.     then BlockWrite(F, ETR, sizeOf(ETR.Count) + sizeOf(ETR.BndType))
  1861.     else BlockWrite(F, ETR, sizeOf(ETR));
  1862.    While I < J do
  1863.     begin
  1864.      BlockWrite(F, pEntryPoint(EntryTbl^.At(pred(I)))^.Entry, K);
  1865.      Inc(I);
  1866.     end;
  1867.   end;
  1868.  ETR.Count := 0; BlockWrite(F, ETR.Count, sizeOf(ETR.Count));
  1869.  
  1870. { Write module directives table }
  1871.  if ModDirTbl <> nil
  1872.   then begin
  1873.         Header.lxDirTabOfs := FilePos(F) - StubSize;
  1874.         BlockWrite(F, ModDirTbl^, Header.lxDirCnt * sizeOf(tResource));
  1875.        end
  1876.   else Header.lxDirTabOfs := 0;
  1877.  
  1878. { Write per-page checksum }
  1879.  if PerPageCRC <> nil
  1880.   then begin
  1881.         Header.lxPageSumOfs := FilePos(F) - StubSize;
  1882.         BlockWrite(F, PerPageCRC^, Header.lxMpages * sizeOf(Longint));
  1883.        end
  1884.   else Header.lxPageSumOfs := 0;
  1885.  
  1886.  Header.lxLdrSize := FilePos(F) - Header.lxObjTabOfs - StubSize;
  1887.  
  1888. { Write page fixup table }
  1889.  L := FilePos(F);
  1890.  
  1891.  I := 0; BlockWrite(F, I, sizeOf(Longint));        {fixup offset for 1st page}
  1892.  For I := 1 to pred(Header.lxMpages) do             {convert sizes to offsets}
  1893.   Inc(FixRecSize^[I], FixRecSize^[pred(I)]);
  1894.  BlockWrite(F, FixRecSize^, Header.lxMpages * sizeOf(Longint));
  1895.  For I := pred(Header.lxMpages) downto 1 do    {convert back offsets to sizes}
  1896.   Dec(FixRecSize^[I], FixRecSize^[pred(I)]);
  1897.  
  1898. { Write fixup record table }
  1899.  Header.lxFRecTabOfs := FilePos(F) - StubSize;
  1900.  For I := 0 to pred(Header.lxMPages) do
  1901.   BlockWrite(F, FixRecTbl^[I]^, FixRecSize^[I]);
  1902.  
  1903. { Write imported modules table }
  1904.  Header.lxImpModOfs := FilePos(F) - StubSize;
  1905.  Header.lxImpModCnt := ImpModTbl^.Count;
  1906.  For I := 1 to Header.lxImpModCnt do
  1907.   begin
  1908.    pS := ImpModTbl^.At(pred(I));
  1909.    if pS <> nil
  1910.     then BlockWrite(F, pS^, succ(length(pS^)))
  1911.     else BlockWrite(F, ZeroB^, 1);
  1912.   end;
  1913.  
  1914. { Write imported procedures table }
  1915.  Header.lxImpProcOfs := FilePos(F) - StubSize;
  1916.  For I := 1 to ImpProcTbl^.Count do
  1917.   begin
  1918.    pS := ImpProcTbl^.At(pred(I));
  1919.    if pS <> nil
  1920.     then BlockWrite(F, pS^, succ(length(pS^)))
  1921.     else BlockWrite(F, ZeroB^, 1);
  1922.   end;
  1923.  
  1924. { Calculate fixup section size }
  1925.  Header.lxFPageTabOfs := L - StubSize;
  1926.  Header.lxFixupSize := FilePos(F) - L;
  1927.  
  1928. { Now write the data/code pages }
  1929.  L := FilePos(F);
  1930.  case SaveFlags and svfAlignFirstObj of
  1931.   svfFOalnNone   : I := L;
  1932.   svfFOalnShift  : I := (L + pred(1 shl Header.lxPageShift)) and
  1933.                         ($FFFFFFFF shl Header.lxPageShift);
  1934.   svfFOalnSector : I := (L + 511) and $FFFFFE00;
  1935.  end;
  1936.  BlockWrite(F, ZeroB^, I - L);
  1937.  
  1938.  Header.lxDataPageOfs := 0;
  1939.  Header.lxIterMapOfs := 0;
  1940.  Header.lxDataPageOfs := FilePos(F);
  1941.  For I := 1 to Header.lxMpages do
  1942.   begin
  1943.    K := PageOrder^[pred(I)];
  1944.    with ObjMap^[K] do
  1945.     begin
  1946.      case PageFlags of
  1947.       pgValid     : pL := @Header.lxDataPageOfs;
  1948.       pgIterData,
  1949.       pgIterData2 : begin
  1950.                      Header.lxIterMapOfs := Header.lxDataPageOfs;
  1951.                      pL := @Header.lxIterMapOfs;
  1952.                     end;
  1953.       pgInvalid,
  1954.       pgZeroed    : pL := nil;
  1955.       else{pgRange} begin Res := lxeUnkPageFlags; GoTo locEx; end;
  1956.      end;
  1957.      if pL <> nil
  1958.       then begin
  1959.             if (Pages^[pred(K)] = nil) and (PageSize <> 0)
  1960.              then begin Res := lxeInvalidPage; GoTo locEx; end;
  1961.             J := FilePos(F);
  1962.             L := (J - pL^ + pred(1 shl Header.lxPageShift)) and
  1963.                  ($FFFFFFFF shl Header.lxPageShift);
  1964.             if pL^ + L > J then BlockWrite(F, ZeroB^, pL^ + L - J);
  1965.             PageDataOffset := L shr Header.lxPageShift;
  1966.             BlockWrite(F, Pages^[pred(K)]^, PageSize);
  1967.            end
  1968.       else PageDataOffset := 0;
  1969.     end;
  1970.   end;
  1971.  
  1972. { And now write the non-resident names table }
  1973.  if NResNameTbl^.Count > 0
  1974.   then begin
  1975.         Header.lxNResTabOfs := FilePos(F);
  1976.         For I := 1 to NResNameTbl^.Count do
  1977.          begin
  1978.           NTR := NResNameTbl^.At(pred(I));
  1979.           BlockWrite(F, NTR^.Name^, succ(length(NTR^.Name^)));
  1980.           BlockWrite(F, NTR^.Ord, sizeOf(Word16));
  1981.          end;
  1982.         I := 0; BlockWrite(F, I, sizeOf(Byte));
  1983.         Header.lxCbNResTabOfs := FilePos(F) - Header.lxNResTabOfs;
  1984.        end
  1985.   else begin
  1986.         Header.lxNResTabOfs := 0;
  1987.         Header.lxCbNResTabOfs := 0;
  1988.        end;
  1989.  
  1990.  if Header.lxDebugInfoOfs <> 0
  1991.   then begin
  1992.         Header.lxDebugInfoOfs := FilePos(F);
  1993.         BlockWrite(F, DebugInfo^, Header.lxDebugLen);
  1994.        end
  1995.   else Header.lxDebugLen := 0;
  1996.  
  1997.  if OverlaySize <> 0
  1998.   then BlockWrite(F, Overlay^, OverlaySize);
  1999.  
  2000.  Seek(F, StubSize + sizeOf(Header) + Header.lxObjCnt * sizeOf(tObjTblRec));
  2001. { Now write Object Page Map Table }
  2002.  if ObjMap <> nil
  2003.   then begin
  2004.         Header.lxObjMapOfs := FilePos(F) - StubSize;
  2005.         BlockWrite(F, ObjMap^, Header.lxMpages * sizeOf(tObjMapRec));
  2006.        end
  2007.   else Header.lxObjMapOfs := 0;
  2008.  
  2009. { Now seek to beginning and write the LX header }
  2010.  Seek(F, StubSize);
  2011.  BlockWrite(F, Header, sizeOf(Header));
  2012.  
  2013. locEx:
  2014.  if ZeroB <> nil then FreeMem(ZeroB, ZeroL);
  2015.  if ioResult <> 0 then Res := lxeWriteError;
  2016.  if TimeStamp <> 0 then SetFTime(F, TimeStamp);
  2017.  Save := Res;  Close(F); inOutRes := 0;
  2018.  if (Res = lxeOK) and (not EA^.Attach(fName))
  2019.   then Save := lxeEAwriteError
  2020.   else SetFattr(F, FileAttr);
  2021. end;
  2022.  
  2023. procedure tLX.freeModule;
  2024. var
  2025.  I   : Longint;
  2026.  NTR : pNameTblRec;
  2027.  EBR : pEntryTblRec;
  2028. begin
  2029.  if PageOrder <> nil
  2030.   then FreeMem(PageOrder, Header.lxMpages * sizeOf(Pointer));
  2031.  
  2032.  if Pages <> nil
  2033.   then begin
  2034.         For I := 1 to Header.lxMpages do
  2035.          if Pages^[pred(I)] <> nil
  2036.           then FreeMem(Pages^[pred(I)], ObjMap^[I].PageSize);
  2037.         FreeMem(Pages, Header.lxMpages * sizeOf(Pointer));
  2038.        end;
  2039.  
  2040.  if FixRecTbl <> nil
  2041.   then begin
  2042.         For I := 1 to Header.lxMPages do
  2043.          FreeMem(FixRecTbl^[pred(I)], FixRecSize^[pred(I)]);
  2044.         FreeMem(FixRecTbl, Header.lxMpages * sizeOf(Longint));
  2045.        end;
  2046.  
  2047.  if ImpProcTbl <> nil
  2048.   then Dispose(ImpProcTbl, Destroy);
  2049.  
  2050.  if ImpModTbl <> nil
  2051.   then Dispose(ImpModTbl, Destroy);
  2052.  
  2053.  if FixRecSize <> nil
  2054.   then FreeMem(FixRecSize, Header.lxMpages * sizeOf(Longint));
  2055.  
  2056.  if PerPageCRC <> nil
  2057.   then FreeMem(PerPageCRC, Header.lxMpages * sizeOf(Longint));
  2058.  
  2059.  if ModDirTbl <> nil
  2060.   then FreeMem(ModDirTbl, Header.lxDirCnt * sizeOf(tResource));
  2061.  
  2062.  if EntryTbl <> nil
  2063.   then Dispose(EntryTbl, Destroy);
  2064.  
  2065.  if NResNameTbl <> nil
  2066.   then Dispose(NResNameTbl, Destroy);
  2067.  
  2068.  if ResNameTbl <> nil
  2069.   then Dispose(ResNameTbl, Destroy);
  2070.  
  2071.  if RsrcTable <> nil
  2072.   then FreeMem(RsrcTable, Header.lxRsrcCnt * sizeOf(tResource));
  2073.  
  2074.  if ObjMap <> nil
  2075.   then FreeMem(ObjMap, Header.lxMpages * sizeOf(tObjMapRec));
  2076.  
  2077.  if ObjTable <> nil
  2078.   then FreeMem(ObjTable, Header.lxObjCnt * sizeOf(tObjTblRec));
  2079.  
  2080.  if stubSize <> 0
  2081.   then FreeMem(Stub, StubSize);
  2082.  
  2083.  if OverlaySize <> 0
  2084.   then FreeMem(Overlay, OverlaySize);
  2085.  
  2086.  if EA <> nil then Dispose(EA, Destroy);
  2087.  Initialize;
  2088. end;
  2089.  
  2090. function tLX.BundleRecSize;
  2091. begin
  2092.  case BndType of
  2093.   btEmpty    : BundleRecSize := 0;
  2094.   btEntry16  : BundleRecSize := fixEnt16;
  2095.   btGate16   : BundleRecSize := gateEnt16;
  2096.   btEntry32  : BundleRecSize := fixEnt32;
  2097.   btEntryFwd : BundleRecSize := fwdEnt;
  2098.   else BundleRecSize := -1;
  2099.  end;
  2100. end;
  2101.  
  2102. function tLX.SetFixups;
  2103. var
  2104.  Fix    : pByteArray;
  2105.  I,FixAlloc,
  2106.  FixLen : Integer;
  2107.  FixPos,
  2108.  FixSz  : Longint;
  2109.  FixTbl : pByteArray;
  2110.  
  2111. procedure FreeFix;
  2112. begin
  2113.  FreeMem(Fix, FixAlloc);
  2114.  FixAlloc := 0;
  2115. end;
  2116.  
  2117. function PackFixup(Fixup : pLXreloc) : boolean;
  2118.  
  2119. procedure Put8(B : Byte);
  2120. begin
  2121.  pByte(@Fix^[FixLen])^ := B;
  2122.  Inc(FixLen, sizeOf(Byte));
  2123. end;
  2124.  
  2125. procedure Put16(W : Word16);
  2126. begin
  2127.  pWord16(@Fix^[FixLen])^ := W;
  2128.  Inc(FixLen, sizeOf(Word16));
  2129. end;
  2130.  
  2131. procedure Put32(L : Word32);
  2132. begin
  2133.  pWord32(@Fix^[FixLen])^ := L;
  2134.  Inc(FixLen, sizeOf(Word32));
  2135. end;
  2136.  
  2137. procedure PutIntRef;
  2138. begin
  2139.  with Fixup^ do
  2140.   if Target.intRef and $FFFF0000 = 0
  2141.    then begin
  2142.          Flags := Flags and (not nr32bitOff);
  2143.          Put16(Target.intRef);
  2144.         end
  2145.    else begin
  2146.          Flags := Flags or nr32bitOff;
  2147.          Put32(Target.intRef);
  2148.         end;
  2149. end;
  2150.  
  2151. procedure PutAddFixup;
  2152. begin
  2153.  with Fixup^ do
  2154.   if Flags and nrAdd <> 0
  2155.    then if AddFixup = 0
  2156.          then Flags := Flags and (not nrAdd)
  2157.          else
  2158.         if AddFixup and $FFFF0000 = 0
  2159.          then begin
  2160.                Flags := Flags and (not nr32bitAdd);
  2161.                Put16(AddFixup);
  2162.               end
  2163.          else begin
  2164.                Flags := Flags or nr32bitAdd;
  2165.                Put32(AddFixup);
  2166.               end;
  2167. end;
  2168.  
  2169. var
  2170.  I : Integer;
  2171. begin
  2172.  PackFixup := FALSE;
  2173.  if Fixup = nil then exit;
  2174.  with Fixup^ do
  2175.   begin
  2176.    I := 64;
  2177.    if sType and nrChain <> 0
  2178.     then Inc(I, targetCount * 2);
  2179.    if I > FixAlloc
  2180.     then begin
  2181.           FreeFix; FixAlloc := I;
  2182.           GetMem(Fix, FixAlloc);
  2183.          end;
  2184.    if Fix = nil then exit;
  2185.    FixLen := 0;
  2186.    Put8(sType);
  2187.    Put8(Flags);
  2188.    if sType and nrChain = 0
  2189.     then Put16(sOffs)
  2190.     else begin
  2191.           if targetCount > 255 then exit;
  2192.           Put8(targetCount);
  2193.          end;
  2194.  
  2195.    if (Flags and (nrAdd + nrRtype) = (nrAdd + nrRint))
  2196.     then begin
  2197.           if sType and nrSType = nrSSeg
  2198.            then Inc(ObjMod, AddFixup)
  2199.            else Inc(Target.intRef, AddFixup);
  2200.           Flags := Flags and (not nrAdd);
  2201.          end;
  2202.  
  2203.    if ObjMod and $FFFFFF00 = 0
  2204.     then begin
  2205.           Flags := Flags and (not nr16objMod);
  2206.           Put8(ObjMod);
  2207.          end
  2208.     else begin
  2209.           Flags := Flags or nr16objMod;
  2210.           Put16(ObjMod);
  2211.          end;
  2212.  
  2213.    case Flags and nrRtype of
  2214.     nrRint:
  2215.      begin
  2216.       if sType and nrSType <> nrSSeg
  2217.        then PutIntRef;
  2218.       PutAddFixup;
  2219.      end;
  2220.     nrRord:
  2221.      begin
  2222.       if Target.extRef.Ord and $FFFFFF00 = 0
  2223.        then begin
  2224.              Flags := Flags or nr8bitOrd and (not nr32bitOff);
  2225.              Put8(Target.extRef.Ord);
  2226.             end
  2227.        else
  2228.       if Target.extRef.Ord and $FFFF0000 = 0
  2229.        then begin
  2230.              Flags := Flags and (not nr8bitOrd) and (not nr32bitOff);
  2231.              Put16(Target.extRef.Ord);
  2232.             end
  2233.        else begin
  2234.              Flags := Flags and (not nr8bitOrd) or nr32bitOff;
  2235.              Put32(Target.extRef.Ord);
  2236.             end;
  2237.       PutAddFixup;
  2238.      end;
  2239.     nrRnam:
  2240.      begin
  2241.       if Target.extRef.Proc and $FFFF0000 = 0
  2242.        then begin
  2243.              Flags := Flags and (not nr32bitOff);
  2244.              Put16(Target.extRef.Proc);
  2245.             end
  2246.        else begin
  2247.              Flags := Flags or nr32bitOff;
  2248.              Put32(Target.extRef.Proc);
  2249.             end;
  2250.       PutAddFixup;
  2251.      end;
  2252.     nrRent:
  2253.      begin
  2254.       PutAddFixup;
  2255.      end;
  2256.    end;
  2257.    Fix^[1] := Flags; {Update flags}
  2258.    if sType and nrChain <> 0
  2259.     then For I := 1 to targetCount do Put16(targets^[pred(I)]);
  2260.   end;
  2261.  PackFixup := TRUE;
  2262. end;
  2263.  
  2264. begin
  2265.  SetFixups := FALSE;
  2266.  if (PageNo = 0) or (PageNo > Header.lxMPages) then exit;
  2267. { Count overall fixup size }
  2268.  FixSz := 0; FixAlloc := 0;
  2269.  For I := 1 to Fixups^.Count do
  2270.   if PackFixup(Fixups^.At(pred(I)))
  2271.    then Inc(FixSz, FixLen)
  2272.    else begin FreeFix; exit; end;
  2273.  GetMem(FixTbl, FixSz);
  2274.  if (FixSz <> 0) and (FixTbl = nil) then begin FreeFix; exit; end;
  2275.  FixPos := 0;
  2276.  For I := 1 to Fixups^.Count do
  2277.   begin
  2278.    PackFixup(Fixups^.At(pred(I)));
  2279.    Move(Fix^, FixTbl^[FixPos], FixLen);
  2280.    Inc(FixPos, FixLen);
  2281.   end;
  2282.  FreeFix;
  2283.  
  2284.  if FixRecSize^[pred(PageNo)] <> 0
  2285.   then FreeMem(FixRecTbl^[pred(PageNo)], FixRecSize^[pred(PageNo)]);
  2286.  FixRecSize^[pred(PageNo)] := FixSz;
  2287.  FixRecTbl^[pred(PageNo)] := FixTbl;
  2288.  
  2289.  SetFixups := TRUE;
  2290. end;
  2291.  
  2292. function tLX.FixupsSize;
  2293. var
  2294.  Fix    : pByteArray;
  2295.  I,FixAlloc,
  2296.  FixLen : Integer;
  2297.  FixPos,
  2298.  FixSz  : Longint;
  2299.  FixTbl : pByteArray;
  2300.  
  2301. function PackFixup(Fixup : pLXreloc) : boolean;
  2302.  
  2303. procedure PutIntRef;
  2304. begin
  2305.  with Fixup^ do
  2306.   if Target.intRef and $FFFF0000 = 0
  2307.    then Inc(FixLen, sizeOf(Word16))
  2308.    else Inc(FixLen, sizeOf(Word32));
  2309. end;
  2310.  
  2311. procedure PutAddFixup;
  2312. begin
  2313.  with Fixup^ do
  2314.   if (Flags and nrAdd <> 0) and (AddFixup <> 0)
  2315.    then if AddFixup and $FFFF0000 = 0
  2316.          then Inc(FixLen, sizeOf(Word16))
  2317.          else Inc(FixLen, sizeOf(Word32));
  2318. end;
  2319.  
  2320. var
  2321.  I : Integer;
  2322. begin
  2323.  PackFixup := FALSE;
  2324.  if Fixup = nil then exit;
  2325.  with Fixup^ do
  2326.   begin
  2327.    FixLen := sizeOf(Byte) * 2;
  2328.    if sType and nrChain = 0
  2329.     then Inc(FixLen, sizeOf(Word16))
  2330.     else Inc(FixLen, sizeOf(Byte));
  2331.  
  2332.    if ObjMod and $FFFFFF00 = 0
  2333.     then Inc(FixLen, sizeOf(Byte))
  2334.     else Inc(FixLen, sizeOf(Word16));
  2335.  
  2336.    case Flags and nrRtype of
  2337.     nrRint:
  2338.      begin
  2339.       if sType and nrSType <> nrSSeg
  2340.        then PutIntRef;
  2341.       PutAddFixup;
  2342.      end;
  2343.     nrRord:
  2344.      begin
  2345.       if Target.extRef.Ord and $FFFFFF00 = 0
  2346.        then Inc(FixLen, sizeOf(Byte))
  2347.        else
  2348.       if Target.extRef.Ord and $FFFF0000 = 0
  2349.        then Inc(FixLen, sizeOf(Word16))
  2350.        else Inc(FixLen, sizeOf(Word32));
  2351.       PutAddFixup;
  2352.      end;
  2353.     nrRnam:
  2354.      begin
  2355.       if Target.extRef.Proc and $FFFF0000 = 0
  2356.        then Inc(FixLen, sizeOf(Word16))
  2357.        else Inc(FixLen, sizeOf(Word32));
  2358.       PutAddFixup;
  2359.      end;
  2360.     nrRent:
  2361.      begin
  2362.       PutAddFixup;
  2363.      end;
  2364.    end;
  2365.    if sType and nrChain <> 0
  2366.     then Inc(FixLen, targetCount * sizeOf(Word16));
  2367.   end;
  2368.  PackFixup := TRUE;
  2369. end;
  2370.  
  2371. begin
  2372.  FixupsSize := 0;
  2373. { Count overall fixup size }
  2374.  FixSz := 0;
  2375.  For I := 1 to Fixups^.Count do
  2376.   if PackFixup(Fixups^.At(pred(I)))
  2377.    then Inc(FixSz, FixLen)
  2378.    else exit;
  2379.  FixupsSize := FixSz;
  2380. end;
  2381.  
  2382. function tLX.GetFixups;
  2383. var
  2384.  FixTbl : pByteArray;
  2385.  FixSz  : Longint;
  2386.  newFix,
  2387.  Fix    : pLXreloc;
  2388.  ST,SF  : Byte;
  2389.  baseSet: boolean;
  2390.  Src,Base,
  2391.  I,fixCount,
  2392.  Next   : longint;
  2393.  Page   : pByteArray;
  2394.  
  2395. function Get8 : Byte;
  2396. begin
  2397.  Get8 := FixTbl^[0];
  2398.  Inc(Longint(FixTbl));
  2399.  Dec(FixSz);
  2400. end;
  2401.  
  2402. function Get16 : Word16;
  2403. begin
  2404.  Get16 := pWord16(@FixTbl^[0])^;
  2405.  Inc(Longint(FixTbl), 2);
  2406.  Dec(FixSz, 2);
  2407. end;
  2408.  
  2409. function Get32 : Word32;
  2410. begin
  2411.  Get32 := pWord32(@FixTbl^[0])^;
  2412.  Inc(Longint(FixTbl), 4);
  2413.  Dec(FixSz, 4);
  2414. end;
  2415.  
  2416. procedure GetIntRef;
  2417. begin
  2418.  with Fix^ do
  2419.   if Flags and nr32bitOff = 0
  2420.    then Target.intRef := Get16
  2421.    else Target.intRef := Get32;
  2422. end;
  2423.  
  2424. procedure GetAddFixup;
  2425. begin
  2426.  with Fix^ do
  2427.   if Flags and nrAdd <> 0
  2428.    then if Flags and nr32bitAdd = 0
  2429.          then AddFixup := Get16
  2430.          else AddFixup := Get32;
  2431. end;
  2432.  
  2433. begin
  2434.  GetFixups := FALSE;
  2435.  FixSz := FixRecSize^[pred(PageNo)];
  2436.  FixTbl := FixRecTbl^[pred(PageNo)];
  2437.  While FixSz > 0 do
  2438.   begin
  2439.    ST := Get8;
  2440.    SF := Get8;
  2441.    New(Fix);
  2442.    if Fix = nil then exit;
  2443.    Fix^.sType := ST;
  2444.    Fix^.Flags := SF;
  2445.  
  2446.    if ST and nrChain <> 0
  2447.     then Fix^.targetCount := Get8
  2448.     else Fix^.sOffs := Get16;
  2449.  
  2450.    if SF and nr16objMod = 0
  2451.     then Fix^.ObjMod := Get8
  2452.     else Fix^.ObjMod := Get16;
  2453.  
  2454.    case SF and nrRType of
  2455.     nrRInt : begin
  2456.               if ST and nrSType <> nrSSeg
  2457.                then GetIntRef;
  2458.               GetAddFixup;
  2459.              end;
  2460.     nrROrd : begin
  2461.               if SF and nr8bitOrd <> 0
  2462.                then Fix^.Target.extRef.Ord := Get8
  2463.                else
  2464.               if SF and nr32bitOff = 0
  2465.                then Fix^.Target.extRef.Ord := Get16
  2466.                else Fix^.Target.extRef.Ord := Get32;
  2467.               GetAddFixup;
  2468.              end;
  2469.     nrRNam : begin
  2470.               if SF and nr32bitOff = 0
  2471.                then Fix^.Target.extRef.Proc := Get16
  2472.                else Fix^.Target.extRef.Proc := Get32;
  2473.               GetAddFixup;
  2474.              end;
  2475.     nrRent : GetAddFixup;
  2476.     else begin Dispose(Fix); exit; end;
  2477.    end;
  2478.  
  2479.    if ST and nrChain <> 0
  2480.     then begin
  2481.           GetMem(Fix^.targets, Fix^.targetCount * sizeOf(Word16));
  2482.           Move(FixTbl^, Fix^.targets^, Fix^.targetCount * sizeOf(Word16));
  2483.           Inc(Longint(FixTbl), Fix^.targetCount * sizeOf(Word16));
  2484.           Dec(FixSz, Fix^.targetCount * sizeOf(Word16));
  2485.          end;
  2486.  
  2487.    if SF and nrNewChain <> 0
  2488.     then with ObjMap^[PageNo] do
  2489.           begin
  2490.            if ((Fix^.Flags and nrRType) <> nrRInt) or
  2491.               ((Fix^.sType and nrChain) <> 0)
  2492.             then exit;
  2493.            if PageFlags <> pgValid
  2494.             then UnpackPage(PageNo);
  2495.            if (PageFlags <> pgValid)
  2496.             then exit;
  2497.            Page := Pages^[pred(PageNo)];
  2498.            Src := Fix^.sOffs;
  2499.            baseSet := FALSE;
  2500.            fixCount := succ(Fixups^.Count);
  2501.            repeat
  2502.             Next := 0;
  2503.             Move(Page^[Src], Next, MinL(4, PageSize - Src));
  2504.             FillChar(Page^[Src], MinL(4, PageSize - Src), 0);
  2505.             if not baseSet
  2506.              then begin
  2507.                    Base := Fix^.Target.intRef - (Next and $FFFFF);
  2508.                    baseSet := TRUE;
  2509.                   end;
  2510.             For I := fixCount to Fixups^.Count do
  2511.              if pLXreloc(Fixups^.At(pred(I)))^.sOffs = Src
  2512.               then begin I := -1; break; end;
  2513.             if (I = -1) or (succ(Fixups^.Count - fixCount) > Header.lxPageSize div 4)
  2514.              then break; {we have a loop or error here}
  2515.             New(newFix); newFix^ := Fix^;
  2516.             newFix^.sOffs := Src;
  2517.             newFix^.Target.intRef := Base + (Next and $FFFFF);
  2518.             newFix^.Flags := newFix^.Flags and (not nrNewChain);
  2519.             Fixups^.Insert(newFix);
  2520.             Src := Next shr 20;
  2521.            until Src > Header.lxPageSize - 4;
  2522.            Dispose(Fix);
  2523.           end
  2524.     else Fixups^.Insert(Fix);
  2525.   end;
  2526.  GetFixups := FixSz = 0;
  2527. end;
  2528.  
  2529. procedure tLX.PackFixups;
  2530. var
  2531.  pgTop,
  2532.  tmpPF,
  2533.  P  : Integer;
  2534.  aFx,
  2535.  Fx : pFixupCollection;
  2536.  nP : pByteArray;
  2537.  
  2538. procedure packVer2;
  2539. var
  2540.  I,J   : Integer;
  2541.  F1,F2 : pLXreloc;
  2542.  fixT  : pWord16array;
  2543. begin
  2544.  For I := Fx^.Count downto 2 do
  2545.   begin
  2546.    F2 := Fx^.At(pred(I));
  2547.    For J := pred(I) downto 1 do
  2548.     begin
  2549.      F1 := Fx^.At(pred(J));
  2550.      if (F1^.sType and (not nrChain) = F2^.sType and (not nrChain)) and
  2551.         (F1^.Flags = F2^.Flags) and (F1^.Flags and nrNewChain = 0) and
  2552.         (F1^.ObjMod = F2^.ObjMod)
  2553.       then begin
  2554.           { Check more deeply }
  2555.             case F1^.Flags and nrRType of
  2556.              nerRInt : if ((F1^.sType and nrSType <> nrSSeg) and
  2557.                            (F1^.Target.intRef <> F2^.Target.intRef)) or
  2558.                           ((F1^.Flags and nrAdd <> 0) and
  2559.                            (F1^.addFixup <> F2^.addFixup))
  2560.                         then Continue;
  2561.              nerROrd : if (F1^.Target.extRef.Ord <> F2^.Target.extRef.Ord) or
  2562.                           ((F1^.Flags and nrAdd <> 0) and
  2563.                            (F1^.addFixup <> F2^.addFixup))
  2564.                         then Continue;
  2565.              nerRNam : if (F1^.Target.extRef.Proc <> F2^.Target.extRef.Proc) or
  2566.                           ((F1^.Flags and nrAdd <> 0) and
  2567.                            (F1^.addFixup <> F2^.addFixup))
  2568.                         then Continue;
  2569.              nrRent  : if ((F1^.Flags and nrAdd <> 0) and
  2570.                            (F1^.addFixup <> F2^.addFixup))
  2571.                         then Continue;
  2572.             end;
  2573.           { join these fixups together }
  2574.             if F1^.sType and nrChain = 0
  2575.              then begin
  2576.                    F1^.targetCount := 1;
  2577.                    F1^.targets := @F1^.sOffs;
  2578.                   end;
  2579.             if F2^.sType and nrChain = 0
  2580.              then begin
  2581.                    F2^.targetCount := 1;
  2582.                    F2^.targets := @F2^.sOffs;
  2583.                   end;
  2584.             if F1^.targetCount + F2^.targetCount > 255 then Continue;
  2585.             GetMem(fixT, (F1^.targetCount + F2^.targetCount) * sizeOf(Word16));
  2586.             Move(F1^.targets^, fixT^, F1^.targetCount * sizeOf(Word16));
  2587.             Move(F2^.targets^, fixT^[F1^.targetCount], F2^.targetCount * sizeOf(Word16));
  2588.             if F1^.sType and nrChain <> 0
  2589.              then FreeMem(F1^.targets, F1^.targetCount * sizeOf(Word16));
  2590.             F1^.sType := F1^.sType or nrChain;
  2591.             Inc(F1^.targetCount, F2^.targetCount);
  2592.             F1^.targets := fixT;
  2593.             Fx^.AtFree(pred(I));
  2594.             break;
  2595.            end;
  2596.     end;
  2597.   end;
  2598. end;
  2599.  
  2600. procedure packVer4;
  2601. var
  2602.  I,J,K,L : Integer;
  2603.  sO      : Word16;
  2604.  F1,F2   : pLXreloc;
  2605.  FixMax,
  2606.  FixBase : pLongArray;
  2607.  
  2608. function GetL(Offs : Word16) : Longint;
  2609. begin
  2610.  if (Offs < pgTop)
  2611.   then GetL := pLong(@pByteArray(Pages^[pred(P)])^[Offs])^
  2612.   else GetL := -1;
  2613. end;
  2614.  
  2615. function SetL(Offs : Word16; Value : Longint) : boolean;
  2616. begin
  2617.  if (Offs < pgTop)
  2618.   then begin
  2619.         pLong(@pByteArray(Pages^[pred(P)])^[Offs])^ := Value;
  2620.         SetL := TRUE;
  2621.        end
  2622.   else SetL := FALSE;
  2623. end;
  2624.  
  2625. function Prepare(Fixup : pLXreloc) : boolean;
  2626. var
  2627.  K  : Integer;
  2628.  nF : pLXreloc;
  2629.  pW : pWord16Array;
  2630. begin
  2631.  Prepare := FALSE;
  2632.  if Fixup^.sType and nrChain = 0
  2633.   then begin
  2634.         Fixup^.targetCount := 1;
  2635.         Fixup^.targets := @Fixup^.sOffs;
  2636.        end;
  2637.  
  2638.  if Fixup^.Flags and nrNewChain = 0
  2639.   then begin
  2640.         sO := pred(Header.lxPageSize);
  2641.         For K := Fixup^.targetCount downto 1 do
  2642.          begin
  2643.           if not SetL(Fixup^.targets^[pred(K)], longint(sO) shl 20 + (Fixup^.Target.intRef - L))
  2644.            then begin
  2645.                  New(nF); Move(Fixup^, nF^, sizeOf(nF^));
  2646.                  nF^.sOffs := Fixup^.targets^[pred(K)];
  2647.                  nF^.sType := nF^.sType and (not nrChain);
  2648.                  Fx^.AtInsert(I, nF);
  2649.                  if Fixup^.targetCount > 1
  2650.                   then begin
  2651.                         GetMem(pW, pred(Fixup^.targetCount) * sizeOf(Word16));
  2652.                         Move(Fixup^.targets^, pW^, pred(K) * sizeOf(Word16));
  2653.                         Move(Fixup^.targets^[K], pW^[pred(K)], (Fixup^.targetCount - K) * sizeOf(Word16));
  2654.                         FreeMem(Fixup^.targets, Fixup^.targetCount * sizeOf(Word16));
  2655.                         Dec(Fixup^.targetCount); Fixup^.targets := pW;
  2656.                        end
  2657.                   else exit;
  2658.                 end
  2659.            else sO := Fixup^.targets^[pred(K)];
  2660.          end;
  2661.         if Fixup^.sType and nrChain <> 0
  2662.          then FreeMem(Fixup^.targets, Fixup^.targetCount * sizeOf(Word16));
  2663.         Fixup^.sOffs := sO;
  2664.         Fixup^.sType := Fixup^.sType and (not nrChain);
  2665.         Fixup^.Flags := Fixup^.Flags or nrNewChain;
  2666.        end;
  2667.  Prepare := TRUE;
  2668. end;
  2669.  
  2670. begin
  2671.  with ObjMap^[P] do
  2672.   if (PageFlags <> pgValid) or (PageSize <> Header.lxPageSize)
  2673.    then exit;
  2674.  
  2675.  GetMem(FixBase, sizeOf(longint) * Header.lxObjCnt);
  2676.  if FixBase = nil then exit;
  2677.  GetMem(FixMax, sizeOf(longint) * Header.lxObjCnt);
  2678.  if FixMax = nil then begin FreeMem(FixBase, sizeOf(longint) * Header.lxObjCnt); exit; end;
  2679.  FillChar(FixBase^, sizeOf(longint) * Header.lxObjCnt, $7F);
  2680.  FillChar(FixMax^, sizeOf(longint) * Header.lxObjCnt, 0);
  2681.  For I := 1 to Fx^.Count do
  2682.   begin
  2683.    F2 := Fx^.At(pred(I));
  2684.    with F2^ do
  2685.     if (sType and nrSType in [nrOff32,nrSoff32]) and
  2686.        (Flags and nrRtype = nrRint)
  2687.      then begin
  2688.            K := Target.intRef;
  2689.           {F2^ _CANNOT_ point to a new-type fixup chain}
  2690.            if (sOffs < pgTop)
  2691.             then begin
  2692.                   if (K < FixBase^[pred(ObjMod)])
  2693.                    then FixBase^[pred(ObjMod)] := K;
  2694.                   if (K > FixMax^[pred(ObjMod)])
  2695.                    then FixMax^[pred(ObjMod)] := K;
  2696.                  end;
  2697.           end;
  2698.   end;
  2699.  For I := 0 to pred(Header.lxObjCnt) do
  2700.   if FixBase^[I] <> $7F7F7F7F
  2701.    then begin
  2702.          J := FixMax^[I] - FixBase^[I];
  2703.          K := $FFFFF - (J and $FFFFF);
  2704.          if FixBase^[I] > K
  2705.           then Dec(FixBase^[I], K)
  2706.           else FixBase^[I] := 0;
  2707.         end;
  2708.  FreeMem(FixMax, sizeOf(longint) * Header.lxObjCnt);
  2709.  
  2710.  For I := Fx^.Count downto 2 do
  2711.   begin
  2712.    F2 := Fx^.At(pred(I));
  2713.    if (not (F2^.sType and nrSType in [nrOff32,nrSoff32])) or
  2714.       (F2^.Flags and nrRtype <> nrRint)
  2715.     then Continue;
  2716.    if F2^.Flags and nrNewChain <> 0
  2717.     then L := F2^.Target.intRef - (GetL(F2^.sOffs) and $FFFFF)
  2718.     else L := FixBase^[pred(F2^.ObjMod)] + (F2^.Target.intRef and $FFF00000);
  2719.    if not Prepare(F2)
  2720.     then begin Fx^.AtFree(pred(I)); Continue; end;
  2721.    For J := pred(I) downto 1 do
  2722.     begin
  2723.      F1 := Fx^.At(pred(J));
  2724.      if (F1^.sType and nrSType = F2^.sType and nrSType) and
  2725.         (F1^.Flags and nrRtype = nrRint) and
  2726.         (F1^.ObjMod = F2^.ObjMod)
  2727.       then begin
  2728.             if F1^.Flags and nrNewChain <> 0
  2729.              then K := F1^.Target.intRef - (GetL(F1^.sOffs) and $FFFFF)
  2730.              else K := FixBase^[pred(F1^.ObjMod)] + (F1^.Target.intRef and $FFF00000);
  2731.             if (L <> K) or (L = $7F7F7F7F) then Continue;
  2732.  
  2733.             if not Prepare(F1)
  2734.              then begin Fx^.AtFree(pred(J)); Dec(I); Continue; end;
  2735.  
  2736.             sO := F1^.sOffs; K := -1;
  2737.             while sO <= Header.lxPageSize - 4 do
  2738.              begin K := sO; sO := GetL(sO) shr 20; end;
  2739.  
  2740.             if K <> -1
  2741.              then SetL(K, (longint(F2^.sOffs) shl 20) + (GetL(K) and $FFFFF))
  2742.              else Continue;
  2743.             F1^.Target.intRef := L + (GetL(F1^.sOffs) and $FFFFF);
  2744.  
  2745.             Fx^.AtFree(pred(I));
  2746.             break;
  2747.            end;
  2748.     end;
  2749.   end;
  2750.  
  2751.  For I := 1 to Fx^.Count do
  2752.   begin
  2753.    F2 := Fx^.At(pred(I));
  2754.    if (F2^.sType and nrSType in [nrOff32,nrSoff32]) and
  2755.       (F2^.Flags and (nrRtype + nrNewChain) = nrRint) and
  2756.       (F2^.sType and nrChain <> 0)
  2757.     then begin
  2758.           L := FixBase^[pred(F2^.ObjMod)] + (F2^.Target.intRef and $FFF00000);
  2759.           Prepare(F2);
  2760.          end;
  2761.    with F2^ do
  2762.     if (Flags and nrNewChain <> 0)
  2763.      then begin
  2764.            sO := sOffs; J := 0;
  2765.            While sO <= pgTop do begin sO := GetL(sO) shr 20; Inc(J); end;
  2766.            if J <= 1
  2767.             then begin
  2768.                   SetL(sOffs, 0);
  2769.                   Flags := Flags and (not nrNewChain);
  2770.                  end;
  2771.           end;
  2772.   end;
  2773.  FreeMem(FixBase, sizeOf(longint) * Header.lxObjCnt);
  2774. end;
  2775.  
  2776. procedure ClearFixedBytes;
  2777. var
  2778.  ofs,cnt,
  2779.  I,J,K : Integer;
  2780.  Fixup : pLXreloc;
  2781. begin
  2782.  if Header.lxMFlags and (lxNoIntFix + lxNoExtFix) <> 0
  2783.   then exit;
  2784.  For I := 1 to Fx^.Count do
  2785.   begin
  2786.    Fixup := Fx^.At(pred(I));
  2787.    if Fixup^.Flags and nrNewChain <> 0
  2788.     then Continue;
  2789.    if (Fixup^.sType and nrChain <> 0) and
  2790.       (Fixup^.targetCount = 1)
  2791.     then begin
  2792.           Fixup^.sOffs := Fixup^.targets^[0];
  2793.           FreeMem(Fixup^.targets, Fixup^.targetCount * sizeOf(Word16));
  2794.           Fixup^.sType := Fixup^.sType and (not nrChain);
  2795.          end;
  2796.    if ObjMap^[P].PageFlags <> pgValid
  2797.     then Continue;
  2798.  
  2799.    case Fixup^.sType and nrSType of
  2800.     nrSByte  : J := 1;                 { lo byte (8-bits)}
  2801.     nrSSeg,                            { 16-bit segment (16-bits) }
  2802.     nrSOff   : J := 2;                 { 16-bit offset (16-bits) }
  2803.     nrSPtr,                            { 16:16 pointer (32-bits) }
  2804.     nrOff32,                           { 32-bit offset (32-bits) }
  2805.     nrSoff32 : J := 4;                 { 32-bit self-relative offset (32-bits) }
  2806.     nrPtr48  : J := 6;                 { 16:32 pointer (48-bits) }
  2807.    end;
  2808.    if Fixup^.sType and nrChain = 0
  2809.     then begin
  2810.           Fixup^.targetCount := 1;
  2811.           Fixup^.targets := @Fixup^.sOffs;
  2812.          end;
  2813.    For K := 1 to Fixup^.targetCount do
  2814.     begin
  2815.      ofs := Fixup^.targets^[pred(K)]; cnt := J;
  2816.      if ofs > 32767 then Dec(ofs, 65536);
  2817.      if ofs < 0
  2818.       then begin Inc(cnt, ofs); ofs :=0; end;
  2819.      if ofs + cnt > Header.lxPageSize
  2820.       then Dec(cnt, ofs + cnt - Header.lxPageSize);
  2821.      if (cnt > 0) and (ofs < Header.lxPageSize)
  2822.       then FillChar(pByteArray(Pages^[pred(P)])^[ofs], cnt, 0);
  2823.     end;
  2824.   end;
  2825. end;
  2826.  
  2827. var
  2828.  ps1,ps2 : Integer;
  2829.  cPage   : pByteArray;
  2830.  
  2831. begin
  2832.  if packFlags and pkfFixups = 0 then exit;
  2833.  New(Fx, Create(16, 16));
  2834.  if packFlags and pkfFixupsLvl = pkfFixupsMax
  2835.   then GetMem(cPage, Header.lxPageSize);
  2836.  For P := 1 to Header.lxMPages do
  2837.   begin
  2838.    tmpPF := packFlags;
  2839.    if (Header.lxMFlags and (lxNoIntFix + lxNoExtFix) <> 0) or
  2840.       (ObjMap^[P].PageFlags = pgZeroed)
  2841.     then tmpPF := (tmpPF and (not pkfFixupsLvl)) or pkfFixupsVer2
  2842.     else with ObjMap^[P] do
  2843.           begin
  2844.            UnpackPage(P);
  2845.            if PageFlags <> pgValid then Continue;
  2846.            GetMem(nP, Header.lxPageSize);
  2847.            Move(Pages^[Pred(P)]^, nP^, PageSize);
  2848.            FreeMem(Pages^[Pred(P)], PageSize);
  2849.            if PageSize < Header.lxPageSize
  2850.             then FillChar(nP^[PageSize], Header.lxPageSize - PageSize, 0);
  2851.            Pages^[Pred(P)] := nP;
  2852.            PageSize := Header.lxPageSize;
  2853.           end;
  2854.    if GetFixups(P, Fx)
  2855.     then begin
  2856.           if tmpPF and pkfFixupsLvl >= pkfFixupsVer4
  2857.            then pgTop := Header.lxPageSize - MaxL(4, MemScanBwd(nP^, Header.lxPageSize, 0) + 4);
  2858.  
  2859.           if tmpPF and pkfFixupsLvl = pkfFixupsMax
  2860.            then begin
  2861.                  ClearFixedBytes;
  2862.                  New(aFx, Clone(Fx));
  2863.                  PackVer2;
  2864.                  ps1 := Header.lxPageSize;
  2865.                  if PackMethod2(Pages^[pred(P)]^, cPage^, Header.lxPageSize -
  2866.                      MemScanBwd(Pages^[pred(P)]^, Header.lxPageSize, 0), ps1)
  2867.                   then Inc(ps1, FixupsSize(Fx))
  2868.                   else ps1 := $7FFFFFFF;
  2869.                  XchgL(Fx, aFx);
  2870.                  PackVer4;
  2871.                  ps2 := Header.lxPageSize;
  2872.                  if PackMethod2(Pages^[pred(P)]^, cPage^, Header.lxPageSize -
  2873.                      MemScanBwd(Pages^[pred(P)]^, Header.lxPageSize, 0), ps2)
  2874.                   then Inc(ps2, FixupsSize(Fx))
  2875.                   else ps2 := $7FFFFFFF;
  2876.                  if ps1 <= ps2
  2877.                   then XchgL(Fx, aFx);
  2878.                  Dispose(aFx, Destroy);
  2879.                 end
  2880.            else begin
  2881.                  if tmpPF and pkfFixupsLvl >= pkfFixupsVer4
  2882.                   then PackVer4;
  2883.                  if tmpPF and pkfFixupsLvl >= pkfFixupsVer2
  2884.                   then PackVer2;
  2885.                 end;
  2886.           ClearFixedBytes;
  2887.           SetFixups(P, Fx);
  2888.          end;
  2889.    Fx^.FreeAll;
  2890.   end;
  2891.  if packFlags and pkfFixupsLvl = pkfFixupsMax
  2892.   then FreeMem(cPage, Header.lxPageSize);
  2893.  Dispose(Fx, Destroy);
  2894. end;
  2895.  
  2896. procedure tLX.ApplyFixups;
  2897. var
  2898.  Fx   : pFixupCollection;
  2899.  F    : pLXreloc;
  2900.  I,J,
  2901.  P,S  : Integer;
  2902.  A    : record case boolean of
  2903.          FALSE: (L : Longint; S : Word16);
  2904.          TRUE:  (B : array[0..5] of Byte);
  2905.         end;
  2906.  pOfs : pWord16;
  2907.  Chg  : boolean;
  2908.  tmpP : pByteArray;
  2909.  
  2910. begin
  2911.  if (Header.lxMFlags and lxModType <> lxEXE){ Applicable only to EXE modules }
  2912.   then exit;
  2913.  New(Fx, Create(16, 16));
  2914.  For P := 1 to Header.lxMPages do
  2915.   begin
  2916.    Fx^.FreeAll;
  2917.    if not GetFixups(P, Fx) then Continue;
  2918.    Chg := FALSE;
  2919.  
  2920.    For I := Fx^.Count downto 1 do
  2921.     begin
  2922.      F := Fx^.At(pred(I));
  2923.      if F^.Flags and nrRtype = nrRint
  2924.       then begin
  2925.             if (F^.Flags and nrNewChain <> 0) or
  2926.                (F^.ObjMod = 0) or (F^.ObjMod > Header.lxObjCnt) or
  2927.                (F^.sType and nrSType in [nrSSeg, nrSPtr, nrPtr48, nrSoff32]) or
  2928.                (ObjTable^[F^.ObjMod].oBase = 0)  { Unassigned object address }
  2929.              then break;
  2930.             if (ObjMap^[P].PageFlags <> pgValid)
  2931.              then UnpackPage(P);
  2932.             if (ObjMap^[P].PageFlags <> pgValid)
  2933.              then break;
  2934.             if (ObjMap^[P].PageSize < Header.lxPageSize)
  2935.              then begin
  2936.                    GetMem(tmpP, Header.lxPageSize);
  2937.                    Move(Pages^[pred(P)]^, tmpP^, ObjMap^[P].PageSize);
  2938.                    FillChar(tmpP^[ObjMap^[P].PageSize], Header.lxPageSize - ObjMap^[P].PageSize, 0);
  2939.                    FreeMem(Pages^[pred(P)], ObjMap^[P].PageSize);
  2940.                    Pages^[pred(P)] := tmpP;
  2941.                    ObjMap^[P].PageSize := Header.lxPageSize;
  2942.                   end;
  2943.             A.L := ObjTable^[F^.ObjMod].oBase;
  2944.             if (A.L = 0)
  2945.              then break;   { todo: assign first free address instead of exit }
  2946.             if (F^.Flags and nrAdd <> 0)
  2947.              then Inc(A.L, F^.addFixup);
  2948.             Inc(A.L, F^.Target.intRef);
  2949.             case F^.sType and nrSType of
  2950.              nrSByte  : S := 1;
  2951.              nrSSeg   : break;{ CS is known only at runtime }
  2952.              nrSPtr   : break;{ CS is known only at runtime }
  2953.              nrSOff   : S := 2;
  2954.              nrPtr48  : break;{ CS is known only at runtime }
  2955.              nrOff32  : S := 4;
  2956.              nrSoff32 : break;{ Not supported (yet?) }
  2957.             end;
  2958.             if (F^.sType and nrChain <> 0)
  2959.              then begin
  2960.                    J := F^.targetCount;
  2961.                    pOfs := @F^.targets^;
  2962.                   end
  2963.              else begin
  2964.                    J := 1;
  2965.                    pOfs := @F^.sOffs;
  2966.                   end;
  2967.             While J > 0 do
  2968.              begin
  2969.               if pOfs^ < Header.lxPageSize
  2970.                then Move(A.L, pByteArray(Pages^[pred(P)])^[pOfs^],
  2971.                          minL(S, Header.lxPageSize - pOfs^))
  2972.                else
  2973.               if pOfs^ + S >= 0
  2974.                then Move(A.B[$10000 - pOfs^], Pages^[pred(P)]^, S - ($10000 - pOfs^));
  2975.               Inc(pOfs); Dec(J);
  2976.              end;
  2977.             Fx^.AtFree(pred(I)); Chg := TRUE;
  2978.            end;
  2979.     end;
  2980.  
  2981.    if Chg then SetFixups(P, Fx);
  2982.   end;
  2983.  Dispose(Fx, Destroy);
  2984. end;
  2985.  
  2986. function tLX.UnpackPage;
  2987. var
  2988.  J       : Integer;
  2989.  uD,pD   : pByteArray;
  2990.  UnpFunc : Function(var srcData, destData; srcDataSize : longint; var dstDataSize : Longint) : boolean;
  2991. begin
  2992.  UnpackPage := FALSE;
  2993.  with ObjMap^[PageNo] do
  2994.   begin
  2995.    case PageFlags of
  2996.     pgIterData  : @UnpFunc := @UnpackMethod1;
  2997.     pgIterData2 : @UnpFunc := @UnpackMethod2;
  2998.     pgValid     : @UnpFunc := nil;
  2999.     else exit;
  3000.    end;
  3001.    pD := Pages^[pred(PageNo)];
  3002.    if @UnpFunc <> nil
  3003.     then begin
  3004.           GetMem(uD, Header.lxPageSize); J := Header.lxPageSize;
  3005.           if UnpFunc(pD^, uD^, PageSize, J)
  3006.            then begin
  3007.                  FreeMem(pD, PageSize);
  3008.                  GetMem(pD, J);
  3009.                  Move(uD^, pD^, J);
  3010.                  PageSize := J;
  3011.                  PageFlags := pgValid;
  3012.                  Pages^[pred(PageNo)] := pD;
  3013.                 end;
  3014.           FreeMem(uD, Header.lxPageSize);
  3015.          end;
  3016.    J := PageSize;
  3017.    While (J > 0) and (pD^[pred(J)] = 0) do Dec(J);
  3018.    if J <> PageSize
  3019.     then begin
  3020.           GetMem(uD, J);
  3021.           Move(pD^, uD^, J);
  3022.           Pages^[pred(PageNo)] := uD;
  3023.           FreeMem(pD, PageSize);
  3024.           PageSize := J;
  3025.          end;
  3026.   end;
  3027.  UnpackPage := TRUE;
  3028. end;
  3029.  
  3030. procedure tLX.Unpack;
  3031. var
  3032.  I : Integer;
  3033. begin
  3034.  For I := 1 to Header.lxMpages do UnpackPage(I);
  3035. end;
  3036.  
  3037. procedure tLX.Pack;
  3038. const
  3039.     maxLen  : array[0..2] of Byte = (1, 16, 255);
  3040. var
  3041.  I,S1,S2 : Longint;
  3042.  Bf1,Bf2 : Pointer;
  3043.  
  3044. Procedure SetPage(var oD : Pointer; nD : Pointer; var oS : Word16; nS : Longint);
  3045. begin
  3046.  FreeMem(oD, oS); oS := nS;
  3047.  GetMem(Pages^[pred(I)], nS);
  3048.  Move(nD^, oD^, nS);
  3049. end;
  3050.  
  3051. begin
  3052. { Now pack fixup records }
  3053.  PackFixups(packFlags);
  3054. { Remove empty pages }
  3055.  RemoveEmptyPages;
  3056.  if packFlags and (pkfRunLength or pkfLempelZiv) = 0 then exit;
  3057.  
  3058.  GetMem(Bf1, Header.lxPageSize);
  3059.  GetMem(Bf2, Header.lxPageSize);
  3060.  For I := 1 to Header.lxMPages do
  3061.   with ObjMap^[I] do
  3062.    if (PageFlags = pgValid) and (PageSize > 0)
  3063.     then begin
  3064.           if @Progress <> nil then Progress(pred(I), Header.lxMPages);
  3065.           S1 := Header.lxPageSize; S2 := Header.lxPageSize;
  3066.           if (packFlags and pkfRunLength = 0) or
  3067.              (not PackMethod1(Pages^[pred(I)]^, Bf1^, PageSize, S1, maxLen[packFlags and pkfRunLengthLvl]))
  3068.            then S1 := $7FFFFFFF;
  3069.           if (packFlags and pkfLempelZiv = 0) or
  3070.              (not PackMethod2(Pages^[pred(I)]^, Bf2^, PageSize, S2))
  3071.            then S2 := $7FFFFFFF;
  3072.           if (S1 < S2) and (S1 < Header.lxPageSize) {RL-coding is effective enough?}
  3073.            then begin
  3074.                  PageFlags := pgIterData;
  3075.                  SetPage(Pages^[pred(I)], Bf1, PageSize, S1);
  3076.                 end
  3077.            else
  3078.           if (S2 < Header.lxPageSize)                  {May be LZ77 done something?}
  3079.            then begin
  3080.                  PageFlags := pgIterData2;
  3081.                  SetPage(Pages^[pred(I)], Bf2, PageSize, S2);
  3082.                 end;
  3083.          end;
  3084.  if @Progress <> nil then Progress(1, 1);
  3085.  FreeMem(Bf2, Header.lxPageSize);
  3086.  FreeMem(Bf1, Header.lxPageSize);
  3087. end;
  3088.  
  3089. procedure tLX.DeletePage;
  3090.  
  3091. procedure Del(var P : pLongArray; Item,Count : Longint);
  3092. var
  3093.  N : pLongArray;
  3094. begin
  3095.  GetMem(N, pred(Count) * sizeOf(Longint));
  3096.  Move(P^, N^, pred(Item) * sizeOf(Longint));
  3097.  Move(P^[Item], N^[pred(Item)], (Count - Item) * sizeOf(Longint));
  3098.  FreeMem(P, Count * sizeOf(Longint));
  3099.  P := N;
  3100. end;
  3101.  
  3102. var
  3103.  I  : Longint;
  3104.  NF : pByteArray;
  3105.  NM : pArrOfOM;
  3106. begin
  3107.  if (PageNo > Header.lxMPages) or (PageNo = 0) then exit;
  3108.  FreeMem(Pages^[pred(PageNo)], ObjMap^[PageNo].PageSize);
  3109.  Del(pLongArray(Pages), PageNo, Header.lxMPages);
  3110.  if PerPageCRC <> nil
  3111.   then Del(PerPageCRC, PageNo, Header.lxMPages);
  3112.  
  3113.  GetMem(NM, pred(Header.lxMpages) * sizeOf(tObjMapRec));
  3114.  Move(ObjMap^, NM^, pred(PageNo) * sizeOf(tObjMapRec));
  3115.  Move(ObjMap^[succ(PageNo)], NM^[PageNo], (Header.lxMpages - PageNo) * sizeOf(tObjMapRec));
  3116.  FreeMem(ObjMap, Header.lxMpages * sizeOf(tObjMapRec));
  3117.  ObjMap := NM;
  3118.  
  3119. { remove fixups for this page }
  3120.  FreeMem(FixRecTbl^[pred(PageNo)], FixRecSize^[pred(PageNo)]);
  3121.  Del(pLongArray(FixRecTbl), PageNo, Header.lxMPages);
  3122.  Del(FixRecSize, PageNo, Header.lxMPages);
  3123.  
  3124.  For I := pred(Header.lxMPages) downto 0 do
  3125.   if PageOrder^[I] = PageNo
  3126.    then Del(PageOrder, succ(I), Header.lxMPages)
  3127.    else
  3128.   if PageOrder^[I] > PageNo
  3129.    then Dec(PageOrder^[I]);
  3130.  
  3131.  For I := 1 to Header.lxObjCnt do
  3132.   with ObjTable^[I] do
  3133.    if PageNo >= oPageMap
  3134.     then if PageNo < oPageMap + oMapSize
  3135.           then Dec(oMapSize)
  3136.           else
  3137.     else Dec(oPageMap);
  3138.  
  3139.  Dec(Header.lxMPages);
  3140. end;
  3141.  
  3142. procedure tLX.MinimizePage;
  3143. var
  3144.  dOf : Longint;
  3145.  P   : pByteArray;
  3146. begin
  3147.  if (PageNo > Header.lxMPages) or (PageNo = 0) then exit;
  3148.  with ObjMap^[PageNo] do
  3149.   if PageFlags = pgValid
  3150.    then begin
  3151.          dOf := PageSize - MemScanBwd(Pages^[pred(PageNo)]^, PageSize, 0);
  3152.          dOf := (dOf + pred(1 shl Header.lxPageShift)) and
  3153.                 ($FFFFFFFF shl Header.lxPageShift);
  3154.          if PageSize <> dOf
  3155.           then begin
  3156.                 GetMem(P, dOf);
  3157.                 Move(Pages^[pred(pageNo)]^, P^, MinL(dOf, PageSize));
  3158.                 if dOf > PageSize
  3159.                  then FillChar(P^[PageSize], dOf - PageSize, 0);
  3160.                 FreeMem(Pages^[pred(pageNo)], PageSize);
  3161.                 Pages^[pred(pageNo)] := P;
  3162.                 PageSize := dOf;
  3163.                end;
  3164.         end;
  3165. end;
  3166.  
  3167. function tLX.UsedPage;
  3168. var
  3169.  I : Longint;
  3170. begin
  3171.  For I := 1 to Header.lxObjCnt do
  3172.   with ObjTable^[I] do
  3173.    if (PageNo >= oPageMap) and (PageNo < oPageMap + oMapSize)
  3174.     then begin UsedPage := TRUE; exit; end;
  3175.  UsedPage := FALSE;
  3176. end;
  3177.  
  3178. procedure tLX.RemoveEmptyPages;
  3179. var
  3180.  I,J : Integer;
  3181. begin
  3182. { Minimize space occupied by all pages }
  3183.  For I := 1 to Header.lxMpages do MinimizePage(I);
  3184. { Remove all absolutely empty pages at ends of objects }
  3185.  For I := 1 to Header.lxObjCnt do
  3186.   with ObjTable^[I] do
  3187.    For J := pred(oPageMap + oMapSize) downto oPageMap do
  3188.     with ObjMap^[J] do
  3189.      if ((PageFlags = pgValid) or (PageFlags = pgIterData) or (PageFlags = pgIterData2))
  3190.       and (PageSize = 0) and (FixRecSize^[pred(J)] = 0)
  3191.       then DeletePage(J)
  3192.       else break;
  3193. end;
  3194.  
  3195. function tLX.isPacked;
  3196. var
  3197.  i,j,k,l,
  3198.  f,cp  : Longint;
  3199.  pl    : pLong;
  3200.  NTR   : pNameTblRec;
  3201.  EP,NP : pEntryPoint;
  3202.  ps    : Byte;
  3203. begin
  3204.  isPacked := TRUE;
  3205.  if (newAlign <> 255) and (newAlign <> header.lxPageShift) then isPacked := FALSE;
  3206.  if (newStubSize <> -1) and (newStubSize <> StubSize) then isPacked := FALSE;
  3207.  if newAlign <> 255 then ps := newAlign else ps := header.lxPageShift;
  3208.  
  3209.  cp := StubSize + sizeOf(Header);
  3210. { Remove empty pages }
  3211.  RemoveEmptyPages;
  3212. { Now pack fixup records }
  3213. { PackFixups(packFlags); }
  3214.  
  3215.  if ObjTable <> nil
  3216.   then begin
  3217.         if Header.lxObjTabOfs <> cp - StubSize then isPacked := FALSE;
  3218.         Inc(cp, Header.lxObjCnt * sizeOf(tObjTblRec));
  3219.        end;
  3220.  
  3221.  if ObjMap <> nil
  3222.   then begin
  3223.         if Header.lxObjMapOfs <> cp - StubSize then isPacked := FALSE;
  3224.         Inc(cp, Header.lxMpages * sizeOf(tObjMapRec));
  3225.        end;
  3226.  
  3227.  if RsrcTable <> nil
  3228.   then begin
  3229.         if Header.lxRsrcTabOfs <> cp - StubSize then isPacked := FALSE;
  3230.         Inc(cp, Header.lxRsrcCnt * sizeOf(tResource));
  3231.        end;
  3232.  
  3233.  if (Header.lxResTabOfs <> 0) and (Header.lxResTabOfs <> cp - StubSize)
  3234.   then isPacked := FALSE;
  3235.  For I := 1 to ResNameTbl^.Count do
  3236.   begin
  3237.    NTR := ResNameTbl^.At(pred(I));
  3238.    Inc(cp, succ(length(NTR^.Name^)) + sizeOf(Word16));
  3239.   end;
  3240.  Inc(cp);
  3241.  
  3242.  if (Header.lxEntTabOfs <> 0) and (Header.lxEntTabOfs <> cp - StubSize)
  3243.   then isPacked := FALSE;
  3244.  
  3245.  I := 1;
  3246.  While I <= EntryTbl^.Count do
  3247.   begin
  3248.    J := I;
  3249.    EP := pEntryPoint(EntryTbl^.At(pred(I)));
  3250.    if I > 1
  3251.     then begin
  3252.           NP := pEntryPoint(EntryTbl^.At(I-2));
  3253.           K := pred(EP^.Ordinal - NP^.Ordinal);
  3254.          end
  3255.     else K := pred(EP^.Ordinal);
  3256.    While K > 0 do
  3257.     begin
  3258.      Inc(cp, 2);
  3259.      Dec(K, MinL(K, 255));
  3260.     end;
  3261.    K := EP^.Ordinal;
  3262.    repeat
  3263.     Inc(J); Inc(K);
  3264.     if (J > EntryTbl^.Count) or (J - I >= 255)
  3265.      then break;
  3266.     NP := pEntryPoint(EntryTbl^.At(pred(J)));
  3267.    until (NP^.Ordinal <> K) or
  3268.          (EP^.BndType <> NP^.BndType) or
  3269.         ((EP^.BndType <> btEmpty) and
  3270.          (EP^.Obj <> NP^.Obj));
  3271.    K := BundleRecSize(EP^.BndType);
  3272.    if EP^.BndType = btEmpty
  3273.     then Inc(cp, sizeOf(Byte) * 2)
  3274.     else Inc(cp, sizeOf(tEntryTblRec));
  3275.    Inc(cp, (J - I) * K);
  3276.    I := J;
  3277.   end;
  3278.  Inc(cp);
  3279.  
  3280.  if ModDirTbl <> nil
  3281.   then begin
  3282.         if Header.lxDirTabOfs <> cp - StubSize then isPacked := FALSE;
  3283.         Inc(cp, Header.lxDirCnt * sizeOf(tResource));
  3284.        end;
  3285.  
  3286.  if PerPageCRC <> nil
  3287.   then begin
  3288.         if Header.lxPageSumOfs <> cp - StubSize then isPacked := FALSE;
  3289.         Inc(cp, Header.lxMpages * sizeOf(Longint));
  3290.        end;
  3291.  
  3292.  if Header.lxLdrSize <> cp - Header.lxObjTabOfs - StubSize then isPacked := FALSE;
  3293.  
  3294. { Write page fixup table }
  3295.  L := cp;
  3296.  
  3297.  if (Header.lxFPageTabOfs <> 0) and (Header.lxFPageTabOfs <> cp - StubSize)
  3298.   then isPacked := FALSE;
  3299.  Inc(cp, succ(Header.lxMpages) * sizeOf(Longint));
  3300.  
  3301.  if (Header.lxFRecTabOfs <> 0) and (Header.lxFRecTabOfs <> cp - StubSize)
  3302.   then isPacked := FALSE;
  3303.  For I := 1 to Header.lxMPages do
  3304.   Inc(cp, FixRecSize^[pred(I)]);
  3305.  
  3306.  if (Header.lxImpModOfs <> 0) and (Header.lxImpModOfs <> cp - StubSize)
  3307.   then isPacked := FALSE;
  3308.  For I := 1 to ImpModTbl^.Count do
  3309.   if ImpModTbl^.At(pred(I)) <> nil
  3310.    then Inc(cp, succ(length(pString(ImpModTbl^.At(pred(I)))^)))
  3311.    else Inc(cp);
  3312.  
  3313.  if (Header.lxImpProcOfs <> 0) and (Header.lxImpProcOfs <> cp - StubSize)
  3314.   then isPacked := FALSE;
  3315.  For I := 1 to ImpProcTbl^.Count do
  3316.   if ImpProcTbl^.At(pred(I)) <> nil
  3317.    then Inc(cp, succ(length(pString(ImpProcTbl^.At(pred(I)))^)))
  3318.    else Inc(cp);
  3319.  
  3320.  if Header.lxFixupSize <> cp - L then isPacked := FALSE;
  3321.  
  3322.  case SaveFlags and svfAlignFirstObj of
  3323.   svfFOalnNone   : ;
  3324.   svfFOalnShift  : cp := (cp + pred(1 shl ps)) and
  3325.                          ($FFFFFFFF shl ps);
  3326.   svfFOalnSector : cp := (cp + 511) and $FFFFFE00;
  3327.  end;
  3328.  if (Header.lxDataPageOfs <> 0) and (Header.lxDataPageOfs <> cp)
  3329.   then isPacked := FALSE;
  3330.  Header.lxDataPageOfs := cp;
  3331.  f := 0;
  3332.  For I := 1 to Header.lxMpages do
  3333.   begin
  3334.    K := PageOrder^[pred(I)];
  3335.    with ObjMap^[K] do
  3336.     begin
  3337.      case PageFlags of
  3338.       pgValid     : begin
  3339.                      pL := @Header.lxDataPageOfs;
  3340.                      if PageSize > 6 then f := f or 1;
  3341.                     end;
  3342.       pgIterData,
  3343.       pgIterData2 : begin
  3344.                      if Header.lxIterMapOfs <> Header.lxDataPageOfs then isPacked := FALSE;
  3345.                      Header.lxIterMapOfs := Header.lxDataPageOfs;
  3346.                      pL := @Header.lxIterMapOfs;
  3347.                      case PageFlags of
  3348.                       pgIterData  : f := f or 2;
  3349.                       pgIterData2 : f := f or 4;
  3350.                      end;
  3351.                     end;
  3352.       pgInvalid,
  3353.       pgZeroed    : pL := nil;
  3354.       else isPacked := FALSE;
  3355.      end;
  3356.      if (PageSize > 0) and (pL <> nil)
  3357.       then begin
  3358.             if (Pages^[pred(K)] = nil) and (PageSize <> 0) then isPacked := FALSE;
  3359.             L := (cp - pL^ + pred(1 shl ps)) and ($FFFFFFFF shl ps);
  3360.             cp := pL^ + L;
  3361.             if PageDataOffset <> L shr ps then isPacked := FALSE;
  3362.             Inc(cp, PageSize);
  3363.            end;
  3364.     end;
  3365.   end;
  3366.  if (packFlags and pkfLempelZiv <> 0) and
  3367.     (f and 4 = 0) and
  3368.     (f and 1 <> 0)
  3369.   then isPacked := FALSE;
  3370.  if (packFlags and pkfRunLength <> 0) and
  3371.     (packFlags and pkfLempelZiv = 0) and
  3372.     (f and 2 = 0) and
  3373.     (f and 1 <> 0)
  3374.   then isPacked := FALSE;
  3375.  
  3376.  if NResNameTbl^.Count > 0
  3377.   then begin
  3378.         if Header.lxNResTabOfs <> cp then isPacked := FALSE;
  3379.         For I := 1 to NResNameTbl^.Count do
  3380.          begin
  3381.           NTR := NResNameTbl^.At(pred(I));
  3382.           Inc(cp, succ(length(NTR^.Name^)) + sizeOf(Word16));
  3383.          end;
  3384.         Inc(cp);
  3385.         if Header.lxCbNResTabOfs <> cp - Header.lxNResTabOfs then isPacked := FALSE;
  3386.        end;
  3387.  
  3388.  if (oldDbgOfs <> 0) or (Header.lxDebugInfoOfs <> 0)
  3389.   then if (Header.lxDebugInfoOfs <> cp) or (Header.lxDebugInfoOfs <> oldDbgOfs)
  3390.         then isPacked := FALSE
  3391.         else Inc(cp, Header.lxDebugLen);
  3392.  
  3393.  NewSize := cp;
  3394. end;
  3395.  
  3396. destructor tLX.Destroy;
  3397. begin
  3398.  freeModule;
  3399. end;
  3400.  
  3401. end.
  3402.