Skip to content

Commit 2082ec2

Browse files
tebe6502tebe6502
authored
Merge pull request #188 from peterdell/way2js4
Way2js4 - Messages, Part 2
2 parents 5135cee + ee9f586 commit 2082ec2

File tree

15 files changed

+646
-388
lines changed

15 files changed

+646
-388
lines changed

‎projects/TestMadPascal.lpi‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -522,10 +522,16 @@
522522
</Debugging>
523523
</Linking>
524524
<Other>
525+
<Verbosity>
526+
<ShoLineNum Value="True"/>
527+
<ShowHintsForUnusedUnitsInMainSrc Value="True"/>
528+
</Verbosity>
525529
<ConfigFile>
526530
<StopAfterErrCount Value="100"/>
527531
</ConfigFile>
528-
<CustomOptions Value="-dDEBUG"/>
532+
<CustomOptions Value="-dDEBUG
533+
-dSIMULATED_COMMAND_LINE
534+
-dSIMULATED_FILE_IO"/>
529535
<OtherDefines Count="1">
530536
<Define0 Value="DEBUG"/>
531537
</OtherDefines>

‎projects/TestUnits.lpi‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,10 @@
9393
<Filename Value="..\src\CommonTypes.pas"/>
9494
<IsPartOfProject Value="True"/>
9595
</Unit>
96+
<Unit>
97+
<Filename Value="..\src\Tokens.pas"/>
98+
<IsPartOfProject Value="True"/>
99+
</Unit>
96100
</Units>
97101
</ProjectOptions>
98102
<CompilerOptions>

‎src/Common.pas‎

Lines changed: 7 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -474,7 +474,6 @@ function GetEnumName(IdentIndex: TIdentIndex): TString;
474474

475475
function GetTokenSpellingAtIndex(i: TTokenIndex): String;
476476

477-
478477
function GetVAL(a: String): Integer;
479478

