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/ @ 8096

  → /programs/develop/oberon07/Source/ @ 8097

  ↔ Reverse comparison

• Compare Path:	Rev

  With Path:	Rev

Regard whitespace Rev 8096 → Rev 8097

/programs/develop/oberon07/Source/AMD64.ob07
8,7 → 8,7
MODULE AMD64;
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, TARGETS,
REG, C := CONSOLE, UTILS, S := STRINGS, PE32, ELF, X86;
REG, UTILS, S := STRINGS, PE32, ELF, X86, ERRORS;
CONST
27,6 → 27,8
rsi = 6;
rdi = 7;
MAX_XMM = 5;
je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H;
sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H;
38,7 → 40,9
sBSS = BIN.PICBSS;
sIMP = BIN.PICIMP;
FPR_ERR = 41;
TYPE
COMMAND = IL.COMMAND;
65,7 → 69,11
Win64RegPar: ARRAY 4 OF INTEGER;
SystemVRegPar: ARRAY 6 OF INTEGER;
Xmm: ARRAY 1000 OF INTEGER;
fname: PATHS.PATH;
PROCEDURE OutByte (b: BYTE);
BEGIN
X86.OutByte(b)
96,24 → 104,19
END OutInt;
PROCEDURE isByte (n: INTEGER): BOOLEAN;
RETURN (-128 <= n) & (n <= 127)
END isByte;
PROCEDURE short (n: INTEGER): INTEGER;
RETURN 2 * ORD(isByte(n))
RETURN 2 * ORD(X86.isByte(n))
END short;
PROCEDURE long (n: INTEGER): INTEGER;
RETURN 40H * ORD(~isByte(n))
RETURN 40H * ORD(~X86.isByte(n))
END long;
PROCEDURE OutIntByte (n: INTEGER);
BEGIN
IF isByte(n) THEN
IF X86.isByte(n) THEN
OutByte(n MOD 256)
ELSE
OutInt(n)
191,10 → 194,10
END and;
PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *)
PROCEDURE _or (reg1, reg2: INTEGER); (* or reg1, reg2 *)
BEGIN
oprr(09H, reg1, reg2)
END or;
END _or;
PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *)
211,7 → 214,12
PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *)
BEGIN
IF rax IN {reg1, reg2} THEN
Rex(reg1 + reg2, 0);
OutByte(90H + (reg1 + reg2) MOD 8)
ELSE
oprr(87H, reg1, reg2)
END
END xchg;
270,17 → 278,9
PROCEDURE callimp (label: INTEGER);
VAR
reg: INTEGER;
BEGIN
reg := GetAnyReg();
lea(reg, label, sIMP);
IF reg >= 8 THEN (* call qword[reg] *)
OutByte(41H)
END;
OutByte2(0FFH, 10H + reg MOD 8);
drop
OutByte2(0FFH, 15H); (* call qword[rip + label + IMP] *)
X86.Reloc(sIMP, label)
END callimp;
383,8 → 383,7
oprlongc(reg, n, oprr)
ELSE
Rex(reg, 0);
OutByte2(81H + short(n), op + reg MOD 8);
OutIntByte(n)
X86.oprc(op, reg, n)
END
END oprc;
419,7 → 418,7
PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *)
BEGIN
oprc(0C8H, reg, n, or)
oprc(0C8H, reg, n, _or)
END orrc;
440,7 → 439,7
push(reg2);
drop
ELSE
OutByte(68H + short(n)); OutIntByte(n) (* push n *)
X86.pushc(n)
END
END pushc;
553,21 → 552,6
END jcc;
PROCEDURE jmp (label: INTEGER); (* jmp label *)
BEGIN
X86.jmp(label)
END jmp;
PROCEDURE setcc (cc, reg: INTEGER); (* setcc reg8 *)
BEGIN
IF reg >= 8 THEN
OutByte(41H)
END;
OutByte3(0FH, cc, 0C0H + reg MOD 8)
END setcc;
PROCEDURE shiftrc (op, reg, n: INTEGER);
BEGIN
Rex(reg, 0);
829,7 → 813,7
cc := setnc
END;
OutByte2(7AH, 3 + reg DIV 8); (* jp L *)
setcc(cc, reg);
X86.setcc(cc, reg)
(* L: *)
END fcmp;
859,7 → 843,7
CASE opcode OF
|IL.opJMP:
jmp(param1)
X86.jmp(param1)
|IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL:
REG.Store(R);
907,24 → 891,24
|IL.opONERR:
pushc(param2);
jmp(param1)
X86.jmp(param1)
|IL.opPUSHC:
pushc(param2)
|IL.opPRECALL:
n := param2;
IF (param1 # 0) & (n # 0) THEN
PushAll(0);
IF (param2 # 0) & (xmm >= 0) THEN
subrc(rsp, 8)
END;
WHILE n > 0 DO
INC(Xmm[0]);
Xmm[Xmm[0]] := xmm + 1;
WHILE xmm >= 0 DO
subrc(rsp, 8);
movsdmr(rsp, 0, xmm);
DEC(xmm);
DEC(n)
DEC(xmm)
END;
ASSERT(xmm = -1);
PushAll(0)
ASSERT(xmm = -1)
|IL.opWIN64ALIGN16:
ASSERT(rax IN R.regs);
942,27 → 926,26
push(rax)
END
|IL.opRESF:
|IL.opRESF, IL.opRES:
ASSERT(R.top = -1);
ASSERT(xmm = -1);
n := Xmm[Xmm[0]]; DEC(Xmm[0]);
IF opcode = IL.opRESF THEN
INC(xmm);
n := param2;
IF n > 0 THEN
movsdmr(rsp, n * 8, xmm);
movsdmr(rsp, n * 8, 0);
DEC(xmm);
INC(n)
END;
WHILE n > 0 DO
INC(xmm);
movsdrm(xmm, rsp, 0);
addrc(rsp, 8);
DEC(n)
IF xmm + n > MAX_XMM THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END
ELSE
GetRegA
END;
|IL.opRES:
ASSERT(R.top = -1);
GetRegA;
n := param2;
WHILE n > 0 DO
INC(xmm);
movsdrm(xmm, rsp, 0);
1137,31 → 1120,29
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
n := param2 * 8;
xor(reg1, reg1);
movrm32(reg1, rbp, n)
END
movrm32(reg1, rbp, param2 * 8)
END;
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32)
|IL.opGLOAD64:
reg1 := GetAnyReg();
lea(reg1, param2, sBSS);
movrm(reg1, reg1, 0)
Rex(0, reg1); (* mov reg1, qword[rip + param2 + BSS] *)
OutByte2(8BH, 05H + 8 * (reg1 MOD 8));
X86.Reloc(sBSS, param2)
|IL.opGLOAD8:
|IL.opGLOAD8, IL.opGLOAD16:
reg1 := GetAnyReg();
lea(reg1, param2, sBSS);
movzx(reg1, reg1, 0, FALSE)
Rex(0, reg1); (* movzx reg1, byte/word[rip + param2 + BSS] *)
OutByte3(0FH, 0B6H + ORD(opcode = IL.opGLOAD16), 05H + 8 * (reg1 MOD 8));
X86.Reloc(sBSS, param2)
|IL.opGLOAD16:
reg1 := GetAnyReg();
lea(reg1, param2, sBSS);
movzx(reg1, reg1, 0, TRUE)
|IL.opGLOAD32:
reg1 := GetAnyReg();
xor(reg1, reg1);
lea(reg1, param2, sBSS);
movrm32(reg1, reg1, 0)
movrm32(reg1, reg1, 0);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32)
|IL.opVLOAD64:
reg1 := GetAnyReg();
1177,9 → 1158,10
|IL.opVLOAD32:
reg1 := GetAnyReg();
reg2 := GetAnyReg();
xor(reg1, reg1);
movrm(reg2, rbp, param2 * 8);
movrm32(reg1, reg2, 0);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
drop
|IL.opLADR:
1186,14 → 1168,22
n := param2 * 8;
next := cmd.next(COMMAND);
IF (next.opcode = IL.opSAVEF) OR (next.opcode = IL.opSAVEFI) THEN
ASSERT(xmm >= 0);
movsdmr(rbp, n, xmm);
DEC(xmm);
cmd := next
ELSIF next.opcode = IL.opLOADF THEN
INC(xmm);
IF xmm > MAX_XMM THEN
ERRORS.ErrorMsg(fname, next.param1, next.param2, FPR_ERR)
END;
movsdrm(xmm, rbp, n);
cmd := next
ELSE
IF (next.opcode = IL.opADDC) & ~isLong(n + next.param2) THEN
INC(n, next.param2);
cmd := next
END;
reg1 := GetAnyReg();
Rex(0, reg1);
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); (* lea reg1, qword[rbp+n] *)
1201,6 → 1191,11
END
|IL.opGADR:
next := cmd.next(COMMAND);
IF (next.opcode = IL.opADDC) & ~isLong(param2 + next.param2) THEN
INC(param2, next.param2);
cmd := next
END;
lea(GetAnyReg(), param2, sBSS)
|IL.opVADR:
1311,15 → 1306,15
cc := X86.cond(opcode);
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
IF next.opcode = IL.opJNZ THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
ELSIF next.opcode = IL.opJZ THEN
jcc(X86.inv0(cc), next.param1);
cmd := next
ELSE
reg1 := GetAnyReg();
setcc(cc + 16, reg1);
X86.setcc(cc + 16, reg1);
andrc(reg1, 1)
END
1342,36 → 1337,23
PushAll(n)
END
|IL.opACC:
IF (R.top # 0) OR (R.stk[0] # rax) THEN
PushAll(0);
GetRegA;
pop(rax);
DEC(R.pushed)
END
|IL.opJNZ:
|IL.opJNZ1:
UnOp(reg1);
test(reg1);
jcc(jne, param1)
|IL.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1)
|IL.opJG:
UnOp(reg1);
test(reg1);
jcc(jg, param1)
|IL.opJE:
|IL.opJNZ:
UnOp(reg1);
test(reg1);
jcc(jne, param1);
drop
|IL.opJNE:
|IL.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1);
1388,11 → 1370,11
cmprc(reg1, 64);
jcc(jb, L);
xor(reg1, reg1);
jmp(label);
X86.jmp(label);
X86.SetLabel(L);
Rex(reg2, reg1);
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); (* bt reg2, reg1 *)
setcc(setc, reg1);
X86.setcc(setc, reg1);
andrc(reg1, 1);
X86.SetLabel(label);
drop
1402,19 → 1384,19
Rex(reg1, 0);
OutByte2(0FH, 0BAH); (* bt reg1, param2 *)
OutByte2(0E0H + reg1 MOD 8, param2);
setcc(setc, reg1);
X86.setcc(setc, reg1);
andrc(reg1, 1)
|IL.opNOT:
UnOp(reg1);
test(reg1);
setcc(sete, reg1);
X86.setcc(sete, reg1);
andrc(reg1, 1)
|IL.opORD:
UnOp(reg1);
test(reg1);
setcc(setne, reg1);
X86.setcc(setne, reg1);
andrc(reg1, 1)
|IL.opABS:
1439,9 → 1421,9
X86.SetLabel(label);
cmprr(reg1, reg2);
IF opcode = IL.opEQB THEN
setcc(sete, reg1)
X86.setcc(sete, reg1)
ELSE
setcc(setne, reg1)
X86.setcc(setne, reg1)
END;
andrc(reg1, 1)
1453,7 → 1435,7
UnOp(reg1);
xorrc(reg1, param2)
|IL.opADDSL, IL.opADDSR:
|IL.opADDSC:
UnOp(reg1);
orrc(reg1, param2)
1688,19 → 1670,18
|IL.opSUBR, IL.opSUBL:
UnOp(reg1);
n := param2;
IF n = 1 THEN
IF param2 = 1 THEN
decr(reg1)
ELSIF n = -1 THEN
ELSIF param2 = -1 THEN
incr(reg1)
ELSIF n # 0 THEN
subrc(reg1, n)
ELSIF param2 # 0 THEN
subrc(reg1, param2)
END;
IF opcode = IL.opSUBL THEN
neg(reg1)
END
|IL.opADDL, IL.opADDR:
|IL.opADDC:
IF (param2 # 0) & ~isLong(param2) THEN
UnOp(reg1);
next := cmd.next(COMMAND);
1851,7 → 1832,7
|IL.opADDS:
BinOp(reg1, reg2);
or(reg1, reg2);
_or(reg1, reg2);
drop
|IL.opSUBS:
1860,7 → 1841,7
and(reg1, reg2);
drop
|IL.opNOP:
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opSWITCH:
UnOp(reg1);
2008,8 → 1989,8
reg1 := GetAnyReg();
CASE opcode OF
|IL.opEQP, IL.opEQIP: setcc(sete, reg1)
|IL.opNEP, IL.opNEIP: setcc(setne, reg1)
|IL.opEQP, IL.opEQIP: X86.setcc(sete, reg1)
|IL.opNEP, IL.opNEIP: X86.setcc(setne, reg1)
END;
andrc(reg1, 1)
2045,9 → 2026,8
drop
|IL.opCLEANUP:
n := param2 * 8;
IF n # 0 THEN
addrc(rsp, n)
IF param2 # 0 THEN
addrc(rsp, param2 * 8)
END
|IL.opPOPSP:
2056,10 → 2036,14
|IL.opLOADF:
UnOp(reg1);
INC(xmm);
IF xmm > MAX_XMM THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
movsdrm(xmm, reg1, 0);
drop
|IL.opPUSHF:
ASSERT(xmm >= 0);
subrc(rsp, 8);
movsdmr(rsp, 0, xmm);
DEC(xmm)
2067,66 → 2051,78
|IL.opCONSTF:
float := cmd.float;
INC(xmm);
reg1 := GetAnyReg();
lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA);
movsdrm(xmm, reg1, 0);
drop;
IF xmm > MAX_XMM THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
(* movsd xmm, qword ptr [rip + Numbers_Offs + Numbers_Count * 8 + DATA] *)
OutByte(0F2H);
IF xmm >= 8 THEN
OutByte(44H)
END;
OutByte3(0FH, 10H, 05H + 8 * (xmm MOD 8));
X86.Reloc(sDATA, Numbers_Offs + Numbers_Count * 8);
NewNumber(UTILS.splitf(float, a, b))
|IL.opSAVEF, IL.opSAVEFI:
ASSERT(xmm >= 0);
UnOp(reg1);
movsdmr(reg1, 0, xmm);
DEC(xmm);
drop
|IL.opADDF, IL.opADDFI:
|IL.opADDF:
ASSERT(xmm >= 1);
opxx(58H, xmm - 1, xmm);
DEC(xmm)
|IL.opSUBF:
ASSERT(xmm >= 1);
opxx(5CH, xmm - 1, xmm);
DEC(xmm)
|IL.opSUBFI:
ASSERT(xmm >= 1);
opxx(5CH, xmm, xmm - 1);
opxx(10H, xmm - 1, xmm);
DEC(xmm)
|IL.opMULF:
ASSERT(xmm >= 1);
opxx(59H, xmm - 1, xmm);
DEC(xmm)
|IL.opDIVF:
ASSERT(xmm >= 1);
opxx(5EH, xmm - 1, xmm);
DEC(xmm)
|IL.opDIVFI:
ASSERT(xmm >= 1);
opxx(5EH, xmm, xmm - 1);
opxx(10H, xmm - 1, xmm);
DEC(xmm)
|IL.opUMINF:
reg1 := GetAnyReg();
lea(reg1, Numbers_Offs, sDATA);
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
|IL.opFABS, IL.opUMINF: (* andpd/xorpd xmm, xmmword[rip + Numbers_Offs + (16) + DATA] *)
ASSERT(xmm >= 0);
OutByte(66H);
IF xmm >= 8 THEN
OutByte(44H)
END;
OutByte3(0FH, 54H + 3 * ORD(opcode = IL.opUMINF), 05H + (xmm MOD 8) * 8);
X86.Reloc(sDATA, Numbers_Offs + 16 * ORD(opcode = IL.opFABS))
|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] *)
OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8);
drop
|IL.opFLT:
UnOp(reg1);
INC(xmm);
IF xmm > MAX_XMM THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); (* cvtsi2sd xmm, reg1 *)
OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8);
drop
|IL.opFLOOR:
ASSERT(xmm >= 0);
reg1 := GetAnyReg();
subrc(rsp, 8);
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); (* stmxcsr dword[rsp+4]; *)
2141,15 → 2137,22
DEC(xmm)
|IL.opEQF .. IL.opGEF:
ASSERT(xmm >= 1);
fcmp(opcode, xmm);
DEC(xmm, 2)
|IL.opINF:
INC(xmm);
reg1 := GetAnyReg();
lea(reg1, Numbers_Offs + 32, sDATA);
movsdrm(xmm, reg1, 0);
drop
IF xmm > MAX_XMM THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
(* movsd xmm, qword ptr [rip + Numbers_Offs + 32 + DATA] *)
OutByte(0F2H);
IF xmm >= 8 THEN
OutByte(44H)
END;
OutByte3(0FH, 10H, 05H + 8 * (xmm MOD 8));
X86.Reloc(sDATA, Numbers_Offs + 32)
|IL.opPACK, IL.opPACKC:
IF opcode = IL.opPACK THEN
2175,7 → 2178,7
and(reg2, reg1);
pop(reg1);
or(reg2, reg1);
_or(reg2, reg1);
pop(reg1);
movmr(reg1, 0, reg2);
drop;
2218,7 → 2221,7
push(reg2);
lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *)
movrm(reg2, reg2, 0);
or(reg1, reg2);
_or(reg1, reg2);
pop(reg2);
Rex(reg1, 0);
2248,26 → 2251,20
END
|IL.opGLOAD64_PARAM:
reg2 := GetAnyReg();
lea(reg2, param2, sBSS);
movrm(reg2, reg2, 0);
push(reg2);
drop
OutByte2(0FFH, 35H); (* push qword[rip + param2 + BSS] *)
X86.Reloc(sBSS, param2)
|IL.opCONST_PARAM:
pushc(param2)
|IL.opGLOAD32_PARAM:
|IL.opGLOAD32_PARAM, IL.opLOAD32_PARAM:
IF opcode = IL.opGLOAD32_PARAM THEN
reg1 := GetAnyReg();
xor(reg1, reg1);
lea(reg1, param2, sBSS);
lea(reg1, param2, sBSS)
ELSE
UnOp(reg1)
END;
movrm32(reg1, reg1, 0);
push(reg1);
drop
|IL.opLOAD32_PARAM:
UnOp(reg1);
movrm32(reg1, reg1, 0);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
push(reg1);
2275,7 → 2272,6
|IL.opLLOAD32_PARAM:
reg1 := GetAnyReg();
xor(reg1, reg1);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
2282,6 → 2278,8
ELSE
movrm32(reg1, rbp, param2 * 8)
END;
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
push(reg1);
drop
2313,12 → 2311,10
drop;
drop
ELSE
reg2 := GetAnyReg();
lea(reg2, param1, sBSS);
Rex(reg2, 0);
OutByte2(0C7H, reg2 MOD 8); (* mov qword[reg2], param2 *)
OutInt(param2);
drop
(* mov qword[rip + param1 - 4 + BSS], param2 *)
OutByte3(48H, 0C7H, 05H);
X86.Reloc(sBSS, param1 - 4);
OutInt(param2)
END
|IL.opLADR_SAVE:
2431,7 → 2427,7
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(~X86.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 *)
2453,6 → 2449,9
OutByte(param2)
END
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
|IL.opLOOP, IL.opENDLOOP:
END;
2485,10 → 2484,9
push(rcx);
CallRTL(IL._dllentry);
test(rax);
jcc(je, dllret)
END;
IF target = TARGETS.Linux64 THEN
jcc(je, dllret);
pushc(0)
ELSIF target = TARGETS.Linux64 THEN
push(rsp)
ELSE
pushc(0)
2527,7 → 2525,7
exp: IL.EXPORT_PROC;
PROCEDURE import (imp: LISTS.LIST);
PROCEDURE _import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
2545,7 → 2543,7
lib := lib.next(IL.IMPORT_LIB)
END
END import;
END _import;
BEGIN
2598,7 → 2596,7
exp := exp.next(IL.EXPORT_PROC)
END;
import(IL.codes.import)
_import(IL.codes._import)
END epilog;
2631,6 → 2629,7
path, modname, ext: PATHS.PATH;
BEGIN
Xmm[0] := 0;
tcount := CHL.Length(IL.codes.types);
Win64RegPar[0] := rcx;

/programs/develop/oberon07/Source/ARITH.ob07
16,11 → 16,12
tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6;
tSTRING* = 7;
opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;
opIN* = 6; opIS* = 7;
TYPE
RELATION* = ARRAY 3 OF CHAR;
VALUE* = RECORD
typ*: INTEGER;
672,7 → 673,7
END equal;
PROCEDURE relation* (VAR v: VALUE; v2: VALUE; operator: RELATION; VAR error: INTEGER);
PROCEDURE relation* (VAR v: VALUE; v2: VALUE; op: INTEGER; VAR error: INTEGER);
VAR
res: BOOLEAN;
681,36 → 682,34
res := FALSE;
CASE operator[0] OF
CASE op OF
|"=":
|opEQ:
res := equal(v, v2, error)
|"#":
|opNE:
res := ~equal(v, v2, error)
|"<":
IF operator[1] = "=" THEN
|opLT:
res := less(v, v2, error)
|opLE:
res := less(v, v2, error);
IF error = 0 THEN
res := equal(v, v2, error) OR res
END
ELSE
res := less(v, v2, error)
END
|">":
IF operator[1] = "=" THEN
|opGE:
res := ~less(v, v2, error)
ELSE
|opGT:
res := less(v, v2, error);
IF error = 0 THEN
res := equal(v, v2, error) OR res
END;
res := ~res
END
|"I":
|opIN:
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
IF range(v, 0, UTILS.target.maxSet) THEN
res := v.int IN v2.set
762,6 → 761,20
END setInt;
PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
res := LENGTH(s) + LENGTH(s1) < LEN(s);
IF res THEN
STRINGS.append(s, s1)
END
RETURN res
END concat;
PROCEDURE init;
VAR
i: INTEGER;

/programs/develop/oberon07/Source/BIN.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
56,7 → 56,7
vmajor*,
vminor*: WCHAR;
modname*: INTEGER;
import*: CHL.BYTELIST;
_import*: CHL.BYTELIST;
export*: CHL.BYTELIST;
rel_list*: LISTS.LIST;
imp_list*: LISTS.LIST;
86,7 → 86,7
program.data := CHL.CreateByteList();
program.code := CHL.CreateByteList();
program.import := CHL.CreateByteList();
program._import := CHL.CreateByteList();
program.export := CHL.CreateByteList()
RETURN program
120,7 → 120,7
END PutData;
PROCEDURE get32le* (array: CHL.BYTELIST; idx: INTEGER): INTEGER;
PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER;
VAR
i: INTEGER;
x: INTEGER;
129,7 → 129,7
x := 0;
FOR i := 3 TO 0 BY -1 DO
x := LSL(x, 8) + CHL.GetByte(array, idx + i)
x := LSL(x, 8) + CHL.GetByte(_array, idx + i)
END;
IF UTILS.bit_depth = 64 THEN
143,13 → 143,13
END get32le;
PROCEDURE put32le* (array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 3 DO
CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
CHL.SetByte(_array, idx + i, UTILS.Byte(x, i))
END
END put32le;
224,15 → 224,15
imp: IMPRT;
BEGIN
CHL.PushByte(program.import, 0);
CHL.PushByte(program.import, 0);
CHL.PushByte(program._import, 0);
CHL.PushByte(program._import, 0);
IF ODD(CHL.Length(program.import)) THEN
CHL.PushByte(program.import, 0)
IF ODD(CHL.Length(program._import)) THEN
CHL.PushByte(program._import, 0)
END;
NEW(imp);
imp.nameoffs := CHL.PushStr(program.import, name);
imp.nameoffs := CHL.PushStr(program._import, name);
imp.label := label;
LISTS.push(program.imp_list, imp)
END Import;
285,19 → 285,18
PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT;
VAR
import: IMPRT;
res: IMPRT;
_import, res: IMPRT;
BEGIN
import := program.imp_list.first(IMPRT);
_import := program.imp_list.first(IMPRT);
res := NIL;
WHILE (import # NIL) & (n >= 0) DO
IF import.label # 0 THEN
res := import;
WHILE (_import # NIL) & (n >= 0) DO
IF _import.label # 0 THEN
res := _import;
DEC(n)
END;
import := import.next(IMPRT)
_import := _import.next(IMPRT)
END;
ASSERT(n = -1)
349,7 → 348,7
END fixup;
PROCEDURE InitArray* (VAR array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
VAR
i, k: INTEGER;
375,7 → 374,7
k := k DIV 2;
FOR i := 0 TO k - 1 DO
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
_array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
END;
INC(idx, k)

/programs/develop/oberon07/Source/CHUNKLISTS.ob07
153,7 → 153,7
END GetStr;
PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST);
PROCEDURE WriteToFile* (list: BYTELIST);
VAR
chunk: BYTECHUNK;
160,7 → 160,7
BEGIN
chunk := list.first(BYTECHUNK);
WHILE chunk # NIL DO
WR.Write(file, chunk.data, chunk.count);
WR.Write(chunk.data, chunk.count);
chunk := chunk.next(BYTECHUNK)
END
END WriteToFile;

/programs/develop/oberon07/Source/Compiler.ob07
8,7 → 8,7
MODULE Compiler;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE,
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS;
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN;
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
15,7 → 15,7
VAR
param: PARS.PATH;
i, j: INTEGER;
end: BOOLEAN;
_end: BOOLEAN;
value: INTEGER;
minor,
major: INTEGER;
24,7 → 24,7
BEGIN
out := "";
checking := options.checking;
end := FALSE;
_end := FALSE;
i := 3;
REPEAT
UTILS.GetArg(i, param);
113,11 → 113,19
DEC(i)
END
ELSIF param = "-lower" THEN
options.lower := TRUE
ELSIF param = "-pic" THEN
options.pic := TRUE
ELSIF param = "-def" THEN
INC(i);
UTILS.GetArg(i, param);
SCAN.NewDef(param)
ELSIF param = "" THEN
end := TRUE
_end := TRUE
ELSE
ERRORS.BadParam(param)
124,7 → 132,7
END;
INC(i)
UNTIL end;
UNTIL _end;
options.checking := checking
END keys;
165,6 → 173,7
options.stack := 2;
options.version := 65536;
options.pic := FALSE;
options.lower := FALSE;
options.checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path);
203,6 → 212,8
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(" -lower allow lower case for keywords"); C.Ln;
C.StringLn(" -def <identifier> define conditional compilation symbol"); 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;
226,6 → 237,8
ERRORS.Error(205)
END;
SCAN.NewDef(param);
IF TARGETS.Select(param) THEN
target := TARGETS.target
ELSE

/programs/develop/oberon07/Source/ELF.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
Copyright (c) 2019-2020, Anton Krotov
All rights reserved.
*)
MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS;
CONST
85,9 → 85,6
END;
FILE = WR.FILE;
VAR
dynamic: LISTS.LIST;
97,75 → 94,38
hashtab, bucket, chain: CHL.INTLIST;
PROCEDURE align (n, _align: INTEGER): INTEGER;
PROCEDURE Write16 (w: WCHAR);
BEGIN
IF n MOD _align # 0 THEN
n := n + _align - (n MOD _align)
END
RETURN n
END align;
PROCEDURE Write16 (file: FILE; w: WCHAR);
BEGIN
WR.Write16LE(file, ORD(w))
WR.Write16LE(ORD(w))
END Write16;
PROCEDURE WritePH (file: FILE; ph: Elf32_Phdr);
PROCEDURE WritePH (ph: Elf32_Phdr);
BEGIN
WR.Write32LE(file, ph.p_type);
WR.Write32LE(file, ph.p_offset);
WR.Write32LE(file, ph.p_vaddr);
WR.Write32LE(file, ph.p_paddr);
WR.Write32LE(file, ph.p_filesz);
WR.Write32LE(file, ph.p_memsz);
WR.Write32LE(file, ph.p_flags);
WR.Write32LE(file, ph.p_align)
WR.Write32LE(ph.p_type);
WR.Write32LE(ph.p_offset);
WR.Write32LE(ph.p_vaddr);
WR.Write32LE(ph.p_paddr);
WR.Write32LE(ph.p_filesz);
WR.Write32LE(ph.p_memsz);
WR.Write32LE(ph.p_flags);
WR.Write32LE(ph.p_align)
END WritePH;
PROCEDURE WritePH64 (file: FILE; ph: Elf32_Phdr);
PROCEDURE WritePH64 (ph: Elf32_Phdr);
BEGIN
WR.Write32LE(file, ph.p_type);
WR.Write32LE(file, ph.p_flags);
WR.Write64LE(file, ph.p_offset);
WR.Write64LE(file, ph.p_vaddr);
WR.Write64LE(file, ph.p_paddr);
WR.Write64LE(file, ph.p_filesz);
WR.Write64LE(file, ph.p_memsz);
WR.Write64LE(file, ph.p_align)
WR.Write32LE(ph.p_type);
WR.Write32LE(ph.p_flags);
WR.Write64LE(ph.p_offset);
WR.Write64LE(ph.p_vaddr);
WR.Write64LE(ph.p_paddr);
WR.Write64LE(ph.p_filesz);
WR.Write64LE(ph.p_memsz);
WR.Write64LE(ph.p_align)
END WritePH64;
PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN);
VAR
reloc: BIN.RELOC;
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(code, reloc.offset);
delta := delta0 - reloc.offset - text;
CASE reloc.opcode OF
|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 fixup;
PROCEDURE NewDyn (tag, val: INTEGER);
VAR
dyn: Elf32_Dyn;
271,14 → 231,12
ehdr: Elf32_Ehdr;
phdr: ARRAY 16 OF Elf32_Phdr;
i, BaseAdr, offset, pad, VA, symCount: INTEGER;
i, BaseAdr, DynAdr, offset, pad, VA, symCount: INTEGER;
SizeOf: RECORD header, code, data, bss: INTEGER END;
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
Offset: RECORD symtab, reltab, hash, strtab: INTEGER END;
File: FILE;
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
item: LISTS.ITEM;
285,6 → 243,8
Name: ARRAY 2048 OF CHAR;
Address: PE32.VIRTUAL_ADDR;
BEGIN
dynamic := LISTS.create(NIL);
symtab := LISTS.create(NIL);
431,12 → 391,12
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
Offset.dyn := phdr[dyn].p_offset;
DynAdr := phdr[dyn].p_offset + BaseAdr;
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + DynAdr;
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + DynAdr;
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + DynAdr;
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + DynAdr;
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
phdr[dyn].p_memsz := phdr[dyn].p_filesz;
450,12 → 410,12
phdr[header].p_offset := offset;
phdr[header].p_vaddr := BaseAdr;
phdr[header].p_paddr := BaseAdr;
phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
phdr[header].p_filesz := SizeOf.header + lenInterpreter + phdr[dyn].p_filesz;
phdr[header].p_memsz := phdr[header].p_filesz;
phdr[header].p_flags := PF_R + PF_W;
phdr[header].p_align := 1000H;
offset := offset + phdr[header].p_filesz;
INC(offset, phdr[header].p_filesz);
VA := BaseAdr + offset + 1000H;
phdr[text].p_type := 1;
469,7 → 429,7
ehdr.e_entry := phdr[text].p_vaddr;
offset := offset + phdr[text].p_filesz;
INC(offset, phdr[text].p_filesz);
VA := BaseAdr + offset + 2000H;
pad := (16 - VA MOD 16) MOD 16;
482,7 → 442,7
phdr[data].p_flags := PF_R + PF_W;
phdr[data].p_align := 1000H;
offset := offset + phdr[data].p_filesz;
INC(offset, phdr[data].p_filesz);
VA := BaseAdr + offset + 3000H;
phdr[bss].p_type := 1;
494,8 → 454,13
phdr[bss].p_flags := PF_R + PF_W;
phdr[bss].p_align := 1000H;
fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
Address.Code := ehdr.e_entry;
Address.Data := phdr[data].p_vaddr + pad;
Address.Bss := WR.align(phdr[bss].p_vaddr, 16);
Address.Import := 0;
PE32.fixup(program, Address, amd64);
item := symtab.first;
WHILE item # NIL DO
IF item(Elf32_Sym).value # 0 THEN
509,146 → 474,137
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
END;
File := WR.Create(FileName);
WR.Create(FileName);
FOR i := 0 TO EI_NIDENT - 1 DO
WR.WriteByte(File, ehdr.e_ident[i])
WR.WriteByte(ehdr.e_ident[i])
END;
Write16(File, ehdr.e_type);
Write16(File, ehdr.e_machine);
Write16(ehdr.e_type);
Write16(ehdr.e_machine);
WR.Write32LE(File, ehdr.e_version);
WR.Write32LE(ehdr.e_version);
IF amd64 THEN
WR.Write64LE(File, ehdr.e_entry);
WR.Write64LE(File, ehdr.e_phoff);
WR.Write64LE(File, ehdr.e_shoff)
WR.Write64LE(ehdr.e_entry);
WR.Write64LE(ehdr.e_phoff);
WR.Write64LE(ehdr.e_shoff)
ELSE
WR.Write32LE(File, ehdr.e_entry);
WR.Write32LE(File, ehdr.e_phoff);
WR.Write32LE(File, ehdr.e_shoff)
WR.Write32LE(ehdr.e_entry);
WR.Write32LE(ehdr.e_phoff);
WR.Write32LE(ehdr.e_shoff)
END;
WR.Write32LE(File, ehdr.e_flags);
WR.Write32LE(ehdr.e_flags);
Write16(File, ehdr.e_ehsize);
Write16(File, ehdr.e_phentsize);
Write16(File, ehdr.e_phnum);
Write16(File, ehdr.e_shentsize);
Write16(File, ehdr.e_shnum);
Write16(File, ehdr.e_shstrndx);
Write16(ehdr.e_ehsize);
Write16(ehdr.e_phentsize);
Write16(ehdr.e_phnum);
Write16(ehdr.e_shentsize);
Write16(ehdr.e_shnum);
Write16(ehdr.e_shstrndx);
IF amd64 THEN
WritePH64(File, phdr[interp]);
WritePH64(File, phdr[dyn]);
WritePH64(File, phdr[header]);
WritePH64(File, phdr[text]);
WritePH64(File, phdr[data]);
WritePH64(File, phdr[bss])
WritePH64(phdr[interp]);
WritePH64(phdr[dyn]);
WritePH64(phdr[header]);
WritePH64(phdr[text]);
WritePH64(phdr[data]);
WritePH64(phdr[bss])
ELSE
WritePH(File, phdr[interp]);
WritePH(File, phdr[dyn]);
WritePH(File, phdr[header]);
WritePH(File, phdr[text]);
WritePH(File, phdr[data]);
WritePH(File, phdr[bss])
WritePH(phdr[interp]);
WritePH(phdr[dyn]);
WritePH(phdr[header]);
WritePH(phdr[text]);
WritePH(phdr[data]);
WritePH(phdr[bss])
END;
FOR i := 0 TO lenInterpreter - 1 DO
WR.WriteByte(File, ORD(Interpreter[i]))
WR.WriteByte(ORD(Interpreter[i]))
END;
i := 0;
IF amd64 THEN
item := dynamic.first;
WHILE item # NIL DO
WR.Write64LE(File, item(Elf32_Dyn).d_tag);
WR.Write64LE(File, item(Elf32_Dyn).d_val);
WR.Write64LE(item(Elf32_Dyn).d_tag);
WR.Write64LE(item(Elf32_Dyn).d_val);
item := item.next
END;
item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
WR.Write64LE(File, item(Elf32_Sym).value);
WR.Write64LE(File, item(Elf32_Sym).size);
WR.Write32LE(item(Elf32_Sym).name);
WR.WriteByte(ORD(item(Elf32_Sym).info));
WR.WriteByte(ORD(item(Elf32_Sym).other));
Write16(item(Elf32_Sym).shndx);
WR.Write64LE(item(Elf32_Sym).value);
WR.Write64LE(item(Elf32_Sym).size);
item := item.next
END;
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16);
WR.Write32LE(File, 1);
WR.Write32LE(File, 1);
WR.Write64LE(File, 0);
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 1);
WR.Write32LE(File, 2);
WR.Write64LE(File, 0);
WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 16);
WR.Write32LE(1);
WR.Write32LE(1);
WR.Write64LE(0);
WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 8);
WR.Write32LE(1);
WR.Write32LE(2);
WR.Write64LE(0)
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write64LE(File, 0);
WR.Write64LE(File, 0)
ELSE
item := dynamic.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Dyn).d_tag);
WR.Write32LE(File, item(Elf32_Dyn).d_val);
WR.Write32LE(item(Elf32_Dyn).d_tag);
WR.Write32LE(item(Elf32_Dyn).d_val);
item := item.next
END;
item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.Write32LE(File, item(Elf32_Sym).value);
WR.Write32LE(File, item(Elf32_Sym).size);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
WR.Write32LE(item(Elf32_Sym).name);
WR.Write32LE(item(Elf32_Sym).value);
WR.Write32LE(item(Elf32_Sym).size);
WR.WriteByte(ORD(item(Elf32_Sym).info));
WR.WriteByte(ORD(item(Elf32_Sym).other));
Write16(item(Elf32_Sym).shndx);
item := item.next
END;
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 00000101H);
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4);
WR.Write32LE(File, 00000201H);
WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 8);
WR.Write32LE(00000101H);
WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 4);
WR.Write32LE(00000201H)
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
END;
WR.Write32LE(symCount);
WR.Write32LE(symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
WR.Write32LE(CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
WR.Write32LE(CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write32LE(File, 0);
WR.Write32LE(File, 0)
CHL.WriteToFile(strtab);
IF amd64 THEN
WR.Write64LE(0);
WR.Write64LE(0)
ELSE
WR.Write32LE(0);
WR.Write32LE(0)
END;
CHL.WriteToFile(File, program.code);
CHL.WriteToFile(program.code);
WHILE pad > 0 DO
WR.WriteByte(File, 0);
WR.WriteByte(0);
DEC(pad)
END;
CHL.WriteToFile(File, program.data);
WR.Close(File)
CHL.WriteToFile(program.data);
WR.Close;
UTILS.chmod(FileName)
END write;

/programs/develop/oberon07/Source/ERRORS.ob07
144,7 → 144,9
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|115: str := "recursive constant definition"
|116: str := "procedure too deep nested"
|117: str := "string expected"
|118: str := "'$END', '$ELSE' or '$ELSIF' without '$IF'"
|119: str := "'$IF', '$ELSIF', '$ELSE' or '$END' expected"
|120: str := "too many formal parameters"
|121: str := "multiply defined handler"
|122: str := "bad divisor"
210,6 → 212,7
|205: Error1("not enough parameters")
|206: Error1("bad parameter <target>")
|207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"')
|208: Error1("not enough RAM")
END
END Error;

/programs/develop/oberon07/Source/FILES.ob07
17,10 → 17,8
ptr: INTEGER;
buffer: ARRAY 64*1024 OF BYTE;
count: INTEGER;
count: INTEGER
chksum*: INTEGER
END;
VAR
85,8 → 83,7
IF ptr > 0 THEN
file := NewFile();
file.ptr := ptr;
file.count := 0;
file.chksum := 0
file.count := 0
ELSE
file := NIL
END

/programs/develop/oberon07/Source/HEX.ob07
7,46 → 7,48
MODULE HEX;
IMPORT FILES, WRITER, CHL := CHUNKLISTS;
IMPORT WRITER, CHL := CHUNKLISTS, UTILS;
PROCEDURE hexdgt (n: BYTE): BYTE;
BEGIN
IF n < 10 THEN
n := n + ORD("0")
ELSE
n := n - 10 + ORD("A")
END
VAR
RETURN n
END hexdgt;
chksum: INTEGER;
PROCEDURE Byte (file: FILES.FILE; byte: BYTE);
PROCEDURE Byte (byte: BYTE);
BEGIN
WRITER.WriteByte(file, hexdgt(byte DIV 16));
WRITER.WriteByte(file, hexdgt(byte MOD 16));
INC(file.chksum, byte);
WRITER.WriteByte(UTILS.hexdgt(byte DIV 16));
WRITER.WriteByte(UTILS.hexdgt(byte MOD 16));
INC(chksum, byte)
END Byte;
PROCEDURE NewLine (file: FILES.FILE);
PROCEDURE Byte4 (a, b, c, d: BYTE);
BEGIN
Byte(file, (-file.chksum) MOD 256);
file.chksum := 0;
WRITER.WriteByte(file, 0DH);
WRITER.WriteByte(file, 0AH)
Byte(a);
Byte(b);
Byte(c);
Byte(d)
END Byte4;
PROCEDURE NewLine;
BEGIN
Byte((-chksum) MOD 256);
chksum := 0;
WRITER.WriteByte(0DH);
WRITER.WriteByte(0AH)
END NewLine;
PROCEDURE StartCode (file: FILES.FILE);
PROCEDURE StartCode;
BEGIN
WRITER.WriteByte(file, ORD(":"));
file.chksum := 0
WRITER.WriteByte(ORD(":"));
chksum := 0
END StartCode;
PROCEDURE Data* (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER);
PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER);
VAR
i, len: INTEGER;
53,74 → 55,62
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);
StartCode;
Byte4(len, idx DIV 256, idx MOD 256, 0);
FOR i := 1 TO len DO
Byte(file, mem[idx]);
Byte(mem[idx]);
INC(idx)
END;
DEC(cnt, len);
NewLine(file)
NewLine
END
END Data;
PROCEDURE ExtLA* (file: FILES.FILE; LA: INTEGER);
PROCEDURE ExtLA* (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)
StartCode;
Byte4(2, 0, 0, 4);
Byte(LA DIV 256);
Byte(LA MOD 256);
NewLine
END ExtLA;
PROCEDURE Data2* (file: FILES.FILE; mem: CHL.BYTELIST; idx, cnt, LA: INTEGER);
PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER);
VAR
i, len, offset: INTEGER;
BEGIN
ExtLA(file, LA);
ExtLA(LA);
offset := 0;
WHILE cnt > 0 DO
ASSERT(offset <= 65536);
IF offset = 65536 THEN
INC(LA);
ExtLA(file, LA);
ExtLA(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);
StartCode;
Byte4(len, offset DIV 256, offset MOD 256, 0);
FOR i := 1 TO len DO
Byte(file, CHL.GetByte(mem, idx));
Byte(CHL.GetByte(mem, idx));
INC(idx);
INC(offset)
END;
DEC(cnt, len);
NewLine(file)
NewLine
END
END Data2;
PROCEDURE End* (file: FILES.FILE);
PROCEDURE End*;
BEGIN
StartCode(file);
Byte(file, 0);
Byte(file, 0);
Byte(file, 0);
Byte(file, 1);
NewLine(file)
StartCode;
Byte4(0, 0, 0, 1);
NewLine
END End;

