kolibrios-gitea/programs/develop/oberon07/source/MSCOFF.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018-2020, Anton Krotov
    All rights reserved.
*)

MODULE MSCOFF;

IMPORT BIN, PE32, KOS, WR := WRITER, UTILS, ERRORS, LISTS, CHL := CHUNKLISTS;


CONST

    SIZE_OF_DWORD = 4;

    (* SectionHeader.Characteristics *)

    SHC_flat  = 040500020H;
    SHC_data  = 0C0500040H;
    SHC_bss   = 0C03000C0H;


TYPE

    FH = PE32.IMAGE_FILE_HEADER;

    SH = PE32.IMAGE_SECTION_HEADER;


PROCEDURE WriteReloc (VirtualAddress, SymbolTableIndex, Type: INTEGER);
BEGIN
    WR.Write32LE(VirtualAddress);
    WR.Write32LE(SymbolTableIndex);
    WR.Write16LE(Type)
END WriteReloc;


PROCEDURE Reloc (program: BIN.PROGRAM);
VAR
    reloc:  BIN.RELOC;
    offset: INTEGER;

BEGIN
    reloc := program.rel_list.first(BIN.RELOC);
    WHILE reloc # NIL DO

        offset := reloc.offset;
        CASE reloc.opcode OF
        |BIN.RIMP,
         BIN.IMPTAB: WriteReloc(offset, 4, 6)
        |BIN.RBSS:   WriteReloc(offset, 5, 6)
        |BIN.RDATA:  WriteReloc(offset, 2, 6)
        |BIN.RCODE:  WriteReloc(offset, 1, 6)
        END;

        reloc := reloc.next(BIN.RELOC)
    END;
END Reloc;


PROCEDURE RelocCount (program: BIN.PROGRAM): INTEGER;
VAR
    reloc:   BIN.RELOC;
    iproc:   BIN.IMPRT;
    res, L:  INTEGER;
    offset:  INTEGER;
    code:    CHL.BYTELIST;

BEGIN
    res := 0;
    code := program.code;
    reloc := program.rel_list.first(BIN.RELOC);
    WHILE reloc # NIL DO

        INC(res);
        offset := reloc.offset;

        IF reloc.opcode = BIN.RIMP THEN
            L := BIN.get32le(code, offset);
            iproc := BIN.GetIProc(program, L);
            BIN.put32le(code, offset, iproc.label)
        END;

        IF reloc.opcode = BIN.RCODE THEN
            L := BIN.get32le(code, offset);
            BIN.put32le(code, offset, BIN.GetLabel(program, L))
        END;

        reloc := reloc.next(BIN.RELOC)
    END

    RETURN res
END RelocCount;


PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER);
VAR
    exp:   BIN.EXPRT;
    n, i:  INTEGER;

    szversion: PE32.NAME;

    ImportTable: CHL.INTLIST;
    ILen, LibCount, isize:  INTEGER;

    ExpCount: INTEGER;

    icount, ecount, dcount, ccount: INTEGER;

    FileHeader: FH;

    flat, data, edata, idata, bss: SH;


    PROCEDURE ICount (ImportTable: CHL.INTLIST; ILen: INTEGER): INTEGER;
    VAR
        i, res: INTEGER;

    BEGIN
        res := 0;

        FOR i := 0 TO ILen - 1 DO
            IF CHL.GetInt(ImportTable, i) # 0 THEN
                INC(res)
            END
        END

        RETURN res
    END ICount;


    PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
    BEGIN
        IF NumberOfRelocations >= 65536 THEN
            ERRORS.Error(202)
        END;
        section.NumberOfRelocations := WCHR(NumberOfRelocations)
    END SetNumberOfRelocations;


