BlueGreycalmElegant

Català-Valencià – Catalan中文 – Chinese (Simplified)中文 – Chinese (Traditional)Česky – CzechDansk – DanishNederlands – DutchEnglish – EnglishSuomi – FinnishFrançais – FrenchDeutsch – Germanעברית – Hebrewहिंदी – HindiMagyar – HungarianBahasa Indonesia – IndonesianItaliano – Italian日本語 – Japanese한국어 – KoreanМакедонски – Macedonianमराठी – MarathiNorsk – NorwegianPolski – PolishPortuguês – PortuguesePortuguês – Portuguese (Brazil)Русский – RussianSlovenčina – SlovakSlovenščina – SlovenianEspañol – SpanishSvenska – SwedishTürkçe – TurkishУкраїнська – UkrainianOëzbekcha – Uzbek

Compare Revisions

• This comparison shows the changes necessary to convert path

  → /programs/develop/oberon07/Source @ 7696

  → /programs/develop/oberon07/Source @ 7983

  ↔ Reverse comparison

• Compare Path:	Rev

  With Path:	Rev

Regard whitespace Rev 7696 → Rev 7983

/programs/develop/oberon07/Source/CONSTANTS.ob07
File deleted

/programs/develop/oberon07/Source/AMD64.ob07
1,14 → 1,14
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE AMD64;
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG,
REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86;
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, TARGETS,
REG, C := CONSOLE, UTILS, S := STRINGS, PE32, ELF, X86;
CONST
74,25 → 74,25
PROCEDURE OutByte2 (a, b: BYTE);
BEGIN
OutByte(a);
OutByte(b)
X86.OutByte(a);
X86.OutByte(b)
END OutByte2;
PROCEDURE OutByte3 (a, b, c: BYTE);
BEGIN
OutByte(a);
OutByte(b);
OutByte(c)
X86.OutByte(a);
X86.OutByte(b);
X86.OutByte(c)
END OutByte3;
PROCEDURE OutInt (n: INTEGER);
BEGIN
OutByte(UTILS.Byte(n, 0));
OutByte(UTILS.Byte(n, 1));
OutByte(UTILS.Byte(n, 2));
OutByte(UTILS.Byte(n, 3))
X86.OutByte(n MOD 256);
X86.OutByte(UTILS.Byte(n, 1));
X86.OutByte(UTILS.Byte(n, 2));
X86.OutByte(UTILS.Byte(n, 3))
END OutInt;
114,7 → 114,7
PROCEDURE OutIntByte (n: INTEGER);
BEGIN
IF isByte(n) THEN
OutByte(UTILS.Byte(n, 0))
OutByte(n MOD 256)
ELSE
OutInt(n)
END
154,12 → 154,12
PROCEDURE lea (reg, offset, section: INTEGER);
BEGIN
Rex(0, reg);
OutByte2(8DH, 05H + 8 * (reg MOD 8)); // lea reg, [rip + offset]
OutByte2(8DH, 05H + 8 * (reg MOD 8)); (* lea reg, [rip + offset] *)
X86.Reloc(section, offset)
END lea;
PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); // op reg1, reg2
PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *)
BEGIN
Rex(reg1, reg2);
OutByte2(op, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8)
166,7 → 166,7
END oprr;
PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); // op reg1, reg2
PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *)
BEGIN
Rex(reg1, reg2);
OutByte3(op1, op2, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8)
173,55 → 173,55
END oprr2;
PROCEDURE mov (reg1, reg2: INTEGER); // mov reg1, reg2
PROCEDURE mov (reg1, reg2: INTEGER); (* mov reg1, reg2 *)
BEGIN
oprr(89H, reg1, reg2)
END mov;
PROCEDURE xor (reg1, reg2: INTEGER); // xor reg1, reg2
PROCEDURE xor (reg1, reg2: INTEGER); (* xor reg1, reg2 *)
BEGIN
oprr(31H, reg1, reg2)
END xor;
PROCEDURE and (reg1, reg2: INTEGER); // and reg1, reg2
PROCEDURE and (reg1, reg2: INTEGER); (* and reg1, reg2 *)
BEGIN
oprr(21H, reg1, reg2)
END and;
PROCEDURE or (reg1, reg2: INTEGER); // and reg1, reg2
PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *)
BEGIN
oprr(09H, reg1, reg2)
END or;
PROCEDURE add (reg1, reg2: INTEGER); // add reg1, reg2
PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *)
BEGIN
oprr(01H, reg1, reg2)
END add;
PROCEDURE sub (reg1, reg2: INTEGER); // sub reg1, reg2
PROCEDURE sub (reg1, reg2: INTEGER); (* sub reg1, reg2 *)
BEGIN
oprr(29H, reg1, reg2)
END sub;
PROCEDURE xchg (reg1, reg2: INTEGER); // xchg reg1, reg2
PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *)
BEGIN
oprr(87H, reg1, reg2)
END xchg;
PROCEDURE cmprr (reg1, reg2: INTEGER); // cmp reg1, reg2
PROCEDURE cmprr (reg1, reg2: INTEGER); (* cmp reg1, reg2 *)
BEGIN
oprr(39H, reg1, reg2)
END cmprr;
PROCEDURE pop (reg: INTEGER); // pop reg
PROCEDURE pop (reg: INTEGER); (* pop reg *)
BEGIN
IF reg >= 8 THEN
OutByte(41H)
230,7 → 230,7
END pop;
PROCEDURE push (reg: INTEGER); // push reg
PROCEDURE push (reg: INTEGER); (* push reg *)
BEGIN
IF reg >= 8 THEN
OutByte(41H)
242,7 → 242,7
PROCEDURE decr (reg: INTEGER);
BEGIN
Rex(reg, 0);
OutByte2(0FFH, 0C8H + reg MOD 8) // dec reg1
OutByte2(0FFH, 0C8H + reg MOD 8) (* dec reg1 *)
END decr;
249,7 → 249,7
PROCEDURE incr (reg: INTEGER);
BEGIN
Rex(reg, 0);
OutByte2(0FFH, 0C0H + reg MOD 8) // inc reg1
OutByte2(0FFH, 0C0H + reg MOD 8) (* inc reg1 *)
END incr;
276,7 → 276,7
BEGIN
reg := GetAnyReg();
lea(reg, label, sIMP);
IF reg >= 8 THEN // call qword[reg]
IF reg >= 8 THEN (* call qword[reg] *)
OutByte(41H)
END;
OutByte2(0FFH, 10H + reg MOD 8);
337,7 → 337,7
BEGIN
Rex(reg, 0);
OutByte(0B8H + reg MOD 8); // movabs reg, n
OutByte(0B8H + reg MOD 8); (* movabs reg, n *)
FOR i := 0 TO 7 DO
OutByte(UTILS.Byte(n, i))
END
344,7 → 344,7
END movabs;
PROCEDURE movrc (reg, n: INTEGER); // mov reg, n
PROCEDURE movrc (reg, n: INTEGER); (* mov reg, n *)
BEGIN
IF isLong(n) THEN
movabs(reg, n)
358,7 → 358,7
END movrc;
PROCEDURE test (reg: INTEGER); // test reg, reg
PROCEDURE test (reg: INTEGER); (* test reg, reg *)
BEGIN
oprr(85H, reg, reg)
END test;
370,6 → 370,7
BEGIN
reg2 := GetAnyReg();
ASSERT(reg2 # reg);
movabs(reg2, n);
oprr(reg, reg2);
drop
388,30 → 389,46
END oprc;
PROCEDURE cmprc (reg, n: INTEGER); // cmp reg, n
PROCEDURE cmprc (reg, n: INTEGER); (* cmp reg, n *)
BEGIN
IF n = 0 THEN
test(reg)
ELSE
oprc(0F8H, reg, n, cmprr)
END
END cmprc;
PROCEDURE addrc (reg, n: INTEGER); // add reg, n
PROCEDURE addrc (reg, n: INTEGER); (* add reg, n *)
BEGIN
oprc(0C0H, reg, n, add)
END addrc;
PROCEDURE subrc (reg, n: INTEGER); // sub reg, n
PROCEDURE subrc (reg, n: INTEGER); (* sub reg, n *)
BEGIN
oprc(0E8H, reg, n, sub)
END subrc;
PROCEDURE andrc (reg, n: INTEGER); // and reg, n
PROCEDURE andrc (reg, n: INTEGER); (* and reg, n *)
BEGIN
oprc(0E0H, reg, n, and)
END andrc;
PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *)
BEGIN
oprc(0C8H, reg, n, or)
END orrc;
PROCEDURE xorrc (reg, n: INTEGER); (* xor reg, n *)
BEGIN
oprc(0F0H, reg, n, xor)
END xorrc;
PROCEDURE pushc (n: INTEGER);
VAR
reg2: INTEGER;
423,12 → 440,12
push(reg2);
drop
ELSE
OutByte(68H + short(n)); OutIntByte(n) // push n
OutByte(68H + short(n)); OutIntByte(n) (* push n *)
END
END pushc;
PROCEDURE not (reg: INTEGER); // not reg
PROCEDURE not (reg: INTEGER); (* not reg *)
BEGIN
Rex(reg, 0);
OutByte2(0F7H, 0D0H + reg MOD 8)
435,7 → 452,7
END not;
PROCEDURE neg (reg: INTEGER); // neg reg
PROCEDURE neg (reg: INTEGER); (* neg reg *)
BEGIN
Rex(reg, 0);
OutByte2(0F7H, 0D8H + reg MOD 8)
442,129 → 459,39
END neg;
PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); // movzx reg1, byte/word[reg2 + offs]
VAR
b: BYTE;
PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *)
BEGIN
Rex(reg2, reg1);
OutByte2(0FH, 0B6H + ORD(word));
IF (offs = 0) & (reg2 # rbp) THEN
b := 0
ELSE
b := 40H + long(offs)
END;
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8);
IF reg2 = rsp THEN
OutByte(24H)
END;
IF b # 0 THEN
OutIntByte(offs)
END
X86.movzx(reg1, reg2, offs, word)
END movzx;
PROCEDURE _movrm (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN);
VAR
b: BYTE;
PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_32 *)
BEGIN
IF size = 16 THEN
OutByte(66H)
END;
IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64))
END;
OutByte(8BH - 2 * ORD(mr) - ORD(size = 8));
IF (offs = 0) & (reg2 # rbp) THEN
b := 0
ELSE
b := 40H + long(offs)
END;
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8);
IF reg2 = rsp THEN
OutByte(24H)
END;
IF b # 0 THEN
OutIntByte(offs)
END
END _movrm;
PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); // mov dword[reg1+offs], reg2_32
BEGIN
_movrm(reg2, reg1, offs, 32, TRUE)
X86._movrm(reg2, reg1, offs, 32, TRUE)
END movmr32;
PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); // mov reg1_32, dword[reg2+offs]
PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); (* mov reg1_32, dword[reg2+offs] *)
BEGIN
_movrm(reg1, reg2, offs, 32, FALSE)
X86._movrm(reg1, reg2, offs, 32, FALSE)
END movrm32;
PROCEDURE movmr8 (reg1, offs, reg2: INTEGER); // mov byte[reg1+offs], reg2_8
PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov qword[reg1+offs], reg2 *)
BEGIN
_movrm(reg2, reg1, offs, 8, TRUE)
END movmr8;
PROCEDURE movrm8 (reg1, reg2, offs: INTEGER); // mov reg1_8, byte[reg2+offs]
BEGIN
_movrm(reg1, reg2, offs, 8, FALSE)
END movrm8;
PROCEDURE movmr16 (reg1, offs, reg2: INTEGER); // mov word[reg1+offs], reg2_16
BEGIN
_movrm(reg2, reg1, offs, 16, TRUE)
END movmr16;
PROCEDURE movrm16 (reg1, reg2, offs: INTEGER); // mov reg1_16, word[reg2+offs]
BEGIN
_movrm(reg1, reg2, offs, 16, FALSE)
END movrm16;
PROCEDURE movmr (reg1, offs, reg2: INTEGER); // mov qword[reg1+offs], reg2
BEGIN
_movrm(reg2, reg1, offs, 64, TRUE)
X86._movrm(reg2, reg1, offs, 64, TRUE)
END movmr;
PROCEDURE movrm (reg1, reg2, offs: INTEGER); // mov reg1, qword[reg2+offs]
PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, qword[reg2+offs] *)
BEGIN
_movrm(reg1, reg2, offs, 64, FALSE)
X86._movrm(reg1, reg2, offs, 64, FALSE)
END movrm;
PROCEDURE pushm (reg, offs: INTEGER); // push qword[reg+offs]
VAR
b: BYTE;
PROCEDURE comisd (xmm1, xmm2: INTEGER); (* comisd xmm1, xmm2 *)
BEGIN
IF reg >= 8 THEN
OutByte(41H)
END;
OutByte(0FFH);
IF (offs = 0) & (reg # rbp) THEN
b := 30H
ELSE
b := 70H + long(offs)
END;
OutByte(b + reg MOD 8);
IF reg = rsp THEN
OutByte(24H)
END;
IF b # 30H THEN
OutIntByte(offs)
END
END pushm;
PROCEDURE comisd (xmm1, xmm2: INTEGER); // comisd xmm1, xmm2
BEGIN
OutByte(66H);
IF (xmm1 >= 8) OR (xmm2 >= 8) THEN
OutByte(40H + (xmm1 DIV 8) * 4 + xmm2 DIV 8)
598,13 → 525,13
END _movsdrm;
PROCEDURE movsdrm (xmm, reg, offs: INTEGER); // movsd xmm, qword[reg+offs]
PROCEDURE movsdrm (xmm, reg, offs: INTEGER); (* movsd xmm, qword[reg+offs] *)
BEGIN
_movsdrm(xmm, reg, offs, FALSE)
END movsdrm;
PROCEDURE movsdmr (reg, offs, xmm: INTEGER); // movsd qword[reg+offs], xmm
PROCEDURE movsdmr (reg, offs, xmm: INTEGER); (* movsd qword[reg+offs], xmm *)
BEGIN
_movsdrm(xmm, reg, offs, TRUE)
END movsdmr;
620,19 → 547,19
END opxx;
PROCEDURE jcc (cc, label: INTEGER); // jcc label
PROCEDURE jcc (cc, label: INTEGER); (* jcc label *)
BEGIN
X86.jcc(cc, label)
END jcc;
PROCEDURE jmp (label: INTEGER); // jmp label
PROCEDURE jmp (label: INTEGER); (* jmp label *)
BEGIN
X86.jmp(label)
END jmp;
PROCEDURE setcc (cc, reg: INTEGER); //setcc reg8
PROCEDURE setcc (cc, reg: INTEGER); (* setcc reg8 *)
BEGIN
IF reg >= 8 THEN
OutByte(41H)
680,7 → 607,6
reg: INTEGER;
max: INTEGER;
loop: INTEGER;
param2: INTEGER;
BEGIN
loop := 1;
756,17 → 682,7
leaf := FALSE
|IL.opDIVR, IL.opMODR:
param2 := cur.param2;
IF param2 >= 1 THEN
param2 := UTILS.Log2(param2)
ELSIF param2 <= -1 THEN
param2 := UTILS.Log2(-param2)
ELSE
param2 := -1
END;
IF param2 < 0 THEN
leaf := FALSE
END
leaf := UTILS.Log2(cur.param2) >= 0
ELSE
912,9 → 828,9
comisd(xmm - 1, xmm);
cc := setnc
END;
OutByte2(7AH, 3 + reg DIV 8); // jp L
OutByte2(7AH, 3 + reg DIV 8); (* jp L *)
setcc(cc, reg);
//L:
(* L: *)
END fcmp;
969,7 → 885,7
|IL.opWIN64CALLP: Win64Passing(param2)
|IL.opSYSVCALLP: SysVPassing(param2)
END;
OutByte2(0FFH, 0D0H); // call rax
OutByte2(0FFH, 0D0H); (* call rax *)
REG.Restore(R);
ASSERT(R.top = -1)
989,6 → 905,10
|IL.opERR:
CallRTL(IL._error)
|IL.opONERR:
pushc(param2);
jmp(param1)
|IL.opPUSHC:
pushc(param2)
1117,9 → 1037,9
n := param2;
IF n > 4 THEN
movrc(rcx, n);
// L:
(* L: *)
pushc(0);
OutByte2(0E2H, 0FCH) // loop L
OutByte2(0E2H, 0FCH) (* loop L *)
ELSE
WHILE n > 0 DO
pushc(0);
1156,9 → 1076,9
pop(rbp);
IF param2 > 0 THEN
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2 *)
ELSE
OutByte(0C3H) // ret
X86.ret
END;
REG.Reset(R)
1265,7 → 1185,7
|IL.opLADR:
n := param2 * 8;
next := cmd.next(COMMAND);
IF next.opcode = IL.opSAVEF THEN
IF (next.opcode = IL.opSAVEF) OR (next.opcode = IL.opSAVEFI) THEN
movsdmr(rbp, n, xmm);
DEC(xmm);
cmd := next
1276,7 → 1196,7
ELSE
reg1 := GetAnyReg();
Rex(0, reg1);
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n]
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); (* lea reg1, qword[rbp+n] *)
OutIntByte(n)
END
1291,7 → 1211,7
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2
OutByte3(0C6H, reg1 MOD 8, param2); (* mov byte[reg1], param2 *)
drop
|IL.opSAVE16C:
1301,7 → 1221,7
OutByte(41H)
END;
OutByte2(0C7H, reg1 MOD 8);
OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2
OutByte2(param2 MOD 256, param2 DIV 256); (* mov word[reg1], param2 *)
drop
|IL.opSAVEC:
1313,7 → 1233,7
drop
ELSE
Rex(reg1, 0);
OutByte2(0C7H, reg1 MOD 8); // mov qword[reg1], param2
OutByte2(0C7H, reg1 MOD 8); (* mov qword[reg1], param2 *)
OutInt(param2)
END;
drop
1346,10 → 1266,10
|IL.opINCL, IL.opEXCL:
BinOp(reg1, reg2);
cmprc(reg1, 64);
OutByte2(73H, 04H); // jnb L
OutByte2(73H, 04H); (* jnb L *)
Rex(reg2, reg1);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1
// L:
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); (* bts/btr qword[reg2], reg1 *)
(* L: *)
drop;
drop
1356,7 → 1276,7
|IL.opINCLC, IL.opEXCLC:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2
OutByte2(0FH, 0BAH); (* bts/btr qword[reg1], param2 *)
OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2);
drop
1384,26 → 1304,19
drop
ELSE
UnOp(reg1);
IF param2 = 0 THEN
test(reg1)
ELSE
cmprc(reg1, param2)
END
END;
drop;
cc := X86.cond(opcode);
IF cmd.next(COMMAND).opcode = IL.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(X86.inv0(cc), label);
cmd := cmd.next(COMMAND)
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
jcc(X86.inv0(cc), next.param1);
cmd := next
ELSE
reg1 := GetAnyReg();
setcc(cc + 16, reg1);
1447,6 → 1360,11
test(reg1);
jcc(je, param1)
|IL.opJG:
UnOp(reg1);
test(reg1);
jcc(jg, param1)
|IL.opJE:
UnOp(reg1);
test(reg1);
1459,7 → 1377,11
jcc(je, param1);
drop
|IL.opIN:
|IL.opIN, IL.opINR:
IF opcode = IL.opINR THEN
reg2 := GetAnyReg();
movrc(reg2, param2)
END;
label := NewLabel();
L := NewLabel();
BinOp(reg1, reg2);
1469,34 → 1391,16
jmp(label);
X86.SetLabel(L);
Rex(reg2, reg1);
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); (* bt reg2, reg1 *)
setcc(setc, reg1);
andrc(reg1, 1);
X86.SetLabel(label);
drop
|IL.opINR:
label := NewLabel();
L := NewLabel();
UnOp(reg1);
reg2 := GetAnyReg();
cmprc(reg1, 64);
jcc(jb, L);
xor(reg1, reg1);
jmp(label);
X86.SetLabel(L);
movrc(reg2, param2);
Rex(reg2, reg1);
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1
setcc(setc, reg1);
andrc(reg1, 1);
X86.SetLabel(label);
drop
|IL.opINL:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(0FH, 0BAH); // bt reg1, param2
OutByte2(0FH, 0BAH); (* bt reg1, param2 *)
OutByte2(0E0H + reg1 MOD 8, param2);
setcc(setc, reg1);
andrc(reg1, 1)
1516,9 → 1420,9
|IL.opABS:
UnOp(reg1);
test(reg1);
OutByte2(7DH, 03H); // jge L
OutByte2(7DH, 03H); (* jge L *)
neg(reg1)
// L:
(* L: *)
|IL.opEQB, IL.opNEB:
BinOp(reg1, reg2);
1545,12 → 1449,14
UnOp(reg1);
andrc(reg1, param2)
|IL.opDIVSC, IL.opADDSL, IL.opADDSR:
|IL.opDIVSC:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2
OutIntByte(param2)
xorrc(reg1, param2)
|IL.opADDSL, IL.opADDSR:
UnOp(reg1);
orrc(reg1, param2)
|IL.opSUBSL:
UnOp(reg1);
not(reg1);
1646,7 → 1552,7
|IL.opTYPEGD:
UnOp(reg1);
PushAll(0);
pushm(reg1, -8);
X86.pushm(reg1, -8);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
GetRegA
1673,7 → 1579,7
|IL.opINC, IL.opDEC:
BinOp(reg1, reg2);
// add/sub qword[reg2], reg1
(* add/sub qword[reg2], reg1 *)
Rex(reg2, reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8);
drop;
1684,15 → 1590,15
IF isLong(param2) THEN
reg2 := GetAnyReg();
movrc(reg2, param2);
// add qword[reg1], reg2
(* add qword[reg1], reg2 *)
Rex(reg1, reg2);
OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8);
drop
ELSIF ABS(param2) = 1 THEN
Rex(reg1, 0);
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1]
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) (* inc/dec qword[reg1] *)
ELSE
// add qword[reg1], param2
(* add qword[reg1], param2 *)
Rex(reg1, 0);
OutByte2(81H + short(param2), reg1 MOD 8);
OutIntByte(param2)
1711,13 → 1617,13
|IL.opSAVE8:
BinOp(reg2, reg1);
movmr8(reg1, 0, reg2);
X86.movmr8(reg1, 0, reg2);
drop;
drop
|IL.opSAVE16:
BinOp(reg2, reg1);
movmr16(reg1, 0, reg2);
X86.movmr16(reg1, 0, reg2);
drop;
drop
1727,38 → 1633,27
drop;
drop
|IL.opMIN:
|IL.opMAX, IL.opMIN:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(7EH, 3); // jle L
OutByte2(7DH + ORD(opcode = IL.opMIN), 3); (* jge/jle L *)
mov(reg1, reg2);
// L:
(* L: *)
drop
|IL.opMAX:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(7DH, 3); // jge L
mov(reg1, reg2);
// L:
drop
|IL.opMINC:
|IL.opMAXC, IL.opMINC:
UnOp(reg1);
cmprc(reg1, param2);
label := NewLabel();
jcc(jle, label);
IF opcode = IL.opMINC THEN
cc := jle
ELSE
cc := jge
END;
jcc(cc, label);
movrc(reg1, param2);
X86.SetLabel(label)
|IL.opMAXC:
UnOp(reg1);
cmprc(reg1, param2);
label := NewLabel();
jcc(jge, label);
movrc(reg1, param2);
X86.SetLabel(label)
|IL.opSBOOL:
BinOp(reg2, reg1);
test(reg2);
1765,7 → 1660,7
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1]
OutByte3(0FH, 95H, reg1 MOD 8); (* setne byte[reg1] *)
drop;
drop
1774,13 → 1669,9
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *)
drop
|IL.opODD:
UnOp(reg1);
andrc(reg1, 1)
|IL.opUMINUS:
UnOp(reg1);
neg(reg1)
1810,8 → 1701,29
END
|IL.opADDL, IL.opADDR:
IF param2 # 0 THEN
IF (param2 # 0) & ~isLong(param2) THEN
UnOp(reg1);
next := cmd.next(COMMAND);
CASE next.opcode OF
|IL.opLOAD64:
movrm(reg1, reg1, param2);
cmd := next
|IL.opLOAD32:
movrm32(reg1, reg1, param2);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
cmd := next
|IL.opLOAD16:
movzx(reg1, reg1, param2, TRUE);
cmd := next
|IL.opLOAD8:
movzx(reg1, reg1, param2, FALSE);
cmd := next
|IL.opLOAD64_PARAM:
X86.pushm(reg1, param2);
drop;
cmd := next
ELSE
IF param2 = 1 THEN
incr(reg1)
ELSIF param2 = -1 THEN
1820,6 → 1732,9
addrc(reg1, param2)
END
END
ELSIF isLong(param2) THEN
addrc(reg1, param2)
END
|IL.opDIV:
PushAll(2);
1827,41 → 1742,16
GetRegA
|IL.opDIVR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
ELSE
n := -1
END;
IF a = 1 THEN
ELSIF a = -1 THEN
UnOp(reg1);
neg(reg1)
ELSE
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(reg1);
IF a < 0 THEN
reg2 := GetAnyReg();
mov(reg2, reg1);
shiftrc(sar, reg1, n);
sub(reg1, reg2);
drop
ELSE
shiftrc(sar, reg1, n)
END
ELSE
ELSIF n < 0 THEN
PushAll(1);
pushc(param2);
CallRTL(IL._divmod);
GetRegA
END
END
|IL.opDIVL:
UnOp(reg1);
1879,39 → 1769,20
GetRegA
|IL.opMODR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
ELSE
n := -1
END;
IF ABS(a) = 1 THEN
UnOp(reg1);
xor(reg1, reg1)
ELSE
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(reg1);
andrc(reg1, ABS(a) - 1);
IF a < 0 THEN
test(reg1);
label := NewLabel();
jcc(je, label);
addrc(reg1, a);
X86.SetLabel(label)
END
ELSE
andrc(reg1, param2 - 1);
ELSIF n < 0 THEN
PushAll(1);
pushc(param2);
CallRTL(IL._divmod);
mov(rax, rdx);
GetRegA
ELSE
UnOp(reg1);
xor(reg1, reg1)
END
END
|IL.opMODL:
UnOp(reg1);
1925,10 → 1796,19
|IL.opMUL:
BinOp(reg1, reg2);
oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2
oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *)
drop
|IL.opMULC:
IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN
BinOp(reg1, reg2);
OutByte2(48H + 5 * (reg1 DIV 8) + 2 * (reg2 DIV 8), 8DH); (* lea reg1, [reg1 + reg2 * param2] *)
reg1 := reg1 MOD 8;
reg2 := reg2 MOD 8;
OutByte2(04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2));
drop;
cmd := cmd.next(COMMAND)
ELSE
UnOp(reg1);
a := param2;
1953,12 → 1833,21
END;
shiftrc(shl, reg1, n)
ELSE
// imul reg1, a
IF isLong(a) THEN
reg2 := GetAnyReg();
movabs(reg2, a);
ASSERT(reg1 # reg2);
oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *)
drop
ELSE
(* imul reg1, a *)
Rex(reg1, reg1);
OutByte2(69H + short(a), 0C0H + (reg1 MOD 8) * 9);
OutIntByte(a)
END
END
END
END
|IL.opADDS:
BinOp(reg1, reg2);
1990,17 → 1879,23
|IL.opENDSW:
|IL.opCASEL:
GetRegA;
cmprc(rax, param1);
jcc(jl, param2)
jcc(jl, param2);
drop
|IL.opCASER:
GetRegA;
cmprc(rax, param1);
jcc(jg, param2)
jcc(jg, param2);
drop
|IL.opCASELR:
GetRegA;
cmprc(rax, param1);
jcc(jl, param2);
jcc(jg, cmd.param3)
jcc(jg, cmd.param3);
drop
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
BinOp(reg1, reg2);
2007,7 → 1902,7
xchg(reg2, rcx);
Rex(reg1, 0);
OutByte(0D3H);
X86.shift(opcode, reg1 MOD 8); // shift reg1, cl
X86.shift(opcode, reg1 MOD 8); (* shift reg1, cl *)
xchg(reg2, rcx);
drop
2018,7 → 1913,7
xchg(reg1, rcx);
Rex(reg2, 0);
OutByte(0D3H);
X86.shift(opcode, reg2 MOD 8); // shift reg2, cl
X86.shift(opcode, reg2 MOD 8); (* shift reg2, cl *)
xchg(reg1, rcx);
drop;
drop;
2038,8 → 1933,8
END;
drop;
drop;
_movrm(reg1, reg1, 0, param2 * 8, FALSE);
_movrm(reg1, reg2, 0, param2 * 8, TRUE)
X86._movrm(reg1, reg1, 0, param2 * 8, FALSE);
X86._movrm(reg1, reg2, 0, param2 * 8, TRUE)
|IL.opCHKBYTE:
BinOp(reg1, reg2);
2055,14 → 1950,11
BinOp(reg1, reg2);
IF param2 # -1 THEN
cmprr(reg2, reg1);
mov(reg1, reg2);
drop;
jcc(jb, param1)
ELSE
jcc(jb, param1);
END;
INCL(R.regs, reg1);
DEC(R.top);
R.stk[R.top] := reg2
END
|IL.opLENGTH:
PushAll(2);
2127,7 → 2019,7
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); (* add/sub byte[reg1], param2 MOD 256 *)
drop
|IL.opINCB, IL.opDECB:
2135,7 → 2027,7
IF (reg1 >= 8) OR (reg2 >= 8) THEN
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8))
END;
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); (* add/sub byte[reg2], reg1_8 *)
drop;
drop
2149,7 → 2041,7
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte2(8FH, reg1 MOD 8); // pop qword[reg1]
OutByte2(8FH, reg1 MOD 8); (* pop qword[reg1] *)
drop
|IL.opCLEANUP:
2181,7 → 2073,7
drop;
NewNumber(UTILS.splitf(float, a, b))
|IL.opSAVEF:
|IL.opSAVEF, IL.opSAVEFI:
UnOp(reg1);
movsdmr(reg1, 0, xmm);
DEC(xmm);
2216,7 → 2108,7
|IL.opUMINF:
reg1 := GetAnyReg();
lea(reg1, Numbers_Offs, sDATA);
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1]
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* xorpd xmm, xmmword[reg1] *)
OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8);
drop
2223,7 → 2115,7
|IL.opFABS:
reg1 := GetAnyReg();
lea(reg1, Numbers_Offs + 16, sDATA);
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1]
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* andpd xmm, xmmword[reg1] *)
OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8);
drop
2230,7 → 2122,7
|IL.opFLT:
UnOp(reg1);
INC(xmm);
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); (* cvtsi2sd xmm, reg1 *)
OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8);
drop
2237,14 → 2129,14
|IL.opFLOOR:
reg1 := GetAnyReg();
subrc(rsp, 8);
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4];
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp];
OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); // and dword[rsp],11111111111111111001111111111111b;
OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); // or dword[rsp],00000000000000000010000000000000b;
OutByte2(00FH, 0AEH); OutByte2(014H, 024H); // ldmxcsr dword[rsp];
OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); // cvtsd2si reg1, xmm
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); (* stmxcsr dword[rsp+4]; *)
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); (* stmxcsr dword[rsp]; *)
OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); (* and dword[rsp],11111111111111111001111111111111b; *)
OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); (* or dword[rsp],00000000000000000010000000000000b; *)
OutByte2(00FH, 0AEH); OutByte2(014H, 024H); (* ldmxcsr dword[rsp]; *)
OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); (* cvtsd2si reg1, xmm *)
OutByte2(2DH, 0C0H + xmm MOD 8 + (reg1 MOD 8) * 8);
OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); // ldmxcsr dword[rsp+4];
OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); (* ldmxcsr dword[rsp+4]; *)
addrc(rsp, 8);
DEC(xmm)
2278,7 → 2170,7
movrm(reg2, reg2, 0);
push(reg1);
lea(reg1, Numbers_Offs + 40, sDATA); // {0..51, 63}
lea(reg1, Numbers_Offs + 40, sDATA); (* {0..51, 63} *)
movrm(reg1, reg1, 0);
and(reg2, reg1);
pop(reg1);
2299,7 → 2191,7
IF ~regVar THEN
reg2 := GetAnyReg();
Rex(0, reg2);
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n]
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *)
OutIntByte(n)
END
ELSE
2324,7 → 2216,7
movrm(reg1, reg2, 0);
push(reg2);
lea(reg2, Numbers_Offs + 48, sDATA); // {52..61}
lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *)
movrm(reg2, reg2, 0);
or(reg1, reg2);
pop(reg2);
2331,7 → 2223,7
Rex(reg1, 0);
OutByte2(0FH, 0BAH);
OutByte2(0F0H + reg1 MOD 8, 3EH); // btr reg1, 62
OutByte2(0F0H + reg1 MOD 8, 3EH); (* btr reg1, 62 *)
movmr(reg2, 0, reg1);
drop;
drop
2340,11 → 2232,11
pushDA(stroffs + param2)
|IL.opVADR_PARAM:
pushm(rbp, param2 * 8)
X86.pushm(rbp, param2 * 8)
|IL.opLOAD64_PARAM:
UnOp(reg1);
pushm(reg1, 0);
X86.pushm(reg1, 0);
drop
|IL.opLLOAD64_PARAM:
2352,7 → 2244,7
IF reg1 # -1 THEN
push(reg1)
ELSE
pushm(rbp, param2 * 8)
X86.pushm(rbp, param2 * 8)
END
|IL.opGLOAD64_PARAM:
2405,7 → 2297,7
movmr(rbp, n, reg2);
drop
ELSE
OutByte3(48H, 0C7H, 45H + long(n)); // mov qword[rbp+n],param2
OutByte3(48H, 0C7H, 45H + long(n)); (* mov qword[rbp+n], param2 *)
OutIntByte(n);
OutInt(param2)
END
2424,7 → 2316,7
reg2 := GetAnyReg();
lea(reg2, param1, sBSS);
Rex(reg2, 0);
OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2
OutByte2(0C7H, reg2 MOD 8); (* mov qword[reg2], param2 *)
OutInt(param2);
drop
END
2450,7 → 2342,7
n := param1 * 8;
Rex(0, reg2);
OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8);
OutIntByte(n) // add qword[rbp+n],reg2
OutIntByte(n) (* add qword[rbp+n], reg2 *)
END;
drop
ELSIF ABS(param2) = 1 THEN
2462,7 → 2354,7
END
ELSE
n := param1 * 8;
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n]
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *)
OutIntByte(n)
END
ELSE
2472,7 → 2364,7
n := param1 * 8;
OutByte3(48H, 81H + short(param2), 45H + long(n));
OutIntByte(n);
OutIntByte(param2) // add qword[rbp+n],param2
OutIntByte(param2) (* add qword[rbp+n], param2 *)
END
END
2490,7 → 2382,7
n := param1 * 8;
OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB));
OutIntByte(n);
OutByte(param2) // add/sub byte[rbp+n],param2
OutByte(param2) (* add/sub byte[rbp+n], param2 *)
END
|IL.opLADR_INC, IL.opLADR_DEC:
2506,7 → 2398,7
n := param2 * 8;
Rex(0, reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
OutIntByte(n) // add/sub qword[rbp+n],reg1
OutIntByte(n) (* add/sub qword[rbp+n], reg1 *)
END;
drop
2526,7 → 2418,7
OutByte(44H)
END;
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
OutIntByte(n) // add/sub byte[rbp+n], reg1_8
OutIntByte(n) (* add/sub byte[rbp+n], reg1_8 *)
END;
drop
2535,16 → 2427,16
cmprc(reg1, 64);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
OutByte2(73H, 4); // jnb L
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1
OutByte2(73H, 4); (* jnb L *)
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *)
ELSE
n := param2 * 8;
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); (* jnb L *)
Rex(0, reg1);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8));
OutIntByte(n) // bts/btr qword[rbp+n], reg1
OutIntByte(n) (* bts/btr qword[rbp+n], reg1 *)
END;
// L:
(* L: *)
drop
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
2551,11 → 2443,11
reg1 := GetVarReg(param1);
IF reg1 # -1 THEN
Rex(reg1, 0);
OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2
OutByte3(0FH, 0BAH, 0E8H); (* bts/btr reg1, param2 *)
OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2)
ELSE
n := param1 * 8;
OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2
OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *)
OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC));
OutIntByte(n);
OutByte(param2)
2586,7 → 2478,7
entry := NewLabel();
X86.SetLabel(entry);
IF target = mConst.Target_iDLL64 THEN
IF target = TARGETS.Win64DLL THEN
dllret := NewLabel();
push(r8);
push(rdx);
2596,7 → 2488,7
jcc(je, dllret)
END;
IF target = mConst.Target_iELF64 THEN
IF target = TARGETS.Linux64 THEN
push(rsp)
ELSE
pushc(0)
2604,12 → 2496,12
lea(rax, entry, sCODE);
push(rax);
pushDA(0); //TYPES
pushDA(0); (* TYPES *)
pushc(tcount);
pushDA(ModName_Offs); //MODNAME
pushDA(ModName_Offs); (* MODNAME *)
CallRTL(IL._init);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iELF64} THEN
IF target IN {TARGETS.Win64C, TARGETS.Win64GUI, TARGETS.Linux64} THEN
L := NewLabel();
pushc(0);
push(rsp);
2619,7 → 2511,9
pop(rax);
test(rax);
jcc(je, L);
GetRegA;
addrc(rax, 1024 * 1024 * stack_size - 8);
drop;
mov(rsp, rax);
X86.SetLabel(L)
END
2655,15 → 2549,15
BEGIN
IF target = mConst.Target_iDLL64 THEN
IF target = TARGETS.Win64DLL THEN
X86.SetLabel(dllret);
OutByte(0C3H) // ret
ELSIF target = mConst.Target_iELFSO64 THEN
X86.ret
ELSIF target = TARGETS.Linux64SO THEN
sofinit := NewLabel();
OutByte(0C3H); // ret
X86.ret;
X86.SetLabel(sofinit);
CallRTL(IL._sofinit);
OutByte(0C3H) // ret
X86.ret
ELSE
pushc(0);
CallRTL(IL._exit)
2724,8 → 2618,8
BEGIN
offs := offs * 8;
CASE size OF
|1: movmr8(rbp, offs, reg)
|2: movmr16(rbp, offs, reg)
|1: X86.movmr8(rbp, offs, reg)
|2: X86.movmr16(rbp, offs, reg)
|4: movmr32(rbp, offs, reg)
|8: movmr(rbp, offs, reg)
END
2778,12 → 2672,12
epilog(modname, target);
BIN.fixup(prog);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
PE32.write(prog, outname, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE)
ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE)
IF TARGETS.OS = TARGETS.osWIN64 THEN
PE32.write(prog, outname, target = TARGETS.Win64C, target = TARGETS.Win64DLL, TRUE)
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
ELF.write(prog, outname, sofinit, target = TARGETS.Linux64SO, TRUE)
END
END CodeGen;
END AMD64.
END AMD64.

