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 @ 8097

  → /programs/develop/oberon07/source/ @ 8859

  ↔ Reverse comparison

• Compare Path:	Rev

  With Path:	Rev

Regard whitespace Rev 8097 → Rev 8859

/programs/develop/oberon07/source/AMD64.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
272,11 → 272,6
END GetAnyReg;
PROCEDURE GetVarReg (offs: INTEGER): INTEGER;
RETURN REG.GetVarReg(R, offs)
END GetVarReg;
PROCEDURE callimp (label: INTEGER);
BEGIN
OutByte2(0FFH, 15H); (* call qword[rip + label + IMP] *)
301,14 → 296,12
label: INTEGER;
BEGIN
REG.Store(R);
label := IL.codes.rtl[proc];
IF label < 0 THEN
callimp(-label)
ELSE
X86.call(label)
END;
REG.Restore(R)
END
END CallRTL;
567,142 → 560,6
END shiftrc;
PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): IL.LOCALVAR;
VAR
cur: IL.LOCALVAR;
BEGIN
cur := variables.first(IL.LOCALVAR);
WHILE (cur # NIL) & (cur.offset # offset) DO
cur := cur.next(IL.LOCALVAR)
END
RETURN cur
END getVar;
PROCEDURE allocReg (cmd: COMMAND);
VAR
leave: BOOLEAN;
leaf: BOOLEAN;
cur: COMMAND;
variables: LISTS.LIST;
lvar, rvar: IL.LOCALVAR;
reg: INTEGER;
max: INTEGER;
loop: INTEGER;
BEGIN
loop := 1;
variables := cmd.variables;
leave := FALSE;
leaf := TRUE;
cur := cmd.next(COMMAND);
REPEAT
CASE cur.opcode OF
|IL.opLLOAD64,
IL.opLLOAD8,
IL.opLLOAD16,
IL.opLLOAD32,
IL.opLLOAD64_PARAM,
IL.opLLOAD32_PARAM,
IL.opLADR_SAVE,
IL.opLADR_INC,
IL.opLADR_DEC,
IL.opLADR_INCB,
IL.opLADR_DECB,
IL.opLADR_INCL,
IL.opLADR_EXCL,
IL.opLADR_UNPK:
lvar := getVar(variables, cur.param2);
IF (lvar # NIL) & (lvar.count # -1) THEN
INC(lvar.count, loop)
END
|IL.opLADR_SAVEC,
IL.opLADR_INCC,
IL.opLADR_INCCB,
IL.opLADR_DECCB,
IL.opLADR_INCLC,
IL.opLADR_EXCLC:
lvar := getVar(variables, cur.param1);
IF (lvar # NIL) & (lvar.count # -1) THEN
INC(lvar.count, loop)
END
|IL.opLADR:
lvar := getVar(variables, cur.param2);
IF (lvar # NIL) & (lvar.count # -1) THEN
lvar.count := -1
END
|IL.opLOOP:
INC(loop, 10)
|IL.opENDLOOP:
DEC(loop, 10)
|IL.opLEAVE,
IL.opLEAVER,
IL.opLEAVEF:
leave := TRUE
|IL.opCALL, IL.opCALLP, IL.opCALLI,
IL.opWIN64CALL, IL.opWIN64CALLP, IL.opWIN64CALLI,
IL.opSYSVCALL, IL.opSYSVCALLP, IL.opSYSVCALLI,
IL.opSAVES, IL.opRSET, IL.opRSETR,
IL.opRSETL, IL.opRSET1,
IL.opEQS .. IL.opGES,
IL.opEQSW .. IL.opGESW,
IL.opCOPY, IL.opMOVE, IL.opCOPYA,
IL.opCOPYS, IL.opROT,
IL.opNEW, IL.opDISP, IL.opISREC,
IL.opIS, IL.opTYPEGR, IL.opTYPEGP,
IL.opTYPEGD, IL.opCASET, IL.opDIV,
IL.opDIVL, IL.opMOD,
IL.opMODL, IL.opLENGTH, IL.opLENGTHW:
leaf := FALSE
|IL.opDIVR, IL.opMODR:
leaf := UTILS.Log2(cur.param2) >= 0
ELSE
END;
cur := cur.next(COMMAND)
UNTIL leave OR ~leaf;
IF leaf THEN
REPEAT
reg := -1;
max := -1;
rvar := NIL;
lvar := variables.first(IL.LOCALVAR);
WHILE lvar # NIL DO
IF lvar.count > max THEN
max := lvar.count;
rvar := lvar
END;
lvar := lvar.next(IL.LOCALVAR)
END;
IF rvar # NIL THEN
reg := REG.GetAnyVarReg(R);
IF reg # -1 THEN
REG.Lock(R, reg, rvar.offset, rvar.size);
REG.Load(R, reg);
rvar.count := -1
END
END
UNTIL (rvar = NIL) OR (reg = -1)
END
END allocReg;
PROCEDURE GetRegA;
BEGIN
ASSERT(REG.GetReg(R, rax))
733,7 → 590,7
reg: BOOLEAN;
BEGIN
ASSERT(r10 IN R.regs);
ASSERT(r11 IN R.regs);
n := params MOD 32;
params := params DIV 32;
s := 0;
772,8 → 629,8
END;
IF ~reg THEN
movrm(r10, rsp, ofs);
movmr(rsp, p, r10);
movrm(r11, rsp, ofs);
movmr(rsp, p, r11);
INC(p, 8)
END
END
828,8 → 685,6
float: REAL;
regVar: BOOLEAN;
BEGIN
xmm := -1;
cmd := commands.first(COMMAND);
846,24 → 701,19
X86.jmp(param1)
|IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL:
REG.Store(R);
CASE opcode OF
|IL.opCALL:
|IL.opWIN64CALL: Win64Passing(param2)
|IL.opSYSVCALL: SysVPassing(param2)
END;
X86.call(param1);
REG.Restore(R)
X86.call(param1)
|IL.opCALLP, IL.opWIN64CALLP, IL.opSYSVCALLP:
UnOp(reg1);
IF reg1 # rax THEN
GetRegA;
ASSERT(REG.Exchange(R, reg1, rax));
drop
mov(rax, reg1)
END;
drop;
REG.Store(R);
CASE opcode OF
|IL.opCALLP:
|IL.opWIN64CALLP: Win64Passing(param2)
870,18 → 720,15
|IL.opSYSVCALLP: SysVPassing(param2)
END;
OutByte2(0FFH, 0D0H); (* call rax *)
REG.Restore(R);
ASSERT(R.top = -1)
|IL.opCALLI, IL.opWIN64CALLI, IL.opSYSVCALLI:
REG.Store(R);
CASE opcode OF
|IL.opCALLI:
|IL.opWIN64CALLI: Win64Passing(param2)
|IL.opSYSVCALLI: SysVPassing(param2)
END;
callimp(param1);
REG.Restore(R)
callimp(param1)
|IL.opLABEL:
X86.SetLabel(param1)
978,9 → 825,9
param3 := -param3;
n := (param3 MOD 32) * 8;
param3 := param3 DIV 32;
pop(r10);
pop(r11);
subrc(rsp, n);
push(r10);
push(r11);
push(rbp);
mov(rbp, rsp);
996,8 → 843,8
movsdmr(rbp, i, b);
INC(b)
ELSE
movrm(r10, rbp, n + c);
movmr(rbp, i, r10);
movrm(r11, rbp, n + c);
movmr(rbp, i, r11);
INC(c, 8)
END
ELSE
1005,8 → 852,8
movmr(rbp, i, SystemVRegPar[a]);
INC(a)
ELSE
movrm(r10, rbp, n + c);
movmr(rbp, i, r10);
movrm(r11, rbp, n + c);
movmr(rbp, i, r11);
INC(c, 8)
END
END;
1028,10 → 875,6
pushc(0);
DEC(n)
END
END;
IF cmd.allocReg THEN
allocReg(cmd)
END
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
1038,9 → 881,7
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # rax THEN
GetRegA;
ASSERT(REG.Exchange(R, reg1, rax));
drop
mov(rax, reg1)
END;
drop
END;
1059,11 → 900,10
pop(rbp);
IF param2 > 0 THEN
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2 *)
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2*8 *)
ELSE
X86.ret
END;
REG.Reset(R)
END
|IL.opSAVES:
UnOp(reg1);
1097,31 → 937,16
|IL.opLLOAD64:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
movrm(reg1, rbp, param2 * 8)
END
|IL.opLLOAD8,
IL.opLLOAD16:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16)
END
|IL.opLLOAD32:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
movrm32(reg1, rbp, param2 * 8)
END;
movrm32(reg1, rbp, param2 * 8);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32)
1490,8 → 1315,8
|IL.opNEW:
PushAll(1);
n := param2 + 16;
ASSERT(UTILS.Align(n, 64));
n := param2 + 8;
ASSERT(UTILS.Align(n, 8));
pushc(n);
pushc(param1);
CallRTL(IL._new)
1502,8 → 1327,7
|IL.opPUSHT:
UnOp(reg1);
reg2 := GetAnyReg();
movrm(reg2, reg1, -8)
movrm(GetAnyReg(), reg1, -8)
|IL.opISREC:
PushAll(2);
1540,11 → 1364,11
GetRegA
|IL.opCASET:
push(r10);
push(r10);
push(rcx);
push(rcx);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
pop(r10);
pop(rcx);
test(rax);
jcc(jne, param1)
1714,6 → 1538,7
END
END
ELSIF isLong(param2) THEN
UnOp(reg1);
addrc(reg1, param2)
END
1848,7 → 1673,7
IF param2 = 0 THEN
reg2 := rax
ELSE
reg2 := r10
reg2 := rcx
END;
IF reg1 # reg2 THEN
ASSERT(REG.GetReg(R, reg2));
1874,28 → 1699,44
|IL.opCASELR:
GetRegA;
cmprc(rax, param1);
IF param2 = cmd.param3 THEN
jcc(jne, param2)
ELSE
jcc(jl, param2);
jcc(jg, cmd.param3);
jcc(jg, cmd.param3)
END;
drop
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
UnOp(reg1);
IF reg1 # rcx THEN
ASSERT(REG.GetReg(R, rcx));
ASSERT(REG.Exchange(R, reg1, rcx));
drop
END;
BinOp(reg1, reg2);
xchg(reg2, rcx);
ASSERT(reg2 = rcx);
Rex(reg1, 0);
OutByte(0D3H);
X86.shift(opcode, reg1 MOD 8); (* shift reg1, cl *)
xchg(reg2, rcx);
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
UnOp(reg1);
IF reg1 # rcx THEN
ASSERT(REG.GetReg(R, rcx));
ASSERT(REG.Exchange(R, reg1, rcx));
drop
END;
reg1 := GetAnyReg();
movrc(reg1, param2);
BinOp(reg1, reg2);
xchg(reg1, rcx);
ASSERT(reg1 = rcx);
Rex(reg2, 0);
OutByte(0D3H);
X86.shift(opcode, reg2 MOD 8); (* shift reg2, cl *)
xchg(reg1, rcx);
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
2189,17 → 2030,12
IF opcode = IL.opLADR_UNPK THEN
n := param2 * 8;
UnOp(reg1);
reg2 := GetVarReg(param2);
regVar := reg2 # -1;
IF ~regVar THEN
reg2 := GetAnyReg();
Rex(0, reg2);
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *)
OutIntByte(n)
END
ELSE
BinOp(reg1, reg2);
regVar := FALSE
BinOp(reg1, reg2)
END;
push(reg1);
2208,12 → 2044,7
shiftrc(shr, reg1, 53);
subrc(reg1, 1023);
IF regVar THEN
mov(reg2, reg1);
reg2 := GetAnyReg()
ELSE
movmr(reg2, 0, reg1)
END;
movmr(reg2, 0, reg1);
pop(reg2);
movrm(reg1, reg2, 0);
2243,12 → 2074,7
drop
|IL.opLLOAD64_PARAM:
reg1 := GetVarReg(param2);
IF reg1 # -1 THEN
push(reg1)
ELSE
X86.pushm(rbp, param2 * 8)
END
|IL.opGLOAD64_PARAM:
OutByte2(0FFH, 35H); (* push qword[rip + param2 + BSS] *)
2272,12 → 2098,7
|IL.opLLOAD32_PARAM:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
movrm32(reg1, rbp, param2 * 8)
END;
movrm32(reg1, rbp, param2 * 8);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
push(reg1);
2285,10 → 2106,6
|IL.opLADR_SAVEC:
n := param1 * 8;
reg1 := GetVarReg(param1);
IF reg1 # -1 THEN
movrc(reg1, param2)
ELSE
IF isLong(param2) THEN
reg2 := GetAnyReg();
movrc(reg2, param2);
2299,7 → 2116,6
OutIntByte(n);
OutInt(param2)
END
END
|IL.opGADR_SAVEC:
IF isLong(param2) THEN
2319,141 → 2135,75
|IL.opLADR_SAVE:
UnOp(reg1);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
mov(reg2, reg1)
ELSE
movmr(rbp, param2 * 8, reg1)
END;
movmr(rbp, param2 * 8, reg1);
drop
|IL.opLADR_INCC:
reg1 := GetVarReg(param1);
IF isLong(param2) THEN
reg2 := GetAnyReg();
movrc(reg2, param2);
IF reg1 # -1 THEN
add(reg1, reg2)
ELSE
n := param1 * 8;
Rex(0, reg2);
OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8);
OutIntByte(n) (* add qword[rbp+n], reg2 *)
END;
OutIntByte(n); (* add qword[rbp+n], reg2 *)
drop
ELSIF ABS(param2) = 1 THEN
IF reg1 # -1 THEN
IF param2 = 1 THEN
incr(reg1)
ELSE
decr(reg1)
END
ELSE
n := param1 * 8;
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *)
OutIntByte(n)
END
ELSE
IF reg1 # -1 THEN
addrc(reg1, param2)
ELSE
n := param1 * 8;
OutByte3(48H, 81H + short(param2), 45H + long(n));
OutIntByte(n);
OutIntByte(param2) (* add qword[rbp+n], param2 *)
END
END
|IL.opLADR_INCCB, IL.opLADR_DECCB:
reg1 := GetVarReg(param1);
param2 := param2 MOD 256;
IF reg1 # -1 THEN
IF opcode = IL.opLADR_DECCB THEN
subrc(reg1, param2)
ELSE
addrc(reg1, param2)
END;
andrc(reg1, 255)
ELSE
n := param1 * 8;
OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB));
OutIntByte(n);
OutByte(param2) (* add/sub byte[rbp+n], param2 *)
END
|IL.opLADR_INC, IL.opLADR_DEC:
UnOp(reg1);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
IF opcode = IL.opLADR_DEC THEN
sub(reg2, reg1)
ELSE
add(reg2, reg1)
END
ELSE
n := param2 * 8;
Rex(0, reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
OutIntByte(n) (* add/sub qword[rbp+n], reg1 *)
END;
OutIntByte(n); (* add/sub qword[rbp+n], reg1 *)
drop
|IL.opLADR_INCB, IL.opLADR_DECB:
UnOp(reg1);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
IF opcode = IL.opLADR_DECB THEN
sub(reg2, reg1)
ELSE
add(reg2, reg1)
END;
andrc(reg2, 255)
ELSE
n := param2 * 8;
IF reg1 >= 8 THEN
OutByte(44H)
END;
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
OutIntByte(n) (* add/sub byte[rbp+n], reg1_8 *)
END;
OutIntByte(n); (* add/sub byte[rbp+n], reg1_8 *)
drop
|IL.opLADR_INCL, IL.opLADR_EXCL:
UnOp(reg1);
cmprc(reg1, 64);
reg2 := GetVarReg(param2);
IF reg2 # -1 THEN
OutByte2(73H, 4); (* jnb L *)
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *)
ELSE
n := param2 * 8;
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 *)
END;
OutIntByte(n); (* bts/btr qword[rbp+n], reg1 *)
(* L: *)
drop
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
reg1 := GetVarReg(param1);
IF reg1 # -1 THEN
Rex(reg1, 0);
OutByte3(0FH, 0BAH, 0E8H); (* bts/btr reg1, param2 *)
OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2)
ELSE
n := param1 * 8;
OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *)
OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC));
OutIntByte(n);
OutByte(param2)
END
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
|IL.opLOOP, IL.opENDLOOP:
END;
cmd := cmd.next(COMMAND)
2600,30 → 2350,6
END epilog;
PROCEDURE rload (reg, offs, size: INTEGER);
BEGIN
offs := offs * 8;
CASE size OF
|1: movzx(reg, rbp, offs, FALSE)
|2: movzx(reg, rbp, offs, TRUE)
|4: xor(reg, reg); movrm32(reg, rbp, offs)
|8: movrm(reg, rbp, offs)
END
END rload;
PROCEDURE rsave (reg, offs, size: INTEGER);
BEGIN
offs := offs * 8;
CASE size OF
|1: X86.movmr8(rbp, offs, reg)
|2: X86.movmr16(rbp, offs, reg)
|4: movmr32(rbp, offs, reg)
|8: movmr(rbp, offs, reg)
END
END rsave;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
path, modname, ext: PATHS.PATH;
2647,7 → 2373,7
PATHS.split(outname, path, modname, ext);
S.append(modname, ext);
REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9});
REG.Init(R, push, pop, mov, xchg, {rax, rcx, rdx, r8, r9, r10, r11});
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 8)));

