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

  → /programs/ @ 7692

  ↔ Reverse comparison

• Compare Path:	Rev

  With Path:	Rev

Regard whitespace Rev 7693 → Rev 7692

/programs/develop/oberon07/Compiler.kex
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream

/programs/develop/oberon07/Source/MSP430.ob07
File deleted
\ No newline at end of file

/programs/develop/oberon07/Source/IL.ob07
File deleted
\ No newline at end of file

/programs/develop/oberon07/Source/MSP430RTL.ob07
File deleted
\ No newline at end of file

/programs/develop/oberon07/Source/AMD64.ob07
7,7 → 7,7
MODULE AMD64;
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG,
IMPORT CODE, BIN, WR := WRITER, CHL := CHUNKLISTS, MACHINE, LISTS, PATHS,
REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86;
31,7 → 31,7
sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H;
shl = IL.opLSL2; shr = IL.opLSR2; sar = IL.opASR2; ror = IL.opROR2;
shl = CODE.opLSL2; shr = CODE.opLSR2; sar = CODE.opASR2; ror = CODE.opROR2;
sCODE = BIN.PICCODE;
sDATA = BIN.PICDATA;
41,7 → 41,7
TYPE
COMMAND = IL.COMMAND;
COMMAND = CODE.COMMAND;
Number = POINTER TO RECORD (LISTS.ITEM) value: INTEGER END;
58,10 → 58,8
prog: BIN.PROGRAM;
tcount: INTEGER;
dllret: INTEGER;
dllret, sofinit: INTEGER;
Win64RegPar: ARRAY 4 OF INTEGER;
SystemVRegPar: ARRAY 6 OF INTEGER;
89,10 → 87,10
PROCEDURE OutInt (n: INTEGER);
BEGIN
OutByte(UTILS.Byte(n, 0));
OutByte(UTILS.Byte(n, 1));
OutByte(UTILS.Byte(n, 2));
OutByte(UTILS.Byte(n, 3))
OutByte(MACHINE.Byte(n, 0));
OutByte(MACHINE.Byte(n, 1));
OutByte(MACHINE.Byte(n, 2));
OutByte(MACHINE.Byte(n, 3))
END OutInt;
114,7 → 112,7
PROCEDURE OutIntByte (n: INTEGER);
BEGIN
IF isByte(n) THEN
OutByte(UTILS.Byte(n, 0))
OutByte(MACHINE.Byte(n, 0))
ELSE
OutInt(n)
END
122,7 → 120,7
PROCEDURE isLong (n: INTEGER): BOOLEAN;
RETURN (n > UTILS.max32) OR (n < UTILS.min32)
RETURN (n > MACHINE.max32) OR (n < MACHINE.min32)
END isLong;
141,7 → 139,7
PROCEDURE NewLabel (): INTEGER;
BEGIN
BIN.NewLabel(prog)
RETURN IL.NewLabel()
RETURN CODE.NewLabel()
END NewLabel;
259,22 → 257,12
END drop;
PROCEDURE GetAnyReg (): INTEGER;
RETURN REG.GetAnyReg(R)
END GetAnyReg;
PROCEDURE GetVarReg (offs: INTEGER): INTEGER;
RETURN REG.GetVarReg(R, offs)
END GetVarReg;
PROCEDURE callimp (label: INTEGER);
VAR
reg: INTEGER;
BEGIN
reg := GetAnyReg();
reg := REG.GetAnyReg(R);
lea(reg, label, sIMP);
IF reg >= 8 THEN // call qword[reg]
OutByte(41H)
289,7 → 277,7
reg: INTEGER;
BEGIN
reg := GetAnyReg();
reg := REG.GetAnyReg(R);
lea(reg, offs, sDATA);
push(reg);
drop
302,7 → 290,7
BEGIN
REG.Store(R);
label := IL.codes.rtl[proc];
label := CODE.codes.rtl[proc];
IF label < 0 THEN
callimp(-label)
ELSE
327,7 → 315,7
PROCEDURE PushAll (NumberOfParameters: INTEGER);
BEGIN
REG.PushAll(R);
DEC(R.pushed, NumberOfParameters)
R.pushed := R.pushed - NumberOfParameters
END PushAll;
339,7 → 327,7
Rex(reg, 0);
OutByte(0B8H + reg MOD 8); // movabs reg, n
FOR i := 0 TO 7 DO
OutByte(UTILS.Byte(n, i))
OutByte(MACHINE.Byte(n, i))
END
END movabs;
348,8 → 336,6
BEGIN
IF isLong(n) THEN
movabs(reg, n)
ELSIF n = 0 THEN
xor(reg, reg)
ELSE
Rex(reg, 0);
OutByte2(0C7H, 0C0H + reg MOD 8);
369,7 → 355,7
reg2: INTEGER;
BEGIN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movabs(reg2, n);
oprr(reg, reg2);
drop
418,7 → 404,7
BEGIN
IF isLong(n) THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movabs(reg2, n);
push(reg2);
drop
656,14 → 642,14
END shiftrc;
PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): IL.LOCALVAR;
PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): CODE.LOCALVAR;
VAR
cur: IL.LOCALVAR;
cur: CODE.LOCALVAR;
BEGIN
cur := variables.first(IL.LOCALVAR);
cur := variables.first(CODE.LOCALVAR);
WHILE (cur # NIL) & (cur.offset # offset) DO
cur := cur.next(IL.LOCALVAR)
cur := cur.next(CODE.LOCALVAR)
END
RETURN cur
676,7 → 662,7
leaf: BOOLEAN;
cur: COMMAND;
variables: LISTS.LIST;
lvar, rvar: IL.LOCALVAR;
lvar, rvar: CODE.LOCALVAR;
reg: INTEGER;
max: INTEGER;
loop: INTEGER;
691,76 → 677,83
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:
|CODE.opLLOAD64,
CODE.opLLOAD8,
CODE.opLLOAD16,
CODE.opLLOAD32,
CODE.opLLOAD64_PARAM,
CODE.opLLOAD32_PARAM,
CODE.opLADR_SAVE,
CODE.opLADR_INC1,
CODE.opLADR_DEC1,
CODE.opLADR_INC,
CODE.opLADR_DEC,
CODE.opLADR_INC1B,
CODE.opLADR_DEC1B,
CODE.opLADR_INCB,
CODE.opLADR_DECB,
CODE.opLADR_INCL,
CODE.opLADR_EXCL,
CODE.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:
|CODE.opLADR_SAVEC,
CODE.opLADR_INCC,
CODE.opLADR_DECC,
CODE.opLADR_INCCB,
CODE.opLADR_DECCB,
CODE.opLADR_INCLC,
CODE.opLADR_EXCLC:
lvar := getVar(variables, cur.param1);
IF (lvar # NIL) & (lvar.count # -1) THEN
INC(lvar.count, loop)
END
|IL.opLADR:
|CODE.opLADR:
lvar := getVar(variables, cur.param2);
IF (lvar # NIL) & (lvar.count # -1) THEN
lvar.count := -1
END
|IL.opLOOP:
|CODE.opLOOP:
INC(loop, 10)
|IL.opENDLOOP:
|CODE.opENDLOOP:
DEC(loop, 10)
|IL.opLEAVE,
IL.opLEAVER,
IL.opLEAVEF:
|CODE.opLEAVE,
CODE.opLEAVER,
CODE.opLEAVEF:
leave := TRUE
|IL.opCALL, IL.opCALLP, IL.opCALLI,
IL.opWIN64CALL, IL.opWIN64CALLP, IL.opWIN64CALLI,
IL.opSYSVCALL, IL.opSYSVCALLP, IL.opSYSVCALLI,
|CODE.opCALL, CODE.opCALLP, CODE.opCALLI,
CODE.opWIN64CALL, CODE.opWIN64CALLP, CODE.opWIN64CALLI,
CODE.opSYSVCALL, CODE.opSYSVCALLP, CODE.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.opCASET, IL.opDIV,
IL.opDIVL, IL.opMOD,
IL.opMODL, IL.opLENGTH, IL.opLENGTHW:
CODE.opSAVES, CODE.opRSET, CODE.opRSETR,
CODE.opRSETL, CODE.opRSET1,
CODE.opEQS .. CODE.opGES,
CODE.opEQS2 .. CODE.opGES2,
CODE.opEQSW .. CODE.opGESW,
CODE.opEQSW2 .. CODE.opGESW2,
CODE.opCOPY, CODE.opMOVE, CODE.opCOPYA,
CODE.opCOPYS, CODE.opCOPYS2, CODE.opROT,
CODE.opNEW, CODE.opDISP, CODE.opISREC,
CODE.opIS, CODE.opTYPEGR, CODE.opTYPEGP,
CODE.opCASET, CODE.opDIV,
CODE.opDIVL, CODE.opMOD,
CODE.opMODL, CODE.opLENGTH, CODE.opLENGTHW:
leaf := FALSE
|IL.opDIVR, IL.opMODR:
|CODE.opDIVR, CODE.opMODR:
param2 := cur.param2;
IF param2 >= 1 THEN
param2 := UTILS.Log2(param2)
param2 := X86.log2(param2)
ELSIF param2 <= -1 THEN
param2 := UTILS.Log2(-param2)
param2 := X86.log2(-param2)
ELSE
param2 := -1
END;
779,13 → 772,13
reg := -1;
max := -1;
rvar := NIL;
lvar := variables.first(IL.LOCALVAR);
lvar := variables.first(CODE.LOCALVAR);
WHILE lvar # NIL DO
IF lvar.count > max THEN
max := lvar.count;
rvar := lvar
END;
lvar := lvar.next(IL.LOCALVAR)
lvar := lvar.next(CODE.LOCALVAR)
END;
IF rvar # NIL THEN
885,30 → 878,30
cc, reg: INTEGER;
BEGIN
reg := GetAnyReg();
reg := REG.GetAnyReg(R);
xor(reg, reg);
CASE op OF
|IL.opEQF:
|CODE.opEQF, CODE.opEQFI:
comisd(xmm - 1, xmm);
cc := sete
|IL.opNEF:
|CODE.opNEF, CODE.opNEFI:
comisd(xmm - 1, xmm);
cc := setne
|IL.opLTF:
|CODE.opLTF, CODE.opGTFI:
comisd(xmm - 1, xmm);
cc := setc
|IL.opGTF:
|CODE.opGTF, CODE.opLTFI:
comisd(xmm, xmm - 1);
cc := setc
|IL.opLEF:
|CODE.opLEF, CODE.opGEFI:
comisd(xmm, xmm - 1);
cc := setnc
|IL.opGEF:
|CODE.opGEF, CODE.opLEFI:
comisd(xmm - 1, xmm);
cc := setnc
END;
922,7 → 915,7
VAR
cmd, next: COMMAND;
opcode, param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER;
param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER;
reg1, reg2, xmm: INTEGER;
938,24 → 931,22
param1 := cmd.param1;
param2 := cmd.param2;
opcode := cmd.opcode;
CASE cmd.opcode OF
CASE opcode OF
|IL.opJMP:
|CODE.opJMP:
jmp(param1)
|IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL:
|CODE.opCALL, CODE.opWIN64CALL, CODE.opSYSVCALL:
REG.Store(R);
CASE opcode OF
|IL.opCALL:
|IL.opWIN64CALL: Win64Passing(param2)
|IL.opSYSVCALL: SysVPassing(param2)
CASE cmd.opcode OF
|CODE.opCALL:
|CODE.opWIN64CALL: Win64Passing(param2)
|CODE.opSYSVCALL: SysVPassing(param2)
END;
X86.call(param1);
REG.Restore(R)
|IL.opCALLP, IL.opWIN64CALLP, IL.opSYSVCALLP:
|CODE.opCALLP, CODE.opWIN64CALLP, CODE.opSYSVCALLP:
UnOp(reg1);
IF reg1 # rax THEN
GetRegA;
964,35 → 955,35
END;
drop;
REG.Store(R);
CASE opcode OF
|IL.opCALLP:
|IL.opWIN64CALLP: Win64Passing(param2)
|IL.opSYSVCALLP: SysVPassing(param2)
CASE cmd.opcode OF
|CODE.opCALLP:
|CODE.opWIN64CALLP: Win64Passing(param2)
|CODE.opSYSVCALLP: SysVPassing(param2)
END;
OutByte2(0FFH, 0D0H); // call rax
REG.Restore(R);
ASSERT(R.top = -1)
|IL.opCALLI, IL.opWIN64CALLI, IL.opSYSVCALLI:
|CODE.opCALLI, CODE.opWIN64CALLI, CODE.opSYSVCALLI:
REG.Store(R);
CASE opcode OF
|IL.opCALLI:
|IL.opWIN64CALLI: Win64Passing(param2)
|IL.opSYSVCALLI: SysVPassing(param2)
CASE cmd.opcode OF
|CODE.opCALLI:
|CODE.opWIN64CALLI: Win64Passing(param2)
|CODE.opSYSVCALLI: SysVPassing(param2)
END;
callimp(param1);
REG.Restore(R)
|IL.opLABEL:
X86.SetLabel(param1)
|CODE.opLABEL:
X86.SetLabel(param2)
|IL.opERR:
CallRTL(IL._error)
|CODE.opERR:
CallRTL(CODE._error)
|IL.opPUSHC:
|CODE.opERRC:
pushc(param2)
|IL.opPRECALL:
|CODE.opPRECALL:
n := param2;
IF (param1 # 0) & (n # 0) THEN
subrc(rsp, 8)
1006,7 → 997,7
ASSERT(xmm = -1);
PushAll(0)
|IL.opWIN64ALIGN16:
|CODE.opWIN64ALIGN16:
ASSERT(rax IN R.regs);
mov(rax, rsp);
andrc(rsp, -16);
1013,7 → 1004,7
push(rax);
subrc(rsp, (MAX(param2 - 4, 0) MOD 2 + MAX(4 - param2, 0) + 1) * 8)
|IL.opSYSVALIGN16:
|CODE.opSYSVALIGN16:
ASSERT(rax IN R.regs);
mov(rax, rsp);
andrc(rsp, -16);
1022,7 → 1013,7
push(rax)
END
|IL.opRESF:
|CODE.opRESF:
ASSERT(xmm = -1);
INC(xmm);
n := param2;
1039,7 → 1030,7
DEC(n)
END
|IL.opRES:
|CODE.opRES:
ASSERT(R.top = -1);
GetRegA;
n := param2;
1050,7 → 1041,7
DEC(n)
END
|IL.opENTER:
|CODE.opENTER:
ASSERT(R.top = -1);
X86.SetLabel(param1);
1131,8 → 1122,8
allocReg(cmd)
END
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode = IL.opLEAVER THEN
|CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF:
IF cmd.opcode = CODE.opLEAVER THEN
UnOp(reg1);
IF reg1 # rax THEN
GetRegA;
1144,16 → 1135,13
ASSERT(R.top = -1);
IF opcode = IL.opLEAVEF THEN
IF cmd.opcode = CODE.opLEAVEF THEN
DEC(xmm)
END;
ASSERT(xmm = -1);
IF param1 > 0 THEN
mov(rsp, rbp)
END;
mov(rsp, rbp);
pop(rbp);
IF param2 > 0 THEN
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2
1162,36 → 1150,40
END;
REG.Reset(R)
|IL.opSAVES:
PushAll(1);
|CODE.opSAVES:
UnOp(reg1);
drop;
PushAll(0);
push(reg1);
pushDA(stroffs + param2);
pushc(param1);
CallRTL(IL._move)
CallRTL(CODE._move)
|IL.opSADR:
lea(GetAnyReg(), stroffs + param2, sDATA)
|CODE.opSADR:
reg1 := REG.GetAnyReg(R);
lea(reg1, stroffs + param2, sDATA)
|IL.opLOAD8:
|CODE.opLOAD8:
UnOp(reg1);
movzx(reg1, reg1, 0, FALSE)
|IL.opLOAD16:
|CODE.opLOAD16:
UnOp(reg1);
movzx(reg1, reg1, 0, TRUE)
|IL.opLOAD32:
|CODE.opLOAD32:
UnOp(reg1);
movrm32(reg1, reg1, 0);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32)
|IL.opLOAD64:
|CODE.opLOAD64:
UnOp(reg1);
movrm(reg1, reg1, 0)
|IL.opLLOAD64:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
|CODE.opLLOAD64:
reg1 := REG.GetAnyReg(R);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
1198,19 → 1190,19
movrm(reg1, rbp, param2 * 8)
END
|IL.opLLOAD8,
IL.opLLOAD16:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
|CODE.opLLOAD8,
CODE.opLLOAD16:
reg1 := REG.GetAnyReg(R);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16)
movzx(reg1, rbp, param2 * 8, cmd.opcode = CODE.opLLOAD16)
END
|IL.opLLOAD32:
reg1 := GetAnyReg();
reg2 := GetVarReg(param2);
|CODE.opLLOAD32:
reg1 := REG.GetAnyReg(R);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
1219,71 → 1211,73
movrm32(reg1, rbp, n)
END
|IL.opGLOAD64:
reg1 := GetAnyReg();
|CODE.opGLOAD64:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sBSS);
movrm(reg1, reg1, 0)
|IL.opGLOAD8:
reg1 := GetAnyReg();
|CODE.opGLOAD8:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sBSS);
movzx(reg1, reg1, 0, FALSE)
|IL.opGLOAD16:
reg1 := GetAnyReg();
|CODE.opGLOAD16:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sBSS);
movzx(reg1, reg1, 0, TRUE)
|IL.opGLOAD32:
reg1 := GetAnyReg();
|CODE.opGLOAD32:
reg1 := REG.GetAnyReg(R);
xor(reg1, reg1);
lea(reg1, param2, sBSS);
movrm32(reg1, reg1, 0)
|IL.opVLOAD64:
reg1 := GetAnyReg();
|CODE.opVLOAD64:
reg1 := REG.GetAnyReg(R);
movrm(reg1, rbp, param2 * 8);
movrm(reg1, reg1, 0)
|IL.opVLOAD8,
IL.opVLOAD16:
reg1 := GetAnyReg();
|CODE.opVLOAD8,
CODE.opVLOAD16:
reg1 := REG.GetAnyReg(R);
movrm(reg1, rbp, param2 * 8);
movzx(reg1, reg1, 0, opcode = IL.opVLOAD16)
movzx(reg1, reg1, 0, cmd.opcode = CODE.opVLOAD16)
|IL.opVLOAD32:
reg1 := GetAnyReg();
reg2 := GetAnyReg();
|CODE.opVLOAD32:
reg1 := REG.GetAnyReg(R);
reg2 := REG.GetAnyReg(R);
xor(reg1, reg1);
movrm(reg2, rbp, param2 * 8);
movrm32(reg1, reg2, 0);
drop
|IL.opLADR:
|CODE.opLADR:
n := param2 * 8;
next := cmd.next(COMMAND);
IF next.opcode = IL.opSAVEF THEN
IF next.opcode = CODE.opSAVEF THEN
movsdmr(rbp, n, xmm);
DEC(xmm);
cmd := next
ELSIF next.opcode = IL.opLOADF THEN
ELSIF next.opcode = CODE.opLOADF THEN
INC(xmm);
movsdrm(xmm, rbp, n);
cmd := next
ELSE
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Rex(0, reg1);
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n]
OutIntByte(n)
END
|IL.opGADR:
lea(GetAnyReg(), param2, sBSS)
|CODE.opGADR:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sBSS)
|IL.opVADR:
movrm(GetAnyReg(), rbp, param2 * 8)
|CODE.opVADR:
reg1 := REG.GetAnyReg(R);
movrm(reg1, rbp, param2 * 8)
|IL.opSAVE8C:
|CODE.opSAVE8C:
UnOp(reg1);
IF reg1 >= 8 THEN
OutByte(41H)
1291,7 → 1285,7
OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2
drop
|IL.opSAVE16C:
|CODE.opSAVE16C:
UnOp(reg1);
OutByte(66H);
IF reg1 >= 8 THEN
1301,10 → 1295,10
OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2
drop
|IL.opSAVEC:
|CODE.opSAVEC:
UnOp(reg1);
IF isLong(param2) THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrc(reg2, param2);
movmr(reg1, 0, reg2);
drop
1315,106 → 1309,142
END;
drop
|IL.opRSET:
|CODE.opRSET:
PushAll(2);
CallRTL(IL._set);
CallRTL(CODE._set);
GetRegA
|IL.opRSETR:
|CODE.opRSETR:
PushAll(1);
pushc(param2);
CallRTL(IL._set);
CallRTL(CODE._set);
GetRegA
|IL.opRSETL:
|CODE.opRSETL:
PushAll(1);
pushc(param2);
CallRTL(IL._set2);
CallRTL(CODE._set2);
GetRegA
|IL.opRSET1:
|CODE.opRSET1:
UnOp(reg1);
PushAll(1);
push(reg1);
CallRTL(IL._set);
CallRTL(CODE._set);
GetRegA
|IL.opINCL, IL.opEXCL:
|CODE.opINCL, CODE.opEXCL:
BinOp(reg1, reg2);
cmprc(reg1, 64);
OutByte2(73H, 04H); // jnb L
Rex(reg2, reg1);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1
// L:
drop;
drop
|IL.opINCLC, IL.opEXCLC:
|CODE.opINCLC, CODE.opEXCLC:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2
OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2);
OutByte2(28H + 8 * ORD(cmd.opcode = CODE.opEXCLC) + reg1 MOD 8, param2);
drop
|IL.opEQS .. IL.opGES:
|CODE.opEQS .. CODE.opGES:
PushAll(4);
pushc(opcode - IL.opEQS);
CallRTL(IL._strcmp);
pushc(cmd.opcode - CODE.opEQS);
CallRTL(CODE._strcmp);
GetRegA
|IL.opEQSW .. IL.opGESW:
|CODE.opEQS2 .. CODE.opGES2:
PushAll(4);
pushc(opcode - IL.opEQSW);
CallRTL(IL._strcmpw);
pushc(cmd.opcode - CODE.opEQS2);
CallRTL(CODE._strcmp2);
GetRegA
|IL.opCONST:
movrc(GetAnyReg(), param2)
|CODE.opEQSW .. CODE.opGESW:
PushAll(4);
pushc(cmd.opcode - CODE.opEQSW);
CallRTL(CODE._strcmpw);
GetRegA
|IL.opEQ..IL.opGE,
IL.opEQC..IL.opGEC:
|CODE.opEQSW2 .. CODE.opGESW2:
PushAll(4);
pushc(cmd.opcode - CODE.opEQSW2);
CallRTL(CODE._strcmpw2);
GetRegA
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
|CODE.opINC1, CODE.opDEC1:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opDEC1));
drop
|CODE.opCONST:
reg1 := REG.GetAnyReg(R);
movrc(reg1, param2)
|CODE.opGT, CODE.opGE, CODE.opLT,
CODE.opLE, CODE.opEQ, CODE.opNE:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
drop
drop;
drop;
cc := X86.cond(cmd.opcode);
IF cmd.next(COMMAND).opcode = CODE.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(X86.inv1(cc), label);
cmd := cmd.next(COMMAND)
ELSE
reg1 := REG.GetAnyReg(R);
setcc(cc + 16, reg1);
andrc(reg1, 1)
END
|CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL,
CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL,
CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL:
UnOp(reg1);
IF param2 = 0 THEN
test(reg1)
ELSE
cmprc(reg1, param2)
END
END;
drop;
cc := X86.cond(opcode);
cc := X86.cond(cmd.opcode);
IF cmd.next(COMMAND).opcode = IL.opJE THEN
IF cmd.next(COMMAND).opcode = CODE.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(X86.inv0(cc), label);
jcc(X86.inv1(cc), label);
cmd := cmd.next(COMMAND)
ELSE
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
setcc(cc + 16, reg1);
andrc(reg1, 1)
END
|IL.opCODE:
|CODE.opCODE:
OutByte(param2)
|IL.opPUSHIP:
reg1 := GetAnyReg();
|CODE.opPUSHIP:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sIMP);
movrm(reg1, reg1, 0)
|IL.opPARAM:
|CODE.opPARAM:
n := param2;
IF n = 1 THEN
UnOp(reg1);
1425,7 → 1455,7
PushAll(n)
END
|IL.opACC:
|CODE.opACC:
IF (R.top # 0) OR (R.stk[0] # rax) THEN
PushAll(0);
GetRegA;
1433,29 → 1463,29
DEC(R.pushed)
END
|IL.opJNZ:
|CODE.opJNZ:
UnOp(reg1);
test(reg1);
jcc(jne, param1)
|IL.opJZ:
|CODE.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1)
|IL.opJE:
|CODE.opJE:
UnOp(reg1);
test(reg1);
jcc(jne, param1);
drop
|IL.opJNE:
|CODE.opJNE:
UnOp(reg1);
test(reg1);
jcc(je, param1);
drop
|IL.opIN:
|CODE.opIN:
label := NewLabel();
L := NewLabel();
BinOp(reg1, reg2);
1471,11 → 1501,11
X86.SetLabel(label);
drop
|IL.opINR:
|CODE.opINR:
label := NewLabel();
L := NewLabel();
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
cmprc(reg1, 64);
jcc(jb, L);
xor(reg1, reg1);
1489,7 → 1519,7
X86.SetLabel(label);
drop
|IL.opINL:
|CODE.opINL:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(0FH, 0BAH); // bt reg1, param2
1497,19 → 1527,19
setcc(setc, reg1);
andrc(reg1, 1)
|IL.opNOT:
|CODE.opNOT:
UnOp(reg1);
test(reg1);
setcc(sete, reg1);
andrc(reg1, 1)
|IL.opORD:
|CODE.opORD:
UnOp(reg1);
test(reg1);
setcc(setne, reg1);
andrc(reg1, 1)
|IL.opABS:
|CODE.opABS:
UnOp(reg1);
test(reg1);
OutByte2(7DH, 03H); // jge L
1516,21 → 1546,22
neg(reg1)
// L:
|IL.opEQB, IL.opNEB:
|CODE.opEQB, CODE.opNEB:
BinOp(reg1, reg2);
drop;
drop;
test(reg1);
label := NewLabel();
jcc(je, label);
OutByte2(74H, 07H); // je L1
movrc(reg1, 1);
X86.SetLabel(label);
// L1:
test(reg2);
label := NewLabel();
jcc(je, label);
OutByte2(74H, 07H); // je L2
movrc(reg2, 1);
X86.SetLabel(label);
// L2:
cmprr(reg1, reg2);
IF opcode = IL.opEQB THEN
reg1 := REG.GetAnyReg(R);
IF cmd.opcode = CODE.opEQB THEN
setcc(sete, reg1)
ELSE
setcc(setne, reg1)
1537,193 → 1568,196
END;
andrc(reg1, 1)
|IL.opMULSC:
|CODE.opMULSC:
UnOp(reg1);
andrc(reg1, param2)
|IL.opDIVSC, IL.opADDSL, IL.opADDSR:
|CODE.opDIVSC, CODE.opADDSL, CODE.opADDSR:
UnOp(reg1);
Rex(reg1, 0);
OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2
OutByte2(81H + short(param2), 0C8H + 28H * ORD(cmd.opcode = CODE.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2
OutIntByte(param2)
|IL.opSUBSL:
|CODE.opSUBSL:
UnOp(reg1);
not(reg1);
andrc(reg1, param2)
|IL.opSUBSR:
|CODE.opSUBSR:
UnOp(reg1);
andrc(reg1, ORD(-BITS(param2)))
|IL.opMULS:
|CODE.opMULS:
BinOp(reg1, reg2);
and(reg1, reg2);
drop
|IL.opDIVS:
|CODE.opDIVS:
BinOp(reg1, reg2);
xor(reg1, reg2);
drop
|IL.opUMINS:
|CODE.opUMINS:
UnOp(reg1);
not(reg1)
|IL.opCOPY:
|CODE.opCOPY:
PushAll(2);
pushc(param2);
CallRTL(IL._move2)
CallRTL(CODE._move2)
|IL.opMOVE:
|CODE.opMOVE:
PushAll(3);
CallRTL(IL._move2)
CallRTL(CODE._move2)
|IL.opCOPYA:
|CODE.opCOPYA:
PushAll(4);
pushc(param2);
CallRTL(IL._arrcpy);
CallRTL(CODE._arrcpy);
GetRegA
|IL.opCOPYS:
|CODE.opCOPYS:
PushAll(4);
pushc(param2);
CallRTL(IL._strcpy)
CallRTL(CODE._strcpy)
|IL.opROT:
|CODE.opCOPYS2:
PushAll(4);
pushc(param2);
CallRTL(CODE._strcpy2)
|CODE.opROT:
PushAll(0);
push(rsp);
pushc(param2);
CallRTL(IL._rot)
CallRTL(CODE._rot)
|IL.opNEW:
|CODE.opNEW:
PushAll(1);
n := param2 + 16;
ASSERT(UTILS.Align(n, 64));
ASSERT(MACHINE.Align(n, 64));
pushc(n);
pushc(param1);
CallRTL(IL._new)
CallRTL(CODE._new)
|IL.opDISP:
|CODE.opDISP:
PushAll(1);
CallRTL(IL._dispose)
CallRTL(CODE._dispose)
|IL.opPUSHT:
|CODE.opPUSHT:
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrm(reg2, reg1, -8)
|IL.opISREC:
|CODE.opISREC:
PushAll(2);
pushc(param2 * tcount);
CallRTL(IL._isrec);
pushc(param2);
CallRTL(CODE._isrec);
GetRegA
|IL.opIS:
|CODE.opIS:
PushAll(1);
pushc(param2 * tcount);
CallRTL(IL._is);
pushc(param2);
CallRTL(CODE._is);
GetRegA
|IL.opTYPEGR:
|CODE.opTYPEGR:
PushAll(1);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
pushc(param2);
CallRTL(CODE._guardrec);
GetRegA
|IL.opTYPEGP:
|CODE.opTYPEGP:
UnOp(reg1);
PushAll(0);
push(reg1);
pushc(param2 * tcount);
CallRTL(IL._guard);
pushc(param2);
CallRTL(CODE._guard);
GetRegA
|IL.opTYPEGD:
|CODE.opTYPEGD:
UnOp(reg1);
PushAll(0);
pushm(reg1, -8);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
pushc(param2);
CallRTL(CODE._guardrec);
GetRegA
|IL.opCASET:
|CODE.opCASET:
push(r10);
push(r10);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
pushc(param2);
CallRTL(CODE._guardrec);
pop(r10);
test(rax);
jcc(jne, param1)
|IL.opSAVEP:
|CODE.opSAVEP:
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
lea(reg2, param2, sCODE);
movmr(reg1, 0, reg2);
drop;
drop
|IL.opPUSHP:
lea(GetAnyReg(), param2, sCODE)
|CODE.opPUSHP:
reg1 := REG.GetAnyReg(R);
lea(reg1, param2, sCODE)
|IL.opINC, IL.opDEC:
|CODE.opINC, CODE.opDEC:
BinOp(reg1, reg2);
// add/sub qword[reg2], reg1
Rex(reg2, reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8);
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8);
drop;
drop
|IL.opINCC:
|CODE.opINCC, CODE.opDECC:
UnOp(reg1);
IF isLong(param2) THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrc(reg2, param2);
// add qword[reg1], reg2
// add/sub qword[reg1], reg2
Rex(reg1, reg2);
OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8);
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDECC), reg1 MOD 8 + (reg2 MOD 8) * 8);
drop
ELSIF ABS(param2) = 1 THEN
Rex(reg1, 0);
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1]
ELSE
// add qword[reg1], param2
// add/sub qword[reg1], param2
Rex(reg1, 0);
OutByte2(81H + short(param2), reg1 MOD 8);
OutByte2(81H + short(param2), 28H * ORD(cmd.opcode = CODE.opDECC) + reg1 MOD 8);
OutIntByte(param2)
END;
drop
|IL.opDROP:
|CODE.opDROP:
UnOp(reg1);
drop
|IL.opSAVE, IL.opSAVE64:
|CODE.opSAVE, CODE.opSAVE64:
BinOp(reg2, reg1);
movmr(reg1, 0, reg2);
drop;
drop
|IL.opSAVE8:
|CODE.opSAVE8:
BinOp(reg2, reg1);
movmr8(reg1, 0, reg2);
drop;
drop
|IL.opSAVE16:
|CODE.opSAVE16:
BinOp(reg2, reg1);
movmr16(reg1, 0, reg2);
drop;
drop
|IL.opSAVE32:
|CODE.opSAVE32:
BinOp(reg2, reg1);
movmr32(reg1, 0, reg2);
drop;
drop
|IL.opMIN:
|CODE.opMIN:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(7EH, 3); // jle L
1731,7 → 1765,7
// L:
drop
|IL.opMAX:
|CODE.opMAX:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(7DH, 3); // jge L
1739,7 → 1773,7
// L:
drop
|IL.opMINC:
|CODE.opMINC:
UnOp(reg1);
cmprc(reg1, param2);
label := NewLabel();
1747,7 → 1781,7
movrc(reg1, param2);
X86.SetLabel(label)
|IL.opMAXC:
|CODE.opMAXC:
UnOp(reg1);
cmprc(reg1, param2);
label := NewLabel();
1755,43 → 1789,41
movrc(reg1, param2);
X86.SetLabel(label)
|IL.opSBOOL:
|CODE.opSBOOL:
BinOp(reg2, reg1);
test(reg2);
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1]
setcc(setne, reg2);
movmr8(reg1, 0, reg2);
drop;
drop
|IL.opSBOOLC:
|CODE.opSBOOLC:
UnOp(reg1);
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0));
drop
|IL.opODD:
|CODE.opODD:
UnOp(reg1);
andrc(reg1, 1)
|IL.opUMINUS:
|CODE.opUMINUS:
UnOp(reg1);
neg(reg1)
|IL.opADD:
|CODE.opADD:
BinOp(reg1, reg2);
add(reg1, reg2);
drop
|IL.opSUB:
|CODE.opSUB:
BinOp(reg1, reg2);
sub(reg1, reg2);
drop
|IL.opSUBR, IL.opSUBL:
|CODE.opSUBR, CODE.opSUBL:
UnOp(reg1);
n := param2;
IF n = 1 THEN
1801,11 → 1833,11
ELSIF n # 0 THEN
subrc(reg1, n)
END;
IF opcode = IL.opSUBL THEN
IF cmd.opcode = CODE.opSUBL THEN
neg(reg1)
END
|IL.opADDL, IL.opADDR:
|CODE.opADDL, CODE.opADDR:
IF param2 # 0 THEN
UnOp(reg1);
IF param2 = 1 THEN
1817,17 → 1849,17
END
END
|IL.opDIV:
|CODE.opDIV:
PushAll(2);
CallRTL(IL._div);
CallRTL(CODE._div);
GetRegA
|IL.opDIVR:
|CODE.opDIVR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := X86.log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := X86.log2(-a)
ELSE
n := -1
END;
1842,7 → 1874,7
UnOp(reg1);
IF a < 0 THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
mov(reg2, reg1);
shiftrc(sar, reg1, n);
sub(reg1, reg2);
1854,28 → 1886,28
ELSE
PushAll(1);
pushc(param2);
CallRTL(IL._div);
CallRTL(CODE._div);
GetRegA
END
END
|IL.opDIVL:
|CODE.opDIVL:
PushAll(1);
pushc(param2);
CallRTL(IL._div2);
CallRTL(CODE._div2);
GetRegA
|IL.opMOD:
|CODE.opMOD:
PushAll(2);
CallRTL(IL._mod);
CallRTL(CODE._mod);
GetRegA
|IL.opMODR:
|CODE.opMODR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := X86.log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := X86.log2(-a)
ELSE
n := -1
END;
1899,30 → 1931,30
ELSE
PushAll(1);
pushc(param2);
CallRTL(IL._mod);
CallRTL(CODE._mod);
GetRegA
END
END
|IL.opMODL:
|CODE.opMODL:
PushAll(1);
pushc(param2);
CallRTL(IL._mod2);
CallRTL(CODE._mod2);
GetRegA
|IL.opMUL:
|CODE.opMUL:
BinOp(reg1, reg2);
oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2
drop
|IL.opMULC:
|CODE.opMULC:
UnOp(reg1);
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := X86.log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := X86.log2(-a)
ELSE
n := -1
END;
1947,20 → 1979,20
END
END
|IL.opADDS:
|CODE.opADDS:
BinOp(reg1, reg2);
or(reg1, reg2);
drop
|IL.opSUBS:
|CODE.opSUBS:
BinOp(reg1, reg2);
not(reg2);
and(reg1, reg2);
drop
|IL.opNOP:
|CODE.opNOP:
|IL.opSWITCH:
|CODE.opSWITCH:
UnOp(reg1);
IF param2 = 0 THEN
reg2 := rax
1974,71 → 2006,65
END;
drop
|IL.opENDSW:
|CODE.opENDSW:
|IL.opCASEL:
|CODE.opCASEL:
cmprc(rax, param1);
jcc(jl, param2)
|IL.opCASER:
|CODE.opCASER:
cmprc(rax, param1);
jcc(jg, param2)
|IL.opCASELR:
|CODE.opCASELR:
cmprc(rax, param1);
jcc(jl, param2);
jcc(jg, cmd.param3)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
|CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR:
BinOp(reg1, reg2);
xchg(reg2, rcx);
Rex(reg1, 0);
OutByte(0D3H);
X86.shift(opcode, reg1 MOD 8); // shift reg1, cl
X86.shift(cmd.opcode, reg1 MOD 8); // shift reg1, cl
xchg(reg2, rcx);
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
reg1 := GetAnyReg();
|CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1:
reg1 := REG.GetAnyReg(R);
movrc(reg1, param2);
BinOp(reg1, reg2);
xchg(reg1, rcx);
Rex(reg2, 0);
OutByte(0D3H);
X86.shift(opcode, reg2 MOD 8); // shift reg2, cl
X86.shift(cmd.opcode, reg2 MOD 8); // shift reg2, cl
xchg(reg1, rcx);
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2:
|CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2:
UnOp(reg1);
shiftrc(opcode, reg1, param2 MOD 64)
shiftrc(cmd.opcode, reg1, ORD(BITS(param2) * {0..5}))
|IL.opGET, IL.opGETC:
IF opcode = IL.opGET THEN
BinOp(reg1, reg2)
ELSIF opcode = IL.opGETC THEN
UnOp(reg2);
reg1 := GetAnyReg();
movrc(reg1, param1)
END;
|CODE.opGET:
BinOp(reg1, reg2);
drop;
drop;
_movrm(reg1, reg1, 0, param2 * 8, FALSE);
_movrm(reg1, reg2, 0, param2 * 8, TRUE)
|IL.opCHKBYTE:
|CODE.opCHKBYTE:
BinOp(reg1, reg2);
cmprc(reg1, 256);
jcc(jb, param1)
|IL.opCHKIDX:
|CODE.opCHKIDX:
UnOp(reg1);
cmprc(reg1, param2);
jcc(jb, param1)
|IL.opCHKIDX2:
|CODE.opCHKIDX2:
BinOp(reg1, reg2);
IF param2 # -1 THEN
cmprr(reg2, reg1);
2051,17 → 2077,17
R.stk[R.top] := reg2
END
|IL.opLENGTH:
|CODE.opLENGTH:
PushAll(2);
CallRTL(IL._length);
CallRTL(CODE._length);
GetRegA
|IL.opLENGTHW:
|CODE.opLENGTHW:
PushAll(2);
CallRTL(IL._lengthw);
CallRTL(CODE._lengthw);
GetRegA
|IL.opLEN:
|CODE.opLEN:
n := param2;
UnOp(reg1);
drop;
2076,23 → 2102,23
INCL(R.regs, reg1);
ASSERT(REG.GetReg(R, reg1))
|IL.opCHR:
|CODE.opCHR:
UnOp(reg1);
andrc(reg1, 255)
|IL.opWCHR:
|CODE.opWCHR:
UnOp(reg1);
andrc(reg1, 65535)
|IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP:
|CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP:
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
CASE opcode OF
|IL.opEQP, IL.opNEP:
CASE cmd.opcode OF
|CODE.opEQP, CODE.opNEP:
lea(reg2, param1, sCODE)
|IL.opEQIP, IL.opNEIP:
|CODE.opEQIP, CODE.opNEIP:
lea(reg2, param1, sIMP);
movrm(reg2, reg2, 0)
END;
2100,35 → 2126,43
cmprr(reg1, reg2);
drop;
drop;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
CASE opcode OF
|IL.opEQP, IL.opEQIP: setcc(sete, reg1)
|IL.opNEP, IL.opNEIP: setcc(setne, reg1)
CASE cmd.opcode OF
|CODE.opEQP, CODE.opEQIP: setcc(sete, reg1)
|CODE.opNEP, CODE.opNEIP: setcc(setne, reg1)
END;
andrc(reg1, 1)
|IL.opINCCB, IL.opDECCB:
|CODE.opINC1B, CODE.opDEC1B:
UnOp(reg1);
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256
OutByte2(0FEH, 8 * ORD(cmd.opcode = CODE.opDEC1B) + reg1 MOD 8); // inc/dec byte[reg1]
drop
|IL.opINCB, IL.opDECB:
|CODE.opINCCB, CODE.opDECCB:
UnOp(reg1);
IF reg1 >= 8 THEN
OutByte(41H)
END;
OutByte3(80H, 28H * ORD(cmd.opcode = CODE.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256
drop
|CODE.opINCB, CODE.opDECB:
BinOp(reg1, reg2);
IF (reg1 >= 8) OR (reg2 >= 8) THEN
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8))
END;
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8
OutByte2(28H * ORD(cmd.opcode = CODE.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8
drop;
drop
|IL.opSAVEIP:
|CODE.opSAVEIP:
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
lea(reg2, param2, sIMP);
movrm(reg2, reg2, 0);
push(reg2);
2139,82 → 2173,82
OutByte2(8FH, reg1 MOD 8); // pop qword[reg1]
drop
|IL.opCLEANUP:
|CODE.opCLEANUP:
n := param2 * 8;
IF n # 0 THEN
addrc(rsp, n)
END
|IL.opPOPSP:
|CODE.opPOPSP:
pop(rsp)
|IL.opLOADF:
|CODE.opLOADF:
UnOp(reg1);
INC(xmm);
movsdrm(xmm, reg1, 0);
drop
|IL.opPUSHF:
|CODE.opPUSHF:
subrc(rsp, 8);
movsdmr(rsp, 0, xmm);
DEC(xmm)
|IL.opCONSTF:
|CODE.opCONSTF:
float := cmd.float;
INC(xmm);
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA);
movsdrm(xmm, reg1, 0);
drop;
NewNumber(UTILS.splitf(float, a, b))
|IL.opSAVEF:
|CODE.opSAVEF:
UnOp(reg1);
movsdmr(reg1, 0, xmm);
DEC(xmm);
drop
|IL.opADDF, IL.opADDFI:
|CODE.opADDF, CODE.opADDFI:
opxx(58H, xmm - 1, xmm);
DEC(xmm)
|IL.opSUBF:
|CODE.opSUBF:
opxx(5CH, xmm - 1, xmm);
DEC(xmm)
|IL.opSUBFI:
|CODE.opSUBFI:
opxx(5CH, xmm, xmm - 1);
opxx(10H, xmm - 1, xmm);
DEC(xmm)
|IL.opMULF:
|CODE.opMULF:
opxx(59H, xmm - 1, xmm);
DEC(xmm)
|IL.opDIVF:
|CODE.opDIVF:
opxx(5EH, xmm - 1, xmm);
DEC(xmm)
|IL.opDIVFI:
|CODE.opDIVFI:
opxx(5EH, xmm, xmm - 1);
opxx(10H, xmm - 1, xmm);
DEC(xmm)
|IL.opUMINF:
reg1 := GetAnyReg();
|CODE.opUMINF:
reg1 := REG.GetAnyReg(R);
lea(reg1, Numbers_Offs, sDATA);
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1]
OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8);
drop
|IL.opFABS:
reg1 := GetAnyReg();
|CODE.opFABS:
reg1 := REG.GetAnyReg(R);
lea(reg1, Numbers_Offs + 16, sDATA);
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1]
OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8);
drop
|IL.opFLT:
|CODE.opFLT:
UnOp(reg1);
INC(xmm);
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1
2221,8 → 2255,8
OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8);
drop
|IL.opFLOOR:
reg1 := GetAnyReg();
|CODE.opFLOOR:
reg1 := REG.GetAnyReg(R);
subrc(rsp, 8);
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4];
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp];
2235,23 → 2269,23
addrc(rsp, 8);
DEC(xmm)
|IL.opEQF .. IL.opGEF:
fcmp(opcode, xmm);
|CODE.opEQF .. CODE.opGEFI:
fcmp(cmd.opcode, xmm);
DEC(xmm, 2)
|IL.opINF:
|CODE.opINF:
INC(xmm);
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
lea(reg1, Numbers_Offs + 32, sDATA);
movsdrm(xmm, reg1, 0);
drop
|IL.opPACK, IL.opPACKC:
IF opcode = IL.opPACK THEN
|CODE.opPACK, CODE.opPACKC:
IF cmd.opcode = CODE.opPACK THEN
BinOp(reg1, reg2)
ELSE
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrc(reg2, param2)
END;
push(reg1);
2276,15 → 2310,15
drop;
drop
|IL.opUNPK, IL.opLADR_UNPK:
|CODE.opUNPK, CODE.opLADR_UNPK:
IF opcode = IL.opLADR_UNPK THEN
IF cmd.opcode = CODE.opLADR_UNPK THEN
n := param2 * 8;
UnOp(reg1);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, param2);
regVar := reg2 # -1;
IF ~regVar THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
Rex(0, reg2);
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n]
OutIntByte(n)
2302,7 → 2336,7
IF regVar THEN
mov(reg2, reg1);
reg2 := GetAnyReg()
reg2 := REG.GetAnyReg(R)
ELSE
movmr(reg2, 0, reg1)
END;
2323,19 → 2357,19
drop;
drop
|IL.opSADR_PARAM:
|CODE.opSADR_PARAM:
pushDA(stroffs + param2)
|IL.opVADR_PARAM:
|CODE.opVADR_PARAM:
pushm(rbp, param2 * 8)
|IL.opLOAD64_PARAM:
|CODE.opLOAD64_PARAM:
UnOp(reg1);
pushm(reg1, 0);
drop
|IL.opLLOAD64_PARAM:
reg1 := GetVarReg(param2);
|CODE.opLLOAD64_PARAM:
reg1 := REG.GetVarReg(R, param2);
IF reg1 # -1 THEN
push(reg1)
ELSE
2342,18 → 2376,18
pushm(rbp, param2 * 8)
END
|IL.opGLOAD64_PARAM:
reg2 := GetAnyReg();
|CODE.opGLOAD64_PARAM:
reg2 := REG.GetAnyReg(R);
lea(reg2, param2, sBSS);
movrm(reg2, reg2, 0);
push(reg2);
drop
|IL.opCONST_PARAM:
|CODE.opCONST_PARAM:
pushc(param2)
|IL.opGLOAD32_PARAM:
reg1 := GetAnyReg();
|CODE.opGLOAD32_PARAM:
reg1 := REG.GetAnyReg(R);
xor(reg1, reg1);
lea(reg1, param2, sBSS);
movrm32(reg1, reg1, 0);
2360,7 → 2394,7
push(reg1);
drop
|IL.opLOAD32_PARAM:
|CODE.opLOAD32_PARAM:
UnOp(reg1);
movrm32(reg1, reg1, 0);
shiftrc(shl, reg1, 32);
2368,10 → 2402,10
push(reg1);
drop
|IL.opLLOAD32_PARAM:
reg1 := GetAnyReg();
|CODE.opLLOAD32_PARAM:
reg1 := REG.GetAnyReg(R);
xor(reg1, reg1);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
mov(reg1, reg2)
ELSE
2380,14 → 2414,14
push(reg1);
drop
|IL.opLADR_SAVEC:
|CODE.opLADR_SAVEC:
n := param1 * 8;
reg1 := GetVarReg(param1);
reg1 := REG.GetVarReg(R, param1);
IF reg1 # -1 THEN
movrc(reg1, param2)
ELSE
IF isLong(param2) THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrc(reg2, param2);
movmr(rbp, n, reg2);
drop
2398,17 → 2432,17
END
END
|IL.opGADR_SAVEC:
|CODE.opGADR_SAVEC:
IF isLong(param2) THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
movrc(reg1, param2);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
lea(reg2, param1, sBSS);
movmr(reg2, 0, reg1);
drop;
drop
ELSE
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
lea(reg2, param1, sBSS);
Rex(reg2, 0);
OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2
2416,9 → 2450,9
drop
END
|IL.opLADR_SAVE:
|CODE.opLADR_SAVE:
UnOp(reg1);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
mov(reg2, reg1)
ELSE
2426,48 → 2460,79
END;
drop
|IL.opLADR_INCC:
reg1 := GetVarReg(param1);
|CODE.opLADR_INC1:
reg1 := REG.GetVarReg(R, param2);
IF reg1 # -1 THEN
incr(reg1)
ELSE
n := param2 * 8;
OutByte3(48H, 0FFH, 45H + long(n)); // inc qword[rbp+n]
OutIntByte(n)
END
|CODE.opLADR_DEC1:
reg1 := REG.GetVarReg(R, param2);
IF reg1 # -1 THEN
decr(reg1)
ELSE
n := param2 * 8;
OutByte3(48H, 0FFH, 4DH + long(n)); // dec qword[rbp+n]
OutIntByte(n)
END
|CODE.opLADR_INCC, CODE.opLADR_DECC:
reg1 := REG.GetVarReg(R, param1);
IF isLong(param2) THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
movrc(reg2, param2);
IF reg1 # -1 THEN
IF cmd.opcode = CODE.opLADR_DECC THEN
sub(reg1, reg2)
ELSE
add(reg1, reg2)
END
ELSE
n := param1 * 8;
Rex(0, reg2);
OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8);
OutIntByte(n) // add qword[rbp+n],reg2
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DECC), 45H + long(n) + (reg2 MOD 8) * 8);
OutIntByte(n) // add/sub qword[rbp+n],reg2
END;
drop
ELSIF ABS(param2) = 1 THEN
ELSE
IF reg1 # -1 THEN
IF param2 = 1 THEN
incr(reg1)
IF cmd.opcode = CODE.opLADR_DECC THEN
subrc(reg1, param2)
ELSE
decr(reg1)
addrc(reg1, param2)
END
ELSE
n := param1 * 8;
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n]
OutIntByte(n)
OutByte3(48H, 81H + short(param2), 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECC));
OutIntByte(n);
OutIntByte(param2) // add/sub qword[rbp+n],param2
END
ELSE
END
|CODE.opLADR_INC1B, CODE.opLADR_DEC1B:
reg1 := REG.GetVarReg(R, param2);
IF reg1 # -1 THEN
addrc(reg1, param2)
IF cmd.opcode = CODE.opLADR_DEC1B THEN
decr(reg1)
ELSE
n := param1 * 8;
OutByte3(48H, 81H + short(param2), 45H + long(n));
OutIntByte(n);
OutIntByte(param2) // add qword[rbp+n],param2
incr(reg1)
END;
andrc(reg1, 255)
ELSE
n := param2 * 8;
OutByte2(0FEH, 45H + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_DEC1B));
OutIntByte(n) // inc/dec byte[rbp+n]
END
END
|IL.opLADR_INCCB, IL.opLADR_DECCB:
reg1 := GetVarReg(param1);
|CODE.opLADR_INCCB, CODE.opLADR_DECCB:
reg1 := REG.GetVarReg(R, param1);
param2 := param2 MOD 256;
IF reg1 # -1 THEN
IF opcode = IL.opLADR_DECCB THEN
IF cmd.opcode = CODE.opLADR_DECCB THEN
subrc(reg1, param2)
ELSE
addrc(reg1, param2)
2475,16 → 2540,16
andrc(reg1, 255)
ELSE
n := param1 * 8;
OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB));
OutByte2(80H, 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECCB));
OutIntByte(n);
OutByte(param2) // add/sub byte[rbp+n],param2
END
|IL.opLADR_INC, IL.opLADR_DEC:
|CODE.opLADR_INC, CODE.opLADR_DEC:
UnOp(reg1);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
IF opcode = IL.opLADR_DEC THEN
IF cmd.opcode = CODE.opLADR_DEC THEN
sub(reg2, reg1)
ELSE
add(reg2, reg1)
2492,16 → 2557,16
ELSE
n := param2 * 8;
Rex(0, reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
OutIntByte(n) // add/sub qword[rbp+n],reg1
END;
drop
|IL.opLADR_INCB, IL.opLADR_DECB:
|CODE.opLADR_INCB, CODE.opLADR_DECB:
UnOp(reg1);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, param2);
IF reg2 # -1 THEN
IF opcode = IL.opLADR_DECB THEN
IF cmd.opcode = CODE.opLADR_DECB THEN
sub(reg2, reg1)
ELSE
add(reg2, reg1)
2512,43 → 2577,43
IF reg1 >= 8 THEN
OutByte(44H)
END;
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
OutByte2(28H * ORD(cmd.opcode = CODE.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
OutIntByte(n) // add/sub byte[rbp+n], reg1_8
END;
drop
|IL.opLADR_INCL, IL.opLADR_EXCL:
|CODE.opLADR_INCL, CODE.opLADR_EXCL:
UnOp(reg1);
cmprc(reg1, 64);
reg2 := GetVarReg(param2);
reg2 := REG.GetVarReg(R, 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
oprr2(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1
ELSE
n := param2 * 8;
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L
Rex(0, reg1);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8));
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8));
OutIntByte(n) // bts/btr qword[rbp+n], reg1
END;
// L:
drop
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
reg1 := GetVarReg(param1);
|CODE.opLADR_INCLC, CODE.opLADR_EXCLC:
reg1 := REG.GetVarReg(R, 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)
OutByte2(reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.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));
OutByte(6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC));
OutIntByte(n);
OutByte(param2)
END
|IL.opLOOP, IL.opENDLOOP:
|CODE.opLOOP, CODE.opENDLOOP:
END;
2561,14 → 2626,14
END translate;
PROCEDURE prolog (code: IL.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER);
PROCEDURE prolog (code: CODE.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER);
VAR
ModName_Offs, entry, L: INTEGER;
ModName_Offs, entry: INTEGER;
BEGIN
ModName_Offs := tcount * 8 + CHL.Length(code.data);
ModName_Offs := CHL.Length(code.types) * 8 + CHL.Length(code.data);
Numbers_Offs := ModName_Offs + LENGTH(modname) + 1;
ASSERT(UTILS.Align(Numbers_Offs, 16));
ASSERT(MACHINE.Align(Numbers_Offs, 16));
entry := NewLabel();
X86.SetLabel(entry);
2578,64 → 2643,44
push(r8);
push(rdx);
push(rcx);
CallRTL(IL._dllentry);
CallRTL(CODE._dllentry);
test(rax);
jcc(je, dllret)
END;
IF target = mConst.Target_iELF64 THEN
push(rsp)
ELSE
pushc(0)
END;
push(rsp);
lea(rax, entry, sCODE);
push(rax);
pushDA(0); //TYPES
pushc(tcount);
pushc(CHL.Length(code.types));
pushDA(ModName_Offs); //MODNAME
CallRTL(IL._init);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64} THEN
L := NewLabel();
pushc(0);
push(rsp);
pushc(1024 * 1024 * stack_size);
pushc(0);
CallRTL(IL._new);
pop(rax);
test(rax);
jcc(je, L);
addrc(rax, 1024 * 1024 * stack_size - 8);
mov(rsp, rax);
X86.SetLabel(L)
END
CallRTL(CODE._init)
END prolog;
PROCEDURE epilog (code: IL.CODES; modname: ARRAY OF CHAR; target: INTEGER);
PROCEDURE epilog (code: CODE.CODES; modname: ARRAY OF CHAR; target: INTEGER);
VAR
i, n: INTEGER;
number: Number;
exp: IL.EXPORT_PROC;
exp: CODE.EXPORT_PROC;
PROCEDURE import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
lib: CODE.IMPORT_LIB;
proc: CODE.IMPORT_PROC;
BEGIN
lib := imp.first(IL.IMPORT_LIB);
lib := imp.first(CODE.IMPORT_LIB);
WHILE lib # NIL DO
BIN.Import(prog, lib.name, 0);
proc := lib.procs.first(IL.IMPORT_PROC);
proc := lib.procs.first(CODE.IMPORT_PROC);
WHILE proc # NIL DO
BIN.Import(prog, proc.name, proc.label);
proc := proc.next(IL.IMPORT_PROC)
proc := proc.next(CODE.IMPORT_PROC)
END;
lib := lib.next(IL.IMPORT_LIB)
lib := lib.next(CODE.IMPORT_LIB)
END
END import;
2645,21 → 2690,15
IF target = mConst.Target_iDLL64 THEN
X86.SetLabel(dllret);
OutByte(0C3H) // ret
ELSIF target = mConst.Target_iELFSO64 THEN
sofinit := NewLabel();
OutByte(0C3H); // ret
X86.SetLabel(sofinit);
CallRTL(IL._sofinit);
OutByte(0C3H) // ret
ELSE
pushc(0);
CallRTL(IL._exit)
CallRTL(CODE._exit)
END;
X86.fixup;
i := 0;
WHILE i < tcount DO
WHILE i < CHL.Length(code.types) DO
BIN.PutData64LE(prog, CHL.GetInt(code.types, i));
INC(i)
END;
2673,7 → 2712,7
BIN.PutDataStr(prog, modname);
BIN.PutData(prog, 0);
n := CHL.Length(prog.data);
ASSERT(UTILS.Align(n, 16));
ASSERT(MACHINE.Align(n, 16));
i := n - CHL.Length(prog.data);
WHILE i > 0 DO
BIN.PutData(prog, 0);
2685,10 → 2724,10
number := number.next(Number)
END;
exp := code.export.first(IL.EXPORT_PROC);
exp := code.export.first(CODE.EXPORT_PROC);
WHILE exp # NIL DO
BIN.Export(prog, exp.name, exp.label);
exp := exp.next(IL.EXPORT_PROC)
exp := exp.next(CODE.EXPORT_PROC)
END;
import(code.import)
2719,13 → 2758,12
END rsave;
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base: INTEGER);
VAR
path, modname, ext: PATHS.PATH;
n: INTEGER;
BEGIN
tcount := CHL.Length(code.types);
Win64RegPar[0] := rcx;
Win64RegPar[1] := rdx;
Win64RegPar[2] := r8;
2741,9 → 2779,13
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});
R := REG.Create(push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9});
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 8));
n := code.dmin - CHL.Length(code.data);
IF n > 0 THEN
INC(code.bss, n)
END;
code.bss := MAX(code.bss, 8);
Numbers := LISTS.create(NIL);
Numbers_Count := 0;
2756,19 → 2798,19
NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *)
prog := BIN.create(code.lcount);
BIN.SetParams(prog, code.bss, 1, WCHR(1), WCHR(0));
BIN.SetParams(prog, code.bss, stack, WCHR(1), WCHR(0));
X86.SetProgram(prog);
prolog(code, modname, target, options.stack);
translate(code.commands, tcount * 8);
prolog(code, modname, target, stack);
translate(code.commands, CHL.Length(code.types) * 8);
epilog(code, modname, target);
BIN.fixup(prog);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
PE32.write(prog, outname, options.base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE)
ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE)
PE32.write(prog, outname, base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE)
ELSIF target = mConst.Target_iELF64 THEN
ELF.write(prog, outname, TRUE)
END
END CodeGen;

