pass_2.pas 30 KB

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