← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to compiler/scanner.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2001-08-29 23:15:17 UTC
  • Revision ID: james.westby@ubuntu.com-20010829231517-thxsp7ctuab584ia
Tags: upstream-1.0.4
Import upstream version 1.0.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
compiler/scanner.pas
 
1
{
 
2
    $Id: scanner.pas,v 1.1.2.5 2000/12/18 18:00:54 peter Exp $
 
3
    Copyright (c) 1998-2000 by Florian Klaempfl
 
4
 
 
5
    This unit implements the scanner part and handling of the switches
 
6
 
 
7
    This program is free software; you can redistribute it and/or modify
 
8
    it under the terms of the GNU General Public License as published by
 
9
    the Free Software Foundation; either version 2 of the License, or
 
10
    (at your option) any later version.
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
15
    GNU General Public License for more details.
 
16
 
 
17
    You should have received a copy of the GNU General Public License
 
18
    along with this program; if not, write to the Free Software
 
19
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
20
 
 
21
 ****************************************************************************
 
22
}
 
23
{$ifdef tp}
 
24
  {$F+,N+,E+,R-}
 
25
{$endif}
 
26
unit scanner;
 
27
{$ifdef FPC}
 
28
  {$goto on}
 
29
{$endif FPC}
 
30
 
 
31
  interface
 
32
 
 
33
    uses
 
34
{$ifdef Delphi}
 
35
       dmisc,
 
36
{$endif Delphi}
 
37
       globtype,version,tokens,
 
38
       cobjects,globals,verbose,comphook,files;
 
39
 
 
40
    const
 
41
{$ifdef TP}
 
42
       maxmacrolen=1024;
 
43
       preprocbufsize=1024;
 
44
{$else}
 
45
       maxmacrolen=16*1024;
 
46
       preprocbufsize=32*1024;
 
47
{$endif}
 
48
       Newline = #10;
 
49
 
 
50
 
 
51
    type
 
52
       tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
 
53
 
 
54
       pmacrobuffer = ^tmacrobuffer;
 
55
       tmacrobuffer = array[0..maxmacrolen-1] of char;
 
56
 
 
57
       preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else);
 
58
       ppreprocstack = ^tpreprocstack;
 
59
       tpreprocstack = object
 
60
          typ     : preproctyp;
 
61
          accept  : boolean;
 
62
          next    : ppreprocstack;
 
63
          name    : stringid;
 
64
          line_nb : longint;
 
65
          constructor init(atyp:preproctyp;a:boolean;n:ppreprocstack);
 
66
          destructor done;
 
67
       end;
 
68
 
 
69
       pscannerfile = ^tscannerfile;
 
70
       tscannerfile = object
 
71
          inputfile    : pinputfile;  { current inputfile list }
 
72
 
 
73
          inputbuffer,                { input buffer }
 
74
          inputpointer : pchar;
 
75
          inputstart   : longint;
 
76
 
 
77
          line_no,                    { line }
 
78
          lastlinepos  : longint;
 
79
 
 
80
          lasttokenpos : longint;     { token }
 
81
          lasttoken,
 
82
          nexttoken    : ttoken;
 
83
 
 
84
          comment_level,
 
85
          yylexcount     : longint;
 
86
          lastasmgetchar : char;
 
87
          ignoredirectives : tstringcontainer; { ignore directives, used to give warnings only once }
 
88
          preprocstack   : ppreprocstack;
 
89
          invalid        : boolean; { flag if sourcefiles have been destroyed ! }
 
90
          in_asm_string  : boolean;
 
91
          constructor init(const fn:string);
 
92
          destructor done;
 
93
        { File buffer things }
 
94
          function  openinputfile:boolean;
 
95
          procedure closeinputfile;
 
96
          function  tempopeninputfile:boolean;
 
97
          procedure tempcloseinputfile;
 
98
          procedure saveinputfile;
 
99
          procedure restoreinputfile;
 
100
          procedure nextfile;
 
101
          procedure addfile(hp:pinputfile);
 
102
          procedure reload;
 
103
          procedure insertmacro(const macname:string;p:pchar;len:longint);
 
104
        { Scanner things }
 
105
          procedure gettokenpos;
 
106
          procedure inc_comment_level;
 
107
          procedure dec_comment_level;
 
108
          procedure illegal_char(c:char);
 
109
          procedure end_of_file;
 
110
          procedure checkpreprocstack;
 
111
          procedure poppreprocstack;
 
112
          procedure addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint);
 
113
          procedure elsepreprocstack;
 
114
          procedure linebreak;
 
115
          procedure readchar;
 
116
          procedure readstring;
 
117
          procedure readnumber;
 
118
          function  readid:string;
 
119
          function  readval:longint;
 
120
          function  readcomment:string;
 
121
          function  readstate:char;
 
122
          procedure skipspace;
 
123
          procedure skipuntildirective;
 
124
          procedure skipcomment;
 
125
          procedure skipdelphicomment;
 
126
          procedure skipoldtpcomment;
 
127
          procedure readtoken;
 
128
          function  readpreproc:ttoken;
 
129
          function  asmgetchar:char;
 
130
       end;
 
131
 
 
132
       ppreprocfile=^tpreprocfile;
 
133
       tpreprocfile=object
 
134
         f   : text;
 
135
         buf : pointer;
 
136
         spacefound,
 
137
         eolfound : boolean;
 
138
         constructor init(const fn:string);
 
139
         destructor  done;
 
140
         procedure Add(const s:string);
 
141
         procedure AddSpace;
 
142
       end;
 
143
 
 
144
 
 
145
    var
 
146
        c              : char;
 
147
        orgpattern,
 
148
        pattern        : string;
 
149
        current_scanner : pscannerfile;
 
150
        aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 
151
 
 
152
        preprocfile : ppreprocfile; { used with only preprocessing }
 
153
 
 
154
 
 
155
implementation
 
156
 
 
157
    uses
 
158
{$ifndef delphi}
 
159
      dos,
 
160
{$endif delphi}
 
161
      systems,symtable,switches
 
162
{$IFDEF NEWST}
 
163
      ,symbols
 
164
{$ENDIF NEWST};
 
165
 
 
166
{*****************************************************************************
 
167
                              Helper routines
 
168
*****************************************************************************}
 
169
 
 
170
    const
 
171
      { use any special name that is an invalid file name to avoid problems }
 
172
      preprocstring : array [preproctyp] of string[7]
 
173
        = ('$IFDEF','$IFNDEF','$IF','$IFOPT','$ELSE');
 
174
 
 
175
 
 
176
    function is_keyword(const s:string):boolean;
 
177
      var
 
178
        low,high,mid : longint;
 
179
      begin
 
180
        if not (length(s) in [2..tokenidlen]) then
 
181
         begin
 
182
           is_keyword:=false;
 
183
           exit;
 
184
         end;
 
185
        low:=ord(tokenidx^[length(s),s[1]].first);
 
186
        high:=ord(tokenidx^[length(s),s[1]].last);
 
187
        while low<high do
 
188
         begin
 
189
           mid:=(high+low+1) shr 1;
 
190
           if pattern<tokeninfo^[ttoken(mid)].str then
 
191
            high:=mid-1
 
192
           else
 
193
            low:=mid;
 
194
         end;
 
195
        is_keyword:=(pattern=tokeninfo^[ttoken(high)].str) and
 
196
                    (tokeninfo^[ttoken(high)].keyword in aktmodeswitches);
 
197
      end;
 
198
 
 
199
 
 
200
{*****************************************************************************
 
201
                            Preprocessor writting
 
202
*****************************************************************************}
 
203
 
 
204
    constructor tpreprocfile.init(const fn:string);
 
205
      begin
 
206
      { open outputfile }
 
207
        assign(f,fn);
 
208
        {$I-}
 
209
         rewrite(f);
 
210
        {$I+}
 
211
        if ioresult<>0 then
 
212
         Comment(V_Fatal,'can''t create file '+fn);
 
213
        getmem(buf,preprocbufsize);
 
214
        settextbuf(f,buf^,preprocbufsize);
 
215
      { reset }
 
216
        eolfound:=false;
 
217
        spacefound:=false;
 
218
      end;
 
219
 
 
220
 
 
221
    destructor tpreprocfile.done;
 
222
      begin
 
223
        close(f);
 
224
        freemem(buf,preprocbufsize);
 
225
      end;
 
226
 
 
227
 
 
228
    procedure tpreprocfile.add(const s:string);
 
229
      begin
 
230
        write(f,s);
 
231
      end;
 
232
 
 
233
    procedure tpreprocfile.addspace;
 