/programs/develop/oberon07/Source/IL.ob07
7,14 → 7,11
MODULE IL;
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS;
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS;
CONST
little_endian* = 0;
big_endian* = 1;
call_stack* = 0;
call_win64* = 1;
call_sysv* = 2;
22,7 → 19,7
opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22;
opADD* = 17; opSUB* = 18; opONERR* = 19; opSUBL* = 20; opADDC* = 21; opSUBR* = 22;
opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28;
opNOT* = 29;
34,14 → 31,14
opVLOAD32* = 60; opGLOAD32* = 61;
opJNE* = 62; opJE* = 63;
opJZ* = 62; opJNZ* = 63;
opSAVE32* = 64; opLLOAD8* = 65;
opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71;
opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;
opUMINF* = 72; opSAVEFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;
opACC* = 77; opJG* = 78;
opJNZ1* = 77; opJG* = 78;
opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82;
opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
55,7 → 52,7
opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102;
opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106;
opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112;
opADDS* = 107; opSUBS* = 108; opERR* = 109; opSUBSL* = 110; opADDSC* = 111; opSUBSR* = 112;
opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116;
opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121;
65,27 → 62,26
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;
opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
opGETC* = 152; 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;
opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179;
opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opLENGTHW* = 179;
opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192;
opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192;
opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201;
opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216;
opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215;
opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221;
opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219;
opAND* = 220; opOR* = 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;
154,6 → 150,12
END;
FNAMECMD* = POINTER TO RECORD (COMMAND)
fname*: PATHS.PATH
END;
CMDSTACK = POINTER TO RECORD
data: ARRAY 1000 OF COMMAND;
192,7 → 194,7
endcall: CMDSTACK;
commands*: LISTS.LIST;
export*: LISTS.LIST;
import*: LISTS.LIST;
_import*: LISTS.LIST;
types*: CHL.INTLIST;
data*: CHL.BYTELIST;
dmin*: INTEGER;
204,7 → 206,6
charoffs: ARRAY 256 OF INTEGER;
wcharoffs: ARRAY 65536 OF INTEGER;
fregs: INTEGER;
wstr: ARRAY 4*1024 OF WCHAR
END;
212,7 → 213,7
VAR
codes*: CODES;
endianness, numRegsFloat, CPU: INTEGER;
CPU: INTEGER;
commands, variables: C.COLLECTION;
343,10 → 344,10
i := 0;
WHILE i < n DO
IF endianness = little_endian THEN
IF TARGETS.LittleEndian THEN
PutByte(ORD(codes.wstr[i]) MOD 256);
PutByte(ORD(codes.wstr[i]) DIV 256)
ELSIF endianness = big_endian THEN
ELSE
PutByte(ORD(codes.wstr[i]) DIV 256);
PutByte(ORD(codes.wstr[i]) MOD 256)
END;
373,10 → 374,10
INC(res)
END;
IF endianness = little_endian THEN
IF TARGETS.LittleEndian THEN
PutByte(c MOD 256);
PutByte(c DIV 256)
ELSIF endianness = big_endian THEN
ELSE
PutByte(c DIV 256);
PutByte(c MOD 256)
END;
410,19 → 411,19
END pop;
PROCEDURE pushBegEnd* (VAR beg, end: COMMAND);
PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND);
BEGIN
push(codes.begcall, beg);
push(codes.endcall, end);
push(codes.endcall, _end);
beg := codes.last;
end := beg.next(COMMAND)
_end := beg.next(COMMAND)
END pushBegEnd;
PROCEDURE popBegEnd* (VAR beg, end: COMMAND);
PROCEDURE popBegEnd* (VAR beg, _end: COMMAND);
BEGIN
beg := pop(codes.begcall);
end := pop(codes.endcall)
_end := pop(codes.endcall)
END popBegEnd;
494,6 → 495,9
ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
cur.param2 := param2 * cur.param2
ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
cur.param2 := param2 + cur.param2
ELSE
old_opcode := -1
END
631,10 → 635,10
prev := codes.last;
not := prev.opcode = opNOT;
IF not THEN
IF opcode = opJE THEN
opcode := opJNE
ELSIF opcode = opJNE THEN
opcode := opJE
IF opcode = opJNZ THEN
opcode := opJZ
ELSIF opcode = opJZ THEN
opcode := opJNZ
ELSE
not := FALSE
END
645,10 → 649,79
IF not THEN
delete(prev)
END
END AddJmpCmd;
PROCEDURE AndOrOpt* (VAR label: INTEGER);
VAR
cur, prev: COMMAND;
i, op, l: INTEGER;
jz, not: BOOLEAN;
BEGIN
cur := codes.last;
not := cur.opcode = opNOT;
IF not THEN
cur := cur.prev(COMMAND)
END;
IF cur.opcode = opAND THEN
op := opAND
ELSIF cur.opcode = opOR THEN
op := opOR
ELSE
op := -1
END;
cur := codes.last;
IF op # -1 THEN
IF not THEN
IF op = opAND THEN
op := opOR
ELSE (* op = opOR *)
op := opAND
END;
prev := cur.prev(COMMAND);
delete(cur);
cur := prev
END;
FOR i := 1 TO 9 DO
IF i = 8 THEN
l := cur.param1
ELSIF i = 9 THEN
jz := cur.opcode = opJZ
END;
prev := cur.prev(COMMAND);
delete(cur);
cur := prev
END;
setlast(cur);
IF op = opAND THEN
label := l;
jz := ~jz
END;
IF jz THEN
AddJmpCmd(opJZ, label)
ELSE
AddJmpCmd(opJNZ, label)
END;
IF op = opOR THEN
SetLabel(l)
END
ELSE
AddJmpCmd(opJZ, label)
END;
setlast(codes.last)
END AndOrOpt;
PROCEDURE OnError* (line, error: INTEGER);
BEGIN
AddCmd2(opONERR, codes.errlabels[error], line)
661,7 → 734,7
BEGIN
AddCmd(op, t);
label := NewLabel();
AddJmpCmd(opJE, label);
AddJmpCmd(opJNZ, label);
OnError(line, error);
SetLabel(label)
END TypeGuard;
685,14 → 758,6
END New;
PROCEDURE fcmp* (opcode: INTEGER);
BEGIN
AddCmd(opcode, 0);
DEC(codes.fregs, 2);
ASSERT(codes.fregs >= 0)
END fcmp;
PROCEDURE not*;
VAR
prev: COMMAND;
707,6 → 772,14
END not;
PROCEDURE _ord*;
BEGIN
IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN
AddCmd0(opORD)
END
END _ord;
PROCEDURE Enter* (label, params: INTEGER): COMMAND;
VAR
cmd: COMMAND;
900,44 → 973,10
AddCmd0(opSAVEFI)
ELSE
AddCmd0(opSAVEF)
END;
DEC(codes.fregs);
ASSERT(codes.fregs >= 0)
END
END savef;
PROCEDURE pushf*;
BEGIN
AddCmd0(opPUSHF);
DEC(codes.fregs);
ASSERT(codes.fregs >= 0)
END pushf;
PROCEDURE loadf* (): BOOLEAN;
BEGIN
AddCmd0(opLOADF);
INC(codes.fregs)
RETURN codes.fregs < numRegsFloat
END loadf;
PROCEDURE inf* (): BOOLEAN;
BEGIN
AddCmd0(opINF);
INC(codes.fregs)
RETURN codes.fregs < numRegsFloat
END inf;
PROCEDURE fbinop* (opcode: INTEGER);
BEGIN
AddCmd0(opcode);
DEC(codes.fregs);
ASSERT(codes.fregs > 0)
END fbinop;
PROCEDURE saves* (offset, length: INTEGER);
BEGIN
AddCmd2(opSAVES, length, offset)
954,22 → 993,6
END abs;
PROCEDURE floor*;
BEGIN
AddCmd0(opFLOOR);
DEC(codes.fregs);
ASSERT(codes.fregs >= 0)
END floor;
PROCEDURE flt* (): BOOLEAN;
BEGIN
AddCmd0(opFLT);
INC(codes.fregs)
RETURN codes.fregs < numRegsFloat
END flt;
PROCEDURE shift_minmax* (op: CHAR);
BEGIN
CASE op OF
1015,7 → 1038,7
END len;
PROCEDURE Float* (r: REAL);
PROCEDURE Float* (r: REAL; line, col: INTEGER);
VAR
cmd: COMMAND;
1023,45 → 1046,12
cmd := NewCmd();
cmd.opcode := opCONSTF;
cmd.float := r;
insert(codes.last, cmd);
INC(codes.fregs);
ASSERT(codes.fregs <= numRegsFloat)
cmd.param1 := line;
cmd.param2 := col;
insert(codes.last, cmd)
END Float;
PROCEDURE precall* (flt: BOOLEAN): INTEGER;
VAR
res: INTEGER;
BEGIN
res := codes.fregs;
AddCmd2(opPRECALL, ORD(flt), res);
codes.fregs := 0
RETURN res
END precall;
PROCEDURE resf* (fregs: INTEGER): BOOLEAN;
BEGIN
AddCmd(opRESF, fregs);
codes.fregs := fregs + 1
RETURN codes.fregs < numRegsFloat
END resf;
PROCEDURE res* (fregs: INTEGER);
BEGIN
AddCmd(opRES, fregs);
codes.fregs := fregs
END res;
PROCEDURE retf*;
BEGIN
DEC(codes.fregs);
ASSERT(codes.fregs = 0)
END retf;
PROCEDURE drop*;
BEGIN
AddCmd0(opDROP)
1068,7 → 1058,7
END drop;
PROCEDURE case* (a, b, L, R: INTEGER);
PROCEDURE _case* (a, b, L, R: INTEGER);
VAR
cmd: COMMAND;
1084,13 → 1074,19
AddCmd2(opCASEL, a, L);
AddCmd2(opCASER, b, R)
END
END case;
END _case;
PROCEDURE caset* (a, label: INTEGER);
PROCEDURE fname* (name: PATHS.PATH);
VAR
cmd: FNAMECMD;
BEGIN
AddCmd2(opCASET, label, a)
END caset;
NEW(cmd);
cmd.opcode := opFNAME;
cmd.fname := name;
insert(codes.last, cmd)
END fname;
PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
1111,7 → 1107,7
p: IMPORT_PROC;
BEGIN
lib := codes.import.first(IMPORT_LIB);
lib := codes._import.first(IMPORT_LIB);
WHILE (lib # NIL) & (lib.name # dll) DO
lib := lib.next(IMPORT_LIB)
END;
1120,7 → 1116,7
NEW(lib);
lib.name := dll;
lib.procs := LISTS.create(NIL);
LISTS.push(codes.import, lib)
LISTS.push(codes._import, lib)
END;
p := lib.procs.first(IMPORT_PROC);
1153,7 → 1149,7
lib := imp(IMPORT_PROC).lib;
LISTS.delete(lib.procs, imp);
IF lib.procs.first = NIL THEN
LISTS.delete(codes.import, lib)
LISTS.delete(codes._import, lib)
END
END
END DelImport;
1169,13 → 1165,6
variables := C.create();
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;
1183,7 → 1172,7
codes.endcall.top := -1;
codes.commands := LISTS.create(NIL);
codes.export := LISTS.create(NIL);
codes.import := LISTS.create(NIL);
codes._import := LISTS.create(NIL);
codes.types := CHL.CreateIntList();
codes.data := CHL.CreateByteList();
1195,8 → 1184,6
codes.lcount := 0;
codes.fregs := 0;
FOR i := 0 TO LEN(codes.charoffs) - 1 DO
codes.charoffs[i] := -1
END;

/programs/develop/oberon07/Source/KOS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
19,8 → 19,6
TYPE
FILE = WR.FILE;
HEADER = RECORD
menuet01: ARRAY 9 OF CHAR;
29,29 → 27,19
END;
PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
n := n + _align - (n MOD _align)
END
RETURN n
END align;
PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER);
VAR
i: INTEGER;
import: BIN.IMPRT;
imp: BIN.IMPRT;
BEGIN
libcount := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
imp := program.imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
INC(libcount)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
len := libcount * 2 + 2;
63,29 → 51,29
END;
i := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
imp := program.imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF import.label = 0 THEN
IF imp.label = 0 THEN
CHL.SetInt(ImportTable, len, 0);
INC(len);
CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD);
INC(i);
CHL.SetInt(ImportTable, i, import.nameoffs + size + idata);
CHL.SetInt(ImportTable, i, imp.nameoffs + size + idata);
INC(i)
ELSE
CHL.SetInt(ImportTable, len, import.nameoffs + size + idata);
import.label := len * SIZE_OF_DWORD;
CHL.SetInt(ImportTable, len, imp.nameoffs + size + idata);
imp.label := len * SIZE_OF_DWORD;
INC(len)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
CHL.SetInt(ImportTable, len, 0);
CHL.SetInt(ImportTable, i, 0);
CHL.SetInt(ImportTable, i + 1, 0);
INC(len);
size := size + CHL.Length(program.import)
INC(size, CHL.Length(program._import))
END Import;
100,7 → 88,7
VAR
header: HEADER;
base, text, data, idata, bss: INTEGER;
base, text, data, idata, bss, offset: INTEGER;
reloc: BIN.RELOC;
iproc: BIN.IMPRT;
109,8 → 97,6
i: INTEGER;
File: FILE;
ImportTable: CHL.INTLIST;
ILen, libcount, isize: INTEGER;
121,23 → 107,23
BEGIN
base := 0;
icount := CHL.Length(program.import);
icount := CHL.Length(program._import);
dcount := CHL.Length(program.data);
ccount := CHL.Length(program.code);
text := base + HEADER_SIZE;
data := align(text + ccount, FileAlignment);
idata := align(data + dcount, FileAlignment);
data := WR.align(text + ccount, FileAlignment);
idata := WR.align(data + dcount, FileAlignment);
Import(program, idata, ImportTable, ILen, libcount, isize);
bss := align(idata + isize, FileAlignment);
bss := WR.align(idata + isize, FileAlignment);
header.menuet01 := "MENUET01";
header.ver := 1;
header.start := text;
header.size := idata + isize - base;
header.mem := align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment);
header.mem := WR.align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment);
header.sp := base + header.mem - PARAM_SIZE * 2;
header.param := header.sp;
header.path := header.param + PARAM_SIZE;
146,73 → 132,74
reloc := program.rel_list.first(BIN.RELOC);
WHILE reloc # NIL DO
L := BIN.get32le(code, reloc.offset);
delta := 3 - reloc.offset - text;
offset := reloc.offset;
L := BIN.get32le(code, offset);
delta := 3 - offset - text;
CASE reloc.opcode OF
|BIN.RIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(code, reloc.offset, idata + iproc.label)
delta := idata + iproc.label
|BIN.RBSS:
BIN.put32le(code, reloc.offset, L + bss)
delta := L + bss
|BIN.RDATA:
BIN.put32le(code, reloc.offset, L + data)
delta := L + data
|BIN.RCODE:
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text)
delta := BIN.GetLabel(program, L) + text
|BIN.PICDATA:
BIN.put32le(code, reloc.offset, L + data + delta)
INC(delta, L + data)
|BIN.PICCODE:
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta)
INC(delta, BIN.GetLabel(program, L) + text)
|BIN.PICBSS:
BIN.put32le(code, reloc.offset, L + bss + delta)
INC(delta, L + bss)
|BIN.PICIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(code, reloc.offset, idata + iproc.label + delta)
INC(delta, idata + iproc.label)
|BIN.IMPTAB:
BIN.put32le(code, reloc.offset, idata + delta)
INC(delta, idata)
END;
BIN.put32le(code, offset, delta);
reloc := reloc.next(BIN.RELOC)
END;
File := WR.Create(FileName);
WR.Create(FileName);
FOR i := 0 TO 7 DO
WR.WriteByte(File, ORD(header.menuet01[i]))
WR.WriteByte(ORD(header.menuet01[i]))
END;
WR.Write32LE(File, header.ver);
WR.Write32LE(File, header.start);
WR.Write32LE(File, header.size);
WR.Write32LE(File, header.mem);
WR.Write32LE(File, header.sp);
WR.Write32LE(File, header.param);
WR.Write32LE(File, header.path);
WR.Write32LE(header.ver);
WR.Write32LE(header.start);
WR.Write32LE(header.size);
WR.Write32LE(header.mem);
WR.Write32LE(header.sp);
WR.Write32LE(header.param);
WR.Write32LE(header.path);
CHL.WriteToFile(File, code);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(code);
WR.Padding(FileAlignment);
CHL.WriteToFile(File, program.data);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(program.data);
WR.Padding(FileAlignment);
FOR i := 0 TO ILen - 1 DO
WR.Write32LE(File, CHL.GetInt(ImportTable, i))
WR.Write32LE(CHL.GetInt(ImportTable, i))
END;
CHL.WriteToFile(File, program.import);
CHL.WriteToFile(program._import);
WR.Close(File)
WR.Close
END write;

