pass_2.pas 31 KB

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