FreeBASIC  0.91.0
parser-decl-option.bas
Go to the documentation of this file.
1 '' option (OPTION) 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 declare sub hUndefSymbol()
10 
11 '' OptDecl = OPTION (BYVAL|DYNAMIC|STATIC|GOSUB|EXPLICIT|PRIVATE|ESCAPE|BASE NUM_LIT|NOKEYWORD ...|NOGOSUB)
12 sub cOptDecl( )
13  if( fbLangOptIsSet( FB_LANG_OPT_OPTION ) = FALSE ) then
14  errReportNotAllowed( FB_LANG_OPT_OPTION )
15  hSkipStmt( )
16  exit sub
17  end if
18 
19  if( cCompStmtIsAllowed( FB_CMPSTMT_MASK_DECL ) = FALSE ) then
20  hSkipStmt( )
21  exit sub
22  end if
23 
24  '' OPTION
25  lexSkipToken( )
26 
27  select case as const lexGetToken( )
28  case FB_TK_BYVAL
29  lexSkipToken( )
30  env.opt.parammode = FB_PARAMMODE_BYVAL
31 
32  case FB_TK_DYNAMIC
33  lexSkipToken( )
34  env.opt.dynamic = TRUE
35 
36  case FB_TK_STATIC
37  lexSkipToken( )
38  env.opt.dynamic = FALSE
39 
40  case FB_TK_GOSUB
41  if( fbLangOptIsSet( FB_LANG_OPT_GOSUB ) = FALSE ) then
42  errReportNotAllowed( FB_LANG_OPT_GOSUB )
43  else
44  env.opt.gosub = TRUE
45  end if
46 
47  lexSkipToken( )
48 
49  case else
50 
51  '' Search for text match with non-keywords - this
52  '' prevents us from having to add them to the namespace
53 
54  select case ucase( *lexGetText( ) )
55  '' EXPLICIT: Not a keyword in lang qb
56  case "EXPLICIT"
57  env.opt.explicit = TRUE
58  lexSkipToken( )
59 
60  '' PRIVATE: Ditto
61  case "PRIVATE"
62  lexSkipToken( )
63  env.opt.procpublic = FALSE
64 
65  case "ESCAPE"
66  lexSkipToken( )
67  env.opt.escapestr = TRUE
68 
69  case "BASE"
70  lexSkipToken( )
71 
72  if( lexGetClass( ) <> FB_TKCLASS_NUMLITERAL ) then
73  errReport( FB_ERRMSG_SYNTAXERROR )
74  '' error recovery: skip stmt
75  hSkipStmt( )
76  else
77  env.opt.base = valint( *lexGetText( ) )
78  lexSkipToken( )
79  end if
80 
81  case "NOKEYWORD"
82  lexSkipToken( LEXCHECK_NODEFINE )
83 
84  do
85  hUndefSymbol()
86 
87  '' ','?
88  if( lexGetToken( ) <> CHAR_COMMA ) then
89  exit do
90  end if
91 
92  lexSkipToken( LEXCHECK_NODEFINE )
93  loop
94 
95  case "NOGOSUB"
96  if( fbLangOptIsSet( FB_LANG_OPT_GOSUB ) = FALSE ) then
97  errReportNotAllowed( FB_LANG_OPT_GOSUB )
98  else
99  env.opt.gosub = FALSE
100  end if
101 
102  lexSkipToken( )
103 
104  case else
105  errReport( FB_ERRMSG_SYNTAXERROR )
106  end select
107 
108  end select
109 end sub
110 
112  dim s as FBSYMBOL ptr
113 
114  select case as const lexGetClass( LEXCHECK_NODEFINE )
115  case FB_TKCLASS_KEYWORD, FB_TKCLASS_QUIRKWD
116  s = lexGetSymChain( )->sym
117  if( s ) then
118  '' Forget the symbol so it's no longer found by lookups,
119  '' but don't fully delete it, since it might already be used somewhere.
120  symbDelFromHash( s )
121  else
122  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER )
123  end if
124 
125  lexSkipToken( )
126 
127  case FB_TKCLASS_IDENTIFIER
128  '' proc?
129  s = symbFindByClass( lexGetSymChain( ), FB_SYMBCLASS_PROC )
130  if( s <> NULL ) then
131  '' is it from the rtlib (gfxlib will be listed as part of the rt too)?
132  if( symbGetIsRTL( s ) = FALSE ) then
133  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER )
134  else
135  '' don't remove if it was defined inside any namespace (any
136  '' USING ref to that ns would break its linked-list)
137  if( symbGetNamespace( s ) <> @symbGetGlobalNamespc( ) ) then
138  errReport( FB_ERRMSG_CANTREMOVENAMESPCSYMBOLS )
139  else
140  if( symbGetCantUndef( s ) ) then
141  errReport( FB_ERRMSG_CANTUNDEF )
142  else
143  symbDelFromHash( s )
144  end if
145  end if
146  end if
147  else
148  '' macro?
149  s = symbFindByClass( lexGetSymChain( ), FB_SYMBCLASS_DEFINE )
150  if( s = NULL ) then
151  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER )
152  else
153  '' don't remove if it was defined inside any namespace (any
154  '' USING ref to that ns would break its linked-list)
155  if( symbGetNamespace( s ) <> @symbGetGlobalNamespc( ) ) then
156  errReport( FB_ERRMSG_CANTREMOVENAMESPCSYMBOLS )
157  else
158  if( symbGetCantUndef( s ) ) then
159  errReport( FB_ERRMSG_CANTUNDEF )
160  else
161  symbDelFromHash( s )
162  end if
163  end if
164  end if
165  end if
166 
167  lexSkipToken( )
168 
169  case else
170  errReport( FB_ERRMSG_SYNTAXERROR )
171  '' error recovery: skip until next ','
172  hSkipUntil( CHAR_COMMA )
173  end select
174 end sub
175