pass_2.pas 31 KB

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