Skip to content

Commit c63ab2d

Browse files
committed
add instruction WITH
1 parent 7619d6e commit c63ab2d

File tree

9 files changed

+612
-77
lines changed

9 files changed

+612
-77
lines changed

origin/CHANGELOG

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
16.08.2025
22
- poprawione przekazywanie typu ENUM w procedurze/funkcji
3+
- dodana obsługa instrukcji WITH
34

45
09.08.2025
56
- optimizations opt_TAY, opt_EOR

origin/Common.pas

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -151,6 +151,7 @@ interface
151151
INTOK = 114;
152152
VOLATILETOK = 115;
153153
STRIPEDTOK = 116;
154+
WITHTOK = 117;
154155

155156

156157
SETTOK = 127; // Size = 32 SET OF
@@ -173,7 +174,7 @@ interface
173174
SINGLETOK = 143; // Size = 4 SINGLE / FLOAT IEEE-754 32bit
174175
HALFSINGLETOK = 144; // Size = 2 HALFSINGLE / FLOAT16 IEEE-754 16bit
175176
PCHARTOK = 145; // Size = 2 POINTER TO ARRAY OF CHAR
176-
ENUMTOK = 146; // Size = 1 BYTE
177+
ENUMTOK = 146; // Size = AllocElementType (4)
177178
PROCVARTOK = 147; // Size = 2
178179
TEXTFILETOK = 148; // Size = 2/12 TEXTFILE
179180
FORWARDTYPE = 149; // Size = 2
@@ -558,14 +559,12 @@ TIdentifier = record
558559

559560
OldConstValType: byte;
560561

561-
NumTok: integer = 0;
562-
563562
AddDefines: integer = 1;
564563
NumDefines: integer = 1; // NumDefines = AddDefines
565564

566-
i, NumIdent, NumTypes, NumPredefIdent, NumStaticStrChars, NumUnits, NumBlocks, run_func, NumProc,
565+
NumTok, NumIdent, NumTypes, NumPredefIdent, NumStaticStrChars, NumUnits, NumBlocks, NumProc,
567566
BlockStackTop, CodeSize, CodePosStackTop, BreakPosStackTop, VarDataSize, Pass, ShrShlCnt,
568-
NumStaticStrCharsTmp, AsmBlockIndex, IfCnt, CaseCnt, IfdefLevel: Integer;
567+
NumStaticStrCharsTmp, AsmBlockIndex, IfCnt, CaseCnt, IfdefLevel, run_func: Integer;
569568

570569
iOut: integer = -1;
571570

@@ -590,7 +589,7 @@ TIdentifier = record
590589
MainPath, FilePath, optyA, optyY, optyBP2,
591590
optyFOR0, optyFOR1, optyFOR2, optyFOR3, outTmp, outputFile: TString;
592591

593-
msgWarning, msgNote, msgUser, UnitPath, OptimizeBuf, LinkObj: TArrayString;
592+
msgWarning, msgNote, msgUser, UnitPath, OptimizeBuf, LinkObj, WithName: TArrayString;
594593

595594

596595
optimize : record

origin/MathEvaluate.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ function constant: real;
5252
var
5353
n: string;
5454
v1: real;
55-
v, k, ln: integer;
55+
v, k, ln, i: integer;
5656
p: word;
5757
pflg: boolean;
5858

origin/Parser.pas

Lines changed: 41 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -128,8 +128,18 @@ function GetIdent(S: TString): Integer;
128128

129129
if S = '' then exit(-1);
130130

131+
132+
if High(WithName) > 0 then
133+
for TempIndex:=0 to High(WithName) do begin
134+
Result := Search(WithName[TempIndex] + '.' + S, UnitNameIndex);
135+
136+
if Result > 0 then exit;
137+
end;
138+
139+
131140
Result := Search(S, UnitNameIndex);
132141

142+
133143
if (Result = 0) and (pos('.', S) > 0) then begin // potencjalnie odwolanie do unitu / obiektu
134144

135145
TempIndex := Search(copy(S, 1, pos('.', S)-1), UnitNameIndex);
@@ -194,7 +204,7 @@ function RecordSize(IdentIndex: integer; field: string =''): integer;
194204
var i, j: integer;
195205
name, base: TName;
196206
FieldType, AllocElementType: Byte;
197-
NumAllocElements: cardinal;
207+
NumAllocElements, NumAllocElements_: cardinal;
198208
yes: Boolean;
199209
begin
200210

@@ -214,20 +224,27 @@ function RecordSize(IdentIndex: integer; field: string =''): integer;
214224
for j := 1 to Types[i].NumFields do begin
215225

