pass_2.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832
  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(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
  417. not(po_interrupt in aktprocsym^.definition^.procoptions) and
  418. ((procinfo.flags and pi_do_call)=0) and
  419. (lexlevel>=normal_function_level) then
  420. begin
  421. { use ESP as frame pointer }
  422. procinfo.framepointer:=stack_pointer;
  423. use_esp_stackframe:=true;
  424. { calc parameter distance new }
  425. dec(procinfo.framepointer_offset,4);
  426. dec(procinfo.ESI_offset,4);
  427. { is this correct ???}
  428. { retoffset can be negativ for results in eax !! }
  429. { the value should be decreased only if positive }
  430. if procinfo.retoffset>=0 then
  431. dec(procinfo.retoffset,4);
  432. dec(procinfo.call_offset,4);
  433. aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
  434. end;
  435. end;
  436. *)
  437. if (p^.registers32<4) then
  438. begin
  439. for i:=1 to maxvarregs do
  440. regvars[i]:=nil;
  441. parasym:=false;
  442. symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
  443. { copy parameter into a register ? }
  444. parasym:=true;
  445. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  446. { hold needed registers free }
  447. for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  448. regvars[i]:=nil;
  449. { now assign register }
  450. for i:=1 to maxvarregs-p^.registers32 do
  451. begin
  452. if assigned(regvars[i]) then
  453. begin
  454. { it is nonsens, to copy the variable to }
  455. { a register because we need then much }
  456. { too pushes ? }
  457. if reg_pushes[varregs[i]]>=regvars[i]^.refs then
  458. begin
  459. regvars[i]:=nil;
  460. goto nextreg;
  461. end;
  462. { register is no longer available for }
  463. { expressions }
  464. { search the register which is the most }
  465. { unused }
  466. usableregs:=usableregs-[varregs[i]];
  467. {$ifdef i386}
  468. procinfo.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
  469. {$endif i386}
  470. is_reg_var[varregs[i]]:=true;
  471. dec(c_usableregs);
  472. { possibly no 32 bit register are needed }
  473. { call by reference/const ? }
  474. if (regvars[i]^.varspez=vs_var) or
  475. ((regvars[i]^.varspez=vs_const) and
  476. push_addr_param(regvars[i]^.definition)) then
  477. begin
  478. regvars[i]^.reg:=varregs[i];
  479. regsize:=S_L;
  480. end
  481. else
  482. if (regvars[i]^.definition^.deftype=orddef) and
  483. (porddef(regvars[i]^.definition)^.size=1) then
  484. begin
  485. {$ifdef i386}
  486. regvars[i]^.reg:=reg32toreg8(varregs[i]);
  487. {$endif}
  488. regsize:=S_B;
  489. end
  490. else
  491. if (regvars[i]^.definition^.deftype=orddef) and
  492. (porddef(regvars[i]^.definition)^.size=2) then
  493. begin
  494. {$ifdef i386}
  495. regvars[i]^.reg:=reg32toreg16(varregs[i]);
  496. {$endif}
  497. regsize:=S_W;
  498. end
  499. else
  500. begin
  501. regvars[i]^.reg:=varregs[i];
  502. regsize:=S_L;
  503. end;
  504. { parameter must be load }
  505. if regvars_para[i] then
  506. begin
  507. { procinfo is there actual, }
  508. { because we can't never be in a }
  509. { nested procedure }
  510. { when loading parameter to reg }
  511. new(hr);
  512. reset_reference(hr^);
  513. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  514. hr^.base:=procinfo.framepointer;
  515. {$ifdef i386}
  516. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  517. hr,regvars[i]^.reg)));
  518. {$endif i386}
  519. {$ifdef m68k}
  520. procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
  521. hr,regvars[i]^.reg)));
  522. {$endif m68k}
  523. unused:=unused - [regvars[i]^.reg];
  524. end;
  525. { procedure uses this register }
  526. {$ifdef i386}
  527. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  528. {$endif i386}
  529. {$ifdef m68k}
  530. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  531. {$endif m68k}
  532. end;
  533. nextreg:
  534. { dummy }
  535. regsize:=S_W;
  536. end;
  537. for i:=1 to maxvarregs do
  538. begin
  539. if assigned(regvars[i]) then
  540. begin
  541. if cs_asm_source in aktglobalswitches then
  542. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  543. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  544. reg2str(regvars[i]^.reg)))));
  545. if (status.verbosity and v_debug)=v_debug then
  546. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  547. tostr(regvars[i]^.refs),regvars[i]^.name);
  548. end;
  549. end;
  550. end;
  551. if (p^.registersfpu<maxfpuvarregs-2) then
  552. begin
  553. for i:=1 to maxfpuvarregs do
  554. regvars[i]:=nil;
  555. parasym:=false;
  556. symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
  557. {$ifdef dummy}
  558. { copy parameter into a register ? }
  559. parasym:=true;
  560. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  561. {$endif dummy}
  562. { hold needed registers free }
  563. for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu+1 do
  564. regvars[i]:=nil;
  565. { now assign register }
  566. for i:=1 to maxfpuvarregs-p^.registersfpu do
  567. begin
  568. if assigned(regvars[i]) then
  569. begin
  570. regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  571. {$ifdef dummy}
  572. { parameter must be load }
  573. if regvars_para[i] then
  574. begin
  575. { procinfo is there actual, }
  576. { because we can't never be in a }
  577. { nested procedure }
  578. { when loading parameter to reg }
  579. new(hr);
  580. reset_reference(hr^);
  581. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  582. hr^.base:=procinfo.framepointer;
  583. {$ifdef i386}
  584. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  585. hr,regvars[i]^.reg)));
  586. {$endif i386}
  587. {$ifdef m68k}
  588. procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
  589. hr,regvars[i]^.reg)));
  590. {$endif m68k}
  591. end;
  592. {$endif dummy}
  593. end;
  594. end;
  595. if cs_asm_source in aktglobalswitches then
  596. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
  597. ' registers on FPU stack used by temp. expressions'))));
  598. for i:=1 to maxfpuvarregs do
  599. begin
  600. if assigned(regvars[i]) then
  601. begin
  602. if cs_asm_source in aktglobalswitches then
  603. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  604. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  605. reg2str(regvars[i]^.reg)))));
  606. if (status.verbosity and v_debug)=v_debug then
  607. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  608. tostr(regvars[i]^.refs),regvars[i]^.name);
  609. end;
  610. end;
  611. if cs_asm_source in aktglobalswitches then
  612. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  613. end;
  614. end;
  615. if assigned(aktprocsym) and
  616. (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  617. make_const_global:=true;
  618. do_secondpass(p);
  619. if assigned(procinfo.def) then
  620. procinfo.def^.fpu_used:=p^.registersfpu;
  621. { all registers can be used again }
  622. resetusableregisters;
  623. end;
  624. procinfo.aktproccode^.concatlist(exprasmlist);
  625. make_const_global:=false;
  626. end;
  627. end.
  628. {
  629. $Log$
  630. Revision 1.35 1999-08-27 10:46:26 pierre
  631. + some EXTTEMPREGDEBUG code added
  632. Revision 1.34 1999/08/25 12:00:01 jonas
  633. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  634. Revision 1.33 1999/08/24 09:07:04 pierre
  635. * wrong testregisters32 placement corrected
  636. Revision 1.32 1999/08/23 23:25:59 pierre
  637. + TEMPREGDEBUG code, test of register allocation
  638. if a tree uses more than registers32 regs then
  639. internalerror(10) is issued
  640. + EXTTEMPREGDEBUG will also give internalerror(10) if
  641. a same register is freed twice (happens in several part
  642. of current compiler like addn for strings and sets)
  643. Revision 1.31 1999/08/07 14:20:59 florian
  644. * some small problems fixed
  645. Revision 1.30 1999/08/04 14:21:07 florian
  646. * now every available fpu register is used for
  647. fpu register variables
  648. Revision 1.29 1999/08/04 13:45:28 florian
  649. + floating point register variables !!
  650. * pairegalloc is now generated for register variables
  651. Revision 1.28 1999/08/04 00:23:10 florian
  652. * renamed i386asm and i386base to cpuasm and cpubase
  653. Revision 1.27 1999/08/03 22:02:55 peter
  654. * moved bitmask constants to sets
  655. * some other type/const renamings
  656. Revision 1.26 1999/06/02 22:44:08 pierre
  657. * previous wrong log corrected
  658. Revision 1.25 1999/06/02 22:25:41 pierre
  659. * changed $ifdef FPC @ into $ifndef TP
  660. Revision 1.24 1999/06/01 14:45:50 peter
  661. * @procvar is now always needed for FPC
  662. Revision 1.23 1999/05/27 19:44:43 peter
  663. * removed oldasm
  664. * plabel -> pasmlabel
  665. * -a switches to source writing automaticly
  666. * assembler readers OOPed
  667. * asmsymbol automaticly external
  668. * jumptables and other label fixes for asm readers
  669. Revision 1.22 1999/05/18 14:15:50 peter
  670. * containsself fixes
  671. * checktypes()
  672. Revision 1.21 1999/05/17 21:57:11 florian
  673. * new temporary ansistring handling
  674. Revision 1.20 1999/05/02 21:33:54 florian
  675. * several bugs regarding -Or fixed
  676. Revision 1.19 1999/05/01 13:24:28 peter
  677. * merged nasm compiler
  678. * old asm moved to oldasm/
  679. Revision 1.18 1999/04/28 06:02:04 florian
  680. * changes of Bruessel:
  681. + message handler can now take an explicit self
  682. * typinfo fixed: sometimes the type names weren't written
  683. * the type checking for pointer comparisations and subtraction
  684. and are now more strict (was also buggy)
  685. * small bug fix to link.pas to support compiling on another
  686. drive
  687. * probable bug in popt386 fixed: call/jmp => push/jmp
  688. transformation didn't count correctly the jmp references
  689. + threadvar support
  690. * warning if ln/sqrt gets an invalid constant argument
  691. Revision 1.17 1999/03/31 13:55:11 peter
  692. * assembler inlining working for ag386bin
  693. Revision 1.16 1999/03/24 23:17:11 peter
  694. * fixed bugs 212,222,225,227,229,231,233
  695. Revision 1.15 1999/02/22 02:15:25 peter
  696. * updates for ag386bin
  697. Revision 1.14 1999/01/23 23:29:37 florian
  698. * first running version of the new code generator
  699. * when compiling exceptions under Linux fixed
  700. Revision 1.13 1998/12/30 13:41:09 peter
  701. * released valuepara
  702. Revision 1.12 1998/12/19 00:23:51 florian
  703. * ansistring memory leaks fixed
  704. Revision 1.11 1998/12/11 00:03:28 peter
  705. + globtype,tokens,version unit splitted from globals
  706. Revision 1.10 1998/11/18 15:44:14 peter
  707. * VALUEPARA for tp7 compatible value parameters
  708. Revision 1.9 1998/11/13 15:40:21 pierre
  709. + added -Se in Makefile cvstest target
  710. + lexlevel cleanup
  711. normal_function_level main_program_level and unit_init_level defined
  712. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  713. (test added in code !)
  714. * -Un option was wrong
  715. * _FAIL and _SELF only keyword inside
  716. constructors and methods respectively
  717. Revision 1.8 1998/10/29 15:42:49 florian
  718. + partial disposing of temp. ansistrings
  719. Revision 1.7 1998/10/26 22:58:19 florian
  720. * new introduded problem with classes fix, the parent class wasn't set
  721. correct, if the class was defined forward before
  722. Revision 1.6 1998/09/23 09:58:52 peter
  723. * first working array of const things
  724. Revision 1.5 1998/09/21 10:01:06 peter
  725. * check if procinfo.def is assigned before storing registersfpu
  726. Revision 1.4 1998/09/21 08:45:16 pierre
  727. + added vmt_offset in tobjectdef.write for fututre use
  728. (first steps to have objects without vmt if no virtual !!)
  729. + added fpu_used field for tabstractprocdef :
  730. sets this level to 2 if the functions return with value in FPU
  731. (is then set to correct value at parsing of implementation)
  732. THIS MIGHT refuse some code with FPU expression too complex
  733. that were accepted before and even in some cases
  734. that don't overflow in fact
  735. ( like if f : float; is a forward that finally in implementation
  736. only uses one fpu register !!)
  737. Nevertheless I think that it will improve security on
  738. FPU operations !!
  739. * most other changes only for UseBrowser code
  740. (added symtable references for record and objects)
  741. local switch for refs to args and local of each function
  742. (static symtable still missing)
  743. UseBrowser still not stable and probably broken by
  744. the definition hash array !!
  745. Revision 1.3 1998/09/17 09:42:40 peter
  746. + pass_2 for cg386
  747. * Message() -> CGMessage() for pass_1/pass_2
  748. Revision 1.2 1998/09/07 18:46:07 peter
  749. * update smartlinking, uses getdatalabel
  750. * renamed ptree.value vars to value_str,value_real,value_set
  751. Revision 1.1 1998/09/01 09:07:12 peter
  752. * m68k fixes, splitted cg68k like cgi386
  753. }