pass_2.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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. {$ifndef newcg}
  38. ,tcflw
  39. {$endif newcg}
  40. {$ifdef GDB}
  41. ,gdb
  42. {$endif}
  43. {$ifdef i386}
  44. ,tgeni386,cgai386
  45. ,cg386con,cg386mat,cg386cnv,cg386set,cg386add
  46. ,cg386mem,cg386cal,cg386ld,cg386flw,cg386inl
  47. {$endif}
  48. {$ifdef m68k}
  49. ,tgen68k,cga68k
  50. ,cg68kcon,cg68kmat,cg68kcnv,cg68kset,cg68kadd
  51. ,cg68kmem,cg68kcal,cg68kld,cg68kflw,cg68kinl
  52. {$endif}
  53. ;
  54. {*****************************************************************************
  55. SecondPass
  56. *****************************************************************************}
  57. type
  58. secondpassproc = procedure(var p : ptree);
  59. procedure secondnothing(var p : ptree);
  60. begin
  61. end;
  62. procedure seconderror(var p : ptree);
  63. begin
  64. p^.error:=true;
  65. codegenerror:=true;
  66. end;
  67. procedure secondstatement(var p : ptree);
  68. var
  69. hp : ptree;
  70. begin
  71. hp:=p;
  72. while assigned(hp) do
  73. begin
  74. if assigned(hp^.right) then
  75. begin
  76. cleartempgen;
  77. {!!!!!!
  78. oldrl:=temptoremove;
  79. temptoremove:=new(plinkedlist,init);
  80. }
  81. secondpass(hp^.right);
  82. { !!!!!!!
  83. some temporary data which can't be released elsewhere
  84. removetemps(exprasmlist,temptoremove);
  85. dispose(temptoremove,done);
  86. temptoremove:=oldrl;
  87. }
  88. end;
  89. hp:=hp^.left;
  90. end;
  91. end;
  92. procedure secondblockn(var p : ptree);
  93. begin
  94. { do second pass on left node }
  95. if assigned(p^.left) then
  96. secondpass(p^.left);
  97. end;
  98. procedure secondasm(var p : ptree);
  99. procedure ReLabel(var p:pasmsymbol);
  100. begin
  101. if p^.proclocal then
  102. begin
  103. if not assigned(p^.altsymbol) then
  104. p^.GenerateAltSymbol;
  105. p:=p^.altsymbol;
  106. end;
  107. end;
  108. var
  109. hp,hp2 : pai;
  110. localfixup,parafixup,
  111. i : longint;
  112. r : preference;
  113. skipnode : boolean;
  114. begin
  115. if inlining_procedure then
  116. begin
  117. localfixup:=aktprocsym^.definition^.localst^.address_fixup;
  118. parafixup:=aktprocsym^.definition^.parast^.address_fixup;
  119. ResetAsmSymbolListAltSymbol;
  120. hp:=pai(p^.p_asm^.first);
  121. while assigned(hp) do
  122. begin
  123. hp2:=pai(hp^.getcopy);
  124. skipnode:=false;
  125. case hp2^.typ of
  126. ait_label :
  127. begin
  128. { regenerate the labels by setting altsymbol }
  129. ReLabel(pai_label(hp2)^.l);
  130. end;
  131. ait_const_rva,
  132. ait_const_symbol :
  133. begin
  134. ReLabel(pai_const_symbol(hp2)^.sym);
  135. end;
  136. ait_instruction :
  137. begin
  138. {$ifdef i386}
  139. { fixup the references }
  140. for i:=1 to paicpu(hp2)^.ops do
  141. case paicpu(hp2)^.oper[i-1].typ of
  142. top_ref :
  143. begin
  144. r:=paicpu(hp2)^.oper[i-1].ref;
  145. case r^.options of
  146. ref_parafixup :
  147. r^.offsetfixup:=parafixup;
  148. ref_localfixup :
  149. r^.offsetfixup:=localfixup;
  150. end;
  151. if assigned(r^.symbol) then
  152. ReLabel(r^.symbol);
  153. end;
  154. top_symbol :
  155. begin
  156. ReLabel(paicpu(hp2)^.oper[i-1].sym);
  157. end;
  158. end;
  159. {$endif i386}
  160. end;
  161. ait_marker :
  162. begin
  163. { it's not an assembler block anymore }
  164. if (pai_marker(hp2)^.kind in [AsmBlockStart, AsmBlockEnd]) then
  165. skipnode:=true;
  166. end;
  167. else
  168. end;
  169. if not skipnode then
  170. exprasmlist^.concat(hp2)
  171. else
  172. dispose(hp2,done);
  173. hp:=pai(hp^.next);
  174. end
  175. end
  176. else
  177. begin
  178. { if the routine is an inline routine, then we must hold a copy
  179. becuase it can be necessary for inlining later }
  180. if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  181. exprasmlist^.concatlistcopy(p^.p_asm)
  182. else
  183. exprasmlist^.concatlist(p^.p_asm);
  184. end;
  185. if not p^.object_preserved then
  186. begin
  187. {$ifdef i386}
  188. maybe_loadesi;
  189. {$endif}
  190. {$ifdef m68k}
  191. maybe_loada5;
  192. {$endif}
  193. end;
  194. end;
  195. procedure secondpass(var p : ptree);
  196. const
  197. procedures : array[ttreetyp] of secondpassproc =
  198. (secondadd, {addn}
  199. secondadd, {muln}
  200. secondadd, {subn}
  201. secondmoddiv, {divn}
  202. secondadd, {symdifn}
  203. secondmoddiv, {modn}
  204. secondassignment, {assignn}
  205. secondload, {loadn}
  206. secondnothing, {range}
  207. secondadd, {ltn}
  208. secondadd, {lten}
  209. secondadd, {gtn}
  210. secondadd, {gten}
  211. secondadd, {equaln}
  212. secondadd, {unequaln}
  213. secondin, {inn}
  214. secondadd, {orn}
  215. secondadd, {xorn}
  216. secondshlshr, {shrn}
  217. secondshlshr, {shln}
  218. secondadd, {slashn}
  219. secondadd, {andn}
  220. secondsubscriptn, {subscriptn}
  221. secondderef, {derefn}
  222. secondaddr, {addrn}
  223. seconddoubleaddr, {doubleaddrn}
  224. secondordconst, {ordconstn}
  225. secondtypeconv, {typeconvn}
  226. secondcalln, {calln}
  227. secondnothing, {callparan}
  228. secondrealconst, {realconstn}
  229. secondfixconst, {fixconstn}
  230. secondunaryminus, {unaryminusn}
  231. secondasm, {asmn}
  232. secondvecn, {vecn}
  233. secondpointerconst, {pointerconstn}
  234. secondstringconst, {stringconstn}
  235. secondfuncret, {funcretn}
  236. secondselfn, {selfn}
  237. secondnot, {notn}
  238. secondinline, {inlinen}
  239. secondniln, {niln}
  240. seconderror, {errorn}
  241. secondnothing, {typen}
  242. secondhnewn, {hnewn}
  243. secondhdisposen, {hdisposen}
  244. secondnewn, {newn}
  245. secondsimplenewdispose, {simpledisposen}
  246. secondsetelement, {setelementn}
  247. secondsetconst, {setconstn}
  248. secondblockn, {blockn}
  249. secondstatement, {statementn}
  250. secondnothing, {loopn}
  251. secondifn, {ifn}
  252. secondbreakn, {breakn}
  253. secondcontinuen, {continuen}
  254. second_while_repeatn, {repeatn}
  255. second_while_repeatn, {whilen}
  256. secondfor, {forn}
  257. secondexitn, {exitn}
  258. secondwith, {withn}
  259. secondcase, {casen}
  260. secondlabel, {labeln}
  261. secondgoto, {goton}
  262. secondsimplenewdispose, {simplenewn}
  263. secondtryexcept, {tryexceptn}
  264. secondraise, {raisen}
  265. secondnothing, {switchesn}
  266. secondtryfinally, {tryfinallyn}
  267. secondon, {onn}
  268. secondis, {isn}
  269. secondas, {asn}
  270. seconderror, {caretn}
  271. secondfail, {failn}
  272. secondadd, {starstarn}
  273. secondprocinline, {procinlinen}
  274. secondarrayconstruct, {arrayconstructn}
  275. secondnothing, {arrayconstructrangen}
  276. secondnothing, {nothingn}
  277. secondloadvmt {loadvmtn}
  278. );
  279. var
  280. oldcodegenerror : boolean;
  281. oldlocalswitches : tlocalswitches;
  282. oldpos : tfileposinfo;
  283. {$ifdef TEMPREGDEBUG}
  284. prevp : pptree;
  285. {$endif TEMPREGDEBUG}
  286. begin
  287. if not(p^.error) then
  288. begin
  289. oldcodegenerror:=codegenerror;
  290. oldlocalswitches:=aktlocalswitches;
  291. oldpos:=aktfilepos;
  292. {$ifdef TEMPREGDEBUG}
  293. testregisters32;
  294. prevp:=curptree;
  295. curptree:=@p;
  296. p^.usableregs:=usablereg32;
  297. {$endif TEMPREGDEBUG}
  298. aktfilepos:=p^.fileinfo;
  299. aktlocalswitches:=p^.localswitches;
  300. codegenerror:=false;
  301. procedures[p^.treetype](p);
  302. p^.error:=codegenerror;
  303. codegenerror:=codegenerror or oldcodegenerror;
  304. aktlocalswitches:=oldlocalswitches;
  305. aktfilepos:=oldpos;
  306. {$ifdef TEMPREGDEBUG}
  307. curptree:=prevp;
  308. {$endif TEMPREGDEBUG}
  309. {$ifdef EXTTEMPREGDEBUG}
  310. if p^.usableregs-usablereg32>p^.reallyusedregs then
  311. p^.reallyusedregs:=p^.usableregs-usablereg32;
  312. if p^.reallyusedregs<p^.registers32 then
  313. Comment(V_Debug,'registers32 overestimated '+tostr(p^.registers32)+
  314. '>'+tostr(p^.reallyusedregs));
  315. {$endif EXTTEMPREGDEBUG}
  316. end
  317. else
  318. codegenerror:=true;
  319. end;
  320. function do_secondpass(var p : ptree) : boolean;
  321. begin
  322. codegenerror:=false;
  323. if not(p^.error) then
  324. secondpass(p);
  325. do_secondpass:=codegenerror;
  326. end;
  327. var
  328. { the array ranges are oveestimated !!! }
  329. { max(maxvarregs,maxfpuvarregs) would be }
  330. { enough }
  331. regvars : array[1..maxvarregs+maxfpuvarregs] of pvarsym;
  332. regvars_para : array[1..maxvarregs+maxfpuvarregs] of boolean;
  333. regvars_refs : array[1..maxvarregs+maxfpuvarregs] of longint;
  334. parasym : boolean;
  335. procedure searchregvars(p : pnamedindexobject);
  336. var
  337. i,j,k : longint;
  338. begin
  339. if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
  340. begin
  341. { walk through all momentary register variables }
  342. for i:=1 to maxvarregs do
  343. begin
  344. { free register ? }
  345. if regvars[i]=nil then
  346. begin
  347. regvars[i]:=pvarsym(p);
  348. regvars_para[i]:=parasym;
  349. break;
  350. end;
  351. { else throw out a variable ? }
  352. j:=pvarsym(p)^.refs;
  353. { parameter get a less value }
  354. if parasym then
  355. begin
  356. if cs_littlesize in aktglobalswitches then
  357. dec(j,1)
  358. else
  359. dec(j,100);
  360. end;
  361. if (j>regvars_refs[i]) and (j>0) then
  362. begin
  363. for k:=maxvarregs-1 downto i do
  364. begin
  365. regvars[k+1]:=regvars[k];
  366. regvars_para[k+1]:=regvars_para[k];
  367. end;
  368. { calc the new refs
  369. pvarsym(p)^.refs:=j; }
  370. regvars[i]:=pvarsym(p);
  371. regvars_para[i]:=parasym;
  372. regvars_refs[i]:=j;
  373. break;
  374. end;
  375. end;
  376. end;
  377. end;
  378. procedure searchfpuregvars(p : pnamedindexobject);
  379. var
  380. i,j,k : longint;
  381. begin
  382. if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
  383. begin
  384. { walk through all momentary register variables }
  385. for i:=1 to maxfpuvarregs do
  386. begin
  387. { free register ? }
  388. if regvars[i]=nil then
  389. begin
  390. regvars[i]:=pvarsym(p);
  391. regvars_para[i]:=parasym;
  392. break;
  393. end;
  394. { else throw out a variable ? }
  395. j:=pvarsym(p)^.refs;
  396. { parameter get a less value }
  397. if parasym then
  398. begin
  399. if cs_littlesize in aktglobalswitches then
  400. dec(j,1)
  401. else
  402. dec(j,100);
  403. end;
  404. if (j>regvars_refs[i]) and (j>0) then
  405. begin
  406. for k:=maxfpuvarregs-1 downto i do
  407. begin
  408. regvars[k+1]:=regvars[k];
  409. regvars_para[k+1]:=regvars_para[k];
  410. end;
  411. { calc the new refs
  412. pvarsym(p)^.refs:=j; }
  413. regvars[i]:=pvarsym(p);
  414. regvars_para[i]:=parasym;
  415. regvars_refs[i]:=j;
  416. break;
  417. end;
  418. end;
  419. end;
  420. end;
  421. procedure generatecode(var p : ptree);
  422. var
  423. i : longint;
  424. regsize : topsize;
  425. hr : preference;
  426. label
  427. nextreg;
  428. begin
  429. {!!!!!!!! temptoremove:=nil; }
  430. cleartempgen;
  431. { when size optimization only count occurrence }
  432. if cs_littlesize in aktglobalswitches then
  433. t_times:=1
  434. else
  435. { reference for repetition is 100 }
  436. t_times:=100;
  437. { clear register count }
  438. clearregistercount;
  439. use_esp_stackframe:=false;
  440. aktexceptblock:=nil;
  441. if not(do_firstpass(p)) then
  442. begin
  443. { max. optimizations }
  444. { only if no asm is used }
  445. { and no try statement }
  446. if (cs_regalloc in aktglobalswitches) and
  447. ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  448. begin
  449. { can we omit the stack frame ? }
  450. { conditions:
  451. 1. procedure (not main block)
  452. 2. no constructor or destructor
  453. 3. no call to other procedures
  454. 4. no interrupt handler
  455. }
  456. {!!!!!! this doesn work yet, because of problems with
  457. with linux and windows
  458. }
  459. (*
  460. if assigned(aktprocsym) then
  461. begin
  462. if not(assigned(procinfo^._class)) and
  463. not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
  464. not(po_interrupt in aktprocsym^.definition^.procoptions) and
  465. ((procinfo^.flags and pi_do_call)=0) and
  466. (lexlevel>=normal_function_level) then
  467. begin
  468. { use ESP as frame pointer }
  469. procinfo^.framepointer:=stack_pointer;
  470. use_esp_stackframe:=true;
  471. { calc parameter distance new }
  472. dec(procinfo^.framepointer_offset,4);
  473. dec(procinfo^.selfpointer_offset,4);
  474. { is this correct ???}
  475. { retoffset can be negativ for results in eax !! }
  476. { the value should be decreased only if positive }
  477. if procinfo^.retoffset>=0 then
  478. dec(procinfo^.retoffset,4);
  479. dec(procinfo^.call_offset,4);
  480. aktprocsym^.definition^.parast^.address_fixup:=procinfo^.call_offset;
  481. end;
  482. end;
  483. *)
  484. { $ifdef dummy}
  485. if (p^.registers32<4) then
  486. begin
  487. for i:=1 to maxvarregs do
  488. regvars[i]:=nil;
  489. parasym:=false;
  490. symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
  491. { copy parameter into a register ? }
  492. parasym:=true;
  493. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  494. { hold needed registers free }
  495. for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  496. regvars[i]:=nil;
  497. { now assign register }
  498. for i:=1 to maxvarregs-p^.registers32 do
  499. begin
  500. if assigned(regvars[i]) then
  501. begin
  502. { it is nonsens, to copy the variable to }
  503. { a register because we need then much }
  504. { too pushes ? }
  505. if reg_pushes[varregs[i]]>=regvars[i]^.refs then
  506. begin
  507. regvars[i]:=nil;
  508. goto nextreg;
  509. end;
  510. { register is no longer available for }
  511. { expressions }
  512. { search the register which is the most }
  513. { unused }
  514. usableregs:=usableregs-[varregs[i]];
  515. {$ifdef i386}
  516. procinfo^.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
  517. {$endif i386}
  518. is_reg_var[varregs[i]]:=true;
  519. dec(c_usableregs);
  520. { possibly no 32 bit register are needed }
  521. { call by reference/const ? }
  522. if (regvars[i]^.varspez=vs_var) or
  523. ((regvars[i]^.varspez=vs_const) and
  524. push_addr_param(regvars[i]^.vartype.def)) then
  525. begin
  526. regvars[i]^.reg:=varregs[i];
  527. regsize:=S_L;
  528. end
  529. else
  530. if (regvars[i]^.vartype.def^.deftype=orddef) and
  531. (porddef(regvars[i]^.vartype.def)^.size=1) then
  532. begin
  533. {$ifdef i386}
  534. regvars[i]^.reg:=reg32toreg8(varregs[i]);
  535. {$endif}
  536. regsize:=S_B;
  537. end
  538. else
  539. if (regvars[i]^.vartype.def^.deftype=orddef) and
  540. (porddef(regvars[i]^.vartype.def)^.size=2) then
  541. begin
  542. {$ifdef i386}
  543. regvars[i]^.reg:=reg32toreg16(varregs[i]);
  544. {$endif}
  545. regsize:=S_W;
  546. end
  547. else
  548. begin
  549. regvars[i]^.reg:=varregs[i];
  550. regsize:=S_L;
  551. end;
  552. { parameter must be load }
  553. if regvars_para[i] then
  554. begin
  555. { procinfo is there actual, }
  556. { because we can't never be in a }
  557. { nested procedure }
  558. { when loading parameter to reg }
  559. new(hr);
  560. reset_reference(hr^);
  561. hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.call_offset;
  562. hr^.base:=procinfo^.framepointer;
  563. {$ifdef i386}
  564. procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  565. hr,regvars[i]^.reg)));
  566. {$endif i386}
  567. {$ifdef m68k}
  568. procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
  569. hr,regvars[i]^.reg)));
  570. {$endif m68k}
  571. unused:=unused - [regvars[i]^.reg];
  572. end;
  573. { procedure uses this register }
  574. {$ifdef i386}
  575. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  576. {$endif i386}
  577. {$ifdef m68k}
  578. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  579. {$endif m68k}
  580. end;
  581. nextreg:
  582. { dummy }
  583. regsize:=S_W;
  584. end;
  585. for i:=1 to maxvarregs do
  586. begin
  587. if assigned(regvars[i]) then
  588. begin
  589. if cs_asm_source in aktglobalswitches then
  590. procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  591. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  592. reg2str(regvars[i]^.reg)))));
  593. if (status.verbosity and v_debug)=v_debug then
  594. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  595. tostr(regvars[i]^.refs),regvars[i]^.name);
  596. end;
  597. end;
  598. end;
  599. { $endif dummy}
  600. if ((p^.registersfpu+1)<maxfpuvarregs) then
  601. begin
  602. for i:=1 to maxfpuvarregs do
  603. regvars[i]:=nil;
  604. parasym:=false;
  605. symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
  606. {$ifdef dummy}
  607. { copy parameter into a register ? }
  608. parasym:=true;
  609. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  610. {$endif dummy}
  611. { hold needed registers free }
  612. { in non leaf procedures we must be very careful }
  613. { with assigning registers }
  614. if aktmaxfpuregisters=-1 then
  615. begin
  616. if (procinfo^.flags and pi_do_call)<>0 then
  617. begin
  618. for i:=maxfpuvarregs downto 2 do
  619. regvars[i]:=nil;
  620. end
  621. else
  622. begin
  623. for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
  624. regvars[i]:=nil;
  625. end;
  626. end
  627. else
  628. begin
  629. for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
  630. regvars[i]:=nil;
  631. end;
  632. { now assign register }
  633. for i:=1 to maxfpuvarregs do
  634. begin
  635. if assigned(regvars[i]) then
  636. begin
  637. {$ifdef i386}
  638. { reserve place on the FPU stack }
  639. regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  640. procinfo^.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
  641. { ... and clean it up }
  642. procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
  643. {$endif i386}
  644. {$ifdef m68k}
  645. regvars[i]^.reg:=fpuvarregs[i];
  646. {$endif m68k}
  647. {$ifdef dummy}
  648. { parameter must be load }
  649. if regvars_para[i] then
  650. begin
  651. { procinfo is there actual, }
  652. { because we can't never be in a }
  653. { nested procedure }
  654. { when loading parameter to reg }
  655. new(hr);
  656. reset_reference(hr^);
  657. hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.call_offset;
  658. hr^.base:=procinfo^.framepointer;
  659. {$ifdef i386}
  660. procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  661. hr,regvars[i]^.reg)));
  662. {$endif i386}
  663. {$ifdef m68k}
  664. procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
  665. hr,regvars[i]^.reg)));
  666. {$endif m68k}
  667. end;
  668. {$endif dummy}
  669. end;
  670. end;
  671. if cs_asm_source in aktglobalswitches then
  672. procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
  673. ' registers on FPU stack used by temp. expressions'))));
  674. for i:=1 to maxfpuvarregs do
  675. begin
  676. if assigned(regvars[i]) then
  677. begin
  678. if cs_asm_source in aktglobalswitches then
  679. procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  680. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  681. reg2str(regvars[i]^.reg)))));
  682. if (status.verbosity and v_debug)=v_debug then
  683. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  684. tostr(regvars[i]^.refs),regvars[i]^.name);
  685. end;
  686. end;
  687. if cs_asm_source in aktglobalswitches then
  688. procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  689. end;
  690. end;
  691. if assigned(aktprocsym) and
  692. (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  693. make_const_global:=true;
  694. do_secondpass(p);
  695. if assigned(procinfo^.def) then
  696. procinfo^.def^.fpu_used:=p^.registersfpu;
  697. { all registers can be used again }
  698. resetusableregisters;
  699. end;
  700. procinfo^.aktproccode^.concatlist(exprasmlist);
  701. make_const_global:=false;
  702. end;
  703. end.
  704. {
  705. $Log$
  706. Revision 1.49 2000-01-07 01:14:28 peter
  707. * updated copyright to 2000
  708. Revision 1.48 2000/01/04 15:15:52 florian
  709. + added compiler switch $maxfpuregisters
  710. + fixed a small problem in secondvecn
  711. Revision 1.47 1999/12/22 01:01:52 peter
  712. - removed freelabel()
  713. * added undefined label detection in internal assembler, this prevents
  714. a lot of ld crashes and wrong .o files
  715. * .o files aren't written anymore if errors have occured
  716. * inlining of assembler labels is now correct
  717. Revision 1.46 1999/12/19 23:37:18 pierre
  718. * fix for web bug735
  719. Revision 1.45 1999/12/14 09:58:42 florian
  720. + compiler checks now if a goto leaves an exception block
  721. Revision 1.44 1999/11/30 10:40:44 peter
  722. + ttype, tsymlist
  723. Revision 1.43 1999/11/18 15:34:47 pierre
  724. * Notes/Hints for local syms changed to
  725. Set_varstate function
  726. Revision 1.42 1999/11/09 23:06:45 peter
  727. * esi_offset -> selfpointer_offset to be newcg compatible
  728. * hcogegen -> cgbase fixes for newcg
  729. Revision 1.41 1999/11/06 14:34:21 peter
  730. * truncated log to 20 revs
  731. Revision 1.40 1999/09/27 23:44:52 peter
  732. * procinfo is now a pointer
  733. * support for result setting in sub procedure
  734. Revision 1.39 1999/09/26 21:30:17 peter
  735. + constant pointer support which can happend with typecasting like
  736. const p=pointer(1)
  737. * better procvar parsing in typed consts
  738. Revision 1.38 1999/09/16 23:05:54 florian
  739. * m68k compiler is again compilable (only gas writer, no assembler reader)
  740. Revision 1.37 1999/09/15 20:35:41 florian
  741. * small fix to operator overloading when in MMX mode
  742. + the compiler uses now fldz and fld1 if possible
  743. + some fixes to floating point registers
  744. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  745. * .... ???
  746. Revision 1.36 1999/09/07 14:12:35 jonas
  747. * framepointer cannot be changed to esp for methods
  748. Revision 1.35 1999/08/27 10:46:26 pierre
  749. + some EXTTEMPREGDEBUG code added
  750. Revision 1.34 1999/08/25 12:00:01 jonas
  751. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  752. Revision 1.33 1999/08/24 09:07:04 pierre
  753. * wrong testregisters32 placement corrected
  754. Revision 1.32 1999/08/23 23:25:59 pierre
  755. + TEMPREGDEBUG code, test of register allocation
  756. if a tree uses more than registers32 regs then
  757. internalerror(10) is issued
  758. + EXTTEMPREGDEBUG will also give internalerror(10) if
  759. a same register is freed twice (happens in several part
  760. of current compiler like addn for strings and sets)
  761. Revision 1.31 1999/08/07 14:20:59 florian
  762. * some small problems fixed
  763. Revision 1.30 1999/08/04 14:21:07 florian
  764. * now every available fpu register is used for
  765. fpu register variables
  766. Revision 1.29 1999/08/04 13:45:28 florian
  767. + floating point register variables !!
  768. * pairegalloc is now generated for register variables
  769. Revision 1.28 1999/08/04 00:23:10 florian
  770. * renamed i386asm and i386base to cpuasm and cpubase
  771. Revision 1.27 1999/08/03 22:02:55 peter
  772. * moved bitmask constants to sets
  773. * some other type/const renamings
  774. Revision 1.26 1999/06/02 22:44:08 pierre
  775. * previous wrong log corrected
  776. Revision 1.25 1999/06/02 22:25:41 pierre
  777. * changed $ifdef FPC @ into $ifndef TP
  778. Revision 1.24 1999/06/01 14:45:50 peter
  779. * @procvar is now always needed for FPC
  780. Revision 1.23 1999/05/27 19:44:43 peter
  781. * removed oldasm
  782. * plabel -> pasmlabel
  783. * -a switches to source writing automaticly
  784. * assembler readers OOPed
  785. * asmsymbol automaticly external
  786. * jumptables and other label fixes for asm readers
  787. Revision 1.22 1999/05/18 14:15:50 peter
  788. * containsself fixes
  789. * checktypes()
  790. Revision 1.21 1999/05/17 21:57:11 florian
  791. * new temporary ansistring handling
  792. }