BEGIN

    szversion := "version";

    ASSERT(LENGTH(szversion) = 7);

    KOS.Import(program, 0, ImportTable, ILen, LibCount, isize);
    ExpCount := LISTS.count(program.exp_list);

    icount := CHL.Length(program._import);
    dcount := CHL.Length(program.data);
    ccount := CHL.Length(program.code);
    ecount := CHL.Length(program.export);

    FileHeader.Machine               :=  014CX;
    FileHeader.NumberOfSections      :=  5X;
    FileHeader.TimeDateStamp         :=  UTILS.UnixTime();
    (* FileHeader.PointerToSymbolTable  :=  0; *)
    FileHeader.NumberOfSymbols       :=  6;
    FileHeader.SizeOfOptionalHeader  :=  0X;
    FileHeader.Characteristics       :=  0184X;

    flat.Name := ".flat";
    flat.VirtualSize := 0;
    flat.VirtualAddress := 0;
    flat.SizeOfRawData := ccount;
    flat.PointerToRawData := ORD(FileHeader.NumberOfSections) * PE32.SIZE_OF_IMAGE_SECTION_HEADER + PE32.SIZE_OF_IMAGE_FILE_HEADER;
    (* flat.PointerToRelocations := 0; *)
    flat.PointerToLinenumbers := 0;
    SetNumberOfRelocations(flat, RelocCount(program));
    flat.NumberOfLinenumbers := 0X;
    flat.Characteristics := SHC_flat;

    data.Name := ".data";
    data.VirtualSize := 0;
    data.VirtualAddress := 0;
    data.SizeOfRawData := dcount;
    data.PointerToRawData := flat.PointerToRawData + flat.SizeOfRawData;
    data.PointerToRelocations := 0;
    data.PointerToLinenumbers := 0;
    data.NumberOfRelocations := 0X;
    data.NumberOfLinenumbers := 0X;
    data.Characteristics := SHC_data;

    edata.Name := ".edata";
    edata.VirtualSize := 0;
    edata.VirtualAddress := 0;
    edata.SizeOfRawData := ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD + LENGTH(szversion) + 1 + ecount;
    edata.PointerToRawData := data.PointerToRawData + data.SizeOfRawData;
    (* edata.PointerToRelocations := 0; *)
    edata.PointerToLinenumbers := 0;
    SetNumberOfRelocations(edata, ExpCount * 2 + 1);
    edata.NumberOfLinenumbers := 0X;
    edata.Characteristics := SHC_data;

    idata.Name := ".idata";
    idata.VirtualSize := 0;
    idata.VirtualAddress := 0;
    idata.SizeOfRawData := isize;
    idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData;
    (* idata.PointerToRelocations := 0; *)
    idata.PointerToLinenumbers := 0;
    SetNumberOfRelocations(idata, ICount(ImportTable, ILen));
    idata.NumberOfLinenumbers := 0X;
    idata.Characteristics := SHC_data;

    bss.Name := ".bss";
    bss.VirtualSize := 0;
    bss.VirtualAddress := 0;
    bss.SizeOfRawData := program.bss;
    bss.PointerToRawData := 0;
    bss.PointerToRelocations := 0;
    bss.PointerToLinenumbers := 0;
    bss.NumberOfRelocations := 0X;
    bss.NumberOfLinenumbers := 0X;
    bss.Characteristics := SHC_bss;

    flat.PointerToRelocations := idata.PointerToRawData + idata.SizeOfRawData;
    edata.PointerToRelocations := flat.PointerToRelocations + ORD(flat.NumberOfRelocations) * 10;
    idata.PointerToRelocations := edata.PointerToRelocations + ORD(edata.NumberOfRelocations) * 10;

    FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10;

    WR.Create(FileName);

    PE32.WriteFileHeader(FileHeader);

    PE32.WriteSectionHeader(flat);
    PE32.WriteSectionHeader(data);
    PE32.WriteSectionHeader(edata);
    PE32.WriteSectionHeader(idata);
    PE32.WriteSectionHeader(bss);

    CHL.WriteToFile(program.code);
    CHL.WriteToFile(program.data);

    exp := program.exp_list.first(BIN.EXPRT);
    WHILE exp # NIL DO
        WR.Write32LE(exp.nameoffs + edata.SizeOfRawData - ecount);
        WR.Write32LE(exp.label);
        exp := exp.next(BIN.EXPRT)
    END;

    WR.Write32LE(((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD);
    WR.Write32LE(ver);

    WR.Write32LE(0);

    PE32.WriteName(szversion);
    CHL.WriteToFile(program.export);

    FOR i := 0 TO ILen - 1 DO
        WR.Write32LE(CHL.GetInt(ImportTable, i))
    END;

    CHL.WriteToFile(program._import);

    Reloc(program);

    n := 0;
    exp := program.exp_list.first(BIN.EXPRT);
    WHILE exp # NIL DO
        WriteReloc(n, 3, 6);
        INC(n, 4);

        WriteReloc(n, 1, 6);
        INC(n, 4);

        exp := exp.next(BIN.EXPRT)
    END;

    WriteReloc(n, 3, 6);

    FOR i := 0 TO LibCount * 2 - 1 DO
        WriteReloc(i * SIZE_OF_DWORD, 4, 6)
    END;

    FOR i := LibCount * 2 TO ILen - 1 DO
        IF CHL.GetInt(ImportTable, i) # 0 THEN
            WriteReloc(i * SIZE_OF_DWORD, 4, 6)
        END
    END;

    PE32.WriteName("EXPORTS");
    WriteReloc(0, 3, 2);

    PE32.WriteName(".flat");
    WriteReloc(0, 1, 3);

    PE32.WriteName(".data");
    WriteReloc(0, 2, 3);

    PE32.WriteName(".edata");
    WriteReloc(0, 3, 3);

    PE32.WriteName(".idata");
    WriteReloc(0, 4, 3);

    PE32.WriteName(".bss");
    WriteReloc(0, 5, 3);

    WR.Write32LE(4);

    WR.Close
END write;


END MSCOFF.