FreeBASIC  0.91.0
parser-decl-def.bas
Go to the documentation of this file.
1 '' DEF### declarations
2 ''
3 '' chng: sep/2004 written [v1ctor]
4 
5 #include once "fb.bi"
6 #include once "fbint.bi"
7 #include once "parser.bi"
8 
9 '' DefDecl = (DEFINT|DEFLNG|DEFSNG|DEFDBL|DEFSTR) (CHAR '-' CHAR ','?)* .
10 sub cDefDecl( )
11  static as zstring * 32+1 char
12  dim as integer dtype = any, ichar = any, echar = any
13 
14  if( fbLangOptIsSet( FB_LANG_OPT_DEFTYPE ) = FALSE ) then
15  errReportNotAllowed( FB_LANG_OPT_DEFTYPE )
16  '' error recovery: skip stmt
17  hSkipStmt( )
18  exit sub
19  end if
20 
21  '' QBASIC allows DEF___ in procs/compound statements, though even then
22  '' it's still disallowed between SELECT and CASE
23  if( cCompStmtIsAllowed( iif( fbLangIsSet( FB_LANG_QB ), _
24  FB_CMPSTMT_MASK_DECL or FB_CMPSTMT_MASK_CODE, _
25  FB_CMPSTMT_MASK_DECL ) ) = FALSE ) then
26  hSkipStmt( )
27  exit sub
28  end if
29 
30  dtype = FB_DATATYPE_INVALID
31 
32  select case as const lexGetToken( )
33  case FB_TK_DEFBYTE
34  dtype = FB_DATATYPE_BYTE
35 
36  case FB_TK_DEFUBYTE
37  dtype = FB_DATATYPE_UBYTE
38 
39  case FB_TK_DEFSHORT
40  dtype = FB_DATATYPE_SHORT
41 
42  case FB_TK_DEFUSHORT
43  dtype = FB_DATATYPE_USHORT
44 
45  case FB_TK_DEFINT
46  dtype = env.lang.integerkeyworddtype
47 
48  case FB_TK_DEFUINT
49  dtype = FB_DATATYPE_UINT
50 
51  case FB_TK_DEFLNG
52  dtype = FB_DATATYPE_LONG
53 
54  case FB_TK_DEFULNG
55  dtype = FB_DATATYPE_ULONG
56 
57  case FB_TK_DEFLNGINT
58  dtype = FB_DATATYPE_LONGINT
59 
60  case FB_TK_DEFULNGINT
61  dtype = FB_DATATYPE_ULONGINT
62 
63  case FB_TK_DEFSNG
64  dtype = FB_DATATYPE_SINGLE
65 
66  case FB_TK_DEFDBL
67  dtype = FB_DATATYPE_DOUBLE
68 
69  case FB_TK_DEFSTR
70  dtype = FB_DATATYPE_STRING
71  end select
72 
73  assert( dtype <> FB_DATATYPE_INVALID )
74  lexSkipToken( )
75 
76  '' (CHAR '-' CHAR ','?)*
77  do
78  '' CHAR
79  char = ucase( *lexGetText( ) )
80  if( len( char ) <> 1 ) then
81  errReport( FB_ERRMSG_EXPECTEDCOMMA )
82  end if
83  ichar = asc( char )
84  lexSkipToken( )
85 
86  '' '-'
87  if( lexGetToken( ) = CHAR_MINUS ) then
88  lexSkipToken( )
89 
90  '' CHAR
91  char = ucase( *lexGetText( ) )
92  if( len( char ) <> 1 ) then
93  errReport( FB_ERRMSG_EXPECTEDCOMMA )
94  end if
95  echar = asc( char )
96  lexSkipToken( )
97 
98  else
99  echar = ichar
100  end if
101 
102  symbSetDefType( ichar, echar, dtype )
103 
104  '' ','
105  if( lexGetToken( ) <> CHAR_COMMA ) then
106  exit do
107  end if
108 
109  lexSkipToken( )
110  loop
111 end sub
112