/programs/develop/oberon07/Source/LISTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
32,17 → 32,14
IF list.first = NIL THEN
list.first := item;
list.last := item;
item.prev := NIL;
item.next := NIL
item.prev := NIL
ELSE
ASSERT(list.last # NIL);
item.prev := list.last;
list.last.next := item;
item.next := NIL;
list.last := item
END
list.last.next := item
END;
list.last := item;
item.next := NIL
END push;
108,16 → 105,13
IF prev # NIL THEN
prev.next := nov;
nov.prev := prev;
cur.prev := nov;
nov.next := cur
nov.prev := prev
ELSE
nov.prev := NIL;
list.first := nov
END;
cur.prev := nov;
nov.next := cur;
list.first := nov
END
nov.next := cur
END insertL;

/programs/develop/oberon07/Source/MSCOFF.ob07
28,28 → 28,30
SH = PE32.IMAGE_SECTION_HEADER;
PROCEDURE WriteReloc (File: WR.FILE; VirtualAddress, SymbolTableIndex, Type: INTEGER);
PROCEDURE WriteReloc (VirtualAddress, SymbolTableIndex, Type: INTEGER);
BEGIN
WR.Write32LE(File, VirtualAddress);
WR.Write32LE(File, SymbolTableIndex);
WR.Write16LE(File, Type)
WR.Write32LE(VirtualAddress);
WR.Write32LE(SymbolTableIndex);
WR.Write16LE(Type)
END WriteReloc;
PROCEDURE Reloc (program: BIN.PROGRAM; File: WR.FILE);
PROCEDURE Reloc (program: BIN.PROGRAM);
VAR
reloc: BIN.RELOC;
offset: INTEGER;
BEGIN
reloc := program.rel_list.first(BIN.RELOC);
WHILE reloc # NIL DO
offset := reloc.offset;
CASE reloc.opcode OF
|BIN.RIMP,
BIN.IMPTAB: WriteReloc(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.IMPTAB: WriteReloc(offset, 4, 6)
|BIN.RBSS: WriteReloc(offset, 5, 6)
|BIN.RDATA: WriteReloc(offset, 2, 6)
|BIN.RCODE: WriteReloc(offset, 1, 6)
END;
reloc := reloc.next(BIN.RELOC)
62,6 → 64,7
reloc: BIN.RELOC;
iproc: BIN.IMPRT;
res, L: INTEGER;
offset: INTEGER;
code: CHL.BYTELIST;
BEGIN
71,16 → 74,17
WHILE reloc # NIL DO
INC(res);
offset := reloc.offset;
IF reloc.opcode = BIN.RIMP THEN
L := BIN.get32le(code, reloc.offset);
L := BIN.get32le(code, offset);
iproc := BIN.GetIProc(program, L);
BIN.put32le(code, reloc.offset, iproc.label)
BIN.put32le(code, offset, iproc.label)
END;
IF reloc.opcode = BIN.RCODE THEN
L := BIN.get32le(code, reloc.offset);
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L))
L := BIN.get32le(code, offset);
BIN.put32le(code, offset, BIN.GetLabel(program, L))
END;
reloc := reloc.next(BIN.RELOC)
92,7 → 96,6
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER);
VAR
File: WR.FILE;
exp: BIN.EXPRT;
n, i: INTEGER;
145,7 → 148,7
KOS.Import(program, 0, ImportTable, ILen, LibCount, isize);
ExpCount := LISTS.count(program.exp_list);
icount := CHL.Length(program.import);
icount := CHL.Length(program._import);
dcount := CHL.Length(program.data);
ccount := CHL.Length(program.code);
ecount := CHL.Length(program.export);
219,91 → 222,87
FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10;
File := WR.Create(FileName);
WR.Create(FileName);
PE32.WriteFileHeader(File, FileHeader);
PE32.WriteFileHeader(FileHeader);
PE32.WriteSectionHeader(File, flat);
PE32.WriteSectionHeader(File, data);
PE32.WriteSectionHeader(File, edata);
PE32.WriteSectionHeader(File, idata);
PE32.WriteSectionHeader(File, bss);
PE32.WriteSectionHeader(flat);
PE32.WriteSectionHeader(data);
PE32.WriteSectionHeader(edata);
PE32.WriteSectionHeader(idata);
PE32.WriteSectionHeader(bss);
CHL.WriteToFile(File, program.code);
CHL.WriteToFile(File, program.data);
CHL.WriteToFile(program.code);
CHL.WriteToFile(program.data);
exp := program.exp_list.first(BIN.EXPRT);
WHILE exp # NIL DO
WR.Write32LE(File, exp.nameoffs + edata.SizeOfRawData - ecount);
WR.Write32LE(File, exp.label);
WR.Write32LE(exp.nameoffs + edata.SizeOfRawData - ecount);
WR.Write32LE(exp.label);
exp := exp.next(BIN.EXPRT)
END;
WR.Write32LE(File, ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD);
WR.Write32LE(File, ver);
WR.Write32LE(((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD);
WR.Write32LE(ver);
WR.Write32LE(File, 0);
WR.Write32LE(0);
PE32.WriteName(File, szversion);
CHL.WriteToFile(File, program.export);
PE32.WriteName(szversion);
CHL.WriteToFile(program.export);
FOR i := 0 TO ILen - 1 DO
WR.Write32LE(File, CHL.GetInt(ImportTable, i))
WR.Write32LE(CHL.GetInt(ImportTable, i))
END;
CHL.WriteToFile(File, program.import);
CHL.WriteToFile(program._import);
Reloc(program, File);
Reloc(program);
n := 0;
exp := program.exp_list.first(BIN.EXPRT);
WHILE exp # NIL DO
WriteReloc(File, n, 3, 6);
WriteReloc(n, 3, 6);
INC(n, 4);
WriteReloc(File, n, 1, 6);
WriteReloc(n, 1, 6);
INC(n, 4);
exp := exp.next(BIN.EXPRT)
END;
WriteReloc(File, n, 3, 6);
WriteReloc(n, 3, 6);
i := 0;
WHILE i < LibCount * 2 DO
WriteReloc(File, i * SIZE_OF_DWORD, 4, 6);
INC(i);
WriteReloc(File, i * SIZE_OF_DWORD, 4, 6);
INC(i)
FOR i := 0 TO LibCount * 2 - 1 DO
WriteReloc(i * SIZE_OF_DWORD, 4, 6)
END;
FOR i := LibCount * 2 TO ILen - 1 DO
IF CHL.GetInt(ImportTable, i) # 0 THEN
WriteReloc(File, i * SIZE_OF_DWORD, 4, 6)
WriteReloc(i * SIZE_OF_DWORD, 4, 6)
END
END;
PE32.WriteName(File, "EXPORTS");
WriteReloc(File, 0, 3, 2);
PE32.WriteName("EXPORTS");
WriteReloc(0, 3, 2);
PE32.WriteName(File, ".flat");
WriteReloc(File, 0, 1, 3);
PE32.WriteName(".flat");
WriteReloc(0, 1, 3);
PE32.WriteName(File, ".data");
WriteReloc(File, 0, 2, 3);
PE32.WriteName(".data");
WriteReloc(0, 2, 3);
PE32.WriteName(File, ".edata");
WriteReloc(File, 0, 3, 3);
PE32.WriteName(".edata");
WriteReloc(0, 3, 3);
PE32.WriteName(File, ".idata");
WriteReloc(File, 0, 4, 3);
PE32.WriteName(".idata");
WriteReloc(0, 4, 3);
PE32.WriteName(File, ".bss");
WriteReloc(File, 0, 5, 3);
PE32.WriteName(".bss");
WriteReloc(0, 5, 3);
WR.Write32LE(File, 4);
WR.Write32LE(4);
WR.Close(File)
WR.Close
END write;

/programs/develop/oberon07/Source/MSP430.ob07
421,8 → 421,7
PROCEDURE xchg (reg1, reg2: INTEGER);
BEGIN
Push(reg1);
Push(reg2);
Pop(reg1);
mov(reg1, reg2);
Pop(reg2)
END xchg;
819,7 → 818,7
Op2(opADD, reg2 * 256, reg1);
drop
|IL.opADDL, IL.opADDR:
|IL.opADDC:
IF param2 # 0 THEN
UnOp(reg1);
Op2(opADD, imm(param2), reg1)
880,10 → 879,10
cc := cond(opcode);
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
IF next.opcode = IL.opJNZ THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
ELSIF next.opcode = IL.opJZ THEN
jcc(ORD(BITS(cc) / {0}), next.param1);
cmd := next
ELSE
890,45 → 889,32
setcc(cc, GetAnyReg())
END
|IL.opNOP:
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opCODE:
EmitWord(param2)
|IL.opACC:
IF (R.top # 0) OR (R.stk[0] # ACC) THEN
PushAll(0);
GetRegA;
Pop(ACC);
DEC(R.pushed)
END
|IL.opDROP:
UnOp(reg1);
drop
|IL.opJNZ:
|IL.opJNZ1:
UnOp(reg1);
Test(reg1);
jcc(jne, param1)
|IL.opJZ:
UnOp(reg1);
Test(reg1);
jcc(je, param1)
|IL.opJG:
UnOp(reg1);
Test(reg1);
jcc(jg, param1)
|IL.opJE:
|IL.opJNZ:
UnOp(reg1);
Test(reg1);
jcc(jne, param1);
drop
|IL.opJNE:
|IL.opJZ:
UnOp(reg1);
Test(reg1);
jcc(je, param1);
958,6 → 944,11
drop;
Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2))
|IL.opCHKBYTE:
BinOp(reg1, reg2);
Op2(opCMP, imm(256), reg1);
jcc(jb, param1)
|IL.opCHKIDX:
UnOp(reg1);
Op2(opCMP, imm(param2), reg1);
1079,7 → 1070,7
Op2(opBIC, reg2 * 256, reg1);
drop
|IL.opADDSL, IL.opADDSR:
|IL.opADDSC:
UnOp(reg1);
Op2(opBIS, imm(param2), reg1)
1189,11 → 1180,6
INCL(R.regs, reg1);
ASSERT(REG.GetReg(R, reg1))
|IL.opCHKBYTE:
BinOp(reg1, reg2);
Op2(opCMP, imm(256), reg1);
jcc(jb, param1)
|IL.opLSL, IL.opASR, IL.opROR, IL.opLSR:
PushAll(2);
CASE opcode OF
1618,7 → 1604,7
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER;
i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER;
Code, Data, Bss, Free: RECORD address, size: INTEGER END;
1626,8 → 1612,6
reloc: RELOC;
file: WR.FILE;
BEGIN
IdxWords.src := NOWORD;
IdxWords.dst := NOWORD;
1687,10 → 1671,11
reloc := RelList.first(RELOC);
WHILE reloc # NIL DO
adr := reloc.WordPtr.offset * 2;
val := reloc.WordPtr.val;
CASE reloc.section OF
|RCODE: PutWord(LabelOffs(reloc.WordPtr.val) * 2, adr)
|RDATA: PutWord(reloc.WordPtr.val + Data.address, adr)
|RBSS: PutWord(reloc.WordPtr.val + Bss.address, adr)
|RCODE: PutWord(LabelOffs(val) * 2, adr)
|RDATA: PutWord(val + Data.address, adr)
|RBSS: PutWord(val + Bss.address, adr)
END;
reloc := reloc.next(RELOC)
END;
1733,13 → 1718,13
PutWord(LabelOffs(IV[i]) * 2, adr)
END;
file := WR.Create(outname);
WR.Create(outname);
HEX.Data(file, mem, Code.address, TextSize);
HEX.Data(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
HEX.End(file);
HEX.Data(mem, Code.address, TextSize);
HEX.Data(mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
HEX.End;
WR.Close(file);
WR.Close;
INC(TextSize, IntVectorSize + TypesSize);
INC(Bss.size, minStackSize + RTL.VarSize);

/programs/develop/oberon07/Source/PARS.ob07
34,7 → 34,7
EXPR* = RECORD
obj*: INTEGER;
type*: PROG.TYPE_;
_type*: PROG._TYPE;
value*: ARITH.VALUE;
stproc*: INTEGER;
readOnly*: BOOLEAN;
44,7 → 44,7
STATPROC = PROCEDURE (parser: PARSER);
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG._TYPE; pos: POSITION): BOOLEAN;
rPARSER = RECORD (C.ITEM)
74,8 → 74,6
VAR
program*: PROG.PROGRAM;
parsers: C.COLLECTION;
lines*, modules: INTEGER;
133,10 → 131,10
BEGIN
SCAN.Next(parser.scanner, parser.lex);
errno := parser.lex.error;
IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN
IF parser.lex.sym = SCAN.lxFLOAT THEN
IF errno = 0 THEN
IF (TARGETS.RealSize = 0) & (parser.lex.sym = SCAN.lxFLOAT) THEN
errno := -SCAN.lxERROR13
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
ELSIF (TARGETS.BitDepth = 16) & (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
errno := -SCAN.lxERROR10
END
END;
184,7 → 182,6
|SCAN.lxSEMI: err := 24
|SCAN.lxRETURN: err := 38
|SCAN.lxMODULE: err := 21
|SCAN.lxSTRING: err := 66
END;
check1(FALSE, parser, err)
227,7 → 224,7
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE;
unit := PROG.getUnit(program, name);
unit := PROG.getUnit(name);
IF unit # NIL THEN
check(unit.closed, pos, 31)
250,7 → 247,7
unit := parser2.unit;
destroy(parser2)
END;
IF unit = program.sysunit THEN
IF unit = PROG.program.sysunit THEN
parser.unit.sysimport := TRUE
END;
ident.unit := unit
350,7 → 347,7
END ConstExpression;
PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
PROCEDURE FieldList (parser: PARSER; rec: PROG._TYPE);
VAR
name: SCAN.IDENT;
export: BOOLEAN;
387,18 → 384,18
END FieldList;
PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
PROCEDURE FormalParameters (parser: PARSER; _type: PROG._TYPE);
VAR
ident: PROG.IDENT;
PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
PROCEDURE FPSection (parser: PARSER; _type: PROG._TYPE);
VAR
ident: PROG.IDENT;
exit: BOOLEAN;
vPar: BOOLEAN;
dim: INTEGER;
t0, t1: PROG.TYPE_;
t0, t1: PROG._TYPE;
BEGIN
vPar := parser.sym = SCAN.lxVAR;
410,7 → 407,7
exit := FALSE;
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
check1(PROG.addParam(_type, parser.lex.ident, vPar), parser, 30);
Next(parser);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
427,17 → 424,17
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
t0 := ident.type;
t0 := ident._type;
t1 := t0;
WHILE dim > 0 DO
t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
t1 := PROG.enterType(PROG.tARRAY, -1, 0, parser.unit);
t1.base := t0;
t0 := t1;
DEC(dim)
END;
PROG.setParams(type, t1);
PROG.setParams(_type, t1);
Next(parser);
exit := TRUE
ELSE
454,10 → 451,10
Next(parser);
IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
FPSection(parser, type);
FPSection(parser, _type);
WHILE parser.sym = SCAN.lxSEMI DO
Next(parser);
FPSection(parser, type)
FPSection(parser, _type)
END
END;
468,12 → 465,12
ExpectSym(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
type.base := ident.type;
check1(~(ident._type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
check1( ~(ODD(_type.call) & (ident._type.typ = PROG.tREAL)), parser, 113);
_type.base := ident._type;
Next(parser)
ELSE
type.base := NIL
_type.base := NIL
END
END
503,6 → 500,8
sf := PROG.sf_linux
ELSIF parser.lex.s = "code" THEN
sf := PROG.sf_code
ELSIF parser.lex.s = "oberon" THEN
sf := PROG.sf_oberon
ELSIF parser.lex.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
509,7 → 508,7
check1(FALSE, parser, 124)
END;
check1(sf IN program.sysflags, parser, 125);
check1(sf IN PROG.program.sysflags, parser, 125);
IF proc THEN
check1(sf IN PROG.proc_flags, parser, 123)
532,6 → 531,12
res := PROG.systemv
|PROG.sf_code:
res := PROG.code
|PROG.sf_oberon:
IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
res := PROG.default32
ELSIF TARGETS.OS IN {TARGETS.osWIN64, TARGETS.osLINUX64} THEN
res := PROG.default64
END
|PROG.sf_windows:
IF TARGETS.OS = TARGETS.osWIN32 THEN
res := PROG.stdcall
552,16 → 557,34
END sysflag;
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
dll, proc: SCAN.LEXSTR;
pos: POSITION;
PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR);
VAR
pos: POSITION;
str: ARITH.VALUE;
BEGIN
getpos(parser, pos);
ConstExpression(parser, str);
IF str.typ = ARITH.tSTRING THEN
name := str.string(SCAN.IDENT).s
ELSIF str.typ = ARITH.tCHAR THEN
ARITH.charToStr(str, name)
ELSE
check(FALSE, pos, 117)
END
END getStr;
import := NIL;
BEGIN
_import := NIL;
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos);
check1(parser.unit.sysimport, parser, 54);
572,34 → 595,32
Next(parser);
INC(call)
END;
IF ~isProc THEN
checklex(parser, SCAN.lxRSQUARE)
END;
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxSTRING);
dll := parser.lex.s;
IF isProc & (parser.sym = SCAN.lxCOMMA) THEN
Next(parser);
getStr(parser, dll);
STRINGS.UpCase(dll);
ExpectSym(parser, SCAN.lxCOMMA);
ExpectSym(parser, SCAN.lxSTRING);
proc := parser.lex.s;
checklex(parser, SCAN.lxCOMMA);
Next(parser);
import := IL.AddImp(dll, proc)
getStr(parser, proc);
_import := IL.AddImp(dll, proc)
END;
checklex(parser, SCAN.lxRSQUARE);
Next(parser)
ELSE
CASE TARGETS.BitDepth OF
|16: call := PROG.default16
|32: IF TARGETS.target = TARGETS.STM32CM3 THEN
|32: IF TARGETS.CPU = TARGETS.cpuX86 THEN
call := PROG.default32
ELSE
call := PROG.ccall
ELSE
call := PROG.default32
END
|64: call := PROG.default64
END
END;
IF import # NIL THEN
IF _import # NIL THEN
check(TARGETS.Import, pos, 70)
END
607,7 → 628,7
END procflag;
PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET);
PROCEDURE _type (parser: PARSER; VAR t: PROG._TYPE; flags: SET);
CONST
comma = 0;
closed = 1;
619,11 → 640,11
ident: PROG.IDENT;
unit: PROG.UNIT;
pos, pos2: POSITION;
fieldType: PROG.TYPE_;
fieldType: PROG._TYPE;
baseIdent: SCAN.IDENT;
a, b: INTEGER;
RecFlag: INTEGER;
import: IL.IMPORT_PROC;
_import: IL.IMPORT_PROC;
BEGIN
unit := parser.unit;
634,7 → 655,7
IF ident # NIL THEN
check1(ident.typ = PROG.idTYPE, parser, 49);
t := ident.type;
t := ident._type;
check1(t # NIL, parser, 50);
IF closed IN flags THEN
check1(t.closed, parser, 50)
656,13 → 677,13
check(ARITH.check(arrLen), pos, 39);
check(ARITH.getInt(arrLen) > 0, pos, 51);
t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
t := PROG.enterType(PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
IF parser.sym = SCAN.lxCOMMA THEN
type(parser, t.base, {comma, closed})
_type(parser, t.base, {comma, closed})
ELSIF parser.sym = SCAN.lxOF THEN
Next(parser);
type(parser, t.base, {closed})
_type(parser, t.base, {closed})
ELSE
check1(FALSE, parser, 47)
END;
681,7 → 702,7
getpos(parser, pos2);
Next(parser);
t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
t := PROG.enterType(PROG.tRECORD, 0, 0, unit);
t.align := 1;
IF parser.sym = SCAN.lxLSQUARE THEN
698,7 → 719,7
ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos);
type(parser, t.base, {closed});
_type(parser, t.base, {closed});
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
717,7 → 738,7
t.align := t.base.align
END
ELSE
t.base := program.stTypes.tANYREC
t.base := PROG.program.stTypes.tANYREC
END;
WHILE parser.sym = SCAN.lxIDENT DO
726,7 → 747,7
ASSERT(parser.sym = SCAN.lxCOLON);
Next(parser);
type(parser, fieldType, {closed});
_type(parser, fieldType, {closed});
check(PROG.setFields(t, fieldType), pos2, 104);
IF (fieldType.align > t.align) & ~t.noalign THEN
756,7 → 777,7
ExpectSym(parser, SCAN.lxTO);
Next(parser);
t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit);
t := PROG.enterType(PROG.tPOINTER, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
getpos(parser, pos);
765,7 → 786,7
baseIdent := parser.lex.ident
END;
type(parser, t.base, {forward});
_type(parser, t.base, {forward});
IF t.base # NIL THEN
check(t.base.typ = PROG.tRECORD, pos, 58)
775,15 → 796,15
ELSIF parser.sym = SCAN.lxPROCEDURE THEN
NextPos(parser, pos);
t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
t.call := procflag(parser, import, FALSE);
t.call := procflag(parser, _import, FALSE);
FormalParameters(parser, t)
ELSE
check1(FALSE, parser, 49)
END
END type;
END _type;
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
811,7 → 832,7
END IdentDef;
PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
PROCEDURE ConstTypeDeclaration (parser: PARSER; _const: BOOLEAN);
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
818,7 → 839,7
pos: POSITION;
BEGIN
IF const THEN
IF _const THEN
ident := IdentDef(parser, PROG.idNONE, name)
ELSE
ident := IdentDef(parser, PROG.idTYPE, name)
827,7 → 848,7
checklex(parser, SCAN.lxEQ);
NextPos(parser, pos);
IF const THEN
IF _const THEN
ConstExpression(parser, ident.value);
IF ident.value.typ = ARITH.tINTEGER THEN
check(ARITH.check(ident.value), pos, 39)
835,9 → 856,9
check(ARITH.check(ident.value), pos, 40)
END;
ident.typ := PROG.idCONST;
ident.type := PROG.getType(program, ident.value.typ)
ident._type := PROG.getType(ident.value.typ)
ELSE
type(parser, ident.type, {})
_type(parser, ident._type, {})
END;
checklex(parser, SCAN.lxSEMI);
850,7 → 871,7
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
t: PROG.TYPE_;
t: PROG._TYPE;
BEGIN
861,7 → 882,7
ExpectSym(parser, SCAN.lxIDENT)
ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser);
type(parser, t, {});
_type(parser, t, {});
PROG.setVarsType(parser.unit, t);
checklex(parser, SCAN.lxSEMI);
Next(parser)
895,8 → 916,8
label: INTEGER;
enter: IL.COMMAND;
call: INTEGER;
t: PROG.TYPE_;
import: IL.IMPORT_PROC;
t: PROG._TYPE;
_import: IL.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
variables: LISTS.LIST;
912,16 → 933,19
unit := parser.unit;
call := procflag(parser, import, TRUE);
call := procflag(parser, _import, TRUE);
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
IF import # NIL THEN
IF _import # NIL THEN
proc := IdentDef(parser, PROG.idIMP, name);
proc.import := import;
program.procs.last(PROG.PROC).import := import
proc._import := _import;
IF _import.name = "" THEN
_import.name := name.s
END;
PROG.program.procs.last(PROG.PROC)._import := _import
ELSE
proc := IdentDef(parser, PROG.idPROC, name)
END;
928,8 → 952,8
check(PROG.openScope(unit, proc.proc), pos, 116);
proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc.type;
proc._type := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc._type;
t.align := TARGETS.AdrSize;
t.call := call;
959,7 → 983,7
WHILE param # NIL DO
ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
ASSERT(ident # NIL);
ident.type := param.type;
ident._type := param._type;
ident.offset := param.offset;
IF param.vPar THEN
ident.typ := PROG.idVPAR
967,7 → 991,7
param := param.next(PROG.PARAM)
END;
IF import = NIL THEN
IF _import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label;
proc.proc.used := handler;
983,10 → 1007,11
getpos(parser, pos2);
ConstExpression(parser, code);
check(code.typ = ARITH.tINTEGER, pos2, 43);
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)
IF TARGETS.WordSize > TARGETS.InstrSize THEN
CASE TARGETS.InstrSize OF
|1: check(ARITH.range(code, 0, 255), pos, 42)
|2: check(ARITH.range(code, 0, 65535), pos, 110)
END
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
1001,7 → 1026,7
checklex(parser, SCAN.lxSEMI);
Next(parser);
IF import = NIL THEN
IF _import = NIL THEN
IF parser.main & proc.export & TARGETS.Dll THEN
IF TARGETS.target = TARGETS.KolibriOSDLL THEN
1015,13 → 1040,13
b := DeclarationSequence(parser)
END;
program.locsize := 0;
PROG.ResetLocSize;
IF call IN {PROG._win64, PROG.win64} THEN
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
fparams := PROG.getFloatParamsPos(proc._type, 3, int, flt);
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc._type.parSize, 4))
ELSIF call IN {PROG._systemv, PROG.systemv} THEN
fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
fparams := PROG.getFloatParamsPos(proc._type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc._type.parSize))
ELSIF codeProc THEN
ELSE
1042,9 → 1067,9
END;
IF ~codeProc THEN
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), PROG.program.locsize,
t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
enter.param2 := program.locsize;
enter.param2 := PROG.program.locsize;
checklex(parser, SCAN.lxEND)
ELSE
proc.proc.leave := IL.LeaveC()
1051,15 → 1076,16
END;
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63)
check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
END
END;
IF parser.sym = SCAN.lxEND THEN
ExpectSym(parser, SCAN.lxIDENT);
Next(parser);
IF parser.sym = SCAN.lxIDENT THEN
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
check(endname = name, pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
1075,9 → 1101,14
error(pos, 60)
END
END
ELSIF parser.sym = SCAN.lxSEMI THEN
Next(parser)
ELSE
checklex(parser, SCAN.lxIDENT)
END
END;
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
variables := LISTS.create(NIL);
ELSE
variables := NIL
1085,7 → 1116,7
PROG.closeScope(unit, variables);
IF ~codeProc & (import = NIL) THEN
IF ~codeProc & (_import = NIL) THEN
enter.variables := variables
END
1157,7 → 1188,7
check1(parser.lex.s = parser.modname, parser, 23)
END;
unit := PROG.newUnit(program, parser.lex.ident);
unit := PROG.newUnit(parser.lex.ident);
parser.unit := unit;
1171,9 → 1202,7
INC(modules);
CONSOLE.String("compiling ");
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ")
END;
CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ");
CONSOLE.String(unit.name.s);
IF parser.unit.sysimport THEN
CONSOLE.String(" (SYSTEM)")
1180,6 → 1209,10
END;
CONSOLE.Ln;
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
IL.fname(parser.fname)
END;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
1189,9 → 1222,7
IL.SetLabel(errlabel);
IL.StrAdr(name);
IL.Param1;
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
IL.AddCmd(IL.opPUSHC, modules)
END;
IL.AddCmd(IL.opPUSHC, modules);
IL.AddCmd0(IL.opERR);
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
1285,7 → 1316,7
PROCEDURE init* (options: PROG.OPTIONS);
BEGIN
program := PROG.create(options);
PROG.create(options);
parsers := C.create();
lines := 0;
modules := 0

/programs/develop/oberon07/Source/PE32.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
102,15 → 102,6
END;
IMAGE_NT_HEADERS = RECORD
Signature: ARRAY 4 OF BYTE;
FileHeader: IMAGE_FILE_HEADER;
OptionalHeader: IMAGE_OPTIONAL_HEADER
END;
IMAGE_SECTION_HEADER* = RECORD
Name*: NAME;
147,35 → 138,33
END;
VIRTUAL_ADDR = RECORD
VIRTUAL_ADDR* = RECORD
Code, Data, Bss, Import: INTEGER
Code*, Data*, Bss*, Import*: INTEGER
END;
FILE = WR.FILE;
VAR
Signature: ARRAY 4 OF BYTE;
FileHeader: IMAGE_FILE_HEADER;
OptionalHeader: IMAGE_OPTIONAL_HEADER;
VAR
msdos: ARRAY 128 OF BYTE;
PEHeader: IMAGE_NT_HEADERS;
SectionHeaders: ARRAY 16 OF IMAGE_SECTION_HEADER;
Relocations: LISTS.LIST;
bit64: BOOLEAN;
libcnt: INTEGER;
SizeOfWord: INTEGER;
PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER;
PROCEDURE Export (program: BIN.PROGRAM; name: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER;
BEGIN
ExportDir.Characteristics := 0;
ExportDir.TimeDateStamp := PEHeader.FileHeader.TimeDateStamp;
ExportDir.TimeDateStamp := FileHeader.TimeDateStamp;
ExportDir.MajorVersion := 0X;
ExportDir.MinorVersion := 0X;
ExportDir.Name := program.modname + DataRVA;
ExportDir.Name := name;
ExportDir.Base := 0;
ExportDir.NumberOfFunctions := LISTS.count(program.exp_list);
ExportDir.NumberOfNames := ExportDir.NumberOfFunctions;
187,27 → 176,17
END Export;
PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
n := n + _align - (n MOD _align)
END
RETURN n
END align;
PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER;
VAR
import: BIN.IMPRT;
imp: BIN.IMPRT;
res: INTEGER;
BEGIN
res := 0;
import := lib.next(BIN.IMPRT);
WHILE (import # NIL) & (import.label # 0) DO
imp := lib.next(BIN.IMPRT);
WHILE (imp # NIL) & (imp.label # 0) DO
INC(res);
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END
RETURN res
216,7 → 195,7
PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER;
VAR
import: BIN.IMPRT;
imp: BIN.IMPRT;
proccnt: INTEGER;
procoffs: INTEGER;
OriginalCurrentThunk,
225,33 → 204,33
BEGIN
libcnt := 0;
proccnt := 0;
import := imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
imp := imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
INC(libcnt)
ELSE
INC(proccnt)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END;
procoffs := 0;
import := imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
import.OriginalFirstThunk := procoffs;
import.FirstThunk := procoffs + (GetProcCount(import) + 1);
OriginalCurrentThunk := import.OriginalFirstThunk;
CurrentThunk := import.FirstThunk;
procoffs := procoffs + (GetProcCount(import) + 1) * 2
imp := imp_list.first(BIN.IMPRT);
WHILE imp # NIL DO
IF imp.label = 0 THEN
imp.OriginalFirstThunk := procoffs;
imp.FirstThunk := procoffs + (GetProcCount(imp) + 1);
OriginalCurrentThunk := imp.OriginalFirstThunk;
CurrentThunk := imp.FirstThunk;
INC(procoffs, (GetProcCount(imp) + 1) * 2)
ELSE
import.OriginalFirstThunk := OriginalCurrentThunk;
import.FirstThunk := CurrentThunk;
imp.OriginalFirstThunk := OriginalCurrentThunk;
imp.FirstThunk := CurrentThunk;
INC(OriginalCurrentThunk);
INC(CurrentThunk)
END;
import := import.next(BIN.IMPRT)
imp := imp.next(BIN.IMPRT)
END
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord
258,40 → 237,40
END GetImportSize;
PROCEDURE fixup (program: BIN.PROGRAM; Address: VIRTUAL_ADDR);
PROCEDURE fixup* (program: BIN.PROGRAM; Address: VIRTUAL_ADDR; amd64: BOOLEAN);
VAR
reloc: BIN.RELOC;
iproc: BIN.IMPRT;
code: CHL.BYTELIST;
L, delta, delta0, AdrImp: INTEGER;
L, delta, delta0, AdrImp, offset: 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);
delta0 := 3 - 7 * ORD(amd64) - Address.Code;
WHILE reloc # NIL DO
L := BIN.get32le(code, reloc.offset);
delta := delta0 - reloc.offset - Address.Code;
offset := reloc.offset;
L := BIN.get32le(code, offset);
delta := delta0 - offset;
CASE reloc.opcode OF
|BIN.PICDATA:
BIN.put32le(code, reloc.offset, L + Address.Data + delta)
INC(delta, L + Address.Data)
|BIN.PICCODE:
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta)
INC(delta, BIN.GetLabel(program, L) + Address.Code)
|BIN.PICBSS:
BIN.put32le(code, reloc.offset, L + Address.Bss + delta)
INC(delta, L + Address.Bss)
|BIN.PICIMP:
iproc := BIN.GetIProc(program, L);
BIN.put32le(code, reloc.offset, iproc.FirstThunk * SizeOfWord + AdrImp + delta)
INC(delta, iproc.FirstThunk * SizeOfWord + AdrImp)
END;
BIN.put32le(code, offset, delta);
reloc := reloc.next(BIN.RELOC)
END
298,13 → 277,13
END fixup;
PROCEDURE WriteWord (file: FILE; w: WORD);
PROCEDURE WriteWord (w: WORD);
BEGIN
WR.Write16LE(file, ORD(w))
WR.Write16LE(ORD(w))
END WriteWord;
PROCEDURE WriteName* (File: FILE; name: NAME);
PROCEDURE WriteName* (name: NAME);
VAR
i, nameLen: INTEGER;
312,12 → 291,12
nameLen := LENGTH(name);
FOR i := 0 TO nameLen - 1 DO
WR.WriteByte(File, ORD(name[i]))
WR.WriteByte(ORD(name[i]))
END;
i := LEN(name) - nameLen;
WHILE i > 0 DO
WR.WriteByte(File, 0);
WR.WriteByte(0);
DEC(i)
END
324,7 → 303,7
END WriteName;
PROCEDURE WriteSectionHeader* (file: FILE; h: IMAGE_SECTION_HEADER);
PROCEDURE WriteSectionHeader* (h: IMAGE_SECTION_HEADER);
VAR
i, nameLen: INTEGER;
332,50 → 311,50
nameLen := LENGTH(h.Name);
FOR i := 0 TO nameLen - 1 DO
WR.WriteByte(file, ORD(h.Name[i]))
WR.WriteByte(ORD(h.Name[i]))
END;
i := LEN(h.Name) - nameLen;
WHILE i > 0 DO
WR.WriteByte(file, 0);
WR.WriteByte(0);
DEC(i)
END;
WR.Write32LE(file, h.VirtualSize);
WR.Write32LE(file, h.VirtualAddress);
WR.Write32LE(file, h.SizeOfRawData);
WR.Write32LE(file, h.PointerToRawData);
WR.Write32LE(file, h.PointerToRelocations);
WR.Write32LE(file, h.PointerToLinenumbers);
WR.Write32LE(h.VirtualSize);
WR.Write32LE(h.VirtualAddress);
WR.Write32LE(h.SizeOfRawData);
WR.Write32LE(h.PointerToRawData);
WR.Write32LE(h.PointerToRelocations);
WR.Write32LE(h.PointerToLinenumbers);
WriteWord(file, h.NumberOfRelocations);
WriteWord(file, h.NumberOfLinenumbers);
WriteWord(h.NumberOfRelocations);
WriteWord(h.NumberOfLinenumbers);
WR.Write32LE(file, h.Characteristics)
WR.Write32LE(h.Characteristics)
END WriteSectionHeader;
PROCEDURE WriteFileHeader* (file: FILE; h: IMAGE_FILE_HEADER);
PROCEDURE WriteFileHeader* (h: IMAGE_FILE_HEADER);
BEGIN
WriteWord(file, h.Machine);
WriteWord(file, h.NumberOfSections);
WriteWord(h.Machine);
WriteWord(h.NumberOfSections);
WR.Write32LE(file, h.TimeDateStamp);
WR.Write32LE(file, h.PointerToSymbolTable);
WR.Write32LE(file, h.NumberOfSymbols);
WR.Write32LE(h.TimeDateStamp);
WR.Write32LE(h.PointerToSymbolTable);
WR.Write32LE(h.NumberOfSymbols);
WriteWord(file, h.SizeOfOptionalHeader);
WriteWord(file, h.Characteristics)
WriteWord(h.SizeOfOptionalHeader);
WriteWord(h.Characteristics)
END WriteFileHeader;
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN);
VAR
i, n: INTEGER;
i, n, temp: INTEGER;
Size: RECORD
Code, Data, Bss, Stack, Import, Reloc, Export: INTEGER
Code, Data, Bss, Import, Reloc, Export: INTEGER
END;
383,9 → 362,7
Address: VIRTUAL_ADDR;
File: FILE;
import: BIN.IMPRT;
_import: BIN.IMPRT;
ImportTable: CHL.INTLIST;
ExportDir: IMAGE_EXPORT_DIRECTORY;
392,99 → 369,93
export: BIN.EXPRT;
PROCEDURE WriteExportDir (file: FILE; e: IMAGE_EXPORT_DIRECTORY);
PROCEDURE WriteExportDir (e: IMAGE_EXPORT_DIRECTORY);
BEGIN
WR.Write32LE(file, e.Characteristics);
WR.Write32LE(file, e.TimeDateStamp);
WR.Write32LE(e.Characteristics);
WR.Write32LE(e.TimeDateStamp);
WriteWord(file, e.MajorVersion);
WriteWord(file, e.MinorVersion);
WriteWord(e.MajorVersion);
WriteWord(e.MinorVersion);
WR.Write32LE(file, e.Name);
WR.Write32LE(file, e.Base);
WR.Write32LE(file, e.NumberOfFunctions);
WR.Write32LE(file, e.NumberOfNames);
WR.Write32LE(file, e.AddressOfFunctions);
WR.Write32LE(file, e.AddressOfNames);
WR.Write32LE(file, e.AddressOfNameOrdinals)
WR.Write32LE(e.Name);
WR.Write32LE(e.Base);
WR.Write32LE(e.NumberOfFunctions);
WR.Write32LE(e.NumberOfNames);
WR.Write32LE(e.AddressOfFunctions);
WR.Write32LE(e.AddressOfNames);
WR.Write32LE(e.AddressOfNameOrdinals)
END WriteExportDir;
PROCEDURE WriteOptHeader (file: FILE; h: IMAGE_OPTIONAL_HEADER);
PROCEDURE WriteOptHeader (h: IMAGE_OPTIONAL_HEADER; amd64: BOOLEAN);
VAR
i: INTEGER;
BEGIN
WriteWord(file, h.Magic);
WriteWord(h.Magic);
WR.WriteByte(file, h.MajorLinkerVersion);
WR.WriteByte(file, h.MinorLinkerVersion);
WR.WriteByte(h.MajorLinkerVersion);
WR.WriteByte(h.MinorLinkerVersion);
WR.Write32LE(file, h.SizeOfCode);
WR.Write32LE(file, h.SizeOfInitializedData);
WR.Write32LE(file, h.SizeOfUninitializedData);
WR.Write32LE(file, h.AddressOfEntryPoint);
WR.Write32LE(file, h.BaseOfCode);
WR.Write32LE(h.SizeOfCode);
WR.Write32LE(h.SizeOfInitializedData);
WR.Write32LE(h.SizeOfUninitializedData);
WR.Write32LE(h.AddressOfEntryPoint);
WR.Write32LE(h.BaseOfCode);
IF bit64 THEN
WR.Write64LE(file, h.ImageBase)
IF amd64 THEN
WR.Write64LE(h.ImageBase)
ELSE
WR.Write32LE(file, h.BaseOfData);
WR.Write32LE(file, h.ImageBase)
WR.Write32LE(h.BaseOfData);
WR.Write32LE(h.ImageBase)
END;
WR.Write32LE(file, h.SectionAlignment);
WR.Write32LE(file, h.FileAlignment);
WR.Write32LE(h.SectionAlignment);
WR.Write32LE(h.FileAlignment);
WriteWord(file, h.MajorOperatingSystemVersion);
WriteWord(file, h.MinorOperatingSystemVersion);
WriteWord(file, h.MajorImageVersion);
WriteWord(file, h.MinorImageVersion);
WriteWord(file, h.MajorSubsystemVersion);
WriteWord(file, h.MinorSubsystemVersion);
WriteWord(h.MajorOperatingSystemVersion);
WriteWord(h.MinorOperatingSystemVersion);
WriteWord(h.MajorImageVersion);
WriteWord(h.MinorImageVersion);
WriteWord(h.MajorSubsystemVersion);
WriteWord(h.MinorSubsystemVersion);
WR.Write32LE(file, h.Win32VersionValue);
WR.Write32LE(file, h.SizeOfImage);
WR.Write32LE(file, h.SizeOfHeaders);
WR.Write32LE(file, h.CheckSum);
WR.Write32LE(h.Win32VersionValue);
WR.Write32LE(h.SizeOfImage);
WR.Write32LE(h.SizeOfHeaders);
WR.Write32LE(h.CheckSum);
WriteWord(file, h.Subsystem);
WriteWord(file, h.DllCharacteristics);
WriteWord(h.Subsystem);
WriteWord(h.DllCharacteristics);
IF bit64 THEN
WR.Write64LE(file, h.SizeOfStackReserve);
WR.Write64LE(file, h.SizeOfStackCommit);
WR.Write64LE(file, h.SizeOfHeapReserve);
WR.Write64LE(file, h.SizeOfHeapCommit)
IF amd64 THEN
WR.Write64LE(h.SizeOfStackReserve);
WR.Write64LE(h.SizeOfStackCommit);
WR.Write64LE(h.SizeOfHeapReserve);
WR.Write64LE(h.SizeOfHeapCommit)
ELSE
WR.Write32LE(file, h.SizeOfStackReserve);
WR.Write32LE(file, h.SizeOfStackCommit);
WR.Write32LE(file, h.SizeOfHeapReserve);
WR.Write32LE(file, h.SizeOfHeapCommit)
WR.Write32LE(h.SizeOfStackReserve);
WR.Write32LE(h.SizeOfStackCommit);
WR.Write32LE(h.SizeOfHeapReserve);
WR.Write32LE(h.SizeOfHeapCommit)
END;
WR.Write32LE(file, h.LoaderFlags);
WR.Write32LE(file, h.NumberOfRvaAndSizes);
WR.Write32LE(h.LoaderFlags);
WR.Write32LE(h.NumberOfRvaAndSizes);
FOR i := 0 TO LEN(h.DataDirectory) - 1 DO
WR.Write32LE(file, h.DataDirectory[i].VirtualAddress);
WR.Write32LE(file, h.DataDirectory[i].Size)
WR.Write32LE(h.DataDirectory[i].VirtualAddress);
WR.Write32LE(h.DataDirectory[i].Size)
END
END WriteOptHeader;
PROCEDURE WritePEHeader (file: FILE; h: IMAGE_NT_HEADERS);
PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; VirtualSize: INTEGER; Characteristics: DWORD);
BEGIN
WR.Write(file, h.Signature, LEN(h.Signature));
WriteFileHeader(file, h.FileHeader);
WriteOptHeader(file, h.OptionalHeader)
END WritePEHeader;
PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; Characteristics: DWORD);
BEGIN
section.Name := Name;
section.VirtualSize := VirtualSize;
section.SizeOfRawData := WR.align(VirtualSize, FileAlignment);
section.PointerToRelocations := 0;
section.PointerToLinenumbers := 0;
section.NumberOfRelocations := 0X;
494,14 → 465,11
BEGIN
bit64 := amd64;
SizeOfWord := SIZE_OF_DWORD * (ORD(bit64) + 1);
Relocations := LISTS.create(NIL);
SizeOfWord := SIZE_OF_DWORD * (ORD(amd64) + 1);
Size.Code := CHL.Length(program.code);
Size.Data := CHL.Length(program.data);
Size.Bss := program.bss;
Size.Stack := program.stack;
IF dll THEN
BaseAddress := 10000000H
509,123 → 477,109
BaseAddress := 400000H
END;
PEHeader.Signature[0] := 50H;
PEHeader.Signature[1] := 45H;
PEHeader.Signature[2] := 0;
PEHeader.Signature[3] := 0;
Signature[0] := 50H;
Signature[1] := 45H;
Signature[2] := 0;
Signature[3] := 0;
IF amd64 THEN
PEHeader.FileHeader.Machine := 08664X
FileHeader.Machine := 08664X
ELSE
PEHeader.FileHeader.Machine := 014CX
FileHeader.Machine := 014CX
END;
PEHeader.FileHeader.NumberOfSections := WCHR(4 + ORD(dll));
FileHeader.NumberOfSections := WCHR(4 + ORD(dll));
PEHeader.FileHeader.TimeDateStamp := UTILS.UnixTime();
PEHeader.FileHeader.PointerToSymbolTable := 0H;
PEHeader.FileHeader.NumberOfSymbols := 0H;
PEHeader.FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64));
PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll));
FileHeader.TimeDateStamp := UTILS.UnixTime();
FileHeader.PointerToSymbolTable := 0H;
FileHeader.NumberOfSymbols := 0H;
FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64));
FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll));
PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64));
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;
PEHeader.OptionalHeader.AddressOfEntryPoint := SectionAlignment;
PEHeader.OptionalHeader.BaseOfCode := SectionAlignment;
PEHeader.OptionalHeader.BaseOfData := PEHeader.OptionalHeader.BaseOfCode + align(Size.Code, SectionAlignment);
PEHeader.OptionalHeader.ImageBase := BaseAddress;
PEHeader.OptionalHeader.SectionAlignment := SectionAlignment;
PEHeader.OptionalHeader.FileAlignment := FileAlignment;
PEHeader.OptionalHeader.MajorOperatingSystemVersion := 1X;
PEHeader.OptionalHeader.MinorOperatingSystemVersion := 0X;
PEHeader.OptionalHeader.MajorImageVersion := 0X;
PEHeader.OptionalHeader.MinorImageVersion := 0X;
PEHeader.OptionalHeader.MajorSubsystemVersion := 4X;
PEHeader.OptionalHeader.MinorSubsystemVersion := 0X;
PEHeader.OptionalHeader.Win32VersionValue := 0H;
PEHeader.OptionalHeader.SizeOfImage := SectionAlignment;
PEHeader.OptionalHeader.SizeOfHeaders := 400H;
PEHeader.OptionalHeader.CheckSum := 0;
PEHeader.OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll));
PEHeader.OptionalHeader.DllCharacteristics := 0040X;
PEHeader.OptionalHeader.SizeOfStackReserve := Size.Stack;
PEHeader.OptionalHeader.SizeOfStackCommit := Size.Stack DIV 16;
PEHeader.OptionalHeader.SizeOfHeapReserve := 100000H;
PEHeader.OptionalHeader.SizeOfHeapCommit := 10000H;
PEHeader.OptionalHeader.LoaderFlags := 0;
PEHeader.OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES;
OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64));
OptionalHeader.MajorLinkerVersion := UTILS.vMajor;
OptionalHeader.MinorLinkerVersion := UTILS.vMinor;
OptionalHeader.SizeOfCode := WR.align(Size.Code, FileAlignment);
OptionalHeader.SizeOfInitializedData := 0;
OptionalHeader.SizeOfUninitializedData := 0;
OptionalHeader.AddressOfEntryPoint := SectionAlignment;
OptionalHeader.BaseOfCode := SectionAlignment;
OptionalHeader.BaseOfData := OptionalHeader.BaseOfCode + WR.align(Size.Code, SectionAlignment);
OptionalHeader.ImageBase := BaseAddress;
OptionalHeader.SectionAlignment := SectionAlignment;
OptionalHeader.FileAlignment := FileAlignment;
OptionalHeader.MajorOperatingSystemVersion := 1X;
OptionalHeader.MinorOperatingSystemVersion := 0X;
OptionalHeader.MajorImageVersion := 0X;
OptionalHeader.MinorImageVersion := 0X;
OptionalHeader.MajorSubsystemVersion := 4X;
OptionalHeader.MinorSubsystemVersion := 0X;
OptionalHeader.Win32VersionValue := 0H;
OptionalHeader.SizeOfImage := SectionAlignment;
OptionalHeader.SizeOfHeaders := 400H;
OptionalHeader.CheckSum := 0;
OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll));
OptionalHeader.DllCharacteristics := 0040X;
OptionalHeader.SizeOfStackReserve := 100000H;
OptionalHeader.SizeOfStackCommit := 10000H;
OptionalHeader.SizeOfHeapReserve := 100000H;
OptionalHeader.SizeOfHeapCommit := 10000H;
OptionalHeader.LoaderFlags := 0;
OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES;
InitSection(SectionHeaders[0], ".text", SHC_text);
SectionHeaders[0].VirtualSize := Size.Code;
FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO
OptionalHeader.DataDirectory[i].VirtualAddress := 0;
OptionalHeader.DataDirectory[i].Size := 0
END;
InitSection(SectionHeaders[0], ".text", Size.Code, SHC_text);
SectionHeaders[0].VirtualAddress := SectionAlignment;
SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment);
SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders;
SectionHeaders[0].PointerToRawData := OptionalHeader.SizeOfHeaders;
InitSection(SectionHeaders[1], ".data", SHC_data);
SectionHeaders[1].VirtualSize := Size.Data;
SectionHeaders[1].VirtualAddress := align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment);
SectionHeaders[1].SizeOfRawData := align(Size.Data, FileAlignment);
InitSection(SectionHeaders[1], ".data", Size.Data, SHC_data);
SectionHeaders[1].VirtualAddress := WR.align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment);
SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData;
InitSection(SectionHeaders[2], ".bss", SHC_bss);
SectionHeaders[2].VirtualSize := Size.Bss;
SectionHeaders[2].VirtualAddress := align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment);
InitSection(SectionHeaders[2], ".bss", Size.Bss, SHC_bss);
SectionHeaders[2].VirtualAddress := WR.align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment);
SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData;
SectionHeaders[2].SizeOfRawData := 0;
SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData;
Size.Import := GetImportSize(program.imp_list);
InitSection(SectionHeaders[3], ".idata", SHC_data);
SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import);
SectionHeaders[3].VirtualAddress := align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment);
SectionHeaders[3].SizeOfRawData := align(SectionHeaders[3].VirtualSize, FileAlignment);
InitSection(SectionHeaders[3], ".idata", Size.Import + CHL.Length(program._import), SHC_data);
SectionHeaders[3].VirtualAddress := WR.align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment);
SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData;
Address.Code := SectionHeaders[0].VirtualAddress + PEHeader.OptionalHeader.ImageBase;
Address.Data := SectionHeaders[1].VirtualAddress + PEHeader.OptionalHeader.ImageBase;
Address.Bss := SectionHeaders[2].VirtualAddress + PEHeader.OptionalHeader.ImageBase;
Address.Import := SectionHeaders[3].VirtualAddress + PEHeader.OptionalHeader.ImageBase;
Address.Code := SectionHeaders[0].VirtualAddress + OptionalHeader.ImageBase;
Address.Data := SectionHeaders[1].VirtualAddress + OptionalHeader.ImageBase;
Address.Bss := SectionHeaders[2].VirtualAddress + OptionalHeader.ImageBase;
Address.Import := SectionHeaders[3].VirtualAddress + OptionalHeader.ImageBase;
fixup(program, Address);
fixup(program, Address, amd64);
IF dll THEN
Size.Export := Export(program, SectionHeaders[1].VirtualAddress, ExportDir);
Size.Export := Export(program, SectionHeaders[1].VirtualAddress + program.modname, ExportDir);
InitSection(SectionHeaders[4], ".edata", SHC_data);
SectionHeaders[4].VirtualSize := Size.Export + CHL.Length(program.export);
SectionHeaders[4].VirtualAddress := align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment);
SectionHeaders[4].SizeOfRawData := align(SectionHeaders[4].VirtualSize, FileAlignment);
InitSection(SectionHeaders[4], ".edata", Size.Export + CHL.Length(program.export), SHC_data);
SectionHeaders[4].VirtualAddress := WR.align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment);
SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData;
END;
FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO
PEHeader.OptionalHeader.DataDirectory[i].VirtualAddress := 0;
PEHeader.OptionalHeader.DataDirectory[i].Size := 0
OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress;
OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize
END;
IF dll THEN
PEHeader.OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress;
PEHeader.OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize
END;
OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress;
OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize;
PEHeader.OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress;
PEHeader.OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize;
FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO
INC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData)
FOR i := 1 TO ORD(FileHeader.NumberOfSections) - 1 DO
INC(OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData)
END;
DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[0].SizeOfRawData);
DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[2].SizeOfRawData);
OptionalHeader.SizeOfUninitializedData := WR.align(SectionHeaders[2].VirtualSize, FileAlignment);
PEHeader.OptionalHeader.SizeOfUninitializedData := align(SectionHeaders[2].VirtualSize, FileAlignment);
FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO
INC(PEHeader.OptionalHeader.SizeOfImage, align(SectionHeaders[i].VirtualSize, SectionAlignment))
FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
INC(OptionalHeader.SizeOfImage, WR.align(SectionHeaders[i].VirtualSize, SectionAlignment))
END;
n := 0;
634,23 → 588,25
BIN.InitArray(msdos, n, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F");
BIN.InitArray(msdos, n, "742062652072756E20696E20444F53206D6F64652E0D0A240000000000000000");
File := WR.Create(FileName);
WR.Create(FileName);
WR.Write(File, msdos, LEN(msdos));
WR.Write(msdos, LEN(msdos));
WritePEHeader(File, PEHeader);
WR.Write(Signature, LEN(Signature));
WriteFileHeader(FileHeader);
WriteOptHeader(OptionalHeader, amd64);
FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO
WriteSectionHeader(File, SectionHeaders[i])
FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
WriteSectionHeader(SectionHeaders[i])
END;
WR.Padding(File, FileAlignment);
WR.Padding(FileAlignment);
CHL.WriteToFile(File, program.code);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(program.code);
WR.Padding(FileAlignment);
CHL.WriteToFile(File, program.data);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(program.data);
WR.Padding(FileAlignment);
n := (libcnt + 1) * 5;
ImportTable := CHL.CreateIntList();
660,17 → 616,17
END;
i := 0;
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label = 0 THEN
CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
_import := program.imp_list.first(BIN.IMPRT);
WHILE _import # NIL DO
IF _import.label = 0 THEN
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 * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
i := i + 5
CHL.SetInt(ImportTable, i + 3, _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
CHL.SetInt(ImportTable, i + 4, _import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
INC(i, 5)
END;
import := import.next(BIN.IMPRT)
_import := _import.next(BIN.IMPRT)
END;
CHL.SetInt(ImportTable, i + 0, 0);
679,29 → 635,30
CHL.SetInt(ImportTable, i + 3, 0);
CHL.SetInt(ImportTable, i + 4, 0);
import := program.imp_list.first(BIN.IMPRT);
WHILE import # NIL DO
IF import.label # 0 THEN
CHL.SetInt(ImportTable, import.OriginalFirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2);
CHL.SetInt(ImportTable, import.FirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2)
_import := program.imp_list.first(BIN.IMPRT);
WHILE _import # NIL DO
IF _import.label # 0 THEN
temp := _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2;
CHL.SetInt(ImportTable, _import.OriginalFirstThunk + n, temp);
CHL.SetInt(ImportTable, _import.FirstThunk + n, temp)
END;
import := import.next(BIN.IMPRT)
_import := _import.next(BIN.IMPRT)
END;
FOR i := 0 TO n - 1 DO
WR.Write32LE(File, CHL.GetInt(ImportTable, i))
WR.Write32LE(CHL.GetInt(ImportTable, i))
END;
FOR i := n TO CHL.Length(ImportTable) - 1 DO
IF amd64 THEN
WR.Write64LE(File, CHL.GetInt(ImportTable, i))
WR.Write64LE(CHL.GetInt(ImportTable, i))
ELSE
WR.Write32LE(File, CHL.GetInt(ImportTable, i))
WR.Write32LE(CHL.GetInt(ImportTable, i))
END
END;
CHL.WriteToFile(File, program.import);
WR.Padding(File, FileAlignment);
CHL.WriteToFile(program._import);
WR.Padding(FileAlignment);
IF dll THEN
709,29 → 666,29
INC(ExportDir.AddressOfNames, SectionHeaders[4].VirtualAddress);
INC(ExportDir.AddressOfNameOrdinals, SectionHeaders[4].VirtualAddress);
WriteExportDir(File, ExportDir);
WriteExportDir(ExportDir);
export := program.exp_list.first(BIN.EXPRT);
WHILE export # NIL DO
WR.Write32LE(File, export.label + SectionHeaders[0].VirtualAddress);
WR.Write32LE(export.label + SectionHeaders[0].VirtualAddress);
export := export.next(BIN.EXPRT)
END;
export := program.exp_list.first(BIN.EXPRT);
WHILE export # NIL DO
WR.Write32LE(File, export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress);
WR.Write32LE(export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress);
export := export.next(BIN.EXPRT)
END;
FOR i := 0 TO ExportDir.NumberOfFunctions - 1 DO
WriteWord(File, WCHR(i))
WriteWord(WCHR(i))
END;
CHL.WriteToFile(File, program.export);
WR.Padding(File, FileAlignment)
CHL.WriteToFile(program.export);
WR.Padding(FileAlignment)
END;
WR.Close(File)
WR.Close
END write;

/programs/develop/oberon07/Source/PROG.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 PROG;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS;
CONST
24,7 → 24,7
tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4;
tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8;
tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12;
tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15;
tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; tNONE* = 16;
BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR};
40,15 → 40,15
sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34;
sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38;
sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42;
sysDINT* = 43;*)
sysDINT* = 43;*)sysGET8* = 44; sysGET16* = 45; sysGET32* = 46;
default32* = 2;
default32* = 2; _default32* = default32 + 1;
stdcall* = 4; _stdcall* = stdcall + 1;
ccall* = 6; _ccall* = ccall + 1;
ccall16* = 8; _ccall16* = ccall16 + 1;
win64* = 10; _win64* = win64 + 1;
stdcall64* = 12; _stdcall64* = stdcall64 + 1;
default64* = 14;
default64* = 14; _default64* = default64 + 1;
systemv* = 16; _systemv* = systemv + 1;
default16* = 18;
code* = 20; _code* = code + 1;
59,10 → 59,10
sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
sf_code* = 8;
sf_noalign* = 9;
sf_code* = 8; sf_oberon* = 9;
sf_noalign* = 10;
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code};
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
rec_flags* = {sf_noalign};
STACK_FRAME = 2;
73,7 → 73,7
OPTIONS* = RECORD
version*, stack*, ram*, rom*: INTEGER;
pic*: BOOLEAN;
pic*, lower*: BOOLEAN;
checking*: SET
END;
82,13 → 82,11
UNIT* = POINTER TO rUNIT;
PROGRAM* = POINTER TO rPROGRAM;
_TYPE* = POINTER TO rTYPE;
TYPE_* = POINTER TO rTYPE_;
FRWPTR* = POINTER TO RECORD (LISTS.ITEM)
type: TYPE_;
_type: _TYPE;
baseIdent: SCAN.IDENT;
linked: BOOLEAN;
102,7 → 100,7
label*: INTEGER;
used*: BOOLEAN;
processed*: BOOLEAN;
import*: LISTS.ITEM;
_import*: LISTS.ITEM;
using*: LISTS.LIST;
enter*,
leave*: LISTS.ITEM
117,7 → 115,6
rUNIT = RECORD (LISTS.ITEM)
program*: PROGRAM;
name*: SCAN.IDENT;
idents*: LISTS.LIST;
frwPointers: LISTS.LIST;
133,7 → 130,7
PARAM* = POINTER TO rPARAM;
rTYPE_ = RECORD (LISTS.ITEM)
rTYPE = RECORD (LISTS.ITEM)
typ*: INTEGER;
size*: INTEGER;
140,7 → 137,7
parSize*: INTEGER;
length*: INTEGER;
align*: INTEGER;
base*: TYPE_;
base*: _TYPE;
fields*: LISTS.LIST;
params*: LISTS.LIST;
unit*: UNIT;
147,7 → 144,7
closed*: BOOLEAN;
num*: INTEGER;
call*: INTEGER;
import*: BOOLEAN;
_import*: BOOLEAN;
noalign*: BOOLEAN
END;
154,7 → 151,7
rFIELD = RECORD (LISTS.ITEM)
type*: TYPE_;
_type*: _TYPE;
name*: SCAN.IDENT;
export*: BOOLEAN;
offset*: INTEGER
164,7 → 161,7
rPARAM = RECORD (LISTS.ITEM)
name*: SCAN.IDENT;
type*: TYPE_;
_type*: _TYPE;
vPar*: BOOLEAN;
offset*: INTEGER
175,10 → 172,10
name*: SCAN.IDENT;
typ*: INTEGER;
export*: BOOLEAN;
import*: LISTS.ITEM;
_import*: LISTS.ITEM;
unit*: UNIT;
value*: ARITH.VALUE;
type*: TYPE_;
_type*: _TYPE;
stproc*: INTEGER;
global*: BOOLEAN;
scopeLvl*: INTEGER;
188,7 → 185,7
END;
rPROGRAM = RECORD
PROGRAM = RECORD
recCount: INTEGER;
units*: LISTS.LIST;
206,18 → 203,20
stTypes*: RECORD
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
tSTRING*, tNIL*, tCARD32*, tANYREC*, tNONE*: _TYPE
END
END;
DELIMPORT = PROCEDURE (import: LISTS.ITEM);
DELIMPORT = PROCEDURE (_import: LISTS.ITEM);
VAR
LowerCase: BOOLEAN;
idents: C.COLLECTION;
program*: PROGRAM;
PROCEDURE NewIdent (): IDENT;
237,15 → 236,15
END NewIdent;
PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER;
PROCEDURE getOffset* (varIdent: IDENT): INTEGER;
VAR
size: INTEGER;
BEGIN
IF varIdent.offset = -1 THEN
size := varIdent.type.size;
size := varIdent._type.size;
IF varIdent.global THEN
IF UTILS.Align(program.bss, varIdent.type.align) THEN
IF UTILS.Align(program.bss, varIdent._type.align) THEN
IF UTILS.maxint - program.bss >= size THEN
varIdent.offset := program.bss;
INC(program.bss, size)
281,7 → 280,7
IF (ident.typ = idVAR) & (ident.offset = -1) THEN
ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
IF ident.export THEN
offset := getOffset(unit.program, ident)
offset := getOffset(ident)
END
END;
ident := ident.prev(IDENT)
322,7 → 321,6
item: IDENT;
res: BOOLEAN;
proc: PROC;
procs: LISTS.LIST;
BEGIN
ASSERT(unit # NIL);
337,8 → 335,8
item.typ := typ;
item.unit := NIL;
item.export := FALSE;
item.import := NIL;
item.type := NIL;
item._import := NIL;
item._type := NIL;
item.value.typ := 0;
item.stproc := 0;
348,13 → 346,12
IF item.typ IN {idPROC, idIMP} THEN
NEW(proc);
proc.import := NIL;
proc._import := NIL;
proc.label := 0;
proc.used := FALSE;
proc.processed := FALSE;
proc.using := LISTS.create(NIL);
procs := unit.program.procs;
LISTS.push(procs, proc);
LISTS.push(program.procs, proc);
item.proc := proc
END;
393,16 → 390,16
END UseProc;
PROCEDURE setVarsType* (unit: UNIT; type: TYPE_);
PROCEDURE setVarsType* (unit: UNIT; _type: _TYPE);
VAR
item: IDENT;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
item := unit.idents.last(IDENT);
WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO
item.type := type;
WHILE (item # NIL) & (item.typ = idVAR) & (item._type = NIL) DO
item._type := _type;
item := item.prev(IDENT)
END
END setVarsType;
481,10 → 478,10
ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
END;
IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN
IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
IF del._type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
lvar := IL.NewVar();
lvar.offset := del.offset;
lvar.size := del.type.size;
lvar.size := del._type.size;
IF del.typ = idVAR THEN
lvar.offset := -lvar.offset
END;
504,18 → 501,18
END closeScope;
PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
PROCEDURE frwPtr* (unit: UNIT; _type: _TYPE; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
VAR
newptr: FRWPTR;
BEGIN
ASSERT(unit # NIL);
ASSERT(type # NIL);
ASSERT(_type # NIL);
ASSERT(baseIdent # NIL);
NEW(newptr);
newptr.type := type;
newptr._type := _type;
newptr.baseIdent := baseIdent;
newptr.pos := pos;
newptr.linked := FALSE;
539,8 → 536,8
ident := getIdent(unit, item.baseIdent, TRUE);
IF (ident # NIL) THEN
IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN
item.type.base := ident.type;
IF (ident.typ = idTYPE) & (ident._type.typ = tRECORD) THEN
item._type.base := ident._type;
item.linked := TRUE
ELSE
item.notRecord := TRUE;
558,7 → 555,7
END linkPtr;
PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN;
PROCEDURE isTypeEq* (t1, t2: _TYPE): BOOLEAN;
VAR
res: BOOLEAN;
param1, param2: LISTS.ITEM;
576,7 → 573,7
res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL));
WHILE res & (param1 # NIL) & (param2 # NIL) DO
res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type);
res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM)._type, param2(PARAM)._type);
param1 := param1.next;
param2 := param2.next;
res := res & ((param1 # NIL) = (param2 # NIL))
594,7 → 591,7
END isTypeEq;
PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN;
PROCEDURE isBaseOf* (t0, t1: _TYPE): BOOLEAN;
VAR
res: BOOLEAN;
617,12 → 614,12
END isBaseOf;
PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN;
PROCEDURE isOpenArray* (t: _TYPE): BOOLEAN;
RETURN (t.typ = tARRAY) & (t.length = 0)
END isOpenArray;
PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN;
PROCEDURE arrcomp* (src, dst: _TYPE): BOOLEAN;
RETURN (dst.typ = tARRAY) & isOpenArray(src) &
~isOpenArray(src.base) & ~isOpenArray(dst.base) &
isTypeEq(src.base, dst.base)
629,7 → 626,7
END arrcomp;
PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
PROCEDURE getUnit* (name: SCAN.IDENT): UNIT;
VAR
item: UNIT;
642,7 → 639,7
item := item.next(UNIT)
END;
IF (item = NIL) & (name.s = "SYSTEM") THEN
IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN
item := program.sysunit
END
650,36 → 647,40
END getUnit;
PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM);
PROCEDURE enterStTypes (unit: UNIT);
PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE);
ident.type := program.stTypes.tINTEGER;
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idTYPE);
ident._type := _type
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
ident._type := _type
END enter;
ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE);
ident.type := program.stTypes.tBYTE;
ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE);
ident.type := program.stTypes.tCHAR;
BEGIN
enter(unit, "integer", program.stTypes.tINTEGER);
enter(unit, "byte", program.stTypes.tBYTE);
enter(unit, "char", program.stTypes.tCHAR);
enter(unit, "set", program.stTypes.tSET);
enter(unit, "boolean", program.stTypes.tBOOLEAN);
ident := addIdent(unit, SCAN.enterid("SET"), idTYPE);
ident.type := program.stTypes.tSET;
ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
ident.type := program.stTypes.tBOOLEAN;
IF TARGETS.RealSize # 0 THEN
ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
ident.type := program.stTypes.tREAL
enter(unit, "real", program.stTypes.tREAL)
END;
IF TARGETS.BitDepth >= 32 THEN
ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
ident.type := program.stTypes.tWCHAR
enter(unit, "wchar", program.stTypes.tWCHAR)
END
END enterStTypes;
689,9 → 690,19
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
ident.stproc := proc
ident.stproc := proc;
ident._type := program.stTypes.tNONE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
ident.stproc := proc;
ident._type := program.stTypes.tNONE
END EnterProc;
698,64 → 709,72
PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
ident.stproc := func
ident.stproc := func;
ident._type := program.stTypes.tNONE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC);
ident.stproc := func;
ident._type := program.stTypes.tNONE
END EnterFunc;
BEGIN
EnterProc(unit, "ASSERT", stASSERT);
EnterProc(unit, "DEC", stDEC);
EnterProc(unit, "EXCL", stEXCL);
EnterProc(unit, "INC", stINC);
EnterProc(unit, "INCL", stINCL);
EnterProc(unit, "NEW", stNEW);
EnterProc(unit, "COPY", stCOPY);
EnterProc(unit, "assert", stASSERT);
EnterProc(unit, "dec", stDEC);
EnterProc(unit, "excl", stEXCL);
EnterProc(unit, "inc", stINC);
EnterProc(unit, "incl", stINCL);
EnterProc(unit, "new", stNEW);
EnterProc(unit, "copy", stCOPY);
EnterFunc(unit, "ABS", stABS);
EnterFunc(unit, "ASR", stASR);
EnterFunc(unit, "CHR", stCHR);
EnterFunc(unit, "LEN", stLEN);
EnterFunc(unit, "LSL", stLSL);
EnterFunc(unit, "ODD", stODD);
EnterFunc(unit, "ORD", stORD);
EnterFunc(unit, "ROR", stROR);
EnterFunc(unit, "BITS", stBITS);
EnterFunc(unit, "LSR", stLSR);
EnterFunc(unit, "LENGTH", stLENGTH);
EnterFunc(unit, "MIN", stMIN);
EnterFunc(unit, "MAX", stMAX);
EnterFunc(unit, "abs", stABS);
EnterFunc(unit, "asr", stASR);
EnterFunc(unit, "chr", stCHR);
EnterFunc(unit, "len", stLEN);
EnterFunc(unit, "lsl", stLSL);
EnterFunc(unit, "odd", stODD);
EnterFunc(unit, "ord", stORD);
EnterFunc(unit, "ror", stROR);
EnterFunc(unit, "bits", stBITS);
EnterFunc(unit, "lsr", stLSR);
EnterFunc(unit, "length", stLENGTH);
EnterFunc(unit, "min", stMIN);
EnterFunc(unit, "max", stMAX);
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "PACK", stPACK);
EnterProc(unit, "UNPK", stUNPK);
EnterFunc(unit, "FLOOR", stFLOOR);
EnterFunc(unit, "FLT", stFLT)
EnterProc(unit, "pack", stPACK);
EnterProc(unit, "unpk", stUNPK);
EnterFunc(unit, "floor", stFLOOR);
EnterFunc(unit, "flt", stFLT)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterFunc(unit, "WCHR", stWCHR)
EnterFunc(unit, "wchr", stWCHR)
END;
IF TARGETS.Dispose THEN
EnterProc(unit, "DISPOSE", stDISPOSE)
EnterProc(unit, "dispose", stDISPOSE)
END
END enterStProcs;
PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
PROCEDURE newUnit* (name: SCAN.IDENT): UNIT;
VAR
unit: UNIT;
BEGIN
ASSERT(program # NIL);
ASSERT(name # NIL);
NEW(unit);
unit.program := program;
unit.name := name;
unit.closed := FALSE;
unit.idents := LISTS.create(NIL);
763,7 → 782,7
ASSERT(openScope(unit, NIL));
enterStTypes(unit, program);
enterStTypes(unit);
enterStProcs(unit);
ASSERT(openScope(unit, NIL));
785,7 → 804,7
END newUnit;
PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
PROCEDURE getField* (self: _TYPE; name: SCAN.IDENT; unit: UNIT): FIELD;
VAR
field: FIELD;
817,7 → 836,7
END getField;
PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
PROCEDURE addField* (self: _TYPE; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
VAR
field: FIELD;
res: BOOLEAN;
832,7 → 851,7
field.name := name;
field.export := export;
field.type := NIL;
field._type := NIL;
field.offset := self.size;
LISTS.push(self.fields, field)
842,33 → 861,33
END addField;
PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN;
PROCEDURE setFields* (self: _TYPE; _type: _TYPE): BOOLEAN;
VAR
item: FIELD;
res: BOOLEAN;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
item := self.fields.first(FIELD);
WHILE (item # NIL) & (item.type # NIL) DO
WHILE (item # NIL) & (item._type # NIL) DO
item := item.next(FIELD)
END;
res := TRUE;
WHILE res & (item # NIL) & (item.type = NIL) DO
item.type := type;
WHILE res & (item # NIL) & (item._type = NIL) DO
item._type := _type;
IF ~self.noalign THEN
res := UTILS.Align(self.size, type.align)
res := UTILS.Align(self.size, _type.align)
ELSE
res := TRUE
END;
item.offset := self.size;
res := res & (UTILS.maxint - self.size >= type.size);
res := res & (UTILS.maxint - self.size >= _type.size);
IF res THEN
INC(self.size, type.size)
INC(self.size, _type.size)
END;
item := item.next(FIELD)
END
877,7 → 896,7
END setFields;
PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM;
PROCEDURE getParam* (self: _TYPE; name: SCAN.IDENT): PARAM;
VAR
item: PARAM;
894,7 → 913,7
END getParam;
PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
PROCEDURE addParam* (self: _TYPE; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
VAR
param: PARAM;
res: BOOLEAN;
908,7 → 927,7
NEW(param);
param.name := name;
param.type := NIL;
param._type := NIL;
param.vPar := vPar;
LISTS.push(self.params, param)
918,7 → 937,7
END addParam;
PROCEDURE Dim* (t: TYPE_): INTEGER;
PROCEDURE Dim* (t: _TYPE): INTEGER;
VAR
res: INTEGER;
932,7 → 951,7
END Dim;
PROCEDURE OpenBase* (t: TYPE_): TYPE_;
PROCEDURE OpenBase* (t: _TYPE): _TYPE;
BEGIN
WHILE isOpenArray(t) DO t := t.base END
RETURN t
939,7 → 958,7
END OpenBase;
PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
PROCEDURE getFloatParamsPos* (self: _TYPE; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
VAR
res: SET;
param: PARAM;
950,7 → 969,7
flt := 0;
param := self.params.first(PARAM);
WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO
IF ~param.vPar & (param.type.typ = tREAL) THEN
IF ~param.vPar & (param._type.typ = tREAL) THEN
INCL(res, param.offset - STACK_FRAME);
INC(flt)
END;
963,7 → 982,7
END getFloatParamsPos;
PROCEDURE setParams* (self: TYPE_; type: TYPE_);
PROCEDURE setParams* (self: _TYPE; _type: _TYPE);
VAR
item: LISTS.ITEM;
param: PARAM;
970,42 → 989,42
word, size: INTEGER;
BEGIN
ASSERT(type # NIL);
ASSERT(_type # NIL);
word := UTILS.target.bit_depth DIV 8;
item := self.params.first;
WHILE (item # NIL) & (item(PARAM).type # NIL) DO
WHILE (item # NIL) & (item(PARAM)._type # NIL) DO
item := item.next
END;
WHILE (item # NIL) & (item(PARAM).type = NIL) DO
WHILE (item # NIL) & (item(PARAM)._type = NIL) DO
param := item(PARAM);
param.type := type;
param._type := _type;
IF param.vPar THEN
IF type.typ = tRECORD THEN
IF _type.typ = tRECORD THEN
size := 2
ELSIF isOpenArray(type) THEN
size := Dim(type) + 1
ELSIF isOpenArray(_type) THEN
size := Dim(_type) + 1
ELSE
size := 1
END;
param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
param.offset := self.parSize + ORD(_type.typ = tRECORD) + Dim(_type) + STACK_FRAME;
INC(self.parSize, size)
ELSE
IF type.typ IN {tRECORD, tARRAY} THEN
IF isOpenArray(type) THEN
size := Dim(type) + 1
IF _type.typ IN {tRECORD, tARRAY} THEN
IF isOpenArray(_type) THEN
size := Dim(_type) + 1
ELSE
size := 1
END
ELSE
size := type.size;
size := _type.size;
ASSERT(UTILS.Align(size, word));
size := size DIV word
END;
param.offset := self.parSize + Dim(type) + STACK_FRAME;
param.offset := self.parSize + Dim(_type) + STACK_FRAME;
INC(self.parSize, size)
END;
1015,9 → 1034,9
END setParams;
PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
PROCEDURE enterType* (typ, size, length: INTEGER; unit: UNIT): _TYPE;
VAR
t: TYPE_;
t: _TYPE;
BEGIN
NEW(t);
1038,7 → 1057,7
|64: t.call := default64
END;
t.import := FALSE;
t._import := FALSE;
t.noalign := FALSE;
t.parSize := 0;
1058,9 → 1077,9
END enterType;
PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_;
PROCEDURE getType* (typ: INTEGER): _TYPE;
VAR
res: TYPE_;
res: _TYPE;
BEGIN
1078,7 → 1097,7
END getType;
PROCEDURE createSysUnit (program: PROGRAM);
PROCEDURE createSysUnit;
VAR
ident: IDENT;
unit: UNIT;
1087,50 → 1106,69
PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(sys, SCAN.enterid(name), idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(sys, SCAN.enterid(upper), idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END EnterProc;
BEGIN
unit := newUnit(program, SCAN.enterid("$SYSTEM"));
unit := newUnit(SCAN.enterid("$SYSTEM"));
EnterProc(unit, "ADR", idSYSFUNC, sysADR);
EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE);
EnterProc(unit, "SADR", idSYSFUNC, sysSADR);
EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
EnterProc(unit, "adr", idSYSFUNC, sysADR);
EnterProc(unit, "size", idSYSFUNC, sysSIZE);
EnterProc(unit, "sadr", idSYSFUNC, sysSADR);
EnterProc(unit, "typeid", idSYSFUNC, sysTYPEID);
EnterProc(unit, "GET", idSYSPROC, sysGET);
EnterProc(unit, "PUT8", idSYSPROC, sysPUT8);
EnterProc(unit, "PUT", idSYSPROC, sysPUT);
EnterProc(unit, "CODE", idSYSPROC, sysCODE);
EnterProc(unit, "MOVE", idSYSPROC, sysMOVE);
EnterProc(unit, "get", idSYSPROC, sysGET);
EnterProc(unit, "get8", idSYSPROC, sysGET8);
EnterProc(unit, "put", idSYSPROC, sysPUT);
EnterProc(unit, "put8", idSYSPROC, sysPUT8);
EnterProc(unit, "code", idSYSPROC, sysCODE);
EnterProc(unit, "move", idSYSPROC, sysMOVE);
(*
IF program.target.sys = mConst.Target_iMSP430 THEN
EnterProc(unit, "NOP", idSYSPROC, sysNOP);
EnterProc(unit, "EINT", idSYSPROC, sysEINT);
EnterProc(unit, "DINT", idSYSPROC, sysDINT)
EnterProc(unit, "nop", idSYSPROC, sysNOP);
EnterProc(unit, "eint", idSYSPROC, sysEINT);
EnterProc(unit, "dint", idSYSPROC, sysDINT)
END;
*)
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "INF", idSYSFUNC, sysINF);
EnterProc(unit, "inf", idSYSFUNC, sysINF);
END;
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
EnterProc(unit, "COPY", idSYSPROC, sysCOPY)
EnterProc(unit, "copy", idSYSPROC, sysCOPY)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR);
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32);
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "wsadr", idSYSFUNC, sysWSADR);
EnterProc(unit, "put16", idSYSPROC, sysPUT16);
EnterProc(unit, "put32", idSYSPROC, sysPUT32);
EnterProc(unit, "get16", idSYSPROC, sysGET16);
EnterProc(unit, "get32", idSYSPROC, sysGET32);
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident.type := program.stTypes.tCARD32;
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE
END;
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE;
END;
closeUnit(unit);
1138,7 → 1176,7
END createSysUnit;
PROCEDURE DelUnused* (program: PROGRAM; DelImport: DELIMPORT);
PROCEDURE DelUnused* (DelImport: DELIMPORT);
VAR
proc: PROC;
flag: BOOLEAN;
1180,10 → 1218,10
WHILE proc # NIL DO
IF ~proc.used THEN
IF proc.import = NIL THEN
IF proc._import = NIL THEN
IL.delete2(proc.enter, proc.leave)
ELSE
DelImport(proc.import)
DelImport(proc._import)
END
END;
proc := proc.next(PROC)
1192,24 → 1230,28
END DelUnused;
PROCEDURE create* (options: OPTIONS): PROGRAM;
VAR
program: PROGRAM;
PROCEDURE ResetLocSize*;
BEGIN
program.locsize := 0
END ResetLocSize;
PROCEDURE create* (options: OPTIONS);
BEGIN
LowerCase := options.lower;
SCAN.init(options.lower);
idents := C.create();
UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8);
NEW(program);
program.options := options;
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.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|TARGETS.osNONE: program.sysflags := {sf_code}
END;
1220,11 → 1262,11
program.types := LISTS.create(NIL);
program.procs := LISTS.create(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, TARGETS.WordSize, 0, NIL);
program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL);
program.stTypes.tINTEGER := enterType(tINTEGER, TARGETS.WordSize, 0, NIL);
program.stTypes.tBYTE := enterType(tBYTE, 1, 0, NIL);
program.stTypes.tCHAR := enterType(tCHAR, 1, 0, NIL);
program.stTypes.tSET := enterType(tSET, TARGETS.WordSize, 0, NIL);
program.stTypes.tBOOLEAN := enterType(tBOOLEAN, 1, 0, NIL);
program.stTypes.tINTEGER.align := TARGETS.WordSize;
program.stTypes.tBYTE.align := 1;
1233,26 → 1275,24
program.stTypes.tBOOLEAN.align := 1;
IF TARGETS.BitDepth >= 32 THEN
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL);
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL);
program.stTypes.tWCHAR := enterType(tWCHAR, 2, 0, NIL);
program.stTypes.tCARD32 := enterType(tCARD32, 4, 0, NIL);
program.stTypes.tWCHAR.align := 2;
program.stTypes.tCARD32.align := 4
END;
IF TARGETS.RealSize # 0 THEN
program.stTypes.tREAL := enterType(program, tREAL, TARGETS.RealSize, 0, NIL);
program.stTypes.tREAL := enterType(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.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL);
program.stTypes.tNIL := enterType(tNIL, TARGETS.WordSize, 0, NIL);
program.stTypes.tNONE := enterType(tNONE, 0, 0, NIL);
program.stTypes.tANYREC := enterType(tRECORD, 0, 0, NIL);
program.stTypes.tANYREC.closed := TRUE;
createSysUnit(program)
RETURN program
createSysUnit
END create;

/programs/develop/oberon07/Source/REG.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
156,7 → 156,7
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
VAR
free, n: INTEGER;
free: INTEGER;
res: BOOLEAN;
178,8 → 178,8
Put(R, reg);
res := TRUE
ELSE
n := InStk(R, reg);
IF n # -1 THEN
res := InStk(R, reg) # -1;
IF res THEN
free := GetFreeReg(R);
IF free # -1 THEN
Put(R, free);
192,12 → 192,9
IF free # reg THEN
exch(R, reg, free)
END
END;
res := TRUE
ELSE
res := FALSE
END
END
END
RETURN res
END GetReg;

/programs/develop/oberon07/Source/RVM32I.ob07
0,0 → 1,1302
(*
BSD 2-Clause License
Copyright (c) 2020, Anton Krotov
All rights reserved.
*)
MODULE RVM32I;
IMPORT
PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS;
CONST
LTypes = 0;
LStrings = 1;
LGlobal = 2;
LHeap = 3;
LStack = 4;
numGPRs = 3;
R0 = 0; R1 = 1;
BP = 3; SP = 4;
ACC = R0;
GPRs = {0 .. 2} + {5 .. numGPRs + 1};
opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opABS = 5;
opXCHG = 6; opLDR8 = 7; opLDR16 = 8; opLDR32 = 9; opPUSH = 10; opPUSHC = 11;
opPOP = 12; opJGZ = 13; opJZ = 14; opJNZ = 15; opLLA = 16; opJGA = 17;
opJLA = 18; opJMP = 19; opCALL = 20; opCALLI = 21;
opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
opSTR8 = 34; opSTR16 = 36; opSTR32 = 38; opINCL = 40; opEXCL = 42;
opIN = 44; opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
opLSL = 56; opROR = 58; opMIN = 60; opMAX = 62; opEQ = 64; opNE = 66;
opLT = 68; opLE = 70; opGT = 72; opGE = 74; opBT = 76;
opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
opSTR8C = 35; opSTR16C = 37; opSTR32C = 39; opINCLC = 41; opEXCLC = 43;
opINC = 45; opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
opLSLC = 57; opRORC = 59; opMINC = 61; opMAXC = 63; opEQC = 65; opNEC = 67;
opLTC = 69; opLEC = 71; opGTC = 73; opGEC = 75; opBTC = 77;
opLEA = 78; opLABEL = 79;
inf = 7F800000H;
VAR
R: REG.REGS; count: INTEGER;
PROCEDURE OutByte (n: BYTE);
BEGIN
WR.WriteByte(n);
INC(count)
END OutByte;
PROCEDURE OutInt (n: INTEGER);
BEGIN
WR.Write32LE(n);
INC(count, 4)
END OutInt;
PROCEDURE Emit (op, par1, par2: INTEGER);
BEGIN
OutInt(op);
OutInt(par1);
OutInt(par2)
END Emit;
PROCEDURE drop;
BEGIN
REG.Drop(R)
END drop;
PROCEDURE GetAnyReg (): INTEGER;
RETURN REG.GetAnyReg(R)
END GetAnyReg;
PROCEDURE GetAcc;
BEGIN
ASSERT(REG.GetReg(R, ACC))
END GetAcc;
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 push (r: INTEGER);
BEGIN
Emit(opPUSH, r, 0)
END push;
PROCEDURE pop (r: INTEGER);
BEGIN
Emit(opPOP, r, 0)
END pop;
PROCEDURE mov (r1, r2: INTEGER);
BEGIN
Emit(opMOV, r1, r2)
END mov;
PROCEDURE xchg (r1, r2: INTEGER);
BEGIN
Emit(opXCHG, r1, r2)
END xchg;
PROCEDURE addrc (r, c: INTEGER);
BEGIN
Emit(opADDC, r, c)
END addrc;
PROCEDURE subrc (r, c: INTEGER);
BEGIN
Emit(opSUBC, r, c)
END subrc;
PROCEDURE movrc (r, c: INTEGER);
BEGIN
Emit(opMOVC, r, c)
END movrc;
PROCEDURE pushc (c: INTEGER);
BEGIN
Emit(opPUSHC, c, 0)
END pushc;
PROCEDURE add (r1, r2: INTEGER);
BEGIN
Emit(opADD, r1, r2)
END add;
PROCEDURE sub (r1, r2: INTEGER);
BEGIN
Emit(opSUB, r1, r2)
END sub;
PROCEDURE ldr32 (r1, r2: INTEGER);
BEGIN
Emit(opLDR32, r1, r2)
END ldr32;
PROCEDURE ldr16 (r1, r2: INTEGER);
BEGIN
Emit(opLDR16, r1, r2)
END ldr16;
PROCEDURE ldr8 (r1, r2: INTEGER);
BEGIN
Emit(opLDR8, r1, r2)
END ldr8;
PROCEDURE str32 (r1, r2: INTEGER);
BEGIN
Emit(opSTR32, r1, r2)
END str32;
PROCEDURE str16 (r1, r2: INTEGER);
BEGIN
Emit(opSTR16, r1, r2)
END str16;
PROCEDURE str8 (r1, r2: INTEGER);
BEGIN
Emit(opSTR8, r1, r2)
END str8;
PROCEDURE GlobalAdr (r, offset: INTEGER);
BEGIN
Emit(opLEA, r + 256 * LGlobal, offset)
END GlobalAdr;
PROCEDURE StrAdr (r, offset: INTEGER);
BEGIN
Emit(opLEA, r + 256 * LStrings, offset)
END StrAdr;
PROCEDURE ProcAdr (r, label: INTEGER);
BEGIN
Emit(opLLA, r, label)
END ProcAdr;
PROCEDURE jnz (r, label: INTEGER);
BEGIN
Emit(opJNZ, r, label)
END jnz;
PROCEDURE CallRTL (proc, par: INTEGER);
BEGIN
Emit(opCALL, IL.codes.rtl[proc], 0);
addrc(SP, par * 4)
END CallRTL;
PROCEDURE translate;
VAR
cmd: IL.COMMAND;
opcode, param1, param2: INTEGER;
r1, r2, r3: INTEGER;
BEGIN
cmd := IL.codes.commands.first(IL.COMMAND);
WHILE cmd # NIL DO
param1 := cmd.param1;
param2 := cmd.param2;
opcode := cmd.opcode;
CASE opcode OF
|IL.opJMP:
Emit(opJMP, param1, 0)
|IL.opLABEL:
Emit(opLABEL, param1, 0)
|IL.opCALL:
Emit(opCALL, param1, 0)
|IL.opCALLP:
UnOp(r1);
Emit(opCALLI, r1, 0);
drop;
ASSERT(R.top = -1)
|IL.opPUSHC:
pushc(param2)
|IL.opCLEANUP:
IF param2 # 0 THEN
addrc(SP, param2 * 4)
END
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opSADR:
StrAdr(GetAnyReg(), param2)
|IL.opGADR:
GlobalAdr(GetAnyReg(), param2)
|IL.opLADR:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4)
|IL.opPARAM:
IF param2 = 1 THEN
UnOp(r1);
push(r1);
drop
ELSE
ASSERT(R.top + 1 <= param2);
PushAll(param2)
END
|IL.opONERR:
pushc(param2);
Emit(opJMP, param1, 0)
|IL.opPRECALL:
PushAll(0)
|IL.opRES, IL.opRESF:
ASSERT(R.top = -1);
GetAcc
|IL.opENTER:
ASSERT(R.top = -1);
Emit(opLABEL, param1, 0);
Emit(opENTER, param2, 0)
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode # IL.opLEAVE THEN
UnOp(r1);
IF r1 # ACC THEN
GetAcc;
ASSERT(REG.Exchange(R, r1, ACC));
drop
END;
drop
END;
ASSERT(R.top = -1);
IF param1 > 0 THEN
mov(SP, BP)
END;
pop(BP);
Emit(opRET, 0, 0)
|IL.opLEAVEC:
Emit(opRET, 0, 0)
|IL.opCONST:
movrc(GetAnyReg(), param2)
|IL.opDROP:
UnOp(r1);
drop
|IL.opSAVEC:
UnOp(r1);
Emit(opSTR32C, r1, param2);
drop
|IL.opSAVE8C:
UnOp(r1);
Emit(opSTR8C, r1, param2 MOD 256);
drop
|IL.opSAVE16C:
UnOp(r1);
Emit(opSTR16C, r1, param2 MOD 65536);
drop
|IL.opSAVE, IL.opSAVE32, IL.opSAVEF:
BinOp(r2, r1);
str32(r1, r2);
drop;
drop
|IL.opSAVEFI:
BinOp(r2, r1);
str32(r2, r1);
drop;
drop
|IL.opSAVE8:
BinOp(r2, r1);
str8(r1, r2);
drop;
drop
|IL.opSAVE16:
BinOp(r2, r1);
str16(r1, r2);
drop;
drop
|IL.opGLOAD32:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr32(r1, r1)
|IL.opVADR, IL.opLLOAD32:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr32(r1, r1)
|IL.opVLOAD32:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr32(r1, r1);
ldr32(r1, r1)
|IL.opGLOAD16:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr16(r1, r1)
|IL.opLLOAD16:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr16(r1, r1)
|IL.opVLOAD16:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr32(r1, r1);
ldr16(r1, r1)
|IL.opGLOAD8:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr8(r1, r1)
|IL.opLLOAD8:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr8(r1, r1)
|IL.opVLOAD8:
r1 := GetAnyReg();
mov(r1, BP);
addrc(r1, param2 * 4);
ldr32(r1, r1);
ldr8(r1, r1)
|IL.opLOAD8:
UnOp(r1);
ldr8(r1, r1)
|IL.opLOAD16:
UnOp(r1);
ldr16(r1, r1)
|IL.opLOAD32, IL.opLOADF:
UnOp(r1);
ldr32(r1, r1)
|IL.opLOOP, IL.opENDLOOP:
|IL.opUMINUS:
UnOp(r1);
Emit(opNEG, r1, 0)
|IL.opADD:
BinOp(r1, r2);
add(r1, r2);
drop
|IL.opSUB:
BinOp(r1, r2);
sub(r1, r2);
drop
|IL.opADDC:
UnOp(r1);
addrc(r1, param2)
|IL.opSUBR:
UnOp(r1);
subrc(r1, param2)
|IL.opSUBL:
UnOp(r1);
subrc(r1, param2);
Emit(opNEG, r1, 0)
|IL.opMULC:
UnOp(r1);
Emit(opMULC, r1, param2)
|IL.opMUL:
BinOp(r1, r2);
Emit(opMUL, r1, r2);
drop
|IL.opDIV:
BinOp(r1, r2);
Emit(opDIV, r1, r2);
drop
|IL.opMOD:
BinOp(r1, r2);
Emit(opMOD, r1, r2);
drop
|IL.opDIVR:
UnOp(r1);
Emit(opDIVC, r1, param2)
|IL.opMODR:
UnOp(r1);
Emit(opMODC, r1, param2)
|IL.opDIVL:
UnOp(r1);
r2 := GetAnyReg();
movrc(r2, param2);
Emit(opDIV, r2, r1);
mov(r1, r2);
drop
|IL.opMODL:
UnOp(r1);
r2 := GetAnyReg();
movrc(r2, param2);
Emit(opMOD, r2, r1);
mov(r1, r2);
drop
|IL.opEQ:
BinOp(r1, r2);
Emit(opEQ, r1, r2);
drop
|IL.opNE:
BinOp(r1, r2);
Emit(opNE, r1, r2);
drop
|IL.opLT:
BinOp(r1, r2);
Emit(opLT, r1, r2);
drop
|IL.opLE:
BinOp(r1, r2);
Emit(opLE, r1, r2);
drop
|IL.opGT:
BinOp(r1, r2);
Emit(opGT, r1, r2);
drop
|IL.opGE:
BinOp(r1, r2);
Emit(opGE, r1, r2);
drop
|IL.opEQC:
UnOp(r1);
Emit(opEQC, r1, param2)
|IL.opNEC:
UnOp(r1);
Emit(opNEC, r1, param2)
|IL.opLTC:
UnOp(r1);
Emit(opLTC, r1, param2)
|IL.opLEC:
UnOp(r1);
Emit(opLEC, r1, param2)
|IL.opGTC:
UnOp(r1);
Emit(opGTC, r1, param2)
|IL.opGEC:
UnOp(r1);
Emit(opGEC, r1, param2)
|IL.opJNZ1:
UnOp(r1);
jnz(r1, param1)
|IL.opJG:
UnOp(r1);
Emit(opJGZ, r1, param1)
|IL.opJNZ:
UnOp(r1);
jnz(r1, param1);
drop
|IL.opJZ:
UnOp(r1);
Emit(opJZ, r1, param1);
drop
|IL.opMULS:
BinOp(r1, r2);
Emit(opAND, r1, r2);
drop
|IL.opMULSC:
UnOp(r1);
Emit(opANDC, r1, param2)
|IL.opDIVS:
BinOp(r1, r2);
Emit(opXOR, r1, r2);
drop
|IL.opDIVSC:
UnOp(r1);
Emit(opXORC, r1, param2)
|IL.opADDS:
BinOp(r1, r2);
Emit(opOR, r1, r2);
drop
|IL.opSUBS:
BinOp(r1, r2);
Emit(opNOT, r2, 0);
Emit(opAND, r1, r2);
drop
|IL.opADDSC:
UnOp(r1);
Emit(opORC, r1, param2)
|IL.opSUBSL:
UnOp(r1);
Emit(opNOT, r1, 0);
Emit(opANDC, r1, param2)
|IL.opSUBSR:
UnOp(r1);
Emit(opANDC, r1, ORD(-BITS(param2)))
|IL.opUMINS:
UnOp(r1);
Emit(opNOT, r1, 0)
|IL.opASR:
BinOp(r1, r2);
Emit(opASR, r1, r2);
drop
|IL.opLSL:
BinOp(r1, r2);
Emit(opLSL, r1, r2);
drop
|IL.opROR:
BinOp(r1, r2);
Emit(opROR, r1, r2);
drop
|IL.opLSR:
BinOp(r1, r2);
Emit(opLSR, r1, r2);
drop
|IL.opASR1:
r2 := GetAnyReg();
Emit(opMOVC, r2, param2);
BinOp(r1, r2);
Emit(opASR, r2, r1);
mov(r1, r2);
drop
|IL.opLSL1:
r2 := GetAnyReg();
Emit(opMOVC, r2, param2);
BinOp(r1, r2);
Emit(opLSL, r2, r1);
mov(r1, r2);
drop
|IL.opROR1:
r2 := GetAnyReg();
Emit(opMOVC, r2, param2);
BinOp(r1, r2);
Emit(opROR, r2, r1);
mov(r1, r2);
drop
|IL.opLSR1:
r2 := GetAnyReg();
Emit(opMOVC, r2, param2);
BinOp(r1, r2);
Emit(opLSR, r2, r1);
mov(r1, r2);
drop
|IL.opASR2:
UnOp(r1);
Emit(opASRC, r1, param2 MOD 32)
|IL.opLSL2:
UnOp(r1);
Emit(opLSLC, r1, param2 MOD 32)
|IL.opROR2:
UnOp(r1);
Emit(opRORC, r1, param2 MOD 32)
|IL.opLSR2:
UnOp(r1);
Emit(opLSRC, r1, param2 MOD 32)
|IL.opCHR:
UnOp(r1);
Emit(opANDC, r1, 255)
|IL.opWCHR:
UnOp(r1);
Emit(opANDC, r1, 65535)
|IL.opABS:
UnOp(r1);
Emit(opABS, r1, 0)
|IL.opLEN:
UnOp(r1);
drop;
EXCL(R.regs, r1);
WHILE param2 > 0 DO
UnOp(r2);
drop;
DEC(param2)
END;
INCL(R.regs, r1);
ASSERT(REG.GetReg(R, r1))
|IL.opSWITCH:
UnOp(r1);
IF param2 = 0 THEN
r2 := ACC
ELSE
r2 := R1
END;
IF r1 # r2 THEN
ASSERT(REG.GetReg(R, r2));
ASSERT(REG.Exchange(R, r1, r2));
drop
END;
drop
|IL.opENDSW:
|IL.opCASEL:
GetAcc;
Emit(opJLA, param1, param2);
drop
|IL.opCASER:
GetAcc;
Emit(opJGA, param1, param2);
drop
|IL.opCASELR:
GetAcc;
Emit(opJLA, param1, param2);
Emit(opJGA, param1, cmd.param3);
drop
|IL.opSBOOL:
BinOp(r2, r1);
Emit(opNEC, r2, 0);
str8(r1, r2);
drop;
drop
|IL.opSBOOLC:
UnOp(r1);
Emit(opSTR8C, r1, ORD(param2 # 0));
drop
|IL.opINCC:
UnOp(r1);
r2 := GetAnyReg();
ldr32(r2, r1);
addrc(r2, param2);
str32(r1, r2);
drop;
drop
|IL.opINCCB, IL.opDECCB:
IF opcode = IL.opDECCB THEN
param2 := -param2
END;
UnOp(r1);
r2 := GetAnyReg();
ldr8(r2, r1);
addrc(r2, param2);
str8(r1, r2);
drop;
drop
|IL.opINCB, IL.opDECB:
BinOp(r2, r1);
r3 := GetAnyReg();
ldr8(r3, r1);
IF opcode = IL.opINCB THEN
add(r3, r2)
ELSE
sub(r3, r2)
END;
str8(r1, r3);
drop;
drop;
drop
|IL.opINC, IL.opDEC:
BinOp(r2, r1);
r3 := GetAnyReg();
ldr32(r3, r1);
IF opcode = IL.opINC THEN
add(r3, r2)
ELSE
sub(r3, r2)
END;
str32(r1, r3);
drop;
drop;
drop
|IL.opINCL, IL.opEXCL:
BinOp(r2, r1);
IF opcode = IL.opINCL THEN
Emit(opINCL, r1, r2)
ELSE
Emit(opEXCL, r1, r2)
END;
drop;
drop
|IL.opINCLC, IL.opEXCLC:
UnOp(r1);
r2 := GetAnyReg();
ldr32(r2, r1);
IF opcode = IL.opINCLC THEN
Emit(opINCLC, r2, param2)
ELSE
Emit(opEXCLC, r2, param2)
END;
str32(r1, r2);
drop;
drop
|IL.opEQB, IL.opNEB:
BinOp(r1, r2);
Emit(opNEC, r1, 0);
Emit(opNEC, r2, 0);
IF opcode = IL.opEQB THEN
Emit(opEQ, r1, r2)
ELSE
Emit(opNE, r1, r2)
END;
drop
|IL.opCHKBYTE:
BinOp(r1, r2);
r3 := GetAnyReg();
mov(r3, r1);
Emit(opBTC, r3, 256);
jnz(r3, param1);
drop
|IL.opCHKIDX:
UnOp(r1);
r2 := GetAnyReg();
mov(r2, r1);
Emit(opBTC, r2, param2);
jnz(r2, param1);
drop
|IL.opCHKIDX2:
BinOp(r1, r2);
IF param2 # -1 THEN
r3 := GetAnyReg();
mov(r3, r2);
Emit(opBT, r3, r1);
jnz(r3, param1);
drop
END;
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
|IL.opEQP, IL.opNEP:
ProcAdr(GetAnyReg(), param1);
BinOp(r1, r2);
IF opcode = IL.opEQP THEN
Emit(opEQ, r1, r2)
ELSE
Emit(opNE, r1, r2)
END;
drop
|IL.opSAVEP:
UnOp(r1);
r2 := GetAnyReg();
ProcAdr(r2, param2);
str32(r1, r2);
drop;
drop
|IL.opPUSHP:
ProcAdr(GetAnyReg(), param2)
|IL.opPUSHT:
UnOp(r1);
r2 := GetAnyReg();
mov(r2, r1);
subrc(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();
movrc(r1, param1)
END;
drop;
drop;
CASE param2 OF
|1: ldr8(r1, r1); str8(r2, r1)
|2: ldr16(r1, r1); str16(r2, r1)
|4: ldr32(r1, r1); str32(r2, r1)
END
|IL.opNOT:
UnOp(r1);
Emit(opEQC, r1, 0)
|IL.opORD:
UnOp(r1);
Emit(opNEC, r1, 0)
|IL.opMIN:
BinOp(r1, r2);
Emit(opMIN, r1, r2);
drop
|IL.opMAX:
BinOp(r1, r2);
Emit(opMAX, r1, r2);
drop
|IL.opMINC:
UnOp(r1);
Emit(opMINC, r1, param2)
|IL.opMAXC:
UnOp(r1);
Emit(opMAXC, r1, param2)
|IL.opIN:
BinOp(r1, r2);
Emit(opIN, r1, r2);
drop
|IL.opINL:
r1 := GetAnyReg();
movrc(r1, param2);
BinOp(r2, r1);
Emit(opIN, r1, r2);
mov(r2, r1);
drop
|IL.opINR:
UnOp(r1);
Emit(opINC, r1, param2)
|IL.opERR:
CallRTL(IL._error, 4)
|IL.opEQS .. IL.opGES:
PushAll(4);
pushc(opcode - IL.opEQS);
CallRTL(IL._strcmp, 5);
GetAcc
|IL.opEQSW .. IL.opGESW:
PushAll(4);
pushc(opcode - IL.opEQSW);
CallRTL(IL._strcmpw, 5);
GetAcc
|IL.opCOPY:
PushAll(2);
pushc(param2);
CallRTL(IL._move, 3)
|IL.opMOVE:
PushAll(3);
CallRTL(IL._move, 3)
|IL.opCOPYA:
PushAll(4);
pushc(param2);
CallRTL(IL._arrcpy, 5);
GetAcc
|IL.opCOPYS:
PushAll(4);
pushc(param2);
CallRTL(IL._strcpy, 5)
|IL.opROT:
PushAll(0);
mov(ACC, SP);
push(ACC);
pushc(param2);
CallRTL(IL._rot, 2)
|IL.opLENGTH:
PushAll(2);
CallRTL(IL._length, 2);
GetAcc
|IL.opLENGTHW:
PushAll(2);
CallRTL(IL._lengthw, 2);
GetAcc
|IL.opSAVES:
UnOp(r2);
REG.PushAll_1(R);
r1 := GetAnyReg();
StrAdr(r1, param2);
push(r1);
drop;
push(r2);
drop;
pushc(param1);
CallRTL(IL._move, 3)
|IL.opRSET:
PushAll(2);
CallRTL(IL._set, 2);
GetAcc
|IL.opRSETR:
PushAll(1);
pushc(param2);
CallRTL(IL._set, 2);
GetAcc
|IL.opRSETL:
UnOp(r1);
REG.PushAll_1(R);
pushc(param2);
push(r1);
drop;
CallRTL(IL._set, 2);
GetAcc
|IL.opRSET1:
PushAll(1);
CallRTL(IL._set1, 1);
GetAcc
|IL.opNEW:
PushAll(1);
INC(param2, 8);
ASSERT(UTILS.Align(param2, 32));
pushc(param2);
pushc(param1);
CallRTL(IL._new, 3)
|IL.opTYPEGP:
UnOp(r1);
PushAll(0);
push(r1);
pushc(param2);
CallRTL(IL._guard, 2);
GetAcc
|IL.opIS:
PushAll(1);
pushc(param2);
CallRTL(IL._is, 2);
GetAcc
|IL.opISREC:
PushAll(2);
pushc(param2);
CallRTL(IL._guardrec, 3);
GetAcc
|IL.opTYPEGR:
PushAll(1);
pushc(param2);
CallRTL(IL._guardrec, 2);
GetAcc
|IL.opTYPEGD:
UnOp(r1);
PushAll(0);
subrc(r1, 4);
ldr32(r1, r1);
push(r1);
pushc(param2);
CallRTL(IL._guardrec, 2);
GetAcc
|IL.opCASET:
push(R1);
push(R1);
pushc(param2);
CallRTL(IL._guardrec, 2);
pop(R1);
jnz(ACC, param1)
|IL.opCONSTF:
movrc(GetAnyReg(), UTILS.d2s(cmd.float))
|IL.opMULF:
PushAll(2);
CallRTL(IL._fmul, 2);
GetAcc
|IL.opDIVF:
PushAll(2);
CallRTL(IL._fdiv, 2);
GetAcc
|IL.opDIVFI:
PushAll(2);
CallRTL(IL._fdivi, 2);
GetAcc
|IL.opADDF:
PushAll(2);
CallRTL(IL._fadd, 2);
GetAcc
|IL.opSUBFI:
PushAll(2);
CallRTL(IL._fsubi, 2);
GetAcc
|IL.opSUBF:
PushAll(2);
CallRTL(IL._fsub, 2);
GetAcc
|IL.opEQF..IL.opGEF:
PushAll(2);
pushc(opcode - IL.opEQF);
CallRTL(IL._fcmp, 3);
GetAcc
|IL.opFLOOR:
PushAll(1);
CallRTL(IL._floor, 1);
GetAcc
|IL.opFLT:
PushAll(1);
CallRTL(IL._flt, 1);
GetAcc
|IL.opUMINF:
UnOp(r1);
Emit(opXORC, r1, ORD({31}))
|IL.opFABS:
UnOp(r1);
Emit(opANDC, r1, ORD({0..30}))
|IL.opINF:
movrc(GetAnyReg(), inf)
|IL.opPUSHF:
UnOp(r1);
push(r1);
drop
|IL.opPACK:
PushAll(2);
CallRTL(IL._pack, 2)
|IL.opPACKC:
PushAll(1);
pushc(param2);
CallRTL(IL._pack, 2)
|IL.opUNPK:
PushAll(2);
CallRTL(IL._unpk, 2)
|IL.opCODE:
OutInt(param2)
END;
cmd := cmd.next(IL.COMMAND)
END;
ASSERT(R.pushed = 0);
ASSERT(R.top = -1)
END translate;
PROCEDURE prolog;
BEGIN
Emit(opLEA, SP + LStack * 256, 0);
Emit(opLEA, ACC + LTypes * 256, 0);
push(ACC);
Emit(opLEA, ACC + LHeap * 256, 0);
push(ACC);
pushc(CHL.Length(IL.codes.types));
CallRTL(IL._init, 3)
END prolog;
PROCEDURE epilog (ram: INTEGER);
VAR
tcount, dcount, i, offTypes, offStrings, szData, szGlobal, szHeapStack: INTEGER;
BEGIN
Emit(opSTOP, 0, 0);
offTypes := count;
tcount := CHL.Length(IL.codes.types);
FOR i := 0 TO tcount - 1 DO
OutInt(CHL.GetInt(IL.codes.types, i))
END;
offStrings := count;
dcount := CHL.Length(IL.codes.data);
FOR i := 0 TO dcount - 1 DO
OutByte(CHL.GetByte(IL.codes.data, i))
END;
IF dcount MOD 4 # 0 THEN
i := 4 - dcount MOD 4;
WHILE i > 0 DO
OutByte(0);
DEC(i)
END
END;
szData := count - offTypes;
szGlobal := (IL.codes.bss DIV 4 + 1) * 4;
szHeapStack := ram - szData - szGlobal;
OutInt(offTypes);
OutInt(offStrings);
OutInt(szGlobal DIV 4);
OutInt(szHeapStack DIV 4);
FOR i := 1 TO 8 DO
OutInt(0)
END
END epilog;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
CONST
minRAM = 32*1024;
maxRAM = 256*1024;
VAR
szData, szRAM: INTEGER;
BEGIN
szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV 4 + IL.codes.bss DIV 4 + 2) * 4;
szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
IF szRAM - szData < 1024*1024 THEN
ERRORS.Error(208)
END;
count := 0;
WR.Create(outname);
REG.Init(R, push, pop, mov, xchg, NIL, NIL, GPRs, {});
prolog;
translate;
epilog(szRAM);
WR.Close
END CodeGen;
END RVM32I.

/programs/develop/oberon07/Source/SCAN.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 SCAN;
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
CONST
48,6 → 48,12
LEXSTR* = ARRAY LEXLEN OF CHAR;
DEF = POINTER TO RECORD (LISTS.ITEM)
ident: LEXSTR
END;
IDENT* = POINTER TO RECORD (AVL.DATA)
s*: LEXSTR;
88,9 → 94,11
NewIdent: IDENT;
upto: BOOLEAN;
upto, LowerCase, _if: BOOLEAN;
def: LISTS.LIST;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
END nodecmp;
166,7 → 174,7
VAR
c: CHAR;
hex: BOOLEAN;
error: INTEGER;
error, sym: INTEGER;
BEGIN
c := text.peak;
174,7 → 182,7
error := 0;
lex.sym := lxINTEGER;
sym := lxINTEGER;
hex := FALSE;
WHILE S.digit(c) DO
191,17 → 199,17
IF c = "H" THEN
putchar(lex, c);
TXT.next(text);
lex.sym := lxHEX
sym := lxHEX
ELSIF c = "X" THEN
putchar(lex, c);
TXT.next(text);
lex.sym := lxCHAR
sym := lxCHAR
ELSIF c = "." THEN
IF hex THEN
lex.sym := lxERROR01
sym := lxERROR01
ELSE
c := nextc(text);
208,9 → 216,9
IF c # "." THEN
putchar(lex, ".");
lex.sym := lxFLOAT
sym := lxFLOAT
ELSE
lex.sym := lxINTEGER;
sym := lxINTEGER;
text.peak := 7FX;
upto := TRUE
END;
235,7 → 243,7
c := nextc(text)
END
ELSE
lex.sym := lxERROR02
sym := lxERROR02
END
END
243,31 → 251,32
END
ELSIF hex THEN
lex.sym := lxERROR01
sym := lxERROR01
END;
IF lex.over & (lex.sym >= 0) THEN
lex.sym := lxERROR07
IF lex.over & (sym >= 0) THEN
sym := lxERROR07
END;
IF lex.sym = lxINTEGER THEN
IF sym = lxINTEGER THEN
ARITH.iconv(lex.s, lex.value, error)
ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN
ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
ARITH.hconv(lex.s, lex.value, error)
ELSIF lex.sym = lxFLOAT THEN
ELSIF sym = lxFLOAT THEN
ARITH.fconv(lex.s, lex.value, error)
END;
CASE error OF
|0:
|1: lex.sym := lxERROR08
|2: lex.sym := lxERROR09
|3: lex.sym := lxERROR10
|4: lex.sym := lxERROR11
|5: lex.sym := lxERROR12
END
|1: sym := lxERROR08
|2: sym := lxERROR09
|3: sym := lxERROR10
|4: sym := lxERROR11
|5: sym := lxERROR12
END;
lex.sym := sym
END number;
349,6 → 358,9
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
VAR
sym: INTEGER;
BEGIN
putchar(lex, c);
c := nextc(text);
355,19 → 367,19
CASE lex.s[0] OF
|"+":
lex.sym := lxPLUS
sym := lxPLUS
|"-":
lex.sym := lxMINUS
sym := lxMINUS
|"*":
lex.sym := lxMUL
sym := lxMUL
|"/":
lex.sym := lxSLASH;
sym := lxSLASH;
IF c = "/" THEN
lex.sym := lxCOMMENT;
sym := lxCOMMENT;
REPEAT
TXT.next(text)
UNTIL text.eol OR text.eof
374,91 → 386,93
END
|"~":
lex.sym := lxNOT
sym := lxNOT
|"&":
lex.sym := lxAND
sym := lxAND
|".":
lex.sym := lxPOINT;
sym := lxPOINT;
IF c = "." THEN
lex.sym := lxRANGE;
sym := lxRANGE;
putchar(lex, c);
TXT.next(text)
END
|",":
lex.sym := lxCOMMA
sym := lxCOMMA
|";":
lex.sym := lxSEMI
sym := lxSEMI
|"|":
lex.sym := lxBAR
sym := lxBAR
|"(":
lex.sym := lxLROUND;
sym := lxLROUND;
IF c = "*" THEN
lex.sym := lxCOMMENT;
sym := lxCOMMENT;
TXT.next(text);
comment(text)
END
|"[":
lex.sym := lxLSQUARE
sym := lxLSQUARE
|"{":
lex.sym := lxLCURLY
sym := lxLCURLY
|"^":
lex.sym := lxCARET
sym := lxCARET
|"=":
lex.sym := lxEQ
sym := lxEQ
|"#":
lex.sym := lxNE
sym := lxNE
|"<":
lex.sym := lxLT;
sym := lxLT;
IF c = "=" THEN
lex.sym := lxLE;
sym := lxLE;
putchar(lex, c);
TXT.next(text)
END
|">":
lex.sym := lxGT;
sym := lxGT;
IF c = "=" THEN
lex.sym := lxGE;
sym := lxGE;
putchar(lex, c);
TXT.next(text)
END
|":":
lex.sym := lxCOLON;
sym := lxCOLON;
IF c = "=" THEN
lex.sym := lxASSIGN;
sym := lxASSIGN;
putchar(lex, c);
TXT.next(text)
END
|")":
lex.sym := lxRROUND
sym := lxRROUND
|"]":
lex.sym := lxRSQUARE
sym := lxRSQUARE
|"}":
lex.sym := lxRCURLY
sym := lxRCURLY
END
END;
lex.sym := sym
END delimiter;
466,9 → 480,110
VAR
c: CHAR;
PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER);
BEGIN
IF ~cond THEN
ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno)
END
END check;
PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN;
VAR
cur: DEF;
BEGIN
cur := def.first(DEF);
WHILE (cur # NIL) & (cur.ident # str) DO
cur := cur.next(DEF)
END
RETURN cur # NIL
END IsDef;
PROCEDURE Skip (text: SCANNER);
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (i <= text.ifc) & ~text._skip[i] DO
INC(i)
END;
text.skip := i <= text.ifc
END Skip;
PROCEDURE prep_if (text: SCANNER; VAR lex: LEX);
VAR
skip: BOOLEAN;
BEGIN
INC(text.ifc);
text._elsif[text.ifc] := lex.sym = lxELSIF;
IF lex.sym = lxIF THEN
INC(text.elsec);
text._else[text.elsec] := FALSE
END;
_if := TRUE;
skip := TRUE;
text.skip := FALSE;
Next(text, lex);
check(lex.sym = lxLROUND, text, lex, 64);
Next(text, lex);
check(lex.sym = lxIDENT, text, lex, 22);
REPEAT
IF IsDef(lex.s) THEN
skip := FALSE
END;
Next(text, lex);
IF lex.sym = lxBAR THEN
Next(text, lex);
check(lex.sym = lxIDENT, text, lex, 22)
ELSE
check(lex.sym = lxRROUND, text, lex, 33)
END
UNTIL lex.sym = lxRROUND;
_if := FALSE;
text._skip[text.ifc] := skip;
Skip(text);
Next(text, lex)
END prep_if;
PROCEDURE prep_end (text: SCANNER; VAR lex: LEX);
BEGIN
check(text.ifc > 0, text, lex, 118);
IF lex.sym = lxEND THEN
WHILE text._elsif[text.ifc] DO
DEC(text.ifc)
END;
DEC(text.ifc);
DEC(text.elsec)
ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
check(~text._else[text.elsec], text, lex, 118);
text._skip[text.ifc] := ~text._skip[text.ifc];
text._else[text.elsec] := lex.sym = lxELSE
END;
Skip(text);
IF lex.sym = lxELSIF THEN
prep_if(text, lex)
ELSE
Next(text, lex)
END
END prep_end;
BEGIN
REPEAT
c := text.peak;
WHILE S.space(c) DO
490,8 → 605,26
string(text, lex, c)
ELSIF delimiters[ORD(c)] THEN
delimiter(text, lex, c)
ELSIF c = "$" THEN
IF S.letter(nextc(text)) THEN
ident(text, lex);
IF lex.sym = lxIF THEN
IF ~_if THEN
prep_if(text, lex)
END
ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
IF ~_if THEN
prep_end(text, lex)
END
ELSE
check(FALSE, text, lex, 119)
END
ELSE
check(FALSE, text, lex, 119)
END
ELSIF c = 0X THEN
lex.sym := lxEOF;
text.skip := FALSE;
IF text.eof THEN
INC(lex.pos.col)
END
514,7 → 647,7
lex.error := 0
END
UNTIL lex.sym # lxCOMMENT
UNTIL (lex.sym # lxCOMMENT) & ~text.skip
END Next;
530,7 → 663,7
END close;
PROCEDURE init;
PROCEDURE init* (lower: BOOLEAN);
VAR
i: INTEGER;
delim: ARRAY 23 OF CHAR;
539,15 → 672,23
PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
VAR
id: IDENT;
upper: LEXSTR;
BEGIN
IF LowerCase THEN
id := enterid(kw);
id.key := key
END;
upper := kw;
S.UpCase(upper);
id := enterid(upper);
id.key := key
END enterkw;
BEGIN
upto := FALSE;
LowerCase := lower;
FOR i := 0 TO 255 DO
delimiters[i] := FALSE
567,43 → 708,54
idents := NIL;
enterkw(lxARRAY, "ARRAY");
enterkw(lxBEGIN, "BEGIN");
enterkw(lxBY, "BY");
enterkw(lxCASE, "CASE");
enterkw(lxCONST, "CONST");
enterkw(lxDIV, "DIV");
enterkw(lxDO, "DO");
enterkw(lxELSE, "ELSE");
enterkw(lxELSIF, "ELSIF");
enterkw(lxEND, "END");
enterkw(lxFALSE, "FALSE");
enterkw(lxFOR, "FOR");
enterkw(lxIF, "IF");
enterkw(lxIMPORT, "IMPORT");
enterkw(lxIN, "IN");
enterkw(lxIS, "IS");
enterkw(lxMOD, "MOD");
enterkw(lxMODULE, "MODULE");
enterkw(lxNIL, "NIL");
enterkw(lxOF, "OF");
enterkw(lxOR, "OR");
enterkw(lxPOINTER, "POINTER");
enterkw(lxPROCEDURE, "PROCEDURE");
enterkw(lxRECORD, "RECORD");
enterkw(lxREPEAT, "REPEAT");
enterkw(lxRETURN, "RETURN");
enterkw(lxTHEN, "THEN");
enterkw(lxTO, "TO");
enterkw(lxTRUE, "TRUE");
enterkw(lxTYPE, "TYPE");
enterkw(lxUNTIL, "UNTIL");
enterkw(lxVAR, "VAR");
enterkw(lxWHILE, "WHILE")
enterkw(lxARRAY, "array");
enterkw(lxBEGIN, "begin");
enterkw(lxBY, "by");
enterkw(lxCASE, "case");
enterkw(lxCONST, "const");
enterkw(lxDIV, "div");
enterkw(lxDO, "do");
enterkw(lxELSE, "else");
enterkw(lxELSIF, "elsif");
enterkw(lxEND, "end");
enterkw(lxFALSE, "false");
enterkw(lxFOR, "for");
enterkw(lxIF, "if");
enterkw(lxIMPORT, "import");
enterkw(lxIN, "in");
enterkw(lxIS, "is");
enterkw(lxMOD, "mod");
enterkw(lxMODULE, "module");
enterkw(lxNIL, "nil");
enterkw(lxOF, "of");
enterkw(lxOR, "or");
enterkw(lxPOINTER, "pointer");
enterkw(lxPROCEDURE, "procedure");
enterkw(lxRECORD, "record");
enterkw(lxREPEAT, "repeat");
enterkw(lxRETURN, "return");
enterkw(lxTHEN, "then");
enterkw(lxTO, "to");
enterkw(lxTRUE, "true");
enterkw(lxTYPE, "type");
enterkw(lxUNTIL, "until");
enterkw(lxVAR, "var");
enterkw(lxWHILE, "while")
END init;
PROCEDURE NewDef* (str: ARRAY OF CHAR);
VAR
item: DEF;
BEGIN
init
NEW(item);
COPY(str, item.ident);
LISTS.push(def, item)
END NewDef;
BEGIN
def := LISTS.create(NIL)
END SCAN.

/programs/develop/oberon07/Source/STATEMENTS.ob07
9,7 → 9,7
IMPORT
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB,
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVM32I,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
48,7 → 48,7
variant, self: INTEGER;
type: PROG.TYPE_;
_type: PROG._TYPE;
prev: CASE_LABEL
75,7 → 75,7
CPU: INTEGER;
tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_;
tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE;
PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
89,17 → 89,17
PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tBOOLEAN)
RETURN isExpr(e) & (e._type = tBOOLEAN)
END isBoolean;
PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tINTEGER)
RETURN isExpr(e) & (e._type = tINTEGER)
END isInteger;
PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tBYTE)
RETURN isExpr(e) & (e._type = tBYTE)
END isByte;
109,42 → 109,42
PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tREAL)
RETURN isExpr(e) & (e._type = tREAL)
END isReal;
PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tSET)
RETURN isExpr(e) & (e._type = tSET)
END isSet;
PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR})
RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR})
END isString;
PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
END isStringW;
PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tCHAR)
RETURN isExpr(e) & (e._type = tCHAR)
END isChar;
PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tWCHAR)
RETURN isExpr(e) & (e._type = tWCHAR)
END isCharW;
PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)
RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER)
END isPtr;
PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tRECORD)
RETURN isExpr(e) & (e._type.typ = PROG.tRECORD)
END isRec;
154,27 → 154,27
PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)
RETURN isExpr(e) & (e._type.typ = PROG.tARRAY)
END isArr;
PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
END isProc;
PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
RETURN e.type.typ = PROG.tNIL
RETURN e._type.typ = PROG.tNIL
END isNil;
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
RETURN isArr(e) & (e.type.base = tCHAR)
RETURN isArr(e) & (e._type.base = tCHAR)
END isCharArray;
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
RETURN isArr(e) & (e.type.base = tWCHAR)
RETURN isArr(e) & (e._type.base = tWCHAR)
END isCharArrayW;
204,7 → 204,7
BEGIN
ASSERT(isString(e));
IF e.type = tCHAR THEN
IF e._type = tCHAR THEN
res := 1
ELSE
res := LENGTH(e.value.string(SCAN.IDENT).s)
237,7 → 237,7
BEGIN
ASSERT(isStringW(e));
IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
res := 1
ELSE
res := _length(e.value.string(SCAN.IDENT).s)
257,11 → 257,11
PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
RETURN isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
END isStringW1;
PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN;
PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN;
VAR
res: BOOLEAN;
268,7 → 268,7
BEGIN
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
IF t = e.type THEN
IF t = e._type THEN
res := TRUE
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
IF (e.obj = eCONST) & (t = tBYTE) THEN
279,10 → 279,10
ELSIF
(e.obj = eCONST) & isChar(e) & (t = tWCHAR)
OR isStringW1(e) & (t = tWCHAR)
OR PROG.isBaseOf(t, e.type)
OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type)
OR PROG.isBaseOf(t, e._type)
OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(t, e._type)
OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
OR PROG.arrcomp(e.type, t)
OR PROG.arrcomp(e._type, t)
OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
THEN
331,9 → 331,9
END;
offset := string.offsetW
ELSE
IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
offset := IL.putstrW1(ARITH.Int(e.value))
ELSE (* e.type.typ = PROG.tSTRING *)
ELSE (* e._type.typ = PROG.tSTRING *)
string := e.value.string(SCAN.IDENT);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
358,8 → 358,18
END CheckRange;
PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN;
PROCEDURE Float (parser: PARS.PARSER; e: PARS.EXPR);
VAR
pos: PARS.POSITION;
BEGIN
getpos(parser, pos);
IL.Float(ARITH.Float(e.value), pos.line, pos.col)
END Float;
PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
label: INTEGER;
366,7 → 376,7
BEGIN
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
res := TRUE;
IF PROG.arrcomp(e.type, VarType) THEN
IF PROG.arrcomp(e._type, VarType) THEN
IF ~PROG.isOpenArray(VarType) THEN
IL.Const(VarType.length)
373,7 → 383,7
END;
IL.AddCmd(IL.opCOPYA, VarType.base.size);
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJE, label);
IL.AddJmpCmd(IL.opJNZ, label);
IL.OnError(line, errCOPY);
IL.SetLabel(label)
414,7 → 424,7
END
ELSIF isReal(e) & (VarType = tREAL) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
Float(parser, e)
END;
IL.savef(e.obj = eCONST)
ELSIF isChar(e) & (VarType = tCHAR) THEN
433,19 → 443,19
ELSE
IL.AddCmd0(IL.opSAVE16)
END
ELSIF PROG.isBaseOf(VarType, e.type) THEN
ELSIF PROG.isBaseOf(VarType, e._type) THEN
IF VarType.typ = PROG.tPOINTER THEN
IL.AddCmd0(IL.opSAVE)
ELSE
IL.AddCmd(IL.opCOPY, VarType.size)
END
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
IL.AddCmd0(IL.opSAVE32)
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN
IF e.obj = ePROC THEN
IL.AssignProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.AssignImpProc(e.ident.import)
IL.AssignImpProc(e.ident._import)
ELSE
IF VarType.typ = PROG.tPROCEDURE THEN
IL.AddCmd0(IL.opSAVE)
481,11 → 491,11
PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
VAR
t1, t2: PROG.TYPE_;
t1, t2: PROG._TYPE;
BEGIN
t1 := p.type;
t2 := e.type;
t1 := p._type;
t2 := e._type;
WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
t1 := t1.base;
t2 := t2.base
495,7 → 505,7
END arrcomp;
PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER;
PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER;
VAR
res: INTEGER;
510,7 → 520,7
END ArrLen;
PROCEDURE OpenArray (t, t2: PROG.TYPE_);
PROCEDURE OpenArray (t, t2: PROG._TYPE);
VAR
n, d1, d2: INTEGER;
547,8 → 557,8
IF p.vPar THEN
PARS.check(isVar(e), pos, 93);
IF p.type.typ = PROG.tRECORD THEN
PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66);
IF p._type.typ = PROG.tRECORD THEN
PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66);
IF e.obj = eVREC THEN
IF e.ident # NIL THEN
IL.AddCmd(IL.opVADR, e.ident.offset - 1)
556,14 → 566,14
IL.AddCmd0(IL.opPUSHT)
END
ELSE
IL.Const(e.type.num)
IL.Const(e._type.num)
END;
IL.AddCmd(IL.opPARAM, 2)
ELSIF PROG.isOpenArray(p.type) THEN
ELSIF PROG.isOpenArray(p._type) THEN
PARS.check(arrcomp(e, p), pos, 66);
OpenArray(e.type, p.type)
OpenArray(e._type, p._type)
ELSE
PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66);
PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66);
IL.Param1
END;
PARS.check(~e.readOnly, pos, 94)
570,16 → 580,16
ELSE
PARS.check(isExpr(e) OR isProc(e), pos, 66);
IF PROG.isOpenArray(p.type) THEN
IF e.type.typ = PROG.tARRAY THEN
IF PROG.isOpenArray(p._type) THEN
IF e._type.typ = PROG.tARRAY THEN
PARS.check(arrcomp(e, p), pos, 66);
OpenArray(e.type, p.type)
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN
OpenArray(e._type, p._type)
ELSIF isString(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tCHAR) THEN
IL.StrAdr(String(e));
IL.Param1;
IL.Const(strlen(e) + 1);
IL.Param1
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN
ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN
IL.StrAdr(StringW(e));
IL.Param1;
IL.Const(utf8strlen(e) + 1);
588,24 → 598,24
PARS.error(pos, 66)
END
ELSE
PARS.check(~PROG.isOpenArray(e.type), pos, 66);
PARS.check(assigncomp(e, p.type), pos, 66);
PARS.check(~PROG.isOpenArray(e._type), pos, 66);
PARS.check(assigncomp(e, p._type), pos, 66);
IF e.obj = eCONST THEN
IF e.type = tREAL THEN
IL.Float(ARITH.Float(e.value));
IL.pushf
ELSIF e.type.typ = PROG.tNIL THEN
IF e._type = tREAL THEN
Float(parser, e);
IL.AddCmd0(IL.opPUSHF)
ELSIF e._type.typ = PROG.tNIL THEN
IL.Const(0);
IL.Param1
ELSIF isStringW1(e) & (p.type = tWCHAR) THEN
ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
IL.Param1
ELSIF (e.type.typ = PROG.tSTRING) OR
(e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
IF p.type.base = tCHAR THEN
ELSIF (e._type.typ = PROG.tSTRING) OR
(e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
IF p._type.base = tCHAR THEN
stroffs := String(e);
IL.StrAdr(stroffs);
IF (CPU = TARGETS.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 *)
612,7 → 622,7
stroffs := StringW(e);
IL.StrAdr(stroffs)
END;
IL.set_dmin(stroffs + p.type.size);
IL.set_dmin(stroffs + p._type.size);
IL.Param1
ELSE
LoadConst(e);
623,12 → 633,12
IL.PushProc(e.ident.proc.label);
IL.Param1
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import);
IL.PushImpProc(e.ident._import);
IL.Param1
ELSIF isExpr(e) & (e.type = tREAL) THEN
IL.pushf
ELSIF isExpr(e) & (e._type = tREAL) THEN
IL.AddCmd0(IL.opPUSHF)
ELSE
IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN
IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN
CheckRange(256, pos.line, errBYTE)
END;
IL.Param1
651,6 → 661,7
pos: PARS.POSITION;
proc,
label,
size,
n, i: INTEGER;
code: ARITH.VALUE;
wchar,
716,7 → 727,8
END
ELSE
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJE, label);
IL.not;
IL.AndOrOpt(label);
IL.OnError(pos.line, errASSERT);
IL.SetLabel(label)
END
724,7 → 736,7
|PROG.stINC, PROG.stDEC:
IL.pushBegEnd(begcall, endcall);
varparam(parser, pos, isInt, TRUE, e);
IF e.type = tINTEGER THEN
IF e._type = tINTEGER THEN
IF parser.sym = SCAN.lxCOMMA THEN
NextPos(parser, pos);
IL.setlast(begcall);
739,7 → 751,7
ELSE
IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
END
ELSE (* e.type = tBYTE *)
ELSE (* e._type = tBYTE *)
IF parser.sym = SCAN.lxCOMMA THEN
NextPos(parser, pos);
IL.setlast(begcall);
777,9 → 789,9
|PROG.stNEW:
varparam(parser, pos, isPtr, TRUE, e);
IF CPU = TARGETS.cpuMSP430 THEN
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63)
PARS.check(e._type.base.size + 16 < Options.ram, pos, 63)
END;
IL.New(e.type.base.size, e.type.base.num)
IL.New(e._type.base.size, e._type.base.num)
|PROG.stDISPOSE:
varparam(parser, pos, isPtr, TRUE, e);
815,8 → 827,8
PARS.error(pos, 66)
END;
IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
IL.Const(e.type.length)
IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN
IL.Const(e._type.length)
END;
PARS.checklex(parser, SCAN.lxCOMMA);
832,11 → 844,11
varparam(parser, pos, isCharArray, TRUE, e1)
END;
wchar := e1.type.base = tWCHAR
wchar := e1._type.base = tWCHAR
END;
IF ~PROG.isOpenArray(e1.type) THEN
IL.Const(e1.type.length)
IF ~PROG.isOpenArray(e1._type) THEN
IL.Const(e1._type.length)
END;
IL.setlast(endcall.prev(IL.COMMAND));
850,10 → 862,10
IL.Const(strlen(e) + 1)
END
END;
IL.AddCmd(IL.opCOPYS, e1.type.base.size);
IL.AddCmd(IL.opCOPYS, e1._type.base.size);
IL.popBegEnd(begcall, endcall)
|PROG.sysGET:
|PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
PARS.checklex(parser, SCAN.lxCOMMA);
860,11 → 872,25
NextPos(parser, pos);
parser.designator(parser, e2);
PARS.check(isVar(e2), pos, 93);
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
IF proc = PROG.sysGET THEN
PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66)
ELSE
PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66)
END;
CASE proc OF
|PROG.sysGET: size := e2._type.size
|PROG.sysGET8: size := 1
|PROG.sysGET16: size := 2
|PROG.sysGET32: size := 4
END;
PARS.check(size <= e2._type.size, pos, 66);
IF e.obj = eCONST THEN
IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size)
IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size)
ELSE
IL.AddCmd(IL.opGET, e2.type.size)
IL.AddCmd(IL.opGET, size)
END
|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
881,39 → 907,40
PARS.check(isExpr(e2), pos, 66);
IF proc = PROG.sysPUT THEN
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
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));
IF e2._type = tREAL THEN
Float(parser, e2);
IL.setlast(endcall.prev(IL.COMMAND));
IL.savef(FALSE)
ELSE
LoadConst(e2);
IL.setlast(endcall.prev(IL.COMMAND));
IL.SysPut(e2.type.size)
IL.SysPut(e2._type.size)
END
ELSE
IL.setlast(endcall.prev(IL.COMMAND));
IF e2.type = tREAL THEN
IF e2._type = tREAL THEN
IL.savef(FALSE)
ELSIF e2.type = tBYTE THEN
ELSIF e2._type = tBYTE THEN
IL.SysPut(tINTEGER.size)
ELSE
IL.SysPut(e2.type.size)
IL.SysPut(e2._type.size)
END
END
ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
IF e2.obj = eCONST THEN
LoadConst(e2)
END;
IL.setlast(endcall.prev(IL.COMMAND));
CASE proc OF
|PROG.sysPUT8: IL.SysPut(1)
|PROG.sysPUT16: IL.SysPut(2)
|PROG.sysPUT32: IL.SysPut(4)
END
|PROG.sysPUT8: size := 1
|PROG.sysPUT16: size := 2
|PROG.sysPUT32: size := 4
END;
IL.SysPut(size)
END;
IL.popBegEnd(begcall, endcall)
940,7 → 967,7
FOR i := 1 TO 2 DO
parser.designator(parser, e);
PARS.check(isVar(e), pos, 93);
n := PROG.Dim(e.type);
n := PROG.Dim(e._type);
WHILE n > 0 DO
IL.drop;
DEC(n)
961,10 → 988,11
getpos(parser, pos);
PARS.ConstExpression(parser, code);
PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
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)
IF TARGETS.WordSize > TARGETS.InstrSize THEN
CASE TARGETS.InstrSize OF
|1: PARS.check(ARITH.range(code, 0, 255), pos, 42)
|2: PARS.check(ARITH.range(code, 0, 65535), pos, 110)
END
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
991,7 → 1019,7
END;
e.obj := eEXPR;
e.type := NIL
e._type := NIL
ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
1012,7 → 1040,7
NextPos(parser, pos);
PExpression(parser, e2);
PARS.check(isInt(e2), pos, 66);
e.type := tINTEGER;
e._type := tINTEGER;
IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
ELSE
1029,7 → 1057,7
|PROG.stCHR:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tCHAR;
e._type := tCHAR;
IF e.obj = eCONST THEN
ARITH.setChar(e.value, ARITH.getInt(e.value));
PARS.check(ARITH.check(e.value), pos, 107)
1044,7 → 1072,7
|PROG.stWCHR:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tWCHAR;
e._type := tWCHAR;
IF e.obj = eCONST THEN
ARITH.setWChar(e.value, ARITH.getInt(e.value));
PARS.check(ARITH.check(e.value), pos, 101)
1059,58 → 1087,58
|PROG.stFLOOR:
PExpression(parser, e);
PARS.check(isReal(e), pos, 66);
e.type := tINTEGER;
e._type := tINTEGER;
IF e.obj = eCONST THEN
PARS.check(ARITH.floor(e.value), pos, 39)
ELSE
IL.floor
IL.AddCmd0(IL.opFLOOR)
END
|PROG.stFLT:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tREAL;
e._type := tREAL;
IF e.obj = eCONST THEN
ARITH.flt(e.value)
ELSE
PARS.check(IL.flt(), pos, 41)
IL.AddCmd2(IL.opFLT, pos.line, pos.col)
END
|PROG.stLEN:
cmd1 := IL.getlast();
varparam(parser, pos, isArr, FALSE, e);
IF e.type.length > 0 THEN
IF e._type.length > 0 THEN
cmd2 := IL.getlast();
IL.delete2(cmd1.next, cmd2);
IL.setlast(cmd1);
ASSERT(ARITH.setInt(e.value, e.type.length));
ASSERT(ARITH.setInt(e.value, e._type.length));
e.obj := eCONST
ELSE
IL.len(PROG.Dim(e.type))
IL.len(PROG.Dim(e._type))
END;
e.type := tINTEGER
e._type := tINTEGER
|PROG.stLENGTH:
PExpression(parser, e);
IF isCharArray(e) THEN
IF e.type.length > 0 THEN
IL.Const(e.type.length)
IF e._type.length > 0 THEN
IL.Const(e._type.length)
END;
IL.AddCmd0(IL.opLENGTH)
ELSIF isCharArrayW(e) THEN
IF e.type.length > 0 THEN
IL.Const(e.type.length)
IF e._type.length > 0 THEN
IL.Const(e._type.length)
END;
IL.AddCmd0(IL.opLENGTHW)
ELSE
PARS.error(pos, 66);
END;
e.type := tINTEGER
e._type := tINTEGER
|PROG.stODD:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tBOOLEAN;
e._type := tBOOLEAN;
IF e.obj = eCONST THEN
ARITH.odd(e.value)
ELSE
1128,10 → 1156,10
END
ELSE
IF isBoolean(e) THEN
IL.AddCmd0(IL.opORD)
IL._ord
END
END;
e.type := tINTEGER
e._type := tINTEGER
|PROG.stBITS:
PExpression(parser, e);
1139,12 → 1167,12
IF e.obj = eCONST THEN
ARITH.bits(e.value)
END;
e.type := tSET
e._type := tSET
|PROG.sysADR:
parser.designator(parser, e);
IF isVar(e) THEN
n := PROG.Dim(e.type);
n := PROG.Dim(e._type);
WHILE n > 0 DO
IL.drop;
DEC(n)
1152,17 → 1180,17
ELSIF e.obj = ePROC THEN
IL.PushProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import)
IL.PushImpProc(e.ident._import)
ELSE
PARS.error(pos, 108)
END;
e.type := tINTEGER
e._type := tINTEGER
|PROG.sysSADR:
PExpression(parser, e);
PARS.check(isString(e), pos, 66);
IL.StrAdr(String(e));
e.type := tINTEGER;
e._type := tINTEGER;
e.obj := eEXPR
|PROG.sysWSADR:
1169,33 → 1197,33
PExpression(parser, e);
PARS.check(isStringW(e), pos, 66);
IL.StrAdr(StringW(e));
e.type := tINTEGER;
e._type := tINTEGER;
e.obj := eEXPR
|PROG.sysTYPEID:
PExpression(parser, e);
PARS.check(e.obj = eTYPE, pos, 68);
IF e.type.typ = PROG.tRECORD THEN
ASSERT(ARITH.setInt(e.value, e.type.num))
ELSIF e.type.typ = PROG.tPOINTER THEN
ASSERT(ARITH.setInt(e.value, e.type.base.num))
IF e._type.typ = PROG.tRECORD THEN
ASSERT(ARITH.setInt(e.value, e._type.num))
ELSIF e._type.typ = PROG.tPOINTER THEN
ASSERT(ARITH.setInt(e.value, e._type.base.num))
ELSE
PARS.error(pos, 52)
END;
e.obj := eCONST;
e.type := tINTEGER
e._type := tINTEGER
|PROG.sysINF:
PARS.check(IL.inf(), pos, 41);
IL.AddCmd2(IL.opINF, pos.line, pos.col);
e.obj := eEXPR;
e.type := tREAL
e._type := tREAL
|PROG.sysSIZE:
PExpression(parser, e);
PARS.check(e.obj = eTYPE, pos, 68);
ASSERT(ARITH.setInt(e.value, e.type.size));
ASSERT(ARITH.setInt(e.value, e._type.size));
e.obj := eCONST;
e.type := tINTEGER
e._type := tINTEGER
END
1215,7 → 1243,7
PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
proc: PROG.TYPE_;
proc: PROG._TYPE;
param: LISTS.ITEM;
e1: PARS.EXPR;
pos: PARS.POSITION;
1224,7 → 1252,7
ASSERT(parser.sym = SCAN.lxLROUND);
IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
proc := e.type;
proc := e._type;
PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
PARS.Next(parser);
1251,7 → 1279,7
PARS.Next(parser);
e.obj := eEXPR;
e.type := proc.base
e._type := proc.base
ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
stProc(parser, e)
1265,13 → 1293,13
PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
ident: PROG.IDENT;
import: BOOLEAN;
imp: BOOLEAN;
pos: PARS.POSITION;
BEGIN
PARS.checklex(parser, SCAN.lxIDENT);
getpos(parser, pos);
import := FALSE;
imp := FALSE;
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
PARS.check1(ident # NIL, parser, 48);
IF ident.typ = PROG.idMODULE THEN
1279,7 → 1307,7
PARS.ExpectSym(parser, SCAN.lxIDENT);
ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
PARS.check1((ident # NIL) & ident.export, parser, 48);
import := TRUE
imp := TRUE
END;
PARS.Next(parser);
1289,24 → 1317,24
CASE ident.typ OF
|PROG.idCONST:
e.obj := eCONST;
e.type := ident.type;
e._type := ident._type;
e.value := ident.value
|PROG.idTYPE:
e.obj := eTYPE;
e.type := ident.type
e._type := ident._type
|PROG.idVAR:
e.obj := eVAR;
e.type := ident.type;
e.readOnly := import
e._type := ident._type;
e.readOnly := imp
|PROG.idPROC:
e.obj := ePROC;
e.type := ident.type
e._type := ident._type
|PROG.idIMP:
e.obj := eIMP;
e.type := ident.type
e._type := ident._type
|PROG.idVPAR:
e.type := ident.type;
IF e.type.typ = PROG.tRECORD THEN
e._type := ident._type;
IF e._type.typ = PROG.tRECORD THEN
e.obj := eVREC
ELSE
e.obj := eVPAR
1313,20 → 1341,24
END
|PROG.idPARAM:
e.obj := ePARAM;
e.type := ident.type;
e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY})
e._type := ident._type;
e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY})
|PROG.idSTPROC:
e.obj := eSTPROC;
e._type := ident._type;
e.stproc := ident.stproc
|PROG.idSTFUNC:
e.obj := eSTFUNC;
e._type := ident._type;
e.stproc := ident.stproc
|PROG.idSYSPROC:
e.obj := eSYSPROC;
e._type := ident._type;
e.stproc := ident.stproc
|PROG.idSYSFUNC:
PARS.check(~parser.constexp, pos, 109);
e.obj := eSYSFUNC;
e._type := ident._type;
e.stproc := ident.stproc
|PROG.idNONE:
PARS.error(pos, 115)
1345,12 → 1377,12
BEGIN
IF load THEN
IL.load(e.type.size)
IL.load(e._type.size)
END;
IF chkPTR IN Options.checking THEN
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ, label);
IL.AddJmpCmd(IL.opJNZ1, label);
IL.OnError(pos.line, error);
IL.SetLabel(label)
END
1373,7 → 1405,7
offset, n: INTEGER;
BEGIN
offset := e.ident.offset;
n := PROG.Dim(e.type);
n := PROG.Dim(e._type);
WHILE n >= 0 DO
IL.AddCmd(IL.opVADR, offset);
DEC(offset);
1384,7 → 1416,7
BEGIN
IF e.obj = eVAR THEN
offset := PROG.getOffset(PARS.program, e.ident);
offset := PROG.getOffset(e.ident);
IF e.ident.global THEN
IL.AddCmd(IL.opGADR, offset)
ELSE
1391,15 → 1423,15
IL.AddCmd(IL.opLADR, -offset)
END
ELSIF e.obj = ePARAM THEN
IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN
IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN
IL.AddCmd(IL.opVADR, e.ident.offset)
ELSIF PROG.isOpenArray(e.type) THEN
ELSIF PROG.isOpenArray(e._type) THEN
OpenArray(e)
ELSE
IL.AddCmd(IL.opLADR, e.ident.offset)
END
ELSIF e.obj IN {eVPAR, eVREC} THEN
IF PROG.isOpenArray(e.type) THEN
IF PROG.isOpenArray(e._type) THEN
OpenArray(e)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset)
1411,7 → 1443,7
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
VAR
label, offset, n, k: INTEGER;
type: PROG.TYPE_;
_type: PROG._TYPE;
BEGIN
1424,11 → 1456,11
IL.AddCmd(IL.opCHKIDX2, -1)
END;
type := PROG.OpenBase(e.type);
IF type.size # 1 THEN
IL.AddCmd(IL.opMULC, type.size)
_type := PROG.OpenBase(e._type);
IF _type.size # 1 THEN
IL.AddCmd(IL.opMULC, _type.size)
END;
n := PROG.Dim(e.type) - 1;
n := PROG.Dim(e._type) - 1;
k := n;
WHILE n > 0 DO
IL.AddCmd0(IL.opMUL);
1458,23 → 1490,23
WHILE parser.sym = SCAN.lxPOINT DO
getpos(parser, pos);
PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
IF e.type.typ = PROG.tPOINTER THEN
PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
IF e._type.typ = PROG.tPOINTER THEN
deref(pos, e, TRUE, errPTR)
END;
PARS.ExpectSym(parser, SCAN.lxIDENT);
IF e.type.typ = PROG.tPOINTER THEN
e.type := e.type.base;
IF e._type.typ = PROG.tPOINTER THEN
e._type := e._type.base;
e.readOnly := FALSE
END;
field := PROG.getField(e.type, parser.lex.ident, parser.unit);
field := PROG.getField(e._type, parser.lex.ident, parser.unit);
PARS.check1(field # NIL, parser, 74);
e.type := field.type;
e._type := field._type;
IF e.obj = eVREC THEN
e.obj := eVPAR
END;
IF field.offset # 0 THEN
IL.AddCmd(IL.opADDR, field.offset)
IL.AddCmd(IL.opADDC, field.offset)
END;
PARS.Next(parser);
e.ident := NIL
1489,10 → 1521,10
PARS.check(isInt(idx), pos, 76);
IF idx.obj = eCONST THEN
IF e.type.length > 0 THEN
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83);
IF e._type.length > 0 THEN
PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83);
IF ARITH.Int(idx.value) > 0 THEN
IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size)
IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size)
END
ELSE
PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
1500,12 → 1532,12
OpenIdx(parser, pos, e)
END
ELSE
IF e.type.length > 0 THEN
IF e._type.length > 0 THEN
IF chkIDX IN Options.checking THEN
CheckRange(e.type.length, pos.line, errIDX)
CheckRange(e._type.length, pos.line, errIDX)
END;
IF e.type.base.size # 1 THEN
IL.AddCmd(IL.opMULC, e.type.base.size)
IF e._type.base.size # 1 THEN
IL.AddCmd(IL.opMULC, e._type.base.size)
END;
IL.AddCmd0(IL.opADD)
ELSE
1513,7 → 1545,7
END
END;
e.type := e.type.base
e._type := e._type.base
UNTIL parser.sym # SCAN.lxCOMMA;
1525,15 → 1557,15
getpos(parser, pos);
PARS.check1(isPtr(e), parser, 77);
deref(pos, e, TRUE, errPTR);
e.type := e.type.base;
e._type := e._type.base;
e.readOnly := FALSE;
PARS.Next(parser);
e.ident := NIL;
e.obj := eVREC
ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
IF e.type.typ = PROG.tRECORD THEN
IF e._type.typ = PROG.tRECORD THEN
PARS.check1(e.obj = eVREC, parser, 78)
END;
NextPos(parser, pos);
1540,26 → 1572,26
qualident(parser, t);
PARS.check(t.obj = eTYPE, pos, 79);
IF e.type.typ = PROG.tRECORD THEN
PARS.check(t.type.typ = PROG.tRECORD, pos, 80);
IF e._type.typ = PROG.tRECORD THEN
PARS.check(t._type.typ = PROG.tRECORD, pos, 80);
IF chkGUARD IN Options.checking THEN
IF e.ident = NIL THEN
IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD)
IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD)
IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD)
END
END;
ELSE
PARS.check(t.type.typ = PROG.tPOINTER, pos, 81);
PARS.check(t._type.typ = PROG.tPOINTER, pos, 81);
IF chkGUARD IN Options.checking THEN
IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD)
IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD)
END
END;
PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82);
PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82);
e.type := t.type;
e._type := t._type;
PARS.checklex(parser, SCAN.lxRROUND);
PARS.Next(parser)
1569,7 → 1601,7
END designator;
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
VAR
cconv,
parSize,
1594,7 → 1626,7
fparSize := 0
END;
IL.setlast(begcall);
fregs := IL.precall(isfloat);
IL.AddCmd(IL.opPRECALL, ORD(isfloat));
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
IL.AddCmd(IL.opALIGN16, parSize)
1606,7 → 1638,7
IL.setlast(endcall.prev(IL.COMMAND));
IF e.obj = eIMP THEN
IL.CallImp(e.ident.import, callconv, fparSize)
IL.CallImp(e.ident._import, callconv, fparSize)
ELSIF e.obj = ePROC THEN
IL.Call(e.ident.proc.label, callconv, fparSize)
ELSIF isExpr(e) THEN
1627,11 → 1659,14
IL.AddCmd(IL.opCLEANUP, parSize)
END;
IF ~CallStat THEN
IF CallStat THEN
IL.AddCmd0(IL.opRES);
IL.drop
ELSE
IF isfloat THEN
PARS.check(IL.resf(fregs), pos, 41)
IL.AddCmd2(IL.opRESF, pos.line, pos.col)
ELSE
IL.res(fregs)
IL.AddCmd0(IL.opRES)
END
END
END ProcCall;
1640,12 → 1675,9
PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
pos, pos0, pos1: PARS.POSITION;
op: INTEGER;
e1: PARS.EXPR;
constant: BOOLEAN;
operator: ARITH.RELATION;
error: INTEGER;
op, cmp, error: INTEGER;
constant, eq: BOOLEAN;
PROCEDURE relation (sym: INTEGER): BOOLEAN;
1701,7 → 1733,7
END
END;
e.type := tSET;
e._type := tSET;
IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
ARITH.constrSet(e.value, e1.value, e2.value);
1732,7 → 1764,7
ASSERT(parser.sym = SCAN.lxLCURLY);
e.obj := eCONST;
e.type := tSET;
e._type := tSET;
ARITH.emptySet(e.value);
PARS.Next(parser);
1752,9 → 1784,9
ARITH.opSet(e.value, e1.value, "+")
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDSL, ARITH.Int(e.value))
IL.AddCmd(IL.opADDSC, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value))
IL.AddCmd(IL.opADDSC, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADDS)
END;
1773,16 → 1805,15
pos: PARS.POSITION;
e1: PARS.EXPR;
isfloat: BOOLEAN;
fregs: INTEGER;
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
BEGIN
IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
IF e.type = tREAL THEN
PARS.check(IL.loadf(), pos, 41)
IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
IF e._type = tREAL THEN
IL.AddCmd2(IL.opLOADF, pos.line, pos.col)
ELSE
IL.load(e.type.size)
IL.load(e._type.size)
END
END
END LoadVar;
1794,18 → 1825,18
IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
e.obj := eCONST;
e.value := parser.lex.value;
e.type := PROG.getType(PARS.program, e.value.typ);
e._type := PROG.getType(e.value.typ);
PARS.Next(parser)
ELSIF sym = SCAN.lxNIL THEN
e.obj := eCONST;
e.type := PARS.program.stTypes.tNIL;
e._type := PROG.program.stTypes.tNIL;
PARS.Next(parser)
ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
e.obj := eCONST;
ARITH.setbool(e.value, sym = SCAN.lxTRUE);
e.type := tBOOLEAN;
e._type := tBOOLEAN;
PARS.Next(parser)
ELSIF sym = SCAN.lxLCURLY THEN
1823,12 → 1854,12
IF parser.sym = SCAN.lxLROUND THEN
e1 := e;
ActualParameters(parser, e);
PARS.check(e.type # NIL, pos, 59);
isfloat := e.type = tREAL;
PARS.check(e._type # NIL, pos, 59);
isfloat := e._type = tREAL;
IF e1.obj IN {ePROC, eIMP} THEN
ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE)
ELSIF isExpr(e1) THEN
ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
ProcCall(e1, e1._type, isfloat, parser, pos, FALSE)
END
END;
IL.popBegEnd(begcall, endcall)
1884,9 → 1915,7
IF e.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
IL.AddCmd0(IL.opACC);
IL.AddJmpCmd(IL.opJZ, label);
IL.drop
IL.AndOrOpt(label)
END
END;
1914,11 → 1943,11
END
ELSIF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
Float(parser, e)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value))
Float(parser, e1)
END;
IL.fbinop(IL.opMULF)
IL.AddCmd0(IL.opMULF)
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
1946,13 → 1975,13
ELSE
IF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fbinop(IL.opDIVFI)
Float(parser, e);
IL.AddCmd0(IL.opDIVFI)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fbinop(IL.opDIVF)
Float(parser, e1);
IL.AddCmd0(IL.opDIVF)
ELSE
IL.fbinop(IL.opDIVF)
IL.AddCmd0(IL.opDIVF)
END
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
2007,15 → 2036,24
e.obj := eEXPR;
IF e1.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e1.value)))
END;
IL.AddCmd0(IL.opACC)
END
END
END
END;
IF label # -1 THEN
IL.SetLabel(label)
label1 := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ, label1);
IL.SetLabel(label);
IL.Const(0);
IL.drop;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(1);
IL.SetLabel(label);
IL.AddCmd0(IL.opAND)
END
END term;
2025,10 → 2063,11
pos: PARS.POSITION;
op: INTEGER;
e1: PARS.EXPR;
s, s1: SCAN.LEXSTR;
plus, minus: BOOLEAN;
label: INTEGER;
label, label1: INTEGER;
BEGIN
plus := parser.sym = SCAN.lxPLUS;
2081,9 → 2120,8
IF e.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
IL.AddCmd0(IL.opACC);
IL.AddJmpCmd(IL.opJNZ, label);
IL.drop
IL.not;
IL.AndOrOpt(label)
END
END;
2093,47 → 2131,69
CASE op OF
|SCAN.lxPLUS, SCAN.lxMINUS:
IF op = SCAN.lxPLUS THEN
minus := op = SCAN.lxMINUS;
IF minus THEN
op := ORD("-")
ELSE
op := ORD("+")
ELSE
op := ORD("-")
END;
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
CASE e.value.typ OF
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
|ARITH.tINTEGER:
PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|ARITH.tREAL:
PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|ARITH.tSET:
ARITH.opSet(e.value, e1.value, CHR(op))
|ARITH.tCHAR, ARITH.tSTRING:
IF e.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e.value, s)
ELSE
s := e.value.string(SCAN.IDENT).s
END;
IF e1.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e1.value, s1)
ELSE
s1 := e1.value.string(SCAN.IDENT).s
END;
PARS.check(ARITH.concat(s, s1), pos, 5);
e.value.string := SCAN.enterid(s);
e.value.typ := ARITH.tSTRING;
e._type := PROG.program.stTypes.tSTRING
END
ELSE
IF isInt(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADD + ORD(op = ORD("-")))
IL.AddCmd0(IL.opADD + ORD(minus))
END
ELSIF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fbinop(IL.opADDFI + ORD(op = ORD("-")))
Float(parser, e);
IL.AddCmd0(IL.opADDF - ORD(minus))
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
Float(parser, e1);
IL.AddCmd0(IL.opADDF + ORD(minus))
ELSE
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
IL.AddCmd0(IL.opADDF + ORD(minus))
END
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADDS + ORD(op = ORD("-")))
IL.AddCmd0(IL.opADDS + ORD(minus))
END
END;
e.obj := eEXPR
2148,15 → 2208,24
e.obj := eEXPR;
IF e1.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e1.value)))
END;
IL.AddCmd0(IL.opACC)
END
END
END
END;
IF label # -1 THEN
IL.SetLabel(label)
label1 := IL.NewLabel();
IL.AddJmpCmd(IL.opJZ, label1);
IL.SetLabel(label);
IL.Const(1);
IL.drop;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(0);
IL.SetLabel(label);
IL.AddCmd0(IL.opOR)
END
END SimpleExpression;
2168,12 → 2237,14
BEGIN
CASE op OF
|SCAN.lxEQ: res := 0
|SCAN.lxNE: res := 1
|SCAN.lxLT: res := 2
|SCAN.lxLE: res := 3
|SCAN.lxGT: res := 4
|SCAN.lxGE: res := 5
|SCAN.lxEQ: res := ARITH.opEQ
|SCAN.lxNE: res := ARITH.opNE
|SCAN.lxLT: res := ARITH.opLT
|SCAN.lxLE: res := ARITH.opLE
|SCAN.lxGT: res := ARITH.opGT
|SCAN.lxGE: res := ARITH.opGE
|SCAN.lxIN: res := ARITH.opIN
|SCAN.lxIS: res := ARITH.opIS
END
RETURN res
2186,12 → 2257,14
BEGIN
CASE op OF
|SCAN.lxEQ: res := 0
|SCAN.lxNE: res := 1
|SCAN.lxLT: res := 4
|SCAN.lxLE: res := 5
|SCAN.lxGT: res := 2
|SCAN.lxGE: res := 3
|SCAN.lxEQ: res := ARITH.opEQ
|SCAN.lxNE: res := ARITH.opNE
|SCAN.lxLT: res := ARITH.opGT
|SCAN.lxLE: res := ARITH.opGE
|SCAN.lxGT: res := ARITH.opLT
|SCAN.lxGE: res := ARITH.opLE
|SCAN.lxIN: res := ARITH.opIN
|SCAN.lxIS: res := ARITH.opIS
END
RETURN res
2211,9 → 2284,11
PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
cmp: INTEGER;
BEGIN
res := TRUE;
cmp := cmpcode(op);
IF isString(e) & isCharArray(e1) THEN
IL.StrAdr(String(e));
2220,36 → 2295,26
IL.Const(strlen(e) + 1);
IL.AddCmd0(IL.opEQS + invcmpcode(op))
ELSIF isString(e) & isCharArrayW(e1) THEN
ELSIF (isString(e) OR isStringW(e)) & isCharArrayW(e1) THEN
IL.StrAdr(StringW(e));
IL.Const(utf8strlen(e) + 1);
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
ELSIF isStringW(e) & isCharArrayW(e1) THEN
IL.StrAdr(StringW(e));
IL.Const(utf8strlen(e) + 1);
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
ELSIF isCharArray(e) & isString(e1) THEN
IL.StrAdr(String(e1));
IL.Const(strlen(e1) + 1);
IL.AddCmd0(IL.opEQS + cmpcode(op))
IL.AddCmd0(IL.opEQS + cmp)
ELSIF isCharArrayW(e) & isString(e1) THEN
ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN
IL.StrAdr(StringW(e1));
IL.Const(utf8strlen(e1) + 1);
IL.AddCmd0(IL.opEQSW + cmpcode(op))
IL.AddCmd0(IL.opEQSW + cmp)
ELSIF isCharArrayW(e) & isStringW(e1) THEN
IL.StrAdr(StringW(e1));
IL.Const(utf8strlen(e1) + 1);
IL.AddCmd0(IL.opEQSW + cmpcode(op))
ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
IL.AddCmd0(IL.opEQSW + cmpcode(op))
IL.AddCmd0(IL.opEQSW + cmp)
ELSIF isCharArray(e) & isCharArray(e1) THEN
IL.AddCmd0(IL.opEQS + cmpcode(op))
IL.AddCmd0(IL.opEQS + cmp)
ELSIF isString(e) & isString(e1) THEN
PARS.strcmp(e.value, e1.value, op)
2267,8 → 2332,8
getpos(parser, pos0);
SimpleExpression(parser, e);
IF relation(parser.sym) THEN
IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
IL.Const(e.type.length)
IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN
IL.Const(e._type.length)
END;
op := parser.sym;
getpos(parser, pos);
2277,61 → 2342,50
getpos(parser, pos1);
SimpleExpression(parser, e1);
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
IL.Const(e1.type.length)
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN
IL.Const(e1._type.length)
END;
constant := (e.obj = eCONST) & (e1.obj = eCONST);
CASE op OF
|SCAN.lxEQ: operator := "="
|SCAN.lxNE: operator := "#"
|SCAN.lxLT: operator := "<"
|SCAN.lxLE: operator := "<="
|SCAN.lxGT: operator := ">"
|SCAN.lxGE: operator := ">="
|SCAN.lxIN: operator := "IN"
|SCAN.lxIS: operator := ""
END;
error := 0;
cmp := cmpcode(op);
CASE op OF
|SCAN.lxEQ, SCAN.lxNE:
eq := op = SCAN.lxEQ;
IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, cmp, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value))
IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
IL.AddCmd0(IL.opEQ + cmp)
END
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
ELSIF isBoolean(e) & isBoolean(e1) THEN
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, cmp, error)
ELSE
IF e.obj = eCONST THEN
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
BoolCmp(eq, ARITH.Int(e.value) # 0)
ELSIF e1.obj = eCONST THEN
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
BoolCmp(eq, ARITH.Int(e1.value) # 0)
ELSE
IF op = SCAN.lxEQ THEN
IF eq THEN
IL.AddCmd0(IL.opEQB)
ELSE
IL.AddCmd0(IL.opNEB)
2341,14 → 2395,14
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, cmp, error)
ELSE
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
Float(parser, e)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value))
Float(parser, e1)
END;
IL.fcmp(IL.opEQF + cmpcode(op))
IL.AddCmd0(IL.opEQF + cmp)
END
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
2357,7 → 2411,7
END
ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
IL.AddCmd0(IL.opEQC + cmpcode(op))
IL.AddCmd0(IL.opEQC + cmp)
ELSIF isProc(e) & isNil(e1) THEN
IF e.obj IN {ePROC, eIMP} THEN
2364,9 → 2418,9
PARS.check(e.ident.global, pos0, 85);
constant := TRUE;
e.obj := eCONST;
ARITH.setbool(e.value, op = SCAN.lxNE)
ARITH.setbool(e.value, ~eq)
ELSE
IL.AddCmd0(IL.opEQC + cmpcode(op))
IL.AddCmd0(IL.opEQC + cmp)
END
ELSIF isNil(e) & isProc(e1) THEN
2374,12 → 2428,12
PARS.check(e1.ident.global, pos1, 85);
constant := TRUE;
e.obj := eCONST;
ARITH.setbool(e.value, op = SCAN.lxNE)
ARITH.setbool(e.value, ~eq)
ELSE
IL.AddCmd0(IL.opEQC + cmpcode(op))
IL.AddCmd0(IL.opEQC + cmp)
END
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN
IF e.obj = ePROC THEN
PARS.check(e.ident.global, pos0, 85)
END;
2389,27 → 2443,27
IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
constant := TRUE;
e.obj := eCONST;
IF op = SCAN.lxEQ THEN
IF eq THEN
ARITH.setbool(e.value, e.ident = e1.ident)
ELSE
ARITH.setbool(e.value, e.ident # e1.ident)
END
ELSIF e.obj = ePROC THEN
IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ)
IL.ProcCmp(e.ident.proc.label, eq)
ELSIF e1.obj = ePROC THEN
IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ)
IL.ProcCmp(e1.ident.proc.label, eq)
ELSIF e.obj = eIMP THEN
IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ)
IL.ProcImpCmp(e.ident._import, eq)
ELSIF e1.obj = eIMP THEN
IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ)
IL.ProcImpCmp(e1.ident._import, eq)
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
IL.AddCmd0(IL.opEQ + cmp)
END
ELSIF isNil(e) & isNil(e1) THEN
constant := TRUE;
e.obj := eCONST;
ARITH.setbool(e.value, op = SCAN.lxEQ)
ARITH.setbool(e.value, eq)
ELSE
PARS.error(pos, 37)
2422,14 → 2476,14
isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, cmp, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
IL.AddCmd0(IL.opEQ + cmp)
END
END
2437,20 → 2491,20
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, cmp, error)
ELSE
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fcmp(IL.opEQF + invcmpcode(op))
Float(parser, e);
IL.AddCmd0(IL.opEQF + invcmpcode(op))
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fcmp(IL.opEQF + cmpcode(op))
Float(parser, e1);
IL.AddCmd0(IL.opEQF + cmp)
ELSE
IL.fcmp(IL.opEQF + cmpcode(op))
IL.AddCmd0(IL.opEQF + cmp)
END
END
2469,7 → 2523,7
PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
END;
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ARITH.relation(e.value, e1.value, ARITH.opIN, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opINL, ARITH.Int(e.value))
2486,25 → 2540,25
IF isRec(e) THEN
PARS.check(e.obj = eVREC, pos0, 78);
PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80);
PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80);
IF e.ident = NIL THEN
IL.TypeCheck(e1.type.num)
IL.TypeCheck(e1._type.num)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
IL.TypeCheckRec(e1.type.num)
IL.TypeCheckRec(e1._type.num)
END
ELSE
PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81);
IL.TypeCheck(e1.type.base.num)
PARS.check(e1._type.typ = PROG.tPOINTER, pos1, 81);
IL.TypeCheck(e1._type.base.num)
END;
PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82)
PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82)
END;
ASSERT(error = 0);
e.type := tBOOLEAN;
e._type := tBOOLEAN;
IF ~constant THEN
e.obj := eEXPR
2520,7 → 2574,6
pos: PARS.POSITION;
line: INTEGER;
call: BOOLEAN;
fregs: INTEGER;
BEGIN
getpos(parser, pos);
2541,7 → 2594,7
IL.setlast(endcall.prev(IL.COMMAND));
PARS.check(assign(e1, e.type, line), pos, 91);
PARS.check(assign(parser, e1, e._type, line), pos, 91);
IF e1.obj = ePROC THEN
PARS.check(e1.ident.global, pos, 85)
END;
2551,7 → 2604,7
ELSIF parser.sym = SCAN.lxLROUND THEN
e1 := e;
ActualParameters(parser, e1);
PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92);
PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92);
call := TRUE
ELSE
IF e.obj IN {eSYSPROC, eSTPROC} THEN
2559,8 → 2612,8
call := FALSE
ELSE
PARS.check(isProc(e), pos, 86);
PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92);
PARS.check1(e.type.params.first = NIL, parser, 64);
PARS.check((e._type.base = NIL) OR ODD(e._type.call), pos, 92);
PARS.check1(e._type.params.first = NIL, parser, 64);
call := TRUE
END
END;
2567,9 → 2620,9
IF call THEN
IF e.obj IN {ePROC, eIMP} THEN
ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE)
ELSIF isExpr(e) THEN
ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
ProcCall(e, e._type, FALSE, parser, pos, TRUE)
END
END;
2577,7 → 2630,7
END ElementaryStatement;
PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN);
VAR
e: PARS.EXPR;
pos: PARS.POSITION;
2587,7 → 2640,7
BEGIN
L := IL.NewLabel();
IF ~if THEN
IF ~_if THEN
IL.AddCmd0(IL.opLOOP);
IL.SetLabel(L)
END;
2605,10 → 2658,10
IL.AddJmpCmd(IL.opJMP, label)
END
ELSE
IL.AddJmpCmd(IL.opJNE, label)
IL.AndOrOpt(label)
END;
IF if THEN
IF _if THEN
PARS.checklex(parser, SCAN.lxTHEN)
ELSE
PARS.checklex(parser, SCAN.lxDO)
2617,25 → 2670,25
PARS.Next(parser);
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, L);
IF ~_if OR (parser.sym # SCAN.lxEND) THEN
IL.AddJmpCmd(IL.opJMP, L)
END;
IL.SetLabel(label)
UNTIL parser.sym # SCAN.lxELSIF;
IF if THEN
IF _if THEN
IF parser.sym = SCAN.lxELSE THEN
PARS.Next(parser);
parser.StatSeq(parser)
END;
IL.SetLabel(L)
ELSE
IL.AddCmd0(IL.opENDLOOP)
END;
PARS.checklex(parser, SCAN.lxEND);
IF ~if THEN
IL.AddCmd0(IL.opENDLOOP)
END;
PARS.Next(parser)
END IfStatement;
2645,6 → 2698,7
e: PARS.EXPR;
pos: PARS.POSITION;
label: INTEGER;
L: IL.COMMAND;
BEGIN
IL.AddCmd0(IL.opLOOP);
2651,6 → 2705,7
label := IL.NewLabel();
IL.SetLabel(label);
L := IL.getlast();
PARS.Next(parser);
parser.StatSeq(parser);
2664,7 → 2719,8
IL.AddJmpCmd(IL.opJMP, label)
END
ELSE
IL.AddJmpCmd(IL.opJNE, label)
IL.AndOrOpt(label);
L.param1 := label
END;
IL.AddCmd0(IL.opENDLOOP)
2724,7 → 2780,7
pos: PARS.POSITION;
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER;
VAR
a: INTEGER;
label: PARS.EXPR;
2733,7 → 2789,7
BEGIN
getpos(parser, pos);
type := NIL;
_type := NIL;
IF isChar(caseExpr) THEN
PARS.ConstExpression(parser, value);
2754,13 → 2810,13
ELSIF isRecPtr(caseExpr) THEN
qualident(parser, label);
PARS.check(label.obj = eTYPE, pos, 79);
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99);
PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99);
IF isRec(caseExpr) THEN
a := label.type.num
a := label._type.num
ELSE
a := label.type.base.num
a := label._type.base.num
END;
type := label.type
_type := label._type
END
RETURN a
2767,12 → 2823,12
END Label;
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION);
PROCEDURE CheckType (node: AVL.NODE; _type: PROG._TYPE; parser: PARS.PARSER; pos: PARS.POSITION);
BEGIN
IF node # NIL THEN
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100);
CheckType(node.left, type, parser, pos);
CheckType(node.right, type, parser, pos)
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL)._type, _type) OR PROG.isBaseOf(_type, node.data(CASE_LABEL)._type)), pos, 100);
CheckType(node.left, _type, parser, pos);
CheckType(node.right, _type, parser, pos)
END
END CheckType;
2798,12 → 2854,12
label.self := IL.NewLabel();
getpos(parser, pos1);
range.a := Label(parser, caseExpr, label.type);
range.a := Label(parser, caseExpr, label._type);
IF parser.sym = SCAN.lxRANGE THEN
PARS.check1(~isRecPtr(caseExpr), parser, 53);
NextPos(parser, pos);
range.b := Label(parser, caseExpr, label.type);
range.b := Label(parser, caseExpr, label._type);
PARS.check(range.a <= range.b, pos, 103)
ELSE
range.b := range.a
2812,7 → 2868,7
label.range := range;
IF isRecPtr(caseExpr) THEN
CheckType(tree, label.type, parser, pos1)
CheckType(tree, label._type, parser, pos1)
END;
tree := AVL.insert(tree, label, LabelCmp, newnode, node);
PARS.check(newnode, pos1, 100)
2843,10 → 2899,10
END CaseLabelList;
PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER);
VAR
sym: INTEGER;
t: PROG.TYPE_;
t: PROG._TYPE;
variant: INTEGER;
node: AVL.NODE;
last: IL.COMMAND;
2859,8 → 2915,8
PARS.checklex(parser, SCAN.lxCOLON);
PARS.Next(parser);
IF isRecPtr(caseExpr) THEN
t := caseExpr.type;
caseExpr.ident.type := node.data(CASE_LABEL).type
t := caseExpr._type;
caseExpr.ident._type := node.data(CASE_LABEL)._type
END;
last := IL.getlast();
2871,16 → 2927,16
END;
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, end);
IL.AddJmpCmd(IL.opJMP, _end);
IF isRecPtr(caseExpr) THEN
caseExpr.ident.type := t
caseExpr.ident._type := t
END
END
END case;
END _case;
PROCEDURE Table (node: AVL.NODE; else: INTEGER);
PROCEDURE Table (node: AVL.NODE; _else: INTEGER);
VAR
L, R: INTEGER;
range: RANGE;
2897,7 → 2953,7
IF left # NIL THEN
L := left.data(CASE_LABEL).self
ELSE
L := else
L := _else
END;
right := node.right;
2904,7 → 2960,7
IF right # NIL THEN
R := right.data(CASE_LABEL).self
ELSE
R := else
R := _else
END;
last := IL.getlast();
2918,7 → 2974,7
IL.setlast(v.cmd);
IL.SetLabel(node.data(CASE_LABEL).self);
IL.case(range.a, range.b, L, R);
IL._case(range.a, range.b, L, R);
IF v.processed THEN
IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
END;
2926,8 → 2982,8
IL.setlast(last);
Table(left, else);
Table(right, else)
Table(left, _else);
Table(right, _else)
END
END Table;
2935,8 → 2991,7
PROCEDURE TableT (node: AVL.NODE);
BEGIN
IF node # NIL THEN
IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
IL.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a);
TableT(node.left);
TableT(node.right)
END
2945,14 → 3000,14
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
VAR
table, end, else: INTEGER;
table, _end, _else: INTEGER;
tree: AVL.NODE;
item: LISTS.ITEM;
BEGIN
LISTS.push(CaseVariants, NewVariant(0, NIL));
end := IL.NewLabel();
else := IL.NewLabel();
_end := IL.NewLabel();
_else := IL.NewLabel();
table := IL.NewLabel();
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
IL.AddJmpCmd(IL.opJMP, table);
2959,17 → 3014,17
tree := NIL;
case(parser, e, tree, end);
_case(parser, e, tree, _end);
WHILE parser.sym = SCAN.lxBAR DO
PARS.Next(parser);
case(parser, e, tree, end)
_case(parser, e, tree, _end)
END;
IL.SetLabel(else);
IL.SetLabel(_else);
IF parser.sym = SCAN.lxELSE THEN
PARS.Next(parser);
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, end)
IL.AddJmpCmd(IL.opJMP, _end)
ELSE
IL.OnError(pos.line, errCASE)
END;
2980,14 → 3035,14
IF isRecPtr(e) THEN
IL.SetLabel(table);
TableT(tree);
IL.AddJmpCmd(IL.opJMP, else)
IL.AddJmpCmd(IL.opJMP, _else)
ELSE
tree.data(CASE_LABEL).self := table;
Table(tree, else)
Table(tree, _else)
END;
AVL.destroy(tree, DestroyLabel);
IL.SetLabel(end);
IL.SetLabel(_end);
IL.AddCmd0(IL.opENDSW);
REPEAT
3048,13 → 3103,13
ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
PARS.check1(ident # NIL, parser, 48);
PARS.check1(ident.typ = PROG.idVAR, parser, 93);
PARS.check1(ident.type = tINTEGER, parser, 97);
PARS.check1(ident._type = tINTEGER, parser, 97);
PARS.ExpectSym(parser, SCAN.lxASSIGN);
NextPos(parser, pos);
expression(parser, e);
PARS.check(isInt(e), pos, 76);
offset := PROG.getOffset(PARS.program, ident);
offset := PROG.getOffset(ident);
IF ident.global THEN
IL.AddCmd(IL.opGADR, offset)
3075,7 → 3130,7
ELSE
IL.AddCmd(IL.opLADR, -offset)
END;
IL.load(ident.type.size);
IL.load(ident._type.size);
PARS.checklex(parser, SCAN.lxTO);
NextPos(parser, pos2);
3112,7 → 3167,7
END
END;
IL.AddJmpCmd(IL.opJNE, L2);
IL.AddJmpCmd(IL.opJZ, L2);
PARS.checklex(parser, SCAN.lxDO);
PARS.Next(parser);
3171,7 → 3226,7
END StatSeq;
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN;
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN;
VAR
res: BOOLEAN;
3179,24 → 3234,20
res := assigncomp(e, t);
IF res THEN
IF e.obj = eCONST THEN
IF e.type = tREAL THEN
IL.Float(ARITH.Float(e.value))
ELSIF e.type.typ = PROG.tNIL THEN
IF e._type = tREAL THEN
Float(parser, e)
ELSIF e._type.typ = PROG.tNIL THEN
IL.Const(0)
ELSE
LoadConst(e)
END
ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
ELSIF (e._type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
CheckRange(256, pos.line, errBYTE)
ELSIF e.obj = ePROC THEN
PARS.check(e.ident.global, pos, 85);
IL.PushProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import)
END;
IF e.type = tREAL THEN
IL.retf
IL.PushImpProc(e.ident._import)
END
END
3216,8 → 3267,8
BEGIN
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
IF (id # NIL) & (id.import # NIL) THEN
IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label);
IF (id # NIL) & (id._import # NIL) THEN
IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
id.proc.used := TRUE
ELSIF (id # NIL) & (id.proc # NIL) THEN
IL.set_rtl(idx, id.proc.label);
3229,7 → 3280,7
BEGIN
rtl := PARS.program.rtl;
rtl := PROG.program.rtl;
ASSERT(rtl # NIL);
getproc(rtl, "_strcmp", IL._strcmp);
3256,7 → 3307,7
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_dllentry", IL._dllentry);
getproc(rtl, "_sofinit", IL._sofinit)
ELSIF CPU = TARGETS.cpuTHUMB THEN
ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} THEN
getproc(rtl, "_fmul", IL._fmul);
getproc(rtl, "_fdiv", IL._fdiv);
getproc(rtl, "_fdivi", IL._fdivi);
3267,8 → 3318,11
getproc(rtl, "_floor", IL._floor);
getproc(rtl, "_flt", IL._flt);
getproc(rtl, "_pack", IL._pack);
getproc(rtl, "_unpk", IL._unpk)
getproc(rtl, "_unpk", IL._unpk);
IF CPU = TARGETS.cpuRVM32I THEN
getproc(rtl, "_error", IL._error)
END
END
END setrtl;
3279,13 → 3333,13
ext: PARS.PATH;
BEGIN
tINTEGER := PARS.program.stTypes.tINTEGER;
tBYTE := PARS.program.stTypes.tBYTE;
tCHAR := PARS.program.stTypes.tCHAR;
tSET := PARS.program.stTypes.tSET;
tBOOLEAN := PARS.program.stTypes.tBOOLEAN;
tWCHAR := PARS.program.stTypes.tWCHAR;
tREAL := PARS.program.stTypes.tREAL;
tINTEGER := PROG.program.stTypes.tINTEGER;
tBYTE := PROG.program.stTypes.tBYTE;
tCHAR := PROG.program.stTypes.tCHAR;
tSET := PROG.program.stTypes.tSET;
tBOOLEAN := PROG.program.stTypes.tBOOLEAN;
tWCHAR := PROG.program.stTypes.tWCHAR;
tREAL := PROG.program.stTypes.tREAL;
Options := options;
CPU := TARGETS.CPU;
3299,7 → 3353,7
IL.init(CPU);
IF CPU # TARGETS.cpuMSP430 THEN
IF TARGETS.RTL THEN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, UTILS.RTL_NAME) THEN
parser.parse(parser);
3327,17 → 3381,17
PARS.destroy(parser);
IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
IF PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
ERRORS.Error(204)
END;
IF CPU # TARGETS.cpuMSP430 THEN
IF TARGETS.RTL THEN
setrtl
END;
PROG.DelUnused(PARS.program, IL.DelImport);
PROG.DelUnused(IL.DelImport);
IL.set_bss(PARS.program.bss);
IL.set_bss(PROG.program.bss);
CASE CPU OF
|TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
3344,6 → 3398,7
|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
|TARGETS.cpuRVM32I: RVM32I.CodeGen(outname, target, options)
END
END compile;

/programs/develop/oberon07/Source/STRINGS.ob07
10,9 → 10,20
IMPORT UTILS;
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
BEGIN
WHILE count > 0 DO
dst[dpos] := src[spos];
INC(spos);
INC(dpos);
DEC(count)
END
END copy;
PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2, i, j: INTEGER;
n1, n2: INTEGER;
BEGIN
n1 := LENGTH(s1);
20,43 → 31,14
ASSERT(n1 + n2 < LEN(s1));
i := 0;
j := n1;
WHILE i < n2 DO
s1[j] := s2[i];
INC(i);
INC(j)
END;
s1[j] := 0X
copy(s2, s1, 0, n1, n2);
s1[n1 + n2] := 0X
END append;
PROCEDURE reverse (VAR s: ARRAY OF CHAR);
VAR
i, j: INTEGER;
a, b: CHAR;
BEGIN
i := 0;
j := LENGTH(s) - 1;
WHILE i < j DO
a := s[i];
b := s[j];
s[i] := b;
s[j] := a;
INC(i);
DEC(j)
END
END reverse;
PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR);
VAR
i, a: INTEGER;
minus: BOOLEAN;
BEGIN
IF x = UTILS.minint THEN
67,48 → 49,35
END
ELSE
i := 0;
IF x < 0 THEN
x := -x;
i := 1;
str[0] := "-"
END;
minus := x < 0;
IF minus THEN
x := -x
END;
i := 0;
a := 0;
a := x;
REPEAT
str[i] := CHR(x MOD 10 + ORD("0"));
x := x DIV 10;
INC(i)
UNTIL x = 0;
INC(i);
a := a DIV 10
UNTIL a = 0;
IF minus THEN
str[i] := "-";
INC(i)
END;
str[i] := 0X;
reverse(str)
REPEAT
DEC(i);
str[i] := CHR(x MOD 10 + ORD("0"));
x := x DIV 10
UNTIL x = 0
END
END IntToStr;
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 IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
BEGIN
str[n] := 0X;
WHILE n > 0 DO
str[n - 1] := CHR(hexdgt(x MOD 16));
str[n - 1] := CHR(UTILS.hexdgt(x MOD 16));
x := x DIV 16;
DEC(n)
END
115,17 → 84,6
END IntToHex;
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
BEGIN
WHILE count > 0 DO
dst[dpos] := src[spos];
INC(spos);
INC(dpos);
DEC(count)
END
END copy;
PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
VAR
length: INTEGER;
185,10 → 143,10
i: INTEGER;
BEGIN
i := 0;
WHILE (i < LEN(str)) & (str[i] # 0X) DO
i := LENGTH(str) - 1;
WHILE i >= 0 DO
cap(str[i]);
INC(i)
DEC(i)
END
END UpCase;

/programs/develop/oberon07/Source/TARGETS.ob07
24,13 → 24,19
Linux64* = 11;
Linux64SO* = 12;
STM32CM3* = 13;
RVM32I* = 14;
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
cpuRVM32I* = 4;
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
noDISPOSE = {MSP430, STM32CM3, RVM32I};
noRTL = {MSP430};
TYPE
STRING = ARRAY 32 OF CHAR;
37,7 → 43,7
TARGET = RECORD
target, CPU, BitDepth, OS, RealSize: INTEGER;
target, CPU, OS, RealSize: INTEGER;
ComLinePar*, LibDir, FileExt: STRING
END;
45,18 → 51,23
VAR
Targets*: ARRAY 14 OF TARGET;
Targets*: ARRAY 15 OF TARGET;
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*: INTEGER;
CPUs: ARRAY 5 OF
RECORD
BitDepth, InstrSize: INTEGER;
LittleEndian: BOOLEAN
END;
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER;
ComLinePar*, LibDir*, FileExt*: STRING;
Import*, Dispose*, Dll*: BOOLEAN;
Import*, Dispose*, RTL*, Dll*, LittleEndian*: BOOLEAN;
PROCEDURE Enter (idx, CPU, BitDepth, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING);
PROCEDURE Enter (idx, CPU, 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;
80,7 → 91,9
IF res THEN
target := Targets[i].target;
CPU := Targets[i].CPU;
BitDepth := Targets[i].BitDepth;
BitDepth := CPUs[CPU].BitDepth;
InstrSize := CPUs[CPU].InstrSize;
LittleEndian := CPUs[CPU].LittleEndian;
RealSize := Targets[i].RealSize;
OS := Targets[i].OS;
ComLinePar := Targets[i].ComLinePar;
88,7 → 101,8
FileExt := Targets[i].FileExt;
Import := OS IN {osWIN32, osWIN64, osKOS};
Dispose := ~(target IN {MSP430, STM32CM3});
Dispose := ~(target IN noDISPOSE);
RTL := ~(target IN noRTL);
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
WordSize := BitDepth DIV 8;
AdrSize := WordSize
98,19 → 112,34
END Select;
PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN);
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");
CPUs[cpu].BitDepth := BitDepth;
CPUs[cpu].InstrSize := InstrSize;
CPUs[cpu].LittleEndian := LittleEndian
END EnterCPU;
BEGIN
EnterCPU(cpuX86, 32, 1, TRUE);
EnterCPU(cpuAMD64, 64, 1, TRUE);
EnterCPU(cpuMSP430, 16, 2, TRUE);
EnterCPU(cpuTHUMB, 32, 2, TRUE);
EnterCPU(cpuRVM32I, 32, 4, TRUE);
Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex");
Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows32", ".exe");
Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows32", ".exe");
Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows32", ".dll");
Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", "");
Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj");
Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows64", ".exe");
Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows64", ".exe");
Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows64", ".dll");
Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux32", "");
Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux32", ".so");
Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux64", "");
Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux64", ".so");
Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", "RVM32I", ".bin");
END TARGETS.

/programs/develop/oberon07/Source/TEXTDRV.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
28,9 → 28,16
CR: BOOLEAN;
line*, col*: INTEGER;
ifc*: INTEGER;
elsec*: INTEGER;
eof*: BOOLEAN;
eol*: BOOLEAN;
peak*: CHAR
skip*: BOOLEAN;
peak*: CHAR;
_skip*,
_elsif*,
_else*: ARRAY 100 OF BOOLEAN;
fname*: ARRAY 2048 OF CHAR
END;
161,8 → 168,13
text.col := 1;
text.eof := FALSE;
text.eol := FALSE;
text.skip := FALSE;
text.ifc := 0;
text.elsec := 0;
text._skip[0] := FALSE;
text.peak := 0X;
text.file := FILES.open(name);
COPY(name, text.fname);
IF text.file # NIL THEN
load(text);
init(text)

/programs/develop/oberon07/Source/THUMB.ob07
616,14 → 616,14
PROCEDURE SetIV (idx, label, CodeAdr: INTEGER);
VAR
l, h: ANYCODE;
l, h: LISTS.ITEM;
BEGIN
l := CodeList.first(ANYCODE);
h := l.next(ANYCODE);
l := CodeList.first;
h := l.next;
WHILE idx > 0 DO
l := h.next(ANYCODE);
h := l.next(ANYCODE);
l := h.next;
h := l.next;
DEC(idx)
END;
label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1;
784,8 → 784,9
PROCEDURE xchg (r1, r2: INTEGER);
BEGIN
push(r1); push(r2);
pop(r1); pop(r2)
push(r1);
mov(r1, r2);
pop(r2)
END xchg;
1092,7 → 1093,7
|IL.opCALLP:
UnOp(r1);
AddImm8(r1, 1);
AddImm8(r1, 1); (* Thumb mode *)
gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *)
drop;
ASSERT(R.top = -1)
1176,7 → 1177,7
|IL.opERR:
call(genTrap)
|IL.opNOP:
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opSADR:
reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2)
1347,37 → 1348,25
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:
|IL.opJNZ1:
UnOp(r1);
cbnz(r1, param1)
|IL.opJZ:
UnOp(r1);
cbz(r1, param1)
|IL.opJG:
UnOp(r1);
Tst(r1);
jcc(jg, param1)
|IL.opJE:
|IL.opJNZ:
UnOp(r1);
cbnz(r1, param1);
drop
|IL.opJNE:
|IL.opJZ:
UnOp(r1);
cbz(r1, param1);
drop
1435,10 → 1424,10
cc := cond(opcode);
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
IF next.opcode = IL.opJNZ THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
ELSIF next.opcode = IL.opJZ THEN
jcc(inv0(cc), next.param1);
cmd := next
ELSE
1487,7 → 1476,7
END;
drop
|IL.opADDL, IL.opADDR:
|IL.opADDC:
UnOp(r1);
AddConst(r1, param2)
1761,7 → 1750,7
gen4(14, r2, r1); (* bic r1, r2 *)
drop
|IL.opADDSL, IL.opADDSR:
|IL.opADDSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(12, r2, r1); (* orr r1, r2 *)
2014,7 → 2003,7
CallRTL(IL._fdivi, 2);
GetRegA
|IL.opADDF, IL.opADDFI:
|IL.opADDF:
PushAll(2);
CallRTL(IL._fadd, 2);
GetRegA
2336,8 → 2325,6
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
File: WR.FILE;
BEGIN
IF target = TARGETS.STM32CM3 THEN
CortexM3
2387,12 → 2374,12
ERRORS.Error(204)
END;
File := WR.Create(outname);
WR.Create(outname);
HEX.Data2(File, program.code, 0, CodeSize, high(Target.FlashAdr));
HEX.End(File);
HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr));
HEX.End;
WR.Close(File);
WR.Close;
C.StringLn("--------------------------------------------");
C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)");

