cgobj.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. This unit implements the basic code generator object
  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. unit cgobj;
  19. interface
  20. uses
  21. cobjects,aasm,symtable
  22. {$I cpuunit.inc}
  23. ;
  24. type
  25. qword = comp;
  26. pcg = ^tcg;
  27. tcg = object
  28. procedure a_call_name_ext(list : paasmoutput;const s : string;
  29. offset : longint;m : texternal_typ);
  30. {************************************************}
  31. { code generation for subroutine entry/exit code }
  32. { helper routines }
  33. procedure g_initialize_data(p : psym);
  34. procedure g_incr_data(p : psym);
  35. procedure g_finalize_data(p : psym);
  36. {$ifndef VALUEPARA}
  37. procedure g_copyopenarrays(p : psym);
  38. {$else}
  39. procedure g_copyvalueparas(p : psym);
  40. {$endif}
  41. procedure g_entrycode(list : paasmoutput;const proc_names:tstringcontainer;make_global:boolean;
  42. stackframe:longint;
  43. var parasize:longint;var nostackframe:boolean;
  44. inlined : boolean);
  45. { string helper routines }
  46. procedure g_decransiref(const ref : treference);
  47. procedure g_removetemps(list : paasmoutput;p : plinkedlist);
  48. {**********************************}
  49. { these methods must be overriden: }
  50. procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
  51. procedure a_call_name(list : paasmoutput;const s : string;
  52. offset : longint);virtual;
  53. procedure a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);virtual;
  54. procedure a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);virtual;
  55. procedure a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);virtual;
  56. procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual;
  57. procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
  58. procedure g_maybe_loadself(list : paasmoutput);virtual;
  59. {********************************************************}
  60. { these methods can be overriden for extra functionality }
  61. { the following methods do nothing: }
  62. procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
  63. procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
  64. procedure g_profilecode(list : paasmoutput);virtual;
  65. procedure g_stackcheck(list : paasmoutput;stackframesize : longint);virtual;
  66. { passing parameters, per default the parameter is pushed }
  67. { nr gives the number of the parameter (enumerated from }
  68. { left to right), this allows to move the parameter to }
  69. { register, if the cpu supports register calling }
  70. { conventions }
  71. procedure a_param_reg(list : paasmoutput;r : tregister;nr : longint);virtual;
  72. procedure a_param_const8(list : paasmoutput;b : byte;nr : longint);virtual;
  73. procedure a_param_const16(list : paasmoutput;w : word;nr : longint);virtual;
  74. procedure a_param_const32(list : paasmoutput;l : longint;nr : longint);virtual;
  75. procedure a_param_const64(list : paasmoutput;q : qword;nr : longint);virtual;
  76. end;
  77. var
  78. cg : pcg; { this is the main code generator class }
  79. implementation
  80. uses
  81. globals,globtype,options,files,gdb,systems,
  82. ppu,cgbase,temp_gen,verbose,types
  83. {$ifdef i386}
  84. ,tgeni386
  85. {$endif i386}
  86. ;
  87. {*****************************************************************************
  88. per default, this methods nothing, can overriden
  89. *****************************************************************************}
  90. procedure tcg.g_interrupt_stackframe_entry(list : paasmoutput);
  91. begin
  92. end;
  93. procedure tcg.g_interrupt_stackframe_exit(list : paasmoutput);
  94. begin
  95. end;
  96. procedure tcg.g_profilecode(list : paasmoutput);
  97. begin
  98. end;
  99. procedure tcg.a_param_reg(list : paasmoutput;r : tregister;nr : longint);
  100. begin
  101. a_push_reg(list,r);
  102. end;
  103. procedure tcg.a_param_const8(list : paasmoutput;b : byte;nr : longint);
  104. begin
  105. {!!!!!!!! a_push_const8(list,b); }
  106. end;
  107. procedure tcg.a_param_const16(list : paasmoutput;w : word;nr : longint);
  108. begin
  109. {!!!!!!!! a_push_const16(list,w); }
  110. end;
  111. procedure tcg.a_param_const32(list : paasmoutput;l : longint;nr : longint);
  112. begin
  113. {!!!!!!!! a_push_const32(list,l); }
  114. end;
  115. procedure tcg.a_param_const64(list : paasmoutput;q : qword;nr : longint);
  116. begin
  117. {!!!!!!!! a_push_const64(list,q); }
  118. end;
  119. procedure tcg.g_stackcheck(list : paasmoutput;stackframesize : longint);
  120. begin
  121. a_param_const32(list,stackframesize,1);
  122. a_call_name_ext(list,'FPC_STACKCHECK',0,EXT_NEAR);
  123. end;
  124. procedure tcg.a_call_name_ext(list : paasmoutput;const s : string;
  125. offset : longint;m : texternal_typ);
  126. begin
  127. a_call_name(list,s,offset);
  128. concat_external(s,m);
  129. end;
  130. {*****************************************************************************
  131. String helper routines
  132. *****************************************************************************}
  133. procedure tcg.g_removetemps(list : paasmoutput;p : plinkedlist);
  134. var
  135. hp : ptemptodestroy;
  136. pushedregs : tpushed;
  137. begin
  138. hp:=ptemptodestroy(p^.first);
  139. if not(assigned(hp)) then
  140. exit;
  141. pushusedregisters(pushedregs,$ff);
  142. while assigned(hp) do
  143. begin
  144. if is_ansistring(hp^.typ) then
  145. begin
  146. g_decransiref(hp^.address);
  147. ungetiftemp(hp^.address);
  148. end;
  149. hp:=ptemptodestroy(hp^.next);
  150. end;
  151. popusedregisters(pushedregs);
  152. end;
  153. procedure tcg.g_decransiref(const ref : treference);
  154. begin
  155. {!!!!!!!!!}
  156. { emitpushreferenceaddr(exprasmlist,ref);
  157. emitcall('FPC_ANSISTR_DECR_REF',true); }
  158. end;
  159. {*****************************************************************************
  160. Code generation for subroutine entry- and exit code
  161. *****************************************************************************}
  162. { generates the code for initialisation of local data }
  163. procedure tcg.g_initialize_data(p : psym);
  164. var
  165. r : preference;
  166. hr : treference;
  167. begin
  168. {$ifdef dummy}
  169. if (p^.typ=varsym) and
  170. assigned(pvarsym(p)^.definition) and
  171. pvarsym(p)^.definition^.needs_inittable and
  172. not((pvarsym(p)^.definition^.deftype=objectdef) and
  173. pobjectdef(pvarsym(p)^.definition)^.isclass) then
  174. begin
  175. if is_ansistring(pvarsym(p)^.definition) or
  176. is_widestring(pvarsym(p)^.definition) then
  177. begin
  178. new(r);
  179. reset_reference(r^);
  180. if p^.owner^.symtabletype=localsymtable then
  181. begin
  182. r^.base:=procinfo.framepointer;
  183. r^.offset:=-pvarsym(p)^.address;
  184. end
  185. else
  186. r^.symbol:=stringdup(pvarsym(p)^.mangledname);
  187. curlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,r)));
  188. end
  189. else
  190. begin
  191. reset_reference(hr);
  192. hr.symbol:=stringdup(lab2str(pvarsym(p)^.definition^.get_inittable_label));
  193. emitpushreferenceaddr(curlist,hr);
  194. clear_reference(hr);
  195. if p^.owner^.symtabletype=localsymtable then
  196. begin
  197. hr.base:=procinfo.framepointer;
  198. hr.offset:=-pvarsym(p)^.address;
  199. end
  200. else
  201. begin
  202. hr.symbol:=stringdup(pvarsym(p)^.mangledname);
  203. end;
  204. emitpushreferenceaddr(curlist,hr);
  205. clear_reference(hr);
  206. curlist^.concat(new(pai386,
  207. op_csymbol(A_CALL,S_NO,newcsymbol('FPC_INITIALIZE',0))));
  208. if not(cs_compilesystem in aktmoduleswitches) then
  209. concat_external('FPC_INITIALIZE',EXT_NEAR);
  210. end;
  211. end;
  212. {$endif dummy}
  213. end;
  214. { generates the code for incrementing the reference count of parameters }
  215. procedure tcg.g_incr_data(p : psym);
  216. var
  217. hr : treference;
  218. begin
  219. {$ifdef dummy}
  220. if (p^.typ=varsym) and
  221. pvarsym(p)^.definition^.needs_inittable and
  222. ((pvarsym(p)^.varspez=vs_value) {or
  223. (pvarsym(p)^.varspez=vs_const) and
  224. not(dont_copy_const_param(pvarsym(p)^.definition))}) and
  225. not((pvarsym(p)^.definition^.deftype=objectdef) and
  226. pobjectdef(pvarsym(p)^.definition)^.isclass) then
  227. begin
  228. reset_reference(hr);
  229. hr.symbol:=stringdup(lab2str(pvarsym(p)^.definition^.get_inittable_label));
  230. emitpushreferenceaddr(curlist,hr);
  231. clear_reference(hr);
  232. hr.base:=procinfo.framepointer;
  233. hr.offset:=pvarsym(p)^.address+procinfo.call_offset;
  234. emitpushreferenceaddr(curlist,hr);
  235. clear_reference(hr);
  236. curlist^.concat(new(pai386,
  237. op_csymbol(A_CALL,S_NO,newcsymbol('FPC_ADDREF',0))));
  238. if not (cs_compilesystem in aktmoduleswitches) then
  239. concat_external('FPC_ADDREF',EXT_NEAR);
  240. end;
  241. {$endif}
  242. end;
  243. { generates the code for finalisation of local data }
  244. procedure tcg.g_finalize_data(p : psym);
  245. var
  246. hr : treference;
  247. begin
  248. {$ifdef dummy}
  249. if (p^.typ=varsym) and
  250. assigned(pvarsym(p)^.definition) and
  251. pvarsym(p)^.definition^.needs_inittable and
  252. not((pvarsym(p)^.definition^.deftype=objectdef) and
  253. pobjectdef(pvarsym(p)^.definition)^.isclass) then
  254. begin
  255. { not all kind of parameters need to be finalized }
  256. if (p^.owner^.symtabletype=parasymtable) and
  257. ((pvarsym(p)^.varspez=vs_var) or
  258. (pvarsym(p)^.varspez=vs_const) { and
  259. (dont_copy_const_param(pvarsym(p)^.definition)) } ) then
  260. exit;
  261. reset_reference(hr);
  262. hr.symbol:=stringdup(lab2str(pvarsym(p)^.definition^.get_inittable_label));
  263. emitpushreferenceaddr(curlist,hr);
  264. clear_reference(hr);
  265. case p^.owner^.symtabletype of
  266. localsymtable:
  267. begin
  268. hr.base:=procinfo.framepointer;
  269. hr.offset:=-pvarsym(p)^.address;
  270. end;
  271. parasymtable:
  272. begin
  273. hr.base:=procinfo.framepointer;
  274. hr.offset:=pvarsym(p)^.address+procinfo.call_offset;
  275. end;
  276. else
  277. hr.symbol:=stringdup(pvarsym(p)^.mangledname);
  278. end;
  279. emitpushreferenceaddr(curlist,hr);
  280. clear_reference(hr);
  281. curlist^.concat(new(pai386,
  282. op_csymbol(A_CALL,S_NO,newcsymbol('FPC_FINALIZE',0))));
  283. if not (cs_compilesystem in aktmoduleswitches) then
  284. concat_external('FPC_FINALIZE',EXT_NEAR);
  285. end;
  286. {$endif dummy}
  287. end;
  288. { generates the code to make local copies of the value parameters }
  289. {$ifndef VALUEPARA}
  290. procedure tcg.g_copyopenarrays(p : psym);
  291. {$else}
  292. procedure tcg.g_copyvalueparas(p : psym);
  293. {$endif}
  294. var
  295. {$ifdef VALUEPARA}
  296. href1,href2 : treference;
  297. {$endif}
  298. r : preference;
  299. len : longint;
  300. opsize : topsize;
  301. oldexprasmlist : paasmoutput;
  302. begin
  303. {$ifdef dummy}
  304. if (p^.typ=varsym) and
  305. {$ifdef VALUEPARA}
  306. (pvarsym(p)^.varspez=vs_value) and
  307. (push_addr_param(pvarsym(p)^.definition)) then
  308. {$else}
  309. (pvarsym(p)^.varspez=vs_value) then
  310. {$endif}
  311. begin
  312. oldexprasmlist:=exprasmlist;
  313. exprasmlist:=curlist;
  314. {$ifdef VALUEPARA}
  315. {$ifdef GDB}
  316. if (cs_debuginfo in aktmoduleswitches) and
  317. (exprasmlist^.first=exprasmlist^.last) then
  318. exprasmlist^.concat(new(pai_force_line,init));
  319. {$endif GDB}
  320. {$endif}
  321. if is_open_array(pvarsym(p)^.definition) then
  322. begin
  323. { get stack space }
  324. new(r);
  325. reset_reference(r^);
  326. r^.base:=procinfo.framepointer;
  327. r^.offset:=pvarsym(p)^.address+4+procinfo.call_offset;
  328. curlist^.concat(new(pai386,
  329. op_ref_reg(A_MOV,S_L,r,R_EDI)));
  330. curlist^.concat(new(pai386,
  331. op_reg(A_INC,S_L,R_EDI)));
  332. curlist^.concat(new(pai386,
  333. op_const_reg(A_IMUL,S_L,
  334. parraydef(pvarsym(p)^.definition)^.definition^.size,R_EDI)));
  335. curlist^.concat(new(pai386,
  336. op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
  337. { load destination }
  338. curlist^.concat(new(pai386,
  339. op_reg_reg(A_MOV,S_L,R_ESP,R_EDI)));
  340. { don't destroy the registers! }
  341. curlist^.concat(new(pai386,
  342. op_reg(A_PUSH,S_L,R_ECX)));
  343. curlist^.concat(new(pai386,
  344. op_reg(A_PUSH,S_L,R_ESI)));
  345. { load count }
  346. new(r);
  347. reset_reference(r^);
  348. r^.base:=procinfo.framepointer;
  349. r^.offset:=pvarsym(p)^.address+4+procinfo.call_offset;
  350. curlist^.concat(new(pai386,
  351. op_ref_reg(A_MOV,S_L,r,R_ECX)));
  352. { load source }
  353. new(r);
  354. reset_reference(r^);
  355. r^.base:=procinfo.framepointer;
  356. r^.offset:=pvarsym(p)^.address+procinfo.call_offset;
  357. curlist^.concat(new(pai386,
  358. op_ref_reg(A_MOV,S_L,r,R_ESI)));
  359. { scheduled .... }
  360. curlist^.concat(new(pai386,
  361. op_reg(A_INC,S_L,R_ECX)));
  362. { calculate size }
  363. len:=parraydef(pvarsym(p)^.definition)^.definition^.size;
  364. if (len and 3)=0 then
  365. begin
  366. opsize:=S_L;
  367. len:=len shr 2;
  368. end
  369. else
  370. if (len and 1)=0 then
  371. begin
  372. opsize:=S_W;
  373. len:=len shr 1;
  374. end;
  375. curlist^.concat(new(pai386,
  376. op_const_reg(A_IMUL,S_L,len,R_ECX)));
  377. curlist^.concat(new(pai386,
  378. op_none(A_REP,S_NO)));
  379. curlist^.concat(new(pai386,
  380. op_none(A_MOVS,opsize)));
  381. curlist^.concat(new(pai386,
  382. op_reg(A_POP,S_L,R_ESI)));
  383. curlist^.concat(new(pai386,
  384. op_reg(A_POP,S_L,R_ECX)));
  385. { patch the new address }
  386. new(r);
  387. reset_reference(r^);
  388. r^.base:=procinfo.framepointer;
  389. r^.offset:=pvarsym(p)^.address+procinfo.call_offset;
  390. curlist^.concat(new(pai386,
  391. op_reg_ref(A_MOV,S_L,R_ESP,r)));
  392. end
  393. {$ifdef VALUEPARA}
  394. else
  395. if is_shortstring(pvarsym(p)^.definition) then
  396. begin
  397. reset_reference(href1);
  398. href1.base:=procinfo.framepointer;
  399. href1.offset:=pvarsym(p)^.address+procinfo.call_offset;
  400. reset_reference(href2);
  401. href2.base:=procinfo.framepointer;
  402. href2.offset:=-pvarsym(p)^.localaddress;
  403. copyshortstring(href2,href1,pstringdef(pvarsym(p)^.definition)^.len,true);
  404. end
  405. else
  406. begin
  407. reset_reference(href1);
  408. href1.base:=procinfo.framepointer;
  409. href1.offset:=pvarsym(p)^.address+procinfo.call_offset;
  410. reset_reference(href2);
  411. href2.base:=procinfo.framepointer;
  412. href2.offset:=-pvarsym(p)^.localaddress;
  413. concatcopy(href1,href2,pvarsym(p)^.definition^.size,true,true);
  414. end;
  415. {$else}
  416. ;
  417. {$endif}
  418. exprasmlist:=oldexprasmlist;
  419. end;
  420. {$endif dummy}
  421. end;
  422. { wrappers for the methods, because TP doesn't know procedures }
  423. { of objects }
  424. procedure _copyopenarrays(s : psym);{$ifndef FPC}far;{$endif}
  425. begin
  426. cg^.g_copyopenarrays(s);
  427. end;
  428. procedure _finalize_data(s : psym);{$ifndef FPC}far;{$endif}
  429. begin
  430. cg^.g_finalize_data(s);
  431. end;
  432. procedure _incr_data(s : psym);{$ifndef FPC}far;{$endif}
  433. begin
  434. cg^.g_incr_data(s);
  435. end;
  436. procedure _initialize_data(s : psym);{$ifndef FPC}far;{$endif}
  437. begin
  438. cg^.g_initialize_data(s);
  439. end;
  440. { generates the entry code for a procedure }
  441. procedure tcg.g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
  442. stackframe:longint;var parasize:longint;var nostackframe:boolean;
  443. inlined : boolean);
  444. var
  445. hs : string;
  446. hp : pused_unit;
  447. unitinits,initcode : taasmoutput;
  448. {$ifdef GDB}
  449. stab_function_name : Pai_stab_function_name;
  450. {$endif GDB}
  451. hr : treference;
  452. r : tregister;
  453. begin
  454. { Align }
  455. if (not inlined) then
  456. begin
  457. { gprof uses 16 byte granularity !! }
  458. if (cs_profile in aktmoduleswitches) then
  459. list^.insert(new(pai_align,init_op(16,$90)))
  460. else
  461. if not(cs_littlesize in aktglobalswitches) then
  462. list^.insert(new(pai_align,init(4)));
  463. end;
  464. if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
  465. begin
  466. { needs the target a console flags ? }
  467. if tf_needs_isconsole in target_info.flags then
  468. begin
  469. hr.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE');
  470. if apptype=at_cui then
  471. a_load_const8_ref(list,1,hr)
  472. else
  473. a_load_const8_ref(list,0,hr);
  474. stringdispose(hr.symbol);
  475. end;
  476. { Call the unit init procedures }
  477. unitinits.init;
  478. hp:=pused_unit(usedunits.first);
  479. while assigned(hp) do
  480. begin
  481. { call the unit init code and make it external }
  482. if (hp^.u^.flags and uf_init)<>0 then
  483. a_call_name_ext(@unitinits,
  484. 'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR);
  485. hp:=Pused_unit(hp^.next);
  486. end;
  487. list^.insertlist(@unitinits);
  488. unitinits.done;
  489. end;
  490. { a constructor needs a help procedure }
  491. if (aktprocsym^.definition^.options and poconstructor)<>0 then
  492. begin
  493. if procinfo._class^.isclass then
  494. begin
  495. list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
  496. list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  497. newcsymbol('FPC_NEW_CLASS',0))));
  498. concat_external('FPC_NEW_CLASS',EXT_NEAR);
  499. end
  500. else
  501. begin
  502. list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
  503. list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
  504. newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
  505. list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
  506. concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
  507. end;
  508. end;
  509. {$ifdef GDB}
  510. if (cs_debuginfo in aktmoduleswitches) then
  511. list^.insert(new(pai_force_line,init));
  512. {$endif GDB}
  513. { save registers on cdecl }
  514. if ((aktprocsym^.definition^.options and pocdecl)<>0) then
  515. begin
  516. for r:=firstregister to lastregister do
  517. begin
  518. if (r in registers_saved_on_cdecl) then
  519. if (r in general_registers) then
  520. begin
  521. if not(r in unused) then
  522. a_push_reg(list,r)
  523. end
  524. else
  525. a_push_reg(list,r);
  526. end;
  527. end;
  528. { omit stack frame ? }
  529. if not inlined then
  530. if procinfo.framepointer=stack_pointer then
  531. begin
  532. CGMessage(cg_d_stackframe_omited);
  533. nostackframe:=true;
  534. if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
  535. parasize:=0
  536. else
  537. parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-4;
  538. end
  539. else
  540. begin
  541. if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
  542. parasize:=0
  543. else
  544. parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
  545. nostackframe:=false;
  546. if (aktprocsym^.definition^.options and pointerrupt)<>0 then
  547. g_interrupt_stackframe_entry(list);
  548. g_stackframe_entry(list,stackframe);
  549. if (cs_check_stack in aktlocalswitches) and
  550. (tf_supports_stack_checking in target_info.flags) then
  551. g_stackcheck(@initcode,stackframe);
  552. end;
  553. if cs_profile in aktmoduleswitches then
  554. g_profilecode(@initcode);
  555. { initialize return value }
  556. if is_ansistring(procinfo.retdef) or
  557. is_widestring(procinfo.retdef) then
  558. begin
  559. reset_reference(hr);
  560. hr.offset:=procinfo.retoffset;
  561. hr.base:=procinfo.framepointer;
  562. a_load_const32_ref(list,0,hr);
  563. end;
  564. { generate copies of call by value parameters }
  565. if (aktprocsym^.definition^.options and poassembler=0) then
  566. begin
  567. {$ifndef VALUEPARA}
  568. aktprocsym^.definition^.parast^.foreach(_copyopenarrays);
  569. {$else}
  570. aktprocsym^.definition^.parast^.foreach(_copyvalueparas);
  571. {$endif}
  572. end;
  573. { initialisizes local data }
  574. aktprocsym^.definition^.localst^.foreach(_initialize_data);
  575. { add a reference to all call by value/const parameters }
  576. aktprocsym^.definition^.parast^.foreach(_incr_data);
  577. if (cs_profile in aktmoduleswitches) or
  578. (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
  579. (assigned(procinfo._class) and (procinfo._class^.owner^.symtabletype=globalsymtable)) then
  580. make_global:=true;
  581. if not inlined then
  582. begin
  583. hs:=proc_names.get;
  584. {$ifdef GDB}
  585. if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
  586. stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
  587. {$endif GDB}
  588. { insert the names for the procedure }
  589. while hs<>'' do
  590. begin
  591. if make_global then
  592. list^.insert(new(pai_symbol,init_global(hs)))
  593. else
  594. list^.insert(new(pai_symbol,init(hs)));
  595. {$ifdef GDB}
  596. if (cs_debuginfo in aktmoduleswitches) then
  597. begin
  598. if target_os.use_function_relative_addresses then
  599. list^.insert(new(pai_stab_function_name,init(strpnew(hs))));
  600. end;
  601. {$endif GDB}
  602. hs:=proc_names.get;
  603. end;
  604. end;
  605. {$ifdef GDB}
  606. if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
  607. begin
  608. if target_os.use_function_relative_addresses then
  609. list^.insert(stab_function_name);
  610. if make_global or ((procinfo.flags and pi_is_global) <> 0) then
  611. aktprocsym^.is_global := True;
  612. list^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
  613. aktprocsym^.isstabwritten:=true;
  614. end;
  615. {$endif GDB}
  616. end;
  617. {*****************************************************************************
  618. some abstract definitions
  619. ****************************************************************************}
  620. procedure tcg.a_push_reg(list : paasmoutput;r : tregister);
  621. begin
  622. abstract;
  623. end;
  624. procedure tcg.a_call_name(list : paasmoutput;const s : string;
  625. offset : longint);
  626. begin
  627. abstract;
  628. end;
  629. procedure tcg.a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);
  630. begin
  631. abstract;
  632. end;
  633. procedure tcg.a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);
  634. begin
  635. abstract;
  636. end;
  637. procedure tcg.a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);
  638. begin
  639. abstract;
  640. end;
  641. procedure tcg.a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);
  642. begin
  643. abstract;
  644. end;
  645. procedure tcg.g_stackframe_entry(list : paasmoutput;localsize : longint);
  646. begin
  647. abstract;
  648. end;
  649. procedure tcg.g_maybe_loadself(list : paasmoutput);
  650. begin
  651. abstract;
  652. end;
  653. end.
  654. {
  655. $Log$
  656. Revision 1.3 1998-12-26 15:20:30 florian
  657. + more changes for the new version
  658. Revision 1.2 1998/12/15 22:18:55 florian
  659. * some code added
  660. Revision 1.1 1998/12/15 16:32:58 florian
  661. + first version, derived from old routines
  662. }