Creating Executable File

This procedure creates space in heap for exe header and typed constants, creates exe file and positions it to the start of the code.
Procedure CreateExeFile;
begin
  ExeHeaderBuffer.Seg := HeapPtrRec.Seg;
  Inc (HeapPtrRec.Seg, (CurrentRelocationItemOffset + $000F) shr 4);
  If HeapPtrRec.Seg > HeapEndRec.Seg then Error (OutOfMemory);
  TypedConstantsPointer.Seg := HeapPtrRec.Seg;
  Inc (HeapPtrRec.Seg, (OffsetOfVariables + $000F) shr 4);
  If HeapPtrRec.Seg > HeapEndRec.Seg then Error (OutOfMemory);
  StrCopy (ExeFileName, CurrentFileName);
  FindFilePath (ExeFileName, Dir_Forced or Dir_EXE_TPU or Ext_Forced or Ext_EXE);
  CreateFile (ExeFile, ExeFileName);
  ExeFileHandle := FileRec (ExeFile).Handle;
  Seek (ExeFile, (CurrentRelocationItemOffset + $000F) and $FFF0);
end;
     PExeHeader = ^TExeHeader;
     TExeHeader = Record
                    Signature: Array [1..2] of Char;  { 00 'MZ' }
                    ExtraBytes: Word;                 { 02 Last page byte count, Filelength mod 512 }
                    Pages: Word;                      { 04 Number of 512 byte blocks including header, Filelength div 512 }
                    RelocItems: Word;                 { 06 Number of relocation items }
                    HeaderSize: Word;                 { 08 Size of header in paragraphs }
                    MinAlloc: Word;                   { 0A Minimum number of memory paragraphs }
                    MaxAlloc: Word;                   { 0C Maximum number of memory paragraphs }
                    InitSS: Word;                     { 0E Initial value of SS }
                    InitSP: Word;                     { 10 Initial value of SP }
                    Checksum: Word;                   { 12 Any value }
                    InitIP: Word;                     { 14 Initial value of IP }
                    InitCS: Word;                     { 16 Initial value of CS }
                    RelocTable: Word;                 { 18 Offset of relocation table }
                    OverlayNumber: Word;              { 1A Usually 0 }
                  end;
This procedure writes typed constants and header to exe file.
Procedure WriteTypedConstantsAndExeHeader;
Var SystemUnitTypedConstants: PWord;
    ExeHeader: PExeHeader;
    ExeFileParagraphs: Word;
    ProgramStartOffset: Word;
    ProceduresBlockRecord: PProceduresBlockRecord;
    CodeConstVarBlockRecord: PCodeConstVarBlockRecord absolute ProceduresBlockRecord;
    CodeConstVarBlockRecordPtrRec: PtrRec absolute CodeConstVarBlockRecord;
begin
  SystemUnitTypedConstants := TypedConstantsPointer.Ptr;
  Word (Ptr (TypedConstantsPointer.Seg, 0)^) := 0;
  SystemUnitTypedConstants^ := OverlayCodeList;
  Inc (SystemUnitTypedConstants);
  SystemUnitTypedConstants^ := OverlayHeapSize;
  FillChar (Ptr (TypedConstantsPointer.Seg, OffsetOfVariables)^, 16 - OffsetOfVariables and $000F, 0);
  BlockWrite (ExeFile, Ptr (TypedConstantsPointer.Seg, 0)^, (OffsetOfVariables + $000F) and $FFF0);
  Seek (ExeFile, 0);
  ExeFileSize := FileSize (ExeFile);
  ExeHeader := Ptr (ExeHeaderBuffer.Seg, 0);
  With ExeHeader^ do
    begin
      Signature := 'MZ';
      HeaderSize := (CurrentRelocationItemOffset + $000F) shr 4;
      ExeFileParagraphs := HeaderSize + DataSegment + (OffsetOfVariables + $000F) shr 4;
      ExtraBytes := (ExeFileParagraphs and $001F) shl 4;
      Pages := (ExeFileParagraphs + $001F) shr 5;
      RelocItems := (CurrentRelocationItemOffset - RelocationTableOffset) div 4;
      ExeFileParagraphs := (ModuleStack + $000F) shr 4 + FirstFreeSegment + OverlayHeapSize -
                             (OffsetOfVariables + $000F) shr 4 - DataSegment;
      If LongInt (ExeFileParagraphs) + ModuleHeapMin > $FFFF then MinAlloc := $FFFF
        else MinAlloc := ExeFileParagraphs + ModuleHeapMin;
      If LongInt (ExeFileParagraphs) + ModuleHeapMax > $FFFF then MaxAlloc := $FFFF
        else MaxAlloc := ExeFileParagraphs + ModuleHeapMax;
      InitSS := FirstFreeSegment;
      InitSP := ModuleStack;
      RelocTable := RelocationTableOffset;
      Checksum := 0;
    end;
  UnitPtrRec.Seg := SymbolTable [stMain].Segment;
  ProceduresBlockRecord := Ptr (UnitPtrRec.Seg, UnitPtr^.BlockOffset [stProcedures]);
  ProgramStartOffset := ProceduresBlockRecord^.SizeOfConstants;
  CodeConstVarBlockRecordPtrRec.Ofs := UnitPtr^.BlockOffset [stCodeBlocks] +
                                         ProceduresBlockRecord^.ProgramCodeBlockRecordOffset;
  Inc (ProgramStartOffset, CodeConstVarBlockRecord^.Offset);
  With ExeHeader^ do
    begin
      InitIP := ProgramStartOffset;
      InitCS := 0;
      OverlayNumber := 0;
    end;
  FillChar (Ptr (ExeHeaderBuffer.Seg, CurrentRelocationItemOffset)^, 16 - CurrentRelocationItemOffset and $000F, 0);
  BlockWrite (ExeFile, Ptr (ExeHeaderBuffer.Seg, 0)^, (CurrentRelocationItemOffset + $000F) and $FFF0);
end;
 
 
 
© 2017 Turbo Pascal | Privacy Policy