/programs/develop/oberon07/Source/UTILS.ob07
13,18 → 13,17
CONST
slash* = HOST.slash;
eol* = HOST.eol;
bit_depth* = HOST.bit_depth;
maxint* = HOST.maxint;
minint* = HOST.minint;
OS = HOST.OS;
min32* = -2147483647-1;
max32* = 2147483647;
vMajor* = 1;
vMinor* = 29;
vMinor* = 43;
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
32,17 → 31,10
MAX_GLOBAL_SIZE* = 1600000000;
TYPE
DAYS = ARRAY 12, 31, 2 OF INTEGER;
VAR
time*: INTEGER;
eol*: ARRAY 3 OF CHAR;
maxreal*: REAL;
target*:
61,9 → 53,7
bit_diff*: INTEGER;
days: DAYS;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
RETURN HOST.FileRead(F, Buffer, bytes)
END FileRead;
90,6 → 80,12
END FileOpen;
PROCEDURE chmod* (FName: ARRAY OF CHAR);
BEGIN
HOST.chmod(FName)
END chmod;
PROCEDURE GetArg* (i: INTEGER; VAR str: ARRAY OF CHAR);
BEGIN
HOST.GetArg(i, str)
134,25 → 130,8
END GetCurrentDirectory;
PROCEDURE GetUnixTime* (year, month, day, hour, min, sec: INTEGER): INTEGER;
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
END GetUnixTime;
PROCEDURE UnixTime* (): INTEGER;
VAR
year, month, day, hour, min, sec: INTEGER;
res: INTEGER;
BEGIN
IF OS = "LINUX" THEN
res := HOST.UnixTime()
ELSE
HOST.now(year, month, day, hour, min, sec);
res := GetUnixTime(year, month, day, hour, min, sec)
END
RETURN res
RETURN HOST.UnixTime()
END UnixTime;
229,51 → 208,19
END Log2;
PROCEDURE init (VAR days: DAYS);
VAR
i, j, n0, n1: INTEGER;
PROCEDURE hexdgt* (n: BYTE): BYTE;
BEGIN
FOR i := 0 TO 11 DO
FOR j := 0 TO 30 DO
days[i, j, 0] := 0;
days[i, j, 1] := 0;
IF n < 10 THEN
INC(n, ORD("0"))
ELSE
INC(n, ORD("A") - 10)
END
END;
days[ 1, 28, 0] := -1;
RETURN n
END hexdgt;
FOR i := 0 TO 1 DO
days[ 1, 29, i] := -1;
days[ 1, 30, i] := -1;
days[ 3, 30, i] := -1;
days[ 5, 30, i] := -1;
days[ 8, 30, i] := -1;
days[10, 30, i] := -1;
END;
n0 := 0;
n1 := 0;
FOR i := 0 TO 11 DO
FOR j := 0 TO 30 DO
IF days[i, j, 0] = 0 THEN
days[i, j, 0] := n0;
INC(n0)
END;
IF days[i, j, 1] = 0 THEN
days[i, j, 1] := n1;
INC(n1)
END
END
END
END init;
BEGIN
time := GetTickCount();
COPY(HOST.eol, eol);
maxreal := HOST.maxreal;
init(days)
maxreal := HOST.maxreal
END UTILS.