/programs/develop/oberon07/Source/STATEMENTS.ob07
9,8 → 9,8
IMPORT
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64,
ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;
CONST
29,9 → 29,7
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3;
TYPE
isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
59,7 → 57,7
CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
label: INTEGER;
cmd: IL.COMMAND;
cmd: CODE.COMMAND;
processed: BOOLEAN
END;
67,19 → 65,15
VAR
Options: PROG.OPTIONS;
begcall, endcall: CODE.COMMAND;
begcall, endcall: IL.COMMAND;
checking: SET;
CaseLabels, CaseVar: C.COLLECTION;
CaseVariants: LISTS.LIST;
CPU: INTEGER;
tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_;
PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
END isExpr;
91,17 → 85,17
PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tBOOLEAN)
RETURN isExpr(e) & (e.type.typ = PROG.tBOOLEAN)
END isBoolean;
PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tINTEGER)
RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER)
END isInteger;
PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tBYTE)
RETURN isExpr(e) & (e.type.typ = PROG.tBYTE)
END isByte;
111,12 → 105,12
PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tREAL)
RETURN isExpr(e) & (e.type.typ = PROG.tREAL)
END isReal;
PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tSET)
RETURN isExpr(e) & (e.type.typ = PROG.tSET)
END isSet;
131,15 → 125,30
PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tCHAR)
RETURN isExpr(e) & (e.type.typ = PROG.tCHAR)
END isChar;
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR)
END isCharArray;
PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type = tWCHAR)
RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR)
END isCharW;
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR)
END isCharArrayW;
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR})
END isCharArrayX;
PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)
END isPtr;
150,11 → 159,6
END isRec;
PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
RETURN isRec(e) OR isPtr(e)
END isRecPtr;
PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)
END isArr;
170,33 → 174,15
END isNil;
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
RETURN isArr(e) & (e.type.base = tCHAR)
END isCharArray;
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
RETURN isArr(e) & (e.type.base = tWCHAR)
END isCharArrayW;
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
RETURN isCharArray(e) OR isCharArrayW(e)
END isCharArrayX;
PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
PROCEDURE getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION);
BEGIN
pos.line := parser.lex.pos.line;
pos.col := parser.lex.pos.col;
pos.parser := parser
pos := parser.lex.pos
END getpos;
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION);
BEGIN
PARS.Next(parser);
getpos(parser, pos)
PARS.NextPos(parser, pos)
END NextPos;
206,7 → 192,7
BEGIN
ASSERT(isString(e));
IF e.type = tCHAR THEN
IF e.type.typ = PROG.tCHAR THEN
res := 1
ELSE
res := LENGTH(e.value.string(SCAN.IDENT).s)
280,24 → 266,24
IF arrcomp(e.type, t) THEN
res := TRUE
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
IF (e.obj = eCONST) & (t = tBYTE) THEN
IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN
res := ARITH.range(e.value, 0, 255)
ELSE
res := TRUE
END
ELSIF isSet(e) & (t = tSET) THEN
ELSIF isSet(e) & (t.typ = PROG.tSET) THEN
res := TRUE
ELSIF isBoolean(e) & (t = tBOOLEAN) THEN
ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN
res := TRUE
ELSIF isReal(e) & (t = tREAL) THEN
ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN
res := TRUE
ELSIF isChar(e) & (t = tCHAR) THEN
ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN
res := TRUE
ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) THEN
ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN
res := TRUE
ELSIF isStringW1(e) & (t = tWCHAR) THEN
ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN
res := TRUE
ELSIF isCharW(e) & (t = tWCHAR) THEN
ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN
res := TRUE
ELSIF PROG.isBaseOf(t, e.type) THEN
res := TRUE
305,9 → 291,9
res := TRUE
ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
res := TRUE
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))) THEN
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN
res := TRUE
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))) THEN
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tWCHAR) & (t.length > utf8strlen(e))) THEN
res := TRUE
ELSE
res := FALSE
328,11 → 314,11
IF strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
IF string.offset = -1 THEN
string.offset := IL.putstr(string.s);
string.offset := CODE.putstr(string.s);
END;
offset := string.offset
ELSE
offset := IL.putstr1(ARITH.Int(e.value))
offset := CODE.putstr1(ARITH.Int(e.value))
END
RETURN offset
348,16 → 334,16
IF utf8strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
string.offsetW := CODE.putstrW(string.s);
END;
offset := string.offsetW
ELSE
IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
offset := IL.putstrW1(ARITH.Int(e.value))
offset := CODE.putstrW1(ARITH.Int(e.value))
ELSE (* e.type.typ = PROG.tSTRING *)
string := e.value.string(SCAN.IDENT);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
string.offsetW := CODE.putstrW(string.s);
END;
offset := string.offsetW
END
372,10 → 358,10
label: INTEGER;
BEGIN
label := IL.NewLabel();
IL.AddCmd2(IL.opCHKIDX, label, range);
IL.OnError(line, errno);
IL.SetLabel(label)
label := CODE.NewLabel();
CODE.AddCmd2(CODE.opCHKIDX, label, range);
CODE.OnError(line, errno);
CODE.SetLabel(label)
END CheckRange;
398,98 → 384,98
IF arrcomp(e.type, VarType) THEN
IF ~PROG.isOpenArray(VarType) THEN
IL.Const(VarType.length)
CODE.AddCmd(CODE.opCONST, VarType.length)
END;
IL.AddCmd(IL.opCOPYA, VarType.base.size);
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJE, label);
IL.OnError(line, errCOPY);
IL.SetLabel(label)
CODE.AddCmd(CODE.opCOPYA, VarType.base.size);
label := CODE.NewLabel();
CODE.AddJmpCmd(CODE.opJE, label);
CODE.OnError(line, errCOPY);
CODE.SetLabel(label)
ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
IF VarType = tINTEGER THEN
IF VarType.typ = PROG.tINTEGER THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSAVE)
CODE.AddCmd0(CODE.opSAVE)
END
ELSE
IF e.obj = eCONST THEN
res := ARITH.range(e.value, 0, 255);
IF res THEN
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
END
ELSE
IF chkBYTE IN Options.checking THEN
label := IL.NewLabel();
IL.AddCmd2(IL.opCHKBYTE, label, 0);
IL.OnError(line, errBYTE);
IL.SetLabel(label)
IF chkBYTE IN checking THEN
label := CODE.NewLabel();
CODE.AddCmd2(CODE.opCHKBYTE, label, 0);
CODE.OnError(line, errBYTE);
CODE.SetLabel(label)
END;
IL.AddCmd0(IL.opSAVE8)
CODE.AddCmd0(CODE.opSAVE8)
END
END
ELSIF isSet(e) & (VarType = tSET) THEN
ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSAVE)
CODE.AddCmd0(CODE.opSAVE)
END
ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSBOOL)
CODE.AddCmd0(CODE.opSBOOL)
END
ELSIF isReal(e) & (VarType = tREAL) THEN
ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
CODE.Float(ARITH.Float(e.value))
END;
IL.savef
ELSIF isChar(e) & (VarType = tCHAR) THEN
CODE.savef
ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSAVE8)
CODE.AddCmd0(CODE.opSAVE8)
END
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))
ELSIF isCharW(e) & (VarType = tWCHAR) THEN
ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN
CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSAVE16)
CODE.AddCmd0(CODE.opSAVE16)
END
ELSIF PROG.isBaseOf(VarType, e.type) THEN
IF VarType.typ = PROG.tPOINTER THEN
IL.AddCmd0(IL.opSAVE)
CODE.AddCmd0(CODE.opSAVE)
ELSE
IL.AddCmd(IL.opCOPY, VarType.size)
CODE.AddCmd(CODE.opCOPY, VarType.size)
END
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
IL.AddCmd0(IL.opSAVE32)
CODE.AddCmd0(CODE.opSAVE32)
ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN
IL.AddCmd0(IL.opSAVE16)
CODE.AddCmd0(CODE.opSAVE16)
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
IF e.obj = ePROC THEN
IL.AssignProc(e.ident.proc.label)
CODE.AssignProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.AssignImpProc(e.ident.import)
CODE.AssignImpProc(e.ident.import)
ELSE
IF VarType.typ = PROG.tPROCEDURE THEN
IL.AddCmd0(IL.opSAVE)
CODE.AddCmd0(CODE.opSAVE)
ELSE
IL.AddCmd(IL.opCOPY, VarType.size)
CODE.AddCmd(CODE.opCOPY, VarType.size)
END
END
ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
IL.AddCmd(IL.opSAVEC, 0)
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
IL.saves(String(e), strlen(e) + 1)
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
CODE.AddCmd(CODE.opSAVEC, 0)
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN
CODE.saves(String(e), strlen(e) + 1)
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN
CODE.saves(StringW(e), (utf8strlen(e) + 1) * 2)
ELSE
res := FALSE
END
502,13 → 488,11
PROCEDURE LoadConst (e: PARS.EXPR);
BEGIN
IL.Const(ARITH.Int(e.value))
CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value))
END LoadConst;
PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
VAR
stroffs: INTEGER;
PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM);
PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
VAR
546,11 → 530,11
d1, d2: INTEGER;
BEGIN
IF t.length # 0 THEN
IL.Param1;
CODE.AddCmd(CODE.opPARAM, 1);
n := PROG.Dim(t2) - 1;
WHILE n >= 0 DO
IL.Const(ArrLen(t, n));
IL.Param1;
CODE.AddCmd(CODE.opCONST, ArrLen(t, n));
CODE.AddCmd(CODE.opPARAM, 1);
DEC(n)
END
ELSE
559,16 → 543,16
IF d1 # d2 THEN
n := d2 - d1;
WHILE d2 > d1 DO
IL.Const(ArrLen(t, d2 - 1));
CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1));
DEC(d2)
END;
d2 := PROG.Dim(t2);
WHILE n > 0 DO
IL.AddCmd(IL.opROT, d2);
CODE.AddCmd(CODE.opROT, d2);
DEC(n)
END
END;
IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1)
END
END OpenArray;
576,92 → 560,87
BEGIN
IF p.vPar THEN
PARS.check(isVar(e), pos, 93);
PARS.check(isVar(e), parser, pos, 93);
IF p.type.typ = PROG.tRECORD THEN
PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66);
PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66);
IF e.obj = eVREC THEN
IF e.ident # NIL THEN
IL.AddCmd(IL.opVADR, e.ident.offset - 1)
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1)
ELSE
IL.AddCmd0(IL.opPUSHT)
CODE.AddCmd0(CODE.opPUSHT)
END
ELSE
IL.Const(e.type.num)
CODE.AddCmd(CODE.opCONST, e.type.num)
END;
IL.AddCmd(IL.opPARAM, 2)
CODE.AddCmd(CODE.opPARAM, 2)
ELSIF PROG.isOpenArray(p.type) THEN
PARS.check(arrcomp(e, p), pos, 66);
PARS.check(arrcomp(e, p), parser, pos, 66);
OpenArray(e.type, p.type)
ELSE
PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66);
IL.Param1
PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66);
CODE.AddCmd(CODE.opPARAM, 1)
END;
PARS.check(~e.readOnly, pos, 94)
PARS.check(~e.readOnly, parser, pos, 94)
ELSE
PARS.check(isExpr(e) OR isProc(e), pos, 66);
PARS.check(isExpr(e) OR isProc(e), parser, pos, 66);
IF PROG.isOpenArray(p.type) THEN
IF e.type.typ = PROG.tARRAY THEN
PARS.check(arrcomp(e, p), pos, 66);
PARS.check(arrcomp(e, p), parser, pos, 66);
OpenArray(e.type, p.type)
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN
IL.StrAdr(String(e));
IL.Param1;
IL.Const(strlen(e) + 1);
IL.Param1
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN
IL.StrAdr(StringW(e));
IL.Param1;
IL.Const(utf8strlen(e) + 1);
IL.Param1
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN
CODE.AddCmd(CODE.opSADR, String(e));
CODE.AddCmd(CODE.opPARAM, 1);
CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
CODE.AddCmd(CODE.opPARAM, 1)
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN
CODE.AddCmd(CODE.opSADR, StringW(e));
CODE.AddCmd(CODE.opPARAM, 1);
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
CODE.AddCmd(CODE.opPARAM, 1)
ELSE
PARS.error(pos, 66)
PARS.error(parser, pos, 66)
END
ELSE
PARS.check(~PROG.isOpenArray(e.type), pos, 66);
PARS.check(assigncomp(e, p.type), pos, 66);
PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66);
PARS.check(assigncomp(e, p.type), parser, pos, 66);
IF e.obj = eCONST THEN
IF e.type = tREAL THEN
IL.Float(ARITH.Float(e.value));
IL.pushf
IF e.type.typ = PROG.tREAL THEN
CODE.Float(ARITH.Float(e.value));
CODE.pushf
ELSIF e.type.typ = PROG.tNIL THEN
IL.Const(0);
IL.Param1
ELSIF isStringW1(e) & (p.type = tWCHAR) THEN
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
IL.Param1
CODE.AddCmd(CODE.opCONST, 0);
CODE.AddCmd(CODE.opPARAM, 1)
ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN
CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s));
CODE.AddCmd(CODE.opPARAM, 1)
ELSIF (e.type.typ = PROG.tSTRING) OR
(e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
IF p.type.base = tCHAR THEN
stroffs := String(e);
IL.StrAdr(stroffs);
IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
ERRORS.WarningMsg(pos.line, pos.col, 0)
END
CODE.SetMinDataSize(p.type.size);
IF p.type.base.typ = PROG.tCHAR THEN
CODE.AddCmd(CODE.opSADR, String(e))
ELSE (* WCHAR *)
stroffs := StringW(e);
IL.StrAdr(stroffs)
CODE.AddCmd(CODE.opSADR, StringW(e))
END;
IL.codes.dmin := stroffs + p.type.size;
IL.Param1
CODE.AddCmd(CODE.opPARAM, 1)
ELSE
LoadConst(e);
IL.Param1
CODE.AddCmd(CODE.opPARAM, 1)
END
ELSIF e.obj = ePROC THEN
PARS.check(e.ident.global, pos, 85);
IL.PushProc(e.ident.proc.label);
IL.Param1
PARS.check(e.ident.global, parser, pos, 85);
CODE.PushProc(e.ident.proc.label);
CODE.AddCmd(CODE.opPARAM, 1)
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import);
IL.Param1
ELSIF isExpr(e) & (e.type = tREAL) THEN
IL.pushf
CODE.PushImpProc(e.ident.import);
CODE.AddCmd(CODE.opPARAM, 1)
ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN
CODE.pushf
ELSE
IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN
IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN
CheckRange(256, pos.line, errBYTE)
END;
IL.Param1
CODE.AddCmd(CODE.opPARAM, 1)
END
END
669,16 → 648,10
END paramcomp;
PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
BEGIN
parser.expression(parser, e)
END PExpression;
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
e2: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
proc: INTEGER;
label: INTEGER;
n, i: INTEGER;
686,17 → 659,16
e1: PARS.EXPR;
wchar: BOOLEAN;
cmd1,
cmd2: IL.COMMAND;
comma: BOOLEAN;
cmd2: CODE.COMMAND;
PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
BEGIN
parser.designator(parser, e);
PARS.check(isVar(e), pos, 93);
PARS.check(isfunc(e), pos, 66);
PARS.check(isVar(e), parser, pos, 93);
PARS.check(isfunc(e), parser, pos, 66);
IF readOnly THEN
PARS.check(~e.readOnly, pos, 94)
PARS.check(~e.readOnly, parser, pos, 94)
END
END varparam;
719,18 → 691,13
BEGIN
ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
proc := e.stproc;
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
PARS.checklex(parser, SCAN.lxLROUND);
PARS.Next(parser);
(* END; *)
getpos(parser, pos);
proc := e.stproc;
IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
IF parser.unit.scopeLvl > 0 THEN
parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE
parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE
END
END;
738,93 → 705,90
CASE proc OF
|PROG.stASSERT:
PExpression(parser, e);
PARS.check(isBoolean(e), pos, 66);
parser.expression(parser, e);
PARS.check(isBoolean(e), parser, pos, 66);
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
IL.OnError(pos.line, errASSERT)
CODE.OnError(pos.line, errASSERT)
END
ELSE
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJE, label);
IL.OnError(pos.line, errASSERT);
IL.SetLabel(label)
label := CODE.NewLabel();
CODE.AddJmpCmd(CODE.opJE, label);
CODE.OnError(pos.line, errASSERT);
CODE.SetLabel(label)
END
|PROG.stINC, PROG.stDEC:
IL.pushBegEnd(begcall, endcall);
CODE.pushBegEnd(begcall, endcall);
varparam(parser, pos, isInt, TRUE, e);
IF e.type = tINTEGER THEN
IF e.type.typ = PROG.tINTEGER THEN
IF parser.sym = SCAN.lxCOMMA THEN
NextPos(parser, pos);
IL.setlast(begcall);
PExpression(parser, e2);
IL.setlast(endcall.prev(IL.COMMAND));
PARS.check(isInt(e2), pos, 66);
CODE.setlast(begcall);
parser.expression(parser, e2);
CODE.setlast(endcall.prev(CODE.COMMAND));
PARS.check(isInt(e2), parser, pos, 66);
IF e2.obj = eCONST THEN
IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
ELSE
IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC))
END
ELSE
IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC))
END
ELSE (* e.type = tBYTE *)
ELSE (* e.type.typ = PROG.tBYTE *)
IF parser.sym = SCAN.lxCOMMA THEN
NextPos(parser, pos);
IL.setlast(begcall);
PExpression(parser, e2);
IL.setlast(endcall.prev(IL.COMMAND));
PARS.check(isInt(e2), pos, 66);
CODE.setlast(begcall);
parser.expression(parser, e2);
CODE.setlast(endcall.prev(CODE.COMMAND));
PARS.check(isInt(e2), parser, pos, 66);
IF e2.obj = eCONST THEN
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
ELSE
IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC))
END
ELSE
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC))
END
END;
IL.popBegEnd(begcall, endcall)
CODE.popBegEnd(begcall, endcall)
|PROG.stINCL, PROG.stEXCL:
IL.pushBegEnd(begcall, endcall);
CODE.pushBegEnd(begcall, endcall);
varparam(parser, pos, isSet, TRUE, e);
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
IL.setlast(begcall);
PExpression(parser, e2);
IL.setlast(endcall.prev(IL.COMMAND));
PARS.check(isInt(e2), pos, 66);
CODE.setlast(begcall);
parser.expression(parser, e2);
CODE.setlast(endcall.prev(CODE.COMMAND));
PARS.check(isInt(e2), parser, pos, 66);
IF e2.obj = eCONST THEN
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56);
CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
ELSE
IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL))
END;
IL.popBegEnd(begcall, endcall)
CODE.popBegEnd(begcall, endcall)
|PROG.stNEW:
varparam(parser, pos, isPtr, TRUE, e);
IF CPU = cpuMSP430 THEN
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63)
END;
IL.New(e.type.base.size, e.type.base.num)
CODE.New(e.type.base.size, e.type.base.num)
|PROG.stDISPOSE:
varparam(parser, pos, isPtr, TRUE, e);
IL.AddCmd0(IL.opDISP)
CODE.AddCmd0(CODE.opDISP)
|PROG.stPACK:
varparam(parser, pos, isReal, TRUE, e);
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
PExpression(parser, e2);
PARS.check(isInt(e2), pos, 66);
parser.expression(parser, e2);
PARS.check(isInt(e2), parser, pos, 66);
IF e2.obj = eCONST THEN
IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value))
ELSE
IL.AddCmd0(IL.opPACK)
CODE.AddCmd0(CODE.opPACK)
END
|PROG.stUNPK:
832,26 → 796,24
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
varparam(parser, pos, isInteger, TRUE, e2);
IL.AddCmd0(IL.opUNPK)
CODE.AddCmd0(CODE.opUNPK)
|PROG.stCOPY:
IL.pushBegEnd(begcall, endcall);
PExpression(parser, e);
parser.expression(parser, e);
IF isString(e) OR isCharArray(e) THEN
wchar := FALSE
ELSIF isStringW(e) OR isCharArrayW(e) THEN
wchar := TRUE
ELSE
PARS.error(pos, 66)
PARS.check(FALSE, parser, pos, 66)
END;
IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
IL.Const(e.type.length)
CODE.AddCmd(CODE.opCONST, e.type.length)
END;
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
IL.setlast(begcall);
IF wchar THEN
varparam(parser, pos, isCharArrayW, TRUE, e1)
862,96 → 824,96
varparam(parser, pos, isCharArray, TRUE, e1)
END;
wchar := e1.type.base = tWCHAR
wchar := e1.type.base.typ = PROG.tWCHAR
END;
IF ~PROG.isOpenArray(e1.type) THEN
IL.Const(e1.type.length)
CODE.AddCmd(CODE.opCONST, e1.type.length)
END;
IL.setlast(endcall.prev(IL.COMMAND));
IF e.obj = eCONST THEN
IF wchar THEN
IL.StrAdr(StringW(e));
IL.Const(utf8strlen(e) + 1)
CODE.AddCmd(CODE.opSADR, StringW(e));
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1)
ELSE
IL.StrAdr(String(e));
IL.Const(strlen(e) + 1)
CODE.AddCmd(CODE.opSADR, String(e));
CODE.AddCmd(CODE.opCONST, strlen(e) + 1)
END;
CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size)
ELSE
CODE.AddCmd(CODE.opCOPYS, e1.type.base.size)
END
END;
IL.AddCmd(IL.opCOPYS, e1.type.base.size);
IL.popBegEnd(begcall, endcall)
|PROG.sysGET:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
LoadConst(e)
END;
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
parser.designator(parser, e2);
PARS.check(isVar(e2), pos, 93);
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
IF e.obj = eCONST THEN
IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size)
ELSE
IL.AddCmd(IL.opGET, e2.type.size)
END
PARS.check(isVar(e2), parser, pos, 93);
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
CODE.SysGet(e2.type.size)
|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
IL.pushBegEnd(begcall, endcall);
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
CODE.pushBegEnd(begcall, endcall);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
LoadConst(e)
END;
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
IL.setlast(begcall);
PExpression(parser, e2);
PARS.check(isExpr(e2), pos, 66);
CODE.setlast(begcall);
parser.expression(parser, e2);
PARS.check(isExpr(e2), parser, pos, 66);
IF proc = PROG.sysPUT THEN
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
IF e2.obj = eCONST THEN
IF e2.type = tREAL THEN
IL.setlast(endcall.prev(IL.COMMAND));
IL.Float(ARITH.Float(e2.value));
IL.savef
IF e2.type.typ = PROG.tREAL THEN
CODE.setlast(endcall.prev(CODE.COMMAND));
CODE.Float(ARITH.Float(e2.value));
CODE.savef
ELSE
LoadConst(e2);
IL.setlast(endcall.prev(IL.COMMAND));
IL.SysPut(e2.type.size)
CODE.setlast(endcall.prev(CODE.COMMAND));
CODE.SysPut(e2.type.size)
END
ELSE
IL.setlast(endcall.prev(IL.COMMAND));
IF e2.type = tREAL THEN
IL.savef
ELSIF e2.type = tBYTE THEN
IL.SysPut(tINTEGER.size)
CODE.setlast(endcall.prev(CODE.COMMAND));
IF e2.type.typ = PROG.tREAL THEN
CODE.savef
ELSIF e2.type.typ = PROG.tBYTE THEN
CODE.SysPut(PARS.program.stTypes.tINTEGER.size)
ELSE
IL.SysPut(e2.type.size)
CODE.SysPut(e2.type.size)
END
END
ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, pos, 66);
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66);
IF e2.obj = eCONST THEN
LoadConst(e2)
END;
IL.setlast(endcall.prev(IL.COMMAND));
CASE proc OF
|PROG.sysPUT8: IL.SysPut(1)
|PROG.sysPUT16: IL.SysPut(2)
|PROG.sysPUT32: IL.SysPut(4)
CODE.setlast(endcall.prev(CODE.COMMAND));
IF proc = PROG.sysPUT8 THEN
CODE.SysPut(1)
ELSIF proc = PROG.sysPUT16 THEN
CODE.SysPut(2)
ELSIF proc = PROG.sysPUT32 THEN
CODE.SysPut(4)
END
END;
IL.popBegEnd(begcall, endcall)
CODE.popBegEnd(begcall, endcall)
|PROG.sysMOVE:
FOR i := 1 TO 2 DO
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
LoadConst(e)
END;
959,20 → 921,20
NextPos(parser, pos)
END;
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
LoadConst(e)
END;
IL.AddCmd0(IL.opMOVE)
CODE.AddCmd0(CODE.opMOVE)
|PROG.sysCOPY:
FOR i := 1 TO 2 DO
parser.designator(parser, e);
PARS.check(isVar(e), pos, 93);
PARS.check(isVar(e), parser, pos, 93);
n := PROG.Dim(e.type);
WHILE n > 0 DO
IL.drop;
CODE.drop;
DEC(n)
END;
PARS.checklex(parser, SCAN.lxCOMMA);
979,43 → 941,27
NextPos(parser, pos)
END;
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
LoadConst(e)
END;
IL.AddCmd0(IL.opMOVE)
CODE.AddCmd0(CODE.opMOVE)
|PROG.sysCODE:
REPEAT
getpos(parser, pos);
PARS.ConstExpression(parser, code);
PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
IF CPU # cpuMSP430 THEN
PARS.check(ARITH.range(code, 0, 255), pos, 42)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
IF comma THEN
PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43);
PARS.check(ARITH.range(code, 0, 255), parser, pos, 42);
IF parser.sym = SCAN.lxCOMMA THEN
PARS.Next(parser)
ELSE
PARS.checklex(parser, SCAN.lxRROUND)
END
UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
(*
|PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
IF parser.sym = SCAN.lxLROUND THEN
PARS.Next(parser);
PARS.checklex(parser, SCAN.lxRROUND);
PARS.Next(parser)
END;
ASSERT(CPU = cpuMSP430);
CASE proc OF
|PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H)
|PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
|PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
END
*)
CODE.AddCmd(CODE.opCODE, ARITH.getInt(code))
UNTIL parser.sym = SCAN.lxRROUND
END;
e.obj := eEXPR;
1025,129 → 971,129
CASE e.stproc OF
|PROG.stABS:
PExpression(parser, e);
PARS.check(isInt(e) OR isReal(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e) OR isReal(e), parser, pos, 66);
IF e.obj = eCONST THEN
PARS.check(ARITH.abs(e.value), pos, 39)
PARS.check(ARITH.abs(e.value), parser, pos, 39)
ELSE
IL.abs(isReal(e))
CODE.abs(isReal(e))
END
|PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
PARS.checklex(parser, SCAN.lxCOMMA);
NextPos(parser, pos);
PExpression(parser, e2);
PARS.check(isInt(e2), pos, 66);
e.type := tINTEGER;
parser.expression(parser, e2);
PARS.check(isInt(e2), parser, pos, 66);
e.type := PARS.program.stTypes.tINTEGER;
IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
ELSE
IF e.obj = eCONST THEN
IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
ELSIF e2.obj = eCONST THEN
IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
ELSE
IL.shift_minmax(shift_minmax(proc))
CODE.shift_minmax(shift_minmax(proc))
END;
e.obj := eEXPR
END
|PROG.stCHR:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tCHAR;
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
e.type := PARS.program.stTypes.tCHAR;
IF e.obj = eCONST THEN
ARITH.setChar(e.value, ARITH.getInt(e.value));
PARS.check(ARITH.check(e.value), pos, 107)
PARS.check(ARITH.check(e.value), parser, pos, 107)
ELSE
IF chkCHR IN Options.checking THEN
IF chkCHR IN checking THEN
CheckRange(256, pos.line, errCHR)
ELSE
IL.AddCmd0(IL.opCHR)
CODE.AddCmd0(CODE.opCHR)
END
END
|PROG.stWCHR:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tWCHAR;
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
e.type := PARS.program.stTypes.tWCHAR;
IF e.obj = eCONST THEN
ARITH.setWChar(e.value, ARITH.getInt(e.value));
PARS.check(ARITH.check(e.value), pos, 101)
PARS.check(ARITH.check(e.value), parser, pos, 101)
ELSE
IF chkWCHR IN Options.checking THEN
IF chkWCHR IN checking THEN
CheckRange(65536, pos.line, errWCHR)
ELSE
IL.AddCmd0(IL.opWCHR)
CODE.AddCmd0(CODE.opWCHR)
END
END
|PROG.stFLOOR:
PExpression(parser, e);
PARS.check(isReal(e), pos, 66);
e.type := tINTEGER;
parser.expression(parser, e);
PARS.check(isReal(e), parser, pos, 66);
e.type := PARS.program.stTypes.tINTEGER;
IF e.obj = eCONST THEN
PARS.check(ARITH.floor(e.value), pos, 39)
PARS.check(ARITH.floor(e.value), parser, pos, 39)
ELSE
IL.floor
CODE.floor
END
|PROG.stFLT:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tREAL;
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
e.type := PARS.program.stTypes.tREAL;
IF e.obj = eCONST THEN
ARITH.flt(e.value)
ELSE
PARS.check(IL.flt(), pos, 41)
PARS.check(CODE.flt(), parser, pos, 41)
END
|PROG.stLEN:
cmd1 := IL.getlast();
cmd1 := CODE.getlast();
varparam(parser, pos, isArr, FALSE, e);
IF e.type.length > 0 THEN
cmd2 := IL.getlast();
IL.delete2(cmd1.next, cmd2);
IL.setlast(cmd1);
cmd2 := CODE.getlast();
CODE.delete2(cmd1.next, cmd2);
CODE.setlast(cmd1);
ASSERT(ARITH.setInt(e.value, e.type.length));
e.obj := eCONST
ELSE
IL.len(PROG.Dim(e.type))
CODE.len(PROG.Dim(e.type))
END;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
|PROG.stLENGTH:
PExpression(parser, e);
parser.expression(parser, e);
IF isCharArray(e) THEN
IF e.type.length > 0 THEN
IL.Const(e.type.length)
CODE.AddCmd(CODE.opCONST, e.type.length)
END;
IL.AddCmd0(IL.opLENGTH)
CODE.AddCmd0(CODE.opLENGTH)
ELSIF isCharArrayW(e) THEN
IF e.type.length > 0 THEN
IL.Const(e.type.length)
CODE.AddCmd(CODE.opCONST, e.type.length)
END;
IL.AddCmd0(IL.opLENGTHW)
CODE.AddCmd0(CODE.opLENGTHW)
ELSE
PARS.error(pos, 66);
PARS.check(FALSE, parser, pos, 66);
END;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
|PROG.stODD:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
e.type := tBOOLEAN;
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
e.type := PARS.program.stTypes.tBOOLEAN;
IF e.obj = eCONST THEN
ARITH.odd(e.value)
ELSE
IL.odd
CODE.odd
END
|PROG.stORD:
PExpression(parser, e);
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
parser.expression(parser, e);
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66);
IF e.obj = eCONST THEN
IF isStringW1(e) THEN
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
1156,18 → 1102,18
END
ELSE
IF isBoolean(e) THEN
IL.ord
CODE.ord
END
END;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
|PROG.stBITS:
PExpression(parser, e);
PARS.check(isInt(e), pos, 66);
parser.expression(parser, e);
PARS.check(isInt(e), parser, pos, 66);
IF e.obj = eCONST THEN
ARITH.bits(e.value)
END;
e.type := tSET
e.type := PARS.program.stTypes.tSET
|PROG.sysADR:
parser.designator(parser, e);
1174,65 → 1120,63
IF isVar(e) THEN
n := PROG.Dim(e.type);
WHILE n > 0 DO
IL.drop;
CODE.drop;
DEC(n)
END
ELSIF e.obj = ePROC THEN
IL.PushProc(e.ident.proc.label)
CODE.PushProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import)
CODE.PushImpProc(e.ident.import)
ELSE
PARS.error(pos, 108)
PARS.check(FALSE, parser, pos, 108)
END;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
|PROG.sysSADR:
PExpression(parser, e);
PARS.check(isString(e), pos, 66);
IL.StrAdr(String(e));
e.type := tINTEGER;
parser.expression(parser, e);
PARS.check(isString(e), parser, pos, 66);
CODE.AddCmd(CODE.opSADR, String(e));
e.type := PARS.program.stTypes.tINTEGER;
e.obj := eEXPR
|PROG.sysWSADR:
PExpression(parser, e);
PARS.check(isStringW(e), pos, 66);
IL.StrAdr(StringW(e));
e.type := tINTEGER;
parser.expression(parser, e);
PARS.check(isStringW(e), parser, pos, 66);
CODE.AddCmd(CODE.opSADR, StringW(e));
e.type := PARS.program.stTypes.tINTEGER;
e.obj := eEXPR
|PROG.sysTYPEID:
PExpression(parser, e);
PARS.check(e.obj = eTYPE, pos, 68);
parser.expression(parser, e);
PARS.check(e.obj = eTYPE, parser, pos, 68);
IF e.type.typ = PROG.tRECORD THEN
ASSERT(ARITH.setInt(e.value, e.type.num))
ELSIF e.type.typ = PROG.tPOINTER THEN
ASSERT(ARITH.setInt(e.value, e.type.base.num))
ELSE
PARS.error(pos, 52)
PARS.check(FALSE, parser, pos, 52)
END;
e.obj := eCONST;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
|PROG.sysINF:
PARS.check(IL.inf(), pos, 41);
PARS.check(CODE.inf(), parser, pos, 41);
e.obj := eEXPR;
e.type := tREAL
e.type := PARS.program.stTypes.tREAL
|PROG.sysSIZE:
PExpression(parser, e);
PARS.check(e.obj = eTYPE, pos, 68);
parser.expression(parser, e);
PARS.check(e.obj = eTYPE, parser, pos, 68);
ASSERT(ARITH.setInt(e.value, e.type.size));
e.obj := eCONST;
e.type := tINTEGER
e.type := PARS.program.stTypes.tINTEGER
END
END;
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
PARS.checklex(parser, SCAN.lxRROUND);
PARS.Next(parser);
(* END; *)
IF e.obj # eCONST THEN
e.obj := eEXPR
1246,7 → 1190,7
proc: PROG.TYPE_;
param: LISTS.ITEM;
e1: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
BEGIN
ASSERT(parser.sym = SCAN.lxLROUND);
1260,12 → 1204,12
WHILE param # NIL DO
getpos(parser, pos);
IL.setlast(begcall);
CODE.setlast(begcall);
IF param(PROG.PARAM).vPar THEN
parser.designator(parser, e1)
ELSE
PExpression(parser, e1)
parser.expression(parser, e1)
END;
paramcomp(parser, pos, e1, param(PROG.PARAM));
param := param.next;
1282,6 → 1226,7
e.type := proc.base
ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
PARS.Next(parser);
stProc(parser, e)
ELSE
PARS.check1(FALSE, parser, 86)
1294,18 → 1239,18
VAR
ident: PROG.IDENT;
import: BOOLEAN;
pos: PARS.POSITION;
pos: SCAN.POSITION;
BEGIN
PARS.checklex(parser, SCAN.lxIDENT);
getpos(parser, pos);
import := FALSE;
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
PARS.check1(ident # NIL, parser, 48);
IF ident.typ = PROG.idMODULE THEN
PARS.ExpectSym(parser, SCAN.lxPOINT);
PARS.ExpectSym(parser, SCAN.lxIDENT);
ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
ident := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE);
PARS.check1((ident # NIL) & ident.export, parser, 48);
import := TRUE
END;
1353,34 → 1298,34
e.obj := eSYSPROC;
e.stproc := ident.stproc
|PROG.idSYSFUNC:
PARS.check(~parser.constexp, pos, 109);
PARS.check(~parser.constexp, parser, pos, 109);
e.obj := eSYSFUNC;
e.stproc := ident.stproc
|PROG.idNONE:
PARS.error(pos, 115)
PARS.check(FALSE, parser, pos, 115)
END;
IF isVar(e) THEN
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105)
END
END qualident;
PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
VAR
label: INTEGER;
BEGIN
IF load THEN
IL.load(e.type.size)
CODE.load(e.type.size)
END;
IF chkPTR IN Options.checking THEN
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJNZ, label);
IL.OnError(pos.line, error);
IL.SetLabel(label)
IF chkPTR IN checking THEN
label := CODE.NewLabel();
CODE.AddJmpCmd(CODE.opJNZ, label);
CODE.OnError(pos.line, error);
CODE.SetLabel(label)
END
END deref;
1388,7 → 1333,7
PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
field: PROG.FIELD;
pos: PARS.POSITION;
pos: SCAN.POSITION;
t, idx: PARS.EXPR;
1403,7 → 1348,7
offset := e.ident.offset;
n := PROG.Dim(e.type);
WHILE n >= 0 DO
IL.AddCmd(IL.opVADR, offset);
CODE.AddCmd(CODE.opVADR, offset);
DEC(offset);
DEC(n)
END
1414,29 → 1359,29
IF e.obj = eVAR THEN
offset := PROG.getOffset(PARS.program, e.ident);
IF e.ident.global THEN
IL.AddCmd(IL.opGADR, offset)
CODE.AddCmd(CODE.opGADR, offset)
ELSE
IL.AddCmd(IL.opLADR, -offset)
CODE.AddCmd(CODE.opLADR, -offset)
END
ELSIF e.obj = ePARAM THEN
IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN
IL.AddCmd(IL.opVADR, e.ident.offset)
CODE.AddCmd(CODE.opVADR, e.ident.offset)
ELSIF PROG.isOpenArray(e.type) THEN
OpenArray(e)
ELSE
IL.AddCmd(IL.opLADR, e.ident.offset)
CODE.AddCmd(CODE.opLADR, e.ident.offset)
END
ELSIF e.obj IN {eVPAR, eVREC} THEN
IF PROG.isOpenArray(e.type) THEN
OpenArray(e)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset)
CODE.AddCmd(CODE.opVADR, e.ident.offset)
END
END
END LoadAdr;
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR);
VAR
label: INTEGER;
type: PROG.TYPE_;
1444,30 → 1389,30
BEGIN
IF chkIDX IN Options.checking THEN
label := IL.NewLabel();
IL.AddCmd2(IL.opCHKIDX2, label, 0);
IL.OnError(pos.line, errIDX);
IL.SetLabel(label)
IF chkIDX IN checking THEN
label := CODE.NewLabel();
CODE.AddCmd2(CODE.opCHKIDX2, label, 0);
CODE.OnError(pos.line, errIDX);
CODE.SetLabel(label)
ELSE
IL.AddCmd(IL.opCHKIDX2, -1)
CODE.AddCmd(CODE.opCHKIDX2, -1)
END;
type := PROG.OpenBase(e.type);
IF type.size # 1 THEN
IL.AddCmd(IL.opMULC, type.size)
CODE.AddCmd(CODE.opMULC, type.size)
END;
n := PROG.Dim(e.type) - 1;
k := n;
WHILE n > 0 DO
IL.AddCmd0(IL.opMUL);
CODE.AddCmd0(CODE.opMUL);
DEC(n)
END;
IL.AddCmd0(IL.opADD);
CODE.AddCmd0(CODE.opADD);
offset := e.ident.offset - 1;
n := k;
WHILE n > 0 DO
IL.AddCmd(IL.opVADR, offset);
CODE.AddCmd(CODE.opVADR, offset);
DEC(offset);
DEC(n)
END
1496,7 → 1441,7
e.type := e.type.base;
e.readOnly := FALSE
END;
field := PROG.getField(e.type, parser.lex.ident, parser.unit);
field := e.type.fields.get(e.type, parser.lex.ident, parser.unit);
PARS.check1(field # NIL, parser, 74);
e.type := field.type;
IF e.obj = eVREC THEN
1503,7 → 1448,7
e.obj := eVPAR
END;
IF field.offset # 0 THEN
IL.AddCmd(IL.opADDR, field.offset)
CODE.AddCmd(CODE.opADDR, field.offset)
END;
PARS.Next(parser);
e.ident := NIL
1514,29 → 1459,29
PARS.check1(isArr(e), parser, 75);
NextPos(parser, pos);
PExpression(parser, idx);
PARS.check(isInt(idx), pos, 76);
parser.expression(parser, idx);
PARS.check(isInt(idx), parser, pos, 76);
IF idx.obj = eCONST THEN
IF e.type.length > 0 THEN
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83);
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83);
IF ARITH.Int(idx.value) > 0 THEN
IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size)
CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size)
END
ELSE
PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83);
LoadConst(idx);
OpenIdx(parser, pos, e)
END
ELSE
IF e.type.length > 0 THEN
IF chkIDX IN Options.checking THEN
IF chkIDX IN checking THEN
CheckRange(e.type.length, pos.line, errIDX)
END;
IF e.type.base.size # 1 THEN
IL.AddCmd(IL.opMULC, e.type.base.size)
CODE.AddCmd(CODE.opMULC, e.type.base.size)
END;
IL.AddCmd0(IL.opADD)
CODE.AddCmd0(CODE.opADD)
ELSE
OpenIdx(parser, pos, e)
END
1567,26 → 1512,26
END;
NextPos(parser, pos);
qualident(parser, t);
PARS.check(t.obj = eTYPE, pos, 79);
PARS.check(t.obj = eTYPE, parser, pos, 79);
IF e.type.typ = PROG.tRECORD THEN
PARS.check(t.type.typ = PROG.tRECORD, pos, 80);
IF chkGUARD IN Options.checking THEN
PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80);
IF chkGUARD IN checking THEN
IF e.ident = NIL THEN
IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD)
CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD)
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD)
END
END;
ELSE
PARS.check(t.type.typ = PROG.tPOINTER, pos, 81);
IF chkGUARD IN Options.checking THEN
IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD)
PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81);
IF chkGUARD IN checking THEN
CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD)
END
END;
PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82);
PARS.check(PROG.isBaseOf(e.type, t.type), parser, pos, 82);
e.type := t.type;
1598,69 → 1543,69
END designator;
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.POSITION; CallStat: BOOLEAN);
VAR
cconv: INTEGER;
parSize: INTEGER;
params: INTEGER;
callconv: INTEGER;
fparSize: INTEGER;
fparams: INTEGER;
int, flt: INTEGER;
stk_par: INTEGER;
BEGIN
cconv := procType.call;
parSize := procType.parSize;
params := procType.params.size;
IF cconv IN {PROG._win64, PROG.win64} THEN
callconv := IL.call_win64;
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
callconv := CODE.call_win64;
fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4)
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
callconv := IL.call_sysv;
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
callconv := CODE.call_sysv;
fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params;
stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
ELSE
callconv := IL.call_stack;
fparSize := 0
callconv := CODE.call_stack;
fparams := 0
END;
IL.setlast(begcall);
fregs := IL.precall(isfloat);
CODE.setlast(begcall);
fregs := CODE.precall(isfloat);
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
IL.AddCmd(IL.opALIGN16, parSize)
CODE.AddCmd(CODE.opALIGN16, params)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
IL.AddCmd(IL.opWIN64ALIGN16, parSize)
CODE.AddCmd(CODE.opWIN64ALIGN16, params)
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par)
END;
IL.setlast(endcall.prev(IL.COMMAND));
CODE.setlast(endcall.prev(CODE.COMMAND));
IF e.obj = eIMP THEN
IL.CallImp(e.ident.import, callconv, fparSize)
CODE.CallImp(e.ident.import, callconv, fparams)
ELSIF e.obj = ePROC THEN
IL.Call(e.ident.proc.label, callconv, fparSize)
CODE.Call(e.ident.proc.label, callconv, fparams)
ELSIF isExpr(e) THEN
deref(pos, e, CallStat, errPROC);
IL.CallP(callconv, fparSize)
CODE.CallP(callconv, fparams)
END;
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
IL.AddCmd(IL.opCLEANUP, parSize);
IL.AddCmd0(IL.opPOPSP)
CODE.AddCmd(CODE.opCLEANUP, params);
CODE.AddCmd0(CODE.opPOPSP)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
IL.AddCmd0(IL.opPOPSP)
CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1);
CODE.AddCmd0(CODE.opPOPSP)
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
IL.AddCmd(IL.opCLEANUP, parSize)
CODE.AddCmd(CODE.opCLEANUP, params + stk_par);
CODE.AddCmd0(CODE.opPOPSP)
ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN
CODE.AddCmd(CODE.opCLEANUP, params)
END;
IF ~CallStat THEN
IF isfloat THEN
PARS.check(IL.resf(fregs), pos, 41)
PARS.check(CODE.resf(fregs), parser, pos, 41)
ELSE
IL.res(fregs)
CODE.res(fregs)
END
END
END ProcCall;
1668,7 → 1613,7
PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
pos, pos0, pos1: PARS.POSITION;
pos, pos0, pos1: SCAN.POSITION;
op: INTEGER;
e1: PARS.EXPR;
1701,7 → 1646,7
PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
e1, e2: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
range: BOOLEAN;
BEGIN
1708,10 → 1653,10
range := FALSE;
getpos(parser, pos);
expression(parser, e1);
PARS.check(isInt(e1), pos, 76);
PARS.check(isInt(e1), parser, pos, 76);
IF e1.obj = eCONST THEN
PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44)
END;
range := parser.sym = SCAN.lxRANGE;
1719,10 → 1664,10
IF range THEN
NextPos(parser, pos);
expression(parser, e2);
PARS.check(isInt(e2), pos, 76);
PARS.check(isInt(e2), parser, pos, 76);
IF e2.obj = eCONST THEN
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44)
END
ELSE
IF e1.obj = eCONST THEN
1730,7 → 1675,7
END
END;
e.type := tSET;
e.type := PARS.program.stTypes.tSET;
IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
ARITH.constrSet(e.value, e1.value, e2.value);
1738,14 → 1683,14
ELSE
IF range THEN
IF e1.obj = eCONST THEN
IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value))
ELSIF e2.obj = eCONST THEN
IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value))
ELSE
IL.AddCmd0(IL.opRSET)
CODE.AddCmd0(CODE.opRSET)
END
ELSE
IL.AddCmd0(IL.opRSET1)
CODE.AddCmd0(CODE.opRSET1)
END;
e.obj := eEXPR
END
1761,7 → 1706,7
ASSERT(parser.sym = SCAN.lxLCURLY);
e.obj := eCONST;
e.type := tSET;
e.type := PARS.program.stTypes.tSET;
ARITH.emptySet(e.value);
PARS.Next(parser);
1781,11 → 1726,11
ARITH.opSet(e.value, e1.value, "+")
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDSL, ARITH.Int(e.value))
CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADDS)
CODE.AddCmd0(CODE.opADDS)
END;
e.obj := eEXPR
END
1799,19 → 1744,19
PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
sym: INTEGER;
pos: PARS.POSITION;
pos: SCAN.POSITION;
e1: PARS.EXPR;
isfloat: BOOLEAN;
fregs: INTEGER;
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION);
BEGIN
IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
IF e.type = tREAL THEN
PARS.check(IL.loadf(), pos, 41)
IF e.type.typ = PROG.tREAL THEN
PARS.check(CODE.loadf(), parser, pos, 41)
ELSE
IL.load(e.type.size)
CODE.load(e.type.size)
END
END
END LoadVar;
1823,7 → 1768,7
IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
e.obj := eCONST;
e.value := parser.lex.value;
e.type := PROG.getType(PARS.program, e.value.typ);
e.type := PARS.program.getType(PARS.program, e.value.typ);
PARS.Next(parser)
ELSIF sym = SCAN.lxNIL THEN
1834,7 → 1779,7
ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
e.obj := eCONST;
ARITH.setbool(e.value, sym = SCAN.lxTRUE);
e.type := tBOOLEAN;
e.type := PARS.program.stTypes.tBOOLEAN;
PARS.Next(parser)
ELSIF sym = SCAN.lxLCURLY THEN
1843,7 → 1788,7
ELSIF sym = SCAN.lxIDENT THEN
getpos(parser, pos);
IL.pushBegEnd(begcall, endcall);
CODE.pushBegEnd(begcall, endcall);
designator(parser, e);
IF isVar(e) THEN
1852,8 → 1797,8
IF parser.sym = SCAN.lxLROUND THEN
e1 := e;
ActualParameters(parser, e);
PARS.check(e.type # NIL, pos, 59);
isfloat := e.type = tREAL;
PARS.check(e.type # NIL, parser, pos, 59);
isfloat := e.type.typ = PROG.tREAL;
IF e1.obj IN {ePROC, eIMP} THEN
ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
ELSIF isExpr(e1) THEN
1860,7 → 1805,7
ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
END
END;
IL.popBegEnd(begcall, endcall)
CODE.popBegEnd(begcall, endcall)
ELSIF sym = SCAN.lxLROUND THEN
PARS.Next(parser);
1874,9 → 1819,9
ELSIF sym = SCAN.lxNOT THEN
NextPos(parser, pos);
factor(parser, e);
PARS.check(isBoolean(e), pos, 72);
PARS.check(isBoolean(e), parser, pos, 72);
IF e.obj # eCONST THEN
IL.not;
CODE.not;
e.obj := eEXPR
ELSE
ASSERT(ARITH.neg(e.value))
1890,7 → 1835,7
PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
pos: PARS.POSITION;
pos: SCAN.POSITION;
op: INTEGER;
e1: PARS.EXPR;
1910,15 → 1855,15
IF ~parser.constexp THEN
IF label = -1 THEN
label := IL.NewLabel()
label := CODE.NewLabel()
END;
IF e.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e.value)))
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
END;
IL.AddCmd0(IL.opACC);
IL.AddJmpCmd(IL.opJZ, label);
IL.drop
CODE.AddCmd0(CODE.opACC);
CODE.AddJmpCmd(CODE.opJZ, label);
CODE.drop
END
END;
1926,12 → 1871,12
CASE op OF
|SCAN.lxMUL:
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
CASE e.value.typ OF
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), parser, pos, 39)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40)
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
END
1938,26 → 1883,26
ELSE
IF isInt(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opMUL)
CODE.AddCmd0(CODE.opMUL)
END
ELSIF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
CODE.Float(ARITH.Float(e.value))
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value))
CODE.Float(ARITH.Float(e1.value))
END;
IL.fbinop(IL.opMULF)
CODE.fbinop(CODE.opMULF)
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opMULS)
CODE.AddCmd0(CODE.opMULS)
END
END;
e.obj := eEXPR
1964,14 → 1909,14
END
|SCAN.lxSLASH:
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
IF (e1.obj = eCONST) & isReal(e1) THEN
PARS.check(~ARITH.isZero(e1.value), pos, 45)
PARS.check(~ARITH.isZero(e1.value), parser, pos, 45)
END;
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
CASE e.value.typ OF
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40)
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
END
1978,21 → 1923,21
ELSE
IF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fbinop(IL.opDIVFI)
CODE.Float(ARITH.Float(e.value));
CODE.fbinop(CODE.opDIVFI)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fbinop(IL.opDIVF)
CODE.Float(ARITH.Float(e1.value));
CODE.fbinop(CODE.opDIVF)
ELSE
IL.fbinop(IL.opDIVF)
CODE.fbinop(CODE.opDIVF)
END
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opDIVS)
CODE.AddCmd0(CODE.opDIVS)
END
END;
e.obj := eEXPR
1999,17 → 1944,14
END
|SCAN.lxDIV, SCAN.lxMOD:
PARS.check(isInt(e) & isInt(e1), pos, 37);
PARS.check(isInt(e) & isInt(e1), parser, pos, 37);
IF e1.obj = eCONST THEN
PARS.check(~ARITH.isZero(e1.value), pos, 46);
IF CPU = cpuMSP430 THEN
PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
END
PARS.check(~ARITH.isZero(e1.value), parser, pos, 46)
END;
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
IF op = SCAN.lxDIV THEN
PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39)
ELSE
ASSERT(ARITH.opInt(e.value, e1.value, "M"))
END
2016,29 → 1958,25
ELSE
IF e1.obj # eCONST THEN
label1 := IL.NewLabel();
IF CPU = cpuMSP430 THEN
IL.AddJmpCmd(IL.opJG, label1)
ELSE
IL.AddJmpCmd(IL.opJNZ, label1)
END
label1 := CODE.NewLabel();
CODE.AddJmpCmd(CODE.opJNZ, label1)
END;
IF e.obj = eCONST THEN
IL.OnError(pos.line, errDIV);
IL.SetLabel(label1);
IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
CODE.OnError(pos.line, errDIV);
CODE.SetLabel(label1);
CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
ELSE
IL.OnError(pos.line, errDIV);
IL.SetLabel(label1);
IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD))
CODE.OnError(pos.line, errDIV);
CODE.SetLabel(label1);
CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD))
END;
e.obj := eEXPR
END
|SCAN.lxAND:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
ARITH.opBoolean(e.value, e1.value, "&")
2045,9 → 1983,9
ELSE
e.obj := eEXPR;
IF e1.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e1.value)))
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
END;
IL.AddCmd0(IL.opACC)
CODE.AddCmd0(CODE.opACC)
END
END
2054,7 → 1992,7
END;
IF label # -1 THEN
IL.SetLabel(label)
CODE.SetLabel(label)
END
END term;
2061,7 → 1999,7
PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
pos: PARS.POSITION;
pos: SCAN.POSITION;
op: INTEGER;
e1: PARS.EXPR;
2081,20 → 2019,20
term(parser, e);
IF plus OR minus THEN
PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);
PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36);
IF minus & (e.obj = eCONST) THEN
PARS.check(ARITH.neg(e.value), pos, 39)
PARS.check(ARITH.neg(e.value), parser, pos, 39)
END;
IF e.obj # eCONST THEN
IF minus THEN
IF isInt(e) THEN
IL.AddCmd0(IL.opUMINUS)
CODE.AddCmd0(CODE.opUMINUS)
ELSIF isReal(e) THEN
IL.AddCmd0(IL.opUMINF)
CODE.AddCmd0(CODE.opUMINF)
ELSIF isSet(e) THEN
IL.AddCmd0(IL.opUMINS)
CODE.AddCmd0(CODE.opUMINS)
END
END;
e.obj := eEXPR
2114,15 → 2052,15
IF ~parser.constexp THEN
IF label = -1 THEN
label := IL.NewLabel()
label := CODE.NewLabel()
END;
IF e.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e.value)))
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
END;
IL.AddCmd0(IL.opACC);
IL.AddJmpCmd(IL.opJNZ, label);
IL.drop
CODE.AddCmd0(CODE.opACC);
CODE.AddJmpCmd(CODE.opJNZ, label);
CODE.drop
END
END;
2138,12 → 2076,12
op := ORD("-")
END;
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
CASE e.value.typ OF
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), parser, pos, 39)
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40)
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
END
2150,29 → 2088,29
ELSE
IF isInt(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADD + ORD(op = ORD("-")))
CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-")))
END
ELSIF isReal(e) THEN
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fbinop(IL.opADDFI + ORD(op = ORD("-")))
CODE.Float(ARITH.Float(e.value));
CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-")))
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
CODE.Float(ARITH.Float(e1.value));
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-")))
ELSE
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-")))
END
ELSIF isSet(e) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opADDS + ORD(op = ORD("-")))
CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-")))
END
END;
e.obj := eEXPR
2179,7 → 2117,7
END
|SCAN.lxOR:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
ARITH.opBoolean(e.value, e1.value, "|")
2186,9 → 2124,9
ELSE
e.obj := eEXPR;
IF e1.obj = eCONST THEN
IL.Const(ORD(ARITH.getBool(e1.value)))
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
END;
IL.AddCmd0(IL.opACC)
CODE.AddCmd0(CODE.opACC)
END
END
2195,7 → 2133,7
END;
IF label # -1 THEN
IL.SetLabel(label)
CODE.SetLabel(label)
END
END SimpleExpression;
2204,7 → 2142,6
PROCEDURE cmpcode (op: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
CASE op OF
|SCAN.lxEQ: res := 0
2219,30 → 2156,12
END cmpcode;
PROCEDURE invcmpcode (op: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
CASE op OF
|SCAN.lxEQ: res := 0
|SCAN.lxNE: res := 1
|SCAN.lxLT: res := 4
|SCAN.lxLE: res := 5
|SCAN.lxGT: res := 2
|SCAN.lxGE: res := 3
END
RETURN res
END invcmpcode;
PROCEDURE BoolCmp (eq, val: BOOLEAN);
BEGIN
IF eq = val THEN
IL.AddCmd0(IL.opNEC)
CODE.AddCmd0(CODE.opNER)
ELSE
IL.AddCmd0(IL.opEQC)
CODE.AddCmd0(CODE.opEQR)
END
END BoolCmp;
2256,40 → 2175,40
res := TRUE;
IF isString(e) & isCharArray(e1) THEN
IL.StrAdr(String(e));
IL.Const(strlen(e) + 1);
IL.AddCmd0(IL.opEQS + invcmpcode(op))
CODE.AddCmd(CODE.opSADR, String(e));
CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
CODE.AddCmd0(CODE.opEQS2 + cmpcode(op))
ELSIF isString(e) & isCharArrayW(e1) THEN
IL.StrAdr(StringW(e));
IL.Const(utf8strlen(e) + 1);
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
CODE.AddCmd(CODE.opSADR, StringW(e));
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
ELSIF isStringW(e) & isCharArrayW(e1) THEN
IL.StrAdr(StringW(e));
IL.Const(utf8strlen(e) + 1);
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
CODE.AddCmd(CODE.opSADR, StringW(e));
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
ELSIF isCharArray(e) & isString(e1) THEN
IL.StrAdr(String(e1));
IL.Const(strlen(e1) + 1);
IL.AddCmd0(IL.opEQS + cmpcode(op))
CODE.AddCmd(CODE.opSADR, String(e1));
CODE.AddCmd(CODE.opCONST, strlen(e1) + 1);
CODE.AddCmd0(CODE.opEQS + cmpcode(op))
ELSIF isCharArrayW(e) & isString(e1) THEN
IL.StrAdr(StringW(e1));
IL.Const(utf8strlen(e1) + 1);
IL.AddCmd0(IL.opEQSW + cmpcode(op))
CODE.AddCmd(CODE.opSADR, StringW(e1));
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
ELSIF isCharArrayW(e) & isStringW(e1) THEN
IL.StrAdr(StringW(e1));
IL.Const(utf8strlen(e1) + 1);
IL.AddCmd0(IL.opEQSW + cmpcode(op))
CODE.AddCmd(CODE.opSADR, StringW(e1));
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
IL.AddCmd0(IL.opEQSW + cmpcode(op))
CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
ELSIF isCharArray(e) & isCharArray(e1) THEN
IL.AddCmd0(IL.opEQS + cmpcode(op))
CODE.AddCmd0(CODE.opEQS + cmpcode(op))
ELSIF isString(e) & isString(e1) THEN
PARS.strcmp(e.value, e1.value, op)
2308,17 → 2227,17
SimpleExpression(parser, e);
IF relation(parser.sym) THEN
IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
IL.Const(e.type.length)
CODE.AddCmd(CODE.opCONST, e.type.length)
END;
op := parser.sym;
getpos(parser, pos);
PARS.Next(parser);
getpos(parser, pos1);
pos1 := parser.lex.pos;
SimpleExpression(parser, e1);
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
IL.Const(e1.type.length)
CODE.AddCmd(CODE.opCONST, e1.type.length)
END;
constant := (e.obj = eCONST) & (e1.obj = eCONST);
2348,19 → 2267,19
ARITH.relation(e.value, e1.value, operator, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op))
END
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
ELSIF isBoolean(e) & isBoolean(e1) THEN
IF constant THEN
2372,9 → 2291,9
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
ELSE
IF op = SCAN.lxEQ THEN
IL.AddCmd0(IL.opEQB)
CODE.AddCmd0(CODE.opEQB)
ELSE
IL.AddCmd0(IL.opNEB)
CODE.AddCmd0(CODE.opNEB)
END
END
END
2384,47 → 2303,50
ARITH.relation(e.value, e1.value, operator, error)
ELSE
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value))
CODE.Float(ARITH.Float(e.value));
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value))
END;
IL.fcmp(IL.opEQF + cmpcode(op))
CODE.Float(ARITH.Float(e1.value));
CODE.fcmp(CODE.opEQF + cmpcode(op))
ELSE
CODE.fcmp(CODE.opEQF + cmpcode(op))
END
END
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
IF ~strcmp(e, e1, op) THEN
PARS.error(pos, 37)
PARS.error(parser, pos, 37)
END
ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
IL.AddCmd0(IL.opEQC + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
ELSIF isProc(e) & isNil(e1) THEN
IF e.obj IN {ePROC, eIMP} THEN
PARS.check(e.ident.global, pos0, 85);
PARS.check(e.ident.global, parser, pos0, 85);
constant := TRUE;
e.obj := eCONST;
ARITH.setbool(e.value, op = SCAN.lxNE)
ELSE
IL.AddCmd0(IL.opEQC + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
END
ELSIF isNil(e) & isProc(e1) THEN
IF e1.obj IN {ePROC, eIMP} THEN
PARS.check(e1.ident.global, pos1, 85);
PARS.check(e1.ident.global, parser, pos1, 85);
constant := TRUE;
e.obj := eCONST;
ARITH.setbool(e.value, op = SCAN.lxNE)
ELSE
IL.AddCmd0(IL.opEQC + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
END
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
IF e.obj = ePROC THEN
PARS.check(e.ident.global, pos0, 85)
PARS.check(e.ident.global, parser, pos0, 85)
END;
IF e1.obj = ePROC THEN
PARS.check(e1.ident.global, pos1, 85)
PARS.check(e1.ident.global, parser, pos1, 85)
END;
IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
constant := TRUE;
2435,15 → 2357,15
ARITH.setbool(e.value, e.ident # e1.ident)
END
ELSIF e.obj = ePROC THEN
IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ)
CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0)
ELSIF e1.obj = ePROC THEN
IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ)
CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0)
ELSIF e.obj = eIMP THEN
IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ)
CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0)
ELSIF e1.obj = eIMP THEN
IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ)
CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0)
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op))
END
ELSIF isNil(e) & isNil(e1) THEN
2452,7 → 2374,7
ARITH.setbool(e.value, op = SCAN.lxEQ)
ELSE
PARS.error(pos, 37)
PARS.error(parser, pos, 37)
END
|SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
2465,19 → 2387,19
ARITH.relation(e.value, e1.value, operator, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opEQ + cmpcode(op))
CODE.AddCmd0(CODE.opEQ + cmpcode(op))
END
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
2484,67 → 2406,69
ARITH.relation(e.value, e1.value, operator, error)
ELSE
IF e.obj = eCONST THEN
IL.Float(ARITH.Float(e.value));
IL.fcmp(IL.opEQF + invcmpcode(op))
CODE.Float(ARITH.Float(e.value));
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
ELSIF e1.obj = eCONST THEN
IL.Float(ARITH.Float(e1.value));
IL.fcmp(IL.opEQF + cmpcode(op))
CODE.Float(ARITH.Float(e1.value));
CODE.fcmp(CODE.opEQF + cmpcode(op))
ELSE
IL.fcmp(IL.opEQF + cmpcode(op))
CODE.fcmp(CODE.opEQF + cmpcode(op))
END
END
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
IF ~strcmp(e, e1, op) THEN
PARS.error(pos, 37)
PARS.error(parser, pos, 37)
END
ELSE
PARS.error(pos, 37)
PARS.error(parser, pos, 37)
END
|SCAN.lxIN:
PARS.check(isInt(e) & isSet(e1), pos, 37);
PARS.check(isInt(e) & isSet(e1), parser, pos, 37);
IF e.obj = eCONST THEN
PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56)
END;
IF constant THEN
ARITH.relation(e.value, e1.value, operator, error)
ELSE
IF e.obj = eCONST THEN
IL.AddCmd(IL.opINL, ARITH.Int(e.value))
CODE.AddCmd(CODE.opINL, ARITH.Int(e.value))
ELSIF e1.obj = eCONST THEN
IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value))
ELSE
IL.AddCmd0(IL.opIN)
CODE.AddCmd0(CODE.opIN)
END
END
|SCAN.lxIS:
PARS.check(isRecPtr(e), pos, 73);
PARS.check(e1.obj = eTYPE, pos1, 79);
PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73);
IF e.type.typ = PROG.tRECORD THEN
PARS.check(e.obj = eVREC, parser, pos0, 78)
END;
PARS.check(e1.obj = eTYPE, parser, pos1, 79);
IF isRec(e) THEN
PARS.check(e.obj = eVREC, pos0, 78);
PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80);
IF e.type.typ = PROG.tRECORD THEN
PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80);
IF e.ident = NIL THEN
IL.TypeCheck(e1.type.num)
CODE.TypeCheck(e1.type.num)
ELSE
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
IL.TypeCheckRec(e1.type.num)
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
CODE.TypeCheckRec(e1.type.num)
END
ELSE
PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81);
IL.TypeCheck(e1.type.base.num)
PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81);
CODE.TypeCheck(e1.type.base.num)
END;
PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82)
PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82)
END;
ASSERT(error = 0);
e.type := tBOOLEAN;
e.type := PARS.program.stTypes.tBOOLEAN;
IF ~constant THEN
e.obj := eEXPR
2557,7 → 2481,7
PROCEDURE ElementaryStatement (parser: PARS.PARSER);
VAR
e, e1: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
line: INTEGER;
call: BOOLEAN;
fregs: INTEGER;
2565,25 → 2489,25
BEGIN
getpos(parser, pos);
IL.pushBegEnd(begcall, endcall);
CODE.pushBegEnd(begcall, endcall);
designator(parser, e);
IF parser.sym = SCAN.lxASSIGN THEN
line := parser.lex.pos.line;
PARS.check(isVar(e), pos, 93);
PARS.check(~e.readOnly, pos, 94);
PARS.check(isVar(e), parser, pos, 93);
PARS.check(~e.readOnly, parser, pos, 94);
IL.setlast(begcall);
CODE.setlast(begcall);
NextPos(parser, pos);
expression(parser, e1);
IL.setlast(endcall.prev(IL.COMMAND));
CODE.setlast(endcall.prev(CODE.COMMAND));
PARS.check(assign(e1, e.type, line), pos, 91);
PARS.check(assign(e1, e.type, line), parser, pos, 91);
IF e1.obj = ePROC THEN
PARS.check(e1.ident.global, pos, 85)
PARS.check(e1.ident.global, parser, pos, 85)
END;
call := FALSE
ELSIF parser.sym = SCAN.lxEQ THEN
2591,18 → 2515,13
ELSIF parser.sym = SCAN.lxLROUND THEN
e1 := e;
ActualParameters(parser, e1);
PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92);
PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92);
call := TRUE
ELSE
IF e.obj IN {eSYSPROC, eSTPROC} THEN
stProc(parser, e);
call := FALSE
ELSE
PARS.check(isProc(e), pos, 86);
PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92);
PARS.check(isProc(e), parser, pos, 86);
PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92);
PARS.check1(e.type.params.first = NIL, parser, 64);
call := TRUE
END
END;
IF call THEN
2613,7 → 2532,7
END
END;
IL.popBegEnd(begcall, endcall)
CODE.popBegEnd(begcall, endcall)
END ElementaryStatement;
2620,32 → 2539,32
PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
VAR
e: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
label, L: INTEGER;
BEGIN
L := IL.NewLabel();
L := CODE.NewLabel();
IF ~if THEN
IL.AddCmd0(IL.opLOOP);
IL.SetLabel(L)
CODE.AddCmd0(CODE.opLOOP);
CODE.SetLabel(L)
END;
REPEAT
NextPos(parser, pos);
label := IL.NewLabel();
label := CODE.NewLabel();
expression(parser, e);
PARS.check(isBoolean(e), pos, 72);
PARS.check(isBoolean(e), parser, pos, 72);
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
IL.AddJmpCmd(IL.opJMP, label)
CODE.AddJmpCmd(CODE.opJMP, label)
END
ELSE
IL.AddJmpCmd(IL.opJNE, label)
CODE.AddJmpCmd(CODE.opJNE, label)
END;
IF if THEN
2657,8 → 2576,8
PARS.Next(parser);
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, L);
IL.SetLabel(label)
CODE.AddJmpCmd(CODE.opJMP, L);
CODE.SetLabel(label)
UNTIL parser.sym # SCAN.lxELSIF;
2667,13 → 2586,13
PARS.Next(parser);
parser.StatSeq(parser)
END;
IL.SetLabel(L)
CODE.SetLabel(L)
END;
PARS.checklex(parser, SCAN.lxEND);
IF ~if THEN
IL.AddCmd0(IL.opENDLOOP)
CODE.AddCmd0(CODE.opENDLOOP)
END;
PARS.Next(parser)
2683,14 → 2602,14
PROCEDURE RepeatStatement (parser: PARS.PARSER);
VAR
e: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
label: INTEGER;
BEGIN
IL.AddCmd0(IL.opLOOP);
CODE.AddCmd0(CODE.opLOOP);
label := IL.NewLabel();
IL.SetLabel(label);
label := CODE.NewLabel();
CODE.SetLabel(label);
PARS.Next(parser);
parser.StatSeq(parser);
2697,17 → 2616,17
PARS.checklex(parser, SCAN.lxUNTIL);
NextPos(parser, pos);
expression(parser, e);
PARS.check(isBoolean(e), pos, 72);
PARS.check(isBoolean(e), parser, pos, 72);
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
IL.AddJmpCmd(IL.opJMP, label)
CODE.AddJmpCmd(CODE.opJMP, label)
END
ELSE
IL.AddJmpCmd(IL.opJNE, label)
CODE.AddJmpCmd(CODE.opJNE, label)
END;
IL.AddCmd0(IL.opENDLOOP)
CODE.AddCmd0(CODE.opENDLOOP)
END RepeatStatement;
2737,7 → 2656,7
END DestroyLabel;
PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT;
VAR
res: CASE_VARIANT;
citem: C.ITEM;
2761,14 → 2680,19
PROCEDURE CaseStatement (parser: PARS.PARSER);
VAR
e: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN;
RETURN isRec(caseExpr) OR isPtr(caseExpr)
END isRecPtr;
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
VAR
a: INTEGER;
label: PARS.EXPR;
pos: PARS.POSITION;
pos: SCAN.POSITION;
value: ARITH.VALUE;
BEGIN
2777,7 → 2701,7
IF isChar(caseExpr) THEN
PARS.ConstExpression(parser, value);
PARS.check(value.typ = ARITH.tCHAR, pos, 99);
PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99);
a := ARITH.getInt(value)
ELSIF isCharW(caseExpr) THEN
PARS.ConstExpression(parser, value);
2784,17 → 2708,17
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)))
ELSE
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99)
END;
a := ARITH.getInt(value)
ELSIF isInt(caseExpr) THEN
PARS.ConstExpression(parser, value);
PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99);
a := ARITH.getInt(value)
ELSIF isRecPtr(caseExpr) THEN
qualident(parser, label);
PARS.check(label.obj = eTYPE, pos, 79);
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99);
PARS.check(label.obj = eTYPE, parser, pos, 79);
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99);
IF isRec(caseExpr) THEN
a := label.type.num
ELSE
2807,10 → 2731,10
END Label;
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION);
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION);
BEGIN
IF node # NIL THEN
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100);
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100);
CheckType(node.left, type, parser, pos);
CheckType(node.right, type, parser, pos)
END
2821,7 → 2745,7
VAR
label: CASE_LABEL;
citem: C.ITEM;
pos, pos1: PARS.POSITION;
pos, pos1: SCAN.POSITION;
node: AVL.NODE;
newnode: BOOLEAN;
range: RANGE;
2835,7 → 2759,7
END;
label.variant := variant;
label.self := IL.NewLabel();
label.self := CODE.NewLabel();
getpos(parser, pos1);
range.a := Label(parser, caseExpr, label.type);
2844,7 → 2768,7
PARS.check1(~isRecPtr(caseExpr), parser, 53);
NextPos(parser, pos);
range.b := Label(parser, caseExpr, label.type);
PARS.check(range.a <= range.b, pos, 103)
PARS.check(range.a <= range.b, parser, pos, 103)
ELSE
range.b := range.a
END;
2855,7 → 2779,7
CheckType(tree, label.type, parser, pos1)
END;
tree := AVL.insert(tree, label, LabelCmp, newnode, node);
PARS.check(newnode, pos1, 100)
PARS.check(newnode, parser, pos1, 100)
RETURN node
2889,12 → 2813,12
t: PROG.TYPE_;
variant: INTEGER;
node: AVL.NODE;
last: IL.COMMAND;
last: CODE.COMMAND;
BEGIN
sym := parser.sym;
IF sym # SCAN.lxBAR THEN
variant := IL.NewLabel();
variant := CODE.NewLabel();
node := CaseLabelList(parser, caseExpr, tree, variant);
PARS.checklex(parser, SCAN.lxCOLON);
PARS.Next(parser);
2903,8 → 2827,8
caseExpr.ident.type := node.data(CASE_LABEL).type
END;
last := IL.getlast();
IL.SetLabel(variant);
last := CODE.getlast();
CODE.SetLabel(variant);
IF ~isRecPtr(caseExpr) THEN
LISTS.push(CaseVariants, NewVariant(variant, last))
2911,7 → 2835,7
END;
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, end);
CODE.AddJmpCmd(CODE.opJMP, end);
IF isRecPtr(caseExpr) THEN
caseExpr.ident.type := t
2925,7 → 2849,7
L, R: INTEGER;
range: RANGE;
left, right: AVL.NODE;
last: IL.COMMAND;
last: CODE.COMMAND;
v: CASE_VARIANT;
BEGIN
2947,7 → 2871,7
R := else
END;
last := IL.getlast();
last := CODE.getlast();
v := CaseVariants.last(CASE_VARIANT);
WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
2955,16 → 2879,16
END;
ASSERT((v # NIL) & (v.label # 0));
IL.setlast(v.cmd);
CODE.setlast(v.cmd);
IL.SetLabel(node.data(CASE_LABEL).self);
IL.case(range.a, range.b, L, R);
CODE.SetLabel(node.data(CASE_LABEL).self);
CODE.case(range.a, range.b, L, R);
IF v.processed THEN
IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant)
END;
v.processed := TRUE;
IL.setlast(last);
CODE.setlast(last);
Table(left, else);
Table(right, else)
2975,7 → 2899,7
PROCEDURE TableT (node: AVL.NODE);
BEGIN
IF node # NIL THEN
IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
TableT(node.left);
TableT(node.right)
2983,7 → 2907,7
END TableT;
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION);
VAR
table, end, else: INTEGER;
tree: AVL.NODE;
2991,11 → 2915,11
BEGIN
LISTS.push(CaseVariants, NewVariant(0, NIL));
end := IL.NewLabel();
else := IL.NewLabel();
table := IL.NewLabel();
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
IL.AddJmpCmd(IL.opJMP, table);
end := CODE.NewLabel();
else := CODE.NewLabel();
table := CODE.NewLabel();
CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e)));
CODE.AddJmpCmd(CODE.opJMP, table);
tree := NIL;
3005,13 → 2929,13
case(parser, e, tree, end)
END;
IL.SetLabel(else);
CODE.SetLabel(else);
IF parser.sym = SCAN.lxELSE THEN
PARS.Next(parser);
parser.StatSeq(parser);
IL.AddJmpCmd(IL.opJMP, end)
CODE.AddJmpCmd(CODE.opJMP, end)
ELSE
IL.OnError(pos.line, errCASE)
CODE.OnError(pos.line, errCASE)
END;
PARS.checklex(parser, SCAN.lxEND);
3018,9 → 2942,9
PARS.Next(parser);
IF isRecPtr(e) THEN
IL.SetLabel(table);
CODE.SetLabel(table);
TableT(tree);
IL.AddJmpCmd(IL.opJMP, else)
CODE.AddJmpCmd(CODE.opJMP, else)
ELSE
tree.data(CASE_LABEL).self := table;
Table(tree, else)
3027,8 → 2951,8
END;
AVL.destroy(tree, DestroyLabel);
IL.SetLabel(end);
IL.AddCmd0(IL.opENDSW);
CODE.SetLabel(end);
CODE.AddCmd0(CODE.opENDSW);
REPEAT
item := LISTS.pop(CaseVariants);
3041,25 → 2965,25
BEGIN
NextPos(parser, pos);
expression(parser, e);
PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95);
IF isRecPtr(e) THEN
PARS.check(isVar(e), pos, 93);
PARS.check(e.ident # NIL, pos, 106)
PARS.check(isVar(e), parser, pos, 93);
PARS.check(e.ident # NIL, parser, pos, 106)
END;
IF isRec(e) THEN
PARS.check(e.obj = eVREC, pos, 78)
PARS.check(e.obj = eVREC, parser, pos, 78)
END;
IF e.obj = eCONST THEN
LoadConst(e)
ELSIF isRec(e) THEN
IL.drop;
IL.AddCmd(IL.opLADR, e.ident.offset - 1);
IL.load(PARS.program.target.word)
CODE.drop;
CODE.AddCmd(CODE.opLADR, e.ident.offset - 1);
CODE.load(PARS.program.target.word)
ELSIF isPtr(e) THEN
deref(pos, e, FALSE, errPTR);
IL.AddCmd(IL.opSUBR, PARS.program.target.word);
IL.load(PARS.program.target.word)
CODE.AddCmd(CODE.opSUBR, PARS.program.target.word);
CODE.load(PARS.program.target.word)
END;
PARS.checklex(parser, SCAN.lxOF);
3071,7 → 2995,7
PROCEDURE ForStatement (parser: PARS.PARSER);
VAR
e: PARS.EXPR;
pos, pos2: PARS.POSITION;
pos: SCAN.POSITION;
step: ARITH.VALUE;
st: INTEGER;
ident: PROG.IDENT;
3079,55 → 3003,55
L1, L2: INTEGER;
BEGIN
IL.AddCmd0(IL.opLOOP);
CODE.AddCmd0(CODE.opLOOP);
L1 := IL.NewLabel();
L2 := IL.NewLabel();
L1 := CODE.NewLabel();
L2 := CODE.NewLabel();
PARS.ExpectSym(parser, SCAN.lxIDENT);
ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE);
PARS.check1(ident # NIL, parser, 48);
PARS.check1(ident.typ = PROG.idVAR, parser, 93);
PARS.check1(ident.type = tINTEGER, parser, 97);
PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97);
PARS.ExpectSym(parser, SCAN.lxASSIGN);
NextPos(parser, pos);
expression(parser, e);
PARS.check(isInt(e), pos, 76);
PARS.check(isInt(e), parser, pos, 76);
offset := PROG.getOffset(PARS.program, ident);
IF ident.global THEN
IL.AddCmd(IL.opGADR, offset)
CODE.AddCmd(CODE.opGADR, offset)
ELSE
IL.AddCmd(IL.opLADR, -offset)
CODE.AddCmd(CODE.opLADR, -offset)
END;
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
ELSE
IL.AddCmd0(IL.opSAVE)
CODE.AddCmd0(CODE.opSAVE)
END;
IL.SetLabel(L1);
CODE.SetLabel(L1);
IF ident.global THEN
IL.AddCmd(IL.opGADR, offset)
CODE.AddCmd(CODE.opGADR, offset)
ELSE
IL.AddCmd(IL.opLADR, -offset)
CODE.AddCmd(CODE.opLADR, -offset)
END;
IL.load(ident.type.size);
CODE.load(ident.type.size);
PARS.checklex(parser, SCAN.lxTO);
NextPos(parser, pos2);
NextPos(parser, pos);
expression(parser, e);
PARS.check(isInt(e), pos2, 76);
PARS.check(isInt(e), parser, pos, 76);
IF parser.sym = SCAN.lxBY THEN
NextPos(parser, pos);
PARS.ConstExpression(parser, step);
PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76);
st := ARITH.getInt(step);
PARS.check(st # 0, pos, 98)
PARS.check(st # 0, parser, pos, 98)
ELSE
st := 1
END;
3134,25 → 3058,19
IF e.obj = eCONST THEN
IF st > 0 THEN
IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
ERRORS.WarningMsg(pos2.line, pos2.col, 1)
END
CODE.AddCmd(CODE.opLER, ARITH.Int(e.value))
ELSE
IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
IF ARITH.Int(e.value) = UTILS.target.minInt THEN
ERRORS.WarningMsg(pos2.line, pos2.col, 1)
CODE.AddCmd(CODE.opGER, ARITH.Int(e.value))
END
END
ELSE
IF st > 0 THEN
IL.AddCmd0(IL.opLE)
CODE.AddCmd0(CODE.opLE)
ELSE
IL.AddCmd0(IL.opGE)
CODE.AddCmd0(CODE.opGE)
END
END;
IL.AddJmpCmd(IL.opJNE, L2);
CODE.AddJmpCmd(CODE.opJNE, L2);
PARS.checklex(parser, SCAN.lxDO);
PARS.Next(parser);
3159,21 → 3077,31
parser.StatSeq(parser);
IF ident.global THEN
IL.AddCmd(IL.opGADR, offset)
CODE.AddCmd(CODE.opGADR, offset)
ELSE
IL.AddCmd(IL.opLADR, -offset)
CODE.AddCmd(CODE.opLADR, -offset)
END;
IL.AddCmd(IL.opINCC, st);
IF st = 1 THEN
CODE.AddCmd0(CODE.opINC1)
ELSIF st = -1 THEN
CODE.AddCmd0(CODE.opDEC1)
ELSE
IF st > 0 THEN
CODE.AddCmd(CODE.opINCC, st)
ELSE
CODE.AddCmd(CODE.opDECC, -st)
END
END;
IL.AddJmpCmd(IL.opJMP, L1);
CODE.AddJmpCmd(CODE.opJMP, L1);
PARS.checklex(parser, SCAN.lxEND);
PARS.Next(parser);
IL.SetLabel(L2);
CODE.SetLabel(L2);
IL.AddCmd0(IL.opENDLOOP)
CODE.AddCmd0(CODE.opENDLOOP)
END ForStatement;
3211,7 → 3139,7
END StatSeq;
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN;
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
VAR
res: BOOLEAN;
3219,24 → 3147,24
res := assigncomp(e, t);
IF res THEN
IF e.obj = eCONST THEN
IF e.type = tREAL THEN
IL.Float(ARITH.Float(e.value))
IF e.type.typ = PROG.tREAL THEN
CODE.Float(ARITH.Float(e.value))
ELSIF e.type.typ = PROG.tNIL THEN
IL.Const(0)
CODE.AddCmd(CODE.opCONST, 0)
ELSE
LoadConst(e)
END
ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN
CheckRange(256, pos.line, errBYTE)
ELSIF e.obj = ePROC THEN
PARS.check(e.ident.global, pos, 85);
IL.PushProc(e.ident.proc.label)
PARS.check(e.ident.global, parser, pos, 85);
CODE.PushProc(e.ident.proc.label)
ELSIF e.obj = eIMP THEN
IL.PushImpProc(e.ident.import)
CODE.PushImpProc(e.ident.import)
END;
IF e.type = tREAL THEN
IL.retf
IF e.type.typ = PROG.tREAL THEN
CODE.retf
END
END
3254,16 → 3182,16
id: PROG.IDENT;
BEGIN
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE);
IF (id # NIL) & (id.import # NIL) THEN
IL.codes.rtl[idx] := -id.import(IL.IMPORT_PROC).label;
CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label;
id.proc.used := TRUE
ELSIF (id # NIL) & (id.proc # NIL) THEN
IL.codes.rtl[idx] := id.proc.label;
CODE.codes.rtl[idx] := id.proc.label;
id.proc.used := TRUE
ELSE
ERRORS.WrongRTL(name)
ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found")
END
END getproc;
3272,65 → 3200,46
rtl := PARS.program.rtl;
ASSERT(rtl # NIL);
IF CPU IN {cpuX86, cpuAMD64} THEN
getproc(rtl, "_strcmp", IL._strcmp);
getproc(rtl, "_length", IL._length);
getproc(rtl, "_arrcpy", IL._arrcpy);
getproc(rtl, "_move", IL._move);
getproc(rtl, "_is", IL._is);
getproc(rtl, "_guard", IL._guard);
getproc(rtl, "_guardrec", IL._guardrec);
getproc(rtl, "_error", IL._error);
getproc(rtl, "_new", IL._new);
getproc(rtl, "_rot", IL._rot);
getproc(rtl, "_strcpy", IL._strcpy);
getproc(rtl, "_move2", IL._move2);
getproc(rtl, "_div2", IL._div2);
getproc(rtl, "_mod2", IL._mod2);
getproc(rtl, "_div", IL._div);
getproc(rtl, "_mod", IL._mod);
getproc(rtl, "_set", IL._set);
getproc(rtl, "_set2", IL._set2);
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_lengthw", IL._lengthw);
getproc(rtl, "_strcmpw", IL._strcmpw);
getproc(rtl, "_dllentry", IL._dllentry);
getproc(rtl, "_dispose", IL._dispose);
getproc(rtl, "_exit", IL._exit);
getproc(rtl, "_init", IL._init);
getproc(rtl, "_sofinit", IL._sofinit)
END
getproc(rtl, "_move", CODE._move);
getproc(rtl, "_move2", CODE._move2);
getproc(rtl, "_set", CODE._set);
getproc(rtl, "_set2", CODE._set2);
getproc(rtl, "_div", CODE._div);
getproc(rtl, "_mod", CODE._mod);
getproc(rtl, "_div2", CODE._div2);
getproc(rtl, "_mod2", CODE._mod2);
getproc(rtl, "_arrcpy", CODE._arrcpy);
getproc(rtl, "_rot", CODE._rot);
getproc(rtl, "_new", CODE._new);
getproc(rtl, "_dispose", CODE._dispose);
getproc(rtl, "_strcmp", CODE._strcmp);
getproc(rtl, "_error", CODE._error);
getproc(rtl, "_is", CODE._is);
getproc(rtl, "_isrec", CODE._isrec);
getproc(rtl, "_guard", CODE._guard);
getproc(rtl, "_guardrec", CODE._guardrec);
getproc(rtl, "_length", CODE._length);
getproc(rtl, "_init", CODE._init);
getproc(rtl, "_dllentry", CODE._dllentry);
getproc(rtl, "_strcpy", CODE._strcpy);
getproc(rtl, "_exit", CODE._exit);
getproc(rtl, "_strcpy2", CODE._strcpy2);
getproc(rtl, "_lengthw", CODE._lengthw);
getproc(rtl, "_strcmp2", CODE._strcmp2);
getproc(rtl, "_strcmpw", CODE._strcmpw);
getproc(rtl, "_strcmpw2", CODE._strcmpw2);
END setrtl;
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET);
VAR
parser: PARS.PARSER;
ext: PARS.PATH;
amd64: BOOLEAN;
BEGIN
tINTEGER := PARS.program.stTypes.tINTEGER;
tBYTE := PARS.program.stTypes.tBYTE;
tCHAR := PARS.program.stTypes.tCHAR;
tSET := PARS.program.stTypes.tSET;
tBOOLEAN := PARS.program.stTypes.tBOOLEAN;
tWCHAR := PARS.program.stTypes.tWCHAR;
tREAL := PARS.program.stTypes.tREAL;
Options := options;
CASE target OF
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
CPU := cpuAMD64
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32,
mConst.Target_iELFSO32:
CPU := cpuX86
|mConst.Target_iMSP430:
CPU := cpuMSP430
END;
amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
ext := mConst.FILE_EXT;
CaseLabels := C.create();
CaseVar := C.create();
3338,13 → 3247,14
CaseVariants := LISTS.create(NIL);
LISTS.push(CaseVariants, NewVariant(0, NIL));
CASE CPU OF
|cpuAMD64: IL.init(6, IL.little_endian)
|cpuX86: IL.init(8, IL.little_endian)
|cpuMSP430: IL.init(0, IL.little_endian)
checking := chk;
IF amd64 THEN
CODE.init(6, CODE.little_endian)
ELSE
CODE.init(8, CODE.little_endian)
END;
IF CPU # cpuMSP430 THEN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
IF parser.open(parser, mConst.RTL_NAME) THEN
parser.parse(parser);
3356,9 → 3266,8
parser.parse(parser);
PARS.destroy(parser)
ELSE
ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT)
ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found")
END
END
END;
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
3367,29 → 3276,25
IF parser.open(parser, modname) THEN
parser.parse(parser)
ELSE
ERRORS.FileNotFound(path, modname, mConst.FILE_EXT)
ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found")
END;
PARS.destroy(parser);
IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
ERRORS.Error(204)
ERRORS.error1("size of global variables is too large")
END;
IF CPU # cpuMSP430 THEN
setrtl
END;
setrtl;
PROG.DelUnused(PARS.program, IL.DelImport);
PROG.DelUnused(PARS.program, CODE.DelImport);
IL.codes.bss := PARS.program.bss;
CASE CPU OF
| cpuAMD64: AMD64.CodeGen(IL.codes, outname, target, options)
| cpuX86: X86.CodeGen(IL.codes, outname, target, options)
|cpuMSP430: MSP430.CodeGen(IL.codes, outname, target, options)
CODE.codes.bss := PARS.program.bss;
IF amd64 THEN
AMD64.CodeGen(CODE.codes, outname, target, stack, base)
ELSE
X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic)
END
END compile;

/programs/develop/oberon07/Source/STRINGS.ob07
92,29 → 92,6
END IntToStr;
PROCEDURE hexdgt (n: BYTE): BYTE;
BEGIN
IF n < 10 THEN
n := n + ORD("0")
ELSE
n := n - 10 + ORD("A")
END
RETURN n
END hexdgt;
PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
BEGIN
str[n] := 0X;
WHILE n > 0 DO
str[n - 1] := CHR(hexdgt(x MOD 16));
x := x DIV 16;
DEC(n)
END
END IntToHex;
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
BEGIN
WHILE count > 0 DO

/programs/develop/oberon07/Source/X86.ob07
7,8 → 7,7
MODULE X86;
IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG,
mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS;
IMPORT CODE, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, mConst := CONSTANTS, MACHINE, CHL := CHUNKLISTS, PATHS;
CONST
32,7 → 31,7
TYPE
COMMAND = IL.COMMAND;
COMMAND = CODE.COMMAND;
ANYCODE = POINTER TO RECORD (LISTS.ITEM)
41,7 → 40,7
END;
CODE = POINTER TO RECORD (ANYCODE)
TCODE = POINTER TO RECORD (ANYCODE)
code: ARRAY CODECHUNK OF BYTE;
length: INTEGER
90,29 → 89,27
CodeList: LISTS.LIST;
tcount: INTEGER;
PROCEDURE Byte (n: INTEGER): BYTE;
RETURN UTILS.Byte(n, 0)
RETURN MACHINE.Byte(n, 0)
END Byte;
PROCEDURE Word (n: INTEGER): INTEGER;
RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256
RETURN MACHINE.Byte(n, 0) + MACHINE.Byte(n, 1) * 256
END Word;
PROCEDURE OutByte* (n: BYTE);
VAR
c: CODE;
c: TCODE;
last: ANYCODE;
BEGIN
last := CodeList.last(ANYCODE);
IF (last IS CODE) & (last(CODE).length < CODECHUNK) THEN
c := last(CODE);
IF (last IS TCODE) & (last(TCODE).length < CODECHUNK) THEN
c := last(TCODE);
c.code[c.length] := n;
INC(c.length)
ELSE
127,10 → 124,10
PROCEDURE OutInt (n: INTEGER);
BEGIN
OutByte(UTILS.Byte(n, 0));
OutByte(UTILS.Byte(n, 1));
OutByte(UTILS.Byte(n, 2));
OutByte(UTILS.Byte(n, 3))
OutByte(MACHINE.Byte(n, 0));
OutByte(MACHINE.Byte(n, 1));
OutByte(MACHINE.Byte(n, 2));
OutByte(MACHINE.Byte(n, 3))
END OutInt;
184,10 → 181,10
PROCEDURE shift* (op, reg: INTEGER);
BEGIN
CASE op OF
|IL.opASR, IL.opASR1, IL.opASR2: OutByte(0F8H + reg)
|IL.opROR, IL.opROR1, IL.opROR2: OutByte(0C8H + reg)
|IL.opLSL, IL.opLSL1, IL.opLSL2: OutByte(0E0H + reg)
|IL.opLSR, IL.opLSR1, IL.opLSR2: OutByte(0E8H + reg)
|CODE.opASR, CODE.opASR1, CODE.opASR2: OutByte(0F8H + reg)
|CODE.opROR, CODE.opROR1, CODE.opROR2: OutByte(0C8H + reg)
|CODE.opLSL, CODE.opLSL1, CODE.opLSL2: OutByte(0E0H + reg)
|CODE.opLSR, CODE.opLSR1, CODE.opLSR2: OutByte(0E8H + reg)
END
END shift;
323,11 → 320,27
END drop;
PROCEDURE GetAnyReg (): INTEGER;
RETURN REG.GetAnyReg(R)
END GetAnyReg;
PROCEDURE log2* (x: INTEGER): INTEGER;
VAR
n: INTEGER;
BEGIN
ASSERT(x > 0);
n := 0;
WHILE ~ODD(x) DO
x := x DIV 2;
INC(n)
END;
IF x # 1 THEN
n := -1
END
RETURN n
END log2;
PROCEDURE cond* (op: INTEGER): INTEGER;
VAR
res: INTEGER;
334,12 → 347,12
BEGIN
CASE op OF
|IL.opGT, IL.opGTC: res := jg
|IL.opGE, IL.opGEC: res := jge
|IL.opLT, IL.opLTC: res := jl
|IL.opLE, IL.opLEC: res := jle
|IL.opEQ, IL.opEQC: res := je
|IL.opNE, IL.opNEC: res := jne
|CODE.opGT, CODE.opGTR, CODE.opLTL: res := jg
|CODE.opGE, CODE.opGER, CODE.opLEL: res := jge
|CODE.opLT, CODE.opLTR, CODE.opGTL: res := jl
|CODE.opLE, CODE.opLER, CODE.opGEL: res := jle
|CODE.opEQ, CODE.opEQR, CODE.opEQL: res := je
|CODE.opNE, CODE.opNER, CODE.opNEL: res := jne
END
RETURN res
346,11 → 359,18
END cond;
PROCEDURE inv0* (op: INTEGER): INTEGER;
RETURN ORD(BITS(op) / {0})
END inv0;
PROCEDURE inv1* (op: INTEGER): INTEGER;
BEGIN
IF ODD(op) THEN
DEC(op)
ELSE
INC(op)
END
RETURN op
END inv1;
PROCEDURE Reloc* (op, value: INTEGER);
VAR
reloc: RELOC;
416,12 → 436,12
reg1: INTEGER;
BEGIN
label := IL.codes.rtl[proc];
label := CODE.codes.rtl[proc];
IF label < 0 THEN
label := -label;
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICIMP, label);
OutByte2(0FFH, 010H + reg1); // call dword[reg1]
drop
465,7 → 485,7
code.offset := count;
CASE code OF
|CODE: INC(count, code.length)
|TCODE: INC(count, code.length)
|LABEL: BIN.SetLabel(program, code.label, count)
|JMP: IF code.short THEN INC(count, 2) ELSE INC(count, 5) END; code.offset := count
|JCC: IF code.short THEN INC(count, 2) ELSE INC(count, 6) END; code.offset := count
498,7 → 518,7
CASE code OF
|CODE:
|TCODE:
FOR i := 0 TO code.length - 1 DO
BIN.PutCode(program, code.code[i])
END
556,7 → 576,7
PROCEDURE PushAll (NumberOfParameters: INTEGER);
BEGIN
REG.PushAll(R);
DEC(R.pushed, NumberOfParameters)
R.pushed := R.pushed - NumberOfParameters
END PushAll;
563,7 → 583,7
PROCEDURE NewLabel (): INTEGER;
BEGIN
BIN.NewLabel(program)
RETURN IL.NewLabel()
RETURN CODE.NewLabel()
END NewLabel;
573,7 → 593,7
END GetRegA;
PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER);
PROCEDURE translate (code: CODE.CODES; pic: BOOLEAN; stroffs: INTEGER);
VAR
cmd: COMMAND;
581,7 → 601,7
n, a, b, label, cc: INTEGER;
opcode, param1, param2: INTEGER;
param1, param2: INTEGER;
float: REAL;
593,19 → 613,17
param1 := cmd.param1;
param2 := cmd.param2;
opcode := cmd.opcode;
CASE cmd.opcode OF
CASE opcode OF
|IL.opJMP:
|CODE.opJMP:
jmp(param1)
|IL.opCALL:
|CODE.opCALL:
call(param1)
|IL.opCALLI:
|CODE.opCALLI:
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICIMP, param1);
OutByte2(0FFH, 010H + reg1); // call dword[reg1]
drop
614,13 → 632,13
Reloc(BIN.RIMP, param1)
END
|IL.opCALLP:
|CODE.opCALLP:
UnOp(reg1);
OutByte2(0FFH, 0D0H + reg1); // call reg1
drop;
ASSERT(R.top = -1)
|IL.opPRECALL:
|CODE.opPRECALL:
n := param2;
IF (param1 # 0) & (n # 0) THEN
subrc(esp, 8)
632,7 → 650,7
END;
PushAll(0)
|IL.opALIGN16:
|CODE.opALIGN16:
ASSERT(eax IN R.regs);
mov(eax, esp);
andrc(esp, -16);
642,7 → 660,7
END;
push(eax)
|IL.opRES:
|CODE.opRES:
ASSERT(R.top = -1);
GetRegA;
n := param2;
652,7 → 670,7
DEC(n)
END
|IL.opRESF:
|CODE.opRESF:
n := param2;
IF n > 0 THEN
OutByte3(0DDH, 5CH + long(n * 8), 24H);
666,7 → 684,7
DEC(n)
END
|IL.opENTER:
|CODE.opENTER:
ASSERT(R.top = -1);
SetLabel(param1);
686,8 → 704,8
END
END
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode = IL.opLEAVER THEN
|CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF:
IF cmd.opcode = CODE.opLEAVER THEN
UnOp(reg1);
IF reg1 # eax THEN
GetRegA;
699,10 → 717,7
ASSERT(R.top = -1);
IF param1 > 0 THEN
mov(esp, ebp)
END;
mov(esp, ebp);
pop(ebp);
n := param2;
713,10 → 728,10
OutByte(0C3H) // ret
END
|IL.opPUSHC:
|CODE.opERRC:
pushc(param2)
|IL.opPARAM:
|CODE.opPARAM:
n := param2;
IF n = 1 THEN
UnOp(reg1);
727,25 → 742,26
PushAll(n)
END
|IL.opCLEANUP:
|CODE.opCLEANUP:
n := param2 * 4;
IF n # 0 THEN
addrc(esp, n)
END
|IL.opPOPSP:
|CODE.opPOPSP:
pop(esp)
|IL.opCONST:
movrc(GetAnyReg(), param2)
|CODE.opCONST:
reg1 := REG.GetAnyReg(R);
movrc(reg1, param2)
|IL.opLABEL:
SetLabel(param1) // L:
|CODE.opLABEL:
SetLabel(param2) // L:
|IL.opNOP:
|CODE.opNOP:
|IL.opGADR:
reg1 := GetAnyReg();
|CODE.opGADR:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICBSS, param2)
ELSE
753,18 → 769,20
Reloc(BIN.RBSS, param2)
END
|IL.opLADR:
|CODE.opLADR:
n := param2 * 4;
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n]
reg1 := REG.GetAnyReg(R);
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n]
OutIntByte(n)
|IL.opVADR:
|CODE.opVADR:
n := param2 * 4;
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n]
reg1 := REG.GetAnyReg(R);
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n)
|IL.opSADR:
reg1 := GetAnyReg();
|CODE.opSADR:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICDATA, stroffs + param2);
ELSE
772,30 → 790,30
Reloc(BIN.RDATA, stroffs + param2)
END
|IL.opSAVEC:
|CODE.opSAVEC:
UnOp(reg1);
OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2
drop
|IL.opSAVE8C:
|CODE.opSAVE8C:
UnOp(reg1);
OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2
drop
|IL.opSAVE16C:
|CODE.opSAVE16C:
UnOp(reg1);
OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2
drop
|IL.opVLOAD32:
|CODE.opVLOAD32:
n := param2 * 4;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
|IL.opGLOAD32:
reg1 := GetAnyReg();
|CODE.opGLOAD32:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
804,24 → 822,25
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD32:
|CODE.opLLOAD32:
n := param2 * 4;
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n]
reg1 := REG.GetAnyReg(R);
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n)
|IL.opLOAD32:
|CODE.opLOAD32:
UnOp(reg1);
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1]
|IL.opVLOAD8:
|CODE.opVLOAD8:
n := param2 * 4;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
|IL.opGLOAD8:
reg1 := GetAnyReg();
|CODE.opGLOAD8:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
830,24 → 849,25
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD8:
|CODE.opLLOAD8:
n := param2 * 4;
OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n]
reg1 := REG.GetAnyReg(R);
OutByte3(0FH, 0B6H, 45H + reg1 * 8 + long(n)); // movzx reg1, byte[ebp + n]
OutIntByte(n)
|IL.opLOAD8:
|CODE.opLOAD8:
UnOp(reg1);
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1]
|IL.opVLOAD16:
|CODE.opVLOAD16:
n := param2 * 4;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n]
OutIntByte(n);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
|IL.opGLOAD16:
reg1 := GetAnyReg();
|CODE.opGLOAD16:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICBSS, param2);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
856,25 → 876,26
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD16:
|CODE.opLLOAD16:
n := param2 * 4;
OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n]
reg1 := REG.GetAnyReg(R);
OutByte3(0FH, 0B7H, 45H + reg1 * 8 + long(n)); // movzx reg1, word[ebp + n]
OutIntByte(n)
|IL.opLOAD16:
|CODE.opLOAD16:
UnOp(reg1);
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1]
|IL.opUMINUS:
|CODE.opUMINUS:
UnOp(reg1);
neg(reg1)
|IL.opADD:
|CODE.opADD:
BinOp(reg1, reg2);
add(reg1, reg2);
drop
|IL.opADDL, IL.opADDR:
|CODE.opADDL, CODE.opADDR:
IF param2 # 0 THEN
UnOp(reg1);
IF param2 = 1 THEN
886,12 → 907,12
END
END
|IL.opSUB:
|CODE.opSUB:
BinOp(reg1, reg2);
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2
drop
|IL.opSUBR, IL.opSUBL:
|CODE.opSUBR, CODE.opSUBL:
UnOp(reg1);
n := param2;
IF n = 1 THEN
901,18 → 922,18
ELSIF n # 0 THEN
subrc(reg1, n)
END;
IF opcode = IL.opSUBL THEN
IF cmd.opcode = CODE.opSUBL THEN
neg(reg1)
END
|IL.opMULC:
|CODE.opMULC:
UnOp(reg1);
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := log2(-a)
ELSE
n := -1
END;
940,33 → 961,33
END
END
|IL.opMUL:
|CODE.opMUL:
BinOp(reg1, reg2);
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2
drop
|IL.opSAVE, IL.opSAVE32:
|CODE.opSAVE, CODE.opSAVE32:
BinOp(reg2, reg1);
OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2
drop;
drop
|IL.opSAVE8:
|CODE.opSAVE8:
BinOp(reg2, reg1);
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2
drop;
drop
|IL.opSAVE16:
|CODE.opSAVE16:
BinOp(reg2, reg1);
OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2
drop;
drop
|IL.opSAVEP:
|CODE.opSAVEP:
UnOp(reg1);
IF pic THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
Pic(reg2, BIN.PICCODE, param2);
OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2
drop
976,10 → 997,10
END;
drop
|IL.opSAVEIP:
|CODE.opSAVEIP:
UnOp(reg1);
IF pic THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
Pic(reg2, BIN.PICIMP, param2);
OutByte2(0FFH, 30H + reg2); // push dword[reg2]
OutByte2(08FH, reg1); // pop dword[reg1]
991,8 → 1012,8
END;
drop
|IL.opPUSHP:
reg1 := GetAnyReg();
|CODE.opPUSHP:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICCODE, param2)
ELSE
1000,8 → 1021,8
Reloc(BIN.RCODE, param2)
END
|IL.opPUSHIP:
reg1 := GetAnyReg();
|CODE.opPUSHIP:
reg1 := REG.GetAnyReg(R);
IF pic THEN
Pic(reg1, BIN.PICIMP, param2);
OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1]
1010,72 → 1031,91
Reloc(BIN.RIMP, param2)
END
|IL.opNOT:
|CODE.opNOT:
UnOp(reg1);
test(reg1);
setcc(sete, reg1);
andrc(reg1, 1)
|IL.opORD:
|CODE.opORD:
UnOp(reg1);
test(reg1);
setcc(setne, reg1);
andrc(reg1, 1)
|IL.opSBOOL:
|CODE.opSBOOL:
BinOp(reg2, reg1);
test(reg2);
OutByte3(0FH, 95H, reg1); // setne byte[reg1]
setcc(setne, reg2);
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2
drop;
drop
|IL.opSBOOLC:
|CODE.opSBOOLC:
UnOp(reg1);
OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1
drop
|IL.opODD:
|CODE.opODD:
UnOp(reg1);
andrc(reg1, 1)
|IL.opEQ..IL.opGE,
IL.opEQC..IL.opGEC:
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
BinOp(reg1, reg2);
cmprr(reg1, reg2);
drop
ELSE
|CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL,
CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL,
CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL:
UnOp(reg1);
IF param2 = 0 THEN
test(reg1)
ELSE
cmprc(reg1, param2)
END
END;
drop;
cc := cond(cmd.opcode);
IF cmd.next(COMMAND).opcode = CODE.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(inv1(cc), label);
cmd := cmd.next(COMMAND)
ELSE
reg1 := REG.GetAnyReg(R);
setcc(cc + 16, reg1);
andrc(reg1, 1)
END
|CODE.opGT, CODE.opGE, CODE.opLT,
CODE.opLE, CODE.opEQ, CODE.opNE:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
drop;
cc := cond(opcode);
drop;
cc := cond(cmd.opcode);
IF cmd.next(COMMAND).opcode = IL.opJE THEN
IF cmd.next(COMMAND).opcode = CODE.opJE THEN
label := cmd.next(COMMAND).param1;
jcc(cc, label);
cmd := cmd.next(COMMAND)
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN
ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN
label := cmd.next(COMMAND).param1;
jcc(inv0(cc), label);
jcc(inv1(cc), label);
cmd := cmd.next(COMMAND)
ELSE
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
setcc(cc + 16, reg1);
andrc(reg1, 1)
END
|IL.opEQB, IL.opNEB:
|CODE.opEQB, CODE.opNEB:
BinOp(reg1, reg2);
drop;
drop;
test(reg1);
OutByte2(74H, 5); // je @f
1087,7 → 1127,8
// @@:
cmprr(reg1, reg2);
IF opcode = IL.opEQB THEN
reg1 := REG.GetAnyReg(R);
IF cmd.opcode = CODE.opEQB THEN
setcc(sete, reg1)
ELSE
setcc(setne, reg1)
1094,7 → 1135,7
END;
andrc(reg1, 1)
|IL.opACC:
|CODE.opACC:
IF (R.top # 0) OR (R.stk[0] # eax) THEN
PushAll(0);
GetRegA;
1102,33 → 1143,33
DEC(R.pushed)
END
|IL.opDROP:
|CODE.opDROP:
UnOp(reg1);
drop
|IL.opJNZ:
|CODE.opJNZ:
UnOp(reg1);
test(reg1);
jcc(jne, param1)
|IL.opJZ:
|CODE.opJZ:
UnOp(reg1);
test(reg1);
jcc(je, param1)
|IL.opJE:
|CODE.opJE:
UnOp(reg1);
test(reg1);
jcc(jne, param1);
drop
drop;
|IL.opJNE:
|CODE.opJNE:
UnOp(reg1);
test(reg1);
jcc(je, param1);
drop
drop;
|IL.opSWITCH:
|CODE.opSWITCH:
UnOp(reg1);
IF param2 = 0 THEN
reg2 := eax
1142,32 → 1183,26
END;
drop
|IL.opENDSW:
|CODE.opENDSW:
|IL.opCASEL:
|CODE.opCASEL:
cmprc(eax, param1);
jcc(jl, param2)
|IL.opCASER:
|CODE.opCASER:
cmprc(eax, param1);
jcc(jg, param2)
|IL.opCASELR:
|CODE.opCASELR:
cmprc(eax, param1);
jcc(jl, param2);
jcc(jg, cmd.param3)
|IL.opCODE:
|CODE.opCODE:
OutByte(param2)
|IL.opGET, IL.opGETC:
IF opcode = IL.opGET THEN
BinOp(reg1, reg2)
ELSIF opcode = IL.opGETC THEN
UnOp(reg2);
reg1 := GetAnyReg();
movrc(reg1, param1)
END;
|CODE.opGET:
BinOp(reg1, reg2);
drop;
drop;
1189,11 → 1224,11
push(reg2);
push(reg1);
pushc(8);
CallRTL(pic, IL._move)
CallRTL(pic, CODE._move)
END
|IL.opSAVES:
|CODE.opSAVES:
UnOp(reg1);
drop;
PushAll(0);
1208,19 → 1243,19
END;
pushc(param1);
CallRTL(pic, IL._move)
CallRTL(pic, CODE._move)
|IL.opCHKBYTE:
|CODE.opCHKBYTE:
BinOp(reg1, reg2);
cmprc(reg1, 256);
jcc(jb, param1)
|IL.opCHKIDX:
|CODE.opCHKIDX:
UnOp(reg1);
cmprc(reg1, param2);
jcc(jb, param1)
|IL.opCHKIDX2:
|CODE.opCHKIDX2:
BinOp(reg1, reg2);
IF param2 # -1 THEN
cmprr(reg2, reg1);
1233,7 → 1268,7
R.stk[R.top] := reg2
END
|IL.opLEN:
|CODE.opLEN:
n := param2;
UnOp(reg1);
drop;
1248,94 → 1283,136
INCL(R.regs, reg1);
ASSERT(REG.GetReg(R, reg1))
|IL.opINCC:
|CODE.opINC1:
UnOp(reg1);
OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2
OutByte2(0FFH, reg1); // inc dword[reg1]
drop
|IL.opINC, IL.opDEC:
|CODE.opDEC1:
UnOp(reg1);
OutByte2(0FFH, 8 + reg1); // dec dword[reg1]
drop
|CODE.opINCC:
UnOp(reg1);
n := param2;
OutByte2(81H + short(n), reg1); OutIntByte(n); // add dword[reg1], n
drop
|CODE.opDECC:
UnOp(reg1);
n := param2;
OutByte2(81H + short(n), 28H + reg1); OutIntByte(n); // sub dword[reg1], n
drop
|CODE.opINC:
BinOp(reg1, reg2);
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1
OutByte2(01H, reg1 * 8 + reg2); // add dword[reg2], reg1
drop;
drop
|IL.opINCCB, IL.opDECCB:
|CODE.opDEC:
BinOp(reg1, reg2);
OutByte2(29H, reg1 * 8 + reg2); // sub dword[reg2], reg1
drop;
drop
|CODE.opINC1B:
UnOp(reg1);
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n
OutByte2(0FEH, reg1); // inc byte[reg1]
drop
|IL.opINCB, IL.opDECB:
|CODE.opDEC1B:
UnOp(reg1);
OutByte2(0FEH, 08H + reg1); // dec byte[reg1]
drop
|CODE.opINCCB:
UnOp(reg1);
OutByte3(80H, reg1, Byte(param2)); // add byte[reg1], n
drop
|CODE.opDECCB:
UnOp(reg1);
OutByte3(80H, 28H + reg1, Byte(param2)); // sub byte[reg1], n
drop
|CODE.opINCB, CODE.opDECB:
BinOp(reg1, reg2);
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1
IF cmd.opcode = CODE.opINCB THEN
OutByte2(00H, reg1 * 8 + reg2) // add byte[reg2], reg1
ELSE
OutByte2(28H, reg1 * 8 + reg2) // sub byte[reg2], reg1
END;
drop;
drop
|IL.opMULS:
|CODE.opMULS:
BinOp(reg1, reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2
drop
|IL.opMULSC:
|CODE.opMULSC:
UnOp(reg1);
andrc(reg1, param2)
|IL.opDIVS:
|CODE.opDIVS:
BinOp(reg1, reg2);
xor(reg1, reg2);
drop
|IL.opDIVSC:
|CODE.opDIVSC:
UnOp(reg1);
OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n
OutIntByte(param2)
|IL.opADDS:
|CODE.opADDS:
BinOp(reg1, reg2);
OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2
drop
|IL.opSUBS:
|CODE.opSUBS:
BinOp(reg1, reg2);
not(reg2);
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2
drop
|IL.opADDSL, IL.opADDSR:
|CODE.opADDSL, CODE.opADDSR:
UnOp(reg1);
orrc(reg1, param2)
|IL.opSUBSL:
|CODE.opSUBSL:
UnOp(reg1);
not(reg1);
andrc(reg1, param2)
|IL.opSUBSR:
|CODE.opSUBSR:
UnOp(reg1);
andrc(reg1, ORD(-BITS(param2)))
andrc(reg1, ORD(-BITS(param2)));
|IL.opUMINS:
|CODE.opUMINS:
UnOp(reg1);
not(reg1)
|IL.opLENGTH:
|CODE.opLENGTH:
PushAll(2);
CallRTL(pic, IL._length);
CallRTL(pic, CODE._length);
GetRegA
|IL.opLENGTHW:
|CODE.opLENGTHW:
PushAll(2);
CallRTL(pic, IL._lengthw);
CallRTL(pic, CODE._lengthw);
GetRegA
|IL.opCHR:
|CODE.opCHR:
UnOp(reg1);
andrc(reg1, 255)
|IL.opWCHR:
|CODE.opWCHR:
UnOp(reg1);
andrc(reg1, 65535)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
|CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR:
UnOp(reg1);
IF reg1 # ecx THEN
ASSERT(REG.GetReg(R, ecx));
1346,10 → 1423,10
BinOp(reg1, reg2);
ASSERT(reg2 = ecx);
OutByte(0D3H);
shift(opcode, reg1); // shift reg1, cl
shift(cmd.opcode, reg1); // shift reg1, cl
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
|CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1:
UnOp(reg1);
IF reg1 # ecx THEN
ASSERT(REG.GetReg(R, ecx));
1357,30 → 1434,30
drop
END;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
movrc(reg1, param2);
BinOp(reg1, reg2);
ASSERT(reg1 = ecx);
OutByte(0D3H);
shift(opcode, reg2); // shift reg2, cl
shift(cmd.opcode, reg2); // shift reg2, cl
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2:
|CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2:
UnOp(reg1);
n := param2 MOD 32;
n := ORD(BITS(param2) * {0..4});
IF n # 1 THEN
OutByte(0C1H)
ELSE
OutByte(0D1H)
END;
shift(opcode, reg1); // shift reg1, n
shift(cmd.opcode, reg1); // shift reg1, n
IF n # 1 THEN
OutByte(n)
END
|IL.opMIN:
|CODE.opMIN:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(07EH, 002H); // jle @f
1388,7 → 1465,7
// @@:
drop
|IL.opMAX:
|CODE.opMAX:
BinOp(reg1, reg2);
cmprr(reg1, reg2);
OutByte2(07DH, 002H); // jge @f
1396,21 → 1473,21
// @@:
drop
|IL.opMINC:
|CODE.opMINC:
UnOp(reg1);
cmprc(reg1, param2);
OutByte2(07EH, 005H); // jle @f
movrc(reg1, param2) // mov reg1, param2
movrc(reg1, param2); // mov reg1, param2
// @@:
|IL.opMAXC:
|CODE.opMAXC:
UnOp(reg1);
cmprc(reg1, param2);
OutByte2(07DH, 005H); // jge @f
movrc(reg1, param2) // mov reg1, param2
movrc(reg1, param2); // mov reg1, param2
// @@:
|IL.opIN:
|CODE.opIN:
label := NewLabel();
BinOp(reg1, reg2);
cmprc(reg1, 32);
1424,10 → 1501,10
SetLabel(label);
drop
|IL.opINR:
|CODE.opINR:
label := NewLabel();
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
cmprc(reg1, 32);
OutByte2(72H, 4); // jb L
xor(reg1, reg1);
1440,42 → 1517,42
SetLabel(label);
drop
|IL.opINL:
|CODE.opINL:
UnOp(reg1);
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2
setcc(setc, reg1);
andrc(reg1, 1)
|IL.opRSET:
|CODE.opRSET:
PushAll(2);
CallRTL(pic, IL._set);
CallRTL(pic, CODE._set);
GetRegA
|IL.opRSETR:
|CODE.opRSETR:
PushAll(1);
pushc(param2);
CallRTL(pic, IL._set);
CallRTL(pic, CODE._set);
GetRegA
|IL.opRSETL:
|CODE.opRSETL:
PushAll(1);
pushc(param2);
CallRTL(pic, IL._set2);
CallRTL(pic, CODE._set2);
GetRegA
|IL.opRSET1:
|CODE.opRSET1:
UnOp(reg1);
PushAll(1);
push(reg1);
CallRTL(pic, IL._set);
CallRTL(pic, CODE._set);
GetRegA
|IL.opINCL, IL.opEXCL:
|CODE.opINCL, CODE.opEXCL:
BinOp(reg1, reg2);
cmprc(reg1, 32);
OutByte2(73H, 03H); // jnb L
OutByte(0FH);
IF opcode = IL.opINCL THEN
IF cmd.opcode = CODE.opINCL THEN
OutByte(0ABH) // bts dword[reg2], reg1
ELSE
OutByte(0B3H) // btr dword[reg2], reg1
1485,27 → 1562,27
drop;
drop
|IL.opINCLC:
|CODE.opINCLC:
UnOp(reg1);
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2
drop
|IL.opEXCLC:
|CODE.opEXCLC:
UnOp(reg1);
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2
drop
|IL.opDIV:
|CODE.opDIV:
PushAll(2);
CallRTL(pic, IL._div);
CallRTL(pic, CODE._div);
GetRegA
|IL.opDIVR:
|CODE.opDIVR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := log2(-a)
ELSE
n := -1
END;
1520,7 → 1597,7
UnOp(reg1);
IF a < 0 THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
mov(reg2, reg1);
IF n # 1 THEN
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n
1540,28 → 1617,28
ELSE
PushAll(1);
pushc(param2);
CallRTL(pic, IL._div);
CallRTL(pic, CODE._div);
GetRegA
END
END
|IL.opDIVL:
|CODE.opDIVL:
PushAll(1);
pushc(param2);
CallRTL(pic, IL._div2);
CallRTL(pic, CODE._div2);
GetRegA
|IL.opMOD:
|CODE.opMOD:
PushAll(2);
CallRTL(pic, IL._mod);
CallRTL(pic, CODE._mod);
GetRegA
|IL.opMODR:
|CODE.opMODR:
a := param2;
IF a > 1 THEN
n := UTILS.Log2(a)
n := log2(a)
ELSIF a < -1 THEN
n := UTILS.Log2(-a)
n := log2(-a)
ELSE
n := -1
END;
1589,83 → 1666,100
ELSE
PushAll(1);
pushc(param2);
CallRTL(pic, IL._mod);
CallRTL(pic, CODE._mod);
GetRegA
END
END
|IL.opMODL:
|CODE.opMODL:
PushAll(1);
pushc(param2);
CallRTL(pic, IL._mod2);
CallRTL(pic, CODE._mod2);
GetRegA
|IL.opERR:
CallRTL(pic, IL._error)
|CODE.opERR:
CallRTL(pic, CODE._error)
|IL.opABS:
|CODE.opABS:
UnOp(reg1);
test(reg1);
OutByte2(07DH, 002H); // jge @f
neg(reg1) // neg reg1
neg(reg1); // neg reg1
// @@:
|IL.opCOPY:
|CODE.opCOPY:
PushAll(2);
pushc(param2);
CallRTL(pic, IL._move2)
CallRTL(pic, CODE._move2)
|IL.opMOVE:
|CODE.opMOVE:
PushAll(3);
CallRTL(pic, IL._move2)
CallRTL(pic, CODE._move2)
|IL.opCOPYA:
|CODE.opCOPYA:
PushAll(4);
pushc(param2);
CallRTL(pic, IL._arrcpy);
CallRTL(pic, CODE._arrcpy);
GetRegA
|IL.opCOPYS:
|CODE.opCOPYS:
PushAll(4);
pushc(param2);
CallRTL(pic, IL._strcpy)
CallRTL(pic, CODE._strcpy)
|IL.opROT:
|CODE.opCOPYS2:
PushAll(4);
pushc(param2);
CallRTL(pic, CODE._strcpy2)
|CODE.opROT:
PushAll(0);
push(esp);
pushc(param2);
CallRTL(pic, IL._rot)
CallRTL(pic, CODE._rot)
|IL.opNEW:
|CODE.opNEW:
PushAll(1);
n := param2 + 8;
ASSERT(UTILS.Align(n, 32));
ASSERT(MACHINE.Align(n, 32));
pushc(n);
pushc(param1);
CallRTL(pic, IL._new)
CallRTL(pic, CODE._new)
|IL.opDISP:
|CODE.opDISP:
PushAll(1);
CallRTL(pic, IL._dispose)
CallRTL(pic, CODE._dispose)
|IL.opEQS .. IL.opGES:
|CODE.opEQS .. CODE.opGES:
PushAll(4);
pushc(opcode - IL.opEQS);
CallRTL(pic, IL._strcmp);
pushc(cmd.opcode - CODE.opEQS);
CallRTL(pic, CODE._strcmp);
GetRegA
|IL.opEQSW .. IL.opGESW:
|CODE.opEQS2 .. CODE.opGES2:
PushAll(4);
pushc(opcode - IL.opEQSW);
CallRTL(pic, IL._strcmpw);
pushc(cmd.opcode - CODE.opEQS2);
CallRTL(pic, CODE._strcmp2);
GetRegA
|IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP:
|CODE.opEQSW .. CODE.opGESW:
PushAll(4);
pushc(cmd.opcode - CODE.opEQSW);
CallRTL(pic, CODE._strcmpw);
GetRegA
|CODE.opEQSW2 .. CODE.opGESW2:
PushAll(4);
pushc(cmd.opcode - CODE.opEQSW2);
CallRTL(pic, CODE._strcmpw2);
GetRegA
|CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP:
UnOp(reg1);
CASE opcode OF
|IL.opEQP, IL.opNEP:
CASE cmd.opcode OF
|CODE.opEQP, CODE.opNEP:
IF pic THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
Pic(reg2, BIN.PICCODE, param1);
cmprr(reg1, reg2);
drop
1674,9 → 1768,9
Reloc(BIN.RCODE, param1)
END
|IL.opEQIP, IL.opNEIP:
|CODE.opEQIP, CODE.opNEIP:
IF pic THEN
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
Pic(reg2, BIN.PICIMP, param1);
OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2]
drop
1687,64 → 1781,64
END;
drop;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
CASE opcode OF
|IL.opEQP, IL.opEQIP: setcc(sete, reg1)
|IL.opNEP, IL.opNEIP: setcc(setne, reg1)
CASE cmd.opcode OF
|CODE.opEQP, CODE.opEQIP: setcc(sete, reg1)
|CODE.opNEP, CODE.opNEIP: setcc(setne, reg1)
END;
andrc(reg1, 1)
|IL.opPUSHT:
|CODE.opPUSHT:
UnOp(reg1);
reg2 := GetAnyReg();
reg2 := REG.GetAnyReg(R);
OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4]
|IL.opISREC:
|CODE.opISREC:
PushAll(2);
pushc(param2 * tcount);
CallRTL(pic, IL._isrec);
pushc(param2);
CallRTL(pic, CODE._isrec);
GetRegA
|IL.opIS:
|CODE.opIS:
PushAll(1);
pushc(param2 * tcount);
CallRTL(pic, IL._is);
pushc(param2);
CallRTL(pic, CODE._is);
GetRegA
|IL.opTYPEGR:
|CODE.opTYPEGR:
PushAll(1);
pushc(param2 * tcount);
CallRTL(pic, IL._guardrec);
pushc(param2);
CallRTL(pic, CODE._guardrec);
GetRegA
|IL.opTYPEGP:
|CODE.opTYPEGP:
UnOp(reg1);
PushAll(0);
push(reg1);
pushc(param2 * tcount);
CallRTL(pic, IL._guard);
pushc(param2);
CallRTL(pic, CODE._guard);
GetRegA
|IL.opTYPEGD:
|CODE.opTYPEGD:
UnOp(reg1);
PushAll(0);
OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4]
pushc(param2 * tcount);
CallRTL(pic, IL._guardrec);
pushc(param2);
CallRTL(pic, CODE._guardrec);
GetRegA
|IL.opCASET:
|CODE.opCASET:
push(ecx);
push(ecx);
pushc(param2 * tcount);
CallRTL(pic, IL._guardrec);
pushc(param2);
CallRTL(pic, CODE._guardrec);
pop(ecx);
test(eax);
jcc(jne, param1)
|IL.opPACK:
|CODE.opPACK:
BinOp(reg1, reg2);
push(reg2);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
1756,7 → 1850,7
drop;
drop
|IL.opPACKC:
|CODE.opPACKC:
UnOp(reg1);
pushc(param2);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
1767,7 → 1861,7
pop(reg1);
drop
|IL.opUNPK:
|CODE.opUNPK:
BinOp(reg1, reg2);
OutByte2(0DDH, reg1); // fld qword[reg1]
OutByte2(0D9H, 0F4H); // fxtract
1776,16 → 1870,16
drop;
drop
|IL.opPUSHF:
|CODE.opPUSHF:
subrc(esp, 8);
OutByte3(0DDH, 01CH, 024H) // fstp qword[esp]
|IL.opLOADF:
|CODE.opLOADF:
UnOp(reg1);
OutByte2(0DDH, reg1); // fld qword[reg1]
drop
|IL.opCONSTF:
|CODE.opCONSTF:
float := cmd.float;
IF float = 0.0 THEN
OutByte2(0D9H, 0EEH) // fldz
1802,36 → 1896,36
addrc(esp, 8)
END
|IL.opSAVEF:
|CODE.opSAVEF:
UnOp(reg1);
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1]
drop
|IL.opADDF, IL.opADDFI:
|CODE.opADDF, CODE.opADDFI:
OutByte2(0DEH, 0C1H) // faddp st1, st
|IL.opSUBF:
|CODE.opSUBF:
OutByte2(0DEH, 0E9H) // fsubp st1, st
|IL.opSUBFI:
|CODE.opSUBFI:
OutByte2(0DEH, 0E1H) // fsubrp st1, st
|IL.opMULF:
|CODE.opMULF:
OutByte2(0DEH, 0C9H) // fmulp st1, st
|IL.opDIVF:
|CODE.opDIVF:
OutByte2(0DEH, 0F9H) // fdivp st1, st
|IL.opDIVFI:
|CODE.opDIVFI:
OutByte2(0DEH, 0F1H) // fdivrp st1, st
|IL.opUMINF:
|CODE.opUMINF:
OutByte2(0D9H, 0E0H) // fchs
|IL.opFABS:
|CODE.opFABS:
OutByte2(0D9H, 0E1H) // fabs
|IL.opFLT:
|CODE.opFLT:
UnOp(reg1);
push(reg1);
OutByte3(0DBH, 004H, 024H); // fild dword[esp]
1838,7 → 1932,8
pop(reg1);
drop
|IL.opFLOOR:
|CODE.opFLOOR:
reg1 := REG.GetAnyReg(R);
subrc(esp, 8);
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4]
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6]
1847,11 → 1942,11
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4]
OutByte2(0D9H, 0FCH); // frndint
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp]
pop(GetAnyReg());
pop(reg1);
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2]
addrc(esp, 4)
|IL.opEQF:
|CODE.opEQF, CODE.opEQFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1861,7 → 1956,7
setcc(sete, al)
// L:
|IL.opNEF:
|CODE.opNEF, CODE.opNEFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1871,7 → 1966,7
setcc(setne, al)
// L:
|IL.opLTF:
|CODE.opLTF, CODE.opGTFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1885,7 → 1980,7
andrc(eax, 1)
// L:
|IL.opGTF:
|CODE.opGTF, CODE.opLTFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1899,7 → 1994,7
andrc(eax, 1)
// L:
|IL.opLEF:
|CODE.opLEF, CODE.opGEFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1909,7 → 2004,7
setcc(setnc, al)
// L:
|IL.opGEF:
|CODE.opGEF, CODE.opLEFI:
GetRegA;
OutByte2(0DAH, 0E9H); // fucompp
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax
1924,15 → 2019,15
andrc(eax, 1)
// L:
|IL.opINF:
|CODE.opINF:
pushc(7FF00000H);
pushc(0);
OutByte3(0DDH, 004H, 024H); // fld qword[esp]
addrc(esp, 8)
|IL.opLADR_UNPK:
|CODE.opLADR_UNPK:
n := param2 * 4;
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n]
OutIntByte(n);
BinOp(reg1, reg2);
1943,9 → 2038,9
drop;
drop
|IL.opSADR_PARAM:
|CODE.opSADR_PARAM:
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICDATA, stroffs + param2);
push(reg1);
drop
1954,17 → 2049,17
Reloc(BIN.RDATA, stroffs + param2)
END
|IL.opVADR_PARAM:
|CODE.opVADR_PARAM:
n := param2 * 4;
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n]
OutIntByte(n)
|IL.opCONST_PARAM:
|CODE.opCONST_PARAM:
pushc(param2)
|IL.opGLOAD32_PARAM:
|CODE.opGLOAD32_PARAM:
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICBSS, param2);
OutByte2(0FFH, 30H + reg1); // push dword[reg1]
drop
1973,36 → 2068,36
Reloc(BIN.RBSS, param2)
END
|IL.opLLOAD32_PARAM:
|CODE.opLLOAD32_PARAM:
n := param2 * 4;
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n]
OutIntByte(n)
|IL.opLOAD32_PARAM:
|CODE.opLOAD32_PARAM:
UnOp(reg1);
OutByte2(0FFH, 30H + reg1); // push dword[reg1]
drop
|IL.opGADR_SAVEC:
|CODE.opGADR_SAVEC:
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICBSS, param1);
OutByte2(0C7H, reg1); // mov dword[reg1], param2
OutInt(param2);
drop
ELSE
OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2
OutByte2(0C7H, 05H); // mov dword[_bss + param2], param2
Reloc(BIN.RBSS, param1);
OutInt(param2)
END
|IL.opLADR_SAVEC:
|CODE.opLADR_SAVEC:
n := param1 * 4;
OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2
OutIntByte(n);
OutInt(param2)
|IL.opLADR_SAVE:
|CODE.opLADR_SAVE:
n := param2 * 4;
UnOp(reg1);
OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1
2009,60 → 2104,96
OutIntByte(n);
drop
|IL.opLADR_INCC:
|CODE.opLADR_INC1:
n := param2 * 4;
OutByte2(0FFH, 45H + long(n)); // inc dword[ebp + n]
OutIntByte(n)
|CODE.opLADR_DEC1:
n := param2 * 4;
OutByte2(0FFH, 4DH + long(n)); // dec dword[ebp + n]
OutIntByte(n)
|CODE.opLADR_INCC:
n := param1 * 4;
IF ABS(param2) = 1 THEN
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n]
OutIntByte(n)
ELSE
OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2
OutIntByte(n);
OutIntByte(param2)
END
|IL.opLADR_INCCB, IL.opLADR_DECCB:
|CODE.opLADR_DECC:
n := param1 * 4;
IF param2 = 1 THEN
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n]
OutByte2(81H + short(param2), 6DH + long(n)); // sub dword[ebp + n], param2
OutIntByte(n);
OutIntByte(param2)
|CODE.opLADR_INC1B:
n := param2 * 4;
OutByte2(0FEH, 45H + long(n)); // inc byte[ebp + n]
OutIntByte(n)
ELSE
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2
|CODE.opLADR_DEC1B:
n := param2 * 4;
OutByte2(0FEH, 4DH + long(n)); // dec byte[ebp + n]
OutIntByte(n)
|CODE.opLADR_INCCB:
n := param1 * 4;
OutByte2(80H, 45H + long(n)); // add byte[ebp + n], param2
OutIntByte(n);
OutByte(param2 MOD 256)
END
|IL.opLADR_INC, IL.opLADR_DEC:
|CODE.opLADR_DECCB:
n := param1 * 4;
OutByte2(80H, 6DH + long(n)); // sub byte[ebp + n], param2
OutIntByte(n);
OutByte(param2 MOD 256)
|CODE.opLADR_INC:
n := param2 * 4;
UnOp(reg1);
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1
OutByte2(01H, 45H + long(n) + reg1 * 8); // add dword[ebp + n], reg1
OutIntByte(n);
drop
|IL.opLADR_INCB, IL.opLADR_DECB:
|CODE.opLADR_DEC:
n := param2 * 4;
UnOp(reg1);
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1
OutByte2(29H, 45H + long(n) + reg1 * 8); // sub dword[ebp + n], reg1
OutIntByte(n);
drop
|IL.opLADR_INCL, IL.opLADR_EXCL:
|CODE.opLADR_INCB:
n := param2 * 4;
UnOp(reg1);
OutByte2(00H, 45H + long(n) + reg1 * 8); // add byte[ebp + n], reg1
OutIntByte(n);
drop
|CODE.opLADR_DECB:
n := param2 * 4;
UnOp(reg1);
OutByte2(28H, 45H + long(n) + reg1 * 8); // sub byte[ebp + n], reg1
OutIntByte(n);
drop
|CODE.opLADR_INCL, CODE.opLADR_EXCL:
n := param2 * 4;
UnOp(reg1);
cmprc(reg1, 32);
label := NewLabel();
jcc(jnb, label);
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1
OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1
OutIntByte(n);
SetLabel(label);
drop
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
|CODE.opLADR_INCLC, CODE.opLADR_EXCLC:
n := param1 * 4;
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2
OutIntByte(n);
OutByte(param2)
|IL.opLOOP, IL.opENDLOOP:
|CODE.opLOOP, CODE.opENDLOOP:
END;
2075,9 → 2206,9
END translate;
PROCEDURE prolog (code: IL.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER);
PROCEDURE prolog (code: CODE.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER);
VAR
reg1, entry, dcount: INTEGER;
reg1, entry, tcount, dcount: INTEGER;
BEGIN
2090,7 → 2221,7
OutByte3(0FFH, 75H, 16); // push dword[ebp+16]
OutByte3(0FFH, 75H, 12); // push dword[ebp+12]
OutByte3(0FFH, 75H, 8); // push dword[ebp+8]
CallRTL(pic, IL._dllentry);
CallRTL(pic, CODE._dllentry);
test(eax);
jcc(je, dllret)
ELSIF target = mConst.Target_iObject THEN
2098,7 → 2229,7
END;
IF target = mConst.Target_iKolibri THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.IMPTAB, 0);
push(reg1); // push IMPORT
drop
2112,7 → 2243,7
END;
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICCODE, entry);
push(reg1); // push CODE
drop
2122,7 → 2253,7
END;
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICDATA, 0);
push(reg1); // push _data
drop
2131,12 → 2262,13
Reloc(BIN.RDATA, 0)
END;
tcount := CHL.Length(code.types);
dcount := CHL.Length(code.data);
pushc(tcount);
IF pic THEN
reg1 := GetAnyReg();
reg1 := REG.GetAnyReg(R);
Pic(reg1, BIN.PICDATA, tcount * 4 + dcount);
push(reg1); // push _data + tcount * 4 + dcount
drop
2145,34 → 2277,35
Reloc(BIN.RDATA, tcount * 4 + dcount)
END;
CallRTL(pic, IL._init)
CallRTL(pic, CODE._init)
END prolog;
PROCEDURE epilog (code: IL.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER);
PROCEDURE epilog (code: CODE.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret: INTEGER);
VAR
exp: IL.EXPORT_PROC;
i, n: INTEGER;
exp: CODE.EXPORT_PROC;
path, name, ext: PATHS.PATH;
dcount, i: INTEGER;
tcount, dcount: INTEGER;
PROCEDURE import (imp: LISTS.LIST);
VAR
lib: IL.IMPORT_LIB;
proc: IL.IMPORT_PROC;
lib: CODE.IMPORT_LIB;
proc: CODE.IMPORT_PROC;
BEGIN
lib := imp.first(IL.IMPORT_LIB);
lib := imp.first(CODE.IMPORT_LIB);
WHILE lib # NIL DO
BIN.Import(program, lib.name, 0);
proc := lib.procs.first(IL.IMPORT_PROC);
proc := lib.procs.first(CODE.IMPORT_PROC);
WHILE proc # NIL DO
BIN.Import(program, proc.name, proc.label);
proc := proc.next(IL.IMPORT_PROC)
proc := proc.next(CODE.IMPORT_PROC)
END;
lib := lib.next(IL.IMPORT_LIB)
lib := lib.next(CODE.IMPORT_LIB)
END
END import;
2182,7 → 2315,7
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN
pushc(0);
CallRTL(pic, IL._exit);
CallRTL(pic, CODE._exit);
ELSIF target = mConst.Target_iDLL THEN
SetLabel(dllret);
movrc(eax, 1);
2191,15 → 2324,11
ELSIF target = mConst.Target_iObject THEN
movrc(eax, 1);
OutByte(0C3H) // ret
ELSIF target = mConst.Target_iELFSO32 THEN
OutByte(0C3H); // ret
SetLabel(sofinit);
CallRTL(pic, IL._sofinit);
OutByte(0C3H) // ret
END;
fixup;
tcount := CHL.Length(code.types);
dcount := CHL.Length(code.data);
FOR i := 0 TO tcount - 1 DO
2221,30 → 2350,30
BIN.Export(program, "lib_init", dllinit);
END;
exp := code.export.first(IL.EXPORT_PROC);
exp := code.export.first(CODE.EXPORT_PROC);
WHILE exp # NIL DO
BIN.Export(program, exp.name, exp.label);
exp := exp.next(IL.EXPORT_PROC)
exp := exp.next(CODE.EXPORT_PROC)
END;
import(code.import);
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 4));
n := code.dmin - CHL.Length(code.data);
IF n > 0 THEN
INC(code.bss, n)
END;
BIN.SetParams(program, code.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536));
BIN.SetParams(program, MAX(code.bss, 4), stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536));
END epilog;
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base, ver: INTEGER; pic: BOOLEAN);
VAR
dllret, dllinit, sofinit: INTEGER;
opt: PROG.OPTIONS;
dllret, dllinit: INTEGER;
BEGIN
tcount := CHL.Length(code.types);
opt := options;
CodeList := LISTS.create(NIL);
program := BIN.create(code.lcount);
2251,32 → 2380,31
dllinit := NewLabel();
dllret := NewLabel();
sofinit := NewLabel();
IF target = mConst.Target_iObject THEN
opt.pic := FALSE
pic := FALSE
END;
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
opt.pic := TRUE
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32} THEN
pic := TRUE
END;
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {});
R := REG.Create(push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {});
prolog(code, opt.pic, target, opt.stack, dllinit, dllret);
translate(code, opt.pic, tcount * 4);
epilog(code, opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);
prolog(code, pic, target, stack, dllinit, dllret);
translate(code, pic, CHL.Length(code.types) * 4);
epilog(code, pic, outname, target, stack, ver, dllinit, dllret);
BIN.fixup(program);
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
PE32.write(program, outname, opt.base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE)
PE32.write(program, outname, base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE)
ELSIF target = mConst.Target_iKolibri THEN
KOS.write(program, outname)
ELSIF target = mConst.Target_iObject THEN
MSCOFF.write(program, outname, opt.version)
ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE)
MSCOFF.write(program, outname, ver)
ELSIF target = mConst.Target_iELF32 THEN
ELF.write(program, outname, FALSE)
END
END CodeGen;