480479
function GetValueType(Value: TIntegerNumber): TDataType;
@@ -560,14 +559,16 @@ function FindFile(Name: String; ftyp: TString): String; overload;
560559
begin
561560
if ftyp = 'unit' then
562561
begin
563-
msg := TMessage.Create(TErrorCode.FileNotFound, 'Can''t find unit ''' + ChangeFileExt(Name, '') +
564-
''' used by program ''' + PROGRAM_NAME + ''' in unit path ''' + unitPathList.ToString + '''.');
562+
msg := TMessage.Create(TErrorCode.FileNotFound,
563+
'Can''t find unit ''{0}'' used by program ''{1}'' in unit path ''{2}''.',
564+
ChangeFileExt(Name, ''), PROGRAM_NAME, unitPathList.ToString);
565565

566566
end
567567
else
568568
begin
569-
msg := TMessage.Create(TErrorCode.FileNotFound, 'Can''t find ' + ftyp + ' file ''' +
570-
Name + ''' used by program ''' + PROGRAM_NAME + ''' in unit path ''' + unitPathList.ToString + '''.');
569+
msg := TMessage.Create(TErrorCode.FileNotFound,
570+
'Can''t find {0} ''{1}'' used by program ''{2}'' in unit path ''{3}''.',
571+
ftyp, Name, PROGRAM_NAME, unitPathList.ToString);
571572
end;
572573
Error(NumTok, msg);
573574
end;
@@ -671,7 +672,7 @@ function StrToInt(const a: String): TIntegerNumber;
671672
(*----------------------------------------------------------------------------*)
672673
{$IFNDEF PAS2JS}
673674
var
674-
i: Integer;
675+
i: Integer; // ##NEEDED
675676
begin
676677
val(a, Result, i);
677678
end;
@@ -717,16 +718,12 @@ procedure FreeTokens;
717718
function GetTokenSpellingAtIndex(i: TTokenIndex): TString;
718719
var
719720
kind: TTokenKind;
720-
var
721-
index: Byte;
722721
begin
723-
724722
if i > NumTok then
725723
Result := 'no token'
726724
else
727725
begin
728726
kind := Tok[i].Kind;
729-
index := Ord(kind);
730727
GetHumanReadbleTokenSpelling(kind);
731728
end;
732729
end;

‎src/Defines.inc‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,9 @@
1717
{$ENDIF}
1818

1919
// Special cases for PAS2JS
20-
{$IFNDEF PAS2JS}
21-
{$DEFINE UPCASE_STRING}
22-
{$ELSE}
20+
{$IFDEF PAS2JS}
2321
{$DEFINE SIMULATED_FILE_IO}
22+
{$DEFINE SIMULATED_COMMAND_LINE}
23+
{$ELSE}
24+
{$DEFINE UPCASE_STRING}
2425
{$ENDIF}

‎src/FileIO.pas‎

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ TPathList = class
4747
// https://www.freepascal.org/docs-html/rtl/system/filepos.html
4848
function FilePos(): TInteger;
4949
procedure Read(var c: Char);
50-
procedure Reset(l: Longint); overload;
50+
procedure Reset(l: Longint); overload; // l = record size
5151
procedure Seek2(Pos: TInteger);
5252
end;
5353

@@ -501,6 +501,8 @@ procedure TBinaryFile.Read(var c: Char);
501501
{$IFNDEF SIMULATED_FILE_IO}
502502

503503
System.Read(f, c);
504+
{$ELSE}
505+
Assert(False, 'Not implemented yet');
504506
{$ENDIF}
505507

506508
end;
@@ -621,4 +623,26 @@ class function TFileSystem.GetFileMapEntry(const filePath: TFilePath): TFileMapE
621623
Result := fileMap.GetEntry(filePath);
622624
end;
623625

626+
627+
procedure InitializeFileMap;
628+
var
629+
fileMap: TFileMap;
630+
fileMapEntry: TFileMapEntry;
631+
begin
632+
{$IFDEF SIMULATED_FILE_IO}
633+
fileMap := TFileMap.Create;
634+
fileMapEntry:=fileMap.AddEntry('Input.pas', TFileMapEntry.TFileType.TextFile);
635+
fileMapEntry.content := 'Program program; end.';
636+
fileMapEntry := fileMap.AddEntry('lib', TFileMapEntry.TFileType.Folder);
637+
fileMapEntry.content := 'SubFolder1;SubFolder2';
638+
fileMapEntry := fileMap.AddEntry('Input.bin', TFileMapEntry.TFileType.BinaryFile);
639+
fileMapEntry.content := '01010110101';
640+
TFileSystem.Init(fileMap);
641+
{$ENDIF}
642+
end;
643+
644+
initialization
645+
646+
InitializeFileMap;
647+
624648
end.

‎src/Makefile.bat‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@ goto :eof
8686
if exist %MADS_OUTPUT_XEX% del %MADS_OUTPUT_XEX%
8787
mads %MP_OUTPUT_ASM% -x -i:%MP_FOLDER%\base -o:%MADS_OUTPUT_XEX%
8888
if exist %MADS_OUTPUT_XEX% (
89-
if "%TEST_MODE%"=="" (
89+
if "%TEST_MODE%"=="FULL" (
9090
echo Starting test program "%MADS_OUTPUT_XEX%".
9191
%MADS_OUTPUT_XEX%
9292
)

‎src/Makefile.pas2js‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
# cd /c/jac/system/Atari800/Programming/Repositories/Mad-Pascal/src
66
# export PATH=/c/jac/system/Windows/Tools/PAS/PAS2JS/pas2js-win64-x86_64-3.0.1/bin/:$PATH
77
# make -f Makefile.pas2js
8+
# start C:\jac\system\Atari800\Programming\Repositories\Mad-Pascal\bin\javascript\mp.html
89
#
910

1011
SRC = mp.pas \

‎src/Messages.pas‎

Lines changed: 29 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,9 @@ TMessageDefinition = record
5757
type
5858
TMessage = class(TInterfacedObject, IMessage)
5959
constructor Create(const errorCode: TErrorCode; const Text: String; const variable0: String = '';
60-
const variable1: String = '');
60+
const variable1: String = ''; const variable2: String = ''; const variable3: String = '';
61+
const variable4: String = ''; const variable5: String = ''; const variable6: String = '';
62+
const variable7: String = ''; const variable8: String = ''; const variable9: String = '');
6163
function GetErrorCode: TErrorCode;
6264
function GetText: String;
6365
private
@@ -121,7 +123,10 @@ implementation
121123

122124
// -----------------------------------------------------------------------------
123125
constructor TMessage.Create(const errorCode: TErrorCode; const Text: String; const variable0: String = '';
124-
const variable1: String = '');
126+
const variable1: String = ''; const variable2: String = ''; const variable3: String = '';
127+
const variable4: String = ''; const variable5: String = ''; const variable6: String = '';
128+
const variable7: String = ''; const variable8: String = '';
129+
const variable9: String = '');
125130
var
126131
l: Integer;
127132
i: Integer;
@@ -136,19 +141,33 @@ constructor TMessage.Create(const errorCode: TErrorCode; const Text: String; con
136141
c := Text[i];
137142
if c = '{' then
138143
begin
139-
assert(i < l - 2, 'Invalid string pattern, too short ''' + Text + '''');
140-
assert(Text[i + 1] in ['0', '9'], 'Invalid string pattern, placeholder must be {0}..{9} ''' + Text + '''');
141-
assert(Text[i + 2] = '}', 'Invalid string pattern, missing } ''' + Text + '''');
144+
assert(i <= l - 2, 'Invalid string pattern, pattern ''' + Text + ''' is too short.');
145+
Inc(i);
146+
c := Text[i];
147+
assert(c in ['0' .. '9'], 'Invalid string pattern, placeholder ''' + c + ''' at index ' +
148+
IntToStr(i + 1) + ' of ''' + Text + ''' must be must a digit 0..9.');
149+
Inc(i);
150+
assert(Text[i] = '}', 'Invalid string pattern, missing } at index ' + IntToStr(i) + ' of ''' + Text + '''');
142151
begin
143-
case Text[i] of
152+
case c of
144153
'0': Self.Text := Self.Text + variable0;
145154
'1': Self.Text := Self.Text + variable1;
155+
'2': Self.Text := Self.Text + variable2;
156+
'3': Self.Text := Self.Text + variable3;
157+
'4': Self.Text := Self.Text + variable4;
158+
'5': Self.Text := Self.Text + variable5;
159+
'6': Self.Text := Self.Text + variable6;
160+
'7': Self.Text := Self.Text + variable7;
161+
'8': Self.Text := Self.Text + variable8;
162+
'9': Self.Text := Self.Text + variable9;
163+
else
164+
Assert(False, 'Internal program error.');
146165
end;
147-
i := i + 2;
148166
end;
149-
end else
167+
end
168+
else
150169
begin
151-
Self.Text := Self.Text + c;
170+
Self.Text := Self.Text + c;
152171
end;
153172
Inc(i);
154173
until i >= l;
@@ -751,3 +770,4 @@ procedure Note(tokenIndex: TTokenIndex; const msg: String);
751770

752771

753772
end.
773+

‎src/Numbers.pas‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66

77
interface
88

9-
uses Types, Common; // TODO Remove Common and have only Tokens
9+
uses Common; // TODO Remove Common and have only TDataType
1010

1111
type
1212
TNumber = Int64;

‎src/Scanner.pas‎

Lines changed: 15 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -297,7 +297,8 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
297297
UnitIndex := NumUnits;
298298

299299
if UnitIndex > High(UnitName) then
300-
Error(NumTok, TMessage.Create(TErrorCode.OutOfResources, 'Out of resources, UnitIndex: ' + IntToStr(UnitIndex)));
300+
Error(NumTok, TMessage.Create(TErrorCode.OutOfResources, 'Out of resources, UnitIndex: ' +
301+
IntToStr(UnitIndex)));
301302

302303
Line := 1;
303304
UnitName[UnitIndex].Name := s;
@@ -1053,8 +1054,8 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
10531054

10541055
if c in [' ', TAB] then Inc(Spaces);
10551056

1056-
if not (c in ['''', ' ', '#', '~', '$', TAB, LF, CR, '{', (*'}',*) 'A'..'Z', '_', '0'..'9',
1057-
'=', '.', ',', ';', '(', ')', '*', '/', '+', '-', ':', '>', '<', '^', '@', '[', ']']) then
1057+
if not (c in ['''', ' ', '#', '~', '$', TAB, LF, CR, '{', (*'}',*) 'A'..'Z', '_',
1058+
'0'..'9', '=', '.', ',', ';', '(', ')', '*', '/', '+', '-', ':', '>', '<', '^', '@', '[', ']']) then
10581059
begin
10591060
// InFile.Close();
10601061
Error(NumTok, TMessage.Create(TErrorCode.UnexpectedCharacter, 'Unexpected unknown character: ' + c));
@@ -1195,6 +1196,7 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
11951196
inFile.Reset(1);
11961197

11971198
Text := '';
1199+
ch:=' ';
11981200

11991201
try
12001202
while True do
@@ -1206,7 +1208,8 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
12061208

12071209
if ch in [' ', TAB] then Inc(Spaces);
12081210

1209-
until not (ch in [' ', TAB, LF, CR, '{'(*, '}'*)]); // Skip space, tab, line feed, carriage return, comment braces
1211+
until not (ch in [' ', TAB, LF, CR, '{'(*, '}'*)]);
1212+
// Skip space, tab, line feed, carriage return, comment braces
12101213

12111214

12121215
ch := UpCase(ch);
@@ -1317,7 +1320,8 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
13171320
StrParams := SplitStr(copy(Num, 2, length(Num) - 2), ',');
13181321

13191322
if High(StrParams) > MAXPARAMS then
1320-
Error(NumTok, TMessage.Create(TErrorCode.TooManyFormalParameters, 'Too many formal parameters in ' + Text));
1323+
Error(NumTok, TMessage.Create(TErrorCode.TooManyFormalParameters,
1324+
'Too many formal parameters in ' + Text));
13211325

13221326
end;
13231327

@@ -1448,7 +1452,8 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
14481452

14491453
if ch in [' ', TAB] then Inc(Spaces);
14501454

1451-
until not (ch in [' ', TAB, LF, CR, '{', '}']); // Skip space, tab, line feed, carriage return, comment braces
1455+
until not (ch in [' ', TAB, LF, CR, '{', '}']);
1456+
// Skip space, tab, line feed, carriage return, comment braces
14521457

14531458
AsmFound := False;
14541459

@@ -1737,17 +1742,17 @@ procedure TokenizeProgram(UsesOn: Boolean = True);
17371742
end
17381743
else
17391744
begin
1740-
Error(NumTok, TMessage.Create(TErrorCode.UnexpectedCharacter, 'Unexpected character ''' +
1741-
ch + ''' found. Expected one of '':><.''.'));
1745+
Error(NumTok, TMessage.Create(TErrorCode.UnexpectedCharacter,
1746+
'Unexpected character ''{0}'' found. Expected one of ''{1}.''', ch, ':><.'));
17421747
end;
17431748
end;
17441749
end;
17451750

17461751

17471752
if NumTok = OldNumTok then // No token found
17481753
begin
1749-
Error(NumTok, TMessage.Create(TErrorCode.UnexpectedCharacter, 'Illegal character ''' + ch +
1750-
''' ($' + IntToHex(Ord(ch), 2) + ')'));
1754+
Error(NumTok, TMessage.Create(TErrorCode.UnexpectedCharacter,
1755+
'Illegal character ''{0}'' (${1}) found.', ch, IntToHex(Ord(ch), 2)));
17511756
end;
17521757

17531758
end;// while

0 commit comments

Comments
 (0)