/programs/develop/oberon07/Source/WRITER.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
10,20 → 10,16
IMPORT FILES, ERRORS, UTILS;
TYPE
FILE* = FILES.FILE;
VAR
counter*: INTEGER;
file: FILES.FILE;
PROCEDURE align (n, _align: INTEGER): INTEGER;
PROCEDURE align* (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
n := n + _align - (n MOD _align)
INC(n, _align - (n MOD _align))
END
RETURN n
30,7 → 26,7
END align;
PROCEDURE WriteByte* (file: FILE; n: BYTE);
PROCEDURE WriteByte* (n: BYTE);
BEGIN
IF FILES.WriteByte(file, n) THEN
INC(counter)
40,7 → 36,7
END WriteByte;
PROCEDURE Write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER);
PROCEDURE Write* (chunk: ARRAY OF BYTE; bytes: INTEGER);
VAR
n: INTEGER;
53,36 → 49,36
END Write;
PROCEDURE Write64LE* (file: FILE; n: INTEGER);
PROCEDURE Write64LE* (n: INTEGER);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 7 DO
WriteByte(file, UTILS.Byte(n, i))
WriteByte(UTILS.Byte(n, i))
END
END Write64LE;
PROCEDURE Write32LE* (file: FILE; n: INTEGER);
PROCEDURE Write32LE* (n: INTEGER);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO 3 DO
WriteByte(file, UTILS.Byte(n, i))
WriteByte(UTILS.Byte(n, i))
END
END Write32LE;
PROCEDURE Write16LE* (file: FILE; n: INTEGER);
PROCEDURE Write16LE* (n: INTEGER);
BEGIN
WriteByte(file, UTILS.Byte(n, 0));
WriteByte(file, UTILS.Byte(n, 1))
WriteByte(UTILS.Byte(n, 0));
WriteByte(UTILS.Byte(n, 1))
END Write16LE;
PROCEDURE Padding* (file: FILE; FileAlignment: INTEGER);
PROCEDURE Padding* (FileAlignment: INTEGER);
VAR
i: INTEGER;
89,20 → 85,20
BEGIN
i := align(counter, FileAlignment) - counter;
WHILE i > 0 DO
WriteByte(file, 0);
WriteByte(0);
DEC(i)
END
END Padding;
PROCEDURE Create* (FileName: ARRAY OF CHAR): FILE;
PROCEDURE Create* (FileName: ARRAY OF CHAR);
BEGIN
counter := 0
RETURN FILES.create(FileName)
counter := 0;
file := FILES.create(FileName)
END Create;
PROCEDURE Close* (VAR file: FILE);
PROCEDURE Close*;
BEGIN
FILES.close(file)
END Close;

