FreeBASIC  0.91.0
lex.bas
Go to the documentation of this file.
1 '' lexical scanner
2 ''
3 ''
4 '' chng: sep/2004 written [v1ctor]
5 '' nov/2005 unicode support added [v1ctor]
6 
7 
8 #include once "fb.bi"
9 #include once "fbint.bi"
10 #include once "lex.bi"
11 #include once "pp.bi"
12 #include once "parser.bi"
13 
14 declare sub lexReadUTF8 ( )
15 
16 declare sub lexReadUTF16LE ( )
17 
18 declare sub lexReadUTF16BE ( )
19 
20 declare sub lexReadUTF32LE ( )
21 
22 declare sub lexReadUTF32BE ( )
23 
24 declare sub hMultiLineComment ( )
25 
26 const UINVALID as uinteger = cuint( INVALID )
27 
28 dim shared as LEX_CTX lex
29 
30 '' Buffer holding the current line when emitting in -pp only mode
31 dim shared as string pponly_ln
32 
33 '':::::
34 '' only update the line count if not inside a multi-line macro
35 #define UPDATE_LINENUM( ) _
36  if( lex.ctx->deflen = 0 ) then :_
37  lex.ctx->linenum += 1 :_
38  end if
39 
40 '':::::
41 sub lexPushCtx( )
42 
43  lex.ctx += 1
44 
45 end sub
46 
47 '':::::
48 sub lexPopCtx( )
49 
50  if( env.includerec = 0 ) then
51  DZstrAllocate( lex.ctx->currline, 0 )
52  end if
53 
54  '' free dynamic strings used in macro expansions
55  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
56  DZstrAllocate( lex.ctx->deftext, 0 )
57  else
58  DWstrAllocate( lex.ctx->deftextw, 0 )
59  end if
60 
61  lex.ctx -= 1
62 
63 end sub
64 
65 
66 '':::::
67 sub lexInit _
68  ( _
69  byval isinclude as integer _
70  )
71 
72  dim as integer i
73  dim as FBTOKEN ptr n
74 
75  if( env.includerec = 0 ) then
76  lex.ctx = @lex.ctxTB(0)
77  end if
78 
79  '' create a circular list
80  lex.ctx->k = 0
81 
82  lex.ctx->head = @lex.ctx->tokenTB(0)
83  lex.ctx->tail = lex.ctx->head
84 
85  n = lex.ctx->head
86  for i = 0 to FB_LEX_MAXK-1
87  n->next = @lex.ctx->tokenTB(i+1)
88  n = n->next
89  next
90  n->next = lex.ctx->head
91 
92  ''
93  for i = 0 to FB_LEX_MAXK
94  lex.ctx->tokenTB(i).id = INVALID
95  next
96 
97  lex.ctx->currchar = UINVALID
98  lex.ctx->lahdchar = UINVALID
99 
100  lex.ctx->linenum = 1
101  lex.ctx->lasttk_id = INVALID
102 
103  lex.ctx->reclevel = 0
104  lex.ctx->currmacro = NULL
105 
106  ''
107  lex.ctx->bufflen = 0
108  lex.ctx->deflen = 0
109 
110  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
111  lex.ctx->buffptr = NULL
112  lex.ctx->defptr = NULL
113  DZstrAllocate( lex.ctx->deftext, 0 )
114  else
115  lex.ctx->buffptrw = NULL
116  lex.ctx->defptrw = NULL
117  DWstrAllocate( lex.ctx->deftextw, 0 )
118  end if
119 
120  ''
121  lex.ctx->filepos = 0
122  lex.ctx->lastfilepos = 0
123 
124  '' only if it's not on an inc file
125  if( env.includerec = 0 ) then
126  DZstrAllocate( lex.ctx->currline, 0 )
127  lex.insidemacro = FALSE
128  end if
129 
130  lex.ctx->after_space = FALSE
131 
132  if( isinclude = FALSE ) then
133  ppInit( )
134  end if
135 
136 end sub
137 
138 '':::::
139 sub lexEnd( )
140 
141  pponly_ln = ""
142 
143  ppEnd( )
144 
145 end sub
146 
147 sub hCollectCharForDebugOutput( byval char as uinteger )
148  if( char < 32 ) then
149  '' Filter out ASCII control chars, as they really shouldn't be
150  '' emitted into .asm/.c, because, for example, &h17 (ETB, end of
151  '' transmission block) apparently causes GAS to stop early,
152  '' instead of reading until the rest of the .asm file, even if
153  '' it's inside a comment.
154  select case as const( char )
155  case 0, CHAR_CR, CHAR_LF
156  exit sub
157 
158  '' Those white-space chars should be ok though
159  case CHAR_TAB, CHAR_VTAB, CHAR_FORMFEED
160 
161  case else
162  char = asc( "?" )
163  end select
164 
165  '' Unicode char? Can't be stored into lex.ctx->currline zstring,
166  '' and .asm/.c output files are ANSI/ASCII-only anyways.
167  elseif( char > 255 ) then
168  char = asc( "?" )
169  end if
170 
171  DZstrConcatAssignC( lex.ctx->currline, char )
172 end sub
173 
174 '':::::
175 function hReadChar _
176  ( _
177  _
178  ) as uinteger
179 
180  dim as uinteger char = any
181 
182  '' any #define'd text?
183  if( lex.ctx->deflen > 0 ) then
184 
185  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
186  char = *lex.ctx->defptr
187  else
188  char = *lex.ctx->defptrw
189  end if
190 
191  '' update current line text (if not parsing an inc file)
192  if( env.clopt.debug ) then
193  if( env.includerec = 0 ) then
194  if( lex.insidemacro = FALSE ) then
195  lex.insidemacro = TRUE
196  DZstrConcatAssign( lex.ctx->currline, " [Macro Expansion: " )
197  end if
198 
200  end if
201  end if
202 
203  else
204 
205  '' buffer empty?
206  if( lex.ctx->bufflen = 0 ) then
207  if( eof( env.inf.num ) = FALSE ) then
208  lex.ctx->filepos = seek( env.inf.num )
209 
210  select case as const env.inf.format
211  case FBFILE_FORMAT_ASCII
212  if( get( #env.inf.num, , lex.ctx->buff ) = 0 ) then
213  lex.ctx->bufflen = seek( env.inf.num ) - lex.ctx->filepos
214  lex.ctx->buffptr = @lex.ctx->buff
215  end if
216 
217  case FBFILE_FORMAT_UTF8
218  lexReadUTF8( )
219 
220  case FBFILE_FORMAT_UTF16LE
221  lexReadUTF16LE( )
222 
223  case FBFILE_FORMAT_UTF16BE
224  lexReadUTF16BE( )
225 
226  case FBFILE_FORMAT_UTF32LE
227  lexReadUTF32LE( )
228 
229  case FBFILE_FORMAT_UTF32BE
230  lexReadUTF32BE( )
231 
232  end select
233 
234  end if
235  end if
236 
237  ''
238  if( lex.ctx->bufflen > 0 ) then
239  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
240  char = *lex.ctx->buffptr
241  else
242  char = *lex.ctx->buffptrw
243  end if
244 
245  else
246  char = 0
247  end if
248 
249  '' update current line text (if not parsing an inc file)
250  if( env.clopt.debug ) then
251  if( env.includerec = 0 ) then
252  if( lex.insidemacro ) then
253  lex.insidemacro = FALSE
254  DZstrConcatAssign( lex.ctx->currline, " ] " )
255  end if
256 
258  end if
259  end if
260 
261  end if
262 
263  function = char
264 
265 end function
266 
267 '':::::
268 function lexEatChar _
269  ( _
270  _
271  ) as uinteger
272 
273  ''
274  function = lex.ctx->currchar
275 
276  '' update if a look ahead char wasn't read already
277  if( lex.ctx->lahdchar = UINVALID ) then
278 
279  '' #define'd text?
280  if( lex.ctx->deflen > 0 ) then
281  lex.ctx->deflen -= 1
282 
283  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
284  lex.ctx->defptr += 1
285  else
286  lex.ctx->defptrw += 1
287  end if
288 
289  '' input stream (not EOF?)
290  elseif( lex.ctx->currchar <> 0 ) then
291  lex.ctx->bufflen -= 1
292 
293  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
294  lex.ctx->buffptr += 1
295  else
296  lex.ctx->buffptrw += 1
297  end if
298 
299  end if
300 
301  lex.ctx->currchar = UINVALID
302 
303  '' current= lookahead; lookhead = INVALID
304  else
305  lex.ctx->currchar = lex.ctx->lahdchar
306  lex.ctx->lahdchar = UINVALID
307  end if
308 
309 end function
310 
311 '':::::
313 
314  '' #define'd text?
315  if( lex.ctx->deflen > 0 ) then
316  lex.ctx->deflen -= 1
317 
318  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
319  lex.ctx->defptr += 1
320  else
321  lex.ctx->defptrw += 1
322  end if
323 
324  '' input stream (not EOF?)
325  elseif( lex.ctx->currchar <> 0 ) then
326  lex.ctx->bufflen -= 1
327 
328  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
329  lex.ctx->buffptr += 1
330  else
331  lex.ctx->buffptrw += 1
332  end if
333 
334  end if
335 
336 end sub
337 
338 '':::::
339 function lexCurrentChar _
340  ( _
341  byval skipwhitespc as integer = FALSE _
342  ) as uinteger
343 
344  if( lex.ctx->currchar = UINVALID ) then
345  lex.ctx->currchar = hReadChar( )
346  end if
347 
348  if( skipwhitespc ) then
349  do while( (lex.ctx->currchar = CHAR_TAB) or (lex.ctx->currchar = CHAR_SPACE) )
350  lex.ctx->after_space = TRUE
351  lexEatChar( )
352  lex.ctx->currchar = hReadChar( )
353  loop
354  end if
355 
356  function = lex.ctx->currchar
357 
358 end function
359 
360 '':::::
361 function lexGetLookAheadChar _
362  ( _
363  byval skipwhitespc as integer = FALSE _
364  ) as uinteger
365 
366  if( lex.ctx->lahdchar = UINVALID ) then
367  hSkipChar( )
368  lex.ctx->lahdchar = hReadChar( )
369  end if
370 
371  if( skipwhitespc ) then
372  do while( (lex.ctx->lahdchar = CHAR_TAB) or (lex.ctx->lahdchar = CHAR_SPACE) )
373  lex.ctx->after_space = TRUE
374  hSkipChar( )
375  lex.ctx->lahdchar = hReadChar( )
376  loop
377  end if
378 
379  function = lex.ctx->lahdchar
380 
381 end function
382 
383 ''
384 ''char classes:
385 ''
386 ''ALPHA 'A' - 'Z'
387 ''DIGIT '0' - '9'
388 ''HEXDIG 'A' - 'F' | DIGIT
389 ''OCTDIG '0' - '7'
390 ''BINDIG '0' | '1'
391 ''ALPHADIGIT ALPHA | DIGIT
392 ''ISUFFIX '%' | '&'
393 ''FSUFFIX '!' | '#'
394 ''SUFFIX ISUFFIX | FSUFFIX | '$'
395 ''
396 ''EXPCHAR 'D' | 'E'
397 ''
398 ''OPERATOR '=' | '<' | '>' | '+' | '-' | '*' | '/' | '\' | '^'
399 ''DELIMITER '.' | ':' | ',' | ';' | '"' | '''
400 ''
401 
402 '':::::
403 ''indentifier = (ALPHA | '_') { [ALPHADIGIT | '_' ] } [SUFFIX].
404 ''
405 sub hReadIdentifier _
406  ( _
407  byval pid as zstring ptr, _
408  byref tlen as integer, _
409  byref dtype as integer, _
410  byval flags as LEXCHECK _
411  )
412 
413  dim as uinteger c = any
414  dim as integer skipchar = any
415 
416  '' (ALPHA | '_' )
417  *pid = lexEatChar( )
418  pid += 1
419  tlen += 1
420 
421  skipchar = FALSE
422 
423  '' { [ALPHADIGIT | '_' ] }
424  do
425  c = lexCurrentChar( )
426  select case as const c
427  case CHAR_AUPP to CHAR_ZUPP, _
428  CHAR_ALOW to CHAR_ZLOW, _
429  CHAR_0 to CHAR_9, _
430  CHAR_UNDER
431 
432  case CHAR_DOT
433  if( (flags and LEXCHECK_EATPERIOD) = 0 ) then
434  exit do
435  end if
436 
437  case else
438  exit do
439  end select
440 
441  lexEatChar( )
442 
443  if( skipchar = FALSE ) then
444  '' no more room?
445  if( tlen = FB_MAXNAMELEN ) then
446  '' show warning?
447  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
448  '' just once..
449  flags or= LEXCHECK_NOLINECONT
450  errReportWarn( FB_WARNINGMSG_IDNAMETOOBIG )
451  end if
452 
453  skipchar = TRUE
454 
455  else
456  *pid = c
457  pid += 1
458  tlen += 1
459  end if
460  end if
461 
462  loop
463 
464  '' null-term
465  *pid = 0
466 
467  '' [SUFFIX]
468  dtype = FB_DATATYPE_INVALID
469 
470  if( (flags and LEXCHECK_NOSUFFIX) = 0 ) then
471  select case as const lexCurrentChar( )
472  '' '%'?
473  case FB_TK_INTTYPECHAR
474  dtype = env.lang.integerkeyworddtype
475  c = lexEatChar( )
476 
477  '' '&'?
478  case FB_TK_LNGTYPECHAR
479  dtype = FB_DATATYPE_LONG
480  c = lexEatChar( )
481 
482  '' '!'?
483  case FB_TK_SGNTYPECHAR
484  dtype = FB_DATATYPE_SINGLE
485  c = lexEatChar( )
486 
487  '' '#'?
488  case FB_TK_DBLTYPECHAR
489  '' isn't it a '##'?
490  if( lexGetLookAheadChar( ) <> FB_TK_DBLTYPECHAR ) then
491  dtype = FB_DATATYPE_DOUBLE
492  c = lexEatChar( )
493  end if
494 
495  '' '$'?
496  case FB_TK_STRTYPECHAR
497  dtype = FB_DATATYPE_STRING
498  c = lexEatChar( )
499  end select
500  end if
501 
502 end sub
503 
504 ''::::
505 ''hex_oct_bin = 'H' HEXDIG+
506 '' | 'O' OCTDIG+
507 '' | 'B' BINDIG+
508 ''
509 function hReadNonDecNumber _
510  ( _
511  byref pnum as zstring ptr, _
512  byref tlen as integer, _
513  byref dtype as integer, _
514  byval flags as LEXCHECK _
515  ) as ulongint
516 
517  dim as uinteger value = any, c = any, first_c = any
518  dim as ulongint value64 = any
519  dim as integer lgt = any
520  dim as integer skipchar = any
521 
522  assert( dtype = FB_DATATYPE_SHORT )
523 
524  value = 0
525  lgt = 0
526  skipchar = FALSE
527 
528  c = lexCurrentChar( )
529 
530  select case as const c
531  '' hex
532  case CHAR_HUPP, CHAR_HLOW
533  pnum[0] = CHAR_AMP
534  pnum[1] = c
535  pnum += 2
536  tlen += 2
537  lexEatChar( )
538 
539  '' skip trailing zeroes if not inside a comment or parsing an $include
540  if( (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 ) then
541  while( lexCurrentChar( ) = CHAR_0 )
542  *pnum = CHAR_0
543  pnum += 1
544  tlen += 1
545  lexEatChar( )
546  wend
547  end if
548 
549  do
550  select case lexCurrentChar( )
551  case CHAR_ALOW to CHAR_FLOW, CHAR_AUPP to CHAR_FUPP, CHAR_0 to CHAR_9
552  c = lexEatChar( )
553  if( skipchar = FALSE ) then
554  *pnum = c
555  pnum += 1
556  tlen += 1
557 
558  c -= CHAR_0
559  if( c > 9 ) then
560  c -= (CHAR_AUPP - CHAR_9 - 1)
561  end if
562  if( c > 16 ) then
563  c -= (CHAR_ALOW - CHAR_AUPP)
564  end if
565 
566  lgt += 1
567  if( lgt > 8 ) then
568  if( lgt = 9 ) then
569  dtype = FB_DATATYPE_LONGINT
570  value64 = (culngint( value ) * 16) + c
571  elseif( lgt = 17 ) then
572  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
573  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
574  end if
575  skipchar = TRUE
576  else
577  value64 = (value64 * 16) + c
578  end if
579  else
580  if( lgt = 5 ) then
581  dtype = FB_DATATYPE_LONG
582  end if
583  value = (value * 16) + c
584  end if
585  end if
586 
587  case else
588  exit do
589  end select
590  loop
591 
592  '' oct
593  case CHAR_OUPP, CHAR_OLOW
594  pnum[0] = CHAR_AMP
595  pnum[1] = c
596  pnum += 2
597  tlen += 2
598  lexEatChar( )
599 
600  '' skip trailing zeroes if not inside a comment or parsing an $include
601  if( (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 ) then
602  while( lexCurrentChar( ) = CHAR_0 )
603  *pnum = CHAR_0
604  pnum += 1
605  tlen += 1
606  lexEatChar( )
607  wend
608  end if
609 
610  first_c = lexCurrentChar( )
611  do
612  select case lexCurrentChar( )
613  case CHAR_0 to CHAR_7
614  c = lexEatChar( )
615 
616  if( skipchar = FALSE ) then
617  *pnum = c
618  pnum += 1
619  tlen += 1
620 
621  c -= CHAR_0
622 
623  lgt += 1
624  if( lgt > 10 ) then
625  select case as const lgt
626  case 11
627  if( first_c > CHAR_3 ) then
628  dtype = FB_DATATYPE_LONGINT
629  value64 = (culngint( value ) * 8) + c
630  else
631  value = (value * 8) + c
632  end if
633 
634  case 12
635  if( typeGetSize( dtype ) < 8 ) then
636  dtype = FB_DATATYPE_LONGINT
637  value64 = culngint( value )
638  end if
639  value64 = (value64 * 8) + c
640 
641  case 22
642  if( first_c > CHAR_1 ) then
643  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
644  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
645  end if
646  skipchar = TRUE
647  else
648  value64 = (value64 * 8) + c
649  end if
650 
651  case 23
652  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
653  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
654  end if
655  skipchar = TRUE
656 
657  case else
658  value64 = (value64 * 8) + c
659  end select
660 
661  else
662  if( lgt = 6 ) then
663  if( first_c > CHAR_1 ) then
664  dtype = FB_DATATYPE_LONG
665  end if
666  elseif( lgt = 7 ) then
667  dtype = FB_DATATYPE_LONG
668  end if
669  value = (value * 8) + c
670  end if
671  end if
672 
673  case else
674  exit do
675  end select
676  loop
677 
678  '' bin
679  case CHAR_BUPP, CHAR_BLOW
680  pnum[0] = CHAR_AMP
681  pnum[1] = c
682  pnum += 2
683  tlen += 2
684  lexEatChar( )
685 
686  '' skip trailing zeroes if not inside a comment or parsing an $include
687  if( (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 ) then
688  while( lexCurrentChar( ) = CHAR_0 )
689  *pnum = CHAR_0
690  pnum += 1
691  tlen += 1
692  lexEatChar( )
693  wend
694  end if
695 
696  do
697  select case lexCurrentChar( )
698  case CHAR_0, CHAR_1
699  c = lexEatChar( )
700  if( skipchar = FALSE ) then
701  *pnum = c
702  pnum += 1
703  tlen += 1
704 
705  c -= CHAR_0
706 
707  lgt += 1
708  if( lgt > 32 ) then
709  if( lgt = 33 ) then
710  dtype = FB_DATATYPE_LONGINT
711  value64 = (culngint( value ) * 2) + c
712 
713  elseif( lgt = 65 ) then
714  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
715  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
716  end if
717  skipchar = TRUE
718 
719  else
720  value64 = (value64 * 2) + c
721  end if
722 
723  else
724  if( lgt = 17 ) then
725  dtype = FB_DATATYPE_LONG
726  end if
727  value = (value * 2) + c
728  end if
729  end if
730 
731  case else
732  exit do
733  end select
734  loop
735 
736  case else
737  exit function
738  end select
739 
740  if( lgt = 0 ) then
741  *pnum = CHAR_0
742  pnum += 1
743  tlen += 1
744  end if
745 
746  if( typeGetSize( dtype ) < 8 ) then
747  function = value
748  else
749  function = value64
750  end if
751 
752 end function
753 
754 '':::::
755 ''float = DOT DIGIT { DIGIT } [FSUFFIX | { EXPCHAR [opadd] DIGIT { DIGIT } } | ].
756 ''
757 sub hReadFloatNumber _
758  ( _
759  byref pnum as zstring ptr, _
760  byref tlen as integer, _
761  byref dtype as integer, _
762  byval hasdot as integer, _
763  byval flags as LEXCHECK _
764  )
765 
766  dim as uinteger c = any
767  dim as integer llen = any
768  dim as integer skipchar = any
769 
770  dtype = env.lang.floatliteraldtype
771  llen = tlen
772  skipchar = FALSE
773 
774  '' DIGIT { DIGIT }
775  do
776  c = lexCurrentChar( )
777  select case c
778  case CHAR_0 to CHAR_9
779  lexEatChar( )
780  if( skipchar = FALSE ) then
781  *pnum = c
782  pnum += 1
783  tlen += 1
784  end if
785  case else
786  exit do
787  end select
788 
789  '' no more room?
790  if( tlen = FB_MAXNUMLEN ) then
791  '' not set yet?
792  if( skipchar = FALSE ) then
793  skipchar = TRUE
794  else
795  '' show warning?
796  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
797  '' just once..
798  flags or= LEXCHECK_NOLINECONT
799  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
800  end if
801  end if
802  end if
803  loop
804 
805  if( tlen > 7 + iif( hasdot, 1, 0 ) ) then
806  dtype = FB_DATATYPE_DOUBLE
807  end if
808 
809  '' [FSUFFIX | { EXPCHAR [opadd] DIGIT { DIGIT } } | ]
810  select case as const lexCurrentChar( )
811  '' 'e', 'E', 'd', 'D'?
812  case CHAR_ELOW, CHAR_EUPP, CHAR_DLOW, CHAR_DUPP
813  '' EXPCHAR
814 
815  c = lexEatChar( )
816 
817  if( c = CHAR_DLOW or c = CHAR_DUPP ) then
818  dtype = FB_DATATYPE_DOUBLE
819  end if
820 
821  if( skipchar = FALSE ) then
822  if( flags = LEXCHECK_EVERYTHING ) then
823  '' make sure exp char is an 'e'
824  '' (Val should accept 'd's, so may not be necessary now...)
825  c = CHAR_ELOW
826  end if
827  *pnum = c
828  pnum += 1
829  tlen += 1
830  end if
831 
832  '' [opadd]
833  c = lexCurrentChar( )
834  if( (c = CHAR_PLUS) or (c = CHAR_MINUS) ) then
835  lexEatChar( )
836  if( skipchar = FALSE ) then
837  *pnum = c
838  pnum += 1
839  tlen += 1
840  end if
841  end if
842 
843  do
844  c = lexCurrentChar( )
845  select case as const c
846  case CHAR_0 to CHAR_9
847  lexEatChar( )
848  if( skipchar = FALSE ) then
849  *pnum = c
850  pnum += 1
851  tlen += 1
852  end if
853  case else
854  exit do
855  end select
856 
857  '' no more room?
858  if( tlen = FB_MAXNUMLEN ) then
859  '' not set yet?
860  if( skipchar = FALSE ) then
861  skipchar = TRUE
862  else
863  '' show warning?
864  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
865  '' just once..
866  flags or= LEXCHECK_NOLINECONT
867  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
868  end if
869  end if
870  end if
871  loop
872 
873  end select
874 
875 
876  select case as const lexCurrentChar( )
877  '' 'F', 'f'?
878  case CHAR_FUPP, CHAR_FLOW
879  dtype = FB_DATATYPE_SINGLE
880 
881  if( (flags and (LEXCHECK_NOSUFFIX or LEXCHECK_NOLETTERSUFFIX)) = 0 ) then
882  c = lexEatChar( )
883  end if
884 
885  '' '!'
886  case FB_TK_SGNTYPECHAR
887  dtype = FB_DATATYPE_SINGLE
888 
889  if( (flags and LEXCHECK_NOSUFFIX) = 0 ) then
890  c = lexEatChar( )
891  end if
892 
893  '' '#'?
894  case FB_TK_DBLTYPECHAR
895  dtype = FB_DATATYPE_DOUBLE
896 
897  if( (flags and LEXCHECK_NOSUFFIX) = 0 ) then
898  c = lexEatChar( )
899  end if
900 
901  end select
902 
903  if( flags = LEXCHECK_EVERYTHING ) then
904  if( tlen - llen = 0 ) then
905  '' '0'
906  *pnum = CHAR_0
907  pnum += 1
908  tlen += 1
909  end if
910  endif
911 
912 end sub
913 
914 '':::::
915 ''number = DIGIT dig_dot_nil i_fsufx_nil
916 '' | '.' float
917 '' | '&' hex_oct_bin
918 ''
919 ''dig_dot_nil = DIGIT dig_dot_nil
920 '' | ('.'|EXPCHAR) float
921 '' | .
922 ''
923 ''i_fsufx_nil = ISUFFIX # is integer
924 '' | FSUFFIX # is float
925 '' | . # is def### !!! context sensitive !!!
926 ''
927 sub hReadNumber _
928  ( _
929  byval pnum as zstring ptr, _
930  byref dtype as integer, _
931  byref tlen as integer, _
932  byval flags as LEXCHECK _
933  )
934 
935  dim as uinteger c = any
936  dim as integer have_u_suffix = any
937  dim as ulongint value = any, value_prev = any
938  dim as integer skipchar = any, hasdot = any, warn = any
939 
940  '' Starting with SHORT for the integer literal parser,
941  '' may be changed to USHORT, LONG, ULONG, LONGINT, ULONGINT,
942  '' depending on the literal's size.
943  '' The float literal parser will change this to SINGLE/DOUBLE.
944  dtype = FB_DATATYPE_SHORT
945 
946  have_u_suffix = FALSE
947  value = 0
948 
949  *pnum = 0
950  tlen = 0
951  skipchar = FALSE
952 
953  c = lexEatChar( )
954 
955  select case as const c
956  '' integer part
957  case CHAR_0
958  '' skip the '0' if not inside a comment or parsing an $include
959  if( (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) <> 0 ) then
960  *pnum = CHAR_0
961  pnum += 1
962  tlen += 1
963  value = 0
964  end if
965 
966  goto read_char
967 
968  case CHAR_1 to CHAR_9
969  *pnum = c
970  pnum += 1
971  tlen += 1
972  value = c - CHAR_0
973 
974 read_char:
975  do
976  c = lexCurrentChar( )
977  select case as const c
978  case CHAR_0
979  lexEatChar( )
980  if( tlen > 0 ) then
981  if( skipchar = FALSE ) then
982  *pnum = CHAR_0
983  pnum += 1
984  tlen += 1
985  value = (value shl 3) + (value shl 1)
986  end if
987  end if
988 
989  case CHAR_1 to CHAR_9
990  lexEatChar( )
991  if( skipchar = FALSE ) then
992  *pnum = c
993  pnum += 1
994  tlen += 1
995  value = (value shl 3) + (value shl 1) + (c - CHAR_0)
996  end if
997 
998  case CHAR_DOT, CHAR_ELOW, CHAR_EUPP, CHAR_DLOW, CHAR_DUPP
999  if( c = CHAR_DOT ) then
1000  c = lexEatChar( )
1001  if( skipchar = FALSE ) then
1002  *pnum = CHAR_DOT
1003  pnum += 1
1004  tlen += 1
1005  end if
1006  hasdot = TRUE
1007  else
1008  hasdot = FALSE
1009  end if
1010 
1011  hReadFloatNumber( pnum, tlen, dtype, hasdot, flags )
1012  exit do
1013 
1014  case else
1015  exit do
1016  end select
1017 
1018  if( (flags and LEXCHECK_NOSUFFIX) = 0 ) then
1019  if( skipchar = FALSE ) then
1020  select case as const tlen
1021  case 5
1022  if( value > 32767 ) then
1023  dtype = FB_DATATYPE_LONG
1024  end if
1025 
1026  case 6
1027  dtype = FB_DATATYPE_LONG
1028 
1029  case 10
1030  if( value > 2147483647ULL ) then
1031  if( value > 4294967295ULL ) then
1032  dtype = FB_DATATYPE_LONGINT
1033  else
1034  dtype = FB_DATATYPE_ULONG
1035  end if
1036  end if
1037 
1038  case 11
1039  dtype = FB_DATATYPE_LONGINT
1040 
1041  case 19
1042  if( value > 9223372036854775807ULL ) then
1043  dtype = FB_DATATYPE_ULONGINT
1044  end if
1045  value_prev = value
1046 
1047  case 20
1048  dtype = FB_DATATYPE_ULONGINT
1049  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1050  if( value_prev > 1844674407370955161ULL or _
1051  (value and &h8000000000000000ULL) = 0 ) then
1052  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1053  skipchar = TRUE
1054  end if
1055  end if
1056 
1057  case 21
1058  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1059  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1060  skipchar = TRUE
1061  end if
1062  end select
1063 
1064  '' no more room?
1065  if( tlen = FB_MAXNUMLEN ) then
1066  '' not set yet?
1067  if( skipchar = FALSE ) then
1068  skipchar = TRUE
1069  else
1070  '' show warning?
1071  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1072  '' just once..
1073  flags or= LEXCHECK_NOLINECONT
1074  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1075  end if
1076  end if
1077  end if
1078  end if
1079  end if
1080 
1081  loop
1082 
1083  if( tlen = 0 ) then
1084  *pnum = CHAR_0
1085  pnum += 1
1086  tlen = 1
1087  end if
1088 
1089  '' fractional part
1090  case CHAR_DOT
1091  '' add '.'
1092  *pnum = CHAR_DOT
1093  pnum += 1
1094  tlen = 1
1095  hReadFloatNumber( pnum, tlen, dtype, TRUE, flags )
1096 
1097  '' hex, oct, bin
1098  case CHAR_AMP
1099  tlen = 0
1100  value = hReadNonDecNumber( pnum, tlen, dtype, flags )
1101  end select
1102 
1103  '' null-term
1104  *pnum = 0
1105 
1106  select case( dtype )
1107  case FB_DATATYPE_SHORT
1108  dtype = env.lang.int15literaldtype
1109  case FB_DATATYPE_USHORT
1110  dtype = env.lang.int16literaldtype
1111  case FB_DATATYPE_LONG
1112  dtype = env.lang.int31literaldtype
1113  case FB_DATATYPE_ULONG
1114  dtype = env.lang.int32literaldtype
1115 #if __FB_DEBUG__
1116  case FB_DATATYPE_LONGINT, FB_DATATYPE_ULONGINT, _
1117  FB_DATATYPE_SINGLE, FB_DATATYPE_DOUBLE
1118  case else
1119  assert( FALSE )
1120 #endif
1121  end select
1122 
1123  '' check suffix type
1124  if( typeGetClass( dtype ) <> FB_DATACLASS_FPOINT ) then
1125  if( (flags and LEXCHECK_NOSUFFIX) = 0 ) then
1126 
1127  '' 'U' | 'u'
1128  if( (flags and LEXCHECK_NOLETTERSUFFIX) = 0 ) then
1129  select case lexCurrentChar( )
1130  case CHAR_UUPP, CHAR_ULOW
1131  lexEatChar( )
1132  dtype = typeToUnsigned( dtype )
1133  have_u_suffix = TRUE
1134  end select
1135  end if
1136 
1137  select case as const lexCurrentChar( )
1138  '' 'L' | 'l'
1139  case CHAR_LUPP, CHAR_LLOW
1140  if( (flags and LEXCHECK_NOLETTERSUFFIX) = 0 ) then
1141  lexEatChar( )
1142  '' 'LL'?
1143  c = lexCurrentChar( )
1144  if( (c = CHAR_LUPP) or (c = CHAR_LLOW) ) then
1145  lexEatChar( )
1146  '' 'ULL' or 'LL'
1147  dtype = iif( have_u_suffix, FB_DATATYPE_ULONGINT, FB_DATATYPE_LONGINT )
1148  '' 'L' only
1149  else
1150  '' LONG is 32bit; warn if number is > 32bit
1151  if( value > &hFFFFFFFFull ) then
1152  if( skipchar = FALSE ) then
1153  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1154  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1155  end if
1156  end if
1157  end if
1158  '' 'UL' or 'L'
1159  dtype = iif( have_u_suffix, FB_DATATYPE_ULONG, FB_DATATYPE_LONG )
1160  end if
1161  end if
1162 
1163  '' 'F' | 'f'
1164  case CHAR_FUPP, CHAR_FLOW
1165  if( (flags and LEXCHECK_NOLETTERSUFFIX) = 0 ) then
1166  if( have_u_suffix = FALSE ) then
1167  dtype = FB_DATATYPE_SINGLE
1168  lexEatChar( )
1169  end if
1170  end if
1171 
1172  '' 'D' | 'd'
1173  '' (NOTE: should this ever occur? Wouldn't it have been parsed as a float already?)
1174  case CHAR_DUPP, CHAR_DLOW
1175  if( (flags and LEXCHECK_NOLETTERSUFFIX) = 0 ) then
1176  if( have_u_suffix = FALSE ) then
1177  dtype = FB_DATATYPE_DOUBLE
1178  lexEatChar( )
1179  end if
1180  end if
1181 
1182  '' '%'
1183  case FB_TK_INTTYPECHAR
1184  '' Assuming it'll be either SHORT (16bit) or INTEGER (32bit or 64bit).
1185  '' So, no need to worry about 8bit. And if it's 64bit, no need to warn
1186  '' either - because it's always big enough.
1187  select case( typeGetSize( env.lang.integerkeyworddtype ) )
1188  case 2 : warn = (value > &hFFFFull)
1189  case 4 : warn = (value > &hFFFFFFFFull)
1190  case else : warn = FALSE
1191  end select
1192  if( warn ) then
1193  if( skipchar = FALSE ) then
1194  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1195  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1196  end if
1197  end if
1198  end if
1199  dtype = env.lang.integerkeyworddtype
1200 
1201  lexEatChar( )
1202 
1203  '' '&'
1204  case FB_TK_LNGTYPECHAR
1205  if( typeGetSize( dtype ) > 4 ) then
1206  if( skipchar = FALSE ) then
1207  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1208  errReportWarn( FB_WARNINGMSG_NUMBERTOOBIG )
1209  end if
1210  end if
1211  end if
1212  dtype = FB_DATATYPE_LONG
1213 
1214  lexEatChar( )
1215 
1216  '' '!'
1217  case FB_TK_SGNTYPECHAR
1218  if( have_u_suffix = FALSE ) then
1219  dtype = FB_DATATYPE_SINGLE
1220  lexEatChar( )
1221  end if
1222 
1223  '' '#'
1224  case FB_TK_DBLTYPECHAR
1225  if( have_u_suffix = FALSE ) then
1226  '' isn't it a '##'?
1227  if( lexGetLookAheadChar( ) <> FB_TK_DBLTYPECHAR ) then
1228  dtype = FB_DATATYPE_DOUBLE
1229  lexEatChar( )
1230  end if
1231  end if
1232 
1233  end select
1234 
1235  end if
1236  end if
1237 
1238 end sub
1239 
1240 '':::::
1241 ''string = '"' { ANY_CHAR_BUT_QUOTE } '"'. # less quotes
1242 ''
1243 sub hReadString _
1244  ( _
1245  byval tk as FBTOKEN ptr, _
1246  byval ps as zstring ptr, _
1247  byval flags as LEXCHECK _
1248  )
1249 
1250  dim as integer lgt = any, hasesc = any, escaped = any, skipchar = any
1251  dim as uinteger char = any
1252 
1253  *ps = 0
1254  lgt = 0
1255  hasesc = FALSE
1256 
1257  escaped = (tk->id = FB_TK_STRLIT_ESC)
1258  skipchar = FALSE
1259 
1260  '' skip open quote?
1261  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1262  lexEatChar( )
1263 
1264  '' read it too..
1265  else
1266  *ps = lexEatChar( )
1267  ps += 1
1268  lgt += 1
1269  end if
1270 
1271  do
1272  char = lexCurrentChar( )
1273 
1274  '' '"'?
1275  if( char = CHAR_QUOTE ) then
1276  lexEatChar( )
1277 
1278  '' copy quote? (even if first of a double)
1279  if( (flags and LEXCHECK_NOQUOTES) <> 0 ) then
1280  if( skipchar = FALSE ) then
1281  *ps = CHAR_QUOTE
1282  ps += 1
1283  lgt += 1
1284  end if
1285  end if
1286 
1287  '' not a double-quote? then it's the closing quote
1288  char = lexCurrentChar( )
1289  if( char <> CHAR_QUOTE ) then exit do
1290 
1291  '' '[\x1b]' (internal escape char)
1292  elseif( char = FB_INTSCAPECHAR ) then
1293 
1294  '' escape it?
1295  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1296  if( skipchar = FALSE ) then
1297  *ps = FB_INTSCAPECHAR
1298  ps += 1
1299  lgt += 1
1300  end if
1301  end if
1302 
1303  '' '\'?
1304  elseif( char = CHAR_RSLASH ) then
1305  hasesc = TRUE
1306 
1307  '' escaping on? needed or "\\" would fail..
1308  if( escaped ) then
1309  lexEatChar( )
1310 
1311  if( skipchar = FALSE ) then
1312  *ps = CHAR_RSLASH
1313  ps += 1
1314  lgt += 1
1315  end if
1316 
1317  char = lexCurrentChar( )
1318  end if
1319 
1320  end if
1321 
1322  select case char
1323  '' EOF or EOL?
1324  case 0, CHAR_CR, CHAR_LF
1325  '' only warn if not in comments
1326  if (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 then
1327  errReportWarn( FB_WARNINGMSG_NOCLOSINGQUOTE )
1328  end if
1329  exit do
1330 
1331  end select
1332 
1333  lexEatChar( )
1334 
1335  if( skipchar = FALSE ) then
1336  '' no more room?
1337  if( lgt = FB_MAXLITLEN ) then
1338  '' show warning?
1339  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1340  '' just once..
1341  flags or= LEXCHECK_NOLINECONT
1342  errReportWarn( FB_WARNINGMSG_LITSTRINGTOOBIG )
1343  end if
1344 
1345  skipchar = TRUE
1346 
1347  else
1348  *ps = char
1349  ps += 1
1350  lgt += 1
1351  end if
1352  end if
1353 
1354  loop
1355 
1356  '' null-term
1357  *ps = 0
1358 
1359  tk->dtype = FB_DATATYPE_CHAR
1360  tk->len = lgt
1361  tk->hasesc = hasesc
1362 
1363 end sub
1364 
1365 '':::::
1366 ''string = '"' { ANY_CHAR_BUT_QUOTE } '"'. # less quotes
1367 ''
1368 sub hReadWStr _
1369  ( _
1370  byval tk as FBTOKEN ptr, _
1371  byval ps as wstring ptr, _
1372  byval flags as LEXCHECK _
1373  )
1374 
1375  dim as integer lgt = any, hasesc = any, escaped = any, skipchar = any
1376  dim as uinteger char = any
1377 
1378  *ps = 0
1379  lgt = 0
1380  hasesc = FALSE
1381 
1382  escaped = (tk->id = FB_TK_STRLIT_ESC)
1383  skipchar = FALSE
1384 
1385  '' skip open quote?
1386  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1387  lexEatChar( )
1388 
1389  '' read it too..
1390  else
1391  *ps = lexEatChar( )
1392  ps += 1
1393  lgt += 1
1394  end if
1395 
1396  do
1397  char = lexCurrentChar( )
1398 
1399  '' '"'?
1400  if( char = CHAR_QUOTE ) then
1401  lexEatChar( )
1402 
1403  '' copy quote? (even if first of a double)
1404  if( (flags and LEXCHECK_NOQUOTES) <> 0 ) then
1405  if( skipchar = FALSE ) then
1406  *ps = CHAR_QUOTE
1407  ps += 1
1408  lgt += 1
1409  end if
1410  end if
1411 
1412  '' not a double-quote? then it's the closing quote
1413  char = lexCurrentChar( )
1414  if( char <> CHAR_QUOTE ) then exit do
1415 
1416  '' '\27' (internal escape char)
1417  elseif( char = FB_INTSCAPECHAR ) then
1418 
1419  '' escape it?
1420  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1421  if( skipchar = FALSE ) then
1422  *ps = FB_INTSCAPECHAR
1423  ps += 1
1424  lgt += 1
1425  end if
1426  end if
1427 
1428  '' '\'?
1429  elseif( char = CHAR_RSLASH ) then
1430  hasesc = TRUE
1431 
1432  '' escaping on? needed or "\\" would fail..
1433  if( escaped ) then
1434  lexEatChar( )
1435 
1436  if( skipchar = FALSE ) then
1437  *ps = CHAR_RSLASH
1438  ps += 1
1439  lgt += 1
1440  end if
1441 
1442  char = lexCurrentChar( )
1443  end if
1444 
1445  end if
1446 
1447  select case char
1448  '' EOF or EOL?
1449  case 0, CHAR_CR, CHAR_LF
1450  '' only warn if not in comments
1451  if (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 then
1452  errReportWarn( FB_WARNINGMSG_NOCLOSINGQUOTE )
1453  end if
1454  exit do
1455 
1456  end select
1457 
1458  lexEatChar( )
1459 
1460  if( skipchar = FALSE ) then
1461  '' no more room?
1462  if( lgt = FB_MAXLITLEN ) then
1463  '' show warning?
1464  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1465  '' just once..
1466  flags or= LEXCHECK_NOLINECONT
1467  errReportWarn( FB_WARNINGMSG_LITSTRINGTOOBIG )
1468  end if
1469 
1470  skipchar = TRUE
1471 
1472  else
1473  *ps = char
1474  ps += 1
1475  lgt += 1
1476  end if
1477  end if
1478 
1479  loop
1480 
1481  '' null-term
1482  *ps = 0
1483 
1484  tk->dtype = FB_DATATYPE_WCHAR
1485  tk->len = lgt
1486  tk->hasesc = hasesc
1487 
1488 end sub
1489 
1490 '':::::
1491 sub hCheckPeriods _
1492  ( _
1493  byval t as FBTOKEN ptr, _
1494  byval flags as LEXCHECK, _
1495  byval chain_ as FBSYMCHAIN ptr _
1496  )
1497 
1498  dim as integer readfullid = any
1499 
1500  '' handle the stupid '.'s in symbols
1501  if( chain_ <> NULL ) then
1502  readfullid = FALSE
1503 
1504  '' is the next char a period?
1505  if( lexCurrentChar( ) = CHAR_DOT ) then
1506  '' not a qualified name (namespace or UDT var)?
1507  if( symbGetClass( chain_->sym ) <> FB_SYMBCLASS_NAMESPACE ) then
1508  readfullid = TRUE
1509 
1510  '' search UDT variables
1511  do while( chain_ <> NULL )
1512  dim as FBSYMBOL ptr sym = chain_->sym
1513  do
1514  if( symbIsVar( sym ) ) then
1515  if( symbGetType( sym ) = FB_DATATYPE_STRUCT ) then
1516  exit sub
1517  end if
1518  end if
1519 
1520  sym = sym->hash.next
1521  loop while( sym <> NULL )
1522 
1523  chain_ = symbChainGetNext( chain_ )
1524  loop
1525  end if
1526  end if
1527 
1528  '' no symbol..
1529  else
1530  '' only read if next char is a '.'
1531  readfullid = (lexCurrentChar( ) = CHAR_DOT)
1532  end if
1533 
1534  '' read the remaining? (including the '.'s)
1535  if( readfullid ) then
1536  t->prdpos = t->len
1537  hReadIdentifier( @t->text[t->len], _
1538  t->len, _
1539  t->dtype, _
1540  flags or LEXCHECK_EATPERIOD )
1541 
1542  t->sym_chain = symbLookup( @t->text, t->id, t->class )
1543  end if
1544 
1545 end sub
1546 
1547 '':::::
1548 sub lexNextToken _
1549  ( _
1550  byval t as FBTOKEN ptr, _
1551  byval flags as LEXCHECK _
1552  )
1553 
1554  dim as uinteger char = any
1555  dim as integer islinecont = any, lgt = any
1556  dim as FBSYMCHAIN ptr chain_ = any
1557 
1558  t->after_space = lex.ctx->after_space
1559  lex.ctx->after_space = FALSE
1560 
1561 re_read:
1562  t->text[0] = 0 '' t.text = ""
1563  t->len = 0
1564  t->sym_chain = NULL
1565 
1566  '' skip white space
1567  islinecont = FALSE
1568  do
1569  char = lexCurrentChar( )
1570 
1571  select case as const char
1572  '' EOF?
1573  case 0
1574  t->id = FB_TK_EOF
1575  t->class = FB_TKCLASS_DELIMITER
1576  t->dtype = FB_DATATYPE_INVALID
1577  exit sub
1578 
1579  '' line continuation?
1580  case CHAR_UNDER
1581 
1582  '' alread skipping?
1583  if( islinecont ) then
1584  lexEatChar( )
1585  continue do
1586  end if
1587 
1588  '' check for line cont?
1589  if( (flags and LEXCHECK_NOLINECONT) = 0 ) then
1590 
1591  '' is next char a valid identifier char? then, read it
1592  select case as const lexGetLookAheadChar( )
1593  case CHAR_AUPP to CHAR_ZUPP, CHAR_ALOW to CHAR_ZLOW, _
1594  CHAR_0 to CHAR_9, CHAR_UNDER
1595  goto read_id
1596 
1597  '' otherwise, skip until new-line is found
1598  case else
1599  lexEatChar( )
1600  islinecont = TRUE
1601  continue do
1602  end select
1603 
1604  '' else, take it as-is
1605  else
1606  exit do
1607  end if
1608 
1609  '' EOL?
1610  case CHAR_CR, CHAR_LF
1611  lexEatChar( )
1612 
1613  '' CRLF on DOS, LF only on *NIX
1614  if( char = CHAR_CR ) then
1615  if( lexCurrentChar( ) = CHAR_LF ) then
1616  lexEatChar( )
1617  end if
1618  end if
1619 
1620  if( islinecont = FALSE ) then
1621  t->id = FB_TK_EOL
1622  t->class = FB_TKCLASS_DELIMITER
1623  t->dtype = FB_DATATYPE_INVALID
1624  t->len = 1
1625  t->text[0] = CHAR_LF '' t.text = chr( 10 )
1626  t->text[1] = 0 '' /
1627  exit sub
1628 
1629  else
1630  t->after_space = TRUE
1631  UPDATE_LINENUM( )
1632  islinecont = FALSE
1633  continue do
1634  end if
1635 
1636  '' white-space?
1637  case CHAR_TAB, CHAR_SPACE
1638  t->after_space = TRUE
1639  if( islinecont = FALSE ) then
1640  if( (flags and LEXCHECK_NOWHITESPC) <> 0 ) then
1641  exit do
1642  end if
1643  end if
1644 
1645  lexEatChar( )
1646 
1647  ''
1648  case else
1649  if( islinecont = FALSE ) then
1650  exit do
1651  end if
1652 
1653  lexEatChar( )
1654  end select
1655 
1656  loop
1657 
1658  lex.ctx->lastfilepos = lex.ctx->filepos + (lex.ctx->buffptr - @lex.ctx->buff) - 1
1659 
1660  select case as const char
1661  '' '.'?
1662  case CHAR_DOT
1663 
1664  '' only check for fpoint literals if not inside a comment or parsing an $include
1665  if( (flags and (LEXCHECK_NOLINECONT or LEXCHECK_NOSUFFIX)) = 0 ) then
1666 
1667  dim as uinteger lachar = lexGetLookAheadChar( TRUE )
1668 
1669  '' '0' .. '9'?
1670  if( (lachar >= CHAR_0) and (lachar <= CHAR_9) ) then
1671  goto read_number
1672  end if
1673 
1674  end if
1675 
1676  goto read_char
1677 
1678  '' '&'?
1679  case CHAR_AMP
1680  select case lexGetLookAheadChar( )
1681  case CHAR_HUPP, CHAR_HLOW, CHAR_OUPP, CHAR_OLOW, CHAR_BUPP, CHAR_BLOW
1682  goto read_number
1683  end select
1684 
1685  t->class = FB_TKCLASS_OPERATOR
1686  t->id = lexEatChar( )
1687  t->dtype = t->id
1688  t->len = 1
1689  t->text[0] = char '' t.text = chr( char )
1690  t->text[1] = 0 '' /
1691 
1692  '' '0' .. '9'?
1693  case CHAR_0 to CHAR_9
1694 read_number:
1695  hReadNumber( @t->text, t->id, t->len, flags )
1696  t->class = FB_TKCLASS_NUMLITERAL
1697  t->dtype = t->id
1698 
1699  '' 'A' .. 'Z', 'a' .. 'z'?
1700  case CHAR_AUPP to CHAR_ZUPP, CHAR_ALOW to CHAR_ZLOW
1701 read_id:
1702  t->len = 0
1703  t->prdpos = 0
1704  hReadIdentifier( @t->text, t->len, t->dtype, flags )
1705 
1706  '' use the special hash tb?
1707  if( (flags and LEXCHECK_KWDNAMESPC) <> 0 ) then
1708  t->sym_chain = symbLookupAt( lex.ctx->kwdns, @t->text, FALSE, FALSE )
1709  '' not found?
1710  if( t->sym_chain = NULL ) then
1711  t->id = FB_TK_ID
1712  t->class = FB_TKCLASS_IDENTIFIER
1713  else
1714  t->id = t->sym_chain->sym->key.id
1715  t->class = t->sym_chain->sym->key.tkclass
1716  end if
1717 
1718  exit sub
1719  end if
1720 
1721  '' don't search for symbols?
1722  if( (flags and LEXCHECK_NOSYMBOL) <> 0 ) then
1723  t->id = FB_TK_ID
1724  t->class = FB_TKCLASS_IDENTIFIER
1725  exit sub
1726  end if
1727 
1728  t->sym_chain = symbLookup( @t->text, t->id, t->class )
1729 
1730  '' don't load defines?
1731  if( (flags and LEXCHECK_NODEFINE) <> 0 ) then
1732  exit sub
1733  end if
1734 
1735  chain_ = t->sym_chain
1736 
1737  if( chain_ <> NULL ) then
1738  '' define? (defines can't have dups nor be part of namespaces)
1739  if( symbGetClass( chain_->sym ) = FB_SYMBCLASS_DEFINE ) then
1740  '' restart..
1741  if( ppDefineLoad( chain_->sym ) ) then
1742  t->after_space = TRUE
1743  goto re_read
1744  end if
1745  end if
1746  end if
1747 
1748  if( fbLangOptIsSet( FB_LANG_OPT_PERIODS ) ) then
1749  '' don't look up symbols?
1750  if( (flags and LEXCHECK_NOPERIOD) <> 0 ) then
1751  exit sub
1752  end if
1753 
1754  hCheckPeriods( t, flags, chain_ )
1755  end if
1756 
1757  '' '"'?
1758  case CHAR_QUOTE
1759  t->class = FB_TKCLASS_STRLITERAL
1760  t->id = iif( env.opt.escapestr, FB_TK_STRLIT_ESC, FB_TK_STRLIT )
1761  t->dtype = FB_DATATYPE_INVALID
1762 
1763  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
1764  hReadString( t, @t->text, flags )
1765  else
1766  hReadWStr( t, @t->textw, flags )
1767  end if
1768 
1769  '' '!' | '$'?
1770  case CHAR_EXCL, CHAR_DOLAR
1771  '' '"' following?
1772  if( lexGetLookAheadChar( ) <> CHAR_QUOTE ) then
1773  goto read_char
1774  end if
1775 
1776  lexEatChar( )
1777 
1778  t->class = FB_TKCLASS_STRLITERAL
1779  t->id = iif( char = CHAR_EXCL, FB_TK_STRLIT_ESC, FB_TK_STRLIT_NOESC )
1780  t->dtype = FB_DATATYPE_INVALID
1781 
1782  if( env.inf.format = FBFILE_FORMAT_ASCII ) then
1783  dim as zstring ptr ps = any
1784 
1785  '' do not preserve the string modifier?
1786  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1787  ps = @t->text
1788  else
1789  t->text[0] = char
1790  ps = @t->text[1]
1791  end if
1792 
1793  hReadString( t, ps, flags )
1794 
1795  else
1796  dim as wstring ptr ps = any
1797 
1798  '' do not preserve the string modifier?
1799  if( (flags and LEXCHECK_NOQUOTES) = 0 ) then
1800  ps = @t->textw
1801  else
1802  t->textw[0] = char
1803  ps = @t->textw[1]
1804  end if
1805 
1806  hReadWStr( t, ps, flags )
1807  end if
1808 
1809  '':::::
1810  case else
1811 read_char:
1812 
1813  t->id = lexEatChar( )
1814  t->dtype = t->id
1815 
1816  t->len = 1
1817  t->text[0] = char '' t.text = chr( char )
1818  t->text[1] = 0 '' /
1819 
1820  select case as const char
1821  '' '<', '>', '='?
1822  case CHAR_LT, CHAR_GT, CHAR_EQ
1823  t->class = FB_TKCLASS_OPERATOR
1824 
1825  select case char
1826  case CHAR_LT
1827  select case lexCurrentChar( TRUE )
1828  '' '<='?
1829  case CHAR_EQ
1830  '' t.text += chr( lexEatChar )
1831  t->text[t->len+0] = lexEatChar( )
1832  t->text[t->len+1] = 0
1833  t->len += 1
1834  t->id = FB_TK_LE
1835 
1836  '' '<>'?
1837  case CHAR_GT
1838  '' t.text += chr( lexEatChar )
1839  t->text[t->len+0] = lexEatChar( )
1840  t->text[t->len+1] = 0
1841  t->len += 1
1842  t->id = FB_TK_NE
1843 
1844  case else
1845  t->id = FB_TK_LT
1846  end select
1847 
1848  case CHAR_GT
1849  '' '>='?
1850  if( fbGetGtInParensOnly( ) = FALSE andalso lexCurrentChar( TRUE ) = CHAR_EQ ) then
1851  '' t.text += chr( lexEatChar )
1852  t->text[t->len+0] = lexEatChar( )
1853  t->text[t->len+1] = 0
1854  t->len += 1
1855  t->id = FB_TK_GE
1856  else
1857  t->id = FB_TK_GT
1858  end if
1859 
1860  case CHAR_EQ
1861  '' '=>'?
1862  if( lexCurrentChar( TRUE ) = CHAR_GT ) then
1863  '' t.text += chr( lexEatChar )
1864  t->text[t->len+0] = lexEatChar( )
1865  t->text[t->len+1] = 0
1866  t->len += 1
1867  t->id = FB_TK_DBLEQ
1868  else
1869  t->id = FB_TK_EQ
1870  end if
1871  end select
1872 
1873  '' '+', '*', '\', '^', '@'?
1874  case CHAR_PLUS, CHAR_TIMES, CHAR_RSLASH, CHAR_CART, CHAR_AT
1875  t->class = FB_TKCLASS_OPERATOR
1876 
1877  '' '-'?
1878  case CHAR_MINUS
1879  t->class = FB_TKCLASS_OPERATOR
1880 
1881  '' check for type-field dereference
1882  if( lexCurrentChar( TRUE ) = CHAR_GT ) then
1883  '' t.text += chr( lexEatChar )
1884  t->text[t->len+0] = lexEatChar( )
1885  t->text[t->len+1] = 0
1886  t->len += 1
1887  t->id = FB_TK_FIELDDEREF
1888  end if
1889 
1890  '' '/'?
1891  case CHAR_SLASH
1892  t->class = FB_TKCLASS_OPERATOR
1893  '' in lang fb, only check for multiline comment if not inside
1894  '' a single line comment already (thanks to VonGodric for help)
1895  if( (flags and LEXCHECK_NOMULTILINECOMMENT) = 0 or _
1896  fbLangIsSet( FB_LANG_FB ) = FALSE ) then
1897  '' "/'"?
1898  if( lexCurrentChar( ) = CHAR_APOST ) then
1899  '' multi-line comment..
1901  t->after_space = TRUE
1902  goto re_read
1903  end if
1904  end if
1905 
1906  '' '''
1907  case CHAR_APOST
1908  t->class = FB_TKCLASS_DELIMITER
1909  t->id = FB_TK_COMMENT
1910 
1911  '' ':'
1912  case CHAR_COLON
1913  t->class = FB_TKCLASS_DELIMITER
1914  t->id = FB_TK_STMTSEP
1915 
1916  '' '(', ')', ',', ';', '.', '{', '}', '[', ']'?
1917  case CHAR_LPRNT, CHAR_RPRNT, CHAR_COMMA, _
1918  CHAR_SEMICOLON, CHAR_DOT, CHAR_LBRACE, CHAR_RBRACE, _
1919  CHAR_LBRACKET, CHAR_RBRACKET
1920  t->class = FB_TKCLASS_DELIMITER
1921 
1922  '' ' ', '\t'?
1923  case CHAR_SPACE, CHAR_TAB
1924  t->class = FB_TKCLASS_DELIMITER
1925  t->id = CHAR_SPACE
1926 
1927  do
1928  select case as const lexCurrentChar( )
1929  case CHAR_SPACE, CHAR_TAB
1930  lexEatChar( )
1931  t->text[t->len] = CHAR_SPACE '' t.text += " "
1932  t->len += 1
1933  case else
1934  t->text[t->len] = 0 '' t.text += chr( 0 )
1935  exit do
1936  end select
1937  loop
1938 
1939  '' anything else..
1940  case else
1941  t->class = FB_TKCLASS_UNKNOWN
1942  end select
1943 
1944  end select
1945 
1946 end sub
1947 
1948 '':::::
1949 '' MultiLineComment = '/' ''' . '/' '''
1950 ''
1951 sub hMultiLineComment( ) static
1952  dim as integer cnt
1953 
1954  '' skip the last '''
1955  lexEatChar( )
1956 
1957  cnt = 0
1958  do
1959  select case as const lexCurrentChar( TRUE )
1960  '' EOF?
1961  case 0
1962  errReportEx( FB_ERRMSG_EXPECTEDENDCOMMENT, NULL )
1963  exit sub
1964 
1965  '' EOL?
1966  case CHAR_CR
1967  lexEatChar( )
1968 
1969  '' CRLF on DOS, LF only on *NIX
1970  if( lexCurrentChar( ) = CHAR_LF ) then
1971  lexEatChar( )
1972  end if
1973 
1974  UPDATE_LINENUM()
1975 
1976  '' EOL?
1977  case CHAR_LF
1978  lexEatChar( )
1979 
1980  UPDATE_LINENUM( )
1981 
1982  '' '/'?
1983  case CHAR_SLASH
1984  lexEatChar( )
1985 
1986  '' nested?
1987  if( lexCurrentChar( ) = CHAR_APOST ) then
1988  lexEatChar( )
1989  cnt += 1
1990  end if
1991 
1992  '' '''?
1993  case CHAR_APOST
1994  lexEatChar( )
1995 
1996  '' end of ml comment?
1997  if( lexCurrentChar( ) = CHAR_SLASH ) then
1998  lexEatChar( )
1999 
2000  '' not nested?
2001  if( cnt = 0 ) then
2002  exit do
2003  end if
2004 
2005  cnt -= 1
2006  end if
2007 
2008  '' anything else, skip..
2009  case else
2010  lexEatChar( )
2011  end select
2012  loop
2013 
2014 end sub
2015 
2016 '':::::
2017 function lexGetToken _
2018  ( _
2019  byval flags as LEXCHECK _
2020  ) as integer static
2021 
2022  if( lex.ctx->head->id = INVALID ) then
2023  lexNextToken( lex.ctx->head, flags )
2024  ppCheck( )
2025  end if
2026 
2027  function = lex.ctx->head->id
2028 
2029 end function
2030 
2031 '':::::
2032 function lexGetClass _
2033  ( _
2034  byval flags as LEXCHECK _
2035  ) as integer static
2036 
2037  if( lex.ctx->head->id = INVALID ) then
2038  lexNextToken( lex.ctx->head, flags )
2039  ppCheck( )
2040  end if
2041 
2042  function = lex.ctx->head->class
2043 
2044 end function
2045 
2046 '':::::
2047 function lexGetLookAhead _
2048  ( _
2049  byval k as integer, _
2050  byval flags as LEXCHECK _
2051  ) as integer static
2052 
2053  if( k > FB_LEX_MAXK ) then
2054  exit function
2055  end if
2056 
2057  if( k > lex.ctx->k ) then
2058  lex.ctx->k = k
2059  lex.ctx->tail = lex.ctx->tail->next
2060  end if
2061 
2062  if( lex.ctx->tail->id = INVALID ) then
2063  lexNextToken( lex.ctx->tail, flags )
2064  end if
2065 
2066  function = lex.ctx->tail->id
2067 
2068 end function
2069 
2070 '':::::
2071 function lexGetLookAheadClass _
2072  ( _
2073  byval k as integer, _
2074  byval flags as LEXCHECK _
2075  ) as integer static
2076 
2077  if( k > FB_LEX_MAXK ) then
2078  exit function
2079  end if
2080 
2081  if( k > lex.ctx->k ) then
2082  lex.ctx->k = k
2083  lex.ctx->tail = lex.ctx->tail->next
2084  end if
2085 
2086  if( lex.ctx->tail->id = INVALID ) then
2087  lexNextToken( lex.ctx->tail, flags )
2088  end if
2089 
2090  function = lex.ctx->tail->class
2091 
2092 end function
2093 
2094 '':::::
2095 sub hMoveKDown( ) static
2096 
2097  lex.ctx->head->id = INVALID
2098 
2099  lex.ctx->k -= 1
2100  lex.ctx->head = lex.ctx->head->next
2101 
2102 end sub
2103 
2104 function lexGetStrLitText( byval tk as integer ) as string
2105  dim as string s
2106  dim as integer is_escaped = any, saw_backslash = any
2107  dim as ubyte ptr p = any
2108 
2109  select case( tk )
2110  case FB_TK_STRLIT
2111  is_escaped = FALSE
2112  case FB_TK_STRLIT_ESC
2113  s += "!"
2114  is_escaped = TRUE
2115  case FB_TK_STRLIT_NOESC
2116  s += "$"
2117  is_escaped = FALSE
2118  end select
2119 
2120  s += """"
2121 
2122  '' Escaping is enabled for this string literal, so it could contain
2123  '' \" (which didn't stop the string token parser), or
2124  '' " (from "" sequences).
2125  ''
2126  '' And \" shouldn't be turned into \"" in the -pp output...
2127 
2128  saw_backslash = FALSE
2129  p = lexGetText( )
2130  do
2131  select case( *p )
2132  case 0
2133  exit do
2134 
2135  case asc( """" )
2136  if( saw_backslash ) then
2137  '' It's just a '\"'
2138  s += """"
2139  else
2140  '' It's a '"', and the user did '""'
2141  s += """"""
2142  end if
2143  saw_backslash = FALSE
2144 
2145  case asc( "\" )
2146  saw_backslash = is_escaped
2147  s += "\"
2148 
2149  case else
2150  saw_backslash = FALSE
2151  s += chr( *p )
2152 
2153  end select
2154 
2155  p += 1
2156  loop
2157 
2158  s += """"
2159 
2160  function = s
2161 end function
2162 
2164  select case( lexGetToken( ) )
2165  case FB_TK_COMMENT, FB_TK_REM
2166  '' Single-line comment
2167  exit sub
2168 
2169  case FB_TK_EOF, FB_TK_EOL
2170  '' EOF/EOL
2171 
2172  '' Don't write out empty lines (e.g. from PP directives)...
2173  if( len( pponly_ln ) > 0 ) then
2174  print #env.ppfile_num, pponly_ln
2175  pponly_ln = ""
2176  elseif( lexGetToken( ) = FB_TK_EOL ) then
2177  '' except for lines that really were empty, to help readability in the output.
2178  if( lex.ctx->lasttk_id = FB_TK_EOL ) then
2179  print #env.ppfile_num, ""
2180  end if
2181  end if
2182 
2183  exit sub
2184  end select
2185 
2186  '' Everything else...
2187  if( lex.ctx->head->after_space ) then
2188  pponly_ln += " "
2189  end if
2190 
2191  select case( lexGetToken( ) )
2192  case FB_TK_STRLIT, FB_TK_STRLIT_ESC, FB_TK_STRLIT_NOESC
2194  case else
2195  pponly_ln += *lexGetText( )
2196  end select
2197 end sub
2198 
2199 sub lexPPOnlyEmitText( byref s as string )
2200  pponly_ln += s
2201 end sub
2202 
2203 sub lexSkipToken( byval flags as LEXCHECK )
2204  '' Emit current token, if -pp was given, except if called from the PP,
2205  '' so only the tokens seen by the parser are written.
2206  '' (some cases like #inclib are given special treatment in the PP)
2207  if( env.ppfile_num > 0 ) then
2208  if( lex.ctx->reclevel = 0 ) then
2210  end if
2211  end if
2212 
2213  '' update stats
2214  select case lex.ctx->head->id
2215  case FB_TK_EOL
2216  UPDATE_LINENUM( )
2217 
2218  end select
2219 
2220  '' if no macro text been read, reset
2221  if( lex.ctx->deflen = 0 ) then
2222  lex.ctx->currmacro = NULL
2223  end if
2224 
2225  lex.ctx->lasttk_id = lex.ctx->head->id
2226 
2227  ''
2228  if( lex.ctx->k = 0 ) then
2229  lexNextToken( lex.ctx->head, flags )
2230  else
2231  hMoveKDown( )
2232  end if
2233 
2234  ppCheck( )
2235 end sub
2236 
2237 '':::::
2238 sub lexEatToken _
2239  ( _
2240  byval token as zstring ptr, _
2241  byval flags as LEXCHECK _
2242  ) static
2243 
2244  ''
2245  if( lex.ctx->head->dtype <> FB_DATATYPE_WCHAR ) then
2246  *token = lex.ctx->head->text
2247  else
2248  *token = str( lex.ctx->head->textw )
2249  end if
2250 
2251  lexSkipToken( flags )
2252 
2253 end sub
2254 
2255 ''::::
2256 function lexGetText _
2257  ( _
2258  ) as zstring ptr static
2259 
2260  static as zstring * FB_MAXLITLEN+1 tmpstr
2261 
2262  if( lex.ctx->head->dtype <> FB_DATATYPE_WCHAR ) then
2263  function = @lex.ctx->head->text
2264  else
2265  tmpstr = str( lex.ctx->head->textw )
2266  function = @tmpstr
2267  end if
2268 
2269 end function
2270 
2271 '':::::
2272 sub lexReadLine _
2273  ( _
2274  byval endchar as uinteger = INVALID, _
2275  byval dst as zstring ptr, _
2276  byval skipline as integer = FALSE _
2277  ) static
2278 
2279  dim as uinteger char
2280 
2281  if( skipline = FALSE ) then
2282  *dst = ""
2283  end if
2284 
2285  '' check look ahead tokens if any
2286  do while( lex.ctx->k > 0 )
2287  select case lex.ctx->head->id
2288  case FB_TK_EOF, FB_TK_EOL, endchar
2289  exit sub
2290  case else
2291  if( skipline = FALSE ) then
2292  *dst += lex.ctx->head->text
2293  end if
2294  end select
2295 
2296  hMoveKDown( )
2297  loop
2298 
2299  '' check current token
2300  select case lex.ctx->head->id
2301  case FB_TK_EOF, FB_TK_EOL, endchar
2302  exit sub
2303  case else
2304  if( skipline = FALSE ) then
2305  *dst += lex.ctx->head->text
2306  end if
2307  end select
2308 
2309  ''
2310  do
2311  char = lexCurrentChar( )
2312 
2313  '' EOF?
2314  select case as const char
2315  case 0
2316  lex.ctx->head->id = FB_TK_EOF
2317  lex.ctx->head->class = FB_TKCLASS_DELIMITER
2318  exit sub
2319 
2320  '' EOL?
2321  case CHAR_CR, CHAR_LF
2322  lexEatChar( )
2323  '' CRLF on DOS, LF only on *NIX
2324  if( char = CHAR_CR ) then
2325  if( lexCurrentChar( ) = CHAR_LF ) then lexEatChar
2326  end if
2327 
2328  lex.ctx->head->id = FB_TK_EOL
2329  lex.ctx->head->class = FB_TKCLASS_DELIMITER
2330  exit sub
2331 
2332  case else
2333  '' closing char?
2334  if( char = endchar ) then
2335  lex.ctx->head->id = endchar
2336  lex.ctx->head->class = FB_TKCLASS_DELIMITER
2337  exit sub
2338  end if
2339  end select
2340 
2341  lexEatChar( )
2342  if( skipline = FALSE ) then
2343  *dst += chr( char )
2344  end if
2345  loop
2346 
2347 end sub
2348 
2349 '':::::
2350 sub lexSkipLine( ) static
2351 
2352  lexReadLine( , NULL, TRUE )
2353 
2354 end sub
2355 
2356 '':::::
2357 function lexPeekCurrentLine _
2358  ( _
2359  byref token_pos as string, _
2360  byval do_trim as integer _
2361  ) as string
2362 
2363  static as zstring * 1024+1 buffer
2364  dim as string res
2365  dim as integer p, old_p, start, token_len
2366  dim as ubyte ptr c
2367  dim as uinteger char
2368 
2369  function = ""
2370 
2371  '' !!!WRITEME!!!
2372  if( env.inf.format <> FBFILE_FORMAT_ASCII ) then
2373  exit function
2374  end if
2375 
2376  '' get file contents around current token
2377  old_p = seek( env.inf.num )
2378  p = lex.ctx->lastfilepos - 512
2379  start = 512
2380  if( p < 0 ) then
2381  start += p
2382  p = 0
2383  end if
2384 
2385  get #env.inf.num, p + 1, buffer
2386  seek #env.inf.num, old_p
2387 
2388  '' find source line start
2389  c = @buffer[start]
2390  token_len = 0
2391  if( start > 0 ) then
2392  c -= 1
2393  do
2394  char = *c
2395  select case char
2396  case CHAR_CR, CHAR_LF
2397  exit do
2398  end select
2399 
2400  if( start <= 0 ) then
2401  exit do
2402  end if
2403 
2404  token_len += 1
2405  c -= 1
2406  start -= 1
2407  loop
2408  c += 1
2409  end if
2410 
2411  '' build source line
2412  res = ""
2413  token_pos = ""
2414  do
2415  char = *c
2416  select case char
2417  case 0, CHAR_CR, CHAR_LF
2418  exit do
2419  end select
2420 
2421  res += chr( char )
2422  if( token_len > 0 ) then
2423  token_pos += chr( iif( char = CHAR_TAB, CHAR_TAB, CHAR_SPACE ) )
2424  token_len -= 1
2425  end if
2426 
2427  c += 1
2428  loop
2429 
2430  if( do_trim ) then
2431  dim as integer i
2432  '' ltrim
2433  for i = 0 to len( res )-1
2434  select case res[i]
2435  case CHAR_TAB, CHAR_SPACE
2436 
2437  case else
2438  exit for
2439  end select
2440  next
2441 
2442  if( i < len( res ) ) then
2443  res = mid( res, 1+i )
2444  else
2445  res = ""
2446  end if
2447 
2448  '' rtrim
2449  for i = len( res )-1 to 0 step -1
2450  select case res[i]
2451  case CHAR_TAB, CHAR_SPACE
2452 
2453  case else
2454  exit for
2455  end select
2456  next
2457 
2458  if( i > 0 ) then
2459  res = left( res, 1+i )
2460  end if
2461  end if
2462 
2463  token_pos += "^"
2464 
2465  function = res
2466 
2467 end function
2468