switches.pas 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221
  1. {
  2. $Id$
  3. Copyright (c) 1998 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. interface
  20. procedure HandleSwitch(switch,state:char);
  21. function CheckSwitch(switch,state:char):boolean;
  22. implementation
  23. uses globals,verbose,files,systems;
  24. {****************************************************************************
  25. Main Switches Parsing
  26. ****************************************************************************}
  27. type
  28. TSwitchType=(ignoredsw,localsw,modulesw,globalsw,illegalsw,unsupportedsw);
  29. SwitchRec=record
  30. typesw : TSwitchType;
  31. setsw : byte;
  32. end;
  33. const
  34. SwitchTable:array['A'..'Z'] of SwitchRec=(
  35. {A} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  36. {B} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  37. {C} (typesw:localsw; setsw:ord(cs_do_assertion)),
  38. {D} (typesw:modulesw; setsw:ord(cs_debuginfo)),
  39. {E} (typesw:globalsw; setsw:ord(cs_fp_emulation)),
  40. {F} (typesw:ignoredsw; setsw:ord(cs_localnone)),
  41. {G} (typesw:ignoredsw; setsw:ord(cs_localnone)),
  42. {H} (typesw:localsw; setsw:ord(cs_ansistrings)),
  43. {I} (typesw:localsw; setsw:ord(cs_check_io)),
  44. {J} (typesw:illegalsw; setsw:ord(cs_localnone)),
  45. {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  46. {L} (typesw:modulesw; setsw:ord(cs_local_browser)),
  47. {M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
  48. {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  49. {O} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  50. {P} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  51. {Q} (typesw:localsw; setsw:ord(cs_check_overflow)),
  52. {R} (typesw:localsw; setsw:ord(cs_check_range)),
  53. {S} (typesw:localsw; setsw:ord(cs_check_stack)),
  54. {T} (typesw:localsw; setsw:ord(cs_typed_addresses)),
  55. {U} (typesw:illegalsw; setsw:ord(cs_localnone)),
  56. {V} (typesw:localsw; setsw:ord(cs_strict_var_strings)),
  57. {W} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
  58. {X} (typesw:modulesw; setsw:ord(cs_extsyntax)),
  59. {Y} (typesw:modulesw; setsw:ord(cs_browser)),
  60. {Z} (typesw:illegalsw; setsw:ord(cs_localnone))
  61. );
  62. procedure HandleSwitch(switch,state:char);
  63. begin
  64. switch:=upcase(switch);
  65. { Is the Switch in the letters ? }
  66. if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
  67. begin
  68. Message(scan_w_illegal_switch);
  69. exit;
  70. end;
  71. { Handle the switch }
  72. with SwitchTable[switch] do
  73. begin
  74. case typesw of
  75. ignoredsw : Message1(scan_n_ignored_switch,'$'+switch);
  76. illegalsw : Message1(scan_w_illegal_switch,'$'+switch);
  77. unsupportedsw : Message1(scan_w_unsupported_switch,'$'+switch);
  78. localsw : begin
  79. if state='+' then
  80. aktlocalswitches:=aktlocalswitches+[tlocalswitch(setsw)]
  81. else
  82. aktlocalswitches:=aktlocalswitches-[tlocalswitch(setsw)];
  83. { Message for linux which has global checking only }
  84. if (switch='S')
  85. {$ifdef i386}
  86. and (target_info.target=target_linux)
  87. {$endif i386}
  88. {$ifdef m68k}
  89. and (target_info.target=target_linux_m68k)
  90. {$endif m68k}
  91. then
  92. Message(scan_n_stack_check_global_under_linux);
  93. end;
  94. modulesw : begin
  95. if current_module^.in_global then
  96. begin
  97. if state='+' then
  98. aktmoduleswitches:=aktmoduleswitches+[tmoduleswitch(setsw)]
  99. else
  100. aktmoduleswitches:=aktmoduleswitches-[tmoduleswitch(setsw)];
  101. end
  102. else
  103. Message(scan_w_switch_is_global);
  104. end;
  105. globalsw : begin
  106. if current_module^.in_global and (current_module=main_module) then
  107. begin
  108. if state='+' then
  109. aktglobalswitches:=aktglobalswitches+[tglobalswitch(setsw)]
  110. else
  111. aktglobalswitches:=aktglobalswitches-[tglobalswitch(setsw)];
  112. end
  113. else
  114. Message(scan_w_switch_is_global);
  115. end;
  116. end;
  117. end;
  118. end;
  119. function CheckSwitch(switch,state:char):boolean;
  120. var
  121. found : boolean;
  122. begin
  123. switch:=upcase(switch);
  124. { Is the Switch in the letters ? }
  125. if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
  126. begin
  127. Message(scan_w_illegal_switch);
  128. CheckSwitch:=false;
  129. exit;
  130. end;
  131. { Check the switch }
  132. with SwitchTable[switch] do
  133. begin
  134. case typesw of
  135. localsw : found:=(tlocalswitch(setsw) in aktlocalswitches);
  136. modulesw : found:=(tmoduleswitch(setsw) in aktmoduleswitches);
  137. globalsw : found:=(tglobalswitch(setsw) in aktglobalswitches);
  138. else
  139. found:=false;
  140. end;
  141. if state='-' then
  142. found:=not found;
  143. CheckSwitch:=found;
  144. end;
  145. end;
  146. end.
  147. {
  148. $Log$
  149. Revision 1.14 1998-10-13 08:19:41 pierre
  150. + source_os is now set correctly for cross-processor compilers
  151. (tos contains all target_infos and
  152. we use CPU86 and CPU68 conditionnals to
  153. get the source operating system
  154. this only works if you do not undefine
  155. the source target !!)
  156. * several cg68k memory leaks fixed
  157. + started to change the code so that it should be possible to have
  158. a complete compiler (both for m68k and i386 !!)
  159. Revision 1.13 1998/09/22 17:13:52 pierre
  160. + browsing updated and developed
  161. records and objects fields are also stored
  162. Revision 1.12 1998/09/01 12:52:05 peter
  163. + a lot of delphi switches
  164. Revision 1.11 1998/08/18 20:52:21 peter
  165. * renamed in_main to in_global which is more logical
  166. Revision 1.10 1998/08/14 18:14:57 peter
  167. * forgot to check the target for linux for $S switch message
  168. Revision 1.9 1998/08/10 15:47:08 peter
  169. * reinstantited stackcheck note for linux
  170. Revision 1.8 1998/08/10 14:50:27 peter
  171. + localswitches, moduleswitches, globalswitches splitting
  172. Revision 1.7 1998/07/24 22:17:00 florian
  173. * internal error 10 together with array access fixed. I hope
  174. that's the final fix.
  175. Revision 1.6 1998/07/18 17:11:13 florian
  176. + ansi string constants fixed
  177. + switch $H partial implemented
  178. Revision 1.5 1998/06/04 23:52:00 peter
  179. * m68k compiles
  180. + .def file creation moved to gendef.pas so it could also be used
  181. for win32
  182. Revision 1.4 1998/05/21 19:33:36 peter
  183. + better procedure directive handling and only one table
  184. Revision 1.3 1998/05/01 07:43:56 florian
  185. + basics for rtti implemented
  186. + switch $m (generate rtti for published sections)
  187. Revision 1.2 1998/04/28 11:45:53 florian
  188. * make it compilable with TP
  189. + small COM problems solved to compile classes.pp
  190. Revision 1.1 1998/04/27 23:13:53 peter
  191. + the new files for the scanner
  192. }