/programs/develop/oberon07/Source/ARITH.ob07
7,7 → 7,7
MODULE ARITH;
IMPORT AVLTREES, STRINGS, UTILS;
IMPORT AVLTREES, STRINGS, MACHINE, UTILS;
CONST
53,7 → 53,10
ELSIF v.typ = tWCHAR THEN
res := v.int
ELSIF v.typ = tSET THEN
res := UTILS.Long(ORD(v.set))
res := ORD(v.set);
IF MACHINE._64to32 THEN
res := MACHINE.Int32To64(res)
END
ELSIF v.typ = tBOOLEAN THEN
res := ORD(v.bool)
END
85,13 → 88,13
BEGIN
error := FALSE;
IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN
IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN
error := TRUE
ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN
error := TRUE
ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN
error := TRUE
ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN
ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN
error := TRUE
END
169,7 → 172,7
n := i
END;
IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN
error := 2
ELSE
value := value * 16 + d;
178,7 → 181,9
END;
value := UTILS.Long(value);
IF MACHINE._64to32 THEN
value := MACHINE.Int32To64(value);
END;
IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
error := 3
466,53 → 471,58
PROCEDURE _ASR (x, n: INTEGER): INTEGER;
RETURN ASR(UTILS.Long(x), n)
BEGIN
IF MACHINE._64to32 THEN
x := MACHINE.Int32To64(x)
END
RETURN ASR(x, n)
END _ASR;
PROCEDURE _LSR (x, n: INTEGER): INTEGER;
RETURN UTILS.Long(LSR(UTILS.Short(x), n))
BEGIN
IF MACHINE._64to32 THEN
x := MACHINE.Int64To32(x);
x := LSR(x, n);
x := MACHINE.Int32To64(x)
ELSE
x := LSR(x, n)
END
RETURN x
END _LSR;
PROCEDURE _LSL (x, n: INTEGER): INTEGER;
RETURN UTILS.Long(LSL(x, n))
BEGIN
x := LSL(x, n);
IF MACHINE._64to32 THEN
x := MACHINE.Int32To64(x)
END
RETURN x
END _LSL;
PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
BEGIN
x := UTILS.Short(x);
x := MACHINE.Int64To32(x);
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
RETURN UTILS.Long(x)
RETURN MACHINE.Int32To64(x)
END _ROR1_32;
PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
BEGIN
x := x MOD 65536;
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
RETURN UTILS.Long(x)
END _ROR1_16;
PROCEDURE _ROR (x, n: INTEGER): INTEGER;
BEGIN
CASE UTILS.bit_diff OF
|0: x := ROR(x, n)
|16, 48:
n := n MOD 16;
WHILE n > 0 DO
x := _ROR1_16(x);
DEC(n)
END
|32:
IF MACHINE._64to32 THEN
n := n MOD 32;
WHILE n > 0 DO
x := _ROR1_32(x);
DEC(n)
END
ELSE
x := ROR(x, n)
END
RETURN x
577,7 → 587,11
CASE v.typ OF
|tCHAR, tWCHAR:
|tBOOLEAN: v.int := ORD(v.bool)
|tSET: v.int := UTILS.Long(ORD(v.set))
|tSET:
v.int := ORD(v.set);
IF MACHINE._64to32 THEN
v.int := MACHINE.Int32To64(v.int)
END
END;
v.typ := tINTEGER
END ord;
773,7 → 787,7
|"I":
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
IF range(v, 0, UTILS.target.maxSet) THEN
IF range(v, 0, MACHINE.target.maxSet) THEN
res := v.int IN v2.set
ELSE
error := 2

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

