pass_2.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870
  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. secondumminus, {umminusn}
  189. secondasm, {asmn}
  190. secondvecn, {vecn}
  191. secondstringconst, {stringconstn}
  192. secondfuncret, {funcretn}
  193. secondselfn, {selfn}
  194. secondnot, {notn}
  195. secondinline, {inlinen}
  196. secondniln, {niln}
  197. seconderror, {errorn}
  198. secondnothing, {typen}
  199. secondhnewn, {hnewn}
  200. secondhdisposen, {hdisposen}
  201. secondnewn, {newn}
  202. secondsimplenewdispose, {simpledisposen}
  203. secondsetelement, {setelementn}
  204. secondsetconst, {setconstn}
  205. secondblockn, {blockn}
  206. secondstatement, {statementn}
  207. secondnothing, {loopn}
  208. secondifn, {ifn}
  209. secondbreakn, {breakn}
  210. secondcontinuen, {continuen}
  211. second_while_repeatn, {repeatn}
  212. second_while_repeatn, {whilen}
  213. secondfor, {forn}
  214. secondexitn, {exitn}
  215. secondwith, {withn}
  216. secondcase, {casen}
  217. secondlabel, {labeln}
  218. secondgoto, {goton}
  219. secondsimplenewdispose, {simplenewn}
  220. secondtryexcept, {tryexceptn}
  221. secondraise, {raisen}
  222. secondnothing, {switchesn}
  223. secondtryfinally, {tryfinallyn}
  224. secondon, {onn}
  225. secondis, {isn}
  226. secondas, {asn}
  227. seconderror, {caretn}
  228. secondfail, {failn}
  229. secondadd, {starstarn}
  230. secondprocinline, {procinlinen}
  231. secondarrayconstruct, {arrayconstructn}
  232. secondnothing, {arrayconstructrangen}
  233. secondnothing, {nothingn}
  234. secondloadvmt {loadvmtn}
  235. );
  236. var
  237. oldcodegenerror : boolean;
  238. oldlocalswitches : tlocalswitches;
  239. oldpos : tfileposinfo;
  240. {$ifdef TEMPREGDEBUG}
  241. prevp : pptree;
  242. {$endif TEMPREGDEBUG}
  243. begin
  244. if not(p^.error) then
  245. begin
  246. oldcodegenerror:=codegenerror;
  247. oldlocalswitches:=aktlocalswitches;
  248. oldpos:=aktfilepos;
  249. {$ifdef TEMPREGDEBUG}
  250. testregisters32;
  251. prevp:=curptree;
  252. curptree:=@p;
  253. p^.usableregs:=usablereg32;
  254. {$endif TEMPREGDEBUG}
  255. aktfilepos:=p^.fileinfo;
  256. aktlocalswitches:=p^.localswitches;
  257. codegenerror:=false;
  258. procedures[p^.treetype](p);
  259. p^.error:=codegenerror;
  260. codegenerror:=codegenerror or oldcodegenerror;
  261. aktlocalswitches:=oldlocalswitches;
  262. aktfilepos:=oldpos;
  263. {$ifdef TEMPREGDEBUG}
  264. curptree:=prevp;
  265. {$endif TEMPREGDEBUG}
  266. {$ifdef EXTTEMPREGDEBUG}
  267. if p^.usableregs-usablereg32>p^.reallyusedregs then
  268. p^.reallyusedregs:=p^.usableregs-usablereg32;
  269. if p^.reallyusedregs<p^.registers32 then
  270. Comment(V_Debug,'registers32 overestimated '+tostr(p^.registers32)+
  271. '>'+tostr(p^.reallyusedregs));
  272. {$endif EXTTEMPREGDEBUG}
  273. end
  274. else
  275. codegenerror:=true;
  276. end;
  277. function do_secondpass(var p : ptree) : boolean;
  278. begin
  279. codegenerror:=false;
  280. if not(p^.error) then
  281. secondpass(p);
  282. do_secondpass:=codegenerror;
  283. end;
  284. var
  285. { the array ranges are oveestimated !!! }
  286. { max(maxvarregs,maxfpuvarregs) would be }
  287. { enough }
  288. regvars : array[1..maxvarregs+maxfpuvarregs] of pvarsym;
  289. regvars_para : array[1..maxvarregs+maxfpuvarregs] of boolean;
  290. regvars_refs : array[1..maxvarregs+maxfpuvarregs] of longint;
  291. parasym : boolean;
  292. procedure searchregvars(p : pnamedindexobject);
  293. var
  294. i,j,k : longint;
  295. begin
  296. if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
  297. begin
  298. { walk through all momentary register variables }
  299. for i:=1 to maxvarregs do
  300. begin
  301. { free register ? }
  302. if regvars[i]=nil then
  303. begin
  304. regvars[i]:=pvarsym(p);
  305. regvars_para[i]:=parasym;
  306. break;
  307. end;
  308. { else throw out a variable ? }
  309. j:=pvarsym(p)^.refs;
  310. { parameter get a less value }
  311. if parasym then
  312. begin
  313. if cs_littlesize in aktglobalswitches then
  314. dec(j,1)
  315. else
  316. dec(j,100);
  317. end;
  318. if (j>regvars_refs[i]) and (j>0) then
  319. begin
  320. for k:=maxvarregs-1 downto i do
  321. begin
  322. regvars[k+1]:=regvars[k];
  323. regvars_para[k+1]:=regvars_para[k];
  324. end;
  325. { calc the new refs
  326. pvarsym(p)^.refs:=j; }
  327. regvars[i]:=pvarsym(p);
  328. regvars_para[i]:=parasym;
  329. regvars_refs[i]:=j;
  330. break;
  331. end;
  332. end;
  333. end;
  334. end;
  335. procedure searchfpuregvars(p : pnamedindexobject);
  336. var
  337. i,j,k : longint;
  338. begin
  339. if (psym(p)^.typ=varsym) and (vo_fpuregable in pvarsym(p)^.varoptions) then
  340. begin
  341. { walk through all momentary register variables }
  342. for i:=1 to maxfpuvarregs do
  343. begin
  344. { free register ? }
  345. if regvars[i]=nil then
  346. begin
  347. regvars[i]:=pvarsym(p);
  348. regvars_para[i]:=parasym;
  349. break;
  350. end;
  351. { else throw out a variable ? }
  352. j:=pvarsym(p)^.refs;
  353. { parameter get a less value }
  354. if parasym then
  355. begin
  356. if cs_littlesize in aktglobalswitches then
  357. dec(j,1)
  358. else
  359. dec(j,100);
  360. end;
  361. if (j>regvars_refs[i]) and (j>0) then
  362. begin
  363. for k:=maxfpuvarregs-1 downto i do
  364. begin
  365. regvars[k+1]:=regvars[k];
  366. regvars_para[k+1]:=regvars_para[k];
  367. end;
  368. { calc the new refs
  369. pvarsym(p)^.refs:=j; }
  370. regvars[i]:=pvarsym(p);
  371. regvars_para[i]:=parasym;
  372. regvars_refs[i]:=j;
  373. break;
  374. end;
  375. end;
  376. end;
  377. end;
  378. procedure generatecode(var p : ptree);
  379. var
  380. i : longint;
  381. regsize : topsize;
  382. hr : preference;
  383. label
  384. nextreg;
  385. begin
  386. {!!!!!!!! temptoremove:=nil; }
  387. cleartempgen;
  388. { when size optimization only count occurrence }
  389. if cs_littlesize in aktglobalswitches then
  390. t_times:=1
  391. else
  392. { reference for repetition is 100 }
  393. t_times:=100;
  394. { clear register count }
  395. clearregistercount;
  396. use_esp_stackframe:=false;
  397. if not(do_firstpass(p)) then
  398. begin
  399. { max. optimizations }
  400. { only if no asm is used }
  401. { and no try statement }
  402. if (cs_regalloc in aktglobalswitches) and
  403. ((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
  404. begin
  405. { can we omit the stack frame ? }
  406. { conditions:
  407. 1. procedure (not main block)
  408. 2. no constructor or destructor
  409. 3. no call to other procedures
  410. 4. no interrupt handler
  411. }
  412. {!!!!!! this doesn work yet, because of problems with
  413. with linux and windows
  414. }
  415. (*
  416. if assigned(aktprocsym) then
  417. begin
  418. if not(assigned(procinfo._class)) and
  419. not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
  420. not(po_interrupt in aktprocsym^.definition^.procoptions) and
  421. ((procinfo.flags and pi_do_call)=0) and
  422. (lexlevel>=normal_function_level) then
  423. begin
  424. { use ESP as frame pointer }
  425. procinfo.framepointer:=stack_pointer;
  426. use_esp_stackframe:=true;
  427. { calc parameter distance new }
  428. dec(procinfo.framepointer_offset,4);
  429. dec(procinfo.ESI_offset,4);
  430. { is this correct ???}
  431. { retoffset can be negativ for results in eax !! }
  432. { the value should be decreased only if positive }
  433. if procinfo.retoffset>=0 then
  434. dec(procinfo.retoffset,4);
  435. dec(procinfo.call_offset,4);
  436. aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
  437. end;
  438. end;
  439. *)
  440. { $ifdef dummy}
  441. if (p^.registers32<4) then
  442. begin
  443. for i:=1 to maxvarregs do
  444. regvars[i]:=nil;
  445. parasym:=false;
  446. symtablestack^.foreach({$ifndef TP}@{$endif}searchregvars);
  447. { copy parameter into a register ? }
  448. parasym:=true;
  449. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  450. { hold needed registers free }
  451. for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
  452. regvars[i]:=nil;
  453. { now assign register }
  454. for i:=1 to maxvarregs-p^.registers32 do
  455. begin
  456. if assigned(regvars[i]) then
  457. begin
  458. { it is nonsens, to copy the variable to }
  459. { a register because we need then much }
  460. { too pushes ? }
  461. if reg_pushes[varregs[i]]>=regvars[i]^.refs then
  462. begin
  463. regvars[i]:=nil;
  464. goto nextreg;
  465. end;
  466. { register is no longer available for }
  467. { expressions }
  468. { search the register which is the most }
  469. { unused }
  470. usableregs:=usableregs-[varregs[i]];
  471. {$ifdef i386}
  472. procinfo.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
  473. {$endif i386}
  474. is_reg_var[varregs[i]]:=true;
  475. dec(c_usableregs);
  476. { possibly no 32 bit register are needed }
  477. { call by reference/const ? }
  478. if (regvars[i]^.varspez=vs_var) or
  479. ((regvars[i]^.varspez=vs_const) and
  480. push_addr_param(regvars[i]^.definition)) then
  481. begin
  482. regvars[i]^.reg:=varregs[i];
  483. regsize:=S_L;
  484. end
  485. else
  486. if (regvars[i]^.definition^.deftype=orddef) and
  487. (porddef(regvars[i]^.definition)^.size=1) then
  488. begin
  489. {$ifdef i386}
  490. regvars[i]^.reg:=reg32toreg8(varregs[i]);
  491. {$endif}
  492. regsize:=S_B;
  493. end
  494. else
  495. if (regvars[i]^.definition^.deftype=orddef) and
  496. (porddef(regvars[i]^.definition)^.size=2) then
  497. begin
  498. {$ifdef i386}
  499. regvars[i]^.reg:=reg32toreg16(varregs[i]);
  500. {$endif}
  501. regsize:=S_W;
  502. end
  503. else
  504. begin
  505. regvars[i]^.reg:=varregs[i];
  506. regsize:=S_L;
  507. end;
  508. { parameter must be load }
  509. if regvars_para[i] then
  510. begin
  511. { procinfo is there actual, }
  512. { because we can't never be in a }
  513. { nested procedure }
  514. { when loading parameter to reg }
  515. new(hr);
  516. reset_reference(hr^);
  517. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  518. hr^.base:=procinfo.framepointer;
  519. {$ifdef i386}
  520. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  521. hr,regvars[i]^.reg)));
  522. {$endif i386}
  523. {$ifdef m68k}
  524. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
  525. hr,regvars[i]^.reg)));
  526. {$endif m68k}
  527. unused:=unused - [regvars[i]^.reg];
  528. end;
  529. { procedure uses this register }
  530. {$ifdef i386}
  531. usedinproc:=usedinproc or ($80 shr byte(varregs[i]));
  532. {$endif i386}
  533. {$ifdef m68k}
  534. usedinproc:=usedinproc or ($800 shr word(varregs[i]));
  535. {$endif m68k}
  536. end;
  537. nextreg:
  538. { dummy }
  539. regsize:=S_W;
  540. end;
  541. for i:=1 to maxvarregs do
  542. begin
  543. if assigned(regvars[i]) then
  544. begin
  545. if cs_asm_source in aktglobalswitches then
  546. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  547. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  548. reg2str(regvars[i]^.reg)))));
  549. if (status.verbosity and v_debug)=v_debug then
  550. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  551. tostr(regvars[i]^.refs),regvars[i]^.name);
  552. end;
  553. end;
  554. end;
  555. { $endif dummy}
  556. if ((p^.registersfpu+1)<maxfpuvarregs) then
  557. begin
  558. for i:=1 to maxfpuvarregs do
  559. regvars[i]:=nil;
  560. parasym:=false;
  561. symtablestack^.foreach({$ifndef TP}@{$endif}searchfpuregvars);
  562. {$ifdef dummy}
  563. { copy parameter into a register ? }
  564. parasym:=true;
  565. symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
  566. {$endif dummy}
  567. { hold needed registers free }
  568. { in non leaf procedures we must be very careful }
  569. { with assigning registers }
  570. if (procinfo.flags and pi_do_call)<>0 then
  571. begin
  572. for i:=maxfpuvarregs downto 2 do
  573. regvars[i]:=nil;
  574. end
  575. else
  576. begin
  577. for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
  578. regvars[i]:=nil;
  579. end;
  580. { now assign register }
  581. for i:=1 to maxfpuvarregs do
  582. begin
  583. if assigned(regvars[i]) then
  584. begin
  585. {$ifdef i386}
  586. { reserve place on the FPU stack }
  587. regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
  588. procinfo.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
  589. { ... and clean it up }
  590. procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
  591. {$endif i386}
  592. {$ifdef m68k}
  593. regvars[i]^.reg:=fpuvarregs[i];
  594. {$endif m68k}
  595. {$ifdef dummy}
  596. { parameter must be load }
  597. if regvars_para[i] then
  598. begin
  599. { procinfo is there actual, }
  600. { because we can't never be in a }
  601. { nested procedure }
  602. { when loading parameter to reg }
  603. new(hr);
  604. reset_reference(hr^);
  605. hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
  606. hr^.base:=procinfo.framepointer;
  607. {$ifdef i386}
  608. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
  609. hr,regvars[i]^.reg)));
  610. {$endif i386}
  611. {$ifdef m68k}
  612. procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
  613. hr,regvars[i]^.reg)));
  614. {$endif m68k}
  615. end;
  616. {$endif dummy}
  617. end;
  618. end;
  619. if cs_asm_source in aktglobalswitches then
  620. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
  621. ' registers on FPU stack used by temp. expressions'))));
  622. for i:=1 to maxfpuvarregs do
  623. begin
  624. if assigned(regvars[i]) then
  625. begin
  626. if cs_asm_source in aktglobalswitches then
  627. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
  628. ' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
  629. reg2str(regvars[i]^.reg)))));
  630. if (status.verbosity and v_debug)=v_debug then
  631. Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
  632. tostr(regvars[i]^.refs),regvars[i]^.name);
  633. end;
  634. end;
  635. if cs_asm_source in aktglobalswitches then
  636. procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
  637. end;
  638. end;
  639. if assigned(aktprocsym) and
  640. (pocall_inline in aktprocsym^.definition^.proccalloptions) then
  641. make_const_global:=true;
  642. do_secondpass(p);
  643. if assigned(procinfo.def) then
  644. procinfo.def^.fpu_used:=p^.registersfpu;
  645. { all registers can be used again }
  646. resetusableregisters;
  647. end;
  648. procinfo.aktproccode^.concatlist(exprasmlist);
  649. make_const_global:=false;
  650. end;
  651. end.
  652. {
  653. $Log$
  654. Revision 1.38 1999-09-16 23:05:54 florian
  655. * m68k compiler is again compilable (only gas writer, no assembler reader)
  656. Revision 1.37 1999/09/15 20:35:41 florian
  657. * small fix to operator overloading when in MMX mode
  658. + the compiler uses now fldz and fld1 if possible
  659. + some fixes to floating point registers
  660. + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  661. * .... ???
  662. Revision 1.36 1999/09/07 14:12:35 jonas
  663. * framepointer cannot be changed to esp for methods
  664. Revision 1.35 1999/08/27 10:46:26 pierre
  665. + some EXTTEMPREGDEBUG code added
  666. Revision 1.34 1999/08/25 12:00:01 jonas
  667. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  668. Revision 1.33 1999/08/24 09:07:04 pierre
  669. * wrong testregisters32 placement corrected
  670. Revision 1.32 1999/08/23 23:25:59 pierre
  671. + TEMPREGDEBUG code, test of register allocation
  672. if a tree uses more than registers32 regs then
  673. internalerror(10) is issued
  674. + EXTTEMPREGDEBUG will also give internalerror(10) if
  675. a same register is freed twice (happens in several part
  676. of current compiler like addn for strings and sets)
  677. Revision 1.31 1999/08/07 14:20:59 florian
  678. * some small problems fixed
  679. Revision 1.30 1999/08/04 14:21:07 florian
  680. * now every available fpu register is used for
  681. fpu register variables
  682. Revision 1.29 1999/08/04 13:45:28 florian
  683. + floating point register variables !!
  684. * pairegalloc is now generated for register variables
  685. Revision 1.28 1999/08/04 00:23:10 florian
  686. * renamed i386asm and i386base to cpuasm and cpubase
  687. Revision 1.27 1999/08/03 22:02:55 peter
  688. * moved bitmask constants to sets
  689. * some other type/const renamings
  690. Revision 1.26 1999/06/02 22:44:08 pierre
  691. * previous wrong log corrected
  692. Revision 1.25 1999/06/02 22:25:41 pierre
  693. * changed $ifdef FPC @ into $ifndef TP
  694. Revision 1.24 1999/06/01 14:45:50 peter
  695. * @procvar is now always needed for FPC
  696. Revision 1.23 1999/05/27 19:44:43 peter
  697. * removed oldasm
  698. * plabel -> pasmlabel
  699. * -a switches to source writing automaticly
  700. * assembler readers OOPed
  701. * asmsymbol automaticly external
  702. * jumptables and other label fixes for asm readers
  703. Revision 1.22 1999/05/18 14:15:50 peter
  704. * containsself fixes
  705. * checktypes()
  706. Revision 1.21 1999/05/17 21:57:11 florian
  707. * new temporary ansistring handling
  708. Revision 1.20 1999/05/02 21:33:54 florian
  709. * several bugs regarding -Or fixed
  710. Revision 1.19 1999/05/01 13:24:28 peter
  711. * merged nasm compiler
  712. * old asm moved to oldasm/
  713. Revision 1.18 1999/04/28 06:02:04 florian
  714. * changes of Bruessel:
  715. + message handler can now take an explicit self
  716. * typinfo fixed: sometimes the type names weren't written
  717. * the type checking for pointer comparisations and subtraction
  718. and are now more strict (was also buggy)
  719. * small bug fix to link.pas to support compiling on another
  720. drive
  721. * probable bug in popt386 fixed: call/jmp => push/jmp
  722. transformation didn't count correctly the jmp references
  723. + threadvar support
  724. * warning if ln/sqrt gets an invalid constant argument
  725. Revision 1.17 1999/03/31 13:55:11 peter
  726. * assembler inlining working for ag386bin
  727. Revision 1.16 1999/03/24 23:17:11 peter
  728. * fixed bugs 212,222,225,227,229,231,233
  729. Revision 1.15 1999/02/22 02:15:25 peter
  730. * updates for ag386bin
  731. Revision 1.14 1999/01/23 23:29:37 florian
  732. * first running version of the new code generator
  733. * when compiling exceptions under Linux fixed
  734. Revision 1.13 1998/12/30 13:41:09 peter
  735. * released valuepara
  736. Revision 1.12 1998/12/19 00:23:51 florian
  737. * ansistring memory leaks fixed
  738. Revision 1.11 1998/12/11 00:03:28 peter
  739. + globtype,tokens,version unit splitted from globals
  740. Revision 1.10 1998/11/18 15:44:14 peter
  741. * VALUEPARA for tp7 compatible value parameters
  742. Revision 1.9 1998/11/13 15:40:21 pierre
  743. + added -Se in Makefile cvstest target
  744. + lexlevel cleanup
  745. normal_function_level main_program_level and unit_init_level defined
  746. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  747. (test added in code !)
  748. * -Un option was wrong
  749. * _FAIL and _SELF only keyword inside
  750. constructors and methods respectively
  751. Revision 1.8 1998/10/29 15:42:49 florian
  752. + partial disposing of temp. ansistrings
  753. Revision 1.7 1998/10/26 22:58:19 florian
  754. * new introduded problem with classes fix, the parent class wasn't set
  755. correct, if the class was defined forward before
  756. Revision 1.6 1998/09/23 09:58:52 peter
  757. * first working array of const things
  758. Revision 1.5 1998/09/21 10:01:06 peter
  759. * check if procinfo.def is assigned before storing registersfpu
  760. Revision 1.4 1998/09/21 08:45:16 pierre
  761. + added vmt_offset in tobjectdef.write for fututre use
  762. (first steps to have objects without vmt if no virtual !!)
  763. + added fpu_used field for tabstractprocdef :
  764. sets this level to 2 if the functions return with value in FPU
  765. (is then set to correct value at parsing of implementation)
  766. THIS MIGHT refuse some code with FPU expression too complex
  767. that were accepted before and even in some cases
  768. that don't overflow in fact
  769. ( like if f : float; is a forward that finally in implementation
  770. only uses one fpu register !!)
  771. Nevertheless I think that it will improve security on
  772. FPU operations !!
  773. * most other changes only for UseBrowser code
  774. (added symtable references for record and objects)
  775. local switch for refs to args and local of each function
  776. (static symtable still missing)
  777. UseBrowser still not stable and probably broken by
  778. the definition hash array !!
  779. Revision 1.3 1998/09/17 09:42:40 peter
  780. + pass_2 for cg386
  781. * Message() -> CGMessage() for pass_1/pass_2
  782. Revision 1.2 1998/09/07 18:46:07 peter
  783. * update smartlinking, uses getdatalabel
  784. * renamed ptree.value vars to value_str,value_real,value_set
  785. Revision 1.1 1998/09/01 09:07:12 peter
  786. * m68k fixes, splitted cg68k like cgi386
  787. }