pass_2.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. This unit handles the codegeneration pass
  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 TP}
  19. {$E+,F+,N+}
  20. {$endif}
  21. unit pass_2;
  22. interface
  23. uses
  24. tree;
  25. { produces assembler for the expression in variable p }
  26. { and produces an assembler node at the end }
  27. procedure generatecode(var p : ptree);
  28. { produces the actual code }
  29. function do_secondpass(var p : ptree) : boolean;
  30. procedure secondpass(var p : ptree);
  31. implementation
  32. uses
  33. globtype,systems,
  34. cobjects,comphook,verbose,globals,files,
  35. symconst,symtable,types,aasm,scanner,
  36. pass_1,hcodegen,temp_gen,cpubase,cpuasm
  37. {$ifdef GDB}
  38. ,gdb
  39. {$endif}
  40. {$ifdef i386}
  41. ,tgeni386,cgai386
  42. ,cg386con,cg386mat,cg386cnv,cg386set,cg386add
  43. ,cg386mem,cg386cal,cg386ld,cg386flw,cg386inl
  44. {$endif}
  45. {$ifdef m68k}
  46. ,tgen68k,cga68k
  47. ,cg68kcon,cg68kmat,cg68kcnv,cg68kset,cg68kadd
  48. ,cg68kmem,cg68kcal,cg68kld,cg68kflw,cg68kinl
  49. {$endif}
  50. ;
  51. {*****************************************************************************
  52. SecondPass
  53. *****************************************************************************}
  54. type
  55. secondpassproc = procedure(var p : ptree);
  56. procedure secondnothing(var p : ptree);
  57. begin
  58. end;
  59. procedure seconderror(var p : ptree);
  60. begin
  61. p^.error:=true;
  62. codegenerror:=true;
  63. end;
  64. procedure secondstatement(var p : ptree);
  65. var
  66. hp : ptree;
  67. begin
  68. hp:=p;
  69. while assigned(hp) do
  70. begin
  71. if assigned(hp^.right) then
  72. begin
  73. cleartempgen;
  74. {!!!!!!
  75. oldrl:=temptoremove;
  76. temptoremove:=new(plinkedlist,init);
  77. }
  78. secondpass(hp^.right);
  79. { !!!!!!!
  80. some temporary data which can't be released elsewhere
  81. removetemps(exprasmlist,temptoremove);
  82. dispose(temptoremove,done);
  83. temptoremove:=oldrl;
  84. }
  85. end;
  86. hp:=hp^.left;
  87. end;
  88. end;
  89. procedure secondblockn(var p : ptree);
  90. begin
  91. { do second pass on left node }
  92. if assigned(p^.left) then
  93. secondpass(p^.left);
  94. end;
  95. procedure secondasm(var p : ptree);
  96. var
  97. hp,hp2 : pai;
  98. localfixup,parafixup,
  99. i : longint;
  100. r : preference;
  101. begin
  102. if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  103. begin
  104. localfixup:=aktprocsym^.definition^.localst^.address_fixup;
  105. parafixup:=aktprocsym^.definition^.parast^.address_fixup;
  106. hp:=pai(p^.p_asm^.first);
  107. while assigned(hp) do
  108. begin
  109. hp2:=pai(hp^.getcopy);
  110. case hp2^.typ of
  111. ait_instruction :
  112. begin
  113. { fixup the references }
  114. for i:=1 to pai386(hp2)^.ops do
  115. if pai386(hp2)^.oper[i-1].typ=top_ref then
  116. begin
  117. r:=pai386(hp2)^.oper[i-1].ref;
  118. case r^.options of
  119. ref_parafixup :
  120. r^.offsetfixup:=parafixup;
  121. ref_localfixup :
  122. r^.offsetfixup:=localfixup;
  123. end;
  124. end;
  125. exprasmlist^.concat(hp2);
  126. end;
  127. ait_marker :
  128. begin
  129. { it's not an assembler block anymore }
  130. if not(pai_marker(hp2)^.kind in [AsmBlockStart, AsmBlockEnd]) then
  131. exprasmlist^.concat(hp2);
  132. end;
  133. else
  134. exprasmlist^.concat(hp2);
  135. end;
  136. hp:=pai(hp^.next);
  137. end
  138. end
  139. else
  140. exprasmlist^.concatlist(p^.p_asm);
  141. if not p^.object_preserved then
  142. begin
  143. {$ifdef i386}
  144. maybe_loadesi;
  145. {$endif}
  146. {$ifdef m68k}
  147. maybe_loada5;
  148. {$endif}
  149. end;
  150. end;
  151. procedure secondpass(var p : ptree);
  152. const
  153. procedures : array[ttreetyp] of secondpassproc =
  154. (secondadd, {addn}
  155. secondadd, {muln}
  156. secondadd, {subn}
  157. secondmoddiv, {divn}
  158. secondadd, {symdifn}
  159. secondmoddiv, {modn}
  160. secondassignment, {assignn}
  161. secondload, {loadn}
  162. secondnothing, {range}
  163. secondadd, {ltn}
  164. secondadd, {lten}
  165. secondadd, {gtn}
  166. secondadd, {gten}
  167. secondadd, {equaln}
  168. secondadd, {unequaln}
  169. secondin, {inn}
  170. secondadd, {orn}
  171. secondadd, {xorn}
  172. secondshlshr, {shrn}
  173. secondshlshr, {shln}
  174. secondadd, {slashn}
  175. secondadd, {andn}
  176. secondsubscriptn, {subscriptn}
  177. secondderef, {derefn}
  178. secondaddr, {addrn}
  179. seconddoubleaddr, {doubleaddrn}
  180. secondordconst, {ordconstn}
  181. secondtypeconv, {typeconvn}
  182. secondcalln, {calln}
  183. secondnothing, {callparan}
  184. secondrealconst, {realconstn}
  185. secondfixconst, {fixconstn}
  186. secondumminus, {umminusn}
  187. secondasm, {asmn}
  188. secondvecn, {vecn}
  189. secondstringconst, {stringconstn}
  190. secondfuncret, {funcretn}
  191. secondselfn, {selfn}
  192. secondnot, {notn}
  193. secondinline, {inlinen}
  194. secondniln, {niln}
  195. seconderror, {errorn}
  196. secondnothing, {typen}
  197. secondhnewn, {hnewn}
  198. secondhdisposen, {hdisposen}
  199. secondnewn, {newn}
  200. secondsimplenewdispose, {simpledisposen}
  201. secondsetelement, {setelementn}
  202. secondsetconst, {setconstn}
  203. secondblockn, {blockn}
  204. secondstatement, {statementn}
  205. secondnothing, {loopn}
  206. secondifn, {ifn}
  207. secondbreakn, {breakn}
  208. secondcontinuen, {continuen}
  209. second_while_repeatn, {repeatn}
  210. second_while_repeatn, {whilen}
  211. secondfor, {forn}
  212. secondexitn, {exitn}
  213. secondwith, {withn}
  214. secondcase, {casen}
  215. secondlabel, {labeln}
  216. secondgoto, {goton}
  217. secondsimplenewdispose, {simplenewn}
  218. secondtryexcept, {tryexceptn}
  219. secondraise, {raisen}
  220. secondnothing, {switchesn}
  221. secondtryfinally, {tryfinallyn}
  222. secondon, {onn}
  223. secondis, {isn}
  224. secondas, {asn}
  225. seconderror, {caretn}
  226. secondfail, {failn}
  227. secondadd, {starstarn}
  228. secondprocinline, {procinlinen}
  229. secondarrayconstruct, {arrayconstructn}
  230. secondnothing, {arrayconstructrangen}
  231. secondnothing, {nothingn}
  232. secondloadvmt {loadvmtn}
  233. );
  234. var
  235. oldcodegenerror : boolean;
  236. oldlocalswitches : tlocalswitches;
  237. oldpos : tfileposinfo;
  238. {$ifdef TEMPREGDEBUG}
  239. prevp : pptree;
  240. {$endif TEMPREGDEBUG}
  241. begin
  242. if not(p^.error) then
  243. begin
  244. oldcodegenerror:=codegenerror;
  245. oldlocalswitches:=aktlocalswitches;
  246. oldpos:=aktfilepos;
  247. testregisters32;
  248. {$ifdef TEMPREGDEBUG}
  249. prevp:=curptree;
  250. curptree:=@p;
  251. p^.usableregs:=usablereg32;
  252. {$endif TEMPREGDEBUG}
  253. aktfilepos:=p^.fileinfo;
  254. aktlocalswitches:=p^.localswitches;
  255. codegenerror:=false;
  256. procedures[p^.treetype](p);
  257. p^.error:=codegenerror;
  258. codegenerror:=codegenerror or oldcodegenerror;
  259. aktlocalswitches:=oldlocalswitches;
  260. aktfilepos:=oldpos;
  261. {$ifdef TEMPREGDEBUG}
  262. curptree:=prevp;
  263. {$endif TEMPREGDEBUG}
  264. end
  265. else
  266. codegenerror:=true;
  267. end;
  268. function do_secondpass(var p : ptree) : boolean;
  269. begin
  270. codegenerror:=false;
  271. if not(p^.error) then
  272. secondpass(p);
  273. do_secondpass:=codegenerror;
  274. end;
  275. var
  276. { the array ranges are oveestimated !!! }
  277. { max(maxvarregs,maxfpuvarregs) would be }
  278. { enough }
  279. regvars : array[1..maxvarregs+maxfpuvarregs] of pvarsym;
  280. regvars_para : array[1..maxvarregs+maxfpuvarregs] of boolean;
  281. regvars_refs : array[1..maxvarregs+maxfpuvarregs] of longint;
  282. parasym : boolean;
  283. procedure searchregvars(p : pnamedindexobject);
  284. var
  285. i,j,k : longint;
  286. begin
  287. if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
  288. begin
  289. { walk through all momentary register variables }
  290. for i:=1 to maxvarregs do
  291. begin
  292. { free register ? }
  293. if regvars[i]=nil then
  294. begin
  295. regvars[i]:=pvarsym(p);
  296. regvars_para[i]:=parasym;
  297. break;
  298. end;
  299. { else throw out a variable ? }
  300. j:=pvarsym(p)^.refs;
  301. { parameter get a less value }
  302. if parasym then
  303. begin
  304. if cs_littlesize in aktglobalswitches then
  305. dec(j,1)
  306. else
  307. dec(j,100);
  308. end;
  309. if (j>regvars_refs[i]) and (j>0) then
  310. begin
  311. for k:=maxvarregs-1 downto i do
  312. begin
  313. regvars[k+1]:=regvars[k];
  314. regvars_para[k+1]:=regvars_para[k];
  315. end;
  316. { calc the new refs
  317. pvarsym(p)^.refs:=j; }
  318. regvars[i]:=pvarsym(p);
  319. regvars_para[i]:=parasym;
  320. regvars_refs[i]:=j;
  321. break;
  322. end;
  323. end;
  324. end;
  325. end;
  326. procedure searchfpuregvars(p : pnamedindexobject);
  327. var
  328. i,j,k : longint;
  329. begin
  330. if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
  331. begin
  332. { walk through all momentary register variables }
  333. for i:=1 to maxfpuvarregs do
  334. begin
  335. { free register ? }
  336. if regvars[i]=nil then
  337. begin
  338. regvars[i]:=pvarsym(p);
  339. regvars_para[i]:=parasym;
  340. break;
  341. end;
  342. { else throw out a variable ? }
  343. j:=pvarsym(p)^.refs;
  344. { parameter get a less value }
  345. if parasym then
  346. begin
  347. if cs_littlesize in aktglobalswitches then
  348. dec(j,1)
  349. else
  350. dec(j,100);
  351. end;
  352. if (j>regvars_refs[i]) and (j>0) then
  353. begin
  354. for k:=maxfpuvarregs-1 downto i do
  355. begin
  356. regvars[k+1]:=regvars[k];
  357. regvars_para[k+1]:=regvars_para[k];
  358. end;
  359. { calc the new refs
  360. pvarsym(p)^.refs:=j; }
  361. regvars[i]:=pvarsym(p);
  362. regvars_para[i]:=parasym;
  363. regvars_refs[i]:=j;
  364. break;
  365. end;
  366. end;
  367. end;
  368. end;
  369. procedure generatecode(var p : ptree);
  370. var
  371. i : longint;
  372. regsize : topsize;
  373. hr : preference;
  374. label
  375. nextreg;
  376. begin
  377. {!!!!!!!! temptoremove:=nil; }
  378. cleartempgen;
  379. { when size optimization only count occurrence }
  380. if cs_littlesize in aktglobalswitches then
  381. t_times:=1
  382. else
  383. { reference for repetition is 100 }
  384. t_times:=100;
  385. { clear register count }
  386. clearregistercount;
  387. use_esp_stackframe:=false;
  388. if not(do_firstpass(p)) then
  389. begin
  390. { max. optimizations }
  391. { only if no asm is used }
  392. { and no try statement }
  393. if (cs_regalloc in aktglobalswitches) and
  394. ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  395. begin
  396. { can we omit the stack frame ? }
  397. { conditions:
  398. 1. procedure (not main block)
  399. 2. no constructor or destructor
  400. 3. no call to other procedures
  401. 4. no interrupt handler
  402. }
  403. {!!!!!! this doesn work yet, because of problems with
  404. with linux and windows
  405. }
  406. (*
  407. if assigned(aktprocsym) then
  408. begin
  409. if not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
  410. not(po_interrupt in aktprocsym^.definition^.procoptions) and
  411. ((procinfo.flags and pi_do_call)=0) and
  412. (lexlevel>=normal_function_level) then
  413. begin
  414. { use ESP as frame pointer }
  415. procinfo.framepointer:=stack_pointer;
  416. use_esp_stackframe:=true;
  417. { calc parameter distance new }
  418. dec(procinfo.framepointer_offset,4);
  419. dec(procinfo.ESI_offset,4);
  420. { is this correct ???}
  421. { retoffset can be negativ for results in eax !! }
  422. { the value should be decreased only if positive }
  423. if procinfo.retoffset>=0 then
  424. dec(procinfo.retoffset,4);
  425. dec(procinfo.call_offset,4);
  426. aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
  427. end;
  428. end;
  429. *)
  430. if (p^.registers32<4) then
  431. begin
  432. for i:=1 to maxvarregs do
  433. regvars[i]:=nil;
  434. parasym:=false;
  435. symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
  436. { copy parameter into a register ? }
  437. parasym:=true;
  438. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  439. { hold needed registers free }
  440. for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  441. regvars[i]:=nil;
  442. { now assign register }
  443. for i:=1 to maxvarregs-p^.registers32 do
  444. begin
  445. if assigned(regvars[i]) then
  446. begin
  447. { it is nonsens, to copy the variable to }
  448. { a register because we need then much }
  449. { too pushes ? }
  450. if reg_pushes[varregs[i]]>=regvars[i]^.refs then
  451. begin
  452. regvars[i]:=nil;
  453. goto nextreg;
  454. end;
  455. { register is no longer available for }
  456. { expressions }
  457. { search the register which is the most }
  458. { unused }
  459. usableregs:=usableregs-[varregs[i]];
  460. {$ifdef i386}
  461. procinfo.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
  462. {$endif i386}
  463. is_reg_var[varregs[i]]:=true;
  464. dec(c_usableregs);
  465. { possibly no 32 bit register are needed }
  466. { call by reference/const ? }
  467. if (regvars[i]^.varspez=vs_var) or
  468. ((regvars[i]^.varspez=vs_const) and
  469. push_addr_param(regvars[i]^.definition)) then
  470. begin
  471. regvars[i]^.reg:=varregs[i];
  472. regsize:=S_L;
  473. end
  474. else
  475. if (regvars[i]^.definition^.deftype=orddef) and
  476. (porddef(regvars[i]^.definition)^.size=1) then
  477. begin
  478. {$ifdef i386}
  479. regvars[i]^.reg:=reg32toreg8(varregs[i]);
  480. {$endif}
  481. regsize:=S_B;
  482. end
  483. else
  484. if (regvars[i]^.definition^.deftype=orddef) and
  485. (porddef(regvars[i]^.definition)^.size=2) then
  486. begin
  487. {$ifdef i386}
  488. regvars[i]^.reg:=reg32toreg16(varregs[i]);
  489. {$endif}
  490. regsize:=S_W;
  491. end
  492. else
  493. begin
  494. regvars[i]^.reg:=varregs[i];
  495. regsize:=S_L;
  496. end;
  497. { parameter must be load }
  498. if regvars_para[i] then
  499. begin
  500. { procinfo is there actual, }
  501. { because we can't never be in a }
  502. { nested procedure }
  503. { when loading parameter to reg }
  504. new(hr);
  505. reset_reference(hr^);
  506. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  507. hr^.base:=procinfo.framepointer;
  508. {$ifdef i386}
  509. procinfo.aktentrycode^.concat(new(pai386,op_ref_reg(A_MOV,regsize,
  510. hr,regvars[i]^.reg)));
  511. {$endif i386}
  512. {$ifdef m68k}
  513. procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
  514. hr,regvars[i]^.reg)));
  515. {$endif m68k}
  516. unused:=unused - [regvars[i]^.reg];
  517. end;
  518. { procedure uses this register }
  519. {$ifdef i386}
  520. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  521. {$endif i386}
  522. {$ifdef m68k}
  523. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  524. {$endif m68k}
  525. end;
  526. nextreg:
  527. { dummy }
  528. regsize:=S_W;
  529. end;
  530. for i:=1 to maxvarregs do
  531. begin
  532. if assigned(regvars[i]) then
  533. begin
  534. if cs_asm_source in aktglobalswitches then
  535. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  536. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  537. reg2str(regvars[i]^.reg)))));
  538. if (status.verbosity and v_debug)=v_debug then
  539. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  540. tostr(regvars[i]^.refs),regvars[i]^.name);
  541. end;
  542. end;
  543. end;
  544. if (p^.registersfpu<maxfpuvarregs-2) then
  545. begin
  546. for i:=1 to maxfpuvarregs do
  547. regvars[i]:=nil;
  548. parasym:=false;
  549. symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
  550. {$ifdef dummy}
  551. { copy parameter into a register ? }
  552. parasym:=true;
  553. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  554. {$endif dummy}
  555. { hold needed registers free }
  556. for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu+1 do
  557. regvars[i]:=nil;
  558. { now assign register }
  559. for i:=1 to maxfpuvarregs-p^.registersfpu do
  560. begin
  561. if assigned(regvars[i]) then
  562. begin
  563. regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  564. {$ifdef dummy}
  565. { parameter must be load }
  566. if regvars_para[i] then
  567. begin
  568. { procinfo is there actual, }
  569. { because we can't never be in a }
  570. { nested procedure }
  571. { when loading parameter to reg }
  572. new(hr);
  573. reset_reference(hr^);
  574. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  575. hr^.base:=procinfo.framepointer;
  576. {$ifdef i386}
  577. procinfo.aktentrycode^.concat(new(pai386,op_ref_reg(A_MOV,regsize,
  578. hr,regvars[i]^.reg)));
  579. {$endif i386}
  580. {$ifdef m68k}
  581. procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
  582. hr,regvars[i]^.reg)));
  583. {$endif m68k}
  584. end;
  585. {$endif dummy}
  586. end;
  587. end;
  588. if cs_asm_source in aktglobalswitches then
  589. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
  590. ' registers on FPU stack used by temp. expressions'))));
  591. for i:=1 to maxfpuvarregs do
  592. begin
  593. if assigned(regvars[i]) then
  594. begin
  595. if cs_asm_source in aktglobalswitches then
  596. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  597. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  598. reg2str(regvars[i]^.reg)))));
  599. if (status.verbosity and v_debug)=v_debug then
  600. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  601. tostr(regvars[i]^.refs),regvars[i]^.name);
  602. end;
  603. end;
  604. if cs_asm_source in aktglobalswitches then
  605. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  606. end;
  607. end;
  608. if assigned(aktprocsym) and
  609. (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  610. make_const_global:=true;
  611. do_secondpass(p);
  612. if assigned(procinfo.def) then
  613. procinfo.def^.fpu_used:=p^.registersfpu;
  614. { all registers can be used again }
  615. resetusableregisters;
  616. end;
  617. procinfo.aktproccode^.concatlist(exprasmlist);
  618. make_const_global:=false;
  619. end;
  620. end.
  621. {
  622. $Log$
  623. Revision 1.32 1999-08-23 23:25:59 pierre
  624. + TEMPREGDEBUG code, test of register allocation
  625. if a tree uses more than registers32 regs then
  626. internalerror(10) is issued
  627. + EXTTEMPREGDEBUG will also give internalerror(10) if
  628. a same register is freed twice (happens in several part
  629. of current compiler like addn for strings and sets)
  630. Revision 1.31 1999/08/07 14:20:59 florian
  631. * some small problems fixed
  632. Revision 1.30 1999/08/04 14:21:07 florian
  633. * now every available fpu register is used for
  634. fpu register variables
  635. Revision 1.29 1999/08/04 13:45:28 florian
  636. + floating point register variables !!
  637. * pairegalloc is now generated for register variables
  638. Revision 1.28 1999/08/04 00:23:10 florian
  639. * renamed i386asm and i386base to cpuasm and cpubase
  640. Revision 1.27 1999/08/03 22:02:55 peter
  641. * moved bitmask constants to sets
  642. * some other type/const renamings
  643. Revision 1.26 1999/06/02 22:44:08 pierre
  644. * previous wrong log corrected
  645. Revision 1.25 1999/06/02 22:25:41 pierre
  646. * changed $ifdef FPC @ into $ifndef TP
  647. Revision 1.24 1999/06/01 14:45:50 peter
  648. * @procvar is now always needed for FPC
  649. Revision 1.23 1999/05/27 19:44:43 peter
  650. * removed oldasm
  651. * plabel -> pasmlabel
  652. * -a switches to source writing automaticly
  653. * assembler readers OOPed
  654. * asmsymbol automaticly external
  655. * jumptables and other label fixes for asm readers
  656. Revision 1.22 1999/05/18 14:15:50 peter
  657. * containsself fixes
  658. * checktypes()
  659. Revision 1.21 1999/05/17 21:57:11 florian
  660. * new temporary ansistring handling
  661. Revision 1.20 1999/05/02 21:33:54 florian
  662. * several bugs regarding -Or fixed
  663. Revision 1.19 1999/05/01 13:24:28 peter
  664. * merged nasm compiler
  665. * old asm moved to oldasm/
  666. Revision 1.18 1999/04/28 06:02:04 florian
  667. * changes of Bruessel:
  668. + message handler can now take an explicit self
  669. * typinfo fixed: sometimes the type names weren't written
  670. * the type checking for pointer comparisations and subtraction
  671. and are now more strict (was also buggy)
  672. * small bug fix to link.pas to support compiling on another
  673. drive
  674. * probable bug in popt386 fixed: call/jmp => push/jmp
  675. transformation didn't count correctly the jmp references
  676. + threadvar support
  677. * warning if ln/sqrt gets an invalid constant argument
  678. Revision 1.17 1999/03/31 13:55:11 peter
  679. * assembler inlining working for ag386bin
  680. Revision 1.16 1999/03/24 23:17:11 peter
  681. * fixed bugs 212,222,225,227,229,231,233
  682. Revision 1.15 1999/02/22 02:15:25 peter
  683. * updates for ag386bin
  684. Revision 1.14 1999/01/23 23:29:37 florian
  685. * first running version of the new code generator
  686. * when compiling exceptions under Linux fixed
  687. Revision 1.13 1998/12/30 13:41:09 peter
  688. * released valuepara
  689. Revision 1.12 1998/12/19 00:23:51 florian
  690. * ansistring memory leaks fixed
  691. Revision 1.11 1998/12/11 00:03:28 peter
  692. + globtype,tokens,version unit splitted from globals
  693. Revision 1.10 1998/11/18 15:44:14 peter
  694. * VALUEPARA for tp7 compatible value parameters
  695. Revision 1.9 1998/11/13 15:40:21 pierre
  696. + added -Se in Makefile cvstest target
  697. + lexlevel cleanup
  698. normal_function_level main_program_level and unit_init_level defined
  699. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  700. (test added in code !)
  701. * -Un option was wrong
  702. * _FAIL and _SELF only keyword inside
  703. constructors and methods respectively
  704. Revision 1.8 1998/10/29 15:42:49 florian
  705. + partial disposing of temp. ansistrings
  706. Revision 1.7 1998/10/26 22:58:19 florian
  707. * new introduded problem with classes fix, the parent class wasn't set
  708. correct, if the class was defined forward before
  709. Revision 1.6 1998/09/23 09:58:52 peter
  710. * first working array of const things
  711. Revision 1.5 1998/09/21 10:01:06 peter
  712. * check if procinfo.def is assigned before storing registersfpu
  713. Revision 1.4 1998/09/21 08:45:16 pierre
  714. + added vmt_offset in tobjectdef.write for fututre use
  715. (first steps to have objects without vmt if no virtual !!)
  716. + added fpu_used field for tabstractprocdef :
  717. sets this level to 2 if the functions return with value in FPU
  718. (is then set to correct value at parsing of implementation)
  719. THIS MIGHT refuse some code with FPU expression too complex
  720. that were accepted before and even in some cases
  721. that don't overflow in fact
  722. ( like if f : float; is a forward that finally in implementation
  723. only uses one fpu register !!)
  724. Nevertheless I think that it will improve security on
  725. FPU operations !!
  726. * most other changes only for UseBrowser code
  727. (added symtable references for record and objects)
  728. local switch for refs to args and local of each function
  729. (static symtable still missing)
  730. UseBrowser still not stable and probably broken by
  731. the definition hash array !!
  732. Revision 1.3 1998/09/17 09:42:40 peter
  733. + pass_2 for cg386
  734. * Message() -> CGMessage() for pass_1/pass_2
  735. Revision 1.2 1998/09/07 18:46:07 peter
  736. * update smartlinking, uses getdatalabel
  737. * renamed ptree.value vars to value_str,value_real,value_set
  738. Revision 1.1 1998/09/01 09:07:12 peter
  739. * m68k fixes, splitted cg68k like cgi386
  740. }