234
      begin
 
235
        if eolfound then
 
236
         begin
 
237
           writeln(f,'');
 
238
           eolfound:=false;
 
239
           spacefound:=false;
 
240
         end
 
241
        else
 
242
         if spacefound then
 
243
          begin
 
244
            write(f,' ');
 
245
            spacefound:=false;
 
246
          end;
 
247
      end;
 
248
 
 
249
 
 
250
{*****************************************************************************
 
251
                              TPreProcStack
 
252
*****************************************************************************}
 
253
 
 
254
    constructor tpreprocstack.init(atyp : preproctyp;a:boolean;n:ppreprocstack);
 
255
      begin
 
256
        accept:=a;
 
257
        typ:=atyp;
 
258
        next:=n;
 
259
      end;
 
260
 
 
261
 
 
262
    destructor tpreprocstack.done;
 
263
      begin
 
264
      end;
 
265
 
 
266
 
 
267
{****************************************************************************
 
268
                                TSCANNERFILE
 
269
 ****************************************************************************}
 
270
 
 
271
    constructor tscannerfile.init(const fn:string);
 
272
      begin
 
273
        inputfile:=do_openinputfile(fn);
 
274
        if assigned(current_module) then
 
275
          current_module^.sourcefiles^.register_file(inputfile);
 
276
      { reset localinput }
 
277
        inputbuffer:=nil;
 
278
        inputpointer:=nil;
 
279
        inputstart:=0;
 
280
      { reset scanner }
 
281
        preprocstack:=nil;
 
282
        comment_level:=0;
 
283
        yylexcount:=0;
 
284
        block_type:=bt_general;
 
285
        line_no:=0;
 
286
        lastlinepos:=0;
 
287
        lasttokenpos:=0;
 
288
        lasttoken:=NOTOKEN;
 
289
        nexttoken:=NOTOKEN;
 
290
        lastasmgetchar:=#0;
 
291
        ignoredirectives.init;
 
292
        invalid:=false;
 
293
        in_asm_string:=false;
 
294
      { load block }
 
295
        if not openinputfile then
 
296
         Message1(scan_f_cannot_open_input,fn);
 
297
        reload;
 
298
      { process first read char }
 
299
        case c of
 
300
         #26 : reload;
 
301
         #10,
 
302
         #13 : linebreak;
 
303
        end;
 
304
      end;
 
305
 
 
306
 
 
307
    destructor tscannerfile.done;
 
308
      begin
 
309
        if not invalid then
 
310
          begin
 
311
             if status.errorcount=0 then
 
312
              checkpreprocstack;
 
313
           { close file, but only if we are the first compile }
 
314
           { probably not necessary anymore with invalid flag PM }
 
315
             if not current_module^.in_second_compile then
 
316
              begin
 
317
                if not inputfile^.closed then
 
318
                 closeinputfile;
 
319
              end;
 
320
          end;
 
321
         ignoredirectives.done;
 
322
       end;
 
323
 
 
324
 
 
325
    function tscannerfile.openinputfile:boolean;
 
326
      begin
 
327
        openinputfile:=inputfile^.open;
 
328
      { load buffer }
 
329
        inputbuffer:=inputfile^.buf;
 
330
        inputpointer:=inputfile^.buf;
 
331
        inputstart:=inputfile^.bufstart;
 
332
      { line }
 
333
        line_no:=0;
 
334
        lastlinepos:=0;
 
335
        lasttokenpos:=0;
 
336
      end;
 
337
 
 
338
 
 
339
    procedure tscannerfile.closeinputfile;
 
340
      begin
 
341
        inputfile^.close;
 
342
      { reset buffer }
 
343
        inputbuffer:=nil;
 
344
        inputpointer:=nil;
 
345
        inputstart:=0;
 
346
      { reset line }
 
347
        line_no:=0;
 
348
        lastlinepos:=0;
 
349
        lasttokenpos:=0;
 
350
      end;
 
351
 
 
352
 
 
353
    function tscannerfile.tempopeninputfile:boolean;
 
354
      begin
 
355
        tempopeninputfile:=inputfile^.tempopen;
 
356
      { reload buffer }
 
357
        inputbuffer:=inputfile^.buf;
 
358
        inputpointer:=inputfile^.buf;
 
359
        inputstart:=inputfile^.bufstart;
 
360
      end;
 
361
 
 
362
 
 
363
    procedure tscannerfile.tempcloseinputfile;
 
364
      begin
 
365
        inputfile^.setpos(inputstart+(inputpointer-inputbuffer));
 
366
        inputfile^.tempclose;
 
367
      { reset buffer }
 
368
        inputbuffer:=nil;
 
369
        inputpointer:=nil;
 
370
        inputstart:=0;
 
371
      end;
 
372
 
 
373
 
 
374
    procedure tscannerfile.saveinputfile;
 
375
      begin
 
376
        inputfile^.saveinputpointer:=inputpointer;
 
377
        inputfile^.savelastlinepos:=lastlinepos;
 
378
        inputfile^.saveline_no:=line_no;
 
379
      end;
 
380
 
 
381
 
 
382
    procedure tscannerfile.restoreinputfile;
 
383
      begin
 
384
        inputpointer:=inputfile^.saveinputpointer;
 
385
        lastlinepos:=inputfile^.savelastlinepos;
 
386
        line_no:=inputfile^.saveline_no;
 
387
        if not inputfile^.is_macro then
 
388
          parser_current_file:=inputfile^.name^;
 
389
      end;
 
390
 
 
391
 
 
392
    procedure tscannerfile.nextfile;
 
393
      var
 
394
        to_dispose : pinputfile;
 
395
      begin
 
396
        if assigned(inputfile^.next) then
 
397
         begin
 
398
           if inputfile^.is_macro then
 
399
             to_dispose:=inputfile
 
400
           else
 
401
             to_dispose:=nil;
 
402
           { we can allways close the file, no ? }
 
403
           inputfile^.close;
 
404
           inputfile:=inputfile^.next;
 
405
           if assigned(to_dispose) then
 
406
             dispose(to_dispose,done);
 
407
           restoreinputfile;
 
408
         end;
 
409
      end;
 
410
 
 
411
 
 
412
    procedure tscannerfile.addfile(hp:pinputfile);
 
413
      begin
 
414
        saveinputfile;
 
415
      { add to list }
 
416
        hp^.next:=inputfile;
 
417
        inputfile:=hp;
 
418
      { load new inputfile }
 
419
        restoreinputfile;
 
420
      end;
 
421
 
 
422
 
 
423
    procedure tscannerfile.reload;
 
424
      begin
 
425
        with inputfile^ do
 
426
         begin
 
427
           { when nothing more to read then leave immediatly, so we
 
428
             don't change the aktfilepos and leave it point to the last
 
429
             char }
 
