paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 14:09:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* '1.' is now parsed as a real

Browse Source
This commit is contained in:
peter 1999-04-01 22:05:59 +00:00
parent 11fee238d9
commit e0e2e44849
1 changed files with 431 additions and 373 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

804
compiler/scanner.pas
View File

@ -66,9 +66,9 @@ unit scanner;
lastlinepos : longint; lastlinepos : longint;
lasttokenpos : longint; { token } lasttokenpos : longint; { token }
lasttoken : ttoken; lasttoken,
nexttoken : ttoken;
do_special, { 1=point after nr, 2=caret after id }
comment_level, comment_level,
yylexcount : longint; yylexcount : longint;
lastasmgetchar : char; lastasmgetchar : char;
@ -216,13 +216,13 @@ implementation
{ reset scanner } { reset scanner }
preprocstack:=nil; preprocstack:=nil;
comment_level:=0; comment_level:=0;
do_special:=0;
yylexcount:=0; yylexcount:=0;
block_type:=bt_general; block_type:=bt_general;
line_no:=0; line_no:=0;
lastlinepos:=0; lastlinepos:=0;
lasttokenpos:=0; lasttokenpos:=0;
lasttoken:=_END; lasttoken:=NOTOKEN;
nexttoken:=NOTOKEN;
lastasmgetchar:=#0; lastasmgetchar:=#0;
invalid:=false; invalid:=false;
{ load block } { load block }
@ -995,52 +995,34 @@ implementation
end; end;
end; end;
procedure tscannerfile.readtoken; procedure tscannerfile.readtoken;
var var
code : integer; code : integer;
low,high,mid, low,high,mid : longint;
l : {$ifdef TP} word; {$else} longint; {$endif}
m : longint; m : longint;
mac : pmacrosym; mac : pmacrosym;
asciinr : string[3]; asciinr : string[3];
label label
exit_label; exit_label;
begin begin
{ was the last character a point ? } { was there already a token read, then return that token }
{ this code is needed because the scanner if there is a 1. found if } if nexttoken<>NOTOKEN then
{ this is a floating point number or range like 1..3 } begin
if do_special>0 then token:=nexttoken;
begin nexttoken:=NOTOKEN;
gettokenpos; goto exit_label;
l:=do_special; end;
do_special:=0;
case l of
1 : begin { first char was a point }
case c of
'.' : begin
readchar;
token:=POINTPOINT;
goto exit_label;
end;
')' : begin
readchar;
token:=RECKKLAMMER;
goto exit_label;
end;
end;
token:=POINT;
goto exit_label;
end;
end;
end;
{ Skip all spaces and comments } { Skip all spaces and comments }
repeat repeat
case c of case c of
'{' : skipcomment; '{' :
' ',#9..#13 : skipspace; skipcomment;
else ' ',#9..#13 :
break; skipspace;
else
break;
end; end;
until false; until false;
@ -1105,350 +1087,423 @@ implementation
begin begin
idtoken:=NOID; idtoken:=NOID;
case c of case c of
'$' : begin
readnumber; '$' :
token:=INTCONST; begin
goto exit_label; readnumber;
token:=INTCONST;
goto exit_label;
end;
'%' :
begin
readnumber;
token:=INTCONST;
goto exit_label;
end;
'0'..'9' :
begin
readnumber;
if (c in ['.','e','E']) then
begin
{ first check for a . }
if c='.' then
begin
readchar;
{ is it a .. from a range? }
case c of
'.' :
begin
readchar;
token:=INTCONST;
nexttoken:=POINTPOINT;
goto exit_label;
end;
')' :
begin
readchar;
token:=INTCONST;
nexttoken:=RECKKLAMMER;
goto exit_label;
end;
end;
{ insert the number after the . }
pattern:=pattern+'.';
while c in ['0'..'9'] do
begin
pattern:=pattern+c;
readchar;
end;
end; end;
'%' : begin { E can also follow after a point is scanned }
readnumber; if c in ['e','E'] then
token:=INTCONST; begin
goto exit_label; pattern:=pattern+'E';
end; readchar;
'0'..'9' : begin if c in ['-','+'] then
readnumber; begin
if (c in ['.','e','E']) then pattern:=pattern+c;
begin readchar;
{ first check for a . } end;
if c='.' then if not(c in ['0'..'9']) then
begin Message(scan_f_illegal_char);
readchar; while c in ['0'..'9'] do
if not(c in ['0'..'9']) then begin
pattern:=pattern+c;
readchar;
end;
end;
token:=REALNUMBER;
goto exit_label;
end;
token:=INTCONST;
goto exit_label;
end;
';' :
begin
readchar;
token:=SEMICOLON;
goto exit_label;
end;
'[' :
begin
readchar;
token:=LECKKLAMMER;
goto exit_label;
end;
']' :
begin
readchar;
token:=RECKKLAMMER;
goto exit_label;
end;
'(' :
begin
readchar;
case c of
'*' :
begin
skipoldtpcomment;
readtoken;
exit;
end;
'.' :
begin
readchar;
token:=LECKKLAMMER;
goto exit_label;
end;
end;
token:=LKLAMMER;
goto exit_label;
end;
')' :
begin
readchar;
token:=RKLAMMER;
goto exit_label;
end;
'+' :
begin
readchar;
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
begin
readchar;
token:=_PLUSASN;
goto exit_label;
end;
token:=PLUS;
goto exit_label;
end;
'-' :
begin
readchar;
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
begin
readchar;
token:=_MINUSASN;
goto exit_label;
end;
token:=MINUS;
goto exit_label;
end;
':' :
begin
readchar;
if c='=' then
begin
readchar;
token:=ASSIGNMENT;
goto exit_label;
end;
token:=COLON;
goto exit_label;
end;
'*' :
begin
readchar;
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
begin
readchar;
token:=_STARASN;
end
else
if c='*' then
begin
readchar;
token:=STARSTAR;
end
else
token:=STAR;
goto exit_label;
end;
'/' :
begin
readchar;
case c of
'=' :
begin
if (cs_support_c_operators in aktmoduleswitches) then
begin
readchar;
token:=_SLASHASN;
goto exit_label;
end;
end;
'/' :
begin
skipdelphicomment;
readtoken;
exit;
end;
'*' :
begin
skipccomment;
readtoken;
exit;
end;
end;
token:=SLASH;
goto exit_label;
end;
'=' :
begin
readchar;
token:=EQUAL;
goto exit_label;
end;
'.' :
begin
readchar;
case c of
'.' :
begin
readchar;
token:=POINTPOINT;
goto exit_label;
end;
')' :
begin
readchar;
token:=RECKKLAMMER;
goto exit_label;
end;
end;
token:=POINT;
goto exit_label;
end;
'@' :
begin
readchar;
if c='@' then
begin
readchar;
token:=DOUBLEADDR;
end
else
token:=KLAMMERAFFE;
goto exit_label;
end;
',' :
begin
readchar;
token:=COMMA;
goto exit_label;
end;
'''','#','^' :
begin
if c='^' then
begin
readchar;
c:=upcase(c);
if (block_type=bt_type) or
(lasttoken=ID) or
(lasttoken=RKLAMMER) or (lasttoken=RECKKLAMMER) or (lasttoken=CARET) then
begin
token:=CARET;
goto exit_label;
end
else
begin
if c<#64 then
pattern:=chr(ord(c)+64)
else
pattern:=chr(ord(c)-64);
readchar;
end;
end
else
pattern:='';
repeat
case c of
'#' :
begin
readchar; { read # }
if c='$' then
begin
readchar; { read leading $ }
asciinr:='$';
while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<3) do
begin begin
do_special:=1; asciinr:=asciinr+c;
token:=INTCONST; readchar;
goto exit_label;
end; end;
pattern:=pattern+'.'; end
while c in ['0'..'9'] do else
begin
asciinr:='';
while (c in ['0'..'9']) and (length(asciinr)<3) do
begin begin
pattern:=pattern+c; asciinr:=asciinr+c;
readchar; readchar;
end; end;
end; end;
{ E can also follow after a point is scanned } valint(asciinr,m,code);
if c in ['e','E'] then if (asciinr='') or (code<>0) or
begin (m<0) or (m>255) then
pattern:=pattern+'E'; Message(scan_e_illegal_char_const);
readchar; pattern:=pattern+chr(m);
if c in ['-','+'] then end;
'''' :
begin
repeat
readchar;
case c of
#26 :
Message(scan_f_end_of_file);
newline :
Message(scan_f_string_exceeds_line);
'''' :
begin begin
pattern:=pattern+c;
readchar; readchar;
if c<>'''' then
break;
end; end;
if not(c in ['0'..'9']) then end;
Message(scan_f_illegal_char); pattern:=pattern+c;
while c in ['0'..'9'] do until false;
begin end;
pattern:=pattern+c; '^' :
readchar; begin
end; readchar;
end; if c<#64 then
token:=REALNUMBER; c:=chr(ord(c)+64)
goto exit_label; else
end; c:=chr(ord(c)-64);
token:=INTCONST; pattern:=pattern+c;
goto exit_label; readchar;
end; end;
';' : begin else
readchar; break;
token:=SEMICOLON; end;
goto exit_label; until false;
end; { strings with length 1 become const chars }
'[' : begin if length(pattern)=1 then
readchar; token:=CCHAR
token:=LECKKLAMMER; else
goto exit_label; token:=CSTRING;
end; goto exit_label;
']' : begin end;
readchar;
token:=RECKKLAMMER; '>' :
goto exit_label; begin
end; readchar;
'(' : begin case c of
readchar; '=' :
case c of begin
'*' : begin readchar;
skipoldtpcomment; token:=GTE;
readtoken; goto exit_label;
exit; end;
end; '>' :
'.' : begin begin
readchar; readchar;
token:=LECKKLAMMER; token:=_SHR;
goto exit_label; goto exit_label;
end; end;
end; '<' :
token:=LKLAMMER; begin { >< is for a symetric diff for sets }
goto exit_label; readchar;
end; token:=SYMDIF;
')' : begin goto exit_label;
readchar; end;
token:=RKLAMMER; end;
goto exit_label; token:=GT;
end; goto exit_label;
'+' : begin end;
readchar;
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then '<' :
begin begin
readchar; readchar;
token:=_PLUSASN; case c of
goto exit_label; '>' :
end; begin
token:=PLUS; readchar;
goto exit_label; token:=UNEQUAL;
end; goto exit_label;
'-' : begin end;
readchar; '=' :
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then begin
begin readchar;
readchar; token:=LTE;
token:=_MINUSASN; goto exit_label;
goto exit_label; end;
end; '<' :
token:=MINUS; begin
goto exit_label; readchar;
end; token:=_SHL;
':' : begin goto exit_label;
readchar; end;
if c='=' then end;
begin token:=LT;
readchar; goto exit_label;
token:=ASSIGNMENT; end;
goto exit_label;
end; #26 :
token:=COLON; begin
goto exit_label; token:=_EOF;
end; goto exit_label;
'*' : begin end;
readchar; else
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then begin
begin Message(scan_f_illegal_char);
readchar; end;
token:=_STARASN;
end
else
if c='*' then
begin
readchar;
token:=STARSTAR;
end
else
token:=STAR;
goto exit_label;
end;
'/' : begin
readchar;
case c of
'=' : begin
if (cs_support_c_operators in aktmoduleswitches) then
begin
readchar;
token:=_SLASHASN;
goto exit_label;
end;
end;
'/' : begin
skipdelphicomment;
readtoken;
exit;
end;
'*' : begin
skipccomment;
readtoken;
exit;
end;
end;
token:=SLASH;
goto exit_label;
end;
'=' : begin
readchar;
token:=EQUAL;
goto exit_label;
end;
'.' : begin
readchar;
case c of
'.' : begin
readchar;
token:=POINTPOINT;
goto exit_label;
end;
')' : begin
readchar;
token:=RECKKLAMMER;
goto exit_label;
end;
end;
token:=POINT;
goto exit_label;
end;
'@' : begin
readchar;
if c='@' then
begin
readchar;
token:=DOUBLEADDR;
end
else
token:=KLAMMERAFFE;
goto exit_label;
end;
',' : begin
readchar;
token:=COMMA;
goto exit_label;
end;
'''','#','^' : begin
if c='^' then
begin
readchar;
c:=upcase(c);
if (block_type=bt_type) or
(lasttoken=ID) or
(lasttoken=RKLAMMER) or (lasttoken=RECKKLAMMER) or (lasttoken=CARET) then
begin
token:=CARET;
goto exit_label;
end
else
begin
if c<#64 then
pattern:=chr(ord(c)+64)
else
pattern:=chr(ord(c)-64);
readchar;
end;
end
else
pattern:='';
repeat
case c of
'#' : begin
readchar; { read # }
if c='$' then
begin
readchar; { read leading $ }
asciinr:='$';
while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<3) do
begin
asciinr:=asciinr+c;
readchar;
end;
end
else
begin
asciinr:='';
while (c in ['0'..'9']) and (length(asciinr)<3) do
begin
asciinr:=asciinr+c;
readchar;
end;
end;
valint(asciinr,m,code);
if (asciinr='') or (code<>0) or
(m<0) or (m>255) then
Message(scan_e_illegal_char_const);
pattern:=pattern+chr(m);
end;
'''' : begin
repeat
readchar;
case c of
#26 : Message(scan_f_end_of_file);
newline : Message(scan_f_string_exceeds_line);
'''' : begin
readchar;
if c<>'''' then
break;
end;
end;
pattern:=pattern+c;
until false;
end;
'^' : begin
readchar;
if c<#64 then
c:=chr(ord(c)+64)
else
c:=chr(ord(c)-64);
pattern:=pattern+c;
readchar;
end;
else
break;
end;
until false;
{ strings with length 1 become const chars }
if length(pattern)=1 then
token:=CCHAR
else
token:=CSTRING;
goto exit_label;
end;
'>' : begin
readchar;
case c of
'=' : begin
readchar;
token:=GTE;
goto exit_label;
end;
'>' : begin
readchar;
token:=_SHR;
goto exit_label;
end;
'<' : begin { >< is for a symetric diff for sets }
readchar;
token:=SYMDIF;
goto exit_label;
end;
end;
token:=GT;
goto exit_label;
end;
'<' : begin
readchar;
case c of
'>' : begin
readchar;
token:=UNEQUAL;
goto exit_label;
end;
'=' : begin
readchar;
token:=LTE;
goto exit_label;
end;
'<' : begin
readchar;
token:=_SHL;
goto exit_label;
end;
end;
token:=LT;
goto exit_label;
end;
#26 : begin
token:=_EOF;
goto exit_label;
end;
else
begin
Message(scan_f_illegal_char);
end;
end; end;
end; end;
exit_label: exit_label:
@ -1582,7 +1637,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.78 1999-03-26 19:10:06 peter Revision 1.79 1999-04-01 22:05:59 peter
* '1.' is now parsed as a real
Revision 1.78 1999/03/26 19:10:06 peter
* support also ^^ * support also ^^
Revision 1.77 1999/03/26 00:05:45 peter Revision 1.77 1999/03/26 00:05:45 peter