pass_2.pas 32 KB

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