430
           if (c=#26) and (not assigned(next)) then
 
431
            exit;
 
432
           repeat
 
433
           { still more to read?, then change the #0 to a space so its seen
 
434
             as a seperator, this can't be used for macro's which can change
 
435
             the place of the #0 in the buffer with tempopen }
 
436
             if (c=#0) and (bufsize>0) and
 
437
                not(inputfile^.is_macro) and
 
438
                (inputpointer-inputbuffer<bufsize) then
 
439
              begin
 
440
                c:=' ';
 
441
                inc(longint(inputpointer));
 
442
                exit;
 
443
              end;
 
444
           { can we read more from this file ? }
 
445
             if (c<>#26) and (not endoffile) then
 
446
              begin
 
447
                readbuf;
 
448
                inputpointer:=buf;
 
449
                inputbuffer:=buf;
 
450
                inputstart:=bufstart;
 
451
              { first line? }
 
452
                if line_no=0 then
 
453
                 begin
 
454
                   line_no:=1;
 
455
                   if cs_asm_source in aktglobalswitches then
 
456
                     inputfile^.setline(line_no,bufstart);
 
457
                 end;
 
458
              end
 
459
             else
 
460
              begin
 
461
              { load eof position in tokenpos/aktfilepos }
 
462
                gettokenpos;
 
463
              { close file }
 
464
                closeinputfile;
 
465
              { no next module, than EOF }
 
466
                if not assigned(inputfile^.next) then
 
467
                 begin
 
468
                   c:=#26;
 
469
                   exit;
 
470
                 end;
 
471
              { load next file and reopen it }
 
472
                nextfile;
 
473
                tempopeninputfile;
 
474
              { status }
 
475
                Message1(scan_t_back_in,inputfile^.name^);
 
476
              end;
 
477
           { load next char }
 
478
             c:=inputpointer^;
 
479
             inc(longint(inputpointer));
 
480
           until c<>#0; { if also end, then reload again }
 
481
         end;
 
482
      end;
 
483
 
 
484
 
 
485
    procedure tscannerfile.insertmacro(const macname:string;p:pchar;len:longint);
 
486
      var
 
487
        hp : pinputfile;
 
488
      begin
 
489
      { save old postion and decrease linebreak }
 
490
        if c=newline then
 
491
         dec(line_no);
 
492
        dec(longint(inputpointer));
 
493
        tempcloseinputfile;
 
494
      { create macro 'file' }
 
495
        { use special name to dispose after !! }
 
496
        hp:=do_openinputfile('_Macro_.'+macname);
 
497
        addfile(hp);
 
498
        with inputfile^ do
 
499
         begin
 
500
           setmacro(p,len);
 
501
         { local buffer }
 
502
           inputbuffer:=buf;
 
503
           inputpointer:=buf;
 
504
           inputstart:=bufstart;
 
505
         end;
 
506
      { reset line }
 
507
        line_no:=0;
 
508
        lastlinepos:=0;
 
509
        lasttokenpos:=0;
 
510
      { load new c }
 
511
        c:=inputpointer^;
 
512
        inc(longint(inputpointer));
 
513
      end;
 
514
 
 
515
 
 
516
    procedure tscannerfile.gettokenpos;
 
517
    { load the values of tokenpos and lasttokenpos }
 
518
      begin
 
519
        lasttokenpos:=inputstart+(inputpointer-inputbuffer);
 
520
        tokenpos.line:=line_no;
 
521
        tokenpos.column:=lasttokenpos-lastlinepos;
 
522
        tokenpos.fileindex:=inputfile^.ref_index;
 
523
        aktfilepos:=tokenpos;
 
524
      end;
 
525
 
 
526
 
 
527
    procedure tscannerfile.inc_comment_level;
 
528
      var
 
529
         oldaktfilepos : tfileposinfo;
 
530
      begin
 
531
         if (m_nested_comment in aktmodeswitches) then
 
532
           inc(comment_level)
 
533
         else
 
534
           comment_level:=1;
 
535
         if (comment_level>1) then
 
536
          begin
 
537
             oldaktfilepos:=aktfilepos;
 
538
             gettokenpos; { update for warning }
 
539
             Message1(scan_w_comment_level,tostr(comment_level));
 
540
             aktfilepos:=oldaktfilepos;
 
541
          end;
 
542
      end;
 
543
 
 
544
 
 
545
    procedure tscannerfile.dec_comment_level;
 
546
      begin
 
547
         if (m_nested_comment in aktmodeswitches) then
 
548
           dec(comment_level)
 
549
         else
 
550
           comment_level:=0;
 
551
      end;
 
552
 
 
553
 
 
554
    procedure tscannerfile.linebreak;
 
555
      var
 
556
         cur : char;
 
557
         oldtokenpos,
 
558
         oldaktfilepos : tfileposinfo;
 
559
      begin
 
560
        with inputfile^ do
 
561
         begin
 
562
           if (byte(inputpointer^)=0) and not(endoffile) then
 
563
            begin
 
564
              cur:=c;
 
565
              reload;
 
566
              if byte(cur)+byte(c)<>23 then
 
567
                dec(longint(inputpointer));
 
568
            end
 
569
           else
 
570
            begin
 
571
            { Fix linebreak to be only newline (=#10) for all types of linebreaks }
 
572
              if (byte(inputpointer^)+byte(c)=23) then
 
573
                inc(longint(inputpointer));
 
574
            end;
 
575
           c:=newline;
 
576
         { increase line counters }
 
577
           lastlinepos:=bufstart+(inputpointer-inputbuffer);
 
578
           inc(line_no);
 
579
         { update linebuffer }
 
580
           if cs_asm_source in aktglobalswitches then
 
581
             inputfile^.setline(line_no,lastlinepos);
 
582
         { update for status and call the show status routine,
 
583
           but don't touch aktfilepos ! }
 
584
           oldaktfilepos:=aktfilepos;
 
585
           oldtokenpos:=tokenpos;
 
586
           gettokenpos; { update for v_status }
 
587
           inc(status.compiledlines);
 
588
           ShowStatus;
 
589
           aktfilepos:=oldaktfilepos;
 
590
           tokenpos:=oldtokenpos;
 
591
         end;
 
592
      end;
 
593
 
 
594
 
 
595
    procedure tscannerfile.illegal_char(c:char);
 
596
      var
 
597
        s : string;
 
598
      begin
 
599
        if c in [#32..#255] then
 
600
         s:=''''+c+''''
 
601
        else
 
602
         s:='#'+tostr(ord(c));
 
603
        Message2(scan_f_illegal_char,s,'$'+hexstr(ord(c),2));
 
604
      end;
 
605
 
 
606
 
 
607
    procedure tscannerfile.end_of_file;
 
608
      begin
 
609
        checkpreprocstack;
 
610
        Message(scan_f_end_of_file);
 
611
      end;
 
612
 
 
613
 
 
614
    procedure tscannerfile.checkpreprocstack;
 
615
      begin
 
616
      { check for missing ifdefs }
 
617
        while assigned(preprocstack) do
 
618
         begin
 
619
           Message3(scan_e_endif_expected,preprocstring[preprocstack^.typ],preprocstack^.name,tostr(preprocstack^.line_nb));
 
620
           poppreprocstack;
 
621
         end;
 
622
      end;
 
623
 
 
624
 
 
625
    procedure tscannerfile.poppreprocstack;
 
626
      var
 
627
        hp : ppreprocstack;
 
628
      begin
 
629
        if assigned(preprocstack) then
 
630
         begin
 
631
           Message1(scan_c_endif_found,preprocstack^.name);
 
632
           hp:=preprocstack^.next;
 
633
           dispose(preprocstack,done);
 
634
           preprocstack:=hp;
 
635
         end
 
636
        else
 
637
         Message(scan_e_endif_without_if);
 
638
      end;
 
639
 
 
640
 
 
641
    procedure tscannerfile.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint);
 
642
      begin
 
643
        preprocstack:=new(ppreprocstack,init(atyp,((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
 
644
        preprocstack^.name:=s;
 
645
        preprocstack^.line_nb:=line_no;
 
646
        if preprocstack^.accept then
 
647
         Message2(w,preprocstack^.name,'accepted')
 
648
        else
 
649
         Message2(w,preprocstack^.name,'rejected');
 
650
      end;
 
651
 
 
652
 
 
653
    procedure tscannerfile.elsepreprocstack;
 
654
      begin
 
655
        if assigned(preprocstack) then
 
656
         begin
 
657
           preprocstack^.typ:=pp_else;
 
658
           preprocstack^.line_nb:=line_no;
 
659
           if not(assigned(preprocstack^.next)) or (preprocstack^.next^.accept) then
 
660
            preprocstack^.accept:=not preprocstack^.accept;
 
661
           if preprocstack^.accept then
 
662
            Message2(scan_c_else_found,preprocstack^.name,'accepted')
 
663
           else
 
664
            Message2(scan_c_else_found,preprocstack^.name,'rejected');
 
665
         end
 
666
        else
 
667
         Message(scan_e_endif_without_if);
 
668
      end;
 
669
 
 
670
 
 
671
    procedure tscannerfile.readchar;
 
672
      begin
 
673
        c:=inputpointer^;
 
674
        if c=#0 then
 
675
         reload
 
676
        else
 
677
         inc(longint(inputpointer));
 
678
        case c of
 
679
         #26 : reload;
 
680
         #10,
 
681
         #13 : linebreak;
 
682
        end;
 
683
      end;
 
684
 
 
685
 
 
686
    procedure tscannerfile.readstring;
 
687
      var
 
688
        i : longint;
 
689
      begin
 
690
        i:=0;
 
691
        repeat
 
692
          case c of
 
693
                 '_',
 
694
            '0'..'9',
 
695
            'A'..'Z' : begin
 
696
                         if i<255 then
 
697
                          begin
 
698
                            inc(i);
 
699
                            orgpattern[i]:=c;
 
700
                            pattern[i]:=c;
 
701
                          end;
 
702
                         c:=inputpointer^;
 
703
                         inc(longint(inputpointer));
 
704
                       end;
 
705
            'a'..'z' : begin
 
706
                         if i<255 then
 
707
                          begin
 
708
                            inc(i);
 
709
                            orgpattern[i]:=c;
 
710
                            pattern[i]:=chr(ord(c)-32)
 
711
                          end;
 
712
                         c:=inputpointer^;
 
713
                         inc(longint(inputpointer));
 
714
                       end;
 
715
              #0 : reload;
 
716
              #26 : begin
 
717
                      reload;
 
718
                      if c=#26 then
 
719
                        break;
 
720
                    end;
 
721
             #13,#10 : begin
 
722
                         linebreak;
 
723
                         break;
 
724
                       end;
 
725
          else
 
726
           break;
 
727
          end;
 
728
        until false;
 
729
        {$ifndef TP}
 
730
          {$ifopt H+}
 
731
            setlength(orgpattern,i);
 
732
            setlength(pattern,i);
 
733
          {$else}
 
734
            orgpattern[0]:=chr(i);
 
735
            pattern[0]:=chr(i);
 
736
          {$endif}
 
737
        {$else}
 
738
          orgpattern[0]:=chr(i);
 
739
          pattern[0]:=chr(i);
 
740
        {$endif}
 
741
      end;
 
742
 
 
743
 
 
744
    procedure tscannerfile.readnumber;
 
745
      var
 
746
        base,
 
747
        i  : longint;
 
748
      begin
 
749
        case c of
 
750
         '%' : begin
 
751
                 readchar;
 
752
                 base:=2;
 
753
                 pattern[1]:='%';
 
754
                 i:=1;
 
755
               end;
 
756
         '$' : begin
 
757
                 readchar;
 
758
                 base:=16;
 
759
                 pattern[1]:='$';
 
760
                 i:=1;
 
761
               end;
 
762
        else
 
763
         begin
 
764
           base:=10;
 
765
           i:=0;
 
766
         end;
 
767
        end;
 
768
        while ((base>=10) and (c in ['0'..'9'])) or
 
769
              ((base=16) and (c in ['A'..'F','a'..'f'])) or
 
770
              ((base=2) and (c in ['0'..'1'])) do
 
771
         begin
 
772
           if i<255 then
 
773
            begin
 
774
              inc(i);
 
775
              pattern[i]:=c;
 
776
            end;
 
777
        { get next char }
 
778
           c:=inputpointer^;
 
779
           if c=#0 then
 
780
            reload
 
781
           else
 
782
            inc(longint(inputpointer));
 
783
         end;
 
784
      { was the next char a linebreak ? }
 
785
        case c of
 
786
         #26 : reload;
 
787
         #10,
 
788
         #13 : linebreak;
 
789
        end;
 
790
        {$ifndef TP}
 
791
          {$ifopt H+}
 
792
            setlength(pattern,i);
 
793
          {$else}
 
794
            pattern[0]:=chr(i);
 
795
          {$endif}
 
796
        {$else}
 
797
          pattern[0]:=chr(i);
 
798
        {$endif}
 
799
      end;
 
800
 
 
801
 
 
802
    function tscannerfile.readid:string;
 
803
      begin
 
804
        readstring;
 
805
        readid:=pattern;
 
806
      end;
 
807
 
 
808
 
 
809
    function tscannerfile.readval:longint;
 
810
      var
 
811
        l : longint;
 
812
        w : integer;
 
813
      begin
 
814
        readnumber;
 
815
        valint(pattern,l,w);
 
816
        readval:=l;
 
817
      end;
 
818
 
 
819
 
 
820
    function tscannerfile.readcomment:string;
 
821
      var
 
822
        i : longint;
 
823
      begin
 
824
        i:=0;
 
825
        repeat
 
826
          case c of
 
827
           '{' :
 
828
             if aktcommentstyle=comment_tp then
 
829
              inc_comment_level;
 
830
           '}' :
 
831
             if aktcommentstyle=comment_tp then
 
832
              begin
 
833
                readchar;
 
834
                dec_comment_level;
 
835
                if comment_level=0 then
 
836
                 break
 
837
                else
 
838
                 continue;
 
839
              end;
 
840
           '*' :
 
841
             if aktcommentstyle=comment_oldtp then
 
842
              begin
 
843
                readchar;
 
844
                if c=')' then
 
845
                 begin
 
846
                   readchar;
 
847
                   dec_comment_level;
 
848
                   break;
 
849
                 end
 
850
                else
 
851
                 { Add both characters !!}
 
852
                 if (i<255) then
 
853
                   begin
 
854
                   inc(i);
 
855
                   readcomment[i]:='*';
 
856
                   if (i<255) then
 
857
                     begin
 
858
                     inc(i);
 
859
                     readcomment[i]:='*';
 
860
                     end;
 
861
                   end;
 
862
              end
 
863
             else
 
864
              { Not old TP comment, so add...}
 
865
              begin
 
866
              if (i<255) then
 
867
               begin
 
868
               inc(i);
 
869
               readcomment[i]:='*';
 
870
               end;
 
871
              end;
 
872
           #26 :
 
873
              end_of_file;
 
874
          else
 
875
            begin
 
876
              if (i<255) then
 
877
               begin
 
878
                 inc(i);
 
879
                 readcomment[i]:=c;
 
880
               end;
 
881
            end;
 
882
          end;
 
883
          c:=inputpointer^;
 
884
          if c=#0 then
 
885
           reload
 
886
          else
 
887
           inc(longint(inputpointer));
 
888
          if c in [#10,#13] then
 
889
           linebreak;
 
890
        until false;
 
891
        {$ifndef TP}
 
892
          {$ifopt H+}
 
893
            setlength(readcomment,i);
 
894
          {$else}
 
895
            readcomment[0]:=chr(i);
 
896
          {$endif}
 
897
        {$else}
 
898
          readcomment[0]:=chr(i);
 
899
        {$endif}
 
900
      end;
 
901
 
 
902
 
 
903
    function tscannerfile.readstate:char;
 
904
      var
 
905
        state : char;
 
906
      begin
 
907
        state:=' ';
 
908
        if c=' ' then
 
909
         begin
 
910
           current_scanner^.skipspace;
 
911
           current_scanner^.readid;
 
912
           if pattern='ON' then
 
913
            state:='+'
 
914
           else
 
915
            if pattern='OFF' then
 
916
             state:='-';
 
917
         end
 
918
        else
 
919
         state:=c;
 
920
        if not (state in ['+','-']) then
 
921
         Message(scan_e_wrong_switch_toggle);
 
922
        readstate:=state;
 
923
      end;
 
924
 
 
925
 
 
926
    procedure tscannerfile.skipspace;
 
927
      begin
 
928
        while c in [' ',#9..#13] do
 
929
         begin
 
930
           c:=inputpointer^;
 
931
           if c=#0 then
 
932
            reload
 
933
           else
 
934
            inc(longint(inputpointer));
 
935
           case c of
 
936
            #26 :
 
937
              reload;
 
938
            #10,
 
939
            #13 :
 
940
              linebreak;
 
941
           end;
 
942
         end;
 
943
      end;
 
944
 
 
945
 
 
946
    procedure tscannerfile.skipuntildirective;
 
947
      var
 
948
        incomment : boolean;
 
949
        found : longint;
 
950
        next_char_loaded : boolean;
 
951
        oldcommentstyle : tcommentstyle;
 
952
      begin
 
953
         found:=0;
 
954
         next_char_loaded:=false;
 
955
         incomment:=true;
 
956
         oldcommentstyle:=aktcommentstyle;
 
957
         repeat
 
958
           case c of
 
959
             #26 :
 
960
               end_of_file;
 
961
             '{' :
 
962
               begin
 
963
                 if not(m_nested_comment in aktmodeswitches) or
 
964
                    (comment_level=0) then
 
965
                  begin
 
966
                    found:=1;
 
967
                    aktcommentstyle:=comment_tp;
 
968
                  end;
 
969
                 inc_comment_level;
 
970
                 incomment:=true;
 
971
               end;
 
972
             '}' :
 
973
               begin
 
974
                 dec_comment_level;
 
975
                 found:=0;
 
976
                 incomment:=false;
 
977
               end;
 
978
             '$' :
 
979
               begin
 
980
                 if found=1 then
 
981
                  found:=2;
 
982
               end;
 
983
             '''' :
 
984
               if not incomment then
 
985
                begin
 
986
                  repeat
 
987
                    readchar;
 
988
                    case c of
 
989
                      #26 :
 
990
                        end_of_file;
 
991
                      newline :
 
992
                        break;
 
993
                      '''' :
 
994
                        begin
 
995
                          readchar;
 
996
                          if c<>'''' then
 
997
                           begin
 
998
                             next_char_loaded:=true;
 
999
                             break;
 
1000
                           end;
 
1001
                        end;
 
1002
                    end;
 
1003
                  until false;
 
1004
                end;
 
1005
             '(' :
 
1006
               begin
 
1007
                 readchar;
 
1008
                 if c='*' then
 
1009
                   begin
 
1010
                     readchar;
 
1011
                     if c='$' then
 
1012
                      begin
 
1013
                        found:=2;
 
1014
                        inc_comment_level;
 
1015
                        aktcommentstyle:=comment_oldtp;
 
1016
                      end
 
1017
                     else
 
1018
                      begin
 
1019
                        skipoldtpcomment;
 
1020
                        aktcommentstyle:=oldcommentstyle;
 
1021
                      end;
 
1022
                   end
 
1023
                 else
 
1024
                   next_char_loaded:=true;
 
1025
               end;
 
1026
             else
 
1027
               found:=0;
 
1028
           end;
 
1029
           if next_char_loaded then
 
1030
             next_char_loaded:=false
 
1031
           else
 
1032
             begin
 
1033
                c:=inputpointer^;
 
1034
                if c=#0 then
 
1035
                  reload
 
1036
                else
 
1037
                  inc(longint(inputpointer));
 
1038
                case c of
 
1039
                  #26 : reload;
 
1040
                  #10,
 
1041
                  #13 : linebreak;
 
1042
                end;
 
1043
             end;
 
1044
         until (found=2);
 
1045
      end;
 
1046
 
 
1047
 
 
1048
{****************************************************************************
 
1049
                      Include directive scanning/parsing
 
1050
****************************************************************************}
 
1051
 
 
1052
{$i scandir.inc}
 
1053
 
 
1054
 
 
1055
{****************************************************************************
 
1056
                             Comment Handling
 
1057
****************************************************************************}
 
1058
 
 
1059
    procedure tscannerfile.skipcomment;
 
1060
      begin
 
1061
        aktcommentstyle:=comment_tp;
 
1062
        readchar;
 
1063
        inc_comment_level;
 
1064
      { handle compiler switches }
 
1065
        if (c='$') then
 
1066
         handledirectives;
 
1067
      { handle_switches can dec comment_level,  }
 
1068
        while (comment_level>0) do
 
1069
         begin
 
1070
           case c of
 
1071
            '{' : inc_comment_level;
 
1072
            '}' : dec_comment_level;
 
1073
            #26 : end_of_file;
 
1074
           end;
 
1075
           c:=inputpointer^;
 
1076
           if c=#0 then
 
1077
            reload
 
1078
           else
 
1079
            inc(longint(inputpointer));
 
1080
           case c of
 
1081
            #26 : reload;
 
1082
            #10,
 
1083
            #13 : linebreak;
 
1084
           end;
 
1085
         end;
 
1086
        aktcommentstyle:=comment_none;
 
1087
      end;
 
1088
 
 
1089
 
 
1090
    procedure tscannerfile.skipdelphicomment;
 
1091
      begin
 
1092
        aktcommentstyle:=comment_delphi;
 
1093
        inc_comment_level;
 
1094
        readchar;
 
1095
      { this is currently not supported }
 
1096
        if c='$' then
 
1097
          Message(scan_e_wrong_styled_switch);
 
1098
      { skip comment }
 
1099
        while c<>newline do
 
1100
         begin
 
1101
           if c=#26 then
 
1102
            end_of_file;
 
1103
           readchar;
 
1104
         end;
 
1105
        dec_comment_level;
 
1106
        aktcommentstyle:=comment_none;
 
1107
      end;
 
1108
 
 
1109
 
 
1110
    procedure tscannerfile.skipoldtpcomment;
 
1111
      var
 
1112
        found : longint;
 
1113
      begin
 
1114
        aktcommentstyle:=comment_oldtp;
 
1115
        inc_comment_level;
 
1116
        readchar;
 
1117
      { this is currently not supported }
 
1118
        if (c='$') then
 
1119
         handledirectives;
 
1120
      { skip comment }
 
1121
        while (comment_level>0) do
 
1122
         begin
 
1123
           found:=0;
 
1124
           repeat
 
1125
             case c of
 
1126
               #26 :
 
1127
                 end_of_file;
 
1128
               '*' :
 
1129
                 begin
 
1130
                   if found=3 then
 
1131
                    found:=4
 
1132
                   else
 
1133
                    found:=1;
 
1134
                 end;
 
1135
               ')' :
 
1136
                 begin
 
1137
                   if found in [1,4] then
 
1138
                    begin
 
1139
                      dec_comment_level;
 
1140
                      if comment_level=0 then
 
1141
                       found:=2
 
1142
                      else
 
1143
                       found:=0;
 
1144
                    end;
 
1145
                 end;
 
1146
               '(' :
 
1147
                 begin
 
1148
                   if found=4 then
 
1149
                    inc_comment_level;
 
1150
                   found:=3;
 
1151
                 end;
 
1152
               else
 
1153
                 begin
 
1154
                   if found=4 then
 
1155
                    inc_comment_level;
 
1156
                   found:=0;
 
1157
                 end;
 
1158
             end;
 
1159
             c:=inputpointer^;
 
1160
             if c=#0 then
 
1161
              reload
 
1162
             else
 
1163
              inc(longint(inputpointer));
 
1164
             case c of
 
1165
              #26 : reload;
 
1166
              #10,
 
1167
              #13 : linebreak;
 
1168
             end;
 
1169
           until (found=2);
 
1170
         end;
 
1171
        aktcommentstyle:=comment_none;
 
1172
      end;
 
1173
 
 
1174
 
 
1175
 
 
1176
{****************************************************************************
 
1177
                               Token Scanner
 
1178
****************************************************************************}
 
1179
 
 
1180
    procedure tscannerfile.readtoken;
 
1181
      var
 
1182
        code    : integer;
 
1183
        low,high,mid : longint;
 
1184
        m       : longint;
 
1185
        mac     : pmacrosym;
 
1186
        asciinr : string[6];
 
1187
      label
 
1188
         exit_label;
 
1189
      begin
 
1190
        if localswitcheschanged then
 
1191
          begin
 
1192
            aktlocalswitches:=nextaktlocalswitches;
 
1193
            localswitcheschanged:=false;
 
1194
          end;
 
1195
      { was there already a token read, then return that token }
 
1196
        if nexttoken<>NOTOKEN then
 
1197
         begin
 
1198
           token:=nexttoken;
 
1199
           nexttoken:=NOTOKEN;
 
1200
           goto exit_label;
 
1201
         end;
 
1202
 
 
1203
      { Skip all spaces and comments }
 
1204
        repeat
 
1205
          case c of
 
1206
            '{' :
 
1207
              skipcomment;
 
1208
            ' ',#9..#13 :
 
1209
              begin
 
1210
                if parapreprocess then
 
1211
                 begin
 
1212
                   if c=#10 then
 
1213
                    preprocfile^.eolfound:=true
 
1214
                   else
 
1215
                    preprocfile^.spacefound:=true;
 
1216
                 end;
 
1217
                skipspace;
 
1218
              end
 
1219
            else
 
1220
              break;
 
1221
          end;
 
1222
        until false;
 
1223
 
 
1224
      { Save current token position, for EOF its already loaded }
 
1225
        if c<>#26 then
 
1226
         gettokenpos;
 
1227
 
 
1228
      { Check first for a identifier/keyword, this is 20+% faster (PFV) }
 
1229
        if c in ['A'..'Z','a'..'z','_'] then
 
1230
         begin
 
1231
           readstring;
 
1232
           token:=_ID;
 
1233
           idtoken:=_ID;
 
1234
         { keyword or any other known token,
 
1235
           pattern is always uppercased }
 
1236
           if (pattern[1]<>'_') and (length(pattern) in [2..tokenidlen]) then
 
1237
            begin
 
1238
              low:=ord(tokenidx^[length(pattern),pattern[1]].first);
 
1239
              high:=ord(tokenidx^[length(pattern),pattern[1]].last);
 
1240
              while low<high do
 
1241
               begin
 
1242
                 mid:=(high+low+1) shr 1;
 
1243
                 if pattern<tokeninfo^[ttoken(mid)].str then
 
1244
                  high:=mid-1
 
1245
                 else
 
1246
                  low:=mid;
 
1247
               end;
 
1248
              if pattern=tokeninfo^[ttoken(high)].str then
 
1249
               begin
 
1250
                 if tokeninfo^[ttoken(high)].keyword in aktmodeswitches then
 
1251
                  if tokeninfo^[ttoken(high)].op=NOTOKEN then
 
1252
                    token:=ttoken(high)
 
1253
                  else
 
1254
                    token:=tokeninfo^[ttoken(high)].op;
 
1255
                 idtoken:=ttoken(high);
 
1256
               end;
 
1257
            end;
 
1258
         { Only process identifiers and not keywords }
 
1259
           if token=_ID then
 
1260
            begin
 
1261
            { this takes some time ... }
 
1262
              if (cs_support_macro in aktmoduleswitches) then
 
1263
               begin
 
1264
                 mac:=pmacrosym(macros^.search(pattern));
 
1265
                 if assigned(mac) and (assigned(mac^.buftext)) then
 
1266
                  begin
 
1267
                    insertmacro(pattern,mac^.buftext,mac^.buflen);
 
1268
                  { handle empty macros }
 
1269
                    if c=#0 then
 
1270
                     begin
 
1271
                       reload;
 
1272
                       case c of
 
1273
                        #26 : reload;
 
1274
                        #10,
 
1275
                        #13 : linebreak;
 
1276
                       end;
 
1277
                     end;
 
1278
                  { play it again ... }
 
1279
                    inc(yylexcount);
 
1280
                    if yylexcount>16 then
 
1281
                     Message(scan_w_macro_deep_ten);
 
1282
                    readtoken;
 
1283
                  { that's all folks }
 
1284
                    dec(yylexcount);
 
1285
                    exit;
 
1286
                  end;
 
1287
               end;
 
1288
            end;
 
1289
         { return token }
 
1290
           goto exit_label;
 
1291
         end
 
1292
        else
 
1293
         begin
 
1294
           idtoken:=_NOID;
 
1295
           case c of
 
1296
 
 
1297
             '$' :
 
1298
               begin
 
1299
                 readnumber;
 
1300
                 token:=_INTCONST;
 
1301
                 goto exit_label;
 
1302
               end;
 
1303
 
 
1304
             '%' :
 
1305
               begin
 
1306
                 if (m_tp in aktmodeswitches) then
 
1307
                  Illegal_Char(c)
 
1308
                 else
 
1309
                  begin
 
1310
                    readnumber;
 
1311
                    token:=_INTCONST;
 
1312
                    goto exit_label;
 
1313
                  end;
 
1314
               end;
 
1315
 
 
1316
             '0'..'9' :
 
1317
               begin
 
1318
                 readnumber;
 
1319
                 if (c in ['.','e','E']) then
 
1320
                  begin
 
1321
                  { first check for a . }
 
1322
                    if c='.' then
 
1323
                     begin
 
1324
                       readchar;
 
1325
                       { is it a .. from a range? }
 
1326
                       case c of
 
1327
                         '.' :
 
1328
                           begin
 
1329
                             readchar;
 
1330
                             token:=_INTCONST;
 
1331
                             nexttoken:=_POINTPOINT;
 
1332
                             goto exit_label;
 
1333
                           end;
 
1334
                         ')' :
 
1335
                           begin
 
1336
                             readchar;
 
1337
                             token:=_INTCONST;
 
1338
                             nexttoken:=_RECKKLAMMER;
 
1339
                             goto exit_label;
 
1340
                           end;
 
1341
                       end;
 
1342
                       { insert the number after the . }
 
1343
                       pattern:=pattern+'.';
 
1344
                       while c in ['0'..'9'] do
 
1345
                        begin
 
1346
                          pattern:=pattern+c;
 
1347
                          readchar;
 
1348
                        end;
 
1349
                      end;
 
1350
                  { E can also follow after a point is scanned }
 
1351
                    if c in ['e','E'] then
 
1352
                     begin
 
1353
                       pattern:=pattern+'E';
 
1354
                       readchar;
 
1355
                       if c in ['-','+'] then
 
1356
                        begin
 
1357
                          pattern:=pattern+c;
 
1358
                          readchar;
 
1359
                        end;
 
1360
                       if not(c in ['0'..'9']) then
 
1361
                        Illegal_Char(c);
 
1362
                       while c in ['0'..'9'] do
 
1363
                        begin
 
1364
                          pattern:=pattern+c;
 
1365
                          readchar;
 
1366
                        end;
 
1367
                     end;
 
1368
                    token:=_REALNUMBER;
 
1369
                    goto exit_label;
 
1370
                  end;
 
1371
                 token:=_INTCONST;
 
1372
                 goto exit_label;
 
1373
               end;
 
1374
 
 
1375
             ';' :
 
1376
               begin
 
1377
                 readchar;
 
1378
                 token:=_SEMICOLON;
 
1379
                 goto exit_label;
 
1380
               end;
 
1381
 
 
1382
             '[' :
 
1383
               begin
 
1384
                 readchar;
 
1385
                 token:=_LECKKLAMMER;
 
1386
                 goto exit_label;
 
1387
               end;
 
1388
 
 
1389
             ']' :
 
1390
               begin
 
1391
                 readchar;
 
1392
                 token:=_RECKKLAMMER;
 
1393
                 goto exit_label;
 
1394
               end;
 
1395
 
 
1396
             '(' :
 
1397
               begin
 
1398
                 readchar;
 
1399
                 case c of
 
1400
                   '*' :
 
1401
                     begin
 
1402
                       skipoldtpcomment;
 
1403
                       readtoken;
 
1404
                       exit;
 
1405
                     end;
 
1406
                   '.' :
 
1407
                     begin
 
1408
                       readchar;
 
1409
                       token:=_LECKKLAMMER;
 
1410
                       goto exit_label;
 
1411
                     end;
 
1412
                 end;
 
1413
                 token:=_LKLAMMER;
 
1414
                 goto exit_label;
 
1415
               end;
 
1416
 
 
1417
             ')' :
 
1418
               begin
 
1419
                 readchar;
 
1420
                 token:=_RKLAMMER;
 
1421
                 goto exit_label;
 
1422
               end;
 
1423
 
 
1424
             '+' :
 
1425
               begin
 
1426
                 readchar;
 
1427
                 if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
 
1428
                  begin
 
1429
                    readchar;
 
1430
                    token:=_PLUSASN;
 
1431
                    goto exit_label;
 
1432
                  end;
 
1433
                 token:=_PLUS;
 
1434
                 goto exit_label;
 
1435
               end;
 
1436
 
 
1437
             '-' :
 
1438
               begin
 
1439
                 readchar;
 
1440
                 if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
 
1441
                  begin
 
1442
                    readchar;
 
1443
                    token:=_MINUSASN;
 
1444
                    goto exit_label;
 
1445
                  end;
 
1446
                 token:=_MINUS;
 
1447
                 goto exit_label;
 
1448
               end;
 
1449
 
 
1450
             ':' :
 
1451
               begin
 
1452
                 readchar;
 
1453
                 if c='=' then
 
1454
                  begin
 
1455
                    readchar;
 
1456
                    token:=_ASSIGNMENT;
 
1457
                    goto exit_label;
 
1458
                  end;
 
1459
                 token:=_COLON;
 
1460
                 goto exit_label;
 
1461
               end;
 
1462
 
 
1463
             '*' :
 
1464
               begin
 
1465
                 readchar;
 
1466
                 if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
 
1467
                  begin
 
1468
                    readchar;
 
1469
                    token:=_STARASN;
 
1470
                  end
 
1471
                 else
 
1472
                  if c='*' then
 
1473
                   begin
 
1474
                     readchar;
 
1475
                     token:=_STARSTAR;
 
1476
                   end
 
1477
                 else
 
1478
                  token:=_STAR;
 
1479
                 goto exit_label;
 
1480
               end;
 
1481
 
 
1482
             '/' :
 
1483
               begin
 
1484
                 readchar;
 
1485
                 case c of
 
1486
                   '=' :
 
1487
                     begin
 
1488
                       if (cs_support_c_operators in aktmoduleswitches) then
 
1489
                        begin
 
1490
                          readchar;
 
1491
                          token:=_SLASHASN;
 
1492
                          goto exit_label;
 
1493
                        end;
 
1494
                     end;
 
1495
                   '/' :
 
1496
                     begin
 
1497
                       skipdelphicomment;
 
1498
                       readtoken;
 
1499
                       exit;
 
1500
                     end;
 
1501
                 end;
 
1502
                 token:=_SLASH;
 
1503
                 goto exit_label;
 
1504
               end;
 
1505
 
 
1506
             '=' :
 
1507
               begin
 
1508
                 readchar;
 
1509
                 token:=_EQUAL;
 
1510
                 goto exit_label;
 
1511
               end;
 
1512
 
 
1513
             '.' :
 
1514
               begin
 
1515
                 readchar;
 
1516
                 case c of
 
1517
                   '.' :
 
1518
                     begin
 
1519
                       readchar;
 
1520
                       token:=_POINTPOINT;
 
1521
                       goto exit_label;
 
1522
                     end;
 
1523
                   ')' :
 
1524
                     begin
 
1525
                       readchar;
 
1526
                       token:=_RECKKLAMMER;
 
1527
                       goto exit_label;
 
1528
                     end;
 
1529
                 end;
 
1530
                 token:=_POINT;
 
1531
                 goto exit_label;
 
1532
               end;
 
1533
 
 
1534
             '@' :
 
1535
               begin
 
1536
                 readchar;
 
1537
                 if c='@' then
 
1538
                  begin
 
1539
                    readchar;
 
1540
                    token:=_DOUBLEADDR;
 
1541
                  end
 
1542
                 else
 
1543
                  token:=_KLAMMERAFFE;
 
1544
                 goto exit_label;
 
1545
               end;
 
1546
 
 
1547
             ',' :
 
1548
               begin
 
1549
                 readchar;
 
1550
                 token:=_COMMA;
 
1551
                 goto exit_label;
 
1552
               end;
 
1553
 
 
1554
             '''','#','^' :
 
1555
               begin
 
1556
                 if c='^' then
 
1557
                  begin
 
1558
                    readchar;
 
1559
                    c:=upcase(c);
 
1560
                    if (block_type=bt_type) or
 
1561
                       (lasttoken=_ID) or
 
1562
                       (lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then
 
1563
                     begin
 
1564
                       token:=_CARET;
 
1565
                       goto exit_label;
 
1566
                     end
 
1567
                    else
 
1568
                     begin
 
1569
                       if c<#64 then
 
1570
                        pattern:=chr(ord(c)+64)
 
1571
                       else
 
1572
                        pattern:=chr(ord(c)-64);
 
1573
                       readchar;
 
1574
                     end;
 
1575
                  end
 
1576
                 else
 
1577
                  pattern:='';
 
1578
                 repeat
 
1579
                   case c of
 
1580
                     '#' :
 
1581
                       begin
 
1582
                         readchar; { read # }
 
1583
                         if c='$' then
 
1584
                           begin
 
1585
                              readchar; { read leading $ }
 
1586
                              asciinr:='$';
 
1587
                              while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<6) do
 
1588
                               begin
 
1589
                                 asciinr:=asciinr+c;
 
1590
                                 readchar;
 
1591
                               end;
 
1592
                           end
 
1593
                         else
 
1594
                           begin
 
1595
                              asciinr:='';
 
1596
                              while (c in ['0'..'9']) and (length(asciinr)<6) do
 
1597
                               begin
 
1598
                                 asciinr:=asciinr+c;
 
1599
                                 readchar;
 
1600
                               end;
 
1601
                           end;
 
1602
                         valint(asciinr,m,code);
 
1603
                         if (asciinr='') or (code<>0) or
 
1604
                            (m<0) or (m>255) then
 
1605
                          Message(scan_e_illegal_char_const);
 
1606
                         pattern:=pattern+chr(m);
 
1607
                       end;
 
1608
                     '''' :
 
1609
                       begin
 
1610
                         repeat
 
1611
                           readchar;
 
1612
                           case c of
 
1613
                             #26 :
 
1614
                               end_of_file;
 
1615
                             newline :
 
1616
                               Message(scan_f_string_exceeds_line);
 
1617
                             '''' :
 
1618
                               begin
 
1619
                                 readchar;
 
1620
                                 if c<>'''' then
 
1621
                                  break;
 
1622
                               end;
 
1623
                           end;
 
1624
                           pattern:=pattern+c;
 
1625
                         until false;
 
1626
                       end;
 
1627
                     '^' :
 
1628
                       begin
 
1629
                         readchar;
 
1630
                         c:=upcase(c);
 
1631
                         if c<#64 then
 
1632
                          c:=chr(ord(c)+64)
 
1633
                         else
 
1634
                          c:=chr(ord(c)-64);
 
1635
                         pattern:=pattern+c;
 
1636
                         readchar;
 
1637
                       end;
 
1638
                     else
 
1639
                      break;
 
1640
                   end;
 
1641
                 until false;
 
1642
               { strings with length 1 become const chars }
 
1643
                 if length(pattern)=1 then
 
1644
                  token:=_CCHAR
 
1645
                 else
 
1646
                  token:=_CSTRING;
 
1647
                 goto exit_label;
 
1648
               end;
 
1649
 
 
1650
             '>' :
 
1651
               begin
 
1652
                 readchar;
 
1653
                 case c of
 
1654
                   '=' :
 
1655
                     begin
 
1656
                       readchar;
 
1657
                       token:=_GTE;
 
1658
                       goto exit_label;
 
1659
                     end;
 
1660
                   '>' :
 
1661
                     begin
 
1662
                       readchar;
 
1663
                       token:=_OP_SHR;
 
1664
                       goto exit_label;
 
1665
                     end;
 
1666
                   '<' :
 
1667
                     begin { >< is for a symetric diff for sets }
 
1668
                       readchar;
 
1669
                       token:=_SYMDIF;
 
1670
                       goto exit_label;
 
1671
                     end;
 
1672
                 end;
 
1673
                 token:=_GT;
 
1674
                 goto exit_label;
 
1675
               end;
 
1676
 
 
1677
             '<' :
 
1678
               begin
 
1679
                 readchar;
 
1680
                 case c of
 
1681
                   '>' :
 
1682
                     begin
 
1683
                       readchar;
 
1684
                       token:=_UNEQUAL;
 
1685
                       goto exit_label;
 
1686
                     end;
 
1687
                   '=' :
 
1688
                     begin
 
1689
                       readchar;
 
1690
                       token:=_LTE;
 
1691
                       goto exit_label;
 
1692
                     end;
 
1693
                   '<' :
 
1694
                     begin
 
1695
                       readchar;
 
1696
                       token:=_OP_SHL;
 
1697
                       goto exit_label;
 
1698
                     end;
 
1699
                 end;
 
1700
                 token:=_LT;
 
1701
                 goto exit_label;
 
1702
               end;
 
1703
 
 
1704
             #26 :
 
1705
               begin
 
1706
                 token:=_EOF;
 
1707
                 checkpreprocstack;
 
1708
                 goto exit_label;
 
1709
               end;
 
1710
             else
 
1711
               Illegal_Char(c);
 
1712
           end;
 
1713
        end;
 
1714
exit_label:
 
1715
        lasttoken:=token;
 
1716
      end;
 
1717
 
 
1718
 
 
1719
    function tscannerfile.readpreproc:ttoken;
 
1720
      begin
 
1721
         skipspace;
 
1722
         case c of
 
1723
        'A'..'Z',
 
1724
        'a'..'z',
 
1725
    '_','0'..'9' : begin
 
1726
                     preprocpat:=readid;
 
1727
                     readpreproc:=_ID;
 
1728
                   end;
 
1729
             '}' : begin
 
1730
                     readpreproc:=_END;
 
1731
                   end;
 
1732
             '(' : begin
 
1733
                     readchar;
 
1734
                     readpreproc:=_LKLAMMER;
 
1735
                   end;
 
1736
             ')' : begin
 
1737
                     readchar;
 
1738
                     readpreproc:=_RKLAMMER;
 
1739
                   end;
 
1740
             '+' : begin
 
1741
                     readchar;
 
1742
                     readpreproc:=_PLUS;
 
1743
                   end;
 
1744
             '-' : begin
 
1745
                     readchar;
 
1746
                     readpreproc:=_MINUS;
 
1747
                   end;
 
1748
             '*' : begin
 
1749
                     readchar;
 
1750
                     readpreproc:=_STAR;
 
1751
                   end;
 
1752
             '/' : begin
 
1753
                     readchar;
 
1754
                     readpreproc:=_SLASH;
 
1755
                   end;
 
1756
             '=' : begin
 
1757
                     readchar;
 
1758
                     readpreproc:=_EQUAL;
 
1759
                   end;
 
1760
             '>' : begin
 
1761
                     readchar;
 
1762
                     if c='=' then
 
1763
                      begin
 
1764
                        readchar;
 
1765
                        readpreproc:=_GTE;
 
1766
                      end
 
1767
                     else
 
1768
                      readpreproc:=_GT;
 
1769
                   end;
 
1770
             '<' : begin
 
1771
                     readchar;
 
1772
                     case c of
 
1773
                      '>' : begin
 
1774
                              readchar;
 
1775
                              readpreproc:=_UNEQUAL;
 
1776
                            end;
 
1777
                      '=' : begin
 
1778
                              readchar;
 
1779
                              readpreproc:=_LTE;
 
1780
                            end;
 
1781
                     else   readpreproc:=_LT;
 
1782
                     end;
 
1783
                   end;
 
1784
             #26 :
 
1785
               end_of_file;
 
1786
         else
 
1787
          begin
 
1788
            readpreproc:=_EOF;
 
1789
            checkpreprocstack;
 
1790
          end;
 
1791
         end;
 
1792
      end;
 
1793
 
 
1794
 
 
1795
    function tscannerfile.asmgetchar : char;
 
1796
      begin
 
1797
         if lastasmgetchar<>#0 then
 
1798
          begin
 
1799
            c:=lastasmgetchar;
 
1800
            lastasmgetchar:=#0;
 
1801
          end
 
1802
         else
 
1803
          readchar;
 
1804
         if in_asm_string then
 
1805
           begin
 
1806
             asmgetchar:=c;
 
1807
             exit;
 
1808
           end;
 
1809
         case c of
 
1810
          '{' : begin
 
1811
                  skipcomment;
 
1812
                  asmgetchar:=c;
 
1813
                  exit;
 
1814
                end;
 
1815
          '/' : begin
 
1816
                  readchar;
 
1817
                  if c='/' then
 
1818
                   begin
 
1819
                     skipdelphicomment;
 
1820
                     asmgetchar:=c;
 
1821
                   end
 
1822
                  else
 
1823
                   begin
 
1824
                     asmgetchar:='/';
 
1825
                     lastasmgetchar:=c;
 
1826
                   end;
 
1827
                  exit;
 
1828
                end;
 
1829
          '(' : begin
 
1830
                  readchar;
 
1831
                  if c='*' then
 
1832
                   begin
 
1833
                     skipoldtpcomment;
 
1834
                     asmgetchar:=c;
 
1835
                   end
 
1836
                  else
 
1837
                   begin
 
1838
                     asmgetchar:='(';
 
1839
                     lastasmgetchar:=c;
 
1840
                   end;
 
1841
                  exit;
 
1842
                end;
 
1843
         else
 
1844
          begin
 
1845
            asmgetchar:=c;
 
1846
          end;
 
1847
         end;
 
1848
      end;
 
1849
 
 
1850
end.
 
1851
{
 
1852
  $Log: scanner.pas,v $
 
1853
  Revision 1.1.2.5  2000/12/18 18:00:54  peter
 
1854
    * skipuntildirective fix
 
1855
 
 
1856
  Revision 1.1.2.4  2000/12/16 15:30:12  peter
 
1857
    * fixed parsing of comments in string with skipuntildirective
 
1858
 
 
1859
  Revision 1.1.2.3  2000/11/30 00:33:34  pierre
 
1860
   * fix for web bug 1229
 
1861
 
 
1862
  Revision 1.1.2.2  2000/08/12 15:29:52  peter
 
1863
    * patch from Gabor for IDE to support memory stream reading
 
1864
 
 
1865
  Revision 1.1.2.1  2000/08/08 19:19:11  peter
 
1866
    * only report illegal directives once
 
1867
 
 
1868
  Revision 1.1  2000/07/13 06:29:56  michael
 
1869
  + Initial import
 
1870
 
 
1871
  Revision 1.116  2000/07/08 18:03:11  peter
 
1872
    * undid my previous commit, because it breaks some code
 
1873
 
 
1874
  Revision 1.115  2000/07/08 16:22:30  peter
 
1875
    * also support string parsing in skipuntildirective for fpc modes
 
1876
 
 
1877
  Revision 1.114  2000/06/30 20:23:38  peter
 
1878
    * new message files layout with msg numbers (but still no code to
 
1879
      show the number on the screen)
 
1880
 
 
1881
  Revision 1.113  2000/06/18 18:05:54  peter
 
1882
    * no binary value reading with % if not fpc mode
 
1883
    * extended illegal char message with the char itself (Delphi like)
 
1884
 
 
1885
  Revision 1.112  2000/06/09 21:35:37  peter
 
1886
    * fixed parsing of $if preproc function
 
1887
 
 
1888
  Revision 1.111  2000/05/03 14:36:58  pierre
 
1889
   * fix for tests/test/testrang.pp bug
 
1890
 
 
1891
  Revision 1.110  2000/04/08 20:18:53  michael
 
1892
  * Fixed bug in readcomment that was dropping * characters
 
1893
 
 
1894
  Revision 1.109  2000/03/13 21:21:57  peter
 
1895
    * ^m support also after a string
 
1896
 
 
1897
  Revision 1.108  2000/03/12 17:53:16  florian
 
1898
    * very small change to scanner ...
 
1899
 
 
1900
  Revision 1.107  2000/02/29 23:59:47  pierre
 
1901
   Use $GOTO ON
 
1902
 
 
1903
  Revision 1.106  2000/02/28 17:23:57  daniel
 
1904
  * Current work of symtable integration committed. The symtable can be
 
1905
    activated by defining 'newst', but doesn't compile yet. Changes in type
 
1906
    checking and oop are completed. What is left is to write a new
 
1907
    symtablestack and adapt the parser to use it.
 
1908
 
 
1909
  Revision 1.105  2000/02/09 13:23:03  peter
 
1910
    * log truncated
 
1911
 
 
1912
  Revision 1.104  2000/01/30 19:28:25  peter
 
1913
    * fixed filepos when eof is read, it'll now stay on the eof position
 
1914
 
 
1915
  Revision 1.103  2000/01/07 01:14:38  peter
 
1916
    * updated copyright to 2000
 
1917
 
 
1918
  Revision 1.102  1999/12/02 17:34:34  peter
 
1919
    * preprocessor support. But it fails on the caret in type blocks
 
1920
 
 
1921
  Revision 1.101  1999/11/15 17:52:59  pierre
 
1922
    + one field added for ttoken record for operator
 
1923
      linking the id to the corresponding operator token that
 
1924
      can now now all be overloaded
 
1925
    * overloaded operators are resetted to nil in InitSymtable
 
1926
      (bug when trying to compile a uint that overloads operators twice)
 
1927
 
 
1928
  Revision 1.100  1999/11/06 14:34:26  peter
 
1929
    * truncated log to 20 revs
 
1930
 
 
1931
  Revision 1.99  1999/11/03 23:44:28  peter
 
1932
    * fixed comment level counting after directive
 
1933
 
 
1934
  Revision 1.98  1999/11/02 15:05:08  peter
 
1935
    * fixed oldtp comment parsing
 
1936
 
 
1937
  Revision 1.97  1999/10/30 12:32:30  peter
 
1938
    * fixed line counter when the first line had #10 only. This was buggy
 
1939
      for both the main file as for include files
 
1940
 
 
1941
  Revision 1.96  1999/09/27 23:40:10  peter
 
1942
    * fixed macro within macro endless-loop
 
1943
 
 
1944
  Revision 1.95  1999/09/03 10:02:48  peter
 
1945
    * $IFNDEF is 7 chars and not 6 chars
 
1946
 
 
1947
  Revision 1.94  1999/09/02 18:47:47  daniel
 
1948
    * Could not compile with TP, some arrays moved to heap
 
1949
    * NOAG386BIN default for TP
 
1950
    * AG386* files were not compatible with TP, fixed.
 
1951
 
 
1952
  Revision 1.93  1999/08/30 10:17:58  peter
 
1953
    * fixed crash in psub
 
1954
    * ansistringcompare fixed
 
1955
    * support for #$0b8
 
1956
 
 
1957
  Revision 1.92  1999/08/06 13:11:44  michael
 
1958
  * Removed C style comments.
 
1959
 
 
1960
  Revision 1.91  1999/08/05 16:53:11  peter
 
1961
    * V_Fatal=1, all other V_ are also increased
 
1962
    * Check for local procedure when assigning procvar
 
1963
    * fixed comment parsing because directives
 
1964
    * oldtp mode directives better supported
 
1965
    * added some messages to errore.msg
 
1966
 
 
1967
  Revision 1.90  1999/08/04 13:03:05  jonas
 
1968
    * all tokens now start with an underscore
 
1969
    * PowerPC compiles!!
 
1970
 
 
1971
  Revision 1.89  1999/07/29 11:43:22  peter
 
1972
    * always output preprocstack when unexpected eof is found
 
1973
    * fixed tp7/delphi skipuntildirective parsing
 
1974
 
 
1975
  Revision 1.88  1999/07/24 11:20:59  peter
 
1976
    * directives are allowed in (* *)
 
1977
    * fixed parsing of (* between conditional code
 
1978
 
 
1979
}