/programs/develop/oberon07/Source/BIN.ob07
7,7 → 7,7
MODULE BIN;
IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS;
CONST
138,10 → 138,7
END;
IF UTILS.bit_depth = 64 THEN
x := LSL(x, 16);
x := LSL(x, 16);
x := ASR(x, 16);
x := ASR(x, 16)
x := MACHINE.Int32To64(x)
END
RETURN x
154,7 → 151,7
BEGIN
FOR i := 0 TO 3 DO
CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
CHL.SetByte(array, idx + i, MACHINE.Byte(x, i))
END
END put32le;
165,7 → 162,7
BEGIN
FOR i := 0 TO 3 DO
CHL.PushByte(program.data, UTILS.Byte(x, i))
CHL.PushByte(program.data, MACHINE.Byte(x, i))
END
END PutData32LE;
176,7 → 173,7
BEGIN
FOR i := 0 TO 7 DO
CHL.PushByte(program.data, UTILS.Byte(x, i))
CHL.PushByte(program.data, MACHINE.Byte(x, i))
END
END PutData64LE;
206,7 → 203,7
BEGIN
FOR i := 0 TO 3 DO
CHL.PushByte(program.code, UTILS.Byte(x, i))
CHL.PushByte(program.code, MACHINE.Byte(x, i))
END
END PutCode32LE;
220,6 → 217,7
PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
VAR
imp: IMPRT;
i: INTEGER;
BEGIN
CHL.PushByte(program.import, 0);
230,9 → 228,16
END;
NEW(imp);
imp.nameoffs := CHL.PushStr(program.import, name);
imp.nameoffs := CHL.Length(program.import);
imp.label := label;
LISTS.push(program.imp_list, imp)
LISTS.push(program.imp_list, imp);
i := 0;
WHILE name[i] # 0X DO
CHL.PushByte(program.import, ORD(name[i]));
INC(i)
END;
CHL.PushByte(program.import, 0)
END Import;
257,12 → 262,20
PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
VAR
exp, cur: EXPRT;
i: INTEGER;
BEGIN
NEW(exp);
exp.nameoffs := CHL.Length(program.export);
exp.label := CHL.GetInt(program.labels, label);
exp.nameoffs := CHL.PushStr(program.export, name);
i := 0;
WHILE name[i] # 0X DO
CHL.PushByte(program.export, ORD(name[i]));
INC(i)
END;
CHL.PushByte(program.export, 0);
cur := program.exp_list.first(EXPRT);
WHILE (cur # NIL) & less(program.export, cur, exp) DO
cur := cur.next(EXPRT)
376,7 → 389,7
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
END;
INC(idx, k)
idx := idx + k
END InitArray;

/programs/develop/oberon07/Source/CHUNKLISTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
118,41 → 118,6
END PushByte;
PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
VAR
i, res: INTEGER;
BEGIN
res := list.length;
i := 0;
REPEAT
PushByte(list, ORD(str[i]));
INC(i)
UNTIL str[i - 1] = 0X
RETURN res
END PushStr;
PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
VAR
i: INTEGER;
res: BOOLEAN;
BEGIN
res := FALSE;
i := 0;
WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
str[i] := CHR(GetByte(list, pos));
res := str[i] = 0X;
INC(pos);
INC(i)
END
RETURN res
END GetStr;
PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST);
VAR
chunk: BYTECHUNK;

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

