scandir.pas 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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,
  26. verbose,comphook,
  27. scanner,switches,
  28. fmodule;
  29. {*****************************************************************************
  30. Helpers
  31. *****************************************************************************}
  32. procedure do_delphiswitch(sw:char);
  33. var
  34. state : char;
  35. begin
  36. { c contains the next char, a + or - would be fine }
  37. state:=current_scanner.readstate;
  38. if state in ['-','+'] then
  39. HandleSwitch(sw,state);
  40. end;
  41. procedure do_setverbose(flag:char);
  42. var
  43. state : char;
  44. begin
  45. { support ON/OFF }
  46. state:=current_scanner.ReadState;
  47. SetVerbosity(flag+state);
  48. end;
  49. procedure do_moduleswitch(sw:tmoduleswitch);
  50. var
  51. state : char;
  52. begin
  53. state:=current_scanner.readstate;
  54. if (sw<>cs_modulenone) and (state in ['-','+']) then
  55. begin
  56. if state='-' then
  57. exclude(aktmoduleswitches,sw)
  58. else
  59. include(aktmoduleswitches,sw);
  60. end;
  61. end;
  62. procedure do_localswitch(sw:tlocalswitch);
  63. var
  64. state : char;
  65. begin
  66. state:=current_scanner.readstate;
  67. if (sw<>cs_localnone) and (state in ['-','+']) then
  68. begin
  69. if not localswitcheschanged then
  70. nextaktlocalswitches:=aktlocalswitches;
  71. if state='-' then
  72. exclude(nextaktlocalswitches,sw)
  73. else
  74. include(nextaktlocalswitches,sw);
  75. localswitcheschanged:=true;
  76. end;
  77. end;
  78. procedure do_message(w:integer);
  79. begin
  80. current_scanner.skipspace;
  81. Message1(w,current_scanner.readcomment);
  82. end;
  83. {*****************************************************************************
  84. Directive Callbacks
  85. *****************************************************************************}
  86. procedure dir_align;
  87. var
  88. hs : string;
  89. begin
  90. current_scanner.skipspace;
  91. if not(c in ['0'..'9']) then
  92. begin
  93. { Support also the ON and OFF as switch }
  94. hs:=current_scanner.readid;
  95. if (hs='ON') then
  96. aktalignment.recordalignmax:=4
  97. else
  98. if (hs='OFF') then
  99. aktalignment.recordalignmax:=1
  100. else
  101. Message(scan_w_only_pack_records);
  102. end
  103. else
  104. begin
  105. case current_scanner.readval of
  106. 1 : aktalignment.recordalignmax:=1;
  107. 2 : aktalignment.recordalignmax:=2;
  108. 4 : aktalignment.recordalignmax:=4;
  109. 8 : aktalignment.recordalignmax:=8;
  110. 16 : aktalignment.recordalignmax:=16;
  111. 32 : aktalignment.recordalignmax:=32;
  112. else
  113. Message(scan_w_only_pack_records);
  114. end;
  115. end;
  116. end;
  117. procedure dir_asmmode;
  118. var
  119. s : string;
  120. begin
  121. current_scanner.skipspace;
  122. s:=current_scanner.readid;
  123. If Inside_asm_statement then
  124. Message1(scan_w_no_asm_reader_switch_inside_asm,s);
  125. if s='DEFAULT' then
  126. aktasmmode:=initasmmode
  127. else
  128. if not set_asmmode_by_string(s,aktasmmode) then
  129. Message1(scan_w_unsupported_asmmode_specifier,s);
  130. end;
  131. {$ifdef m68k}
  132. procedure dir_appid;
  133. begin
  134. if target_info.target<>target_m68k_palmos then
  135. Message(scan_w_appid_not_support);
  136. { change description global var in all cases }
  137. { it not used but in win32 and os2 }
  138. current_scanner^.skipspace;
  139. palmos_applicationid:=current_scanner^.readcomment;
  140. end;
  141. procedure dir_appname;
  142. begin
  143. if target_info.target<>target_m68k_palmos then
  144. Message(scan_w_appname_not_support);
  145. { change description global var in all cases }
  146. { it not used but in win32 and os2 }
  147. current_scanner^.skipspace;
  148. palmos_applicationname:=current_scanner^.readcomment;
  149. end;
  150. {$endif m68k}
  151. procedure dir_apptype;
  152. var
  153. hs : string;
  154. begin
  155. if (target_info.target<>target_i386_win32)
  156. and (target_info.target<>target_i386_os2) then
  157. Message(scan_w_app_type_not_support);
  158. if not current_module.in_global then
  159. Message(scan_w_switch_is_global)
  160. else
  161. begin
  162. current_scanner.skipspace;
  163. hs:=current_scanner.readid;
  164. if hs='GUI' then
  165. apptype:=app_gui
  166. else if hs='CONSOLE' then
  167. apptype:=app_cui
  168. else if (hs='FS') and (target_info.target=target_i386_os2) then
  169. apptype:=app_fs
  170. else
  171. Message1(scan_w_unsupported_app_type,hs);
  172. end;
  173. end;
  174. procedure dir_calling;
  175. var
  176. hs : string;
  177. begin
  178. current_scanner.skipspace;
  179. hs:=current_scanner.readid;
  180. if not SetAktProcCall(hs,false) then
  181. Message1(parser_w_unknown_proc_directive_ignored,hs);
  182. end;
  183. procedure dir_assertions;
  184. begin
  185. do_delphiswitch('C');
  186. end;
  187. procedure dir_booleval;
  188. begin
  189. do_delphiswitch('B');
  190. end;
  191. procedure dir_debuginfo;
  192. begin
  193. do_delphiswitch('D');
  194. end;
  195. procedure dir_description;
  196. begin
  197. if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware,target_i386_wdosx]) then
  198. Message(scan_w_description_not_support);
  199. { change description global var in all cases }
  200. { it not used but in win32, os2 and netware }
  201. current_scanner.skipspace;
  202. description:=current_scanner.readcomment;
  203. end;
  204. procedure dir_screenname; {ad}
  205. begin
  206. if target_info.target <> target_i386_netware then
  207. {Message(scan_w_decription_not_support);}
  208. comment (V_Warning,'Screenname only supported for target netware');
  209. current_scanner.skipspace;
  210. nwscreenname:=current_scanner.readcomment;
  211. end;
  212. procedure dir_threadname; {ad}
  213. begin
  214. if target_info.target <> target_i386_netware then
  215. {Message(scan_w_decription_not_support);}
  216. comment (V_Warning,'Threadname only supported for target netware');
  217. current_scanner.skipspace;
  218. nwthreadname:=current_scanner.readcomment;
  219. end;
  220. procedure dir_copyright; {ad}
  221. begin
  222. if target_info.target <> target_i386_netware then
  223. {Message(scan_w_decription_not_support);}
  224. comment (V_Warning,'Copyright only supported for target netware');
  225. current_scanner.skipspace;
  226. nwcopyright:=current_scanner.readcomment;
  227. end;
  228. procedure dir_error;
  229. begin
  230. do_message(scan_e_user_defined);
  231. end;
  232. procedure dir_extendedsyntax;
  233. begin
  234. do_delphiswitch('X');
  235. end;
  236. procedure dir_fatal;
  237. begin
  238. do_message(scan_f_user_defined);
  239. end;
  240. procedure dir_goto;
  241. begin
  242. do_moduleswitch(cs_support_goto);
  243. end;
  244. procedure dir_hint;
  245. begin
  246. do_message(scan_h_user_defined);
  247. end;
  248. procedure dir_hints;
  249. begin
  250. do_setverbose('H');
  251. end;
  252. procedure dir_includepath;
  253. begin
  254. if not current_module.in_global then
  255. Message(scan_w_switch_is_global)
  256. else
  257. begin
  258. current_scanner.skipspace;
  259. current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
  260. end;
  261. end;
  262. procedure dir_info;
  263. begin
  264. do_message(scan_i_user_defined);
  265. end;
  266. procedure dir_inline;
  267. begin
  268. do_moduleswitch(cs_support_inline);
  269. end;
  270. procedure dir_interfaces;
  271. var
  272. hs : string;
  273. begin
  274. {corba/com/default}
  275. current_scanner.skipspace;
  276. hs:=current_scanner.readid;
  277. if (hs='CORBA') then
  278. aktinterfacetype:=it_interfacecorba
  279. else if (hs='COM') then
  280. aktinterfacetype:=it_interfacecom
  281. else if (hs='DEFAULT') then
  282. aktinterfacetype:=initinterfacetype
  283. else
  284. Message(scan_e_invalid_interface_type);
  285. end;
  286. procedure dir_iochecks;
  287. begin
  288. do_delphiswitch('I');
  289. end;
  290. procedure dir_librarypath;
  291. begin
  292. if not current_module.in_global then
  293. Message(scan_w_switch_is_global)
  294. else
  295. begin
  296. current_scanner.skipspace;
  297. current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
  298. end;
  299. end;
  300. procedure dir_link;
  301. var
  302. s : string;
  303. begin
  304. current_scanner.skipspace;
  305. s:=AddExtension(FixFileName(current_scanner.readcomment),target_info.objext);
  306. current_module.linkotherofiles.add(s,link_allways);
  307. end;
  308. procedure dir_linklib;
  309. type
  310. tLinkMode=(lm_shared,lm_static);
  311. var
  312. s : string;
  313. quote : char;
  314. libname,
  315. linkmodestr : string;
  316. p : longint;
  317. linkMode : tLinkMode;
  318. begin
  319. current_scanner.skipspace;
  320. s:=current_scanner.readcomment;
  321. p:=pos(',',s);
  322. if p=0 then
  323. begin
  324. libname:=TrimSpace(s);
  325. linkmodeStr:='';
  326. end
  327. else
  328. begin
  329. libname:=TrimSpace(copy(s,1,p-1));
  330. linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
  331. end;
  332. if (libname='') or (libname='''''') or (libname='""') then
  333. exit;
  334. { get linkmode, default is shared linking }
  335. if linkModeStr='STATIC' then
  336. linkmode:=lm_static
  337. else if (LinkModeStr='SHARED') or (LinkModeStr='') then
  338. linkmode:=lm_shared
  339. else
  340. begin
  341. Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
  342. exit;
  343. end;
  344. { create library name }
  345. if libname[1] in ['''','"'] then
  346. begin
  347. quote:=libname[1];
  348. Delete(libname,1,1);
  349. p:=pos(quote,libname);
  350. if p>0 then
  351. Delete(libname,p,1);
  352. end;
  353. { add to the list of libraries to link }
  354. if linkMode=lm_static then
  355. current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
  356. else
  357. current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
  358. end;
  359. procedure dir_localsymbols;
  360. begin
  361. do_delphiswitch('L');
  362. end;
  363. procedure dir_longstrings;
  364. begin
  365. do_delphiswitch('H');
  366. end;
  367. procedure dir_macro;
  368. begin
  369. do_moduleswitch(cs_support_macro);
  370. end;
  371. procedure dir_maxfpuregisters;
  372. var
  373. l : integer;
  374. hs : string;
  375. begin
  376. current_scanner.skipspace;
  377. if not(c in ['0'..'9']) then
  378. begin
  379. hs:=current_scanner.readid;
  380. if (hs='NORMAL') or (hs='DEFAULT') then
  381. aktmaxfpuregisters:=-1
  382. else
  383. Message(scan_e_invalid_maxfpureg_value);
  384. end
  385. else
  386. begin
  387. l:=current_scanner.readval;
  388. case l of
  389. 0..8:
  390. aktmaxfpuregisters:=l;
  391. else
  392. Message(scan_e_invalid_maxfpureg_value);
  393. end;
  394. end;
  395. end;
  396. procedure dir_memory;
  397. var
  398. l : longint;
  399. begin
  400. current_scanner.skipspace;
  401. l:=current_scanner.readval;
  402. if l>1024 then
  403. stacksize:=l;
  404. current_scanner.skipspace;
  405. if c=',' then
  406. begin
  407. current_scanner.readchar;
  408. current_scanner.skipspace;
  409. l:=current_scanner.readval;
  410. if l>1024 then
  411. heapsize:=l;
  412. end;
  413. if c=',' then
  414. begin
  415. current_scanner.readchar;
  416. current_scanner.skipspace;
  417. l:=current_scanner.readval;
  418. { Ignore this value, because the limit is set by the OS
  419. info and shouldn't be changed by the user (PFV) }
  420. end;
  421. end;
  422. procedure dir_message;
  423. begin
  424. do_message(scan_i_user_defined);
  425. end;
  426. procedure dir_mode;
  427. begin
  428. if not current_module.in_global then
  429. Message(scan_w_switch_is_global)
  430. else
  431. begin
  432. current_scanner.skipspace;
  433. current_scanner.readstring;
  434. if not SetCompileMode(pattern,false) then
  435. Message1(scan_w_illegal_switch,pattern);
  436. end;
  437. end;
  438. procedure dir_mmx;
  439. begin
  440. do_localswitch(cs_mmx);
  441. end;
  442. procedure dir_note;
  443. begin
  444. do_message(scan_n_user_defined);
  445. end;
  446. procedure dir_notes;
  447. begin
  448. do_setverbose('N');
  449. end;
  450. procedure dir_objectpath;
  451. begin
  452. if not current_module.in_global then
  453. Message(scan_w_switch_is_global)
  454. else
  455. begin
  456. current_scanner.skipspace;
  457. current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
  458. end;
  459. end;
  460. procedure dir_openstrings;
  461. begin
  462. do_delphiswitch('P');
  463. end;
  464. procedure dir_output_format;
  465. begin
  466. if not current_module.in_global then
  467. Message(scan_w_switch_is_global)
  468. else
  469. begin
  470. current_scanner.skipspace;
  471. if set_target_asm_by_string(current_scanner.readid) then
  472. aktoutputformat:=target_asm.id
  473. else
  474. Message1(scan_w_illegal_switch,pattern);
  475. end;
  476. end;
  477. procedure dir_overflowchecks;
  478. begin
  479. do_delphiswitch('Q');
  480. end;
  481. procedure dir_packenum;
  482. var
  483. hs : string;
  484. begin
  485. current_scanner.skipspace;
  486. if not(c in ['0'..'9']) then
  487. begin
  488. hs:=current_scanner.readid;
  489. if (hs='NORMAL') or (hs='DEFAULT') then
  490. aktpackenum:=4
  491. else
  492. Message(scan_w_only_pack_enum);
  493. end
  494. else
  495. begin
  496. case current_scanner.readval of
  497. 1 : aktpackenum:=1;
  498. 2 : aktpackenum:=2;
  499. 4 : aktpackenum:=4;
  500. else
  501. Message(scan_w_only_pack_enum);
  502. end;
  503. end;
  504. end;
  505. procedure dir_packrecords;
  506. var
  507. hs : string;
  508. begin
  509. current_scanner.skipspace;
  510. if not(c in ['0'..'9']) then
  511. begin
  512. hs:=current_scanner.readid;
  513. { C has the special recordalignmax of -1 }
  514. if (hs='C') then
  515. aktalignment.recordalignmax:=-1
  516. else
  517. if (hs='NORMAL') or (hs='DEFAULT') then
  518. aktalignment.recordalignmax:=2
  519. else
  520. Message(scan_w_only_pack_records);
  521. end
  522. else
  523. begin
  524. case current_scanner.readval of
  525. 1 : aktalignment.recordalignmax:=1;
  526. 2 : aktalignment.recordalignmax:=2;
  527. 4 : aktalignment.recordalignmax:=4;
  528. 8 : aktalignment.recordalignmax:=8;
  529. 16 : aktalignment.recordalignmax:=16;
  530. 32 : aktalignment.recordalignmax:=32;
  531. else
  532. Message(scan_w_only_pack_records);
  533. end;
  534. end;
  535. end;
  536. {$ifdef testvarsets}
  537. procedure dir_packset;
  538. var
  539. hs : string;
  540. begin
  541. current_scanner.skipspace;
  542. if not(c in ['1','2','4']) then
  543. begin
  544. hs:=current_scanner.readid;
  545. if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
  546. aktsetalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
  547. else
  548. Message(scan_w_only_packset);
  549. end
  550. else
  551. begin
  552. case current_scanner.readval of
  553. 1 : aktsetalloc:=1;
  554. 2 : aktsetalloc:=2;
  555. 4 : aktsetalloc:=4;
  556. else
  557. Message(scan_w_only_packset);
  558. end;
  559. end;
  560. end;
  561. {$ENDIF}
  562. procedure dir_profile;
  563. var
  564. mac : tmacro;
  565. begin
  566. do_moduleswitch(cs_profile);
  567. { defined/undefine FPC_PROFILE }
  568. mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
  569. if not assigned(mac) then
  570. begin
  571. mac:=tmacro.create('FPC_PROFILE');
  572. current_scanner.macros.insert(mac);
  573. end;
  574. mac.defined:=(cs_profile in aktmoduleswitches);
  575. end;
  576. procedure dir_rangechecks;
  577. begin
  578. do_delphiswitch('R');
  579. end;
  580. procedure dir_referenceinfo;
  581. begin
  582. do_delphiswitch('Y');
  583. end;
  584. procedure dir_resource;
  585. var
  586. s : string;
  587. begin
  588. current_scanner.skipspace;
  589. s:=current_scanner.readcomment;
  590. { replace * with current module name.
  591. This should always be defined. }
  592. if s[1]='*' then
  593. if Assigned(Current_Module) then
  594. begin
  595. delete(S,1,1);
  596. insert(lower(current_module.modulename^),S,1);
  597. end;
  598. s:=AddExtension(FixFileName(s),target_info.resext);
  599. if target_info.res<>res_none then
  600. if (target_info.res = res_emxbind) and
  601. not (Current_module.ResourceFiles.Empty) then
  602. Message(scan_w_only_one_resourcefile_supported)
  603. else
  604. current_module.resourcefiles.insert(FixFileName(s))
  605. else
  606. Message(scan_e_resourcefiles_not_supported);
  607. end;
  608. procedure dir_saturation;
  609. begin
  610. do_localswitch(cs_mmx_saturation);
  611. end;
  612. procedure dir_smartlink;
  613. begin
  614. do_moduleswitch(cs_create_smart);
  615. end;
  616. procedure dir_stackframes;
  617. begin
  618. do_delphiswitch('W');
  619. end;
  620. procedure dir_static;
  621. begin
  622. do_moduleswitch(cs_static_keyword);
  623. end;
  624. procedure dir_stop;
  625. begin
  626. do_message(scan_f_user_defined);
  627. end;
  628. procedure dir_typedaddress;
  629. begin
  630. do_delphiswitch('T');
  631. end;
  632. procedure dir_typeinfo;
  633. begin
  634. do_delphiswitch('M');
  635. end;
  636. procedure dir_unitpath;
  637. begin
  638. if not current_module.in_global then
  639. Message(scan_w_switch_is_global)
  640. else
  641. begin
  642. current_scanner.skipspace;
  643. current_module.localunitsearchpath.AddPath(current_scanner.readcomment,false);
  644. end;
  645. end;
  646. procedure dir_varstringchecks;
  647. begin
  648. do_delphiswitch('V');
  649. end;
  650. procedure dir_version;
  651. var
  652. major, minor, revision : longint;
  653. error : integer;
  654. begin
  655. if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware,target_i386_wdosx]) then
  656. begin
  657. Message(scan_n_version_not_support);
  658. exit;
  659. end;
  660. if (compile_level<>1) then
  661. Message(scan_n_only_exe_version)
  662. else
  663. begin
  664. { change description global var in all cases }
  665. { it not used but in win32, os2 and netware }
  666. current_scanner.skipspace;
  667. { we should only accept Major.Minor format for win32 and os2 }
  668. current_scanner.readnumber;
  669. major:=0;
  670. minor:=0;
  671. revision:=0;
  672. valint(pattern,major,error);
  673. if error<>0 then
  674. begin
  675. Message1(scan_w_wrong_version_ignored,pattern);
  676. exit;
  677. end;
  678. if c='.' then
  679. begin
  680. current_scanner.readchar;
  681. current_scanner.readnumber;
  682. valint(pattern,minor,error);
  683. if error<>0 then
  684. begin
  685. Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
  686. exit;
  687. end;
  688. if (c='.') and
  689. (target_info.target = target_i386_netware) then
  690. begin
  691. current_scanner.readchar;
  692. current_scanner.readnumber;
  693. valint(pattern,revision,error);
  694. if error<>0 then
  695. begin
  696. Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
  697. exit;
  698. end;
  699. dllmajor:=major;
  700. dllminor:=minor;
  701. dllrevision:=revision;
  702. dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
  703. end
  704. else
  705. begin
  706. dllmajor:=major;
  707. dllminor:=minor;
  708. dllversion:=tostr(major)+'.'+tostr(minor);
  709. end;
  710. end
  711. else
  712. dllversion:=tostr(major);
  713. end;
  714. end;
  715. procedure dir_wait;
  716. var
  717. had_info : boolean;
  718. begin
  719. had_info:=(status.verbosity and V_Info)<>0;
  720. { this message should allways appear !! }
  721. status.verbosity:=status.verbosity or V_Info;
  722. Message(scan_i_press_enter);
  723. readln;
  724. If not(had_info) then
  725. status.verbosity:=status.verbosity and (not V_Info);
  726. end;
  727. procedure dir_warning;
  728. begin
  729. do_message(scan_w_user_defined);
  730. end;
  731. procedure dir_warnings;
  732. begin
  733. do_setverbose('W');
  734. end;
  735. procedure dir_z1;
  736. begin
  737. aktpackenum:=1;
  738. end;
  739. procedure dir_z2;
  740. begin
  741. aktpackenum:=2;
  742. end;
  743. procedure dir_z4;
  744. begin
  745. aktpackenum:=4;
  746. end;
  747. {****************************************************************************
  748. Initialize Directives
  749. ****************************************************************************}
  750. procedure InitScannerDirectives;
  751. begin
  752. AddDirective('ALIGN',{$ifdef FPCPROCVAR}@{$endif}dir_align);
  753. {$ifdef m68k}
  754. AddDirective('APPID',{$ifdef FPCPROCVAR}@{$endif}dir_appid);
  755. AddDirective('APPNAME',{$ifdef FPCPROCVAR}@{$endif}dir_appname);
  756. {$endif m68k}
  757. AddDirective('APPTYPE',{$ifdef FPCPROCVAR}@{$endif}dir_apptype);
  758. AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
  759. AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
  760. AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
  761. AddDirective('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);
  762. AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
  763. AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
  764. AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
  765. AddDirective('DESCRIPTION',{$ifdef FPCPROCVAR}@{$endif}dir_description);
  766. AddDirective('ERROR',{$ifdef FPCPROCVAR}@{$endif}dir_error);
  767. AddDirective('EXTENDEDSYNTAX',{$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
  768. AddDirective('FATAL',{$ifdef FPCPROCVAR}@{$endif}dir_fatal);
  769. AddDirective('GOTO',{$ifdef FPCPROCVAR}@{$endif}dir_goto);
  770. AddDirective('HINT',{$ifdef FPCPROCVAR}@{$endif}dir_hint);
  771. AddDirective('HINTS',{$ifdef FPCPROCVAR}@{$endif}dir_hints);
  772. AddDirective('IOCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
  773. AddDirective('INCLUDEPATH',{$ifdef FPCPROCVAR}@{$endif}dir_includepath);
  774. AddDirective('INFO',{$ifdef FPCPROCVAR}@{$endif}dir_info);
  775. AddDirective('INLINE',{$ifdef FPCPROCVAR}@{$endif}dir_inline);
  776. AddDirective('INTERFACES',{$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
  777. AddDirective('L',{$ifdef FPCPROCVAR}@{$endif}dir_link);
  778. AddDirective('LIBRARYPATH',{$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
  779. AddDirective('LINK',{$ifdef FPCPROCVAR}@{$endif}dir_link);
  780. AddDirective('LINKLIB',{$ifdef FPCPROCVAR}@{$endif}dir_linklib);
  781. AddDirective('LOCALSYMBOLS',{$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
  782. AddDirective('LONGSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
  783. AddDirective('M',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
  784. AddDirective('MACRO',{$ifdef FPCPROCVAR}@{$endif}dir_macro);
  785. AddDirective('MAXFPUREGISTERS',{$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
  786. AddDirective('MEMORY',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
  787. AddDirective('MESSAGE',{$ifdef FPCPROCVAR}@{$endif}dir_message);
  788. AddDirective('MINENUMSIZE',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  789. AddDirective('MMX',{$ifdef FPCPROCVAR}@{$endif}dir_mmx);
  790. AddDirective('MODE',{$ifdef FPCPROCVAR}@{$endif}dir_mode);
  791. AddDirective('NOTE',{$ifdef FPCPROCVAR}@{$endif}dir_note);
  792. AddDirective('NOTES',{$ifdef FPCPROCVAR}@{$endif}dir_notes);
  793. AddDirective('OBJECTPATH',{$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
  794. AddDirective('OPENSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
  795. AddDirective('OUTPUT_FORMAT',{$ifdef FPCPROCVAR}@{$endif}dir_output_format);
  796. AddDirective('OVERFLOWCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
  797. AddDirective('PACKENUM',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
  798. AddDirective('PACKRECORDS',{$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
  799. {$IFDEF TestVarsets}
  800. AddDirective('PACKSET',{$ifdef FPCPROCVAR}@{$endif}dir_packset);
  801. {$ENDIF}
  802. AddDirective('PROFILE',{$ifdef FPCPROCVAR}@{$endif}dir_profile);
  803. AddDirective('R',{$ifdef FPCPROCVAR}@{$endif}dir_resource);
  804. AddDirective('RANGECHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
  805. AddDirective('REFERENCEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
  806. AddDirective('SATURATION',{$ifdef FPCPROCVAR}@{$endif}dir_saturation);
  807. {ad 18.05.2001: Screen and Threadname for Netware}
  808. AddDirective('SCREENNAME',{$ifdef FPCPROCVAR}@{$endif}dir_screenname);
  809. AddDirective('SMARTLINK',{$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
  810. AddDirective('STACKFRAMES',{$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
  811. AddDirective('STATIC',{$ifdef FPCPROCVAR}@{$endif}dir_static);
  812. AddDirective('STOP',{$ifdef FPCPROCVAR}@{$endif}dir_stop);
  813. {ad 18.05.2001: Screen and Threadname for Netware}
  814. AddDirective('THREADNAME',{$ifdef FPCPROCVAR}@{$endif}dir_threadname);
  815. AddDirective('TYPEDADDRESS',{$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
  816. AddDirective('TYPEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
  817. AddDirective('UNITPATH',{$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
  818. AddDirective('VARSTRINGCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
  819. AddDirective('VERSION',{$ifdef FPCPROCVAR}@{$endif}dir_version);
  820. AddDirective('WAIT',{$ifdef FPCPROCVAR}@{$endif}dir_wait);
  821. AddDirective('WARNING',{$ifdef FPCPROCVAR}@{$endif}dir_warning);
  822. AddDirective('WARNINGS',{$ifdef FPCPROCVAR}@{$endif}dir_warnings);
  823. AddDirective('Z1',{$ifdef FPCPROCVAR}@{$endif}dir_z1);
  824. AddDirective('Z2',{$ifdef FPCPROCVAR}@{$endif}dir_z2);
  825. AddDirective('Z4',{$ifdef FPCPROCVAR}@{$endif}dir_z4);
  826. end;
  827. end.
  828. {
  829. $Log$
  830. Revision 1.14 2002-05-16 19:46:44 carl
  831. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  832. + try to fix temp allocation (still in ifdef)
  833. + generic constructor calls
  834. + start of tassembler / tmodulebase class cleanup
  835. Revision 1.12 2002/04/07 13:34:20 carl
  836. + wdosx target
  837. Revision 1.11 2002/04/04 19:06:05 peter
  838. * removed unused units
  839. * use tlocation.size in cg.a_*loc*() routines
  840. Revision 1.10 2001/11/02 23:16:52 peter
  841. * removed obsolete chainprocsym and test_procsym code
  842. Revision 1.9 2001/10/23 21:49:42 peter
  843. * $calling directive and -Cc commandline patch added
  844. from Pavel Ozerski
  845. Revision 1.8 2001/09/02 21:18:28 peter
  846. * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
  847. is used for holding target platform pointer values. As those can be
  848. bigger than the source platform.
  849. Revision 1.7 2001/08/19 11:22:24 peter
  850. * palmos support from v10 merged
  851. Revision 1.6 2001/08/07 18:47:13 peter
  852. * merged netbsd start
  853. * profile for win32
  854. Revision 1.5 2001/07/01 20:16:16 peter
  855. * alignmentinfo record added
  856. * -Oa argument supports more alignment settings that can be specified
  857. per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
  858. RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
  859. required alignment and the maximum usefull alignment. The final
  860. alignment will be choosen per variable size dependent on these
  861. settings
  862. Revision 1.4 2001/06/03 20:20:27 peter
  863. * Align directive supports also values to be Kylix compatible. It's
  864. strange because the help of kylix still shows only On and Off as
  865. possible values, so still support those. On means 4 bytes and Off
  866. means 1 byte alignment.
  867. Revision 1.3 2001/05/30 21:35:49 peter
  868. * netware patches for copyright, screenname, threadname directives
  869. Revision 1.2 2001/04/18 22:01:58 peter
  870. * registration of targets and assemblers
  871. Revision 1.1 2001/04/13 18:00:36 peter
  872. * easier registration of directives
  873. Revision 1.20 2001/04/13 01:22:13 peter
  874. * symtable change to classes
  875. * range check generation and errors fixed, make cycle DEBUG=1 works
  876. * memory leaks fixed
  877. Revision 1.19 2001/03/13 18:45:07 peter
  878. * fixed some memory leaks
  879. Revision 1.18 2001/02/20 21:41:18 peter
  880. * new fixfilename, findfile for unix. Look first for lowercase, then
  881. NormalCase and last for UPPERCASE names.
  882. Revision 1.17 2001/01/20 18:32:52 hajny
  883. + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
  884. Revision 1.16 2001/01/13 00:09:21 peter
  885. * made Pavel O. happy ;)
  886. Revision 1.15 2000/12/25 00:07:28 peter
  887. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  888. tlinkedlist objects)
  889. Revision 1.14 2000/12/24 12:24:38 peter
  890. * moved preprocessfile into a conditional
  891. Revision 1.13 2000/12/12 19:48:52 peter
  892. * fixed lost char after $I directive (merged)
  893. Revision 1.12 2000/11/12 22:17:47 peter
  894. * some realname updates for messages
  895. Revision 1.11 2000/11/04 14:25:21 florian
  896. + merged Attila's changes for interfaces, not tested yet
  897. Revision 1.10 2000/10/31 22:02:51 peter
  898. * symtable splitted, no real code changes
  899. Revision 1.9 2000/09/26 10:50:41 jonas
  900. * initmodeswitches is changed is you change the compiler mode from the
  901. command line (the -S<x> switches didn't work anymore for changing the
  902. compiler mode) (merged from fixes branch)
  903. Revision 1.8 2000/09/24 21:33:47 peter
  904. * message updates merges
  905. Revision 1.7 2000/09/24 15:06:27 peter
  906. * use defines.inc
  907. Revision 1.6 2000/09/11 17:00:23 florian
  908. + first implementation of Netware Module support, thanks to
  909. Armin Diehl ([email protected]) for providing the patches
  910. Revision 1.5 2000/09/10 21:18:15 peter
  911. * macro warning (merged)
  912. Revision 1.4 2000/08/12 15:30:44 peter
  913. * IDE patch for stream reading (merged)
  914. Revision 1.3 2000/08/08 19:28:57 peter
  915. * memdebug/memory patches (merged)
  916. * only once illegal directive (merged)
  917. Revision 1.2 2000/07/13 11:32:49 michael
  918. + removed logs
  919. }