Skip to content

Commit 5f41e9b

Browse files
tebe6502tebe6502
committed
bugfixes and optimizations
1 parent 2ab76af commit 5f41e9b

File tree

6 files changed

+52
-73
lines changed

6 files changed

+52
-73
lines changed

‎origin/CHANGELOG‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
29.09.2025
2+
- bugfixes and optimizations
3+
14
19.09.2025
25
- 'RTI'/'RTS' FORWARD Procedure/Function
36

‎origin/Optimize.pas‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -101,17 +101,16 @@ procedure OptimizeTemporaryBuf;
101101
if (pos('#asm:', TemporaryBuf[i]) = 1) or
102102

103103
ldy(i) or
104-
(pos('mwy ', TemporaryBuf[i]) > 0) or
105-
(pos('mvy ', TemporaryBuf[i]) > 0) or
106104
jsr(i) or
107-
(pos(#9'.if', TemporaryBuf[i]) > 0) or
108-
(pos(#9'.LOCAL ', TemporaryBuf[i]) > 0) or
109-
(pos(#9'@print', TemporaryBuf[i]) > 0) or
110105
iny(i) or
111106
dey(i) or
107+
tay(i) or
112108
tya(i) or
113-
tay(i) then Result:=true else Result:=false;
114-
109+
mwy(i) or
110+
mwy(i) or
111+
(pos(#9'.if', TemporaryBuf[i]) > 0) or
112+
(pos(#9'.LOCAL ', TemporaryBuf[i]) > 0) or
113+
(pos(#9'@print', TemporaryBuf[i]) > 0) then Result:=true else Result:=false;
115114
end;
116115

117116

@@ -225,9 +224,9 @@ procedure OptimizeTemporaryBuf;
225224

226225

227226
{
228-
if (pos('jmp a_0004', TemporaryBuf[3]) > 0) then begin
227+
if (pos('#for:dec', TemporaryBuf[10]) > 0) then begin
229228
230-
for p:=0 to 11 do writeln(TemporaryBuf[p]);
229+
for p:=0 to 30 do writeln(TemporaryBuf[p]);
231230
writeln('-------');
232231
233232
end;
@@ -1270,6 +1269,7 @@ procedure OptimizeASM;
12701269
if opt_BRANCH(i) = false then begin Result := false; Break end;
12711270

12721271
if opt_STACK(i) = false then begin Result := false; Break end;
1272+
12731273
if opt_STACK_INX(i) = false then begin Result := false; Break end;
12741274
if opt_STACK_ADD(i) = false then begin Result := false; Break end;
12751275
if opt_STACK_CMP(i) = false then begin Result := false; Break end;
@@ -1431,7 +1431,7 @@ procedure OptimizeEAX_OFF;
14311431

14321432

14331433
{
1434-
if (pos(#9'sub #$', listing[i]) > 0) then begin
1434+
if (pos(#9'and #$', listing[i]) > 0) then begin
14351435
14361436
for p:=0 to l-1 do writeln(listing[p]);
14371437
writeln('-------');

‎origin/Parser.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -285,7 +285,7 @@ function RecordSize(IdentIndex: integer; field: string =''): integer;
285285

286286
if AllocElementType = RECORDTOK then begin
287287
AllocElementType := POINTERTOK;
288-
NumAllocElements := Types[i].Field[j].NumAllocElements shr 16;
288+
NumAllocElements := Types[Ident[IdentIndex].NumAllocElements].Field[i].NumAllocElements shr 16;
289289
NumAllocElements_ := 0;
290290
end;
291291

‎origin/mp.pas‎

Lines changed: 27 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -254,9 +254,10 @@ function ExtractName(IdentIndex: integer; const a: string): string;
254254
var lab: string;
255255
begin
256256

257-
if {(Ident[IdentIndex].UnitIndex > 1) and} (pos(UnitName[Ident[IdentIndex].UnitIndex].Name + '.', a) = 1) then begin
257+
lab := Ident[IdentIndex].Name;
258+
259+
if (lab <> a) and (pos(UnitName[Ident[IdentIndex].UnitIndex].Name + '.', a) = 1) then begin
258260

259-
lab := Ident[IdentIndex].Name;
260261
if lab.IndexOf('.') > 0 then lab := copy(lab, 1, lab.LastIndexOf('.'));
261262

262263
if (pos(UnitName[Ident[IdentIndex].UnitIndex].Name + '.adr.', a) = 1) then
@@ -715,37 +716,9 @@ procedure a65(code: code65; Value: Int64 = 0; Kind: Byte = CONSTANT; Size: Byte
715716

716717
__imulECX: asm65(#9'jsr imulECX');
717718

718-
// __notBOOLEAN: asm65(#9'jsr notBOOLEAN');
719-
// __notaBX: asm65(#9'jsr notaBX');
720-
721-
// __negaBX: asm65(#9'jsr negaBX');
722-
723-
// __xorEAX_ECX: asm65(#9'jsr xorEAX_ECX');
724-
// __xorAX_CX: asm65(#9'jsr xorAX_CX');
725-
// __xorAL_CL: asm65(#9'jsr xorAL_CL');
726-
727-
// __andEAX_ECX: asm65(#9'jsr andEAX_ECX');
728-
// __andAX_CX: asm65(#9'jsr andAX_CX');
729-
// __andAL_CL: asm65(#9'jsr andAL_CL');
730-
731-
// __orEAX_ECX: asm65(#9'jsr orEAX_ECX');
732-
// __orAX_CX: asm65(#9'jsr orAX_CX');
733-
// __orAL_CL: asm65(#9'jsr orAL_CL');
734-
735-
// __cmpEAX_ECX: asm65(#9'jsr cmpEAX_ECX');
736-
// __cmpAX_CX: asm65(#9'jsr cmpEAX_ECX.AX_CX');
737-
// __cmpSHORTINT: asm65(#9'jsr cmpSHORTINT');
738-
// __cmpSMALLINT: asm65(#9'jsr cmpSMALLINT');
739-
// __cmpINT: asm65(#9'jsr cmpINT');
740-
741-
// __cmpSTRING: asm65(#9'jsr cmpSTRING');
742-
// __cmpCHAR2STRING: asm65(#9'jsr cmpCHAR2STRING');
743-
// __cmpSTRING2CHAR: asm65(#9'jsr cmpSTRING2CHAR');
744-
745719
__movaBX_Value: begin
746-
// asm65(#9'ldx sp', '; mov dword ptr [bx], Value');
747720

748-
if Kind=VARIABLE then begin // @label
721+
if Kind = VARIABLE then begin // @label
749722

750723
svar := GetLocalName(IdentIndex);
751724

@@ -2050,15 +2023,15 @@ procedure GenerateFileOpen(IdentIndex: Integer; Code: ioCode);
20502023
ioOpenRead,
20512024
ioOpenWrite:
20522025

2053-
asm65(#9'@openfile '+Ident[IdentIndex].Name+', #'+IntToStr(ord(Code)));
2026+
asm65(#9'@openfile ' + Ident[IdentIndex].Name + ', #'+IntToStr(ord(Code)));
20542027

20552028
ioFileMode:
20562029

2057-
asm65(#9'@openfile '+Ident[IdentIndex].Name+', MAIN.SYSTEM.FileMode');
2030+
asm65(#9'@openfile ' + Ident[IdentIndex].Name + ', MAIN.SYSTEM.FileMode');
20582031

20592032
ioClose:
20602033

2061-
asm65(#9'@closefile '+Ident[IdentIndex].Name);
2034+
asm65(#9'@closefile ' + Ident[IdentIndex].Name);
20622035

20632036
end;
20642037

@@ -2093,9 +2066,9 @@ procedure GenerateFileRead(IdentIndex: Integer; Code: ioCode; NumParams: integer
20932066
ioWriteRecord:
20942067

20952068
if NumParams = 3 then
2096-
asm65(#9'@readfile '+Ident[IdentIndex].Name+', #'+IntToStr(ord(Code) or $80))
2069+
asm65(#9'@readfile ' + Ident[IdentIndex].Name + ', #'+IntToStr(ord(Code) or $80))
20972070
else
2098-
asm65(#9'@readfile '+Ident[IdentIndex].Name+', #'+IntToStr(ord(Code)));
2071+
asm65(#9'@readfile ' + Ident[IdentIndex].Name + ', #'+IntToStr(ord(Code)));
20992072

21002073
end;
21012074

@@ -6411,24 +6384,23 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass
64116384
i := CompileArrayIndex(i, IdentIndex, AllocElementType);
64126385

64136386

6414-
if Ident[IdentIndex].DataType = ENUMTYPE then begin
6415-
// Size := DataSize[Ident[IdentIndex].AllocElementType];
6416-
NumAllocElements := 0;
6417-
end else
6418-
NumAllocElements := Elements(IdentIndex); //Ident[IdentIndex].NumAllocElements;
6387+
if Ident[IdentIndex].DataType = ENUMTYPE then
6388+
NumAllocElements := 0
6389+
else
6390+
NumAllocElements := Elements(IdentIndex);
64196391

64206392
svar := GetLocalName(IdentIndex);
64216393

64226394
if (pos('.', svar) > 0) then begin
6423-
// lab:=copy(svar,1,pos('.', svar)-1);
6395+
// lab:=copy(svar, 1, svar.IndexOf('.'));
64246396
lab := ExtractName(IdentIndex, svar);
64256397

64266398
rec := (Ident[GetIdent(lab)].AllocElementType = RECORDTOK);
64276399
end;
64286400

64296401
//AllocElementType := Ident[IdentIndex].AllocElementType;
64306402

6431-
// writeln(Ident[IdentIndex].DataType,',',Ident[IdentIndex].AllocElementType,',',Ident[IdentIndex].NumAllocElements,',',Ident[IdentIndex].PassMethod,',',VarPass );
6403+
// writeln(Ident[IdentIndex].name,',',Ident[IdentIndex].DataType,',',Ident[IdentIndex].AllocElementType,',',Ident[IdentIndex].NumAllocElements,',',Ident[IdentIndex].PassMethod,',',VarPass ,',',rec,',',Ident[IdentIndex].idType);
64326404

64336405
if rec then begin // record.array[]
64346406

@@ -7269,8 +7241,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn
72697241

72707242
end else begin
72717243

7272-
7273-
if (Ident[IdentIndex].Param[NumActualParams].DataType = POINTERTOK) and (Ident[IdentIndex].Param[NumActualParams].NumAllocElements > 0) then
7244+
if (Ident[IdentIndex].Param[NumActualParams].DataType = POINTERTOK) and (Ident[IdentIndex].Param[NumActualParams].NumAllocElements > 0) and not (Ident[IdentIndex].Param[NumActualParams].AllocElementType in [RECORDTOK, OBJECTTOK]) then
72747245
i := CompileAddress(i + 1, ActualParamType, AllocElementType)
72757246
else
72767247
i := CompileExpression(i + 2, ActualParamType, Ident[IdentIndex].Param[NumActualParams].DataType); // Evaluate actual parameters and push them onto the stack
@@ -8909,10 +8880,12 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy
89098880

89108881
if (Ident[IdentIndex].DataType = POINTERTOK) and (Elements(IdentIndex) > 0) then begin
89118882

8912-
//writeln(Ident[IdentIndex].name, ',', Ident[IdentIndex].PassMethod);
8913-
89148883
i := CompileAddress(i+1, VarType, ValType);
89158884

8885+
8886+
//writeln(Ident[IdentIndex].name, ',', Ident[IdentIndex].PassMethod,',',VarType,',',ValType);
8887+
8888+
89168889
CheckTok(i + 1, CPARTOK);
89178890
CheckTok(i + 2, OBRACKETTOK);
89188891

@@ -9376,7 +9349,7 @@ // === record^.
93769349
else
93779350
begin
93789351

9379-
//writeln('> ',Ident[IdentIndex].Name,',',ValType,',',Ident[GetIdent(Tok[i].Name^)].name,',',VarType);
9352+
// writeln('> ',Ident[IdentIndex].Name,',',ValType,',',Ident[GetIdent(Tok[i].Name^)].name,',',VarType);
93809353
// perl
93819354
i := CompileArrayIndex(i, IdentIndex, ValType); // array[ ].field
93829355

@@ -14848,8 +14821,6 @@ procedure SaveData(compile: Boolean = true);
1484814821

1484914822
begin
1485014823

14851-
// yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy
14852-
1485314824
{
1485414825
if (Tok[i].Kind = STRINGLITERALTOK) and (ConstValType = CHARTOK) then begin // init char array by string -> array [0..15] of char = '0123456789ABCDEF';
1485514826
@@ -15038,7 +15009,6 @@ procedure SaveData(compile: Boolean = true);
1503815009

1503915010
begin
1504015011

15041-
// yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy
1504215012
{
1504315013
if (Tok[i].Kind = STRINGLITERALTOK) and (ConstValType = CHARTOK) then begin // init char array by string -> array [0..15] of char = '0123456789ABCDEF';
1504415014
@@ -15384,8 +15354,8 @@ procedure CheckForwardResolutions(typ: Boolean = true);
1538415354
// ----------------------------------------------------------------------------
1538515355

1538615356

15387-
procedure CompileRecordDeclaration(i: integer; var VarOfSameType: TVariableList; var tmpVarDataSize: integer; var ConstVal: Int64; VarOfSameTypeIndex: integer; VarType, AllocElementType: Byte; NumAllocElements: cardinal; isAbsolute: Boolean);
15388-
var tmpVarDataSize_, ParamIndex{, idx}: integer;
15357+
procedure CompileRecordDeclaration(i: integer; var VarOfSameType: TVariableList; var tmpVarDataSize: integer; var ConstVal: Int64; VarOfSameTypeIndex: integer; VarType, AllocElementType: Byte; NumAllocElements: cardinal; isAbsolute: Boolean; var idx: integer);
15358+
var tmpVarDataSize_, ParamIndex: integer;
1538915359
begin
1539015360

1539115361
// writeln(iDtype,',',VarOfSameType[VarOfSameTypeIndex].Name,' / ',NumAllocElements,' , ',VarType,',',Types[NumAllocElements].Block,' | ', AllocElementType);
@@ -15412,7 +15382,7 @@ procedure CompileRecordDeclaration(i: integer; var VarOfSameType: TVariableList;
1541215382
if Ident[NumIdent].isAbsolute = false then inc(tmpVarDataSize, DataSize[POINTERTOK]); // wskaznik dla ^record
1541315383

1541415384

15415-
//idx := Ident[NumIdent].Value - DATAORIGIN;
15385+
idx := Ident[NumIdent].Value - DATAORIGIN;
1541615386

1541715387
//writeln(NumAllocElements);
1541815388
//!@!@
@@ -15457,7 +15427,7 @@ procedure CompileRecordDeclaration(i: integer; var VarOfSameType: TVariableList;
1545715427

1545815428
end;
1545915429

15460-
end;
15430+
end; //CompileRecordDeclaration
1546115431

1546215432

1546315433
// ----------------------------------------------------------------------------
@@ -16868,7 +16838,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer;
1686816838
end;
1686916839

1687016840

16871-
CompileRecordDeclaration(i, VarOfSameType, tmpVarDataSize, ConstVal, VarOfSameTypeIndex, VarType, AllocElementType, NumAllocElements, isAbsolute);
16841+
CompileRecordDeclaration(i, VarOfSameType, tmpVarDataSize, ConstVal, VarOfSameTypeIndex, VarType, AllocElementType, NumAllocElements, isAbsolute, idx); // !!! idx !!!
1687216842

1687316843

1687416844
end;
@@ -16886,7 +16856,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer;
1688616856

1688716857
if isAbsolute and (open_array = false) then
1688816858

16889-
SetVarDataSize( i, tmpVarDataSize )
16859+
SetVarDataSize( i, tmpVarDataSize )
1689016860

1689116861
else
1689216862

‎src/CHANGELOG‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1+
29.09.2025
2+
- bugfixes and optimizations
3+
14
19.09.2025
25
- 'RTI'/'RTS' FORWARD Procedure/Function
36

‎src/Compiler.pas‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,10 @@ function ExtractName(IdentIndex: Integer; const a: String): String;
137137
lab: String;
138138
begin
139139

140-
if (IdentifierAt(IdentIndex).SourceFile.UnitIndex > 1) and
140+
lab := IdentifierAt(IdentIndex).Name;
141+
142+
//if (IdentifierAt(IdentIndex).SourceFile.UnitIndex > 1) and
143+
if (lab <> a) and
141144
(pos(IdentifierAt(IdentIndex).SourceFile.Name + '.', a) = 1) then
142145
begin
143146

@@ -16664,9 +16667,9 @@ procedure CheckForwardResolutions(typ: Boolean = True);
1666416667

1666516668
procedure CompileRecordDeclaration(i: Integer; var VarOfSameType: TVariableList;
1666616669
var tmpVarDataSize: Integer; var ConstVal: Int64; VarOfSameTypeIndex: Integer;
16667-
VarType, AllocElementType: TDataType; NumAllocElements: Cardinal; isAbsolute: Boolean); // TODO: Actually not used
16670+
VarType, AllocElementType: TDataType; NumAllocElements: Cardinal; isAbsolute: Boolean; var idx: integer); // TODO: Actually not used
1666816671
var
16669-
tmpVarDataSize_, ParamIndex{, idx}: Integer;
16672+
tmpVarDataSize_, ParamIndex: Integer;
1667016673
begin
1667116674

1667216675
// writeln(iDtype,',',VarOfSameType[VarOfSameTypeIndex].Name,' / ',NumAllocElements,' , ',VarType,',',GetTypeAtIndex(NumAllocElements).Block,' | ', AllocElementType);
@@ -16697,7 +16700,7 @@ procedure CompileRecordDeclaration(i: Integer; var VarOfSameType: TVariableList;
1669716700
// wskaznik dla ^record
1669816701

1669916702

16700-
//idx := IdentifierAt(NumIdent).Value - DATAORIGIN;
16703+
idx := IdentifierAt(NumIdent).Value - DATAORIGIN;
1670116704

1670216705
//writeln(NumAllocElements);
1670316706
//!@!@
@@ -18384,7 +18387,7 @@ function CompileBlock(i: TTokenIndex; BlockIdentIndex: Integer; NumParams: Integ
1838418387

1838518388

1838618389
CompileRecordDeclaration(i, VarOfSameType, tmpVarDataSize, ConstVal, VarOfSameTypeIndex, VarType,
18387-
AllocElementType, NumAllocElements, isAbsolute);
18390+
AllocElementType, NumAllocElements, isAbsolute, idx);
1838818391

1838918392
end;
1839018393

0 commit comments

Comments
 (0)