/programs/develop/oberon07/Source/CONSOLE.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
23,32 → 23,22
END String;
PROCEDURE Int* (x: INTEGER);
PROCEDURE Int* (n: INTEGER);
VAR
s: ARRAY 24 OF CHAR;
s: ARRAY 32 OF CHAR;
BEGIN
STRINGS.IntToStr(x, s);
STRINGS.IntToStr(n, s);
String(s)
END Int;
PROCEDURE Hex* (x, n: INTEGER);
VAR
s: ARRAY 24 OF CHAR;
PROCEDURE Int2* (n: INTEGER);
BEGIN
STRINGS.IntToHex(x, s, n);
String(s)
END Hex;
PROCEDURE Int2* (x: INTEGER);
BEGIN
IF x < 10 THEN
IF n < 10 THEN
String("0")
END;
Int(x)
Int(n)
END Int2;
65,16 → 55,16
END StringLn;
PROCEDURE IntLn* (x: INTEGER);
PROCEDURE IntLn* (n: INTEGER);
BEGIN
Int(x);
Int(n);
Ln
END IntLn;
PROCEDURE Int2Ln* (x: INTEGER);
PROCEDURE Int2Ln* (n: INTEGER);
BEGIN
Int2(x);
Int2(n);
Ln
END Int2Ln;