/programs/develop/oberon07/Source/ARITH.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
75,6 → 75,11
END Float;
PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
RETURN (a <= i.int) & (i.int <= b)
END range;
PROCEDURE check* (v: VALUE): BOOLEAN;
VAR
res: BOOLEAN;
81,9 → 86,9
BEGIN
CASE v.typ OF
|tINTEGER: res := (UTILS.target.minInt <= v.int) & (v.int <= UTILS.target.maxInt)
|tCHAR: res := (0 <= v.int) & (v.int <= 255)
|tWCHAR: res := (0 <= v.int) & (v.int <= 65535)
|tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)
|tCHAR: res := range(v, 0, 255)
|tWCHAR: res := range(v, 0, 65535)
|tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
END
196,61 → 201,15
PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;
VAR
max: REAL;
res: BOOLEAN;
BEGIN
max := UTILS.maxreal;
CASE op OF
|"+":
IF (a < 0.0) & (b < 0.0) THEN
res := a > -max - b
ELSIF (a > 0.0) & (b > 0.0) THEN
res := a < max - b
ELSE
res := TRUE
END;
IF res THEN
a := a + b
|"+": a := a + b
|"-": a := a - b
|"*": a := a * b
|"/": a := a / b
END
|"-":
IF (a < 0.0) & (b > 0.0) THEN
res := a > b - max
ELSIF (a > 0.0) & (b < 0.0) THEN
res := a < b + max
ELSE
res := TRUE
END;
IF res THEN
a := a - b
END
|"*":
IF (ABS(a) > 1.0) & (ABS(b) > 1.0) THEN
res := ABS(a) < max / ABS(b)
ELSE
res := TRUE
END;
IF res THEN
a := a * b
END
|"/":
IF ABS(b) < 1.0 THEN
res := ABS(a) < max * ABS(b)
ELSE
res := TRUE
END;
IF res THEN
a := a / b
END
END
RETURN res
RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)
END opFloat2;
407,13 → 366,8
BEGIN
ASSERT(x > 0);
n := 0;
WHILE ~ODD(x) DO
x := x DIV 2;
INC(n)
END;
IF x # 1 THEN
n := UTILS.Log2(x);
IF n = -1 THEN
n := 255
END
521,7 → 475,7
|"-": success := subInt(a.int, b.int)
|"*": success := mulInt(a.int, b.int)
|"/": success := FALSE
|"D": IF (b.int # -1) OR (a.int # UTILS.minint) THEN a.int := a.int DIV b.int ELSE success := FALSE END
|"D": a.int := a.int DIV b.int
|"M": a.int := a.int MOD b.int
|"L": a.int := _LSL(a.int, b.int)
|"A": a.int := _ASR(a.int, b.int)
670,11 → 624,6
END opBoolean;
PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
RETURN (a <= i.int) & (i.int <= b)
END range;
PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;

/programs/develop/oberon07/Source/AVLTREES.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/BIN.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
12,19 → 12,14
CONST
RCODE* = 1;
RDATA* = 2;
RBSS* = 3;
RIMP* = 4;
RCODE* = 0; PICCODE* = RCODE + 1;
RDATA* = 2; PICDATA* = RDATA + 1;
RBSS* = 4; PICBSS* = RBSS + 1;
RIMP* = 6; PICIMP* = RIMP + 1;
PICCODE* = 5;
PICDATA* = 6;
PICBSS* = 7;
PICIMP* = 8;
IMPTAB* = 8;
IMPTAB* = 9;
TYPE
RELOC* = POINTER TO RECORD (LISTS.ITEM)
211,6 → 206,13
END PutCode32LE;
PROCEDURE PutCode16LE* (program: PROGRAM; x: INTEGER);
BEGIN
CHL.PushByte(program.code, UTILS.Byte(x, 0));
CHL.PushByte(program.code, UTILS.Byte(x, 1))
END PutCode16LE;
PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER);
BEGIN
CHL.SetInt(program.labels, label, offset)

/programs/develop/oberon07/Source/CHUNKLISTS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
12,8 → 12,8
CONST
LENOFBYTECHUNK = 64000;
LENOFINTCHUNK = 16000;
LENOFBYTECHUNK = 65536;
LENOFINTCHUNK = 16384;
TYPE

/programs/develop/oberon07/Source/COLLECTIONS.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/CONSOLE.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/Compiler.ob07
1,54 → 1,16
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE Compiler;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE,
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS;
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER;
VAR
res: INTEGER;
BEGIN
IF s = mConst.Target_sConsole THEN
res := mConst.Target_iConsole
ELSIF s = mConst.Target_sGUI THEN
res := mConst.Target_iGUI
ELSIF s = mConst.Target_sDLL THEN
res := mConst.Target_iDLL
ELSIF s = mConst.Target_sKolibri THEN
res := mConst.Target_iKolibri
ELSIF s = mConst.Target_sObject THEN
res := mConst.Target_iObject
ELSIF s = mConst.Target_sConsole64 THEN
res := mConst.Target_iConsole64
ELSIF s = mConst.Target_sGUI64 THEN
res := mConst.Target_iGUI64
ELSIF s = mConst.Target_sDLL64 THEN
res := mConst.Target_iDLL64
ELSIF s = mConst.Target_sELF32 THEN
res := mConst.Target_iELF32
ELSIF s = mConst.Target_sELFSO32 THEN
res := mConst.Target_iELFSO32
ELSIF s = mConst.Target_sELF64 THEN
res := mConst.Target_iELF64
ELSIF s = mConst.Target_sELFSO64 THEN
res := mConst.Target_iELFSO64
ELSIF s = mConst.Target_sMSP430 THEN
res := mConst.Target_iMSP430
ELSE
res := 0
END
RETURN res
END Target;
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
VAR
param: PARS.PATH;
168,6 → 130,22
END keys;
PROCEDURE OutTargetItem (target: INTEGER; text: ARRAY OF CHAR);
VAR
width: INTEGER;
BEGIN
width := 15;
width := width - LENGTH(TARGETS.Targets[target].ComLinePar) - 4;
C.String(" '"); C.String(TARGETS.Targets[target].ComLinePar); C.String("'");
WHILE width > 0 DO
C.String(20X);
DEC(width)
END;
C.StringLn(text)
END OutTargetItem;
PROCEDURE main;
VAR
path: PARS.PATH;
180,7 → 158,6
param: PARS.PATH;
temp: PARS.PATH;
target: INTEGER;
bit_depth: INTEGER;
time: INTEGER;
options: PROG.OPTIONS;
196,32 → 173,46
UTILS.GetArg(1, inname);
C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
C.StringLn("Copyright (c) 2018-2019, Anton Krotov");
C.StringLn("Copyright (c) 2018-2020, Anton Krotov");
IF inname = "" THEN
C.Ln;
C.StringLn("Usage: Compiler <main module> <target> [optional settings]"); C.Ln;
C.StringLn("target =");
IF UTILS.bit_depth = 64 THEN
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
ELSIF UTILS.bit_depth = 32 THEN
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
OutTargetItem(TARGETS.Win64C, "Windows64 Console");
OutTargetItem(TARGETS.Win64GUI, "Windows64 GUI");
OutTargetItem(TARGETS.Win64DLL, "Windows64 DLL");
OutTargetItem(TARGETS.Linux64, "Linux64 Exec");
OutTargetItem(TARGETS.Linux64SO, "Linux64 SO")
END;
OutTargetItem(TARGETS.Win32C, "Windows32 Console");
OutTargetItem(TARGETS.Win32GUI, "Windows32 GUI");
OutTargetItem(TARGETS.Win32DLL, "Windows32 DLL");
OutTargetItem(TARGETS.Linux32, "Linux32 Exec");
OutTargetItem(TARGETS.Linux32SO, "Linux32 SO");
OutTargetItem(TARGETS.KolibriOS, "KolibriOS Exec");
OutTargetItem(TARGETS.KolibriOSDLL, "KolibriOS DLL");
OutTargetItem(TARGETS.MSP430, "MSP430x{1,2}xx microcontrollers");
OutTargetItem(TARGETS.STM32CM3, "STM32 Cortex-M3 microcontrollers");
C.Ln;
C.StringLn("optional settings:"); C.Ln;
C.StringLn(" -out <file name> output"); C.Ln;
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln;
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln;
C.StringLn(" -ver <major.minor> set version of program ('obj' target)"); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes ('msp430' target)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes ('msp430' target)"); C.Ln;
C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,");
C.StringLn(" BYTE, CHR, WCHR)"); C.Ln;
C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
UTILS.Exit(0)
END;
C.StringLn("--------------------------------------------");
PATHS.split(inname, path, modname, ext);
IF ext # mConst.FILE_EXT THEN
IF ext # UTILS.FILE_EXT THEN
ERRORS.Error(207)
END;
235,52 → 226,29
ERRORS.Error(205)
END;
target := Target(param);
IF target = 0 THEN
IF TARGETS.Select(param) THEN
target := TARGETS.target
ELSE
ERRORS.Error(206)
END;
CASE target OF
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
bit_depth := 64
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32:
bit_depth := 32
|mConst.Target_iMSP430:
bit_depth := 16;
IF target = TARGETS.MSP430 THEN
options.ram := MSP430.minRAM;
options.rom := MSP430.minROM
END;
IF UTILS.bit_depth < bit_depth THEN
IF target = TARGETS.STM32CM3 THEN
options.ram := THUMB.STM32_minRAM;
options.rom := THUMB.STM32_minROM
END;
IF UTILS.bit_depth < TARGETS.BitDepth THEN
ERRORS.Error(206)
END;
STRINGS.append(lib_path, "lib");
STRINGS.append(lib_path, UTILS.slash);
CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
STRINGS.append(lib_path, "Windows32")
|mConst.Target_iKolibri, mConst.Target_iObject:
STRINGS.append(lib_path, "KolibriOS")
|mConst.Target_iELF32, mConst.Target_iELFSO32:
STRINGS.append(lib_path, "Linux32")
|mConst.Target_iELF64, mConst.Target_iELFSO64:
STRINGS.append(lib_path, "Linux64")
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64:
STRINGS.append(lib_path, "Windows64")
|mConst.Target_iMSP430:
STRINGS.append(lib_path, "MSP430")
END;
STRINGS.append(lib_path, TARGETS.LibDir);
STRINGS.append(lib_path, UTILS.slash);
keys(options, outname);
287,24 → 255,7
IF outname = "" THEN
outname := path;
STRINGS.append(outname, modname);
CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iConsole64, mConst.Target_iGUI64:
STRINGS.append(outname, ".exe")
|mConst.Target_iObject:
STRINGS.append(outname, ".obj")
|mConst.Target_iKolibri, mConst.Target_iELF32, mConst.Target_iELF64:
|mConst.Target_iELFSO32, mConst.Target_iELFSO64:
STRINGS.append(outname, ".so")
|mConst.Target_iDLL, mConst.Target_iDLL64:
STRINGS.append(outname, ".dll")
|mConst.Target_iMSP430:
STRINGS.append(outname, ".hex")
END
STRINGS.append(outname, TARGETS.FileExt)
ELSE
IF PATHS.isRelative(outname) THEN
PATHS.RelPath(app_path, outname, temp);
312,15 → 263,12
END
END;
PARS.init(bit_depth, target, options);
PARS.init(options);
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
PARS.program.obj := target = mConst.Target_iObject;
ST.compile(path, lib_path, modname, outname, target, options);
time := UTILS.GetTickCount() - UTILS.time;
C.StringLn("--------------------------------------------");
C.Int(PARS.lines); C.String(" lines, ");
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");
C.Int(WRITER.counter); C.StringLn(" bytes");

/programs/develop/oberon07/Source/ELF.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
142,23 → 142,27
PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN);
VAR
reloc: BIN.RELOC;
L, delta: INTEGER;
code: CHL.BYTELIST;
L, delta, delta0: INTEGER;
BEGIN
code := program.code;
delta0 := 3 - 7 * ORD(amd64);
reloc := program.rel_list.first(BIN.RELOC);
WHILE reloc # NIL DO
L := BIN.get32le(program.code, reloc.offset);
delta := 3 - reloc.offset - text - 7 * ORD(amd64);
L := BIN.get32le(code, reloc.offset);
delta := delta0 - reloc.offset - text;
CASE reloc.opcode OF
|BIN.PICDATA: BIN.put32le(program.code, reloc.offset, L + data + delta)
|BIN.PICCODE: BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta)
|BIN.PICBSS: BIN.put32le(program.code, reloc.offset, L + bss + delta)
|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)
END;
reloc := reloc.next(BIN.RELOC)
END;
END
END fixup;

/programs/develop/oberon07/Source/ERRORS.ob07
1,13 → 1,13
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE ERRORS;
IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS;
IMPORT C := CONSOLE, UTILS;
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
73,7 → 73,7
| 43: str := "expression is not an integer"
| 44: str := "out of range 0..MAXSET"
| 45: str := "division by zero"
| 46: str := "integer division by zero"
| 46: str := "IV out of range"
| 47: str := "'OF' or ',' expected"
| 48: str := "undeclared identifier"
| 49: str := "type expected"
137,7 → 137,7
|107: str := "too large parameter of CHR"
|108: str := "a variable or a procedure expected"
|109: str := "expression should be constant"
|110: str := "out of range 0..65535"
|111: str := "record [noalign] cannot have a base type"
|112: str := "record [noalign] cannot be a base type"
|113: str := "result type of procedure should not be REAL"
146,8 → 146,8
|116: str := "procedure too deep nested"
|120: str := "too many formal parameters"
|122: str := "negative divisor"
|121: str := "multiply defined handler"
|122: str := "bad divisor"
|123: str := "illegal flag"
|124: str := "unknown flag"
|125: str := "flag not supported"
184,7 → 184,7
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
BEGIN
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found")
Error5("procedure ", UTILS.RTL_NAME, ".", ProcName, " not found")
END WrongRTL;
209,9 → 209,9
|204: Error1("size of variables is too large")
|205: Error1("not enough parameters")
|206: Error1("bad parameter <target>")
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
|207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"')
END
END Error;
END ERRORS.
END ERRORS.