216226
FieldType := Types[i].Field[j].DataType;
217-
NumAllocElements := Types[i].Field[j].NumAllocElements;
227+
NumAllocElements := Types[i].Field[j].NumAllocElements and $FFFF;
228+
NumAllocElements_ := Types[i].Field[j].NumAllocElements shr 16;
218229
AllocElementType := Types[i].Field[j].AllocElementType;
219230

220231
if AllocElementType in [FORWARDTYPE, PROCVARTOK] then begin
221232
AllocElementType := POINTERTOK;
222233
NumAllocElements := 0;
234+
NumAllocElements_ := 0;
223235
end;
224236

225237
if Types[i].Field[j].Name = field then begin yes:=true; Break end;
226238

227239
if FieldType <> RECORDTOK then
228-
if (FieldType in Pointers) and (NumAllocElements > 0) then
229-
inc(Result, NumAllocElements * DataSize[AllocElementType])
230-
else
240+
if (FieldType in Pointers) and (NumAllocElements > 0) then begin
241+
242+
if NumAllocElements_ > 0 then
243+
inc(Result, NumAllocElements * NumAllocElements_ * DataSize[AllocElementType])
244+
else
245+
inc(Result, NumAllocElements * DataSize[AllocElementType]);
246+
247+
end else
231248
inc(Result, DataSize[FieldType]);
232249

233250
end;
@@ -245,15 +262,21 @@ function RecordSize(IdentIndex: integer; field: string =''): integer;
245262
if Types[Ident[IdentIndex].NumAllocElements].Field[i].DataType <> RECORDTOK then begin
246263

247264
FieldType := Types[Ident[IdentIndex].NumAllocElements].Field[i].DataType;
248-
NumAllocElements := Types[Ident[IdentIndex].NumAllocElements].Field[i].NumAllocElements;
265+
NumAllocElements := Types[Ident[IdentIndex].NumAllocElements].Field[i].NumAllocElements and $FFFF;
266+
NumAllocElements_ := Types[Ident[IdentIndex].NumAllocElements].Field[i].NumAllocElements shr 16;
249267
AllocElementType := Types[Ident[IdentIndex].NumAllocElements].Field[i].AllocElementType;
250268

251269
if Types[Ident[IdentIndex].NumAllocElements].Field[i].Name = field then begin yes:=true; Break end;
252270

253271
if FieldType <> RECORDTOK then
254-
if (FieldType in Pointers) and (NumAllocElements > 0) then
255-
inc(Result, NumAllocElements * DataSize[AllocElementType])
256-
else
272+
if (FieldType in Pointers) and (NumAllocElements > 0) then begin
273+
274+
if NumAllocElements_ > 0 then
275+
inc(Result, NumAllocElements * NumAllocElements_ * DataSize[AllocElementType])
276+
else
277+
inc(Result, NumAllocElements * DataSize[AllocElementType]);
278+
279+
end else
257280
inc(Result, DataSize[FieldType]);
258281

259282
end;
@@ -562,7 +585,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B
562585
fl:=0;
563586
j:=0;
564587

565-
// WRITELN(tok[i].line, ',', tok[i].kind);
588+
//WRITELN(tok[i].line, ',', tok[i].kind);
566589

567590
case Tok[i].Kind of
568591

@@ -970,13 +993,15 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B
970993
iError(i, TypeMismatch);
971994

972995

973-
if (Ident[GetIdent(Tok[i].Name^)].DataType in RealTypes) and (ConstValType in RealTypes) then begin
996+
if (Ident[IdentIndex].DataType in RealTypes) and (ConstValType in RealTypes) then begin
974997
// ok
975998
end else
976-
if Ident[GetIdent(Tok[i].Name^)].DataType in Pointers then
999+
if Ident[IdentIndex].DataType in Pointers then
9771000
Error(j, 'Illegal type conversion: "'+InfoAboutToken(ConstValType)+'" to "'+Tok[i].Name^+'"');
9781001

979-
ConstValType := Ident[GetIdent(Tok[i].Name^)].DataType;
1002+
ConstValType := Ident[IdentIndex].DataType;
1003+
1004+
if ConstValType = ENUMTYPE then ConstValType := Ident[IdentIndex].AllocElementType;
9801005

9811006
CheckTok(j + 1, CPARTOK);
9821007

@@ -1031,6 +1056,9 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B
10311056
ConstVal := Ident[IdentIndex].Value;
10321057

10331058

1059+
//writeln(ident[identindex].name,',',ConstValType,',',ident[identindex].kind);
1060+
1061+
10341062
if ConstValType = ENUMTYPE then begin
10351063
CheckTok(i + 1, OPARTOK);
10361064

@@ -1918,9 +1946,6 @@ function DeclareFunction(i: integer; out ProcVarIndex: cardinal): integer;
19181946

19191947
Ident[NumIdent].DataType := VarType; // Result
19201948