/programs/develop/oberon07/Source/CONSTANTS.ob07
9,8 → 9,8
CONST
vMajor* = 1;
vMinor* = 0;
vMajor* = 0;
vMinor* = 98;
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
26,10 → 26,7
Target_iGUI64* = 7;
Target_iDLL64* = 8;
Target_iELF32* = 9;
Target_iELFSO32* = 10;
Target_iELF64* = 11;
Target_iELFSO64* = 12;
Target_iMSP430* = 13;
Target_iELF64* = 10;
Target_sConsole* = "console";
Target_sGUI* = "gui";
40,10 → 37,7
Target_sGUI64* = "gui64";
Target_sDLL64* = "dll64";
Target_sELF32* = "elfexe";
Target_sELFSO32* = "elfso";
Target_sELF64* = "elfexe64";
Target_sELFSO64* = "elfso64";
Target_sMSP430* = "msp430";
END CONSTANTS.

/programs/develop/oberon07/Source/Compiler.ob07
7,7 → 7,7
MODULE Compiler;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER;
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER;
33,14 → 33,8
res := mConst.Target_iDLL64
ELSIF s = mConst.Target_sELF32 THEN
res := mConst.Target_iELF32
ELSIF s = mConst.Target_sELFSO32 THEN
res := mConst.Target_iELFSO32
ELSIF s = mConst.Target_sELF64 THEN
res := mConst.Target_iELF64
ELSIF s = mConst.Target_sELFSO64 THEN
res := mConst.Target_iELFSO64
ELSIF s = mConst.Target_sMSP430 THEN
res := mConst.Target_iMSP430
ELSE
res := 0
END
49,7 → 43,7
END Target;
PROCEDURE keys (VAR options: PROG.OPTIONS);
PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET);
VAR
param: PARS.PATH;
i, j: INTEGER;
57,10 → 51,8
value: INTEGER;
minor,
major: INTEGER;
checking: SET;
BEGIN
checking := options.checking;
end := FALSE;
i := 4;
REPEAT
70,7 → 62,7
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
options.stack := value
StackSize := value
END;
IF param[0] = "-" THEN
DEC(i)
80,32 → 72,12
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.base := ((value DIV 64) * 64) * 1024
BaseAddress := ((value DIV 64) * 64) * 1024
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-ram" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.ram := value
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-rom" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.rom := value
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-nochk" THEN
INC(i);
UTILS.GetArg(i, param);
137,15 → 109,14
END;
INC(j)
END;
END
END
ELSIF param = "-ver" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToVer(param, major, minor) THEN
options.version := major * 65536 + minor
Version := major * 65536 + minor
END;
IF param[0] = "-" THEN
DEC(i)
152,19 → 123,18
END
ELSIF param = "-pic" THEN
options.pic := TRUE
pic := TRUE
ELSIF param = "" THEN
end := TRUE
ELSE
ERRORS.BadParam(param)
ERRORS.error3("bad parameter: ", param, "")
END;
INC(i)
UNTIL end;
UNTIL end
options.checking := checking
END keys;
179,16 → 149,24
outname: PARS.PATH;
param: PARS.PATH;
temp: PARS.PATH;
target: INTEGER;
bit_depth: INTEGER;
time: INTEGER;
options: PROG.OPTIONS;
StackSize,
Version,
BaseAdr: INTEGER;
pic: BOOLEAN;
checking: SET;
bits64: BOOLEAN;
BEGIN
options.stack := 2;
options.version := 65536;
options.pic := FALSE;
options.checking := ST.chkALL;
StackSize := 2;
Version := 65536;
pic := FALSE;
checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path);
lib_path := app_path;
195,18 → 173,14
UTILS.GetArg(1, inname);
C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
C.StringLn("Copyright (c) 2018-2019, Anton Krotov");
IF inname = "" THEN
C.Ln;
C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln;
C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln;
IF UTILS.bit_depth = 64 THEN
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln;
ELSIF UTILS.bit_depth = 32 THEN
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln;
END;
C.StringLn("optional settings:"); C.Ln;
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln;
214,8 → 188,6
C.StringLn(' -ver <major.minor> set version of program'); C.Ln;
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430)"); C.Ln;
UTILS.Exit(0)
END;
222,9 → 194,8
PATHS.split(inname, path, modname, ext);
IF ext # mConst.FILE_EXT THEN
ERRORS.Error(207)
ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
END;
IF PATHS.isRelative(path) THEN
PATHS.RelPath(app_path, path, temp);
path := temp
232,7 → 203,7
UTILS.GetArg(2, outname);
IF outname = "" THEN
ERRORS.Error(205)
ERRORS.error1("not enough parameters")
END;
IF PATHS.isRelative(outname) THEN
PATHS.RelPath(app_path, outname, temp);
241,71 → 212,60
UTILS.GetArg(3, param);
IF param = "" THEN
ERRORS.Error(205)
ERRORS.error1("not enough parameters")
END;
target := Target(param);
IF target = 0 THEN
ERRORS.Error(206)
ERRORS.error1("bad parameter <target>")
END;
CASE target OF
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
bit_depth := 64
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32:
bit_depth := 32
|mConst.Target_iMSP430:
bit_depth := 16;
options.ram := MSP430.minRAM;
options.rom := MSP430.minROM
END;
bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
IF UTILS.bit_depth < bit_depth THEN
ERRORS.Error(206)
IF bits64 THEN
IF UTILS.bit_depth = 32 THEN
ERRORS.error1("bad parameter <target>")
END;
PARS.init(64, target)
ELSE
PARS.init(32, target)
END;
PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64};
PARS.program.obj := target = mConst.Target_iObject;
STRINGS.append(lib_path, "lib");
STRINGS.append(lib_path, UTILS.slash);
CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
IF target = mConst.Target_iDLL THEN
options.base := 10000000H
BaseAdr := 10000000H
ELSE
options.base := 400000H
BaseAdr := 400000H
END;
STRINGS.append(lib_path, "Windows32")
|mConst.Target_iKolibri, mConst.Target_iObject:
ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN
STRINGS.append(lib_path, "KolibriOS")
|mConst.Target_iELF32, mConst.Target_iELFSO32:
ELSIF target = mConst.Target_iELF32 THEN
STRINGS.append(lib_path, "Linux32")
|mConst.Target_iELF64, mConst.Target_iELFSO64:
ELSIF target = mConst.Target_iELF64 THEN
STRINGS.append(lib_path, "Linux64")
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64:
ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
STRINGS.append(lib_path, "Windows64")
|mConst.Target_iMSP430:
STRINGS.append(lib_path, "MSP430")
END;
STRINGS.append(lib_path, UTILS.slash);
keys(options);
keys(StackSize, BaseAdr, Version, pic, checking);
PARS.init(bit_depth, target, options);
ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking);
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
PARS.program.obj := target = mConst.Target_iObject;
ST.compile(path, lib_path, modname, outname, target, options);
time := UTILS.GetTickCount() - UTILS.time;
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");

/programs/develop/oberon07/Source/ELF.ob07
7,7 → 7,7
MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS;
CONST
68,35 → 68,9
END;
Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
d_tag, d_val: INTEGER
END;
Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
name, value, size: INTEGER;
info, other: CHAR;
shndx: WCHAR
END;
FILE = WR.FILE;
VAR
dynamic: LISTS.LIST;
strtab: CHL.BYTELIST;
symtab: LISTS.LIST;
hashtab, bucket, chain: CHL.INTLIST;
PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
162,75 → 136,7
END fixup;
PROCEDURE NewDyn (tag, val: INTEGER);
VAR
dyn: Elf32_Dyn;
BEGIN
NEW(dyn);
dyn.d_tag := tag;
dyn.d_val := val;
LISTS.push(dynamic, dyn)
END NewDyn;
PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
VAR
sym: Elf32_Sym;
BEGIN
NEW(sym);
sym.name := name;
sym.value := value;
sym.size := size;
sym.info := info;
sym.other := other;
sym.shndx := shndx;
LISTS.push(symtab, sym)
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;
BEGIN
FOR symi := 0 TO symCount - 1 DO
CHL.SetInt(chain, symi, 0);
hi := CHL.GetInt(hashtab, symi) MOD symCount;
IF CHL.GetInt(bucket, hi) # 0 THEN
k := symi;
WHILE CHL.GetInt(chain, k) # 0 DO
k := CHL.GetInt(chain, k)
END;
CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
END;
CHL.SetInt(bucket, hi, symi)
END
END MakeHash;
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN);
CONST
interp = 0;
dyn = 1;
239,67 → 145,33
data = 4;
bss = 5;
linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
linuxInterpreter32 = "/lib/ld-linux.so.2";
exeBaseAddress32 = 8048000H;
exeBaseAddress64 = 400000H;
dllBaseAddress = 0;
DT_NULL = 0;
DT_NEEDED = 1;
DT_HASH = 4;
DT_STRTAB = 5;
DT_SYMTAB = 6;
DT_RELA = 7;
DT_RELASZ = 8;
DT_RELAENT = 9;
DT_STRSZ = 10;
DT_SYMENT = 11;
DT_INIT = 12;
DT_FINI = 13;
DT_SONAME = 14;
DT_REL = 17;
DT_RELSZ = 18;
DT_RELENT = 19;
VAR
ehdr: Elf32_Ehdr;
phdr: ARRAY 16 OF Elf32_Phdr;
i, BaseAdr, offset, pad, VA, symCount: INTEGER;
i, LoadAdr, offset, pad, VA: INTEGER;
SizeOf: RECORD header, code, data, bss: INTEGER END;
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
File: FILE;
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
str: ARRAY 40 OF CHAR; lstr: INTEGER;
Dyn: ARRAY 350 OF BYTE;
item: LISTS.ITEM;
Name: ARRAY 2048 OF CHAR;
BEGIN
dynamic := LISTS.create(NIL);
symtab := LISTS.create(NIL);
strtab := CHL.CreateByteList();
IF amd64 THEN
BaseAdr := exeBaseAddress64;
Interpreter := linuxInterpreter64
str := "/lib64/ld-linux-x86-64.so.2"
ELSE
BaseAdr := exeBaseAddress32;
Interpreter := linuxInterpreter32
str := "/lib/ld-linux.so.2"
END;
lstr := LENGTH(str);
IF so THEN
BaseAdr := dllBaseAddress
IF amd64 THEN
LoadAdr := 400000H
ELSE
LoadAdr := 08048000H
END;
lenInterpreter := LENGTH(Interpreter) + 1;
SizeOf.code := CHL.Length(program.code);
SizeOf.data := CHL.Length(program.data);
SizeOf.bss := program.bss;
320,12 → 192,7
ehdr.e_ident[i] := 0
END;
IF so THEN
ehdr.e_type := WCHR(ET_DYN)
ELSE
ehdr.e_type := WCHR(ET_EXEC)
END;
ehdr.e_type := WCHR(ET_EXEC);
ehdr.e_version := 1;
ehdr.e_shoff := 0;
ehdr.e_flags := 0;
351,92 → 218,24
phdr[interp].p_type := 3;
phdr[interp].p_offset := SizeOf.header;
phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
phdr[interp].p_paddr := phdr[interp].p_vaddr;
phdr[interp].p_filesz := lenInterpreter;
phdr[interp].p_memsz := lenInterpreter;
phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset;
phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset;
phdr[interp].p_filesz := lstr + 1;
phdr[interp].p_memsz := lstr + 1;
phdr[interp].p_flags := PF_R;
phdr[interp].p_align := 1;
phdr[dyn].p_type := 2;
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
hashtab := CHL.CreateIntList();
CHL.PushInt(hashtab, HashStr(""));
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlopen"));
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlsym"));
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
IF so THEN
item := program.exp_list.first;
WHILE item # NIL DO
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
CHL.PushInt(hashtab, HashStr(Name));
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
item := item.next
END;
ASSERT(CHL.GetStr(program.data, program.modname, Name))
END;
symCount := LISTS.count(symtab);
bucket := CHL.CreateIntList();
chain := CHL.CreateIntList();
FOR i := 1 TO symCount DO
CHL.PushInt(bucket, 0);
CHL.PushInt(chain, 0)
END;
MakeHash(bucket, chain, symCount);
NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
NewDyn(DT_STRTAB, 0);
NewDyn(DT_STRSZ, CHL.Length(strtab));
NewDyn(DT_SYMTAB, 0);
phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset;
phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset;
IF amd64 THEN
NewDyn(DT_SYMENT, 24);
NewDyn(DT_RELA, 0);
NewDyn(DT_RELASZ, 48);
NewDyn(DT_RELAENT, 24)
phdr[dyn].p_filesz := 0A0H;
phdr[dyn].p_memsz := 0A0H
ELSE
NewDyn(DT_SYMENT, 16);
NewDyn(DT_REL, 0);
NewDyn(DT_RELSZ, 16);
NewDyn(DT_RELENT, 8)
phdr[dyn].p_filesz := 50H;
phdr[dyn].p_memsz := 50H
END;
NewDyn(DT_HASH, 0);
IF so THEN
NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
NewDyn(DT_INIT, 0);
NewDyn(DT_FINI, 0)
END;
NewDyn(DT_NULL, 0);
Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
Offset.dyn := phdr[dyn].p_offset;
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr;
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
phdr[dyn].p_memsz := phdr[dyn].p_filesz;
phdr[dyn].p_flags := PF_R;
phdr[dyn].p_align := 1;
444,15 → 243,20
phdr[header].p_type := 1;
phdr[header].p_offset := offset;
phdr[header].p_vaddr := BaseAdr;
phdr[header].p_paddr := BaseAdr;
phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
phdr[header].p_memsz := phdr[header].p_filesz;
phdr[header].p_vaddr := LoadAdr;
phdr[header].p_paddr := LoadAdr;
IF amd64 THEN
phdr[header].p_filesz := 305H;
phdr[header].p_memsz := 305H
ELSE
phdr[header].p_filesz := 1D0H;
phdr[header].p_memsz := 1D0H
END;
phdr[header].p_flags := PF_R + PF_W;
phdr[header].p_align := 1000H;
offset := offset + phdr[header].p_filesz;
VA := BaseAdr + offset + 1000H;
VA := LoadAdr + offset + 1000H;
phdr[text].p_type := 1;
phdr[text].p_offset := offset;
466,7 → 270,7
ehdr.e_entry := phdr[text].p_vaddr;
offset := offset + phdr[text].p_filesz;
VA := BaseAdr + offset + 2000H;
VA := LoadAdr + offset + 2000H;
pad := (16 - VA MOD 16) MOD 16;
phdr[data].p_type := 1;
479,7 → 283,7
phdr[data].p_align := 1000H;
offset := offset + phdr[data].p_filesz;
VA := BaseAdr + offset + 3000H;
VA := LoadAdr + offset + 3000H;
phdr[bss].p_type := 1;
phdr[bss].p_offset := offset;
490,21 → 294,8
phdr[bss].p_flags := PF_R + PF_W;
phdr[bss].p_align := 1000H;
fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
item := symtab.first;
WHILE item # NIL DO
IF item(Elf32_Sym).value # 0 THEN
INC(item(Elf32_Sym).value, ehdr.e_entry)
END;
item := item.next
END;
IF so THEN
item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
END;
File := WR.Create(FileName);
FOR i := 0 TO EI_NIDENT - 1 DO
549,95 → 340,35
WritePH(File, phdr[bss])
END;
FOR i := 0 TO lenInterpreter - 1 DO
WR.WriteByte(File, ORD(Interpreter[i]))
FOR i := 0 TO lstr DO
WR.WriteByte(File, ORD(str[i]))
END;
i := 0;
IF amd64 THEN
item := dynamic.first;
WHILE item # NIL DO
WR.Write64LE(File, item(Elf32_Dyn).d_tag);
WR.Write64LE(File, item(Elf32_Dyn).d_val);
item := item.next
END;
item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
WR.Write64LE(File, item(Elf32_Sym).value);
WR.Write64LE(File, item(Elf32_Sym).size);
item := item.next
END;
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16);
WR.Write32LE(File, 1);
WR.Write32LE(File, 1);
WR.Write64LE(File, 0);
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 1);
WR.Write32LE(File, 2);
WR.Write64LE(File, 0);
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write64LE(File, 0);
WR.Write64LE(File, 0)
BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000");
BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000");
BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000");
BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000");
BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000");
BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000");
BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000");
BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000");
BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000");
BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69");
BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000")
ELSE
item := dynamic.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Dyn).d_tag);
WR.Write32LE(File, item(Elf32_Dyn).d_val);
item := item.next
BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408");
BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000");
BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000");
BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000");
BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000");
BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32");
BIN.InitArray(Dyn, i, "000000000000000000")
END;
item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.Write32LE(File, item(Elf32_Sym).value);
WR.Write32LE(File, item(Elf32_Sym).size);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
item := item.next
END;
WR.Write(File, Dyn, i);
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 00000101H);
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4);
WR.Write32LE(File, 00000201H);
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write32LE(File, 0);
WR.Write32LE(File, 0)
END;
CHL.WriteToFile(File, program.code);
WHILE pad > 0 DO
WR.WriteByte(File, 0);

/programs/develop/oberon07/Source/ERRORS.ob07
7,35 → 7,25
MODULE ERRORS;
IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS;
IMPORT C := CONSOLE, UTILS;
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
BEGIN
IF hint = 0 THEN
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
C.String("variable '"); C.String(name); C.StringLn("' never used")
END
END HintMsg;
END hintmsg;
PROCEDURE WarningMsg* (line, col, warning: INTEGER);
BEGIN
C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
CASE warning OF
|0: C.StringLn("passing a string value as a fixed array")
|1: C.StringLn("endless FOR loop")
END
END WarningMsg;
PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
VAR
str: ARRAY 80 OF CHAR;
BEGIN
C.Ln;
C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
CASE errno OF
| 1: str := "missing 'H' or 'X'"
46,7 → 36,6
| 6: str := "identifier too long"
| 7: str := "number too long"
| 8..12: str := "number too large"
| 13: str := "real numbers not supported"
| 21: str := "'MODULE' expected"
| 22: str := "identifier expected"
90,7 → 79,7
| 60: str := "identifier does not match procedure name"
| 61: str := "illegally marked identifier"
| 62: str := "expression should be constant"
| 63: str := "not enough RAM"
| 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected"
| 64: str := "'(' expected"
| 65: str := "',' expected"
| 66: str := "incompatible parameter"
137,7 → 126,7
|107: str := "too large parameter of CHR"
|108: str := "a variable or a procedure expected"
|109: str := "expression should be constant"
|110: str := "'noalign' expected"
|111: str := "record [noalign] cannot have a base type"
|112: str := "record [noalign] cannot be a base type"
|113: str := "result type of procedure should not be REAL"
144,74 → 133,39
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|115: str := "recursive constant definition"
|116: str := "procedure too deep nested"
|117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected"
|118: str := "this flag for Windows only"
|119: str := "this flag for Linux only"
|120: str := "too many formal parameters"
|122: str := "negative divisor"
|123: str := "illegal flag"
|124: str := "unknown flag"
|125: str := "flag not supported"
END;
C.StringLn(str);
C.String(" file: "); C.StringLn(fname);
UTILS.Exit(1)
END ErrorMsg;
END errormsg;
PROCEDURE Error1 (s1: ARRAY OF CHAR);
PROCEDURE error1* (s1: ARRAY OF CHAR);
BEGIN
C.Ln;
C.StringLn(s1);
UTILS.Exit(1)
END Error1;
END error1;
PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR);
BEGIN
C.Ln;
C.String(s1); C.String(s2); C.StringLn(s3);
UTILS.Exit(1)
END Error3;
END error3;
PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR);
BEGIN
C.Ln;
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
UTILS.Exit(1)
END Error5;
END error5;
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
BEGIN
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found")
END WrongRTL;
PROCEDURE BadParam* (param: ARRAY OF CHAR);
BEGIN
Error3("bad parameter: ", param, "")
END BadParam;
PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
BEGIN
Error5("file ", Path, Name, Ext, " not found")
END FileNotFound;
PROCEDURE Error* (n: INTEGER);
BEGIN
CASE n OF
|201: Error1("writing file error")
|202: Error1("too many relocations")
|203: Error1("size of program is too large")
|204: Error1("size of global variables is too large")
|205: Error1("not enough parameters")
|206: Error1("bad parameter <target>")
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
END
END Error;
END ERRORS.

/programs/develop/oberon07/Source/FILES.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)

/programs/develop/oberon07/Source/KOS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)