/programs/develop/oberon07/Source/FILES.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
17,8 → 17,10
ptr: INTEGER;
buffer: ARRAY 64*1024 OF BYTE;
count: INTEGER
count: INTEGER;
chksum*: INTEGER
END;
VAR
83,7 → 85,8
IF ptr > 0 THEN
file := NewFile();
file.ptr := ptr;
file.count := 0
file.count := 0;
file.chksum := 0
ELSE
file := NIL
END
190,30 → 193,14
PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN;
VAR
res: BOOLEAN;
arr: ARRAY 1 OF BYTE;
BEGIN
res := TRUE;
IF (file # NIL) & (file.count >= 0) THEN
IF file.count = LEN(file.buffer) THEN
IF flush(file) # LEN(file.buffer) THEN
res := FALSE
ELSE
file.buffer[0] := byte;
file.count := 1
END
ELSE
file.buffer[file.count] := byte;
INC(file.count)
END
ELSE
res := FALSE
END
RETURN res
arr[0] := byte
RETURN write(file, arr, 1) = 1
END WriteByte;
BEGIN
files := C.create()
END FILES.
END FILES.

/programs/develop/oberon07/Source/HEX.ob07
0,0 → 1,127
(*
BSD 2-Clause License
Copyright (c) 2020, Anton Krotov
All rights reserved.
*)
MODULE HEX;
IMPORT FILES, WRITER, CHL := CHUNKLISTS;
PROCEDURE hexdgt (n: BYTE): BYTE;
BEGIN
IF n < 10 THEN
n := n + ORD("0")
ELSE
n := n - 10 + ORD("A")
END
RETURN n
END hexdgt;
PROCEDURE Byte (file: FILES.FILE; byte: BYTE);
BEGIN
WRITER.WriteByte(file, hexdgt(byte DIV 16));
WRITER.WriteByte(file, hexdgt(byte MOD 16));
INC(file.chksum, byte);
END Byte;
PROCEDURE NewLine (file: FILES.FILE);
BEGIN
Byte(file, (-file.chksum) MOD 256);
file.chksum := 0;
WRITER.WriteByte(file, 0DH);
WRITER.WriteByte(file, 0AH)
END NewLine;
PROCEDURE StartCode (file: FILES.FILE);
BEGIN
WRITER.WriteByte(file, ORD(":"));
file.chksum := 0
END StartCode;
PROCEDURE Data* (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER);
VAR
i, len: INTEGER;
BEGIN
WHILE cnt > 0 DO
len := MIN(cnt, 16);
StartCode(file);
Byte(file, len);
Byte(file, idx DIV 256);
Byte(file, idx MOD 256);
Byte(file, 0);
FOR i := 1 TO len DO
Byte(file, mem[idx]);
INC(idx)
END;
DEC(cnt, len);
NewLine(file)
END
END Data;
PROCEDURE ExtLA* (file: FILES.FILE; LA: INTEGER);
BEGIN
ASSERT((0 <= LA) & (LA <= 0FFFFH));
StartCode(file);
Byte(file, 2);
Byte(file, 0);
Byte(file, 0);
Byte(file, 4);
Byte(file, LA DIV 256);
Byte(file, LA MOD 256);
NewLine(file)
END ExtLA;
PROCEDURE Data2* (file: FILES.FILE; mem: CHL.BYTELIST; idx, cnt, LA: INTEGER);
VAR
i, len, offset: INTEGER;
BEGIN
ExtLA(file, LA);
offset := 0;
WHILE cnt > 0 DO
ASSERT(offset <= 65536);
IF offset = 65536 THEN
INC(LA);
ExtLA(file, LA);
offset := 0
END;
len := MIN(cnt, 16);
StartCode(file);
Byte(file, len);
Byte(file, offset DIV 256);
Byte(file, offset MOD 256);
Byte(file, 0);
FOR i := 1 TO len DO
Byte(file, CHL.GetByte(mem, idx));
INC(idx);
INC(offset)
END;
DEC(cnt, len);
NewLine(file)
END
END Data2;
PROCEDURE End* (file: FILES.FILE);
BEGIN
StartCode(file);
Byte(file, 0);
Byte(file, 0);
Byte(file, 0);
Byte(file, 1);
NewLine(file)
END End;
END HEX.

/programs/develop/oberon07/Source/IL.ob07
1,13 → 1,13
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE IL;
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS;
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS;
CONST
65,7 → 65,7
opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139;
opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145;
opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151;
opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162;
opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168;
opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
83,7 → 83,9
opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221;
opONERR* = 222; opSAVEFI* = 223; opHANDLER* = 224;
opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8;
opLOAD32_PARAM* = -9;
119,7 → 121,19
_guard *= 20;
_guardrec *= 21;
_fmul *= 22;
_fdiv *= 23;
_fdivi *= 24;
_fadd *= 25;
_fsub *= 26;
_fsubi *= 27;
_fcmp *= 28;
_floor *= 29;
_flt *= 30;
_pack *= 31;
_unpk *= 32;
TYPE
LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
184,7 → 198,7
dmin*: INTEGER;
lcount*: INTEGER;
bss*: INTEGER;
rtl*: ARRAY 22 OF INTEGER;
rtl*: ARRAY 33 OF INTEGER;
errlabels*: ARRAY 12 OF INTEGER;
charoffs: ARRAY 256 OF INTEGER;
198,8 → 212,7
VAR
codes*: CODES;
endianness: INTEGER;
numRegsFloat: INTEGER;
endianness, numRegsFloat, CPU: INTEGER;
commands, variables: C.COLLECTION;
433,6 → 446,8
BEGIN
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN
old_opcode := cur.opcode;
param2 := nov.param2;
481,6 → 496,9
ELSE
old_opcode := -1
END
ELSE
old_opcode := -1
END;
IF old_opcode = -1 THEN
633,8 → 651,7
PROCEDURE OnError* (line, error: INTEGER);
BEGIN
AddCmd(opPUSHC, line);
AddJmpCmd(opJMP, codes.errlabels[error])
AddCmd2(opONERR, codes.errlabels[error], line)
END OnError;
877,9 → 894,13
END SysPut;
PROCEDURE savef*;
PROCEDURE savef* (inv: BOOLEAN);
BEGIN
AddCmd0(opSAVEF);
IF inv THEN
AddCmd0(opSAVEFI)
ELSE
AddCmd0(opSAVEF)
END;
DEC(codes.fregs);
ASSERT(codes.fregs >= 0)
END savef;
1138,7 → 1159,7
END DelImport;
PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER);
PROCEDURE init* (pCPU: INTEGER);
VAR
cmd: COMMAND;
i: INTEGER;
1146,9 → 1167,16
BEGIN
commands := C.create();
variables := C.create();
numRegsFloat := pNumRegsFloat;
endianness := pEndianness;
CPU := pCPU;
endianness := little_endian;
CASE CPU OF
|TARGETS.cpuAMD64: numRegsFloat := 6
|TARGETS.cpuX86: numRegsFloat := 8
|TARGETS.cpuMSP430: numRegsFloat := 0
|TARGETS.cpuTHUMB: numRegsFloat := 256
END;
NEW(codes.begcall);
codes.begcall.top := -1;
NEW(codes.endcall);

/programs/develop/oberon07/Source/KOS.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
116,6 → 116,7
icount, dcount, ccount: INTEGER;
code: CHL.BYTELIST;
BEGIN
base := 0;
141,11 → 142,11
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(program.code, reloc.offset);
L := BIN.get32le(code, reloc.offset);
delta := 3 - reloc.offset - text;
CASE reloc.opcode OF
152,32 → 153,32
|BIN.RIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(program.code, reloc.offset, idata + iproc.label)
BIN.put32le(code, reloc.offset, idata + iproc.label)
|BIN.RBSS:
BIN.put32le(program.code, reloc.offset, L + bss)
BIN.put32le(code, reloc.offset, L + bss)
|BIN.RDATA:
BIN.put32le(program.code, reloc.offset, L + data)
BIN.put32le(code, reloc.offset, L + data)
|BIN.RCODE:
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text)
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text)
|BIN.PICDATA:
BIN.put32le(program.code, reloc.offset, L + data + delta)
BIN.put32le(code, reloc.offset, L + data + delta)
|BIN.PICCODE:
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta)
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta)
|BIN.PICBSS:
BIN.put32le(program.code, reloc.offset, L + bss + delta)
BIN.put32le(code, reloc.offset, L + bss + delta)
|BIN.PICIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(program.code, reloc.offset, idata + iproc.label + delta)
BIN.put32le(code, reloc.offset, idata + iproc.label + delta)
|BIN.IMPTAB:
BIN.put32le(program.code, reloc.offset, idata + delta)
BIN.put32le(code, reloc.offset, idata + delta)
END;
198,7 → 199,7
WR.Write32LE(File, header.param);
WR.Write32LE(File, header.path);
CHL.WriteToFile(File, program.code);
CHL.WriteToFile(File, code);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(File, program.data);

/programs/develop/oberon07/Source/LISTS.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/MSCOFF.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
45,19 → 45,11
WHILE reloc # NIL DO
CASE reloc.opcode OF
|BIN.RIMP, BIN.IMPTAB:
WriteReloc(File, reloc.offset, 4, 6)
|BIN.RBSS:
WriteReloc(File, reloc.offset, 5, 6)
|BIN.RDATA:
WriteReloc(File, reloc.offset, 2, 6)
|BIN.RCODE:
WriteReloc(File, reloc.offset, 1, 6)
|BIN.RIMP,
BIN.IMPTAB: WriteReloc(File, reloc.offset, 4, 6)
|BIN.RBSS: WriteReloc(File, reloc.offset, 5, 6)
|BIN.RDATA: WriteReloc(File, reloc.offset, 2, 6)
|BIN.RCODE: WriteReloc(File, reloc.offset, 1, 6)
END;
reloc := reloc.next(BIN.RELOC)
70,9 → 62,11
reloc: BIN.RELOC;
iproc: BIN.IMPRT;
res, L: INTEGER;
code: CHL.BYTELIST;
BEGIN
res := 0;
code := program.code;
reloc := program.rel_list.first(BIN.RELOC);
WHILE reloc # NIL DO
79,14 → 73,14
INC(res);
IF reloc.opcode = BIN.RIMP THEN
L := BIN.get32le(program.code, reloc.offset);
L := BIN.get32le(code, reloc.offset);
iproc := BIN.GetIProc(program, L);
BIN.put32le(program.code, reloc.offset, iproc.label)
BIN.put32le(code, reloc.offset, iproc.label)
END;
IF reloc.opcode = BIN.RCODE THEN
L := BIN.get32le(program.code, reloc.offset);
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L))
L := BIN.get32le(code, reloc.offset);
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L))
END;
reloc := reloc.next(BIN.RELOC)
159,7 → 153,7
FileHeader.Machine := 014CX;
FileHeader.NumberOfSections := 5X;
FileHeader.TimeDateStamp := UTILS.UnixTime();
//FileHeader.PointerToSymbolTable := 0;
(* FileHeader.PointerToSymbolTable := 0; *)
FileHeader.NumberOfSymbols := 6;
FileHeader.SizeOfOptionalHeader := 0X;
FileHeader.Characteristics := 0184X;
169,7 → 163,7
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.PointerToRelocations := 0; *)
flat.PointerToLinenumbers := 0;
SetNumberOfRelocations(flat, RelocCount(program));
flat.NumberOfLinenumbers := 0X;
191,7 → 185,7
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.PointerToRelocations := 0; *)
edata.PointerToLinenumbers := 0;
SetNumberOfRelocations(edata, ExpCount * 2 + 1);
edata.NumberOfLinenumbers := 0X;
202,7 → 196,7
idata.VirtualAddress := 0;
idata.SizeOfRawData := isize;
idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData;
//idata.PointerToRelocations := 0;
(* idata.PointerToRelocations := 0; *)
idata.PointerToLinenumbers := 0;
SetNumberOfRelocations(idata, ICount(ImportTable, ILen));
idata.NumberOfLinenumbers := 0X;

/programs/develop/oberon07/Source/MSP430.ob07
1,20 → 1,20
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
Copyright (c) 2019-2020, Anton Krotov
All rights reserved.
*)
MODULE MSP430;
IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, FILES, WRITER,
IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX,
UTILS, C := CONSOLE, PROG, RTL := MSP430RTL;
CONST
minRAM* = 128; maxRAM* = 10240;
minROM* = 2048; maxROM* = 49152;
minRAM* = 128; maxRAM* = 2048;
minROM* = 2048; maxROM* = 24576;
minStackSize = 64;
24,7 → 24,7
R4 = 4; R5 = 5; R6 = 6; R7 = 7;
IR = 13; HP = 14; BP = 15;
HP = 14; IR = 15;
ACC = R4;
108,7 → 108,9
IdxWords: RECORD src, dst: INTEGER END;
StkCnt: INTEGER;
PROCEDURE EmitLabel (L: INTEGER);
VAR
label: LABEL;
167,9 → 169,18
PROCEDURE src_x (x, Rn: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IdxWords.src := x
RETURN Rn * 256 + sIDX
IF (x = 0) & ~(Rn IN {PC, SR, CG}) THEN
res := Rn * 256 + sINDIR
ELSE
IdxWords.src := x;
res := Rn * 256 + sIDX
END
RETURN res
END src_x;
197,7 → 208,7
BEGIN
CASE x OF
| 0: res := CG * 256
| 1: res := src_x(0, CG); IdxWords.src := NOWORD
| 1: res := CG * 256 + sIDX
| 2: res := indir(CG)
| 4: res := indir(SR)
| 8: res := incr(SR)
213,9 → 224,9
PROCEDURE Op2 (op, src, dst: INTEGER);
BEGIN
ASSERT(BITS(op) + {6, 12..15} = {6, 12..15});
ASSERT(BITS(src) + {4, 5, 8..11} = {4, 5, 8..11});
ASSERT(BITS(dst) + {0..3, 7} = {0..3, 7});
ASSERT(BITS(op) - {6, 12..15} = {});
ASSERT(BITS(src) - {4, 5, 8..11} = {});
ASSERT(BITS(dst) - {0..3, 7} = {});
EmitWord(op + src + dst);
254,7 → 265,8
ELSE
Op1(opPUSH, PC, sINCR);
EmitWord(imm)
END
END;
INC(StkCnt)
END PushImm;
376,13 → 388,15
PROCEDURE Push (reg: INTEGER);
BEGIN
Op1(opPUSH, reg, sREG)
Op1(opPUSH, reg, sREG);
INC(StkCnt)
END Push;
PROCEDURE Pop (reg: INTEGER);
BEGIN
Op2(opMOV, incr(SP), reg)
Op2(opMOV, incr(SP), reg);
DEC(StkCnt)
END Pop;
430,7 → 444,8
EmitCall(RTL.rtl[proc].label);
RTL.Used(proc);
IF params > 0 THEN
Op2(opADD, imm(params * 2), SP)
Op2(opADD, imm(params * 2), SP);
DEC(StkCnt, params)
END
END CallRTL;
582,11 → 597,26
END Neg;
PROCEDURE LocalOffset (offset: INTEGER): INTEGER;
RETURN (offset + StkCnt - ORD(offset > 0)) * 2
END LocalOffset;
PROCEDURE LocalDst (offset: INTEGER): INTEGER;
RETURN dst_x(LocalOffset(offset), SP)
END LocalDst;
PROCEDURE LocalSrc (offset: INTEGER): INTEGER;
RETURN src_x(LocalOffset(offset), SP)
END LocalSrc;
PROCEDURE translate;
VAR
cmd, next: COMMAND;
opcode, param1, param2, label, L, a, n, c1, c2: INTEGER;
opcode, param1, param2, L, a, n, c1, c2: INTEGER;
reg1, reg2: INTEGER;
623,6 → 653,7
|IL.opSADR_PARAM:
Op1(opPUSH, PC, sINCR);
INC(StkCnt);
EmitWord(param2);
Reloc(RDATA)
632,17 → 663,18
|IL.opPUSHC:
PushImm(param2)
|IL.opONERR:
PushImm(param2);
DEC(StkCnt);
EmitJmp(opJMP, param1)
|IL.opLEAVEC:
Pop(PC)
|IL.opENTER:
ASSERT(R.top = -1);
StkCnt := 0;
EmitLabel(param1);
Push(BP);
MovRR(SP, BP);
IF param2 > 8 THEN
Op2(opMOV, imm(param2), R4);
L := NewLabel();
668,14 → 700,11
END;
drop
END;
ASSERT(R.top = -1);
ASSERT(StkCnt = param1);
IF param1 > 0 THEN
MovRR(BP, SP)
Op2(opADD, imm(param1 * 2), SP)
END;
Pop(BP);
Pop(PC)
|IL.opRES:
684,7 → 713,8
|IL.opCLEANUP:
IF param2 # 0 THEN
Op2(opADD, imm(param2 * 2), SP)
Op2(opADD, imm(param2 * 2), SP);
DEC(StkCnt, param2)
END
|IL.opCONST:
720,14 → 750,17
|IL.opLADR:
reg1 := GetAnyReg();
MovRR(BP, reg1);
Op2(opADD, imm(param2 * 2), reg1)
n := LocalOffset(param2);
Op2(opMOV, SP * 256, reg1);
IF n # 0 THEN
Op2(opADD, imm(n), reg1)
END
|IL.opLLOAD8:
Op2(opMOV + BW, src_x(param2 * 2, BP), GetAnyReg())
Op2(opMOV + BW, LocalSrc(param2), GetAnyReg())
|IL.opLLOAD16, IL.opVADR:
Op2(opMOV, src_x(param2 * 2, BP), GetAnyReg())
Op2(opMOV, LocalSrc(param2), GetAnyReg())
|IL.opGLOAD8:
Op2(opMOV + BW, src_x(param2, SR), GetAnyReg());
747,12 → 780,12
|IL.opVLOAD8:
reg1 := GetAnyReg();
Op2(opMOV, src_x(param2 * 2, BP), reg1);
Op2(opMOV, LocalSrc(param2), reg1);
Op2(opMOV + BW, indir(reg1), reg1)
|IL.opVLOAD16:
reg1 := GetAnyReg();
Op2(opMOV, src_x(param2 * 2, BP), reg1);
Op2(opMOV, LocalSrc(param2), reg1);
Op2(opMOV, indir(reg1), reg1)
|IL.opSAVE, IL.opSAVE16:
803,20 → 836,15
Op2(opSUB, imm(param2), reg1)
END;
IF opcode = IL.opSUBL THEN
reg2 := GetAnyReg();
Clear(reg2);
Op2(opSUB, reg1 * 256, reg2);
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
Neg(reg1)
END
|IL.opLADR_SAVEC:
Op2(opMOV, imm(param2), dst_x(param1 * 2, BP))
Op2(opMOV, imm(param2), LocalDst(param1))
|IL.opLADR_SAVE:
UnOp(reg1);
Op2(opMOV, reg1 * 256, dst_x(param2 * 2, BP));
Op2(opMOV, reg1 * 256, LocalDst(param2));
drop
|IL.opGADR_SAVEC:
850,17 → 878,14
drop;
cc := cond(opcode);
next := cmd.next(COMMAND);
IF cmd.next(COMMAND).opcode = IL.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(ORD(BITS(cc) / {0}), label);
cmd := cmd.next(COMMAND)
IF next.opcode = IL.opJE THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
jcc(ORD(BITS(cc) / {0}), next.param1);
cmd := next
ELSE
setcc(cc, GetAnyReg())
END
942,14 → 967,11
BinOp(reg1, reg2);
IF param2 # -1 THEN
Op2(opCMP, reg1 * 256, reg2);
MovRR(reg2, reg1);
drop;
jcc(jb, param1)
ELSE
END;
INCL(R.regs, reg1);
DEC(R.top);
R.stk[R.top] := reg2
END
|IL.opINCC, IL.opINCCB:
UnOp(reg1);
974,19 → 996,19
drop
|IL.opLADR_INCC, IL.opLADR_INCCB:
Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), dst_x(param1 * 2, BP))
Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), LocalDst(param1))
|IL.opLADR_DECCB:
Op2(opSUB + BW, imm(param2), dst_x(param1 * 2, BP))
Op2(opSUB + BW, imm(param2), LocalDst(param1))
|IL.opLADR_INC, IL.opLADR_INCB:
UnOp(reg1);
Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, dst_x(param2 * 2, BP));
Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, LocalDst(param2));
drop
|IL.opLADR_DEC, IL.opLADR_DECB:
UnOp(reg1);
Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, dst_x(param2 * 2, BP));
Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, LocalDst(param2));
drop
|IL.opPUSHT:
1023,6 → 1045,7
UnOp(reg1);
PushAll(0);
Op1(opPUSH, reg1, sIDX);
INC(StkCnt);
EmitWord(-2);
PushImm(param2);
CallRTL(RTL._guardrec, 2);
1078,39 → 1101,32
CallRTL(RTL._length, 2);
GetRegA
|IL.opMIN:
|IL.opMAX,IL.opMIN:
BinOp(reg1, reg2);
Op2(opCMP, reg2 * 256, reg1);
EmitWord(opJL + 1); (* jl L *)
IF opcode = IL.opMIN THEN
cc := opJL + 1
ELSE
cc := opJGE + 1
END;
EmitWord(cc); (* jge/jl L *)
MovRR(reg2, reg1);
(* L: *)
drop
|IL.opMAX:
BinOp(reg1, reg2);
Op2(opCMP, reg2 * 256, reg1);
EmitWord(opJGE + 1); (* jge L *)
MovRR(reg2, reg1);
(* L: *)
drop
|IL.opMINC:
|IL.opMAXC, IL.opMINC:
UnOp(reg1);
Op2(opCMP, imm(param2), reg1);
L := NewLabel();
jcc(jl, L);
IF opcode = IL.opMINC THEN
cc := jl
ELSE
cc := jge
END;
jcc(cc, L);
Op2(opMOV, imm(param2), reg1);
EmitLabel(L)
|IL.opMAXC:
UnOp(reg1);
Op2(opCMP, imm(param2), reg1);
L := NewLabel();
jcc(jge, L);
Op2(opMOV, imm(param2), reg1);
EmitLabel(L)
|IL.opSWITCH:
UnOp(reg1);
IF param2 = 0 THEN
1153,10 → 1169,6
Op2(opMOV + BW, imm(param2), dst_x(0, reg1));
drop
|IL.opODD:
UnOp(reg1);
Op2(opAND, imm(1), reg1)
|IL.opEQS .. IL.opGES:
PushAll(4);
PushImm((opcode - IL.opEQS) * 12);
1353,6 → 1365,7
UnOp(reg1);
PushAll_1;
Op1(opPUSH, PC, sINCR);
INC(StkCnt);
EmitWord(param2);
Reloc(RDATA);
Push(reg1);
1432,8 → 1445,10
END
|IL.opVADR_PARAM:
Op1(opPUSH, BP, sIDX);
EmitWord(param2 * 2)
reg1 := GetAnyReg();
Op2(opMOV, LocalSrc(param2), reg1);
Push(reg1);
drop
|IL.opNEW:
PushAll(1);
1505,8 → 1520,11
|IL.opLADR_INCL, IL.opLADR_EXCL:
PushAll(1);
MovRR(BP, ACC);
Op2(opADD, imm(param2 * 2), ACC);
MovRR(SP, ACC);
n := LocalOffset(param2);
IF n # 0 THEN
Op2(opADD, imm(n), ACC)
END;
Push(ACC);
IF opcode = IL.opLADR_INCL THEN
CallRTL(RTL._incl, 2)
1515,10 → 1533,10
END
|IL.opLADR_INCLC:
Op2(opBIS, imm(ORD({param2})), dst_x(param1 * 2, BP))
Op2(opBIS, imm(ORD({param2})), LocalDst(param1))
|IL.opLADR_EXCLC:
Op2(opBIC, imm(ORD({param2})), dst_x(param1 * 2, BP))
Op2(opBIC, imm(ORD({param2})), LocalDst(param1))
END;
1598,51 → 1616,6
END epilog;
PROCEDURE hexdgt (n: BYTE): BYTE;
BEGIN
IF n < 10 THEN
n := n + ORD("0")
ELSE
n := n - 10 + ORD("A")
END
RETURN n
END hexdgt;
PROCEDURE WriteHexByte (file: FILES.FILE; byte: BYTE);
BEGIN
WRITER.WriteByte(file, hexdgt(byte DIV 16));
WRITER.WriteByte(file, hexdgt(byte MOD 16));
END WriteHexByte;
PROCEDURE WriteHex (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER);
VAR
i, len, chksum: INTEGER;
BEGIN
WHILE cnt > 0 DO
len := MIN(cnt, 16);
chksum := len + idx DIV 256 + idx MOD 256;
WRITER.WriteByte(file, ORD(":"));
WriteHexByte(file, len);
WriteHexByte(file, idx DIV 256);
WriteHexByte(file, idx MOD 256);
WriteHexByte(file, 0);
FOR i := 1 TO len DO
WriteHexByte(file, mem[idx]);
INC(chksum, mem[idx]);
INC(idx)
END;
WriteHexByte(file, (-chksum) MOD 256);
DEC(cnt, len);
WRITER.WriteByte(file, 0DH);
WRITER.WriteByte(file, 0AH)
END
END WriteHex;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER;
1653,7 → 1626,7
reloc: RELOC;
file: FILES.FILE;
file: WR.FILE;
BEGIN
IdxWords.src := NOWORD;
1694,7 → 1667,7
Code.size := Fixup(Code.address, IntVectorSize + TypesSize);
Data.address := Code.address + Code.size;
Data.size := CHL.Length(IL.codes.data);
Data.size := Data.size + ORD(ODD(Data.size));
Data.size := Data.size + Data.size MOD 2;
TextSize := Code.size + Data.size;
IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN
1702,7 → 1675,7
END;
Bss.address := RTL.ram + RTL.VarSize;
Bss.size := IL.codes.bss + ORD(ODD(IL.codes.bss));
Bss.size := IL.codes.bss + IL.codes.bss MOD 2;
heap := Bss.address + Bss.size;
stack := RTL.ram + ram;
ASSERT(stack - heap >= minStackSize);
1754,25 → 1727,19
PutWord(Free.size, adr);
PutWord(4130H, adr); (* RET *)
PutWord(stack, adr);
PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *)
FOR i := 0 TO LEN(IV) - 1 DO
PutWord(LabelOffs(IV[i]) * 2, adr)
END;
file := FILES.create(outname);
WriteHex(file, mem, Code.address, TextSize);
WriteHex(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
file := WR.Create(outname);
WRITER.WriteByte(file, ORD(":"));
WriteHexByte(file, 0);
WriteHexByte(file, 0);
WriteHexByte(file, 0);
WriteHexByte(file, 1);
WriteHexByte(file, 255);
WRITER.WriteByte(file, 0DH);
WRITER.WriteByte(file, 0AH);
HEX.Data(file, mem, Code.address, TextSize);
HEX.Data(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
HEX.End(file);
FILES.close(file);
WR.Close(file);
INC(TextSize, IntVectorSize + TypesSize);
INC(Bss.size, minStackSize + RTL.VarSize);
1784,10 → 1751,9
C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)")
END;
C.Ln;
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)");
C.StringLn("--------------------------------------------")
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)")
END CodeGen;
END MSP430.
END MSP430.

/programs/develop/oberon07/Source/MSP430RTL.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
Copyright (c) 2019-2020, Anton Krotov
All rights reserved.
*)
39,7 → 39,8
LenIV* = 32;
iv = 10000H - LenIV * 2;
sp = iv - 2;
bsl = iv - 2;
sp = bsl - 2;
empty_proc* = sp - 2;
free_size = empty_proc - 2;
free_adr = free_size - 2;
370,18 → 371,20
Word1(4130H) (* RET *)
END;
(* _error (module, err, line: INTEGER) *)
(* _error (modNum, modName, err, line: INTEGER) *)
IF rtl[_error].used THEN
Label(rtl[_error].label);
Word1(0C232H); (* BIC #8, SR; DINT *)
Word1(4303H); (* MOV R3, R3; NOP *)
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *)
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *)
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- modNum *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- modName *)
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- err *)
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- line *)
Word2(4211H, sp); (* MOV sp(SR), SP *)
Word1(1207H); (* PUSH R7 *)
Word1(1206H); (* PUSH R6 *)
Word1(1205H); (* PUSH R5 *)
Word1(1204H); (* PUSH R4 *)
Word1(1205H); (* PUSH R5 *)
Word2(4214H, trap); (* MOV trap(SR), R4 *)
Word1(9304H); (* TST R4 *)
Word1(2400H + 1); (* JZ L *)
663,15 → 666,10
Label := pLabel;
Word := pWord;
Call := pCall;
IF ramSize > 2048 THEN
ram := 1100H
ELSE
ram := 200H
END;
ram := 200H;
trap := ram;
int := trap + 2
END Init;
END MSP430RTL.
END MSP430RTL.

