← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to utils/tply/lexlib.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/tply/lexlib.pas
1
 
 
2
 
{$I-}
3
 
 
4
 
unit LexLib;
5
 
 
6
 
(* Standard Lex library unit for TP Lex Version 3.0.
7
 
   2-11-91 AG *)
8
 
 
9
 
interface
10
 
 
11
 
(* The Lex library unit supplies a collection of variables and routines
12
 
   needed by the lexical analyzer routine yylex and application programs
13
 
   using Lex-generated lexical analyzers. It also provides access to the
14
 
   input/output streams used by the lexical analyzer and the text of the
15
 
   matched string, and provides some utility functions which may be used
16
 
   in actions.
17
 
 
18
 
   This `standard' version of the LexLib unit is used to implement lexical
19
 
   analyzers which read from and write to MS-DOS files (using standard input
20
 
   and output, by default). It is suitable for many standard applications
21
 
   for lexical analyzers, such as text conversion tools or compilers.
22
 
 
23
 
   However, you may create your own version of the LexLib unit, tailored to
24
 
   your target applications. In particular, you may wish to provide another
25
 
   set of I/O functions, e.g., if you want to read from or write to memory
26
 
   instead to files, or want to use different file types. *)
27
 
 
28
 
(* Variables:
29
 
 
30
 
   The variable yytext contains the current match, yyleng its length.
31
 
   The variable yyline contains the current input line, and yylineno and
32
 
   yycolno denote the current input position (line, column). These values
33
 
   are often used in giving error diagnostics (however, they will only be
34
 
   meaningful if there is no rescanning across line ends).
35
 
 
36
 
   The variables yyinput and yyoutput are the text files which are used
37
 
   by the lexical analyzer. By default, they are assigned to standard
38
 
   input and output, but you may change these assignments to fit your
39
 
   target application (use the Turbo Pascal standard routines assign,
40
 
   reset, and rewrite for this purpose). *)
41
 
 
42
 
var
43
 
 
44
 
yyinput, yyoutput : Text;        (* input and output file *)
45
 
yyline            : String;      (* current input line *)
46
 
yylineno, yycolno : Integer;     (* current input position *)
47
 
yytext            : String;      (* matched text (should be considered r/o) *)
48
 
yyleng            : Byte         (* length of matched text *)
49
 
  absolute yytext;
50
 
 
51
 
(* I/O routines:
52
 
 
53
 
   The following routines get_char, unget_char and put_char are used to
54
 
   implement access to the input and output files. Since \n (newline) for
55
 
   Lex means line end, the I/O routines have to translate MS-DOS line ends
56
 
   (carriage-return/line-feed) into newline characters and vice versa. Input
57
 
   is buffered to allow rescanning text (via unput_char).
58
 
 
59
 
   The input buffer holds the text of the line to be scanned. When the input
60
 
   buffer empties, a new line is obtained from the input stream. Characters
61
 
   can be returned to the input buffer by calls to unget_char. At end-of-
62
 
   file a null character is returned.
63
 
 
64
 
   The input routines also keep track of the input position and set the
65
 
   yyline, yylineno, yycolno variables accordingly.
66
 
 
67
 
   Since the rest of the Lex library only depends on these three routines
68
 
   (there are no direct references to the yyinput and yyoutput files or
69
 
   to the input buffer), you can easily replace get_char, unget_char and
70
 
   put_char by another suitable set of routines, e.g. if you want to read
71
 
   from/write to memory, etc. *)
72
 
 
73
 
function get_char : Char;
74
 
  (* obtain one character from the input file (null character at end-of-
75
 
     file) *)
76
 
 
77
 
procedure unget_char ( c : Char );
78
 
  (* return one character to the input file to be reread in subsequent calls
79
 
     to get_char *)
80
 
 
81
 
procedure put_char ( c : Char );
82
 
  (* write one character to the output file *)
83
 
 
84
 
(* Utility routines: *)
85
 
 
86
 
procedure echo;
87
 
  (* echoes the current match to the output stream *)
88
 
 
89
 
procedure yymore;
90
 
  (* append the next match to the current one *)
91
 
 
92
 
procedure yyless ( n : Integer );
93
 
  (* truncate yytext to size n and return the remaining characters to the
94
 
     input stream *)
95
 
 
96
 
procedure reject;
97
 
  (* reject the current match and execute the next one *)
98
 
 
99
 
  (* reject does not actually cause the input to be rescanned; instead,
100
 
     internal state information is used to find the next match. Hence
101
 
     you should not try to modify the input stream or the yytext variable
102
 
     when rejecting a match. *)
103
 
 
104
 
procedure return ( n : Integer );
105
 
procedure returnc ( c : Char );
106
 
  (* sets the return value of yylex *)
107
 
 
108
 
procedure start ( state : Integer );
109
 
  (* puts the lexical analyzer in the given start state; state=0 denotes
110
 
     the default start state, other values are user-defined *)
111
 
 
112
 
(* yywrap:
113
 
 
114
 
   The yywrap function is called by yylex at end-of-file (unless you have
115
 
   specified a rule matching end-of-file). You may redefine this routine
116
 
   in your Lex program to do application-dependent processing at end of
117
 
   file. In particular, yywrap may arrange for more input and return false
118
 
   in which case the yylex routine resumes lexical analysis. *)
119
 
 
120
 
function yywrap : Boolean;
121
 
  (* The default yywrap routine supplied here closes input and output files
122
 
     and returns true (causing yylex to terminate). *)
123
 
 
124
 
(* The following are the internal data structures and routines used by the
125
 
   lexical analyzer routine yylex; they should not be used directly. *)
126
 
 
127
 
var
128
 
 
129
 
yystate    : Integer; (* current state of lexical analyzer *)
130
 
yyactchar  : Char;    (* current character *)
131
 
yylastchar : Char;    (* last matched character (#0 if none) *)
132
 
yyrule     : Integer; (* matched rule *)
133
 
yyreject   : Boolean; (* current match rejected? *)
134
 
yydone     : Boolean; (* yylex return value set? *)
135
 
yyretval   : Integer; (* yylex return value *)
136
 
 
137
 
procedure yynew;
138
 
  (* starts next match; initializes state information of the lexical
139
 
     analyzer *)
140
 
 
141
 
procedure yyscan;
142
 
  (* gets next character from the input stream and updates yytext and
143
 
     yyactchar accordingly *)
144
 
 
145
 
procedure yymark ( n : Integer );
146
 
  (* marks position for rule no. n *)
147
 
 
148
 
procedure yymatch ( n : Integer );
149
 
  (* declares a match for rule number n *)
150
 
 
151
 
function yyfind ( var n : Integer ) : Boolean;
152
 
  (* finds the last match and the corresponding marked position and adjusts
153
 
     the matched string accordingly; returns:
154
 
     - true if a rule has been matched, false otherwise
155
 
     - n: the number of the matched rule *)
156
 
 
157
 
function yydefault : Boolean;
158
 
  (* executes the default action (copy character); returns true unless
159
 
     at end-of-file *)
160
 
 
161
 
procedure yyclear;
162
 
  (* reinitializes state information after lexical analysis has been
163
 
     finished *)
164
 
 
165
 
implementation
166
 
 
167
 
procedure fatal ( msg : String );
168
 
  (* writes a fatal error message and halts program *)
169
 
  begin
170
 
    writeln('LexLib: ', msg);
171
 
    halt(1);
172
 
  end(*fatal*);
173
 
 
174
 
(* I/O routines: *)
175
 
 
176
 
const nl = #10;  (* newline character *)
177
 
 
178
 
const max_chars = 2048;
179
 
 
180
 
var
181
 
 
182
 
bufptr : Integer;
183
 
buf    : array [1..max_chars] of Char;
184
 
 
185
 
function get_char : Char;
186
 
  var i : Integer;
187
 
  begin
188
 
    if (bufptr=0) and not eof(yyinput) then
189
 
      begin
190
 
        readln(yyinput, yyline);
191
 
        inc(yylineno); yycolno := 1;
192
 
        buf[1] := nl;
193
 
        for i := 1 to length(yyline) do
194
 
          buf[i+1] := yyline[length(yyline)-i+1];
195
 
        inc(bufptr, length(yyline)+1);
196
 
      end;
197
 
    if bufptr>0 then
198
 
      begin
199
 
        get_char := buf[bufptr];
200
 
        dec(bufptr);
201
 
        inc(yycolno);
202
 
      end
203
 
    else
204
 
      get_char := #0;
205
 
  end(*get_char*);
206
 
 
207
 
procedure unget_char ( c : Char );
208
 
  begin
209
 
    if bufptr=max_chars then fatal('input buffer overflow');
210
 
    inc(bufptr);
211
 
    dec(yycolno);
212
 
    buf[bufptr] := c;
213
 
  end(*unget_char*);
214
 
 
215
 
procedure put_char ( c : Char );
216
 
  begin
217
 
    if c=#0 then
218
 
      { ignore }
219
 
    else if c=nl then
220
 
      writeln(yyoutput)
221
 
    else
222
 
      write(yyoutput, c)
223
 
  end(*put_char*);
224
 
 
225
 
(* Variables:
226
 
 
227
 
   Some state information is maintained to keep track with calls to yymore,
228
 
   yyless, reject, start and yymatch/yymark, and to initialize state
229
 
   information used by the lexical analyzer.
230
 
   - yystext: contains the initial contents of the yytext variable; this
231
 
     will be the empty string, unless yymore is called which sets yystext
232
 
     to the current yytext
233
 
   - yysstate: start state of lexical analyzer (set to 0 during
234
 
     initialization, and modified in calls to the start routine)
235
 
   - yylstate: line state information (1 if at beginning of line, 0
236
 
     otherwise)
237
 
   - yystack: stack containing matched rules; yymatches contains the number of
238
 
     matches
239
 
   - yypos: for each rule the last marked position (yymark); zeroed when rule
240
 
     has already been considered
241
 
   - yysleng: copy of the original yyleng used to restore state information
242
 
     when reject is used *)
243
 
 
244
 
const
245
 
 
246
 
max_matches = 1024;
247
 
max_rules   = 256;
248
 
 
249
 
var
250
 
 
251
 
yystext            : String;
252
 
yysstate, yylstate : Integer;
253
 
yymatches          : Integer;
254
 
yystack            : array [1..max_matches] of Integer;
255
 
yypos              : array [1..max_rules] of Integer;
256
 
yysleng            : Byte;
257
 
 
258
 
(* Utilities: *)
259
 
 
260
 
procedure echo;
261
 
  var i : Integer;
262
 
  begin
263
 
    for i := 1 to yyleng do
264
 
      put_char(yytext[i])
265
 
  end(*echo*);
266
 
 
267
 
procedure yymore;
268
 
  begin
269
 
    yystext := yytext;
270
 
  end(*yymore*);
271
 
 
272
 
procedure yyless ( n : Integer );
273
 
  var i : Integer;
274
 
  begin
275
 
    for i := yyleng downto n+1 do
276
 
      unget_char(yytext[i]);
277
 
    yyleng := n;
278
 
  end(*yyless*);
279
 
 
280
 
procedure reject;
281
 
  var i : Integer;
282
 
  begin
283
 
    yyreject := true;
284
 
    for i := yyleng+1 to yysleng do
285
 
      yytext := yytext+get_char;
286
 
    dec(yymatches);
287
 
  end(*reject*);
288
 
 
289
 
procedure return ( n : Integer );
290
 
  begin
291
 
    yyretval := n;
292
 
    yydone := true;
293
 
  end(*return*);
294
 
 
295
 
procedure returnc ( c : Char );
296
 
  begin
297
 
    yyretval := ord(c);
298
 
    yydone := true;
299
 
  end(*returnc*);
300
 
 
301
 
procedure start ( state : Integer );
302
 
  begin
303
 
    yysstate := state;
304
 
  end(*start*);
305
 
 
306
 
(* yywrap: *)
307
 
 
308
 
function yywrap : Boolean;
309
 
  begin
310
 
    close(yyinput); close(yyoutput);
311
 
    yywrap := true;
312
 
  end(*yywrap*);
313
 
 
314
 
(* Internal routines: *)
315
 
 
316
 
procedure yynew;
317
 
  begin
318
 
    if yylastchar<>#0 then
319
 
      if yylastchar=nl then
320
 
        yylstate := 1
321
 
      else
322
 
        yylstate := 0;
323
 
    yystate := yysstate+yylstate;
324
 
    yytext  := yystext;
325
 
    yystext := '';
326
 
    yymatches := 0;
327
 
    yydone := false;
328
 
  end(*yynew*);
329
 
 
330
 
procedure yyscan;
331
 
  begin
332
 
    if yyleng=255 then fatal('yytext overflow');
333
 
    yyactchar := get_char;
334
 
    inc(yyleng);
335
 
    yytext[yyleng] := yyactchar;
336
 
  end(*yyscan*);
337
 
 
338
 
procedure yymark ( n : Integer );
339
 
  begin
340
 
    if n>max_rules then fatal('too many rules');
341
 
    yypos[n] := yyleng;
342
 
  end(*yymark*);
343
 
 
344
 
procedure yymatch ( n : Integer );
345
 
  begin
346
 
    inc(yymatches);
347
 
    if yymatches>max_matches then fatal('match stack overflow');
348
 
    yystack[yymatches] := n;
349
 
  end(*yymatch*);
350
 
 
351
 
function yyfind ( var n : Integer ) : Boolean;
352
 
  begin
353
 
    yyreject := false;
354
 
    while (yymatches>0) and (yypos[yystack[yymatches]]=0) do
355
 
      dec(yymatches);
356
 
    if yymatches>0 then
357
 
      begin
358
 
        yysleng := yyleng;
359
 
        n       := yystack[yymatches];
360
 
        yyless(yypos[n]);
361
 
        yypos[n] := 0;
362
 
        if yyleng>0 then
363
 
          yylastchar := yytext[yyleng]
364
 
        else
365
 
          yylastchar := #0;
366
 
        yyfind := true;
367
 
      end
368
 
    else
369
 
      begin
370
 
        yyless(0);
371
 
        yylastchar := #0;
372
 
        yyfind := false;
373
 
      end
374
 
  end(*yyfind*);
375
 
 
376
 
function yydefault : Boolean;
377
 
  begin
378
 
    yyreject := false;
379
 
    yyactchar := get_char;
380
 
    if yyactchar<>#0 then
381
 
      begin
382
 
        put_char(yyactchar);
383
 
        yydefault := true;
384
 
      end
385
 
    else
386
 
      begin
387
 
        yylstate := 1;
388
 
        yydefault := false;
389
 
      end;
390
 
    yylastchar := yyactchar;
391
 
  end(*yydefault*);
392
 
 
393
 
procedure yyclear;
394
 
  begin
395
 
    bufptr := 0;
396
 
    yysstate := 0;
397
 
    yylstate := 1;
398
 
    yylastchar := #0;
399
 
    yytext := '';
400
 
    yystext := '';
401
 
  end(*yyclear*);
402
 
 
403
 
begin
404
 
  assign(yyinput, '');
405
 
  assign(yyoutput, '');
406
 
  reset(yyinput); rewrite(yyoutput);
407
 
  yylineno := 0;
408
 
  yyclear;
409
 
end(*LexLib*).