/programs/develop/oberon07/Source/LISTS.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
168,24 → 168,6
END count;
PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
VAR
item: ITEM;
BEGIN
ASSERT(list # NIL);
ASSERT(idx >= 0);
item := list.first;
WHILE (item # NIL) & (idx > 0) DO
item := item.next;
DEC(idx)
END
RETURN item
END getidx;
PROCEDURE create* (list: LIST): LIST;
BEGIN
IF list = NIL THEN

/programs/develop/oberon07/Source/MSCOFF.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
136,7 → 136,7
PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
BEGIN
IF NumberOfRelocations >= 65536 THEN
ERRORS.Error(202)
ERRORS.error1("too many relocations")
END;
section.NumberOfRelocations := WCHR(NumberOfRelocations)
END SetNumberOfRelocations;

/programs/develop/oberon07/Source/PARS.ob07
7,7 → 7,7
MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS;
CONST
24,12 → 24,6
PARSER* = POINTER TO rPARSER;
POSITION* = RECORD (SCAN.POSITION)
parser*: PARSER
END;
EXPR* = RECORD
obj*: INTEGER;
43,7 → 37,7
STATPROC = PROCEDURE (parser: PARSER);
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
rPARSER = RECORD (C.ITEM)
89,40 → 83,34
END destroy;
PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
BEGIN
pos.line := parser.lex.pos.line;
pos.col := parser.lex.pos.col;
pos.parser := parser
END getpos;
PROCEDURE error* (pos: POSITION; errno: INTEGER);
BEGIN
ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
ERRORS.errormsg(parser.fname, pos.line, pos.col, errno)
END error;
PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
BEGIN
IF ~condition THEN
error(pos, errno)
error(parser, pos, errno)
END
END check;
PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
VAR
pos: POSITION;
BEGIN
IF ~condition THEN
getpos(parser, pos);
error(pos, errno)
error(parser, parser.lex.pos, errno)
END
END check1;
PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
BEGIN
pos := parser.lex.pos
END getpos;
PROCEDURE Next* (parser: PARSER);
VAR
errno: INTEGER;
130,14 → 118,6
BEGIN
SCAN.Next(parser.scanner, parser.lex);
errno := parser.lex.error;
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
IF parser.lex.sym = SCAN.lxFLOAT THEN
errno := -SCAN.lxERROR13
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
errno := -SCAN.lxERROR10
END
END;
IF errno # 0 THEN
check1(FALSE, parser, errno)
END;
145,10 → 125,10
END Next;
PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION);
BEGIN
Next(parser);
getpos(parser, pos)
pos := parser.lex.pos
END NextPos;
200,12 → 180,15
VAR
name: SCAN.IDENT;
parser2: PARSER;
pos: POSITION;
pos: SCAN.POSITION;
alias: BOOLEAN;
unit: PROG.UNIT;
ident: PROG.IDENT;
units: PROG.UNITS;
BEGIN
units := program.units;
alias := FALSE;
REPEAT
216,8 → 199,8
getpos(parser, pos);
IF ~alias THEN
ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
check(ident # NIL, pos, 30)
ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE);
check(ident # NIL, parser, pos, 30)
END;
Next(parser);
224,10 → 207,10
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE;
unit := PROG.getUnit(program, name);
unit := units.get(units, name);
IF unit # NIL THEN
check(unit.closed, pos, 31)
check(unit.closed, parser, pos, 31)
ELSE
parser2 := parser.create(parser.path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
237,9 → 220,9
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.s), parser, pos, 29)
ELSE
error(pos, 29)
check(FALSE, parser, pos, 29)
END
END;
274,7 → 257,7
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
IF ~forward THEN
check1(ident # NIL, parser, 48)
284,7 → 267,7
unit := ident.unit;
ExpectSym(parser, SCAN.lxPOINT);
ExpectSym(parser, SCAN.lxIDENT);
ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
ident := unit.idents.get(unit, parser.lex.ident, FALSE);
check1((ident # NIL) & ident.export, parser, 48)
END
329,6 → 312,7
END;
ARITH.setbool(v, bool)
END strcmp;
335,7 → 319,7
PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
VAR
e: EXPR;
pos: POSITION;
pos: SCAN.POSITION;
BEGIN
getpos(parser, pos);
342,7 → 326,7
parser.constexp := TRUE;
parser.expression(parser, e);
parser.constexp := FALSE;
check(e.obj = eCONST, pos, 62);
check(e.obj = eCONST, parser, pos, 62);
v := e.value
END ConstExpression;
351,7 → 335,7
VAR
name: SCAN.IDENT;
export: BOOLEAN;
pos: POSITION;
pos: SCAN.POSITION;
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
371,7 → 355,7
Next(parser)
END;
check(PROG.addField(rec, name, export), pos, 30);
check(rec.fields.add(rec, name, export), parser, pos, 30);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
407,7 → 391,7
exit := FALSE;
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
check1(type.params.add(type, parser.lex.ident, vPar), parser, 30);
Next(parser);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
428,13 → 412,13
t1 := t0;
WHILE dim > 0 DO
t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
t1.base := t0;
t0 := t1;
DEC(dim)
END;
PROG.setParams(type, t1);
type.params.set(type, t1);
Next(parser);
exit := TRUE
ELSE
465,7 → 449,7
ExpectSym(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69);
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
type.base := ident.type;
Next(parser)
477,72 → 461,43
END FormalParameters;
PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
PROCEDURE sysflag (parser: PARSER): INTEGER;
VAR
res, sf: INTEGER;
res: INTEGER;
BEGIN
IF parser.lex.s = "stdcall" THEN
sf := PROG.sf_stdcall
res := PROG.stdcall
ELSIF parser.lex.s = "stdcall64" THEN
sf := PROG.sf_stdcall64
res := PROG.stdcall64
ELSIF parser.lex.s = "ccall" THEN
sf := PROG.sf_ccall
res := PROG.ccall
ELSIF parser.lex.s = "ccall16" THEN
sf := PROG.sf_ccall16
res := PROG.ccall16
ELSIF parser.lex.s = "win64" THEN
sf := PROG.sf_win64
res := PROG.win64
ELSIF parser.lex.s = "systemv" THEN
sf := PROG.sf_systemv
res := PROG.systemv
ELSIF parser.lex.s = "windows" THEN
sf := PROG.sf_windows
ELSIF parser.lex.s = "linux" THEN
sf := PROG.sf_linux
ELSIF parser.lex.s = "code" THEN
sf := PROG.sf_code
ELSIF parser.lex.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
check1(FALSE, parser, 124)
END;
check1(sf IN program.target.sysflags, parser, 125);
IF proc THEN
check1(sf IN PROG.proc_flags, parser, 123)
ELSE
check1(sf IN PROG.rec_flags, parser, 123)
END;
CASE sf OF
|PROG.sf_stdcall:
res := PROG.stdcall
|PROG.sf_stdcall64:
res := PROG.stdcall64
|PROG.sf_ccall:
res := PROG.ccall
|PROG.sf_ccall16:
res := PROG.ccall16
|PROG.sf_win64:
res := PROG.win64
|PROG.sf_systemv:
res := PROG.systemv
|PROG.sf_code:
res := PROG.code
|PROG.sf_windows:
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
res := PROG.stdcall
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
res := PROG.win64
ELSE
check1(FALSE, parser, 118)
END
|PROG.sf_linux:
IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
ELSIF parser.lex.s = "linux" THEN
IF program.target.sys = mConst.Target_iELF32 THEN
res := PROG.ccall16
ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
ELSIF program.target.sys = mConst.Target_iELF64 THEN
res := PROG.systemv
ELSE
check1(FALSE, parser, 119)
END
|PROG.sf_noalign:
ELSIF parser.lex.s = "noalign" THEN
res := PROG.noalign
ELSE
res := 0
END
RETURN res
549,11 → 504,11
END sysflag;
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
dll, proc: SCAN.LEXSTR;
pos: POSITION;
pos: SCAN.POSITION;
BEGIN
563,7 → 518,12
getpos(parser, pos);
check1(parser.unit.sysimport, parser, 54);
Next(parser);
call := sysflag(parser, TRUE);
call := sysflag(parser);
IF program.target.bit_depth = 64 THEN
check1(call IN PROG.callconv64, parser, 117)
ELSIF program.target.bit_depth = 32 THEN
check1(call IN PROG.callconv32, parser, 63)
END;
Next(parser);
IF parser.sym = SCAN.lxMINUS THEN
Next(parser);
579,21 → 539,20
ExpectSym(parser, SCAN.lxSTRING);
proc := parser.lex.s;
Next(parser);
import := IL.AddImp(dll, proc)
import := CODE.AddImp(dll, proc)
END;
checklex(parser, SCAN.lxRSQUARE);
Next(parser)
ELSE
CASE program.target.bit_depth OF
|16: call := PROG.default16
|32: call := PROG.default32
|64: call := PROG.default64
IF program.target.bit_depth = 32 THEN
call := PROG.default
ELSIF program.target.bit_depth = 64 THEN
call := PROG.default64
END
END;
IF import # NIL THEN
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70)
END
RETURN call
611,12 → 570,12
typeSize: ARITH.VALUE;
ident: PROG.IDENT;
unit: PROG.UNIT;
pos, pos2: POSITION;
pos, pos2: SCAN.POSITION;
fieldType: PROG.TYPE_;
baseIdent: SCAN.IDENT;
a, b: INTEGER;
RecFlag: INTEGER;
import: IL.IMPORT_PROC;
import: CODE.IMPORT_PROC;
BEGIN
unit := parser.unit;
645,11 → 604,11
ConstExpression(parser, arrLen);
check(arrLen.typ = ARITH.tINTEGER, pos, 43);
check(ARITH.check(arrLen), pos, 39);
check(ARITH.getInt(arrLen) > 0, pos, 51);
check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43);
check(ARITH.check(arrLen), parser, pos, 39);
check(ARITH.getInt(arrLen) > 0, parser, pos, 51);
t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
IF parser.sym = SCAN.lxCOMMA THEN
type(parser, t.base, {comma, closed})
664,8 → 623,8
a := t.length;
b := t.base.size;
check(ARITH.mulInt(a, b), pos2, 104);
check(ARITH.setInt(typeSize, a), pos2, 104);
check(ARITH.mulInt(a, b), parser, pos2, 104);
check(ARITH.setInt(typeSize, a), parser, pos2, 104);
t.size := a;
t.closed := TRUE
674,14 → 633,19
getpos(parser, pos2);
Next(parser);
t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
t := program.enterType(program, PROG.tRECORD, 0, 0, unit);
t.align := 1;
IF parser.sym = SCAN.lxLSQUARE THEN
check1(parser.unit.sysimport, parser, 54);
Next(parser);
RecFlag := sysflag(parser, FALSE);
t.noalign := RecFlag = PROG.noalign;
RecFlag := sysflag(parser);
IF RecFlag = PROG.noalign THEN
t.noalign := TRUE
ELSE
check1(FALSE, parser, 110)
END;
ExpectSym(parser, SCAN.lxRSQUARE);
Next(parser)
END;
693,14 → 657,14
type(parser, t.base, {closed});
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52);
IF t.base.typ = PROG.tPOINTER THEN
t.base := t.base.base;
check(t.base # NIL, pos, 55)
check(t.base # NIL, parser, pos, 55)
END;
check(~t.base.noalign, pos, 112);
check(~t.base.noalign, parser, pos, 112);
checklex(parser, SCAN.lxRROUND);
Next(parser);
720,7 → 684,7
Next(parser);
type(parser, fieldType, {closed});
check(PROG.setFields(t, fieldType), pos2, 104);
check(t.fields.set(t, fieldType), parser, pos2, 104);
IF (fieldType.align > t.align) & ~t.noalign THEN
t.align := fieldType.align
735,11 → 699,11
t.closed := TRUE;
IL.AddRec(t.base.num);
CODE.AddRec(t.base.num);
IF ~t.noalign THEN
check(UTILS.Align(t.size, t.align), pos2, 104);
check(ARITH.setInt(typeSize, t.size), pos2, 104)
check(MACHINE.Align(t.size, t.align), parser, pos2, 104);
check(ARITH.setInt(typeSize, t.size), parser, pos2, 104)
END;
checklex(parser, SCAN.lxEND);
749,7 → 713,7
ExpectSym(parser, SCAN.lxTO);
Next(parser);
t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
t.align := program.target.adr;
getpos(parser, pos);
761,14 → 725,14
type(parser, t.base, {forward});
IF t.base # NIL THEN
check(t.base.typ = PROG.tRECORD, pos, 58)
check(t.base.typ = PROG.tRECORD, parser, pos, 58)
ELSE
PROG.frwPtr(unit, t, baseIdent, pos)
unit.pointers.add(unit, t, baseIdent, pos)
END
ELSIF parser.sym = SCAN.lxPROCEDURE THEN
NextPos(parser, pos);
t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t.align := program.target.adr;
t.call := procflag(parser, import, FALSE);
FormalParameters(parser, t)
782,7 → 746,7
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
VAR
ident: PROG.IDENT;
pos: POSITION;
pos: SCAN.POSITION;
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
789,8 → 753,8
name := parser.lex.ident;
getpos(parser, pos);
ident := PROG.addIdent(parser.unit, name, typ);
check(ident # NIL, pos, 30);
ident := parser.unit.idents.add(parser.unit, name, typ);
check(ident # NIL, parser, pos, 30);
ident.pos := pos;
Next(parser);
808,7 → 772,7
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
pos: POSITION;
pos: SCAN.POSITION;
BEGIN
IF const THEN
823,12 → 787,12
IF const THEN
ConstExpression(parser, ident.value);
IF ident.value.typ = ARITH.tINTEGER THEN
check(ARITH.check(ident.value), pos, 39)
check(ARITH.check(ident.value), parser, pos, 39)
ELSIF ident.value.typ = ARITH.tREAL THEN
check(ARITH.check(ident.value), pos, 40)
check(ARITH.check(ident.value), parser, pos, 40)
END;
ident.typ := PROG.idCONST;
ident.type := PROG.getType(program, ident.value.typ)
ident.type := program.getType(program, ident.value.typ)
ELSE
type(parser, ident.type, {})
END;
855,7 → 819,7
ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser);
type(parser, t, {});
PROG.setVarsType(parser.unit, t);
parser.unit.setvars(parser.unit, t);
checklex(parser, SCAN.lxSEMI);
Next(parser)
ELSE
871,7 → 835,6
VAR
ptr: PROG.FRWPTR;
endmod: BOOLEAN;
pos: POSITION;
PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
879,24 → 842,20
proc: PROG.IDENT;
endname,
name: SCAN.IDENT;
param: PROG.PARAM;
param: LISTS.ITEM;
unit: PROG.UNIT;
ident: PROG.IDENT;
e: EXPR;
pos, pos1,
pos2: POSITION;
pos: SCAN.POSITION;
label: INTEGER;
enter: IL.COMMAND;
enter: CODE.COMMAND;
call: INTEGER;
t: PROG.TYPE_;
import: IL.IMPORT_PROC;
import: CODE.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
variables: LISTS.LIST;
int, flt: INTEGER;
comma: BOOLEAN;
code: ARITH.VALUE;
codeProc: BOOLEAN;
BEGIN
endmod := FALSE;
906,7 → 865,6
call := procflag(parser, import, TRUE);
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
IF import # NIL THEN
917,9 → 875,9
proc := IdentDef(parser, PROG.idPROC, name)
END;
check(PROG.openScope(unit, proc.proc), pos, 116);
check(unit.scope.open(unit, proc.proc), parser, pos, 116);
proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t := proc.type;
t.align := program.target.adr;
t.call := call;
926,112 → 884,76
FormalParameters(parser, t);
codeProc := call IN {PROG.code, PROG._code};
IF call IN {PROG.systemv, PROG._systemv} THEN
check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120)
END;
param := t.params.first(PROG.PARAM);
param := t.params.first;
WHILE param # NIL DO
ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM);
ASSERT(ident # NIL);
ident.type := param.type;
ident.offset := param.offset;
IF param.vPar THEN
ident.type := param(PROG.PARAM).type;
ident.offset := param(PROG.PARAM).offset;
IF param(PROG.PARAM).vPar THEN
ident.typ := PROG.idVPAR
END;
param := param.next(PROG.PARAM)
param := param.next
END;
IF import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label
END;
IF codeProc THEN
enter := IL.EnterC(label);
comma := FALSE;
WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
getpos(parser, pos2);
ConstExpression(parser, code);
check(code.typ = ARITH.tINTEGER, pos2, 43);
IF program.target.sys # mConst.Target_iMSP430 THEN
check(ARITH.range(code, 0, 255), pos2, 42)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
IF comma THEN
Next(parser)
ELSE
checklex(parser, SCAN.lxSEMI)
END
END
END;
checklex(parser, SCAN.lxSEMI);
Next(parser);
IF import = NIL THEN
label := CODE.NewLabel();
proc.proc.label := label;
IF parser.main & proc.export & program.dll THEN
IF program.obj THEN
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114)
END;
IL.AddExp(label, proc.name.s);
CODE.AddExp(label, proc.name.s);
proc.proc.used := TRUE
END;
IF ~codeProc THEN
b := DeclarationSequence(parser)
END;
b := DeclarationSequence(parser);
program.locsize := 0;
IF call IN {PROG._win64, PROG.win64} THEN
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
fparams := proc.type.params.getfparams(proc.type, 3, int, flt);
enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4))
ELSIF call IN {PROG._systemv, PROG.systemv} THEN
fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
ELSIF codeProc THEN
fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size))
ELSE
enter := IL.Enter(label, 0)
enter := CODE.Enter(label, 0)
END;
proc.proc.enter := enter;
IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
IF parser.sym = SCAN.lxBEGIN THEN
Next(parser);
parser.StatSeq(parser)
END;
IF ~codeProc & (t.base # NIL) THEN
IF t.base # NIL THEN
checklex(parser, SCAN.lxRETURN);
NextPos(parser, pos);
parser.expression(parser, e);
check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87)
END;
IF ~codeProc THEN
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL),
t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
enter.param2 := program.locsize;
checklex(parser, SCAN.lxEND)
ELSE
proc.proc.leave := IL.LeaveC()
END;
IF program.target.sys = mConst.Target_iMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
END
END;
IF parser.sym = SCAN.lxEND THEN
ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (import = NIL) THEN
check(endname = name, pos, 60);
IF import = NIL THEN
check(endname = name, parser, pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
1043,20 → 965,20
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
error(pos, 60)
check(FALSE, parser, pos, 60)
END
END
END;
IF ~codeProc & (import = NIL) THEN
IF import = NIL THEN
variables := LISTS.create(NIL);
ELSE
variables := NIL
END;
PROG.closeScope(unit, variables);
unit.scope.close(unit, variables);
IF ~codeProc & (import = NIL) THEN
IF import = NIL THEN
enter.variables := variables
END
1079,15 → 1001,12
END
END;
ptr := PROG.linkPtr(parser.unit);
ptr := parser.unit.pointers.link(parser.unit);
IF ptr # NIL THEN
pos.line := ptr.pos.line;
pos.col := ptr.pos.col;
pos.parser := parser;
IF ptr.notRecord THEN
error(pos, 58)
error(parser, ptr.pos, 58)
ELSE
error(pos, 48)
error(parser, ptr.pos, 48)
END
END;
1114,8 → 1033,6
label: INTEGER;
name: INTEGER;
endmod: BOOLEAN;
errlabel: INTEGER;
errno: INTEGER;
BEGIN
ASSERT(parser # NIL);
1128,7 → 1045,7
check1(parser.lex.s = parser.modname, parser, 23)
END;
unit := PROG.newUnit(program, parser.lex.ident);
unit := program.units.create(program.units, parser.lex.ident);
parser.unit := unit;
1145,26 → 1062,19
END;
CONSOLE.Ln;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
label := CODE.NewLabel();
CODE.AddJmpCmd(CODE.opJMP, label);
name := IL.putstr(unit.name.s);
name := CODE.putstr(unit.name.s);
errlabel := IL.NewLabel();
IL.SetLabel(errlabel);
IL.StrAdr(name);
IL.Param1;
IL.AddCmd0(IL.opERR);
CODE.SetErrLabel;
CODE.AddCmd(CODE.opSADR, name);
CODE.AddCmd(CODE.opPARAM, 1);
CODE.AddCmd0(CODE.opERR);
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
IL.SetErrLabel(errno);
IL.AddCmd(IL.opPUSHC, errno);
IL.AddJmpCmd(IL.opJMP, errlabel)
END;
endmod := DeclarationSequence(parser);
IL.SetLabel(label);
CODE.SetLabel(label);
IF ~endmod THEN
1181,7 → 1091,8
END;
PROG.closeUnit(unit)
unit.close(unit)
END parse;
1245,9 → 1156,9
END create;
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
PROCEDURE init* (bit_depth, sys: INTEGER);
BEGIN
program := PROG.create(bit_depth, target, options);
program := PROG.create(bit_depth, sys);
parsers := C.create()
END init;

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

/programs/develop/oberon07/Source/PROG.ob07
7,7 → 7,7
MODULE PROG;
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS;
IMPORT SCAN, LISTS, ARITH, ERRORS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS, CODE, UTILS;
CONST
39,10 → 39,9
sysMOVE* = 27; stLENGTH* = 28; stMIN* = 29; stMAX* = 30;
sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34;
sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38;
sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42;
sysDINT* = 43;*)
sysWSADR* = 39; sysPUT32* = 40;
default32* = 2;
default* = 2;
stdcall* = 4; _stdcall* = stdcall + 1;
ccall* = 6; _ccall* = ccall + 1;
ccall16* = 8; _ccall16* = ccall16 + 1;
50,34 → 49,19
stdcall64* = 12; _stdcall64* = stdcall64 + 1;
default64* = 14;
systemv* = 16; _systemv* = systemv + 1;
default16* = 18;
code* = 20; _code* = code + 1;
noalign* = 22;
noalign* = 20;
callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64};
caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv};
callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16};
callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv};
sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
sf_code* = 8;
sf_noalign* = 9;
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code};
rec_flags* = {sf_noalign};
STACK_FRAME = 2;
TYPE
OPTIONS* = RECORD
version*, stack*, base*, ram*, rom*: INTEGER;
pic*: BOOLEAN;
checking*: SET
END;
IDENT* = POINTER TO rIDENT;
UNIT* = POINTER TO rUNIT;
97,6 → 81,13
END;
IDENTS = POINTER TO RECORD (LISTS.LIST)
add*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
get*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT
END;
PROC* = POINTER TO RECORD (LISTS.ITEM)
label*: INTEGER;
119,30 → 110,66
program*: PROGRAM;
name*: SCAN.IDENT;
idents*: LISTS.LIST;
idents*: IDENTS;
frwPointers: LISTS.LIST;
gscope: IDENT;
closed*: BOOLEAN;
scopeLvl*: INTEGER;
sysimport*: BOOLEAN;
scopes*: ARRAY MAXSCOPE OF PROC
scopes*: ARRAY MAXSCOPE OF PROC;
scope*: RECORD
open*: PROCEDURE (unit: UNIT; proc: PROC): BOOLEAN;
close*: PROCEDURE (unit: UNIT; variables: LISTS.LIST)
END;
close*: PROCEDURE (unit: UNIT);
setvars*: PROCEDURE (unit: UNIT; type: TYPE_);
pointers*: RECORD
add*: PROCEDURE (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
link*: PROCEDURE (unit: UNIT): FRWPTR
END
END;
FIELD* = POINTER TO rFIELD;
PARAM* = POINTER TO rPARAM;
FIELDS = POINTER TO RECORD (LISTS.LIST)
add*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
get*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
set*: PROCEDURE (rec: TYPE_; type: TYPE_): BOOLEAN
END;
PARAMS = POINTER TO RECORD (LISTS.LIST)
size*: INTEGER;
add*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
get*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT): PARAM;
set*: PROCEDURE (proc: TYPE_; type: TYPE_);
getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET
END;
rTYPE_ = RECORD (LISTS.ITEM)
typ*: INTEGER;
size*: INTEGER;
parSize*: INTEGER;
length*: INTEGER;
align*: INTEGER;
base*: TYPE_;
fields*: LISTS.LIST;
params*: LISTS.LIST;
fields*: FIELDS;
params*: PARAMS;
unit*: UNIT;
closed*: BOOLEAN;
num*: INTEGER;
188,10 → 215,19
END;
UNITS* = POINTER TO RECORD (LISTS.LIST)
program: PROGRAM;
create*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT;
get*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT
END;
rPROGRAM = RECORD
recCount: INTEGER;
units*: LISTS.LIST;
units*: UNITS;
types*: LISTS.LIST;
sysunit*: UNIT;
rtl*: UNIT;
204,8 → 240,8
stTypes*: RECORD
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*,
tCARD16*, tCARD32*, tANYREC*: TYPE_
END;
214,12 → 250,13
bit_depth*: INTEGER;
word*: INTEGER;
adr*: INTEGER;
sys*: INTEGER;
sysflags*: SET;
options*: OPTIONS
sys*: INTEGER
END
END;
enterType*: PROCEDURE (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
getType*: PROCEDURE (program: PROGRAM; typ: INTEGER): TYPE_
END;
DELIMPORT = PROCEDURE (import: LISTS.ITEM);
255,7 → 292,7
BEGIN
IF varIdent.offset = -1 THEN
IF varIdent.global THEN
IF UTILS.Align(program.bss, varIdent.type.align) THEN
IF MACHINE.Align(program.bss, varIdent.type.align) THEN
IF UTILS.maxint - program.bss >= varIdent.type.size THEN
varIdent.offset := program.bss;
INC(program.bss, varIdent.type.size)
264,7 → 301,7
ELSE
word := program.target.word;
size := varIdent.type.size;
IF UTILS.Align(size, word) THEN
IF MACHINE.Align(size, word) THEN
size := size DIV word;
IF UTILS.maxint - program.locsize >= size THEN
INC(program.locsize, size);
278,7 → 315,7
END getOffset;
PROCEDURE closeUnit* (unit: UNIT);
PROCEDURE close (unit: UNIT);
VAR
ident, prev: IDENT;
offset: INTEGER;
287,7 → 324,7
ident := unit.idents.last(IDENT);
WHILE (ident # NIL) & (ident.typ # idGUARD) DO
IF (ident.typ = idVAR) & (ident.offset = -1) THEN
ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
ERRORS.hintmsg(ident.name.s, ident.pos.line, ident.pos.col, 0);
IF ident.export THEN
offset := getOffset(unit.program, ident)
END
306,7 → 343,7
END;
unit.closed := TRUE
END closeUnit;
END close;
PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
325,7 → 362,7
END unique;
PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
PROCEDURE addIdent (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT;
VAR
item: IDENT;
res: BOOLEAN;
401,7 → 438,7
END UseProc;
PROCEDURE setVarsType* (unit: UNIT; type: TYPE_);
PROCEDURE setvars (unit: UNIT; type: TYPE_);
VAR
item: IDENT;
413,10 → 450,10
item.type := type;
item := item.prev(IDENT)
END
END setVarsType;
END setvars;
PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
PROCEDURE getIdent (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT;
VAR
item: IDENT;
425,7 → 462,7
item := unit.idents.last(IDENT);
IF item # NIL THEN
ASSERT(item # NIL);
IF currentScope THEN
WHILE (item.name # ident) & (item.typ # idGUARD) DO
440,13 → 477,11
END
END
END
RETURN item
END getIdent;
PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN;
PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN;
VAR
item: IDENT;
res: BOOLEAN;
473,11 → 508,11
END openScope;
PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
PROCEDURE closeScope (unit: UNIT; variables: LISTS.LIST);
VAR
item: IDENT;
del: IDENT;
lvar: IL.LOCALVAR;
lvar: CODE.LOCALVAR;
BEGIN
item := unit.idents.last(IDENT);
486,11 → 521,11
del := item;
item := item.prev(IDENT);
IF (del.typ = idVAR) & (del.offset = -1) THEN
ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
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 := CODE.NewVar();
lvar.offset := del.offset;
lvar.size := del.type.size;
IF del.typ = idVAR THEN
513,7 → 548,7
END closeScope;
PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
PROCEDURE frwptr (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION);
VAR
newptr: FRWPTR;
531,10 → 566,10
newptr.notRecord := FALSE;
LISTS.push(unit.frwPointers, newptr)
END frwPtr;
END frwptr;
PROCEDURE linkPtr* (unit: UNIT): FRWPTR;
PROCEDURE linkptr (unit: UNIT): FRWPTR;
VAR
item: FRWPTR;
ident: IDENT;
545,7 → 580,7
item := unit.frwPointers.last(FRWPTR);
WHILE (item # NIL) & ~item.linked & (res = NIL) DO
ident := getIdent(unit, item.baseIdent, TRUE);
ident := unit.idents.get(unit, item.baseIdent, TRUE);
IF (ident # NIL) THEN
IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN
564,7 → 599,7
END
RETURN res
END linkPtr;
END linkptr;
PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN;
582,7 → 617,7
param1 := t1.params.first;
param2 := t2.params.first;
res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL));
res := (t1.call = t2.call) & ((param1 # NIL) = (param2 # NIL));
WHILE res & (param1 # NIL) & (param2 # NIL) DO
res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type);
608,21 → 643,18
res: BOOLEAN;
BEGIN
res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD});
res := ((t0.typ = tPOINTER) & (t1.typ = tPOINTER)) OR ((t0.typ = tRECORD) & (t1.typ = tRECORD));
IF res & (t0.typ = tPOINTER) THEN
IF (t0.typ = tPOINTER) & (t1.typ = tPOINTER) THEN
t0 := t0.base;
t1 := t1.base
END;
IF res THEN
WHILE (t1 # NIL) & (t1 # t0) DO
WHILE res & (t1 # NIL) & (t1 # t0) DO
t1 := t1.base
END;
res := t1 # NIL
END
RETURN res
RETURN res & (t1 = t0)
END isBaseOf;
631,7 → 663,7
END isOpenArray;
PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT;
VAR
item: UNIT;
638,7 → 670,7
BEGIN
ASSERT(name # NIL);
item := program.units.first(UNIT);
item := units.first(UNIT);
WHILE (item # NIL) & (item.name # name) DO
item := item.next(UNIT)
645,41 → 677,48
END;
IF (item = NIL) & (name.s = "SYSTEM") THEN
item := program.sysunit
item := units.program.sysunit
END
RETURN item
END getUnit;
END getunit;
PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM);
VAR
ident: IDENT;
stName: SCAN.IDENT;
BEGIN
ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE);
stName := SCAN.enterid("INTEGER");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tINTEGER;
ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE);
stName := SCAN.enterid("BYTE");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tBYTE;
ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE);
stName := SCAN.enterid("CHAR");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tCHAR;
ident := addIdent(unit, SCAN.enterid("SET"), idTYPE);
stName := SCAN.enterid("WCHAR");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tWCHAR;
stName := SCAN.enterid("SET");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tSET;
ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE);
stName := SCAN.enterid("BOOLEAN");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tBOOLEAN;
IF program.target.sys # mConst.Target_iMSP430 THEN
ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE);
stName := SCAN.enterid("REAL");
ident := addIdent(unit, stName, idTYPE);
ident.type := program.stTypes.tREAL;
ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE);
ident.type := program.stTypes.tWCHAR
END
END enterStTypes;
686,86 → 725,86
PROCEDURE enterStProcs (unit: UNIT);
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
BEGIN
ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
ident := addIdent(unit, SCAN.enterid(name), idtyp);
ident.stproc := proc
END EnterProc;
PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
VAR
ident: IDENT;
BEGIN
ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
ident.stproc := func
END EnterFunc;
EnterProc(unit, "ASSERT", idSTPROC, stASSERT);
EnterProc(unit, "DEC", idSTPROC, stDEC);
EnterProc(unit, "EXCL", idSTPROC, stEXCL);
EnterProc(unit, "INC", idSTPROC, stINC);
EnterProc(unit, "INCL", idSTPROC, stINCL);
EnterProc(unit, "NEW", idSTPROC, stNEW);
EnterProc(unit, "PACK", idSTPROC, stPACK);
EnterProc(unit, "UNPK", idSTPROC, stUNPK);
EnterProc(unit, "DISPOSE", idSTPROC, stDISPOSE);
EnterProc(unit, "COPY", idSTPROC, stCOPY);
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 unit.program.target.sys # mConst.Target_iMSP430 THEN
EnterProc(unit, "PACK", stPACK);
EnterProc(unit, "UNPK", stUNPK);
EnterProc(unit, "DISPOSE", stDISPOSE);
EnterFunc(unit, "WCHR", stWCHR);
EnterFunc(unit, "FLOOR", stFLOOR);
EnterFunc(unit, "FLT", stFLT)
END
EnterProc(unit, "ABS", idSTFUNC, stABS);
EnterProc(unit, "ASR", idSTFUNC, stASR);
EnterProc(unit, "CHR", idSTFUNC, stCHR);
EnterProc(unit, "WCHR", idSTFUNC, stWCHR);
EnterProc(unit, "FLOOR", idSTFUNC, stFLOOR);
EnterProc(unit, "FLT", idSTFUNC, stFLT);
EnterProc(unit, "LEN", idSTFUNC, stLEN);
EnterProc(unit, "LSL", idSTFUNC, stLSL);
EnterProc(unit, "ODD", idSTFUNC, stODD);
EnterProc(unit, "ORD", idSTFUNC, stORD);
EnterProc(unit, "ROR", idSTFUNC, stROR);
EnterProc(unit, "BITS", idSTFUNC, stBITS);
EnterProc(unit, "LSR", idSTFUNC, stLSR);
EnterProc(unit, "LENGTH", idSTFUNC, stLENGTH);
EnterProc(unit, "MIN", idSTFUNC, stMIN);
EnterProc(unit, "MAX", idSTFUNC, stMAX);
END enterStProcs;
PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT;
VAR
unit: UNIT;
idents: IDENTS;
BEGIN
ASSERT(program # NIL);
ASSERT(units # NIL);
ASSERT(name # NIL);
NEW(unit);
unit.program := program;
NEW(idents);
ASSERT(LISTS.create(idents) = idents);
idents.add := addIdent;
idents.get := getIdent;
unit.program := units.program;
unit.name := name;
unit.closed := FALSE;
unit.idents := LISTS.create(NIL);
unit.idents := idents;
unit.frwPointers := LISTS.create(NIL);
ASSERT(openScope(unit, NIL));
unit.scope.open := openScope;
unit.scope.close := closeScope;
unit.close := close;
unit.setvars := setvars;
unit.pointers.add := frwptr;
unit.pointers.link := linkptr;
enterStTypes(unit, program);
ASSERT(unit.scope.open(unit, NIL));
enterStTypes(unit, units.program);
enterStProcs(unit);
ASSERT(openScope(unit, NIL));
ASSERT(unit.scope.open(unit, NIL));
unit.gscope := unit.idents.last(IDENT);
LISTS.push(program.units, unit);
LISTS.push(units, unit);
unit.scopeLvl := 0;
unit.scopes[0] := NIL;
773,14 → 812,14
unit.sysimport := FALSE;
IF unit.name.s = mConst.RTL_NAME THEN
program.rtl := unit
unit.program.rtl := unit
END
RETURN unit
END newUnit;
END newunit;
PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
PROCEDURE getField (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD;
VAR
field: FIELD;
812,7 → 851,7
END getField;
PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
PROCEDURE addField (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN;
VAR
field: FIELD;
res: BOOLEAN;
837,7 → 876,7
END addField;
PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN;
PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN;
VAR
item: FIELD;
res: BOOLEAN;
856,7 → 895,7
WHILE res & (item # NIL) & (item.type = NIL) DO
item.type := type;
IF ~self.noalign THEN
res := UTILS.Align(self.size, type.align)
res := MACHINE.Align(self.size, type.align)
ELSE
res := TRUE
END;
872,7 → 911,7
END setFields;
PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM;
PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM;
VAR
item: PARAM;
889,7 → 928,7
END getParam;
PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
PROCEDURE addParam (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN;
VAR
param: PARAM;
res: BOOLEAN;
897,7 → 936,7
BEGIN
ASSERT(name # NIL);
res := getParam(self, name) = NIL;
res := self.params.get(self, name) = NIL;
IF res THEN
NEW(param);
934,7 → 973,7
END OpenBase;
PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
PROCEDURE getFloatParamsPos (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET;
VAR
res: SET;
param: PARAM;
952,13 → 991,13
param := param.next(PARAM)
END;
int := self.parSize - flt
int := self.params.size - flt
RETURN res
END getFloatParamsPos;
PROCEDURE setParams* (self: TYPE_; type: TYPE_);
PROCEDURE setParams (self: TYPE_; type: TYPE_);
VAR
item: LISTS.ITEM;
param: PARAM;
967,7 → 1006,7
BEGIN
ASSERT(type # NIL);
word := UTILS.target.bit_depth DIV 8;
word := MACHINE.target.bit_depth DIV 8;
item := self.params.first;
986,8 → 1025,8
ELSE
size := 1
END;
param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
INC(self.parSize, size)
param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME;
INC(self.params.size, size)
ELSE
IF type.typ IN {tRECORD, tARRAY} THEN
IF isOpenArray(type) THEN
997,11 → 1036,11
END
ELSE
size := type.size;
ASSERT(UTILS.Align(size, word));
ASSERT(MACHINE.Align(size, word));
size := size DIV word
END;
param.offset := self.parSize + Dim(type) + STACK_FRAME;
INC(self.parSize, size)
param.offset := self.params.size + Dim(type) + STACK_FRAME;
INC(self.params.size, size)
END;
item := item.next
1010,33 → 1049,48
END setParams;
PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_;
VAR
t: TYPE_;
fields: FIELDS;
params: PARAMS;
BEGIN
NEW(t);
NEW(fields);
ASSERT(LISTS.create(fields) = fields);
NEW(params);
ASSERT(LISTS.create(params) = params);
t.typ := typ;
t.size := size;
t.length := length;
t.align := 0;
t.base := NIL;
t.fields := LISTS.create(NIL);
t.params := LISTS.create(NIL);
t.fields := fields;
t.params := params;
t.unit := unit;
t.num := 0;
CASE program.target.bit_depth OF
|16: t.call := default16
|32: t.call := default32
|64: t.call := default64
IF program.target.bit_depth = 32 THEN
t.call := default
ELSIF program.target.bit_depth = 64 THEN
t.call := default64
END;
t.import := FALSE;
t.noalign := FALSE;
t.parSize := 0;
t.fields.add := addField;
t.fields.get := getField;
t.fields.set := setFields;
t.params.add := addParam;
t.params.get := getParam;
t.params.getfparams := getFloatParamsPos;
t.params.set := setParams;
t.params.size := 0;
IF typ IN {tARRAY, tRECORD} THEN
t.closed := FALSE;
IF typ = tRECORD THEN
1053,7 → 1107,7
END enterType;
PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_;
PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_;
VAR
res: TYPE_;
1100,30 → 1154,22
BEGIN
unit := newUnit(program, SCAN.enterid("$SYSTEM"));
unit := program.units.create(program.units, SCAN.enterid("$SYSTEM"));
EnterProc(unit, "ADR", idSYSFUNC, sysADR);
EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE);
EnterProc(unit, "SADR", idSYSFUNC, sysSADR);
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR);
EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID);
EnterProc(unit, "INF", idSYSFUNC, sysINF);
EnterProc(unit, "GET", idSYSPROC, sysGET);
EnterProc(unit, "PUT", idSYSPROC, sysPUT);
EnterProc(unit, "PUT8", idSYSPROC, sysPUT8);
EnterProc(unit, "PUT", idSYSPROC, sysPUT);
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32);
EnterProc(unit, "CODE", idSYSPROC, sysCODE);
EnterProc(unit, "MOVE", idSYSPROC, sysMOVE);
(*
IF program.target.sys = mConst.Target_iMSP430 THEN
EnterProc(unit, "NOP", idSYSPROC, sysNOP);
EnterProc(unit, "EINT", idSYSPROC, sysEINT);
EnterProc(unit, "DINT", idSYSPROC, sysDINT)
END;
*)
IF program.target.sys # mConst.Target_iMSP430 THEN
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR);
EnterProc(unit, "INF", idSYSFUNC, sysINF);
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32);
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "COPY", idSYSPROC, sysCOPY);
ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE);
1132,10 → 1178,9
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident.type := program.stTypes.tCARD32;
ident.export := TRUE
END;
ident.export := TRUE;
closeUnit(unit);
unit.close(unit);
program.sysunit := unit
END createSysUnit;
1166,6 → 1211,7
BEGIN
REPEAT
flag := FALSE;
proc := program.procs.first(PROC);
1184,7 → 1230,7
WHILE proc # NIL DO
IF ~proc.used THEN
IF proc.import = NIL THEN
IL.delete2(proc.enter, proc.leave)
CODE.delete2(proc.enter, proc.leave)
ELSE
DelImport(proc.import)
END
1195,66 → 1241,46
END DelUnused;
PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM;
PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM;
VAR
program: PROGRAM;
units: UNITS;
BEGIN
idents := C.create();
UTILS.SetBitDepth(bit_depth);
MACHINE.SetBitDepth(bit_depth);
NEW(program);
NEW(units);
ASSERT(LISTS.create(units) = units);
program.target.bit_depth := bit_depth;
program.target.word := bit_depth DIV 8;
program.target.adr := bit_depth DIV 8;
program.target.sys := target;
program.target.options := options;
program.target.sys := sys;
CASE target OF
|mConst.Target_iConsole,
mConst.Target_iGUI,
mConst.Target_iDLL: program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iELF32,
mConst.Target_iELFSO32: program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iKolibri,
mConst.Target_iObject: program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|mConst.Target_iConsole64,
mConst.Target_iGUI64,
mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|mConst.Target_iELF64,
mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|mConst.Target_iMSP430: program.target.sysflags := {sf_code}
END;
program.recCount := -1;
program.bss := 0;
program.units := LISTS.create(NIL);
program.units := units;
program.types := LISTS.create(NIL);
program.procs := LISTS.create(NIL);
program.enterType := enterType;
program.getType := getType;
program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL);
program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL);
program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL);
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL);
program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL);
program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL);
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL);
program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL);
program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL);
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL)
END;
program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL);
program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL);
program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL);
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL);
program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL);
program.stTypes.tANYREC.closed := TRUE;
1261,16 → 1287,18
program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size;
program.stTypes.tBYTE.align := 1;
program.stTypes.tCHAR.align := program.stTypes.tCHAR.size;
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size;
program.stTypes.tSET.align := program.stTypes.tSET.size;
program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size;
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size;
program.stTypes.tREAL.align := program.stTypes.tREAL.size;
program.stTypes.tCARD16.align := program.stTypes.tCARD16.size;
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size
END;
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size;
units.program := program;
units.create := newunit;
units.get := getunit;
program.dll := FALSE;
program.obj := FALSE;

