verbose.pas 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896
  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. This unit handles the verbose management
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit verbose;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. {$IFNDEF USE_FAKE_SYSUTILS}
  22. sysutils,
  23. {$ELSE}
  24. fksysutl,
  25. {$ENDIF}
  26. cutils,
  27. globals,finput,
  28. cmsgs;
  29. {$ifndef EXTERN_MSG}
  30. {$i msgtxt.inc}
  31. {$endif}
  32. {$i msgidx.inc}
  33. Const
  34. { Levels }
  35. V_None = $0;
  36. V_Fatal = $1;
  37. V_Error = $2;
  38. V_Normal = $4; { doesn't show a text like Error: }
  39. V_Warning = $8;
  40. V_Note = $10;
  41. V_Hint = $20;
  42. V_LineInfoMask = $fff;
  43. { From here by default no line info }
  44. V_Info = $1000;
  45. V_Status = $2000;
  46. V_Used = $4000;
  47. V_Tried = $8000;
  48. V_Conditional = $10000;
  49. V_Debug = $20000;
  50. V_Executable = $40000;
  51. V_LevelMask = $fffffff;
  52. V_All = V_LevelMask;
  53. V_Default = V_Fatal + V_Error + V_Normal;
  54. { Flags }
  55. V_LineInfo = $10000000;
  56. var
  57. msg : pmessage;
  58. type
  59. tmsgqueueevent = procedure(s:string;v,w:longint) of object;
  60. const
  61. msgfilename : string = '';
  62. procedure SetRedirectFile(const fn:string);
  63. function SetVerbosity(const s:string):boolean;
  64. procedure PrepareReport;
  65. function CheckVerbosity(v:longint):boolean;
  66. procedure SetCompileModule(p:tmodulebase);
  67. procedure ShowStatus;
  68. function ErrorCount:longint;
  69. procedure SetErrorFlags(const s:string);
  70. procedure GenerateError;
  71. procedure Internalerror(i:longint);
  72. procedure Comment(l:longint;s:ansistring);
  73. function MessagePchar(w:longint):pchar;
  74. procedure Message(w:longint;onqueue:tmsgqueueevent=nil);
  75. procedure Message1(w:longint;const s1:string;onqueue:tmsgqueueevent=nil);
  76. procedure Message2(w:longint;const s1,s2:string;onqueue:tmsgqueueevent=nil);
  77. procedure Message3(w:longint;const s1,s2,s3:string;onqueue:tmsgqueueevent=nil);
  78. procedure Message4(w:longint;const s1,s2,s3,s4:string;onqueue:tmsgqueueevent=nil);
  79. procedure MessagePos(const pos:tfileposinfo;w:longint;onqueue:tmsgqueueevent=nil);
  80. procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string;onqueue:tmsgqueueevent=nil);
  81. procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string;onqueue:tmsgqueueevent=nil);
  82. procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string;onqueue:tmsgqueueevent=nil);
  83. procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string;onqueue:tmsgqueueevent=nil);
  84. { message calls with codegenerror support }
  85. procedure cgmessage(t : longint);
  86. procedure cgmessage1(t : longint;const s : string);
  87. procedure cgmessage2(t : longint;const s1,s2 : string);
  88. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  89. procedure CGMessagePos(const pos:tfileposinfo;t:longint);
  90. procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:string);
  91. procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:string);
  92. procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:string);
  93. procedure FlushOutput;
  94. procedure InitVerbose;
  95. procedure DoneVerbose;
  96. implementation
  97. uses
  98. comphook,fmodule;
  99. var
  100. compiling_module : tmodulebase;
  101. {****************************************************************************
  102. Extra Handlers for default compiler
  103. ****************************************************************************}
  104. procedure DoneRedirectFile;
  105. begin
  106. if status.use_redir then
  107. begin
  108. close(status.redirfile);
  109. status.use_redir:=false;
  110. end;
  111. if status.use_bugreport then
  112. begin
  113. close(status.reportbugfile);
  114. status.use_bugreport:=false;
  115. end;
  116. end;
  117. procedure SetRedirectFile(const fn:string);
  118. begin
  119. { close old redirection file because FileRedirection is handled in both passes }
  120. if status.use_redir then
  121. close(status.redirfile);
  122. assign(status.redirfile,fn);
  123. {$I-}
  124. append(status.redirfile);
  125. if ioresult <> 0 then
  126. begin
  127. assign(status.redirfile,fn);
  128. rewrite(status.redirfile);
  129. end;
  130. {$I+}
  131. status.use_redir:=(ioresult=0);
  132. end;
  133. procedure PrepareReport;
  134. var
  135. fn : string;
  136. begin
  137. if status.use_bugreport then
  138. exit;
  139. fn:='fpcdebug.txt';
  140. assign(status.reportbugfile,fn);
  141. {$I-}
  142. append(status.reportbugfile);
  143. if ioresult <> 0 then
  144. rewrite(status.reportbugfile);
  145. {$I+}
  146. status.use_bugreport:=(ioresult=0);
  147. if status.use_bugreport then
  148. writeln(status.reportbugfile,'FPC bug report file');
  149. end;
  150. function CheckVerbosity(v:longint):boolean;
  151. begin
  152. CheckVerbosity:=status.use_bugreport or
  153. ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask));
  154. end;
  155. function SetVerbosity(const s:string):boolean;
  156. var
  157. m : Longint;
  158. i : Integer;
  159. inverse : boolean;
  160. c : char;
  161. begin
  162. Setverbosity:=false;
  163. val(s,m,i);
  164. if (i=0) and (s<>'') then
  165. status.verbosity:=m
  166. else
  167. begin
  168. i:=1;
  169. while i<=length(s) do
  170. begin
  171. c:=upcase(s[i]);
  172. inverse:=false;
  173. { on/off ? }
  174. if (i<length(s)) then
  175. case s[i+1] of
  176. '-' : begin
  177. inc(i);
  178. inverse:=true;
  179. end;
  180. '+' : inc(i);
  181. end;
  182. { handle switch }
  183. case c of
  184. { Special cases }
  185. 'A' : status.verbosity:=V_All;
  186. 'B' : begin
  187. if inverse then
  188. status.print_source_path:=false
  189. else
  190. status.print_source_path:=true;
  191. end;
  192. '0' : status.verbosity:=V_Default;
  193. 'P' : begin
  194. if inverse then
  195. paraprintnodetree:=0
  196. else
  197. paraprintnodetree:=1;
  198. end;
  199. 'R' : begin
  200. if inverse then
  201. begin
  202. status.use_gccoutput:=false;
  203. status.use_stderr:=false;
  204. end
  205. else
  206. begin
  207. status.use_gccoutput:=true;
  208. status.use_stderr:=true;
  209. end;
  210. end;
  211. 'Z' : begin
  212. if inverse then
  213. status.use_stderr:=false
  214. else
  215. status.use_stderr:=true;
  216. end;
  217. { Normal cases - do an or }
  218. 'E' : if inverse then
  219. status.verbosity:=status.verbosity and (not V_Error)
  220. else
  221. status.verbosity:=status.verbosity or V_Error;
  222. 'I' : if inverse then
  223. status.verbosity:=status.verbosity and (not V_Info)
  224. else
  225. status.verbosity:=status.verbosity or V_Info;
  226. 'W' : if inverse then
  227. status.verbosity:=status.verbosity and (not V_Warning)
  228. else
  229. status.verbosity:=status.verbosity or V_Warning;
  230. 'N' : if inverse then
  231. status.verbosity:=status.verbosity and (not V_Note)
  232. else
  233. status.verbosity:=status.verbosity or V_Note;
  234. 'H' : if inverse then
  235. status.verbosity:=status.verbosity and (not V_Hint)
  236. else
  237. status.verbosity:=status.verbosity or V_Hint;
  238. 'L' : if inverse then
  239. status.verbosity:=status.verbosity and (not V_Status)
  240. else
  241. status.verbosity:=status.verbosity or V_Status;
  242. 'U' : if inverse then
  243. status.verbosity:=status.verbosity and (not V_Used)
  244. else
  245. status.verbosity:=status.verbosity or V_Used;
  246. 'T' : if inverse then
  247. status.verbosity:=status.verbosity and (not V_Tried)
  248. else
  249. status.verbosity:=status.verbosity or V_Tried;
  250. 'C' : if inverse then
  251. status.verbosity:=status.verbosity and (not V_Conditional)
  252. else
  253. status.verbosity:=status.verbosity or V_Conditional;
  254. 'D' : if inverse then
  255. status.verbosity:=status.verbosity and (not V_Debug)
  256. else
  257. status.verbosity:=status.verbosity or V_Debug;
  258. 'X' : if inverse then
  259. status.verbosity:=status.verbosity and (not V_Executable)
  260. else
  261. status.verbosity:=status.verbosity or V_Executable;
  262. 'S' : if inverse then
  263. status.verbosity:=status.verbosity and (not V_TimeStamps)
  264. else
  265. status.verbosity:=status.verbosity or V_TimeStamps;
  266. 'V' : PrepareReport;
  267. end;
  268. inc(i);
  269. end;
  270. end;
  271. if status.verbosity=0 then
  272. status.verbosity:=V_Default;
  273. setverbosity:=true;
  274. end;
  275. procedure Loadprefixes;
  276. function loadprefix(w:longint):string;
  277. var
  278. s : string;
  279. idx : longint;
  280. begin
  281. s:=msg^.get(w,[]);
  282. idx:=pos('_',s);
  283. if idx>0 then
  284. Loadprefix:=Copy(s,idx+1,255)
  285. else
  286. Loadprefix:=s;
  287. end;
  288. begin
  289. { Load the prefixes }
  290. fatalstr:=Loadprefix(general_i_fatal);
  291. errorstr:=Loadprefix(general_i_error);
  292. warningstr:=Loadprefix(general_i_warning);
  293. notestr:=Loadprefix(general_i_note);
  294. hintstr:=Loadprefix(general_i_hint);
  295. end;
  296. procedure LoadMsgFile(const fn:string);
  297. begin
  298. { reload the internal messages if not already loaded }
  299. {$ifndef EXTERN_MSG}
  300. if not msg^.msgintern then
  301. msg^.LoadIntern(@msgtxt,msgtxtsize);
  302. {$endif}
  303. if not msg^.LoadExtern(fn) then
  304. begin
  305. {$ifdef EXTERN_MSG}
  306. writeln('Fatal: Cannot find error message file.');
  307. halt(3);
  308. {$else}
  309. msg^.LoadIntern(@msgtxt,msgtxtsize);
  310. {$endif}
  311. end;
  312. { reload the prefixes using the new messages }
  313. Loadprefixes;
  314. end;
  315. procedure MaybeLoadMessageFile;
  316. begin
  317. { Load new message file }
  318. if (msgfilename<>'') then
  319. begin
  320. LoadMsgFile(msgfilename);
  321. msgfilename:='';
  322. end;
  323. end;
  324. procedure SetCompileModule(p:tmodulebase);
  325. begin
  326. compiling_module:=p;
  327. end;
  328. var
  329. lastfileidx,
  330. lastmoduleidx : longint;
  331. Procedure UpdateStatus;
  332. var
  333. module : tmodulebase;
  334. begin
  335. { fix status }
  336. status.currentline:=current_filepos.line;
  337. status.currentcolumn:=current_filepos.column;
  338. module:=get_module(current_filepos.moduleindex);
  339. if assigned(module) and
  340. assigned(module.sourcefiles) and
  341. ((module.unit_index<>lastmoduleidx) or
  342. (current_filepos.fileindex<>lastfileidx)) then
  343. begin
  344. { update status record }
  345. status.currentmodule:=module.modulename^;
  346. status.currentsource:=module.sourcefiles.get_file_name(current_filepos.fileindex);
  347. status.currentsourcepath:=module.sourcefiles.get_file_path(current_filepos.fileindex);
  348. { update lastfileidx only if name known PM }
  349. if status.currentsource<>'' then
  350. lastfileidx:=current_filepos.fileindex
  351. else
  352. lastfileidx:=0;
  353. lastmoduleidx:=module.unit_index;
  354. end;
  355. status.compiling_current:=assigned(compiling_module) and
  356. (module=compiling_module) and
  357. (compiling_module.state in [ms_compile,ms_second_compile]);
  358. end;
  359. procedure ShowStatus;
  360. begin
  361. UpdateStatus;
  362. if do_status() then
  363. raise ECompilerAbort.Create;
  364. end;
  365. function ErrorCount:longint;
  366. begin
  367. ErrorCount:=status.errorcount;
  368. end;
  369. procedure SetErrorFlags(const s:string);
  370. var
  371. code : integer;
  372. i,j,l : longint;
  373. begin
  374. { empty string means error count = 1 for backward compatibility (PFV) }
  375. if s='' then
  376. begin
  377. status.maxerrorcount:=1;
  378. exit;
  379. end;
  380. i:=0;
  381. while (i<length(s)) do
  382. begin
  383. inc(i);
  384. case s[i] of
  385. '0'..'9' :
  386. begin
  387. j:=i;
  388. while (j<=length(s)) and (s[j] in ['0'..'9']) do
  389. inc(j);
  390. val(copy(s,i,j-i),l,code);
  391. if code<>0 then
  392. l:=1;
  393. status.maxerrorcount:=l;
  394. i:=j;
  395. end;
  396. 'w','W' :
  397. status.errorwarning:=true;
  398. 'n','N' :
  399. status.errornote:=true;
  400. 'h','H' :
  401. status.errorhint:=true;
  402. end;
  403. end;
  404. end;
  405. procedure GenerateError;
  406. begin
  407. inc(status.errorcount);
  408. end;
  409. procedure internalerror(i : longint);
  410. begin
  411. UpdateStatus;
  412. do_internalerror(i);
  413. inc(status.errorcount);
  414. raise ECompilerAbort.Create;
  415. end;
  416. procedure Comment(l:longint;s:ansistring);
  417. var
  418. dostop : boolean;
  419. begin
  420. dostop:=((l and V_Fatal)<>0);
  421. if ((l and V_Error)<>0) or
  422. ((l and V_Fatal)<>0) or
  423. (status.errorwarning and ((l and V_Warning)<>0)) or
  424. (status.errornote and ((l and V_Note)<>0)) or
  425. (status.errorhint and ((l and V_Hint)<>0)) then
  426. inc(status.errorcount)
  427. else
  428. if l and V_Warning <> 0 then
  429. inc(status.countWarnings)
  430. else
  431. if l and V_Note <> 0 then
  432. inc(status.countNotes)
  433. else
  434. if l and V_Hint <> 0 then
  435. inc(status.countHints);
  436. { check verbosity level }
  437. if not CheckVerbosity(l) then
  438. exit;
  439. if (l and V_LineInfoMask)<>0 then
  440. l:=l or V_LineInfo;
  441. { Create status info }
  442. UpdateStatus;
  443. { Fix replacements }
  444. DefaultReplacements(s);
  445. { show comment }
  446. if do_comment(l,s) or dostop then
  447. raise ECompilerAbort.Create;
  448. if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
  449. begin
  450. Message1(unit_f_errors_in_unit,tostr(status.errorcount));
  451. status.skip_error:=true;
  452. raise ECompilerAbort.Create;
  453. end;
  454. end;
  455. Procedure Msg2Comment(s:ansistring;w:longint;onqueue:tmsgqueueevent);
  456. var
  457. idx,i,v : longint;
  458. dostop : boolean;
  459. doqueue : boolean;
  460. begin
  461. {Reset}
  462. dostop:=false;
  463. doqueue:=false;
  464. v:=0;
  465. {Parse options}
  466. idx:=pos('_',s);
  467. if idx=0 then
  468. v:=V_Normal
  469. else
  470. if (idx >= 1) And (idx <= 5) then
  471. begin
  472. for i:=1 to idx do
  473. begin
  474. case upcase(s[i]) of
  475. 'F' :
  476. begin
  477. v:=v or V_Fatal;
  478. inc(status.errorcount);
  479. dostop:=true;
  480. end;
  481. 'E' :
  482. begin
  483. v:=v or V_Error;
  484. inc(status.errorcount);
  485. end;
  486. 'O' :
  487. v:=v or V_Normal;
  488. 'W':
  489. begin
  490. v:=v or V_Warning;
  491. if status.errorwarning then
  492. inc(status.errorcount)
  493. else
  494. inc(status.countWarnings);
  495. end;
  496. 'N' :
  497. begin
  498. v:=v or V_Note;
  499. if status.errornote then
  500. inc(status.errorcount)
  501. else
  502. inc(status.countNotes);
  503. end;
  504. 'H' :
  505. begin
  506. v:=v or V_Hint;
  507. if status.errorhint then
  508. inc(status.errorcount)
  509. else
  510. inc(status.countHints);
  511. end;
  512. 'I' :
  513. v:=v or V_Info;
  514. 'L' :
  515. v:=v or V_LineInfo;
  516. 'U' :
  517. v:=v or V_Used;
  518. 'T' :
  519. v:=v or V_Tried;
  520. 'C' :
  521. v:=v or V_Conditional;
  522. 'D' :
  523. v:=v or V_Debug;
  524. 'X' :
  525. v:=v or V_Executable;
  526. 'S' :
  527. dostop:=true;
  528. '_' : ;
  529. end;
  530. end;
  531. end;
  532. Delete(s,1,idx);
  533. { check verbosity level }
  534. if not CheckVerbosity(v) then
  535. begin
  536. doqueue := onqueue <> nil;
  537. if not doqueue then
  538. exit;
  539. end;
  540. if (v and V_LineInfoMask)<>0 then
  541. v:=v or V_LineInfo;
  542. { fix status }
  543. UpdateStatus;
  544. { Fix replacements }
  545. DefaultReplacements(s);
  546. if doqueue then
  547. begin
  548. onqueue(s,v,w);
  549. exit;
  550. end;
  551. { show comment }
  552. if do_comment(v,s) or dostop then
  553. raise ECompilerAbort.Create;
  554. if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
  555. begin
  556. Message1(unit_f_errors_in_unit,tostr(status.errorcount));
  557. status.skip_error:=true;
  558. raise ECompilerAbort.Create;
  559. end;
  560. end;
  561. function MessagePchar(w:longint):pchar;
  562. begin
  563. MaybeLoadMessageFile;
  564. MessagePchar:=msg^.GetPchar(w)
  565. end;
  566. procedure Message(w:longint;onqueue:tmsgqueueevent=nil);
  567. begin
  568. MaybeLoadMessageFile;
  569. Msg2Comment(msg^.Get(w,[]),w,onqueue);
  570. end;
  571. procedure Message1(w:longint;const s1:string;onqueue:tmsgqueueevent=nil);
  572. begin
  573. MaybeLoadMessageFile;
  574. Msg2Comment(msg^.Get(w,[s1]),w,onqueue);
  575. end;
  576. procedure Message2(w:longint;const s1,s2:string;onqueue:tmsgqueueevent=nil);
  577. begin
  578. MaybeLoadMessageFile;
  579. Msg2Comment(msg^.Get(w,[s1,s2]),w,onqueue);
  580. end;
  581. procedure Message3(w:longint;const s1,s2,s3:string;onqueue:tmsgqueueevent=nil);
  582. begin
  583. MaybeLoadMessageFile;
  584. Msg2Comment(msg^.Get(w,[s1,s2,s3]),w,onqueue);
  585. end;
  586. procedure Message4(w:longint;const s1,s2,s3,s4:string;onqueue:tmsgqueueevent=nil);
  587. begin
  588. MaybeLoadMessageFile;
  589. Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]),w,onqueue);
  590. end;
  591. procedure MessagePos(const pos:tfileposinfo;w:longint;onqueue:tmsgqueueevent=nil);
  592. var
  593. oldpos : tfileposinfo;
  594. begin
  595. oldpos:=current_filepos;
  596. current_filepos:=pos;
  597. MaybeLoadMessageFile;
  598. Msg2Comment(msg^.Get(w,[]),w,onqueue);
  599. current_filepos:=oldpos;
  600. end;
  601. procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:string;onqueue:tmsgqueueevent=nil);
  602. var
  603. oldpos : tfileposinfo;
  604. begin
  605. oldpos:=current_filepos;
  606. current_filepos:=pos;
  607. MaybeLoadMessageFile;
  608. Msg2Comment(msg^.Get(w,[s1]),w,onqueue);
  609. current_filepos:=oldpos;
  610. end;
  611. procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:string;onqueue:tmsgqueueevent=nil);
  612. var
  613. oldpos : tfileposinfo;
  614. begin
  615. oldpos:=current_filepos;
  616. current_filepos:=pos;
  617. MaybeLoadMessageFile;
  618. Msg2Comment(msg^.Get(w,[s1,s2]),w,onqueue);
  619. current_filepos:=oldpos;
  620. end;
  621. procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:string;onqueue:tmsgqueueevent=nil);
  622. var
  623. oldpos : tfileposinfo;
  624. begin
  625. oldpos:=current_filepos;
  626. current_filepos:=pos;
  627. MaybeLoadMessageFile;
  628. Msg2Comment(msg^.Get(w,[s1,s2,s3]),w,onqueue);
  629. current_filepos:=oldpos;
  630. end;
  631. procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:string;onqueue:tmsgqueueevent=nil);
  632. var
  633. oldpos : tfileposinfo;
  634. begin
  635. oldpos:=current_filepos;
  636. current_filepos:=pos;
  637. MaybeLoadMessageFile;
  638. Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]),w,onqueue);
  639. current_filepos:=oldpos;
  640. end;
  641. {*****************************************************************************
  642. override the message calls to set codegenerror
  643. *****************************************************************************}
  644. procedure cgmessage(t : longint);
  645. var
  646. olderrorcount : longint;
  647. begin
  648. if not(codegenerror) then
  649. begin
  650. olderrorcount:=Errorcount;
  651. verbose.Message(t);
  652. codegenerror:=olderrorcount<>Errorcount;
  653. end;
  654. end;
  655. procedure cgmessage1(t : longint;const s : string);
  656. var
  657. olderrorcount : longint;
  658. begin
  659. if not(codegenerror) then
  660. begin
  661. olderrorcount:=Errorcount;
  662. verbose.Message1(t,s);
  663. codegenerror:=olderrorcount<>Errorcount;
  664. end;
  665. end;
  666. procedure cgmessage2(t : longint;const s1,s2 : string);
  667. var
  668. olderrorcount : longint;
  669. begin
  670. if not(codegenerror) then
  671. begin
  672. olderrorcount:=Errorcount;
  673. verbose.Message2(t,s1,s2);
  674. codegenerror:=olderrorcount<>Errorcount;
  675. end;
  676. end;
  677. procedure cgmessage3(t : longint;const s1,s2,s3 : string);
  678. var
  679. olderrorcount : longint;
  680. begin
  681. if not(codegenerror) then
  682. begin
  683. olderrorcount:=Errorcount;
  684. verbose.Message3(t,s1,s2,s3);
  685. codegenerror:=olderrorcount<>Errorcount;
  686. end;
  687. end;
  688. procedure cgmessagepos(const pos:tfileposinfo;t : longint);
  689. var
  690. olderrorcount : longint;
  691. begin
  692. if not(codegenerror) then
  693. begin
  694. olderrorcount:=Errorcount;
  695. verbose.MessagePos(pos,t);
  696. codegenerror:=olderrorcount<>Errorcount;
  697. end;
  698. end;
  699. procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : string);
  700. var
  701. olderrorcount : longint;
  702. begin
  703. if not(codegenerror) then
  704. begin
  705. olderrorcount:=Errorcount;
  706. verbose.MessagePos1(pos,t,s1);
  707. codegenerror:=olderrorcount<>Errorcount;
  708. end;
  709. end;
  710. procedure cgmessagepos2(const pos:tfileposinfo;t : longint;const s1,s2 : string);
  711. var
  712. olderrorcount : longint;
  713. begin
  714. if not(codegenerror) then
  715. begin
  716. olderrorcount:=Errorcount;
  717. verbose.MessagePos2(pos,t,s1,s2);
  718. codegenerror:=olderrorcount<>Errorcount;
  719. end;
  720. end;
  721. procedure cgmessagepos3(const pos:tfileposinfo;t : longint;const s1,s2,s3 : string);
  722. var
  723. olderrorcount : longint;
  724. begin
  725. if not(codegenerror) then
  726. begin
  727. olderrorcount:=Errorcount;
  728. verbose.MessagePos3(pos,t,s1,s2,s3);
  729. codegenerror:=olderrorcount<>Errorcount;
  730. end;
  731. end;
  732. procedure FlushOutput;
  733. begin
  734. if not (Status.Use_StdErr) then (* StdErr is flushed after every line *)
  735. begin
  736. if Status.Use_Redir then
  737. Flush(Status.RedirFile)
  738. else
  739. Flush(Output);
  740. end;
  741. end;
  742. {*****************************************************************************
  743. Initialization
  744. *****************************************************************************}
  745. procedure InitVerbose;
  746. begin
  747. { Init }
  748. msg:=new(pmessage,Init(20,msgidxmax));
  749. if msg=nil then
  750. begin
  751. writeln('Fatal: MsgIdx Wrong');
  752. halt(3);
  753. end;
  754. {$ifndef EXTERN_MSG}
  755. msg^.LoadIntern(@msgtxt,msgtxtsize);
  756. {$else EXTERN_MSG}
  757. LoadMsgFile(exepath+'errore.msg');
  758. {$endif EXTERN_MSG}
  759. FillChar(Status,sizeof(TCompilerStatus),0);
  760. status.verbosity:=V_Default;
  761. Status.MaxErrorCount:=50;
  762. Status.codesize:=-1;
  763. Status.datasize:=-1;
  764. Loadprefixes;
  765. lastfileidx:=-1;
  766. lastmoduleidx:=-1;
  767. status.currentmodule:='';
  768. status.currentsource:='';
  769. status.currentsourcepath:='';
  770. status.compiling_current:=false;
  771. compiling_module:=nil;
  772. { Register internalerrorproc for cutils/cclasses }
  773. internalerrorproc:=@internalerror;
  774. end;
  775. procedure DoneVerbose;
  776. begin
  777. if assigned(msg) then
  778. begin
  779. dispose(msg,Done);
  780. msg:=nil;
  781. end;
  782. DoneRedirectFile;
  783. end;
  784. initialization
  785. finalization
  786. { Be sure to close the redirect files to flush all data }
  787. DoneRedirectFile;
  788. end.