1921-
if VarType = ENUMTOK then
1922-
Ident[NumIdent].AllocElementType := AllocElementType;
1923-
19241949
Ident[NumIdent].NestedFunctionNumAllocElements := NumAllocElements;
19251950
Ident[NumIdent].NestedFunctionAllocElementType := AllocElementType;
19261951

@@ -2085,10 +2110,6 @@ function DefineFunction(i, ForwardIdentIndex: integer; out isForward, isInt, isI
20852110

20862111
Ident[NumIdent].DataType := NestedFunctionResultType; // Result
20872112

2088-
if NestedFunctionResultType = ENUMTOK then
2089-
Ident[NumIdent].AllocElementType := AllocElementType;
2090-
2091-
20922113
NestedFunctionNumAllocElements := NumAllocElements;
20932114
Ident[NumIdent].NestedFunctionNumAllocElements := NumAllocElements;
20942115

origin/Scanner.pas

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ implementation
3030

3131

3232
procedure TokenizeProgramInitialization;
33+
var i: integer;
3334
begin
3435

3536
fillchar(Ident, sizeof(Ident), 0);
@@ -39,6 +40,7 @@ procedure TokenizeProgramInitialization;
3940
PublicSection := true;
4041
UnitNameIndex := 1;
4142

43+
SetLength(WithName, 1);
4244
SetLength(linkObj, 1);
4345
SetLength(resArray, 1);
4446
SetLength(msgUser, 1);
@@ -1826,6 +1828,7 @@ procedure TokenizeUnit(a: integer; testUnit: Boolean = false);
18261828
Spelling[PACKEDTOK ] := 'PACKED';
18271829
Spelling[VOLATILETOK ] := 'VOLATILE';
18281830
Spelling[STRIPEDTOK ] := 'STRIPED';
1831+
Spelling[WITHTOK ] := 'WITH';
18291832
Spelling[LABELTOK ] := 'LABEL';
18301833
Spelling[GOTOTOK ] := 'GOTO';
18311834
Spelling[INTOK ] := 'IN';
@@ -1958,7 +1961,7 @@ procedure TokenizeMacro(a: string; Line, Spaces: integer);
19581961
var
19591962
Text: string;
19601963
Num, Frac: TString;
1961-
Err, Line2, TextPos, im: Integer;
1964+
i, Err, Line2, TextPos, im: Integer;
19621965
yes: Boolean;
19631966
ch, ch2: Char;
19641967
CurToken: Byte;

origin/include/opt6502/opt_IF_OR.inc

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,6 @@
6767
end;
6868

6969

70-
7170
if lab_a(i) and //@ ; 0 ORA :STACK -> JEQ
7271
tya(i+1) and // tya ; 1
7372
ora_stack(i+2) and // ora :STACKORIGIN ; 2

origin/include/opt6502/opt_TEMP_IMUL_CX.inc

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -21,13 +21,13 @@ begin
2121
(TemporaryBuf[6] = #9'sta :ecx+1') and // sta :ecx+1 ; 6
2222
(TemporaryBuf[7] = #9'sta :eax+1') then // sta :eax+1 ; 7
2323
begin
24-
TemporaryBuf[i+5] := '~';
25-
TemporaryBuf[i+6] := '~';
26-
TemporaryBuf[i+7] := '~';
24+
TemporaryBuf[5] := '~';
25+
TemporaryBuf[6] := '~';
26+
TemporaryBuf[7] := '~';
2727

28-
TemporaryBuf[i+9] := #9'fmulu_8';
28+
TemporaryBuf[9] := #9'fmulu_8';
2929

30-
TemporaryBuf[i+11]:= #9'imulCL';
30+
TemporaryBuf[11]:= #9'imulCL';
3131
end;
3232

3333

@@ -47,13 +47,13 @@ begin
4747
(TemporaryBuf[7] = #9'sta :eax+1') then // sta :eax+1 ; 7
4848
if copy(TemporaryBuf[1], 6, 256) = copy(TemporaryBuf[5], 6, 256) then
4949
begin
50-
TemporaryBuf[i+5] := '~';
51-
TemporaryBuf[i+6] := '~';
52-
TemporaryBuf[i+7] := '~';
50+
TemporaryBuf[5] := '~';
51+
TemporaryBuf[6] := '~';
52+
TemporaryBuf[7] := '~';
5353

54-
TemporaryBuf[i+9] := #9'fmulu_8';
54+
TemporaryBuf[9] := #9'fmulu_8';
5555

56-
TemporaryBuf[i+11]:= #9'imulCL';
56+
TemporaryBuf[11]:= #9'imulCL';
5757
end;
5858

5959
end; // procedure

0 commit comments

Comments
 (0)