/programs/develop/oberon07/Source/PARS.ob07
1,13 → 1,14
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS,
C := COLLECTIONS, TARGETS, THUMB;
CONST
77,7 → 78,7
parsers: C.COLLECTION;
lines*: INTEGER;
lines*, modules: INTEGER;
PROCEDURE destroy* (VAR parser: PARSER);
132,7 → 133,7
BEGIN
SCAN.Next(parser.scanner, parser.lex);
errno := parser.lex.error;
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN
IF parser.lex.sym = SCAN.lxFLOAT THEN
errno := -SCAN.lxERROR13
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
508,7 → 509,7
check1(FALSE, parser, 124)
END;
check1(sf IN program.target.sysflags, parser, 125);
check1(sf IN program.sysflags, parser, 125);
IF proc THEN
check1(sf IN PROG.proc_flags, parser, 123)
532,15 → 533,15
|PROG.sf_code:
res := PROG.code
|PROG.sf_windows:
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
IF TARGETS.OS = TARGETS.osWIN32 THEN
res := PROG.stdcall
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
res := PROG.win64
END
|PROG.sf_linux:
IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
IF TARGETS.OS = TARGETS.osLINUX32 THEN
res := PROG.ccall16
ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
res := PROG.systemv
END
|PROG.sf_noalign:
577,6 → 578,7
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxSTRING);
dll := parser.lex.s;
STRINGS.UpCase(dll);
ExpectSym(parser, SCAN.lxCOMMA);
ExpectSym(parser, SCAN.lxSTRING);
proc := parser.lex.s;
586,16 → 588,19
checklex(parser, SCAN.lxRSQUARE);
Next(parser)
ELSE
CASE program.target.bit_depth OF
CASE TARGETS.BitDepth OF
|16: call := PROG.default16
|32: call := PROG.default32
|32: IF TARGETS.target = TARGETS.STM32CM3 THEN
call := PROG.ccall
ELSE
call := PROG.default32
END
|64: call := PROG.default64
END
END;
IF import # NIL THEN
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
check(TARGETS.Import, pos, 70)
END
RETURN call
751,8 → 756,8
ExpectSym(parser, SCAN.lxTO);
Next(parser);
t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
t.align := program.target.adr;
t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
getpos(parser, pos);
770,8 → 775,8
ELSIF parser.sym = SCAN.lxPROCEDURE THEN
NextPos(parser, pos);
t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t.align := program.target.adr;
t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
t.call := procflag(parser, import, FALSE);
FormalParameters(parser, t)
ELSE
897,11 → 902,13
variables: LISTS.LIST;
int, flt: INTEGER;
comma: BOOLEAN;
code: ARITH.VALUE;
codeProc: BOOLEAN;
code, iv: ARITH.VALUE;
codeProc,
handler: BOOLEAN;
BEGIN
endmod := FALSE;
handler := FALSE;
unit := parser.unit;
921,13 → 928,27
check(PROG.openScope(unit, proc.proc), pos, 116);
proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc.type;
t.align := program.target.adr;
t.align := TARGETS.AdrSize;
t.call := call;
FormalParameters(parser, t);
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos2);
check(TARGETS.target = TARGETS.STM32CM3, pos2, 24);
Next(parser);
getpos(parser, pos2);
ConstExpression(parser, iv);
check(iv.typ = ARITH.tINTEGER, pos2, 43);
check((0 <= ARITH.Int(iv)) & (ARITH.Int(iv) <= THUMB.maxIVT), pos2, 46);
check(THUMB.SetIV(ARITH.Int(iv)), pos2, 121);
checklex(parser, SCAN.lxRSQUARE);
Next(parser);
handler := TRUE
END;
codeProc := call IN {PROG.code, PROG._code};
IF call IN {PROG.systemv, PROG._systemv} THEN
948,7 → 969,11
IF import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label
proc.proc.label := label;
proc.proc.used := handler;
IF handler THEN
IL.AddCmd2(IL.opHANDLER, label, ARITH.Int(iv))
END
END;
IF codeProc THEN
958,8 → 983,10
getpos(parser, pos2);
ConstExpression(parser, code);
check(code.typ = ARITH.tINTEGER, pos2, 43);
IF program.target.sys # mConst.Target_iMSP430 THEN
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
check(ARITH.range(code, 0, 255), pos2, 42)
ELSIF TARGETS.CPU = TARGETS.cpuTHUMB THEN
check(ARITH.range(code, 0, 65535), pos2, 110)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
976,8 → 1003,8
IF import = NIL THEN
IF parser.main & proc.export & program.dll THEN
IF program.obj THEN
IF parser.main & proc.export & TARGETS.Dll THEN
IF TARGETS.target = TARGETS.KolibriOSDLL THEN
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
END;
IL.AddExp(label, proc.name.s);
1023,8 → 1050,8
proc.proc.leave := IL.LeaveC()
END;
IF program.target.sys = mConst.Target_iMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63)
END
END;
1141,7 → 1168,13
ImportList(parser)
END;
CONSOLE.String("compiling "); CONSOLE.String(unit.name.s);
INC(modules);
CONSOLE.String("compiling ");
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ")
END;
CONSOLE.String(unit.name.s);
IF parser.unit.sysimport THEN
CONSOLE.String(" (SYSTEM)")
END;
1156,6 → 1189,9
IL.SetLabel(errlabel);
IL.StrAdr(name);
IL.Param1;
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
IL.AddCmd(IL.opPUSHC, modules)
END;
IL.AddCmd0(IL.opERR);
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
1227,7 → 1263,7
parser.path := path;
parser.lib_path := lib_path;
parser.ext := mConst.FILE_EXT;
parser.ext := UTILS.FILE_EXT;
parser.fname := path;
parser.modname := "";
parser.scanner := NIL;
1247,12 → 1283,13
END create;
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
PROCEDURE init* (options: PROG.OPTIONS);
BEGIN
program := PROG.create(bit_depth, target, options);
program := PROG.create(options);
parsers := C.create();
lines := 0
lines := 0;
modules := 0
END init;
END PARS.
END PARS.

/programs/develop/oberon07/Source/PATHS.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/PE32.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
7,7 → 7,7
MODULE PE32;
IMPORT BIN, LISTS, UTILS, WR := WRITER, mConst := CONSTANTS, CHL := CHUNKLISTS;
IMPORT BIN, LISTS, UTILS, WR := WRITER, CHL := CHUNKLISTS;
CONST
165,13 → 165,9
Relocations: LISTS.LIST;
bit64: BOOLEAN;
libcnt: INTEGER;
SizeOfWord: INTEGER;
PROCEDURE SIZE (): INTEGER;
RETURN SIZE_OF_DWORD * (ORD(bit64) + 1)
END SIZE;
PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER;
BEGIN
258,7 → 254,7
import := import.next(BIN.IMPRT)
END
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SIZE()
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord
END GetImportSize;
266,33 → 262,34
VAR
reloc: BIN.RELOC;
iproc: BIN.IMPRT;
L: INTEGER;
delta: INTEGER;
AdrImp: INTEGER;
code: CHL.BYTELIST;
L, delta, delta0, AdrImp: INTEGER;
BEGIN
AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD;
code := program.code;
reloc := program.rel_list.first(BIN.RELOC);
delta0 := 3 - 7 * ORD(bit64);
reloc := program.rel_list.first(BIN.RELOC);
WHILE reloc # NIL DO
L := BIN.get32le(program.code, reloc.offset);
delta := 3 - reloc.offset - Address.Code - 7 * ORD(bit64);
L := BIN.get32le(code, reloc.offset);
delta := delta0 - reloc.offset - Address.Code;
CASE reloc.opcode OF
|BIN.PICDATA:
BIN.put32le(program.code, reloc.offset, L + Address.Data + delta)
BIN.put32le(code, reloc.offset, L + Address.Data + delta)
|BIN.PICCODE:
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta)
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta)
|BIN.PICBSS:
BIN.put32le(program.code, reloc.offset, L + Address.Bss + delta)
BIN.put32le(code, reloc.offset, L + Address.Bss + delta)
|BIN.PICIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(program.code, reloc.offset, iproc.FirstThunk * SIZE() + AdrImp + delta)
BIN.put32le(code, reloc.offset, iproc.FirstThunk * SizeOfWord + AdrImp + delta)
END;
418,7 → 415,6
i: INTEGER;
BEGIN
WriteWord(file, h.Magic);
WR.WriteByte(file, h.MajorLinkerVersion);
499,6 → 495,7
BEGIN
bit64 := amd64;
SizeOfWord := SIZE_OF_DWORD * (ORD(bit64) + 1);
Relocations := LISTS.create(NIL);
Size.Code := CHL.Length(program.code);
532,8 → 529,8
PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll));
PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64));
PEHeader.OptionalHeader.MajorLinkerVersion := mConst.vMajor;
PEHeader.OptionalHeader.MinorLinkerVersion := mConst.vMinor;
PEHeader.OptionalHeader.MajorLinkerVersion := UTILS.vMajor;
PEHeader.OptionalHeader.MinorLinkerVersion := UTILS.vMinor;
PEHeader.OptionalHeader.SizeOfCode := align(Size.Code, FileAlignment);
PEHeader.OptionalHeader.SizeOfInitializedData := 0;
PEHeader.OptionalHeader.SizeOfUninitializedData := 0;
658,7 → 655,7
n := (libcnt + 1) * 5;
ImportTable := CHL.CreateIntList();
FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SIZE() + n - 1 DO
FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SizeOfWord + n - 1 DO
CHL.PushInt(ImportTable, 0)
END;
666,11 → 663,11
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
CHL.SetInt(ImportTable, i + 1, 0);
CHL.SetInt(ImportTable, i + 2, 0);
CHL.SetInt(ImportTable, i + 3, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
i := i + 5
END;
import := import.next(BIN.IMPRT)

/programs/develop/oberon07/Source/PROG.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
7,7 → 7,7
MODULE PROG;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS;
CONST
199,25 → 199,15
locsize*: INTEGER;
procs*: LISTS.LIST;
dll*: BOOLEAN;
obj*: BOOLEAN;
sysflags*: SET;
options*: OPTIONS;
stTypes*: RECORD
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
END;
target*: RECORD
bit_depth*: INTEGER;
word*: INTEGER;
adr*: INTEGER;
sys*: INTEGER;
sysflags*: SET;
options*: OPTIONS
END
END;
249,7 → 239,6
PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER;
VAR
word: INTEGER;
size: INTEGER;
BEGIN
263,9 → 252,8
END
END
ELSE
word := program.target.word;
IF UTILS.Align(size, word) THEN
size := size DIV word;
IF UTILS.Align(size, TARGETS.WordSize) THEN
size := size DIV TARGETS.WordSize;
IF UTILS.maxint - program.locsize >= size THEN
INC(program.locsize, size);
varIdent.offset := program.locsize
682,10 → 670,12
ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
ident.type := program.stTypes.tBOOLEAN;
IF program.target.sys # mConst.Target_iMSP430 THEN
IF TARGETS.RealSize # 0 THEN
ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
ident.type := program.stTypes.tREAL;
ident.type := program.stTypes.tREAL
END;
IF TARGETS.BitDepth >= 32 THEN
ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
ident.type := program.stTypes.tWCHAR
END
737,14 → 727,19
EnterFunc(unit, "MIN", stMIN);
EnterFunc(unit, "MAX", stMAX);
IF unit.program.target.sys # mConst.Target_iMSP430 THEN
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "PACK", stPACK);
EnterProc(unit, "UNPK", stUNPK);
EnterProc(unit, "DISPOSE", stDISPOSE);
EnterFunc(unit, "WCHR", stWCHR);
EnterFunc(unit, "FLOOR", stFLOOR);
EnterFunc(unit, "FLT", stFLT)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterFunc(unit, "WCHR", stWCHR)
END;
IF TARGETS.Dispose THEN
EnterProc(unit, "DISPOSE", stDISPOSE)
END
END enterStProcs;
782,7 → 777,7
unit.sysimport := FALSE;
IF unit.name.s = mConst.RTL_NAME THEN
IF unit.name.s = UTILS.RTL_NAME THEN
program.rtl := unit
END
1037,7 → 1032,7
t.unit := unit;
t.num := 0;
CASE program.target.bit_depth OF
CASE TARGETS.BitDepth OF
|16: t.call := default16
|32: t.call := default32
|64: t.call := default64
1119,12 → 1114,18
EnterProc(unit, "DINT", idSYSPROC, sysDINT)
END;
*)
IF program.target.sys # mConst.Target_iMSP430 THEN
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "INF", idSYSFUNC, sysINF);
END;
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
EnterProc(unit, "COPY", idSYSPROC, sysCOPY)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR);
EnterProc(unit, "INF", idSYSFUNC, sysINF);
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32);
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "COPY", idSYSPROC, sysCOPY);
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident.type := program.stTypes.tCARD32;
1191,7 → 1192,7
END DelUnused;
PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM;
PROCEDURE create* (options: OPTIONS): PROGRAM;
VAR
program: PROGRAM;
1198,34 → 1199,18
BEGIN
idents := C.create();
UTILS.SetBitDepth(bit_depth);
UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8);
NEW(program);
program.target.bit_depth := bit_depth;
program.target.word := bit_depth DIV 8;
program.target.adr := bit_depth DIV 8;
program.target.sys := target;
program.target.options := options;
program.options := options;
CASE target OF
|mConst.Target_iConsole,
mConst.Target_iGUI,
mConst.Target_iDLL: program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iELF32,
mConst.Target_iELFSO32: program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iKolibri,
mConst.Target_iObject: program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iConsole64,
mConst.Target_iGUI64,
mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|mConst.Target_iELF64,
mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|mConst.Target_iMSP430: program.target.sysflags := {sf_code}
CASE TARGETS.OS OF
|TARGETS.osWIN32: program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osLINUX32: program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osKOS: program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osWIN64: program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|TARGETS.osLINUX64: program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|TARGETS.osNONE: program.sysflags := {sf_code}
END;
program.recCount := -1;
1235,39 → 1220,36
program.types := LISTS.create(NIL);
program.procs := LISTS.create(NIL);
program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL);
program.stTypes.tINTEGER := enterType(program, tINTEGER, TARGETS.WordSize, 0, NIL);
program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL);
program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL);
program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL);
program.stTypes.tSET := enterType(program, tSET, TARGETS.WordSize, 0, NIL);
program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL);
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tINTEGER.align := TARGETS.WordSize;
program.stTypes.tBYTE.align := 1;
program.stTypes.tCHAR.align := 1;
program.stTypes.tSET.align := TARGETS.WordSize;
program.stTypes.tBOOLEAN.align := 1;
IF TARGETS.BitDepth >= 32 THEN
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL);
program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL);
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL)
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL);
program.stTypes.tWCHAR.align := 2;
program.stTypes.tCARD32.align := 4
END;
program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL);
program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL);
IF TARGETS.RealSize # 0 THEN
program.stTypes.tREAL := enterType(program, tREAL, TARGETS.RealSize, 0, NIL);
program.stTypes.tREAL.align := TARGETS.RealSize
END;
program.stTypes.tSTRING := enterType(program, tSTRING, TARGETS.WordSize, 0, NIL);
program.stTypes.tNIL := enterType(program, tNIL, TARGETS.WordSize, 0, NIL);
program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL);
program.stTypes.tANYREC.closed := TRUE;
program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
program.stTypes.tBYTE.align := 1;
program.stTypes.tCHAR.align := program.stTypes.tCHAR.size;
program.stTypes.tSET.align := program.stTypes.tSET.size;
program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size;
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size;
program.stTypes.tREAL.align := program.stTypes.tREAL.size;
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size
END;
program.dll := FALSE;
program.obj := FALSE;
createSysUnit(program)
RETURN program

/programs/develop/oberon07/Source/REG.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/SCAN.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/STATEMENTS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
9,8 → 9,8
IMPORT
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
CONST
29,9 → 29,7
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3;
TYPE
isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
418,7 → 416,7
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
END;
IL.savef
IL.savef(e.obj = eCONST)
ELSIF isChar(e) & (VarType = tCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
500,6 → 498,7
PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
REPEAT
res := t.length;
513,8 → 512,8
PROCEDURE OpenArray (t, t2: PROG.TYPE_);
VAR
n: INTEGER;
d1, d2: INTEGER;
n, d1, d2: INTEGER;
BEGIN
IF t.length # 0 THEN
IL.Param1;
606,7 → 605,7
IF p.type.base = tCHAR THEN
stroffs := String(e);
IL.StrAdr(stroffs);
IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
ERRORS.WarningMsg(pos.line, pos.col, 0)
END
ELSE (* WCHAR *)
648,17 → 647,16
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
e2: PARS.EXPR;
e1, e2: PARS.EXPR;
pos: PARS.POSITION;
proc: INTEGER;
label: INTEGER;
proc,
label,
n, i: INTEGER;
code: ARITH.VALUE;
e1: PARS.EXPR;
wchar: BOOLEAN;
wchar,
comma: BOOLEAN;
cmd1,
cmd2: IL.COMMAND;
comma: BOOLEAN;
PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
675,6 → 673,7
PROCEDURE shift_minmax (proc: INTEGER): CHAR;
VAR
res: CHAR;
BEGIN
CASE proc OF
|PROG.stASR: res := "A"
777,7 → 776,7
|PROG.stNEW:
varparam(parser, pos, isPtr, TRUE, e);
IF CPU = cpuMSP430 THEN
IF CPU = TARGETS.cpuMSP430 THEN
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63)
END;
IL.New(e.type.base.size, e.type.base.num)
885,9 → 884,9
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
IF e2.obj = eCONST THEN
IF e2.type = tREAL THEN
IL.Float(ARITH.Float(e2.value));
IL.setlast(endcall.prev(IL.COMMAND));
IL.Float(ARITH.Float(e2.value));
IL.savef
IL.savef(FALSE)
ELSE
LoadConst(e2);
IL.setlast(endcall.prev(IL.COMMAND));
896,7 → 895,7
ELSE
IL.setlast(endcall.prev(IL.COMMAND));
IF e2.type = tREAL THEN
IL.savef
IL.savef(FALSE)
ELSIF e2.type = tBYTE THEN
IL.SysPut(tINTEGER.size)
ELSE
962,8 → 961,10
getpos(parser, pos);
PARS.ConstExpression(parser, code);
PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
IF CPU # cpuMSP430 THEN
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
PARS.check(ARITH.range(code, 0, 255), pos, 42)
ELSIF CPU = TARGETS.cpuTHUMB THEN
PARS.check(ARITH.range(code, 0, 65535), pos, 110)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
1113,7 → 1114,7
IF e.obj = eCONST THEN
ARITH.odd(e.value)
ELSE
IL.AddCmd0(IL.opODD)
IL.AddCmd(IL.opMODR, 2)
END
|PROG.stORD:
1409,9 → 1410,8
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
VAR
label: INTEGER;
label, offset, n, k: INTEGER;
type: PROG.TYPE_;
n, offset, k: INTEGER;
BEGIN
1571,11 → 1571,11
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
VAR
cconv: INTEGER;
parSize: INTEGER;
callconv: INTEGER;
fparSize: INTEGER;
int, flt: INTEGER;
cconv,
parSize,
callconv,
fparSize,
int, flt,
stk_par: INTEGER;
BEGIN
1862,12 → 1862,9
PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
pos: PARS.POSITION;
op: INTEGER;
e1: PARS.EXPR;
op, label, label1: INTEGER;
label: INTEGER;
label1: INTEGER;
BEGIN
factor(parser, e);
label := -1;
1972,10 → 1969,7
|SCAN.lxDIV, SCAN.lxMOD:
PARS.check(isInt(e) & isInt(e1), pos, 37);
IF e1.obj = eCONST THEN
PARS.check(~ARITH.isZero(e1.value), pos, 46);
IF CPU = cpuMSP430 THEN
PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
END
END;
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
1988,11 → 1982,7
ELSE
IF e1.obj # eCONST THEN
label1 := IL.NewLabel();
IF CPU = cpuMSP430 THEN
IL.AddJmpCmd(IL.opJG, label1)
ELSE
IL.AddJmpCmd(IL.opJNZ, label1)
END
END;
IF e.obj = eCONST THEN
IL.OnError(pos.line, errDIV);
2223,7 → 2213,6
res: BOOLEAN;
BEGIN
res := TRUE;
IF isString(e) & isCharArray(e1) THEN
3026,11 → 3015,11
ELSIF isRec(e) THEN
IL.drop;
IL.AddCmd(IL.opLADR, e.ident.offset - 1);
IL.load(PARS.program.target.word)
IL.load(TARGETS.WordSize)
ELSIF isPtr(e) THEN
deref(pos, e, FALSE, errPTR);
IL.AddCmd(IL.opSUBR, PARS.program.target.word);
IL.load(PARS.program.target.word)
IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
IL.load(TARGETS.WordSize)
END;
PARS.checklex(parser, SCAN.lxOF);
3243,7 → 3232,6
rtl := PARS.program.rtl;
ASSERT(rtl # NIL);
IF CPU IN {cpuX86, cpuAMD64} THEN
getproc(rtl, "_strcmp", IL._strcmp);
getproc(rtl, "_length", IL._length);
getproc(rtl, "_arrcpy", IL._arrcpy);
3250,22 → 3238,36
getproc(rtl, "_is", IL._is);
getproc(rtl, "_guard", IL._guard);
getproc(rtl, "_guardrec", IL._guardrec);
getproc(rtl, "_error", IL._error);
getproc(rtl, "_new", IL._new);
getproc(rtl, "_rot", IL._rot);
getproc(rtl, "_strcpy", IL._strcpy);
getproc(rtl, "_move", IL._move);
getproc(rtl, "_divmod", IL._divmod);
getproc(rtl, "_set", IL._set);
getproc(rtl, "_set1", IL._set1);
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_lengthw", IL._lengthw);
getproc(rtl, "_strcmpw", IL._strcmpw);
getproc(rtl, "_init", IL._init);
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
getproc(rtl, "_error", IL._error);
getproc(rtl, "_divmod", IL._divmod);
getproc(rtl, "_exit", IL._exit);
getproc(rtl, "_dispose", IL._dispose);
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_dllentry", IL._dllentry);
getproc(rtl, "_dispose", IL._dispose);
getproc(rtl, "_exit", IL._exit);
getproc(rtl, "_init", IL._init);
getproc(rtl, "_sofinit", IL._sofinit)
ELSIF CPU = TARGETS.cpuTHUMB THEN
getproc(rtl, "_fmul", IL._fmul);
getproc(rtl, "_fdiv", IL._fdiv);
getproc(rtl, "_fdivi", IL._fdivi);
getproc(rtl, "_fadd", IL._fadd);
getproc(rtl, "_fsub", IL._fsub);
getproc(rtl, "_fsubi", IL._fsubi);
getproc(rtl, "_fcmp", IL._fcmp);
getproc(rtl, "_floor", IL._floor);
getproc(rtl, "_flt", IL._flt);
getproc(rtl, "_pack", IL._pack);
getproc(rtl, "_unpk", IL._unpk)
END
END setrtl;
3286,19 → 3288,9
tREAL := PARS.program.stTypes.tREAL;
Options := options;
CPU := TARGETS.CPU;
CASE target OF
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
CPU := cpuAMD64
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32,
mConst.Target_iELFSO32:
CPU := cpuX86
|mConst.Target_iMSP430:
CPU := cpuMSP430
END;
ext := mConst.FILE_EXT;
ext := UTILS.FILE_EXT;
CaseLabels := C.create();
CaseVar := C.create();
3305,25 → 3297,21
CaseVariants := LISTS.create(NIL);
LISTS.push(CaseVariants, NewVariant(0, NIL));
CASE CPU OF
|cpuAMD64: IL.init(6, IL.little_endian)
|cpuX86: IL.init(8, IL.little_endian)
|cpuMSP430: IL.init(0, IL.little_endian)
END;
IL.init(CPU);
IF CPU # cpuMSP430 THEN
IF CPU # TARGETS.cpuMSP430 THEN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, mConst.RTL_NAME) THEN
IF parser.open(parser, UTILS.RTL_NAME) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
PARS.destroy(parser);
parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, mConst.RTL_NAME) THEN
IF parser.open(parser, UTILS.RTL_NAME) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT)
ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
END
END
END;
3334,16 → 3322,16
IF parser.open(parser, modname) THEN
parser.parse(parser)
ELSE
ERRORS.FileNotFound(path, modname, mConst.FILE_EXT)
ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
END;
PARS.destroy(parser);
IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
ERRORS.Error(204)
END;
IF CPU # cpuMSP430 THEN
IF CPU # TARGETS.cpuMSP430 THEN
setrtl
END;
3352,12 → 3340,13
IL.set_bss(PARS.program.bss);
CASE CPU OF
| cpuAMD64: AMD64.CodeGen(outname, target, options)
| cpuX86: X86.CodeGen(outname, target, options)
|cpuMSP430: MSP430.CodeGen(outname, target, options)
|TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
END
END compile;
END STATEMENTS.
END STATEMENTS.

