kolibrios/programs/develop/oberon07/Source/KOS.ob07

(*
    BSD 2-Clause License

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

MODULE KOS;

IMPORT BIN, WR := WRITER, LISTS, CHL := CHUNKLISTS;


CONST

    HEADER_SIZE = 36;

    SIZE_OF_DWORD = 4;


TYPE

    FILE = WR.FILE;

    HEADER = RECORD

        menuet01: ARRAY 9 OF CHAR;
        ver, start, size, mem, sp, param, path: INTEGER

    END;


PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN
    IF n MOD _align # 0 THEN
        n := n + _align - (n MOD _align)
    END

    RETURN n
END align;


PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER);
VAR
    i:      INTEGER;
    import: BIN.IMPRT;

BEGIN
    libcount  := 0;
    import := program.imp_list.first(BIN.IMPRT);
    WHILE import # NIL DO
        IF import.label = 0 THEN
            INC(libcount)
        END;
        import := import.next(BIN.IMPRT)
    END;

    len  := libcount * 2 + 2;
    size := (LISTS.count(program.imp_list) + len + 1) * SIZE_OF_DWORD;

    ImportTable := CHL.CreateIntList();
    FOR i := 0 TO size DIV SIZE_OF_DWORD - 1 DO
        CHL.PushInt(ImportTable, 0)
    END;

    i := 0;
    import := program.imp_list.first(BIN.IMPRT);
    WHILE import # NIL DO

        IF import.label = 0 THEN
            CHL.SetInt(ImportTable, len, 0);
            INC(len);
            CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD);
            INC(i);
            CHL.SetInt(ImportTable, i, import.nameoffs + size + idata);
            INC(i)
        ELSE
            CHL.SetInt(ImportTable, len, import.nameoffs + size + idata);
            import.label := len * SIZE_OF_DWORD;
            INC(len)
        END;

        import := import.next(BIN.IMPRT)
    END;
    CHL.SetInt(ImportTable, len, 0);
    CHL.SetInt(ImportTable, i, 0);
    CHL.SetInt(ImportTable, i + 1, 0);
    INC(len);
    size := size + CHL.Length(program.import)
END Import;


PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR);

CONST

    PARAM_SIZE    = 2048;
    FileAlignment = 16;


VAR
    header: HEADER;

    base, text, data, idata, bss: INTEGER;

    reloc:   BIN.RELOC;
    iproc:   BIN.IMPRT;
    L:       INTEGER;
    delta:   INTEGER;

    i: INTEGER;

    File: FILE;

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

    icount, dcount, ccount: INTEGER;

    code: CHL.BYTELIST;

BEGIN
    base := 0;

    icount := CHL.Length(program.import);
    dcount := CHL.Length(program.data);
    ccount := CHL.Length(program.code);

    text  := base + HEADER_SIZE;
    data  := align(text + ccount, FileAlignment);
    idata := align(data + dcount, FileAlignment);

    Import(program, idata, ImportTable, ILen, libcount, isize);

    bss := align(idata + isize, FileAlignment);

    header.menuet01 := "MENUET01";
    header.ver      :=  1;
    header.start    :=  text;
    header.size     :=  idata + isize - base;
    header.mem      :=  align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment);
    header.sp       :=  base + header.mem - PARAM_SIZE * 2;
    header.param    :=  header.sp;
    header.path     :=  header.param + PARAM_SIZE;

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

        L := BIN.get32le(code, reloc.offset);
        delta := 3 - reloc.offset - text;

        CASE reloc.opcode OF

        |BIN.RIMP:
              iproc := BIN.GetIProc(program, L);
              BIN.put32le(code, reloc.offset, idata + iproc.label)

        |BIN.RBSS:
              BIN.put32le(code, reloc.offset, L + bss)

        |BIN.RDATA:
              BIN.put32le(code, reloc.offset, L + data)

        |BIN.RCODE:
              BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text)

        |BIN.PICDATA:
              BIN.put32le(code, reloc.offset, L + data + delta)

        |BIN.PICCODE:
              BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta)

        |BIN.PICBSS:
              BIN.put32le(code, reloc.offset, L + bss + delta)

        |BIN.PICIMP:
              iproc := BIN.GetIProc(program, L);
              BIN.put32le(code, reloc.offset, idata + iproc.label + delta)

        |BIN.IMPTAB:
              BIN.put32le(code, reloc.offset, idata + delta)

        END;

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

    File := WR.Create(FileName);

    FOR i := 0 TO 7 DO
        WR.WriteByte(File, ORD(header.menuet01[i]))
    END;

    WR.Write32LE(File, header.ver);
    WR.Write32LE(File, header.start);
    WR.Write32LE(File, header.size);
    WR.Write32LE(File, header.mem);
    WR.Write32LE(File, header.sp);
    WR.Write32LE(File, header.param);
    WR.Write32LE(File, header.path);

    CHL.WriteToFile(File, code);
    WR.Padding(File, FileAlignment);

    CHL.WriteToFile(File, program.data);
    WR.Padding(File, FileAlignment);

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

    CHL.WriteToFile(File, program.import);

    WR.Close(File)

END write;


END KOS.