Aren/kolibrios
1
0
Fork 0
mirror of https://github.com/KolibriOS/kolibrios.git synced 2024-12-24 23:56:49 +03:00
Code Issues Packages Projects Releases Wiki Activity
ba50660e2b
kolibrios/programs/develop/oberon07/Source/X86.ob07
Kirill Lipatov (Leency) 31a4eb5247 upload oberon07 by akron1, add to ISO 
git-svn-id: svn://kolibrios.org@6613 a494cfbc-eb01-0410-851d-a64ba20cac60
2016-10-23 23:30:27 +00:00

1986 lines
47 KiB
Plaintext
Raw Blame History

(*
Copyright 2016 Anton Krotov
This file is part of Compiler.
Compiler is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Compiler is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Compiler. If not, see <http://www.gnu.org/licenses/>.
*)
MODULE X86;
IMPORT UTILS, sys := SYSTEM, SCAN, ELF;
CONST
ADIM* = 5;
lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54;
lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76;
TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7;
TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
stABS* = 1; stODD* = 2; stLEN* = 3; stLSL* = 4; stASR* = 5; stROR* = 6; stFLOOR* = 7;
stFLT* = 8; stORD* = 9; stCHR* = 10; stLONG* = 11; stSHORT* = 12; stINC* = 13;
stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
stLENGTH* = 30;
sysMOVE* = 108;
JMP* = 0E9X; CALL = 0E8X;
JE = 84X; JNE = 85X; JLE = 8EX; JGE = 8DX; JG = 8FX; JL = 8CX;
JCMD = 1; LCMD = 2; GCMD = 3; OCMD = 4; ECMD = 5;
PUSHEAX = 6; PUSHECX = 7; PUSHEDX = 8; POPEAX = 9; POPECX = 10; POPEDX = 11;
ICMP1 = 13; ICMP2 = 14;
defcall = 0; stdcall = 1; cdecl = 2; winapi = 3;
_rset* = 0; _inset* = 1; _saverec* = 2; _length* = 3; _checktype* = 4; _strcmp* = 5;
_lstrcmp* = 6; _rstrcmp* = 7; _savearr* = 8; _newrec* = 9; _disprec* = 10; _arrayidx* = 11;
_arrayrot* = 12; _assrt* = 13; _strcopy* = 14; _arrayidx1* = 15; _init* = 16; _close* = 17; _halt* = 18;
ASSRT = 19; hInstance = 20; SELFNAME = 21; RTABLE = 22;LoadLibrary = 23; GetProcAddress = 24;
Exports = 25; szSTART = 26; START = 27; szversion = 28; _floor = 29; HALT = 30;
FREGS = 8;
TYPE
ASMLINE* = POINTER TO RECORD (UTILS.rITEM)
cmd, clen, varadr, adr, tcmd, codeadr: INTEGER; short: BOOLEAN
END;
TFLT = ARRAY 2 OF INTEGER;
TIDX* = ARRAY ADIM OF INTEGER;
SECTIONNAME = ARRAY 8 OF CHAR;
SECTION = RECORD
name: SECTIONNAME;
size, adr, sizealign, OAPfile, reserved6, reserved7, reserved8, attrflags: INTEGER
END;
HEADER = RECORD
msdos: ARRAY 180 OF CHAR;
typecomp, seccount: sys.CARD16;
time, reserved1, reserved2: INTEGER;
PEoptsize, infflags, PEfile, compver: sys.CARD16;
codesize, datasize, initdatasize, startadr,
codeadr, rdataadr, loadadr, secalign, filealign,
oldestver, version, oldestverNT, reserved3,
filesize, headersize, dllcrc: INTEGER;
UI, reserved4: sys.CARD16;
stksize, stkalloc, heapsize, heapalloc, reserved5, structcount: INTEGER;
structs: ARRAY 16 OF RECORD adr, size: INTEGER END;
sections: ARRAY 3 OF SECTION
END;
COFFHEADER = RECORD
Machine: sys.CARD16;
NumberOfSections: sys.CARD16;
TimeDateStamp,
PointerToSymbolTable,
NumberOfSymbols: INTEGER;
SizeOfOptionalHeader,
Characteristics: sys.CARD16;
text, data, bss: SECTION
END;
KOSHEADER = RECORD
menuet01: ARRAY 8 OF CHAR;
ver, start, size, mem, sp, param, path: INTEGER
END;
ETABLE = RECORD
reserved1, time, reserved2, dllnameoffset, firstnum, adrcount,
namecount, arradroffset, arrnameptroffset, arrnumoffset: INTEGER;
arradr, arrnameptr: ARRAY 10000H OF INTEGER;
arrnum: ARRAY 10000H OF sys.CARD16;
text: ARRAY 1000000 OF CHAR;
textlen, size: INTEGER
END;
RELOC = RECORD
Page, Size: INTEGER;
reloc: ARRAY 1024 OF sys.CARD16
END;
VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj: BOOLEAN;
Lcount, reccount, topstk: INTEGER; recarray: ARRAY 2048 OF INTEGER; current*: ASMLINE;
callstk: ARRAY 1024, 2 OF ASMLINE; OutFile: UTILS.STRING;
Code: ARRAY 4000000 OF CHAR; ccount: INTEGER; Data: ARRAY 1000000 OF CHAR; dcount: INTEGER;
Labels: ARRAY 200000 OF INTEGER; rdata: ARRAY 400H OF INTEGER; Header: HEADER; etable: ETABLE;
ExecName: UTILS.STRING; LoadAdr: INTEGER; Reloc: ARRAY 200000 OF CHAR; rcount: INTEGER;
RtlProc: ARRAY 20 OF INTEGER; OutFilePos: INTEGER; RelocSection: SECTION;
fpu*: INTEGER; isfpu: BOOLEAN; maxfpu: INTEGER; fpucmd: ASMLINE;
kosexp: ARRAY 65536 OF RECORD Name: SCAN.NODE; Adr, NameLabel: INTEGER END; kosexpcount: INTEGER;
PROCEDURE AddRtlProc*(idx, proc: INTEGER);
BEGIN
RtlProc[idx] := proc
END AddRtlProc;
PROCEDURE IntToCard16(i: INTEGER): sys.CARD16;
VAR w: sys.CARD16;
BEGIN
sys.GET(sys.ADR(i), w)
RETURN w
END IntToCard16;
PROCEDURE CopyStr(VAR Dest: ARRAY OF CHAR; Source: ARRAY OF CHAR; VAR di: INTEGER; si: INTEGER);
BEGIN
DEC(di);
REPEAT
INC(di);
Dest[di] := Source[si];
INC(si)
UNTIL Dest[di] = 0X
END CopyStr;
PROCEDURE exch(VAR a, b: INTEGER);
VAR c: INTEGER;
BEGIN
c := a;
a := b;
b := c
END exch;
PROCEDURE Sort(VAR NamePtr, Adr: ARRAY OF INTEGER; Text: ARRAY OF CHAR; LB, RB: INTEGER);
VAR L, R: INTEGER;
PROCEDURE strle(s1, s2: INTEGER): BOOLEAN;
VAR S1, S2: ARRAY 256 OF CHAR; i: INTEGER;
BEGIN
i := 0;
CopyStr(S1, Text, i, s1);
i := 0;
CopyStr(S2, Text, i, s2)
RETURN S1 <= S2
END strle;
BEGIN
IF LB < RB THEN
L := LB;
R := RB;
REPEAT
WHILE (L < RB) & strle(NamePtr[L], NamePtr[LB]) DO
INC(L)
END;
WHILE (R > LB) & strle(NamePtr[LB], NamePtr[R]) DO
DEC(R)
END;
IF L < R THEN
exch(NamePtr[L], NamePtr[R]);
exch(Adr[L], Adr[R])
END
UNTIL L >= R;
IF R > LB THEN
exch(NamePtr[LB], NamePtr[R]);
exch(Adr[LB], Adr[R]);
Sort(NamePtr, Adr, Text, LB, R - 1)
END;
Sort(NamePtr, Adr, Text, R + 1, RB)
END
END Sort;
PROCEDURE PackExport(Name: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
Sort(etable.arrnameptr, etable.arradr, etable.text, 0, etable.namecount - 1);
FOR i := 0 TO etable.namecount - 1 DO
etable.arrnum[i] := IntToCard16(i)
END;
etable.size := 40 + etable.adrcount * 4 + etable.namecount * 6;
etable.arradroffset := 40;
etable.arrnameptroffset := 40 + etable.adrcount * 4;
etable.arrnumoffset := etable.arrnameptroffset + etable.namecount * 4;
etable.dllnameoffset := etable.size + etable.textlen;
CopyStr(etable.text, Name, etable.textlen, 0);
INC(etable.textlen);
FOR i := 0 TO etable.namecount - 1 DO
etable.arrnameptr[i] := etable.arrnameptr[i] + etable.size
END;
etable.size := etable.size + etable.textlen
END PackExport;
PROCEDURE ProcExport*(Number: INTEGER; Name: SCAN.NODE; NameLabel: INTEGER);
BEGIN
IF dll THEN
etable.arradr[etable.adrcount] := Number;
INC(etable.adrcount);
etable.arrnameptr[etable.namecount] := etable.textlen;
INC(etable.namecount);
CopyStr(etable.text, Name.Name, etable.textlen, 0);
INC(etable.textlen)
ELSIF obj THEN
kosexp[kosexpcount].Name := Name;
kosexp[kosexpcount].Adr := Number;
kosexp[kosexpcount].NameLabel := NameLabel;
INC(kosexpcount)
END
END ProcExport;
PROCEDURE Err(code: INTEGER);
BEGIN
CASE code OF
|1: UTILS.ErrMsg(67); UTILS.OutString(OutFile)
|2: UTILS.ErrMsg(69); UTILS.OutString(OutFile)
ELSE
END;
UTILS.Ln;
UTILS.HALT(1)
END Err;
PROCEDURE Align*(n, m: INTEGER): INTEGER;
RETURN n + (m - n MOD m) MOD m
END Align;
PROCEDURE PutReloc(R: RELOC);
VAR i: INTEGER;
BEGIN
sys.PUT(sys.ADR(Reloc[rcount]), R.Page);
INC(rcount, 4);
sys.PUT(sys.ADR(Reloc[rcount]), R.Size);
INC(rcount, 4);
FOR i := 0 TO ASR(R.Size - 8, 1) - 1 DO
sys.PUT(sys.ADR(Reloc[rcount]), R.reloc[i]);
INC(rcount, 2)
END
END PutReloc;
PROCEDURE InitArray(VAR adr: INTEGER; chars: UTILS.STRING);
VAR i, x, n: INTEGER;
BEGIN
n := LEN(chars) - 1;
i := 0;
WHILE (i < n) & (chars[i] # 0X) DO
x := SCAN.hex(chars[i]) * 16 + SCAN.hex(chars[i + 1]);
sys.PUT(adr, CHR(x));
INC(adr);
INC(i, 2)
END
END InitArray;
PROCEDURE WriteF(F, A, N: INTEGER);
BEGIN
IF UTILS.Write(F, A, N) # N THEN
Err(2)
END
END WriteF;
PROCEDURE Write(A, N: INTEGER);
BEGIN
sys.MOVE(A, OutFilePos, N);
OutFilePos := OutFilePos + N
END Write;
PROCEDURE Fill(n: INTEGER; c: CHAR);
VAR i: INTEGER;
BEGIN
FOR i := 1 TO n DO
Write(sys.ADR(c), 1)
END
END Fill;
PROCEDURE SetSection(VAR Section: SECTION; name: SECTIONNAME; size, adr, sizealign, OAPfile, attrflags: INTEGER);
BEGIN
Section.name := name;
Section.size := size;
Section.adr := adr;
Section.sizealign := sizealign;
Section.OAPfile := OAPfile;
Section.attrflags := attrflags;
END SetSection;
PROCEDURE WritePE(FName: ARRAY OF CHAR; stksize, codesize, datasize, rdatasize, gsize: INTEGER);
CONST textattr = 60000020H; rdataattr = 40000040H; dataattr = 0C0000040H; relocattr = 42000040H;
VAR i, F, adr, acodesize, compver, version, stkalloc, heapsize, heapalloc, filesize, filebuf: INTEGER;
cur: ASMLINE;
BEGIN
compver := 0;
version := 0;
stkalloc := stksize;
heapsize := 100000H;
heapalloc := 100000H;
acodesize := Align(codesize, 1000H) + 1000H;
adr := sys.ADR(rdata);
filesize := acodesize + Align(rdatasize, 1000H) + Align(datasize, 1000H) + Align(rcount, 1000H);
InitArray(adr, "5000000040000000000000003400000000000000000000006200000000000000");
InitArray(adr, "0000000000000000000000000000000000000000500000004000000000000000");
InitArray(adr, "A4014C6F61644C6962726172794100001F0147657450726F6341646472657373");
InitArray(adr, "00006B65726E656C33322E646C6C0000");
rdata[ 0] := acodesize + 50H;
rdata[ 1] := acodesize + 40H;
rdata[ 3] := acodesize + 34H;
rdata[ 6] := acodesize + 62H;
rdata[ 7] := acodesize;
rdata[13] := acodesize + 50H;
rdata[14] := acodesize + 40H;
adr := sys.ADR(Header.msdos);
InitArray(adr, "4D5A90000300000004000000FFFF0000B8000000000000004000000000000000");
InitArray(adr, "00000000000000000000000000000000000000000000000000000000B0000000");
InitArray(adr, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F");
InitArray(adr, "742062652072756E20696E20444F53206D6F64652E0D0D0A2400000000000000");
InitArray(adr, "5DCF9F8719AEF1D419AEF1D419AEF1D497B1E2D413AEF1D4E58EE3D418AEF1D4");
InitArray(adr, "5269636819AEF1D4000000000000000050450000");
Header.typecomp := IntToCard16(014CH);
IF dll THEN
Header.seccount := IntToCard16(0004H);
Header.infflags := IntToCard16(210EH)
ELSE
Header.seccount := IntToCard16(0003H);
Header.infflags := IntToCard16(010FH)
END;
Header.time := UTILS.Date;
Header.PEoptsize := IntToCard16(00E0H);
Header.PEfile := IntToCard16(010BH);
Header.compver := IntToCard16(compver);
Header.codesize := Align(codesize, 200H);
Header.datasize := Align(datasize + gsize, 200H) + Align(rdatasize, 200H) + Align(rcount, 200H);
Header.startadr := 1000H;
Header.codeadr := 1000H;
Header.rdataadr := Header.codeadr + Align(codesize, 1000H);
Header.loadadr := LoadAdr;
Header.secalign := 1000H;
Header.filealign := 0200H;
Header.oldestver := 0004H;
Header.version := version;
Header.oldestverNT := 0004H;
Header.filesize := Align(codesize, 1000H) + Align(datasize + gsize, 1000H) + Align(rdatasize, 1000H) + Align(rcount, 1000H) + 1000H;
Header.headersize := 0400H;
Header.UI := IntToCard16(ORD(con) + 2);
Header.stksize := stksize;
Header.stkalloc := stkalloc;
Header.heapsize := heapsize;
Header.heapalloc := heapalloc;
Header.structcount := 10H;
IF dll THEN
Header.structs[0].adr := Header.rdataadr + 0DAH;
Header.structs[0].size := etable.size
END;
Header.structs[1].adr := Header.rdataadr + 0CH;
Header.structs[1].size := 28H;
Header.structs[12].adr := Header.rdataadr;
Header.structs[12].size := 0CH;
SetSection(Header.sections[0], ".text", codesize, 1000H, Align(codesize, 200H), 400H, textattr);
SetSection(Header.sections[1], ".rdata", rdatasize, Align(codesize, 1000H) + 1000H, Align(rdatasize, 200H),
Align(codesize, 200H) + 400H, rdataattr);
SetSection(Header.sections[2], ".data", datasize + gsize, Align(codesize, 1000H) + Align(rdatasize, 1000H) + 1000H,
Align(datasize, 200H), Align(codesize, 200H) + Align(rdatasize, 200H) + 400H, dataattr);
IF dll THEN
SetSection(RelocSection, ".reloc", rcount, Header.sections[2].adr + Align(datasize + gsize, 1000H), Align(rcount, 200H),
Header.sections[2].OAPfile + Align(datasize, 200H), relocattr);
Header.structs[5].adr := RelocSection.adr;
Header.structs[5].size := rcount
END;
F := UTILS.CreateF(FName);
IF F = 0 THEN
Err(1)
END;
OutFilePos := UTILS.GetMem(filesize);
filebuf := OutFilePos;
UTILS.MemErr(OutFilePos = 0);
Write(sys.ADR(Header), sys.SIZE(HEADER));
IF dll THEN
Write(sys.ADR(RelocSection), sys.SIZE(SECTION));
Fill(Align(sys.SIZE(HEADER) + sys.SIZE(SECTION), 200H) - (sys.SIZE(HEADER) + sys.SIZE(SECTION)), 0X)
ELSE
Fill(Align(sys.SIZE(HEADER), 200H) - sys.SIZE(HEADER), 0X)
END;
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
Write(sys.ADR(Code[cur.cmd]), cur.clen);
cur := cur.Next(ASMLINE)
END;
Fill(Align(codesize, 200H) - codesize, 0X);
Write(sys.ADR(rdata), 0DAH);
IF dll THEN
etable.time := Header.time;
Write(sys.ADR(etable), 40);
Write(sys.ADR(etable.arradr), etable.adrcount * 4);
Write(sys.ADR(etable.arrnameptr), etable.namecount * 4);
Write(sys.ADR(etable.arrnum), etable.namecount * 2);
Write(sys.ADR(etable.text), etable.textlen)
END;
Fill(Align(rdatasize, 200H) - rdatasize, 0X);
Write(sys.ADR(Data), datasize);
Fill(Align(datasize, 200H) - datasize, 0X);
IF dll THEN
Write(sys.ADR(Reloc), rcount);
Fill(Align(rcount, 200H) - rcount, 0X)
END;
WriteF(F, filebuf, OutFilePos - filebuf);
UTILS.CloseF(F)
END WritePE;
PROCEDURE New;
VAR nov: ASMLINE;
BEGIN
NEW(nov);
UTILS.MemErr(nov = NIL);
nov.cmd := ccount;
UTILS.Insert(asmlist, nov, current);
current := current.Next(ASMLINE)
END New;
PROCEDURE Empty(varadr: INTEGER);
BEGIN
New;
current.clen := 0;
current.tcmd := ECMD;
current.varadr := varadr
END Empty;
PROCEDURE OutByte(byte: INTEGER);
BEGIN
New;
current.clen := 1;
Code[ccount] := CHR(byte);
INC(ccount)
END OutByte;
PROCEDURE OutInt(int: INTEGER);
BEGIN
New;
current.clen := 4;
sys.PUT(sys.ADR(Code[ccount]), int);
INC(ccount, 4)
END OutInt;
PROCEDURE PushEAX;
BEGIN
OutByte(50H);
current.tcmd := PUSHEAX
END PushEAX;
PROCEDURE PushECX;
BEGIN
OutByte(51H);
current.tcmd := PUSHECX
END PushECX;
PROCEDURE PushEDX;
BEGIN
OutByte(52H);
current.tcmd := PUSHEDX
END PushEDX;
PROCEDURE PopEAX;
BEGIN
OutByte(58H);
current.tcmd := POPEAX
END PopEAX;
PROCEDURE PopECX;
BEGIN
OutByte(59H);
current.tcmd := POPECX
END PopECX;
PROCEDURE PopEDX;
BEGIN
OutByte(5AH);
current.tcmd := POPEDX
END PopEDX;
PROCEDURE OutCode(cmd: UTILS.STRING);
VAR a, b: INTEGER;
BEGIN
New;
a := sys.ADR(Code[ccount]);
b := a;
InitArray(a, cmd);
ccount := a - b + ccount;
current.clen := a - b
END OutCode;
PROCEDURE Del*(last: ASMLINE);
BEGIN
last.Next := current.Next;
IF current = asmlist.Last THEN
asmlist.Last := last
END;
current := last
END Del;
PROCEDURE NewLabel*(): INTEGER;
BEGIN
INC(Lcount)
RETURN Lcount
END NewLabel;
PROCEDURE PushCall*(asmline: ASMLINE);
BEGIN
New;
callstk[topstk][0] := asmline;
callstk[topstk][1] := current;
INC(topstk)
END PushCall;
PROCEDURE Param*;
BEGIN
current := callstk[topstk - 1][0]
END Param;
PROCEDURE EndCall*;
BEGIN
current := callstk[topstk - 1][1];
DEC(topstk)
END EndCall;
PROCEDURE Init*(UI: INTEGER);
VAR nov: ASMLINE;
BEGIN
dcount := 4;
dll := UI = 1;
gui := UI = 2;
con := UI = 3;
kos := UI = 4;
elf := UI = 5;
obj := UI = 6;
Lcount := HALT;
asmlist := UTILS.CreateList();
NEW(nov);
UTILS.MemErr(nov = NIL);
UTILS.Push(asmlist, nov);
current := nov;
END Init;
PROCEDURE datastr(str: UTILS.STRING);
VAR i, n: INTEGER;
BEGIN
i := 0;
n := LEN(str);
WHILE (i < n) & (str[i] # 0X) DO
Data[dcount] := str[i];
INC(dcount);
INC(i)
END;
Data[dcount] := 0X;
INC(dcount)
END datastr;
PROCEDURE dataint(n: INTEGER);
BEGIN
sys.PUT(sys.ADR(Data[dcount]), n);
INC(dcount, 4)
END dataint;
PROCEDURE jmp*(jamp: CHAR; label: INTEGER);
VAR n: INTEGER;
BEGIN
New;
CASE jamp OF
|JMP, CALL:
n := 5
|JE, JLE, JGE, JG, JL, JNE:
Code[ccount] := 0FX;
INC(ccount);
n := 6
ELSE
END;
current.clen := n;
Code[ccount] := jamp;
INC(ccount);
current.codeadr := sys.ADR(Code[ccount]);
current.varadr := sys.ADR(Labels[label]);
current.tcmd := JCMD;
current.short := TRUE;
INC(ccount, 4)
END jmp;
PROCEDURE jmplong(jamp: CHAR; label: INTEGER);
BEGIN
jmp(jamp, label);
current.short := FALSE
END jmplong;
PROCEDURE Label*(label: INTEGER);
BEGIN
New;
current.varadr := sys.ADR(Labels[label]);
current.tcmd := LCMD
END Label;
PROCEDURE CmdN(Number: INTEGER);
BEGIN
New;
current.clen := 4;
current.codeadr := sys.ADR(Code[ccount]);
current.varadr := sys.ADR(Labels[Number]);
current.tcmd := OCMD;
INC(ccount, 4)
END CmdN;
PROCEDURE IntByte(bytecode, intcode: UTILS.STRING; n: INTEGER);
BEGIN
IF (n <= 127) & (n >= -128) THEN
OutCode(bytecode);
OutByte(n)
ELSE
OutCode(intcode);
OutInt(n)
END
END IntByte;
PROCEDURE DropFpu*(long: BOOLEAN);
BEGIN
IF long THEN
OutCode("83EC08DD1C24")
ELSE
OutCode("83EC04D91C24")
END;
DEC(fpu)
END DropFpu;
PROCEDURE AfterRet(func, float: BOOLEAN; callconv, parsize: INTEGER);
BEGIN
IF callconv = cdecl THEN
OutCode("81C4");
OutInt(parsize)
END;
IF func THEN
IF float THEN
OutCode("83EC08DD1C24")
ELSE
PushEAX
END
END
END AfterRet;
PROCEDURE FpuSave(local: INTEGER);
VAR i: INTEGER;
BEGIN
IF fpu > maxfpu THEN
maxfpu := fpu
END;
FOR i := 1 TO fpu DO
IntByte("DD5D", "DD9D", -local - i * 8)
END
END FpuSave;
PROCEDURE Incfpu;
BEGIN
IF fpu >= FREGS THEN
UTILS.ErrMsgPos(SCAN.coord.line, SCAN.coord.col, 97);
UTILS.HALT(1)
END;
INC(fpu);
isfpu := TRUE
END Incfpu;
PROCEDURE FpuLoad(local: INTEGER; float: BOOLEAN);
VAR i: INTEGER;
BEGIN
FOR i := fpu TO 1 BY -1 DO
IntByte("DD45", "DD85", -local - i * 8)
END;
IF float THEN
Incfpu;
OutCode("DD042483C408")
END
END FpuLoad;
PROCEDURE Call*(proc: INTEGER; func, float: BOOLEAN; callconv, ccall, bases, level, parsize, local: INTEGER);
VAR i: INTEGER;
BEGIN
IF ccall # 0 THEN
FOR i := level TO level - bases + ORD(ccall = 1) + 1 BY -1 DO
IntByte("FF75", "FFB5", 4 * i + 4)
END;
IF ccall = 1 THEN
OutByte(55H)
END
END;
FpuSave(local);
jmplong(CALL, proc);
AfterRet(func, float, callconv, parsize);
FpuLoad(local, func & float)
END Call;
PROCEDURE CallRTL(Proc: INTEGER);
BEGIN
New;
current.clen := 5;
Code[ccount] := CALL;
INC(ccount);
current.codeadr := sys.ADR(Code[ccount]);
current.varadr := sys.ADR(RtlProc[Proc]);
current.tcmd := JCMD;
INC(ccount, 4)
END CallRTL;
PROCEDURE PushInt*(n: INTEGER);
BEGIN
OutByte(68H);
CmdN(n)
END PushInt;
PROCEDURE Prolog*(exename: UTILS.STRING);
BEGIN
ExecName := exename;
Labels[hInstance] := -dcount;
dataint(0);
Labels[SELFNAME] := -dcount;
datastr(exename);
Label(START);
IF dll THEN
OutCode("558BEC837D0C007507");
CallRTL(_close);
OutCode("EB06837D0C017409B801000000C9C20C00")
ELSIF obj THEN
OutCode("558BEC")
END;
start := asmlist.Last(ASMLINE)
END Prolog;
PROCEDURE AddRec*(base: INTEGER);
BEGIN
INC(reccount);
recarray[reccount] := base
END AddRec;
PROCEDURE CmpOpt(inv: BOOLEAN): INTEGER;
VAR cur: ASMLINE; c: INTEGER;
BEGIN
c := ORD(Code[current.Prev.Prev(ASMLINE).cmd]);
IF inv THEN
IF ODD(c) THEN
DEC(c)
ELSE
INC(c)
END
END;
cur := current;
REPEAT
cur.tcmd := 0;
cur.clen := 0;
cur := cur.Prev(ASMLINE)
UNTIL cur.tcmd = ICMP1;
cur.tcmd := 0;
cur.clen := 0
RETURN c - 16
END CmpOpt;
PROCEDURE ifwh*(L: INTEGER);
VAR c: INTEGER;
BEGIN
IF current.Prev(ASMLINE).tcmd = ICMP2 THEN
c := CmpOpt(TRUE);
OutCode("5A583BC2");
jmp(CHR(c), L)
ELSE
PopECX;
OutCode("85C9");
jmp(JE, L)
END
END ifwh;
PROCEDURE PushConst*(Number: INTEGER);
BEGIN
IntByte("6A", "68", Number);
current.Prev(ASMLINE).varadr := Number
END PushConst;
PROCEDURE IfWhile*(L: INTEGER; orop: BOOLEAN);
VAR c, L1: INTEGER;
BEGIN
L1 := NewLabel();
IF current.Prev(ASMLINE).tcmd = ICMP2 THEN
c := CmpOpt(orop);
OutCode("5A583BC2");
jmp(CHR(c), L1);
PushConst(ORD(orop))
ELSE
PopECX;
OutCode("85C9");
IF orop THEN
jmp(JE, L1)
ELSE
jmp(JNE, L1)
END;
PushECX
END;
jmp(JMP, L);
Label(L1)
END IfWhile;
PROCEDURE newrec*;
BEGIN
CallRTL(_newrec)
END newrec;
PROCEDURE disprec*;
BEGIN
CallRTL(_disprec)
END disprec;
PROCEDURE String*(Number, Len: INTEGER; str: UTILS.STRING);
BEGIN
Labels[Number] := -dcount;
IF Len > 1 THEN
datastr(str)
ELSIF Len = 1 THEN
dataint(ORD(str[0]))
ELSE
dataint(0)
END
END String;
PROCEDURE InsertFpuInit;
VAR t: ASMLINE;
BEGIN
IF isfpu THEN
t := current;
current := fpucmd;
IF maxfpu > 0 THEN
OutCode("83EC");
OutByte(maxfpu * 8)
END;
OutCode("DBE3");
current := t
END
END InsertFpuInit;
PROCEDURE ProcBeg*(Number, Local: INTEGER; Module: BOOLEAN);
VAR i: INTEGER;
BEGIN
IF Module THEN
OutCode("EB0C");
Label(Number + 3);
PushInt(Number + 2);
jmplong(JMP, HALT);
Label(Number + 1)
ELSE
Label(Number)
END;
OutCode("558BEC");
IF Local > 12 THEN
IntByte("83EC", "81EC", Local);
OutCode("8BD733C08BFCB9");
OutInt(ASR(Local, 2));
OutCode("9CFCF3AB8BFA9D")
ELSE
FOR i := 4 TO Local BY 4 DO
OutCode("6A00")
END
END;
fpucmd := current;
fpu := 0;
maxfpu := 0;
isfpu := FALSE
END ProcBeg;
PROCEDURE Leave*;
BEGIN
OutByte(0C9H);
InsertFpuInit
END Leave;
PROCEDURE ProcEnd*(Number, Param: INTEGER; func, float: BOOLEAN);
BEGIN
IF func & ~float THEN
PopEAX
END;
OutByte(0C9H);
IF Param = 0 THEN
OutByte(0C3H)
ELSE
OutByte(0C2H);
OutByte(Param MOD 256);
OutByte(ASR(Param, 8))
END;
InsertFpuInit
END ProcEnd;
PROCEDURE Module*(Name: UTILS.STRING; Number: INTEGER);
BEGIN
String(Number + 2, LENGTH(Name), Name);
jmplong(JMP, Number + 1)
END Module;
PROCEDURE Asm*(s: UTILS.STRING);
BEGIN
OutCode(s)
END Asm;
PROCEDURE GlobalAdr*(offset: INTEGER);
BEGIN
OutByte(0BAH);
OutInt(offset);
current.codeadr := sys.ADR(Code[ccount - 4]);
current.tcmd := GCMD;
PushEDX
END GlobalAdr;
PROCEDURE Mono*(Number: INTEGER);
BEGIN
PopEDX;
PushInt(Number)
END Mono;
PROCEDURE StrMono*;
BEGIN
PopEDX;
OutCode("6A02");
PushEDX
END StrMono;
PROCEDURE Not*;
BEGIN
PopECX;
OutCode("85C90F94C1");
PushECX
END Not;
PROCEDURE NegSet*;
BEGIN
OutCode("F71424")
END NegSet;
PROCEDURE Int*(Op: INTEGER);
BEGIN
PopEDX;
CASE Op OF
|lxPlus: OutCode("011424")
|lxMinus: OutCode("291424")
|lxMult: OutCode("58F7EA"); PushEAX
ELSE
END
END Int;
PROCEDURE Set*(Op: INTEGER);
BEGIN
PopEDX;
OutByte(58H);
CASE Op OF
|lxPlus: OutByte(0BH)
|lxMinus: OutCode("F7D223")
|lxMult: OutByte(23H)
|lxSlash: OutByte(33H)
ELSE
END;
OutByte(0C2H);
PushEAX
END Set;
PROCEDURE Setfpu*(newfpu: INTEGER);
BEGIN
fpu := newfpu
END Setfpu;
PROCEDURE PushFlt*(x: LONGREAL);
VAR f: TFLT; L: INTEGER;
BEGIN
sys.PUT(sys.ADR(f), x);
Incfpu;
IF x = 0.0D0 THEN
OutCode("D9EE")
ELSIF x = 1.0D0 THEN
OutCode("D9E8")
ELSE
L := NewLabel();
Labels[L] := -dcount;
dataint(f[0]);
dataint(f[1]);
OutByte(0BAH);
CmdN(L);
OutCode("DD02")
END
END PushFlt;
PROCEDURE farith*(op: INTEGER);
VAR n: INTEGER;
BEGIN
OutByte(0DEH);
CASE op OF
|lxPlus: n := 0C1H
|lxMinus: n := 0E9H
|lxMult: n := 0C9H
|lxSlash: n := 0F9H
ELSE
END;
OutByte(n);
DEC(fpu)
END farith;
PROCEDURE fcmp*(Op: INTEGER);
VAR n: INTEGER;
BEGIN
OutCode("33C9DED9DFE09E0F");
CASE Op OF
|lxEQ: n := 94H
|lxNE: n := 95H
|lxLT: n := 97H
|lxGT: n := 92H
|lxLE: n := 93H
|lxGE: n := 96H
ELSE
END;
DEC(fpu, 2);
OutByte(n);
OutByte(0C1H);
PushECX
END fcmp;
PROCEDURE fneg*;
BEGIN
OutCode("D9E0")
END fneg;
PROCEDURE OnError*(n: INTEGER);
BEGIN
OutByte(68H);
OutInt(LSL(UTILS.Line, 4) + n);
jmplong(JMP, UTILS.Unit + 3)
END OnError;
PROCEDURE idivmod*(opmod: BOOLEAN);
BEGIN
PopECX;
IF opmod THEN
OutCode("58E32E538BD833D9C1FB1F8BD0C1FA1F83F9FF750C3D0000008075055B6A00EB1AF7F985DB740685D2740203D15B52EB0A")
ELSE
OutCode("58E32C538BD833D9C1FB1F8BD0C1FA1F83F9FF750B3D0000008075045B50EB19F7F985DB740585D27401485B50EB0A")
END;
OnError(8)
END idivmod;
PROCEDURE rset*;
BEGIN
CallRTL(_rset);
PushEAX
END rset;
PROCEDURE inset*;
BEGIN
CallRTL(_inset);
PushEAX
END inset;
PROCEDURE Dup*;
BEGIN
PopEDX;
PushEDX;
PushEDX
END Dup;
PROCEDURE Inclusion*(Op: INTEGER);
BEGIN
PopEDX;
PopEAX;
IF Op = lxLE THEN
PushEDX
ELSE
PushEAX
END;
OutCode("0BC25933C8E3046A00EB026A01")
END Inclusion;
PROCEDURE NegInt*;
BEGIN
OutCode("F71C24")
END NegInt;
PROCEDURE CmpInt*(Op: INTEGER);
VAR n: INTEGER;
BEGIN
OutCode("33C95A583BC20F"); current.tcmd := ICMP1;
CASE Op OF
|lxEQ: n := 94H
|lxNE: n := 95H
|lxLT: n := 9CH
|lxGT: n := 9FH
|lxLE: n := 9EH
|lxGE: n := 9DH
ELSE
END;
OutByte(n);
OutByte(0C1H); current.tcmd := ICMP2;
PushECX;
END CmpInt;
PROCEDURE CallVar*(func, float: BOOLEAN; callconv, parsize, local: INTEGER);
BEGIN
PopEDX;
OutCode("8B1285D2750A");
OnError(2);
FpuSave(local);
OutCode("FFD2");
AfterRet(func, float, callconv, parsize);
FpuLoad(local, func & float)
END CallVar;
PROCEDURE LocalAdr*(offset, bases: INTEGER);
BEGIN
IF bases = 0 THEN
Empty(offset);
OutCode("8BD5")
ELSE
IntByte("8B55", "8B95", 4 * bases + 4)
END;
IntByte("83C2", "81C2", offset);
PushEDX;
IF bases = 0 THEN
Empty(offset)
END
END LocalAdr;
PROCEDURE Field*(offset: INTEGER);
BEGIN
IF offset # 0 THEN
IntByte("830424", "810424", offset)
END
END Field;
PROCEDURE DerefType*(n: INTEGER);
BEGIN
IntByte("8B5424", "8B9424", n);
OutCode("FF72FC")
END DerefType;
PROCEDURE Guard*(T: INTEGER; Check: BOOLEAN);
BEGIN
IF Check THEN
PopEAX;
OutCode("85C074");
IF T <= 127 THEN
OutByte(9)
ELSE
OutByte(12)
END;
PushEAX
END;
PushConst(T);
PushEAX;
CallRTL(_checktype);
IF Check THEN
PushEAX
ELSE
OutCode("85C0750A");
OnError(3)
END
END Guard;
PROCEDURE StProc*(proc: INTEGER);
BEGIN
CASE proc OF
|stINC: PopEDX; OutCode("590111")
|stDEC: PopEDX; OutCode("592911")
|stINC1: PopEDX; OutCode("FF02")
|stDEC1: PopEDX; OutCode("FF0A")
|stINCL: PopEDX; OutCode("580910")
|stEXCL: PopEDX; OutCode("582110")
|stPACK: OutCode("DB04245A5ADD02D9FDDD1A"); isfpu := TRUE
|stPACK1: OutCode("DB04245A5AD902D9FDD91A"); isfpu := TRUE
|stUNPK: PopEDX; OutCode("59DD01D9F4DD19DB1A"); isfpu := TRUE
|stUNPK1: PopEDX; OutCode("59D901D9F4D919DB1A"); isfpu := TRUE
|stCOPY: CallRTL(_strcopy)
|sysMOVE: CallRTL(_savearr)
ELSE
END
END StProc;
PROCEDURE Assert*(proc, assrt: INTEGER);
BEGIN
PopEDX;
OutCode("85D2751368");
OutInt(UTILS.Line * 16 + 1);
PushInt(UTILS.Unit + 2);
IF proc = stASSERT THEN
OutCode("6A026A")
ELSE
OutCode("6A016A")
END;
OutByte(assrt);
jmplong(JMP, ASSRT)
END Assert;
PROCEDURE StFunc*(func: INTEGER);
BEGIN
CASE func OF
|stABS: PopEDX; OutCode("85D27D02F7DA"); PushEDX
|stFABS: OutCode("D9E1")
|stFLT: OutCode("DB0424"); PopEAX; Incfpu;
|stFLOOR: jmplong(CALL, _floor); PushEAX; DEC(fpu)
|stODD: OutCode("83242401")
|stROR: PopECX; OutCode("58D3C8"); PushEAX
|stASR: PopECX; OutCode("58D3F8"); PushEAX
|stLSL: PopECX; OutCode("58D3E0"); PushEAX
|stLSR: PopECX; OutCode("58D3E8"); PushEAX
|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX
|stLENGTH: CallRTL(_length); PushEAX
ELSE
END
END StFunc;
PROCEDURE Load*(T: INTEGER);
VAR lastcmd: ASMLINE; offset: INTEGER;
PROCEDURE del;
BEGIN
lastcmd.tcmd := 0;
offset := lastcmd.varadr;
lastcmd := lastcmd.Prev(ASMLINE);
WHILE lastcmd.tcmd # ECMD DO
lastcmd.clen := 0;
lastcmd.tcmd := 0;
lastcmd := lastcmd.Prev(ASMLINE)
END;
lastcmd.tcmd := 0
END del;
BEGIN
lastcmd := current;
CASE T OF
|TINTEGER, TSET, TPOINTER, TPROC:
IF lastcmd.tcmd = ECMD THEN
del;
IntByte("8B55", "8B95", offset);
PushEDX
ELSE
PopEDX;
OutCode("FF32")
END
|TCHAR, TBOOLEAN:
IF lastcmd.tcmd = ECMD THEN
del;
OutCode("33D28A");
IntByte("55", "95", offset);
PushEDX
ELSE
PopEDX;
OutCode("33C98A0A");
PushECX
END
|TLONGREAL:
IF lastcmd.tcmd = ECMD THEN
del;
IntByte("DD45", "DD85", offset)
ELSE
PopEDX;
OutCode("DD02")
END;
Incfpu
|TREAL:
IF lastcmd.tcmd = ECMD THEN
del;
IntByte("D945", "D985", offset)
ELSE
PopEDX;
OutCode("D902")
END;
Incfpu
|TCARD16:
IF lastcmd.tcmd = ECMD THEN
del;
OutCode("33D2668B");
IntByte("55", "95", offset);
PushEDX
ELSE
PopEDX;
OutCode("33C9668B0A");
PushECX
END
ELSE
END
END Load;
PROCEDURE Save*(T: INTEGER);
BEGIN
CASE T OF
|TINTEGER, TSET, TPOINTER, TPROC:
PopEDX;
OutCode("588910")
|TCHAR, TSTRING, TBOOLEAN:
PopEDX;
OutCode("588810")
|TCARD16:
PopEDX;
OutCode("58668910")
|TLONGREAL:
PopEDX;
OutCode("DD1A");
DEC(fpu)
|TREAL:
PopEDX;
OutCode("D91A");
DEC(fpu)
|TRECORD:
CallRTL(_saverec);
OutCode("85C0750A");
OnError(4)
|TARRAY:
CallRTL(_savearr)
ELSE
END
END Save;
PROCEDURE OpenArray*(A: TIDX; n: INTEGER);
VAR i: INTEGER;
BEGIN
PopEDX;
FOR i := n - 1 TO 0 BY -1 DO
PushConst(A[i])
END;
PushEDX
END OpenArray;
PROCEDURE OpenIdx*(n: INTEGER);
BEGIN
OutByte(54H);
IF n > 1 THEN
PushConst(n);
CallRTL(_arrayidx)
ELSE
CallRTL(_arrayidx1)
END;
PopEDX;
OutCode("85D2750A");
OnError(5);
PushEDX;
END OpenIdx;
PROCEDURE FixIdx*(len, size: INTEGER);
BEGIN
PopEDX;
IntByte("5983FA", "5981FA", len);
OutCode("720A");
OnError(5);
IF size > 1 THEN
IntByte("6BD2", "69D2", size)
END;
OutCode("03D1");
PushEDX
END FixIdx;
PROCEDURE Idx*;
BEGIN
PopEDX;
PopECX;
OutCode("03D1");
PushEDX
END Idx;
PROCEDURE DupLoadCheck*;
BEGIN
PopEDX;
OutCode("528B125285D2750A");
OnError(6)
END DupLoadCheck;
PROCEDURE DupLoad*;
BEGIN
PopEDX;
OutCode("528B12");
PushEDX;
END DupLoad;
PROCEDURE CheckNIL*;
BEGIN
PopEDX;
OutCode("85D2750A");
OnError(6);
PushEDX;
END CheckNIL;
PROCEDURE ExtArray*(A: TIDX; n, m: INTEGER);
VAR i: INTEGER;
BEGIN
FOR i := n - 1 TO 0 BY -1 DO
PushConst(A[i])
END;
OutByte(54H);
PushConst(n);
PushConst(m);
CallRTL(_arrayrot)
END ExtArray;
PROCEDURE ADR*(dim: INTEGER);
BEGIN
IF dim > 0 THEN
PopEDX;
OutCode("83C4");
OutByte(dim * 4);
PushEDX
END
END ADR;
PROCEDURE Len*(dim: INTEGER);
BEGIN
PopEDX;
IF dim < 0 THEN
PushConst(-dim)
ELSIF dim > 1 THEN
PopEDX;
OutCode("83C4");
OutByte((dim - 1) * 4);
PushEDX
END
END Len;
PROCEDURE For*(inc: BOOLEAN; VAR LBeg, LEnd: INTEGER);
BEGIN
LEnd := NewLabel();
LBeg := NewLabel();
Label(LBeg);
OutCode("8B14248B4424043910");
IF inc THEN
jmp(JG, LEnd)
ELSE
jmp(JL, LEnd)
END
END For;
PROCEDURE NextFor*(step, LBeg, LEnd: INTEGER);
BEGIN
OutCode("8B542404");
IF step = 1 THEN
OutCode("FF02")
ELSIF step = -1 THEN
OutCode("FF0A")
ELSE
IntByte("8302", "8102", step)
END;
jmp(JMP, LBeg);
Label(LEnd);
OutCode("83C408")
END NextFor;
PROCEDURE CaseLabel*(a, b, LBeg: INTEGER);
VAR L: INTEGER;
BEGIN
L := NewLabel();
IntByte("83FA", "81FA", a);
IF a = b THEN
jmp(JNE, L)
ELSE
jmp(JL, L);
IntByte("83FA", "81FA", b);
jmp(JG, L)
END;
jmp(JMP, LBeg);
Label(L)
END CaseLabel;
PROCEDURE Drop*;
BEGIN
PopEDX
END Drop;
PROCEDURE strcmp*(Op, LR: INTEGER);
BEGIN
CASE Op OF
|lxEQ: PushConst(0)
|lxNE: PushConst(1)
|lxLT: PushConst(2)
|lxGT: PushConst(3)
|lxLE: PushConst(4)
|lxGE: PushConst(5)
ELSE
END;
CASE LR OF
|-1: CallRTL(_lstrcmp)
| 0: CallRTL(_strcmp)
| 1: CallRTL(_rstrcmp)
ELSE
END;
PushEAX
END strcmp;
PROCEDURE Optimization;
VAR cur: ASMLINE; flag: BOOLEAN;
BEGIN
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
flag := FALSE;
CASE cur.tcmd OF
|PUSHEAX:
flag := cur.Next(ASMLINE).tcmd = POPEAX
|PUSHECX:
flag := cur.Next(ASMLINE).tcmd = POPECX
|PUSHEDX:
flag := cur.Next(ASMLINE).tcmd = POPEDX
ELSE
END;
IF flag THEN
cur.clen := 0;
cur.tcmd := 0;
cur := cur.Next(ASMLINE);
cur.clen := 0;
cur.tcmd := 0
END;
cur := cur.Next(ASMLINE)
END
END Optimization;
PROCEDURE WriteKOS(FName: ARRAY OF CHAR; stk, size, datasize, gsize: INTEGER; obj: BOOLEAN);
CONST strsize = 2048;
VAR Header: KOSHEADER; F, i, filesize, filebuf, a, sec, adr, size2: INTEGER; cur: ASMLINE;
Coff: COFFHEADER; sym: ARRAY 18 * 4 OF CHAR; FileName: UTILS.STRING;
BEGIN
F := UTILS.CreateF(FName);
IF F <= 0 THEN
Err(1)
END;
OutFilePos := UTILS.GetMem(Align(size, 4) + datasize + 1000H);
filebuf := OutFilePos;
UTILS.MemErr(OutFilePos = 0);
IF ~obj THEN
Header.menuet01 := "MENUET01";
Header.ver := 1;
Header.start := sys.SIZE(KOSHEADER);
Header.size := Align(size, 4) + datasize;
Header.mem := Header.size + stk + gsize + strsize * 2 + 1000H;
Header.sp := Header.size + gsize + stk;
Header.param := Header.sp;
Header.path := Header.param + strsize;
Write(sys.ADR(Header), sys.SIZE(KOSHEADER));
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
Write(sys.ADR(Code[cur.cmd]), cur.clen);
cur := cur.Next(ASMLINE)
END;
Fill(Align(size, 4) - size, 0X);
Write(sys.ADR(Data), datasize);
WriteF(F, filebuf, OutFilePos - filebuf)
ELSE
size2 := size;
size := Align(size, 4) - sys.SIZE(KOSHEADER);
Coff.Machine := IntToCard16(014CH);
Coff.NumberOfSections := IntToCard16(3);
Coff.TimeDateStamp := UTILS.Date;
Coff.SizeOfOptionalHeader := IntToCard16(0);
Coff.Characteristics := IntToCard16(0184H);
Coff.text.name := ".flat";
Coff.text.size := 0;
Coff.text.adr := 0;
Coff.text.sizealign := size;
Coff.text.OAPfile := 8CH;
Coff.text.reserved6 := size + datasize + 8CH;
Coff.text.reserved7 := 0;
Coff.text.attrflags := 40300020H;
Coff.data.name := ".data";
Coff.data.size := 0;
Coff.data.adr := 0;
Coff.data.sizealign := datasize;
Coff.data.OAPfile := size + 8CH;
Coff.data.reserved6 := 0;
Coff.data.reserved7 := 0;
Coff.data.reserved8 := 0;
Coff.data.attrflags := 0C0300040H;
Coff.bss.name := ".bss";
Coff.bss.size := 0;
Coff.bss.adr := 0;
Coff.bss.sizealign := gsize;
Coff.bss.OAPfile := 0;
Coff.bss.reserved6 := 0;
Coff.bss.reserved7 := 0;
Coff.bss.reserved8 := 0;
Coff.bss.attrflags := 0C03000C0H;
size := Align(size2, 4);
rcount := 0;
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
IF cur.tcmd IN {OCMD, GCMD} THEN
sys.GET(sys.ADR(Code[cur.cmd]), a);
IF a < size THEN
a := a - sys.SIZE(KOSHEADER);
sec := 1
ELSIF a < size + datasize THEN
a := a - size;
sec := 2
ELSE
a := a - size - datasize;
sec := 3
END;
sys.PUT(sys.ADR(Code[cur.cmd]), a);
sys.PUT(sys.ADR(Reloc[rcount]), cur.adr - sys.SIZE(KOSHEADER));
INC(rcount, 4);
sys.PUT(sys.ADR(Reloc[rcount]), sec);
INC(rcount, 4);
sys.PUT(sys.ADR(Reloc[rcount]), 06X); INC(rcount);
sys.PUT(sys.ADR(Reloc[rcount]), 00X); INC(rcount);
END;
Write(sys.ADR(Code[cur.cmd]), cur.clen);
cur := cur.Next(ASMLINE)
END;
size := size2;
Fill(Align(size, 4) - size2, 0X);
Write(sys.ADR(Data), datasize);
Coff.text.reserved8 := rcount DIV 10;
Coff.PointerToSymbolTable := Coff.text.reserved6 + rcount;
Coff.NumberOfSymbols := 4;
WriteF(F, sys.ADR(Coff), sys.SIZE(COFFHEADER));
WriteF(F, filebuf, OutFilePos - filebuf);
WriteF(F, sys.ADR(Reloc), rcount);
adr := sys.ADR(sym);
InitArray(adr, "4558504F52545300000000000100000002002E666C617400000000000000010000000300");
InitArray(adr, "2E64617461000000000000000200000003002E6273730000000000000000030000000300");
sys.PUT(sys.ADR(sym) + 8, Labels[Exports] - sys.SIZE(KOSHEADER));
WriteF(F, sys.ADR(sym), LEN(sym));
i := 4;
WriteF(F, sys.ADR(i), 4)
END;
UTILS.CloseF(F)
END WriteKOS;
PROCEDURE WriteELF(FName: ARRAY OF CHAR; code, data, glob: INTEGER);
VAR F, delta, filebuf: INTEGER; cur: ASMLINE; bytes: ARRAY 817H + 55FH + 4900 OF CHAR;
PROCEDURE Add(offset: INTEGER);
VAR m: INTEGER;
BEGIN
sys.GET(sys.ADR(bytes[offset]), m);
sys.PUT(sys.ADR(bytes[offset]), m + delta)
END Add;
PROCEDURE Sub(offset: INTEGER);
VAR m: INTEGER;
BEGIN
sys.GET(sys.ADR(bytes[offset]), m);
sys.PUT(sys.ADR(bytes[offset]), m - delta)
END Sub;
PROCEDURE Add8(a1, a2, a3, a4, a5, a6, a7, a8: INTEGER);
BEGIN
Add(a1); Add(a2); Add(a3); Add(a4);
Add(a5); Add(a6); Add(a7); Add(a8)
END Add8;
BEGIN
sys.MOVE(ELF.get(), sys.ADR(bytes[0]), ELF.size);
DEC(code, 13);
delta := Align(data, 1000H) - 100000H;
Add8(0020H, 00A4H, 00A8H, 0258H, 02B8H, 0308H, 0494H, 049CH);
Add8(04A4H, 0679H, 0681H, 06A4H, 06B0H, 06BAH, 0703H, 0762H);
Add8(0774H, 0786H, 0819H, 0823H, 17C5H, 17E5H, 17E9H, 1811H);
Add8(1839H, 1861H, 1889H, 1A25H, 1A95H, 1AA5H, 1C05H, 1C55H);
Add(1CE5H); Add(1D09H); Add(1D15H); Add(1D25H); Add(1D35H); Add(1D55H);
delta := Align(glob, 1000H) - 3200000H;
Add(00A8H); Add(17EDH); Add(1C09H); Add(1D25H);
delta := Align(code, 1000H) - 100000H;
Add8(0020H, 0084H, 0088H, 0098H, 009CH, 00A0H, 00B8H, 00BCH);
Add8(00C0H, 0118H, 011CH, 0120H, 0258H, 0278H, 02B8H, 0308H);
Add8(048CH, 0494H, 049CH, 04A4H, 04ACH, 04B4H, 04BCH, 04C4H);
Add8(04CCH, 04D4H, 04DCH, 04E4H, 04ECH, 04F4H, 04FCH, 0504H);
Add8(050CH, 0514H, 052BH, 0544H, 054EH, 0554H, 055EH, 056EH);
Add8(057EH, 058EH, 059EH, 05AEH, 05BEH, 05CEH, 05DEH, 05EEH);
Add8(05FEH, 060EH, 061EH, 062EH, 064CH, 0651H, 0679H, 0681H);
Add8(0686H, 068CH, 06A4H, 06ABH, 06B0H, 06BAH, 06D7H, 06EBH);
Add8(0703H, 0762H, 0774H, 0786H, 0819H, 0823H, 0828H, 082DH);
Add8(1635H, 1655H, 1659H, 167DH, 1681H, 16A5H, 16A9H, 16CDH);
Add8(16D1H, 16F5H, 16F9H, 171DH, 1721H, 1745H, 1749H, 176DH);
Add8(1771H, 1795H, 1799H, 17BDH, 17C1H, 17E5H, 17E9H, 1811H);
Add8(1839H, 1861H, 1889H, 1985H, 1995H, 19A5H, 19B5H, 19C5H);
Add8(19D5H, 19E5H, 19F5H, 1A05H, 1A15H, 1A25H, 1A55H, 1A65H);
Add8(1A75H, 1A95H, 1AA5H, 1AD5H, 1AE5H, 1AF5H, 1B05H, 1B25H);
Add8(1B35H, 1B45H, 1B55H, 1B65H, 1B75H, 1BB5H, 1BC5H, 1BE5H);
Add8(1C05H, 1C15H, 1C55H, 1C75H, 1CA5H, 1CB5H, 1CE5H, 1D05H);
Add8(1D15H, 1D25H, 1D35H, 1D55H, 1D75H, 1D89H, 08DEH, 08E8H);
Sub(0845H); Sub(087BH); Sub(0916H); Add(0C52H); Add(0C8AH); Add(0D0AH);
OutFilePos := UTILS.GetMem(code + data + 8000H);
filebuf := OutFilePos;
UTILS.MemErr(OutFilePos = 0);
Write(sys.ADR(bytes), 817H);
Fill(2DDH, 90X);
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
Write(sys.ADR(Code[cur.cmd]), cur.clen);
cur := cur.Next(ASMLINE)
END;
Fill(Align(code, 1000H) - code, 90X);
Write(sys.ADR(bytes[817H]), 55FH);
Write(sys.ADR(Data), data);
Fill(Align(data, 1000H) - data, 0X);
Write(sys.ADR(bytes[817H + 55FH + 55FH]), 0DC5H);
F := UTILS.CreateF(FName);
IF F <= 0 THEN
Err(1)
END;
WriteF(F, filebuf, OutFilePos - filebuf);
UTILS.CloseF(F)
END WriteELF;
PROCEDURE DelProc*(beg, end: ASMLINE);
BEGIN
WHILE beg # end DO
beg.clen := 0;
beg.tcmd := 0;
beg := beg.Next(ASMLINE)
END;
beg.clen := 0;
beg.tcmd := 0
END DelProc;
PROCEDURE FixLabels*(FName: ARRAY OF CHAR; stk, gsize, glob: INTEGER);
VAR size, asize, i, rdatasize, RCount, n, temp, temp2, temp3: INTEGER; cur: ASMLINE; R: RELOC; c: CHAR;
BEGIN
dcount := Align(dcount, 4);
IF dll THEN
LoadAdr := 10000000H;
PackExport(ExecName)
ELSIF con OR gui THEN
LoadAdr := 400000H
ELSIF kos OR obj THEN
LoadAdr := sys.SIZE(KOSHEADER)
ELSIF elf THEN
LoadAdr := 134514420 + 1024;
INC(gsize, 1024)
END;
IF dll OR con OR gui THEN
rdatasize := 0DAH + etable.size;
size := 1000H + LoadAdr;
ELSIF kos OR elf OR obj THEN
rdatasize := 0;
size := LoadAdr
END;
Optimization;
temp2 := size;
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
cur.adr := size;
IF cur.tcmd = LCMD THEN
sys.PUT(cur.varadr, size)
END;
size := size + cur.clen;
cur := cur.Next(ASMLINE)
END;
size := temp2;
cur := asmlist.First(ASMLINE);
WHILE cur # NIL DO
cur.adr := size;
IF cur.tcmd = LCMD THEN
sys.PUT(cur.varadr, size)
ELSIF (cur.tcmd = JCMD) & cur.short THEN
sys.GET(cur.varadr, i);
temp3 := i - cur.Next(ASMLINE).adr;
IF (-131 <= temp3) & (temp3 <= 123) THEN
sys.GET(cur(ASMLINE).codeadr - 1, c);
IF c = JMP THEN
sys.PUT(cur(ASMLINE).codeadr - 1, 0EBX)
ELSE (*JE, JNE, JLE, JGE, JG, JL*)
sys.PUT(cur(ASMLINE).codeadr - 2, ORD(c) - 16);
sys.PUT(cur(ASMLINE).codeadr - 1, temp3);
DEC(cur(ASMLINE).codeadr)
END;
cur.clen := 2
END
END;
size := size + cur.clen;
cur := cur.Next(ASMLINE)
END;
IF dll OR con OR gui THEN
asize := Align(size, 1000H)
ELSIF kos OR obj THEN
asize := Align(size, 4)
ELSIF elf THEN
asize := 134514420 + 6508 + Align(size - 13 - LoadAdr, 1000H)
END;
FOR i := 0 TO Lcount DO
IF Labels[i] < 0 THEN
Labels[i] := -Labels[i] + asize + Align(rdatasize, 1000H)
END
END;
temp := dcount;
IF elf THEN
asize := asize + Align(dcount, 1000H) + 64 + 1024;
sys.PUT(sys.ADR(Code[glob + 1]), asize - 1024);
dcount := 0
END;
IF dll THEN
asize := asize - LoadAdr + 0DAH;
FOR i := 0 TO etable.namecount - 1 DO
etable.arradr[i] := Labels[etable.arradr[i]] - LoadAdr;
etable.arrnameptr[i] := etable.arrnameptr[i] + asize
END;
etable.arradroffset := etable.arradroffset + asize;
etable.arrnameptroffset := etable.arrnameptroffset + asize;
etable.arrnumoffset := etable.arrnumoffset + asize;
etable.dllnameoffset := etable.dllnameoffset + asize;
asize := asize + LoadAdr - 0DAH
END;
IF dll OR con OR gui THEN
Labels[LoadLibrary] := asize + 4;
Labels[GetProcAddress] := asize;
R.Page := 0;
R.Size := 0;
RCount := 0;
END;
cur := asmlist.First(ASMLINE);
FOR i := 0 TO LEN(RtlProc) - 1 DO
RtlProc[i] := Labels[RtlProc[i]]
END;
temp3 := asize + Align(rdatasize, 1000H) + dcount;
WHILE cur # NIL DO
CASE cur.tcmd OF
|JCMD:
sys.GET(cur.varadr, i);
sys.PUT(cur.codeadr, i - cur.Next(ASMLINE).adr)
|GCMD:
sys.GET(cur.codeadr, i);
sys.PUT(cur.codeadr, i + temp3)
|OCMD:
sys.MOVE(cur.varadr, cur.codeadr, 4)
ELSE
END;
IF dll & (cur.tcmd IN {GCMD, OCMD}) THEN
n := cur.adr - LoadAdr;
IF ASR(n, 12) = ASR(R.Page, 12) THEN
R.reloc[RCount] := IntToCard16(n MOD 1000H + 3000H);
INC(RCount);
INC(R.Size, 2)
ELSE
IF R.Size # 0 THEN
PutReloc(R)
END;
R.Page := ASR(n, 12) * 1000H;
R.Size := 10;
R.reloc[0] := IntToCard16(n MOD 1000H + 3000H);
RCount := 1
END
END;
cur := cur.Next(ASMLINE)
END;
IF R.Size # 0 THEN
PutReloc(R)
END;
IF dll OR con OR gui THEN
WritePE(FName, stk, size - 1000H - LoadAdr, dcount, rdatasize, gsize)
ELSIF kos OR obj THEN
WriteKOS(FName, Align(stk, 4), size, dcount, gsize, obj)
ELSIF elf THEN
WriteELF(FName, size - LoadAdr, temp, gsize)
END
END FixLabels;
PROCEDURE OutStringZ(str: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
New;
current.clen := LENGTH(str);
FOR i := 0 TO current.clen - 1 DO
Code[ccount] := str[i];
INC(ccount)
END;
Code[ccount] := 0X;
INC(ccount);
INC(current.clen)
END OutStringZ;
PROCEDURE Epilog*(gsize: INTEGER; FName: ARRAY OF CHAR; stk: INTEGER);
VAR i, glob: INTEGER;
BEGIN
glob := 0;
gsize := Align(gsize, 4) + 4;
COPY(FName, OutFile);
Labels[RTABLE] := -dcount;
dataint(recarray[0]);
FOR i := 1 TO reccount DO
dataint(recarray[i])
END;
current := start;
IF con OR gui OR dll THEN
PushInt(LoadLibrary);
PushInt(GetProcAddress);
OutCode("5859FF31FF3054")
ELSIF elf THEN
OutCode("6800000000");
glob := current.cmd;
ELSIF kos OR obj THEN
OutByte(54H)
END;
GlobalAdr(0);
PushConst(ASR(gsize, 2));
PushInt(RTABLE);
PushInt(SELFNAME);
CallRTL(_init);
current := asmlist.Last(ASMLINE);
IF dll THEN
OutCode("B801000000C9C20C00")
END;
IF obj THEN
OutCode("B801000000C9C20000")
END;
OutCode("EB05");
Label(ASSRT);
CallRTL(_assrt);
OutCode("EB09");
Label(HALT);
OutCode("6A006A00");
CallRTL(_assrt);
OutCode("6A00");
CallRTL(_halt);
Label(_floor);
OutCode("83EC06D93C2466812424FFF366810C24FFF7D92C2483C402D9FCDB1C2458C3");
IF obj THEN
Label(Exports);
CmdN(szSTART); CmdN(START);
CmdN(szversion); OutInt(stk);
FOR i := 0 TO kosexpcount - 1 DO
CmdN(kosexp[i].NameLabel); CmdN(kosexp[i].Adr)
END;
OutInt(0);
Label(szSTART); OutStringZ("lib_init");
Label(szversion); OutStringZ("version");
FOR i := 0 TO kosexpcount - 1 DO
Label(kosexp[i].NameLabel);
OutStringZ(kosexp[i].Name.Name)
END
END;
FixLabels(FName, stk, gsize, glob)
END Epilog;
END X86.
Reference in New Issue View Git Blame Copy Permalink