pstatmnt.pas 50 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 by Florian Klaempfl
  4. Does the parsing of the statements
  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. {$ifdef FPC}
  19. {$goto on}
  20. {$endif FPC}
  21. unit pstatmnt;
  22. interface
  23. uses tree;
  24. { reads a block }
  25. function block(islibrary : boolean) : ptree;
  26. { reads an assembler block }
  27. function assembler_block : ptree;
  28. implementation
  29. uses
  30. globtype,systems,tokens,
  31. strings,cobjects,globals,files,verbose,
  32. symconst,symtable,aasm,pass_1,types,scanner,
  33. {$ifdef newcg}
  34. cgbase,
  35. {$else}
  36. hcodegen,
  37. {$endif}
  38. ppu
  39. ,pbase,pexpr,pdecl,cpubase,cpuasm
  40. {$ifdef i386}
  41. ,tgeni386
  42. {$ifndef NoRa386Int}
  43. ,ra386int
  44. {$endif NoRa386Int}
  45. {$ifndef NoRa386Att}
  46. ,ra386att
  47. {$endif NoRa386Att}
  48. {$ifndef NoRa386Dir}
  49. ,ra386dir
  50. {$endif NoRa386Dir}
  51. {$endif i386}
  52. {$ifdef m68k}
  53. ,tgen68k
  54. {$ifndef NoRa68kMot}
  55. ,ra68kmot
  56. {$endif NoRa68kMot}
  57. {$endif m68k}
  58. {$ifdef alpha}
  59. ,tgeni386 { this is a dummy!! }
  60. {$endif alpha}
  61. {$ifdef powerpc}
  62. ,tgeni386 { this is a dummy!! }
  63. {$endif powerpc}
  64. ;
  65. const
  66. statement_level : longint = 0;
  67. function statement : ptree;forward;
  68. function if_statement : ptree;
  69. var
  70. ex,if_a,else_a : ptree;
  71. begin
  72. consume(_IF);
  73. ex:=comp_expr(true);
  74. consume(_THEN);
  75. if token<>_ELSE then
  76. if_a:=statement
  77. else
  78. if_a:=nil;
  79. if try_to_consume(_ELSE) then
  80. else_a:=statement
  81. else
  82. else_a:=nil;
  83. if_statement:=genloopnode(ifn,ex,if_a,else_a,false);
  84. end;
  85. { creates a block (list) of statements, til the next END token }
  86. function statements_til_end : ptree;
  87. var
  88. first,last : ptree;
  89. begin
  90. first:=nil;
  91. while token<>_END do
  92. begin
  93. if first=nil then
  94. begin
  95. last:=gennode(statementn,nil,statement);
  96. first:=last;
  97. end
  98. else
  99. begin
  100. last^.left:=gennode(statementn,nil,statement);
  101. last:=last^.left;
  102. end;
  103. if not try_to_consume(_SEMICOLON) then
  104. break;
  105. emptystats;
  106. end;
  107. consume(_END);
  108. statements_til_end:=gensinglenode(blockn,first);
  109. end;
  110. function case_statement : ptree;
  111. var
  112. { contains the label number of currently parsed case block }
  113. aktcaselabel : pasmlabel;
  114. firstlabel : boolean;
  115. root : pcaserecord;
  116. { the typ of the case expression }
  117. casedef : pdef;
  118. procedure newcaselabel(l,h : longint;first:boolean);
  119. var
  120. hcaselabel : pcaserecord;
  121. procedure insertlabel(var p : pcaserecord);
  122. begin
  123. if p=nil then p:=hcaselabel
  124. else
  125. if (p^._low>hcaselabel^._low) and
  126. (p^._low>hcaselabel^._high) then
  127. if (hcaselabel^.statement = p^.statement) and
  128. (p^._low = hcaselabel^._high + 1) then
  129. begin
  130. p^._low := hcaselabel^._low;
  131. dispose(hcaselabel);
  132. end
  133. else
  134. insertlabel(p^.less)
  135. else
  136. if (p^._high<hcaselabel^._low) and
  137. (p^._high<hcaselabel^._high) then
  138. if (hcaselabel^.statement = p^.statement) and
  139. (p^._high+1 = hcaselabel^._low) then
  140. begin
  141. p^._high := hcaselabel^._high;
  142. dispose(hcaselabel);
  143. end
  144. else
  145. insertlabel(p^.greater)
  146. else Message(parser_e_double_caselabel);
  147. end;
  148. begin
  149. new(hcaselabel);
  150. hcaselabel^.less:=nil;
  151. hcaselabel^.greater:=nil;
  152. hcaselabel^.statement:=aktcaselabel;
  153. hcaselabel^.firstlabel:=first;
  154. getlabel(hcaselabel^._at);
  155. hcaselabel^._low:=l;
  156. hcaselabel^._high:=h;
  157. insertlabel(root);
  158. end;
  159. var
  160. code,caseexpr,p,instruc,elseblock : ptree;
  161. hl1,hl2 : longint;
  162. casedeferror : boolean;
  163. begin
  164. consume(_CASE);
  165. caseexpr:=comp_expr(true);
  166. { determines result type }
  167. cleartempgen;
  168. do_firstpass(caseexpr);
  169. casedeferror:=false;
  170. casedef:=caseexpr^.resulttype;
  171. if (not assigned(casedef)) or
  172. not(is_ordinal(casedef) or is_64bitint(casedef)) then
  173. begin
  174. Message(type_e_ordinal_expr_expected);
  175. { set error flag so no rangechecks are done }
  176. casedeferror:=true;
  177. end;
  178. consume(_OF);
  179. inc(statement_level);
  180. root:=nil;
  181. instruc:=nil;
  182. repeat
  183. getlabel(aktcaselabel);
  184. firstlabel:=true;
  185. { may be an instruction has more case labels }
  186. repeat
  187. p:=expr;
  188. cleartempgen;
  189. do_firstpass(p);
  190. hl1:=0;
  191. hl2:=0;
  192. if (p^.treetype=rangen) then
  193. begin
  194. { type checking for case statements }
  195. if is_subequal(casedef, p^.left^.resulttype) and
  196. is_subequal(casedef, p^.right^.resulttype) then
  197. begin
  198. hl1:=get_ordinal_value(p^.left);
  199. hl2:=get_ordinal_value(p^.right);
  200. if hl1>hl2 then
  201. Message(parser_e_case_lower_less_than_upper_bound);
  202. if not casedeferror then
  203. begin
  204. testrange(casedef,hl1);
  205. testrange(casedef,hl2);
  206. end;
  207. end
  208. else
  209. Message(parser_e_case_mismatch);
  210. newcaselabel(hl1,hl2,firstlabel);
  211. end
  212. else
  213. begin
  214. { type checking for case statements }
  215. if not is_subequal(casedef, p^.resulttype) then
  216. Message(parser_e_case_mismatch);
  217. hl1:=get_ordinal_value(p);
  218. if not casedeferror then
  219. testrange(casedef,hl1);
  220. newcaselabel(hl1,hl1,firstlabel);
  221. end;
  222. disposetree(p);
  223. if token=_COMMA then
  224. consume(_COMMA)
  225. else
  226. break;
  227. firstlabel:=false;
  228. until false;
  229. consume(_COLON);
  230. { handles instruction block }
  231. p:=gensinglenode(labeln,statement);
  232. p^.labelnr:=aktcaselabel;
  233. { concats instruction }
  234. instruc:=gennode(statementn,instruc,p);
  235. if not((token=_ELSE) or (token=_OTHERWISE) or (token=_END)) then
  236. consume(_SEMICOLON);
  237. until (token=_ELSE) or (token=_OTHERWISE) or (token=_END);
  238. if (token=_ELSE) or (token=_OTHERWISE) then
  239. begin
  240. if not try_to_consume(_ELSE) then
  241. consume(_OTHERWISE);
  242. elseblock:=statements_til_end;
  243. end
  244. else
  245. begin
  246. elseblock:=nil;
  247. consume(_END);
  248. end;
  249. dec(statement_level);
  250. code:=gencasenode(caseexpr,instruc,root);
  251. code^.elseblock:=elseblock;
  252. case_statement:=code;
  253. end;
  254. function repeat_statement : ptree;
  255. var
  256. first,last,p_e : ptree;
  257. begin
  258. consume(_REPEAT);
  259. first:=nil;
  260. inc(statement_level);
  261. while token<>_UNTIL do
  262. begin
  263. if first=nil then
  264. begin
  265. last:=gennode(statementn,nil,statement);
  266. first:=last;
  267. end
  268. else
  269. begin
  270. last^.left:=gennode(statementn,nil,statement);
  271. last:=last^.left;
  272. end;
  273. if not try_to_consume(_SEMICOLON) then
  274. break;
  275. emptystats;
  276. end;
  277. consume(_UNTIL);
  278. dec(statement_level);
  279. first:=gensinglenode(blockn,first);
  280. p_e:=comp_expr(true);
  281. repeat_statement:=genloopnode(repeatn,p_e,first,nil,false);
  282. end;
  283. function while_statement : ptree;
  284. var
  285. p_e,p_a : ptree;
  286. begin
  287. consume(_WHILE);
  288. p_e:=comp_expr(true);
  289. consume(_DO);
  290. p_a:=statement;
  291. while_statement:=genloopnode(whilen,p_e,p_a,nil,false);
  292. end;
  293. function for_statement : ptree;
  294. var
  295. p_e,tovalue,p_a : ptree;
  296. backward : boolean;
  297. begin
  298. { parse loop header }
  299. consume(_FOR);
  300. p_e:=expr;
  301. if token=_DOWNTO then
  302. begin
  303. consume(_DOWNTO);
  304. backward:=true;
  305. end
  306. else
  307. begin
  308. consume(_TO);
  309. backward:=false;
  310. end;
  311. tovalue:=comp_expr(true);
  312. consume(_DO);
  313. { ... now the instruction }
  314. p_a:=statement;
  315. for_statement:=genloopnode(forn,p_e,tovalue,p_a,backward);
  316. end;
  317. function _with_statement : ptree;
  318. var
  319. right,p : ptree;
  320. i,levelcount : longint;
  321. withsymtable,symtab : psymtable;
  322. obj : pobjectdef;
  323. {$ifdef tp}
  324. hp : ptree;
  325. {$endif}
  326. begin
  327. p:=comp_expr(true);
  328. do_firstpass(p);
  329. set_varstate(p,false);
  330. right:=nil;
  331. if (not codegenerror) and
  332. (p^.resulttype^.deftype in [objectdef,recorddef]) then
  333. begin
  334. case p^.resulttype^.deftype of
  335. objectdef : begin
  336. obj:=pobjectdef(p^.resulttype);
  337. withsymtable:=new(pwithsymtable,init);
  338. withsymtable^.symsearch:=obj^.symtable^.symsearch;
  339. withsymtable^.defowner:=obj;
  340. symtab:=withsymtable;
  341. if (p^.treetype=loadn) and
  342. (p^.symtable=aktprocsym^.definition^.localst) then
  343. pwithsymtable(symtab)^.direct_with:=true;
  344. {symtab^.withnode:=p; not yet allocated !! }
  345. pwithsymtable(symtab)^.withrefnode:=p;
  346. levelcount:=1;
  347. obj:=obj^.childof;
  348. while assigned(obj) do
  349. begin
  350. symtab^.next:=new(pwithsymtable,init);
  351. symtab:=symtab^.next;
  352. symtab^.symsearch:=obj^.symtable^.symsearch;
  353. if (p^.treetype=loadn) and
  354. (p^.symtable=aktprocsym^.definition^.localst) then
  355. pwithsymtable(symtab)^.direct_with:=true;
  356. {symtab^.withnode:=p; not yet allocated !! }
  357. pwithsymtable(symtab)^.withrefnode:=p;
  358. symtab^.defowner:=obj;
  359. obj:=obj^.childof;
  360. inc(levelcount);
  361. end;
  362. symtab^.next:=symtablestack;
  363. symtablestack:=withsymtable;
  364. end;
  365. recorddef : begin
  366. symtab:=precorddef(p^.resulttype)^.symtable;
  367. levelcount:=1;
  368. withsymtable:=new(pwithsymtable,init);
  369. withsymtable^.symsearch:=symtab^.symsearch;
  370. withsymtable^.next:=symtablestack;
  371. if (p^.treetype=loadn) and
  372. (p^.symtable=aktprocsym^.definition^.localst) then
  373. pwithsymtable(withsymtable)^.direct_with:=true;
  374. {symtab^.withnode:=p; not yet allocated !! }
  375. pwithsymtable(withsymtable)^.withrefnode:=p;
  376. withsymtable^.defowner:=obj;
  377. symtablestack:=withsymtable;
  378. end;
  379. end;
  380. if token=_COMMA then
  381. begin
  382. consume(_COMMA);
  383. right:=_with_statement{$ifndef tp}(){$endif};
  384. end
  385. else
  386. begin
  387. consume(_DO);
  388. if token<>_SEMICOLON then
  389. right:=statement
  390. else
  391. right:=nil;
  392. end;
  393. for i:=1 to levelcount do
  394. symtablestack:=symtablestack^.next;
  395. _with_statement:=genwithnode(pwithsymtable(withsymtable),p,right,levelcount);
  396. end
  397. else
  398. begin
  399. Message(parser_e_false_with_expr);
  400. { try to recover from error }
  401. if token=_COMMA then
  402. begin
  403. consume(_COMMA);
  404. {$ifdef tp}
  405. hp:=_with_statement;
  406. {$else}
  407. _with_statement();
  408. {$endif}
  409. end
  410. else
  411. begin
  412. consume(_DO);
  413. { ignore all }
  414. if token<>_SEMICOLON then
  415. statement;
  416. end;
  417. _with_statement:=nil;
  418. end;
  419. end;
  420. function with_statement : ptree;
  421. begin
  422. consume(_WITH);
  423. with_statement:=_with_statement;
  424. end;
  425. function raise_statement : ptree;
  426. var
  427. p1,p2 : ptree;
  428. begin
  429. p1:=nil;
  430. p2:=nil;
  431. consume(_RAISE);
  432. if not(token in [_SEMICOLON,_END]) then
  433. begin
  434. p1:=comp_expr(true);
  435. if (idtoken=_AT) then
  436. begin
  437. consume(_ID);
  438. p2:=comp_expr(true);
  439. end;
  440. end
  441. else
  442. begin
  443. if (block_type<>bt_except) then
  444. Message(parser_e_no_reraise_possible);
  445. end;
  446. raise_statement:=gennode(raisen,p1,p2);
  447. end;
  448. function try_statement : ptree;
  449. var
  450. p_try_block,p_finally_block,first,last,
  451. p_default,p_specific,hp : ptree;
  452. ot : pobjectdef;
  453. sym : pvarsym;
  454. old_block_type : tblock_type;
  455. exceptsymtable : psymtable;
  456. objname : stringid;
  457. begin
  458. procinfo^.flags:=procinfo^.flags or
  459. pi_uses_exceptions;
  460. p_default:=nil;
  461. p_specific:=nil;
  462. { read statements to try }
  463. consume(_TRY);
  464. first:=nil;
  465. inc(statement_level);
  466. while (token<>_FINALLY) and (token<>_EXCEPT) do
  467. begin
  468. if first=nil then
  469. begin
  470. last:=gennode(statementn,nil,statement);
  471. first:=last;
  472. end
  473. else
  474. begin
  475. last^.left:=gennode(statementn,nil,statement);
  476. last:=last^.left;
  477. end;
  478. if not try_to_consume(_SEMICOLON) then
  479. break;
  480. emptystats;
  481. end;
  482. p_try_block:=gensinglenode(blockn,first);
  483. if try_to_consume(_FINALLY) then
  484. begin
  485. p_finally_block:=statements_til_end;
  486. try_statement:=gennode(tryfinallyn,p_try_block,p_finally_block);
  487. dec(statement_level);
  488. end
  489. else
  490. begin
  491. consume(_EXCEPT);
  492. old_block_type:=block_type;
  493. block_type:=bt_except;
  494. p_specific:=nil;
  495. if token=_ON then
  496. { catch specific exceptions }
  497. begin
  498. repeat
  499. consume(_ON);
  500. if token=_ID then
  501. begin
  502. getsym(pattern,false);
  503. objname:=pattern;
  504. consume(_ID);
  505. { is a explicit name for the exception given ? }
  506. if try_to_consume(_COLON) then
  507. begin
  508. getsym(pattern,true);
  509. consume(_ID);
  510. if srsym^.typ=unitsym then
  511. begin
  512. consume(_POINT);
  513. getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
  514. consume(_ID);
  515. end;
  516. if (srsym^.typ=typesym) and
  517. (ptypesym(srsym)^.restype.def^.deftype=objectdef) and
  518. pobjectdef(ptypesym(srsym)^.restype.def)^.is_class then
  519. ot:=pobjectdef(ptypesym(srsym)^.restype.def)
  520. else
  521. begin
  522. ot:=pobjectdef(generrordef);
  523. if (srsym^.typ=typesym) then
  524. Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
  525. else
  526. Message1(type_e_class_type_expected,ot^.typename);
  527. end;
  528. sym:=new(pvarsym,initdef(objname,ot));
  529. exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
  530. exceptsymtable^.insert(sym);
  531. { insert the exception symtable stack }
  532. exceptsymtable^.next:=symtablestack;
  533. symtablestack:=exceptsymtable;
  534. end
  535. else
  536. begin
  537. { only exception type }
  538. if srsym^.typ=unitsym then
  539. begin
  540. consume(_POINT);
  541. getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
  542. consume(_ID);
  543. end;
  544. if (srsym^.typ=typesym) and
  545. (ptypesym(srsym)^.restype.def^.deftype=objectdef) and
  546. pobjectdef(ptypesym(srsym)^.restype.def)^.is_class then
  547. ot:=pobjectdef(ptypesym(srsym)^.restype.def)
  548. else
  549. begin
  550. ot:=pobjectdef(generrordef);
  551. if (srsym^.typ=typesym) then
  552. Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
  553. else
  554. Message1(type_e_class_type_expected,ot^.typename);
  555. end;
  556. exceptsymtable:=nil;
  557. end;
  558. end
  559. else
  560. consume(_ID);
  561. consume(_DO);
  562. hp:=gennode(onn,nil,statement);
  563. if ot^.deftype=errordef then
  564. begin
  565. disposetree(hp);
  566. hp:=genzeronode(errorn);
  567. end;
  568. if p_specific=nil then
  569. begin
  570. last:=hp;
  571. p_specific:=last;
  572. end
  573. else
  574. begin
  575. last^.left:=hp;
  576. last:=last^.left;
  577. end;
  578. { set the informations }
  579. last^.excepttype:=ot;
  580. last^.exceptsymtable:=exceptsymtable;
  581. last^.disposetyp:=dt_onn;
  582. { remove exception symtable }
  583. if assigned(exceptsymtable) then
  584. dellexlevel;
  585. if not try_to_consume(_SEMICOLON) then
  586. break;
  587. emptystats;
  588. until (token=_END) or(token=_ELSE);
  589. if token=_ELSE then
  590. { catch the other exceptions }
  591. begin
  592. consume(_ELSE);
  593. p_default:=statements_til_end;
  594. end
  595. else
  596. consume(_END);
  597. end
  598. else
  599. { catch all exceptions }
  600. begin
  601. p_default:=statements_til_end;
  602. end;
  603. dec(statement_level);
  604. block_type:=old_block_type;
  605. try_statement:=genloopnode(tryexceptn,p_try_block,p_specific,p_default,false);
  606. end;
  607. end;
  608. function exit_statement : ptree;
  609. var
  610. p : ptree;
  611. begin
  612. consume(_EXIT);
  613. if try_to_consume(_LKLAMMER) then
  614. begin
  615. p:=comp_expr(true);
  616. consume(_RKLAMMER);
  617. if (block_type=bt_except) then
  618. Message(parser_e_exit_with_argument_not__possible);
  619. if procinfo^.returntype.def=pdef(voiddef) then
  620. Message(parser_e_void_function);
  621. end
  622. else
  623. p:=nil;
  624. p:=gensinglenode(exitn,p);
  625. p^.resulttype:=procinfo^.returntype.def;
  626. exit_statement:=p;
  627. end;
  628. function _asm_statement : ptree;
  629. var
  630. asmstat : ptree;
  631. Marker : Pai;
  632. begin
  633. Inside_asm_statement:=true;
  634. case aktasmmode of
  635. asmmode_none : ; { just be there to allow to a compile without
  636. any assembler readers }
  637. {$ifdef i386}
  638. {$ifndef NoRA386Att}
  639. asmmode_i386_att:
  640. asmstat:=ra386att.assemble;
  641. {$endif NoRA386Att}
  642. {$ifndef NoRA386Int}
  643. asmmode_i386_intel:
  644. asmstat:=ra386int.assemble;
  645. {$endif NoRA386Int}
  646. {$ifndef NoRA386Dir}
  647. asmmode_i386_direct:
  648. begin
  649. if not target_asm.allowdirect then
  650. Message(parser_f_direct_assembler_not_allowed);
  651. if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  652. Begin
  653. Message1(parser_w_not_supported_for_inline,'direct asm');
  654. Message(parser_w_inlining_disabled);
  655. {$ifdef INCLUDEOK}
  656. exclude(aktprocsym^.definition^.proccalloptions,pocall_inline);
  657. {$else}
  658. aktprocsym^.definition^.proccalloptions:=aktprocsym^.definition^.proccalloptions-[pocall_inline];
  659. {$endif}
  660. End;
  661. asmstat:=ra386dir.assemble;
  662. end;
  663. {$endif NoRA386Dir}
  664. {$endif}
  665. {$ifdef m68k}
  666. {$ifndef NoRA68kMot}
  667. asmmode_m68k_mot:
  668. asmstat:=ra68kmot.assemble;
  669. {$endif NoRA68kMot}
  670. {$endif}
  671. else
  672. Message(parser_f_assembler_reader_not_supported);
  673. end;
  674. { Read first the _ASM statement }
  675. consume(_ASM);
  676. {$ifndef newcg}
  677. { END is read }
  678. if try_to_consume(_LECKKLAMMER) then
  679. begin
  680. { it's possible to specify the modified registers }
  681. asmstat^.object_preserved:=true;
  682. if token<>_RECKKLAMMER then
  683. repeat
  684. { uppercase, because it's a CSTRING }
  685. uppervar(pattern);
  686. {$ifdef i386}
  687. if pattern='EAX' then
  688. usedinproc:=usedinproc or ($80 shr byte(R_EAX))
  689. else if pattern='EBX' then
  690. usedinproc:=usedinproc or ($80 shr byte(R_EBX))
  691. else if pattern='ECX' then
  692. usedinproc:=usedinproc or ($80 shr byte(R_ECX))
  693. else if pattern='EDX' then
  694. usedinproc:=usedinproc or ($80 shr byte(R_EDX))
  695. else if pattern='ESI' then
  696. begin
  697. usedinproc:=usedinproc or ($80 shr byte(R_ESI));
  698. asmstat^.object_preserved:=false;
  699. end
  700. else if pattern='EDI' then
  701. usedinproc:=usedinproc or ($80 shr byte(R_EDI))
  702. {$endif i386}
  703. {$ifdef m68k}
  704. if pattern='D0' then
  705. usedinproc:=usedinproc or ($800 shr word(R_D0))
  706. else if pattern='D1' then
  707. usedinproc:=usedinproc or ($800 shr word(R_D1))
  708. else if pattern='D6' then
  709. usedinproc:=usedinproc or ($800 shr word(R_D6))
  710. else if pattern='A0' then
  711. usedinproc:=usedinproc or ($800 shr word(R_A0))
  712. else if pattern='A1' then
  713. usedinproc:=usedinproc or ($800 shr word(R_A1))
  714. {$endif m68k}
  715. else consume(_RECKKLAMMER);
  716. consume(_CSTRING);
  717. if not try_to_consume(_COMMA) then
  718. break;
  719. until false;
  720. consume(_RECKKLAMMER);
  721. end
  722. else usedinproc:=$ff;
  723. {$endif newcg}
  724. { mark the start and the end of the assembler block for the optimizer }
  725. If Assigned(AsmStat^.p_asm) Then
  726. Begin
  727. Marker := New(Pai_Marker, Init(AsmBlockStart));
  728. AsmStat^.p_asm^.Insert(Marker);
  729. Marker := New(Pai_Marker, Init(AsmBlockEnd));
  730. AsmStat^.p_asm^.Concat(Marker);
  731. End;
  732. Inside_asm_statement:=false;
  733. _asm_statement:=asmstat;
  734. end;
  735. function new_dispose_statement : ptree;
  736. var
  737. p,p2 : ptree;
  738. ht : ttoken;
  739. again : boolean; { dummy for do_proc_call }
  740. destructorname : stringid;
  741. sym : psym;
  742. classh : pobjectdef;
  743. pd,pd2 : pdef;
  744. destructorpos,storepos : tfileposinfo;
  745. tt : ttreetyp;
  746. begin
  747. ht:=token;
  748. if try_to_consume(_NEW) then
  749. tt:=hnewn
  750. else
  751. begin
  752. consume(_DISPOSE);
  753. tt:=hdisposen;
  754. end;
  755. consume(_LKLAMMER);
  756. p:=comp_expr(true);
  757. { calc return type }
  758. cleartempgen;
  759. do_firstpass(p);
  760. set_varstate(p,tt=hdisposen);
  761. {var o:Pobject;
  762. begin
  763. new(o,init); (*Also a valid new statement*)
  764. end;}
  765. if try_to_consume(_COMMA) then
  766. begin
  767. { extended syntax of new and dispose }
  768. { function styled new is handled in factor }
  769. { destructors have no parameters }
  770. destructorname:=pattern;
  771. destructorpos:=tokenpos;
  772. consume(_ID);
  773. pd:=p^.resulttype;
  774. if pd=nil then
  775. pd:=generrordef;
  776. pd2:=pd;
  777. if (pd^.deftype<>pointerdef) then
  778. begin
  779. Message1(type_e_pointer_type_expected,pd^.typename);
  780. p:=factor(false);
  781. consume(_RKLAMMER);
  782. new_dispose_statement:=genzeronode(errorn);
  783. exit;
  784. end;
  785. { first parameter must be an object or class }
  786. if ppointerdef(pd)^.pointertype.def^.deftype<>objectdef then
  787. begin
  788. Message(parser_e_pointer_to_class_expected);
  789. new_dispose_statement:=factor(false);
  790. consume_all_until(_RKLAMMER);
  791. consume(_RKLAMMER);
  792. exit;
  793. end;
  794. { check, if the first parameter is a pointer to a _class_ }
  795. classh:=pobjectdef(ppointerdef(pd)^.pointertype.def);
  796. if classh^.is_class then
  797. begin
  798. Message(parser_e_no_new_or_dispose_for_classes);
  799. new_dispose_statement:=factor(false);
  800. consume_all_until(_RKLAMMER);
  801. consume(_RKLAMMER);
  802. exit;
  803. end;
  804. { search cons-/destructor, also in parent classes }
  805. storepos:=tokenpos;
  806. tokenpos:=destructorpos;
  807. sym:=search_class_member(classh,destructorname);
  808. tokenpos:=storepos;
  809. { the second parameter of new/dispose must be a call }
  810. { to a cons-/destructor }
  811. if (not assigned(sym)) or (sym^.typ<>procsym) then
  812. begin
  813. if tt=hnewn then
  814. Message(parser_e_expr_have_to_be_constructor_call)
  815. else
  816. Message(parser_e_expr_have_to_be_destructor_call);
  817. new_dispose_statement:=genzeronode(errorn);
  818. end
  819. else
  820. begin
  821. p2:=gensinglenode(tt,p);
  822. if ht=_NEW then
  823. begin
  824. { Constructors can take parameters.}
  825. p2^.resulttype:=ppointerdef(pd)^.pointertype.def;
  826. do_member_read(false,sym,p2,pd,again);
  827. end
  828. else
  829. begin
  830. p2:=genmethodcallnode(pprocsym(sym),srsymtable,p2);
  831. { support dispose(p,done()); }
  832. if try_to_consume(_LKLAMMER) then
  833. begin
  834. if not try_to_consume(_RKLAMMER) then
  835. begin
  836. Message(parser_e_no_paras_for_destructor);
  837. consume_all_until(_RKLAMMER);
  838. consume(_RKLAMMER);
  839. end;
  840. end;
  841. end;
  842. { we need the real called method }
  843. cleartempgen;
  844. do_firstpass(p2);
  845. if not codegenerror then
  846. begin
  847. if (ht=_NEW) and (p2^.procdefinition^.proctypeoption<>potype_constructor) then
  848. Message(parser_e_expr_have_to_be_constructor_call);
  849. if (ht=_DISPOSE) and (p2^.procdefinition^.proctypeoption<>potype_destructor) then
  850. Message(parser_e_expr_have_to_be_destructor_call);
  851. if ht=_NEW then
  852. begin
  853. p2:=gennode(assignn,getcopy(p),gensinglenode(newn,p2));
  854. p2^.right^.resulttype:=pd2;
  855. end;
  856. end;
  857. new_dispose_statement:=p2;
  858. end;
  859. end
  860. else
  861. begin
  862. if p^.resulttype=nil then
  863. p^.resulttype:=generrordef;
  864. if (p^.resulttype^.deftype<>pointerdef) then
  865. Begin
  866. Message1(type_e_pointer_type_expected,p^.resulttype^.typename);
  867. new_dispose_statement:=genzeronode(errorn);
  868. end
  869. else
  870. begin
  871. if (ppointerdef(p^.resulttype)^.pointertype.def^.deftype=objectdef) and
  872. (oo_has_vmt in pobjectdef(ppointerdef(p^.resulttype)^.pointertype.def)^.objectoptions) then
  873. Message(parser_w_use_extended_syntax_for_objects);
  874. if (ppointerdef(p^.resulttype)^.pointertype.def^.deftype=orddef) and
  875. (porddef(ppointerdef(p^.resulttype)^.pointertype.def)^.typ=uvoid) then
  876. if (m_tp in aktmodeswitches) or
  877. (m_delphi in aktmodeswitches) then
  878. Message(parser_w_no_new_dispose_on_void_pointers)
  879. else
  880. Message(parser_e_no_new_dispose_on_void_pointers);
  881. case ht of
  882. _NEW : new_dispose_statement:=gensinglenode(simplenewn,p);
  883. _DISPOSE : new_dispose_statement:=gensinglenode(simpledisposen,p);
  884. end;
  885. end;
  886. end;
  887. consume(_RKLAMMER);
  888. end;
  889. function statement_block(starttoken : ttoken) : ptree;
  890. var
  891. first,last : ptree;
  892. filepos : tfileposinfo;
  893. begin
  894. first:=nil;
  895. filepos:=tokenpos;
  896. consume(starttoken);
  897. inc(statement_level);
  898. while not(token in [_END,_FINALIZATION]) do
  899. begin
  900. if first=nil then
  901. begin
  902. last:=gennode(statementn,nil,statement);
  903. first:=last;
  904. end
  905. else
  906. begin
  907. last^.left:=gennode(statementn,nil,statement);
  908. last:=last^.left;
  909. end;
  910. if (token in [_END,_FINALIZATION]) then
  911. break
  912. else
  913. begin
  914. { if no semicolon, then error and go on }
  915. if token<>_SEMICOLON then
  916. begin
  917. consume(_SEMICOLON);
  918. consume_all_until(_SEMICOLON);
  919. end;
  920. consume(_SEMICOLON);
  921. end;
  922. emptystats;
  923. end;
  924. { don't consume the finalization token, it is consumed when
  925. reading the finalization block, but allow it only after
  926. an initalization ! }
  927. if (starttoken<>_INITIALIZATION) or (token<>_FINALIZATION) then
  928. consume(_END);
  929. dec(statement_level);
  930. last:=gensinglenode(blockn,first);
  931. set_tree_filepos(last,filepos);
  932. statement_block:=last;
  933. end;
  934. function statement : ptree;
  935. var
  936. p : ptree;
  937. code : ptree;
  938. labelnr : pasmlabel;
  939. filepos : tfileposinfo;
  940. sr : plabelsym;
  941. label
  942. ready;
  943. begin
  944. filepos:=tokenpos;
  945. case token of
  946. _GOTO : begin
  947. if not(cs_support_goto in aktmoduleswitches)then
  948. Message(sym_e_goto_and_label_not_supported);
  949. consume(_GOTO);
  950. if (token<>_INTCONST) and (token<>_ID) then
  951. begin
  952. Message(sym_e_label_not_found);
  953. code:=genzeronode(errorn);
  954. end
  955. else
  956. begin
  957. getsym(pattern,true);
  958. consume(token);
  959. if srsym^.typ<>labelsym then
  960. begin
  961. Message(sym_e_id_is_no_label_id);
  962. code:=genzeronode(errorn);
  963. end
  964. else
  965. begin
  966. code:=genlabelnode(goton,plabelsym(srsym)^.lab);
  967. code^.labsym:=plabelsym(srsym);
  968. { set flag that this label is used }
  969. plabelsym(srsym)^.used:=true;
  970. end;
  971. end;
  972. end;
  973. _BEGIN : code:=statement_block(_BEGIN);
  974. _IF : code:=if_statement;
  975. _CASE : code:=case_statement;
  976. _REPEAT : code:=repeat_statement;
  977. _WHILE : code:=while_statement;
  978. _FOR : code:=for_statement;
  979. _NEW,_DISPOSE : code:=new_dispose_statement;
  980. _WITH : code:=with_statement;
  981. _TRY : code:=try_statement;
  982. _RAISE : code:=raise_statement;
  983. { semicolons,else until and end are ignored }
  984. _SEMICOLON,
  985. _ELSE,
  986. _UNTIL,
  987. _END:
  988. code:=genzeronode(niln);
  989. _FAIL : begin
  990. { internalerror(100); }
  991. if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
  992. Message(parser_e_fail_only_in_constructor);
  993. consume(_FAIL);
  994. code:=genzeronode(failn);
  995. end;
  996. _EXIT : code:=exit_statement;
  997. _ASM : begin
  998. code:=_asm_statement;
  999. end;
  1000. _EOF : begin
  1001. Message(scan_f_end_of_file);
  1002. end;
  1003. else
  1004. begin
  1005. if (token in [_INTCONST,_ID]) then
  1006. begin
  1007. getsym(pattern,true);
  1008. lastsymknown:=true;
  1009. lastsrsym:=srsym;
  1010. { it is NOT necessarily the owner
  1011. it can be a withsymtable !!! }
  1012. lastsrsymtable:=srsymtable;
  1013. if assigned(srsym) and (srsym^.typ=labelsym) then
  1014. begin
  1015. consume(token);
  1016. consume(_COLON);
  1017. { we must preserve srsym to set code later }
  1018. sr:=plabelsym(srsym);
  1019. if sr^.defined then
  1020. Message(sym_e_label_already_defined);
  1021. sr^.defined:=true;
  1022. { statement modifies srsym }
  1023. labelnr:=sr^.lab;
  1024. lastsymknown:=false;
  1025. { the pointer to the following instruction }
  1026. { isn't a very clean way }
  1027. code:=gensinglenode(labeln,statement{$ifndef tp}(){$endif});
  1028. code^.labelnr:=labelnr;
  1029. sr^.code:=code;
  1030. { sorry, but there is a jump the easiest way }
  1031. goto ready;
  1032. end;
  1033. end;
  1034. p:=expr;
  1035. if not(p^.treetype in [calln,assignn,breakn,inlinen,
  1036. continuen]) then
  1037. Message(cg_e_illegal_expression);
  1038. { specify that we don't use the value returned by the call }
  1039. { Question : can this be also improtant
  1040. for inlinen ??
  1041. it is used for :
  1042. - dispose of temp stack space
  1043. - dispose on FPU stack }
  1044. if p^.treetype=calln then
  1045. p^.return_value_used:=false;
  1046. code:=p;
  1047. end;
  1048. end;
  1049. ready:
  1050. if assigned(code) then
  1051. set_tree_filepos(code,filepos);
  1052. statement:=code;
  1053. end;
  1054. function block(islibrary : boolean) : ptree;
  1055. var
  1056. funcretsym : pfuncretsym;
  1057. storepos : tfileposinfo;
  1058. begin
  1059. if procinfo^.returntype.def<>pdef(voiddef) then
  1060. begin
  1061. { if the current is a function aktprocsym is non nil }
  1062. { and there is a local symtable set }
  1063. storepos:=tokenpos;
  1064. tokenpos:=aktprocsym^.fileinfo;
  1065. funcretsym:=new(pfuncretsym,init(aktprocsym^.name,procinfo));
  1066. { insert in local symtable }
  1067. symtablestack^.insert(funcretsym);
  1068. tokenpos:=storepos;
  1069. if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
  1070. procinfo^.return_offset:=-funcretsym^.address;
  1071. procinfo^.funcretsym:=funcretsym;
  1072. { insert result also if support is on }
  1073. if (m_result in aktmodeswitches) then
  1074. begin
  1075. procinfo^.resultfuncretsym:=new(pfuncretsym,init('RESULT',procinfo));
  1076. symtablestack^.insert(procinfo^.resultfuncretsym);
  1077. end;
  1078. end;
  1079. read_declarations(islibrary);
  1080. { temporary space is set, while the BEGIN of the procedure }
  1081. if (symtablestack^.symtabletype=localsymtable) then
  1082. procinfo^.firsttemp_offset := -symtablestack^.datasize
  1083. else
  1084. procinfo^.firsttemp_offset := 0;
  1085. { space for the return value }
  1086. { !!!!! this means that we can not set the return value
  1087. in a subfunction !!!!! }
  1088. { because we don't know yet where the address is }
  1089. if procinfo^.returntype.def<>pdef(voiddef) then
  1090. begin
  1091. if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
  1092. { if (procinfo^.retdef^.deftype=orddef) or
  1093. (procinfo^.retdef^.deftype=pointerdef) or
  1094. (procinfo^.retdef^.deftype=enumdef) or
  1095. (procinfo^.retdef^.deftype=procvardef) or
  1096. (procinfo^.retdef^.deftype=floatdef) or
  1097. (
  1098. (procinfo^.retdef^.deftype=setdef) and
  1099. (psetdef(procinfo^.retdef)^.settype=smallset)
  1100. ) then }
  1101. begin
  1102. { the space has been set in the local symtable }
  1103. procinfo^.return_offset:=-funcretsym^.address;
  1104. if ((procinfo^.flags and pi_operator)<>0) and
  1105. assigned(opsym) then
  1106. {opsym^.address:=procinfo^.para_offset; is wrong PM }
  1107. opsym^.address:=-procinfo^.return_offset;
  1108. { eax is modified by a function }
  1109. {$ifndef newcg}
  1110. {$ifdef i386}
  1111. usedinproc:=usedinproc or ($80 shr byte(R_EAX));
  1112. if is_64bitint(procinfo^.returntype.def) then
  1113. usedinproc:=usedinproc or ($80 shr byte(R_EDX))
  1114. {$endif}
  1115. {$ifdef m68k}
  1116. usedinproc:=usedinproc or ($800 shr word(R_D0));
  1117. if is_64bitint(procinfo^.retdef) then
  1118. usedinproc:=usedinproc or ($800 shr byte(R_D1))
  1119. {$endif}
  1120. {$endif newcg}
  1121. end;
  1122. end;
  1123. {Unit initialization?.}
  1124. if (lexlevel=unit_init_level) and (current_module^.is_unit)
  1125. or islibrary then
  1126. begin
  1127. if (token=_END) then
  1128. begin
  1129. consume(_END);
  1130. { We need at least a node, else the entry/exit code is not
  1131. generated and thus no PASCALMAIN symbol which we need (PFV) }
  1132. if islibrary then
  1133. block:=genzeronode(nothingn)
  1134. else
  1135. block:=nil;
  1136. end
  1137. else
  1138. begin
  1139. if token=_INITIALIZATION then
  1140. begin
  1141. current_module^.flags:=current_module^.flags or uf_init;
  1142. block:=statement_block(_INITIALIZATION);
  1143. end
  1144. else if (token=_FINALIZATION) then
  1145. begin
  1146. if (current_module^.flags and uf_finalize)<>0 then
  1147. block:=statement_block(_FINALIZATION)
  1148. else
  1149. begin
  1150. { can we allow no INITIALIZATION for DLL ??
  1151. I think it should work PM }
  1152. block:=nil;
  1153. exit;
  1154. end;
  1155. end
  1156. else
  1157. begin
  1158. current_module^.flags:=current_module^.flags or uf_init;
  1159. block:=statement_block(_BEGIN);
  1160. end;
  1161. end;
  1162. end
  1163. else
  1164. block:=statement_block(_BEGIN);
  1165. end;
  1166. function assembler_block : ptree;
  1167. begin
  1168. read_declarations(false);
  1169. { temporary space is set, while the BEGIN of the procedure }
  1170. if symtablestack^.symtabletype=localsymtable then
  1171. procinfo^.firsttemp_offset := -symtablestack^.datasize
  1172. else
  1173. procinfo^.firsttemp_offset := 0;
  1174. { assembler code does not allocate }
  1175. { space for the return value }
  1176. if procinfo^.returntype.def<>pdef(voiddef) then
  1177. begin
  1178. if ret_in_acc(procinfo^.returntype.def) then
  1179. begin
  1180. { in assembler code the result should be directly in %eax
  1181. procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef^.size;
  1182. procinfo^.firsttemp:=procinfo^.retoffset; }
  1183. {$ifndef newcg}
  1184. {$ifdef i386}
  1185. usedinproc:=usedinproc or ($80 shr byte(R_EAX))
  1186. {$endif}
  1187. {$ifdef m68k}
  1188. usedinproc:=usedinproc or ($800 shr word(R_D0))
  1189. {$endif}
  1190. {$endif newcg}
  1191. end
  1192. {
  1193. else if not is_fpu(procinfo^.retdef) then
  1194. should we allow assembler functions of big elements ?
  1195. YES (FK)!!
  1196. Message(parser_e_asm_incomp_with_function_return);
  1197. }
  1198. end;
  1199. { set the framepointer to esp for assembler functions }
  1200. { but only if the are no local variables }
  1201. { added no parameter also (PM) }
  1202. { disable for methods, because self pointer is expected }
  1203. { at -8(%ebp) (JM) }
  1204. if not(assigned(procinfo^._class)) and
  1205. (po_assembler in aktprocsym^.definition^.procoptions) and
  1206. (aktprocsym^.definition^.localst^.datasize=0) and
  1207. (aktprocsym^.definition^.parast^.datasize=0) and
  1208. not(ret_in_param(aktprocsym^.definition^.rettype.def)) then
  1209. begin
  1210. procinfo^.framepointer:=stack_pointer;
  1211. { set the right value for parameters }
  1212. dec(aktprocsym^.definition^.parast^.address_fixup,target_os.size_of_pointer);
  1213. dec(procinfo^.para_offset,target_os.size_of_pointer);
  1214. end;
  1215. { force the asm statement }
  1216. if token<>_ASM then
  1217. consume(_ASM);
  1218. procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
  1219. assembler_block:=_asm_statement;
  1220. { becuase the END is already read we need to get the
  1221. last_endtoken_filepos here (PFV) }
  1222. last_endtoken_filepos:=tokenpos;
  1223. end;
  1224. end.
  1225. {
  1226. $Log$
  1227. Revision 1.123 2000-02-29 23:59:47 pierre
  1228. Use $GOTO ON
  1229. Revision 1.122 2000/02/09 13:22:59 peter
  1230. * log truncated
  1231. Revision 1.121 2000/01/23 16:33:49 peter
  1232. * fixed destructor parsing with preprocessor things
  1233. * support dipsoe(p,done())
  1234. * fixed constructor message with dispose(p,<nonexist>)
  1235. Revision 1.120 2000/01/16 22:17:12 peter
  1236. * renamed call_offset to para_offset
  1237. Revision 1.119 2000/01/12 10:30:50 peter
  1238. * fixed library with only end.
  1239. Revision 1.118 2000/01/07 01:14:31 peter
  1240. * updated copyright to 2000
  1241. Revision 1.117 1999/12/22 01:01:52 peter
  1242. - removed freelabel()
  1243. * added undefined label detection in internal assembler, this prevents
  1244. a lot of ld crashes and wrong .o files
  1245. * .o files aren't written anymore if errors have occured
  1246. * inlining of assembler labels is now correct
  1247. Revision 1.116 1999/12/14 09:58:42 florian
  1248. + compiler checks now if a goto leaves an exception block
  1249. Revision 1.115 1999/12/01 22:43:17 peter
  1250. * fixed sigsegv with casedef=nil
  1251. Revision 1.114 1999/12/01 12:42:32 peter
  1252. * fixed bug 698
  1253. * removed some notes about unused vars
  1254. Revision 1.113 1999/11/30 10:40:45 peter
  1255. + ttype, tsymlist
  1256. Revision 1.112 1999/11/20 01:19:10 pierre
  1257. * DLL index used for win32 target with DEF file
  1258. + DLL initialization/finalization support
  1259. Revision 1.111 1999/11/18 15:34:48 pierre
  1260. * Notes/Hints for local syms changed to
  1261. Set_varstate function
  1262. Revision 1.110 1999/11/17 17:05:02 pierre
  1263. * Notes/hints changes
  1264. Revision 1.109 1999/11/15 22:00:48 peter
  1265. * labels used but not defined give error instead of warning, the warning
  1266. is now only with declared but not defined and not used.
  1267. Revision 1.108 1999/11/10 00:24:02 pierre
  1268. * more browser details
  1269. Revision 1.107 1999/11/09 13:02:46 peter
  1270. * fixed 'raise end;'
  1271. Revision 1.106 1999/11/06 14:34:23 peter
  1272. * truncated log to 20 revs
  1273. Revision 1.105 1999/10/22 10:39:35 peter
  1274. * split type reading from pdecl to ptype unit
  1275. * parameter_dec routine is now used for procedure and procvars
  1276. Revision 1.104 1999/10/14 14:57:54 florian
  1277. - removed the hcodegen use in the new cg, use cgbase instead
  1278. Revision 1.103 1999/09/27 23:44:56 peter
  1279. * procinfo is now a pointer
  1280. * support for result setting in sub procedure
  1281. Revision 1.102 1999/09/16 23:05:54 florian
  1282. * m68k compiler is again compilable (only gas writer, no assembler reader)
  1283. }