pdecsub.pas 88 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione
  4. Does the parsing of the procedures/functions
  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 pdecsub;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. tokens,symconst,symtype,symdef,symsym;
  23. type
  24. tpdflag=(
  25. pd_body, { directive needs a body }
  26. pd_implemen, { directive can be used implementation section }
  27. pd_interface, { directive can be used interface section }
  28. pd_object, { directive can be used object declaration }
  29. pd_procvar, { directive can be used procvar declaration }
  30. pd_notobject, { directive can not be used object declaration }
  31. pd_notobjintf, { directive can not be used interface declaration }
  32. pd_notprocvar { directive can not be used procvar declaration }
  33. );
  34. tpdflags=set of tpdflag;
  35. function check_proc_directive(isprocvar:boolean):boolean;
  36. procedure insert_funcret_local(pd:tprocdef);
  37. function proc_add_definition(var pd:tprocdef):boolean;
  38. function proc_get_importname(pd:tprocdef):string;
  39. procedure proc_set_mangledname(pd:tprocdef);
  40. procedure handle_calling_convention(pd:tabstractprocdef);
  41. procedure parse_parameter_dec(pd:tabstractprocdef);
  42. procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
  43. procedure parse_var_proc_directives(sym:tsym);
  44. procedure parse_object_proc_directives(pd:tabstractprocdef);
  45. function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
  46. function parse_proc_dec(aclass:tobjectdef):tprocdef;
  47. implementation
  48. uses
  49. strings,
  50. { common }
  51. cutils,cclasses,
  52. { global }
  53. globtype,globals,verbose,
  54. systems,
  55. cpuinfo,
  56. { symtable }
  57. symbase,symtable,defutil,defcmp,paramgr,cpupara,
  58. { pass 1 }
  59. node,htypechk,
  60. nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
  61. { parser }
  62. scanner,
  63. pbase,pexpr,ptype,pdecl
  64. ;
  65. const
  66. { Please leave this here, this module should NOT use
  67. these variables.
  68. Declaring it as string here results in an error when compiling (PFV) }
  69. current_procinfo = 'error';
  70. procedure insert_funcret_para(pd:tabstractprocdef);
  71. var
  72. storepos : tfileposinfo;
  73. vs : tparavarsym;
  74. paranr : word;
  75. begin
  76. if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
  77. not is_void(pd.rettype.def) and
  78. paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
  79. begin
  80. storepos:=akttokenpos;
  81. if pd.deftype=procdef then
  82. akttokenpos:=tprocdef(pd).fileinfo;
  83. { For left to right add it at the end to be delphi compatible }
  84. if pd.proccalloption in pushleftright_pocalls then
  85. paranr:=paranr_result_leftright
  86. else
  87. paranr:=paranr_result;
  88. { Generate result variable accessing function result }
  89. vs:=tparavarsym.create('$result',paranr,vs_var,pd.rettype,[vo_is_funcret,vo_is_hidden_para]);
  90. pd.parast.insert(vs);
  91. { Store the this symbol as funcretsym for procedures }
  92. if pd.deftype=procdef then
  93. tprocdef(pd).funcretsym:=vs;
  94. akttokenpos:=storepos;
  95. end;
  96. end;
  97. procedure insert_parentfp_para(pd:tabstractprocdef);
  98. var
  99. storepos : tfileposinfo;
  100. vs : tparavarsym;
  101. begin
  102. if pd.parast.symtablelevel>normal_function_level then
  103. begin
  104. storepos:=akttokenpos;
  105. if pd.deftype=procdef then
  106. akttokenpos:=tprocdef(pd).fileinfo;
  107. { Generate result variable accessing function result, it
  108. can't be put in a register since it must be accessable
  109. from the framepointer }
  110. vs:=tparavarsym.create('$parentfp',paranr_parentfp,vs_var,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
  111. vs.varregable:=vr_none;
  112. pd.parast.insert(vs);
  113. akttokenpos:=storepos;
  114. end;
  115. end;
  116. procedure insert_self_and_vmt_para(pd:tabstractprocdef);
  117. var
  118. storepos : tfileposinfo;
  119. vs : tparavarsym;
  120. tt : ttype;
  121. vsp : tvarspez;
  122. begin
  123. if (pd.deftype=procvardef) and
  124. pd.is_methodpointer then
  125. begin
  126. { Generate self variable }
  127. tt:=voidpointertype;
  128. vs:=tparavarsym.create('$self',paranr_self,vs_value,tt,[vo_is_self,vo_is_hidden_para]);
  129. pd.parast.insert(vs);
  130. end
  131. else
  132. begin
  133. if (pd.deftype=procdef) and
  134. assigned(tprocdef(pd)._class) and
  135. (pd.parast.symtablelevel=normal_function_level) then
  136. begin
  137. storepos:=akttokenpos;
  138. akttokenpos:=tprocdef(pd).fileinfo;
  139. { Generate VMT variable for constructor/destructor }
  140. if pd.proctypeoption in [potype_constructor,potype_destructor] then
  141. begin
  142. { can't use classrefdef as type because inheriting
  143. will then always file because of a type mismatch }
  144. tt:=voidpointertype;
  145. vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,tt,[vo_is_vmt,vo_is_hidden_para]);
  146. pd.parast.insert(vs);
  147. end;
  148. { Generate self variable, for classes we need
  149. to use the generic voidpointer to be compatible with
  150. methodpointers }
  151. vsp:=vs_value;
  152. if (po_staticmethod in pd.procoptions) or
  153. (po_classmethod in pd.procoptions) then
  154. begin
  155. tt.setdef(tprocdef(pd)._class);
  156. tt.setdef(tclassrefdef.create(tt));
  157. end
  158. else
  159. begin
  160. if is_object(tprocdef(pd)._class) then
  161. vsp:=vs_var;
  162. tt.setdef(tprocdef(pd)._class);
  163. end;
  164. vs:=tparavarsym.create('$self',paranr_self,vsp,tt,[vo_is_self,vo_is_hidden_para]);
  165. pd.parast.insert(vs);
  166. akttokenpos:=storepos;
  167. end;
  168. end;
  169. end;
  170. procedure insert_funcret_local(pd:tprocdef);
  171. var
  172. storepos : tfileposinfo;
  173. vs : tlocalvarsym;
  174. aliasvs : tabsolutevarsym;
  175. sl : tsymlist;
  176. begin
  177. { The result from constructors and destructors can't be accessed directly }
  178. if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
  179. not is_void(pd.rettype.def) then
  180. begin
  181. storepos:=akttokenpos;
  182. akttokenpos:=pd.fileinfo;
  183. { We always need a localsymtable }
  184. if not assigned(pd.localst) then
  185. pd.insert_localst;
  186. { We need to insert a varsym for the result in the localst
  187. when it is returning in a register }
  188. if not paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
  189. begin
  190. vs:=tlocalvarsym.create('$result',vs_value,pd.rettype,[vo_is_funcret]);
  191. pd.localst.insert(vs);
  192. pd.funcretsym:=vs;
  193. end;
  194. { insert the name of the procedure as alias for the function result,
  195. we can't use realname because that will not work for compilerprocs
  196. as the name is lowercase and unreachable from the code }
  197. if pd.resultname='' then
  198. pd.resultname:=pd.procsym.name;
  199. sl:=tsymlist.create;
  200. sl.addsym(sl_load,pd.funcretsym);
  201. aliasvs:=tabsolutevarsym.create_ref(pd.resultname,pd.rettype,sl);
  202. include(aliasvs.varoptions,vo_is_funcret);
  203. pd.localst.insert(aliasvs);
  204. { insert result also if support is on }
  205. if (m_result in aktmodeswitches) then
  206. begin
  207. sl:=tsymlist.create;
  208. sl.addsym(sl_load,pd.funcretsym);
  209. aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.rettype,sl);
  210. include(aliasvs.varoptions,vo_is_funcret);
  211. include(aliasvs.varoptions,vo_is_result);
  212. pd.localst.insert(aliasvs);
  213. end;
  214. akttokenpos:=storepos;
  215. end;
  216. end;
  217. procedure insert_hidden_para(p:tnamedindexitem;arg:pointer);
  218. var
  219. hvs : tparavarsym;
  220. pd : tabstractprocdef absolute arg;
  221. begin
  222. if (tsym(p).typ<>paravarsym) then
  223. exit;
  224. with tparavarsym(p) do
  225. begin
  226. { We need a local copy for a value parameter when only the
  227. address is pushed. Open arrays and Array of Const are
  228. an exception because they are allocated at runtime and the
  229. address that is pushed is patched }
  230. if (varspez=vs_value) and
  231. paramanager.push_addr_param(varspez,vartype.def,pd.proccalloption) and
  232. not(is_open_array(vartype.def) or
  233. is_array_of_const(vartype.def)) then
  234. include(varoptions,vo_has_local_copy);
  235. { needs high parameter ? }
  236. if paramanager.push_high_param(varspez,vartype.def,pd.proccalloption) then
  237. begin
  238. hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
  239. owner.insert(hvs);
  240. end
  241. else
  242. begin
  243. { Give a warning that cdecl routines does not include high()
  244. support }
  245. if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
  246. paramanager.push_high_param(varspez,vartype.def,pocall_default) then
  247. begin
  248. if is_open_string(vartype.def) then
  249. Message(parser_w_cdecl_no_openstring);
  250. if not (po_external in pd.procoptions) then
  251. Message(parser_w_cdecl_has_no_high);
  252. end;
  253. end;
  254. end;
  255. end;
  256. procedure check_c_para(p:tnamedindexitem;arg:pointer);
  257. begin
  258. if (tsym(p).typ<>paravarsym) then
  259. exit;
  260. with tparavarsym(p) do
  261. begin
  262. case vartype.def.deftype of
  263. arraydef :
  264. begin
  265. if not is_variant_array(vartype.def) and
  266. not is_array_of_const(vartype.def) then
  267. begin
  268. if (varspez<>vs_var) then
  269. Message(parser_h_c_arrays_are_references);
  270. end;
  271. if is_array_of_const(vartype.def) and
  272. assigned(indexnext) and
  273. (tsym(indexnext).typ=paravarsym) and
  274. not(vo_is_high_para in tparavarsym(indexnext).varoptions) then
  275. Message(parser_e_C_array_of_const_must_be_last);
  276. end;
  277. end;
  278. end;
  279. end;
  280. procedure check_msg_para(p:tnamedindexitem;arg:pointer);
  281. begin
  282. if (tsym(p).typ<>paravarsym) then
  283. exit;
  284. with tparavarsym(p) do
  285. begin
  286. { Count parameters }
  287. if (paranr>=10) then
  288. inc(plongint(arg)^);
  289. { First parameter must be var }
  290. if (paranr=10) and
  291. (varspez<>vs_var) then
  292. Message(parser_e_ill_msg_param);
  293. end;
  294. end;
  295. procedure check_inline_para(p:tnamedindexitem;arg:pointer);
  296. var
  297. pd : tabstractprocdef absolute arg;
  298. begin
  299. if (pd.proccalloption<>pocall_inline) or
  300. (tsym(p).typ<>paravarsym) then
  301. exit;
  302. with tparavarsym(p) do
  303. begin
  304. case vartype.def.deftype of
  305. arraydef :
  306. begin
  307. with tarraydef(vartype.def) do
  308. if IsVariant or IsConstructor then
  309. begin
  310. Message1(parser_w_not_supported_for_inline,'array of const');
  311. Message(parser_w_inlining_disabled);
  312. pd.proccalloption:=pocall_default;
  313. end;
  314. end;
  315. end;
  316. end;
  317. end;
  318. procedure set_addr_param_regable(p:tnamedindexitem;arg:pointer);
  319. begin
  320. if (tsym(p).typ<>paravarsym) then
  321. exit;
  322. with tparavarsym(p) do
  323. begin
  324. if not vartype.def.needs_inittable and
  325. paramanager.push_addr_param(varspez,vartype.def,tprocdef(arg).proccalloption) then
  326. varregable:=vr_intreg;
  327. end;
  328. end;
  329. procedure parse_parameter_dec(pd:tabstractprocdef);
  330. {
  331. handle_procvar needs the same changes
  332. }
  333. type
  334. tppv = (pv_none,pv_proc,pv_func);
  335. var
  336. sc : tsinglelist;
  337. tt : ttype;
  338. arrayelementtype : ttype;
  339. vs : tparavarsym;
  340. srsym : tsym;
  341. pv : tprocvardef;
  342. varspez : Tvarspez;
  343. defaultvalue : tconstsym;
  344. defaultrequired : boolean;
  345. old_object_option : tsymoptions;
  346. currparast : tparasymtable;
  347. parseprocvar : tppv;
  348. explicit_paraloc : boolean;
  349. locationstr : string;
  350. paranr : integer;
  351. dummytype : ttypesym;
  352. begin
  353. explicit_paraloc:=false;
  354. consume(_LKLAMMER);
  355. { Delphi/Kylix supports nonsense like }
  356. { procedure p(); }
  357. if try_to_consume(_RKLAMMER) and
  358. not(m_tp7 in aktmodeswitches) then
  359. exit;
  360. { parsing a proc or procvar ? }
  361. currparast:=tparasymtable(pd.parast);
  362. { reset }
  363. sc:=tsinglelist.create;
  364. defaultrequired:=false;
  365. paranr:=0;
  366. { the variables are always public }
  367. old_object_option:=current_object_option;
  368. current_object_option:=[sp_public];
  369. inc(testcurobject);
  370. repeat
  371. parseprocvar:=pv_none;
  372. if try_to_consume(_VAR) then
  373. varspez:=vs_var
  374. else
  375. if try_to_consume(_CONST) then
  376. varspez:=vs_const
  377. else
  378. if (m_out in aktmodeswitches) and
  379. try_to_consume(_OUT) then
  380. varspez:=vs_out
  381. else
  382. if (m_mac in aktmodeswitches) and
  383. try_to_consume(_POINTPOINTPOINT) then
  384. begin
  385. include(pd.procoptions,po_varargs);
  386. break;
  387. end
  388. else
  389. if (m_mac in aktmodeswitches) and
  390. try_to_consume(_PROCEDURE) then
  391. begin
  392. parseprocvar:=pv_proc;
  393. varspez:=vs_const;
  394. end
  395. else
  396. if (m_mac in aktmodeswitches) and
  397. try_to_consume(_FUNCTION) then
  398. begin
  399. parseprocvar:=pv_func;
  400. varspez:=vs_const;
  401. end
  402. else
  403. varspez:=vs_value;
  404. defaultvalue:=nil;
  405. tt.reset;
  406. { read identifiers and insert with error type }
  407. sc.reset;
  408. repeat
  409. inc(paranr);
  410. vs:=tparavarsym.create(orgpattern,paranr*10,varspez,generrortype,[]);
  411. currparast.insert(vs);
  412. if assigned(vs.owner) then
  413. sc.insert(vs)
  414. else
  415. vs.free;
  416. consume(_ID);
  417. until not try_to_consume(_COMMA);
  418. locationstr:='';
  419. { macpas anonymous procvar }
  420. if parseprocvar<>pv_none then
  421. begin
  422. pv:=tprocvardef.create(normal_function_level);
  423. if token=_LKLAMMER then
  424. parse_parameter_dec(pv);
  425. if parseprocvar=pv_func then
  426. begin
  427. consume(_COLON);
  428. single_type(pv.rettype,false);
  429. end;
  430. tt.def:=pv;
  431. { possible proc directives }
  432. if check_proc_directive(true) then
  433. begin
  434. dummytype:=ttypesym.create('unnamed',tt);
  435. parse_var_proc_directives(tsym(dummytype));
  436. dummytype.restype.def:=nil;
  437. tt.def.typesym:=nil;
  438. dummytype.free;
  439. end;
  440. { Add implicit hidden parameters and function result }
  441. handle_calling_convention(pv);
  442. end
  443. else
  444. { read type declaration, force reading for value and const paras }
  445. if (token=_COLON) or (varspez=vs_value) then
  446. begin
  447. consume(_COLON);
  448. { check for an open array }
  449. if token=_ARRAY then
  450. begin
  451. consume(_ARRAY);
  452. consume(_OF);
  453. { define range and type of range }
  454. tt.setdef(tarraydef.create(0,-1,s32inttype));
  455. { array of const ? }
  456. if (token=_CONST) and (m_objpas in aktmodeswitches) then
  457. begin
  458. consume(_CONST);
  459. srsym:=searchsymonlyin(systemunit,'TVARREC');
  460. if not assigned(srsym) then
  461. InternalError(200404181);
  462. tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
  463. tarraydef(tt.def).IsArrayOfConst:=true;
  464. end
  465. else
  466. begin
  467. { define field type }
  468. single_type(arrayelementtype,false);
  469. tarraydef(tt.def).setelementtype(arrayelementtype);
  470. end;
  471. end
  472. else
  473. begin
  474. { open string ? }
  475. if (varspez=vs_var) and
  476. (
  477. (
  478. ((token=_STRING) or (idtoken=_SHORTSTRING)) and
  479. (cs_openstring in aktmoduleswitches) and
  480. not(cs_ansistrings in aktlocalswitches)
  481. ) or
  482. (idtoken=_OPENSTRING)) then
  483. begin
  484. consume(token);
  485. tt:=openshortstringtype;
  486. end
  487. else
  488. begin
  489. { everything else }
  490. if (m_mac in aktmodeswitches) then
  491. try_to_consume(_UNIV); {currently does nothing}
  492. single_type(tt,false);
  493. end;
  494. if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
  495. begin
  496. if (idtoken=_LOCATION) then
  497. begin
  498. consume(_LOCATION);
  499. locationstr:=pattern;
  500. consume(_CSTRING);
  501. end
  502. else
  503. begin
  504. if explicit_paraloc then
  505. Message(parser_e_paraloc_all_paras);
  506. locationstr:='';
  507. end;
  508. end
  509. else
  510. locationstr:='';
  511. { default parameter }
  512. if (m_default_para in aktmodeswitches) then
  513. begin
  514. if try_to_consume(_EQUAL) then
  515. begin
  516. vs:=tparavarsym(sc.first);
  517. if assigned(vs.listnext) then
  518. Message(parser_e_default_value_only_one_para);
  519. { prefix 'def' to the parameter name }
  520. defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
  521. if assigned(defaultvalue) then
  522. begin
  523. include(defaultvalue.symoptions,sp_internal);
  524. pd.parast.insert(defaultvalue);
  525. end;
  526. defaultrequired:=true;
  527. end
  528. else
  529. begin
  530. if defaultrequired then
  531. Message1(parser_e_default_value_expected_for_para,vs.name);
  532. end;
  533. end;
  534. end;
  535. end
  536. else
  537. tt:=cformaltype;
  538. { File types are only allowed for var parameters }
  539. if (tt.def.deftype=filedef) and
  540. (varspez<>vs_var) then
  541. CGMessage(cg_e_file_must_call_by_reference);
  542. vs:=tparavarsym(sc.first);
  543. while assigned(vs) do
  544. begin
  545. { update varsym }
  546. vs.vartype:=tt;
  547. vs.defaultconstsym:=defaultvalue;
  548. if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
  549. begin
  550. if locationstr<>'' then
  551. begin
  552. if assigned(sc.first.listnext) then
  553. Message(parser_e_paraloc_only_one_para);
  554. if (paranr>1) and not(explicit_paraloc) then
  555. Message(parser_e_paraloc_all_paras);
  556. explicit_paraloc:=true;
  557. include(vs.varoptions,vo_has_explicit_paraloc);
  558. if not(paramanager.parseparaloc(vs,upper(locationstr))) then
  559. message(parser_e_illegal_explicit_paraloc);
  560. end
  561. else
  562. if explicit_paraloc then
  563. Message(parser_e_paraloc_all_paras);
  564. end;
  565. vs:=tparavarsym(vs.listnext);
  566. end;
  567. until not try_to_consume(_SEMICOLON);
  568. if explicit_paraloc then
  569. begin
  570. pd.has_paraloc_info:=true;
  571. include(pd.procoptions,po_explicitparaloc);
  572. end;
  573. { remove parasymtable from stack }
  574. sc.free;
  575. { reset object options }
  576. dec(testcurobject);
  577. current_object_option:=old_object_option;
  578. consume(_RKLAMMER);
  579. end;
  580. function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
  581. var
  582. orgsp,sp : stringid;
  583. sym : tsym;
  584. srsym : tsym;
  585. srsymtable : tsymtable;
  586. storepos,
  587. procstartfilepos : tfileposinfo;
  588. searchagain : boolean;
  589. i : longint;
  590. st : tsymtable;
  591. aprocsym : tprocsym;
  592. begin
  593. { Save the position where this procedure really starts }
  594. procstartfilepos:=akttokenpos;
  595. result:=false;
  596. pd:=nil;
  597. aprocsym:=nil;
  598. if (potype=potype_operator) then
  599. begin
  600. sp:=overloaded_names[optoken];
  601. orgsp:=sp;
  602. end
  603. else
  604. begin
  605. sp:=pattern;
  606. orgsp:=orgpattern;
  607. consume(_ID);
  608. end;
  609. { examine interface map: function/procedure iname.functionname=locfuncname }
  610. if assigned(aclass) and
  611. assigned(aclass.implementedinterfaces) and
  612. (aclass.implementedinterfaces.count>0) and
  613. try_to_consume(_POINT) then
  614. begin
  615. storepos:=akttokenpos;
  616. akttokenpos:=procstartfilepos;
  617. { get interface syms}
  618. searchsym(sp,sym,srsymtable);
  619. if not assigned(sym) then
  620. begin
  621. identifier_not_found(orgsp);
  622. sym:=generrorsym;
  623. end;
  624. akttokenpos:=storepos;
  625. { qualifier is interface? }
  626. if (sym.typ=typesym) and
  627. (ttypesym(sym).restype.def.deftype=objectdef) then
  628. i:=aclass.implementedinterfaces.searchintf(ttypesym(sym).restype.def)
  629. else
  630. i:=-1;
  631. if (i=-1) then
  632. Message(parser_e_interface_id_expected);
  633. consume(_ID);
  634. consume(_EQUAL);
  635. if (token=_ID) then
  636. aclass.implementedinterfaces.addmappings(i,sp,pattern);
  637. consume(_ID);
  638. result:=true;
  639. exit;
  640. end;
  641. { method ? }
  642. if not assigned(aclass) and
  643. (potype<>potype_operator) and
  644. (symtablestack.symtablelevel=main_program_level) and
  645. try_to_consume(_POINT) then
  646. begin
  647. { search for object name }
  648. storepos:=akttokenpos;
  649. akttokenpos:=procstartfilepos;
  650. searchsym(sp,sym,srsymtable);
  651. if not assigned(sym) then
  652. begin
  653. identifier_not_found(orgsp);
  654. sym:=generrorsym;
  655. end;
  656. akttokenpos:=storepos;
  657. { consume proc name }
  658. sp:=pattern;
  659. orgsp:=orgpattern;
  660. procstartfilepos:=akttokenpos;
  661. consume(_ID);
  662. { qualifier is class name ? }
  663. if (sym.typ=typesym) and
  664. (ttypesym(sym).restype.def.deftype=objectdef) then
  665. begin
  666. aclass:=tobjectdef(ttypesym(sym).restype.def);
  667. aprocsym:=tprocsym(aclass.symtable.search(sp));
  668. { we solve this below }
  669. if assigned(aprocsym) then
  670. begin
  671. if aprocsym.typ<>procsym then
  672. begin
  673. { we use a different error message for tp7 so it looks more compatible }
  674. if (m_fpc in aktmodeswitches) then
  675. Message1(parser_e_overloaded_no_procedure,aprocsym.realname)
  676. else
  677. Message(parser_e_methode_id_expected);
  678. { rename the name to an unique name to avoid an
  679. error when inserting the symbol in the symtable }
  680. orgsp:=orgsp+'$'+tostr(aktfilepos.line);
  681. aprocsym:=nil;
  682. end;
  683. end
  684. else
  685. begin
  686. Message(parser_e_methode_id_expected);
  687. { recover by making it a normal procedure instead of method }
  688. aclass:=nil;
  689. end;
  690. end
  691. else
  692. Message(parser_e_class_id_expected);
  693. end
  694. else
  695. begin
  696. { check for constructor/destructor which is not allowed here }
  697. if (not parse_only) and
  698. (potype in [potype_constructor,potype_destructor]) then
  699. Message(parser_e_constructors_always_objects);
  700. repeat
  701. searchagain:=false;
  702. akttokenpos:=procstartfilepos;
  703. srsym:=tsym(symtablestack.search(sp));
  704. if not(parse_only) and
  705. not assigned(srsym) and
  706. (symtablestack.symtabletype=staticsymtable) and
  707. assigned(symtablestack.next) and
  708. (symtablestack.next.iscurrentunit) then
  709. begin
  710. { The procedure we prepare for is in the implementation
  711. part of the unit we compile. It is also possible that we
  712. are compiling a program, which is also some kind of
  713. implementaion part.
  714. We need to find out if the procedure is global. If it is
  715. global, it is in the global symtable.}
  716. srsym:=tsym(symtablestack.next.search(sp));
  717. end;
  718. { Check if overloaded is a procsym }
  719. if assigned(srsym) then
  720. begin
  721. if srsym.typ=procsym then
  722. aprocsym:=tprocsym(srsym)
  723. else
  724. begin
  725. { when the other symbol is a unit symbol then hide the unit
  726. symbol }
  727. if (srsym.typ=unitsym) then
  728. begin
  729. srsym.owner.rename(srsym.name,'hidden'+srsym.name);
  730. searchagain:=true;
  731. end
  732. else
  733. begin
  734. { we use a different error message for tp7 so it looks more compatible }
  735. if (m_fpc in aktmodeswitches) then
  736. Message1(parser_e_overloaded_no_procedure,srsym.realname)
  737. else
  738. tstoredsymtable(symtablestack).DuplicateSym(nil,srsym);
  739. { rename the name to an unique name to avoid an
  740. error when inserting the symbol in the symtable }
  741. orgsp:=orgsp+'$'+tostr(aktfilepos.line);
  742. end;
  743. end;
  744. end;
  745. until not searchagain;
  746. end;
  747. { test again if assigned, it can be reset to recover }
  748. if not assigned(aprocsym) then
  749. begin
  750. { create a new procsym and set the real filepos }
  751. akttokenpos:=procstartfilepos;
  752. { for operator we have only one procsym for each overloaded
  753. operation }
  754. if (potype=potype_operator) then
  755. begin
  756. Aprocsym:=Tprocsym(symtablestack.search(sp));
  757. if Aprocsym=nil then
  758. Aprocsym:=tprocsym.create('$'+sp);
  759. end
  760. else
  761. aprocsym:=tprocsym.create(orgsp);
  762. symtablestack.insert(aprocsym);
  763. end;
  764. { to get the correct symtablelevel we must ignore objectsymtables }
  765. st:=symtablestack;
  766. while not(st.symtabletype in [staticsymtable,globalsymtable,localsymtable]) do
  767. st:=st.next;
  768. pd:=tprocdef.create(st.symtablelevel+1);
  769. pd._class:=aclass;
  770. pd.procsym:=aprocsym;
  771. pd.proctypeoption:=potype;
  772. { methods need to be exported }
  773. if assigned(aclass) and
  774. (
  775. (symtablestack.symtabletype=objectsymtable) or
  776. (symtablestack.symtablelevel=main_program_level)
  777. ) then
  778. include(pd.procoptions,po_global);
  779. { symbol options that need to be kept per procdef }
  780. pd.fileinfo:=procstartfilepos;
  781. pd.symoptions:=current_object_option;
  782. { parse parameters }
  783. if token=_LKLAMMER then
  784. parse_parameter_dec(pd);
  785. result:=true;
  786. end;
  787. function parse_proc_dec(aclass:tobjectdef):tprocdef;
  788. var
  789. pd : tprocdef;
  790. isclassmethod : boolean;
  791. begin
  792. pd:=nil;
  793. isclassmethod:=false;
  794. { read class method }
  795. if try_to_consume(_CLASS) then
  796. begin
  797. { class method only allowed for procedures and functions }
  798. if not(token in [_FUNCTION,_PROCEDURE]) then
  799. Message(parser_e_procedure_or_function_expected);
  800. if is_interface(aclass) then
  801. Message(parser_e_no_static_method_in_interfaces)
  802. else
  803. isclassmethod:=true;
  804. end;
  805. case token of
  806. _FUNCTION :
  807. begin
  808. consume(_FUNCTION);
  809. if parse_proc_head(aclass,potype_none,pd) then
  810. begin
  811. { pd=nil when it is a interface mapping }
  812. if assigned(pd) then
  813. begin
  814. if try_to_consume(_COLON) then
  815. begin
  816. inc(testcurobject);
  817. single_type(pd.rettype,false);
  818. pd.test_if_fpu_result;
  819. dec(testcurobject);
  820. end
  821. else
  822. begin
  823. if (
  824. parse_only and
  825. not(is_interface(pd._class))
  826. ) or
  827. (m_repeat_forward in aktmodeswitches) then
  828. begin
  829. consume(_COLON);
  830. consume_all_until(_SEMICOLON);
  831. end;
  832. end;
  833. if isclassmethod then
  834. include(pd.procoptions,po_classmethod);
  835. end;
  836. end
  837. else
  838. begin
  839. { recover }
  840. consume(_COLON);
  841. consume_all_until(_SEMICOLON);
  842. end;
  843. end;
  844. _PROCEDURE :
  845. begin
  846. consume(_PROCEDURE);
  847. if parse_proc_head(aclass,potype_none,pd) then
  848. begin
  849. { pd=nil when it is a interface mapping }
  850. if assigned(pd) then
  851. begin
  852. pd.rettype:=voidtype;
  853. if isclassmethod then
  854. include(pd.procoptions,po_classmethod);
  855. end;
  856. end;
  857. end;
  858. _CONSTRUCTOR :
  859. begin
  860. consume(_CONSTRUCTOR);
  861. parse_proc_head(aclass,potype_constructor,pd);
  862. if assigned(pd) and
  863. assigned(pd._class) then
  864. begin
  865. { Set return type, class constructors return the
  866. created instance, object constructors return boolean }
  867. if is_class(pd._class) then
  868. pd.rettype.setdef(pd._class)
  869. else
  870. pd.rettype:=booltype;
  871. end;
  872. end;
  873. _DESTRUCTOR :
  874. begin
  875. consume(_DESTRUCTOR);
  876. parse_proc_head(aclass,potype_destructor,pd);
  877. if assigned(pd) then
  878. pd.rettype:=voidtype;
  879. end;
  880. _OPERATOR :
  881. begin
  882. consume(_OPERATOR);
  883. if (token in [first_overloaded..last_overloaded]) then
  884. begin
  885. optoken:=token;
  886. end
  887. else
  888. begin
  889. Message(parser_e_overload_operator_failed);
  890. { Use the dummy NOTOKEN that is also declared
  891. for the overloaded_operator[] }
  892. optoken:=NOTOKEN;
  893. end;
  894. consume(token);
  895. parse_proc_head(aclass,potype_operator,pd);
  896. if assigned(pd) then
  897. begin
  898. if pd.parast.symtablelevel>normal_function_level then
  899. Message(parser_e_no_local_operator);
  900. if token<>_ID then
  901. begin
  902. if not(m_result in aktmodeswitches) then
  903. consume(_ID);
  904. end
  905. else
  906. begin
  907. pd.resultname:=orgpattern;
  908. consume(_ID);
  909. end;
  910. if not try_to_consume(_COLON) then
  911. begin
  912. consume(_COLON);
  913. pd.rettype:=generrortype;
  914. consume_all_until(_SEMICOLON);
  915. end
  916. else
  917. begin
  918. single_type(pd.rettype,false);
  919. pd.test_if_fpu_result;
  920. if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
  921. ((pd.rettype.def.deftype<>orddef) or
  922. (torddef(pd.rettype.def).typ<>bool8bit)) then
  923. Message(parser_e_comparative_operator_return_boolean);
  924. if (optoken=_ASSIGNMENT) and
  925. equal_defs(pd.rettype.def,
  926. tparavarsym(pd.parast.symindex.first).vartype.def) then
  927. message(parser_e_no_such_assignment)
  928. else if not isoperatoracceptable(pd,optoken) then
  929. Message(parser_e_overload_impossible);
  930. end;
  931. end
  932. else
  933. begin
  934. { recover }
  935. try_to_consume(_ID);
  936. consume(_COLON);
  937. consume_all_until(_SEMICOLON);
  938. end;
  939. end;
  940. end;
  941. { support procedure proc stdcall export; }
  942. if not(check_proc_directive(false)) then
  943. consume(_SEMICOLON);
  944. result:=pd;
  945. end;
  946. {****************************************************************************
  947. Procedure directive handlers
  948. ****************************************************************************}
  949. procedure pd_far(pd:tabstractprocdef);
  950. begin
  951. Message1(parser_w_proc_directive_ignored,'FAR');
  952. end;
  953. procedure pd_near(pd:tabstractprocdef);
  954. begin
  955. Message1(parser_w_proc_directive_ignored,'NEAR');
  956. end;
  957. procedure pd_export(pd:tabstractprocdef);
  958. begin
  959. if pd.deftype<>procdef then
  960. internalerror(200304264);
  961. if assigned(tprocdef(pd)._class) then
  962. Message(parser_e_methods_dont_be_export);
  963. if pd.parast.symtablelevel>normal_function_level then
  964. Message(parser_e_dont_nest_export);
  965. end;
  966. procedure pd_forward(pd:tabstractprocdef);
  967. begin
  968. if pd.deftype<>procdef then
  969. internalerror(200304265);
  970. tprocdef(pd).forwarddef:=true;
  971. end;
  972. procedure pd_alias(pd:tabstractprocdef);
  973. begin
  974. if pd.deftype<>procdef then
  975. internalerror(200304266);
  976. consume(_COLON);
  977. tprocdef(pd).aliasnames.insert(get_stringconst);
  978. include(pd.procoptions,po_has_public_name);
  979. end;
  980. procedure pd_public(pd:tabstractprocdef);
  981. begin
  982. if pd.deftype<>procdef then
  983. internalerror(200304266);
  984. if try_to_consume(_NAME) then
  985. begin
  986. tprocdef(pd).aliasnames.insert(get_stringconst);
  987. include(pd.procoptions,po_has_public_name);
  988. end;
  989. end;
  990. procedure pd_asmname(pd:tabstractprocdef);
  991. begin
  992. if pd.deftype<>procdef then
  993. internalerror(200304267);
  994. tprocdef(pd).aliasnames.insert(target_info.Cprefix+pattern);
  995. if token=_CCHAR then
  996. consume(_CCHAR)
  997. else
  998. consume(_CSTRING);
  999. { we don't need anything else }
  1000. tprocdef(pd).forwarddef:=false;
  1001. end;
  1002. procedure pd_inline(pd:tabstractprocdef);
  1003. begin
  1004. { Check if there are parameters that can't be inlined }
  1005. pd.parast.foreach_static(@check_inline_para,pd);
  1006. end;
  1007. procedure pd_internconst(pd:tabstractprocdef);
  1008. begin
  1009. if pd.deftype<>procdef then
  1010. internalerror(200304268);
  1011. consume(_COLON);
  1012. tprocdef(pd).extnumber:=get_intconst;
  1013. end;
  1014. procedure pd_internproc(pd:tabstractprocdef);
  1015. begin
  1016. if pd.deftype<>procdef then
  1017. internalerror(200304268);
  1018. consume(_COLON);
  1019. tprocdef(pd).extnumber:=get_intconst;
  1020. { the proc is defined }
  1021. tprocdef(pd).forwarddef:=false;
  1022. end;
  1023. procedure pd_interrupt(pd:tabstractprocdef);
  1024. begin
  1025. if pd.parast.symtablelevel>normal_function_level then
  1026. Message(parser_e_dont_nest_interrupt);
  1027. end;
  1028. procedure pd_abstract(pd:tabstractprocdef);
  1029. begin
  1030. if pd.deftype<>procdef then
  1031. internalerror(200304269);
  1032. if (po_virtualmethod in pd.procoptions) then
  1033. include(pd.procoptions,po_abstractmethod)
  1034. else
  1035. Message(parser_e_only_virtual_methods_abstract);
  1036. { the method is defined }
  1037. tprocdef(pd).forwarddef:=false;
  1038. end;
  1039. procedure pd_virtual(pd:tabstractprocdef);
  1040. {$ifdef WITHDMT}
  1041. var
  1042. pt : tnode;
  1043. {$endif WITHDMT}
  1044. begin
  1045. if pd.deftype<>procdef then
  1046. internalerror(2003042610);
  1047. if (pd.proctypeoption=potype_constructor) and
  1048. is_object(tprocdef(pd)._class) then
  1049. Message(parser_e_constructor_cannot_be_not_virtual);
  1050. {$ifdef WITHDMT}
  1051. if is_object(tprocdef(pd)._class) and
  1052. (token<>_SEMICOLON) then
  1053. begin
  1054. { any type of parameter is allowed here! }
  1055. pt:=comp_expr(true);
  1056. if is_constintnode(pt) then
  1057. begin
  1058. include(pd.procoptions,po_msgint);
  1059. pd.messageinf.i:=pt^.value;
  1060. end
  1061. else
  1062. Message(parser_e_ill_msg_expr);
  1063. disposetree(pt);
  1064. end;
  1065. {$endif WITHDMT}
  1066. end;
  1067. procedure pd_static(pd:tabstractprocdef);
  1068. begin
  1069. if (cs_static_keyword in aktmoduleswitches) then
  1070. begin
  1071. if pd.deftype=procdef then
  1072. include(tprocdef(pd).procsym.symoptions,sp_static);
  1073. include(pd.procoptions,po_staticmethod);
  1074. end;
  1075. end;
  1076. procedure pd_override(pd:tabstractprocdef);
  1077. begin
  1078. if pd.deftype<>procdef then
  1079. internalerror(2003042611);
  1080. if not(is_class_or_interface(tprocdef(pd)._class)) then
  1081. Message(parser_e_no_object_override);
  1082. end;
  1083. procedure pd_overload(pd:tabstractprocdef);
  1084. begin
  1085. if pd.deftype<>procdef then
  1086. internalerror(2003042612);
  1087. include(tprocdef(pd).procsym.symoptions,sp_has_overloaded);
  1088. end;
  1089. procedure pd_message(pd:tabstractprocdef);
  1090. var
  1091. pt : tnode;
  1092. paracnt : longint;
  1093. begin
  1094. if pd.deftype<>procdef then
  1095. internalerror(2003042613);
  1096. if not is_class(tprocdef(pd)._class) then
  1097. Message(parser_e_msg_only_for_classes);
  1098. { check parameter type }
  1099. paracnt:=0;
  1100. pd.parast.foreach_static(@check_msg_para,@paracnt);
  1101. if paracnt<>1 then
  1102. Message(parser_e_ill_msg_param);
  1103. pt:=comp_expr(true);
  1104. if pt.nodetype=stringconstn then
  1105. begin
  1106. include(pd.procoptions,po_msgstr);
  1107. tprocdef(pd).messageinf.str:=strnew(tstringconstnode(pt).value_str);
  1108. end
  1109. else
  1110. if is_constintnode(pt) then
  1111. begin
  1112. include(pd.procoptions,po_msgint);
  1113. tprocdef(pd).messageinf.i:=tordconstnode(pt).value;
  1114. end
  1115. else
  1116. Message(parser_e_ill_msg_expr);
  1117. pt.free;
  1118. end;
  1119. procedure pd_reintroduce(pd:tabstractprocdef);
  1120. begin
  1121. if pd.deftype<>procdef then
  1122. internalerror(200401211);
  1123. if not(is_class_or_interface(tprocdef(pd)._class)) then
  1124. Message(parser_e_no_object_reintroduce);
  1125. end;
  1126. procedure pd_syscall(pd:tabstractprocdef);
  1127. {$ifdef powerpc}
  1128. var
  1129. vs : tparavarsym;
  1130. sym : tsym;
  1131. symtable : tsymtable;
  1132. {$endif powerpc}
  1133. begin
  1134. if pd.deftype<>procdef then
  1135. internalerror(2003042614);
  1136. tprocdef(pd).forwarddef:=false;
  1137. {$ifdef powerpc}
  1138. if target_info.system in [system_powerpc_morphos] then
  1139. begin
  1140. if idtoken=_LEGACY then
  1141. begin
  1142. consume(_LEGACY);
  1143. include(pd.procoptions,po_syscall_legacy);
  1144. end
  1145. else if idtoken=_SYSV then
  1146. begin
  1147. consume(_SYSV);
  1148. include(pd.procoptions,po_syscall_sysv);
  1149. end
  1150. else if idtoken=_BASESYSV then
  1151. begin
  1152. consume(_BASESYSV);
  1153. include(pd.procoptions,po_syscall_basesysv);
  1154. end
  1155. else if idtoken=_SYSVBASE then
  1156. begin
  1157. consume(_SYSVBASE);
  1158. include(pd.procoptions,po_syscall_sysvbase);
  1159. end
  1160. else if idtoken=_R12BASE then
  1161. begin
  1162. consume(_R12BASE);
  1163. include(pd.procoptions,po_syscall_r12base);
  1164. end
  1165. else
  1166. if syscall_convention='LEGACY' then
  1167. include(pd.procoptions,po_syscall_legacy)
  1168. else if syscall_convention='SYSV' then
  1169. include(pd.procoptions,po_syscall_sysv)
  1170. else if syscall_convention='BASESYSV' then
  1171. include(pd.procoptions,po_syscall_basesysv)
  1172. else if syscall_convention='SYSVBASE' then
  1173. include(pd.procoptions,po_syscall_sysvbase)
  1174. else if syscall_convention='R12BASE' then
  1175. include(pd.procoptions,po_syscall_r12base)
  1176. else
  1177. internalerror(2005010404);
  1178. if consume_sym(sym,symtable) then
  1179. begin
  1180. if (sym.typ=globalvarsym) and
  1181. (
  1182. (tabstractvarsym(sym).vartype.def.deftype=pointerdef) or
  1183. is_32bitint(tabstractvarsym(sym).vartype.def)
  1184. ) then
  1185. begin
  1186. tprocdef(pd).libsym:=sym;
  1187. if po_syscall_legacy in tprocdef(pd).procoptions then
  1188. begin
  1189. vs:=tparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
  1190. paramanager.parseparaloc(vs,'A6');
  1191. pd.parast.insert(vs);
  1192. end
  1193. else if po_syscall_sysv in tprocdef(pd).procoptions then
  1194. begin
  1195. { Nothing to be done for sysv here for now, but this might change }
  1196. end
  1197. else if po_syscall_basesysv in tprocdef(pd).procoptions then
  1198. begin
  1199. vs:=tparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para]);
  1200. pd.parast.insert(vs);
  1201. end
  1202. else if po_syscall_sysvbase in tprocdef(pd).procoptions then
  1203. begin
  1204. vs:=tparavarsym.create('$syscalllib',paranr_syscall_sysvbase,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para]);
  1205. pd.parast.insert(vs);
  1206. end
  1207. else if po_syscall_r12base in tprocdef(pd).procoptions then
  1208. begin
  1209. vs:=tparavarsym.create('$syscalllib',paranr_syscall_r12base,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
  1210. paramanager.parseparaloc(vs,'R12');
  1211. pd.parast.insert(vs);
  1212. end
  1213. else
  1214. internalerror(2005010501);
  1215. end
  1216. else
  1217. Message(parser_e_32bitint_or_pointer_variable_expected);
  1218. end;
  1219. (paramanager as tppcparamanager).create_funcretloc_info(pd,calleeside);
  1220. (paramanager as tppcparamanager).create_funcretloc_info(pd,callerside);
  1221. end;
  1222. {$endif powerpc}
  1223. tprocdef(pd).extnumber:=get_intconst;
  1224. end;
  1225. procedure pd_external(pd:tabstractprocdef);
  1226. {
  1227. If import_dll=nil the procedure is assumed to be in another
  1228. object file. In that object file it should have the name to
  1229. which import_name is pointing to. Otherwise, the procedure is
  1230. assumed to be in the DLL to which import_dll is pointing to. In
  1231. that case either import_nr<>0 or import_name<>nil is true, so
  1232. the procedure is either imported by number or by name. (DM)
  1233. }
  1234. begin
  1235. if pd.deftype<>procdef then
  1236. internalerror(2003042615);
  1237. with tprocdef(pd) do
  1238. begin
  1239. forwarddef:=false;
  1240. { forbid local external procedures }
  1241. if parast.symtablelevel>normal_function_level then
  1242. Message(parser_e_no_local_proc_external);
  1243. { If the procedure should be imported from a DLL, a constant string follows.
  1244. This isn't really correct, an contant string expression follows
  1245. so we check if an semicolon follows, else a string constant have to
  1246. follow (FK) }
  1247. if not(token=_SEMICOLON) and not(idtoken=_NAME) then
  1248. begin
  1249. import_dll:=stringdup(get_stringconst);
  1250. if (idtoken=_NAME) then
  1251. begin
  1252. consume(_NAME);
  1253. import_name:=stringdup(get_stringconst);
  1254. if import_name^='' then
  1255. message(parser_e_empty_import_name);
  1256. end;
  1257. if (idtoken=_INDEX) then
  1258. begin
  1259. {After the word index follows the index number in the DLL.}
  1260. consume(_INDEX);
  1261. import_nr:=get_intconst;
  1262. end;
  1263. { default is to used the realname of the procedure }
  1264. if (import_nr=0) and not assigned(import_name) then
  1265. import_name:=stringdup(procsym.realname);
  1266. end
  1267. else
  1268. begin
  1269. if (idtoken=_NAME) then
  1270. begin
  1271. consume(_NAME);
  1272. import_name:=stringdup(get_stringconst);
  1273. if import_name^='' then
  1274. message(parser_e_empty_import_name);
  1275. end;
  1276. end;
  1277. end;
  1278. end;
  1279. type
  1280. pd_handler=procedure(pd:tabstractprocdef);
  1281. proc_dir_rec=record
  1282. idtok : ttoken;
  1283. pd_flags : tpdflags;
  1284. handler : pd_handler;
  1285. pocall : tproccalloption;
  1286. pooption : tprocoptions;
  1287. mutexclpocall : tproccalloptions;
  1288. mutexclpotype : tproctypeoptions;
  1289. mutexclpo : tprocoptions;
  1290. end;
  1291. const
  1292. {Should contain the number of procedure directives we support.}
  1293. num_proc_directives=37;
  1294. proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
  1295. (
  1296. (
  1297. idtok:_ABSTRACT;
  1298. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1299. handler : @pd_abstract;
  1300. pocall : pocall_none;
  1301. pooption : [po_abstractmethod];
  1302. mutexclpocall : [pocall_internproc,pocall_inline];
  1303. mutexclpotype : [];
  1304. mutexclpo : [po_exports,po_interrupt,po_external]
  1305. ),(
  1306. idtok:_ALIAS;
  1307. pd_flags : [pd_implemen,pd_body,pd_notobjintf];
  1308. handler : @pd_alias;
  1309. pocall : pocall_none;
  1310. pooption : [];
  1311. mutexclpocall : [pocall_inline];
  1312. mutexclpotype : [];
  1313. mutexclpo : [po_external]
  1314. ),(
  1315. idtok:_ASMNAME;
  1316. pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
  1317. handler : @pd_asmname;
  1318. pocall : pocall_cdecl;
  1319. pooption : [po_external];
  1320. mutexclpocall : [pocall_internproc,pocall_inline];
  1321. mutexclpotype : [];
  1322. mutexclpo : [po_external]
  1323. ),(
  1324. idtok:_ASSEMBLER;
  1325. pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
  1326. handler : nil;
  1327. pocall : pocall_none;
  1328. pooption : [po_assembler];
  1329. mutexclpocall : [];
  1330. mutexclpotype : [];
  1331. mutexclpo : [po_external]
  1332. ),(
  1333. idtok:_C; {same as cdecl for mode mac}
  1334. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1335. handler : nil;
  1336. pocall : pocall_cdecl;
  1337. pooption : [];
  1338. mutexclpocall : [];
  1339. mutexclpotype : [potype_constructor,potype_destructor];
  1340. mutexclpo : [po_assembler,po_external]
  1341. ),(
  1342. idtok:_CDECL;
  1343. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1344. handler : nil;
  1345. pocall : pocall_cdecl;
  1346. pooption : [];
  1347. mutexclpocall : [];
  1348. mutexclpotype : [potype_constructor,potype_destructor];
  1349. mutexclpo : [po_assembler,po_external]
  1350. ),(
  1351. idtok:_DYNAMIC;
  1352. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1353. handler : @pd_virtual;
  1354. pocall : pocall_none;
  1355. pooption : [po_virtualmethod];
  1356. mutexclpocall : [pocall_internproc,pocall_inline];
  1357. mutexclpotype : [];
  1358. mutexclpo : [po_exports,po_interrupt,po_external,po_overridingmethod]
  1359. ),(
  1360. idtok:_EXPORT;
  1361. pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf];
  1362. handler : @pd_export;
  1363. pocall : pocall_none;
  1364. pooption : [po_exports,po_global];
  1365. mutexclpocall : [pocall_internproc,pocall_inline];
  1366. mutexclpotype : [potype_constructor,potype_destructor];
  1367. mutexclpo : [po_external,po_interrupt]
  1368. ),(
  1369. idtok:_EXTERNAL;
  1370. pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf];
  1371. handler : @pd_external;
  1372. pocall : pocall_none;
  1373. pooption : [po_external];
  1374. mutexclpocall : [pocall_internproc,pocall_inline,pocall_syscall];
  1375. mutexclpotype : [potype_constructor,potype_destructor];
  1376. mutexclpo : [po_public,po_exports,po_interrupt,po_assembler]
  1377. ),(
  1378. idtok:_FAR;
  1379. pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf];
  1380. handler : @pd_far;
  1381. pocall : pocall_none;
  1382. pooption : [];
  1383. mutexclpocall : [pocall_internproc,pocall_inline];
  1384. mutexclpotype : [];
  1385. mutexclpo : []
  1386. ),(
  1387. idtok:_FAR16;
  1388. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject];
  1389. handler : nil;
  1390. pocall : pocall_far16;
  1391. pooption : [];
  1392. mutexclpocall : [];
  1393. mutexclpotype : [];
  1394. mutexclpo : [po_external]
  1395. ),(
  1396. idtok:_FORWARD;
  1397. pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
  1398. handler : @pd_forward;
  1399. pocall : pocall_none;
  1400. pooption : [];
  1401. mutexclpocall : [pocall_internproc,pocall_inline];
  1402. mutexclpotype : [];
  1403. mutexclpo : [po_external]
  1404. ),(
  1405. idtok:_OLDFPCCALL;
  1406. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1407. handler : nil;
  1408. pocall : pocall_oldfpccall;
  1409. pooption : [];
  1410. mutexclpocall : [];
  1411. mutexclpotype : [];
  1412. mutexclpo : []
  1413. ),(
  1414. idtok:_INLINE;
  1415. pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
  1416. handler : @pd_inline;
  1417. pocall : pocall_inline;
  1418. pooption : [];
  1419. mutexclpocall : [];
  1420. mutexclpotype : [potype_constructor,potype_destructor];
  1421. mutexclpo : [po_exports,po_external,po_interrupt,po_virtualmethod]
  1422. ),(
  1423. idtok:_INTERNCONST;
  1424. pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf];
  1425. handler : @pd_internconst;
  1426. pocall : pocall_none;
  1427. pooption : [po_internconst];
  1428. mutexclpocall : [];
  1429. mutexclpotype : [potype_operator];
  1430. mutexclpo : []
  1431. ),(
  1432. idtok:_INTERNPROC;
  1433. pd_flags : [pd_interface,pd_notobject,pd_notobjintf];
  1434. handler : @pd_internproc;
  1435. pocall : pocall_internproc;
  1436. pooption : [];
  1437. mutexclpocall : [];
  1438. mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
  1439. mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod]
  1440. ),(
  1441. idtok:_INTERRUPT;
  1442. pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
  1443. handler : @pd_interrupt;
  1444. pocall : pocall_none;
  1445. pooption : [po_interrupt];
  1446. mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,
  1447. pocall_inline,pocall_pascal,pocall_far16,pocall_oldfpccall];
  1448. mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
  1449. mutexclpo : [po_external]
  1450. ),(
  1451. idtok:_IOCHECK;
  1452. pd_flags : [pd_implemen,pd_body,pd_notobjintf];
  1453. handler : nil;
  1454. pocall : pocall_none;
  1455. pooption : [po_iocheck];
  1456. mutexclpocall : [pocall_internproc];
  1457. mutexclpotype : [];
  1458. mutexclpo : [po_external]
  1459. ),(
  1460. idtok:_MESSAGE;
  1461. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1462. handler : @pd_message;
  1463. pocall : pocall_none;
  1464. pooption : []; { can be po_msgstr or po_msgint }
  1465. mutexclpocall : [pocall_inline,pocall_internproc];
  1466. mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
  1467. mutexclpo : [po_interrupt,po_external]
  1468. ),(
  1469. idtok:_MWPASCAL;
  1470. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1471. handler : nil;
  1472. pocall : pocall_mwpascal;
  1473. pooption : [];
  1474. mutexclpocall : [];
  1475. mutexclpotype : [];
  1476. mutexclpo : []
  1477. ),(
  1478. idtok:_NEAR;
  1479. pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
  1480. handler : @pd_near;
  1481. pocall : pocall_none;
  1482. pooption : [];
  1483. mutexclpocall : [pocall_internproc];
  1484. mutexclpotype : [];
  1485. mutexclpo : []
  1486. ),(
  1487. idtok:_NOSTACKFRAME;
  1488. pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
  1489. handler : nil;
  1490. pocall : pocall_none;
  1491. pooption : [po_nostackframe];
  1492. mutexclpocall : [pocall_internproc];
  1493. mutexclpotype : [];
  1494. mutexclpo : []
  1495. ),(
  1496. idtok:_OVERLOAD;
  1497. pd_flags : [pd_implemen,pd_interface,pd_body];
  1498. handler : @pd_overload;
  1499. pocall : pocall_none;
  1500. pooption : [po_overload];
  1501. mutexclpocall : [pocall_internproc];
  1502. mutexclpotype : [];
  1503. mutexclpo : []
  1504. ),(
  1505. idtok:_OVERRIDE;
  1506. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1507. handler : @pd_override;
  1508. pocall : pocall_none;
  1509. pooption : [po_overridingmethod,po_virtualmethod];
  1510. mutexclpocall : [pocall_inline,pocall_internproc];
  1511. mutexclpotype : [];
  1512. mutexclpo : [po_exports,po_external,po_interrupt,po_virtualmethod]
  1513. ),(
  1514. idtok:_PASCAL;
  1515. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1516. handler : nil;
  1517. pocall : pocall_pascal;
  1518. pooption : [];
  1519. mutexclpocall : [];
  1520. mutexclpotype : [potype_constructor,potype_destructor];
  1521. mutexclpo : [po_external]
  1522. ),(
  1523. idtok:_PUBLIC;
  1524. pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf];
  1525. handler : @pd_public;
  1526. pocall : pocall_none;
  1527. pooption : [po_public,po_global];
  1528. mutexclpocall : [pocall_internproc,pocall_inline];
  1529. mutexclpotype : [];
  1530. mutexclpo : [po_external]
  1531. ),(
  1532. idtok:_REGISTER;
  1533. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1534. handler : nil;
  1535. pocall : pocall_register;
  1536. pooption : [];
  1537. mutexclpocall : [];
  1538. mutexclpotype : [potype_constructor,potype_destructor];
  1539. mutexclpo : [po_external]
  1540. ),(
  1541. idtok:_REINTRODUCE;
  1542. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1543. handler : @pd_reintroduce;
  1544. pocall : pocall_none;
  1545. pooption : [po_reintroduce];
  1546. mutexclpocall : [pocall_inline,pocall_internproc];
  1547. mutexclpotype : [];
  1548. mutexclpo : [po_external,po_interrupt,po_exports,po_overridingmethod]
  1549. ),(
  1550. idtok:_SAFECALL;
  1551. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1552. handler : nil;
  1553. pocall : pocall_safecall;
  1554. pooption : [];
  1555. mutexclpocall : [];
  1556. mutexclpotype : [potype_constructor,potype_destructor];
  1557. mutexclpo : [po_external]
  1558. ),(
  1559. idtok:_SOFTFLOAT;
  1560. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1561. handler : nil;
  1562. pocall : pocall_softfloat;
  1563. pooption : [];
  1564. mutexclpocall : [];
  1565. mutexclpotype : [potype_constructor,potype_destructor];
  1566. { it's available with po_external because the libgcc floating point routines on the arm
  1567. uses this calling convention }
  1568. mutexclpo : []
  1569. ),(
  1570. idtok:_STATIC;
  1571. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1572. handler : @pd_static;
  1573. pocall : pocall_none;
  1574. pooption : [po_staticmethod];
  1575. mutexclpocall : [pocall_inline,pocall_internproc];
  1576. mutexclpotype : [potype_constructor,potype_destructor];
  1577. mutexclpo : [po_external,po_interrupt,po_exports]
  1578. ),(
  1579. idtok:_STDCALL;
  1580. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1581. handler : nil;
  1582. pocall : pocall_stdcall;
  1583. pooption : [];
  1584. mutexclpocall : [];
  1585. mutexclpotype : [potype_constructor,potype_destructor];
  1586. mutexclpo : [po_external]
  1587. ),(
  1588. idtok:_SYSCALL;
  1589. pd_flags : [pd_interface,pd_implemen,pd_notobject,pd_notobjintf];
  1590. handler : @pd_syscall;
  1591. pocall : pocall_syscall;
  1592. pooption : [];
  1593. mutexclpocall : [];
  1594. mutexclpotype : [potype_constructor,potype_destructor];
  1595. mutexclpo : [po_external,po_assembler,po_interrupt,po_exports]
  1596. ),(
  1597. idtok:_VIRTUAL;
  1598. pd_flags : [pd_interface,pd_object,pd_notobjintf];
  1599. handler : @pd_virtual;
  1600. pocall : pocall_none;
  1601. pooption : [po_virtualmethod];
  1602. mutexclpocall : [pocall_inline,pocall_internproc];
  1603. mutexclpotype : [];
  1604. mutexclpo : [po_external,po_interrupt,po_exports,po_overridingmethod]
  1605. ),(
  1606. idtok:_CPPDECL;
  1607. pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
  1608. handler : nil;
  1609. pocall : pocall_cppdecl;
  1610. pooption : [];
  1611. mutexclpocall : [];
  1612. mutexclpotype : [potype_constructor,potype_destructor];
  1613. mutexclpo : [po_assembler,po_external,po_virtualmethod]
  1614. ),(
  1615. idtok:_VARARGS;
  1616. pd_flags : [pd_interface,pd_implemen,pd_procvar];
  1617. handler : nil;
  1618. pocall : pocall_none;
  1619. pooption : [po_varargs];
  1620. mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
  1621. pocall_inline,pocall_far16,pocall_oldfpccall,pocall_mwpascal];
  1622. mutexclpotype : [];
  1623. mutexclpo : [po_assembler,po_interrupt]
  1624. ),(
  1625. idtok:_COMPILERPROC;
  1626. pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
  1627. handler : nil;
  1628. pocall : pocall_compilerproc;
  1629. pooption : [];
  1630. mutexclpocall : [];
  1631. mutexclpotype : [potype_constructor,potype_destructor];
  1632. mutexclpo : [po_interrupt]
  1633. )
  1634. );
  1635. function check_proc_directive(isprocvar:boolean):boolean;
  1636. var
  1637. i : longint;
  1638. begin
  1639. result:=false;
  1640. for i:=1 to num_proc_directives do
  1641. if proc_direcdata[i].idtok=idtoken then
  1642. begin
  1643. if ((not isprocvar) or
  1644. (pd_procvar in proc_direcdata[i].pd_flags)) and
  1645. { don't eat a public directive in classes }
  1646. not((idtoken=_PUBLIC) and (symtablestack.symtabletype=objectsymtable)) then
  1647. result:=true;
  1648. exit;
  1649. end;
  1650. end;
  1651. function parse_proc_direc(pd:tabstractprocdef;var pdflags:tpdflags):boolean;
  1652. {
  1653. Parse the procedure directive, returns true if a correct directive is found
  1654. }
  1655. var
  1656. p : longint;
  1657. found : boolean;
  1658. name : stringid;
  1659. begin
  1660. parse_proc_direc:=false;
  1661. name:=tokeninfo^[idtoken].str;
  1662. found:=false;
  1663. { Hint directive? Then exit immediatly }
  1664. if (m_hintdirective in aktmodeswitches) then
  1665. begin
  1666. case idtoken of
  1667. _LIBRARY,
  1668. _PLATFORM,
  1669. _UNIMPLEMENTED,
  1670. _DEPRECATED :
  1671. exit;
  1672. end;
  1673. end;
  1674. { C directive is MAC only, because it breaks too much existing code
  1675. on other platforms (PFV) }
  1676. if (idtoken=_C) and
  1677. not(m_mac in aktmodeswitches) then
  1678. exit;
  1679. { retrieve data for directive if found }
  1680. for p:=1 to num_proc_directives do
  1681. if proc_direcdata[p].idtok=idtoken then
  1682. begin
  1683. found:=true;
  1684. break;
  1685. end;
  1686. { Check if the procedure directive is known }
  1687. if not found then
  1688. begin
  1689. { parsing a procvar type the name can be any
  1690. next variable !! }
  1691. if ((pdflags * [pd_procvar,pd_object])=[]) and
  1692. not(idtoken=_PROPERTY) then
  1693. Message1(parser_w_unknown_proc_directive_ignored,name);
  1694. exit;
  1695. end;
  1696. { static needs a special treatment }
  1697. if (idtoken=_STATIC) and not (cs_static_keyword in aktmoduleswitches) then
  1698. exit;
  1699. { check if method and directive not for object, like public.
  1700. This needs to be checked also for procvars }
  1701. if (pd_notobject in proc_direcdata[p].pd_flags) and
  1702. (symtablestack.symtabletype=objectsymtable) then
  1703. exit;
  1704. { Conflicts between directives ? }
  1705. if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) or
  1706. (pd.proccalloption in proc_direcdata[p].mutexclpocall) or
  1707. ((pd.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
  1708. begin
  1709. Message1(parser_e_proc_dir_conflict,name);
  1710. exit;
  1711. end;
  1712. { set calling convention }
  1713. if proc_direcdata[p].pocall<>pocall_none then
  1714. begin
  1715. if (po_hascallingconvention in pd.procoptions) then
  1716. begin
  1717. Message2(parser_w_proc_overriding_calling,
  1718. proccalloptionStr[pd.proccalloption],
  1719. proccalloptionStr[proc_direcdata[p].pocall]);
  1720. end;
  1721. { check if the target processor supports this calling convention }
  1722. if not(proc_direcdata[p].pocall in supported_calling_conventions) then
  1723. begin
  1724. Message1(parser_e_illegal_calling_convention,proccalloptionStr[proc_direcdata[p].pocall]);
  1725. { recover }
  1726. proc_direcdata[p].pocall:=pocall_stdcall;
  1727. end;
  1728. pd.proccalloption:=proc_direcdata[p].pocall;
  1729. include(pd.procoptions,po_hascallingconvention);
  1730. end;
  1731. if pd.deftype=procdef then
  1732. begin
  1733. { Check if the directive is only for objects }
  1734. if (pd_object in proc_direcdata[p].pd_flags) and
  1735. not assigned(tprocdef(pd)._class) then
  1736. exit;
  1737. { check if method and directive not for interface }
  1738. if (pd_notobjintf in proc_direcdata[p].pd_flags) and
  1739. is_interface(tprocdef(pd)._class) then
  1740. exit;
  1741. end;
  1742. { consume directive, and turn flag on }
  1743. consume(token);
  1744. parse_proc_direc:=true;
  1745. { Check the pd_flags if the directive should be allowed }
  1746. if (pd_interface in pdflags) and
  1747. not(pd_interface in proc_direcdata[p].pd_flags) then
  1748. begin
  1749. Message1(parser_e_proc_dir_not_allowed_in_interface,name);
  1750. exit;
  1751. end;
  1752. if (pd_implemen in pdflags) and
  1753. not(pd_implemen in proc_direcdata[p].pd_flags) then
  1754. begin
  1755. Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
  1756. exit;
  1757. end;
  1758. if (pd_procvar in pdflags) and
  1759. not(pd_procvar in proc_direcdata[p].pd_flags) then
  1760. begin
  1761. Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
  1762. exit;
  1763. end;
  1764. { Return the new pd_flags }
  1765. if not(pd_body in proc_direcdata[p].pd_flags) then
  1766. exclude(pdflags,pd_body);
  1767. { Add the correct flag }
  1768. pd.procoptions:=pd.procoptions+proc_direcdata[p].pooption;
  1769. { Call the handler }
  1770. if pointer(proc_direcdata[p].handler)<>nil then
  1771. proc_direcdata[p].handler(pd);
  1772. end;
  1773. function proc_get_importname(pd:tprocdef):string;
  1774. begin
  1775. result:='';
  1776. if not(po_external in pd.procoptions) then
  1777. internalerror(200412151);
  1778. { import by number? }
  1779. if pd.import_nr<>0 then
  1780. begin
  1781. { Nothing to do }
  1782. end
  1783. else
  1784. { external name specified }
  1785. if assigned(pd.import_name) then
  1786. begin
  1787. { Win32 imports need to use the normal name since to functions
  1788. can refer to the same DLL function. This is also needed for compatability
  1789. with Delphi and TP7 }
  1790. if not(
  1791. assigned(pd.import_dll) and
  1792. (target_info.system in [system_i386_win32,system_i386_wdosx,
  1793. system_i386_emx,system_i386_os2])
  1794. ) then
  1795. begin
  1796. if not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  1797. result:=pd.import_name^
  1798. else
  1799. result:=target_info.Cprefix+pd.import_name^;
  1800. end;
  1801. end
  1802. else
  1803. begin
  1804. { Default names when importing variables }
  1805. case pd.proccalloption of
  1806. pocall_cdecl :
  1807. begin
  1808. if assigned(pd._class) then
  1809. result:=target_info.Cprefix+pd._class.objrealname^+'_'+pd.procsym.realname
  1810. else
  1811. result:=target_info.Cprefix+pd.procsym.realname;
  1812. end;
  1813. pocall_cppdecl :
  1814. begin
  1815. result:=target_info.Cprefix+pd.cplusplusmangledname;
  1816. end;
  1817. else
  1818. begin
  1819. {In MacPas a single "external" has the same effect as "external name 'xxx'" }
  1820. if (m_mac in aktmodeswitches) then
  1821. result:=tprocdef(pd).procsym.realname;
  1822. end;
  1823. end;
  1824. end;
  1825. end;
  1826. procedure proc_set_mangledname(pd:tprocdef);
  1827. var
  1828. s : string;
  1829. begin
  1830. { When the mangledname is already set we aren't allowed to change
  1831. it because it can already be used somewhere (PFV) }
  1832. if not(po_has_mangledname in pd.procoptions) then
  1833. begin
  1834. if (po_external in pd.procoptions) then
  1835. begin
  1836. { External Procedures are only allowed to change the mangledname
  1837. in their first declaration }
  1838. if (pd.forwarddef or (not pd.hasforward)) then
  1839. begin
  1840. s:=proc_get_importname(pd);
  1841. if s<>'' then
  1842. pd.setmangledname(s);
  1843. end;
  1844. end
  1845. else
  1846. { Normal procedures }
  1847. begin
  1848. case pd.proccalloption of
  1849. pocall_compilerproc :
  1850. begin
  1851. pd.setmangledname(lower(pd.procsym.name));
  1852. end;
  1853. end;
  1854. end;
  1855. end;
  1856. { Public/exported alias names }
  1857. if (po_public in pd.procoptions) and
  1858. not(po_has_public_name in pd.procoptions) then
  1859. begin
  1860. case pd.proccalloption of
  1861. pocall_cdecl :
  1862. begin
  1863. if assigned(pd._class) then
  1864. pd.aliasnames.insert(target_info.Cprefix+pd._class.objrealname^+'_'+pd.procsym.realname)
  1865. else
  1866. pd.aliasnames.insert(target_info.Cprefix+pd.procsym.realname);
  1867. end;
  1868. pocall_cppdecl :
  1869. begin
  1870. pd.aliasnames.insert(target_info.Cprefix+pd.cplusplusmangledname);
  1871. end;
  1872. end;
  1873. { prevent adding the alias a second time }
  1874. include(pd.procoptions,po_has_public_name);
  1875. end;
  1876. end;
  1877. procedure handle_calling_convention(pd:tabstractprocdef);
  1878. begin
  1879. { set the default calling convention if none provided }
  1880. if not(po_hascallingconvention in pd.procoptions) then
  1881. pd.proccalloption:=aktdefproccall
  1882. else
  1883. begin
  1884. if pd.proccalloption=pocall_none then
  1885. internalerror(200309081);
  1886. end;
  1887. { handle proccall specific settings }
  1888. case pd.proccalloption of
  1889. pocall_cdecl,
  1890. pocall_cppdecl :
  1891. begin
  1892. { check C cdecl para types }
  1893. pd.parast.foreach_static(@check_c_para,nil);
  1894. end;
  1895. pocall_far16 :
  1896. begin
  1897. { Temporary stub, must be rewritten to support OS/2 far16 }
  1898. Message1(parser_w_proc_directive_ignored,'FAR16');
  1899. end;
  1900. pocall_inline :
  1901. begin
  1902. if not(cs_support_inline in aktmoduleswitches) then
  1903. begin
  1904. Message(parser_e_proc_inline_not_supported);
  1905. pd.proccalloption:=pocall_default;
  1906. end;
  1907. end;
  1908. end;
  1909. { For varargs directive also cdecl and external must be defined }
  1910. if (po_varargs in pd.procoptions) then
  1911. begin
  1912. { check first for external in the interface, if available there
  1913. then the cdecl must also be there since there is no implementation
  1914. available to contain it }
  1915. if parse_only then
  1916. begin
  1917. { if external is available, then cdecl must also be available,
  1918. procvars don't need external }
  1919. if not((po_external in pd.procoptions) or
  1920. (pd.deftype=procvardef)) and
  1921. not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  1922. Message(parser_e_varargs_need_cdecl_and_external);
  1923. end
  1924. else
  1925. begin
  1926. { both must be defined now }
  1927. if not((po_external in pd.procoptions) or
  1928. (pd.deftype=procvardef)) or
  1929. not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
  1930. Message(parser_e_varargs_need_cdecl_and_external);
  1931. end;
  1932. end;
  1933. { insert hidden high parameters }
  1934. pd.parast.foreach_static(@insert_hidden_para,pd);
  1935. { insert hidden self parameter }
  1936. insert_self_and_vmt_para(pd);
  1937. { insert funcret parameter if required }
  1938. insert_funcret_para(pd);
  1939. { Make var parameters regable, this must be done after the calling
  1940. convention is set. }
  1941. { this must be done before parentfp is insert, because getting all cases
  1942. where parentfp must be in a memory location isn't catched properly so
  1943. we put parentfp never in a register }
  1944. pd.parast.foreach_static(@set_addr_param_regable,pd);
  1945. { insert parentfp parameter if required }
  1946. insert_parentfp_para(pd);
  1947. { Calculate parameter tlist }
  1948. pd.calcparas;
  1949. end;
  1950. procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
  1951. {
  1952. Parse the procedure directives. It does not matter if procedure directives
  1953. are written using ;procdir; or ['procdir'] syntax.
  1954. }
  1955. var
  1956. res : boolean;
  1957. begin
  1958. if (m_mac in aktmodeswitches) and (cs_externally_visible in aktlocalswitches) then
  1959. begin
  1960. tprocdef(pd).aliasnames.insert(tprocdef(pd).procsym.realname);
  1961. include(pd.procoptions,po_public);
  1962. include(pd.procoptions,po_has_public_name);
  1963. include(pd.procoptions,po_global);
  1964. end;
  1965. while token in [_ID,_LECKKLAMMER] do
  1966. begin
  1967. if try_to_consume(_LECKKLAMMER) then
  1968. begin
  1969. repeat
  1970. parse_proc_direc(pd,pdflags);
  1971. until not try_to_consume(_COMMA);
  1972. consume(_RECKKLAMMER);
  1973. { we always expect at least '[];' }
  1974. res:=true;
  1975. end
  1976. else
  1977. begin
  1978. res:=parse_proc_direc(pd,pdflags);
  1979. end;
  1980. { A procedure directive normally followed by a semicolon, but in
  1981. a const section or reading a type we should stop when _EQUAL is found,
  1982. because a constant/default value follows }
  1983. if res then
  1984. begin
  1985. if (block_type in [bt_const,bt_type]) and
  1986. (token=_EQUAL) then
  1987. break;
  1988. { support procedure proc;stdcall export; }
  1989. if not(check_proc_directive((pd.deftype=procvardef))) then
  1990. begin
  1991. { support "record p : procedure stdcall end;" and
  1992. "var p : procedure stdcall = nil;" }
  1993. if (pd_procvar in pdflags) and
  1994. (token in [_END,_RKLAMMER,_EQUAL]) then
  1995. break
  1996. else
  1997. consume(_SEMICOLON);
  1998. end;
  1999. end
  2000. else
  2001. break;
  2002. end;
  2003. end;
  2004. procedure parse_var_proc_directives(sym:tsym);
  2005. var
  2006. pdflags : tpdflags;
  2007. pd : tabstractprocdef;
  2008. begin
  2009. pdflags:=[pd_procvar];
  2010. pd:=nil;
  2011. case sym.typ of
  2012. fieldvarsym,
  2013. globalvarsym,
  2014. localvarsym,
  2015. paravarsym :
  2016. pd:=tabstractprocdef(tabstractvarsym(sym).vartype.def);
  2017. typedconstsym :
  2018. pd:=tabstractprocdef(ttypedconstsym(sym).typedconsttype.def);
  2019. typesym :
  2020. pd:=tabstractprocdef(ttypesym(sym).restype.def);
  2021. else
  2022. internalerror(2003042617);
  2023. end;
  2024. if pd.deftype<>procvardef then
  2025. internalerror(2003042618);
  2026. { names should never be used anyway }
  2027. parse_proc_directives(pd,pdflags);
  2028. end;
  2029. procedure parse_object_proc_directives(pd:tabstractprocdef);
  2030. var
  2031. pdflags : tpdflags;
  2032. begin
  2033. pdflags:=[pd_object];
  2034. parse_proc_directives(pd,pdflags);
  2035. end;
  2036. function proc_add_definition(var pd:tprocdef):boolean;
  2037. {
  2038. Add definition aprocdef to the overloaded definitions of aprocsym. If a
  2039. forwarddef is found and reused it returns true
  2040. }
  2041. var
  2042. hd : tprocdef;
  2043. ad,fd : tsym;
  2044. s1,s2 : stringid;
  2045. i : cardinal;
  2046. forwardfound : boolean;
  2047. po_comp : tprocoptions;
  2048. aprocsym : tprocsym;
  2049. begin
  2050. forwardfound:=false;
  2051. aprocsym:=tprocsym(pd.procsym);
  2052. { check overloaded functions if the same function already exists }
  2053. for i:=1 to aprocsym.procdef_count do
  2054. begin
  2055. hd:=aprocsym.procdef[i];
  2056. { Skip overloaded definitions that are declared in other
  2057. units }
  2058. if hd.procsym<>aprocsym then
  2059. continue;
  2060. { check the parameters, for delphi/tp it is possible to
  2061. leave the parameters away in the implementation (forwarddef=false).
  2062. But for an overload declared function this is not allowed }
  2063. if { check if empty implementation arguments match is allowed }
  2064. (
  2065. not(m_repeat_forward in aktmodeswitches) and
  2066. not(pd.forwarddef) and
  2067. (pd.maxparacount=0) and
  2068. not(po_overload in hd.procoptions)
  2069. ) or
  2070. { check arguments }
  2071. (
  2072. (compare_paras(pd.paras,hd.paras,cp_none,[cpo_comparedefaultvalue])>=te_equal) and
  2073. { for operators equal_paras is not enough !! }
  2074. ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
  2075. { be careful here, equal_defs doesn't take care of unique }
  2076. (hd.rettype.def=pd.rettype.def) or
  2077. (equal_defs(hd.rettype.def,pd.rettype.def) and
  2078. not(df_unique in hd.rettype.def.defoptions) and not(df_unique in pd.rettype.def.defoptions)
  2079. )
  2080. )
  2081. ) then
  2082. begin
  2083. { Check if we've found the forwarddef, if found then
  2084. we need to update the forward def with the current
  2085. implementation settings }
  2086. if hd.forwarddef then
  2087. begin
  2088. forwardfound:=true;
  2089. { Check if the procedure type and return type are correct,
  2090. also the parameters must match also with the type }
  2091. if (hd.proctypeoption<>pd.proctypeoption) or
  2092. (
  2093. (m_repeat_forward in aktmodeswitches) and
  2094. (not((pd.maxparacount=0) or
  2095. (compare_paras(pd.paras,hd.paras,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
  2096. ) or
  2097. (
  2098. ((m_repeat_forward in aktmodeswitches) or
  2099. not(is_void(pd.rettype.def))) and
  2100. (not equal_defs(hd.rettype.def,pd.rettype.def))) then
  2101. begin
  2102. MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,
  2103. pd.fullprocname(false));
  2104. aprocsym.write_parameter_lists(pd);
  2105. break;
  2106. end;
  2107. { Check if both are declared forward }
  2108. if hd.forwarddef and pd.forwarddef then
  2109. begin
  2110. MessagePos1(pd.fileinfo,parser_e_function_already_declared_public_forward,
  2111. pd.fullprocname(false));
  2112. end;
  2113. { internconst or internproc only need to be defined once }
  2114. if (hd.proccalloption=pocall_internproc) then
  2115. pd.proccalloption:=hd.proccalloption
  2116. else
  2117. if (pd.proccalloption=pocall_internproc) then
  2118. hd.proccalloption:=pd.proccalloption;
  2119. { Check calling convention }
  2120. if (hd.proccalloption<>pd.proccalloption) then
  2121. begin
  2122. { In delphi it is possible to specify the calling
  2123. convention in the interface or implementation if
  2124. there was no convention specified in the other
  2125. part }
  2126. if (m_delphi in aktmodeswitches) then
  2127. begin
  2128. if not(po_hascallingconvention in pd.procoptions) then
  2129. pd.proccalloption:=hd.proccalloption
  2130. else
  2131. if not(po_hascallingconvention in hd.procoptions) then
  2132. hd.proccalloption:=pd.proccalloption
  2133. else
  2134. begin
  2135. MessagePos(pd.fileinfo,parser_e_call_convention_dont_match_forward);
  2136. aprocsym.write_parameter_lists(pd);
  2137. { restore interface settings }
  2138. pd.proccalloption:=hd.proccalloption;
  2139. end;
  2140. end
  2141. else
  2142. begin
  2143. MessagePos(pd.fileinfo,parser_e_call_convention_dont_match_forward);
  2144. aprocsym.write_parameter_lists(pd);
  2145. { restore interface settings }
  2146. pd.proccalloption:=hd.proccalloption;
  2147. end;
  2148. end;
  2149. { Check procedure options, Delphi requires that class is
  2150. repeated in the implementation for class methods }
  2151. if (m_fpc in aktmodeswitches) then
  2152. po_comp:=[po_varargs,po_methodpointer,po_interrupt]
  2153. else
  2154. po_comp:=[po_classmethod,po_methodpointer];
  2155. if ((po_comp * hd.procoptions)<>(po_comp * pd.procoptions)) then
  2156. begin
  2157. MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,
  2158. pd.fullprocname(false));
  2159. aprocsym.write_parameter_lists(pd);
  2160. { This error is non-fatal, we can recover }
  2161. end;
  2162. { Forward declaration is external? }
  2163. if (po_external in hd.procoptions) then
  2164. MessagePos(pd.fileinfo,parser_e_proc_already_external);
  2165. { Check parameters }
  2166. if (m_repeat_forward in aktmodeswitches) or
  2167. (pd.minparacount>0) then
  2168. begin
  2169. { If mangled names are equal then they have the same amount of arguments }
  2170. { We can check the names of the arguments }
  2171. { both symtables are in the same order from left to right }
  2172. ad:=tsym(hd.parast.symindex.first);
  2173. fd:=tsym(pd.parast.symindex.first);
  2174. repeat
  2175. { skip default parameter constsyms }
  2176. while assigned(ad) and (ad.typ<>paravarsym) do
  2177. ad:=tsym(ad.indexnext);
  2178. while assigned(fd) and (fd.typ<>paravarsym) do
  2179. fd:=tsym(fd.indexnext);
  2180. { stop when one of the two lists is at the end }
  2181. if not assigned(ad) or not assigned(fd) then
  2182. break;
  2183. { retrieve names, remove reg for register parameters }
  2184. s1:=ad.name;
  2185. s2:=fd.name;
  2186. { compare names }
  2187. if (s1<>s2) then
  2188. begin
  2189. MessagePos3(pd.fileinfo,parser_e_header_different_var_names,
  2190. aprocsym.name,s1,s2);
  2191. break;
  2192. end;
  2193. ad:=tsym(ad.indexnext);
  2194. fd:=tsym(fd.indexnext);
  2195. until false;
  2196. if assigned(ad) xor assigned(fd) then
  2197. internalerror(200204178);
  2198. end;
  2199. { Everything is checked, now we can update the forward declaration
  2200. with the new data from the implementation }
  2201. hd.forwarddef:=pd.forwarddef;
  2202. hd.hasforward:=true;
  2203. hd.procoptions:=hd.procoptions+pd.procoptions;
  2204. if hd.extnumber=65535 then
  2205. hd.extnumber:=pd.extnumber;
  2206. while not pd.aliasnames.empty do
  2207. hd.aliasnames.insert(pd.aliasnames.getfirst);
  2208. { update fileinfo so position references the implementation,
  2209. also update funcretsym if it is already generated }
  2210. hd.fileinfo:=pd.fileinfo;
  2211. if assigned(hd.funcretsym) then
  2212. hd.funcretsym.fileinfo:=pd.fileinfo;
  2213. { import names }
  2214. if assigned(pd.import_dll) then
  2215. begin
  2216. stringdispose(hd.import_dll);
  2217. hd.import_dll:=stringdup(pd.import_dll^);
  2218. end;
  2219. if assigned(pd.import_name) then
  2220. begin
  2221. stringdispose(hd.import_name);
  2222. hd.import_name:=stringdup(pd.import_name^);
  2223. end;
  2224. hd.import_nr:=pd.import_nr;
  2225. { for compilerproc defines we need to rename and update the
  2226. symbolname to lowercase }
  2227. if (pd.proccalloption=pocall_compilerproc) then
  2228. begin
  2229. { rename to lowercase so users can't access it }
  2230. aprocsym.owner.rename(aprocsym.name,lower(aprocsym.name));
  2231. { also update the realname that is stored in the ppu }
  2232. stringdispose(aprocsym._realname);
  2233. aprocsym._realname:=stringdup('$'+aprocsym.name);
  2234. { the mangeled name is already changed by the pd_compilerproc }
  2235. { handler. It must be done immediately because if we have a }
  2236. { call to a compilerproc before it's implementation is }
  2237. { encountered, it must already use the new mangled name (JM) }
  2238. end;
  2239. { the procdef will be released by the symtable, we release
  2240. at least the parast }
  2241. pd.releasemem;
  2242. pd:=hd;
  2243. end
  2244. else
  2245. begin
  2246. { abstract methods aren't forward defined, but this }
  2247. { needs another error message }
  2248. if (po_abstractmethod in hd.procoptions) then
  2249. MessagePos(pd.fileinfo,parser_e_abstract_no_definition)
  2250. else
  2251. begin
  2252. MessagePos(pd.fileinfo,parser_e_overloaded_have_same_parameters);
  2253. aprocsym.write_parameter_lists(pd);
  2254. end;
  2255. end;
  2256. { we found one proc with the same arguments, there are no others
  2257. so we can stop }
  2258. break;
  2259. end;
  2260. { check for allowing overload directive }
  2261. if not(m_fpc in aktmodeswitches) then
  2262. begin
  2263. { overload directive turns on overloading }
  2264. if ((po_overload in pd.procoptions) or
  2265. (po_overload in hd.procoptions)) then
  2266. begin
  2267. { check if all procs have overloading, but not if the proc is a method or
  2268. already declared forward, then the check is already done }
  2269. if not(hd.hasforward or
  2270. assigned(pd._class) or
  2271. (pd.forwarddef<>hd.forwarddef) or
  2272. ((po_overload in pd.procoptions) and
  2273. (po_overload in hd.procoptions))) then
  2274. begin
  2275. MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,aprocsym.realname);
  2276. break;
  2277. end;
  2278. end
  2279. else
  2280. begin
  2281. if not(hd.forwarddef) then
  2282. begin
  2283. MessagePos(pd.fileinfo,parser_e_procedure_overloading_is_off);
  2284. break;
  2285. end;
  2286. end;
  2287. end; { equal arguments }
  2288. end;
  2289. { if we didn't reuse a forwarddef then we add the procdef to the overloaded
  2290. list }
  2291. if not forwardfound then
  2292. aprocsym.addprocdef(pd);
  2293. proc_add_definition:=forwardfound;
  2294. end;
  2295. end.
  2296. {
  2297. $Log$
  2298. Revision 1.234 2005-04-28 19:32:11 florian
  2299. * overloading of assignment operator by different unique result types now possible
  2300. Revision 1.233 2005/04/06 19:39:04 florian
  2301. * fixed previous commit
  2302. Revision 1.232 2005/04/06 19:09:39 florian
  2303. * hidden parameters can be put now in registers as well
  2304. Revision 1.231 2005/03/27 14:10:52 jonas
  2305. * const record parameters > 8 bytes are now passed by reference for non
  2306. cdecl/cppdecl procedures on Mac OS/Mac OS X to fix compatibility with
  2307. GPC (slightly more efficient than Metrowerks behaviour below, but
  2308. less efficient in most cases than our previous scheme)
  2309. + "mwpascal" procedure directive to support the const record parameter
  2310. behaviour of Metrowerks Pascal, which passes all const records by
  2311. reference
  2312. Revision 1.230 2005/02/14 17:13:07 peter
  2313. * truncate log
  2314. Revision 1.229 2005/02/03 17:11:40 peter
  2315. * more procvar directive fixes
  2316. Revision 1.228 2005/02/01 08:46:13 michael
  2317. * Patch from peter: fix macpas anonymous function procvar
  2318. Revision 1.227 2005/01/31 21:27:51 peter
  2319. * macpas procvars in parameters
  2320. Revision 1.226 2005/01/19 22:19:41 peter
  2321. * unit mapping rewrite
  2322. * new derefmap added
  2323. Revision 1.225 2005/01/06 02:13:03 karoly
  2324. * more SysV call support stuff for MorphOS
  2325. Revision 1.224 2005/01/05 02:31:06 karoly
  2326. * fixed SysV syscall support (MorphOS)
  2327. Revision 1.223 2005/01/04 17:40:33 karoly
  2328. + sysv style syscalls added for MorphOS
  2329. }