pass_2.pas 34 KB

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