/programs/develop/oberon07/Source/STRINGS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
13,6 → 13,7
PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2, i, j: INTEGER;
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
32,13 → 33,12
END append;
PROCEDURE reverse* (VAR s: ARRAY OF CHAR);
PROCEDURE reverse (VAR s: ARRAY OF CHAR);
VAR
i, j: INTEGER;
a, b: CHAR;
BEGIN
i := 0;
j := LENGTH(s) - 1;
172,6 → 172,27
END space;
PROCEDURE cap (VAR c: CHAR);
BEGIN
IF ("a" <= c) & (c <= "z") THEN
c := CHR(ORD(c) - 32)
END
END cap;
PROCEDURE UpCase* (VAR str: ARRAY OF CHAR);
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i < LEN(str)) & (str[i] # 0X) DO
cap(str[i]);
INC(i)
END
END UpCase;
PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN;
VAR
i, k: INTEGER;
276,21 → 297,21
u := ORD(c)
|0C1X..0DFX:
u := LSL(ORD(c) - 0C0H, 6);
u := (ORD(c) - 0C0H) * 64;
IF i + 1 < srclen THEN
INC(i);
INC(u, ORD(BITS(ORD(src[i])) * {0..5}))
INC(u, ORD(src[i]) MOD 64)
END
|0E1X..0EFX:
u := LSL(ORD(c) - 0E0H, 12);
u := (ORD(c) - 0E0H) * 4096;
IF i + 1 < srclen THEN
INC(i);
INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64)
INC(u, (ORD(src[i]) MOD 64) * 64)
END;
IF i + 1 < srclen THEN
INC(i);
INC(u, ORD(BITS(ORD(src[i])) * {0..5}))
INC(u, ORD(src[i]) MOD 64)
END
(*
|0F1X..0F7X:

/programs/develop/oberon07/Source/TARGETS.ob07
0,0 → 1,116
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
All rights reserved.
*)
MODULE TARGETS;
CONST
MSP430* = 0;
Win32C* = 1;
Win32GUI* = 2;
Win32DLL* = 3;
KolibriOS* = 4;
KolibriOSDLL* = 5;
Win64C* = 6;
Win64GUI* = 7;
Win64DLL* = 8;
Linux32* = 9;
Linux32SO* = 10;
Linux64* = 11;
Linux64SO* = 12;
STM32CM3* = 13;
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
TYPE
STRING = ARRAY 32 OF CHAR;
TARGET = RECORD
target, CPU, BitDepth, OS, RealSize: INTEGER;
ComLinePar*, LibDir, FileExt: STRING
END;
VAR
Targets*: ARRAY 14 OF TARGET;
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*: INTEGER;
ComLinePar*, LibDir*, FileExt*: STRING;
Import*, Dispose*, Dll*: BOOLEAN;
PROCEDURE Enter (idx, CPU, BitDepth, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING);
BEGIN
Targets[idx].target := idx;
Targets[idx].CPU := CPU;
Targets[idx].BitDepth := BitDepth;
Targets[idx].RealSize := RealSize;
Targets[idx].OS := OS;
Targets[idx].ComLinePar := ComLinePar;
Targets[idx].LibDir := LibDir;
Targets[idx].FileExt := FileExt;
END Enter;
PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN;
VAR
i: INTEGER;
res: BOOLEAN;
BEGIN
i := 0;
WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO
INC(i)
END;
res := i < LEN(Targets);
IF res THEN
target := Targets[i].target;
CPU := Targets[i].CPU;
BitDepth := Targets[i].BitDepth;
RealSize := Targets[i].RealSize;
OS := Targets[i].OS;
ComLinePar := Targets[i].ComLinePar;
LibDir := Targets[i].LibDir;
FileExt := Targets[i].FileExt;
Import := OS IN {osWIN32, osWIN64, osKOS};
Dispose := ~(target IN {MSP430, STM32CM3});
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
WordSize := BitDepth DIV 8;
AdrSize := WordSize
END
RETURN res
END Select;
BEGIN
Enter( MSP430, cpuMSP430, 16, 0, osNONE, "msp430", "MSP430", ".hex");
Enter( Win32C, cpuX86, 32, 8, osWIN32, "win32con", "Windows32", ".exe");
Enter( Win32GUI, cpuX86, 32, 8, osWIN32, "win32gui", "Windows32", ".exe");
Enter( Win32DLL, cpuX86, 32, 8, osWIN32, "win32dll", "Windows32", ".dll");
Enter( KolibriOS, cpuX86, 32, 8, osKOS, "kosexe", "KolibriOS", "");
Enter( KolibriOSDLL, cpuX86, 32, 8, osKOS, "kosdll", "KolibriOS", ".obj");
Enter( Win64C, cpuAMD64, 64, 8, osWIN64, "win64con", "Windows64", ".exe");
Enter( Win64GUI, cpuAMD64, 64, 8, osWIN64, "win64gui", "Windows64", ".exe");
Enter( Win64DLL, cpuAMD64, 64, 8, osWIN64, "win64dll", "Windows64", ".dll");
Enter( Linux32, cpuX86, 32, 8, osLINUX32, "linux32exe", "Linux32", "");
Enter( Linux32SO, cpuX86, 32, 8, osLINUX32, "linux32so", "Linux32", ".so");
Enter( Linux64, cpuAMD64, 64, 8, osLINUX64, "linux64exe", "Linux64", "");
Enter( Linux64SO, cpuAMD64, 64, 8, osLINUX64, "linux64so", "Linux64", ".so");
Enter( STM32CM3, cpuTHUMB, 32, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
END TARGETS.

/programs/develop/oberon07/Source/TEXTDRV.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/THUMB.ob07
0,0 → 1,2430
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
All rights reserved.
*)
MODULE THUMB;
IMPORT PROG, LISTS, CHL := CHUNKLISTS, BIN, REG, IL, C := CONSOLE,
UTILS, WR := WRITER, HEX, ERRORS, TARGETS;
CONST
R0 = 0; R1 = 1; R2 = 2; R3 = 3; R4 = 4;
SP = 13; LR = 14; PC = 15;
ACC = R0;
je = 0; jne = 1; jnb = 2; jb = 3; jge = 10; jl = 11; jg = 12; jle = 13;
inf = 7F800000H;
STM32_minROM* = 16; STM32_maxROM* = 65536;
STM32_minRAM* = 4; STM32_maxRAM* = 65536;
maxIVT* = 1023;
TYPE
COMMAND = IL.COMMAND;
ANYCODE = POINTER TO RECORD (LISTS.ITEM)
offset: INTEGER
END;
CODE = POINTER TO RECORD (ANYCODE)
code: INTEGER
END;
LABEL = POINTER TO RECORD (ANYCODE)
label: INTEGER
END;
JUMP = POINTER TO RECORD (ANYCODE)
label, diff, len, cond: INTEGER;
short: BOOLEAN
END;
JMP = POINTER TO RECORD (JUMP)
END;
JCC = POINTER TO RECORD (JUMP)
END;
CBXZ = POINTER TO RECORD (JUMP)
reg: INTEGER
END;
CALL = POINTER TO RECORD (JUMP)
END;
RELOC = POINTER TO RECORD (ANYCODE)
reg, rel, value: INTEGER
END;
RELOCCODE = ARRAY 7 OF INTEGER;
VAR
R: REG.REGS;
tcount: INTEGER;
CodeList: LISTS.LIST;
program: BIN.PROGRAM;
StkCount: INTEGER;
Target: RECORD
FlashAdr,
SRAMAdr,
IVTLen,
MinStack,
Reserved: INTEGER;
InstrSet: RECORD thumb2, it, cbxz, sdiv: BOOLEAN END
END;
IVT: ARRAY maxIVT + 1 OF INTEGER;
sdivProc, trap, genTrap, entry, emptyProc, int0, genInt: INTEGER;
PROCEDURE Code (code: INTEGER);
VAR
c: CODE;
BEGIN
NEW(c);
c.code := code;
LISTS.push(CodeList, c)
END Code;
PROCEDURE Label (label: INTEGER);
VAR
L: LABEL;
BEGIN
NEW(L);
L.label := label;
LISTS.push(CodeList, L)
END Label;
PROCEDURE jcc (cond, label: INTEGER);
VAR
j: JCC;
BEGIN
NEW(j);
j.label := label;
j.cond := cond;
j.short := FALSE;
j.len := 3;
LISTS.push(CodeList, j)
END jcc;
PROCEDURE cbxz (cond, reg, label: INTEGER);
VAR
j: CBXZ;
BEGIN
NEW(j);
j.label := label;
j.cond := cond;
j.reg := reg;
j.short := FALSE;
j.len := 4;
LISTS.push(CodeList, j)
END cbxz;
PROCEDURE jmp (label: INTEGER);
VAR
j: JMP;
BEGIN
NEW(j);
j.label := label;
j.short := FALSE;
j.len := 2;
LISTS.push(CodeList, j)
END jmp;
PROCEDURE call (label: INTEGER);
VAR
c: CALL;
BEGIN
NEW(c);
c.label := label;
c.short := FALSE;
c.len := 2;
LISTS.push(CodeList, c)
END call;
PROCEDURE reloc (reg, rel, value: INTEGER);
VAR
r: RELOC;
BEGIN
NEW(r);
r.reg := reg;
r.rel := rel;
r.value := value;
LISTS.push(CodeList, r)
END reloc;
PROCEDURE NewLabel (): INTEGER;
BEGIN
BIN.NewLabel(program)
RETURN IL.NewLabel()
END NewLabel;
PROCEDURE range (x, n: INTEGER): BOOLEAN;
RETURN (0 <= x) & (x < LSL(1, n))
END range;
PROCEDURE srange (x, n: INTEGER): BOOLEAN;
RETURN (-LSL(1, n - 1) <= x) & (x < LSL(1, n - 1))
END srange;
PROCEDURE gen1 (op, imm, rs, rd: INTEGER);
BEGIN
ASSERT(op IN {0..2});
ASSERT(range(imm, 5));
ASSERT(range(rs, 3));
ASSERT(range(rd, 3));
Code(LSL(op, 11) + LSL(imm, 6) + LSL(rs, 3) + rd)
END gen1;
PROCEDURE gen2 (i, op: BOOLEAN; imm, rs, rd: INTEGER);
BEGIN
ASSERT(range(imm, 3));
ASSERT(range(rs, 3));
ASSERT(range(rd, 3));
Code(1800H + LSL(ORD(i), 10) + LSL(ORD(op), 9) + LSL(imm, 6) + LSL(rs, 3) + rd)
END gen2;
PROCEDURE gen3 (op, rd, imm: INTEGER);
BEGIN
ASSERT(range(op, 2));
ASSERT(range(rd, 3));
ASSERT(range(imm, 8));
Code(2000H + LSL(op, 11) + LSL(rd, 8) + imm)
END gen3;
PROCEDURE gen4 (op, rs, rd: INTEGER);
BEGIN
ASSERT(range(op, 4));
ASSERT(range(rs, 3));
ASSERT(range(rd, 3));
Code(4000H + LSL(op, 6) + LSL(rs, 3) + rd)
END gen4;
PROCEDURE gen5 (op: INTEGER; h1, h2: BOOLEAN; rs, rd: INTEGER);
BEGIN
ASSERT(range(op, 2));
ASSERT(range(rs, 3));
ASSERT(range(rd, 3));
Code(4400H + LSL(op, 8) + LSL(ORD(h1), 7) + LSL(ORD(h2), 6) + LSL(rs, 3) + rd)
END gen5;
PROCEDURE gen7 (l, b: BOOLEAN; ro, rb, rd: INTEGER);
BEGIN
ASSERT(range(ro, 3));
ASSERT(range(rb, 3));
ASSERT(range(rd, 3));
Code(5000H + LSL(ORD(l), 11) + LSL(ORD(b), 10) + LSL(ro, 6) + LSL(rb, 3) + rd)
END gen7;
PROCEDURE gen8 (h, s: BOOLEAN; ro, rb, rd: INTEGER);
BEGIN
ASSERT(range(ro, 3));
ASSERT(range(rb, 3));
ASSERT(range(rd, 3));
Code(5200H + LSL(ORD(h), 11) + LSL(ORD(s), 10) + LSL(ro, 6) + LSL(rb, 3) + rd)
END gen8;
PROCEDURE gen9 (b, l: BOOLEAN; imm, rb, rd: INTEGER);
BEGIN
ASSERT(range(imm, 5));
ASSERT(range(rb, 3));
ASSERT(range(rd, 3));
Code(6000H + LSL(ORD(b), 12) + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd)
END gen9;
PROCEDURE gen10 (l: BOOLEAN; imm, rb, rd: INTEGER);
BEGIN
ASSERT(range(imm, 5));
ASSERT(range(rb, 3));
ASSERT(range(rd, 3));
Code(8000H + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd)
END gen10;
PROCEDURE gen11 (l: BOOLEAN; rd, imm: INTEGER);
BEGIN
ASSERT(range(rd, 3));
ASSERT(range(imm, 8));
Code(9000H + LSL(ORD(l), 11) + LSL(rd, 8) + imm)
END gen11;
PROCEDURE gen12 (sp: BOOLEAN; rd, imm: INTEGER);
BEGIN
ASSERT(range(rd, 3));
ASSERT(range(imm, 8));
Code(0A000H + LSL(ORD(sp), 11) + LSL(rd, 8) + imm)
END gen12;
PROCEDURE gen14 (l, r: BOOLEAN; rlist: SET);
VAR
i, n: INTEGER;
BEGIN
ASSERT(range(ORD(rlist), 8));
n := ORD(r);
FOR i := 0 TO 7 DO
IF i IN rlist THEN
INC(n)
END
END;
IF l THEN
n := -n
END;
INC(StkCount, n);
Code(0B400H + LSL(ORD(l), 11) + LSL(ORD(r), 8) + ORD(rlist))
END gen14;
PROCEDURE split16 (imm16: INTEGER; VAR imm4, imm1, imm3, imm8: INTEGER);
BEGIN
ASSERT(range(imm16, 16));
imm8 := imm16 MOD 256;
imm4 := LSR(imm16, 12);
imm3 := LSR(imm16, 8) MOD 8;
imm1 := LSR(imm16, 11) MOD 2;
END split16;
PROCEDURE LslImm (r, imm5: INTEGER);
BEGIN
gen1(0, imm5, r, r)
END LslImm;
PROCEDURE LsrImm (r, imm5: INTEGER);
BEGIN
gen1(1, imm5, r, r)
END LsrImm;
PROCEDURE AsrImm (r, imm5: INTEGER);
BEGIN
gen1(2, imm5, r, r)
END AsrImm;
PROCEDURE AddReg (rd, rs, rn: INTEGER);
BEGIN
gen2(FALSE, FALSE, rn, rs, rd)
END AddReg;
PROCEDURE SubReg (rd, rs, rn: INTEGER);
BEGIN
gen2(FALSE, TRUE, rn, rs, rd)
END SubReg;
PROCEDURE AddImm8 (rd, imm8: INTEGER);
BEGIN
IF imm8 # 0 THEN
gen3(2, rd, imm8)
END
END AddImm8;
PROCEDURE SubImm8 (rd, imm8: INTEGER);
BEGIN
IF imm8 # 0 THEN
gen3(3, rd, imm8)
END
END SubImm8;
PROCEDURE AddSubImm12 (r, imm12: INTEGER; sub: BOOLEAN);
VAR
imm4, imm1, imm3, imm8: INTEGER;
BEGIN
split16(imm12, imm4, imm1, imm3, imm8);
Code(0F200H + LSL(imm1, 10) + r + 0A0H * ORD(sub)); (* addw/subw r, r, imm12 *)
Code(LSL(imm3, 12) + LSL(r, 8) + imm8)
END AddSubImm12;
PROCEDURE MovImm8 (rd, imm8: INTEGER);
BEGIN
gen3(0, rd, imm8)
END MovImm8;
PROCEDURE CmpImm8 (rd, imm8: INTEGER);
BEGIN
gen3(1, rd, imm8)
END CmpImm8;
PROCEDURE Neg (r: INTEGER);
BEGIN
gen4(9, r, r)
END Neg;
PROCEDURE Mul (rd, rs: INTEGER);
BEGIN
gen4(13, rs, rd)
END Mul;
PROCEDURE Str32 (rs, rb: INTEGER);
BEGIN
gen9(FALSE, FALSE, 0, rb, rs)
END Str32;
PROCEDURE Ldr32 (rd, rb: INTEGER);
BEGIN
gen9(FALSE, TRUE, 0, rb, rd)
END Ldr32;
PROCEDURE Str16 (rs, rb: INTEGER);
BEGIN
gen10(FALSE, 0, rb, rs)
END Str16;
PROCEDURE Ldr16 (rd, rb: INTEGER);
BEGIN
gen10(TRUE, 0, rb, rd)
END Ldr16;
PROCEDURE Str8 (rs, rb: INTEGER);
BEGIN
gen9(TRUE, FALSE, 0, rb, rs)
END Str8;
PROCEDURE Ldr8 (rd, rb: INTEGER);
BEGIN
gen9(TRUE, TRUE, 0, rb, rd)
END Ldr8;
PROCEDURE Cmp (r1, r2: INTEGER);
BEGIN
gen4(10, r2, r1)
END Cmp;
PROCEDURE Tst (r: INTEGER);
BEGIN
gen3(1, r, 0) (* cmp r, #0 *)
END Tst;
PROCEDURE LdrSp (r, offset: INTEGER);
BEGIN
gen11(TRUE, r, offset)
END LdrSp;
PROCEDURE MovImm32 (r, imm32: INTEGER);
BEGIN
MovImm8(r, LSR(imm32, 24) MOD 256);
LslImm(r, 8);
AddImm8(r, LSR(imm32, 16) MOD 256);
LslImm(r, 8);
AddImm8(r, LSR(imm32, 8) MOD 256);
LslImm(r, 8);
AddImm8(r, imm32 MOD 256)
END MovImm32;
PROCEDURE low (x: INTEGER): INTEGER;
RETURN x MOD 65536
END low;
PROCEDURE high (x: INTEGER): INTEGER;
RETURN (x DIV 65536) MOD 65536
END high;
PROCEDURE movwt (r, imm16, t: INTEGER);
VAR
imm1, imm3, imm4, imm8: INTEGER;
BEGIN
ASSERT(range(r, 3));
ASSERT(range(imm16, 16));
ASSERT(range(t, 1));
split16(imm16, imm4, imm1, imm3, imm8);
Code(0F240H + imm1 * 1024 + t * 128 + imm4);
Code(imm3 * 4096 + r * 256 + imm8);
END movwt;
PROCEDURE inv0 (cond: INTEGER): INTEGER;
RETURN ORD(BITS(cond) / {0})
END inv0;
PROCEDURE fixup (CodeAdr, DataAdr, BssAdr: INTEGER);
VAR
code: ANYCODE;
count: INTEGER;
shorted: BOOLEAN;
jump: JUMP;
first, second: INTEGER;
reloc, i, diff, len: INTEGER;
RelocCode: RELOCCODE;
PROCEDURE genjcc (cond, offset: INTEGER): INTEGER;
BEGIN
ASSERT(range(cond, 4));
ASSERT(srange(offset, 8))
RETURN 0D000H + cond * 256 + offset MOD 256
END genjcc;
PROCEDURE genjmp (offset: INTEGER): INTEGER;
BEGIN
ASSERT(srange(offset, 11))
RETURN 0E000H + offset MOD 2048
END genjmp;
PROCEDURE genlongjmp (offset: INTEGER; VAR first, second: INTEGER);
BEGIN
ASSERT(srange(offset, 22));
first := 0F000H + ASR(offset, 11) MOD 2048;
second := 0F800H + offset MOD 2048
END genlongjmp;
PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE);
VAR
imm1, imm3, imm4, imm8: INTEGER;
BEGIN
split16(imm16, imm4, imm1, imm3, imm8);
code[t * 2] := 0F240H + imm1 * 1024 + t * 128 + imm4;
code[t * 2 + 1] := imm3 * 4096 + r * 256 + imm8
END movwt;
PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE);
BEGIN
IF Target.InstrSet.thumb2 THEN
movwt(r, low(value), 0, code);
movwt(r, high(value), 1, code)
ELSE
code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* mov r, #imm8 *)
code[1] := 0200H + r * 9; (* lsl r, r, #8 *)
code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* add r, #imm8 *)
code[3] := code[1]; (* lsl r, r, #8 *)
code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* add r, #imm8 *)
code[5] := code[1]; (* lsl r, r, #8 *)
code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* add r, #imm8 *)
END
END genmovimm32;
PROCEDURE PutCode (code: INTEGER);
BEGIN
BIN.PutCode16LE(program, code)
END PutCode;
PROCEDURE genbc (code: JUMP);
VAR
first, second: INTEGER;
BEGIN
CASE code.len OF
|1: PutCode(genjcc(code.cond, code.diff))
|2: PutCode(genjcc(inv0(code.cond), 0));
PutCode(genjmp(code.diff))
|3: PutCode(genjcc(inv0(code.cond), 1));
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
END
END genbc;
PROCEDURE SetIV (idx, label, CodeAdr: INTEGER);
VAR
l, h: ANYCODE;
BEGIN
l := CodeList.first(ANYCODE);
h := l.next(ANYCODE);
WHILE idx > 0 DO
l := h.next(ANYCODE);
h := l.next(ANYCODE);
DEC(idx)
END;
label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1;
l(CODE).code := low(label);
h(CODE).code := high(label)
END SetIV;
BEGIN
REPEAT
shorted := FALSE;
count := 0;
code := CodeList.first(ANYCODE);
WHILE code # NIL DO
code.offset := count;
CASE code OF
|CODE: INC(count)
|LABEL: BIN.SetLabel(program, code.label, count)
|JUMP: INC(count, code.len); code.offset := count + ORD(code.short)
|RELOC: INC(count, 7 - ORD(Target.InstrSet.thumb2) * 3 + code.rel MOD 2)
END;
code := code.next(ANYCODE)
END;
code := CodeList.first(ANYCODE);
WHILE code # NIL DO
IF code IS JUMP THEN
jump := code(JUMP);
jump.diff := BIN.GetLabel(program, jump.label) - jump.offset;
len := jump.len;
diff := jump.diff;
CASE jump OF
|JMP:
IF (len = 2) & srange(diff, 11) THEN
len := 1
END
|JCC:
CASE len OF
|1:
|2: IF srange(diff, 8) THEN DEC(len) END
|3: IF srange(diff, 11) THEN DEC(len) END
END
|CBXZ:
CASE len OF
|1:
|2: IF range(diff, 6) THEN DEC(len) END
|3: IF srange(diff, 8) THEN DEC(len) END
|4: IF srange(diff, 11) THEN DEC(len) END
END
|CALL:
END;
IF len # jump.len THEN
jump.len := len;
jump.short := TRUE;
shorted := TRUE
END
END;
code := code.next(ANYCODE)
END
UNTIL ~shorted;
FOR i := 1 TO Target.IVTLen - 1 DO
SetIV(i, IVT[i], CodeAdr)
END;
code := CodeList.first(ANYCODE);
WHILE code # NIL DO
CASE code OF
|CODE: BIN.PutCode16LE(program, code.code)
|LABEL:
|JMP:
IF code.len = 1 THEN
PutCode(genjmp(code.diff))
ELSE
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
END
|JCC: genbc(code)
|CBXZ:
IF code.len > 1 THEN
PutCode(2800H + code.reg * 256); (* cmp code.reg, #0 *)
DEC(code.len);
genbc(code)
ELSE
(* cb(n)z code.reg, L *)
PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * ORD(code.diff >= 32) + (code.diff MOD 32) * 8 + code.reg)
END
|CALL:
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
|RELOC:
CASE code.rel OF
|BIN.RCODE, BIN.PICCODE: reloc := BIN.GetLabel(program, code.value) * 2 + CodeAdr
|BIN.RDATA, BIN.PICDATA: reloc := code.value + DataAdr
|BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(Target.InstrSet.thumb2) + 9))
END;
genmovimm32(code.reg, reloc, RelocCode);
FOR i := 0 TO 6 - 3 * ORD(Target.InstrSet.thumb2) DO
PutCode(RelocCode[i])
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
PutCode(4478H + code.reg) (* add code.reg, PC *)
END
END;
code := code.next(ANYCODE)
END
END fixup;
PROCEDURE push (r: INTEGER);
BEGIN
gen14(FALSE, FALSE, {r})
END push;
PROCEDURE pop (r: INTEGER);
BEGIN
gen14(TRUE, FALSE, {r})
END pop;
PROCEDURE mov (r1, r2: INTEGER);
BEGIN
IF (r1 < 8) & (r2 < 8) THEN
gen1(0, 0, r2, r1)
ELSE
gen5(2, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8)
END
END mov;
PROCEDURE xchg (r1, r2: INTEGER);
BEGIN
push(r1); push(r2);
pop(r1); pop(r2)
END xchg;
PROCEDURE drop;
BEGIN
REG.Drop(R)
END drop;
PROCEDURE GetAnyReg (): INTEGER;
RETURN REG.GetAnyReg(R)
END GetAnyReg;
PROCEDURE UnOp (VAR r: INTEGER);
BEGIN
REG.UnOp(R, r)
END UnOp;
PROCEDURE BinOp (VAR r1, r2: INTEGER);
BEGIN
REG.BinOp(R, r1, r2)
END BinOp;
PROCEDURE PushAll (NumberOfParameters: INTEGER);
BEGIN
REG.PushAll(R);
DEC(R.pushed, NumberOfParameters)
END PushAll;
PROCEDURE cond (op: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
CASE op OF
|IL.opGT, IL.opGTC: res := jg
|IL.opGE, IL.opGEC: res := jge
|IL.opLT, IL.opLTC: res := jl
|IL.opLE, IL.opLEC: res := jle
|IL.opEQ, IL.opEQC: res := je
|IL.opNE, IL.opNEC: res := jne
END
RETURN res
END cond;
PROCEDURE GetRegA;
BEGIN
ASSERT(REG.GetReg(R, ACC))
END GetRegA;
PROCEDURE MovConst (r, c: INTEGER);
BEGIN
IF (0 <= c) & (c <= 255) THEN
MovImm8(r, c)
ELSIF (-255 <= c) & (c < 0) THEN
MovImm8(r, -c);
Neg(r)
ELSIF UTILS.Log2(c) >= 0 THEN
MovImm8(r, 1);
LslImm(r, UTILS.Log2(c))
ELSIF c = UTILS.min32 THEN
MovImm8(r, 1);
LslImm(r, 31)
ELSE
IF Target.InstrSet.thumb2 THEN
movwt(r, low(c), 0);
IF (c < 0) OR (c > 65535) THEN
movwt(r, high(c), 1)
END
ELSE
MovImm32(r, c)
END
END
END MovConst;
PROCEDURE CmpConst (r, c: INTEGER);
VAR
r2: INTEGER;
BEGIN
IF (0 <= c) & (c <= 255) THEN
CmpImm8(r, c)
ELSE
r2 := GetAnyReg();
ASSERT(r2 # r);
MovConst(r2, c);
Cmp(r, r2);
drop
END
END CmpConst;
PROCEDURE LocalOffset (offset: INTEGER): INTEGER;
RETURN offset + StkCount - ORD(offset > 0)
END LocalOffset;
PROCEDURE SetCC (cc, r: INTEGER);
VAR
L1, L2: INTEGER;
BEGIN
IF Target.InstrSet.it THEN
Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *)
MovConst(r, 1);
MovConst(r, 0)
ELSE
L1 := NewLabel();
L2 := NewLabel();
jcc(cc, L1);
MovConst(r, 0);
jmp(L2);
Label(L1);
MovConst(r, 1);
Label(L2)
END
END SetCC;
PROCEDURE PushConst (n: INTEGER);
VAR
r: INTEGER;
BEGIN
r := GetAnyReg();
MovConst(r, n);
push(r);
drop
END PushConst;
PROCEDURE AddConst (r, n: INTEGER);
VAR
r2: INTEGER;
BEGIN
IF n # 0 THEN
IF (-255 <= n) & (n <= 255) THEN
IF n > 0 THEN
AddImm8(r, n)
ELSE
SubImm8(r, -n)
END
ELSIF Target.InstrSet.thumb2 & (-4095 <= n) & (n <= 4095) THEN
IF n > 0 THEN
AddSubImm12(r, n, FALSE)
ELSE
AddSubImm12(r, -n, TRUE)
END
ELSE
r2 := GetAnyReg();
ASSERT(r2 # r);
IF n > 0 THEN
MovConst(r2, n);
AddReg(r, r, r2)
ELSE
MovConst(r2, -n);
SubReg(r, r, r2)
END;
drop
END
END
END AddConst;
PROCEDURE AddHH (r1, r2: INTEGER);
BEGIN
ASSERT((r1 >= 8) OR (r2 >= 8));
gen5(0, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8)
END AddHH;
PROCEDURE AddSP (n: INTEGER);
BEGIN
IF n > 0 THEN
IF n < 127 THEN
Code(0B000H + n) (* add sp, n*4 *)
ELSE
ASSERT(R2 IN R.regs);
MovConst(R2, n * 4);
AddHH(SP, R2)
END;
DEC(StkCount, n)
END
END AddSP;
PROCEDURE cbz (r, label: INTEGER);
BEGIN
IF Target.InstrSet.cbxz THEN
cbxz(je, r, label)
ELSE
Tst(r);
jcc(je, label)
END
END cbz;
PROCEDURE cbnz (r, label: INTEGER);
BEGIN
IF Target.InstrSet.cbxz THEN
cbxz(jne, r, label)
ELSE
Tst(r);
jcc(jne, label)
END
END cbnz;
PROCEDURE Shift (op, r1, r2: INTEGER);
VAR
L: INTEGER;
BEGIN
LslImm(r2, 27);
LsrImm(r2, 27);
L := NewLabel();
cbz(r2, L);
CASE op OF
|IL.opLSL, IL.opLSL1: gen4(2, r2, r1)
|IL.opLSR, IL.opLSR1: gen4(3, r2, r1)
|IL.opASR, IL.opASR1: gen4(4, r2, r1)
|IL.opROR, IL.opROR1: gen4(7, r2, r1)
END;
Label(L)
END Shift;
PROCEDURE LocAdr (offs: INTEGER);
VAR
r1, n: INTEGER;
BEGIN
r1 := GetAnyReg();
n := LocalOffset(offs);
IF n <= 255 THEN
gen12(TRUE, r1, n)
ELSE
MovConst(r1, n * 4);
AddHH(r1, SP)
END
END LocAdr;
PROCEDURE CallRTL (proc, par: INTEGER);
BEGIN
call(IL.codes.rtl[proc]);
AddSP(par)
END CallRTL;
PROCEDURE divmod;
BEGIN
call(sdivProc);
AddSP(2)
END divmod;
PROCEDURE translate (pic, stroffs: INTEGER);
VAR
cmd, next: COMMAND;
opcode, param1, param2: INTEGER;
r1, r2, r3: INTEGER;
a, n, cc, L, L2: INTEGER;
BEGIN
cmd := IL.codes.commands.first(COMMAND);
WHILE cmd # NIL DO
param1 := cmd.param1;
param2 := cmd.param2;
opcode := cmd.opcode;
CASE opcode OF
|IL.opJMP:
jmp(param1)
|IL.opLABEL:
Label(param1)
|IL.opHANDLER:
IF param2 = 0 THEN
int0 := param1
ELSIF param2 = 1 THEN
trap := param1
ELSE
IVT[param2] := param1
END
|IL.opCALL:
call(param1)
|IL.opCALLP:
UnOp(r1);
AddImm8(r1, 1);
gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *)
drop;
ASSERT(R.top = -1)
|IL.opENTER:
ASSERT(R.top = -1);
Label(param1);
gen14(FALSE, TRUE, {}); (* push LR *)
n := param2;
IF n >= 5 THEN
MovConst(ACC, 0);
MovConst(R2, n);
L := NewLabel();
Label(L);
push(ACC);
SubImm8(R2, 1);
Tst(R2);
jcc(jne, L)
ELSIF n > 0 THEN
MovConst(ACC, 0);
WHILE n > 0 DO
push(ACC);
DEC(n)
END
END;
StkCount := param2
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode # IL.opLEAVE THEN
UnOp(r1);
IF r1 # ACC THEN
GetRegA;
ASSERT(REG.Exchange(R, r1, ACC));
drop
END;
drop
END;
ASSERT(R.top = -1);
ASSERT(StkCount = param1);
AddSP(param1);
gen14(TRUE, TRUE, {}) (* pop PC *)
|IL.opLEAVEC:
gen5(3, FALSE, TRUE, 6, 0) (* bx LR *)
|IL.opPRECALL:
PushAll(0)
|IL.opPARAM:
n := param2;
IF n = 1 THEN
UnOp(r1);
push(r1);
drop
ELSE
ASSERT(R.top + 1 <= n);
PushAll(n)
END
|IL.opCLEANUP:
AddSP(param2)
|IL.opRES, IL.opRESF:
ASSERT(R.top = -1);
GetRegA
|IL.opPUSHC:
PushConst(param2)
|IL.opONERR:
MovConst(R0, param2);
push(R0);
DEC(StkCount);
jmp(param1)
|IL.opERR:
call(genTrap)
|IL.opNOP:
|IL.opSADR:
reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2)
|IL.opGADR:
reloc(GetAnyReg(), BIN.RBSS + pic, param2)
|IL.opLADR:
LocAdr(param2)
|IL.opGLOAD32:
r1 := GetAnyReg();
reloc(r1, BIN.RBSS + pic, param2);
Ldr32(r1, r1)
|IL.opGLOAD16:
r1 := GetAnyReg();
reloc(r1, BIN.RBSS + pic, param2);
Ldr16(r1, r1)
|IL.opGLOAD8:
r1 := GetAnyReg();
reloc(r1, BIN.RBSS + pic, param2);
Ldr8(r1, r1)
|IL.opLLOAD32, IL.opVADR, IL.opVLOAD32:
r1 := GetAnyReg();
n := LocalOffset(param2);
IF n <= 255 THEN
LdrSp(r1, n)
ELSE
drop;
LocAdr(param2);
UnOp(r1);
Ldr32(r1, r1)
END;
IF opcode = IL.opVLOAD32 THEN
Ldr32(r1, r1)
END
|IL.opLLOAD16:
LocAdr(param2);
UnOp(r1);
Ldr16(r1, r1)
|IL.opLLOAD8:
LocAdr(param2);
UnOp(r1);
Ldr8(r1, r1)
|IL.opLOAD32, IL.opLOADF:
UnOp(r1);
Ldr32(r1, r1)
|IL.opLOAD16:
UnOp(r1);
Ldr16(r1, r1)
|IL.opLOAD8:
UnOp(r1);
Ldr8(r1, r1)
|IL.opVLOAD16:
LocAdr(param2);
UnOp(r1);
Ldr32(r1, r1);
Ldr16(r1, r1)
|IL.opVLOAD8:
LocAdr(param2);
UnOp(r1);
Ldr32(r1, r1);
Ldr8(r1, r1)
|IL.opSBOOL:
BinOp(r2, r1);
Tst(r2);
SetCC(jne, r2);
Str8(r2, r1);
drop;
drop
|IL.opSBOOLC:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, ORD(param2 # 0));
Str8(r2, r1);
drop;
drop
|IL.opSAVEC:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, param2);
Str32(r2, r1);
drop;
drop
|IL.opSAVE16C:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, low(param2));
Str16(r2, r1);
drop;
drop
|IL.opSAVE8C:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, param2 MOD 256);
Str8(r2, r1);
drop;
drop
|IL.opSAVE, IL.opSAVE32, IL.opSAVEF:
BinOp(r2, r1);
Str32(r2, r1);
drop;
drop
|IL.opSAVEFI:
BinOp(r2, r1);
Str32(r1, r2);
drop;
drop
|IL.opSAVE16:
BinOp(r2, r1);
Str16(r2, r1);
drop;
drop
|IL.opSAVE8:
BinOp(r2, r1);
Str8(r2, r1);
drop;
drop
|IL.opSAVEP:
UnOp(r1);
r2 := GetAnyReg();
reloc(r2, BIN.RCODE + pic, param2);
Str32(r2, r1);
drop;
drop
|IL.opPUSHP:
reloc(GetAnyReg(), BIN.RCODE + pic, param2)
|IL.opEQB, IL.opNEB:
BinOp(r1, r2);
drop;
L := NewLabel();
cbz(r1, L);
MovConst(r1, 1);
Label(L);
L := NewLabel();
cbz(r2, L);
MovConst(r2, 1);
Label(L);
Cmp(r1, r2);
IF opcode = IL.opEQB THEN
SetCC(je, r1)
ELSE
SetCC(jne, r1)
END
|IL.opACC:
IF (R.top # 0) OR (R.stk[0] # ACC) THEN
PushAll(0);
GetRegA;
pop(ACC);
DEC(R.pushed)
END
|IL.opDROP:
UnOp(r1);
drop
|IL.opJNZ:
UnOp(r1);
cbnz(r1, param1)
|IL.opJZ:
UnOp(r1);
cbz(r1, param1)
|IL.opJG:
UnOp(r1);
Tst(r1);
jcc(jg, param1)
|IL.opJE:
UnOp(r1);
cbnz(r1, param1);
drop
|IL.opJNE:
UnOp(r1);
cbz(r1, param1);
drop
|IL.opSWITCH:
UnOp(r1);
IF param2 = 0 THEN
r2 := ACC
ELSE
r2 := R2
END;
IF r1 # r2 THEN
ASSERT(REG.GetReg(R, r2));
ASSERT(REG.Exchange(R, r1, r2));
drop
END;
drop
|IL.opENDSW:
|IL.opCASEL:
GetRegA;
CmpConst(ACC, param1);
jcc(jl, param2);
drop
|IL.opCASER:
GetRegA;
CmpConst(ACC, param1);
jcc(jg, param2);
drop
|IL.opCASELR:
GetRegA;
CmpConst(ACC, param1);
jcc(jl, param2);
jcc(jg, cmd.param3);
drop
|IL.opCODE:
Code(param2)
|IL.opEQ..IL.opGE,
IL.opEQC..IL.opGEC:
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
BinOp(r1, r2);
Cmp(r1, r2);
drop
ELSE
UnOp(r1);
CmpConst(r1, param2)
END;
drop;
cc := cond(opcode);
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
jcc(inv0(cc), next.param1);
cmd := next
ELSE
SetCC(cc, GetAnyReg())
END
|IL.opINCC:
UnOp(r1);
r2 := GetAnyReg();
Ldr32(r2, r1);
AddConst(r2, param2);
Str32(r2, r1);
drop;
drop
|IL.opINCCB, IL.opDECCB:
IF opcode = IL.opDECCB THEN
param2 := -param2
END;
UnOp(r1);
r2 := GetAnyReg();
Ldr8(r2, r1);
AddConst(r2, param2);
Str8(r2, r1);
drop;
drop
|IL.opUMINUS:
UnOp(r1);
Neg(r1)
|IL.opADD:
BinOp(r1, r2);
CASE cmd.next(COMMAND).opcode OF
|IL.opLOAD32, IL.opLOADF:
gen7(TRUE, FALSE, r2, r1, r1); (* ldr r1, [r1, r2] *)
cmd := cmd.next(COMMAND)
|IL.opLOAD8:
gen7(TRUE, TRUE, r2, r1, r1); (* ldrb r1, [r1, r2] *)
cmd := cmd.next(COMMAND)
|IL.opLOAD16:
gen8(TRUE, FALSE, r2, r1, r1); (* ldrh r1, [r1, r2] *)
cmd := cmd.next(COMMAND)
ELSE
AddReg(r1, r1, r2)
END;
drop
|IL.opADDL, IL.opADDR:
UnOp(r1);
AddConst(r1, param2)
|IL.opSUB:
BinOp(r1, r2);
SubReg(r1, r1, r2);
drop
|IL.opSUBL, IL.opSUBR:
UnOp(r1);
AddConst(r1, -param2);
IF opcode = IL.opSUBL THEN
Neg(r1)
END
|IL.opMUL:
BinOp(r1, r2);
Mul(r1, r2);
drop
|IL.opMULC:
UnOp(r1);
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
ELSE
n := -1
END;
IF a = 1 THEN
ELSIF a = -1 THEN
Neg(r1)
ELSIF a = 0 THEN
MovConst(r1, 0)
ELSE
IF n > 0 THEN
IF a < 0 THEN
Neg(r1)
END;
LslImm(r1, n)
ELSE
r2 := GetAnyReg();
MovConst(r2, a);
Mul(r1, r2);
drop
END
END
|IL.opABS:
UnOp(r1);
Tst(r1);
L := NewLabel();
jcc(jge, L);
Neg(r1);
Label(L)
|IL.opNOT:
UnOp(r1);
Tst(r1);
SetCC(je, r1)
|IL.opORD:
UnOp(r1);
Tst(r1);
SetCC(jne, r1)
|IL.opCHR:
UnOp(r1);
Code(0B2C0H + r1 * 9) (* uxtb r1 *)
|IL.opWCHR:
UnOp(r1);
Code(0B280H + r1 * 9) (* uxth r1 *)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
BinOp(r1, r2);
Shift(opcode, r1, r2);
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
MovConst(GetAnyReg(), param2);
BinOp(r2, r1);
Shift(opcode, r1, r2);
INCL(R.regs, r2);
DEC(R.top);
R.stk[R.top] := r1
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2:
n := param2 MOD 32;
IF n # 0 THEN
UnOp(r1);
CASE opcode OF
|IL.opASR2: AsrImm(r1, n)
|IL.opROR2: r2 := GetAnyReg(); MovConst(r2, n); Shift(IL.opROR, r1, r2); drop
|IL.opLSL2: LslImm(r1, n)
|IL.opLSR2: LsrImm(r1, n)
END
END
|IL.opCHKBYTE:
BinOp(r1, r2);
CmpConst(r1, 256);
jcc(jb, param1)
|IL.opCHKIDX:
UnOp(r1);
CmpConst(r1, param2);
jcc(jb, param1)
|IL.opCHKIDX2:
BinOp(r1, r2);
IF param2 # -1 THEN
Cmp(r2, r1);
jcc(jb, param1)
END;
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
|IL.opLEN:
n := param2;
UnOp(r1);
drop;
EXCL(R.regs, r1);
WHILE n > 0 DO
UnOp(r2);
drop;
DEC(n)
END;
INCL(R.regs, r1);
ASSERT(REG.GetReg(R, r1))
|IL.opLOOP, IL.opENDLOOP:
|IL.opINF:
MovConst(GetAnyReg(), inf)
|IL.opPUSHF:
UnOp(r1);
push(r1);
drop
|IL.opCONST:
MovConst(GetAnyReg(), param2)
|IL.opEQP, IL.opNEP:
reloc(GetAnyReg(), BIN.RCODE + pic, param1);
BinOp(r1, r2);
Cmp(r1, r2);
drop;
IF opcode = IL.opEQP THEN
SetCC(je, r1)
ELSE
SetCC(jne, r1)
END
|IL.opPUSHT:
UnOp(r1);
r2 := GetAnyReg();
mov(r2, r1);
SubImm8(r2, 4);
Ldr32(r2, r2)
|IL.opGET, IL.opGETC:
IF opcode = IL.opGET THEN
BinOp(r1, r2)
ELSIF opcode = IL.opGETC THEN
UnOp(r2);
r1 := GetAnyReg();
MovConst(r1, param1)
END;
drop;
drop;
CASE param2 OF
|1: Ldr8(r1, r1); Str8(r1, r2)
|2: Ldr16(r1, r1); Str16(r1, r2)
|4: Ldr32(r1, r1); Str32(r1, r2)
END
|IL.opINC, IL.opDEC:
BinOp(r2, r1);
r3 := GetAnyReg();
Ldr32(r3, r1);
IF opcode = IL.opINC THEN
AddReg(r3, r3, r2)
ELSE
SubReg(r3, r3, r2)
END;
Str32(r3, r1);
drop;
drop;
drop
|IL.opINCB, IL.opDECB:
BinOp(r2, r1);
r3 := GetAnyReg();
Ldr8(r3, r1);
IF opcode = IL.opINCB THEN
AddReg(r3, r3, r2)
ELSE
SubReg(r3, r3, r2)
END;
Str8(r3, r1);
drop;
drop;
drop
|IL.opMIN, IL.opMAX:
BinOp(r1, r2);
Cmp(r1, r2);
L := NewLabel();
IF opcode = IL.opMIN THEN
cc := jle
ELSE
cc := jge
END;
jcc(cc, L);
mov(r1, r2);
Label(L);
drop
|IL.opMINC, IL.opMAXC:
UnOp(r1);
CmpConst(r1, param2);
L := NewLabel();
IF opcode = IL.opMINC THEN
cc := jle
ELSE
cc := jge
END;
jcc(cc, L);
MovConst(r1, param2);
Label(L)
|IL.opMULS:
BinOp(r1, r2);
gen4(0, r2, r1); (* and r1, r2 *)
drop
|IL.opMULSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(0, r2, r1); (* and r1, r2 *)
drop
|IL.opDIVS:
BinOp(r1, r2);
gen4(1, r2, r1); (* eor r1, r2 *)
drop
|IL.opDIVSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(1, r2, r1); (* eor r1, r2 *)
drop
|IL.opADDS:
BinOp(r1, r2);
gen4(12, r2, r1); (* orr r1, r2 *)
drop
|IL.opSUBS:
BinOp(r1, r2);
gen4(14, r2, r1); (* bic r1, r2 *)
drop
|IL.opADDSL, IL.opADDSR:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(12, r2, r1); (* orr r1, r2 *)
drop
|IL.opSUBSL:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(14, r1, r2); (* bic r2, r1 *)
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
|IL.opSUBSR:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(14, r2, r1); (* bic r1, r2 *)
drop
|IL.opUMINS:
UnOp(r1);
gen4(15, r1, r1) (* mvn r1, r1 *)
|IL.opINCL, IL.opEXCL:
BinOp(r1, r2);
r3 := GetAnyReg();
MovConst(r3, 1);
CmpConst(r1, 32);
L := NewLabel();
jcc(jnb, L);
gen4(2, r1, r3); (* lsl r3, r1 *)
Ldr32(r1, r2);
IF opcode = IL.opINCL THEN
gen4(12, r3, r1) (* orr r1, r3 *)
ELSE
gen4(14, r3, r1) (* bic r1, r3 *)
END;
Str32(r1, r2);
Label(L);
drop;
drop;
drop
|IL.opINCLC, IL.opEXCLC:
UnOp(r2);
r1 := GetAnyReg();
r3 := GetAnyReg();
MovConst(r3, 1);
LslImm(r3, param2);
Ldr32(r1, r2);
IF opcode = IL.opINCLC THEN
gen4(12, r3, r1) (* orr r1, r3 *)
ELSE
gen4(14, r3, r1) (* bic r1, r3 *)
END;
Str32(r1, r2);
drop;
drop;
drop
|IL.opLENGTH:
PushAll(2);
CallRTL(IL._length, 2);
GetRegA
|IL.opLENGTHW:
PushAll(2);
CallRTL(IL._lengthw, 2);
GetRegA
|IL.opSAVES:
UnOp(r2);
REG.PushAll_1(R);
r1 := GetAnyReg();
reloc(r1, BIN.RDATA + pic, stroffs + param2);
push(r1);
drop;
push(r2);
drop;
PushConst(param1);
CallRTL(IL._move, 3)
|IL.opEQS .. IL.opGES:
PushAll(4);
PushConst(opcode - IL.opEQS);
CallRTL(IL._strcmp, 5);
GetRegA
|IL.opEQSW .. IL.opGESW:
PushAll(4);
PushConst(opcode - IL.opEQSW);
CallRTL(IL._strcmpw, 5);
GetRegA
|IL.opCOPY:
PushAll(2);
PushConst(param2);
CallRTL(IL._move, 3)
|IL.opMOVE:
PushAll(3);
CallRTL(IL._move, 3)
|IL.opCOPYA:
PushAll(4);
PushConst(param2);
CallRTL(IL._arrcpy, 5);
GetRegA
|IL.opCOPYS:
PushAll(4);
PushConst(param2);
CallRTL(IL._strcpy, 5)
|IL.opDIV:
PushAll(2);
divmod;
GetRegA
|IL.opDIVL:
UnOp(r1);
REG.PushAll_1(R);
PushConst(param2);
push(r1);
drop;
divmod;
GetRegA
|IL.opDIVR:
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(r1);
AsrImm(r1, n)
ELSIF n < 0 THEN
PushAll(1);
PushConst(param2);
divmod;
GetRegA
END
|IL.opMOD:
PushAll(2);
divmod;
mov(R0, R1);
GetRegA
|IL.opMODR:
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(r1);
IF n = 8 THEN
Code(0B2C0H + r1 * 9) (* uxtb r1 *)
ELSIF n = 16 THEN
Code(0B280H + r1 * 9) (* uxth r1 *)
ELSE
LslImm(r1, 32 - n);
LsrImm(r1, 32 - n)
END
ELSIF n < 0 THEN
PushAll(1);
PushConst(param2);
divmod;
mov(R0, R1);
GetRegA
ELSE
UnOp(r1);
MovConst(r1, 0)
END
|IL.opMODL:
UnOp(r1);
REG.PushAll_1(R);
PushConst(param2);
push(r1);
drop;
divmod;
mov(R0, R1);
GetRegA
|IL.opIN, IL.opINR:
IF opcode = IL.opINR THEN
r2 := GetAnyReg();
MovConst(r2, param2)
END;
L := NewLabel();
L2 := NewLabel();
BinOp(r1, r2);
r3 := GetAnyReg();
CmpConst(r1, 32);
jcc(jb, L);
MovConst(r1, 0);
jmp(L2);
Label(L);
MovConst(r3, 1);
Shift(IL.opLSL, r3, r1);
gen4(0, r3, r2); (* and r2, r3 *)
SetCC(jne, r1);
Label(L2);
drop;
drop
|IL.opINL:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, LSL(1, param2));
gen4(0, r2, r1); (* and r1, r2 *)
SetCC(jne, r1);
drop
|IL.opRSET:
PushAll(2);
CallRTL(IL._set, 2);
GetRegA
|IL.opRSETR:
PushAll(1);
PushConst(param2);
CallRTL(IL._set, 2);
GetRegA
|IL.opRSETL:
UnOp(r1);
REG.PushAll_1(R);
PushConst(param2);
push(r1);
drop;
CallRTL(IL._set, 2);
GetRegA
|IL.opRSET1:
PushAll(1);
CallRTL(IL._set1, 1);
GetRegA
|IL.opCONSTF:
MovConst(GetAnyReg(), UTILS.d2s(cmd.float))
|IL.opMULF:
PushAll(2);
CallRTL(IL._fmul, 2);
GetRegA
|IL.opDIVF:
PushAll(2);
CallRTL(IL._fdiv, 2);
GetRegA
|IL.opDIVFI:
PushAll(2);
CallRTL(IL._fdivi, 2);
GetRegA
|IL.opADDF, IL.opADDFI:
PushAll(2);
CallRTL(IL._fadd, 2);
GetRegA
|IL.opSUBFI:
PushAll(2);
CallRTL(IL._fsubi, 2);
GetRegA
|IL.opSUBF:
PushAll(2);
CallRTL(IL._fsub, 2);
GetRegA
|IL.opEQF..IL.opGEF:
PushAll(2);
PushConst(opcode - IL.opEQF);
CallRTL(IL._fcmp, 3);
GetRegA
|IL.opFLOOR:
PushAll(1);
CallRTL(IL._floor, 1);
GetRegA
|IL.opFLT:
PushAll(1);
CallRTL(IL._flt, 1);
GetRegA
|IL.opUMINF:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
gen4(1, r2, r1); (* eor r1, r2 *)
drop
|IL.opFABS:
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
gen4(14, r2, r1); (* bic r1, r2 *)
drop
|IL.opNEW:
PushAll(1);
n := param2 + 8;
ASSERT(UTILS.Align(n, 32));
PushConst(n);
PushConst(param1);
CallRTL(IL._new, 3)
|IL.opTYPEGP:
UnOp(r1);
PushAll(0);
push(r1);
PushConst(param2);
CallRTL(IL._guard, 2);
GetRegA
|IL.opIS:
PushAll(1);
PushConst(param2);
CallRTL(IL._is, 2);
GetRegA
|IL.opISREC:
PushAll(2);
PushConst(param2);
CallRTL(IL._guardrec, 3);
GetRegA
|IL.opTYPEGR:
PushAll(1);
PushConst(param2);
CallRTL(IL._guardrec, 2);
GetRegA
|IL.opTYPEGD:
UnOp(r1);
PushAll(0);
SubImm8(r1, 4);
Ldr32(r1, r1);
push(r1);
PushConst(param2);
CallRTL(IL._guardrec, 2);
GetRegA
|IL.opCASET:
push(R2);
push(R2);
PushConst(param2);
CallRTL(IL._guardrec, 2);
pop(R2);
cbnz(ACC, param1)
|IL.opROT:
PushAll(0);
mov(R2, SP);
push(R2);
PushConst(param2);
CallRTL(IL._rot, 2)
|IL.opPACK:
PushAll(2);
CallRTL(IL._pack, 2)
|IL.opPACKC:
PushAll(1);
PushConst(param2);
CallRTL(IL._pack, 2)
|IL.opUNPK:
PushAll(2);
CallRTL(IL._unpk, 2)
END;
cmd := cmd.next(COMMAND)
END;
ASSERT(R.pushed = 0);
ASSERT(R.top = -1)
END translate;
PROCEDURE prolog (GlobSize, tcount, pic, FlashAdr, sp, ivt_len: INTEGER);
VAR
r1, r2, i, dcount: INTEGER;
BEGIN
entry := NewLabel();
emptyProc := NewLabel();
genInt := NewLabel();
genTrap := NewLabel();
sdivProc := NewLabel();
trap := emptyProc;
int0 := emptyProc;
IVT[0] := sp;
IVT[1] := entry;
FOR i := 2 TO ivt_len - 1 DO
IVT[i] := genInt
END;
FOR i := 0 TO ivt_len - 1 DO
Code(low(IVT[i]));
Code(high(IVT[i]))
END;
Label(entry);
r1 := GetAnyReg();
r2 := GetAnyReg();
reloc(r1, BIN.RDATA + pic, 0);
FOR i := 0 TO tcount - 1 DO
MovConst(r2, CHL.GetInt(IL.codes.types, i));
Str32(r2, r1);
AddImm8(r1, 4)
END;
dcount := CHL.Length(IL.codes.data);
FOR i := 0 TO dcount - 1 BY 4 DO
MovConst(r2, BIN.get32le(IL.codes.data, i));
Str32(r2, r1);
AddImm8(r1, 4)
END;
drop;
drop;
r1 := GetAnyReg();
MovConst(r1, sp);
mov(SP, r1);
reloc(r1, BIN.RDATA + pic, 0);
push(r1);
reloc(r1, BIN.RBSS + pic, 0);
r2 := GetAnyReg();
MovConst(r2, GlobSize);
AddReg(r1, r1, r2);
drop;
push(r1);
drop;
PushConst(tcount);
CallRTL(IL._init, 3)
END prolog;
PROCEDURE epilog;
VAR
L1, L2, L3, L4: INTEGER;
BEGIN
Code(0BF30H); (* L2: wfi *)
Code(0E7FDH); (* b L2 *)
Label(genInt);
Code(0F3EFH); Code(08105H); (* mrs r1, ipsr *)
gen14(FALSE, TRUE, {R1}); (* push {LR, R1} *)
call(int0);
gen14(TRUE, TRUE, {R1}); (* pop {PC, R1} *)
Label(emptyProc);
Code(04770H); (* bx lr *)
Label(genTrap);
call(trap);
call(entry);
Label(sdivProc);
IF Target.InstrSet.sdiv THEN
Code(09800H); (* ldr r0, [sp + #0] *)
Code(09901H); (* ldr r1, [sp + #4] *)
Code(0FB91H); (* sdiv r2, r1, r0 *)
Code(0F2F0H);
Code(00013H); (* mov r3, r2 *)
Code(04343H); (* mul r3, r0 *)
Code(01AC9H); (* sub r1, r3 *)
Code(0DA01H); (* bge L *)
Code(04401H); (* add r1, r0 *)
Code(03A01H); (* sub r2, #1 *)
(* L: *)
Code(00010H); (* mov r0, r2 *)
Code(04770H); (* bx lr *)
ELSE
(* a / b; a >= 0 *)
L1 := NewLabel();
L2 := NewLabel();
L3 := NewLabel();
L4 := NewLabel();
LdrSp(R1, 1);
LdrSp(R2, 0);
MovConst(R0, 0);
push(R4);
Label(L4);
Cmp(R1, R2);
jcc(jl, L1);
MovConst(R3, 2);
mov(R4, R2);
LslImm(R4, 1);
Label(L3);
Cmp(R1, R4);
jcc(jl, L2);
CmpConst(R4, 0);
jcc(jle, L2);
LslImm(R4, 1);
LslImm(R3, 1);
jmp(L3);
Label(L2);
LsrImm(R4, 1);
LsrImm(R3, 1);
SubReg(R1, R1, R4);
AddReg(R0, R0, R3);
jmp(L4);
Label(L1);
(* a / b; a < 0 *)
L1 := NewLabel();
L2 := NewLabel();
L3 := NewLabel();
L4 := NewLabel();
Label(L4);
CmpConst(R1, 0);
jcc(jge, L1);
MovConst(R3, 2);
mov(R4, R2);
LslImm(R4, 1);
Neg(R1);
Label(L3);
Cmp(R1, R4);
jcc(jl, L2);
CmpConst(R4, 0);
jcc(jle, L2);
LslImm(R4, 1);
LslImm(R3, 1);
jmp(L3);
Label(L2);
Neg(R1);
LsrImm(R4, 1);
LsrImm(R3, 1);
AddReg(R1, R1, R4);
SubReg(R0, R0, R3);
jmp(L4);
Label(L1);
pop(R4);
Code(04770H); (* bx lr *)
END
END epilog;
PROCEDURE CortexM3;
BEGIN
Target.FlashAdr := 08000000H;
Target.SRAMAdr := 20000000H;
Target.IVTLen := 256;
Target.Reserved := 0;
Target.MinStack := 512;
Target.InstrSet.thumb2 := TRUE;
Target.InstrSet.it := TRUE;
Target.InstrSet.sdiv := TRUE;
Target.InstrSet.cbxz := TRUE
END CortexM3;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
opt: PROG.OPTIONS;
ram, rom: INTEGER;
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
File: WR.FILE;
BEGIN
IF target = TARGETS.STM32CM3 THEN
CortexM3
END;
ram := MIN(MAX(options.ram, STM32_minRAM), STM32_maxRAM) * 1024;
rom := MIN(MAX(options.rom, STM32_minROM), STM32_maxROM) * 1024;
tcount := CHL.Length(IL.codes.types);
opt := options;
CodeList := LISTS.create(NIL);
program := BIN.create(IL.codes.lcount);
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {R0, R1, R2, R3}, {});
StkCount := 0;
DataAdr := Target.SRAMAdr + Target.Reserved;
DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved;
WHILE DataSize MOD 4 # 0 DO
CHL.PushByte(IL.codes.data, 0);
INC(DataSize)
END;
BssAdr := DataAdr + DataSize - Target.Reserved;
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4)));
BssSize := IL.codes.bss;
ASSERT(UTILS.Align(BssSize, 4));
prolog(BssSize, tcount, ORD(opt.pic), Target.FlashAdr, Target.SRAMAdr + ram, Target.IVTLen);
translate(ORD(opt.pic), tcount * 4);
epilog;
fixup(Target.FlashAdr, DataAdr, BssAdr);
INC(DataSize, BssSize);
CodeSize := CHL.Length(program.code);
IF CodeSize > rom THEN
ERRORS.Error(203)
END;
IF DataSize > ram - Target.MinStack THEN
ERRORS.Error(204)
END;
File := WR.Create(outname);
HEX.Data2(File, program.code, 0, CodeSize, high(Target.FlashAdr));
HEX.End(File);
WR.Close(File);
C.StringLn("--------------------------------------------");
C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)");
C.Ln;
C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)")
END CodeGen;
PROCEDURE SetIV* (idx: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := IVT[idx] = 0;
IVT[idx] := 1
RETURN res
END SetIV;
PROCEDURE init;
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO LEN(IVT) - 1 DO
IVT[i] := 0
END
END init;
BEGIN
init
END THUMB.

/programs/develop/oberon07/Source/UTILS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
23,7 → 23,15
min32* = -2147483647-1;
max32* = 2147483647;
vMajor* = 1;
vMinor* = 29;
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
MAX_GLOBAL_SIZE* = 1600000000;
TYPE
DAYS = ARRAY 12, 31, 2 OF INTEGER;
110,6 → 118,11
END splitf;
PROCEDURE d2s* (x: REAL): INTEGER;
RETURN HOST.d2s(x)
END d2s;
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN HOST.isRelative(path)
END isRelative;
143,7 → 156,7
END UnixTime;
PROCEDURE SetBitDepth* (BitDepth: INTEGER);
PROCEDURE SetBitDepth* (BitDepth: INTEGER; Double: BOOLEAN);
BEGIN
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
bit_diff := bit_depth - BitDepth;
154,8 → 167,13
target.maxHex := BitDepth DIV 4;
target.minInt := ASR(minint, bit_diff);
target.maxInt := ASR(maxint, bit_diff);
IF Double THEN
target.maxReal := maxreal
ELSE
target.maxReal := 1.9;
PACK(target.maxReal, 1023);
PACK(target.maxReal, 127)
END
END SetBitDepth;
197,8 → 215,6
n: INTEGER;
BEGIN
ASSERT(x > 0);
n := 0;
WHILE ~ODD(x) DO
x := x DIV 2;
258,7 → 274,6
BEGIN
time := GetTickCount();
COPY(HOST.eol, eol);
maxreal := 1.9;
PACK(maxreal, 1023);
maxreal := HOST.maxreal;
init(days)
END UTILS.
END UTILS.

/programs/develop/oberon07/Source/WRITER.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov

/programs/develop/oberon07/Source/X86.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
8,7 → 8,7
MODULE X86;
IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG,
mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS;
CHL := CHUNKLISTS, PATHS, TARGETS;
CONST
93,16 → 93,6
tcount: INTEGER;
PROCEDURE Byte (n: INTEGER): BYTE;
RETURN UTILS.Byte(n, 0)
END Byte;
PROCEDURE Word (n: INTEGER): INTEGER;
RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256
END Word;
PROCEDURE OutByte* (n: BYTE);
VAR
c: CODE;
127,7 → 117,7
PROCEDURE OutInt (n: INTEGER);
BEGIN
OutByte(UTILS.Byte(n, 0));
OutByte(n MOD 256);
OutByte(UTILS.Byte(n, 1));
OutByte(UTILS.Byte(n, 2));
OutByte(UTILS.Byte(n, 3))
174,7 → 164,7
PROCEDURE OutIntByte (n: INTEGER);
BEGIN
IF isByte(n) THEN
OutByte(Byte(n))
OutByte(n MOD 256)
ELSE
OutInt(n)
END
194,7 → 184,7
PROCEDURE mov (reg1, reg2: INTEGER);
BEGIN
OutByte2(89H, 0C0H + reg2 * 8 + reg1) // mov reg1, reg2
OutByte2(89H, 0C0H + reg2 * 8 + reg1) (* mov reg1, reg2 *)
END mov;
205,11 → 195,11
BEGIN
regs := {reg1, reg2};
IF regs = {eax, ecx} THEN
OutByte(91H) // xchg eax, ecx
OutByte(91H) (* xchg eax, ecx *)
ELSIF regs = {eax, edx} THEN
OutByte(92H) // xchg eax, edx
OutByte(92H) (* xchg eax, edx *)
ELSIF regs = {ecx, edx} THEN
OutByte2(87H, 0D1H) // xchg ecx, edx
OutByte2(87H, 0D1H) (* xchg ecx, edx *)
END
END xchg;
216,19 → 206,19
PROCEDURE pop (reg: INTEGER);
BEGIN
OutByte(58H + reg) // pop reg
OutByte(58H + reg) (* pop reg *)
END pop;
PROCEDURE push (reg: INTEGER);
BEGIN
OutByte(50H + reg) // push reg
OutByte(50H + reg) (* push reg *)
END push;
PROCEDURE movrc (reg, n: INTEGER);
BEGIN
OutByte(0B8H + reg); // mov reg, n
OutByte(0B8H + reg); (* mov reg, n *)
OutInt(n)
END movrc;
235,7 → 225,7
PROCEDURE pushc (n: INTEGER);
BEGIN
OutByte(68H + short(n)); // push n
OutByte(68H + short(n)); (* push n *)
OutIntByte(n)
END pushc;
242,31 → 232,31
PROCEDURE test (reg: INTEGER);
BEGIN
OutByte2(85H, 0C0H + reg * 9) // test reg, reg
OutByte2(85H, 0C0H + reg * 9) (* test reg, reg *)
END test;
PROCEDURE neg (reg: INTEGER);
BEGIN
OutByte2(0F7H, 0D8H + reg) // neg reg
OutByte2(0F7H, 0D8H + reg) (* neg reg *)
END neg;
PROCEDURE not (reg: INTEGER);
BEGIN
OutByte2(0F7H, 0D0H + reg) // not reg
OutByte2(0F7H, 0D0H + reg) (* not reg *)
END not;
PROCEDURE add (reg1, reg2: INTEGER);
BEGIN
OutByte2(01H, 0C0H + reg2 * 8 + reg1) // add reg1, reg2
OutByte2(01H, 0C0H + reg2 * 8 + reg1) (* add reg1, reg2 *)
END add;
PROCEDURE andrc (reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0E0H + reg); // and reg, n
OutByte2(81H + short(n), 0E0H + reg); (* and reg, n *)
OutIntByte(n)
END andrc;
273,7 → 263,7
PROCEDURE orrc (reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0C8H + reg); // or reg, n
OutByte2(81H + short(n), 0C8H + reg); (* or reg, n *)
OutIntByte(n)
END orrc;
280,7 → 270,7
PROCEDURE addrc (reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0C0H + reg); // add reg, n
OutByte2(81H + short(n), 0C0H + reg); (* add reg, n *)
OutIntByte(n)
END addrc;
287,7 → 277,7
PROCEDURE subrc (reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0E8H + reg); // sub reg, n
OutByte2(81H + short(n), 0E8H + reg); (* sub reg, n *)
OutIntByte(n)
END subrc;
294,29 → 284,39
PROCEDURE cmprr (reg1, reg2: INTEGER);
BEGIN
OutByte2(39H, 0C0H + reg2 * 8 + reg1) // cmp reg1, reg2
OutByte2(39H, 0C0H + reg2 * 8 + reg1) (* cmp reg1, reg2 *)
END cmprr;
PROCEDURE cmprc (reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0F8H + reg); // cmp reg, n
IF n = 0 THEN
test(reg)
ELSE
OutByte2(81H + short(n), 0F8H + reg); (* cmp reg, n *)
OutIntByte(n)
END
END cmprc;
PROCEDURE setcc (cond, reg: INTEGER);
BEGIN
OutByte3(0FH, cond, 0C0H + reg) // setcc reg
OutByte3(0FH, cond, 0C0H + reg) (* setcc reg *)
END setcc;
PROCEDURE xor (reg1, reg2: INTEGER);
BEGIN
OutByte2(31H, 0C0H + reg2 * 8 + reg1) // xor reg1, reg2
OutByte2(31H, 0C0H + reg2 * 8 + reg1) (* xor reg1, reg2 *)
END xor;
PROCEDURE ret*;
BEGIN
OutByte(0C3H)
END ret;
PROCEDURE drop;
BEGIN
REG.Drop(R)
402,10 → 402,10
PROCEDURE Pic (reg, opcode, value: INTEGER);
BEGIN
OutByte(0E8H); OutInt(0); // call L
// L:
OutByte(0E8H); OutInt(0); (* call L
L: *)
pop(reg);
OutByte2(081H, 0C0H + reg); // add reg, ...
OutByte2(081H, 0C0H + reg); (* add reg, ... *)
Reloc(opcode, value)
END Pic;
423,10 → 423,10
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICIMP, label);
OutByte2(0FFH, 010H + reg1); // call dword[reg1]
OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *)
drop
ELSE
OutByte2(0FFH, 015H); // call dword[label]
OutByte2(0FFH, 015H); (* call dword[label] *)
Reloc(BIN.RIMP, label)
END
ELSE
504,12 → 504,11
END
|LABEL:
BIN.SetLabel(program, code.label, code.offset)
|JMP:
IF code.short THEN
BIN.PutCode(program, 0EBH);
BIN.PutCode(program, Byte(code.diff))
BIN.PutCode(program, code.diff MOD 256)
ELSE
BIN.PutCode(program, 0E9H);
BIN.PutCode32LE(program, code.diff)
518,7 → 517,7
|JCC:
IF code.short THEN
BIN.PutCode(program, code.jmp - 16);
BIN.PutCode(program, Byte(code.diff))
BIN.PutCode(program, code.diff MOD 256)
ELSE
BIN.PutCode(program, 0FH);
BIN.PutCode(program, code.jmp);
573,9 → 572,127
END GetRegA;
PROCEDURE fcmp;
BEGIN
GetRegA;
OutByte2(0DAH, 0E9H); (* fucompp *)
OutByte3(09BH, 0DFH, 0E0H); (* fstsw ax *)
OutByte(09EH); (* sahf *)
movrc(eax, 0)
END fcmp;
PROCEDURE movzx* (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *)
VAR
b: BYTE;
BEGIN
OutByte2(0FH, 0B6H + ORD(word));
IF (offs = 0) & (reg2 # ebp) THEN
b := 0
ELSE
b := 40H + long(offs)
END;
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8);
IF reg2 = esp THEN
OutByte(24H)
END;
IF b # 0 THEN
OutIntByte(offs)
END
END movzx;
PROCEDURE _movrm* (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN);
VAR
b: BYTE;
BEGIN
IF size = 16 THEN
OutByte(66H)
END;
IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64))
END;
OutByte(8BH - 2 * ORD(mr) - ORD(size = 8));
IF (offs = 0) & (reg2 # ebp) THEN
b := 0
ELSE
b := 40H + long(offs)
END;
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8);
IF reg2 = esp THEN
OutByte(24H)
END;
IF b # 0 THEN
OutIntByte(offs)
END
END _movrm;
PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_8 *)
BEGIN
_movrm(reg2, reg1, offs, 32, TRUE)
END movmr;
PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, dword[reg2 + offs] *)
BEGIN
_movrm(reg1, reg2, offs, 32, FALSE)
END movrm;
PROCEDURE movmr8* (reg1, offs, reg2: INTEGER); (* mov byte[reg1+offs], reg2_8 *)
BEGIN
_movrm(reg2, reg1, offs, 8, TRUE)
END movmr8;
PROCEDURE movrm8* (reg1, reg2, offs: INTEGER); (* mov reg1_8, byte[reg2+offs] *)
BEGIN
_movrm(reg1, reg2, offs, 8, FALSE)
END movrm8;
PROCEDURE movmr16* (reg1, offs, reg2: INTEGER); (* mov word[reg1+offs], reg2_16 *)
BEGIN
_movrm(reg2, reg1, offs, 16, TRUE)
END movmr16;
PROCEDURE movrm16* (reg1, reg2, offs: INTEGER); (* mov reg1_16, word[reg2+offs] *)
BEGIN
_movrm(reg1, reg2, offs, 16, FALSE)
END movrm16;
PROCEDURE pushm* (reg, offs: INTEGER); (* push qword[reg+offs] *)
VAR
b: BYTE;
BEGIN
IF reg >= 8 THEN
OutByte(41H)
END;
OutByte(0FFH);
IF (offs = 0) & (reg # ebp) THEN
b := 30H
ELSE
b := 70H + long(offs)
END;
OutByte(b + reg MOD 8);
IF reg = esp THEN
OutByte(24H)
END;
IF b # 30H THEN
OutIntByte(offs)
END
END pushm;
PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER);
VAR
cmd: COMMAND;
cmd, next: COMMAND;
reg1, reg2: INTEGER;
607,16 → 724,16
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICIMP, param1);
OutByte2(0FFH, 010H + reg1); // call dword[reg1]
OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *)
drop
ELSE
OutByte2(0FFH, 015H); // call dword[L]
OutByte2(0FFH, 015H); (* call dword[L] *)
Reloc(BIN.RIMP, param1)
END
|IL.opCALLP:
UnOp(reg1);
OutByte2(0FFH, 0D0H + reg1); // call reg1
OutByte2(0FFH, 0D0H + reg1); (* call reg1 *)
drop;
ASSERT(R.top = -1)
627,7 → 744,7
END;
WHILE n > 0 DO
subrc(esp, 8);
OutByte3(0DDH, 01CH, 024H); // fstp qword[esp]
OutByte3(0DDH, 01CH, 024H); (* fstp qword[esp] *)
DEC(n)
END;
PushAll(0)
647,7 → 764,7
GetRegA;
n := param2;
WHILE n > 0 DO
OutByte3(0DDH, 004H, 024H); // fld qword[esp]
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8);
DEC(n)
END
656,12 → 773,12
n := param2;
IF n > 0 THEN
OutByte3(0DDH, 5CH + long(n * 8), 24H);
OutIntByte(n * 8); // fstp qword[esp + n*8]
OutIntByte(n * 8); (* fstp qword[esp + n*8] *)
INC(n)
END;
WHILE n > 0 DO
OutByte3(0DDH, 004H, 024H); // fld qword[esp]
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8);
DEC(n)
END
677,8 → 794,8
n := param2;
IF n > 4 THEN
movrc(ecx, n);
pushc(0); // @@: push 0
OutByte2(0E2H, 0FCH) // loop @b
pushc(0); (* L: push 0 *)
OutByte2(0E2H, 0FCH) (* loop L *)
ELSE
WHILE n > 0 DO
pushc(0);
708,14 → 825,18
n := param2;
IF n > 0 THEN
n := n * 4;
OutByte(0C2H); OutWord(Word(n)) // ret n
OutByte(0C2H); OutWord(n MOD 65536) (* ret n *)
ELSE
OutByte(0C3H) // ret
ret
END
|IL.opPUSHC:
pushc(param2)
|IL.opONERR:
pushc(param2);
jmp(param1)
|IL.opPARAM:
n := param2;
IF n = 1 THEN
740,7 → 861,7
movrc(GetAnyReg(), param2)
|IL.opLABEL:
SetLabel(param1) // L:
SetLabel(param1) (* L: *)
|IL.opNOP:
749,19 → 870,17
IF pic THEN
Pic(reg1, BIN.PICBSS, param2)
ELSE
OutByte(0B8H + reg1); // mov reg1, _bss + param2
OutByte(0B8H + reg1); (* mov reg1, _bss + param2 *)
Reloc(BIN.RBSS, param2)
END
|IL.opLADR:
n := param2 * 4;
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n]
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); (* lea reg1, dword[ebp + n] *)
OutIntByte(n)
|IL.opVADR:
n := param2 * 4;
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n)
|IL.opVADR, IL.opLLOAD32:
movrm(GetAnyReg(), ebp, param2 * 4)
|IL.opSADR:
reg1 := GetAnyReg();
768,102 → 887,88
IF pic THEN
Pic(reg1, BIN.PICDATA, stroffs + param2);
ELSE
OutByte(0B8H + reg1); // mov reg1, _data + stroffs + param2
OutByte(0B8H + reg1); (* mov reg1, _data + stroffs + param2 *)
Reloc(BIN.RDATA, stroffs + param2)
END
|IL.opSAVEC:
UnOp(reg1);
OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2
OutByte2(0C7H, reg1); OutInt(param2); (* mov dword[reg1], param2 *)
drop
|IL.opSAVE8C:
UnOp(reg1);
OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2
OutByte3(0C6H, reg1, param2 MOD 256); (* mov byte[reg1], param2 *)
drop
|IL.opSAVE16C:
UnOp(reg1);
OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2
OutByte3(66H, 0C7H, reg1); OutWord(param2 MOD 65536); (* mov word[reg1], param2 *)
drop
|IL.opVLOAD32:
n := param2 * 4;
reg1 := GetAnyReg();
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
movrm(reg1, ebp, param2 * 4);
movrm(reg1, reg1, 0)
|IL.opGLOAD32:
reg1 := GetAnyReg();
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
movrm(reg1, reg1, 0)
ELSE
OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[_bss + param2]
OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[_bss + param2] *)
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD32:
n := param2 * 4;
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n)
|IL.opLOAD32:
UnOp(reg1);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
movrm(reg1, reg1, 0)
|IL.opVLOAD8:
n := param2 * 4;
reg1 := GetAnyReg();
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
movrm(reg1, ebp, param2 * 4);
movzx(reg1, reg1, 0, FALSE)
|IL.opGLOAD8:
reg1 := GetAnyReg();
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
movzx(reg1, reg1, 0, FALSE)
ELSE
OutByte3(00FH, 0B6H, 05H + reg1 * 8); // movzx reg1, byte[_bss + param2]
OutByte3(00FH, 0B6H, 05H + reg1 * 8); (* movzx reg1, byte[_bss + param2] *)
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD8:
n := param2 * 4;
OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n]
OutIntByte(n)
movzx(GetAnyReg(), ebp, param2 * 4, FALSE)
|IL.opLOAD8:
UnOp(reg1);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
movzx(reg1, reg1, 0, FALSE)
|IL.opVLOAD16:
n := param2 * 4;
reg1 := GetAnyReg();
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
movrm(reg1, ebp, param2 * 4);
movzx(reg1, reg1, 0, TRUE)
|IL.opGLOAD16:
reg1 := GetAnyReg();
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
movzx(reg1, reg1, 0, TRUE)
ELSE
OutByte3(00FH, 0B7H, 05H + reg1 * 8); // movzx reg1, word[_bss + param2]
OutByte3(00FH, 0B7H, 05H + reg1 * 8); (* movzx reg1, word[_bss + param2] *)
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD16:
n := param2 * 4;
OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n]
OutIntByte(n)
movzx(GetAnyReg(), ebp, param2 * 4, TRUE)
|IL.opLOAD16:
UnOp(reg1);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
movzx(reg1, reg1, 0, TRUE)
|IL.opUMINUS:
UnOp(reg1);
877,18 → 982,35
|IL.opADDL, IL.opADDR:
IF param2 # 0 THEN
UnOp(reg1);
next := cmd.next(COMMAND);
CASE next.opcode OF
|IL.opLOAD32:
movrm(reg1, reg1, param2);
cmd := next
|IL.opLOAD16:
movzx(reg1, reg1, param2, TRUE);
cmd := next
|IL.opLOAD8:
movzx(reg1, reg1, param2, FALSE);
cmd := next
|IL.opLOAD32_PARAM:
pushm(reg1, param2);
drop;
cmd := next
ELSE
IF param2 = 1 THEN
OutByte(40H + reg1) // inc reg1
OutByte(40H + reg1) (* inc reg1 *)
ELSIF param2 = -1 THEN
OutByte(48H + reg1) // dec reg1
OutByte(48H + reg1) (* dec reg1 *)
ELSE
addrc(reg1, param2)
END
END
END
|IL.opSUB:
BinOp(reg1, reg2);
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2
OutByte2(29H, 0C0H + reg2 * 8 + reg1); (* sub reg1, reg2 *)
drop
|IL.opSUBR, IL.opSUBL:
895,9 → 1017,9
UnOp(reg1);
n := param2;
IF n = 1 THEN
OutByte(48H + reg1) // dec reg1
OutByte(48H + reg1) (* dec reg1 *)
ELSIF n = -1 THEN
OutByte(40H + reg1) // inc reg1
OutByte(40H + reg1) (* inc reg1 *)
ELSIF n # 0 THEN
subrc(reg1, n)
END;
906,6 → 1028,12
END
|IL.opMULC:
IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN
BinOp(reg1, reg2);
OutByte3(8DH, 04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2)); (* lea reg1, [reg1 + reg2 * param2] *)
drop;
cmd := cmd.next(COMMAND)
ELSE
UnOp(reg1);
a := param2;
930,36 → 1058,37
END;
IF n # 1 THEN
OutByte3(0C1H, 0E0H + reg1, n) // shl reg1, n
OutByte3(0C1H, 0E0H + reg1, n) (* shl reg1, n *)
ELSE
OutByte2(0D1H, 0E0H + reg1) // shl reg1, 1
OutByte2(0D1H, 0E0H + reg1) (* shl reg1, 1 *)
END
ELSE
OutByte2(69H + short(a), 0C0H + reg1 * 9); // imul reg1, a
OutByte2(69H + short(a), 0C0H + reg1 * 9); (* imul reg1, a *)
OutIntByte(a)
END
END
END
|IL.opMUL:
BinOp(reg1, reg2);
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); (* imul reg1, reg2 *)
drop
|IL.opSAVE, IL.opSAVE32:
BinOp(reg2, reg1);
OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2
movmr(reg1, 0, reg2);
drop;
drop
|IL.opSAVE8:
BinOp(reg2, reg1);
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2
movmr8(reg1, 0, reg2);
drop;
drop
|IL.opSAVE16:
BinOp(reg2, reg1);
OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2
movmr16(reg1, 0, reg2);
drop;
drop
968,10 → 1097,10
IF pic THEN
reg2 := GetAnyReg();
Pic(reg2, BIN.PICCODE, param2);
OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2
movmr(reg1, 0, reg2);
drop
ELSE
OutByte2(0C7H, reg1); // mov dword[reg1], L
OutByte2(0C7H, reg1); (* mov dword[reg1], L *)
Reloc(BIN.RCODE, param2)
END;
drop
981,13 → 1110,13
IF pic THEN
reg2 := GetAnyReg();
Pic(reg2, BIN.PICIMP, param2);
OutByte2(0FFH, 30H + reg2); // push dword[reg2]
OutByte2(08FH, reg1); // pop dword[reg1]
pushm(reg2, 0);
OutByte2(08FH, reg1); (* pop dword[reg1] *)
drop
ELSE
OutByte2(0FFH, 035H); // push dword[L]
OutByte2(0FFH, 035H); (* push dword[L] *)
Reloc(BIN.RIMP, param2);
OutByte2(08FH, reg1) // pop dword[reg1]
OutByte2(08FH, reg1) (* pop dword[reg1] *)
END;
drop
996,7 → 1125,7
IF pic THEN
Pic(reg1, BIN.PICCODE, param2)
ELSE
OutByte(0B8H + reg1); // mov reg1, L
OutByte(0B8H + reg1); (* mov reg1, L *)
Reloc(BIN.RCODE, param2)
END
1004,9 → 1133,9
reg1 := GetAnyReg();
IF pic THEN
Pic(reg1, BIN.PICIMP, param2);
OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1]
movrm(reg1, reg1, 0)
ELSE
OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[L]
OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[L] *)
Reloc(BIN.RIMP, param2)
END
1025,19 → 1154,15
|IL.opSBOOL:
BinOp(reg2, reg1);
test(reg2);
OutByte3(0FH, 95H, reg1); // setne byte[reg1]
OutByte3(0FH, 95H, reg1); (* setne byte[reg1] *)
drop;
drop
|IL.opSBOOLC:
UnOp(reg1);
OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1
OutByte3(0C6H, reg1, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *)
drop
|IL.opODD:
UnOp(reg1);
andrc(reg1, 1)
|IL.opEQ..IL.opGE,
IL.opEQC..IL.opGEC:
1047,26 → 1172,19
drop
ELSE
UnOp(reg1);
IF param2 = 0 THEN
test(reg1)
ELSE
cmprc(reg1, param2)
END
END;
drop;
cc := cond(opcode);
next := cmd.next(COMMAND);
IF cmd.next(COMMAND).opcode = IL.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(inv0(cc), label);
cmd := cmd.next(COMMAND)
IF next.opcode = IL.opJE THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
jcc(inv0(cc), next.param1);
cmd := next
ELSE
reg1 := GetAnyReg();
setcc(cc + 16, reg1);
1078,13 → 1196,13
drop;
test(reg1);
OutByte2(74H, 5); // je @f
movrc(reg1, 1); // mov reg1, 1
// @@:
OutByte2(74H, 5); (* je @f *)
movrc(reg1, 1); (* mov reg1, 1
@@: *)
test(reg2);
OutByte2(74H, 5); // je @f
movrc(reg2, 1); // mov reg2, 1
// @@:
OutByte2(74H, 5); (* je @f *)
movrc(reg2, 1); (* mov reg2, 1
@@: *)
cmprr(reg1, reg2);
IF opcode = IL.opEQB THEN
1116,6 → 1234,11
test(reg1);
jcc(je, param1)
|IL.opJG:
UnOp(reg1);
test(reg1);
jcc(jg, param1)
|IL.opJE:
UnOp(reg1);
test(reg1);
1171,26 → 1294,15
drop;
drop;
CASE param2 OF
|1:
OutByte2(8AH, reg1 * 9); // mov reg1, byte[reg1]
OutByte2(88H, reg1 * 8 + reg2) // mov byte[reg2], reg1
|2:
OutByte3(66H, 8BH, reg1 * 9); // mov reg1, word[reg1]
OutByte3(66H, 89H, reg1 * 8 + reg2) // mov word[reg2], reg1
|4:
OutByte2(8BH, reg1 * 9); // mov reg1, dword[reg1]
OutByte2(89H, reg1 * 8 + reg2) // mov dword[reg2], reg1
|8:
IF param2 # 8 THEN
_movrm(reg1, reg1, 0, param2 * 8, FALSE);
_movrm(reg1, reg2, 0, param2 * 8, TRUE)
ELSE
PushAll(0);
push(reg1);
push(reg2);
pushc(8);
CallRTL(pic, IL._move)
END
|IL.opSAVES:
1203,7 → 1315,7
push(reg1);
drop
ELSE
OutByte(068H); // push _data + stroffs + param2
OutByte(068H); (* push _data + stroffs + param2 *)
Reloc(BIN.RDATA, stroffs + param2);
END;
1226,14 → 1338,11
BinOp(reg1, reg2);
IF param2 # -1 THEN
cmprr(reg2, reg1);
mov(reg1, reg2);
drop;
jcc(jb, param1)
ELSE
END;
INCL(R.regs, reg1);
DEC(R.top);
R.stk[R.top] := reg2
END
|IL.opLEN:
n := param2;
1252,29 → 1361,35
|IL.opINCC:
UnOp(reg1);
OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2
IF param2 = 1 THEN
OutByte2(0FFH, reg1) (* inc dword[reg1] *)
ELSIF param2 = -1 THEN
OutByte2(0FFH, reg1 + 8) (* dec dword[reg1] *)
ELSE
OutByte2(81H + short(param2), reg1); OutIntByte(param2) (* add dword[reg1], param2 *)
END;
drop
|IL.opINC, IL.opDEC:
BinOp(reg1, reg2);
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); (* add/sub dword[reg2], reg1 *)
drop;
drop
|IL.opINCCB, IL.opDECCB:
UnOp(reg1);
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, param2 MOD 256); (* add/sub byte[reg1], n *)
drop
|IL.opINCB, IL.opDECB:
BinOp(reg1, reg2);
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); (* add/sub byte[reg2], reg1 *)
drop;
drop
|IL.opMULS:
BinOp(reg1, reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *)
drop
|IL.opMULSC:
1288,18 → 1403,18
|IL.opDIVSC:
UnOp(reg1);
OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n
OutByte2(81H + short(param2), 0F0H + reg1); (* xor reg1, n *)
OutIntByte(param2)
|IL.opADDS:
BinOp(reg1, reg2);
OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2
OutByte2(9H, 0C0H + reg2 * 8 + reg1); (* or reg1, reg2 *)
drop
|IL.opSUBS:
BinOp(reg1, reg2);
not(reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *)
drop
|IL.opADDSL, IL.opADDSR:
1348,7 → 1463,7
BinOp(reg1, reg2);
ASSERT(reg2 = ecx);
OutByte(0D3H);
shift(opcode, reg1); // shift reg1, cl
shift(opcode, reg1); (* shift reg1, cl *)
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
1364,7 → 1479,7
BinOp(reg1, reg2);
ASSERT(reg1 = ecx);
OutByte(0D3H);
shift(opcode, reg2); // shift reg2, cl
shift(opcode, reg2); (* shift reg2, cl *)
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
1377,74 → 1492,47
ELSE
OutByte(0D1H)
END;
shift(opcode, reg1); // shift reg1, n
shift(opcode, reg1); (* shift reg1, n *)
IF n # 1 THEN
OutByte(n)
END
|IL.opMIN:
|IL.opMAX, IL.opMIN:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(07EH, 002H); // jle @f
mov(reg1, reg2); // mov reg1, reg2
// @@:
OutByte2(07DH + ORD(opcode = IL.opMIN), 2); (* jge/jle L *)
mov(reg1, reg2);
(* L: *)
drop
|IL.opMAX:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(07DH, 002H); // jge @f
mov(reg1, reg2); // mov reg1, reg2
// @@:
drop
|IL.opMINC:
|IL.opMAXC, IL.opMINC:
UnOp(reg1);
cmprc(reg1, param2);
OutByte2(07EH, 005H); // jle @f
movrc(reg1, param2) // mov reg1, param2
// @@:
OutByte2(07DH + ORD(opcode = IL.opMINC), 5); (* jge/jle L *)
movrc(reg1, param2)
(* L: *)
|IL.opMAXC:
UnOp(reg1);
cmprc(reg1, param2);
OutByte2(07DH, 005H); // jge @f
movrc(reg1, param2) // mov reg1, param2
// @@:
|IL.opIN:
|IL.opIN, IL.opINR:
IF opcode = IL.opINR THEN
reg2 := GetAnyReg();
movrc(reg2, param2)
END;
label := NewLabel();
BinOp(reg1, reg2);
cmprc(reg1, 32);
OutByte2(72H, 4); // jb L
OutByte2(72H, 4); (* jb L *)
xor(reg1, reg1);
jmp(label);
//L:
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1
(* L: *)
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); (* bt reg2, reg1 *)
setcc(setc, reg1);
andrc(reg1, 1);
SetLabel(label);
drop
|IL.opINR:
label := NewLabel();
UnOp(reg1);
reg2 := GetAnyReg();
cmprc(reg1, 32);
OutByte2(72H, 4); // jb L
xor(reg1, reg1);
jmp(label);
//L:
movrc(reg2, param2);
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1
setcc(setc, reg1);
andrc(reg1, 1);
SetLabel(label);
drop
|IL.opINL:
UnOp(reg1);
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); (* bt reg1, param2 *)
setcc(setc, reg1);
andrc(reg1, 1)
1476,26 → 1564,26
|IL.opINCL, IL.opEXCL:
BinOp(reg1, reg2);
cmprc(reg1, 32);
OutByte2(73H, 03H); // jnb L
OutByte2(73H, 03H); (* jnb L *)
OutByte(0FH);
IF opcode = IL.opINCL THEN
OutByte(0ABH) // bts dword[reg2], reg1
OutByte(0ABH) (* bts dword[reg2], reg1 *)
ELSE
OutByte(0B3H) // btr dword[reg2], reg1
OutByte(0B3H) (* btr dword[reg2], reg1 *)
END;
OutByte(reg2 + 8 * reg1);
//L:
(* L: *)
drop;
drop
|IL.opINCLC:
UnOp(reg1);
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); (* bts dword[reg1], param2 *)
drop
|IL.opEXCLC:
UnOp(reg1);
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); (* btr dword[reg1], param2 *)
drop
|IL.opDIV:
1504,49 → 1592,20
GetRegA
|IL.opDIVR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
ELSE
n := -1
END;
IF a = 1 THEN
ELSIF a = -1 THEN
UnOp(reg1);
neg(reg1)
ELSE
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(reg1);
IF a < 0 THEN
reg2 := GetAnyReg();
mov(reg2, reg1);
IF n # 1 THEN
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n
OutByte3(0C1H, 0F8H + reg1, n) (* sar reg1, n *)
ELSE
OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1
END;
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2
drop
ELSE
IF n # 1 THEN
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n
ELSE
OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1
OutByte2(0D1H, 0F8H + reg1) (* sar reg1, 1 *)
END
END
ELSE
ELSIF n < 0 THEN
PushAll(1);
pushc(param2);
CallRTL(pic, IL._divmod);
GetRegA
END
END
|IL.opDIVL:
UnOp(reg1);
1564,43 → 1623,20
GetRegA
|IL.opMODR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
ELSE
n := -1
END;
IF ABS(a) = 1 THEN
UnOp(reg1);
xor(reg1, reg1)
ELSE
n := UTILS.Log2(param2);
IF n > 0 THEN
UnOp(reg1);
andrc(reg1, ABS(a) - 1);
IF a < 0 THEN
test(reg1);
OutByte(74H); // je @f
IF isByte(a) THEN
OutByte(3)
ELSE
OutByte(6)
END;
addrc(reg1, a)
// @@:
END
ELSE
andrc(reg1, param2 - 1);
ELSIF n < 0 THEN
PushAll(1);
pushc(param2);
CallRTL(pic, IL._divmod);
mov(eax, edx);
GetRegA
ELSE
UnOp(reg1);
xor(reg1, reg1)
END
END
|IL.opMODL:
UnOp(reg1);
1618,9 → 1654,9
|IL.opABS:
UnOp(reg1);
test(reg1);
OutByte2(07DH, 002H); // jge @f
neg(reg1) // neg reg1
// @@:
OutByte2(07DH, 002H); (* jge L *)
neg(reg1) (* neg reg1
L: *)
|IL.opCOPY:
PushAll(2);
1682,7 → 1718,7
cmprr(reg1, reg2);
drop
ELSE
OutByte2(081H, 0F8H + reg1); // cmp reg1, L
OutByte2(081H, 0F8H + reg1); (* cmp reg1, L *)
Reloc(BIN.RCODE, param1)
END
1690,10 → 1726,10
IF pic THEN
reg2 := GetAnyReg();
Pic(reg2, BIN.PICIMP, param1);
OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2]
OutByte2(03BH, reg1 * 8 + reg2); (* cmp reg1, dword [reg2] *)
drop
ELSE
OutByte2(3BH, 05H + reg1 * 8); // cmp reg1, dword[L]
OutByte2(3BH, 05H + reg1 * 8); (* cmp reg1, dword[L] *)
Reloc(BIN.RIMP, param1)
END
1710,8 → 1746,7
|IL.opPUSHT:
UnOp(reg1);
reg2 := GetAnyReg();
OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4]
movrm(GetAnyReg(), reg1, -4)
|IL.opISREC:
PushAll(2);
1742,7 → 1777,7
|IL.opTYPEGD:
UnOp(reg1);
PushAll(0);
OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4]
pushm(reg1, -4);
pushc(param2 * tcount);
CallRTL(pic, IL._guardrec);
GetRegA
1759,11 → 1794,11
|IL.opPACK:
BinOp(reg1, reg2);
push(reg2);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0D9H, 0FDH); // fscale
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp]
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *)
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
OutByte2(0D9H, 0FDH); (* fscale *)
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *)
pop(reg2);
drop;
drop
1771,187 → 1806,163
|IL.opPACKC:
UnOp(reg1);
pushc(param2);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0D9H, 0FDH); // fscale
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp]
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *)
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
OutByte2(0D9H, 0FDH); (* fscale *)
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *)
pop(reg1);
drop
|IL.opUNPK:
BinOp(reg1, reg2);
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0D9H, 0F4H); // fxtract
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
OutByte2(0DBH, 018H + reg2); // fistp dword[reg2]
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
OutByte2(0D9H, 0F4H); (* fxtract *)
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *)
drop;
drop
|IL.opPUSHF:
subrc(esp, 8);
OutByte3(0DDH, 01CH, 024H) // fstp qword[esp]
OutByte3(0DDH, 01CH, 024H) (* fstp qword[esp] *)
|IL.opLOADF:
UnOp(reg1);
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
drop
|IL.opCONSTF:
float := cmd.float;
IF float = 0.0 THEN
OutByte2(0D9H, 0EEH) // fldz
OutByte2(0D9H, 0EEH) (* fldz *)
ELSIF float = 1.0 THEN
OutByte2(0D9H, 0E8H) // fld1
OutByte2(0D9H, 0E8H) (* fld1 *)
ELSIF float = -1.0 THEN
OutByte2(0D9H, 0E8H); // fld1
OutByte2(0D9H, 0E0H) // fchs
OutByte2(0D9H, 0E8H); (* fld1 *)
OutByte2(0D9H, 0E0H) (* fchs *)
ELSE
n := UTILS.splitf(float, a, b);
pushc(b);
pushc(a);
OutByte3(0DDH, 004H, 024H); // fld qword[esp]
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8)
END
|IL.opSAVEF:
|IL.opSAVEF, IL.opSAVEFI:
UnOp(reg1);
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
drop
|IL.opADDF, IL.opADDFI:
OutByte2(0DEH, 0C1H) // faddp st1, st
OutByte2(0DEH, 0C1H) (* faddp st1, st *)
|IL.opSUBF:
OutByte2(0DEH, 0E9H) // fsubp st1, st
OutByte2(0DEH, 0E9H) (* fsubp st1, st *)
|IL.opSUBFI:
OutByte2(0DEH, 0E1H) // fsubrp st1, st
OutByte2(0DEH, 0E1H) (* fsubrp st1, st *)
|IL.opMULF:
OutByte2(0DEH, 0C9H) // fmulp st1, st
OutByte2(0DEH, 0C9H) (* fmulp st1, st *)
|IL.opDIVF:
OutByte2(0DEH, 0F9H) // fdivp st1, st
OutByte2(0DEH, 0F9H) (* fdivp st1, st *)
|IL.opDIVFI:
OutByte2(0DEH, 0F1H) // fdivrp st1, st
OutByte2(0DEH, 0F1H) (* fdivrp st1, st *)
|IL.opUMINF:
OutByte2(0D9H, 0E0H) // fchs
OutByte2(0D9H, 0E0H) (* fchs *)
|IL.opFABS:
OutByte2(0D9H, 0E1H) // fabs
OutByte2(0D9H, 0E1H) (* fabs *)
|IL.opFLT:
UnOp(reg1);
push(reg1);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *)
pop(reg1);
drop
|IL.opFLOOR:
subrc(esp, 8);
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4]
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6]
OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); // and word[esp+4], 1111001111111111b
OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); // or word[esp+4], 0000010000000000b
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4]
OutByte2(0D9H, 0FCH); // frndint
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp]
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); (* fstcw word[esp+4] *)
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); (* fstcw word[esp+6] *)
OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); (* and word[esp+4], 1111001111111111b *)
OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); (* or word[esp+4], 0000010000000000b *)
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); (* fldcw word[esp+4] *)
OutByte2(0D9H, 0FCH); (* frndint *)
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *)
pop(GetAnyReg());
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2]
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); (* fldcw word[esp+2] *)
addrc(esp, 4)
|IL.opEQF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 003H); // jp L
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(sete, al)
// L:
(* L: *)
|IL.opNEF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 003H); // jp L
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(setne, al)
// L:
(* L: *)
|IL.opLTF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 00EH); // jp L
fcmp;
OutByte2(07AH, 00EH); (* jp L *)
setcc(setc, al);
setcc(sete, ah);
test(eax);
setcc(sete, al);
andrc(eax, 1)
// L:
(* L: *)
|IL.opGTF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 00FH); // jp L
fcmp;
OutByte2(07AH, 00FH); (* jp L *)
setcc(setc, al);
setcc(sete, ah);
cmprc(eax, 1);
setcc(sete, al);
andrc(eax, 1)
// L:
(* L: *)
|IL.opLEF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 003H); // jp L
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(setnc, al)
// L:
(* L: *)
|IL.opGEF:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
OutByte(09EH); // sahf
movrc(eax, 0);
OutByte2(07AH, 010H); // jp L
fcmp;
OutByte2(07AH, 010H); (* jp L *)
setcc(setc, al);
setcc(sete, ah);
OutByte2(000H, 0E0H); // add al,ah
OutByte2(03CH, 001H); // cmp al,1
OutByte2(000H, 0E0H); (* add al, ah *)
OutByte2(03CH, 001H); (* cmp al, 1 *)
setcc(sete, al);
andrc(eax, 1)
// L:
(* L: *)
|IL.opINF:
pushc(7FF00000H);
pushc(0);
OutByte3(0DDH, 004H, 024H); // fld qword[esp]
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8)
|IL.opLADR_UNPK:
n := param2 * 4;
reg1 := GetAnyReg();
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n]
OutByte2(8DH, 45H + reg1 * 8 + long(n)); (* lea reg1, dword[ebp + n] *)
OutIntByte(n);
BinOp(reg1, reg2);
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0D9H, 0F4H); // fxtract
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
OutByte2(0DBH, 018H + reg2); // fistp dword[reg2]
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
OutByte2(0D9H, 0F4H); (* fxtract *)
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *)
drop;
drop
1962,14 → 1973,12
push(reg1);
drop
ELSE
OutByte(068H); // push _data + stroffs + param2
OutByte(068H); (* push _data + stroffs + param2 *)
Reloc(BIN.RDATA, stroffs + param2)
END
|IL.opVADR_PARAM:
n := param2 * 4;
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n]
OutIntByte(n)
|IL.opVADR_PARAM, IL.opLLOAD32_PARAM:
pushm(ebp, param2 * 4)
|IL.opCONST_PARAM:
pushc(param2)
1978,21 → 1987,16
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICBSS, param2);
OutByte2(0FFH, 30H + reg1); // push dword[reg1]
pushm(reg1, 0);
drop
ELSE
OutByte2(0FFH, 035H); // push dword[_bss + param2]
OutByte2(0FFH, 035H); (* push dword[_bss + param2] *)
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD32_PARAM:
n := param2 * 4;
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n]
OutIntByte(n)
|IL.opLOAD32_PARAM:
UnOp(reg1);
OutByte2(0FFH, 30H + reg1); // push dword[reg1]
pushm(reg1, 0);
drop
|IL.opGADR_SAVEC:
1999,11 → 2003,11
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICBSS, param1);
OutByte2(0C7H, reg1); // mov dword[reg1], param2
OutByte2(0C7H, reg1); (* mov dword[reg1], param2 *)
OutInt(param2);
drop
ELSE
OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2
OutByte2(0C7H, 05H); (* mov dword[_bss + param1], param2 *)
Reloc(BIN.RBSS, param1);
OutInt(param2)
END
2010,24 → 2014,22
|IL.opLADR_SAVEC:
n := param1 * 4;
OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2
OutByte2(0C7H, 45H + long(n)); (* mov dword[ebp + n], param2 *)
OutIntByte(n);
OutInt(param2)
|IL.opLADR_SAVE:
n := param2 * 4;
UnOp(reg1);
OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1
OutIntByte(n);
movmr(ebp, param2 * 4, reg1);
drop
|IL.opLADR_INCC:
n := param1 * 4;
IF ABS(param2) = 1 THEN
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n]
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec dword[ebp + n] *)
OutIntByte(n)
ELSE
OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2
OutByte2(81H + short(param2), 45H + long(n)); (* add dword[ebp + n], param2 *)
OutIntByte(n);
OutIntByte(param2)
END
2035,10 → 2037,10
|IL.opLADR_INCCB, IL.opLADR_DECCB:
n := param1 * 4;
IF param2 = 1 THEN
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n]
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* inc/dec byte[ebp + n] *)
OutIntByte(n)
ELSE
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* add/sub byte[ebp + n], param2 *)
OutIntByte(n);
OutByte(param2 MOD 256)
END
2046,7 → 2048,7
|IL.opLADR_INC, IL.opLADR_DEC:
n := param2 * 4;
UnOp(reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); (* add/sub dword[ebp + n], reg1 *)
OutIntByte(n);
drop
2053,7 → 2055,7
|IL.opLADR_INCB, IL.opLADR_DECB:
n := param2 * 4;
UnOp(reg1);
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); (* add/sub byte[ebp + n], reg1 *)
OutIntByte(n);
drop
2063,7 → 2065,7
cmprc(reg1, 32);
label := NewLabel();
jcc(jnb, label);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); (* bts(r) dword[ebp + n], reg1 *)
OutIntByte(n);
SetLabel(label);
drop
2070,7 → 2072,7
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
n := param1 * 4;
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); (* bts(r) dword[ebp + n], param2 *)
OutIntByte(n);
OutByte(param2)
2096,28 → 2098,28
entry := NewLabel();
SetLabel(entry);
IF target = mConst.Target_iDLL THEN
IF target = TARGETS.Win32DLL THEN
push(ebp);
mov(ebp, esp);
OutByte3(0FFH, 75H, 16); // push dword[ebp+16]
OutByte3(0FFH, 75H, 12); // push dword[ebp+12]
OutByte3(0FFH, 75H, 8); // push dword[ebp+8]
pushm(ebp, 16);
pushm(ebp, 12);
pushm(ebp, 8);
CallRTL(pic, IL._dllentry);
test(eax);
jcc(je, dllret)
ELSIF target = mConst.Target_iObject THEN
ELSIF target = TARGETS.KolibriOSDLL THEN
SetLabel(dllinit)
END;
IF target = mConst.Target_iKolibri THEN
IF target = TARGETS.KolibriOS THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.IMPTAB, 0);
push(reg1); // push IMPORT
push(reg1); (* push IMPORT *)
drop
ELSIF target = mConst.Target_iObject THEN
OutByte(68H); // push IMPORT
ELSIF target = TARGETS.KolibriOSDLL THEN
OutByte(68H); (* push IMPORT *)
Reloc(BIN.IMPTAB, 0)
ELSIF target = mConst.Target_iELF32 THEN
ELSIF target = TARGETS.Linux32 THEN
push(esp)
ELSE
pushc(0)
2126,10 → 2128,10
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICCODE, entry);
push(reg1); // push CODE
push(reg1); (* push CODE *)
drop
ELSE
OutByte(68H); // push CODE
OutByte(68H); (* push CODE *)
Reloc(BIN.RCODE, entry)
END;
2136,10 → 2138,10
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICDATA, 0);
push(reg1); // push _data
push(reg1); (* push _data *)
drop
ELSE
OutByte(68H); // push _data
OutByte(68H); (* push _data *)
Reloc(BIN.RDATA, 0)
END;
2150,16 → 2152,16
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICDATA, tcount * 4 + dcount);
push(reg1); // push _data + tcount * 4 + dcount
push(reg1); (* push _data + tcount * 4 + dcount *)
drop
ELSE
OutByte(68H); // push _data
OutByte(68H); (* push _data *)
Reloc(BIN.RDATA, tcount * 4 + dcount)
END;
CallRTL(pic, IL._init);
IF target = mConst.Target_iELF32 THEN
IF target = TARGETS.Linux32 THEN
L := NewLabel();
pushc(0);
push(esp);
2207,22 → 2209,22
BEGIN
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN
IF target IN {TARGETS.Win32C, TARGETS.Win32GUI, TARGETS.KolibriOS, TARGETS.Linux32} THEN
pushc(0);
CallRTL(pic, IL._exit);
ELSIF target = mConst.Target_iDLL THEN
ELSIF target = TARGETS.Win32DLL THEN
SetLabel(dllret);
movrc(eax, 1);
OutByte(0C9H); // leave
OutByte3(0C2H, 0CH, 0) // ret 12
ELSIF target = mConst.Target_iObject THEN
OutByte(0C9H); (* leave *)
OutByte3(0C2H, 0CH, 0) (* ret 12 *)
ELSIF target = TARGETS.KolibriOSDLL THEN
movrc(eax, 1);
OutByte(0C3H) // ret
ELSIF target = mConst.Target_iELFSO32 THEN
OutByte(0C3H); // ret
ret
ELSIF target = TARGETS.Linux32SO THEN
ret;
SetLabel(sofinit);
CallRTL(pic, IL._sofinit);
OutByte(0C3H) // ret
ret
END;
fixup;
2244,7 → 2246,7
BIN.PutDataStr(program, ext);
BIN.PutData(program, 0);
IF target = mConst.Target_iObject THEN
IF target = TARGETS.KolibriOSDLL THEN
BIN.Export(program, "lib_init", dllinit);
END;
2280,11 → 2282,11
dllret := NewLabel();
sofinit := NewLabel();
IF target = mConst.Target_iObject THEN
IF target = TARGETS.KolibriOSDLL THEN
opt.pic := FALSE
END;
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32} THEN
opt.pic := TRUE
END;
2296,14 → 2298,14
BIN.fixup(program);
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
PE32.write(program, outname, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE)
ELSIF target = mConst.Target_iKolibri THEN
IF TARGETS.OS = TARGETS.osWIN32 THEN
PE32.write(program, outname, target = TARGETS.Win32C, target = TARGETS.Win32DLL, FALSE)
ELSIF target = TARGETS.KolibriOS THEN
KOS.write(program, outname)
ELSIF target = mConst.Target_iObject THEN
ELSIF target = TARGETS.KolibriOSDLL THEN
MSCOFF.write(program, outname, opt.version)
ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE)
ELSIF TARGETS.OS = TARGETS.osLINUX32 THEN
ELF.write(program, outname, sofinit, target = TARGETS.Linux32SO, FALSE)
END
END CodeGen;