switches.pas 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Peter Vreman
  4. This unit implements the parsing of the switches like $I-
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit switches;
  19. {$i fpcdefs.inc}
  20. interface
  21. procedure HandleSwitch(switch,state:char);
  22. function CheckSwitch(switch,state:char):boolean;
  23. implementation
  24. uses
  25. globtype,systems,
  26. globals,verbose,fmodule;
  27. {****************************************************************************
  28. Main Switches Parsing
  29. ****************************************************************************}
  30. type
  31. TSwitchType=(ignoredsw,localsw,modulesw,globalsw,illegalsw,unsupportedsw);
  32. SwitchRec=record
  33. typesw : TSwitchType;
  34. setsw : byte;
  35. end;
  36. const
  37. SwitchTable:array['A'..'Z'] of SwitchRec=(
  38. {A} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  39. {B} (typesw:localsw; setsw:ord(cs_full_boolean_eval)),
  40. {C} (typesw:localsw; setsw:ord(cs_do_assertion)),
  41. {D} (typesw:modulesw; setsw:ord(cs_debuginfo)),
  42. {E} (typesw:modulesw; setsw:ord(cs_fp_emulation)),
  43. {F} (typesw:ignoredsw; setsw:ord(cs_localnone)),
  44. {G} (typesw:ignoredsw; setsw:ord(cs_localnone)),
  45. {H} (typesw:localsw; setsw:ord(cs_ansistrings)),
  46. {I} (typesw:localsw; setsw:ord(cs_check_io)),
  47. {J} (typesw:localsw; setsw:ord(cs_typed_const_writable)),
  48. {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  49. {L} (typesw:modulesw; setsw:ord(cs_local_browser)),
  50. {M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
  51. {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  52. {O} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  53. {P} (typesw:modulesw; setsw:ord(cs_openstring)),
  54. {Q} (typesw:localsw; setsw:ord(cs_check_overflow)),
  55. {R} (typesw:localsw; setsw:ord(cs_check_range)),
  56. {S} (typesw:localsw; setsw:ord(cs_check_stack)),
  57. {T} (typesw:localsw; setsw:ord(cs_typed_addresses)),
  58. {U} (typesw:illegalsw; setsw:ord(cs_localnone)),
  59. {V} (typesw:localsw; setsw:ord(cs_strict_var_strings)),
  60. {W} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  61. {X} (typesw:modulesw; setsw:ord(cs_extsyntax)),
  62. {Y} (typesw:modulesw; setsw:ord(cs_browser)),
  63. {Z} (typesw:illegalsw; setsw:ord(cs_localnone))
  64. );
  65. procedure HandleSwitch(switch,state:char);
  66. begin
  67. switch:=upcase(switch);
  68. { Is the Switch in the letters ? }
  69. if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
  70. begin
  71. Message(scan_w_illegal_switch);
  72. exit;
  73. end;
  74. { Handle the switch }
  75. with SwitchTable[switch] do
  76. begin
  77. case typesw of
  78. ignoredsw : Message1(scan_n_ignored_switch,'$'+switch);
  79. illegalsw : Message1(scan_w_illegal_switch,'$'+switch);
  80. unsupportedsw : Message1(scan_w_unsupported_switch,'$'+switch);
  81. localsw : begin
  82. if not localswitcheschanged then
  83. nextaktlocalswitches:=aktlocalswitches;
  84. if state='+' then
  85. include(nextaktlocalswitches,tlocalswitch(setsw))
  86. else
  87. exclude(nextaktlocalswitches,tlocalswitch(setsw));
  88. localswitcheschanged:=true;
  89. end;
  90. modulesw : begin
  91. if current_module.in_global then
  92. begin
  93. if state='+' then
  94. include(aktmoduleswitches,tmoduleswitch(setsw))
  95. else
  96. exclude(aktmoduleswitches,tmoduleswitch(setsw));
  97. end
  98. else
  99. Message(scan_w_switch_is_global);
  100. end;
  101. globalsw : begin
  102. if current_module.in_global and (current_module=main_module) then
  103. begin
  104. if state='+' then
  105. include(aktglobalswitches,tglobalswitch(setsw))
  106. else
  107. exclude(aktglobalswitches,tglobalswitch(setsw));
  108. end
  109. else
  110. Message(scan_w_switch_is_global);
  111. end;
  112. end;
  113. end;
  114. end;
  115. function CheckSwitch(switch,state:char):boolean;
  116. var
  117. found : boolean;
  118. begin
  119. switch:=upcase(switch);
  120. { Is the Switch in the letters ? }
  121. if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
  122. begin
  123. Message(scan_w_illegal_switch);
  124. CheckSwitch:=false;
  125. exit;
  126. end;
  127. { Check the switch }
  128. with SwitchTable[switch] do
  129. begin
  130. case typesw of
  131. localsw : found:=(tlocalswitch(setsw) in aktlocalswitches);
  132. modulesw : found:=(tmoduleswitch(setsw) in aktmoduleswitches);
  133. globalsw : found:=(tglobalswitch(setsw) in aktglobalswitches);
  134. else
  135. found:=false;
  136. end;
  137. if state='-' then
  138. found:=not found;
  139. CheckSwitch:=found;
  140. end;
  141. end;
  142. end.
  143. {
  144. $Log$
  145. Revision 1.12 2002-05-18 13:34:18 peter
  146. * readded missing revisions
  147. Revision 1.11 2002/05/16 19:46:44 carl
  148. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  149. + try to fix temp allocation (still in ifdef)
  150. + generic constructor calls
  151. + start of tassembler / tmodulebase class cleanup
  152. Revision 1.9 2002/04/15 19:44:20 peter
  153. * fixed stackcheck that would be called recursively when a stack
  154. error was found
  155. * generic changeregsize(reg,size) for i386 register resizing
  156. * removed some more routines from cga unit
  157. * fixed returnvalue handling
  158. * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
  159. }