ruberon/source/MSCOFF.ob07

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.