mirror of
https://github.com/nim-lang/Nim.git
synced 2026-01-01 19:02:18 +00:00
739 lines
20 KiB
ObjectPascal
739 lines
20 KiB
ObjectPascal
//
|
|
//
|
|
// The Nimrod Compiler
|
|
// (c) Copyright 2009 Andreas Rumpf
|
|
//
|
|
// See the file "copying.txt", included in this
|
|
// distribution, for details about the copyright.
|
|
//
|
|
unit paslex;
|
|
|
|
// This module implements a FreePascal scanner. This is a adaption from
|
|
// the scanner module.
|
|
|
|
interface
|
|
|
|
{$include 'config.inc'}
|
|
|
|
uses
|
|
charsets, nsystem, sysutils,
|
|
nhashes, options, msgs, strutils, platform, idents,
|
|
lexbase, wordrecg, scanner;
|
|
|
|
const
|
|
MaxLineLength = 80; // lines longer than this lead to a warning
|
|
|
|
numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; // we support up to base 36
|
|
SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255];
|
|
SymStartChars: TCharSet = ['a'..'z', 'A'..'Z', #128..#255];
|
|
OpChars: TCharSet = ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.',
|
|
'|', '=', ':', '%', '&', '$', '@', '~', #128..#255];
|
|
|
|
type
|
|
// order is important for TPasTokKind
|
|
TPasTokKind = (pxInvalid, pxEof,
|
|
// keywords:
|
|
//[[[cog
|
|
//from string import capitalize
|
|
//keywords = eval(open("data/pas_keyw.yml").read())
|
|
//idents = ""
|
|
//strings = ""
|
|
//i = 1
|
|
//for k in keywords:
|
|
// idents = idents + "px" + capitalize(k) + ", "
|
|
// strings = strings + "'" + k + "', "
|
|
// if i % 4 == 0:
|
|
// idents = idents + "\n"
|
|
// strings = strings + "\n"
|
|
// i = i + 1
|
|
//cog.out(idents)
|
|
//]]]
|
|
pxAnd, pxArray, pxAs, pxAsm,
|
|
pxBegin, pxCase, pxClass, pxConst,
|
|
pxConstructor, pxDestructor, pxDiv, pxDo,
|
|
pxDownto, pxElse, pxEnd, pxExcept,
|
|
pxExports, pxFinalization, pxFinally, pxFor,
|
|
pxFunction, pxGoto, pxIf, pxImplementation,
|
|
pxIn, pxInherited, pxInitialization, pxInline,
|
|
pxInterface, pxIs, pxLabel, pxLibrary,
|
|
pxMod, pxNil, pxNot, pxObject,
|
|
pxOf, pxOr, pxOut, pxPacked,
|
|
pxProcedure, pxProgram, pxProperty, pxRaise,
|
|
pxRecord, pxRepeat, pxResourcestring, pxSet,
|
|
pxShl, pxShr, pxThen, pxThreadvar,
|
|
pxTo, pxTry, pxType, pxUnit,
|
|
pxUntil, pxUses, pxVar, pxWhile,
|
|
pxWith, pxXor,
|
|
//[[[end]]]
|
|
pxComment, // ordinary comment
|
|
pxCommand, // {@}
|
|
pxAmp, // {&}
|
|
pxPer, // {%}
|
|
pxStrLit,
|
|
pxSymbol, // a symbol
|
|
|
|
pxIntLit,
|
|
pxInt64Lit, // long constant like 0x00000070fffffff or out of int range
|
|
pxFloatLit,
|
|
|
|
pxParLe, pxParRi, pxBracketLe, pxBracketRi,
|
|
pxComma, pxSemiColon, pxColon,
|
|
|
|
// operators
|
|
pxAsgn,
|
|
pxEquals, pxDot, pxDotDot, pxHat, pxPlus, pxMinus, pxStar, pxSlash,
|
|
pxLe, pxLt, pxGe, pxGt, pxNeq, pxAt,
|
|
|
|
pxStarDirLe,
|
|
pxStarDirRi,
|
|
pxCurlyDirLe,
|
|
pxCurlyDirRi
|
|
);
|
|
TPasTokKinds = set of TPasTokKind;
|
|
const
|
|
PasTokKindToStr: array [TPasTokKind] of string = (
|
|
'pxInvalid', '[EOF]',
|
|
//[[[cog
|
|
//cog.out(strings)
|
|
//]]]
|
|
'and', 'array', 'as', 'asm',
|
|
'begin', 'case', 'class', 'const',
|
|
'constructor', 'destructor', 'div', 'do',
|
|
'downto', 'else', 'end', 'except',
|
|
'exports', 'finalization', 'finally', 'for',
|
|
'function', 'goto', 'if', 'implementation',
|
|
'in', 'inherited', 'initialization', 'inline',
|
|
'interface', 'is', 'label', 'library',
|
|
'mod', 'nil', 'not', 'object',
|
|
'of', 'or', 'out', 'packed',
|
|
'procedure', 'program', 'property', 'raise',
|
|
'record', 'repeat', 'resourcestring', 'set',
|
|
'shl', 'shr', 'then', 'threadvar',
|
|
'to', 'try', 'type', 'unit',
|
|
'until', 'uses', 'var', 'while',
|
|
'with', 'xor',
|
|
//[[[end]]]
|
|
'pxComment', 'pxCommand',
|
|
'{&}', '{%}', 'pxStrLit', '[IDENTIFIER]', 'pxIntLit', 'pxInt64Lit',
|
|
'pxFloatLit',
|
|
'('+'', ')'+'', '['+'', ']'+'',
|
|
','+'', ';'+'', ':'+'',
|
|
':=', '='+'', '.'+'', '..', '^'+'', '+'+'', '-'+'', '*'+'', '/'+'',
|
|
'<=', '<'+'', '>=', '>'+'', '<>', '@'+'', '(*$', '*)', '{$', '}'+''
|
|
);
|
|
|
|
type
|
|
TPasTok = object(TToken) // a Pascal token
|
|
xkind: TPasTokKind; // the type of the token
|
|
end;
|
|
|
|
TPasLex = object(TLexer)
|
|
end;
|
|
|
|
procedure getPasTok(var L: TPasLex; out tok: TPasTok);
|
|
|
|
procedure PrintPasTok(const tok: TPasTok);
|
|
function pasTokToStr(const tok: TPasTok): string;
|
|
|
|
implementation
|
|
|
|
function pastokToStr(const tok: TPasTok): string;
|
|
begin
|
|
case tok.xkind of
|
|
pxIntLit, pxInt64Lit:
|
|
result := toString(tok.iNumber);
|
|
pxFloatLit:
|
|
result := toStringF(tok.fNumber);
|
|
pxInvalid, pxComment..pxStrLit:
|
|
result := tok.literal;
|
|
else if (tok.ident.s <> '') then
|
|
result := tok.ident.s
|
|
else
|
|
result := pasTokKindToStr[tok.xkind];
|
|
end
|
|
end;
|
|
|
|
procedure PrintPasTok(const tok: TPasTok);
|
|
begin
|
|
write(output, pasTokKindToStr[tok.xkind]);
|
|
write(output, ' ');
|
|
writeln(output, pastokToStr(tok))
|
|
end;
|
|
|
|
// ----------------------------------------------------------------------------
|
|
|
|
procedure setKeyword(var L: TPasLex; var tok: TPasTok);
|
|
begin
|
|
case tok.ident.id of
|
|
//[[[cog
|
|
//for k in keywords:
|
|
// m = capitalize(k)
|
|
// cog.outl("ord(w%s):%s tok.xkind := px%s;" % (m, ' '*(18-len(m)), m))
|
|
//]]]
|
|
ord(wAnd): tok.xkind := pxAnd;
|
|
ord(wArray): tok.xkind := pxArray;
|
|
ord(wAs): tok.xkind := pxAs;
|
|
ord(wAsm): tok.xkind := pxAsm;
|
|
ord(wBegin): tok.xkind := pxBegin;
|
|
ord(wCase): tok.xkind := pxCase;
|
|
ord(wClass): tok.xkind := pxClass;
|
|
ord(wConst): tok.xkind := pxConst;
|
|
ord(wConstructor): tok.xkind := pxConstructor;
|
|
ord(wDestructor): tok.xkind := pxDestructor;
|
|
ord(wDiv): tok.xkind := pxDiv;
|
|
ord(wDo): tok.xkind := pxDo;
|
|
ord(wDownto): tok.xkind := pxDownto;
|
|
ord(wElse): tok.xkind := pxElse;
|
|
ord(wEnd): tok.xkind := pxEnd;
|
|
ord(wExcept): tok.xkind := pxExcept;
|
|
ord(wExports): tok.xkind := pxExports;
|
|
ord(wFinalization): tok.xkind := pxFinalization;
|
|
ord(wFinally): tok.xkind := pxFinally;
|
|
ord(wFor): tok.xkind := pxFor;
|
|
ord(wFunction): tok.xkind := pxFunction;
|
|
ord(wGoto): tok.xkind := pxGoto;
|
|
ord(wIf): tok.xkind := pxIf;
|
|
ord(wImplementation): tok.xkind := pxImplementation;
|
|
ord(wIn): tok.xkind := pxIn;
|
|
ord(wInherited): tok.xkind := pxInherited;
|
|
ord(wInitialization): tok.xkind := pxInitialization;
|
|
ord(wInline): tok.xkind := pxInline;
|
|
ord(wInterface): tok.xkind := pxInterface;
|
|
ord(wIs): tok.xkind := pxIs;
|
|
ord(wLabel): tok.xkind := pxLabel;
|
|
ord(wLibrary): tok.xkind := pxLibrary;
|
|
ord(wMod): tok.xkind := pxMod;
|
|
ord(wNil): tok.xkind := pxNil;
|
|
ord(wNot): tok.xkind := pxNot;
|
|
ord(wObject): tok.xkind := pxObject;
|
|
ord(wOf): tok.xkind := pxOf;
|
|
ord(wOr): tok.xkind := pxOr;
|
|
ord(wOut): tok.xkind := pxOut;
|
|
ord(wPacked): tok.xkind := pxPacked;
|
|
ord(wProcedure): tok.xkind := pxProcedure;
|
|
ord(wProgram): tok.xkind := pxProgram;
|
|
ord(wProperty): tok.xkind := pxProperty;
|
|
ord(wRaise): tok.xkind := pxRaise;
|
|
ord(wRecord): tok.xkind := pxRecord;
|
|
ord(wRepeat): tok.xkind := pxRepeat;
|
|
ord(wResourcestring): tok.xkind := pxResourcestring;
|
|
ord(wSet): tok.xkind := pxSet;
|
|
ord(wShl): tok.xkind := pxShl;
|
|
ord(wShr): tok.xkind := pxShr;
|
|
ord(wThen): tok.xkind := pxThen;
|
|
ord(wThreadvar): tok.xkind := pxThreadvar;
|
|
ord(wTo): tok.xkind := pxTo;
|
|
ord(wTry): tok.xkind := pxTry;
|
|
ord(wType): tok.xkind := pxType;
|
|
ord(wUnit): tok.xkind := pxUnit;
|
|
ord(wUntil): tok.xkind := pxUntil;
|
|
ord(wUses): tok.xkind := pxUses;
|
|
ord(wVar): tok.xkind := pxVar;
|
|
ord(wWhile): tok.xkind := pxWhile;
|
|
ord(wWith): tok.xkind := pxWith;
|
|
ord(wXor): tok.xkind := pxXor;
|
|
//[[[end]]]
|
|
else tok.xkind := pxSymbol
|
|
end
|
|
end;
|
|
|
|
|
|
// ----------------------------------------------------------------------------
|
|
|
|
procedure matchUnderscoreChars(var L: TPasLex; var tok: TPasTok;
|
|
const chars: TCharSet);
|
|
// matches ([chars]_)*
|
|
var
|
|
pos: int;
|
|
buf: PChar;
|
|
begin
|
|
pos := L.bufpos; // use registers for pos, buf
|
|
buf := L.buf;
|
|
repeat
|
|
if buf[pos] in chars then begin
|
|
addChar(tok.literal, buf[pos]);
|
|
Inc(pos)
|
|
end
|
|
else break;
|
|
if buf[pos] = '_' then begin
|
|
addChar(tok.literal, '_');
|
|
Inc(pos);
|
|
end;
|
|
until false;
|
|
L.bufPos := pos;
|
|
end;
|
|
|
|
function isFloatLiteral(const s: string): boolean;
|
|
var
|
|
i: int;
|
|
begin
|
|
for i := strStart to length(s)+strStart-1 do
|
|
if s[i] in ['.','e','E'] then begin
|
|
result := true; exit
|
|
end;
|
|
result := false
|
|
end;
|
|
|
|
procedure getNumber2(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
pos, bits: int;
|
|
xi: biggestInt;
|
|
begin
|
|
pos := L.bufpos+1; // skip %
|
|
if not (L.buf[pos] in ['0'..'1']) then begin // BUGFIX for %date%
|
|
tok.xkind := pxInvalid;
|
|
addChar(tok.literal, '%');
|
|
inc(L.bufpos);
|
|
exit;
|
|
end;
|
|
|
|
tok.base := base2;
|
|
xi := 0;
|
|
bits := 0;
|
|
while true do begin
|
|
case L.buf[pos] of
|
|
'A'..'Z', 'a'..'z', '2'..'9', '.': begin
|
|
lexMessage(L, errInvalidNumber);
|
|
inc(pos)
|
|
end;
|
|
'_': inc(pos);
|
|
'0', '1': begin
|
|
xi := shlu(xi, 1) or (ord(L.buf[pos]) - ord('0'));
|
|
inc(pos);
|
|
inc(bits);
|
|
end;
|
|
else break;
|
|
end
|
|
end;
|
|
tok.iNumber := xi;
|
|
if (bits > 32) then //or (xi < low(int32)) or (xi > high(int32)) then
|
|
tok.xkind := pxInt64Lit
|
|
else
|
|
tok.xkind := pxIntLit;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure getNumber16(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
pos, bits: int;
|
|
xi: biggestInt;
|
|
begin
|
|
pos := L.bufpos+1; // skip $
|
|
tok.base := base16;
|
|
xi := 0;
|
|
bits := 0;
|
|
while true do begin
|
|
case L.buf[pos] of
|
|
'G'..'Z', 'g'..'z', '.': begin
|
|
lexMessage(L, errInvalidNumber);
|
|
inc(pos);
|
|
end;
|
|
'_': inc(pos);
|
|
'0'..'9': begin
|
|
xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('0'));
|
|
inc(pos);
|
|
inc(bits, 4);
|
|
end;
|
|
'a'..'f': begin
|
|
xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10);
|
|
inc(pos);
|
|
inc(bits, 4);
|
|
end;
|
|
'A'..'F': begin
|
|
xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10);
|
|
inc(pos);
|
|
inc(bits, 4);
|
|
end;
|
|
else break;
|
|
end
|
|
end;
|
|
tok.iNumber := xi;
|
|
if (bits > 32) then // (xi < low(int32)) or (xi > high(int32)) then
|
|
tok.xkind := pxInt64Lit
|
|
else
|
|
tok.xkind := pxIntLit;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure getNumber10(var L: TPasLex; var tok: TPasTok);
|
|
begin
|
|
tok.base := base10;
|
|
matchUnderscoreChars(L, tok, ['0'..'9']);
|
|
if (L.buf[L.bufpos] = '.') and (L.buf[L.bufpos+1] in ['0'..'9']) then begin
|
|
addChar(tok.literal, '.');
|
|
inc(L.bufpos);
|
|
matchUnderscoreChars(L, tok, ['e', 'E', '+', '-', '0'..'9'])
|
|
end;
|
|
try
|
|
if isFloatLiteral(tok.literal) then begin
|
|
tok.fnumber := parseFloat(tok.literal);
|
|
tok.xkind := pxFloatLit;
|
|
end
|
|
else begin
|
|
tok.iNumber := ParseInt(tok.literal);
|
|
if (tok.iNumber < low(int32)) or (tok.iNumber > high(int32)) then
|
|
tok.xkind := pxInt64Lit
|
|
else
|
|
tok.xkind := pxIntLit;
|
|
end;
|
|
except
|
|
on EInvalidValue do
|
|
lexMessage(L, errInvalidNumber, tok.literal);
|
|
on EOverflow do
|
|
lexMessage(L, errNumberOutOfRange, tok.literal);
|
|
{@ignore}
|
|
on sysutils.EIntOverflow do
|
|
lexMessage(L, errNumberOutOfRange, tok.literal);
|
|
{@emit}
|
|
end;
|
|
end;
|
|
|
|
function HandleCRLF(var L: TLexer; pos: int): int;
|
|
begin
|
|
case L.buf[pos] of
|
|
CR: result := lexbase.HandleCR(L, pos);
|
|
LF: result := lexbase.HandleLF(L, pos);
|
|
else result := pos
|
|
end
|
|
end;
|
|
|
|
procedure getString(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
pos, xi: int;
|
|
buf: PChar;
|
|
begin
|
|
pos := L.bufPos;
|
|
buf := L.buf;
|
|
while true do begin
|
|
if buf[pos] = '''' then begin
|
|
inc(pos);
|
|
while true do begin
|
|
case buf[pos] of
|
|
CR, LF, lexbase.EndOfFile: begin
|
|
lexMessage(L, errClosingQuoteExpected);
|
|
break
|
|
end;
|
|
'''': begin
|
|
inc(pos);
|
|
if buf[pos] = '''' then begin
|
|
inc(pos);
|
|
addChar(tok.literal, '''');
|
|
end
|
|
else break;
|
|
end;
|
|
else begin
|
|
addChar(tok.literal, buf[pos]);
|
|
inc(pos);
|
|
end
|
|
end
|
|
end
|
|
end
|
|
else if buf[pos] = '#' then begin
|
|
inc(pos);
|
|
xi := 0;
|
|
case buf[pos] of
|
|
'$': begin
|
|
inc(pos);
|
|
xi := 0;
|
|
while true do begin
|
|
case buf[pos] of
|
|
'0'..'9': xi := (xi shl 4) or (ord(buf[pos]) - ord('0'));
|
|
'a'..'f': xi := (xi shl 4) or (ord(buf[pos]) - ord('a') + 10);
|
|
'A'..'F': xi := (xi shl 4) or (ord(buf[pos]) - ord('A') + 10);
|
|
else break;
|
|
end;
|
|
inc(pos)
|
|
end
|
|
end;
|
|
'0'..'9': begin
|
|
xi := 0;
|
|
while buf[pos] in ['0'..'9'] do begin
|
|
xi := (xi * 10) + (ord(buf[pos]) - ord('0'));
|
|
inc(pos);
|
|
end;
|
|
end
|
|
else lexMessage(L, errInvalidCharacterConstant)
|
|
end;
|
|
if (xi <= 255) then
|
|
addChar(tok.literal, Chr(xi))
|
|
else
|
|
lexMessage(L, errInvalidCharacterConstant)
|
|
end
|
|
else break
|
|
end;
|
|
tok.xkind := pxStrLit;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
{@ignore}
|
|
{$ifopt Q+} {$define Q_on} {$Q-} {$endif}
|
|
{$ifopt R+} {$define R_on} {$R-} {$endif}
|
|
{@emit}
|
|
procedure getSymbol(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
pos: int;
|
|
c: Char;
|
|
buf: pchar;
|
|
h: THash; // hashing algorithm inlined
|
|
begin
|
|
h := 0;
|
|
pos := L.bufpos;
|
|
buf := L.buf;
|
|
while true do begin
|
|
c := buf[pos];
|
|
case c of
|
|
'a'..'z', '0'..'9', #128..#255: begin
|
|
h := h +{%} Ord(c);
|
|
h := h +{%} h shl 10;
|
|
h := h xor (h shr 6)
|
|
end;
|
|
'A'..'Z': begin
|
|
c := chr(ord(c) + (ord('a')-ord('A'))); // toLower()
|
|
h := h +{%} Ord(c);
|
|
h := h +{%} h shl 10;
|
|
h := h xor (h shr 6)
|
|
end;
|
|
'_': begin end;
|
|
else break
|
|
end;
|
|
Inc(pos)
|
|
end;
|
|
h := h +{%} h shl 3;
|
|
h := h xor (h shr 11);
|
|
h := h +{%} h shl 15;
|
|
tok.ident := getIdent(addr(L.buf[L.bufpos]), pos-L.bufpos, h);
|
|
L.bufpos := pos;
|
|
setKeyword(L, tok);
|
|
end;
|
|
{@ignore}
|
|
{$ifdef Q_on} {$undef Q_on} {$Q+} {$endif}
|
|
{$ifdef R_on} {$undef R_on} {$R+} {$endif}
|
|
{@emit}
|
|
|
|
procedure scanLineComment(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
buf: PChar;
|
|
pos, col: int;
|
|
indent: int;
|
|
begin
|
|
pos := L.bufpos;
|
|
buf := L.buf;
|
|
// a comment ends if the next line does not start with the // on the same
|
|
// column after only whitespace
|
|
tok.xkind := pxComment;
|
|
col := getColNumber(L, pos);
|
|
while true do begin
|
|
inc(pos, 2); // skip //
|
|
addChar(tok.literal, '#');
|
|
while not (buf[pos] in [CR, LF, lexbase.EndOfFile]) do begin
|
|
addChar(tok.literal, buf[pos]); inc(pos);
|
|
end;
|
|
pos := handleCRLF(L, pos);
|
|
buf := L.buf;
|
|
indent := 0;
|
|
while buf[pos] = ' ' do begin inc(pos); inc(indent) end;
|
|
if (col = indent) and (buf[pos] = '/') and (buf[pos+1] = '/') then
|
|
tok.literal := tok.literal +{&} nl
|
|
else
|
|
break
|
|
end;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure scanCurlyComment(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
buf: PChar;
|
|
pos: int;
|
|
begin
|
|
pos := L.bufpos;
|
|
buf := L.buf;
|
|
tok.literal := '#'+'';
|
|
tok.xkind := pxComment;
|
|
repeat
|
|
case buf[pos] of
|
|
CR, LF: begin
|
|
pos := HandleCRLF(L, pos);
|
|
buf := L.buf;
|
|
tok.literal := tok.literal +{&} nl + '#';
|
|
end;
|
|
'}': begin inc(pos); break end;
|
|
lexbase.EndOfFile: lexMessage(L, errTokenExpected, '}'+'');
|
|
else begin
|
|
addChar(tok.literal, buf[pos]);
|
|
inc(pos)
|
|
end
|
|
end
|
|
until false;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure scanStarComment(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
buf: PChar;
|
|
pos: int;
|
|
begin
|
|
pos := L.bufpos;
|
|
buf := L.buf;
|
|
tok.literal := '#'+'';
|
|
tok.xkind := pxComment;
|
|
repeat
|
|
case buf[pos] of
|
|
CR, LF: begin
|
|
pos := HandleCRLF(L, pos);
|
|
buf := L.buf;
|
|
tok.literal := tok.literal +{&} nl + '#';
|
|
end;
|
|
'*': begin
|
|
inc(pos);
|
|
if buf[pos] = ')' then begin inc(pos); break end
|
|
else addChar(tok.literal, '*')
|
|
end;
|
|
lexbase.EndOfFile: lexMessage(L, errTokenExpected, '*)');
|
|
else begin
|
|
addChar(tok.literal, buf[pos]);
|
|
inc(pos)
|
|
end
|
|
end
|
|
until false;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure skip(var L: TPasLex; var tok: TPasTok);
|
|
var
|
|
buf: PChar;
|
|
pos: int;
|
|
begin
|
|
pos := L.bufpos;
|
|
buf := L.buf;
|
|
repeat
|
|
case buf[pos] of
|
|
' ', Tabulator: Inc(pos);
|
|
// newline is special:
|
|
CR, LF: begin
|
|
pos := HandleCRLF(L, pos);
|
|
buf := L.buf;
|
|
end
|
|
else break // EndOfFile also leaves the loop
|
|
end
|
|
until false;
|
|
L.bufpos := pos;
|
|
end;
|
|
|
|
procedure getPasTok(var L: TPasLex; out tok: TPasTok);
|
|
var
|
|
c: Char;
|
|
begin
|
|
tok.xkind := pxInvalid;
|
|
fillToken(tok);
|
|
skip(L, tok);
|
|
c := L.buf[L.bufpos];
|
|
if c in SymStartChars then // common case first
|
|
getSymbol(L, tok)
|
|
else if c in ['0'..'9'] then
|
|
getNumber10(L, tok)
|
|
else begin
|
|
case c of
|
|
';': begin tok.xkind := pxSemicolon; Inc(L.bufpos) end;
|
|
'/': begin
|
|
if L.buf[L.bufpos+1] = '/' then scanLineComment(L, tok)
|
|
else begin tok.xkind := pxSlash; inc(L.bufpos) end;
|
|
end;
|
|
',': begin tok.xkind := pxComma; Inc(L.bufpos) end;
|
|
'(': begin
|
|
Inc(L.bufpos);
|
|
if (L.buf[L.bufPos] = '*') then begin
|
|
if (L.buf[L.bufPos+1] = '$') then begin
|
|
Inc(L.bufpos, 2);
|
|
skip(L, tok);
|
|
getSymbol(L, tok);
|
|
tok.xkind := pxStarDirLe;
|
|
end
|
|
else begin
|
|
inc(L.bufpos);
|
|
scanStarComment(L, tok)
|
|
end
|
|
end
|
|
else
|
|
tok.xkind := pxParLe;
|
|
end;
|
|
'*': begin
|
|
inc(L.bufpos);
|
|
if L.buf[L.bufpos] = ')' then begin
|
|
inc(L.bufpos); tok.xkind := pxStarDirRi
|
|
end
|
|
else tok.xkind := pxStar
|
|
end;
|
|
')': begin tok.xkind := pxParRi; Inc(L.bufpos) end;
|
|
'[': begin Inc(L.bufpos); tok.xkind := pxBracketLe end;
|
|
']': begin Inc(L.bufpos); tok.xkind := pxBracketRi end;
|
|
'.': begin
|
|
inc(L.bufpos);
|
|
if L.buf[L.bufpos] = '.' then begin
|
|
tok.xkind := pxDotDot; inc(L.bufpos)
|
|
end
|
|
else tok.xkind := pxDot
|
|
end;
|
|
'{': begin
|
|
Inc(L.bufpos);
|
|
case L.buf[L.bufpos] of
|
|
'$': begin
|
|
Inc(L.bufpos);
|
|
skip(L, tok);
|
|
getSymbol(L, tok);
|
|
tok.xkind := pxCurlyDirLe
|
|
end;
|
|
'&': begin Inc(L.bufpos); tok.xkind := pxAmp end;
|
|
'%': begin Inc(L.bufpos); tok.xkind := pxPer end;
|
|
'@': begin Inc(L.bufpos); tok.xkind := pxCommand end;
|
|
else scanCurlyComment(L, tok);
|
|
end;
|
|
end;
|
|
'+': begin tok.xkind := pxPlus; inc(L.bufpos) end;
|
|
'-': begin tok.xkind := pxMinus; inc(L.bufpos) end;
|
|
':': begin
|
|
inc(L.bufpos);
|
|
if L.buf[L.bufpos] = '=' then begin
|
|
inc(L.bufpos); tok.xkind := pxAsgn;
|
|
end
|
|
else tok.xkind := pxColon
|
|
end;
|
|
'<': begin
|
|
inc(L.bufpos);
|
|
if L.buf[L.bufpos] = '>' then begin
|
|
inc(L.bufpos);
|
|
tok.xkind := pxNeq
|
|
end
|
|
else if L.buf[L.bufpos] = '=' then begin
|
|
inc(L.bufpos);
|
|
tok.xkind := pxLe
|
|
end
|
|
else tok.xkind := pxLt
|
|
end;
|
|
'>': begin
|
|
inc(L.bufpos);
|
|
if L.buf[L.bufpos] = '=' then begin
|
|
inc(L.bufpos);
|
|
tok.xkind := pxGe
|
|
end
|
|
else tok.xkind := pxGt
|
|
end;
|
|
'=': begin tok.xkind := pxEquals; inc(L.bufpos) end;
|
|
'@': begin tok.xkind := pxAt; inc(L.bufpos) end;
|
|
'^': begin tok.xkind := pxHat; inc(L.bufpos) end;
|
|
'}': begin tok.xkind := pxCurlyDirRi; Inc(L.bufpos) end;
|
|
'''', '#': getString(L, tok);
|
|
'$': getNumber16(L, tok);
|
|
'%': getNumber2(L, tok);
|
|
lexbase.EndOfFile: tok.xkind := pxEof;
|
|
else begin
|
|
tok.literal := c + '';
|
|
tok.xkind := pxInvalid;
|
|
lexMessage(L, errInvalidToken, c + ' (\' +{&} toString(ord(c)) + ')');
|
|
Inc(L.bufpos);
|
|
end
|
|
end
|
|
end
|
|
end;
|
|
|
|
end.
|