/programs/develop/oberon07/source/ARITH.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE ARITH;
IMPORT AVLTREES, STRINGS, UTILS;
IMPORT STRINGS, UTILS, LISTS;
CONST
31,7 → 31,7
set: SET;
bool: BOOLEAN;
string*: AVLTREES.DATA
string*: LISTS.ITEM
END;
158,7 → 158,7
n := -1;
i := 0;
WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO
WHILE (s[i] # "H") & (s[i] # "X") & (s[i] # "h") & (s[i] # "x") & (error = 0) DO
d := digit[ORD(s[i])];
IF (n = -1) & (d # 0) THEN
176,13 → 176,13
value := UTILS.Long(value);
IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
IF ((s[i] = "X") OR (s[i] = "x")) & (n # -1) & (i - n > 4) THEN
error := 3
END;
IF error = 0 THEN
v.int := value;
IF s[i] = "X" THEN
IF (s[i] = "X") OR (s[i] = "x") THEN
v.typ := tCHAR;
IF ~check(v) THEN
v.typ := tWCHAR;
217,6 → 217,7
PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
VAR
value: REAL;
frac: REAL;
exp10: REAL;
i, n, d: INTEGER;
minus: BOOLEAN;
224,7 → 225,8
BEGIN
error := 0;
value := 0.0;
exp10 := 10.0;
frac := 0.0;
exp10 := 1.0;
minus := FALSE;
n := 0;
240,7 → 242,8
INC(i);
WHILE (error = 0) & STRINGS.digit(s[i]) DO
IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN
IF opFloat2(frac, 10.0, "*") & opFloat2(frac, FLT(digit[ORD(s[i])]), "+") THEN
exp10 := exp10 * 10.0;
INC(i)
ELSE
error := 4
247,7 → 250,11
END
END;
IF s[i] = "E" THEN
IF ~opFloat2(value, frac / exp10, "+") THEN
error := 4
END;
IF (s[i] = "E") OR (s[i] = "e") THEN
INC(i)
END;

/programs/develop/oberon07/source/CHUNKLISTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
46,26 → 46,18
PROCEDURE SetByte* (list: BYTELIST; idx: INTEGER; byte: BYTE);
VAR
ChunkNum: INTEGER;
chunk: BYTECHUNK;
item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
ChunkNum := idx DIV LENOFBYTECHUNK;
item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
ASSERT(item # NIL);
chunk := item(BYTECHUNK);
idx := idx MOD LENOFBYTECHUNK;
chunk := list.first(BYTECHUNK);
WHILE (chunk # NIL) & (ChunkNum > 0) DO
chunk := chunk.next(BYTECHUNK);
DEC(ChunkNum)
END;
ASSERT(chunk # NIL);
ASSERT(idx < chunk.count);
chunk.data[idx] := byte
END SetByte;
72,26 → 64,18
PROCEDURE GetByte* (list: BYTELIST; idx: INTEGER): BYTE;
VAR
ChunkNum: INTEGER;
chunk: BYTECHUNK;
item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
ChunkNum := idx DIV LENOFBYTECHUNK;
item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
ASSERT(item # NIL);
chunk := item(BYTECHUNK);
idx := idx MOD LENOFBYTECHUNK;
chunk := list.first(BYTECHUNK);
WHILE (chunk # NIL) & (ChunkNum > 0) DO
chunk := chunk.next(BYTECHUNK);
DEC(ChunkNum)
END;
ASSERT(chunk # NIL);
ASSERT(idx < chunk.count)
RETURN chunk.data[idx]
END GetByte;
187,52 → 171,37
PROCEDURE SetInt* (list: INTLIST; idx: INTEGER; int: INTEGER);
VAR
ChunkNum: INTEGER;
chunk: INTCHUNK;
item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
ChunkNum := idx DIV LENOFINTCHUNK;
item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
ASSERT(item # NIL);
chunk := item(INTCHUNK);
idx := idx MOD LENOFINTCHUNK;
chunk := list.first(INTCHUNK);
WHILE (chunk # NIL) & (ChunkNum > 0) DO
chunk := chunk.next(INTCHUNK);
DEC(ChunkNum)
END;
ASSERT(chunk # NIL);
ASSERT(idx < chunk.count);
chunk.data[idx] := int
END SetInt;
PROCEDURE GetInt* (list: INTLIST; idx: INTEGER): INTEGER;
VAR
ChunkNum: INTEGER;
chunk: INTCHUNK;
item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
ChunkNum := idx DIV LENOFINTCHUNK;
item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
ASSERT(item # NIL);
chunk := item(INTCHUNK);
idx := idx MOD LENOFINTCHUNK;
chunk := list.first(INTCHUNK);
WHILE (chunk # NIL) & (ChunkNum > 0) DO
chunk := chunk.next(INTCHUNK);
DEC(ChunkNum)
END;
ASSERT(chunk # NIL);
ASSERT(idx < chunk.count)
RETURN chunk.data[idx]
END GetInt;

/programs/develop/oberon07/source/CONSOLE.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
33,16 → 33,6
END Int;
PROCEDURE Hex* (x, n: INTEGER);
VAR
s: ARRAY 24 OF CHAR;
BEGIN
STRINGS.IntToHex(x, s, n);
String(s)
END Hex;
PROCEDURE Int2* (x: INTEGER);
BEGIN
IF x < 10 THEN
79,4 → 69,10
END Int2Ln;
PROCEDURE Dashes*;
BEGIN
StringLn("------------------------------------------------")
END Dashes;
END CONSOLE.

/programs/develop/oberon07/source/Compiler.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
11,6 → 11,15
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN;
CONST
DEF_WINDOWS = "WINDOWS";
DEF_LINUX = "LINUX";
DEF_KOLIBRIOS = "KOLIBRIOS";
DEF_CPU_X86 = "CPU_X86";
DEF_CPU_X8664 = "CPU_X8664";
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
VAR
param: PARS.PATH;
94,6 → 103,8
EXCL(checking, ST.chkCHR);
EXCL(checking, ST.chkWCHR);
EXCL(checking, ST.chkBYTE)
ELSIF param[j] = "s" THEN
EXCL(checking, ST.chkSTK)
ELSIF param[j] = "a" THEN
checking := {}
END;
177,14 → 188,23
options.checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path);
lib_path := app_path;
UTILS.GetArg(0, temp);
PATHS.split(temp, path, modname, ext);
IF PATHS.isRelative(path) THEN
PATHS.RelPath(app_path, path, temp);
path := temp
END;
lib_path := path;
UTILS.GetArg(1, inname);
STRINGS.replace(inname, "\", UTILS.slash);
STRINGS.replace(inname, "/", UTILS.slash);
C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
C.StringLn("Copyright (c) 2018-2020, Anton Krotov");
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date);
C.StringLn("Copyright (c) 2018-2021, Anton Krotov");
IF inname = "" THEN
C.Ln;
220,7 → 240,7
UTILS.Exit(0)
END;
C.StringLn("--------------------------------------------");
C.Dashes;
PATHS.split(inname, path, modname, ext);
IF ext # UTILS.FILE_EXT THEN
245,14 → 265,14
ERRORS.Error(206)
END;
IF target = TARGETS.MSP430 THEN
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
options.ram := MSP430.minRAM;
options.rom := MSP430.minROM
END;
IF target = TARGETS.STM32CM3 THEN
options.ram := THUMB.STM32_minRAM;
options.rom := THUMB.STM32_minROM
IF (TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE) THEN
options.ram := THUMB.minRAM;
options.rom := THUMB.minROM
END;
IF UTILS.bit_depth < TARGETS.BitDepth THEN
278,10 → 298,28
PARS.init(options);
CASE TARGETS.OS OF
|TARGETS.osNONE:
|TARGETS.osWIN32,
TARGETS.osWIN64: SCAN.NewDef(DEF_WINDOWS)
|TARGETS.osLINUX32,
TARGETS.osLINUX64: SCAN.NewDef(DEF_LINUX)
|TARGETS.osKOS: SCAN.NewDef(DEF_KOLIBRIOS)
END;
CASE TARGETS.CPU OF
|TARGETS.cpuX86: SCAN.NewDef(DEF_CPU_X86)
|TARGETS.cpuAMD64: SCAN.NewDef(DEF_CPU_X8664)
|TARGETS.cpuMSP430:
|TARGETS.cpuTHUMB:
|TARGETS.cpuRVM32I:
|TARGETS.cpuRVM64I:
END;
ST.compile(path, lib_path, modname, outname, target, options);
time := UTILS.GetTickCount() - UTILS.time;
C.StringLn("--------------------------------------------");
C.Dashes;
C.Int(PARS.lines); C.String(" lines, ");
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");
C.Int(WRITER.counter); C.StringLn(" bytes");

/programs/develop/oberon07/source/ELF.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS, STRINGS;
CONST
155,25 → 155,6
END NewSym;
PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
VAR
i, h: INTEGER;
g: SET;
BEGIN
h := 0;
i := 0;
WHILE name[i] # 0X DO
h := h * 16 + ORD(name[i]);
g := BITS(h) * {28..31};
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
INC(i)
END
RETURN h
END HashStr;
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
VAR
symi, hi, k: INTEGER;
329,11 → 310,11
hashtab := CHL.CreateIntList();
CHL.PushInt(hashtab, HashStr(""));
CHL.PushInt(hashtab, STRINGS.HashStr(""));
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlopen"));
CHL.PushInt(hashtab, STRINGS.HashStr("dlopen"));
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlsym"));
CHL.PushInt(hashtab, STRINGS.HashStr("dlsym"));
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
IF so THEN
340,7 → 321,7
item := program.exp_list.first;
WHILE item # NIL DO
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
CHL.PushInt(hashtab, HashStr(Name));
CHL.PushInt(hashtab, STRINGS.HashStr(Name));
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
item := item.next
END;

/programs/develop/oberon07/source/ERRORS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
25,6 → 25,7
CASE warning OF
|0: C.StringLn("passing a string value as a fixed array")
|1: C.StringLn("endless FOR loop")
|2: C.StringLn("identifier too long")
END
END WarningMsg;
43,7 → 44,7
| 3: str := "unclosed string"
| 4: str := "illegal character"
| 5: str := "string too long"
| 6: str := "identifier too long"
| 7: str := "number too long"
| 8..12: str := "number too large"
| 13: str := "real numbers not supported"

/programs/develop/oberon07/source/FILES.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
154,11 → 154,10
PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
VAR
free, n, k, res, idx: INTEGER;
free, n, idx: INTEGER;
BEGIN
idx := 0;
res := 0;
IF (file # NIL) & (file.count >= 0) THEN
free := LEN(file.buffer) - file.count;
165,16 → 164,14
WHILE bytes > 0 DO
n := MIN(free, bytes);
copy(chunk, idx, file.buffer, file.count, n);
INC(res, n);
DEC(free, n);
DEC(bytes, n);
INC(idx, n);
INC(file.count, n);
IF free = 0 THEN
k := flush(file);
IF k # LEN(file.buffer) THEN
IF flush(file) # LEN(file.buffer) THEN
bytes := 0;
DEC(res, n)
DEC(idx, n)
ELSE
file.count := 0;
free := LEN(file.buffer)
184,7 → 181,7
END
RETURN res
RETURN idx
END write;

/programs/develop/oberon07/source/IL.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
16,6 → 16,8
call_win64* = 1;
call_sysv* = 2;
begin_loop* = 1; end_loop* = 2;
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;
44,7 → 46,7
opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
opPOPSP* = 86;
opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91;
opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opAND* = 90; opOR* = 91;
opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
opPUSHC* = 98; opSWITCH* = 99;
79,7 → 81,6
opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215;
opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219;
opAND* = 220; opOR* = 221;
opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
132,12 → 133,6
TYPE
LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
offset*, size*, count*: INTEGER
END;
COMMAND* = POINTER TO RECORD (LISTS.ITEM)
opcode*: INTEGER;
144,9 → 139,7
param1*: INTEGER;
param2*: INTEGER;
param3*: INTEGER;
float*: REAL;
variables*: LISTS.LIST;
allocReg*: BOOLEAN
float*: REAL
END;
166,13 → 159,13
EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
label*: INTEGER;
name*: SCAN.LEXSTR
name*: SCAN.IDSTR
END;
IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)
name*: SCAN.LEXSTR;
name*: SCAN.TEXTSTR;
procs*: LISTS.LIST
END;
181,7 → 174,7
label*: INTEGER;
lib*: IMPORT_LIB;
name*: SCAN.LEXSTR;
name*: SCAN.TEXTSTR;
count: INTEGER
END;
215,7 → 208,7
codes*: CODES;
CPU: INTEGER;
commands, variables: C.COLLECTION;
commands: C.COLLECTION;
PROCEDURE set_dmin* (value: INTEGER);
247,33 → 240,12
NEW(cmd)
ELSE
cmd := citem(COMMAND)
END;
END
cmd.allocReg := FALSE
RETURN cmd
END NewCmd;
PROCEDURE NewVar* (): LOCALVAR;
VAR
lvar: LOCALVAR;
citem: C.ITEM;
BEGIN
citem := C.pop(variables);
IF citem = NIL THEN
NEW(lvar)
ELSE
lvar := citem(LOCALVAR)
END;
lvar.count := 0
RETURN lvar
END NewVar;
PROCEDURE setlast* (cmd: COMMAND);
BEGIN
codes.last := cmd
493,16 → 465,34
set(cur, opGADR_SAVEC, param2)
ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
cur.param2 := param2 * cur.param2
cur.param2 := cur.param2 * param2
ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
cur.param2 := param2 + cur.param2
INC(cur.param2, param2)
ELSE
old_opcode := -1
END
ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
old_opcode := cur.opcode;
param2 := nov.param2;
IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN
cur.opcode := opLADR_SAVE
ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN
set(cur, opLADR_INCC, param2)
ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
cur.param2 := cur.param2 * param2
ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
INC(cur.param2, param2)
ELSE
old_opcode := -1
END
ELSE
old_opcode := -1
END;
IF old_opcode = -1 THEN
583,23 → 573,8
END AddCmd0;
PROCEDURE deleteVarList (list: LISTS.LIST);
VAR
last: LISTS.ITEM;
BEGIN
WHILE list.last # NIL DO
last := LISTS.pop(list);
C.push(variables, last)
END
END deleteVarList;
PROCEDURE delete (cmd: COMMAND);
BEGIN
IF cmd.variables # NIL THEN
deleteVarList(cmd.variables)
END;
LISTS.delete(codes.commands, cmd);
C.push(commands, cmd)
END delete;
626,7 → 601,7
END delete2;
PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER);
PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER);
VAR
prev: COMMAND;
not: BOOLEAN;
649,7 → 624,7
IF not THEN
delete(prev)
END
END AddJmpCmd;
END Jmp;
PROCEDURE AndOrOpt* (VAR label: INTEGER);
706,9 → 681,9
END;
IF jz THEN
AddJmpCmd(opJZ, label)
Jmp(opJZ, label)
ELSE
AddJmpCmd(opJNZ, label)
Jmp(opJNZ, label)
END;
IF op = opOR THEN
715,7 → 690,7
SetLabel(l)
END
ELSE
AddJmpCmd(opJZ, label)
Jmp(opJZ, label)
END;
setlast(codes.last)
734,7 → 709,7
BEGIN
AddCmd(op, t);
label := NewLabel();
AddJmpCmd(opJNZ, label);
Jmp(opJNZ, label);
OnError(line, error);
SetLabel(label)
END TypeGuard;
789,7 → 764,6
cmd.opcode := opENTER;
cmd.param1 := label;
cmd.param3 := params;
cmd.allocReg := TRUE;
insert(codes.last, cmd)
RETURN codes.last
829,9 → 803,9
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
BEGIN
CASE callconv OF
|call_stack: AddJmpCmd(opCALL, proc)
|call_win64: AddJmpCmd(opWIN64CALL, proc)
|call_sysv: AddJmpCmd(opSYSVCALL, proc)
|call_stack: Jmp(opCALL, proc)
|call_win64: Jmp(opWIN64CALL, proc)
|call_sysv: Jmp(opSYSVCALL, proc)
END;
codes.last(COMMAND).param2 := fparams
END Call;
840,9 → 814,9
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
BEGIN
CASE callconv OF
|call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label)
|call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label)
|call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label)
|call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label)
|call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label)
|call_sysv: Jmp(opSYSVCALLI, proc(IMPORT_PROC).label)
END;
codes.last(COMMAND).param2 := fparams
END CallImp;
860,25 → 834,25
PROCEDURE AssignProc* (proc: INTEGER);
BEGIN
AddJmpCmd(opSAVEP, proc)
Jmp(opSAVEP, proc)
END AssignProc;
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
BEGIN
AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label)
Jmp(opSAVEIP, proc(IMPORT_PROC).label)
END AssignImpProc;
PROCEDURE PushProc* (proc: INTEGER);
BEGIN
AddJmpCmd(opPUSHP, proc)
Jmp(opPUSHP, proc)
END PushProc;
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
BEGIN
AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label)
Jmp(opPUSHIP, proc(IMPORT_PROC).label)
END PushImpProc;
885,9 → 859,9
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
BEGIN
IF eq THEN
AddJmpCmd(opEQP, proc)
Jmp(opEQP, proc)
ELSE
AddJmpCmd(opNEP, proc)
Jmp(opNEP, proc)
END
END ProcCmp;
895,9 → 869,9
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
BEGIN
IF eq THEN
AddJmpCmd(opEQIP, proc(IMPORT_PROC).label)
Jmp(opEQIP, proc(IMPORT_PROC).label)
ELSE
AddJmpCmd(opNEIP, proc(IMPORT_PROC).label)
Jmp(opNEIP, proc(IMPORT_PROC).label)
END
END ProcImpCmp;
1089,7 → 1063,7
END fname;
PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR);
VAR
exp: EXPORT_PROC;
1101,7 → 1075,7
END AddExp;
PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC;
PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC;
VAR
lib: IMPORT_LIB;
p: IMPORT_PROC;
1162,7 → 1136,6
BEGIN
commands := C.create();
variables := C.create();
CPU := pCPU;

/programs/develop/oberon07/source/LISTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
126,20 → 126,23
prev := item.prev;
next := item.next;
IF (next # NIL) & (prev # NIL) THEN
IF next # NIL THEN
IF prev # NIL THEN
prev.next := next;
next.prev := prev
ELSIF (next = NIL) & (prev = NIL) THEN
list.first := NIL;
list.last := NIL
ELSIF (next = NIL) & (prev # NIL) THEN
prev.next := NIL;
list.last := prev
ELSIF (next # NIL) & (prev = NIL) THEN
ELSE
next.prev := NIL;
list.first := next
END
ELSE
IF prev # NIL THEN
prev.next := NIL;
list.last := prev
ELSE
list.first := NIL;
list.last := NIL
END
END
END delete;

/programs/develop/oberon07/source/MSP430.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
13,10 → 13,12
CONST
chkSTK* = 6;
minRAM* = 128; maxRAM* = 2048;
minROM* = 2048; maxROM* = 24576;
minStackSize = 64;
StkReserve = RTL.StkReserve;
IntVectorSize* = RTL.IntVectorSize;
24,7 → 26,7
R4 = 4; R5 = 5; R6 = 6; R7 = 7;
HP = 14; IR = 15;
HP = RTL.HP;
ACC = R4;
108,9 → 110,14
IdxWords: RECORD src, dst: INTEGER END;
StkCnt: INTEGER;
StkCnt, MaxStkCnt: INTEGER;
PROCEDURE CheckProcDataSize* (VarSize, RamSize: INTEGER): BOOLEAN;
RETURN (VarSize + 1) * 2 + StkReserve + RTL.VarSize < RamSize
END CheckProcDataSize;
PROCEDURE EmitLabel (L: INTEGER);
VAR
label: LABEL;
163,6 → 170,13
END EmitCall;
PROCEDURE IncStk;
BEGIN
INC(StkCnt);
MaxStkCnt := MAX(StkCnt, MaxStkCnt)
END IncStk;
PROCEDURE bw (b: BOOLEAN): INTEGER;
RETURN BW * ORD(b)
END bw;
266,7 → 280,7
Op1(opPUSH, PC, sINCR);
EmitWord(imm)
END;
INC(StkCnt)
IncStk
END PushImm;
389,7 → 403,7
PROCEDURE Push (reg: INTEGER);
BEGIN
Op1(opPUSH, reg, sREG);
INC(StkCnt)
IncStk
END Push;
440,6 → 454,8
PROCEDURE CallRTL (proc, params: INTEGER);
BEGIN
IncStk;
DEC(StkCnt);
EmitCall(RTL.rtl[proc].label);
RTL.Used(proc);
IF params > 0 THEN
611,7 → 627,7
END LocalSrc;
PROCEDURE translate;
PROCEDURE translate (chk_stk: BOOLEAN);
VAR
cmd, next: COMMAND;
621,6 → 637,8
cc: INTEGER;
word: WORD;
BEGIN
cmd := IL.codes.commands.first(COMMAND);
636,9 → 654,13
EmitJmp(opJMP, param1)
|IL.opCALL:
IncStk;
DEC(StkCnt);
EmitCall(param1)
|IL.opCALLP:
IncStk;
DEC(StkCnt);
UnOp(reg1);
Op1(opCALL, reg1, sREG);
drop;
652,7 → 674,7
|IL.opSADR_PARAM:
Op1(opPUSH, PC, sINCR);
INC(StkCnt);
IncStk;
EmitWord(param2);
Reloc(RDATA)
663,8 → 685,10
PushImm(param2)
|IL.opONERR:
DEC(StkCnt);
EmitWord(0C232H); (* BIC #8, SR; DINT *)
EmitWord(4303H); (* MOV R3, R3; NOP *)
PushImm(param2);
DEC(StkCnt);
EmitJmp(opJMP, param1)
|IL.opLEAVEC:
672,8 → 696,25
|IL.opENTER:
ASSERT(R.top = -1);
EmitLabel(param1);
n := param2 MOD 65536;
param2 := param2 DIV 65536;
StkCnt := 0;
EmitLabel(param1);
IF chk_stk THEN
L := NewLabel();
Op2(opMOV, SP * 256, R4);
Op2(opSUB, HP * 256, R4);
Op2(opCMP, imm(StkReserve), R4);
word := CodeList.last(WORD);
jcc(jge, L);
DEC(StkCnt);
EmitWord(0C232H); (* BIC #8, SR; DINT *)
EmitWord(4303H); (* MOV R3, R3; NOP *)
PushImm(n);
EmitJmp(opJMP, cmd.param3);
EmitLabel(L)
END;
IF param2 > 8 THEN
Op2(opMOV, imm(param2), R4);
L := NewLabel();
681,12 → 722,13
Push(CG);
Op2(opSUB, imm(1), R4);
jcc(jne, L)
ELSIF param2 > 0 THEN
WHILE param2 > 0 DO
Push(CG);
DEC(param2)
ELSE
FOR n := 1 TO param2 DO
Push(CG)
END
END
END;
StkCnt := param2;
MaxStkCnt := StkCnt
|IL.opLEAVE, IL.opLEAVER:
ASSERT(param2 = 0);
693,14 → 735,15
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # ACC THEN
GetRegA;
ASSERT(REG.Exchange(R, reg1, ACC));
drop
mov(ACC, reg1)
END;
drop
END;
ASSERT(R.top = -1);
ASSERT(StkCnt = param1);
IF chk_stk THEN
INC(word.val, MaxStkCnt * 2)
END;
IF param1 > 0 THEN
Op2(opADD, imm(param1 * 2), SP)
END;
930,9 → 973,6
Test(reg1);
setcc(jne, reg1)
|IL.opLOOP:
|IL.opENDLOOP:
|IL.opGET:
BinOp(reg1, reg2);
drop;
1036,7 → 1076,7
UnOp(reg1);
PushAll(0);
Op1(opPUSH, reg1, sIDX);
INC(StkCnt);
IncStk;
EmitWord(-2);
PushImm(param2);
CallRTL(RTL._guardrec, 2);
1144,8 → 1184,12
|IL.opCASELR:
Op2(opCMP, imm(param1), ACC);
IF param2 = cmd.param3 THEN
jcc(jne, param2)
ELSE
jcc(jl, param2);
jcc(jg, cmd.param3)
END
|IL.opSBOOL:
BinOp(reg2, reg1);
1351,7 → 1395,7
UnOp(reg1);
PushAll_1;
Op1(opPUSH, PC, sINCR);
INC(StkCnt);
IncStk;
EmitWord(param2);
Reloc(RDATA);
Push(reg1);
1534,12 → 1578,12
END translate;
PROCEDURE prolog (ramSize: INTEGER);
PROCEDURE prolog;
VAR
i: INTEGER;
BEGIN
RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize);
RTL.Init(EmitLabel, EmitWord, EmitCall);
FOR i := 0 TO LEN(RTL.rtl) - 1 DO
RTL.Set(i, NewLabel())
END;
1551,14 → 1595,14
Op2(opMOV, incr(PC), HP);
EmitWord(0);
Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *)
Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR));
Op2(opMOV, imm(0), dst_x(RTL.trap, SR))
Op2(opMOV, imm(RTL.empty_proc), dst_x(0, SP));
Op2(opMOV, imm(RTL.empty_proc), dst_x(2, SP));
END prolog;
PROCEDURE epilog;
VAR
L1, i: INTEGER;
L1, i, n: INTEGER;
BEGIN
Op2(opBIS, imm(10H), SR); (* CPUOFF *)
1575,22 → 1619,24
EmitLabel(L1);
MovRR(SP, IR);
n := 0;
FOR i := 0 TO 15 DO
IF i IN R.regs + R.vregs THEN
Push(i)
IF i IN R.regs THEN
Push(i);
INC(n)
END
END;
Push(IR);
Op1(opPUSH, IR, sINDIR);
Op1(opCALL, SR, sIDX);
EmitWord(RTL.int);
MovRR(SP, R4);
Op2(opADD, imm(n * 2), R4);
Push(R4);
Op1(opPUSH, R4, sINDIR);
Op1(opCALL, SR, sIDX); EmitWord(-RTL.VarSize); Reloc(RBSS); (* call int *)
Op2(opADD, imm(4), SP);
FOR i := 15 TO 0 BY -1 DO
IF i IN R.regs + R.vregs THEN
IF i IN R.regs THEN
Pop(i)
END
END;
1606,7 → 1652,7
VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER;
Code, Data, Bss, Free: RECORD address, size: INTEGER END;
Code, Data, Bss: RECORD address, size: INTEGER END;
ram, rom: INTEGER;
1625,7 → 1671,7
ram := MIN(MAX(ram, minRAM), maxRAM);
rom := MIN(MAX(rom, minROM), maxROM);
IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN
IF IL.codes.bss > ram - StkReserve - RTL.VarSize THEN
ERRORS.Error(204)
END;
1634,24 → 1680,27
CHL.PushInt(Labels, 0)
END;
FOR i := 0 TO LEN(mem) - 1 DO
mem[i] := 0
END;
TypesSize := CHL.Length(IL.codes.types) * 2;
CodeList := LISTS.create(NIL);
RelList := LISTS.create(NIL);
REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {});
REG.Init(R, Push, Pop, mov, xchg, {R4, R5, R6, R7});
prolog(ram);
translate;
prolog;
translate(chkSTK IN options.checking);
epilog;
Code.address := 10000H - rom;
Code.size := Fixup(Code.address, IntVectorSize + TypesSize);
TypesSize := CHL.Length(IL.codes.types) * 2;
Data.size := CHL.Length(IL.codes.data);
IF ODD(Data.size) THEN
CHL.PushByte(IL.codes.data, 0);
INC(Data.size)
END;
Code.size := Fixup(0, IntVectorSize + TypesSize + Data.size);
Code.address := 10000H - (IntVectorSize + TypesSize + Data.size + Code.size);
IF Code.address < 10000H - rom THEN
ERRORS.Error(203)
END;
Code.size := Fixup(Code.address, IntVectorSize + TypesSize + Data.size);
Data.address := Code.address + Code.size;
Data.size := CHL.Length(IL.codes.data);
Data.size := Data.size + Data.size MOD 2;
TextSize := Code.size + Data.size;
IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN
1658,11 → 1707,13
ERRORS.Error(203)
END;
Bss.address := RTL.ram + RTL.VarSize;
stack := RTL.ram + ram;
Bss.size := IL.codes.bss + IL.codes.bss MOD 2;
heap := Bss.address + Bss.size;
stack := RTL.ram + ram;
ASSERT(stack - heap >= minStackSize);
DEC(stack, Bss.size);
Bss.address := stack;
DEC(stack, RTL.VarSize);
heap := RTL.ram;
ASSERT(stack - heap >= StkReserve);
adr := Code.address + 2;
PutWord(stack, adr);
adr := Code.address + 6;
1675,7 → 1726,7
CASE reloc.section OF
|RCODE: PutWord(LabelOffs(val) * 2, adr)
|RDATA: PutWord(val + Data.address, adr)
|RBSS: PutWord(val + Bss.address, adr)
|RBSS: PutWord((val + Bss.address) MOD 65536, adr)
END;
reloc := reloc.next(RELOC)
END;
1682,13 → 1733,11
adr := Data.address;
FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO
FOR i := 0 TO Data.size - 1 DO
mem[adr] := CHL.GetByte(IL.codes.data, i);
INC(adr)
END;
adr := 10000H - IntVectorSize - TypesSize;
FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO
PutWord(CHL.GetInt(IL.codes.types, i), adr)
END;
1705,11 → 1754,6
END
END;
Free.address := Code.address + TextSize;
Free.size := rom - (IntVectorSize + TypesSize + TextSize);
PutWord(Free.address, adr);
PutWord(Free.size, adr);
PutWord(4130H, adr); (* RET *)
PutWord(stack, adr);
PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *)
1718,26 → 1762,18
PutWord(LabelOffs(IV[i]) * 2, adr)
END;
INC(TextSize, IntVectorSize + TypesSize + Code.address MOD 16);
INC(Bss.size, StkReserve + RTL.VarSize);
WR.Create(outname);
HEX.Data(mem, Code.address, TextSize);
HEX.Data(mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
HEX.Data(mem, Code.address - Code.address MOD 16, TextSize);
HEX.End;
WR.Close;
INC(TextSize, IntVectorSize + TypesSize);
INC(Bss.size, minStackSize + RTL.VarSize);
C.StringLn("--------------------------------------------");
C.Dashes;
C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)");
IF Free.size > 0 THEN
C.String( " "); C.Int(Free.size); C.String(" bytes free (0");
C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)")
END;
C.Ln;
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)")
END CodeGen;

/programs/develop/oberon07/source/MSP430RTL.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
34,7 → 34,7
_new* = 21;
HP = 14;
HP* = 15;
LenIV* = 32;
42,9 → 42,7
bsl = iv - 2;
sp = bsl - 2;
empty_proc* = sp - 2;
free_size = empty_proc - 2;
free_adr = free_size - 2;
bits = free_adr - 272;
bits = empty_proc - 272;
bits_offs = bits - 32;
DataSize* = iv - bits_offs;
types = bits_offs - 2;
53,7 → 51,11
VarSize* = 4;
StkReserve* = 40;
trap = 2;
TYPE
EMITPROC = PROCEDURE (n: INTEGER);
61,7 → 63,7
VAR
ram*, trap*, int*: INTEGER;
ram*: INTEGER;
rtl*: ARRAY 22 OF
RECORD
187,7 → 189,7
Word1(5405H); (* ADD R4, R5 *)
Word2(5035H, bits); (* ADD bits, R5 *)
Word1(4524H); (* MOV @R5, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
Word1(4130H); (* RET *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
202,7 → 204,7
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
Word1(4130H); (* RET *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
234,7 → 236,7
Word2(0F114H, 2); (* AND 2(SP), R4 *)
Word1(2400H + 3); (* JZ L1 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
Word1(4130H); (* RET *)
(* L2: *)
Word1(4304H); (* MOV #0, R4 *)
(* L1: *)
374,22 → 376,18
(* _error (modNum, modName, err, line: INTEGER) *)
IF rtl[_error].used THEN
Label(rtl[_error].label);
Word1(0C232H); (* BIC #8, SR; DINT *)
Word1(4303H); (* MOV R3, R3; NOP *)
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- modNum *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- modName *)
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- err *)
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- line *)
Word1(5321H); (* ADD #2, SP *)
Word1(4134H); (* POP R4; R4 <- modNum *)
Word1(4135H); (* POP R5; R5 <- modName *)
Word1(4136H); (* POP R6; R6 <- err *)
Word1(4137H); (* POP R7; R7 <- line *)
Word2(4211H, sp); (* MOV sp(SR), SP *)
Word1(1207H); (* PUSH R7 *)
Word1(1206H); (* PUSH R6 *)
Word1(1205H); (* PUSH R5 *)
Word1(1204H); (* PUSH R4 *)
Word2(4214H, trap); (* MOV trap(SR), R4 *)
Word1(9304H); (* TST R4 *)
Word1(2400H + 1); (* JZ L *)
Word1(1284H); (* CALL R4 *)
(* L: *)
Word2(4214H, sp); (* MOV sp(SR), R4 *)
Word2(1294H, trap); (* CALL trap(R4) *)
Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
END;
400,7 → 398,7
Word1(4302H); (* MOV #0, SR *)
Word1(4303H); (* NOP *)
Word1(4104H); (* MOV SP, R4 *)
Word2(8034H, 16); (* SUB #16, R4 *)
Word2(8034H, StkReserve); (* SUB #StkReserve, R4 *)
Word1(4005H + 100H * HP); (* MOV HP, R5 *)
Word2(5115H, 6); (* ADD 6(SP), R5 *)
Word1(9504H); (* CMP R5, R4 *)
442,7 → 440,7
Word1(9405H); (* CMP R4, R5 *)
Word1(2400H + 2); (* JZ L2 *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
Word1(4130H); (* RET *)
(* L2: *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H) (* RET *)
661,14 → 659,12
END Used;
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER);
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC);
BEGIN
Label := pLabel;
Word := pWord;
Call := pCall;
ram := 200H;
trap := ram;
int := trap + 2
END Init;

/programs/develop/oberon07/source/PARS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
8,7 → 8,7
MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS,
C := COLLECTIONS, TARGETS, THUMB;
C := COLLECTIONS, TARGETS, THUMB, MSP430;
CONST
60,7 → 60,7
constexp*: BOOLEAN;
main*: BOOLEAN;
open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
open*: PROCEDURE (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
parse*: PROCEDURE (parser: PARSER);
StatSeq*: STATPROC;
expression*: EXPRPROC;
198,10 → 198,11
PROCEDURE ImportList (parser: PARSER);
VAR
fname, path, ext, _name: PATH;
name: SCAN.IDENT;
parser2: PARSER;
pos: POSITION;
alias: BOOLEAN;
alias, _in: BOOLEAN;
unit: PROG.UNIT;
ident: PROG.IDENT;
222,22 → 223,69
Next(parser);
path := parser.path;
fname := "";
ext := UTILS.FILE_EXT;
COPY(name.s, _name);
_in := FALSE;
IF parser.sym = SCAN.lxIN THEN
_in := TRUE;
Next(parser);
IF parser.sym = SCAN.lxSTRING THEN
STRINGS.trim(parser.lex.string.s, fname)
ELSIF parser.sym = SCAN.lxCHAR THEN
fname[0] := CHR(ARITH.Int(parser.lex.value));
fname[1] := 0X
ELSE
check1(FALSE, parser, 117)
END;
STRINGS.replace(fname, "/", UTILS.slash);
STRINGS.replace(fname, "\", UTILS.slash);
PATHS.DelSlashes(fname);
PATHS.split(fname, path, _name, ext);
IF PATHS.isRelative(path) THEN
PATHS.RelPath(parser.path, path, fname);
STRINGS.append(fname, _name);
STRINGS.append(fname, ext);
PATHS.split(fname, path, _name, ext)
END;
Next(parser)
END;
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE;
unit := PROG.getUnit(name);
IF (fname = "") & ((_name = "SYSTEM") OR PROG.LowerCase & (_name = "system")) THEN
unit := PROG.program.sysunit
ELSE
IF fname # "" THEN
unit := PROG.getUnit(fname)
ELSE
fname := path;
STRINGS.append(fname, _name);
STRINGS.append(fname, UTILS.FILE_EXT);
unit := PROG.getUnit(fname);
IF unit = NIL THEN
fname := parser.lib_path;
STRINGS.append(fname, _name);
STRINGS.append(fname, UTILS.FILE_EXT);
unit := PROG.getUnit(fname)
END
END
END;
IF unit # NIL THEN
check(unit.closed, pos, 31)
ELSE
parser2 := parser.create(parser.path, parser.lib_path,
parser2 := parser.create(path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
IF ~parser2.open(parser2, name.s) THEN
IF parser.path # parser.lib_path THEN
IF ~parser2.open(parser2, _name, ext) THEN
IF (path # parser.lib_path) & ~_in THEN
destroy(parser2);
parser2 := parser.create(parser.lib_path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
check(parser2.open(parser2, name.s), pos, 29)
check(parser2.open(parser2, _name, ext), pos, 29)
ELSE
error(pos, 29)
END
245,6 → 293,7
parser2.parse(parser2);
unit := parser2.unit;
unit.fname := parser2.fname;
destroy(parser2)
END;
IF unit = PROG.program.sysunit THEN
294,8 → 343,8
PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
VAR
str: SCAN.LEXSTR;
string1, string2: SCAN.IDENT;
str: SCAN.TEXTSTR;
string1, string2: SCAN.STRING;
bool: BOOLEAN;
BEGIN
303,20 → 352,20
IF v.typ = ARITH.tCHAR THEN
ASSERT(v2.typ = ARITH.tSTRING);
ARITH.charToStr(v, str);
string1 := SCAN.enterid(str);
string2 := v2.string(SCAN.IDENT)
string1 := SCAN.enterStr(str);
string2 := v2.string(SCAN.STRING)
END;
IF v2.typ = ARITH.tCHAR THEN
ASSERT(v.typ = ARITH.tSTRING);
ARITH.charToStr(v2, str);
string2 := SCAN.enterid(str);
string1 := v.string(SCAN.IDENT)
string2 := SCAN.enterStr(str);
string1 := v.string(SCAN.STRING)
END;
IF v.typ = v2.typ THEN
string1 := v.string(SCAN.IDENT);
string2 := v2.string(SCAN.IDENT)
string1 := v.string(SCAN.STRING);
string2 := v2.string(SCAN.STRING)
END;
CASE operator OF
482,27 → 531,26
res, sf: INTEGER;
BEGIN
IF parser.lex.s = "stdcall" THEN
checklex(parser, SCAN.lxIDENT);
IF parser.lex.ident.s = "stdcall" THEN
sf := PROG.sf_stdcall
ELSIF parser.lex.s = "stdcall64" THEN
sf := PROG.sf_stdcall64
ELSIF parser.lex.s = "ccall" THEN
ELSIF parser.lex.ident.s = "cdecl" THEN
sf := PROG.sf_cdecl
ELSIF parser.lex.ident.s = "ccall" THEN
sf := PROG.sf_ccall
ELSIF parser.lex.s = "ccall16" THEN
sf := PROG.sf_ccall16
ELSIF parser.lex.s = "win64" THEN
ELSIF parser.lex.ident.s = "win64" THEN
sf := PROG.sf_win64
ELSIF parser.lex.s = "systemv" THEN
ELSIF parser.lex.ident.s = "systemv" THEN
sf := PROG.sf_systemv
ELSIF parser.lex.s = "windows" THEN
ELSIF parser.lex.ident.s = "windows" THEN
sf := PROG.sf_windows
ELSIF parser.lex.s = "linux" THEN
ELSIF parser.lex.ident.s = "linux" THEN
sf := PROG.sf_linux
ELSIF parser.lex.s = "code" THEN
ELSIF parser.lex.ident.s = "code" THEN
sf := PROG.sf_code
ELSIF parser.lex.s = "oberon" THEN
ELSIF parser.lex.ident.s = "oberon" THEN
sf := PROG.sf_oberon
ELSIF parser.lex.s = "noalign" THEN
ELSIF parser.lex.ident.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
check1(FALSE, parser, 124)
519,12 → 567,16
CASE sf OF
|PROG.sf_stdcall:
res := PROG.stdcall
|PROG.sf_stdcall64:
res := PROG.stdcall64
|PROG.sf_cdecl:
res := PROG.cdecl
|PROG.sf_ccall:
IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
res := PROG.ccall
|PROG.sf_ccall16:
res := PROG.ccall16
ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
res := PROG.win64
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
res := PROG.systemv
END
|PROG.sf_win64:
res := PROG.win64
|PROG.sf_systemv:
545,7 → 597,7
END
|PROG.sf_linux:
IF TARGETS.OS = TARGETS.osLINUX32 THEN
res := PROG.ccall16
res := PROG.ccall
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
res := PROG.systemv
END
560,11 → 612,11
PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
dll, proc: SCAN.LEXSTR;
dll, proc: SCAN.TEXTSTR;
pos: POSITION;
PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR);
PROCEDURE getStr (parser: PARSER; VAR name: SCAN.TEXTSTR);
VAR
pos: POSITION;
str: ARITH.VALUE;
573,7 → 625,7
getpos(parser, pos);
ConstExpression(parser, str);
IF str.typ = ARITH.tSTRING THEN
name := str.string(SCAN.IDENT).s
name := str.string(SCAN.STRING).s
ELSIF str.typ = ARITH.tCHAR THEN
ARITH.charToStr(str, name)
ELSE
614,10 → 666,14
|32: IF TARGETS.CPU = TARGETS.cpuX86 THEN
call := PROG.default32
ELSE
call := PROG.ccall
call := PROG.cdecl
END
|64: call := PROG.default64
|64: IF TARGETS.CPU = TARGETS.cpuAMD64 THEN
call := PROG.default64
ELSE
call := PROG.cdecl
END
END
END;
IF _import # NIL THEN
920,12 → 976,12
_import: IL.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
variables: LISTS.LIST;
int, flt: INTEGER;
comma: BOOLEAN;
code, iv: ARITH.VALUE;
codeProc,
handler: BOOLEAN;
line: INTEGER;
BEGIN
endmod := FALSE;
938,12 → 994,13
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
line := pos.line;
IF _import # NIL THEN
proc := IdentDef(parser, PROG.idIMP, name);
proc._import := _import;
IF _import.name = "" THEN
_import.name := name.s
COPY(name.s, _import.name)
END;
PROG.program.procs.last(PROG.PROC)._import := _import
ELSE
961,7 → 1018,7
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos2);
check(TARGETS.target = TARGETS.STM32CM3, pos2, 24);
check((TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE), pos2, 24);
Next(parser);
getpos(parser, pos2);
ConstExpression(parser, iv);
1075,8 → 1132,10
proc.proc.leave := IL.LeaveC()
END;
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
IF (TARGETS.CPU = TARGETS.cpuMSP430) & ~codeProc THEN
check(MSP430.CheckProcDataSize(enter.param2 + proc._type.parSize, PROG.program.options.ram), pos1, 63);
enter.param2 := enter.param2 * 65536 + line;
enter.param3 := IL.codes.errlabels[10]
END
END;
1086,15 → 1145,15
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (_import = NIL) THEN
check(endname = name, pos, 60);
check(PROG.IdEq(endname, name), pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
IF endname = parser.unit.name THEN
IF PROG.IdEq(endname, parser.unit.name) THEN
ExpectSym(parser, SCAN.lxPOINT);
Next(parser);
endmod := TRUE
ELSIF endname = name THEN
ELSIF PROG.IdEq(endname, name) THEN
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
1108,18 → 1167,8
END
END;
IF ~codeProc & (_import = NIL) THEN
variables := LISTS.create(NIL);
ELSE
variables := NIL
END;
PROG.closeScope(unit);
PROG.closeScope(unit, variables);
IF ~codeProc & (_import = NIL) THEN
enter.variables := variables
END
RETURN endmod
END ProcDeclaration;
1185,11 → 1234,11
ExpectSym(parser, SCAN.lxIDENT);
IF ~parser.main THEN
check1(parser.lex.s = parser.modname, parser, 23)
check1(parser.lex.ident.s = parser.modname, parser, 23)
END;
unit := PROG.newUnit(parser.lex.ident);
unit.fname := parser.fname;
parser.unit := unit;
ExpectSym(parser, SCAN.lxSEMI);
1214,7 → 1263,7
END;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
IL.Jmp(IL.opJMP, label);
name := IL.putstr(unit.name.s);
1228,7 → 1277,7
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
IL.SetErrLabel(errno);
IL.AddCmd(IL.opPUSHC, errno);
IL.AddJmpCmd(IL.opJMP, errlabel)
IL.Jmp(IL.opJMP, errlabel)
END;
endmod := DeclarationSequence(parser);
1245,7 → 1294,7
checklex(parser, SCAN.lxEND);
ExpectSym(parser, SCAN.lxIDENT);
check1(parser.lex.s = unit.name.s, parser, 25);
check1(parser.lex.ident.s = unit.name.s, parser, 25);
ExpectSym(parser, SCAN.lxPOINT)
END;
1254,12 → 1303,12
END parse;
PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
PROCEDURE open (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
BEGIN
ASSERT(parser # NIL);
STRINGS.append(parser.fname, modname);
STRINGS.append(parser.fname, parser.ext);
STRINGS.append(parser.fname, FileExt);
STRINGS.append(parser.modname, modname);
parser.scanner := SCAN.open(parser.fname)

/programs/develop/oberon07/source/PATHS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
29,7 → 29,7
BEGIN
len := LENGTH(fname);
pos1 := len - 1;
pos2 := len - 1;
pos2 := pos1;
STRINGS.search(fname, pos1, slash, FALSE);
STRINGS.search(fname, pos2, ".", FALSE);
45,8 → 45,7
STRINGS.copy(fname, name, pos1, 0, pos2 - pos1);
name[pos2 - pos1] := 0X;
STRINGS.copy(fname, ext, pos2, 0, len - pos2);
ext[len - pos2] := 0X;
ext[len - pos2] := 0X
END split;
67,6 → 66,12
error := FALSE;
j := 0;
WHILE (relative[j] = ".") & (relative[j + 1] = slash) DO
INC(j, 2)
ELSIF relative[j] = slash DO
INC(j)
END;
WHILE ~error & (relative[j] # 0X) DO
IF (relative[j] = ".") & (relative[j + 1] = ".") & (relative[j + 2] = slash) & (i > 0) & (res[i - 1] = slash) THEN
DEC(i, 2);
95,6 → 100,43
END RelPath;
PROCEDURE DelSlashes* (VAR path: ARRAY OF CHAR);
VAR
i, j, k: INTEGER;
c: CHAR;
BEGIN
i := 0;
j := 0;
k := 0;
REPEAT
c := path[j];
INC(j);
IF c = slash THEN
INC(k)
ELSE
k := 0
END;
IF k <= 1 THEN
path[i] := c;
INC(i)
END
UNTIL c = 0X;
i := 0;
j := 0;
REPEAT
c := path[j];
INC(j);
path[i] := c;
INC(i);
IF (c = slash) & (path[j] = ".") & (path[j + 1] = slash) THEN
INC(j, 2)
END
UNTIL c = 0X
END DelSlashes;
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN UTILS.isRelative(path)
END isRelative;

/programs/develop/oberon07/source/PROG.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE PROG;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS, PATHS;
CONST
44,25 → 44,24
default32* = 2; _default32* = default32 + 1;
stdcall* = 4; _stdcall* = stdcall + 1;
ccall* = 6; _ccall* = ccall + 1;
ccall16* = 8; _ccall16* = ccall16 + 1;
cdecl* = 6; _cdecl* = cdecl + 1;
ccall* = 8; _ccall* = ccall + 1;
win64* = 10; _win64* = win64 + 1;
stdcall64* = 12; _stdcall64* = stdcall64 + 1;
default64* = 14; _default64* = default64 + 1;
systemv* = 16; _systemv* = systemv + 1;
default16* = 18;
code* = 20; _code* = code + 1;
default64* = 12; _default64* = default64 + 1;
systemv* = 14; _systemv* = systemv + 1;
default16* = 16; _default16* = default16 + 1;
code* = 18; _code* = code + 1;
noalign* = 22;
callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
callee_clean_up* = {default32, _default32, stdcall, _stdcall, default64, _default64};
sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
sf_stdcall* = 0; sf_oberon* = 1; sf_cdecl* = 2; sf_ccall* = 3;
sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
sf_code* = 8; sf_oberon* = 9;
sf_noalign* = 10;
sf_code* = 8;
sf_noalign* = 9;
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
proc_flags* = {sf_stdcall, sf_cdecl, sf_ccall, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
rec_flags* = {sf_noalign};
STACK_FRAME = 2;
115,6 → 114,7
rUNIT = RECORD (LISTS.ITEM)
fname*: PATHS.PATH;
name*: SCAN.IDENT;
idents*: LISTS.LIST;
frwPointers: LISTS.LIST;
214,7 → 214,7
VAR
LowerCase: BOOLEAN;
LowerCase*: BOOLEAN;
idents: C.COLLECTION;
program*: PROGRAM;
300,15 → 300,18
END closeUnit;
PROCEDURE IdEq* (a, b: SCAN.IDENT): BOOLEAN;
RETURN (a.hash = b.hash) & (a.s = b.s)
END IdEq;
PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
VAR
item: IDENT;
BEGIN
ASSERT(ident # NIL);
item := unit.idents.last(IDENT);
WHILE (item.typ # idGUARD) & (item.name # ident) DO
WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
324,7 → 327,6
BEGIN
ASSERT(unit # NIL);
ASSERT(ident # NIL);
res := unique(unit, ident);
410,21 → 412,19
item: IDENT;
BEGIN
ASSERT(ident # NIL);
item := unit.idents.last(IDENT);
IF item # NIL THEN
IF currentScope THEN
WHILE (item.name # ident) & (item.typ # idGUARD) DO
WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END;
IF item.name # ident THEN
IF item.typ = idGUARD THEN
item := NIL
END
ELSE
WHILE (item # NIL) & (item.name # ident) DO
WHILE (item # NIL) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
END
452,7 → 452,8
NEW(item);
item := NewIdent();
item.name := NIL;
item.name.s := "";
item.name.hash := 0;
item.typ := idGUARD;
LISTS.push(unit.idents, item)
462,11 → 463,10
END openScope;
PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
PROCEDURE closeScope* (unit: UNIT);
VAR
item: IDENT;
del: IDENT;
lvar: IL.LOCALVAR;
BEGIN
item := unit.idents.last(IDENT);
477,17 → 477,6
IF (del.typ = idVAR) & (del.offset = -1) THEN
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
lvar := IL.NewVar();
lvar.offset := del.offset;
lvar.size := del._type.size;
IF del.typ = idVAR THEN
lvar.offset := -lvar.offset
END;
LISTS.push(variables, lvar)
END
END;
LISTS.delete(unit.idents, del);
C.push(idents, del)
END;
508,7 → 497,6
BEGIN
ASSERT(unit # NIL);
ASSERT(_type # NIL);
ASSERT(baseIdent # NIL);
NEW(newptr);
626,20 → 614,18
END arrcomp;
PROCEDURE getUnit* (name: SCAN.IDENT): UNIT;
PROCEDURE getUnit* (name: PATHS.PATH): UNIT;
VAR
item: UNIT;
BEGIN
ASSERT(name # NIL);
item := program.units.first(UNIT);
WHILE (item # NIL) & (item.name # name) DO
WHILE (item # NIL) & (item.fname # name) DO
item := item.next(UNIT)
END;
IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN
IF (item = NIL) & ((name = "SYSTEM") OR LowerCase & (name = "system")) THEN
item := program.sysunit
END
650,19 → 636,22
PROCEDURE enterStTypes (unit: UNIT);
PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
PROCEDURE enter (unit: UNIT; nameStr: SCAN.IDSTR; _type: _TYPE);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
upper: SCAN.IDSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idTYPE);
SCAN.setIdent(name, nameStr);
ident := addIdent(unit, name, idTYPE);
ident._type := _type
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
SCAN.setIdent(name, upper);
ident := addIdent(unit, name, idTYPE);
ident._type := _type
END enter;
687,80 → 676,64
PROCEDURE enterStProcs (unit: UNIT);
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
PROCEDURE Enter (unit: UNIT; nameStr: SCAN.IDSTR; nfunc, tfunc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
upper: SCAN.IDSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
ident.stproc := proc;
SCAN.setIdent(name, nameStr);
ident := addIdent(unit, name, tfunc);
ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
ident.stproc := proc;
SCAN.setIdent(name, upper);
ident := addIdent(unit, name, tfunc);
ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
END EnterProc;
END Enter;
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._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;
Enter(unit, "assert", stASSERT, idSTPROC);
Enter(unit, "dec", stDEC, idSTPROC);
Enter(unit, "excl", stEXCL, idSTPROC);
Enter(unit, "inc", stINC, idSTPROC);
Enter(unit, "incl", stINCL, idSTPROC);
Enter(unit, "new", stNEW, idSTPROC);
Enter(unit, "copy", stCOPY, idSTPROC);
Enter(unit, "abs", stABS, idSTFUNC);
Enter(unit, "asr", stASR, idSTFUNC);
Enter(unit, "chr", stCHR, idSTFUNC);
Enter(unit, "len", stLEN, idSTFUNC);
Enter(unit, "lsl", stLSL, idSTFUNC);
Enter(unit, "odd", stODD, idSTFUNC);
Enter(unit, "ord", stORD, idSTFUNC);
Enter(unit, "ror", stROR, idSTFUNC);
Enter(unit, "bits", stBITS, idSTFUNC);
Enter(unit, "lsr", stLSR, idSTFUNC);
Enter(unit, "length", stLENGTH, idSTFUNC);
Enter(unit, "min", stMIN, idSTFUNC);
Enter(unit, "max", stMAX, idSTFUNC);
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);
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)
Enter(unit, "pack", stPACK, idSTPROC);
Enter(unit, "unpk", stUNPK, idSTPROC);
Enter(unit, "floor", stFLOOR, idSTFUNC);
Enter(unit, "flt", stFLT, idSTFUNC)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterFunc(unit, "wchr", stWCHR)
Enter(unit, "wchr", stWCHR, idSTFUNC)
END;
IF TARGETS.Dispose THEN
EnterProc(unit, "dispose", stDISPOSE)
Enter(unit, "dispose", stDISPOSE, idSTPROC)
END
END enterStProcs;
771,8 → 744,6
unit: UNIT;
BEGIN
ASSERT(name # NIL);
NEW(unit);
unit.name := name;
810,7 → 781,6
BEGIN
ASSERT(self # NIL);
ASSERT(name # NIL);
ASSERT(unit # NIL);
field := NIL;
818,7 → 788,7
field := self.fields.first(FIELD);
WHILE (field # NIL) & (field.name # name) DO
WHILE (field # NIL) & ~IdEq(field.name, name) DO
field := field.next(FIELD)
END;
842,8 → 812,6
res: BOOLEAN;
BEGIN
ASSERT(name # NIL);
res := getField(self, name, self.unit) = NIL;
IF res THEN
901,11 → 869,9
item: PARAM;
BEGIN
ASSERT(name # NIL);
item := self.params.first(PARAM);
WHILE (item # NIL) & (item.name # name) DO
WHILE (item # NIL) & ~IdEq(item.name, name) DO
item := item.next(PARAM)
END
919,8 → 885,6
res: BOOLEAN;
BEGIN
ASSERT(name # NIL);
res := getParam(self, name) = NIL;
IF res THEN
1101,23 → 1065,27
VAR
ident: IDENT;
unit: UNIT;
name: SCAN.IDENT;
PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
PROCEDURE EnterProc (sys: UNIT; nameStr: SCAN.IDSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
upper: SCAN.IDSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(sys, SCAN.enterid(name), idtyp);
SCAN.setIdent(name, nameStr);
ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(sys, SCAN.enterid(upper), idtyp);
SCAN.setIdent(name, upper);
ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
1125,7 → 1093,9
BEGIN
unit := newUnit(SCAN.enterid("$SYSTEM"));
SCAN.setIdent(name, "$SYSTEM");
unit := newUnit(name);
unit.fname := "SYSTEM";
EnterProc(unit, "adr", idSYSFUNC, sysADR);
EnterProc(unit, "size", idSYSFUNC, sysSIZE);
1161,11 → 1131,13
EnterProc(unit, "get32", idSYSPROC, sysGET32);
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
SCAN.setIdent(name, "card32");
ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE
END;
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
SCAN.setIdent(name, "CARD32");
ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE;
END;
1247,11 → 1219,11
program.options := options;
CASE TARGETS.OS OF
|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.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
|TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
|TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
|TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_win64, sf_systemv, sf_ccall, sf_noalign}
|TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_win64, sf_systemv, sf_ccall, sf_noalign}
|TARGETS.osNONE: program.sysflags := {sf_code}
END;

/programs/develop/oberon07/source/REG.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
17,14 → 17,11
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
NVR = 32;
TYPE
OP1 = PROCEDURE (arg: INTEGER);
OP2 = PROCEDURE (arg1, arg2: INTEGER);
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
REGS* = RECORD
33,13 → 30,8
top*: INTEGER;
pushed*: INTEGER;
vregs*: SET;
offs: ARRAY NVR OF INTEGER;
size: ARRAY NVR OF INTEGER;
push, pop: OP1;
mov, xch: OP2;
load, save: OP3
mov, xch: OP2
END;
78,17 → 70,12
PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER;
VAR
i, n: INTEGER;
i: INTEGER;
BEGIN
i := 0;
n := R.top;
WHILE (i <= n) & (R.stk[i] # reg) DO
INC(i)
END;
IF i > n THEN
i := -1
i := R.top;
WHILE (i >= 0) & (R.stk[i] # reg) DO
DEC(i)
END
RETURN i
206,7 → 193,7
res: BOOLEAN;
BEGIN
res := FALSE;
res := TRUE;
IF reg1 # reg2 THEN
n1 := InStk(R, reg1);
215,24 → 202,21
IF (n1 # -1) & (n2 # -1) THEN
R.stk[n1] := reg2;
R.stk[n2] := reg1;
R.xch(reg2, reg1);
res := TRUE
R.xch(reg2, reg1)
ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
R.stk[n1] := reg2;
INCL(R.regs, reg1);
EXCL(R.regs, reg2);
R.mov(reg2, reg1);
res := TRUE
R.mov(reg2, reg1)
ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
R.stk[n2] := reg1;
EXCL(R.regs, reg1);
INCL(R.regs, reg2);
R.mov(reg1, reg2);
res := TRUE
END
R.mov(reg1, reg2)
ELSE
res := TRUE
res := FALSE
END
END
RETURN res
END Exchange;
252,8 → 236,8
reg2 := R.stk[R.top]
ELSIF R.top = 0 THEN
reg1 := PopAnyReg(R);
reg2 := R.stk[R.top]
ELSIF R.top < 0 THEN
reg2 := R.stk[1]
ELSE (* R.top = -1 *)
reg2 := PopAnyReg(R);
reg1 := PopAnyReg(R)
END
286,131 → 270,8
END PushAll_1;
PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; regs: SET);
BEGIN
ASSERT(reg IN R.vregs);
ASSERT(offs # 0);
ASSERT(size IN {1, 2, 4, 8});
R.offs[reg] := offs;
R.size[reg] := size
END Lock;
PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
BEGIN
ASSERT(reg IN R.vregs);
R.offs[reg] := 0
END Release;
PROCEDURE Load* (R: REGS; reg: INTEGER);
VAR
offs: INTEGER;
BEGIN
ASSERT(reg IN R.vregs);
offs := R.offs[reg];
IF offs # 0 THEN
R.load(reg, offs, R.size[reg])
END
END Load;
PROCEDURE Save* (R: REGS; reg: INTEGER);
VAR
offs: INTEGER;
BEGIN
ASSERT(reg IN R.vregs);
offs := R.offs[reg];
IF offs # 0 THEN
R.save(reg, offs, R.size[reg])
END
END Save;
PROCEDURE Store* (R: REGS);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO NVR - 1 DO
IF i IN R.vregs THEN
Save(R, i)
END
END
END Store;
PROCEDURE Restore* (R: REGS);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO NVR - 1 DO
IF i IN R.vregs THEN
Load(R, i)
END
END
END Restore;
PROCEDURE Reset* (VAR R: REGS);
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO NVR - 1 DO
IF i IN R.vregs THEN
R.offs[i] := 0
END
END
END Reset;
PROCEDURE GetVarReg* (R: REGS; offs: INTEGER): INTEGER;
VAR
i, res: INTEGER;
BEGIN
res := -1;
i := 0;
WHILE i < NVR DO
IF (i IN R.vregs) & (R.offs[i] = offs) THEN
res := i;
i := NVR
END;
INC(i)
END
RETURN res
END GetVarReg;
PROCEDURE GetAnyVarReg* (R: REGS): INTEGER;
VAR
i, res: INTEGER;
BEGIN
res := -1;
i := 0;
WHILE i < NVR DO
IF (i IN R.vregs) & (R.offs[i] = 0) THEN
res := i;
i := NVR
END;
INC(i)
END
RETURN res
END GetAnyVarReg;
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
VAR
i: INTEGER;
BEGIN
R.regs := regs;
R.pushed := 0;
R.top := -1;
419,16 → 280,6
R.pop := pop;
R.mov := mov;
R.xch := xch;
R.load := load;
R.save := save;
R.vregs := vregs;
FOR i := 0 TO NVR - 1 DO
R.offs[i] := 0;
R.size[i] := 0
END
END Init;

/programs/develop/oberon07/source/RVMxI.ob07
0,0 → 1,1428
(*
BSD 2-Clause License
Copyright (c) 2020-2021, Anton Krotov
All rights reserved.
*)
MODULE RVMxI;
IMPORT
PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS;
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; opNOP = 5;
opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11;
opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15;
opLDD = 16; (* 17, 18 *)
opJMP = 19; opCALL = 20; opCALLI = 21;
opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *)
opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64;
opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *)
opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65;
opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69;
opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75;
opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81;
VAR
R: REG.REGS; count, szWord: INTEGER;
ldr, str: PROCEDURE (r1, r2: INTEGER);
PROCEDURE OutByte (n: BYTE);
BEGIN
WR.WriteByte(n);
INC(count)
END OutByte;
PROCEDURE OutInt (n: INTEGER);
BEGIN
IF szWord = 8 THEN
WR.Write64LE(n);
INC(count, 8)
ELSE (* szWord = 4 *)
WR.Write32LE(n);
INC(count, 4)
END
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 ldr64 (r1, r2: INTEGER);
BEGIN
Emit(opLDD, r2 * 256 + r1, 0)
END ldr64;
PROCEDURE ldr32 (r1, r2: INTEGER);
BEGIN
Emit(opLDW, r2 * 256 + r1, 0)
END ldr32;
PROCEDURE ldr16 (r1, r2: INTEGER);
BEGIN
Emit(opLDH, r2 * 256 + r1, 0)
END ldr16;
PROCEDURE ldr8 (r1, r2: INTEGER);
BEGIN
Emit(opLDB, r2 * 256 + r1, 0)
END ldr8;
PROCEDURE str64 (r1, r2: INTEGER);
BEGIN
Emit(opSTD, r1 * 256 + r2, 0)
END str64;
PROCEDURE str32 (r1, r2: INTEGER);
BEGIN
Emit(opSTW, r1 * 256 + r2, 0)
END str32;
PROCEDURE str16 (r1, r2: INTEGER);
BEGIN
Emit(opSTH, r1 * 256 + r2, 0)
END str16;
PROCEDURE str8 (r1, r2: INTEGER);
BEGIN
Emit(opSTB, r1 * 256 + r2, 0)
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(opCMPC, r, 0);
Emit(opJNE, label, 0)
END jnz;
PROCEDURE CallRTL (proc, par: INTEGER);
BEGIN
Emit(opCALL, IL.codes.rtl[proc], 0);
addrc(SP, par * szWord)
END CallRTL;
PROCEDURE jcc (cc: INTEGER): INTEGER;
BEGIN
CASE cc OF
|IL.opEQ, IL.opEQC: cc := opJEQ
|IL.opNE, IL.opNEC: cc := opJNE
|IL.opLT, IL.opLTC: cc := opJLT
|IL.opLE, IL.opLEC: cc := opJLE
|IL.opGT, IL.opGTC: cc := opJGT
|IL.opGE, IL.opGEC: cc := opJGE
END
RETURN cc
END jcc;
PROCEDURE shift1 (op, param: INTEGER);
VAR
r1, r2: INTEGER;
BEGIN
r2 := GetAnyReg();
Emit(opMOVC, r2, param);
BinOp(r1, r2);
Emit(op, r2, r1);
mov(r1, r2);
drop
END shift1;
PROCEDURE shift (op: INTEGER);
VAR
r1, r2: INTEGER;
BEGIN
BinOp(r1, r2);
Emit(op, r1, r2);
drop
END shift;
PROCEDURE translate (szWord: INTEGER);
VAR
cmd, next: IL.COMMAND;
opcode, param1, param2, r1, r2, r3,
a, b, label, opLD, opST, opSTC: INTEGER;
BEGIN
IF szWord = 8 THEN
opLD := opLDD;
opST := opSTD;
opSTC := opSTDC
ELSE
opLD := opLDW;
opST := opSTW;
opSTC := opSTWC
END;
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 * szWord)
END
|IL.opNOP, IL.opAND, IL.opOR:
|IL.opSADR:
StrAdr(GetAnyReg(), param2)
|IL.opGADR:
GlobalAdr(GetAnyReg(), param2)
|IL.opLADR:
param2 := param2 * szWord;
next := cmd.next(IL.COMMAND);
IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN
UnOp(r1);
Emit(opSTD, BP * 256 + r1, param2);
drop;
cmd := next
ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN
UnOp(r1);
Emit(opSTW, BP * 256 + r1, param2);
drop;
cmd := next
ELSIF next.opcode = IL.opSAVE16 THEN
UnOp(r1);
Emit(opSTH, BP * 256 + r1, param2);
drop;
cmd := next
ELSIF next.opcode = IL.opSAVE8 THEN
UnOp(r1);
Emit(opSTB, BP * 256 + r1, param2);
drop;
cmd := next
ELSE
Emit(opADDRC, BP * 256 + GetAnyReg(), param2)
END
|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
mov(ACC, r1)
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:
next := cmd.next(IL.COMMAND);
IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN
pushc(param2);
cmd := next
ELSE
movrc(GetAnyReg(), param2)
END
|IL.opDROP:
UnOp(r1);
drop
|IL.opSAVEC:
UnOp(r1);
Emit(opSTC, r1, param2);
drop
|IL.opSAVE8C:
UnOp(r1);
Emit(opSTBC, r1, param2 MOD 256);
drop
|IL.opSAVE16C:
UnOp(r1);
Emit(opSTHC, r1, param2 MOD 65536);
drop
|IL.opSAVE, IL.opSAVEF:
BinOp(r2, r1);
str(r1, r2);
drop;
drop
|IL.opSAVE32:
BinOp(r2, r1);
str32(r1, r2);
drop;
drop
|IL.opSAVE64:
BinOp(r2, r1);
str64(r1, r2);
drop;
drop
|IL.opSAVEFI:
BinOp(r2, r1);
str(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.opGLOAD64:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr64(r1, r1)
|IL.opVADR:
Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord)
|IL.opLLOAD32:
Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord)
|IL.opLLOAD64:
Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord)
|IL.opVLOAD32:
r1 := GetAnyReg();
Emit(opLD, BP * 256 + r1, param2 * szWord);
ldr32(r1, r1)
|IL.opVLOAD64:
r1 := GetAnyReg();
Emit(opLDD, BP * 256 + r1, param2 * szWord);
ldr64(r1, r1)
|IL.opGLOAD16:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr16(r1, r1)
|IL.opLLOAD16:
Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord)
|IL.opVLOAD16:
r1 := GetAnyReg();
Emit(opLD, BP * 256 + r1, param2 * szWord);
ldr16(r1, r1)
|IL.opGLOAD8:
r1 := GetAnyReg();
GlobalAdr(r1, param2);
ldr8(r1, r1)
|IL.opLLOAD8:
Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord)
|IL.opVLOAD8:
r1 := GetAnyReg();
Emit(opLD, BP * 256 + r1, param2 * szWord);
ldr8(r1, r1)
|IL.opLOAD8:
UnOp(r1);
ldr8(r1, r1)
|IL.opLOAD16:
UnOp(r1);
ldr16(r1, r1)
|IL.opLOAD32:
UnOp(r1);
ldr32(r1, r1)
|IL.opLOAD64:
UnOp(r1);
ldr64(r1, r1)
|IL.opLOADF:
UnOp(r1);
ldr(r1, r1)
|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);
next := cmd.next(IL.COMMAND);
CASE next.opcode OF
|IL.opLOADF:
Emit(opLD, r1 * 256 + r1, param2);
cmd := next
|IL.opLOAD64:
Emit(opLDD, r1 * 256 + r1, param2);
cmd := next
|IL.opLOAD32:
Emit(opLDW, r1 * 256 + r1, param2);
cmd := next
|IL.opLOAD16:
Emit(opLDH, r1 * 256 + r1, param2);
cmd := next
|IL.opLOAD8:
Emit(opLDB, r1 * 256 + r1, param2);
cmd := next
ELSE
addrc(r1, param2)
END
|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 .. IL.opGE, IL.opEQC .. IL.opGEC:
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
BinOp(r1, r2);
Emit(opCMP, r1, r2);
drop
ELSE
UnOp(r1);
Emit(opCMPC, r1, param2)
END;
next := cmd.next(IL.COMMAND);
IF next.opcode = IL.opJZ THEN
Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0);
cmd := next;
drop
ELSIF next.opcode = IL.opJNZ THEN
Emit(jcc(opcode), next.param1, 0);
cmd := next;
drop
ELSE
Emit(jcc(opcode) + 6, r1, 0)
END
|IL.opJNZ1:
UnOp(r1);
jnz(r1, param1)
|IL.opJG:
UnOp(r1);
Emit(opCMPC, r1, 0);
Emit(opJGT, param1, 0)
|IL.opJNZ:
UnOp(r1);
jnz(r1, param1);
drop
|IL.opJZ:
UnOp(r1);
Emit(opCMPC, r1, 0);
Emit(opJEQ, param1, 0);
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:
shift(opASR)
|IL.opLSL:
shift(opLSL)
|IL.opROR:
shift(opROR)
|IL.opLSR:
shift(opLSR)
|IL.opASR1:
shift1(opASR, param2)
|IL.opLSL1:
shift1(opLSL, param2)
|IL.opROR1:
shift1(opROR, param2)
|IL.opLSR1:
shift1(opLSR, param2)
|IL.opASR2:
UnOp(r1);
Emit(opASRC, r1, param2 MOD (szWord * 8))
|IL.opLSL2:
UnOp(r1);
Emit(opLSLC, r1, param2 MOD (szWord * 8))
|IL.opROR2:
UnOp(r1);
Emit(opRORC, r1, param2 MOD (szWord * 8))
|IL.opLSR2:
UnOp(r1);
Emit(opLSRC, r1, param2 MOD (szWord * 8))
|IL.opCHR:
UnOp(r1);
Emit(opANDC, r1, 255)
|IL.opWCHR:
UnOp(r1);
Emit(opANDC, r1, 65535)
|IL.opABS:
UnOp(r1);
Emit(opCMPC, r1, 0);
label := IL.NewLabel();
Emit(opJGE, label, 0);
Emit(opNEG, r1, 0);
Emit(opLABEL, label, 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:
Emit(opCMPC, ACC, param1);
Emit(opJLT, param2, 0)
|IL.opCASER:
Emit(opCMPC, ACC, param1);
Emit(opJGT, param2, 0)
|IL.opCASELR:
Emit(opCMPC, ACC, param1);
IF param2 = cmd.param3 THEN
Emit(opJNE, param2, 0)
ELSE
Emit(opJLT, param2, 0);
Emit(opJGT, cmd.param3, 0)
END
|IL.opSBOOL:
BinOp(r2, r1);
Emit(opCMPC, r2, 0);
Emit(opSNE, r2, 0);
str8(r1, r2);
drop;
drop
|IL.opSBOOLC:
UnOp(r1);
Emit(opSTBC, r1, ORD(param2 # 0));
drop
|IL.opINCC:
UnOp(r1);
r2 := GetAnyReg();
ldr(r2, r1);
addrc(r2, param2);
str(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();
ldr(r3, r1);
IF opcode = IL.opINC THEN
add(r3, r2)
ELSE
sub(r3, r2)
END;
str(r1, r3);
drop;
drop;
drop
|IL.opINCL, IL.opEXCL:
BinOp(r2, r1);
Emit(opBIT, r2, r2);
r3 := GetAnyReg();
ldr(r3, r1);
IF opcode = IL.opINCL THEN
Emit(opOR, r3, r2)
ELSE
Emit(opNOT, r2, 0);
Emit(opAND, r3, r2)
END;
str(r1, r3);
drop;
drop;
drop
|IL.opINCLC, IL.opEXCLC:
UnOp(r1);
r2 := GetAnyReg();
ldr(r2, r1);
IF opcode = IL.opINCLC THEN
Emit(opORC, r2, ORD({param2}))
ELSE
Emit(opANDC, r2, ORD(-{param2}))
END;
str(r1, r2);
drop;
drop
|IL.opEQB, IL.opNEB:
BinOp(r1, r2);
Emit(opCMPC, r1, 0);
Emit(opSNE, r1, 0);
Emit(opCMPC, r2, 0);
Emit(opSNE, r2, 0);
Emit(opCMP, r1, r2);
IF opcode = IL.opEQB THEN
Emit(opSEQ, r1, 0)
ELSE
Emit(opSNE, r1, 0)
END;
drop
|IL.opCHKBYTE:
BinOp(r1, r2);
Emit(opCMPC, r1, 256);
Emit(opJBT, param1, 0)
|IL.opCHKIDX:
UnOp(r1);
Emit(opCMPC, r1, param2);
Emit(opJBT, param1, 0)
|IL.opCHKIDX2:
BinOp(r1, r2);
IF param2 # -1 THEN
Emit(opCMP, r2, r1);
Emit(opJBT, param1, 0)
END;
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
|IL.opEQP, IL.opNEP:
ProcAdr(GetAnyReg(), param1);
BinOp(r1, r2);
Emit(opCMP, r1, r2);
IF opcode = IL.opEQP THEN
Emit(opSEQ, r1, 0)
ELSE
Emit(opSNE, r1, 0)
END;
drop
|IL.opSAVEP:
UnOp(r1);
r2 := GetAnyReg();
ProcAdr(r2, param2);
str(r1, r2);
drop;
drop
|IL.opPUSHP:
ProcAdr(GetAnyReg(), param2)
|IL.opPUSHT:
UnOp(r1);
Emit(opLD, r1 * 256 + GetAnyReg(), -szWord)
|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)
|8: ldr64(r1, r1); str64(r2, r1)
END
|IL.opNOT:
UnOp(r1);
Emit(opCMPC, r1, 0);
Emit(opSEQ, r1, 0)
|IL.opORD:
UnOp(r1);
Emit(opCMPC, r1, 0);
Emit(opSNE, r1, 0)
|IL.opMIN, IL.opMAX:
BinOp(r1, r2);
Emit(opCMP, r1, r2);
label := IL.NewLabel();
IF opcode = IL.opMIN THEN
Emit(opJLE, label, 0)
ELSE
Emit(opJGE, label, 0)
END;
Emit(opMOV, r1, r2);
Emit(opLABEL, label, 0);
drop
|IL.opMINC, IL.opMAXC:
UnOp(r1);
Emit(opCMPC, r1, param2);
label := IL.NewLabel();
IF opcode = IL.opMINC THEN
Emit(opJLE, label, 0)
ELSE
Emit(opJGE, label, 0)
END;
Emit(opMOVC, r1, param2);
Emit(opLABEL, label, 0)
|IL.opIN:
BinOp(r1, r2);
Emit(opBIT, r1, r1);
Emit(opAND, r1, r2);
Emit(opCMPC, r1, 0);
Emit(opSNE, r1, 0);
drop
|IL.opINL:
UnOp(r1);
Emit(opANDC, r1, ORD({param2}));
Emit(opCMPC, r1, 0);
Emit(opSNE, r1, 0)
|IL.opINR:
UnOp(r1);
Emit(opBIT, r1, r1);
Emit(opANDC, r1, param2);
Emit(opCMPC, r1, 0);
Emit(opSNE, r1, 0)
|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, szWord);
ASSERT(UTILS.Align(param2, szWord));
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, szWord);
ldr(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:
IF szWord = 8 THEN
movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b))
ELSE (* szWord = 4 *)
movrc(GetAnyReg(), UTILS.d2s(cmd.float))
END
|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(opRORC, r1, -1);
Emit(opXORC, r1, 1);
Emit(opRORC, r1, 1)
|IL.opFABS:
UnOp(r1);
Emit(opLSLC, r1, 1);
Emit(opLSRC, r1, 1)
|IL.opINF:
r1 := GetAnyReg();
Emit(opMOVC, r1, 1);
Emit(opRORC, r1, 1);
Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8));
Emit(opLSRC, r1, 1)
|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)
|IL.opLADR_SAVE:
UnOp(r1);
Emit(opST, BP * 256 + r1, param2 * szWord);
drop
|IL.opLADR_INCC:
r1 := GetAnyReg();
Emit(opLD, BP * 256 + r1, param1 * szWord);
Emit(opADDC, r1, param2);
Emit(opST, BP * 256 + r1, param1 * szWord);
drop
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, szWord: 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 szWord # 0 THEN
i := szWord - dcount MOD szWord;
WHILE i > 0 DO
OutByte(0);
DEC(i)
END
END;
szData := count - offTypes;
szGlobal := (IL.codes.bss DIV szWord + 1) * szWord;
szHeapStack := ram - szData - szGlobal;
OutInt(offTypes);
OutInt(offStrings);
OutInt(szGlobal DIV szWord);
OutInt(szHeapStack DIV szWord);
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
szWord := TARGETS.WordSize;
IF szWord = 8 THEN
ldr := ldr64;
str := str64
ELSE
ldr := ldr32;
str := str32
END;
szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord;
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, GPRs);
prolog;
translate(szWord);
epilog(szRAM, szWord);
WR.Close
END CodeGen;
END RVMxI.

/programs/develop/oberon07/source/SCAN.ob07
1,18 → 1,20
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE SCAN;
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
CONST
LEXLEN = 1024;
NUMLEN = 256;
IDLEN = 256;
TEXTLEN = 512;
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
39,7 → 41,7
lxWHILE* = 83;
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
lxERROR05* = -5; (*lxERROR06* = -6;*) lxERROR07* = -7; lxERROR08* = -8;
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
lxERROR13* = -13;
46,22 → 48,29
TYPE
LEXSTR* = ARRAY LEXLEN OF CHAR;
TEXTSTR* = ARRAY TEXTLEN OF CHAR;
IDSTR* = ARRAY IDLEN OF CHAR;
DEF = POINTER TO RECORD (LISTS.ITEM)
ident: LEXSTR
ident: IDSTR
END;
IDENT* = POINTER TO RECORD (AVL.DATA)
STRING* = POINTER TO RECORD (LISTS.ITEM)
s*: LEXSTR;
offset*, offsetW*: INTEGER;
key: INTEGER
s*: TEXTSTR;
offset*, offsetW*, hash: INTEGER
END;
IDENT* = RECORD
s*: IDSTR;
hash*: INTEGER
END;
POSITION* = RECORD
line*, col*: INTEGER
70,72 → 79,91
LEX* = RECORD
s*: LEXSTR;
length*: INTEGER;
sym*: INTEGER;
pos*: POSITION;
ident*: IDENT;
string*: IDENT;
string*: STRING;
value*: ARITH.VALUE;
error*: INTEGER;
error*: INTEGER
over: BOOLEAN
END;
SCANNER* = TXT.TEXT;
KEYWORD = ARRAY 10 OF CHAR;
VAR
idents: AVL.NODE;
delimiters: ARRAY 256 OF BOOLEAN;
NewIdent: IDENT;
upto, LowerCase, _if: BOOLEAN;
def: LISTS.LIST;
strings, def: LISTS.LIST;
KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
END nodecmp;
PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
BEGIN
KW[idx].lower := s;
KW[idx].upper := s;
S.UpCase(KW[idx].upper);
KW[idx].uhash := S.HashStr(KW[idx].upper);
KW[idx].lhash := S.HashStr(KW[idx].lower);
END enterKW;
PROCEDURE enterid* (s: LEXSTR): IDENT;
PROCEDURE checkKW (ident: IDENT): INTEGER;
VAR
newnode: BOOLEAN;
node: AVL.NODE;
i, res: INTEGER;
BEGIN
NewIdent.s := s;
idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
IF newnode THEN
NEW(NewIdent);
NewIdent.offset := -1;
NewIdent.offsetW := -1;
NewIdent.key := 0
res := lxIDENT;
i := 0;
WHILE i < LEN(KW) DO
IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
res := i + lxKW;
i := LEN(KW)
END;
INC(i)
END
RETURN node.data(IDENT)
END enterid;
RETURN res
END checkKW;
PROCEDURE putchar (VAR lex: LEX; c: CHAR);
PROCEDURE enterStr* (s: TEXTSTR): STRING;
VAR
str, res: STRING;
hash: INTEGER;
BEGIN
IF lex.length < LEXLEN - 1 THEN
lex.s[lex.length] := c;
INC(lex.length);
lex.s[lex.length] := 0X
hash := S.HashStr(s);
str := strings.first(STRING);
res := NIL;
WHILE str # NIL DO
IF (str.hash = hash) & (str.s = s) THEN
res := str;
str := NIL
ELSE
lex.over := TRUE
str := str.next(STRING)
END
END putchar;
END;
IF res = NIL THEN
NEW(res);
res.s := s;
res.offset := -1;
res.offsetW := -1;
res.hash := hash;
LISTS.push(strings, res)
END
RETURN res
END enterStr;
PROCEDURE nextc (text: TXT.TEXT): CHAR;
BEGIN
TXT.next(text)
143,43 → 171,68
END nextc;
PROCEDURE setIdent* (VAR ident: IDENT; s: IDSTR);
BEGIN
ident.s := s;
ident.hash := S.HashStr(s)
END setIdent;
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
VAR
c: CHAR;
i: INTEGER;
BEGIN
c := text.peak;
ASSERT(S.letter(c));
WHILE S.letter(c) OR S.digit(c) DO
putchar(lex, c);
i := 0;
WHILE (i < IDLEN - 1) & (S.letter(c) OR S.digit(c)) DO
lex.ident.s[i] := c;
INC(i);
c := nextc(text)
END;
IF lex.over THEN
lex.sym := lxERROR06
ELSE
lex.ident := enterid(lex.s);
IF lex.ident.key # 0 THEN
lex.sym := lex.ident.key
ELSE
lex.sym := lxIDENT
lex.ident.s[i] := 0X;
lex.ident.hash := S.HashStr(lex.ident.s);
lex.sym := checkKW(lex.ident);
IF S.letter(c) OR S.digit(c) THEN
ERRORS.WarningMsg(lex.pos.line, lex.pos.col, 2);
WHILE S.letter(c) OR S.digit(c) DO
c := nextc(text)
END
END
END ident;
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
TYPE
NUMSTR = ARRAY NUMLEN OF CHAR;
VAR
c: CHAR;
hex: BOOLEAN;
error, sym: INTEGER;
error, sym, i: INTEGER;
num: NUMSTR;
PROCEDURE push (VAR num: NUMSTR; VAR i: INTEGER; c: CHAR);
BEGIN
IF i < NUMLEN - 1 THEN
num[i] := c;
INC(i)
END
END push;
BEGIN
c := text.peak;
ASSERT(S.digit(c));
i := 0;
error := 0;
sym := lxINTEGER;
186,23 → 239,24
hex := FALSE;
WHILE S.digit(c) DO
putchar(lex, c);
push(num, i, c);
c := nextc(text)
END;
WHILE S.hexdigit(c) DO
putchar(lex, c);
WHILE S.hexdigit(c) OR LowerCase & ("a" <= c) & (c <= "f") DO
S.cap(c);
push(num, i, c);
c := nextc(text);
hex := TRUE
END;
IF c = "H" THEN
putchar(lex, c);
IF (c = "H") OR LowerCase & (c = "h") THEN
push(num, i, c);
TXT.next(text);
sym := lxHEX
ELSIF c = "X" THEN
putchar(lex, c);
ELSIF (c = "X") OR LowerCase & (c = "x") THEN
push(num, i, c);
TXT.next(text);
sym := lxCHAR
215,7 → 269,7
c := nextc(text);
IF c # "." THEN
putchar(lex, ".");
push(num, i, ".");
sym := lxFLOAT
ELSE
sym := lxINTEGER;
224,22 → 278,22
END;
WHILE S.digit(c) DO
putchar(lex, c);
push(num, i, c);
c := nextc(text)
END;
IF c = "E" THEN
IF (c = "E") OR LowerCase & (c = "e") THEN
putchar(lex, c);
push(num, i, c);
c := nextc(text);
IF (c = "+") OR (c = "-") THEN
putchar(lex, c);
push(num, i, c);
c := nextc(text)
END;
IF S.digit(c) THEN
WHILE S.digit(c) DO
putchar(lex, c);
push(num, i, c);
c := nextc(text)
END
ELSE
255,16 → 309,18
END;
IF lex.over & (sym >= 0) THEN
IF (i = NUMLEN - 1) & (sym >= 0) THEN
sym := lxERROR07
END;
num[i] := 0X;
IF sym = lxINTEGER THEN
ARITH.iconv(lex.s, lex.value, error)
ARITH.iconv(num, lex.value, error)
ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
ARITH.hconv(lex.s, lex.value, error)
ARITH.hconv(num, lex.value, error)
ELSIF sym = lxFLOAT THEN
ARITH.fconv(lex.s, lex.value, error)
ARITH.fconv(num, lex.value, error)
END;
CASE error OF
283,36 → 339,39
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
VAR
c: CHAR;
n: INTEGER;
i: INTEGER;
str: TEXTSTR;
BEGIN
c := nextc(text);
n := 0;
WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
putchar(lex, c);
i := 0;
WHILE (i < LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
str[i] := c;
c := nextc(text);
INC(n)
INC(i)
END;
str[i] := 0X;
IF (i = LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof THEN
lex.sym := lxERROR05
END;
IF c = quot THEN
TXT.next(text);
IF lex.over THEN
lex.sym := lxERROR05
ELSE
IF n # 1 THEN
IF i # 1 THEN
lex.sym := lxSTRING
ELSE
lex.sym := lxCHAR;
ARITH.setChar(lex.value, ORD(lex.s[0]))
ARITH.setChar(lex.value, ORD(str[0]))
END
END
ELSE
ELSIF lex.sym # lxERROR05 THEN
lex.sym := lxERROR03
END;
IF lex.sym = lxSTRING THEN
lex.string := enterid(lex.s);
lex.string := enterStr(str);
lex.value.typ := ARITH.tSTRING;
lex.value.string := lex.string
END
357,15 → 416,16
END comment;
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
PROCEDURE delimiter (text: TXT.TEXT; c: CHAR): INTEGER;
VAR
sym: INTEGER;
c0: CHAR;
BEGIN
putchar(lex, c);
c0 := c;
c := nextc(text);
CASE lex.s[0] OF
CASE c0 OF
|"+":
sym := lxPLUS
396,7 → 456,6
IF c = "." THEN
sym := lxRANGE;
putchar(lex, c);
TXT.next(text)
END
438,7 → 497,6
IF c = "=" THEN
sym := lxLE;
putchar(lex, c);
TXT.next(text)
END
447,7 → 505,6
IF c = "=" THEN
sym := lxGE;
putchar(lex, c);
TXT.next(text)
END
456,7 → 513,6
IF c = "=" THEN
sym := lxASSIGN;
putchar(lex, c);
TXT.next(text)
END
469,10 → 525,9
|"}":
sym := lxRCURLY
END;
END
lex.sym := sym
RETURN sym
END delimiter;
538,7 → 593,7
check(lex.sym = lxIDENT, text, lex, 22);
REPEAT
IF IsDef(lex.s) THEN
IF IsDef(lex.ident.s) THEN
skip := FALSE
END;
590,12 → 645,8
c := nextc(text)
END;
lex.s[0] := 0X;
lex.length := 0;
lex.pos.line := text.line;
lex.pos.col := text.col;
lex.ident := NIL;
lex.over := FALSE;
IF S.letter(c) THEN
ident(text, lex)
604,7 → 655,7
ELSIF (c = '"') OR (c = "'") THEN
string(text, lex, c)
ELSIF delimiters[ORD(c)] THEN
delimiter(text, lex, c)
lex.sym := delimiter(text, c)
ELSIF c = "$" THEN
IF S.letter(nextc(text)) THEN
ident(text, lex);
631,12 → 682,9
ELSIF (c = 7FX) & upto THEN
upto := FALSE;
lex.sym := lxRANGE;
putchar(lex, ".");
putchar(lex, ".");
DEC(lex.pos.col);
TXT.next(text)
ELSE
putchar(lex, c);
TXT.next(text);
lex.sym := lxERROR04
END;
668,25 → 716,7
i: INTEGER;
delim: ARRAY 23 OF CHAR;
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;
700,48 → 730,39
delimiters[ORD(delim[i])] := TRUE
END;
NEW(NewIdent);
NewIdent.s := "";
NewIdent.offset := -1;
NewIdent.offsetW := -1;
NewIdent.key := 0;
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("array", 0);
enterKW("begin", 1);
enterKW("by", 2);
enterKW("case", 3);
enterKW("const", 4);
enterKW("div", 5);
enterKW("do", 6);
enterKW("else", 7);
enterKW("elsif", 8);
enterKW("end", 9);
enterKW("false", 10);
enterKW("for", 11);
enterKW("if", 12);
enterKW("import", 13);
enterKW("in", 14);
enterKW("is", 15);
enterKW("mod", 16);
enterKW("module", 17);
enterKW("nil", 18);
enterKW("of", 19);
enterKW("or", 20);
enterKW("pointer", 21);
enterKW("procedure", 22);
enterKW("record", 23);
enterKW("repeat", 24);
enterKW("return", 25);
enterKW("then", 26);
enterKW("to", 27);
enterKW("true", 28);
enterKW("type", 29);
enterKW("until", 30);
enterKW("var", 31);
enterKW("while", 32)
END init;
757,5 → 778,6
BEGIN
def := LISTS.create(NIL)
def := LISTS.create(NIL);
strings := LISTS.create(NIL)
END SCAN.

/programs/develop/oberon07/source/STATEMENTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
9,7 → 9,7
IMPORT
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVM32I,
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVMxI,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
26,8 → 26,9
errCHR = 9; errWCHR = 10; errBYTE = 11;
chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
chkSTK* = MSP430.chkSTK; (* 6 *)
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE, chkSTK};
TYPE
207,7 → 208,7
IF e._type = tCHAR THEN
res := 1
ELSE
res := LENGTH(e.value.string(SCAN.IDENT).s)
res := LENGTH(e.value.string(SCAN.STRING).s)
END
RETURN res
END strlen;
240,7 → 241,7
IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
res := 1
ELSE
res := _length(e.value.string(SCAN.IDENT).s)
res := _length(e.value.string(SCAN.STRING).s)
END
RETURN res
END utf8strlen;
301,11 → 302,11
PROCEDURE String (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
string: SCAN.IDENT;
string: SCAN.STRING;
BEGIN
IF strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offset = -1 THEN
string.offset := IL.putstr(string.s);
END;
321,11 → 322,11
PROCEDURE StringW (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
string: SCAN.IDENT;
string: SCAN.STRING;
BEGIN
IF utf8strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
334,7 → 335,7
IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
offset := IL.putstrW1(ARITH.Int(e.value))
ELSE (* e._type.typ = PROG.tSTRING *)
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
383,7 → 384,7
END;
IL.AddCmd(IL.opCOPYA, VarType.base.size);
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ, label);
IL.Jmp(IL.opJNZ, label);
IL.OnError(line, errCOPY);
IL.SetLabel(label)
436,7 → 437,7
ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isCharW(e) & (VarType = tWCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
608,7 → 609,7
IL.Const(0);
IL.Param1
ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
IL.Const(StrToWChar(e.value.string(SCAN.STRING).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
709,12 → 710,6
getpos(parser, pos);
IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
IF parser.unit.scopeLvl > 0 THEN
parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE
END
END;
IF e.obj IN {eSTPROC, eSYSPROC} THEN
CASE proc OF
1146,11 → 1141,12
END
|PROG.stORD:
IL.AddCmd(IL.opPRECALL, 0);
PExpression(parser, e);
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
IF e.obj = eCONST THEN
IF isStringW1(e) THEN
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
ELSE
ARITH.ord(e.value)
END
1382,7 → 1378,7
IF chkPTR IN Options.checking THEN
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ1, label);
IL.Jmp(IL.opJNZ1, label);
IL.OnError(pos.line, error);
IL.SetLabel(label)
END
1551,7 → 1547,9
PARS.checklex(parser, SCAN.lxRSQUARE);
PARS.Next(parser);
IF ~(isArr(e) & (e._type.length = 0) & (parser.sym = SCAN.lxLSQUARE)) THEN
e.ident := NIL
END
ELSIF parser.sym = SCAN.lxCARET DO
getpos(parser, pos);
1628,7 → 1626,7
IL.setlast(begcall);
IL.AddCmd(IL.opPRECALL, ORD(isfloat));
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
IF cconv IN {PROG._ccall, PROG.ccall} THEN
IL.AddCmd(IL.opALIGN16, parSize)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
IL.AddCmd(IL.opWIN64ALIGN16, parSize)
1646,7 → 1644,7
IL.CallP(callconv, fparSize)
END;
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
IF cconv IN {PROG._ccall, PROG.ccall} THEN
IL.AddCmd(IL.opCLEANUP, parSize);
IL.AddCmd0(IL.opPOPSP)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
1655,7 → 1653,7
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
IL.AddCmd0(IL.opPOPSP)
ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN
ELSIF cconv IN {PROG._cdecl, PROG.cdecl, PROG.default16, PROG.code, PROG._code} THEN
IL.AddCmd(IL.opCLEANUP, parSize)
END;
1912,10 → 1910,10
label := IL.NewLabel()
END;
IF e.obj = eCONST THEN
IF (e.obj = eCONST) & isBoolean(e) THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
IL.AndOrOpt(label)
IL.Jmp(IL.opJZ, label)
END
END;
2011,7 → 2009,7
ELSE
IF e1.obj # eCONST THEN
label1 := IL.NewLabel();
IL.AddJmpCmd(IL.opJG, label1)
IL.Jmp(IL.opJG, label1)
END;
IF e.obj = eCONST THEN
IL.OnError(pos.line, errDIV);
2030,7 → 2028,7
|SCAN.lxAND:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
ARITH.opBoolean(e.value, e1.value, "&")
ELSE
e.obj := eEXPR;
2044,12 → 2042,12
IF label # -1 THEN
label1 := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ, label1);
IL.Jmp(IL.opJNZ, label1);
IL.SetLabel(label);
IL.Const(0);
IL.drop;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
IL.Jmp(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(1);
IL.SetLabel(label);
2063,7 → 2061,7
pos: PARS.POSITION;
op: INTEGER;
e1: PARS.EXPR;
s, s1: SCAN.LEXSTR;
s, s1: SCAN.TEXTSTR;
plus, minus: BOOLEAN;
2117,11 → 2115,10
label := IL.NewLabel()
END;
IF e.obj = eCONST THEN
IF (e.obj = eCONST) & isBoolean(e) THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
IL.not;
IL.AndOrOpt(label)
IL.Jmp(IL.opJNZ, label)
END
END;
2155,15 → 2152,15
IF e.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e.value, s)
ELSE
s := e.value.string(SCAN.IDENT).s
s := e.value.string(SCAN.STRING).s
END;
IF e1.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e1.value, s1)
ELSE
s1 := e1.value.string(SCAN.IDENT).s
s1 := e1.value.string(SCAN.STRING).s
END;
PARS.check(ARITH.concat(s, s1), pos, 5);
e.value.string := SCAN.enterid(s);
e.value.string := SCAN.enterStr(s);
e.value.typ := ARITH.tSTRING;
e._type := PROG.program.stTypes.tSTRING
END
2202,7 → 2199,7
|SCAN.lxOR:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
ARITH.opBoolean(e.value, e1.value, "|")
ELSE
e.obj := eEXPR;
2216,12 → 2213,12
IF label # -1 THEN
label1 := IL.NewLabel();
IL.AddJmpCmd(IL.opJZ, label1);
IL.Jmp(IL.opJZ, label1);
IL.SetLabel(label);
IL.Const(1);
IL.drop;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
IL.Jmp(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(0);
IL.SetLabel(label);
2371,10 → 2368,10
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isBoolean(e) & isBoolean(e1) THEN
IF constant THEN
2488,10 → 2485,10
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
2641,7 → 2638,7
L := IL.NewLabel();
IF ~_if THEN
IL.AddCmd0(IL.opLOOP);
IL.AddCmd(IL.opNOP, IL.begin_loop);
IL.SetLabel(L)
END;
2655,7 → 2652,7
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
IL.AddJmpCmd(IL.opJMP, label)
IL.Jmp(IL.opJMP, label)
END
ELSE
IL.AndOrOpt(label)
2671,7 → 2668,7
parser.StatSeq(parser);
IF ~_if OR (parser.sym # SCAN.lxEND) THEN
IL.AddJmpCmd(IL.opJMP, L)
IL.Jmp(IL.opJMP, L)
END;
IL.SetLabel(label)
2684,7 → 2681,7
END;
IL.SetLabel(L)
ELSE
IL.AddCmd0(IL.opENDLOOP)
IL.AddCmd(IL.opNOP, IL.end_loop)
END;
PARS.checklex(parser, SCAN.lxEND);
2701,7 → 2698,7
L: IL.COMMAND;
BEGIN
IL.AddCmd0(IL.opLOOP);
IL.AddCmd(IL.opNOP, IL.begin_loop);
label := IL.NewLabel();
IL.SetLabel(label);
2716,7 → 2713,7
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
IL.AddJmpCmd(IL.opJMP, label)
IL.Jmp(IL.opJMP, label)
END
ELSE
IL.AndOrOpt(label);
2723,7 → 2720,7
L.param1 := label
END;
IL.AddCmd0(IL.opENDLOOP)
IL.AddCmd(IL.opNOP, IL.end_loop)
END RepeatStatement;
2797,8 → 2794,8
a := ARITH.getInt(value)
ELSIF isCharW(caseExpr) THEN
PARS.ConstExpression(parser, value);
IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
ELSE
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
END;
2927,7 → 2924,7
END;
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, _end);
IL.Jmp(IL.opJMP, _end);
IF isRecPtr(caseExpr) THEN
caseExpr.ident._type := t
2976,7 → 2973,7
IL.SetLabel(node.data(CASE_LABEL).self);
IL._case(range.a, range.b, L, R);
IF v.processed THEN
IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
IL.Jmp(IL.opJMP, node.data(CASE_LABEL).variant)
END;
v.processed := TRUE;
3010,7 → 3007,7
_else := IL.NewLabel();
table := IL.NewLabel();
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
IL.AddJmpCmd(IL.opJMP, table);
IL.Jmp(IL.opJMP, table);
tree := NIL;
3024,7 → 3021,7
IF parser.sym = SCAN.lxELSE THEN
PARS.Next(parser);
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, _end)
IL.Jmp(IL.opJMP, _end)
ELSE
IL.OnError(pos.line, errCASE)
END;
3035,7 → 3032,7
IF isRecPtr(e) THEN
IL.SetLabel(table);
TableT(tree);
IL.AddJmpCmd(IL.opJMP, _else)
IL.Jmp(IL.opJMP, _else)
ELSE
tree.data(CASE_LABEL).self := table;
Table(tree, _else)
3094,7 → 3091,7
L1, L2: INTEGER;
BEGIN
IL.AddCmd0(IL.opLOOP);
IL.AddCmd(IL.opNOP, IL.begin_loop);
L1 := IL.NewLabel();
L2 := IL.NewLabel();
3167,7 → 3164,7
END
END;
IL.AddJmpCmd(IL.opJZ, L2);
IL.Jmp(IL.opJZ, L2);
PARS.checklex(parser, SCAN.lxDO);
PARS.Next(parser);
3181,7 → 3178,7
IL.AddCmd(IL.opINCC, st);
IL.AddJmpCmd(IL.opJMP, L1);
IL.Jmp(IL.opJMP, L1);
PARS.checklex(parser, SCAN.lxEND);
PARS.Next(parser);
3188,8 → 3185,7
IL.SetLabel(L2);
IL.AddCmd0(IL.opENDLOOP)
IL.AddCmd(IL.opNOP, IL.end_loop)
END ForStatement;
3260,12 → 3256,14
rtl: PROG.UNIT;
PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.IDSTR; idx: INTEGER);
VAR
id: PROG.IDENT;
ident: SCAN.IDENT;
BEGIN
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
SCAN.setIdent(ident, name);
id := PROG.getIdent(rtl, ident, FALSE);
IF (id # NIL) & (id._import # NIL) THEN
IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
3307,7 → 3305,7
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_dllentry", IL._dllentry);
getproc(rtl, "_sofinit", IL._sofinit)
ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} THEN
ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
getproc(rtl, "_fmul", IL._fmul);
getproc(rtl, "_fdiv", IL._fdiv);
getproc(rtl, "_fdivi", IL._fdivi);
3319,7 → 3317,7
getproc(rtl, "_flt", IL._flt);
getproc(rtl, "_pack", IL._pack);
getproc(rtl, "_unpk", IL._unpk);
IF CPU = TARGETS.cpuRVM32I THEN
IF CPU IN {TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
getproc(rtl, "_error", IL._error)
END
END
3355,13 → 3353,13
IF TARGETS.RTL THEN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, UTILS.RTL_NAME) THEN
IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
PARS.destroy(parser);
parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, UTILS.RTL_NAME) THEN
IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
3373,7 → 3371,7
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
parser.main := TRUE;
IF parser.open(parser, modname) THEN
IF parser.open(parser, modname, UTILS.FILE_EXT) THEN
parser.parse(parser)
ELSE
ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
3398,7 → 3396,8
|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)
|TARGETS.cpuRVM32I,
TARGETS.cpuRVM64I: RVMxI.CodeGen(outname, target, options)
END
END compile;

/programs/develop/oberon07/source/STRINGS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
73,17 → 73,6
END IntToStr;
PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
BEGIN
str[n] := 0X;
WHILE n > 0 DO
str[n - 1] := CHR(UTILS.hexdgt(x MOD 16));
x := x DIV 16;
DEC(n)
END
END IntToHex;
PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
VAR
length: INTEGER;
110,6 → 99,47
END search;
PROCEDURE replace* (VAR s: ARRAY OF CHAR; find, repl: CHAR);
VAR
i, strlen: INTEGER;
BEGIN
strlen := LENGTH(s) - 1;
FOR i := 0 TO strlen DO
IF s[i] = find THEN
s[i] := repl
END
END
END replace;
PROCEDURE trim* (source: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
VAR
LenS, start, _end, i, j: INTEGER;
BEGIN
LenS := LENGTH(source) - 1;
j := 0;
IF LenS >= 0 THEN
start := 0;
WHILE (start <= LenS) & (source[start] <= 20X) DO
INC(start)
END;
_end := LenS;
WHILE (_end >= 0) & (source[_end] <= 20X) DO
DEC(_end)
END;
FOR i := start TO _end DO
result[j] := source[i];
INC(j)
END
END;
result[j] := 0X
END trim;
PROCEDURE letter* (c: CHAR): BOOLEAN;
RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") OR (c = "_")
END letter;
130,7 → 160,7
END space;
PROCEDURE cap (VAR c: CHAR);
PROCEDURE cap* (VAR c: CHAR);
BEGIN
IF ("a" <= c) & (c <= "z") THEN
c := CHR(ORD(c) - 32)
290,4 → 320,23
END Utf8To16;
PROCEDURE HashStr* (name: ARRAY OF CHAR): INTEGER;
VAR
i, h: INTEGER;
g: SET;
BEGIN
h := 0;
i := 0;
WHILE name[i] # 0X DO
h := h * 16 + ORD(name[i]);
g := BITS(h) * {28..31};
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
INC(i)
END
RETURN h
END HashStr;
END STRINGS.

/programs/develop/oberon07/source/TARGETS.ob07
1,13 → 1,15
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE TARGETS;
IMPORT UTILS;
CONST
MSP430* = 0;
25,18 → 27,22
Linux64SO* = 12;
STM32CM3* = 13;
RVM32I* = 14;
RVM64I* = 15;
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
cpuRVM32I* = 4;
cpuRVM32I* = 4; cpuRVM64I* = 5;
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
noDISPOSE = {MSP430, STM32CM3, RVM32I};
noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I};
noRTL = {MSP430};
libRVM32I = "RVMxI" + UTILS.slash + "32";
libRVM64I = "RVMxI" + UTILS.slash + "64";
TYPE
STRING = ARRAY 32 OF CHAR;
51,9 → 57,9
VAR
Targets*: ARRAY 15 OF TARGET;
Targets*: ARRAY 16 OF TARGET;
CPUs: ARRAY 5 OF
CPUs: ARRAY 6 OF
RECORD
BitDepth, InstrSize: INTEGER;
LittleEndian: BOOLEAN
126,20 → 132,22
EnterCPU(cpuMSP430, 16, 2, TRUE);
EnterCPU(cpuTHUMB, 32, 2, TRUE);
EnterCPU(cpuRVM32I, 32, 4, TRUE);
EnterCPU(cpuRVM64I, 64, 8, 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( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows", ".exe");
Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows", ".exe");
Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows", ".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( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows", ".exe");
Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows", ".exe");
Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows", ".dll");
Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux", "");
Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux", ".so");
Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux", "");
Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux", ".so");
Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", "RVM32I", ".bin");
Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", libRVM32I, ".bin");
Enter( RVM64I, cpuRVM64I, 8, osNONE, "rvm64i", libRVM64I, ".bin");
END TARGETS.

/programs/develop/oberon07/source/THUMB.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
23,12 → 23,19
inf = 7F800000H;
STM32_minROM* = 16; STM32_maxROM* = 65536;
STM32_minRAM* = 4; STM32_maxRAM* = 65536;
minROM* = 16; maxROM* = 65536;
minRAM* = 4; maxRAM* = 65536;
maxIVT* = 1023;
_THUMB2 = 0; _IT = 1; _SDIV = 2; _CBXZ = 3;
CortexM0 = {};
CortexM1 = {};
CortexM3 = {_THUMB2, _IT, _SDIV, _CBXZ};
CortexM23 = {_SDIV, _CBXZ};
TYPE
COMMAND = IL.COMMAND;
103,7 → 110,8
IVTLen,
MinStack,
Reserved: INTEGER;
InstrSet: RECORD thumb2, it, cbxz, sdiv: BOOLEAN END
InstrSet: SET;
isNXP: BOOLEAN
END;
IVT: ARRAY maxIVT + 1 OF INTEGER;
475,7 → 483,7
PROCEDURE Tst (r: INTEGER);
BEGIN
gen3(1, r, 0) (* cmp r, #0 *)
gen3(1, r, 0) (* cmp r, 0 *)
END Tst;
533,8 → 541,6
shorted: BOOLEAN;
jump: JUMP;
first, second: INTEGER;
reloc, i, diff, len: INTEGER;
RelocCode: RELOCCODE;
555,14 → 561,6
END genjmp;
PROCEDURE genlongjmp (offset: INTEGER; VAR first, second: INTEGER);
BEGIN
ASSERT(srange(offset, 22));
first := 0F000H + ASR(offset, 11) MOD 2048;
second := 0F800H + offset MOD 2048
END genlongjmp;
PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE);
VAR
imm1, imm3, imm4, imm8: INTEGER;
576,17 → 574,17
PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE);
BEGIN
IF Target.InstrSet.thumb2 THEN
IF _THUMB2 IN Target.InstrSet THEN
movwt(r, low(value), 0, code);
movwt(r, high(value), 1, code)
ELSE
code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* mov r, #imm8 *)
code[1] := 0200H + r * 9; (* lsl r, r, #8 *)
code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* add r, #imm8 *)
code[3] := code[1]; (* lsl r, r, #8 *)
code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* add r, #imm8 *)
code[5] := code[1]; (* lsl r, r, #8 *)
code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* add r, #imm8 *)
code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* movs r, imm8 *)
code[1] := 0200H + r * 9; (* lsls r, 8 *)
code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* adds r, imm8 *)
code[3] := code[1]; (* lsls r, 8 *)
code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* adds r, imm8 *)
code[5] := code[1]; (* lsls r, 8 *)
code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* adds r, imm8 *)
END
END genmovimm32;
597,10 → 595,15
END PutCode;
PROCEDURE genlongjmp (offset: INTEGER);
BEGIN
ASSERT(srange(offset, 22));
PutCode(0F000H + ASR(offset, 11) MOD 2048);
PutCode(0F800H + offset MOD 2048)
END genlongjmp;
PROCEDURE genbc (code: JUMP);
VAR
first, second: INTEGER;
BEGIN
CASE code.len OF
|1: PutCode(genjcc(code.cond, code.diff))
607,9 → 610,7
|2: PutCode(genjcc(inv0(code.cond), 0));
PutCode(genjmp(code.diff))
|3: PutCode(genjcc(inv0(code.cond), 1));
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
genlongjmp(code.diff)
END
END genbc;
647,7 → 648,7
|CODE: INC(count)
|LABEL: BIN.SetLabel(program, code.label, count)
|JUMP: INC(count, code.len); code.offset := count + ORD(code.short)
|RELOC: INC(count, 7 - ORD(Target.InstrSet.thumb2) * 3 + code.rel MOD 2)
|RELOC: INC(count, 7 - ORD(_THUMB2 IN Target.InstrSet) * 3 + code.rel MOD 2)
END;
code := code.next(ANYCODE)
714,9 → 715,7
IF code.len = 1 THEN
PutCode(genjmp(code.diff))
ELSE
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
genlongjmp(code.diff)
END
|JCC: genbc(code)
723,18 → 722,15
|CBXZ:
IF code.len > 1 THEN
PutCode(2800H + code.reg * 256); (* cmp code.reg, #0 *)
PutCode(2800H + code.reg * 256); (* cmp code.reg, 0 *)
DEC(code.len);
genbc(code)
ELSE
(* cb(n)z code.reg, L *)
PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * ORD(code.diff >= 32) + (code.diff MOD 32) * 8 + code.reg)
PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * (code.diff DIV 32) + (code.diff MOD 32) * 8 + code.reg)
END
|CALL:
genlongjmp(code.diff, first, second);
PutCode(first);
PutCode(second)
|CALL: genlongjmp(code.diff)
|RELOC:
CASE code.rel OF
743,14 → 739,14
|BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(Target.InstrSet.thumb2) + 9))
DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(_THUMB2 IN Target.InstrSet) + 9))
END;
genmovimm32(code.reg, reloc, RelocCode);
FOR i := 0 TO 6 - 3 * ORD(Target.InstrSet.thumb2) DO
FOR i := 0 TO 6 - 3 * ORD(_THUMB2 IN Target.InstrSet) DO
PutCode(RelocCode[i])
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
PutCode(4478H + code.reg) (* add code.reg, PC *)
PutCode(4478H + code.reg) (* add code.reg, pc *)
END
END;
858,7 → 854,7
MovImm8(r, 1);
LslImm(r, 31)
ELSE
IF Target.InstrSet.thumb2 THEN
IF _THUMB2 IN Target.InstrSet THEN
movwt(r, low(c), 0);
IF (c < 0) OR (c > 65535) THEN
movwt(r, high(c), 1)
897,7 → 893,7
L1, L2: INTEGER;
BEGIN
IF Target.InstrSet.it THEN
IF _IT IN Target.InstrSet THEN
Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *)
MovConst(r, 1);
MovConst(r, 0)
938,13 → 934,9
ELSE
SubImm8(r, -n)
END
ELSIF Target.InstrSet.thumb2 & (-4095 <= n) & (n <= 4095) THEN
IF n > 0 THEN
AddSubImm12(r, n, FALSE)
ELSIF (_THUMB2 IN Target.InstrSet) & (-4095 <= n) & (n <= 4095) THEN
AddSubImm12(r, ABS(n), n < 0)
ELSE
AddSubImm12(r, -n, TRUE)
END
ELSE
r2 := GetAnyReg();
ASSERT(r2 # r);
IF n > 0 THEN
982,25 → 974,26
END AddSP;
PROCEDURE cbz (r, label: INTEGER);
PROCEDURE cbxz2 (c, r, label: INTEGER);
BEGIN
IF Target.InstrSet.cbxz THEN
cbxz(je, r, label)
IF _CBXZ IN Target.InstrSet THEN
cbxz(c, r, label)
ELSE
Tst(r);
jcc(je, label)
jcc(c, label)
END
END cbxz2;
PROCEDURE cbz (r, label: INTEGER);
BEGIN
cbxz2(je, r, label)
END cbz;
PROCEDURE cbnz (r, label: INTEGER);
BEGIN
IF Target.InstrSet.cbxz THEN
cbxz(jne, r, label)
ELSE
Tst(r);
jcc(jne, label)
END
cbxz2(jne, r, label)
END cbnz;
1053,6 → 1046,18
END divmod;
PROCEDURE cpsid_i;
BEGIN
Code(0B672H) (* cpsid i *)
END cpsid_i;
PROCEDURE cpsie_i;
BEGIN
Code(0B662H) (* cpsie i *)
END cpsie_i;
PROCEDURE translate (pic, stroffs: INTEGER);
VAR
cmd, next: COMMAND;
1103,7 → 1108,7
Label(param1);
gen14(FALSE, TRUE, {}); (* push LR *)
gen14(FALSE, TRUE, {}); (* push {lr} *)
n := param2;
IF n >= 5 THEN
1128,9 → 1133,7
IF opcode # IL.opLEAVE THEN
UnOp(r1);
IF r1 # ACC THEN
GetRegA;
ASSERT(REG.Exchange(R, r1, ACC));
drop
mov(ACC, r1)
END;
drop
END;
1139,10 → 1142,10
ASSERT(StkCount = param1);
AddSP(param1);
gen14(TRUE, TRUE, {}) (* pop PC *)
gen14(TRUE, TRUE, {}) (* pop {pc} *)
|IL.opLEAVEC:
gen5(3, FALSE, TRUE, 6, 0) (* bx LR *)
gen5(3, FALSE, TRUE, 6, 0) (* bx lr *)
|IL.opPRECALL:
PushAll(0)
1169,6 → 1172,7
PushConst(param2)
|IL.opONERR:
cpsid_i;
MovConst(R0, param2);
push(R0);
DEC(StkCount);
1203,6 → 1207,38
reloc(r1, BIN.RBSS + pic, param2);
Ldr8(r1, r1)
|IL.opLADR_SAVE:
UnOp(r1);
n := LocalOffset(param2);
IF n <= 255 THEN
gen11(FALSE, r1, n) (* str r1, [sp, n*4] *)
ELSE
LocAdr(param2);
BinOp(r1, r2);
Str32(r1, r2);
drop
END;
drop
|IL.opLADR_INCC:
n := LocalOffset(param1);
IF n <= 255 THEN
r1 := GetAnyReg();
LdrSp(r1, n);
AddConst(r1, param2);
gen11(FALSE, r1, n) (* str r1, [sp, n*4] *)
ELSE
LocAdr(param1);
r1 := GetAnyReg();
BinOp(r2, r1);
Ldr32(r1, r2);
AddConst(r1, param2);
BinOp(r2, r1);
Str32(r1, r2);
drop
END;
drop
|IL.opLLOAD32, IL.opVADR, IL.opVLOAD32:
r1 := GetAnyReg();
n := LocalOffset(param2);
1402,8 → 1438,12
|IL.opCASELR:
GetRegA;
CmpConst(ACC, param1);
IF param2 = cmd.param3 THEN
jcc(jne, param2)
ELSE
jcc(jl, param2);
jcc(jg, cmd.param3);
jcc(jg, cmd.param3)
END;
drop
|IL.opCODE:
1549,11 → 1589,11
|IL.opCHR:
UnOp(r1);
Code(0B2C0H + r1 * 9) (* uxtb r1 *)
Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *)
|IL.opWCHR:
UnOp(r1);
Code(0B280H + r1 * 9) (* uxth r1 *)
Code(0B280H + r1 * 9) (* uxth r1, r1 *)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
BinOp(r1, r2);
1615,8 → 1655,6
INCL(R.regs, r1);
ASSERT(REG.GetReg(R, r1))
|IL.opLOOP, IL.opENDLOOP:
|IL.opINF:
MovConst(GetAnyReg(), inf)
1720,46 → 1758,46
|IL.opMULS:
BinOp(r1, r2);
gen4(0, r2, r1); (* and r1, r2 *)
gen4(0, r2, r1); (* ands r1, r2 *)
drop
|IL.opMULSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(0, r2, r1); (* and r1, r2 *)
gen4(0, r2, r1); (* ands r1, r2 *)
drop
|IL.opDIVS:
BinOp(r1, r2);
gen4(1, r2, r1); (* eor r1, r2 *)
gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opDIVSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(1, r2, r1); (* eor r1, r2 *)
gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opADDS:
BinOp(r1, r2);
gen4(12, r2, r1); (* orr r1, r2 *)
gen4(12, r2, r1); (* orrs r1, r2 *)
drop
|IL.opSUBS:
BinOp(r1, r2);
gen4(14, r2, r1); (* bic r1, r2 *)
gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opADDSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(12, r2, r1); (* orr r1, r2 *)
gen4(12, r2, r1); (* orrs r1, r2 *)
drop
|IL.opSUBSL:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(14, r1, r2); (* bic r2, r1 *)
gen4(14, r1, r2); (* bics r2, r1 *)
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
1767,12 → 1805,12
|IL.opSUBSR:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
gen4(14, r2, r1); (* bic r1, r2 *)
gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opUMINS:
UnOp(r1);
gen4(15, r1, r1) (* mvn r1, r1 *)
gen4(15, r1, r1) (* mvns r1, r1 *)
|IL.opINCL, IL.opEXCL:
BinOp(r1, r2);
1781,12 → 1819,12
CmpConst(r1, 32);
L := NewLabel();
jcc(jnb, L);
gen4(2, r1, r3); (* lsl r3, r1 *)
gen4(2, r1, r3); (* lsls r3, r1 *)
Ldr32(r1, r2);
IF opcode = IL.opINCL THEN
gen4(12, r3, r1) (* orr r1, r3 *)
gen4(12, r3, r1) (* orrs r1, r3 *)
ELSE
gen4(14, r3, r1) (* bic r1, r3 *)
gen4(14, r3, r1) (* bics r1, r3 *)
END;
Str32(r1, r2);
Label(L);
1802,9 → 1840,9
LslImm(r3, param2);
Ldr32(r1, r2);
IF opcode = IL.opINCLC THEN
gen4(12, r3, r1) (* orr r1, r3 *)
gen4(12, r3, r1) (* orrs r1, r3 *)
ELSE
gen4(14, r3, r1) (* bic r1, r3 *)
gen4(14, r3, r1) (* bics r1, r3 *)
END;
Str32(r1, r2);
drop;
1902,9 → 1940,9
IF n > 0 THEN
UnOp(r1);
IF n = 8 THEN
Code(0B2C0H + r1 * 9) (* uxtb r1 *)
Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *)
ELSIF n = 16 THEN
Code(0B280H + r1 * 9) (* uxth r1 *)
Code(0B280H + r1 * 9) (* uxth r1, r1 *)
ELSE
LslImm(r1, 32 - n);
LsrImm(r1, 32 - n)
1946,7 → 1984,7
Label(L);
MovConst(r3, 1);
Shift(IL.opLSL, r3, r1);
gen4(0, r3, r2); (* and r2, r3 *)
gen4(0, r3, r2); (* ands r2, r3 *)
SetCC(jne, r1);
Label(L2);
drop;
1956,7 → 1994,7
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, LSL(1, param2));
gen4(0, r2, r1); (* and r1, r2 *)
gen4(0, r2, r1); (* ands r1, r2 *)
SetCC(jne, r1);
drop
2039,7 → 2077,7
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
gen4(1, r2, r1); (* eor r1, r2 *)
gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opFABS:
2047,16 → 2085,18
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
gen4(14, r2, r1); (* bic r1, r2 *)
gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opNEW:
cpsid_i;
PushAll(1);
n := param2 + 8;
ASSERT(UTILS.Align(n, 32));
n := param2 + 4;
ASSERT(UTILS.Align(n, 4));
PushConst(n);
PushConst(param1);
CallRTL(IL._new, 3)
CallRTL(IL._new, 3);
cpsie_i
|IL.opTYPEGP:
UnOp(r1);
2132,7 → 2172,7
END translate;
PROCEDURE prolog (GlobSize, tcount, pic, FlashAdr, sp, ivt_len: INTEGER);
PROCEDURE prolog (GlobSize, tcount, pic, sp, ivt_len: INTEGER);
VAR
r1, r2, i, dcount: INTEGER;
2158,6 → 2198,7
END;
Label(entry);
cpsie_i;
r1 := GetAnyReg();
r2 := GetAnyReg();
2201,14 → 2242,14
L1, L2, L3, L4: INTEGER;
BEGIN
Code(0BF30H); (* L2: wfi *)
Code(0E7FDH); (* b L2 *)
(* L2: *)
Code(0E7FEH); (* b L2 *)
Label(genInt);
Code(0F3EFH); Code(08105H); (* mrs r1, ipsr *)
gen14(FALSE, TRUE, {R1}); (* push {LR, R1} *)
Code(0F3EFH); Code(08005H); (* mrs r0, ipsr *)
gen14(FALSE, TRUE, {R0}); (* push {lr, r0} *)
call(int0);
gen14(TRUE, TRUE, {R1}); (* pop {PC, R1} *)
gen14(TRUE, TRUE, {R0}); (* pop {pc, r0} *)
Label(emptyProc);
Code(04770H); (* bx lr *)
2218,19 → 2259,19
call(entry);
Label(sdivProc);
IF Target.InstrSet.sdiv THEN
Code(09800H); (* ldr r0, [sp + #0] *)
Code(09901H); (* ldr r1, [sp + #4] *)
IF _SDIV IN Target.InstrSet THEN
Code(09800H); (* ldr r0, [sp] *)
Code(09901H); (* ldr r1, [sp, 4] *)
Code(0FB91H); (* sdiv r2, r1, r0 *)
Code(0F2F0H);
Code(00013H); (* mov r3, r2 *)
Code(04343H); (* mul r3, r0 *)
Code(01AC9H); (* sub r1, r3 *)
Code(00013H); (* movs r3, r2 *)
Code(04343H); (* muls r3, r0, r3 *)
Code(01AC9H); (* subs r1, r1, r3 *)
Code(0DA01H); (* bge L *)
Code(04401H); (* add r1, r0 *)
Code(03A01H); (* sub r2, #1 *)
Code(01809H); (* adds r1, r1, r0 *)
Code(03A01H); (* subs r2, 1 *)
(* L: *)
Code(00010H); (* mov r0, r2 *)
Code(00010H); (* movs r0, r2 *)
Code(04770H); (* bx lr *)
ELSE
(* a / b; a >= 0 *)
2303,18 → 2344,17
END epilog;
PROCEDURE CortexM3;
PROCEDURE SetTarget (FlashStart, SRAMStart: INTEGER; InstrSet: SET; isNXP: BOOLEAN);
BEGIN
Target.FlashAdr := 08000000H;
Target.SRAMAdr := 20000000H;
Target.IVTLen := 256;
Target.FlashAdr := FlashStart;
Target.SRAMAdr := SRAMStart;
Target.InstrSet := InstrSet;
Target.isNXP := isNXP;
Target.IVTLen := 256; (* >= 192 *)
Target.Reserved := 0;
Target.MinStack := 512;
Target.InstrSet.thumb2 := TRUE;
Target.InstrSet.it := TRUE;
Target.InstrSet.sdiv := TRUE;
Target.InstrSet.cbxz := TRUE
END CortexM3;
END SetTarget;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
2321,18 → 2361,18
VAR
opt: PROG.OPTIONS;
ram, rom: INTEGER;
ram, rom, i, j: INTEGER;
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
BEGIN
ram := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
rom := MIN(MAX(options.rom, minROM), maxROM) * 1024;
IF target = TARGETS.STM32CM3 THEN
CortexM3
SetTarget(08000000H, 20000000H, CortexM3, FALSE)
END;
ram := MIN(MAX(options.ram, STM32_minRAM), STM32_maxRAM) * 1024;
rom := MIN(MAX(options.rom, STM32_minROM), STM32_maxROM) * 1024;
tcount := CHL.Length(IL.codes.types);
opt := options;
2340,7 → 2380,7
program := BIN.create(IL.codes.lcount);
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {R0, R1, R2, R3}, {});
REG.Init(R, push, pop, mov, xchg, {R0, R1, R2, R3});
StkCount := 0;
2357,7 → 2397,7
BssSize := IL.codes.bss;
ASSERT(UTILS.Align(BssSize, 4));
prolog(BssSize, tcount, ORD(opt.pic), Target.FlashAdr, Target.SRAMAdr + ram, Target.IVTLen);
prolog(BssSize, tcount, ORD(opt.pic), Target.SRAMAdr + ram, Target.IVTLen);
translate(ORD(opt.pic), tcount * 4);
epilog;
2374,6 → 2414,16
ERRORS.Error(204)
END;
IF Target.isNXP THEN
BIN.put32le(program.code, 2FCH, 0H); (* code read protection (CRP) *)
(* NXP checksum *)
j := 0;
FOR i := 0 TO 6 DO
INC(j, BIN.get32le(program.code, i * 4))
END;
BIN.put32le(program.code, 1CH, -j)
END;
WR.Create(outname);
HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr));
2381,11 → 2431,10
WR.Close;
C.StringLn("--------------------------------------------");
C.Dashes;
C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)");
C.Ln;
C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)")
END CodeGen;

/programs/develop/oberon07/source/UTILS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
23,7 → 23,8
max32* = 2147483647;
vMajor* = 1;
vMinor* = 43;
vMinor* = 52;
Date* = "07-may-2021";
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
162,20 → 163,9
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF bytes MOD align # 0 THEN
res := maxint - bytes >= align - (bytes MOD align);
IF res THEN
bytes := bytes + align - (bytes MOD align)
END
ELSE
res := TRUE
END
RETURN res
INC(bytes, (-bytes) MOD align)
RETURN bytes >= 0
END Align;
221,6 → 211,6
BEGIN
time := GetTickCount();
time := HOST.GetTickCount();
maxreal := HOST.maxreal
END UTILS.

/programs/develop/oberon07/source/WRITER.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
18,10 → 18,7
PROCEDURE align* (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
INC(n, _align - (n MOD _align))
END
ASSERT(UTILS.Align(n, _align))
RETURN n
END align;

/programs/develop/oberon07/source/X86.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
851,9 → 851,7
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # eax THEN
GetRegA;
ASSERT(REG.Exchange(R, reg1, eax));
drop
mov(eax, reg1)
END;
drop
END;
872,10 → 870,8
pop(ebp);
n := param2;
IF n > 0 THEN
n := n * 4;
OutByte(0C2H); OutWord(n MOD 65536) (* ret n *)
IF param2 > 0 THEN
OutByte(0C2H); OutWord(param2 * 4 MOD 65536) (* ret param2*4 *)
ELSE
ret
END
1321,8 → 1317,12
|IL.opCASELR:
cmprc(eax, param1);
IF param2 = cmd.param3 THEN
jcc(jne, param2)
ELSE
jcc(jl, param2);
jcc(jg, cmd.param3)
END
|IL.opCODE:
OutByte(param2)
2176,8 → 2176,6
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
|IL.opLOOP, IL.opENDLOOP:
END;
cmd := cmd.next(COMMAND)
2374,7 → 2372,7
opt.pic := TRUE
END;
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {});
REG.Init(R, push, pop, mov, xchg, {eax, ecx, edx});
prolog(opt.pic, target, opt.stack, dllinit, dllret);
translate(opt.pic, tcount * 4);