pass_2.pas 31 KB

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