diff --git a/src/Common.pas b/src/Common.pas index ca5a39df2..fb06b0c56 100644 --- a/src/Common.pas +++ b/src/Common.pas @@ -16,14 +16,14 @@ interface CR = ^M; // Char for a CR LF = ^J; // Char for a LF - AllowDirectorySeparators : set of char = ['/','\']; + AllowDirectorySeparators: set of Char = ['/', '\']; - AllowWhiteSpaces : set of char = [' ',TAB,CR,LF]; - AllowQuotes : set of char = ['''','"']; - AllowLabelFirstChars : set of char = ['A'..'Z','_']; - AllowLabelChars : set of char = ['A'..'Z','0'..'9','_','.']; - AllowDigitFirstChars : set of char = ['0'..'9','%','$']; - AllowDigitChars : set of char = ['0'..'9','A'..'F']; + AllowWhiteSpaces: set of Char = [' ', TAB, CR, LF]; + AllowQuotes: set of Char = ['''', '"']; + AllowLabelFirstChars: set of Char = ['A'..'Z', '_']; + AllowLabelChars: set of Char = ['A'..'Z', '0'..'9', '_', '.']; + AllowDigitFirstChars: set of Char = ['0'..'9', '%', '$']; + AllowDigitChars: set of Char = ['0'..'9', 'A'..'F']; // Token codes @@ -438,11 +438,11 @@ TIdentifier = record PassMethod: Byte; Pass: Byte; - NestedNumAllocElements: cardinal; + NestedNumAllocElements: Cardinal; NestedAllocElementType: Byte; NestedDataType: Byte; - NestedFunctionNumAllocElements: cardinal; + NestedFunctionNumAllocElements: Cardinal; NestedFunctionAllocElementType: Byte; isNestedFunction: Boolean; @@ -489,59 +489,61 @@ TIdentifier = record NumChildren: Word; end; - TUnit = - record + TUnit = record Name: TString; Path: String; - Units: integer; + Units: Integer; Allow: array [1..MAXALLOWEDUNITS] of TString; end; - TResource = - record + TResource = record resStream: Boolean; resName, resType, resFile: TString; - resValue: integer; - resFullName: string; + resValue: Integer; + resFullName: String; resPar: array [1..MAXPARAMS] of TString; end; - TCaseLabel = - record + TCaseLabel = record left, right: Int64; equality: Boolean; end; - TPosStack = - record - ptr: word; + TPosStack = record + ptr: Word; brk, cnt: Boolean; end; - TForLoop = - record + TForLoop = record begin_value, end_value: Int64; begin_const, end_const: Boolean; end; TCaseLabelArray = array of TCaseLabel; - TArrayString = array of string; + TArrayString = array of String; {$i targets/var.inc} - const MIN_MEMORY_ADDRESS=$0000; - const MAX_MEMORY_ADDRESS=$FFFF; +const + MIN_MEMORY_ADDRESS = $0000; - type TWordMemory = array [MIN_MEMORY_ADDRESS..MAX_MEMORY_ADDRESS] of Word; +const + MAX_MEMORY_ADDRESS = $FFFF; + +type + TWordMemory = array [MIN_MEMORY_ADDRESS..MAX_MEMORY_ADDRESS] of Word; +type + TTokenIndex = Integer; + var - PROGRAM_NAME: string = 'Program'; - LIBRARY_NAME: string; + PROGRAM_NAME: String = 'Program'; + LIBRARY_NAME: String; - AsmBlock: array [0..4095] of string; + AsmBlock: array [0..4095] of String; Data, DataSegment, StaticStringData: TWordMemory; @@ -551,32 +553,32 @@ TIdentifier = record Spelling: array [1..MAXTOKENNAMES] of TString; UnitName: array [1..MAXUNITS + MAXUNITS] of TUnit; // {$include ...} -> UnitName[MAXUNITS..] Defines: array [1..MAXDEFINES] of TDefines; - IFTmpPosStack: array of integer; + IFTmpPosStack: array of Integer; BreakPosStack: array [0..MAXPOSSTACK] of TPosStack; CodePosStack: array [0..MAXPOSSTACK] of Word; BlockStack: array [0..MAXBLOCKS - 1] of Integer; CallGraph: array [1..MAXBLOCKS] of TCallGraphNode; // For dead code elimination - OldConstValType: byte; + OldConstValType: Byte; - NumTok: integer = 0; + NumTok: Integer = 0; - AddDefines: integer = 1; - NumDefines: integer = 1; // NumDefines = AddDefines + AddDefines: Integer = 1; + NumDefines: Integer = 1; // NumDefines = AddDefines i, NumIdent, NumTypes, NumPredefIdent, NumStaticStrChars, NumUnits, NumBlocks, run_func, NumProc, BlockStackTop, CodeSize, CodePosStackTop, BreakPosStackTop, VarDataSize, Pass, ShrShlCnt, NumStaticStrCharsTmp, AsmBlockIndex, IfCnt, CaseCnt, IfdefLevel: Integer; - iOut: integer = -1; + iOut: Integer = -1; start_time: QWord; - CODEORIGIN_BASE: integer = -1; + CODEORIGIN_BASE: Integer = -1; - DATA_BASE: integer = -1; - ZPAGE_BASE: integer = -1; - STACK_BASE: integer = -1; + DATA_BASE: Integer = -1; + ZPAGE_BASE: Integer = -1; + STACK_BASE: Integer = -1; UnitNameIndex: Integer = 1; @@ -597,23 +599,23 @@ TIdentifier = record optimize : record use: Boolean; - unitIndex, line, old: integer; + unitIndex, line, old: Integer; end; codealign : record - proc, loop, link : integer; + proc, loop, link: Integer; end; - PROGRAMTOK_USE, INTERFACETOK_USE, LIBRARYTOK_USE, LIBRARY_USE, RCLIBRARY, - OutputDisabled, isConst, isError, isInterrupt, IOCheck, Macros: Boolean; + PROGRAMTOK_USE, INTERFACETOK_USE, LIBRARYTOK_USE, LIBRARY_USE, RCLIBRARY, OutputDisabled, + isConst, isError, isInterrupt, IOCheck, Macros: Boolean; - DiagMode: Boolean = false; - DataSegmentUse: Boolean = false; + DiagMode: Boolean = False; + DataSegmentUse: Boolean = False; - LoopUnroll : Boolean = false; + LoopUnroll: Boolean = False; - PublicSection : Boolean = true; + PublicSection: Boolean = True; {$IFDEF USEOPTFILE} @@ -626,9 +628,9 @@ TIdentifier = record procedure ClearWordMemory(anArray: TWordMemory); - procedure AddDefine(X: string); +procedure AddDefine(X: String); - procedure AddPath(s: string); +procedure AddPath(s: String); procedure CheckArrayIndex(i: Integer; IdentIndex: Integer; ArrayIndex: Int64; ArrayIndexType: Byte); @@ -636,43 +638,43 @@ TIdentifier = record procedure CheckOperator(ErrTokenIndex: Integer; op: Byte; DataType: Byte; RightType: Byte = 0); - procedure CheckTok(i: integer; ExpectedTok: Byte); +procedure CheckTok(i: Integer; ExpectedTok: Byte); procedure DefineStaticString(StrTokenIndex: Integer; StrValue: String); procedure DefineFilename(StrTokenIndex: Integer; StrValue: String); - function ErrTokenFound(ErrTokenIndex: Integer): string; +function ErrTokenFound(ErrTokenIndex: Integer): String; - function FindFile(Name: string; ftyp: TString): string; overload; +function FindFile(Name: String; ftyp: TString): String; overload; procedure FreeTokens; - function GetCommonConstType(ErrTokenIndex: Integer; DstType, SrcType: Byte; err: Boolean = true): Boolean; +function GetCommonConstType(ErrTokenIndex: Integer; DstType, SrcType: Byte; err: Boolean = True): Boolean; function GetCommonType(ErrTokenIndex: Integer; LeftType, RightType: Byte): Byte; - function GetEnumName(IdentIndex: integer): TString; +function GetEnumName(IdentIndex: Integer): TString; function GetSpelling(i: Integer): TString; - function GetVAL(a: string): integer; +function GetVAL(a: String): Integer; - function GetValueType(Value: Int64): byte; +function GetValueType(Value: Int64): Byte; - function HighBound(i: integer; DataType: Byte): Int64; +function HighBound(i: Integer; DataType: Byte): Int64; - function InfoAboutToken(t: Byte): string; +function InfoAboutToken(t: Byte): String; - function IntToStr(const a: Int64): string; +function IntToStr(const a: Int64): String; - function LowBound(i: integer; DataType: Byte): Int64; +function LowBound(i: Integer; DataType: Byte): Int64; - function Min(a,b: integer): integer; +function Min(a, b: Integer): Integer; - function SearchDefine(X: string): integer; +function SearchDefine(X: String): Integer; - function StrToInt(const a: string): Int64; +function StrToInt(const a: String): Int64; // ---------------------------------------------------------------------------- @@ -684,26 +686,29 @@ implementation // ---------------------------------------------------------------------------- -function FindFile(name: string; ftyp: TString): string; overload; +function FindFile(Name: String; ftyp: TString): String; overload; begin - result:=unitPathList.FindFile( name); - if result = '' then + Result := unitPathList.FindFile(Name); + if Result = '' then if ftyp = 'unit' then - Error(NumTok, 'Can''t find unit '''+ChangeFileExt(name,'')+''' used by program '''+PROGRAM_NAME+''' in unit path '''+unitPathList.ToString+'''.') + Error(NumTok, 'Can''t find unit ''' + ChangeFileExt(Name, '') + ''' used by program ''' + + PROGRAM_NAME + ''' in unit path ''' + unitPathList.ToString + '''.') else - Error(NumTok, 'Can''t find '+ftyp+' file '''+name+''' used by program '''+PROGRAM_NAME+''' in unit path '''+unitPathList.ToString+'''.'); - + Error(NumTok, 'Can''t find ' + ftyp + ' file ''' + Name + ''' used by program ''' + PROGRAM_NAME + + ''' in unit path ''' + unitPathList.ToString + '''.'); end; // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- -function SearchDefine(X: string): integer; -var i: integer; +function SearchDefine(X: String): Integer; +var + i: Integer; begin for i:=1 to NumDefines do - if X = Defines[i].Name then begin + if X = Defines[i].Name then + begin Exit(i); end; Result := 0; @@ -714,8 +719,9 @@ function SearchDefine(X: string): integer; // ---------------------------------------------------------------------------- -procedure AddDefine(X: string); -var S: TName; +procedure AddDefine(X: String); +var + S: TName; begin S := X; if SearchDefine(S) = 0 then @@ -733,7 +739,7 @@ procedure AddDefine(X: string); // ---------------------------------------------------------------------------- -procedure AddPath(s: string); +procedure AddPath(s: String); begin unitPathList.AddFolder(s); end; @@ -743,12 +749,14 @@ procedure AddPath(s: string); // ---------------------------------------------------------------------------- -function GetEnumName(IdentIndex: integer): TString; -var IdentTtemp: integer; +function GetEnumName(IdentIndex: Integer): TString; +var + IdentTtemp: Integer; - function Search(Num: cardinal): integer; - var IdentIndex, BlockStackIndex: Integer; + function Search(Num: Cardinal): Integer; + var + IdentIndex, BlockStackIndex: Integer; begin Result := 0; @@ -756,7 +764,8 @@ function GetEnumName(IdentIndex: integer): TString; // Search all nesting levels from the current one to the most outer one for BlockStackIndex := BlockStackTop downto 0 do for IdentIndex := 1 to NumIdent do - if (Ident[IdentIndex].DataType = ENUMTYPE) and (Ident[IdentIndex].NumAllocElements = Num) and (BlockStack[BlockStackIndex] = Ident[IdentIndex].Block) then + if (Ident[IdentIndex].DataType = ENUMTYPE) and (Ident[IdentIndex].NumAllocElements = Num) and + (BlockStack[BlockStackIndex] = Ident[IdentIndex].Block) then exit(IdentIndex); end; @@ -765,13 +774,16 @@ function GetEnumName(IdentIndex: integer): TString; Result := ''; - if Ident[IdentIndex].NumAllocElements > 0 then begin + if Ident[IdentIndex].NumAllocElements > 0 then + begin IdentTtemp := Search(Ident[IdentIndex].NumAllocElements); if IdentTtemp > 0 then Result := Ident[IdentTtemp].Name; - end else - if Ident[IdentIndex].DataType = ENUMTYPE then begin + end + else + if Ident[IdentIndex].DataType = ENUMTYPE then + begin IdentTtemp := Search(Ident[IdentIndex].NumAllocElements); if IdentTtemp > 0 then @@ -785,11 +797,12 @@ function GetEnumName(IdentIndex: integer): TString; // ---------------------------------------------------------------------------- -function StrToInt(const a: string): Int64; +function StrToInt(const a: String): Int64; (*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*) {$IFNDEF PAS2JS} -var i: integer; +var + i: Integer; begin val(a,Result, i); end; @@ -806,7 +819,7 @@ function StrToInt(const a: string): Int64; // ---------------------------------------------------------------------------- -function IntToStr(const a: Int64): string; +function IntToStr(const a: Int64): String; (*----------------------------------------------------------------------------*) (*----------------------------------------------------------------------------*) begin @@ -818,7 +831,7 @@ function IntToStr(const a: Int64): string; // ---------------------------------------------------------------------------- -function Min(a,b: integer): integer; +function Min(a, b: Integer): Integer; begin if a < b then @@ -873,7 +886,7 @@ function GetSpelling(i: Integer): TString; // ---------------------------------------------------------------------------- -function ErrTokenFound(ErrTokenIndex: Integer): string; +function ErrTokenFound(ErrTokenIndex: Integer): String; begin Result:=' expected but ''' + GetSpelling(ErrTokenIndex) + ''' found'; @@ -891,21 +904,20 @@ procedure CheckOperator(ErrTokenIndex: Integer; op: Byte; DataType: Byte; RightT //writeln(tok[ErrTokenIndex].Name,',', op,',',DataType); if {(not (DataType in (OrdinalTypes + [REALTOK, POINTERTOK]))) or} - ((DataType in RealTypes) and - not (op in [MULTOK, DIVTOK, PLUSTOK, MINUSTOK, GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK])) or - ((DataType in IntegerTypes) and - not (op in [MULTOK, IDIVTOK, MODTOK, SHLTOK, SHRTOK, ANDTOK, PLUSTOK, MINUSTOK, ORTOK, XORTOK, NOTTOK, GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK, INTOK])) or - ((DataType = CHARTOK) and + ((DataType in RealTypes) and not (op in [MULTOK, DIVTOK, PLUSTOK, MINUSTOK, GTTOK, + GETOK, EQTOK, NETOK, LETOK, LTTOK])) or ((DataType in IntegerTypes) and not + (op in [MULTOK, IDIVTOK, MODTOK, SHLTOK, SHRTOK, ANDTOK, PLUSTOK, MINUSTOK, ORTOK, XORTOK, + NOTTOK, GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK, INTOK])) or ((DataType = CHARTOK) and not (op in [GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK, INTOK])) or - ((DataType = BOOLEANTOK) and - not (op in [ANDTOK, ORTOK, XORTOK, NOTTOK, GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK])) or - ((DataType in Pointers) and - not (op in [GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK, PLUSTOK, MINUSTOK])) -then + ((DataType = BOOLEANTOK) and not (op in [ANDTOK, ORTOK, XORTOK, NOTTOK, GTTOK, GETOK, + EQTOK, NETOK, LETOK, LTTOK])) or ((DataType in Pointers) and not + (op in [GTTOK, GETOK, EQTOK, NETOK, LETOK, LTTOK, PLUSTOK, MINUSTOK])) then if DataType = RightType then - Error(ErrTokenIndex, 'Operator is not overloaded: ' + '"' + InfoAboutToken(DataType) + '" ' + InfoAboutToken(op) + ' "' + InfoAboutToken(RightType) + '"') + Error(ErrTokenIndex, 'Operator is not overloaded: ' + '"' + InfoAboutToken(DataType) + '" ' + + InfoAboutToken(op) + ' "' + InfoAboutToken(RightType) + '"') else - Error(ErrTokenIndex, 'Operation "' + InfoAboutToken(op) + '" not supported for types "' + InfoAboutToken(DataType) + '" and "' + InfoAboutToken(RightType) + '"'); + Error(ErrTokenIndex, 'Operation "' + InfoAboutToken(op) + '" not supported for types "' + + InfoAboutToken(DataType) + '" and "' + InfoAboutToken(RightType) + '"'); end; @@ -918,7 +930,8 @@ procedure CheckArrayIndex(i: Integer; IdentIndex: Integer; ArrayIndex: Int64; Ar begin if (Ident[IdentIndex].NumAllocElements > 0) and (Ident[IdentIndex].AllocElementType <> RECORDTOK) then - if (ArrayIndex < 0) or (ArrayIndex > Ident[IdentIndex].NumAllocElements-1 + ord(Ident[IdentIndex].DataType = STRINGPOINTERTOK)) then + if (ArrayIndex < 0) or (ArrayIndex > Ident[IdentIndex].NumAllocElements - 1 + + Ord(Ident[IdentIndex].DataType = STRINGPOINTERTOK)) then if Ident[IdentIndex].NumAllocElements <> 1 then warning(i, RangeCheckError, IdentIndex, ArrayIndex, ArrayIndexType); end; @@ -932,8 +945,10 @@ procedure CheckArrayIndex_(i: Integer; IdentIndex: Integer; ArrayIndex: Int64; A begin if Ident[IdentIndex].NumAllocElements_ > 0 then - if (ArrayIndex < 0) or (ArrayIndex > Ident[IdentIndex].NumAllocElements_-1 + ord(Ident[IdentIndex].DataType = STRINGPOINTERTOK)) then - if Ident[IdentIndex].NumAllocElements_ <> 1 then warning(i, RangeCheckError_, IdentIndex, ArrayIndex, ArrayIndexType); + if (ArrayIndex < 0) or (ArrayIndex > Ident[IdentIndex].NumAllocElements_ - 1 + + Ord(Ident[IdentIndex].DataType = STRINGPOINTERTOK)) then + if Ident[IdentIndex].NumAllocElements_ <> 1 then + warning(i, RangeCheckError_, IdentIndex, ArrayIndex, ArrayIndexType); end; @@ -942,7 +957,7 @@ procedure CheckArrayIndex_(i: Integer; IdentIndex: Integer; ArrayIndex: Int64; A // ---------------------------------------------------------------------------- -function InfoAboutToken(t: Byte): string; +function InfoAboutToken(t: Byte): String; begin case t of @@ -1039,26 +1054,26 @@ function InfoAboutToken(t: Byte): string; // ---------------------------------------------------------------------------- -function LowBound(i: integer; DataType: Byte): Int64; +function LowBound(i: Integer; DataType: Byte): Int64; begin Result := 0; case DataType of - UNTYPETOK: iError(i, CantReadWrite); + UNTYPETOK: Error(i, CantReadWrite); INTEGERTOK: Result := Low(Integer); - SMALLINTTOK: Result := Low(SmallInt); - SHORTINTTOK: Result := Low(ShortInt); + SMALLINTTOK: Result := Low(Smallint); + SHORTINTTOK: Result := Low(Shortint); CHARTOK: Result := 0; - BOOLEANTOK: Result := ord(Low(Boolean)); + BOOLEANTOK: Result := Ord(Low(Boolean)); BYTETOK: Result := Low(Byte); WORDTOK: Result := Low(Word); CARDINALTOK: Result := Low(Cardinal); STRINGTOK: Result := 1; else - iError(i, TypeMismatch); + Error(i, TypeMismatch); end;// case end; @@ -1068,26 +1083,26 @@ function LowBound(i: integer; DataType: Byte): Int64; // ---------------------------------------------------------------------------- -function HighBound(i: integer; DataType: Byte): Int64; +function HighBound(i: Integer; DataType: Byte): Int64; begin Result := 0; case DataType of - UNTYPETOK: iError(i, CantReadWrite); + UNTYPETOK: Error(i, CantReadWrite); INTEGERTOK: Result := High(Integer); - SMALLINTTOK: Result := High(SmallInt); - SHORTINTTOK: Result := High(ShortInt); + SMALLINTTOK: Result := High(Smallint); + SHORTINTTOK: Result := High(Shortint); CHARTOK: Result := 255; - BOOLEANTOK: Result := ord(High(Boolean)); + BOOLEANTOK: Result := Ord(High(Boolean)); BYTETOK: Result := High(Byte); WORDTOK: Result := High(Word); CARDINALTOK: Result := High(Cardinal); STRINGTOK: Result := 255; else - iError(i, TypeMismatch); + Error(i, TypeMismatch); end;// case end; @@ -1097,14 +1112,16 @@ function HighBound(i: integer; DataType: Byte): Int64; // ---------------------------------------------------------------------------- -function GetVAL(a: string): integer; -var err: integer; +function GetVAL(a: String): Integer; +var + err: Integer; begin Result := -1; if a <> '' then - if a[1] = '#' then begin + if a[1] = '#' then + begin val(copy(a, 2, length(a)), Result, err); if err > 0 then Result := -1; @@ -1117,16 +1134,20 @@ function GetVAL(a: string): integer; // ---------------------------------------------------------------------------- -function GetValueType(Value: Int64): byte; +function GetValueType(Value: Int64): Byte; begin - if Value < 0 then begin + if Value < 0 then + begin - if Value >= Low(shortint) then Result := SHORTINTTOK else - if Value >= Low(smallint) then Result := SMALLINTTOK else + if Value >= Low(Shortint) then Result := SHORTINTTOK + else + if Value >= Low(Smallint) then Result := SMALLINTTOK + else Result := INTEGERTOK; - end else + end + else case Value of 0..255: Result := BYTETOK; @@ -1142,8 +1163,9 @@ function GetValueType(Value: Int64): byte; // ---------------------------------------------------------------------------- -procedure CheckTok(i: integer; ExpectedTok: Byte); -var s: string; +procedure CheckTok(i: Integer; ExpectedTok: Byte); +var + s: String; begin if ExpectedTok < IDENTTOK then @@ -1169,31 +1191,26 @@ procedure CheckTok(i: integer; ExpectedTok: Byte); // ---------------------------------------------------------------------------- -function GetCommonConstType(ErrTokenIndex: Integer; DstType, SrcType: Byte; err: Boolean = true): Boolean; +function GetCommonConstType(ErrTokenIndex: Integer; DstType, SrcType: Byte; err: Boolean = True): Boolean; begin - Result := false; + Result := False; - if (DataSize[DstType] < DataSize[SrcType]) or - ( (DstType = REALTOK) and (SrcType <> REALTOK) ) or - ( (DstType <> REALTOK) and (SrcType = REALTOK) ) or - - ( (DstType = SINGLETOK) and (SrcType <> SINGLETOK) ) or - ( (DstType <> SINGLETOK) and (SrcType = SINGLETOK) ) or - - ( (DstType = HALFSINGLETOK) and (SrcType <> HALFSINGLETOK) ) or - ( (DstType <> HALFSINGLETOK) and (SrcType = HALFSINGLETOK) ) or + if (DataSize[DstType] < DataSize[SrcType]) or ((DstType = REALTOK) and (SrcType <> REALTOK)) or + ((DstType <> REALTOK) and (SrcType = REALTOK)) or ((DstType = SINGLETOK) and (SrcType <> SINGLETOK)) or + ((DstType <> SINGLETOK) and (SrcType = SINGLETOK)) or ((DstType = HALFSINGLETOK) and + (SrcType <> HALFSINGLETOK)) or ((DstType <> HALFSINGLETOK) and (SrcType = HALFSINGLETOK)) or ( (DstType = SHORTREALTOK) and (SrcType <> SHORTREALTOK) ) or ( (DstType <> SHORTREALTOK) and (SrcType = SHORTREALTOK) ) or - - ( (DstType in IntegerTypes) and (SrcType in [CHARTOK, BOOLEANTOK, POINTERTOK, DATAORIGINOFFSET, CODEORIGINOFFSET, STRINGPOINTERTOK]) ) or - ( (SrcType in IntegerTypes) and (DstType in [CHARTOK, BOOLEANTOK]) ) then + ((DstType in IntegerTypes) and (SrcType in [CHARTOK, BOOLEANTOK, POINTERTOK, DATAORIGINOFFSET, + CODEORIGINOFFSET, STRINGPOINTERTOK])) or ((SrcType in IntegerTypes) and + (DstType in [CHARTOK, BOOLEANTOK])) then if err then - iError(ErrTokenIndex, IncompatibleTypes, 0, SrcType, DstType) + Error(ErrTokenIndex, IncompatibleTypes, 0, SrcType, DstType) else - Result := true; + Result := True; end; //GetCommonConstType @@ -1221,7 +1238,7 @@ function GetCommonType(ErrTokenIndex: Integer; LeftType, RightType: Byte): Byte; if LeftType = UNTYPETOK then Result := RightType; if Result = 0 then - iError(ErrTokenIndex, IncompatibleTypes, 0, RightType, LeftType); + Error(ErrTokenIndex, IncompatibleTypes, 0, RightType, LeftType); end; //GetCommonType @@ -1231,11 +1248,16 @@ function GetCommonType(ErrTokenIndex: Integer; LeftType, RightType: Byte): Byte; procedure DefineFilename(StrTokenIndex: Integer; StrValue: String); -var i: integer; +var + i: Integer; begin for i := 0 to High(linkObj) - 1 do - if linkObj[i] = StrValue then begin Tok[StrTokenIndex].Value := i; exit end; + if linkObj[i] = StrValue then + begin + Tok[StrTokenIndex].Value := i; + exit; + end; i := High(linkObj); linkObj[i] := StrValue; @@ -1263,14 +1285,16 @@ procedure DefineStaticString(StrTokenIndex: Integer; StrValue: String); Data[0] := len; if (NumStaticStrChars + len > $FFFF) then - begin writeln('DefineStaticString: ' + IntToStr(len)); + begin + writeln('DefineStaticString: ' + IntToStr(len)); RaiseHaltException(2); end; -for i:=1 to len do Data[i] := ord(StrValue[i]); + for i := 1 to len do Data[i] := Ord(StrValue[i]); for i:=0 to NumStaticStrChars-len-1 do - if CompareWord(Data[0], StaticStringData[i], Len + 1) = 0 then begin + if CompareWord(Data[0], StaticStringData[i], Len + 1) = 0 then + begin Tok[StrTokenIndex].StrLength := len; Tok[StrTokenIndex].StrAddress := CODEORIGIN + i; @@ -1286,7 +1310,7 @@ procedure DefineStaticString(StrTokenIndex: Integer; StrValue: String); for i := 1 to len do begin - StaticStringData[NumStaticStrChars] := ord(StrValue[i]); + StaticStringData[NumStaticStrChars] := Ord(StrValue[i]); Inc(NumStaticStrChars); end; diff --git a/src/FileIO.pas b/src/FileIO.pas index f477c8061..67f2c2efb 100644 --- a/src/FileIO.pas +++ b/src/FileIO.pas @@ -8,10 +8,6 @@ interface {$i Types.inc} {$SCOPEDENUMS ON} -{$IFDEF PAS2JS} - {$DEFINE SIMULATED_FILE_IO} -{$ENDIF} - uses SysUtils; type diff --git a/src/Makefile.bat b/src/Makefile.bat index d72ccff75..4c9012dc2 100644 --- a/src/Makefile.bat +++ b/src/Makefile.bat @@ -158,7 +158,6 @@ rem call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform fedorahat call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform cannabis call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform snowflake - call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform snowflake_float16 call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform spline call :run_mp %1 %MP_FOLDER%\samples\a8\graph_crossplatform fern goto :eof diff --git a/src/MathEvaluate.pas b/src/MathEvaluate.pas index ea67d08a2..223fe561a 100644 --- a/src/MathEvaluate.pas +++ b/src/MathEvaluate.pas @@ -1,390 +1,436 @@ unit MathEvaluate; -(* source: CLSN PASCAL *) -(* *) -(* This program will evaluate *) -(* numeric expressions like: *) +(* Source: CLSN PASCAL *) +(* This program will evaluate numeric expressions like: *) +(* 5+6/7 sin(cos(pi)) sqrt(4*4) *) +(* Mutual recursion is necessary, hence the FORWARD clause is used. *) -(* 5+6/7 sin(cos(pi)) sqrt(4*4) *) +interface -(* Mutual recursion was necessary *) -(* so the FORWARD clause was used *) +{$i define.inc} -interface +uses SysUtils; + +type + TEvaluationResult = Single; +type + EEValuationException = class(Exception) + private + _expression: String; + _index: Integer; + public + constructor Create(const msg: String); + property Expression: String read _expression; + property Index: Integer read _index; + end; - function evaluate(const a: string; i: integer): real; +type + IEvaluationContext = interface + function GetConstantName(const expression: String; var index: Integer): String; + function GetConstantValue(const constantName: String; var constantValue: Int64): Boolean; + end; + + +function Evaluate(const expression: String; const evaluationContext: IEvaluationContext): TEvaluationResult; implementation -uses math, common, parser, scanner, messages; +uses Math; type - sop=string; + TOperator = String; var - s: string; - cix: integer; + evaluationContext: IEvaluationContext; + s: String; + cix: Integer; - TokenIndex: integer; + // If the names of the functions are similar then their longer versions should be placed earlier. + // Example:_ arctan2 .. arctan + fop: array[0..14] of TOperator = (' ', 'PI', 'RND', 'SQRT', 'SQR', 'ARCTAN2', 'COS', 'SIN', + 'TAN', 'EXP', 'LN', 'ABS', 'INT', 'POWER', 'ARCTAN'); + top: array[0..7] of TOperator = (' ', '*', '/', 'DIV', 'MOD', 'AND', 'SHL', 'SHR'); + seop: array[0..4] of TOperator = (' ', '+', '-', 'OR', 'XOR'); -// if the names of the functions are similar then their longer versions should be placed earlier -// arctan2 .. arctan - fop: array[0..14] of sop = (' ','PI','RND','SQRT','SQR','ARCTAN2','COS','SIN','TAN','EXP','LN','ABS','INT','POWER','ARCTAN'); - top: array[0..7] of sop=(' ','*','/','DIV','MOD','AND','SHL','SHR'); - seop: array[0..4] of sop=(' ','+','-','OR','XOR'); +constructor EEValuationException.Create(const msg: String); +begin + inherited Create(msg); + _expression := MathEvaluate.s; + _index := MathEvaluate.cix; +end; -function simple_expression: real; forward; +procedure RaiseError(const msg: String); +begin + raise EEValuationException.Create(msg); +end; +function SimpleExpression: TEvaluationResult; forward; -procedure skip_blanks; +procedure SkipBlanks; begin - while (s[cix]=' ') do - inc(cix); + while (s[cix] = ' ') do + Inc(cix); end; - -function constant: real; +function Constant: TEvaluationResult; var - n: string; - v1: real; - v, k, ln: integer; - p: word; - pflg: boolean; - - IdentTemp: integer; - + n: String; + i, v, k, ln: Integer; +{$IFNDEF PAS2JS} + v1: TEvaluationResult; +{$ELSE} + v1: ValReal; // For PAS2JS, should also work for FPC and be used a return value there, see Test-70287.pas +{$ENDIF} + p: Integer; + pflg: Boolean; + constantValue: Int64; begin - n:=''; pflg:=false; + n := ''; + pflg := False; - skip_blanks; + SkipBlanks; - p:=0; + p := 0; - if s[cix] = '%' then begin // bin + if s[cix] = '%' then // binary + begin - inc(cix); + Inc(cix); - while (s[cix] in ['0', '1']) do - begin - n := n + s[cix]; + while (s[cix] in ['0', '1']) do + begin + n := n + s[cix]; - inc(cix); - end; + Inc(cix); + end; - if length(n)=0 then - Error(TokenIndex, 'Invalid constant %'); + if Length(n) = 0 then + RaiseError('Invalid constant %'); - //remove leading zeros - i:=1; - while n[i]='0' do inc(i); + // Remove leading zeros + i := 1; + while n[i] = '0' do Inc(i); - ln:=length(n); - v:=0; + ln := Length(n); + v := 0; - //do the conversion - for k:=ln downto i do - if n[k]='1' then - v:=v+(1 shl (ln-k)); + // Do the conversion + for k := ln downto i do + if n[k] = '1' then + v := v + (1 shl (ln - k)); - v1:=v; + v1 := v; - end else + end + else - if s[cix] = '$' then begin // hex + if s[cix] = '$' then // hexadecimal + begin - n:='$'; - inc(cix); + n := '$'; + Inc(cix); - while (UpCase(s[cix]) in ['0'..'9', 'A'..'F']) do - begin - n := n + s[cix]; + while (UpCase(s[cix]) in ['0'..'9', 'A'..'F']) do + begin + n := n + s[cix]; - inc(cix); - end; + Inc(cix); + end; - val(n,v,p); + // If the conversion isn't successful, then the parameter p (Code) contains + // the index of the character in S which prevented the conversion + Val(n, v, p); - v1:=v; + v1 := v; - end else begin // dec + end + else + begin // decimal - while (s[cix] in ['0'..'9']) or ((s[cix]='.') and (not pflg)) do - begin - if (s[cix]='.') then pflg:=true; + while (s[cix] in ['0'..'9']) or ((s[cix] = '.') and (not pflg)) do + begin + if (s[cix] = '.') then pflg := True; - n := n + s[cix]; + n := n + s[cix]; - inc(cix); - end; + Inc(cix); + end; - val(n,v1,p); + Val(n, v1, p); end; - if (p<>0) then begin + if (p <> 0) then + begin - n:=get_constant(cix, s); - - IdentTemp:=GetIdent(n); - - if IdentTemp > 0 then - v1 := Ident[IdentTemp].Value - else - Error(TokenIndex, 'Invalid constant "' + n + '"'); + n := evaluationContext.GetConstantName(s, cix); + if n <> '' then + begin + constantValue := 0; + if evaluationContext.GetConstantValue(n, constantValue) then + v1 := constantValue + else + RaiseError('Invalid constant "' + n + '"'); + end; end; - constant:=v1; + constant := v1; end; -function xnot(v: real): real; +function XNot(v: TEvaluationResult): TEvaluationResult; begin - if (v=0) then - xnot:=1 + if (v = 0) then + Result := 1 else - xnot:=0; + Result := 0; end; -function factor: real; +function Factor: TEvaluationResult; var - v1, v2: real; - ch: char; - op, i: byte; + v1, v2: TEvaluationResult; + ch: Char; + op, i: Byte; - procedure Wrong_number; - begin + procedure RaiseWrongNumberOfParametersError; + begin - Error(TokenIndex, 'Wrong number of parameters specified for call to "' + fop[op] + '"'); - - end; + RaiseError('Wrong number of parameters specified for call to "' + fop[op] + '"'); + end; begin - skip_blanks; + SkipBlanks; - op:=0; - v1:=0; - v2:=0; + op := 0; + v1 := 0; + v2 := 0; - for i:=1 to High(fop) do - if (op=0) then - if (copy(s,cix,length(fop[i])) = fop[i]) then - op:=i; + for i := 1 to High(fop) do + if (op = 0) then + if (Copy(s, cix, Length(fop[i])) = fop[i]) then + op := i; if (op > 0) then - begin - cix:=cix + length(fop[op]); + begin + cix := cix + Length(fop[op]); - skip_blanks; + SkipBlanks; - if (op in [1,2]) and (s[cix] = '(') then - Wrong_number; + if (op in [1, 2]) and (s[cix] = '(') then + RaiseWrongNumberOfParametersError; - if (op > 2) then // 0:' ', 1:'PI', 2:'RND' - begin - if (s[cix] <> '(') then - Wrong_number; - - v1:=factor; - - if (op in [5,13]) and (s[cix] <> ',') then // 5:'ARCTAN2', 13:'POWER' - Wrong_number; - - if s[cix] = ',' then begin + if (op > 2) then // 0:' ', 1:'PI', 2:'RND' + begin + if (s[cix] <> '(') then + RaiseWrongNumberOfParametersError; - if not (op in [5,13]) then // 5:'ARCTAN2', 13:'POWER' - Wrong_number; + v1 := factor; - inc(cix); + if (op in [5, 13]) and (s[cix] <> ',') then // 5:'ARCTAN2', 13:'POWER' + RaiseWrongNumberOfParametersError; - skip_blanks; + if s[cix] = ',' then + begin - v2:=factor; + if not (op in [5, 13]) then // 5:'ARCTAN2', 13:'POWER' + RaiseWrongNumberOfParametersError; - if s[cix] <> ')' then - Wrong_number; + Inc(cix); - inc(cix); + SkipBlanks; - end; + v2 := factor; - end; + if s[cix] <> ')' then + RaiseWrongNumberOfParametersError; + Inc(cix); - case op of - 1: v1:=pi; - 2: v1:=Random; - 3: v1:=sqrt(v1); - 4: v1:=sqr(v1); - 5: v1:=arctan2(v1,v2); - 6: v1:=cos(v1); - 7: v1:=sin(v1); - 8: v1:=sin(v1)/cos(v1); - 9: v1:=exp(v1); - 10: v1:=ln(v1); - 11: v1:=abs(v1); - 12: v1:=int(v1); - 13: v1:=power(v1,v2); - 14: v1:=arctan(v1); end; - - end + end; + + + case op of + 1: v1 := pi; + 2: v1 := Random; + 3: v1 := sqrt(v1); + 4: v1 := sqr(v1); + 5: v1 := arctan2(v1, v2); + 6: v1 := cos(v1); + 7: v1 := sin(v1); + 8: v1 := sin(v1) / cos(v1); + 9: v1 := exp(v1); + 10: v1 := ln(v1); + 11: v1 := abs(v1); + 12: v1 := int(v1); + 13: v1 := power(v1, v2); + 14: v1 := arctan(v1); + else + Assert(False, 'Invalid operator code ' + IntToStr(op) + '.'); + end; + + end else - if (s[cix]='(') then - begin - inc(cix); + if (s[cix] = '(') then + begin + Inc(cix); - v1:=simple_expression; + v1 := SimpleExpression; - skip_blanks; + SkipBlanks; - if (s[cix] <> ',') then + if (s[cix] <> ',') then - if (s[cix]=')') then - inc(cix) - else - Error(TokenIndex, 'Parenthesis Mismatch'); - end + if (s[cix] = ')') then + Inc(cix) + else + RaiseError('Parenthesis Mismatch'); + end + else + if (s[cix] = '-') or (s[cix] = '+') or (Copy(s, cix, 3) = 'NOT') then + begin + ch := s[cix]; + + if (ch = 'N') then + cix := cix + 3 else - if (s[cix] = '-') or (s[cix] = '+') or (copy(s,cix,3)='NOT') then - begin - ch:=s[cix]; - - if (ch='N') then - cix:=cix+3 - else - inc(cix); - - case ch of - '+': v1:=factor; - '-': v1:=-factor; - 'N': v1:=xnot(factor); - end; - end - else - v1:=constant; - - factor:=v1; + Inc(cix); + + case ch of + '+': v1 := factor; + '-': v1 := -factor; + 'N': v1 := xnot(factor); + else + Assert(False, 'Invalid case'); + end; + end + else + v1 := constant; + + Result := v1; end; -function term: real; +function Term: TEvaluationResult; var - op,i: byte; - v1,v2: real; + op, i: Byte; + v1, v2: TEvaluationResult; begin - v1:=factor; + v1 := factor; repeat - skip_blanks; + SkipBlanks; - op:=0; + op := 0; - for i:=1 to High(top) do - if (op=0) then - if (copy(s,cix,length(top[i])) = top[i]) then - op:=i; + for i := 1 to High(top) do + if (op = 0) then + if (Copy(s, cix, Length(top[i])) = top[i]) then + op := i; - if (op>0) then - begin - cix:=cix+length(top[op]); - - v2:=factor; - - case op of - 1: v1:=v1*v2; - 2: v1:=v1/v2; - 3: v1:=round(v1) div round(v2); - 4: v1:=round(v1) mod round(v2); - 5: v1:=round(v1) and round(v2); - 6: v1:=round(v1) shl round(v2); - 7: v1:=round(v1) shr round(v2); - end; + if (op > 0) then + begin + cix := cix + Length(top[op]); + + v2 := factor; + + case op of + 1: v1 := v1 * v2; + 2: v1 := v1 / v2; + 3: v1 := round(v1) div round(v2); + 4: v1 := round(v1) mod round(v2); + 5: v1 := round(v1) and round(v2); + 6: v1 := round(v1) shl round(v2); + 7: v1 := round(v1) shr round(v2); end; + end; - until (op=0); + until (op = 0); - term:=v1; + Result := v1; end; -function simple_expression: real; +function SimpleExpression: TEvaluationResult; var - op,i: byte; - v1,v2: real; + op, i: Byte; + v1, v2: TEvaluationResult; begin - skip_blanks; + SkipBlanks; - v1:=term; + v1 := term; repeat - skip_blanks; + SkipBlanks; - op:=0; + op := 0; - for i:=1 to High(seop) do - if (op=0) then - if (copy(s,cix,length(seop[i])) = seop[i]) then - op:=i; + for i := 1 to High(seop) do + if (op = 0) then + if (Copy(s, cix, Length(seop[i])) = seop[i]) then + op := i; - if (op>0) then - begin - cix:=cix+length(seop[op]); + if (op > 0) then + begin + cix := cix + Length(seop[op]); - v2:=term; + v2 := term; - case op of - 1: v1:=v1+v2; - 2: v1:=v1-v2; - 3: v1:=round(v1) or round(v2); - 4: v1:=round(v1) xor round(v2); - end; + case op of + 1: v1 := v1 + v2; + 2: v1 := v1 - v2; + 3: v1 := round(v1) or round(v2); + 4: v1 := round(v1) xor round(v2); end; + end; - until (op=0); + until (op = 0); - simple_expression:=v1; + Result := v1; end; -function evaluate(const a: string; i: integer): real; -var k: word; +function Evaluate(const expression: String; const evaluationContext: IEvaluationContext): TEvaluationResult; +{$IFNDEF UPCASE_STRING} +var i: Integer; +{$ENDIF} begin - Result := 0; - - TokenIndex := i; - - if a <> '' then begin - - cix:=1; - - s := a; - for k:=1 to length(s) do - s[k]:=upcase(s[k]); - - evaluate := simple_expression; - + if expression = '' then + Result := 0 + else + begin + + // Set the global variables for the unit. + MathEvaluate.evaluationContext := evaluationContext; + {$IFDEF UPCASE_STRING} + MathEvaluate.s := UpCase(expression); + {$ELSE} + // Currently there is only UpCase(Char) in PAS2JS + MathEvaluate.s := expression; + for i:=1 to Length(MathEvaluate.s) do MathEvaluate.s[i]:=UpCase( MathEvaluate.s[i] ); + {$ENDIF} + MathEvaluate.cix := 1; + Result := SimpleExpression; end; - end; - end. diff --git a/src/Messages.pas b/src/Messages.pas index e73c7e772..3f9ca14e3 100644 --- a/src/Messages.pas +++ b/src/Messages.pas @@ -6,55 +6,55 @@ interface uses Common; - type - ErrorCode = - ( - UnknownIdentifier, OParExpected, IdentifierExpected, IncompatibleTypeOf, UserDefined, - IdNumExpExpected, IncompatibleTypes, IncompatibleEnum, OrdinalExpectedFOR, CantAdrConstantExp, - VariableExpected, WrongNumParameters, OrdinalExpExpected, RangeCheckError, RangeCheckError_, - VariableNotInit, ShortStringLength, StringTruncated, TypeMismatch, CantReadWrite, - SubrangeBounds, TooManyParameters, CantDetermine, UpperBoundOfRange, HighLimit, - IllegalTypeConversion, IncompatibleTypesArray, IllegalExpression, AlwaysTrue, AlwaysFalse, - UnreachableCode, IllegalQualifier, LoHi, StripedAllowed - ); + TErrorCode = + ( + UnknownIdentifier, OParExpected, IdentifierExpected, IncompatibleTypeOf, UserDefined, + IdNumExpExpected, IncompatibleTypes, IncompatibleEnum, OrdinalExpectedFOR, CantAdrConstantExp, + VariableExpected, WrongNumParameters, OrdinalExpExpected, RangeCheckError, RangeCheckError_, + VariableNotInit, ShortStringLength, StringTruncated, TypeMismatch, CantReadWrite, + SubrangeBounds, TooManyParameters, CantDetermine, UpperBoundOfRange, HighLimit, + IllegalTypeConversion, IncompatibleTypesArray, IllegalExpression, AlwaysTrue, AlwaysFalse, + UnreachableCode, IllegalQualifier, LoHi, StripedAllowed + ); // ---------------------------------------------------------------------------- - procedure Error(ErrTokenIndex: Integer; Msg: string); - // TODO: Use overload and rename to Error, like for Note - procedure iError(ErrTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0; SrcType: Int64 = 0; DstType: Int64 = 0); - - procedure Note(NoteTokenIndex: Integer; IdentIndex: Integer); overload; +procedure Error(errorTokenIndex: TTokenIndex; msg: String); overload; +procedure Error(errorTokenIndex: TTokenIndex; errorCode: TErrorCode; identIndex: TTokenIndex = 0; + srcType: Int64 = 0; DstType: Int64 = 0); overload; - procedure Note(NoteTokenIndex: Integer; Msg: string); overload; +procedure Note(NoteTokenIndex: TTokenIndex; identIndex: TTokenIndex); overload; +procedure Note(NoteTokenIndex: TTokenIndex; msg: String); overload; - procedure Warning(WarnTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0; SrcType: Int64 = 0; DstType: Int64 = 0); +procedure Warning(warningTokenIndex: TTokenIndex; errorCode: TErrorCode; identIndex: TTokenIndex = 0; + srcType: Int64 = 0; DstType: Int64 = 0); - procedure WritelnMsg; +procedure WritelnMsg; // ---------------------------------------------------------------------------- implementation - uses Console, FileIO, Utilities; +uses Console, FileIO, Utilities; // ----------------------------------------------------------------------------- procedure WritelnMsg; -var i: integer; +var + i: Integer; begin - TextColor(LIGHTGREEN); + TextColor(LIGHTGREEN); - for i := 0 to High(msgWarning) - 1 do writeln(msgWarning[i]); + for i := 0 to High(msgWarning) - 1 do writeln(msgWarning[i]); - TextColor(LIGHTCYAN); + TextColor(LIGHTCYAN); - for i := 0 to High(msgNote) - 1 do writeln(msgNote[i]); + for i := 0 to High(msgNote) - 1 do writeln(msgNote[i]); - NormVideo; + NormVideo; end; @@ -63,147 +63,259 @@ procedure WritelnMsg; // ---------------------------------------------------------------------------- -function ErrorMessage(ErrTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0; SrcType: Int64 = 0; DstType: Int64 = 0): string; +function ErrorMessage(errorTokenIndex: TTokenIndex; errorCode: TErrorCode; identIndex: TTokenIndex = 0; + srcType: Int64 = 0; DstType: Int64 = 0): String; begin - Result := ''; + Result := ''; - case err of + case errorCode of - UserDefined: Result := 'User defined: ' + msgUser[Tok[ErrTokenIndex].Value]; + UserDefined: + begin + Result := 'User defined: ' + msgUser[Tok[errorTokenIndex].Value]; + end; - UnknownIdentifier: if IdentIndex > 0 then - Result := 'Identifier not found ''' + Ident[IdentIndex].Alias + '''' - else - Result := 'Identifier not found ''' + Tok[ErrTokenIndex].Name + ''''; + UnknownIdentifier: + begin + if identIndex > 0 then + Result := 'Identifier not found ''' + Ident[identIndex].Alias + '''' + else + Result := 'Identifier not found ''' + Tok[errorTokenIndex].Name + ''''; + end; - IncompatibleTypeOf: Result := 'Incompatible type of ' + Ident[IdentIndex].Name; - IncompatibleEnum: if DstType < 0 then - Result := 'Incompatible types: got "'+GetEnumName(SrcType)+'" expected "'+InfoAboutToken(abs(DstType))+ '"' - else - if SrcType < 0 then - Result := 'Incompatible types: got "'+InfoAboutToken(abs(SrcType))+'" expected "'+GetEnumName(DstType)+ '"' - else - Result := 'Incompatible types: got "'+GetEnumName(SrcType)+'" expected "'+GetEnumName(DstType)+ '"'; + IncompatibleTypeOf: + begin + Result := 'Incompatible type of ' + Ident[identIndex].Name; + end; - WrongNumParameters: Result := 'Wrong number of parameters specified for call to "' + Ident[IdentIndex].Name+'"'; + IncompatibleEnum: + begin + if DstType < 0 then + Result := 'Incompatible types: got "' + GetEnumName(srcType) + '" expected "' + + InfoAboutToken(abs(DstType)) + '"' + else + if srcType < 0 then + Result := 'Incompatible types: got "' + InfoAboutToken(abs(srcType)) + '" expected "' + + GetEnumName(DstType) + '"' + else + Result := 'Incompatible types: got "' + GetEnumName(srcType) + '" expected "' + GetEnumName(DstType) + '"'; + end; - CantAdrConstantExp: Result := 'Can''t take the address of constant expressions'; + WrongNumParameters: + begin + Result := 'Wrong number of parameters specified for call to "' + Ident[identIndex].Name + '"'; + end; - OParExpected: Result := '''(''' + ErrTokenFound(ErrTokenIndex); + CantAdrConstantExp: + begin + Result := 'Can''t take the address of constant expressions'; + end; - IllegalExpression: Result := 'Illegal expression'; - VariableExpected: Result := 'Variable identifier expected'; - OrdinalExpExpected: Result := 'Ordinal expression expected'; - OrdinalExpectedFOR: Result := 'Ordinal expression expected as ''FOR'' loop counter value'; + OParExpected: + begin + Result := '''(''' + ErrTokenFound(errorTokenIndex); + end; - IncompatibleTypes: begin - Result := 'Incompatible types: got "'; + IllegalExpression: + begin + Result := 'Illegal expression'; + end; - if SrcType < 0 then Result := Result + '^'; + VariableExpected: begin + Result := 'Variable identifier expected'; + end; - Result := Result + InfoAboutToken(abs(SrcType)) + '" expected "'; + OrdinalExpExpected: + begin + Result := 'Ordinal expression expected'; + end; - if DstType < 0 then Result := Result + '^'; + OrdinalExpectedFOR: + begin + Result := 'Ordinal expression expected as ''FOR'' loop counter value'; + end; - Result := Result + InfoAboutToken(abs(DstType)) + '"'; - end; + IncompatibleTypes: + begin + Result := 'Incompatible types: got "'; - IdentifierExpected: Result := 'Identifier' + ErrTokenFound(ErrTokenIndex); - IdNumExpExpected: Result := 'Identifier, number or expression' + ErrTokenFound(ErrTokenIndex); + if srcType < 0 then Result := Result + '^'; - LoHi: Result := 'lo/hi(dword/qword) returns the upper/lower word/dword'; + Result := Result + InfoAboutToken(abs(srcType)) + '" expected "'; - IllegalTypeConversion, IncompatibleTypesArray: - begin + if DstType < 0 then Result := Result + '^'; - if err = IllegalTypeConversion then - Result := 'Illegal type conversion: "Array[0..' - else begin - Result := 'Incompatible types: got '; - if Ident[IdentIndex].NumAllocElements > 0 then Result := Result + '"Array[0..'; - end; + Result := Result + InfoAboutToken(abs(DstType)) + '"'; + end; + IdentifierExpected: + begin + Result := 'Identifier' + ErrTokenFound(errorTokenIndex); + end; - if Ident[IdentIndex].NumAllocElements_ > 0 then - Result := Result + IntToStr(Ident[IdentIndex].NumAllocElements-1)+'] Of Array[0..'+IntToStr(Ident[IdentIndex].NumAllocElements_-1)+'] Of '+InfoAboutToken(Ident[IdentIndex].AllocElementType)+'" ' - else - if Ident[IdentIndex].NumAllocElements = 0 then begin + IdNumExpExpected: begin + Result := 'Identifier, number or expression' + ErrTokenFound(errorTokenIndex); + end; - if Ident[IdentIndex].AllocElementType <> UNTYPETOK then - Result := Result + '"^'+InfoAboutToken(Ident[IdentIndex].AllocElementType)+'" ' - else - Result := Result + '"'+InfoAboutToken(POINTERTOK)+'" '; + LoHi: + begin + Result := 'lo/hi(dword/qword) returns the upper/lower word/dword'; + end; - end else - Result := Result + IntToStr(Ident[IdentIndex].NumAllocElements-1)+'] Of '+InfoAboutToken(Ident[IdentIndex].AllocElementType)+'" '; + IllegalTypeConversion, IncompatibleTypesArray: + begin + + if errorCode = IllegalTypeConversion then + Result := 'Illegal type conversion: "Array[0..' + else + begin + Result := 'Incompatible types: got '; + if Ident[identIndex].NumAllocElements > 0 then Result := Result + '"Array[0..'; + end; + + + if Ident[identIndex].NumAllocElements_ > 0 then + Result := Result + IntToStr(Ident[identIndex].NumAllocElements - 1) + '] Of Array[0..' + + IntToStr(Ident[identIndex].NumAllocElements_ - 1) + '] Of ' + + InfoAboutToken(Ident[identIndex].AllocElementType) + '" ' + else + if Ident[identIndex].NumAllocElements = 0 then + begin + + if Ident[identIndex].AllocElementType <> UNTYPETOK then + Result := Result + '"^' + InfoAboutToken(Ident[identIndex].AllocElementType) + '" ' + else + Result := Result + '"' + InfoAboutToken(POINTERTOK) + '" '; + + end + else + Result := Result + IntToStr(Ident[identIndex].NumAllocElements - 1) + '] Of ' + + InfoAboutToken(Ident[identIndex].AllocElementType) + '" '; + + if errorCode = IllegalTypeConversion then + Result := Result + 'to "' + InfoAboutToken(srcType) + '"' + else + if srcType < 0 then + begin + + Result := Result + 'expected '; + + if Ident[abs(srcType)].NumAllocElements_ > 0 then + Result := Result + '"Array[0..' + IntToStr(Ident[abs(srcType)].NumAllocElements - 1) + + '] Of Array[0..' + IntToStr(Ident[abs(srcType)].NumAllocElements_ - 1) + '] Of ' + + InfoAboutToken(Ident[identIndex].AllocElementType) + '"' + else + if Ident[abs(srcType)].AllocElementType in [RECORDTOK, OBJECTTOK] then + Result := Result + '"^' + Types[Ident[abs(srcType)].NumAllocElements].Field[0].Name + '"' + else + begin + + if Ident[abs(srcType)].DataType in [RECORDTOK, OBJECTTOK] then + Result := Result + '"' + Types[Ident[abs(srcType)].NumAllocElements].Field[0].Name + '"' + else + Result := Result + '"Array[0..' + IntToStr(Ident[abs(srcType)].NumAllocElements - 1) + + '] Of ' + InfoAboutToken(Ident[abs(srcType)].AllocElementType) + '"'; + + end; + + end + else + Result := Result + 'expected "' + InfoAboutToken(srcType) + '"'; - if err = IllegalTypeConversion then - Result := Result + 'to "'+InfoAboutToken(SrcType)+'"' - else - if SrcType < 0 then begin + end; - Result := Result + 'expected '; + AlwaysTrue: + begin + Result := 'Comparison might be always true due to range of constant and expression'; + end; - if Ident[abs(SrcType)].NumAllocElements_ > 0 then - Result := Result + '"Array[0..' + IntToStr(Ident[abs(SrcType)].NumAllocElements-1)+'] Of Array[0..'+IntToStr(Ident[abs(SrcType)].NumAllocElements_-1)+'] Of '+InfoAboutToken(Ident[IdentIndex].AllocElementType)+'"' - else - if Ident[abs(SrcType)].AllocElementType in [RECORDTOK, OBJECTTOK] then - Result := Result + '"^'+Types[Ident[abs(SrcType)].NumAllocElements].Field[0].Name+'"' - else begin + AlwaysFalse: + begin + Result := 'Comparison might be always false due to range of constant and expression'; + end; - if Ident[abs(SrcType)].DataType in [RECORDTOK, OBJECTTOK] then - Result := Result + '"'+Types[Ident[abs(SrcType)].NumAllocElements].Field[0].Name+'"' - else - Result := Result + '"Array[0..' + IntToStr(Ident[abs(SrcType)].NumAllocElements-1)+'] Of '+InfoAboutToken(Ident[abs(SrcType)].AllocElementType)+'"'; + RangeCheckError: + begin + Result := 'Range check error while evaluating constants (' + IntToStr(srcType) + + ' must be between ' + IntToStr(LowBound(errorTokenIndex, DstType)) + ' and '; - end; + if identIndex > 0 then + Result := Result + IntToStr(Ident[identIndex].NumAllocElements - 1) + ')' + else + Result := Result + IntToStr(HighBound(errorTokenIndex, DstType)) + ')'; - end else - Result := Result + 'expected "'+InfoAboutToken(SrcType)+'"'; + end; - end; + RangeCheckError_: begin + Result := 'Range check error while evaluating constants (' + IntToStr(srcType) + + ' must be between ' + IntToStr(LowBound(errorTokenIndex, DstType)) + ' and '; - AlwaysTrue: Result := 'Comparison might be always true due to range of constant and expression'; + if identIndex > 0 then + Result := Result + IntToStr(Ident[identIndex].NumAllocElements_ - 1) + ')' + else + Result := Result + IntToStr(HighBound(errorTokenIndex, DstType)) + ')'; + end; - AlwaysFalse: Result := 'Comparison might be always false due to range of constant and expression'; + VariableNotInit: + begin + Result := 'Variable ''' + Ident[identIndex].Name + ''' does not seem to be initialized'; + end; - RangeCheckError: begin - Result := 'Range check error while evaluating constants ('+IntToStr(SrcType)+' must be between '+IntToStr(LowBound(ErrTokenIndex, DstType))+' and '; + ShortStringLength: begin + Result := 'String literal has more characters than short string length'; + end; - if IdentIndex > 0 then - Result := Result + IntToStr(Ident[IdentIndex].NumAllocElements-1)+')' - else - Result := Result + IntToStr(HighBound(ErrTokenIndex, DstType))+')'; + StringTruncated: + begin + Result := 'String constant truncated to fit STRING[' + IntToStr(Ident[identIndex].NumAllocElements - 1) + ']'; + end; - end; + CantReadWrite: + begin + Result := 'Can''t read or write variables of this type'; + end; - RangeCheckError_: begin - Result := 'Range check error while evaluating constants ('+IntToStr(SrcType)+' must be between '+IntToStr(LowBound(ErrTokenIndex, DstType))+' and '; + TypeMismatch: begin + Result := 'Type mismatch'; + end; - if IdentIndex > 0 then - Result := Result + IntToStr(Ident[IdentIndex].NumAllocElements_-1)+')' - else - Result := Result + IntToStr(HighBound(ErrTokenIndex, DstType))+')'; + UnreachableCode: begin + Result := 'unreachable code'; + end; - end; + IllegalQualifier: begin + Result := 'Illegal qualifier'; + end; - VariableNotInit: Result := 'Variable '''+Ident[IdentIndex].Name+''' does not seem to be initialized'; - ShortStringLength: Result := 'String literal has more characters than short string length'; - StringTruncated: Result := 'String constant truncated to fit STRING['+IntToStr(Ident[IdentIndex].NumAllocElements - 1)+']'; - CantReadWrite: Result := 'Can''t read or write variables of this type'; - TypeMismatch: Result := 'Type mismatch'; - UnreachableCode: Result := 'unreachable code'; - IllegalQualifier: Result := 'Illegal qualifier'; - SubrangeBounds: Result := 'Constant expression violates subrange bounds'; - TooManyParameters: Result := 'Too many formal parameters in ' + Ident[IdentIndex].Name; - CantDetermine: Result := 'Can''t determine which overloaded function '''+ Ident[IdentIndex].Name +''' to call'; - UpperBoundOfRange: Result := 'Upper bound of range is less than lower bound'; - HighLimit: Result := 'High range limit > '+IntToStr(High(word)); + SubrangeBounds: begin + Result := 'Constant expression violates subrange bounds'; + end; + TooManyParameters: begin + Result := 'Too many formal parameters in ' + Ident[identIndex].Name; + end; - StripedAllowed: Result := 'Striped array is allowed for maximum [0..255] size'; - end; + CantDetermine: + begin + Result := 'Can''t determine which overloaded function ''' + Ident[identIndex].Name + ''' to call'; + end; + + UpperBoundOfRange: + begin + Result := 'Upper bound of range is less than lower bound'; + end; + + HighLimit: + begin + Result := 'High range limit > ' + IntToStr(High(Word)); + end; + + StripedAllowed: + begin + Result := 'Striped array is allowed for maximum [0..255] size'; + end; + end; end; @@ -212,13 +324,16 @@ function ErrorMessage(ErrTokenIndex: Integer; err: ErrorCode; IdentIndex: Intege // ---------------------------------------------------------------------------- -procedure iError(ErrTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0; SrcType: Int64 = 0; DstType: Int64 = 0); -var Msg: string; +procedure Error(errorTokenIndex: TTokenIndex; errorCode: TErrorCode; identIndex: TTokenIndex = 0; + srcType: Int64 = 0; DstType: Int64 = 0); +var + msg: String; begin - if not isConst then begin - Msg:=ErrorMessage(ErrTokenIndex, err, IdentIndex, SrcType, DstType); - Error(ErrTokenIndex,msg); + if not isConst then + begin + msg := ErrorMessage(errorTokenIndex, errorCode, identIndex, srcType, DstType); + Error(errorTokenIndex, msg); end; end; @@ -227,47 +342,51 @@ procedure iError(ErrTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0 // ---------------------------------------------------------------------------- -procedure Error(ErrTokenIndex: Integer; Msg: string); -var token, previousToken: TToken; +procedure Error(errorTokenIndex: TTokenIndex; msg: String); +var + token, previousToken: TToken; begin - Assert(NumTok>0, 'No token in token list'); - if not isConst then begin + Assert(NumTok > 0, 'No token in token list'); + + if not isConst then + begin - //Tok[NumTok-1].Column := Tok[NumTok].Column + Tok[NumTok-1].Column; + //Tok[NumTok-1].Column := Tok[NumTok].Column + Tok[NumTok-1].Column; - WritelnMsg; + WritelnMsg; - if ErrTokenIndex > NumTok then ErrTokenIndex := NumTok; + if errorTokenIndex > NumTok then errorTokenIndex := NumTok; - TextColor(LIGHTRED); - token:=Tok[ErrTokenIndex]; - if (ErrTokenIndex>1) then - begin - previousToken:=Tok[ErrTokenIndex - 1]; - WriteLn(UnitName[token.UnitIndex].Path + ' (' + IntToStr(token.Line) + ',' + IntToStr(Succ(previousToken.Column)) + ')' + ' Error: ' + Msg); - end - else - begin - WriteLn(UnitName[token.UnitIndex].Path + ' (' + IntToStr(token.Line) + ')' + ' Error: ' + Msg); - end; + TextColor(LIGHTRED); + token := Tok[errorTokenIndex]; + if (errorTokenIndex > 1) then + begin + previousToken := Tok[errorTokenIndex - 1]; + WriteLn(UnitName[token.UnitIndex].Path + ' (' + IntToStr(token.Line) + ',' + + IntToStr(Succ(previousToken.Column)) + ')' + ' Error: ' + msg); + end + else + begin + WriteLn(UnitName[token.UnitIndex].Path + ' (' + IntToStr(token.Line) + ')' + ' Error: ' + msg); + end; - NormVideo; + NormVideo; - FreeTokens; + FreeTokens; - if Outfile<>nil then - begin - OutFile.Close; - OutFile.Erase; - end; + if Outfile <> nil then + begin + OutFile.Close; + OutFile.Erase; + end; - RaiseHaltException(2); + RaiseHaltException(2); - end; + end; - isError := true; + isError := True; end; @@ -276,25 +395,29 @@ procedure Error(ErrTokenIndex: Integer; Msg: string); // ---------------------------------------------------------------------------- -procedure Warning(WarnTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = 0; SrcType: Int64 = 0; DstType: Int64 = 0); -var i: integer; - Msg, a: string; +procedure Warning(warningTokenIndex: TTokenIndex; errorCode: TErrorCode; identIndex: TTokenIndex = 0; + srcType: Int64 = 0; DstType: Int64 = 0); +var + i: Integer; + msg, a: String; begin - if Pass = CODEGENERATIONPASS then begin + if pass = CODEGENERATIONPASS then + begin - Msg := ErrorMessage(WarnTokenIndex, err, IdentIndex, SrcType, DstType); + msg := ErrorMessage(warningTokenIndex, errorCode, identIndex, srcType, DstType); - a := UnitName[Tok[WarnTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[WarnTokenIndex].Line) + ')' + ' Warning: ' + Msg; + a := UnitName[Tok[warningTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[warningTokenIndex].Line) + + ')' + ' Warning: ' + msg; - for i := High(msgWarning)-1 downto 0 do - if msgWarning[i] = a then exit; + for i := High(msgWarning) - 1 downto 0 do + if msgWarning[i] = a then exit; - i := High(msgWarning); - msgWarning[i] := a; - SetLength(msgWarning, i+2); + i := High(msgWarning); + msgWarning[i] := a; + SetLength(msgWarning, i + 2); - end; + end; end; @@ -303,14 +426,15 @@ procedure Warning(WarnTokenIndex: Integer; err: ErrorCode; IdentIndex: Integer = // ---------------------------------------------------------------------------- -procedure newMsg(var msg: TArrayString; var a: string); -var i: integer; +procedure newMsg(var msg: TArrayString; var a: String); +var + i: Integer; begin - i:=High(msg); - msg[i] := a; + i := High(msg); + msg[i] := a; - SetLength(msg, i+2); + SetLength(msg, i + 2); end; @@ -319,41 +443,45 @@ procedure newMsg(var msg: TArrayString; var a: string); // ---------------------------------------------------------------------------- -procedure Note(NoteTokenIndex: Integer; IdentIndex: Integer); overload; -var a: string; +procedure Note(NoteTokenIndex: TTokenIndex; identIndex: TTokenIndex); overload; +var + a: String; begin - if Pass = CODEGENERATIONPASS then - if pos('.', Ident[IdentIndex].Name) = 0 then begin + if Pass = CODEGENERATIONPASS then + if pos('.', Ident[identIndex].Name) = 0 then + begin - a := UnitName[Tok[NoteTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[NoteTokenIndex].Line) + ')' + ' Note: Local '; + a := UnitName[Tok[NoteTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[NoteTokenIndex].Line) + + ')' + ' Note: Local '; - if Ident[IdentIndex].Kind <> UNITTYPE then begin + if Ident[identIndex].Kind <> UNITTYPE then + begin - case Ident[IdentIndex].Kind of - CONSTANT: a := a + 'const'; - USERTYPE: a := a + 'type'; - LABELTYPE: a := a + 'label'; + case Ident[identIndex].Kind of + CONSTANT: a := a + 'const'; + USERTYPE: a := a + 'type'; + LABELTYPE: a := a + 'label'; - VARIABLE: if Ident[IdentIndex].isAbsolute then - a := a + 'absolutevar' - else - a := a + 'variable'; + VARIABLE: if Ident[identIndex].isAbsolute then + a := a + 'absolutevar' + else + a := a + 'variable'; - PROCEDURETOK: a := a + 'proc'; - FUNCTIONTOK: a := a + 'func'; - end; + PROCEDURETOK: a := a + 'proc'; + FUNCTIONTOK: a := a + 'func'; + end; - a := a +' ''' + Ident[IdentIndex].Name + '''' + ' not used'; + a := a + ' ''' + Ident[identIndex].Name + '''' + ' not used'; - if pos('@FN', Ident[IdentIndex].Name) = 1 then + if pos('@FN', Ident[identIndex].Name) = 1 then - else - newMsg(msgNote, a); + else + newMsg(msgNote, a); - end; + end; - end; + end; end; @@ -362,19 +490,21 @@ procedure Note(NoteTokenIndex: Integer; IdentIndex: Integer); overload; // ---------------------------------------------------------------------------- -procedure Note(NoteTokenIndex: Integer; Msg: string); overload; -var a: string; +procedure Note(NoteTokenIndex: TTokenIndex; msg: String); overload; +var + a: String; begin - if Pass = CODEGENERATIONPASS then begin + if Pass = CODEGENERATIONPASS then + begin - a := UnitName[Tok[NoteTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[NoteTokenIndex].Line) + ')' + ' Note: '; + a := UnitName[Tok[NoteTokenIndex].UnitIndex].Path + ' (' + IntToStr(Tok[NoteTokenIndex].Line) + ')' + ' Note: '; - a := a + Msg; + a := a + msg; - newMsg(msgNote, a); + newMsg(msgNote, a); - end; + end; end; diff --git a/src/Parser.pas b/src/Parser.pas index 0221ff1ab..b842f44d9 100644 --- a/src/Parser.pas +++ b/src/Parser.pas @@ -501,7 +501,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); if Ident[IdentIndex].Kind in [VARIABLE, CONSTANT] then begin @@ -525,14 +525,14 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B end; end else - iError(i+2, TypeMismatch); + Error(i+2, TypeMismatch); end else - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); inc(i, 2); end else - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); CheckTok(i + 1, CPARTOK); @@ -554,7 +554,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B end else begin if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); j := CompileConstExpression(i + 2, ConstVal, ConstValType); @@ -641,7 +641,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B if isError then Exit; if not (ConstValType in RealTypes) then - iError(i, IncompatibleTypes, 0, ConstValType, REALTOK); + Error(i, IncompatibleTypes, 0, ConstValType, REALTOK); CheckTok(i + 1, CPARTOK); @@ -740,7 +740,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B i := CompileConstExpression(i + 2, ConstVal, ConstValType, BYTETOK); if not(ConstValType in OrdinalTypes + [ENUMTYPE]) then - iError(i, OrdinalExpExpected); + Error(i, OrdinalExpExpected); if isError then Exit; @@ -762,7 +762,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B i := CompileConstExpression(i + 2, ConstVal, ConstValType); if not(ConstValType in OrdinalTypes) then - iError(i, OrdinalExpExpected); + Error(i, OrdinalExpExpected); if isError then Exit; @@ -795,7 +795,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B if isError then Exit; if not(ConstValType in AllTypes) then - iError(i, TypeMismatch); + Error(i, TypeMismatch); if (Ident[GetIdent(Tok[i].Name)].DataType in RealTypes) and (ConstValType in RealTypes) then begin @@ -817,7 +817,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B else if Tok[i + 1].Kind = OBRACKETTOK then // Array element access if not (Ident[IdentIndex].DataType in Pointers) then - iError(i, IncompatibleTypeOf, IdentIndex) + Error(i, IncompatibleTypeOf, IdentIndex) else begin @@ -827,7 +827,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B if (ArrayIndex < 0) or (ArrayIndex > Ident[IdentIndex].NumAllocElements-1 + ord(Ident[IdentIndex].DataType = STRINGPOINTERTOK)) then begin isConst := false; - iError(i, SubrangeBounds); + Error(i, SubrangeBounds); end; CheckTok(j + 1, CBRACKETTOK); @@ -875,7 +875,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B end else - iError(i, UnknownIdentifier); + Error(i, UnknownIdentifier); Result := i; end; @@ -883,7 +883,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B ADDRESSTOK: if Tok[i + 1].Kind <> IDENTTOK then - iError(i + 1, IdentifierExpected) + Error(i + 1, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 1].Name); @@ -891,7 +891,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B case Ident[IdentIndex].Kind of CONSTANT: if not( (Ident[IdentIndex].DataType in Pointers) and (Ident[IdentIndex].NumAllocElements > 0) ) then - iError(i + 1, CantAdrConstantExp) + Error(i + 1, CantAdrConstantExp) else ConstVal := Ident[IdentIndex].Value - CODEORIGIN; @@ -994,7 +994,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B ConstValType := POINTERTOK; end else - iError(i + 1, UnknownIdentifier); + Error(i + 1, UnknownIdentifier); Result := i + 1; end; @@ -1108,7 +1108,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B if ((Ident[IdentIndex].AllocElementType <> UNTYPETOK) and (Ident[IdentIndex].NumAllocElements in [0,1])) or (Ident[IdentIndex].DataType = STRINGPOINTERTOK) then begin end else - iError(i + 2, IllegalTypeConversion, IdentIndex, Tok[i].Kind); + Error(i + 2, IllegalTypeConversion, IdentIndex, Tok[i].Kind); end; @@ -1124,7 +1124,7 @@ function CompileConstFactor(i: Integer; out ConstVal: Int64; out ConstValType: B else - iError(i, IdNumExpExpected); + Error(i, IdNumExpExpected); end;// case @@ -1366,7 +1366,7 @@ function CompileConstExpression(i: Integer; out ConstVal: Int64; out ConstValTyp if Err then begin isConst := false; isError := false; - iError(i, RangeCheckError, 0, ConstVal, VarType); + Error(i, RangeCheckError, 0, ConstVal, VarType); end else if War then if VarType <> BOOLEANTOK then @@ -1630,7 +1630,7 @@ function DeclareFunction(i: integer; out ProcVarIndex: cardinal): integer; Inc(Ident[NumIdent].NumParams); if Ident[NumIdent].NumParams > MAXPARAMS then - iError(i, TooManyParameters, NumIdent) + Error(i, TooManyParameters, NumIdent) else begin VarOfSameType[VarOfSameTypeIndex].DataType := VarType; @@ -1785,7 +1785,7 @@ function DefineFunction(i, ForwardIdentIndex: integer; out isForward, isInt, isI Inc(Ident[NumIdent].NumParams); if Ident[NumIdent].NumParams > MAXPARAMS then - iError(i, TooManyParameters, NumIdent) + Error(i, TooManyParameters, NumIdent) else begin VarOfSameType[VarOfSameTypeIndex].DataType := VarType; @@ -2157,7 +2157,7 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi end else begin if not (Tok[i + 1].Kind in OrdinalTypes + RealTypes + [POINTERTOK]) then - iError(i + 1, IdentifierExpected); + Error(i + 1, IdentifierExpected); NumAllocElements := 0; AllocElementType := Tok[i + 1].Kind; @@ -2604,7 +2604,7 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi NumAllocElements := UpperBound + 1; if UpperBound>255 then - iError(i, SubrangeBounds); + Error(i, SubrangeBounds); end// if STRINGTOK else @@ -2675,10 +2675,10 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi Error(i, 'Array upper bound must be integer'); if UpperBound < 0 then - iError(i, UpperBoundOfRange); + Error(i, UpperBoundOfRange); if UpperBound > High(word) then - iError(i, HighLimit); + Error(i, HighLimit); NumAllocElements := UpperBound - LowerBound + 1; @@ -2698,10 +2698,10 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi Error(i, 'Array upper bound must be integer'); if UpperBound < 0 then - iError(i, UpperBoundOfRange); + Error(i, UpperBoundOfRange); if UpperBound > High(word) then - iError(i, HighLimit); + Error(i, HighLimit); NumAllocElements := NumAllocElements or (UpperBound - LowerBound + 1) shl 16; @@ -2791,7 +2791,7 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi IdentIndex := GetIdent(Tok[i].Name); if IdentIndex = 0 then - iError(i, UnknownIdentifier); + Error(i, UnknownIdentifier); if Ident[IdentIndex].Kind <> USERTYPE then Error(i, 'Type expected but ' + Tok[i].Name + ' found'); @@ -2815,7 +2815,7 @@ function CompileType(i: Integer; out DataType: Byte; out NumAllocElements: cardi UpperBound:=ConstVal; if UpperBound < LowerBound then - iError(i, UpperBoundOfRange); + Error(i, UpperBoundOfRange); // Error(i, 'Error in type definition'); diff --git a/src/Scanner.pas b/src/Scanner.pas index 6e6046b82..75a145efa 100644 --- a/src/Scanner.pas +++ b/src/Scanner.pas @@ -15,13 +15,13 @@ interface function get_digit(var i:integer; var a:string): string; - function get_constant(var i:integer; var a:string): string; + function get_constant(var i:integer; const a:string): string; function get_label(var i:integer; var a:string; up: Boolean = true): string; function get_string(var i:integer; var a:string; up: Boolean = true): string; - procedure omin_spacje (var i:integer; var a:string); + procedure omin_spacje (var i:integer; const a:string); // ---------------------------------------------------------------------------- @@ -81,9 +81,9 @@ procedure TokenizeProgramInitialization; // ---------------------------------------------------------------------------- -procedure omin_spacje (var i:integer; var a:string); +procedure omin_spacje (var i:integer; const a:string); (*----------------------------------------------------------------------------*) -(* omijamy tzw. "biale spacje" czyli spacje, tabulatory *) +(* Skip whitespace characters until the next non-whitespace character *) (*----------------------------------------------------------------------------*) begin @@ -126,9 +126,9 @@ function get_digit(var i:integer; var a:string): string; // ---------------------------------------------------------------------------- -function get_constant(var i:integer; var a:string): string; +function get_constant(var i:integer; const a:string): string; (*----------------------------------------------------------------------------*) -(* pobierz etykiete zaczynajaca sie znakami 'A'..'Z','_' *) +(* Get label starting with characters 'A'..'Z','_' *) (*----------------------------------------------------------------------------*) begin @@ -773,7 +773,7 @@ procedure TokenizeProgram(UsesOn: Boolean = true); val(s, v, Err); if Err > 0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); GetCommonConstType(NumTok, WORDTOK, GetValueType(v)); @@ -844,7 +844,7 @@ procedure TokenizeProgram(UsesOn: Boolean = true); val(s,CPUMode, Err); if Err > 0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); GetCommonConstType(NumTok, CARDINALTOK, GetValueType(CPUMode)); @@ -874,7 +874,7 @@ procedure TokenizeProgram(UsesOn: Boolean = true); val(s, FastMul, Err); if Err <> 0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); AddDefine('FASTMUL'); AddDefines := NumDefines; @@ -1208,7 +1208,7 @@ procedure TokenizeProgram(UsesOn: Boolean = true); end; if length(Num)=0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); Num := '%' + Num; @@ -1225,7 +1225,7 @@ procedure TokenizeProgram(UsesOn: Boolean = true); end; if length(Num)=0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); Num := '$' + Num; @@ -2060,7 +2060,7 @@ procedure TokenizeMacro(a: string; Line, Spaces: integer); end; if length(Num)=0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); Num := '%' + Num; @@ -2077,7 +2077,7 @@ procedure TokenizeMacro(a: string; Line, Spaces: integer); end; if length(Num)=0 then - iError(NumTok, OrdinalExpExpected); + Error(NumTok, OrdinalExpExpected); Num := '$' + Num; diff --git a/src/TestMadPascal.lpi b/src/TestMadPascal.lpi index cff419a69..32ea35427 100644 --- a/src/TestMadPascal.lpi +++ b/src/TestMadPascal.lpi @@ -85,6 +85,422 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -119,6 +535,11 @@ + + + + + diff --git a/src/TestUnits.lpi b/src/TestUnits.lpi index e94724812..371b74732 100644 --- a/src/TestUnits.lpi +++ b/src/TestUnits.lpi @@ -45,6 +45,18 @@ + + + + + + + + + + + + @@ -89,6 +101,18 @@ + + + + + + + + + + + + diff --git a/src/TestUnits.lpr b/src/TestUnits.lpr index feac7b3a1..6b32a5e11 100644 --- a/src/TestUnits.lpr +++ b/src/TestUnits.lpr @@ -2,16 +2,18 @@ {$i define.inc} -{$DEFINE SIMULATED_FILE_IO} - uses + Crt, Console, Common, FileIO, + MathEvaluate, Scanner, - Utilities {$IFDEF PAS2JS} + Utilities + {$IFDEF PAS2JS} ,browserconsole - {$ENDIF}; + {$ENDIF}, + SysUtils; procedure StartTest(Name: String); begin @@ -85,26 +87,8 @@ var pathList: TPathList; - var - fileMap: TFileMap; - var - fileMapEntry: TFileMapEntry; - begin StartTest('TestUnitFile'); - - fileMap := TFileMap.Create; - fileMapEntry := fileMap.AddEntry('Input.pas', TFileMapEntry.TFileType.TextFile); - fileMapEntry.content := 'Program program; end.'; - - fileMapEntry := fileMap.AddEntry('Input.bin', TFileMapEntry.TFileType.BinaryFile); - fileMapEntry.content := '01010110101'; - - fileMapEntry := fileMap.AddEntry('lib', TFileMapEntry.TFileType.Folder); - fileMapEntry.content := 'SubFolder1;SubFolder2'; - - TFileSystem.Init(fileMap); - TestNative(TEST_MP_FILE_PATH); TestFileIO(TEST_MP_FILE_PATH); @@ -113,8 +97,7 @@ pathList.AddFolder('Folder2'); pathList.AddFolder('Folder2' + TFileSystem.PathDelim); Assert(pathList.GetSize() = 2); - Assert(pathList.ToString() = 'Folder1' + TFileSystem.PathDelim + - ';Folder2' + TFileSystem.PathDelim); + Assert(pathList.ToString() = 'Folder1' + TFileSystem.PathDelim + ';Folder2' + TFileSystem.PathDelim); pathList.Free; EndTest('TestUnitFile'); @@ -145,15 +128,106 @@ Assert(ex.GetExitCode = THaltException.COMPILING_ABORTED); end; end; - Assert(filePath <> '', 'Non-existing TestUnit found'); + Assert(filePath = '', 'Non-existing TestUnit found'); EndTest('TestUnitCommon'); end; +type + TTestEvaluationContext = class(TInterfacedObject, IEvaluationContext) + public + constructor Create; + function GetConstantName(const expression: String; var index: Integer): String; + function GetConstantValue(const constantName: String; var constantValue: Int64): Boolean; + end; + + constructor TTestEvaluationContext.Create; + begin + end; + + function TTestEvaluationContext.GetConstantName(const expression: String; var index: Integer): String; + begin + Result := 'EXAMPLE'; + end; + + function TTestEvaluationContext.GetConstantValue(const constantName: String; var constantValue: Int64): Boolean; + begin + if constantName = 'EXAMPLE' then + begin + constantValue := 1; + Result := True; + end + else + begin + constantValue := 0; + Result := False; + end; + end; + + procedure TestUnitMathEvaluate; + + procedure AssertValue(const expression: String; expectedValue: TEvaluationResult); + var + evaluationContext: IEvaluationContext; + actualValue: TEvaluationResult; + begin + evaluationContext := TTestEvaluationContext.Create; + actualValue := MathEvaluate.Evaluate(expression, evaluationContext); + Assert(actualValue = expectedValue, + 'Expression ''' + expression + ''' was evaluated to value ' + FloatToStr(actualValue) + + ' instead of ' + FloatToStr(expectedValue) + '.'); + end; + + procedure AssertException(const expression: String; expectedIndex: Integer; expectedMessage: String); + var + evaluationContext: IEvaluationContext; + begin + evaluationContext := TTestEvaluationContext.Create; + try + MathEvaluate.Evaluate(expression, evaluationContext); + Assert(False, 'Expected exception ''' + expectedMessage + ''' for expression ''' + + expression + ''' not raised.'); + except + on ex: EEvaluationException do + begin + Assert(ex.Message = expectedMessage, 'Expected exception ''' + expectedMessage + + ''' for expression ''' + expression + ''' raised with different text ''' + ex.Message + '''.'); + Assert(ex.Index = expectedIndex, 'Expected exception ''' + expectedMessage + + ''' for expression ''' + expression + ''' raised with different index ' + + IntToStr(ex.Index) + ' instead of ' + IntToStr(expectedIndex) + '.'); + + end; + end; + + end; + begin + + StartTest('TestUnitCommon'); + + AssertValue('', 0); + AssertValue('(1+2)*3+1+100/10', 20); + AssertValue('$1234+$2345', $1234 + $2345); + AssertValue('%111011010', $1da); // There is no binary in Delphi + + AssertException('(', 2, 'Parenthesis Mismatch'); + EndTest('TestUnitMathEvaluate'); + end; + +begin + try TestUnitFile; TestUnitCommon; + TestUnitMathEvaluate; + except + on e: Exception do + begin + ShowException(e, ExceptAddr); + end; + end; - Writeln('Main completed.'); + Writeln('Main completed. Press any key.'); + repeat + until keypressed; end. diff --git a/src/Utilities.pas b/src/Utilities.pas index 6ab28dfe5..4f0b7d46e 100644 --- a/src/Utilities.pas +++ b/src/Utilities.pas @@ -88,12 +88,7 @@ function THaltException.GetExitCode: Longint; procedure RaiseHaltException(errnum: Longint); begin -{$IFDEF PAS2JS} raise THaltException.Create(errnum); -{$ELSE} - halt(errnum); -{$ENDIF} - end; {$IFDEF PAS2JS} diff --git a/src/define.inc b/src/define.inc index 52f0c58a9..4d6220120 100644 --- a/src/define.inc +++ b/src/define.inc @@ -15,3 +15,10 @@ {$ELSE} {$IOCHECKS ON} {$ENDIF} + +// Special cases for PAS2JS +{$IFNDEF PAS2JS} +{$DEFINE UPCASE_STRING} +{$ELSE} +{$DEFINE SIMULATED_FILE_IO} +{$ENDIF} diff --git a/src/include/compile_pchar.inc b/src/include/compile_pchar.inc index 47146660e..ac64c0478 100644 --- a/src/include/compile_pchar.inc +++ b/src/include/compile_pchar.inc @@ -237,7 +237,7 @@ end else - iError(i, IncompatibleTypes, 0, ExpressionType, VarType); + Error(i, IncompatibleTypes, 0, ExpressionType, VarType); end; diff --git a/src/include/compile_string.inc b/src/include/compile_string.inc index 8e5aa2e01..7d874d879 100644 --- a/src/include/compile_string.inc +++ b/src/include/compile_string.inc @@ -234,7 +234,7 @@ end else - iError(i, IncompatibleTypes, 0, ExpressionType, VarType); + Error(i, IncompatibleTypes, 0, ExpressionType, VarType); end; diff --git a/src/include/doevaluate.inc b/src/include/doevaluate.inc index 8e4581a16..cded07fdf 100644 --- a/src/include/doevaluate.inc +++ b/src/include/doevaluate.inc @@ -1,147 +1,163 @@ -function doEvaluate: integer; -var s: string; - par1, par2, p1, p2: integer; - k: integer; - -// ---------------------------------------------------------------------------- - - function GetParameter: integer; - var tmp: string; - Err, IdentTemp: integer; +function DoEvaluate(const evaluationContext: IEvaluationContext): Integer; +var + s: String; + par1, par2, p1, p2: Integer; + k: Integer; + + // ---------------------------------------------------------------------------- + + function GetParameter: Integer; + var + tmp: String; + err: Integer; + constantValue: Int64; begin - Result:=0; + Result := 0; - tmp := get_digit(k, s); - if tmp <> '' then begin + tmp := get_digit(k, s); + if tmp <> '' then + begin - val(tmp, Result, Err); - if Err > 0 then Error(i, 'Identifier or number expected but ''' + tmp + ''' found'); + val(tmp, Result, err); + if err > 0 then Error(i, 'Identifier or number expected but ''' + tmp + ''' found'); if Result < 0 then Error(i, 'evaluation parameter is less than zero'); exit; - end; - + end; - tmp := get_constant(k, s); - if tmp <> '' then begin - IdentTemp:=GetIdent(tmp); + tmp := evaluationContext.GetConstantName(s, k); + if tmp <> '' then + begin - if IdentTemp > 0 then - Result := Ident[IdentTemp].Value + constantValue := 0; + if evaluationContext.GetConstantValue(tmp, constantValue) then + Result := constantValue else Error(i, 'Identifier or number expected but ''' + tmp + ''' found'); if Result < 0 then Error(i, 'evaluation parameter is less than zero'); exit; - end; + end; - Error(i, 'Identifier or number expected but ''' + s[k] + ''' found'); + Error(i, 'Identifier or number expected but ''' + s[k] + ''' found'); end; -// ---------------------------------------------------------------------------- + // ---------------------------------------------------------------------------- - procedure doEvaluations(_0,_1: integer); - var p: integer; - _s: string; - fl: single; -begin + procedure doEvaluations(_0, _1: Integer); + var + p: Integer; + _s: String; + fl: Single; + begin - _s := s; + _s := s; - if _0 >= 0 then - while _s.IndexOf(':1') >= 0 do begin - p:=_s.IndexOf(':1'); + if _0 >= 0 then + while _s.IndexOf(':1') >= 0 do + begin + p := _s.IndexOf(':1'); - delete(_s, p+1, 2); - insert(IntToStr(_0), _s, p+1); - end; + Delete(_s, p + 1, 2); + Insert(IntToStr(_0), _s, p + 1); + end; - if _1 >= 0 then - while _s.IndexOf(':2') >= 0 do begin - p:=_s.IndexOf(':2'); + if _1 >= 0 then + while _s.IndexOf(':2') >= 0 do + begin + p := _s.IndexOf(':2'); - delete(_s, p+1, 2); - insert(IntToStr(_1), _s, p+1); - end; + Delete(_s, p + 1, 2); + Insert(IntToStr(_1), _s, p + 1); + end; - fl := Evaluate(_s, i); + try + fl := MathEvaluate.Evaluate(_s, evaluationContext); + except + on e: EEvaluationException do + Error(i, 'Evaluation error at position ' + IntToStr(e.Index) + ' of expression ''' + e.expression + '''. ' + e.message); + end; - ConstVal:=Assign(ConstValType, fl); + ConstVal := Assign(ConstValType, fl); - SaveData(false); + SaveData(False); end; -// ---------------------------------------------------------------------------- - + // ---------------------------------------------------------------------------- begin - doEvaluate:=0; + Result := 0; par1 := -1; par2 := -1; - s := linkObj[ Tok[i + 1].Value ]; + s := linkObj[Tok[i + 1].Value]; - if s <> '' then begin - - k:=1; - omin_spacje(k, s); + if s <> '' then + begin - if s[k] <> '"' then begin + k := 1; + omin_spacje(k, s); - par1 := GetParameter; + if s[k] <> '"' then + begin - omin_spacje(k, s); - if s[k] <> ',' then Error(i, 'Syntax error, '','' expected but ''' + s[k] + ''' found'); + par1 := GetParameter; - inc(k); - end; + omin_spacje(k, s); + if s[k] <> ',' then Error(i, 'Syntax error, '','' expected but ''' + s[k] + ''' found'); - omin_spacje(k, s); + Inc(k); + end; - if s[k] <> '"' then begin + omin_spacje(k, s); - par2 := GetParameter; + if s[k] <> '"' then + begin - omin_spacje(k, s); - if s[k] <> ',' then Error(i, 'Syntax error, '','' expected but ''' + s[k] + ''' found'); + par2 := GetParameter; - inc(k); - end; + omin_spacje(k, s); + if s[k] <> ',' then Error(i, 'Syntax error, '','' expected but ''' + s[k] + ''' found'); - omin_spacje(k, s); + Inc(k); + end; - if s[k] <> '"' then Error(i, 'Syntax error, ''"'' expected but ''' + s[k] + ''' found'); + omin_spacje(k, s); - s := get_string(k, s, true); + if s[k] <> '"' then Error(i, 'Syntax error, ''"'' expected but ''' + s[k] + ''' found'); - ActualParamType := ConstValType; + s := get_string(k, s, True); - if par1 > 0 then - if par2 > 0 then begin + ActualParamType := ConstValType; - for p2 := 0 to par2 - 1 do - for p1 := 0 to par1 - 1 do doEvaluations(p1,p2); + if par1 > 0 then + if par2 > 0 then + begin - doEvaluate := par1 * par2; + for p2 := 0 to par2 - 1 do + for p1 := 0 to par1 - 1 do doEvaluations(p1, p2); - end else begin - for p1 := 0 to par1 - 1 do doEvaluations(p1,-1); + Result := par1 * par2; - doEvaluate := par1; - end; + end + else + begin + for p1 := 0 to par1 - 1 do doEvaluations(p1, -1); + Result := par1; + end; - end; // if s <> '' + end; // if s <> '' - inc(i); + Inc(i); end; diff --git a/src/include/for_in_ident.inc b/src/include/for_in_ident.inc index 397541d59..c0a238813 100644 --- a/src/include/for_in_ident.inc +++ b/src/include/for_in_ident.inc @@ -4,7 +4,7 @@ // ----------------------------------------------------------------------------- if Tok[j].Kind <> IDENTTOK then - iError(j, IdentifierExpected); + Error(j, IdentifierExpected); IdentTemp := GetIdent(Tok[j].Name); diff --git a/src/include/syntax.inc b/src/include/syntax.inc index 488668f5c..15d066811 100644 --- a/src/include/syntax.inc +++ b/src/include/syntax.inc @@ -27,16 +27,18 @@ begin For i:=1 to TEnvironment.GetParameterCount do begin - if i = index then + if i < index then begin - Console.TextColor(Console.LightRed); - + Console.TextColor(Console.LightGreen); + end + else if i = index then + begin + Console.TextColor(Console.LightRed); end else -begin - Console.NormVideo; - end; - + begin + Console.NormVideo; + end; Write(TEnvironment.GetParameterString(i)); Write(' '); @@ -45,9 +47,9 @@ begin Console.TextColor(Console.LightRed); - WriteLn('ERROR: '+message + ' Check option number '+IntToStr(index)+'.'); + WriteLn('ERROR: Check option number '+IntToStr(index)+'. '+message ); Console.NormVideo; - Syntax(3); + Syntax(THaltException.COMPILING_NOT_STARTED); end; procedure ParameterValueError(index: Longint; parameterValue: String; message:String) ; diff --git a/src/mp.pas b/src/mp.pas index 75646cacc..0e9401538 100644 --- a/src/mp.pas +++ b/src/mp.pas @@ -39,7 +39,7 @@ + David Schmenk : - IEEE-754 (32bit) Single[Float] -+ Daniel Koźmiński : ++ Daniel Kozminski : - unit STRINGUTILS - unit CIO @@ -70,10 +70,10 @@ - unit LZ4: unLZ4 - unit aPLib: unAPL -+ Krzysztof Święcicki : ++ Krzysztof Swiecicki : - unit PP -+ Marcin Żukowski : ++ Marcin Zukowski : - unit FASTGRAPH: fLine + Michael Jaskula : @@ -117,7 +117,7 @@ - unit LZJB - unit RC4 -+ Wojciech Bociański (http://bocianu.atari.pl/) : ++ Wojciech Bocianski (http://bocianu.atari.pl/) : - library BLIBS: B_CRT, B_DL, B_PMG, B_SYSTEM, B_UTILS, XBIOS - MADSTRAP - PASDOC @@ -194,6 +194,43 @@ {$ENDIF} Common, Console, Messages, Numbers, Scanner, Parser, Optimize, Diagnostic, MathEvaluate, FileIO, Utilities; +// Temporarily own variable, because main program is no class yet. +var evaluationContext: IEvaluationContext; + +type + TEvaluationContext = class(TInterfacedObject, IEvaluationContext) + public + constructor Create; + function GetConstantName(const expression: String; var index: Integer): String; + function GetConstantValue(const constantName: String; var constantValue: Int64): Boolean; + end; + + constructor TEvaluationContext.Create; + begin + end; + + function TEvaluationContext.GetConstantName(const expression: String; var index: Integer): String; + begin + Result:= Scanner.get_constant(index, expression); + end; + + function TEvaluationContext.GetConstantValue(const constantName: String; var constantValue: Int64): Boolean; + var identTemp: Integer; + begin + + identTemp := Parser.GetIdent(constantName); + + if identTemp > 0 then begin + + constantValue := Ident[IdentTemp].Value; + Result:=true; + end + else + begin + constantValue:=0; + Result:=false; + end; + end; // ---------------------------------------------------------------------------- // ---------------------------------------------------------------------------- @@ -6204,7 +6241,7 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass end else if Tok[i + 1].Kind <> IDENTTOK then - iError(i + 1, IdentifierExpected) + Error(i + 1, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 1].Name); @@ -6214,12 +6251,12 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass begin if not(Ident[IdentIndex].Kind in [CONSTANT, VARIABLE, PROCEDURETOK, FUNCTIONTOK, CONSTRUCTORTOK, DESTRUCTORTOK, ADDRESSTOK]) then - iError(i + 1, VariableExpected) + Error(i + 1, VariableExpected) else begin if Ident[IdentIndex].Kind = CONSTANT then if not ( (Ident[IdentIndex].DataType in Pointers) and (Ident[IdentIndex].NumAllocElements > 0) ) then - iError(i + 1, CantAdrConstantExp); + Error(i + 1, CantAdrConstantExp); // writeln(Ident[IdentIndex].nAME,' = ',Ident[IdentIndex].DataType,',',Ident[IdentIndex].AllocElementType,',',Ident[IdentIndex].NumAllocElements,',',Ident[IdentIndex].PassMethod ); @@ -6356,7 +6393,7 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass IdentTemp:=GetIdent(svar + '.' + string(Tok[i + 4].Name) ); if IdentTemp = 0 then - iError(i + 4, UnknownIdentifier); + Error(i + 4, UnknownIdentifier); Push(Ident[IdentTemp].Value, ASPOINTER, DataSize[POINTERTOK], IdentTemp); @@ -6374,10 +6411,10 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass if Ident[IdentIndex].NumAllocElements_ = 0 then else - iError(i + 4, IllegalQualifier); // array of ^record + Error(i + 4, IllegalQualifier); // array of ^record end else - iError(i + 4, IllegalQualifier); // array + Error(i + 4, IllegalQualifier); // array end; @@ -6451,7 +6488,7 @@ function CompileAddress(i: integer; out ValType, AllocElementType: Byte; VarPass end else - iError(i + 1, UnknownIdentifier); + Error(i + 1, UnknownIdentifier); end; end; //CompileAddress @@ -6487,7 +6524,7 @@ function NumActualParameters(i: integer; IdentIndex: integer; out NumActualParam Inc(NumActualParams); if NumActualParams > MAXPARAMS then - iError(i, TooManyParameters, IdentIndex); + Error(i, TooManyParameters, IdentIndex); Result[NumActualParams].i := i; @@ -6743,9 +6780,9 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if NumActualParams <> Ident[IdentIndex].NumParams then if ProcVarIndex > 0 then - iError(i, WrongNumParameters, ProcVarIndex) + Error(i, WrongNumParameters, ProcVarIndex) else - iError(i, WrongNumParameters, IdentIndex); + Error(i, WrongNumParameters, IdentIndex); ParamIndex := NumActualParams; @@ -6769,9 +6806,9 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn // if NumActualParams > Ident[IdentIndex].NumParams then // if ProcVarIndex > 0 then -// iError(i, WrongNumParameters, ProcVarIndex) +// Error(i, WrongNumParameters, ProcVarIndex) // else -// iError(i, WrongNumParameters, IdentIndex); +// Error(i, WrongNumParameters, IdentIndex); i := Param[NumActualParams].i; @@ -6808,7 +6845,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if IdentTemp > 0 then begin - if Ident[IdentTemp].Kind = FUNCTIONTOK then iError(i, CantAdrConstantExp); // VARPASSING function not possible + if Ident[IdentTemp].Kind = FUNCTIONTOK then Error(i, CantAdrConstantExp); // VARPASSING function not possible // writeln(' - ',Tok[i].Name,',',ActualParamType,',',AllocElementType, ',', Ident[IdentTemp].NumAllocElements ); @@ -6839,9 +6876,9 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if (Ident[IdentIndex].Param[NumActualParams].NumAllocElements > 0) and (Ident[IdentTemp].NumAllocElements <> Ident[IdentIndex].Param[NumActualParams].NumAllocElements) then begin if Ident[IdentTemp].PassMethod <> Ident[IdentIndex].Param[NumActualParams].PassMethod then - iError(i, CantAdrConstantExp) + Error(i, CantAdrConstantExp) else - iError(i, IncompatibleTypeOf, IdentTemp); + Error(i, IncompatibleTypeOf, IdentTemp); end; @@ -6851,7 +6888,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if (Ident[IdentTemp].AllocElementType = UNTYPETOK) then if (Ident[IdentIndex].Param[NumActualParams].DataType <> UNTYPETOK) and (Ident[IdentIndex].Param[NumActualParams].DataType <> Ident[IdentTemp].DataType) then - iError(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, Ident[IdentIndex].Param[NumActualParams].DataType); end else if Ident[IdentIndex].Param[NumActualParams].DataType in Pointers then begin @@ -6876,10 +6913,10 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if Ident[IdentTemp].AllocElementType in [RECORDTOK, OBJECTTOK] then else - iError(i, IncompatibleTypesArray, IdentTemp, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypesArray, IdentTemp, Ident[IdentIndex].Param[NumActualParams].DataType); end else - iError(i, IncompatibleTypes, 0, Ident[IdentTemp].AllocElementType, Ident[IdentIndex].Param[NumActualParams].AllocElementType); + Error(i, IncompatibleTypes, 0, Ident[IdentTemp].AllocElementType, Ident[IdentIndex].Param[NumActualParams].AllocElementType); end; @@ -6895,10 +6932,10 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if Ident[IdentIndex].Param[NumActualParams].AllocElementType <> UNTYPETOK then begin if Ident[IdentIndex].Param[NumActualParams].AllocElementType <> AllocElementType then - iError(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].DataType); end else - iError(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].DataType); end; @@ -6927,11 +6964,11 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if Ident[GetIdent(Tok[i].Name)].isNestedFunction then begin if Ident[GetIdent(Tok[i].Name)].NestedFunctionNumAllocElements <> Ident[IdentIndex].Param[NumActualParams].NumAllocElements then - iError(i, IncompatibleTypeOf, GetIdent(Tok[i].Name)); + Error(i, IncompatibleTypeOf, GetIdent(Tok[i].Name)); end else if Ident[GetIdent(Tok[i].Name)].NumAllocElements <> Ident[IdentIndex].Param[NumActualParams].NumAllocElements then - iError(i, IncompatibleTypeOf, GetIdent(Tok[i].Name)); + Error(i, IncompatibleTypeOf, GetIdent(Tok[i].Name)); if ((ActualParamType in [RECORDTOK, OBJECTTOK]) and (Ident[IdentIndex].Param[NumActualParams].DataType in Pointers)) or @@ -6949,7 +6986,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn AllocElementType := Ident[IdentTemp].AllocElementType; if AllocElementType = UNTYPETOK then - iError(i, IncompatibleTypes, 0, ActualParamType, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypes, 0, ActualParamType, Ident[IdentIndex].Param[NumActualParams].DataType); { writeln('--- ',Ident[IdentIndex].Name,',',ActualParamType,',',AllocElementType); writeln(Ident[IdentIndex].Param[NumActualParams].DataType,',', Ident[IdentTemp].DataType); @@ -6958,7 +6995,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn writeln(Ident[IdentIndex].Param[NumActualParams].PassMethod,',', Ident[IdentTemp].PassMethod); } end else - iError(i, IncompatibleTypes, 0, ActualParamType, Ident[IdentIndex].Param[NumActualParams].DataType); + Error(i, IncompatibleTypes, 0, ActualParamType, Ident[IdentIndex].Param[NumActualParams].DataType); end @@ -6979,10 +7016,10 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if Ident[IdentIndex].Param[NumActualParams].AllocElementType <> AllocElementType then begin if (Ident[IdentIndex].Param[NumActualParams].AllocElementType = UNTYPETOK) and (Ident[IdentIndex].Param[NumActualParams].DataType = POINTERTOK) and ({Ident[IdentIndex].Param[NumActualParams]} Ident[IdentTemp].NumAllocElements > 0) then - iError(i, IncompatibleTypesArray, IdentTemp, POINTERTOK) + Error(i, IncompatibleTypesArray, IdentTemp, POINTERTOK) else if (Ident[IdentIndex].Param[NumActualParams].AllocElementType <> PROCVARTOK) and (Ident[IdentIndex].Param[NumActualParams].NumAllocElements > 0) then - iError(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].AllocElementType); + Error(i, IncompatibleTypes, 0, AllocElementType, Ident[IdentIndex].Param[NumActualParams].AllocElementType); end; @@ -6994,10 +7031,10 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if (Ident[IdentTemp].DataType = STRINGPOINTERTOK) and (Ident[IdentTemp].NumAllocElements <> 0) and (Ident[IdentIndex].Param[NumActualParams].DataType = POINTERTOK) and (Ident[IdentIndex].Param[NumActualParams].NumAllocElements = 0) then if Ident[IdentIndex].Param[NumActualParams].AllocElementType = UNTYPETOK then - iError(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, Ident[IdentIndex].Param[NumActualParams].DataType) + Error(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, Ident[IdentIndex].Param[NumActualParams].DataType) else if Ident[IdentIndex].Param[NumActualParams].AllocElementType <> BYTETOK then // wyjatkowo akceptujemy PBYTE jako STRING - iError(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, -Ident[IdentIndex].Param[NumActualParams].AllocElementType); + Error(i, IncompatibleTypes, 0, Ident[IdentTemp].DataType, -Ident[IdentIndex].Param[NumActualParams].AllocElementType); { if (Ident[IdentIndex].Param[NumActualParams].DataType = PCHARTOK) then begin @@ -7021,7 +7058,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn // writeln('2 > ',Ident[IdentIndex].Name,',',ActualParamType,',',AllocElementType,',',Tok[i].Kind,',',Ident[IdentIndex].Param[NumActualParams].DataType,',',Ident[IdentIndex].Param[NumActualParams].NumAllocElements); if (ActualParamType = POINTERTOK) and (Ident[IdentIndex].Param[NumActualParams].DataType = STRINGPOINTERTOK) then - iError(i, IncompatibleTypes, 0, ActualParamType, -STRINGPOINTERTOK); + Error(i, IncompatibleTypes, 0, ActualParamType, -STRINGPOINTERTOK); if (Ident[IdentIndex].Param[NumActualParams].DataType = STRINGPOINTERTOK) then begin // CHAR -> STRING @@ -7305,7 +7342,7 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn if Ident[IdentIndex].ObjectIndex > 0 then begin if Tok[old_i].Kind <> IDENTTOK then - iError(old_i, IdentifierExpected) + Error(old_i, IdentifierExpected) else IdentTemp := GetIdent(copy(Tok[old_i].Name, 1, pos('.', Tok[old_i].Name)-1 )); @@ -7484,13 +7521,13 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if Tok[j].Kind = IDENTTOK then IdentIndex := GetIdent(Tok[j].Name) else - iError(i, TypeMismatch); + Error(i, TypeMismatch); - if IdentIndex = 0 then iError(i, TypeMismatch); + if IdentIndex = 0 then Error(i, TypeMismatch); IdentTemp := GetIdent(Types[Ident[IdentIndex].NumAllocElements].Field[Types[Ident[IdentIndex].NumAllocElements].NumFields].Name); - if Ident[IdentTemp].NumAllocElements = 0 then iError(i, TypeMismatch); + if Ident[IdentTemp].NumAllocElements = 0 then Error(i, TypeMismatch); Push(Ident[IdentTemp].Value, ASPOINTER, DataSize[POINTERTOK], IdentTemp); @@ -7553,13 +7590,13 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if Tok[j].Kind = IDENTTOK then IdentIndex := GetIdent(Tok[j].Name) else - iError(i, TypeMismatch); + Error(i, TypeMismatch); - if IdentIndex = 0 then iError(i, TypeMismatch); + if IdentIndex = 0 then Error(i, TypeMismatch); IdentTemp := GetIdent(Types[Ident[IdentIndex].NumAllocElements].Field[1].Name); - if Ident[IdentTemp].NumAllocElements = 0 then iError(i, TypeMismatch); + if Ident[IdentTemp].NumAllocElements = 0 then Error(i, TypeMismatch); ValType := ENUMTYPE; Push(Ident[IdentTemp].Value, ASPOINTER, DataSize[POINTERTOK], IdentTemp); @@ -7606,7 +7643,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy end else begin if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); oldPass := Pass; oldCodeSize := CodeSize; @@ -7665,7 +7702,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // writeln(Ident[IdentIndex].name,',',Ident[IdentIndex].DataType,',',Ident[IdentIndex].NumAllocElements,',',Ident[IdentIndex].AllocElementType ); @@ -7706,7 +7743,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy end else begin - if (IdentTemp shr 16) <> STRINGPOINTERTOK then iError(i + 1, TypeMismatch); + if (IdentTemp shr 16) <> STRINGPOINTERTOK then Error(i + 1, TypeMismatch); Push(0, ASVALUE, 1); @@ -7821,7 +7858,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if Tok[i + 3].Kind = OBRACKETTOK then - iError(i+2, TypeMismatch) + Error(i+2, TypeMismatch) else begin @@ -7835,14 +7872,14 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy end; end else - iError(i + 2, TypeMismatch); + Error(i + 2, TypeMismatch); end else - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); inc(i, 2); end else - iError(i + 2, IdentifierExpected); + Error(i + 2, IdentifierExpected); CheckTok(i + 1, CPARTOK); @@ -7936,7 +7973,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy i := CompileExpression(i + 2, ActualParamType); if not (ActualParamType in RealTypes) then - iError(i + 2, IncompatibleTypes, 0, ActualParamType, REALTOK); + Error(i + 2, IncompatibleTypes, 0, ActualParamType, REALTOK); CheckTok(i + 1, CPARTOK); @@ -8000,7 +8037,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy i := CompileExpression(i + 2, ActualParamType); if not (ActualParamType in RealTypes) then - iError(i + 2, IncompatibleTypes, 0, ActualParamType, REALTOK); + Error(i + 2, IncompatibleTypes, 0, ActualParamType, REALTOK); CheckTok(i + 1, CPARTOK); @@ -8330,7 +8367,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy i := CompileExpression(i + 2, ValType, BYTETOK); if not(ValType in OrdinalTypes + [ENUMTYPE]) then - iError(i, OrdinalExpExpected); + Error(i, OrdinalExpExpected); CheckTok(i + 1, CPARTOK); @@ -8350,7 +8387,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy i := CompileExpression(i + 2, ValType); if not(ValType in OrdinalTypes) then - iError(i, OrdinalExpExpected); + Error(i, OrdinalExpExpected); CheckTok(i + 1, CPARTOK); @@ -8511,7 +8548,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if not(ValType in AllTypes) then - iError(i, TypeMismatch); + Error(i, TypeMismatch); if (ValType = POINTERTOK) and not (Ident[IdentIndex].DataType in [POINTERTOK, RECORDTOK, OBJECTTOK]) then begin @@ -8631,7 +8668,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if Ident[IdentTemp].IsNestedFunction = FALSE then Error(j, 'Variable, constant or function name expected but procedure ' + Ident[IdentIndex].Name + ' found'); - if Tok[j].Kind <> IDENTTOK then iError(j, VariableExpected); + if Tok[j].Kind <> IDENTTOK then Error(j, VariableExpected); svar := GetLocalName(GetIdent(Tok[j].Name)); @@ -8701,7 +8738,7 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy inc(j); end else - iError(j + 2, IllegalQualifier); + Error(j + 2, IllegalQualifier); if yes then @@ -8799,11 +8836,11 @@ function CompileFactor(i: Integer; out isZero: Boolean; out ValType: Byte; VarTy if Ident[IdentIndex].isOverload then begin if Ident[IdentIndex].NumParams <> j then - iError(i, WrongNumParameters, IdentIndex); + Error(i, WrongNumParameters, IdentIndex); - iError(i, CantDetermine, IdentIndex) + Error(i, CantDetermine, IdentIndex) end else - iError(i, WrongNumParameters, IdentIndex); + Error(i, WrongNumParameters, IdentIndex); IdentIndex := IdentTemp; @@ -8835,7 +8872,7 @@ // === record^. if (Tok[i + 1].Kind = DEREFERENCETOK) then if (Ident[IdentIndex].Kind <> VARIABLE) or not (Ident[IdentIndex].DataType in Pointers) then - iError(i, IncompatibleTypeOf, IdentIndex) + Error(i, IncompatibleTypeOf, IdentIndex) else begin @@ -8908,7 +8945,7 @@ // === record^. if Tok[i + 1].Kind = OBRACKETTOK then // Array element access if not (Ident[IdentIndex].DataType in Pointers) {or ((Ident[IdentIndex].NumAllocElements = 0) and (Ident[IdentIndex].idType <> PCHARTOK))} then // PByte, PWord - iError(i, IncompatibleTypeOf, IdentIndex) + Error(i, IncompatibleTypeOf, IdentIndex) else begin @@ -9163,7 +9200,7 @@ // === record^. end else - iError(i, UnknownIdentifier); + Error(i, UnknownIdentifier); end; @@ -9290,7 +9327,7 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); end else begin @@ -9358,7 +9395,7 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); end else begin @@ -9417,7 +9454,7 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); end else begin @@ -9508,7 +9545,7 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); end else begin @@ -9577,7 +9614,7 @@ // === record^. if ((Ident[IdentIndex].AllocElementType <> UNTYPETOK) and (Ident[IdentIndex].NumAllocElements in [0,1])) or (Ident[IdentIndex].DataType = STRINGPOINTERTOK) then else - iError(i + 2, IllegalTypeConversion, IdentIndex, Tok[i].Kind); + Error(i + 2, IllegalTypeConversion, IdentIndex, Tok[i].Kind); end; @@ -9627,11 +9664,11 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); if not(ValType in AllTypes) then - iError(i, TypeMismatch); + Error(i, TypeMismatch); ExpandParam(Tok[i].Kind, ValType); @@ -9648,14 +9685,14 @@ // === record^. inc(j); end else - iError(j + 1, IllegalQualifier); + Error(j + 1, IllegalQualifier); Result := j + 1; end; else - iError(i, IdNumExpExpected); + Error(i, IdNumExpExpected); end;// case end; //CompileFactor @@ -10362,12 +10399,12 @@ function CompileBlockRead(var i: integer; IdentIndex: integer; IdentBlock: integ StartOptimization(i); if NumActualParams > 3 then - iError(i, WrongNumParameters, IdentBlock); + Error(i, WrongNumParameters, IdentBlock); if fBlockRead_ParamType[NumActualParams] in Pointers + [UNTYPETOK] then begin if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, VariableExpected) + Error(i + 2, VariableExpected) else begin idx:=GetIdent(Tok[i + 2].Name); @@ -10375,12 +10412,12 @@ function CompileBlockRead(var i: integer; IdentIndex: integer; IdentBlock: integ if (Ident[idx].Kind = CONSTTOK) then begin if not (Ident[idx].DataType in Pointers) or (Elements(idx) = 0) then - iError(i + 2, VariableExpected); + Error(i + 2, VariableExpected); end else if (Ident[idx].Kind <> VARTOK) then - iError(i + 2, VariableExpected); + Error(i + 2, VariableExpected); end; @@ -10402,7 +10439,7 @@ function CompileBlockRead(var i: integer; IdentIndex: integer; IdentBlock: integ until Tok[i + 1].Kind <> COMMATOK; if NumActualParams < 2 then - iError(i, WrongNumParameters, IdentBlock); + Error(i, WrongNumParameters, IdentBlock); CheckTok(i + 1, CPARTOK); @@ -10496,7 +10533,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; StartOptimization(i + 1); if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, VariableExpected) + Error(i + 2, VariableExpected) else IdentIndex := GetIdent(Tok[i + 2].Name); @@ -10508,7 +10545,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; CheckTok(i + 3, CPARTOK); if Tok[i + 4].Kind <> ASSIGNTOK then - iError(i + 4, IllegalExpression); + Error(i + 4, IllegalExpression); i := CompileExpression(i + 5, ExpressionType, VarType); @@ -10578,7 +10615,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; IdentTemp:=GetIdent( ExtractName(IdentIndex, Ident[IdentIndex].Name) ); if (Ident[IdentTemp].NumAllocElements_ > 0) and (Ident[IdentTemp].DataType = POINTERTOK) and (Ident[IdentTemp].AllocElementType in [RECORDTOK, OBJECTTOK]) then - iError(i, IllegalQualifier); + Error(i, IllegalQualifier); // writeln(Ident[IdentTemp].name,',',Ident[IdentTemp].DataType,',',Ident[IdentTemp].AllocElementType,',',Ident[IdentTemp].NumAllocElements_); @@ -10593,7 +10630,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; // writeln('= ',Ident[IdentIndex].Name,',',Ident[IdentIndex].DataType,',',Ident[IdentIndex].AllocElementType); if not (Ident[IdentIndex].DataType in [POINTERTOK, RECORDTOK, OBJECTTOK]) then - iError(i, IllegalExpression); + Error(i, IllegalExpression); if Ident[IdentIndex].DataType = POINTERTOK then VarType := Ident[IdentIndex].AllocElementType @@ -10677,7 +10714,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; begin if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 1, IncompatibleTypeOf, IdentIndex); + Error(i + 1, IncompatibleTypeOf, IdentIndex); if (Ident[IdentIndex].DataType = STRINGPOINTERTOK) and (Ident[IdentIndex].NumAllocElements = 0) then VarType := STRINGPOINTERTOK @@ -10695,7 +10732,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; inc(i); if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 1, IncompatibleTypeOf, IdentIndex); + Error(i + 1, IncompatibleTypeOf, IdentIndex); IndirectionLevel := ASPOINTERTOARRAYORIGIN2; @@ -10717,7 +10754,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Tok[i + 4].Kind = OBRACKETTOK then begin // pp^.field[index] := if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); VarType := Ident[GetIdent(Ident[IdentIndex].Name + '.' + Tok[i + 3].Name)].AllocElementType; par2 := '$' + IntToHex(IdentTemp and $ffff, 2); @@ -10747,7 +10784,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; begin if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 1, IncompatibleTypeOf, IdentIndex); + Error(i + 1, IncompatibleTypeOf, IdentIndex); IndirectionLevel := ASPOINTERTOARRAYORIGIN2; @@ -10811,7 +10848,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Tok[i + 4].Kind = OBRACKETTOK then begin // array_to_record_pointers[x].field[index] := if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); VarType := Ident[GetIdent(Ident[IdentIndex].Name + '.' + Tok[i + 3].Name)].AllocElementType; par2 := '$' + IntToHex(IdentTemp and $ffff, 2); @@ -10940,7 +10977,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; asm65(#9'sta :STACKORIGIN+STACKWIDTH,x'); end else if Ident[IdentIndex].AllocElementType = UNTYPETOK then - iError(i + 1, IncompatibleTypes, IdentIndex, STRINGPOINTERTOK, POINTERTOK) + Error(i + 1, IncompatibleTypes, IdentIndex, STRINGPOINTERTOK, POINTERTOK) else GetCommonType(i + 1, Ident[IdentIndex].AllocElementType, STRINGPOINTERTOK); @@ -11010,10 +11047,10 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; IdentTemp := GetIdentResult(Ident[IdentTemp].ProcAsBlock); {if (Tok[i + 3].Kind <> OBRACKETTOK) and ((Elements(IdentTemp) <> Elements(IdentIndex)) or (Ident[IdentTemp].AllocElementType <> Ident[IdentIndex].AllocElementType)) then - iError(k, IncompatibleTypesArray, GetIdent(Tok[k].Name), ExpressionType ) + Error(k, IncompatibleTypesArray, GetIdent(Tok[k].Name), ExpressionType ) else if (Elements(IdentTemp) > 0) and (Tok[i + 3].Kind <> OBRACKETTOK) then - iError(k, IncompatibleTypesArray, IdentTemp, ExpressionType ) + Error(k, IncompatibleTypesArray, IdentTemp, ExpressionType ) else} if Ident[IdentTemp].AllocElementType = RECORDTOK then @@ -11024,7 +11061,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if ((Ident[IdentTemp].NumAllocElements > 0) {and (Ident[IdentTemp].AllocElementType <> RECORDTOK)}) and ((Ident[IdentIndex].NumAllocElements > 0) {and (Ident[IdentIndex].AllocElementType <> RECORDTOK)}) then - iError(k, IncompatibleTypesArray, IdentTemp, -IdentIndex) + Error(k, IncompatibleTypesArray, IdentTemp, -IdentIndex) else begin @@ -11034,7 +11071,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; (Ident[IdentTemp].DataType = POINTERTOK) and (Ident[IdentTemp].AllocElementType <> UNTYPETOK) and (Ident[IdentTemp].NumAllocElements = 0) then Error(k, 'Incompatible types: got "^'+InfoAboutToken(Ident[IdentTemp].AllocElementType)+'" expected "^' + InfoAboutToken(Ident[IdentIndex].AllocElementType) + '"') else - iError(k, IncompatibleTypesArray, IdentTemp, ExpressionType); + Error(k, IncompatibleTypesArray, IdentTemp, ExpressionType); end; @@ -11088,22 +11125,22 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if (IdentTemp > 0) and (Ident[IdentTemp].Kind = USERTYPE) and (Ident[IdentTemp].DataType = ENUMTYPE) then begin if Ident[IdentIndex].NumAllocElements <> Ident[IdentTemp].NumAllocElements then - iError(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); + Error(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); end else if (IdentTemp > 0) and (Ident[IdentTemp].Kind = ENUMTYPE) then begin if Ident[IdentTemp].NumAllocElements <> Ident[IdentIndex].NumAllocElements then - iError(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); + Error(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); end else if (IdentTemp > 0) and (Ident[IdentTemp].DataType = ENUMTYPE) then begin if Ident[IdentTemp].NumAllocElements <> Ident[IdentIndex].NumAllocElements then - iError(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); + Error(i, IncompatibleEnum, 0, IdentTemp, IdentIndex); end else - iError(i, IncompatibleEnum, 0, -ExpressionType, IdentIndex); + Error(i, IncompatibleEnum, 0, -ExpressionType, IdentIndex); end else begin @@ -11113,7 +11150,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; IdentTemp := 0; if (IdentTemp > 0) and ((Ident[IdentTemp].Kind = ENUMTYPE) or (Ident[IdentTemp].DataType = ENUMTYPE)) then - iError(i, IncompatibleEnum, 0, IdentTemp, -ExpressionType) + Error(i, IncompatibleEnum, 0, IdentTemp, -ExpressionType) else GetCommonType(i + 1, Ident[IdentIndex].DataType, ExpressionType); @@ -11158,7 +11195,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; ADDRESS := true; end; - if Tok[k].Kind <> IDENTTOK then iError(k, IdentifierExpected); + if Tok[k].Kind <> IDENTTOK then Error(k, IdentifierExpected); IdentTemp := GetIdent(Tok[k].Name); @@ -11242,7 +11279,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if IdentTemp > 0 then if Ident[IdentIndex].NumAllocElements <> Ident[IdentTemp].NumAllocElements then // porownanie indeksow do tablicy TYPES -// iError(i, IncompatibleTypeOf, IdentTemp); +// Error(i, IncompatibleTypeOf, IdentTemp); if (Ident[IdentIndex].NumAllocElements = 0) then Error(i, 'Incompatible types: got "' + Types[Ident[IdentTemp].NumAllocElements].Field[0].Name +'" expected "' + InfoAboutToken(Ident[IdentIndex].DataType) + '"') else @@ -11431,7 +11468,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Ident[IdentTemp].AllocElementType <> RECORDTOK then if (j <> integer(Ident[IdentTemp].NumAllocElements * DataSize[Ident[IdentTemp].AllocElementType])) then - iError(i, IncompatibleTypesArray, IdentTemp, -IdentIndex); + Error(i, IncompatibleTypesArray, IdentTemp, -IdentIndex); a65(__subBX); StopOptimization; @@ -11448,7 +11485,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; end else - iError(k, UnknownIdentifier); + Error(k, UnknownIdentifier); end else @@ -11473,11 +11510,11 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Ident[IdentIndex].isOverload then begin if Ident[IdentIndex].NumParams <> j then - iError(i, WrongNumParameters, IdentIndex); + Error(i, WrongNumParameters, IdentIndex); - iError(i, CantDetermine, IdentIndex); + Error(i, CantDetermine, IdentIndex); end else - iError(i, WrongNumParameters, IdentIndex); + Error(i, WrongNumParameters, IdentIndex); IdentIndex := IdentTemp; @@ -11507,7 +11544,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; Error(i, 'Assignment or procedure call expected but ' + Ident[IdentIndex].Name + ' found'); end// case Ident[IdentIndex].Kind else - iError(i, UnknownIdentifier) + Error(i, UnknownIdentifier) end; INFOTOK: @@ -11531,7 +11568,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; ERRORTOK: begin - if Pass = CODEGENERATIONPASS then iError(i, UserDefined); + if Pass = CODEGENERATIONPASS then Error(i, UserDefined); Result := i; end; @@ -11607,7 +11644,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; asm65(#9'jmp '+Ident[IdentIndex].Name); end else - iError(i + 1, UnknownIdentifier); + Error(i + 1, UnknownIdentifier); Result := i + 1; end; @@ -12039,7 +12076,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; FORTOK: begin if Tok[i + 1].Kind <> IDENTTOK then - iError(i + 1, IdentifierExpected) + Error(i + 1, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 1].Name); @@ -12112,7 +12149,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; end; if not (ExpressionType in OrdinalTypes) then - iError(j, OrdinalExpectedFOR); + Error(j, OrdinalExpectedFOR); ActualParamType := ExpressionType; @@ -12175,7 +12212,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; {$ENDIF} if not (ExpressionType in OrdinalTypes) then - iError(j, OrdinalExpectedFOR); + Error(j, OrdinalExpectedFOR); // if DataSize[ExpressionType] > DataSize[Ident[IdentIndex].DataType] then @@ -12362,28 +12399,28 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; end else - iError(i + 1, UnknownIdentifier); + Error(i + 1, UnknownIdentifier); end; end; ASSIGNFILETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; AssignFile'); if not( (Ident[IdentIndex].DataType in [FILETOK, TEXTFILETOK]) or (Ident[IdentIndex].AllocElementType in [FILETOK, TEXTFILETOK]) ) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, COMMATOK); @@ -12420,21 +12457,21 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; RESETTOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; Reset'); if not( (Ident[IdentIndex].DataType in [FILETOK, TEXTFILETOK]) or (Ident[IdentIndex].AllocElementType in [FILETOK, TEXTFILETOK]) ) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); StartOptimization(i + 3); @@ -12470,21 +12507,21 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; REWRITETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; Rewrite'); if not( (Ident[IdentIndex].DataType in [FILETOK, TEXTFILETOK]) or (Ident[IdentIndex].AllocElementType in [FILETOK, TEXTFILETOK]) ) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); StartOptimization(i + 3); @@ -12521,17 +12558,17 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; APPENDTOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; Append'); @@ -12557,19 +12594,19 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; GETRESOURCEHANDLETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); if Ident[IdentIndex].DataType <> POINTERTOK then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, COMMATOK); @@ -12600,19 +12637,19 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; SIZEOFRESOURCETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); if not(Ident[IdentIndex].DataType in IntegerTypes) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, COMMATOK); @@ -12642,21 +12679,21 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; BLOCKREADTOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; BlockRead'); if not((Ident[IdentIndex].DataType = FILETOK) or (Ident[IdentIndex].AllocElementType = FILETOK)) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, COMMATOK); @@ -12672,21 +12709,21 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; BLOCKWRITETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; BlockWrite'); if not((Ident[IdentIndex].DataType = FILETOK) or (Ident[IdentIndex].AllocElementType = FILETOK)) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, COMMATOK); @@ -12701,21 +12738,21 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; CLOSEFILETOK: if Tok[i + 1].Kind <> OPARTOK then - iError(i + 1, OParExpected) + Error(i + 1, OParExpected) else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); // asm65('; CloseFile'); if not( (Ident[IdentIndex].DataType in [FILETOK, TEXTFILETOK]) or (Ident[IdentIndex].AllocElementType in [FILETOK, TEXTFILETOK])) then - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, CPARTOK); @@ -12733,11 +12770,11 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; Result := i; end else - iError(i + 1, OParExpected); + Error(i + 1, OParExpected); end else if Tok[i + 2].Kind <> IDENTTOK then - iError(i + 2, IdentifierExpected) + Error(i + 2, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 2].Name); @@ -12754,7 +12791,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; CheckTok(i + 1, IDENTTOK); if Ident[GetIdent(Tok[i + 1].Name)].DataType <> STRINGPOINTERTOK then - iError(i + 1, VariableExpected); + Error(i + 1, VariableExpected); IdentIndex := GetIdent(Tok[i + 1].Name); @@ -12768,7 +12805,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if IdentIndex > 0 then if (Ident[IdentIndex].Kind <> VARIABLE) {or (Ident[IdentIndex].DataType <> CHARTOK)} then - iError(i + 2, IncompatibleTypeOf, IdentIndex) + Error(i + 2, IncompatibleTypeOf, IdentIndex) else begin // Push(Ident[IdentIndex].Value, ASVALUE, DataSize[CHARTOK]); @@ -12808,14 +12845,14 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; end; end else - iError(i + 2, IncompatibleTypeOf, IdentIndex); + Error(i + 2, IncompatibleTypeOf, IdentIndex); CheckTok(i + 3, CPARTOK); Result := i + 3; end else - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); end; WRITETOK, WRITELNTOK: @@ -12851,7 +12888,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; begin if Ident[GetIdent(Tok[i + 1].Name)].DataType <> STRINGPOINTERTOK then - iError(i + 1, VariableExpected); + Error(i + 1, VariableExpected); asm65(#9'mwy ' + GetLocalName(GetIdent(Tok[i + 1].Name)) +' :bp2'); asm65(#9'ldy #$01'); @@ -13052,7 +13089,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Tok[j].Kind = IDENTTOK then IdentIndex := GetIdent(Tok[j].Name) else - iError(i, CantReadWrite); + Error(i, CantReadWrite); // writeln(Ident[IdentIndex].Name,',',ExpressionType,' | ',Ident[IdentIndex].DataType,',',Ident[IdentIndex].AllocElementType,',',Ident[IdentIndex].NumAllocElements_,',',Ident[IdentIndex].Kind); @@ -13084,7 +13121,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; GenerateWriteString(Tok[i].Value, ASHALFSINGLE) // Half Single argument else if ExpressionType = SINGLETOK then GenerateWriteString(Tok[i].Value, ASSINGLE) // Single argument - else iError(i, CantReadWrite); + else Error(i, CantReadWrite); end else @@ -13094,10 +13131,10 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if (ExpressionType = PCHARTOK) or (Ident[IdentIndex].AllocElementType in [CHARTOK, POINTERTOK]) then GenerateWriteString(Ident[IdentIndex].Value, ASPCHAR, Ident[IdentIndex].DataType) else - iError(i, CantReadWrite); + Error(i, CantReadWrite); end else - iError(i, CantReadWrite); + Error(i, CantReadWrite); END; @@ -13202,7 +13239,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; CheckAssignment(i, IdentIndex); if IdentIndex = 0 then - iError(i, UnknownIdentifier); + Error(i, UnknownIdentifier); if Ident[IdentIndex].Kind = VARIABLE then begin @@ -13229,7 +13266,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; Error(i, 'Left side cannot be assigned to'); end else - iError(i , IdentifierExpected); + Error(i , IdentifierExpected); StartOptimization(i); @@ -13243,7 +13280,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Ident[IdentIndex].AllocElementType = REALTOK then - iError(i, OrdinalExpExpected); + Error(i, OrdinalExpExpected); if not (Ident[IdentIndex].idType in [PCHARTOK]) and (Ident[IdentIndex].DataType in Pointers) and (Ident[IdentIndex].NumAllocElements > 0) and ( not(Ident[IdentIndex].AllocElementType in [RECORDTOK, OBJECTTOK]) ) then begin @@ -13262,9 +13299,9 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; end else if Tok[i + 1].Kind = DEREFERENCETOK then - iError(i + 1, IllegalQualifier) + Error(i + 1, IllegalQualifier) else - iError(i + 1, IncompatibleTypes, IdentIndex, Ident[IdentIndex].DataType, ExpressionType); + Error(i + 1, IncompatibleTypes, IdentIndex, Ident[IdentIndex].DataType, ExpressionType); end else @@ -13286,7 +13323,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; if Tok[i + 1].Kind = DEREFERENCETOK then if Ident[IdentIndex].AllocElementType = 0 then - iError(i + 1, CantAdrConstantExp) + Error(i + 1, CantAdrConstantExp) else begin ExpressionType := Ident[IdentIndex].AllocElementType; @@ -13440,7 +13477,7 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; Error(i, 'Procedures cannot return a value'); if (ActualParamType = STRINGPOINTERTOK) and ((Ident[IdentIndex].DataType = POINTERTOK) and (Ident[IdentIndex].NumAllocElements = 0)) then - iError(i, IncompatibleTypes, 0, ActualParamType, PCHARTOK) + Error(i, IncompatibleTypes, 0, ActualParamType, PCHARTOK) else GetCommonConstType(i, Ident[IdentIndex].DataType, ActualParamType); @@ -13522,10 +13559,10 @@ function CompileStatement(i: Integer; isAsm: Boolean = false): Integer; IdentIndex := GetIdent(Tok[i + 2].Name); if IdentIndex = 0 then - iError(i + 2, UnknownIdentifier); + Error(i + 2, UnknownIdentifier); if not (Ident[IdentIndex].DataType in Pointers) then - iError(i + 2, IncompatibleTypes, 0, Ident[IdentIndex].DataType , POINTERTOK); + Error(i + 2, IncompatibleTypes, 0, Ident[IdentIndex].DataType , POINTERTOK); svar := GetLocalName(IdentIndex); @@ -13991,7 +14028,7 @@ procedure GenerateProcFuncAsmLabels(BlockIdentIndex: integer; VarSize: Boolean = end; if yes then - iError(Ident[IdentIndex].Libraries, UnknownIdentifier, IdentIndex); + Error(Ident[IdentIndex].Libraries, UnknownIdentifier, IdentIndex); HeaFile.Close; @@ -14216,11 +14253,11 @@ procedure SaveData(compile: Boolean = true); if (ConstValType in StringTypes + [CHARTOK, STRINGPOINTERTOK]) and (ActualParamType in IntegerTypes + RealTypes) then - iError(i, IllegalExpression); + Error(i, IllegalExpression); if (ConstValType in StringTypes + [STRINGPOINTERTOK]) and (ActualParamType = CHARTOK) then - iError(i, IncompatibleTypes, 0, ActualParamType, ConstValType); + Error(i, IncompatibleTypes, 0, ActualParamType, ConstValType); if (ConstValType in [SINGLETOK, HALFSINGLETOK]) and (ActualParamType = REALTOK) then @@ -14323,7 +14360,7 @@ procedure SaveData(compile: Boolean = true); end else //SaveData; if Tok[i + 1].Kind = EVALTOK then - NumActualParams := doEvaluate + NumActualParams := doEvaluate(evaluationContext) else SaveData; @@ -14405,11 +14442,11 @@ procedure SaveData(compile: Boolean = true); if (ConstValType in StringTypes + [CHARTOK, STRINGPOINTERTOK]) and (ActualParamType in IntegerTypes + RealTypes) then - iError(i, IllegalExpression); + Error(i, IllegalExpression); if (ConstValType in StringTypes + [STRINGPOINTERTOK]) and (ActualParamType = CHARTOK) then - iError(i, IncompatibleTypes, 0, ActualParamType, ConstValType); + Error(i, IncompatibleTypes, 0, ActualParamType, ConstValType); if (ConstValType in [SINGLETOK, HALFSINGLETOK]) and (ActualParamType = REALTOK) then @@ -14490,7 +14527,7 @@ procedure SaveData(compile: Boolean = true); repeat if Tok[i + 1].Kind = EVALTOK then - doEvaluate + doEvaluate(evaluationContext) else SaveData; @@ -14636,7 +14673,7 @@ procedure FormalParameterList(var i: integer; var NumParams: integer; var Param: Inc(NumParams); if NumParams > MAXPARAMS then - iError(i, TooManyParameters, NumIdent) + Error(i, TooManyParameters, NumIdent) else begin // VarOfSameType[VarOfSameTypeIndex].DataType := VarType; @@ -15379,7 +15416,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; if Tok[i].Kind = ERRORTOK then begin - if Pass = CODEGENERATIONPASS then iError(i, UserDefined); + if Pass = CODEGENERATIONPASS then Error(i, UserDefined); inc(i, 2); end; @@ -15486,7 +15523,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; IdentIndex := GetIdent(Tok[i].Name); if IdentIndex = 0 then - iError(i, UnknownIdentifier); + Error(i, UnknownIdentifier); if Ident[IdentIndex].isInline then Error(i, 'INLINE is not allowed to exports'); @@ -15770,7 +15807,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; end else if (ConstValType in Pointers) then - iError(j, IllegalExpression) + Error(j, IllegalExpression) else DefineIdent(i + 1, Tok[i + 1].Name, CONSTANT, ConstValType, 0, 0, ConstVal, Tok[j].Kind); @@ -15816,7 +15853,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; if (VarType in Pointers) and (NumAllocElements = 0) then - if AllocElementType <> CHARTOK then iError(j, IllegalExpression); + if AllocElementType <> CHARTOK then Error(j, IllegalExpression); CheckTok(j + 1, EQTOK); @@ -15837,7 +15874,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; DefineIdent(i + 1, Tok[i + 1].Name, CONSTANT, VarType, NumAllocElements, AllocElementType, NumStaticStrChars + CODEORIGIN + CODEORIGIN_BASE, IDENTTOK); if (Ident[NumIdent].NumAllocElements in [0,1]) and (open_array = false) then - iError(i, IllegalExpression) + Error(i, IllegalExpression) else if open_array then begin // const array of type = [ ] @@ -16334,7 +16371,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; if Tok[i].Kind = ADDRESSTOK then begin if Tok[i + 1].Kind <> IDENTTOK then - iError(i + 1, IdentifierExpected) + Error(i + 1, IdentifierExpected) else begin IdentIndex := GetIdent(Tok[i + 1].Name); @@ -16343,7 +16380,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; if (Ident[IdentIndex].Kind = CONSTANT) then begin if not ( (Ident[IdentIndex].DataType in Pointers) and (Ident[IdentIndex].NumAllocElements > 0) ) then - iError(i + 1, CantAdrConstantExp) + Error(i + 1, CantAdrConstantExp) else SaveToDataSegment(idx, Ident[IdentIndex].Value - CODEORIGIN - CODEORIGIN_BASE, CODEORIGINOFFSET); @@ -16353,7 +16390,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; VarType := POINTERTOK; end else - iError(i + 1, UnknownIdentifier); + Error(i + 1, UnknownIdentifier); end; @@ -16412,7 +16449,7 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer; } if (Ident[NumIdent].NumAllocElements in [0,1]) and (open_array = false) then - iError(i, IllegalExpression) + Error(i, IllegalExpression) else if open_array then begin // array of type = [ ] diff --git a/src/targets/parse_param.inc b/src/targets/parse_param.inc index 6f6a9d0aa..2f3ada29a 100644 --- a/src/targets/parse_param.inc +++ b/src/targets/parse_param.inc @@ -4,4 +4,4 @@ if t = 'A8' then target.id := ___a8 else if t = 'RAW' then target.id := ___raw else if t = 'NEO' then target.id := ___neo else if t = 'X16' then target.id := ___x16 else - Syntax(3); + Syntax(THaltException.COMPILING_NOT_STARTED); diff --git a/test/HOWTO-test.txt b/test/HOWTO-test.txt index e8b81c9e1..3956fcf66 100644 --- a/test/HOWTO-test.txt +++ b/test/HOWTO-test.txt @@ -1,4 +1,8 @@ -1. create config.ini based on config_example.ini, update with your paths -2. enter to py65emu dir and install (python setup.py install) -3. install pytest (pip install -U pytest) -4. run all tests from this directory (pytest) +1. Open a command shell +2. Enter "pip install setuptools" to install the Pytho setup tools. +1. Copy the template "config_example.ini" to "config.ini" and it update with your actual paths. +2. Open a command shell in the "py65emu" folder and enter"python setup.py install" + Note: This won't work when using Python installed for all users on Windows + There enter "python setup.py install --user" instead to install for you user only. +3. Enter "pip install -U pytest" to install the Physon test suite for your user only. +4. Enter "pytest" to un all tests from in directory.