scandir.pas 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Peter Vreman
  4. This unit implements directive parsing for the scanner
  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 scandir;
  19. {$i fpcdefs.inc}
  20. interface
  21. procedure InitScannerDirectives;
  22. implementation
  23. uses
  24. cutils,
  25. globtype,globals,systems,widestr,
  26. verbose,comphook,
  27. scanner,switches,
  28. fmodule,
  29. rabase;
  30. {*****************************************************************************
  31. Helpers
  32. *****************************************************************************}
  33. procedure do_delphiswitch(sw:char);
  34. var
  35. state : char;
  36. begin
  37. { c contains the next char, a + or - would be fine }
  38. state:=current_scanner.readstate;
  39. if state in ['-','+'] then
  40. HandleSwitch(sw,state);
  41. end;
  42. procedure do_setverbose(flag:char);
  43. var
  44. state : char;
  45. begin
  46. { support ON/OFF }
  47. state:=current_scanner.ReadState;
  48. SetVerbosity(flag+state);
  49. end;
  50. procedure do_moduleswitch(sw:tmoduleswitch);
  51. var
  52. state : char;
  53. begin
  54. state:=current_scanner.readstate;
  55. if (sw<>cs_modulenone) and (state in ['-','+']) then
  56. begin
  57. if state='-' then
  58. exclude(aktmoduleswitches,sw)
  59. else
  60. include(aktmoduleswitches,sw);
  61. end;
  62. end;
  63. procedure do_localswitch(sw:tlocalswitch);
  64. var
  65. state : char;
  66. begin
  67. state:=current_scanner.readstate;
  68. if (sw<>cs_localnone) and (state in ['-','+']) then
  69. begin
  70. if not localswitcheschanged then
  71. nextaktlocalswitches:=aktlocalswitches;
  72. if state='-' then
  73. exclude(nextaktlocalswitches,sw)
  74. else
  75. include(nextaktlocalswitches,sw);
  76. localswitcheschanged:=true;
  77. end;
  78. end;
  79. procedure do_message(w:integer);
  80. begin
  81. current_scanner.skipspace;
  82. Message1(w,current_scanner.readcomment);
  83. end;
  84. {*****************************************************************************
  85. Directive Callbacks
  86. *****************************************************************************}
  87. procedure dir_align;
  88. var
  89. hs : string;
  90. begin
  91. current_scanner.skipspace;
  92. if not(c in ['0'..'9']) then
  93. begin
  94. { Support also the ON and OFF as switch }
  95. hs:=current_scanner.readid;
  96. if (hs='ON') then
  97. aktpackrecords:=4
  98. else
  99. if (hs='OFF') then
  100. aktpackrecords:=1
  101. else
  102. Message(scan_w_only_pack_records);
  103. end
  104. else
  105. begin
  106. case current_scanner.readval of
  107. 1 : aktpackrecords:=1;
  108. 2 : aktpackrecords:=2;
  109. 4 : aktpackrecords:=4;
  110. 8 : aktpackrecords:=8;
  111. 16 : aktpackrecords:=16;
  112. 32 : aktpackrecords:=32;
  113. else
  114. Message(scan_w_only_pack_records);
  115. end;
  116. end;
  117. end;
  118. procedure dir_asmmode;
  119. var
  120. s : string;
  121. begin
  122. current_scanner.skipspace;
  123. s:=current_scanner.readid;
  124. If Inside_asm_statement then
  125. Message1(scan_w_no_asm_reader_switch_inside_asm,s);
  126. if s='DEFAULT' then
  127. aktasmmode:=initasmmode
  128. else
  129. if not SetAsmReadMode(s,aktasmmode) then
  130. Message1(scan_e_illegal_asmmode_specifier,s);
  131. end;
  132. {$ifdef m68k}
  133. procedure dir_appid;
  134. begin
  135. if target_info.system<>system_m68k_palmos then
  136. Message(scan_w_appid_not_support);
  137. { change description global var in all cases }
  138. { it not used but in win32 and os2 }
  139. current_scanner.skipspace;
  140. palmos_applicationid:=current_scanner.readcomment;
  141. end;
  142. procedure dir_appname;
  143. begin
  144. if target_info.system<>system_m68k_palmos then
  145. Message(scan_w_appname_not_support);
  146. { change description global var in all cases }
  147. { it not used but in win32 and os2 }
  148. current_scanner.skipspace;
  149. palmos_applicationname:=current_scanner.readcomment;
  150. end;
  151. {$endif m68k}
  152. procedure dir_apptype;
  153. var
  154. hs : string;
  155. begin
  156. if not (target_info.system in [system_i386_win32,system_i386_os2,
  157. system_i386_emx, system_powerpc_macos]) then
  158. Message(scan_w_app_type_not_support);
  159. if not current_module.in_global then
  160. Message(scan_w_switch_is_global)
  161. else
  162. begin
  163. current_scanner.skipspace;
  164. hs:=current_scanner.readid;
  165. if hs='GUI' then
  166. apptype:=app_gui
  167. else if hs='CONSOLE' then
  168. apptype:=app_cui
  169. else if (hs='FS') and (target_info.system in [system_i386_os2,
  170. system_i386_emx]) then
  171. apptype:=app_fs
  172. else if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then
  173. apptype:=app_tool
  174. else
  175. Message1(scan_w_unsupported_app_type,hs);
  176. end;
  177. end;
  178. procedure dir_calling;
  179. var
  180. hs : string;
  181. begin
  182. current_scanner.skipspace;
  183. hs:=current_scanner.readid;
  184. if not SetAktProcCall(hs,false) then
  185. Message1(parser_w_unknown_proc_directive_ignored,hs);
  186. end;
  187. procedure dir_objectchecks;
  188. begin
  189. do_localswitch(cs_check_object);
  190. end;
  191. procedure dir_assertions;
  192. begin
  193. do_delphiswitch('C');
  194. end;
  195. procedure dir_booleval;
  196. begin
  197. do_delphiswitch('B');
  198. end;
  199. procedure dir_debuginfo;
  200. begin
  201. do_delphiswitch('D');
  202. end;
  203. procedure dir_description;
  204. begin
  205. if not (target_info.system in [system_i386_os2,system_i386_emx,
  206. system_i386_win32,system_i386_netware,system_i386_wdosx]) then
  207. Message(scan_w_description_not_support);
  208. { change description global var in all cases }
  209. { it not used but in win32, os2 and netware }
  210. current_scanner.skipspace;
  211. description:=current_scanner.readcomment;
  212. end;
  213. procedure dir_screenname; {ad}
  214. begin
  215. if target_info.system <> system_i386_netware then
  216. {Message(scan_w_decription_not_support);}
  217. comment (V_Warning,'Screenname only supported for target netware');
  218. current_scanner.skipspace;
  219. nwscreenname:=current_scanner.readcomment;
  220. end;
  221. procedure dir_threadname; {ad}
  222. begin
  223. if target_info.system <> system_i386_netware then
  224. {Message(scan_w_decription_not_support);}
  225. comment (V_Warning,'Threadname only supported for target netware');
  226. current_scanner.skipspace;
  227. nwthreadname:=current_scanner.readcomment;
  228. end;
  229. procedure dir_copyright; {ad}
  230. begin
  231. if target_info.system <> system_i386_netware then
  232. {Message(scan_w_decription_not_support);}
  233. comment (V_Warning,'Copyright only supported for target netware');
  234. current_scanner.skipspace;
  235. nwcopyright:=current_scanner.readcomment;
  236. end;
  237. procedure dir_error;
  238. begin
  239. do_message(scan_e_user_defined);
  240. end;
  241. procedure dir_extendedsyntax;
  242. begin
  243. do_delphiswitch('X');
  244. end;
  245. procedure dir_fatal;
  246. begin
  247. do_message(scan_f_user_defined);
  248. end;
  249. procedure dir_fputype;
  250. begin
  251. current_scanner.skipspace;
  252. if not(SetFPUType(upper(current_scanner.readcomment),false)) then
  253. comment(V_Error,'Illegal FPU type');
  254. end;
  255. procedure dir_goto;
  256. begin
  257. do_moduleswitch(cs_support_goto);
  258. end;
  259. procedure dir_hint;
  260. begin
  261. do_message(scan_h_user_defined);
  262. end;
  263. procedure dir_hints;
  264. begin
  265. do_setverbose('H');
  266. end;
  267. procedure dir_implicitexceptions;
  268. begin
  269. do_moduleswitch(cs_implicit_exceptions);
  270. end;
  271. procedure dir_includepath;
  272. begin
  273. if not current_module.in_global then
  274. Message(scan_w_switch_is_global)
  275. else
  276. begin
  277. current_scanner.skipspace;
  278. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  279. end;
  280. end;
  281. procedure dir_info;
  282. begin
  283. do_message(scan_i_user_defined);
  284. end;
  285. procedure dir_inline;
  286. begin
  287. do_moduleswitch(cs_support_inline);
  288. end;
  289. procedure dir_interfaces;
  290. var
  291. hs : string;
  292. begin
  293. {corba/com/default}
  294. current_scanner.skipspace;
  295. hs:=current_scanner.readid;
  296. if (hs='CORBA') then
  297. aktinterfacetype:=it_interfacecorba
  298. else if (hs='COM') then
  299. aktinterfacetype:=it_interfacecom
  300. else if (hs='DEFAULT') then
  301. aktinterfacetype:=initinterfacetype
  302. else
  303. Message(scan_e_invalid_interface_type);
  304. end;
  305. procedure dir_iochecks;
  306. begin
  307. do_delphiswitch('I');
  308. end;
  309. procedure dir_librarypath;
  310. begin
  311. if not current_module.in_global then
  312. Message(scan_w_switch_is_global)
  313. else
  314. begin
  315. current_scanner.skipspace;
  316. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  317. end;
  318. end;
  319. procedure dir_link;
  320. var
  321. s : string;
  322. begin
  323. current_scanner.skipspace;
  324. s:=AddExtension(FixFileName(current_scanner.readcomment),target_info.objext);
  325. current_module.linkotherofiles.add(s,link_allways);
  326. end;
  327. procedure dir_linklib;
  328. type
  329. tLinkMode=(lm_shared,lm_static);
  330. var
  331. s : string;
  332. quote : char;
  333. libname,
  334. linkmodestr : string;
  335. p : longint;
  336. linkMode : tLinkMode;
  337. begin
  338. current_scanner.skipspace;
  339. s:=current_scanner.readcomment;
  340. p:=pos(',',s);
  341. if p=0 then
  342. begin
  343. libname:=TrimSpace(s);
  344. linkmodeStr:='';
  345. end
  346. else
  347. begin
  348. libname:=TrimSpace(copy(s,1,p-1));
  349. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  350. end;
  351. if (libname='') or (libname='''''') or (libname='""') then
  352. exit;
  353. { get linkmode, default is shared linking }
  354. if linkModeStr='STATIC' then
  355. linkmode:=lm_static
  356. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  357. linkmode:=lm_shared
  358. else
  359. begin
  360. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  361. exit;
  362. end;
  363. { create library name }
  364. if libname[1] in ['''','"'] then
  365. begin
  366. quote:=libname[1];
  367. Delete(libname,1,1);
  368. p:=pos(quote,libname);
  369. if p>0 then
  370. Delete(libname,p,1);
  371. end;
  372. { add to the list of libraries to link }
  373. if linkMode=lm_static then
  374. current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
  375. else
  376. current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
  377. end;
  378. procedure dir_localsymbols;
  379. begin
  380. do_delphiswitch('L');
  381. end;
  382. procedure dir_longstrings;
  383. begin
  384. do_delphiswitch('H');
  385. end;
  386. procedure dir_macro;
  387. begin
  388. do_moduleswitch(cs_support_macro);
  389. end;
  390. procedure dir_maxfpuregisters;
  391. var
  392. l : integer;
  393. hs : string;
  394. begin
  395. current_scanner.skipspace;
  396. if not(c in ['0'..'9']) then
  397. begin
  398. hs:=current_scanner.readid;
  399. if (hs='NORMAL') or (hs='DEFAULT') then
  400. aktmaxfpuregisters:=-1
  401. else
  402. Message(scan_e_invalid_maxfpureg_value);
  403. end
  404. else
  405. begin
  406. l:=current_scanner.readval;
  407. case l of
  408. 0..8:
  409. aktmaxfpuregisters:=l;
  410. else
  411. Message(scan_e_invalid_maxfpureg_value);
  412. end;
  413. end;
  414. end;
  415. procedure dir_memory;
  416. var
  417. l : longint;
  418. begin
  419. current_scanner.skipspace;
  420. l:=current_scanner.readval;
  421. if l>1024 then
  422. stacksize:=l;
  423. current_scanner.skipspace;
  424. if c=',' then
  425. begin
  426. current_scanner.readchar;
  427. current_scanner.skipspace;
  428. l:=current_scanner.readval;
  429. if l>1024 then
  430. heapsize:=l;
  431. end;
  432. if c=',' then
  433. begin
  434. current_scanner.readchar;
  435. current_scanner.skipspace;
  436. l:=current_scanner.readval;
  437. { Ignore this value, because the limit is set by the OS
  438. info and shouldn't be changed by the user (PFV) }
  439. end;
  440. end;
  441. procedure dir_message;
  442. begin
  443. do_message(scan_i_user_defined);
  444. end;
  445. procedure dir_mode;
  446. begin
  447. if not current_module.in_global then
  448. Message(scan_w_switch_is_global)
  449. else
  450. begin
  451. current_scanner.skipspace;
  452. current_scanner.readstring;
  453. if not SetCompileMode(pattern,false) then
  454. Message1(scan_w_illegal_switch,pattern);
  455. end;
  456. end;
  457. procedure dir_mmx;
  458. begin
  459. do_localswitch(cs_mmx);
  460. end;
  461. procedure dir_note;
  462. begin
  463. do_message(scan_n_user_defined);
  464. end;
  465. procedure dir_notes;
  466. begin
  467. do_setverbose('N');
  468. end;
  469. procedure dir_objectpath;
  470. begin
  471. if not current_module.in_global then
  472. Message(scan_w_switch_is_global)
  473. else
  474. begin
  475. current_scanner.skipspace;
  476. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  477. end;
  478. end;
  479. procedure dir_openstrings;
  480. begin
  481. do_delphiswitch('P');
  482. end;
  483. procedure dir_output_format;
  484. begin
  485. if not current_module.in_global then
  486. Message(scan_w_switch_is_global)
  487. else
  488. begin
  489. current_scanner.skipspace;
  490. if set_target_asm_by_string(current_scanner.readid) then
  491. aktoutputformat:=target_asm.id
  492. else
  493. Message1(scan_w_illegal_switch,pattern);
  494. end;
  495. end;
  496. procedure dir_overflowchecks;
  497. begin
  498. do_delphiswitch('Q');
  499. end;
  500. procedure dir_packenum;
  501. var
  502. hs : string;
  503. begin
  504. current_scanner.skipspace;
  505. if not(c in ['0'..'9']) then
  506. begin
  507. hs:=current_scanner.readid;
  508. if (hs='NORMAL') or (hs='DEFAULT') then
  509. aktpackenum:=4
  510. else
  511. Message(scan_w_only_pack_enum);
  512. end
  513. else
  514. begin
  515. case current_scanner.readval of
  516. 1 : aktpackenum:=1;
  517. 2 : aktpackenum:=2;
  518. 4 : aktpackenum:=4;
  519. else
  520. Message(scan_w_only_pack_enum);
  521. end;
  522. end;
  523. end;
  524. procedure dir_packrecords;
  525. var
  526. hs : string;
  527. begin
  528. current_scanner.skipspace;
  529. if not(c in ['0'..'9']) then
  530. begin
  531. hs:=current_scanner.readid;
  532. { C has the special recordalignmax of -1 }
  533. if (hs='C') then
  534. aktpackrecords:=-1
  535. else
  536. if (hs='NORMAL') or (hs='DEFAULT') then
  537. aktpackrecords:=0
  538. else
  539. Message(scan_w_only_pack_records);
  540. end
  541. else
  542. begin
  543. case current_scanner.readval of
  544. 1 : aktpackrecords:=1;
  545. 2 : aktpackrecords:=2;
  546. 4 : aktpackrecords:=4;
  547. 8 : aktpackrecords:=8;
  548. 16 : aktpackrecords:=16;
  549. 32 : aktpackrecords:=32;
  550. else
  551. Message(scan_w_only_pack_records);
  552. end;
  553. end;
  554. end;
  555. {$ifdef testvarsets}
  556. procedure dir_packset;
  557. var
  558. hs : string;
  559. begin
  560. current_scanner.skipspace;
  561. if not(c in ['1','2','4']) then
  562. begin
  563. hs:=current_scanner.readid;
  564. if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
  565. aktsetalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  566. else
  567. Message(scan_w_only_packset);
  568. end
  569. else
  570. begin
  571. case current_scanner.readval of
  572. 1 : aktsetalloc:=1;
  573. 2 : aktsetalloc:=2;
  574. 4 : aktsetalloc:=4;
  575. else
  576. Message(scan_w_only_packset);
  577. end;
  578. end;
  579. end;
  580. {$ENDIF}
  581. procedure dir_profile;
  582. var
  583. mac : tmacro;
  584. begin
  585. do_moduleswitch(cs_profile);
  586. { defined/undefine FPC_PROFILE }
  587. mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
  588. if not assigned(mac) then
  589. begin
  590. mac:=tmacro.create('FPC_PROFILE');
  591. current_scanner.macros.insert(mac);
  592. end;
  593. mac.defined:=(cs_profile in aktmoduleswitches);
  594. end;
  595. procedure dir_rangechecks;
  596. begin
  597. do_delphiswitch('R');
  598. end;
  599. procedure dir_referenceinfo;
  600. begin
  601. do_delphiswitch('Y');
  602. end;
  603. procedure dir_resource;
  604. var
  605. s : string;
  606. begin
  607. current_scanner.skipspace;
  608. s:=current_scanner.readcomment;
  609. { replace * with current module name.
  610. This should always be defined. }
  611. if s[1]='*' then
  612. if Assigned(Current_Module) then
  613. begin
  614. delete(S,1,1);
  615. insert(lower(current_module.modulename^),S,1);
  616. end;
  617. s:=AddExtension(FixFileName(s),target_info.resext);
  618. if target_info.res<>res_none then
  619. if (target_info.res = res_emxbind) and
  620. not (Current_module.ResourceFiles.Empty) then
  621. Message(scan_w_only_one_resourcefile_supported)
  622. else
  623. current_module.resourcefiles.insert(FixFileName(s))
  624. else
  625. Message(scan_e_resourcefiles_not_supported);
  626. end;
  627. procedure dir_saturation;
  628. begin
  629. do_localswitch(cs_mmx_saturation);
  630. end;
  631. procedure dir_smartlink;
  632. begin
  633. do_moduleswitch(cs_create_smart);
  634. end;
  635. procedure dir_stackframes;
  636. begin
  637. do_delphiswitch('W');
  638. end;
  639. procedure dir_static;
  640. begin
  641. do_moduleswitch(cs_static_keyword);
  642. end;
  643. procedure dir_stop;
  644. begin
  645. do_message(scan_f_user_defined);
  646. end;
  647. procedure dir_threading;
  648. var
  649. mac : tmacro;
  650. begin
  651. do_moduleswitch(cs_threading);
  652. { defined/undefine FPC_THREADING }
  653. mac:=tmacro(current_scanner.macros.search('FPC_THREADING'));
  654. if not assigned(mac) then
  655. begin
  656. mac:=tmacro.create('FPC_THREADING');
  657. current_scanner.macros.insert(mac);
  658. end;
  659. mac.defined:=(cs_threading in aktmoduleswitches);
  660. end;
  661. procedure dir_typedaddress;
  662. begin
  663. do_delphiswitch('T');
  664. end;
  665. procedure dir_typeinfo;
  666. begin
  667. do_delphiswitch('M');
  668. end;
  669. procedure dir_unitpath;
  670. begin
  671. if not current_module.in_global then
  672. Message(scan_w_switch_is_global)
  673. else
  674. with current_scanner,current_module,localunitsearchpath do
  675. begin
  676. skipspace;
  677. AddPath(path^,readcomment,false);
  678. end;
  679. end;
  680. procedure dir_varstringchecks;
  681. begin
  682. do_delphiswitch('V');
  683. end;
  684. procedure dir_version;
  685. var
  686. major, minor, revision : longint;
  687. error : integer;
  688. begin
  689. if not (target_info.system in [system_i386_os2,system_i386_emx,
  690. system_i386_win32,system_i386_netware,system_i386_wdosx]) then
  691. begin
  692. Message(scan_n_version_not_support);
  693. exit;
  694. end;
  695. if (compile_level<>1) then
  696. Message(scan_n_only_exe_version)
  697. else
  698. begin
  699. { change description global var in all cases }
  700. { it not used but in win32, os2 and netware }
  701. current_scanner.skipspace;
  702. { we should only accept Major.Minor format for win32 and os2 }
  703. current_scanner.readnumber;
  704. major:=0;
  705. minor:=0;
  706. revision:=0;
  707. valint(pattern,major,error);
  708. if (error<>0) or (major > high(word)) or (major < 0) then
  709. begin
  710. Message1(scan_w_wrong_version_ignored,pattern);
  711. exit;
  712. end;
  713. if c='.' then
  714. begin
  715. current_scanner.readchar;
  716. current_scanner.readnumber;
  717. valint(pattern,minor,error);
  718. if (error<>0) or (minor > high(word)) or (minor < 0) then
  719. begin
  720. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  721. exit;
  722. end;
  723. if (c='.') and
  724. (target_info.system = system_i386_netware) then
  725. begin
  726. current_scanner.readchar;
  727. current_scanner.readnumber;
  728. valint(pattern,revision,error);
  729. if (error<>0) or (revision > high(word)) or (revision < 0) then
  730. begin
  731. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  732. exit;
  733. end;
  734. dllmajor:=word(major);
  735. dllminor:=word(minor);
  736. dllrevision:=word(revision);
  737. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  738. end
  739. else
  740. begin
  741. dllmajor:=word(major);
  742. dllminor:=word(minor);
  743. dllversion:=tostr(major)+'.'+tostr(minor);
  744. end;
  745. end
  746. else
  747. dllversion:=tostr(major);
  748. end;
  749. end;
  750. procedure dir_wait;
  751. var
  752. had_info : boolean;
  753. begin
  754. had_info:=(status.verbosity and V_Info)<>0;
  755. { this message should allways appear !! }
  756. status.verbosity:=status.verbosity or V_Info;
  757. Message(scan_i_press_enter);
  758. readln;
  759. If not(had_info) then
  760. status.verbosity:=status.verbosity and (not V_Info);
  761. end;
  762. procedure dir_warning;
  763. begin
  764. do_message(scan_w_user_defined);
  765. end;
  766. procedure dir_warnings;
  767. begin
  768. do_setverbose('W');
  769. end;
  770. procedure dir_writeableconst;
  771. begin
  772. do_delphiswitch('J');
  773. end;
  774. procedure dir_z1;
  775. begin
  776. aktpackenum:=1;
  777. end;
  778. procedure dir_z2;
  779. begin
  780. aktpackenum:=2;
  781. end;
  782. procedure dir_z4;
  783. begin
  784. aktpackenum:=4;
  785. end;
  786. procedure dir_externalsym;
  787. begin
  788. end;
  789. procedure dir_codepage;
  790. var
  791. s : string;
  792. begin
  793. if not current_module.in_global then
  794. Message(scan_w_switch_is_global)
  795. else
  796. begin
  797. current_scanner.skipspace;
  798. s:=current_scanner.readcomment;
  799. if not(cpavailable(s)) then
  800. Message1(option_code_page_not_available,s)
  801. else
  802. aktsourcecodepage:=s;
  803. end;
  804. end;
  805. {****************************************************************************
  806. Initialize Directives
  807. ****************************************************************************}
  808. procedure InitScannerDirectives;
  809. begin
  810. AddDirective('ALIGN',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_align);
  811. {$ifdef m68k}
  812. AddDirective('APPID',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appid);
  813. AddDirective('APPNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appname);
  814. {$endif m68k}
  815. AddDirective('APPTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_apptype);
  816. AddDirective('ASMMODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
  817. AddDirective('ASSERTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_assertions);
  818. AddDirective('BOOLEVAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_booleval);
  819. AddDirective('CALLING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_calling);
  820. AddDirective('CODEPAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_codepage);
  821. AddDirective('COPYRIGHT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_copyright);
  822. AddDirective('D',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
  823. AddDirective('DEBUGINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
  824. AddDirective('DESCRIPTION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
  825. AddDirective('ERROR',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_error);
  826. AddDirective('EXTENDEDSYNTAX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
  827. AddDirective('EXTERNALSYM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_externalsym);
  828. AddDirective('FATAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fatal);
  829. AddDirective('FPUTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fputype);
  830. AddDirective('GOTO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_goto);
  831. AddDirective('HINT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hint);
  832. AddDirective('HINTS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hints);
  833. AddDirective('IOCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
  834. AddDirective('IMPLICITEXCEPTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_implicitexceptions);
  835. AddDirective('INCLUDEPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_includepath);
  836. AddDirective('INFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_info);
  837. AddDirective('INLINE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_inline);
  838. AddDirective('INTERFACES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
  839. AddDirective('L',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
  840. AddDirective('LIBRARYPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
  841. AddDirective('LINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
  842. AddDirective('LINKLIB',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_linklib);
  843. AddDirective('LOCALSYMBOLS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
  844. AddDirective('LONGSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
  845. AddDirective('M',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
  846. AddDirective('MACRO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_macro);
  847. AddDirective('MAXFPUREGISTERS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
  848. AddDirective('MEMORY',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
  849. AddDirective('MESSAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_message);
  850. AddDirective('MINENUMSIZE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  851. AddDirective('MMX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mmx);
  852. AddDirective('MODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mode);
  853. AddDirective('NOTE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_note);
  854. AddDirective('NOTES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_notes);
  855. AddDirective('OBJECTCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectchecks);
  856. AddDirective('OBJECTPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
  857. AddDirective('OPENSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
  858. AddDirective('OUTPUT_FORMAT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_output_format);
  859. AddDirective('OVERFLOWCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
  860. AddDirective('PACKENUM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  861. AddDirective('PACKRECORDS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
  862. {$IFDEF TestVarsets}
  863. AddDirective('PACKSET',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packset);
  864. {$ENDIF}
  865. AddDirective('PROFILE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_profile);
  866. AddDirective('R',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_resource);
  867. AddDirective('RANGECHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
  868. AddDirective('REFERENCEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
  869. AddDirective('SATURATION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_saturation);
  870. AddDirective('SCREENNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_screenname);
  871. AddDirective('SMARTLINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
  872. AddDirective('STACKFRAMES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
  873. AddDirective('STATIC',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_static);
  874. AddDirective('STOP',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stop);
  875. AddDirective('THREADING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threading);
  876. AddDirective('THREADNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threadname);
  877. AddDirective('TYPEDADDRESS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
  878. AddDirective('TYPEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
  879. AddDirective('UNITPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
  880. AddDirective('VARSTRINGCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
  881. AddDirective('VERSION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_version);
  882. AddDirective('WAIT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_wait);
  883. AddDirective('WARNING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warning);
  884. AddDirective('WARNINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warnings);
  885. AddDirective('WRITEABLECONST',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_writeableconst);
  886. AddDirective('Z1',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z1);
  887. AddDirective('Z2',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z2);
  888. AddDirective('Z4',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z4);
  889. end;
  890. end.
  891. {
  892. $Log$
  893. Revision 1.32 2004-04-04 18:46:09 olle
  894. + added $APPTYPE TOOL for MPW tools on MacOS
  895. Revision 1.31 2004/03/14 20:08:37 peter
  896. * packrecords fixed for settings from $PACKRECORDS
  897. * default packrecords now uses value 0 and uses info from aligment
  898. structure only, initpackrecords removed
  899. Revision 1.30 2004/01/28 22:16:31 peter
  900. * more record alignment fixes
  901. Revision 1.29 2003/12/25 01:07:09 florian
  902. + $fputype directive support
  903. + single data type operations with sse unit
  904. * fixed more x86-64 stuff
  905. Revision 1.28 2003/11/12 16:05:39 florian
  906. * assembler readers OOPed
  907. + typed currency constants
  908. + typed 128 bit float constants if the CPU supports it
  909. Revision 1.27 2003/11/07 15:58:32 florian
  910. * Florian's culmutative nr. 1; contains:
  911. - invalid calling conventions for a certain cpu are rejected
  912. - arm softfloat calling conventions
  913. - -Sp for cpu dependend code generation
  914. - several arm fixes
  915. - remaining code for value open array paras on heap
  916. Revision 1.26 2003/09/17 22:30:19 olle
  917. + support for a different set of compiler directives under $MODE MAC
  918. + added mac directives $SETC $IFC $ELSEC $ENDC
  919. Revision 1.25 2003/03/23 23:20:38 hajny
  920. + emx target added
  921. Revision 1.24 2003/01/03 21:25:01 peter
  922. * OBJECTCHECKS added, equivalent of -CR
  923. * WRITEABLECONST added, equivalent of $J
  924. Revision 1.23 2002/12/07 14:06:20 carl
  925. * stricter version / revision checking (also remove some warnings)
  926. Revision 1.22 2002/11/20 11:12:46 mazen
  927. + module path is now passed to AddPath to fix relative unit path
  928. Revision 1.21 2002/10/16 19:01:43 peter
  929. + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
  930. implicit exception frames for procedures with initialized variables
  931. and for constructors. The default is on for compatibility
  932. Revision 1.20 2002/10/14 19:43:41 peter
  933. * threading switch, defines the symbol FPC_THREADING
  934. Revision 1.19 2002/08/13 18:01:52 carl
  935. * rename swatoperands to swapoperands
  936. + m68k first compilable version (still needs a lot of testing):
  937. assembler generator, system information , inline
  938. assembler reader.
  939. Revision 1.18 2002/07/26 21:15:42 florian
  940. * rewrote the system handling
  941. Revision 1.17 2002/07/20 17:16:03 florian
  942. + source code page support
  943. Revision 1.16 2002/07/16 15:37:58 florian
  944. + Directive $EXTERNALSYM added, it is ignored for now
  945. Revision 1.15 2002/05/18 13:34:17 peter
  946. * readded missing revisions
  947. Revision 1.14 2002/05/16 19:46:44 carl
  948. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  949. + try to fix temp allocation (still in ifdef)
  950. + generic constructor calls
  951. + start of tassembler / tmodulebase class cleanup
  952. Revision 1.12 2002/04/07 13:34:20 carl
  953. + wdosx target
  954. Revision 1.11 2002/04/04 19:06:05 peter
  955. * removed unused units
  956. * use tlocation.size in cg.a_*loc*() routines
  957. }