/programs/develop/oberon07/Source/X86.ob07
8,7 → 8,7
MODULE X86;
IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG,
CHL := CHUNKLISTS, PATHS, TARGETS;
CHL := CHUNKLISTS, PATHS, TARGETS, ERRORS;
CONST
22,6 → 22,8
esp = 4;
ebp = 5;
MAX_FR = 7;
sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H;
je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H; jnb = 83H;
29,7 → 31,9
CODECHUNK = 8;
FPR_ERR = 41;
TYPE
COMMAND = IL.COMMAND;
92,7 → 96,11
tcount: INTEGER;
FR: ARRAY 1000 OF INTEGER;
fname: PATHS.PATH;
PROCEDURE OutByte* (n: BYTE);
VAR
c: CODE;
146,7 → 154,7
END OutWord;
PROCEDURE isByte (n: INTEGER): BOOLEAN;
PROCEDURE isByte* (n: INTEGER): BOOLEAN;
RETURN (-128 <= n) & (n <= 127)
END isByte;
182,24 → 190,24
END shift;
PROCEDURE mov (reg1, reg2: INTEGER);
PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *)
BEGIN
OutByte2(89H, 0C0H + reg2 * 8 + reg1) (* mov reg1, reg2 *)
OutByte2(op, 0C0H + 8 * reg2 + reg1)
END oprr;
PROCEDURE mov (reg1, reg2: INTEGER); (* mov reg1, reg2 *)
BEGIN
oprr(89H, reg1, reg2)
END mov;
PROCEDURE xchg (reg1, reg2: INTEGER);
VAR
regs: SET;
PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *)
BEGIN
regs := {reg1, reg2};
IF regs = {eax, ecx} THEN
OutByte(91H) (* xchg eax, ecx *)
ELSIF regs = {eax, edx} THEN
OutByte(92H) (* xchg eax, edx *)
ELSIF regs = {ecx, edx} THEN
OutByte2(87H, 0D1H) (* xchg ecx, edx *)
IF eax IN {reg1, reg2} THEN
OutByte(90H + reg1 + reg2)
ELSE
oprr(87H, reg1, reg2)
END
END xchg;
216,14 → 224,24
END push;
PROCEDURE xor (reg1, reg2: INTEGER); (* xor reg1, reg2 *)
BEGIN
oprr(31H, reg1, reg2)
END xor;
PROCEDURE movrc (reg, n: INTEGER);
BEGIN
IF n = 0 THEN
xor(reg, reg)
ELSE
OutByte(0B8H + reg); (* mov reg, n *)
OutInt(n)
END
END movrc;
PROCEDURE pushc (n: INTEGER);
PROCEDURE pushc* (n: INTEGER);
BEGIN
OutByte(68H + short(n)); (* push n *)
OutIntByte(n)
248,67 → 266,85
END not;
PROCEDURE add (reg1, reg2: INTEGER);
PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *)
BEGIN
OutByte2(01H, 0C0H + reg2 * 8 + reg1) (* add reg1, reg2 *)
oprr(01H, reg1, reg2)
END add;
PROCEDURE andrc (reg, n: INTEGER);
PROCEDURE oprc* (op, reg, n: INTEGER);
BEGIN
OutByte2(81H + short(n), 0E0H + reg); (* and reg, n *)
IF (reg = eax) & ~isByte(n) THEN
CASE op OF
|0C0H: op := 05H (* add *)
|0E8H: op := 2DH (* sub *)
|0F8H: op := 3DH (* cmp *)
|0E0H: op := 25H (* and *)
|0C8H: op := 0DH (* or *)
|0F0H: op := 35H (* xor *)
END;
OutByte(op);
OutInt(n)
ELSE
OutByte2(81H + short(n), op + reg MOD 8);
OutIntByte(n)
END
END oprc;
PROCEDURE andrc (reg, n: INTEGER); (* and reg, n *)
BEGIN
oprc(0E0H, reg, n)
END andrc;
PROCEDURE orrc (reg, n: INTEGER);
PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *)
BEGIN
OutByte2(81H + short(n), 0C8H + reg); (* or reg, n *)
OutIntByte(n)
oprc(0C8H, reg, n)
END orrc;
PROCEDURE addrc (reg, n: INTEGER);
PROCEDURE xorrc (reg, n: INTEGER); (* xor reg, n *)
BEGIN
OutByte2(81H + short(n), 0C0H + reg); (* add reg, n *)
OutIntByte(n)
END addrc;
oprc(0F0H, reg, n)
END xorrc;
PROCEDURE subrc (reg, n: INTEGER);
PROCEDURE addrc (reg, n: INTEGER); (* add reg, n *)
BEGIN
OutByte2(81H + short(n), 0E8H + reg); (* sub reg, n *)
OutIntByte(n)
END subrc;
oprc(0C0H, reg, n)
END addrc;
PROCEDURE cmprr (reg1, reg2: INTEGER);
PROCEDURE subrc (reg, n: INTEGER); (* sub reg, n *)
BEGIN
OutByte2(39H, 0C0H + reg2 * 8 + reg1) (* cmp reg1, reg2 *)
END cmprr;
oprc(0E8H, reg, n)
END subrc;
PROCEDURE cmprc (reg, n: INTEGER);
PROCEDURE cmprc (reg, n: INTEGER); (* cmp reg, n *)
BEGIN
IF n = 0 THEN
test(reg)
ELSE
OutByte2(81H + short(n), 0F8H + reg); (* cmp reg, n *)
OutIntByte(n)
oprc(0F8H, reg, n)
END
END cmprc;
PROCEDURE setcc (cond, reg: INTEGER);
PROCEDURE cmprr (reg1, reg2: INTEGER); (* cmp reg1, reg2 *)
BEGIN
OutByte3(0FH, cond, 0C0H + reg) (* setcc reg *)
END setcc;
oprr(39H, reg1, reg2)
END cmprr;
PROCEDURE xor (reg1, reg2: INTEGER);
PROCEDURE setcc* (cc, reg: INTEGER); (* setcc reg *)
BEGIN
OutByte2(31H, 0C0H + reg2 * 8 + reg1) (* xor reg1, reg2 *)
END xor;
IF reg >= 8 THEN
OutByte(41H)
END;
OutByte3(0FH, cc, 0C0H + reg MOD 8)
END setcc;
PROCEDURE ret*;
578,7 → 614,7
OutByte2(0DAH, 0E9H); (* fucompp *)
OutByte3(09BH, 0DFH, 0E0H); (* fstsw ax *)
OutByte(09EH); (* sahf *)
movrc(eax, 0)
OutByte(0B8H); OutInt(0) (* mov eax, 0 *)
END fcmp;
694,7 → 730,7
VAR
cmd, next: COMMAND;
reg1, reg2: INTEGER;
reg1, reg2, fr: INTEGER;
n, a, b, label, cc: INTEGER;
705,6 → 741,8
BEGIN
cmd := IL.codes.commands.first(COMMAND);
fr := -1;
WHILE cmd # NIL DO
param1 := cmd.param1;
738,16 → 776,18
ASSERT(R.top = -1)
|IL.opPRECALL:
n := param2;
IF (param1 # 0) & (n # 0) THEN
PushAll(0);
IF (param2 # 0) & (fr >= 0) THEN
subrc(esp, 8)
END;
WHILE n > 0 DO
INC(FR[0]);
FR[FR[0]] := fr + 1;
WHILE fr >= 0 DO
subrc(esp, 8);
OutByte3(0DDH, 01CH, 024H); (* fstp qword[esp] *)
DEC(n)
DEC(fr)
END;
PushAll(0)
ASSERT(fr = -1)
|IL.opALIGN16:
ASSERT(eax IN R.regs);
759,27 → 799,31
END;
push(eax)
|IL.opRES:
|IL.opRESF, IL.opRES:
ASSERT(R.top = -1);
GetRegA;
n := param2;
WHILE n > 0 DO
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8);
DEC(n)
END
ASSERT(fr = -1);
n := FR[FR[0]]; DEC(FR[0]);
|IL.opRESF:
n := param2;
IF opcode = IL.opRESF THEN
INC(fr);
IF n > 0 THEN
OutByte3(0DDH, 5CH + long(n * 8), 24H);
OutIntByte(n * 8); (* fstp qword[esp + n*8] *)
DEC(fr);
INC(n)
END;
IF fr + n > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END
ELSE
GetRegA
END;
WHILE n > 0 DO
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8);
INC(fr);
DEC(n)
END
816,6 → 860,12
ASSERT(R.top = -1);
IF opcode = IL.opLEAVEF THEN
DEC(fr)
END;
ASSERT(fr = -1);
IF param1 > 0 THEN
mov(esp, ebp)
END;
849,9 → 899,8
END
|IL.opCLEANUP:
n := param2 * 4;
IF n # 0 THEN
addrc(esp, n)
IF param2 # 0 THEN
addrc(esp, param2 * 4)
END
|IL.opPOPSP:
863,9 → 912,14
|IL.opLABEL:
SetLabel(param1) (* L: *)
|IL.opNOP:
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opGADR:
next := cmd.next(COMMAND);
IF next.opcode = IL.opADDC THEN
INC(param2, next.param2);
cmd := next
END;
reg1 := GetAnyReg();
IF pic THEN
Pic(reg1, BIN.PICBSS, param2)
875,7 → 929,12
END
|IL.opLADR:
next := cmd.next(COMMAND);
n := param2 * 4;
IF next.opcode = IL.opADDC THEN
INC(n, next.param2);
cmd := next
END;
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); (* lea reg1, dword[ebp + n] *)
OutIntByte(n)
907,7 → 966,6
drop
|IL.opVLOAD32:
n := param2 * 4;
reg1 := GetAnyReg();
movrm(reg1, ebp, param2 * 4);
movrm(reg1, reg1, 0)
979,7 → 1037,7
add(reg1, reg2);
drop
|IL.opADDL, IL.opADDR:
|IL.opADDC:
IF param2 # 0 THEN
UnOp(reg1);
next := cmd.next(COMMAND);
1010,18 → 1068,17
|IL.opSUB:
BinOp(reg1, reg2);
OutByte2(29H, 0C0H + reg2 * 8 + reg1); (* sub reg1, reg2 *)
oprr(29H, reg1, reg2); (* sub reg1, reg2 *)
drop
|IL.opSUBR, IL.opSUBL:
UnOp(reg1);
n := param2;
IF n = 1 THEN
IF param2 = 1 THEN
OutByte(48H + reg1) (* dec reg1 *)
ELSIF n = -1 THEN
ELSIF param2 = -1 THEN
OutByte(40H + reg1) (* inc reg1 *)
ELSIF n # 0 THEN
subrc(reg1, n)
ELSIF param2 # 0 THEN
subrc(reg1, param2)
END;
IF opcode = IL.opSUBL THEN
neg(reg1)
1179,10 → 1236,10
cc := cond(opcode);
next := cmd.next(COMMAND);
IF next.opcode = IL.opJE THEN
IF next.opcode = IL.opJNZ THEN
jcc(cc, next.param1);
cmd := next
ELSIF next.opcode = IL.opJNE THEN
ELSIF next.opcode = IL.opJZ THEN
jcc(inv0(cc), next.param1);
cmd := next
ELSE
1212,40 → 1269,27
END;
andrc(reg1, 1)
|IL.opACC:
IF (R.top # 0) OR (R.stk[0] # eax) THEN
PushAll(0);
GetRegA;
pop(eax);
DEC(R.pushed)
END
|IL.opDROP:
UnOp(reg1);
drop
|IL.opJNZ:
|IL.opJNZ1:
UnOp(reg1);
test(reg1);
jcc(jne, param1)
|IL.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1)
|IL.opJG:
UnOp(reg1);
test(reg1);
jcc(jg, param1)
|IL.opJE:
|IL.opJNZ:
UnOp(reg1);
test(reg1);
jcc(jne, param1);
drop
|IL.opJNE:
|IL.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1);
1389,7 → 1433,7
|IL.opMULS:
BinOp(reg1, reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *)
oprr(21H, reg1, reg2); (* and reg1, reg2 *)
drop
|IL.opMULSC:
1403,21 → 1447,20
|IL.opDIVSC:
UnOp(reg1);
OutByte2(81H + short(param2), 0F0H + reg1); (* xor reg1, n *)
OutIntByte(param2)
xorrc(reg1, param2)
|IL.opADDS:
BinOp(reg1, reg2);
OutByte2(9H, 0C0H + reg2 * 8 + reg1); (* or reg1, reg2 *)
oprr(9H, reg1, reg2); (* or reg1, reg2 *)
drop
|IL.opSUBS:
BinOp(reg1, reg2);
not(reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *)
oprr(21H, reg1, reg2); (* and reg1, reg2 *)
drop
|IL.opADDSL, IL.opADDSR:
|IL.opADDSC:
UnOp(reg1);
orrc(reg1, param2)
1508,9 → 1551,15
|IL.opMAXC, IL.opMINC:
UnOp(reg1);
cmprc(reg1, param2);
OutByte2(07DH + ORD(opcode = IL.opMINC), 5); (* jge/jle L *)
movrc(reg1, param2)
(* L: *)
label := NewLabel();
IF opcode = IL.opMINC THEN
cc := jle
ELSE
cc := jge
END;
jcc(cc, label);
movrc(reg1, param2);
SetLabel(label)
|IL.opIN, IL.opINR:
IF opcode = IL.opINR THEN
1824,15 → 1873,25
drop
|IL.opPUSHF:
ASSERT(fr >= 0);
DEC(fr);
subrc(esp, 8);
OutByte3(0DDH, 01CH, 024H) (* fstp qword[esp] *)
|IL.opLOADF:
INC(fr);
IF fr > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
UnOp(reg1);
OutByte2(0DDH, reg1); (* fld qword[reg1] *)
drop
|IL.opCONSTF:
INC(fr);
IF fr > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
float := cmd.float;
IF float = 0.0 THEN
OutByte2(0D9H, 0EEH) (* fldz *)
1850,35 → 1909,55
END
|IL.opSAVEF, IL.opSAVEFI:
ASSERT(fr >= 0);
DEC(fr);
UnOp(reg1);
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *)
drop
|IL.opADDF, IL.opADDFI:
|IL.opADDF:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0C1H) (* faddp st1, st *)
|IL.opSUBF:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0E9H) (* fsubp st1, st *)
|IL.opSUBFI:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0E1H) (* fsubrp st1, st *)
|IL.opMULF:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0C9H) (* fmulp st1, st *)
|IL.opDIVF:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0F9H) (* fdivp st1, st *)
|IL.opDIVFI:
ASSERT(fr >= 1);
DEC(fr);
OutByte2(0DEH, 0F1H) (* fdivrp st1, st *)
|IL.opUMINF:
ASSERT(fr >= 0);
OutByte2(0D9H, 0E0H) (* fchs *)
|IL.opFABS:
ASSERT(fr >= 0);
OutByte2(0D9H, 0E1H) (* fabs *)
|IL.opFLT:
INC(fr);
IF fr > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
UnOp(reg1);
push(reg1);
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *)
1886,6 → 1965,8
drop
|IL.opFLOOR:
ASSERT(fr >= 0);
DEC(fr);
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] *)
1899,6 → 1980,8
addrc(esp, 4)
|IL.opEQF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(sete, al)
1905,6 → 1988,8
(* L: *)
|IL.opNEF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(setne, al)
1911,6 → 1996,8
(* L: *)
|IL.opLTF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 00EH); (* jp L *)
setcc(setc, al);
1921,6 → 2008,8
(* L: *)
|IL.opGTF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 00FH); (* jp L *)
setcc(setc, al);
1931,6 → 2020,8
(* L: *)
|IL.opLEF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 003H); (* jp L *)
setcc(setnc, al)
1937,6 → 2028,8
(* L: *)
|IL.opGEF:
ASSERT(fr >= 1);
DEC(fr, 2);
fcmp;
OutByte2(07AH, 010H); (* jp L *)
setcc(setc, al);
1948,6 → 2041,10
(* L: *)
|IL.opINF:
INC(fr);
IF fr > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END;
pushc(7FF00000H);
pushc(0);
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
2076,6 → 2173,9
OutIntByte(n);
OutByte(param2)
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
|IL.opLOOP, IL.opENDLOOP:
END;
2084,8 → 2184,8
END;
ASSERT(R.pushed = 0);
ASSERT(R.top = -1)
ASSERT(R.top = -1);
ASSERT(fr = -1)
END translate;
2094,9 → 2194,9
reg1, entry, L, dcount: INTEGER;
BEGIN
entry := NewLabel();
SetLabel(entry);
dcount := CHL.Length(IL.codes.data);
IF target = TARGETS.Win32DLL THEN
push(ebp);
2106,19 → 2206,17
pushm(ebp, 8);
CallRTL(pic, IL._dllentry);
test(eax);
jcc(je, dllret)
jcc(je, dllret);
pushc(0)
ELSIF target = TARGETS.KolibriOSDLL THEN
SetLabel(dllinit)
END;
IF target = TARGETS.KolibriOS THEN
SetLabel(dllinit);
OutByte(68H); (* push IMPORT *)
Reloc(BIN.IMPTAB, 0)
ELSIF target = TARGETS.KolibriOS THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.IMPTAB, 0);
push(reg1); (* push IMPORT *)
drop
ELSIF target = TARGETS.KolibriOSDLL THEN
OutByte(68H); (* push IMPORT *)
Reloc(BIN.IMPTAB, 0)
ELSIF target = TARGETS.Linux32 THEN
push(esp)
ELSE
2129,39 → 2227,25
reg1 := GetAnyReg();
Pic(reg1, BIN.PICCODE, entry);
push(reg1); (* push CODE *)
drop
ELSE
OutByte(68H); (* push CODE *)
Reloc(BIN.RCODE, entry)
END;
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICDATA, 0);
push(reg1); (* push _data *)
drop
ELSE
OutByte(68H); (* push _data *)
Reloc(BIN.RDATA, 0)
END;
dcount := CHL.Length(IL.codes.data);
pushc(tcount);
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICDATA, tcount * 4 + dcount);
push(reg1); (* push _data + tcount * 4 + dcount *)
drop
ELSE
OutByte(68H); (* push CODE *)
Reloc(BIN.RCODE, entry);
OutByte(68H); (* push _data *)
Reloc(BIN.RDATA, 0);
pushc(tcount);
OutByte(68H); (* push _data + tcount * 4 + dcount *)
Reloc(BIN.RDATA, tcount * 4 + dcount)
END;
CallRTL(pic, IL._init);
IF target = TARGETS.Linux32 THEN
IF target IN {TARGETS.Win32C, TARGETS.Win32GUI, TARGETS.Linux32} THEN
L := NewLabel();
pushc(0);
push(esp);
2186,7 → 2270,7
dcount, i: INTEGER;
PROCEDURE import (imp: LISTS.LIST);
PROCEDURE _import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
2204,7 → 2288,7
lib := lib.next(IL.IMPORT_LIB)
END
END import;
END _import;
BEGIN
2256,12 → 2340,11
exp := exp.next(IL.EXPORT_PROC)
END;
import(IL.codes.import);
_import(IL.codes._import);
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4)));
BIN.SetParams(program, IL.codes.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536));
BIN.SetParams(program, IL.codes.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536))
END epilog;
2271,6 → 2354,7
opt: PROG.OPTIONS;
BEGIN
FR[0] := 0;
tcount := CHL.Length(IL.codes.types);
opt := options;