/programs/develop/oberon07/Source/REG.ob07
12,10 → 12,8
N = 16;
R0* = 0; R1* = 1; R2* = 2; R3* = 3;
R4* = 4; R5* = 5; R6* = 6; R7* = 7;
R0* = 0; R1* = 1; R2* = 2;
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
NVR = 32;
26,7 → 24,7
OP2 = PROCEDURE (arg1, arg2: INTEGER);
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
REGS* = RECORD
REGS* = POINTER TO RECORD
regs*: SET;
stk*: ARRAY N OF INTEGER;
44,7 → 42,7
END;
PROCEDURE push (VAR R: REGS);
PROCEDURE push (R: REGS);
VAR
i, reg: INTEGER;
60,7 → 58,7
END push;
PROCEDURE pop (VAR R: REGS; reg: INTEGER);
PROCEDURE pop (R: REGS; reg: INTEGER);
VAR
i: INTEGER;
113,7 → 111,7
END GetFreeReg;
PROCEDURE Put (VAR R: REGS; reg: INTEGER);
PROCEDURE Put (R: REGS; reg: INTEGER);
BEGIN
EXCL(R.regs, reg);
INC(R.top);
121,7 → 119,7
END Put;
PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
PROCEDURE PopAnyReg (R: REGS): INTEGER;
VAR
reg: INTEGER;
136,7 → 134,7
END PopAnyReg;
PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
PROCEDURE GetAnyReg* (R: REGS): INTEGER;
VAR
reg: INTEGER;
154,13 → 152,13
END GetAnyReg;
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN;
VAR
free, n: INTEGER;
res: BOOLEAN;
PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
PROCEDURE exch (R: REGS; reg1, reg2: INTEGER);
VAR
n1, n2: INTEGER;
203,7 → 201,7
END GetReg;
PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN;
VAR
n1, n2: INTEGER;
res: BOOLEAN;
241,7 → 239,7
END Exchange;
PROCEDURE Drop* (VAR R: REGS);
PROCEDURE Drop* (R: REGS);
BEGIN
INCL(R.regs, R.stk[R.top]);
DEC(R.top)
248,7 → 246,7
END Drop;
PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER);
BEGIN
IF R.top > 0 THEN
reg1 := R.stk[R.top - 1];
263,7 → 261,7
END BinOp;
PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER);
BEGIN
IF R.top >= 0 THEN
reg := R.stk[R.top]
273,7 → 271,7
END UnOp;
PROCEDURE PushAll* (VAR R: REGS);
PROCEDURE PushAll* (R: REGS);
BEGIN
WHILE R.top >= 0 DO
push(R)
281,16 → 279,8
END PushAll;
PROCEDURE PushAll_1* (VAR R: REGS);
PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER);
BEGIN
WHILE R.top >= 1 DO
push(R)
END
END PushAll_1;
PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
BEGIN
ASSERT(reg IN R.vregs);
ASSERT(offs # 0);
R.offs[reg] := offs;
301,7 → 291,7
END Lock;
PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
PROCEDURE Release* (R: REGS; reg: INTEGER);
BEGIN
ASSERT(reg IN R.vregs);
R.offs[reg] := 0
360,7 → 350,7
END Restore;
PROCEDURE Reset* (VAR R: REGS);
PROCEDURE Reset* (R: REGS);
VAR
i: INTEGER;
411,11 → 401,14
END GetAnyVarReg;
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS;
VAR
R: REGS;
i: INTEGER;
BEGIN
NEW(R);
R.regs := regs;
R.pushed := 0;
R.top := -1;
434,7 → 427,8
R.size[i] := 0
END
END Init;
RETURN R
END Create;
END REG.

/programs/develop/oberon07/Source/SCAN.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
MODULE SCAN;
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS;
CONST
18,30 → 18,29
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
lxEOF* = 8;
lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;
lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;
lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;
lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;
lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;
lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;
lxASSIGN* = 45; lxRANGE* = 46;
lxKW = 101;
lxKW = 51;
lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104;
lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108;
lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112;
lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116;
lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120;
lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124;
lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128;
lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132;
lxWHILE* = 133;
lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;
lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;
lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;
lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;
lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;
lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;
lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;
lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;
lxWHILE* = 83;
lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204;
lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208;
lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212;
lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216;
lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220;
lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224;
lxASSIGN* = 225; lxRANGE* = 226;
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
lxERROR13* = -13;
lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4;
lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8;
lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12;
TYPE
76,8 → 75,13
END;
SCANNER* = TXT.TEXT;
SCANNER* = POINTER TO RECORD (C.ITEM)
text: TEXTDRV.TEXT;
range: BOOLEAN
END;
KEYWORD = ARRAY 10 OF CHAR;
86,13 → 90,15
vocabulary: RECORD
KW: ARRAY 33 OF KEYWORD;
delimiters: ARRAY 256 OF BOOLEAN;
idents: AVL.NODE;
ident: IDENT
END;
upto: BOOLEAN;
scanners: C.COLLECTION;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
103,27 → 109,36
PROCEDURE key (VAR lex: LEX);
VAR
L, R, M: INTEGER;
found: BOOLEAN;
BEGIN
L := 0;
R := LEN(vocabulary.KW) - 1;
found := FALSE;
REPEAT
M := (L + R) DIV 2;
IF lex.s # vocabulary.KW[M] THEN
WHILE L # M DO
IF lex.s > vocabulary.KW[M] THEN
L := M + 1
L := M;
M := (L + R) DIV 2
ELSIF lex.s < vocabulary.KW[M] THEN
R := M;
M := (L + R) DIV 2
ELSE
R := M - 1
lex.sym := lxKW + M;
L := M;
R := M
END
ELSE
found := TRUE;
lex.sym := lxKW + M
END;
IF L # R THEN
IF lex.s = vocabulary.KW[L] THEN
lex.sym := lxKW + L
END;
IF lex.s = vocabulary.KW[R] THEN
lex.sym := lxKW + R
END
UNTIL found OR (L > R)
END
END key;
158,24 → 173,18
END putchar;
PROCEDURE nextc (text: TXT.TEXT): CHAR;
BEGIN
TXT.next(text)
RETURN text.peak
END nextc;
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX);
VAR
c: CHAR;
BEGIN
c := text.peak;
c := text.peak(text);
ASSERT(S.letter(c));
WHILE S.letter(c) OR S.digit(c) DO
putchar(lex, c);
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END;
IF lex.over THEN
192,7 → 201,7
END ident;
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
VAR
c: CHAR;
hex: BOOLEAN;
199,33 → 208,37
error: INTEGER;
BEGIN
c := text.peak;
c := text.peak(text);
ASSERT(S.digit(c));
error := 0;
range := FALSE;
lex.sym := lxINTEGER;
hex := FALSE;
WHILE S.digit(c) DO
putchar(lex, c);
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END;
WHILE S.hexdigit(c) DO
putchar(lex, c);
c := nextc(text);
text.nextc(text);
c := text.peak(text);
hex := TRUE
END;
IF c = "H" THEN
putchar(lex, c);
TXT.next(text);
text.nextc(text);
lex.sym := lxHEX
ELSIF c = "X" THEN
putchar(lex, c);
TXT.next(text);
text.nextc(text);
lex.sym := lxCHAR
ELSIF c = "." THEN
234,7 → 247,8
lex.sym := lxERROR01
ELSE
c := nextc(text);
text.nextc(text);
c := text.peak(text);
IF c # "." THEN
putchar(lex, ".");
241,28 → 255,31
lex.sym := lxFLOAT
ELSE
lex.sym := lxINTEGER;
text.peak := 7FX;
upto := TRUE
range := TRUE
END;
WHILE S.digit(c) DO
putchar(lex, c);
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END;
IF c = "E" THEN
putchar(lex, c);
c := nextc(text);
text.nextc(text);
c := text.peak(text);
IF (c = "+") OR (c = "-") THEN
putchar(lex, c);
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END;
IF S.digit(c) THEN
WHILE S.digit(c) DO
putchar(lex, c);
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END
ELSE
lex.sym := lxERROR02
272,8 → 289,11
END
ELSIF hex THEN
ELSE
IF hex THEN
lex.sym := lxERROR01
END
END;
301,23 → 321,31
END number;
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX);
VAR
c: CHAR;
c, c1: CHAR;
n: INTEGER;
quot: CHAR;
BEGIN
c := nextc(text);
quot := text.peak(text);
ASSERT((quot = '"') OR (quot = "'"));
text.nextc(text);
c := text.peak(text);
c1 := c;
n := 0;
WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
putchar(lex, c);
c := nextc(text);
text.nextc(text);
c := text.peak(text);
INC(n)
END;
IF c = quot THEN
TXT.next(text);
text.nextc(text);
IF lex.over THEN
lex.sym := lxERROR05
ELSE
325,7 → 353,7
lex.sym := lxSTRING
ELSE
lex.sym := lxCHAR;
ARITH.setChar(lex.value, ORD(lex.s[0]))
ARITH.setChar(lex.value, ORD(c1))
END
END
ELSE
341,7 → 369,7
END string;
PROCEDURE comment (text: TXT.TEXT);
PROCEDURE comment (text: TEXTDRV.TEXT);
VAR
c: CHAR;
cond, depth: INTEGER;
352,8 → 380,8
REPEAT
c := text.peak;
TXT.next(text);
c := text.peak(text);
text.nextc(text);
IF c = "*" THEN
IF cond = 1 THEN
378,12 → 406,21
END comment;
PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN);
VAR
c: CHAR;
BEGIN
c := text.peak(text);
IF range THEN
ASSERT(c = ".")
END;
putchar(lex, c);
c := nextc(text);
text.nextc(text);
CASE lex.s[0] OF
CASE c OF
|"+":
lex.sym := lxPLUS
396,10 → 433,10
|"/":
lex.sym := lxSLASH;
IF c = "/" THEN
IF text.peak(text) = "/" THEN
lex.sym := lxCOMMENT;
REPEAT
TXT.next(text)
text.nextc(text)
UNTIL text.eol OR text.eof
END
410,14 → 447,26
lex.sym := lxAND
|".":
IF range THEN
putchar(lex, ".");
lex.sym := lxRANGE;
range := FALSE;
DEC(lex.pos.col)
ELSE
lex.sym := lxPOINT;
c := text.peak(text);
IF c = "." THEN
lex.sym := lxRANGE;
putchar(lex, c);
TXT.next(text)
text.nextc(text)
END
END
|",":
lex.sym := lxCOMMA
429,10 → 478,12
|"(":
lex.sym := lxLROUND;
c := text.peak(text);
IF c = "*" THEN
lex.sym := lxCOMMENT;
TXT.next(text);
putchar(lex, c);
text.nextc(text);
comment(text)
END
453,29 → 504,32
|"<":
lex.sym := lxLT;
c := text.peak(text);
IF c = "=" THEN
lex.sym := lxLE;
putchar(lex, c);
TXT.next(text)
text.nextc(text)
END
|">":
lex.sym := lxGT;
c := text.peak(text);
IF c = "=" THEN
lex.sym := lxGE;
putchar(lex, c);
TXT.next(text)
text.nextc(text)
END
|":":
lex.sym := lxCOLON;
c := text.peak(text);
IF c = "=" THEN
lex.sym := lxASSIGN;
putchar(lex, c);
TXT.next(text)
text.nextc(text)
END
|")":
492,21 → 546,26
END delimiter;
PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX);
VAR
c: CHAR;
text: TEXTDRV.TEXT;
BEGIN
text := scanner.text;
REPEAT
c := text.peak;
c := text.peak(text);
WHILE S.space(c) DO
c := nextc(text)
text.nextc(text);
c := text.peak(text)
END;
lex.s[0] := 0X;
lex.length := 0;
lex.sym := lxUNDEF;
lex.pos.line := text.line;
lex.pos.col := text.col;
lex.ident := NIL;
515,26 → 574,19
IF S.letter(c) THEN
ident(text, lex)
ELSIF S.digit(c) THEN
number(text, lex)
number(text, lex, scanner.range)
ELSIF (c = '"') OR (c = "'") THEN
string(text, lex, c)
string(text, lex)
ELSIF vocabulary.delimiters[ORD(c)] THEN
delimiter(text, lex, c)
delimiter(text, lex, scanner.range)
ELSIF c = 0X THEN
lex.sym := lxEOF;
IF text.eof THEN
INC(lex.pos.col)
END
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);
text.nextc(text);
lex.sym := lxERROR04
END;
549,14 → 601,53
END Next;
PROCEDURE NewScanner (): SCANNER;
VAR
scan: SCANNER;
citem: C.ITEM;
BEGIN
citem := C.pop(scanners);
IF citem = NIL THEN
NEW(scan)
ELSE
scan := citem(SCANNER)
END
RETURN scan
END NewScanner;
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
RETURN TXT.open(name)
VAR
scanner: SCANNER;
text: TEXTDRV.TEXT;
BEGIN
text := TEXTDRV.create();
IF text.open(text, name) THEN
scanner := NewScanner();
scanner.text := text;
scanner.range := FALSE
ELSE
scanner := NIL;
TEXTDRV.destroy(text)
END
RETURN scanner
END open;
PROCEDURE close* (VAR scanner: SCANNER);
BEGIN
TXT.close(scanner)
IF scanner # NIL THEN
IF scanner.text # NIL THEN
TEXTDRV.destroy(scanner.text)
END;
C.push(scanners, scanner);
scanner := NIL
END
END close;
565,7 → 656,6
i: INTEGER;
delim: ARRAY 23 OF CHAR;
PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
BEGIN
vocabulary.KW[i] := kw;
572,9 → 662,8
INC(i)
END enterkw;
BEGIN
upto := FALSE;
scanners := C.create();
FOR i := 0 TO 255 DO
vocabulary.delimiters[i] := FALSE

/programs/develop/oberon07/Source/TEXTDRV.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
30,8 → 30,11
line*, col*: INTEGER;
eof*: BOOLEAN;
eol*: BOOLEAN;
peak*: CHAR
open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
peak*: PROCEDURE (text: TEXT): CHAR;
nextc*: PROCEDURE (text: TEXT)
END;
40,6 → 43,26
texts: C.COLLECTION;
PROCEDURE reset (text: TEXT);
BEGIN
text.chunk[0] := 0;
text.pos := 0;
text.size := 0;
text.file := NIL;
text.utf8 := FALSE;
text.CR := FALSE;
text.line := 1;
text.col := 1;
text.eof := FALSE;
text.eol := FALSE
END reset;
PROCEDURE peak (text: TEXT): CHAR;
RETURN CHR(text.chunk[text.pos])
END peak;
PROCEDURE load (text: TEXT);
BEGIN
IF ~text.eof THEN
48,20 → 71,17
IF text.size = 0 THEN
text.eof := TRUE;
text.chunk[0] := 0
END;
text.peak := CHR(text.chunk[0])
END
END
END load;
PROCEDURE next* (text: TEXT);
PROCEDURE next (text: TEXT);
VAR
c: CHAR;
BEGIN
IF text.pos < text.size - 1 THEN
INC(text.pos);
text.peak := CHR(text.chunk[text.pos])
INC(text.pos)
ELSE
load(text)
END;
68,7 → 88,7
IF ~text.eof THEN
c := text.peak;
c := peak(text);
IF c = CR THEN
INC(text.line);
103,6 → 123,7
PROCEDURE init (text: TEXT);
BEGIN
IF (text.pos = 0) & (text.size >= 3) THEN
IF (text.chunk[0] = 0EFH) &
(text.chunk[1] = 0BBH) &
119,26 → 140,27
END;
text.line := 1;
text.col := 1;
text.col := 1
text.peak := CHR(text.chunk[text.pos])
END init;
PROCEDURE close* (VAR text: TEXT);
PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
BEGIN
IF text # NIL THEN
ASSERT(text # NIL);
reset(text);
text.file := FILES.open(name);
IF text.file # NIL THEN
FILES.close(text.file)
END;
C.push(texts, text);
text := NIL
load(text);
init(text)
END
END close;
RETURN text.file # NIL
END open;
PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
PROCEDURE NewText (): TEXT;
VAR
text: TEXT;
citem: C.ITEM;
149,32 → 171,39
NEW(text)
ELSE
text := citem(TEXT)
END;
END
RETURN text
END NewText;
PROCEDURE create* (): TEXT;
VAR
text: TEXT;
BEGIN
text := NewText();
reset(text);
text.open := open;
text.peak := peak;
text.nextc := next
RETURN text
END create;
PROCEDURE destroy* (VAR text: TEXT);
BEGIN
IF text # NIL THEN
text.chunk[0] := 0;
text.pos := 0;
text.size := 0;
text.utf8 := FALSE;
text.CR := FALSE;
text.line := 1;
text.col := 1;
text.eof := FALSE;
text.eol := FALSE;
text.peak := 0X;
text.file := FILES.open(name);
IF text.file # NIL THEN
load(text);
init(text)
ELSE
close(text)
FILES.close(text.file)
END;
C.push(texts, text);
text := NIL
END
END
END destroy;
RETURN text
END open;
BEGIN
texts := C.create()
END TEXTDRV.

/programs/develop/oberon07/Source/UNIXTIME.ob07
1,7 → 1,7
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
55,7 → 55,12
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
VAR
d, s: INTEGER;
BEGIN
d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4;
s := d * 86400 + hour * 3600 + min * 60 + sec
RETURN s
END time;

/programs/develop/oberon07/Source/UTILS.ob07
20,10 → 20,7
OS = HOST.OS;
min32* = -2147483647-1;
max32* = 2147483647;
VAR
time*: INTEGER;
32,23 → 29,7
maxreal*: REAL;
target*:
RECORD
bit_depth*,
maxInt*,
minInt*,
maxSet*,
maxHex*: INTEGER;
maxReal*: REAL
END;
bit_diff*: INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN HOST.FileRead(F, Buffer, bytes)
END FileRead;
131,77 → 112,7
END UnixTime;
PROCEDURE SetBitDepth* (BitDepth: INTEGER);
BEGIN
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
bit_diff := bit_depth - BitDepth;
ASSERT(bit_diff >= 0);
target.bit_depth := BitDepth;
target.maxSet := BitDepth - 1;
target.maxHex := BitDepth DIV 4;
target.minInt := ASR(minint, bit_diff);
target.maxInt := ASR(maxint, bit_diff);
target.maxReal := 1.9;
PACK(target.maxReal, 1023);
END SetBitDepth;
PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
RETURN ASR(n, 8 * idx) MOD 256
END Byte;
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
END Align;
PROCEDURE Long* (value: INTEGER): INTEGER;
RETURN ASR(LSL(value, bit_diff), bit_diff)
END Long;
PROCEDURE Short* (value: INTEGER): INTEGER;
RETURN LSR(LSL(value, bit_diff), bit_diff)
END Short;
PROCEDURE Log2* (x: INTEGER): INTEGER;
VAR
n: INTEGER;
BEGIN
ASSERT(x > 0);
n := 0;
WHILE ~ODD(x) DO
x := x DIV 2;
INC(n)
END;
IF x # 1 THEN
n := -1
END
RETURN n
END Log2;
BEGIN
time := GetTickCount();
COPY(HOST.eol, eol);
maxreal := 1.9;

/programs/develop/oberon07/Source/WRITER.ob07
1,13 → 1,13
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018, Anton Krotov
All rights reserved.
*)
MODULE WRITER;
IMPORT FILES, ERRORS, UTILS;
IMPORT FILES, ERRORS, MACHINE;
TYPE
35,7 → 35,7
IF FILES.WriteByte(file, n) THEN
INC(counter)
ELSE
ERRORS.Error(201)
ERRORS.error1("writing file error")
END
END WriteByte;
47,7 → 47,7
BEGIN
n := FILES.write(file, chunk, bytes);
IF n # bytes THEN
ERRORS.Error(201)
ERRORS.error1("writing file error")
END;
INC(counter, n)
END Write;
59,7 → 59,7
BEGIN
FOR i := 0 TO 7 DO
WriteByte(file, UTILS.Byte(n, i))
WriteByte(file, MACHINE.Byte(n, i))
END
END Write64LE;
70,7 → 70,7
BEGIN
FOR i := 0 TO 3 DO
WriteByte(file, UTILS.Byte(n, i))
WriteByte(file, MACHINE.Byte(n, i))
END
END Write32LE;
77,8 → 77,8
PROCEDURE Write16LE* (file: FILE; n: INTEGER);
BEGIN
WriteByte(file, UTILS.Byte(n, 0));
WriteByte(file, UTILS.Byte(n, 1))
WriteByte(file, MACHINE.Byte(n, 0));
WriteByte(file, MACHINE.Byte(n, 1))
END Write16LE;

/programs/develop/oberon07/Docs/About866.txt
17,7 → 17,6
"kos" - KolibriOS
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡)
-base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å
145,10 → 144,10
¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8,
¤«ï WCHAR -- SYSTEM.PUT16
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
 ¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
 ¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x)
PROCEDURE MOVE(Source, Dest, n: INTEGER)
359,8 → 358,8
‚ᥠ¯à®£à ¬¬ë ­¥ï¢­® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à â࠭᫨àã¥â
­¥ª®â®àë¥ ®¯¥à æ¨¨ (¯à®¢¥àª  ¨ ®åà ­  ⨯ , áà ¢­¥­¨¥ áâப, á®®¡é¥­¨ï ®¡
®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. ¥
á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãà SetDll ¨ SetFini
¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL ¨«¨ Linux SO, ᮮ⢥âá⢥­­®:
á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãàë SetDll,
¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL:
PROCEDURE SetDll
(process_detach, thread_detach, thread_attach: DLL_ENTRY);
373,15 → 372,8
- ᮧ¤ ­¨¨ ­®¢®£® ¯®â®ª  (thread_attach)
- ã­¨ç⮦¥­¨¨ ¯®â®ª  (thread_detach)
PROCEDURE SetFini (ProcFini: PROC);
£¤¥ TYPE PROC = PROCEDURE (* ¡¥§ ¯ à ¬¥â஢ *)
SetFini ­ §­ ç ¥â ¯à®æ¥¤ãàã ProcFini ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ so-¡¨¡«¨®â¥ª¨.
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãà SetDll ¨ SetFini ­¥ ¢«¨ï¥â ­
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãàë SetDll ­¥ ¢«¨ï¥â ­
¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë.
‘®®¡é¥­¨ï ®¡ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª­ å
(Windows), ¢ â¥à¬¨­ « (Linux), ­  ¤®áªã ®â« ¤ª¨ (KolibriOS).
403,4 → 395,6
PROCEDURE [stdcall] lib_init (): INTEGER
â  ¯à®æ¥¤ãà  ¤®«¦­  ¡ëâì ¢ë§¢ ­  ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ DLL.
à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1.
à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1.
„«ï Linux, £¥­¥à æ¨ï ¤¨­ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª ­¥ ॠ«¨§®¢ ­ .

/programs/develop/oberon07/Docs/KOSLib866.txt
98,8 → 98,8
CONST
pi = 3.141592653589793E+00
e = 2.718281828459045E+00
pi = 3.141592653589793D+00
e = 2.718281828459045D+00
PROCEDURE IsNan(x: REAL): BOOLEAN
153,13 → 153,13
PROCEDURE tanh(x: REAL): REAL
£¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
PROCEDURE arsinh(x: REAL): REAL
PROCEDURE arcsinh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x
PROCEDURE arcosh(x: REAL): REAL
PROCEDURE arccosh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x
PROCEDURE artanh(x: REAL): REAL
PROCEDURE arctanh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
PROCEDURE round(x: REAL): REAL
181,9 → 181,6
¥á«¨ x < 0 ¢®§¢à é ¥â -1
¥á«¨ x = 0 ¢®§¢à é ¥â 0
PROCEDURE fact(n: INTEGER): REAL
ä ªâ®à¨ « n
------------------------------------------------------------------------------
MODULE Debug - ¢ë¢®¤ ­  ¤®áªã ®â« ¤ª¨
ˆ­â¥àä¥©á ª ª ¬®¤ã«ì Out
340,7 → 337,7
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
¢®§¢à é ¥â ¤ âã, ¯®«ã祭­ãî ¨§ ª®¬¯®­¥­â®¢
Year, Month, Day, Hour, Min, Sec;
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0E5
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0D5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec: INTEGER): BOOLEAN

/programs/develop/oberon07/Docs/About1251.txt
17,7 → 17,6
"kos" - KolibriOS
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá)
-base <address> àäðåñ çàãðóçêè èñïîëíÿåìîãî ôàéëà â êèëîáàéòàõ
145,10 → 144,10
äî 32 áèò, äëÿ çàïèñè áàéòîâ èñïîëüçîâàòü SYSTEM.PUT8,
äëÿ WCHAR -- SYSTEM.PUT16
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
Ïàìÿòü[a] := ìëàäøèå 8 áèò (x)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR)
Ïàìÿòü[a] := ìëàäøèå 16 áèò (x)
PROCEDURE MOVE(Source, Dest, n: INTEGER)
359,8 → 358,8
Âñå ïðîãðàììû íåÿâíî èñïîëüçóþò ìîäóëü RTL. Êîìïèëÿòîð òðàíñëèðóåò
íåêîòîðûå îïåðàöèè (ïðîâåðêà è îõðàíà òèïà, ñðàâíåíèå ñòðîê, ñîîáùåíèÿ îá
îøèáêàõ âðåìåíè âûïîëíåíèÿ è äð.) êàê âûçîâû ïðîöåäóð ýòîãî ìîäóëÿ. Íå
ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóð SetDll è SetFini
åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL èëè Linux SO, ñîîòâåòñòâåííî:
ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóðû SetDll,
åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL:
PROCEDURE SetDll
(process_detach, thread_detach, thread_attach: DLL_ENTRY);
373,15 → 372,8
- ñîçäàíèè íîâîãî ïîòîêà (thread_attach)
- óíè÷òîæåíèè ïîòîêà (thread_detach)
PROCEDURE SetFini (ProcFini: PROC);
ãäå TYPE PROC = PROCEDURE (* áåç ïàðàìåòðîâ *)
SetFini íàçíà÷àåò ïðîöåäóðó ProcFini âûçûâàåìîé ïðè âûãðóçêå so-áèáëèîòåêè.
Äëÿ ïðî÷èõ òèïîâ ïðèëîæåíèé, âûçîâ ïðîöåäóð SetDll è SetFini íå âëèÿåò íà
Äëÿ ïðî÷èõ òèïîâ ïðèëîæåíèé, âûçîâ ïðîöåäóðû SetDll íå âëèÿåò íà
ïîâåäåíèå ïðîãðàììû.
Ñîîáùåíèÿ îá îøèáêàõ âðåìåíè âûïîëíåíèÿ âûâîäÿòñÿ â äèàëîãîâûõ îêíàõ
(Windows), â òåðìèíàë (Linux), íà äîñêó îòëàäêè (KolibriOS).
403,4 → 395,6
PROCEDURE [stdcall] lib_init (): INTEGER
Ýòà ïðîöåäóðà äîëæíà áûòü âûçâàíà ïåðåä èñïîëüçîâàíèåì DLL.
Ïðîöåäóðà âñåãäà âîçâðàùàåò 1.
Ïðîöåäóðà âñåãäà âîçâðàùàåò 1.
Äëÿ Linux, ãåíåðàöèÿ äèíàìè÷åñêèõ áèáëèîòåê íå ðåàëèçîâàíà.

/programs/develop/oberon07/Docs/KOSLib1251.txt
98,8 → 98,8
CONST
pi = 3.141592653589793E+00
e = 2.718281828459045E+00
pi = 3.141592653589793D+00
e = 2.718281828459045D+00
PROCEDURE IsNan(x: REAL): BOOLEAN
153,13 → 153,13
PROCEDURE tanh(x: REAL): REAL
ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE arsinh(x: REAL): REAL
PROCEDURE arcsinh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x
PROCEDURE arcosh(x: REAL): REAL
PROCEDURE arccosh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x
PROCEDURE artanh(x: REAL): REAL
PROCEDURE arctanh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE round(x: REAL): REAL
181,9 → 181,6
åñëè x < 0 âîçâðàùàåò -1
åñëè x = 0 âîçâðàùàåò 0
PROCEDURE fact(n: INTEGER): REAL
ôàêòîðèàë n
------------------------------------------------------------------------------
MODULE Debug - âûâîä íà äîñêó îòëàäêè
Èíòåðôåéñ êàê ìîäóëü Out
340,7 → 337,7
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ
Year, Month, Day, Hour, Min, Sec;
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec: INTEGER): BOOLEAN

/programs/develop/oberon07/Lib/KolibriOS/Math.ob07
1,5 → 1,5
(*
Copyright 2013, 2014, 2018, 2019 Anton Krotov
Copyright 2013, 2014, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
251,45 → 251,58
PROCEDURE sinh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
x := exp(x)
RETURN (x - 1.0 / x) * 0.5
IF IsZero(x) THEN
res := 0.0
ELSE
res := (exp(x) - exp(-x)) / 2.0
END
RETURN res
END sinh;
PROCEDURE cosh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
x := exp(x)
RETURN (x + 1.0 / x) * 0.5
IF IsZero(x) THEN
res := 1.0
ELSE
res := (exp(x) + exp(-x)) / 2.0
END
RETURN res
END cosh;
PROCEDURE tanh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
IF x > 15.0 THEN
x := 1.0
ELSIF x < -15.0 THEN
x := -1.0
IF IsZero(x) THEN
res := 0.0
ELSE
x := exp(2.0 * x);
x := (x - 1.0) / (x + 1.0)
res := sinh(x) / cosh(x)
END
RETURN x
RETURN res
END tanh;
PROCEDURE arsinh* (x: REAL): REAL;
RETURN ln(x + sqrt(x * x + 1.0))
END arsinh;
PROCEDURE arcsinh* (x: REAL): REAL;
RETURN ln(x + sqrt((x * x) + 1.0))
END arcsinh;
PROCEDURE arcosh* (x: REAL): REAL;
RETURN ln(x + sqrt(x * x - 1.0))
END arcosh;
PROCEDURE arccosh* (x: REAL): REAL;
RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
END arccosh;
PROCEDURE artanh* (x: REAL): REAL;
PROCEDURE arctanh* (x: REAL): REAL;
VAR
res: REAL;
302,7 → 315,7
res := 0.5 * ln((1.0 + x) / (1.0 - x))
END
RETURN res
END artanh;
END arctanh;
PROCEDURE floor* (x: REAL): REAL;
361,24 → 374,8
ELSE
res := 0
END
RETURN res
END sgn;
PROCEDURE fact* (n: INTEGER): REAL;
VAR
res: REAL;
BEGIN
res := 1.0;
WHILE n > 1 DO
res := res * FLT(n);
DEC(n)
END
RETURN res
END fact;
END Math.

/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
22,13 → 22,11
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR
42,9 → 40,7
thread_attach: DLL_ENTRY
END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN
SYSTEM.CODE(
111,12 → 107,18
END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR
i, n, k: INTEGER;
135,27 → 137,30
END _rot;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > MAX_SET THEN
b := MAX_SET
IF (a <= b) & (a <= 31) & (b >= 0) THEN
IF b > 31 THEN
b := 31
END;
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
ELSE
a := 0
res := 0
END
RETURN a
END _set;
RETURN res
END _set2;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
180,7 → 185,7
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
PROCEDURE div_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
191,10 → 196,10
END
RETURN div
END _div2;
END div_;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
205,19 → 210,29
END
RETURN mod
END _mod2;
END mod_;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
RETURN div_(a, b)
END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
RETURN mod_(a, b)
END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
ptr := API._NEW(size);
236,6 → 251,50
END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
286,71 → 345,16
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: CHAR;
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _length(len1, str1) - _length(len2, str2)
END;
CASE op OF
366,25 → 370,21
END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: WCHAR;
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2)
END;
CASE op OF
400,6 → 400,11
END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
c: CHAR;
465,7 → 470,7
END append;
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (module, err: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
472,7 → 477,7
BEGIN
s := "";
CASE err OF
CASE err MOD 16 OF
| 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference")
| 3: append(s, "division by zero")
489,7 → 494,7
append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(line, temp); append(s, temp);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
497,42 → 502,69
END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END
RETURN p MOD 2
RETURN t1 = t0
END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r:t1 IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
p := 1
t1 := t0
END
RETURN p MOD 2
RETURN t1 = t0
END _guard;
581,50 → 613,18
END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code);
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
types := _types;
name := modname;
dll.process_detach := NIL;
dll.thread_detach := NIL;
dll.thread_attach := NIL;
fini := NIL
END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL.

/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07
1,4 → 1,4
(*
(*
Copyright 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify

/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07
1,4 → 1,4
(*
(*
Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify

/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07
38,6 → 38,16
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
END dlopen;
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
END dlsym;
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
VAR
i, len, ptr: INTEGER;

/programs/develop/oberon07/Lib/Linux32/RTL.ob07
22,13 → 22,11
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR
42,9 → 40,7
thread_attach: DLL_ENTRY
END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN
SYSTEM.CODE(
111,12 → 107,18
END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR
i, n, k: INTEGER;
135,27 → 137,30
END _rot;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > MAX_SET THEN
b := MAX_SET
IF (a <= b) & (a <= 31) & (b >= 0) THEN
IF b > 31 THEN
b := 31
END;
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
ELSE
a := 0
res := 0
END
RETURN a
END _set;
RETURN res
END _set2;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
180,7 → 185,7
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
PROCEDURE div_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
191,10 → 196,10
END
RETURN div
END _div2;
END div_;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
205,19 → 210,29
END
RETURN mod
END _mod2;
END mod_;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
RETURN div_(a, b)
END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
RETURN mod_(a, b)
END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
ptr := API._NEW(size);
236,6 → 251,50
END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
286,71 → 345,16
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: CHAR;
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _length(len1, str1) - _length(len2, str2)
END;
CASE op OF
366,25 → 370,21
END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: WCHAR;
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2)
END;
CASE op OF
400,6 → 400,11
END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
c: CHAR;
465,7 → 470,7
END append;
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (module, err: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
472,7 → 477,7
BEGIN
s := "";
CASE err OF
CASE err MOD 16 OF
| 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference")
| 3: append(s, "division by zero")
489,7 → 494,7
append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(line, temp); append(s, temp);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
497,42 → 502,69
END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END
RETURN p MOD 2
RETURN t1 = t0
END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r:t1 IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
p := 1
t1 := t0
END
RETURN p MOD 2
RETURN t1 = t0
END _guard;
581,50 → 613,18
END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code);
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
types := _types;
name := modname;
dll.process_detach := NIL;
dll.thread_detach := NIL;
dll.thread_attach := NIL;
fini := NIL
END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL.

/programs/develop/oberon07/Lib/Windows32/API.ob07
13,14 → 13,12
eol*: ARRAY 3 OF CHAR;
base*: INTEGER;
heap: INTEGER;
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER;
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER;
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
32,14 → 30,12
PROCEDURE _NEW* (size: INTEGER): INTEGER;
RETURN HeapAlloc(heap, 8, size)
RETURN Alloc(64, size)
END _NEW;
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
BEGIN
HeapFree(heap, 0, p)
RETURN 0
RETURN Free(p)
END _DISPOSE;
46,8 → 42,7
PROCEDURE init* (reserved, code: INTEGER);
BEGIN
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
base := code - 4096;
heap := GetProcessHeap()
base := code - 4096
END init;

/programs/develop/oberon07/Lib/Windows32/RTL.ob07
22,13 → 22,11
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR
42,9 → 40,7
thread_attach: DLL_ENTRY
END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN
SYSTEM.CODE(
111,12 → 107,18
END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR
i, n, k: INTEGER;
135,27 → 137,30
END _rot;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > MAX_SET THEN
b := MAX_SET
IF (a <= b) & (a <= 31) & (b >= 0) THEN
IF b > 31 THEN
b := 31
END;
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
ELSE
a := 0
res := 0
END
RETURN a
END _set;
RETURN res
END _set2;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
180,7 → 185,7
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
PROCEDURE div_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
191,10 → 196,10
END
RETURN div
END _div2;
END div_;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
PROCEDURE mod_ (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
205,19 → 210,29
END
RETURN mod
END _mod2;
END mod_;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
RETURN div_(a, b)
END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
RETURN mod_(a, b)
END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
ptr := API._NEW(size);
236,6 → 251,50
END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN
SYSTEM.CODE(
286,71 → 345,16
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: CHAR;
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _length(len1, str1) - _length(len2, str2)
END;
CASE op OF
366,25 → 370,21
END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
res: INTEGER;
bRes: BOOLEAN;
c: WCHAR;
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
IF res = 0 THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2)
END;
CASE op OF
400,6 → 400,11
END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
c: CHAR;
465,7 → 470,7
END append;
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
PROCEDURE [stdcall] _error* (module, err: INTEGER);
VAR
s, temp: ARRAY 1024 OF CHAR;
472,7 → 477,7
BEGIN
s := "";
CASE err OF
CASE err MOD 16 OF
| 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference")
| 3: append(s, "division by zero")
489,7 → 494,7
append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(line, temp); append(s, temp);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name);
497,42 → 502,69
END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END
RETURN p MOD 2
RETURN t1 = t0
END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
BEGIN
SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
(* r:t1 IS t0 *)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
VAR
t1: INTEGER;
BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(t0 + p + types, p)
DEC(p, SIZE_OF_DWORD);
SYSTEM.GET(p, t1);
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
p := 1
t1 := t0
END
RETURN p MOD 2
RETURN t1 = t0
END _guard;
581,50 → 613,18
END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER);
BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code);
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
types := _types;
name := modname;
dll.process_detach := NIL;
dll.thread_detach := NIL;
dll.thread_attach := NIL;
fini := NIL
END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL.