aasmtai.pas 60 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements an abstract asmoutput class for all processor types
  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. { @abstract(This unit implements an abstract asm output class for all processor types)
  19. This unit implements an abstract assembler output class for all processors, these
  20. are then overriden for each assembler writer to actually write the data in these
  21. classes to an assembler file.
  22. }
  23. unit aasmtai;
  24. {$i fpcdefs.inc}
  25. interface
  26. uses
  27. cutils,cclasses,
  28. globtype,globals,systems,
  29. cpuinfo,cpubase,
  30. symppu,
  31. aasmbase;
  32. type
  33. taitype = (
  34. ait_none,
  35. ait_align,
  36. ait_section,
  37. ait_comment,
  38. ait_direct,
  39. ait_string,
  40. ait_instruction,
  41. ait_datablock,
  42. ait_symbol,
  43. ait_symbol_end, { needed to calc the size of a symbol }
  44. ait_label,
  45. ait_const_32bit,
  46. ait_const_16bit,
  47. ait_const_8bit,
  48. ait_const_symbol,
  49. { the following is only used by the win32 version of the compiler }
  50. { and only the GNU AS Win32 is able to write it }
  51. ait_const_rva,
  52. ait_real_32bit,
  53. ait_real_64bit,
  54. ait_real_80bit,
  55. ait_comp_64bit,
  56. ait_real_128bit,
  57. {$ifdef GDB}
  58. ait_stabn,
  59. ait_stabs,
  60. ait_force_line,
  61. ait_stab_function_name,
  62. {$endif GDB}
  63. {$ifdef alpha}
  64. { the follow is for the DEC Alpha }
  65. ait_frame,
  66. ait_ent,
  67. {$endif alpha}
  68. {$ifdef ia64}
  69. ait_bundle,
  70. ait_stop,
  71. {$endif ia64}
  72. {$ifdef m68k}
  73. ait_labeled_instruction,
  74. {$endif m68k}
  75. {$ifdef SPARC}
  76. ait_labeled_instruction,
  77. {$endif SPARC}
  78. ait_cut, { used to split into tiny assembler files }
  79. ait_regalloc,
  80. ait_tempalloc,
  81. ait_marker { used to mark assembler blocks and inlined functions }
  82. );
  83. const
  84. taitypestr : array[taitype] of string[14] = (
  85. '<none>',
  86. 'align',
  87. 'section',
  88. 'comment',
  89. 'direct',
  90. 'string',
  91. 'instruction',
  92. 'datablock',
  93. 'symbol',
  94. 'symbol_end',
  95. 'label',
  96. 'const_32bit',
  97. 'const_16bit',
  98. 'const_8bit',
  99. 'const_symbol',
  100. 'const_rva',
  101. 'real_32bit',
  102. 'real_64bit',
  103. 'real_80bit',
  104. 'comp_64bit',
  105. 'real_128bit',
  106. {$ifdef GDB}
  107. 'stabn',
  108. 'stabs',
  109. 'force_line',
  110. 'stab_funcname',
  111. {$endif GDB}
  112. {$ifdef alpha}
  113. { the follow is for the DEC Alpha }
  114. 'frame',
  115. 'ent',
  116. {$endif alpha}
  117. {$ifdef ia64}
  118. 'bundle',
  119. 'stop',
  120. {$endif ia64}
  121. {$ifdef m68k}
  122. 'labeled_instr',
  123. {$endif m68k}
  124. {$ifdef SPARC}
  125. 'labeled_instr',
  126. {$endif SPARC}
  127. 'cut',
  128. 'regalloc',
  129. 'tempalloc',
  130. 'marker'
  131. );
  132. { ait_* types which don't result in executable code or which don't influence }
  133. { the way the program runs/behaves, but which may be encountered by the }
  134. { optimizer (= if it's sometimes added to the exprasm list). Update if you add }
  135. { a new ait type! }
  136. const
  137. SkipInstr = [ait_comment, ait_symbol,ait_section
  138. {$ifdef GDB}
  139. ,ait_stabs, ait_stabn, ait_stab_function_name, ait_force_line
  140. {$endif GDB}
  141. ,ait_regalloc, ait_tempalloc, ait_symbol_end];
  142. { ait_* types which do not have line information (and hence which are of type
  143. tai, otherwise, they are of type tailineinfo }
  144. { ait_* types which do not have line information (and hence which are of type
  145. tai, otherwise, they are of type tailineinfo }
  146. SkipLineInfo =[ait_label,
  147. ait_regalloc,ait_tempalloc,
  148. {$ifdef GDB}
  149. ait_stabn,ait_stabs,ait_stab_function_name,
  150. {$endif GDB}
  151. ait_cut,ait_marker,ait_align,ait_section,ait_comment,
  152. ait_const_8bit,ait_const_16bit,ait_const_32bit,
  153. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit
  154. ];
  155. type
  156. { cut type, required for alphanumeric ordering of the assembler filenames }
  157. TCutPlace=(cut_normal,cut_begin,cut_end);
  158. TMarker = (NoPropInfoStart,NoPropInfoEnd,
  159. AsmBlockStart,AsmBlockEnd,
  160. InlineStart,InlineEnd,marker_blockstart);
  161. { Buffer type used for alignment }
  162. tfillbuffer = array[0..63] of char;
  163. Tspill_temp_list=array[0..255] of Treference;
  164. { abstract assembler item }
  165. tai = class(TLinkedListItem)
  166. {$ifndef NOOPT}
  167. { pointer to record with optimizer info about this tai object }
  168. optinfo : pointer;
  169. {$endif NOOPT}
  170. typ : taitype;
  171. constructor Create;
  172. constructor ppuload(t:taitype;ppufile:tcompilerppufile);virtual;
  173. procedure ppuwrite(ppufile:tcompilerppufile);virtual;
  174. procedure derefimpl;virtual;
  175. end;
  176. { abstract assembler item with line information }
  177. tailineinfo = class(tai)
  178. fileinfo : tfileposinfo;
  179. constructor Create;
  180. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  181. procedure ppuwrite(ppufile:tcompilerppufile);override;
  182. end;
  183. taiclass = class of tai;
  184. taiclassarray = array[taitype] of taiclass;
  185. { Generates an assembler string }
  186. tai_string = class(tailineinfo)
  187. str : pchar;
  188. { extra len so the string can contain an \0 }
  189. len : longint;
  190. constructor Create(const _str : string);
  191. constructor Create_pchar(_str : pchar);
  192. constructor Create_length_pchar(_str : pchar;length : longint);
  193. destructor Destroy;override;
  194. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  195. procedure ppuwrite(ppufile:tcompilerppufile);override;
  196. function getcopy:tlinkedlistitem;override;
  197. end;
  198. { Generates a common label }
  199. tai_symbol = class(tailineinfo)
  200. is_global : boolean;
  201. sym : tasmsymbol;
  202. size : longint;
  203. constructor Create(_sym:tasmsymbol;siz:longint);
  204. constructor Create_Global(_sym:tasmsymbol;siz:longint);
  205. constructor Createname(const _name : string;siz:longint);
  206. constructor Createname_global(const _name : string;siz:longint);
  207. constructor Createdataname(const _name : string;siz:longint);
  208. constructor Createdataname_global(const _name : string;siz:longint);
  209. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  210. procedure ppuwrite(ppufile:tcompilerppufile);override;
  211. procedure derefimpl;override;
  212. end;
  213. tai_symbol_end = class(tailineinfo)
  214. sym : tasmsymbol;
  215. constructor Create(_sym:tasmsymbol);
  216. constructor Createname(const _name : string);
  217. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  218. procedure ppuwrite(ppufile:tcompilerppufile);override;
  219. procedure derefimpl;override;
  220. end;
  221. { Generates an assembler label }
  222. tai_label = class(tai)
  223. is_global : boolean;
  224. l : tasmlabel;
  225. constructor Create(_l : tasmlabel);
  226. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  227. procedure ppuwrite(ppufile:tcompilerppufile);override;
  228. procedure derefimpl;override;
  229. end;
  230. { Directly output data to final assembler file }
  231. tai_direct = class(tailineinfo)
  232. str : pchar;
  233. constructor Create(_str : pchar);
  234. destructor Destroy; override;
  235. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  236. procedure ppuwrite(ppufile:tcompilerppufile);override;
  237. function getcopy:tlinkedlistitem;override;
  238. end;
  239. { Generates an assembler comment }
  240. tai_comment = class(tai)
  241. str : pchar;
  242. constructor Create(_str : pchar);
  243. destructor Destroy; override;
  244. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  245. procedure ppuwrite(ppufile:tcompilerppufile);override;
  246. function getcopy:tlinkedlistitem;override;
  247. end;
  248. { Generates a section / segment directive }
  249. tai_section = class(tai)
  250. sec : TSection;
  251. constructor Create(s : TSection);
  252. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  253. procedure ppuwrite(ppufile:tcompilerppufile);override;
  254. end;
  255. { Generates an uninitializised data block }
  256. tai_datablock = class(tailineinfo)
  257. is_global : boolean;
  258. sym : tasmsymbol;
  259. size : longint;
  260. constructor Create(const _name : string;_size : longint);
  261. constructor Create_global(const _name : string;_size : longint);
  262. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  263. procedure ppuwrite(ppufile:tcompilerppufile);override;
  264. procedure derefimpl;override;
  265. end;
  266. { Generates a long integer (32 bit) }
  267. tai_const = class(tai)
  268. value : longint;
  269. constructor Create_32bit(_value : longint);
  270. constructor Create_16bit(_value : word);
  271. constructor Create_8bit(_value : byte);
  272. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  273. procedure ppuwrite(ppufile:tcompilerppufile);override;
  274. end;
  275. tai_const_symbol = class(tailineinfo)
  276. sym : tasmsymbol;
  277. offset : longint;
  278. constructor Create(_sym:tasmsymbol);
  279. constructor Create_offset(_sym:tasmsymbol;ofs:longint);
  280. constructor Create_rva(_sym:tasmsymbol);
  281. constructor Createname(const name:string);
  282. constructor Createname_offset(const name:string;ofs:longint);
  283. constructor Createname_rva(const name:string);
  284. constructor Createdataname(const name:string);
  285. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  286. procedure ppuwrite(ppufile:tcompilerppufile);override;
  287. procedure derefimpl;override;
  288. function getcopy:tlinkedlistitem;override;
  289. end;
  290. { Generates a single float (32 bit real) }
  291. tai_real_32bit = class(tai)
  292. value : ts32real;
  293. constructor Create(_value : ts32real);
  294. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  295. procedure ppuwrite(ppufile:tcompilerppufile);override;
  296. end;
  297. { Generates a double float (64 bit real) }
  298. tai_real_64bit = class(tai)
  299. value : ts64real;
  300. constructor Create(_value : ts64real);
  301. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  302. procedure ppuwrite(ppufile:tcompilerppufile);override;
  303. end;
  304. { Generates an extended float (80 bit real) }
  305. tai_real_80bit = class(tai)
  306. value : ts80real;
  307. constructor Create(_value : ts80real);
  308. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  309. procedure ppuwrite(ppufile:tcompilerppufile);override;
  310. end;
  311. { Generates a comp int (integer over 64 bits)
  312. This is Intel 80x86 specific, and is not
  313. really supported on other processors.
  314. }
  315. tai_comp_64bit = class(tai)
  316. value : ts64comp;
  317. constructor Create(_value : ts64comp);
  318. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  319. procedure ppuwrite(ppufile:tcompilerppufile);override;
  320. end;
  321. { Insert a cut to split assembler into several smaller files }
  322. tai_cut = class(tai)
  323. place : tcutplace;
  324. constructor Create;
  325. constructor Create_begin;
  326. constructor Create_end;
  327. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  328. procedure ppuwrite(ppufile:tcompilerppufile);override;
  329. end;
  330. { Insert a marker for assembler and inline blocks }
  331. tai_marker = class(tai)
  332. Kind: TMarker;
  333. Constructor Create(_Kind: TMarker);
  334. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  335. procedure ppuwrite(ppufile:tcompilerppufile);override;
  336. end;
  337. tai_tempalloc = class(tai)
  338. allocation : boolean;
  339. {$ifdef EXTDEBUG}
  340. problem : pstring;
  341. {$endif EXTDEBUG}
  342. temppos,
  343. tempsize : longint;
  344. constructor alloc(pos,size:longint);
  345. constructor dealloc(pos,size:longint);
  346. {$ifdef EXTDEBUG}
  347. constructor allocinfo(pos,size:longint;const st:string);
  348. {$endif EXTDEBUG}
  349. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  350. destructor destroy;override;
  351. procedure ppuwrite(ppufile:tcompilerppufile);override;
  352. end;
  353. tai_regalloc = class(tai)
  354. allocation : boolean;
  355. reg : tregister;
  356. constructor alloc(r : tregister);
  357. constructor dealloc(r : tregister);
  358. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  359. procedure ppuwrite(ppufile:tcompilerppufile);override;
  360. end;
  361. Taasmoutput=class;
  362. Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
  363. Trgungetproc=procedure(list:Taasmoutput;position:Tai;const r:Tregister) of object;
  364. { Class template for assembler instructions
  365. }
  366. taicpu_abstract = class(tailineinfo)
  367. protected
  368. procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
  369. procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
  370. procedure ppuderefoper(var o:toper);virtual;abstract;
  371. public
  372. { Condition flags for instruction }
  373. condition : TAsmCond;
  374. { Number of operands to instruction }
  375. ops : byte;
  376. { Operands of instruction }
  377. oper : array[0..max_operands-1] of toper;
  378. { Actual opcode of instruction }
  379. opcode : tasmop;
  380. {$ifdef x86}
  381. segprefix : tregister;
  382. {$endif x86}
  383. { true if instruction is a jmp }
  384. is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
  385. Constructor Create(op : tasmop);
  386. Destructor Destroy;override;
  387. function getcopy:TLinkedListItem;override;
  388. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  389. procedure ppuwrite(ppufile:tcompilerppufile);override;
  390. procedure derefimpl;override;
  391. procedure SetCondition(const c:TAsmCond);
  392. procedure loadconst(opidx:longint;l:aword);
  393. procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
  394. procedure loadref(opidx:longint;const r:treference);
  395. procedure loadreg(opidx:longint;r:tregister);
  396. procedure loadoper(opidx:longint;o:toper);
  397. function is_nop:boolean;virtual;abstract;
  398. function is_move:boolean;virtual;abstract;
  399. {$ifdef NEWRA}
  400. { register allocator }
  401. function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
  402. procedure forward_allocation(p:Tai;var unusedregsint:Tsupregset);
  403. function spill_registers(list:Taasmoutput;
  404. rgget:Trggetproc;
  405. rgunget:Trgungetproc;
  406. r:Tsupregset;
  407. var unusedregsint:Tsupregset;
  408. const spilltemplist:Tspill_temp_list):boolean;virtual;abstract;
  409. {$endif NEWRA}
  410. end;
  411. { alignment for operator }
  412. tai_align_abstract = class(tai)
  413. aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align }
  414. fillsize : byte; { real size to fill }
  415. fillop : byte; { value to fill with - optional }
  416. use_op : boolean;
  417. constructor Create(b:byte);
  418. constructor Create_op(b: byte; _op: byte);
  419. constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
  420. procedure ppuwrite(ppufile:tcompilerppufile);override;
  421. function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
  422. end;
  423. Ttranstable=array[Tsuperregister] of Tsuperregister;
  424. taasmoutput = class(tlinkedlist)
  425. constructor create;
  426. function getlasttaifilepos : pfileposinfo;
  427. procedure translate_registers(const table:Ttranstable);
  428. end;
  429. var
  430. { array with all class types for tais }
  431. aiclass : taiclassarray;
  432. { temporary lists }
  433. exprasmlist,
  434. { default lists }
  435. datasegment,codesegment,bsssegment,
  436. debuglist,withdebuglist,consts,
  437. importssection,exportssection,
  438. resourcesection,rttilist,
  439. resourcestringlist : taasmoutput;
  440. function ppuloadai(ppufile:tcompilerppufile):tai;
  441. procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
  442. implementation
  443. uses
  444. {$ifdef delphi}
  445. sysutils,
  446. {$else}
  447. strings,
  448. {$endif}
  449. verbose;
  450. const
  451. pputaimarker = 254;
  452. {****************************************************************************
  453. Helpers
  454. ****************************************************************************}
  455. function ppuloadai(ppufile:tcompilerppufile):tai;
  456. var
  457. b : byte;
  458. t : taitype;
  459. begin
  460. { marker }
  461. b:=ppufile.getbyte;
  462. if b<>pputaimarker then
  463. internalerror(200208181);
  464. { load nodetype }
  465. t:=taitype(ppufile.getbyte);
  466. if t<>ait_none then
  467. begin
  468. if t>high(taitype) then
  469. internalerror(200208182);
  470. if not assigned(aiclass[t]) then
  471. internalerror(200208183);
  472. {writeln('taiload: ',taitypestr[t]);}
  473. { generate tai of the correct class }
  474. ppuloadai:=aiclass[t].ppuload(t,ppufile);
  475. end
  476. else
  477. ppuloadai:=nil;
  478. end;
  479. procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
  480. begin
  481. { marker, read by ppuloadnode }
  482. ppufile.putbyte(pputaimarker);
  483. if assigned(n) then
  484. begin
  485. { type, read by ppuloadnode }
  486. ppufile.putbyte(byte(n.typ));
  487. {writeln('taiwrite: ',taitypestr[n.typ]);}
  488. n.ppuwrite(ppufile);
  489. end
  490. else
  491. ppufile.putbyte(byte(ait_none));
  492. end;
  493. {****************************************************************************
  494. TAI
  495. ****************************************************************************}
  496. constructor tai.Create;
  497. begin
  498. {$ifndef NOOPT}
  499. optinfo:=nil;
  500. {$endif NOOPT}
  501. end;
  502. constructor tai.ppuload(t:taitype;ppufile:tcompilerppufile);
  503. begin
  504. typ:=t;
  505. {$ifndef NOOPT}
  506. optinfo:=nil;
  507. {$endif}
  508. end;
  509. procedure tai.ppuwrite(ppufile:tcompilerppufile);
  510. begin
  511. end;
  512. procedure tai.derefimpl;
  513. begin
  514. end;
  515. {****************************************************************************
  516. TAILINEINFO
  517. ****************************************************************************}
  518. constructor tailineinfo.create;
  519. begin
  520. inherited create;
  521. fileinfo:=aktfilepos;
  522. end;
  523. constructor tailineinfo.ppuload(t:taitype;ppufile:tcompilerppufile);
  524. begin
  525. inherited ppuload(t,ppufile);
  526. ppufile.getposinfo(fileinfo);
  527. end;
  528. procedure tailineinfo.ppuwrite(ppufile:tcompilerppufile);
  529. begin
  530. inherited ppuwrite(ppufile);
  531. ppufile.putposinfo(fileinfo);
  532. end;
  533. {****************************************************************************
  534. TAI_SECTION
  535. ****************************************************************************}
  536. constructor tai_section.Create(s : TSection);
  537. begin
  538. inherited Create;
  539. typ:=ait_section;
  540. sec:=s;
  541. end;
  542. constructor tai_section.ppuload(t:taitype;ppufile:tcompilerppufile);
  543. begin
  544. inherited ppuload(t,ppufile);
  545. sec:=tsection(ppufile.getbyte);
  546. end;
  547. procedure tai_section.ppuwrite(ppufile:tcompilerppufile);
  548. begin
  549. inherited ppuwrite(ppufile);
  550. ppufile.putbyte(byte(sec));
  551. end;
  552. {****************************************************************************
  553. TAI_DATABLOCK
  554. ****************************************************************************}
  555. constructor tai_datablock.Create(const _name : string;_size : longint);
  556. begin
  557. inherited Create;
  558. typ:=ait_datablock;
  559. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  560. { keep things aligned }
  561. if _size<=0 then
  562. _size:=4;
  563. size:=_size;
  564. is_global:=false;
  565. end;
  566. constructor tai_datablock.Create_global(const _name : string;_size : longint);
  567. begin
  568. inherited Create;
  569. typ:=ait_datablock;
  570. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  571. { keep things aligned }
  572. if _size<=0 then
  573. _size:=4;
  574. size:=_size;
  575. is_global:=true;
  576. end;
  577. constructor tai_datablock.ppuload(t:taitype;ppufile:tcompilerppufile);
  578. begin
  579. inherited Create;
  580. sym:=ppufile.getasmsymbol;
  581. size:=ppufile.getlongint;
  582. is_global:=boolean(ppufile.getbyte);
  583. end;
  584. procedure tai_datablock.ppuwrite(ppufile:tcompilerppufile);
  585. begin
  586. inherited ppuwrite(ppufile);
  587. ppufile.putasmsymbol(sym);
  588. ppufile.putlongint(size);
  589. ppufile.putbyte(byte(is_global));
  590. end;
  591. procedure tai_datablock.derefimpl;
  592. begin
  593. objectlibrary.DerefAsmsymbol(sym);
  594. end;
  595. {****************************************************************************
  596. TAI_SYMBOL
  597. ****************************************************************************}
  598. constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
  599. begin
  600. inherited Create;
  601. typ:=ait_symbol;
  602. sym:=_sym;
  603. size:=siz;
  604. sym.defbind:=AB_LOCAL;
  605. is_global:=false;
  606. end;
  607. constructor tai_symbol.Create_global(_sym:tasmsymbol;siz:longint);
  608. begin
  609. inherited Create;
  610. typ:=ait_symbol;
  611. sym:=_sym;
  612. size:=siz;
  613. sym.defbind:=AB_GLOBAL;
  614. is_global:=true;
  615. end;
  616. constructor tai_symbol.Createname(const _name : string;siz:longint);
  617. begin
  618. inherited Create;
  619. typ:=ait_symbol;
  620. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
  621. size:=siz;
  622. is_global:=false;
  623. end;
  624. constructor tai_symbol.Createname_global(const _name : string;siz:longint);
  625. begin
  626. inherited Create;
  627. typ:=ait_symbol;
  628. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
  629. size:=siz;
  630. is_global:=true;
  631. end;
  632. constructor tai_symbol.Createdataname(const _name : string;siz:longint);
  633. begin
  634. inherited Create;
  635. typ:=ait_symbol;
  636. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  637. size:=siz;
  638. is_global:=false;
  639. end;
  640. constructor tai_symbol.Createdataname_global(const _name : string;siz:longint);
  641. begin
  642. inherited Create;
  643. typ:=ait_symbol;
  644. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  645. size:=siz;
  646. is_global:=true;
  647. end;
  648. constructor tai_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
  649. begin
  650. inherited ppuload(t,ppufile);
  651. sym:=ppufile.getasmsymbol;
  652. size:=ppufile.getlongint;
  653. is_global:=boolean(ppufile.getbyte);
  654. end;
  655. procedure tai_symbol.ppuwrite(ppufile:tcompilerppufile);
  656. begin
  657. inherited ppuwrite(ppufile);
  658. ppufile.putasmsymbol(sym);
  659. ppufile.putlongint(size);
  660. ppufile.putbyte(byte(is_global));
  661. end;
  662. procedure tai_symbol.derefimpl;
  663. begin
  664. objectlibrary.DerefAsmsymbol(sym);
  665. end;
  666. {****************************************************************************
  667. TAI_SYMBOL
  668. ****************************************************************************}
  669. constructor tai_symbol_end.Create(_sym:tasmsymbol);
  670. begin
  671. inherited Create;
  672. typ:=ait_symbol_end;
  673. sym:=_sym;
  674. end;
  675. constructor tai_symbol_end.Createname(const _name : string);
  676. begin
  677. inherited Create;
  678. typ:=ait_symbol_end;
  679. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
  680. end;
  681. constructor tai_symbol_end.ppuload(t:taitype;ppufile:tcompilerppufile);
  682. begin
  683. inherited ppuload(t,ppufile);
  684. sym:=ppufile.getasmsymbol;
  685. end;
  686. procedure tai_symbol_end.ppuwrite(ppufile:tcompilerppufile);
  687. begin
  688. inherited ppuwrite(ppufile);
  689. ppufile.putasmsymbol(sym);
  690. end;
  691. procedure tai_symbol_end.derefimpl;
  692. begin
  693. objectlibrary.DerefAsmsymbol(sym);
  694. end;
  695. {****************************************************************************
  696. TAI_CONST
  697. ****************************************************************************}
  698. constructor tai_const.Create_32bit(_value : longint);
  699. begin
  700. inherited Create;
  701. typ:=ait_const_32bit;
  702. value:=_value;
  703. end;
  704. constructor tai_const.Create_16bit(_value : word);
  705. begin
  706. inherited Create;
  707. typ:=ait_const_16bit;
  708. value:=_value;
  709. end;
  710. constructor tai_const.Create_8bit(_value : byte);
  711. begin
  712. inherited Create;
  713. typ:=ait_const_8bit;
  714. value:=_value;
  715. end;
  716. constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile);
  717. begin
  718. inherited ppuload(t,ppufile);
  719. value:=ppufile.getlongint;
  720. end;
  721. procedure tai_const.ppuwrite(ppufile:tcompilerppufile);
  722. begin
  723. inherited ppuwrite(ppufile);
  724. ppufile.putlongint(value);
  725. end;
  726. {****************************************************************************
  727. TAI_CONST_SYMBOL
  728. ****************************************************************************}
  729. constructor tai_const_symbol.Create(_sym:tasmsymbol);
  730. begin
  731. inherited Create;
  732. typ:=ait_const_symbol;
  733. sym:=_sym;
  734. offset:=0;
  735. { update sym info }
  736. sym.increfs;
  737. end;
  738. constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:longint);
  739. begin
  740. inherited Create;
  741. typ:=ait_const_symbol;
  742. sym:=_sym;
  743. offset:=ofs;
  744. { update sym info }
  745. sym.increfs;
  746. end;
  747. constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
  748. begin
  749. inherited Create;
  750. typ:=ait_const_rva;
  751. sym:=_sym;
  752. offset:=0;
  753. { update sym info }
  754. sym.increfs;
  755. end;
  756. constructor tai_const_symbol.Createname(const name:string);
  757. begin
  758. inherited Create;
  759. typ:=ait_const_symbol;
  760. sym:=objectlibrary.newasmsymbol(name);
  761. offset:=0;
  762. { update sym info }
  763. sym.increfs;
  764. end;
  765. constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
  766. begin
  767. inherited Create;
  768. typ:=ait_const_symbol;
  769. sym:=objectlibrary.newasmsymbol(name);
  770. offset:=ofs;
  771. { update sym info }
  772. sym.increfs;
  773. end;
  774. constructor tai_const_symbol.Createname_rva(const name:string);
  775. begin
  776. inherited Create;
  777. typ:=ait_const_rva;
  778. sym:=objectlibrary.newasmsymbol(name);
  779. offset:=0;
  780. { update sym info }
  781. sym.increfs;
  782. end;
  783. constructor tai_const_symbol.Createdataname(const name:string);
  784. begin
  785. inherited Create;
  786. typ:=ait_const_symbol;
  787. sym:=objectlibrary.newasmsymboltype(name,AB_EXTERNAL,AT_DATA);
  788. offset:=0;
  789. { update sym info }
  790. sym.increfs;
  791. end;
  792. constructor tai_const_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
  793. begin
  794. inherited ppuload(t,ppufile);
  795. sym:=ppufile.getasmsymbol;
  796. offset:=ppufile.getlongint;
  797. end;
  798. procedure tai_const_symbol.ppuwrite(ppufile:tcompilerppufile);
  799. begin
  800. inherited ppuwrite(ppufile);
  801. ppufile.putasmsymbol(sym);
  802. ppufile.putlongint(offset);
  803. end;
  804. procedure tai_const_symbol.derefimpl;
  805. begin
  806. objectlibrary.DerefAsmsymbol(sym);
  807. end;
  808. function tai_const_symbol.getcopy:tlinkedlistitem;
  809. begin
  810. getcopy:=inherited getcopy;
  811. { we need to increase the reference number }
  812. sym.increfs;
  813. end;
  814. {****************************************************************************
  815. TAI_real_32bit
  816. ****************************************************************************}
  817. constructor tai_real_32bit.Create(_value : ts32real);
  818. begin
  819. inherited Create;
  820. typ:=ait_real_32bit;
  821. value:=_value;
  822. end;
  823. constructor tai_real_32bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  824. begin
  825. inherited ppuload(t,ppufile);
  826. value:=ppufile.getreal;
  827. end;
  828. procedure tai_real_32bit.ppuwrite(ppufile:tcompilerppufile);
  829. begin
  830. inherited ppuwrite(ppufile);
  831. ppufile.putreal(value);
  832. end;
  833. {****************************************************************************
  834. TAI_real_64bit
  835. ****************************************************************************}
  836. constructor tai_real_64bit.Create(_value : ts64real);
  837. begin
  838. inherited Create;
  839. typ:=ait_real_64bit;
  840. value:=_value;
  841. end;
  842. constructor tai_real_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  843. begin
  844. inherited ppuload(t,ppufile);
  845. value:=ppufile.getreal;
  846. end;
  847. procedure tai_real_64bit.ppuwrite(ppufile:tcompilerppufile);
  848. begin
  849. inherited ppuwrite(ppufile);
  850. ppufile.putreal(value);
  851. end;
  852. {****************************************************************************
  853. TAI_real_80bit
  854. ****************************************************************************}
  855. constructor tai_real_80bit.Create(_value : ts80real);
  856. begin
  857. inherited Create;
  858. typ:=ait_real_80bit;
  859. value:=_value;
  860. end;
  861. constructor tai_real_80bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  862. begin
  863. inherited ppuload(t,ppufile);
  864. value:=ppufile.getreal;
  865. end;
  866. procedure tai_real_80bit.ppuwrite(ppufile:tcompilerppufile);
  867. begin
  868. inherited ppuwrite(ppufile);
  869. ppufile.putreal(value);
  870. end;
  871. {****************************************************************************
  872. Tai_comp_64bit
  873. ****************************************************************************}
  874. constructor tai_comp_64bit.Create(_value : ts64comp);
  875. begin
  876. inherited Create;
  877. typ:=ait_comp_64bit;
  878. value:=_value;
  879. end;
  880. constructor tai_comp_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  881. begin
  882. inherited ppuload(t,ppufile);
  883. ppufile.putdata(value,sizeof(value));
  884. end;
  885. procedure tai_comp_64bit.ppuwrite(ppufile:tcompilerppufile);
  886. begin
  887. inherited ppuwrite(ppufile);
  888. ppufile.getdata(value,sizeof(value));
  889. end;
  890. {****************************************************************************
  891. TAI_STRING
  892. ****************************************************************************}
  893. constructor tai_string.Create(const _str : string);
  894. begin
  895. inherited Create;
  896. typ:=ait_string;
  897. len:=length(_str);
  898. getmem(str,len+1);
  899. strpcopy(str,_str);
  900. end;
  901. constructor tai_string.Create_pchar(_str : pchar);
  902. begin
  903. inherited Create;
  904. typ:=ait_string;
  905. str:=_str;
  906. len:=strlen(_str);
  907. end;
  908. constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
  909. begin
  910. inherited Create;
  911. typ:=ait_string;
  912. str:=_str;
  913. len:=length;
  914. end;
  915. destructor tai_string.destroy;
  916. begin
  917. { you can have #0 inside the strings so }
  918. if str<>nil then
  919. freemem(str,len+1);
  920. inherited Destroy;
  921. end;
  922. constructor tai_string.ppuload(t:taitype;ppufile:tcompilerppufile);
  923. begin
  924. inherited ppuload(t,ppufile);
  925. len:=ppufile.getlongint;
  926. getmem(str,len+1);
  927. ppufile.getdata(str^,len);
  928. str[len]:=#0;
  929. end;
  930. procedure tai_string.ppuwrite(ppufile:tcompilerppufile);
  931. begin
  932. inherited ppuwrite(ppufile);
  933. ppufile.putlongint(len);
  934. ppufile.putdata(str^,len);
  935. end;
  936. function tai_string.getcopy : tlinkedlistitem;
  937. var
  938. p : tlinkedlistitem;
  939. begin
  940. p:=inherited getcopy;
  941. getmem(tai_string(p).str,len+1);
  942. move(str^,tai_string(p).str^,len+1);
  943. getcopy:=p;
  944. end;
  945. {****************************************************************************
  946. TAI_LABEL
  947. ****************************************************************************}
  948. constructor tai_label.create(_l : tasmlabel);
  949. begin
  950. inherited Create;
  951. typ:=ait_label;
  952. l:=_l;
  953. l.is_set:=true;
  954. is_global:=(l.defbind=AB_GLOBAL);
  955. end;
  956. constructor tai_label.ppuload(t:taitype;ppufile:tcompilerppufile);
  957. begin
  958. inherited ppuload(t,ppufile);
  959. l:=tasmlabel(ppufile.getasmsymbol);
  960. is_global:=boolean(ppufile.getbyte);
  961. end;
  962. procedure tai_label.ppuwrite(ppufile:tcompilerppufile);
  963. begin
  964. inherited ppuwrite(ppufile);
  965. ppufile.putasmsymbol(l);
  966. ppufile.putbyte(byte(is_global));
  967. end;
  968. procedure tai_label.derefimpl;
  969. begin
  970. objectlibrary.DerefAsmsymbol(tasmsymbol(l));
  971. l.is_set:=true;
  972. end;
  973. {****************************************************************************
  974. TAI_DIRECT
  975. ****************************************************************************}
  976. constructor tai_direct.Create(_str : pchar);
  977. begin
  978. inherited Create;
  979. typ:=ait_direct;
  980. str:=_str;
  981. end;
  982. destructor tai_direct.destroy;
  983. begin
  984. strdispose(str);
  985. inherited Destroy;
  986. end;
  987. constructor tai_direct.ppuload(t:taitype;ppufile:tcompilerppufile);
  988. var
  989. len : longint;
  990. begin
  991. inherited ppuload(t,ppufile);
  992. len:=ppufile.getlongint;
  993. getmem(str,len+1);
  994. ppufile.getdata(str^,len);
  995. str[len]:=#0;
  996. end;
  997. procedure tai_direct.ppuwrite(ppufile:tcompilerppufile);
  998. var
  999. len : longint;
  1000. begin
  1001. inherited ppuwrite(ppufile);
  1002. len:=strlen(str);
  1003. ppufile.putlongint(len);
  1004. ppufile.putdata(str^,len);
  1005. end;
  1006. function tai_direct.getcopy : tlinkedlistitem;
  1007. var
  1008. p : tlinkedlistitem;
  1009. begin
  1010. p:=inherited getcopy;
  1011. getmem(tai_direct(p).str,strlen(str)+1);
  1012. move(str^,tai_direct(p).str^,strlen(str)+1);
  1013. getcopy:=p;
  1014. end;
  1015. {****************************************************************************
  1016. tai_comment comment to be inserted in the assembler file
  1017. ****************************************************************************}
  1018. constructor tai_comment.Create(_str : pchar);
  1019. begin
  1020. inherited Create;
  1021. typ:=ait_comment;
  1022. str:=_str;
  1023. end;
  1024. destructor tai_comment.destroy;
  1025. begin
  1026. strdispose(str);
  1027. inherited Destroy;
  1028. end;
  1029. constructor tai_comment.ppuload(t:taitype;ppufile:tcompilerppufile);
  1030. var
  1031. len : longint;
  1032. begin
  1033. inherited ppuload(t,ppufile);
  1034. len:=ppufile.getlongint;
  1035. getmem(str,len+1);
  1036. ppufile.getdata(str^,len);
  1037. str[len]:=#0;
  1038. end;
  1039. procedure tai_comment.ppuwrite(ppufile:tcompilerppufile);
  1040. var
  1041. len : longint;
  1042. begin
  1043. inherited ppuwrite(ppufile);
  1044. len:=strlen(str);
  1045. ppufile.putlongint(len);
  1046. ppufile.putdata(str^,len);
  1047. end;
  1048. function tai_comment.getcopy : tlinkedlistitem;
  1049. var
  1050. p : tlinkedlistitem;
  1051. begin
  1052. p:=inherited getcopy;
  1053. getmem(tai_comment(p).str,strlen(str)+1);
  1054. move(str^,tai_comment(p).str^,strlen(str)+1);
  1055. getcopy:=p;
  1056. end;
  1057. {****************************************************************************
  1058. TAI_CUT
  1059. ****************************************************************************}
  1060. constructor tai_cut.Create;
  1061. begin
  1062. inherited Create;
  1063. typ:=ait_cut;
  1064. place:=cut_normal;
  1065. end;
  1066. constructor tai_cut.Create_begin;
  1067. begin
  1068. inherited Create;
  1069. typ:=ait_cut;
  1070. place:=cut_begin;
  1071. end;
  1072. constructor tai_cut.Create_end;
  1073. begin
  1074. inherited Create;
  1075. typ:=ait_cut;
  1076. place:=cut_end;
  1077. end;
  1078. constructor tai_cut.ppuload(t:taitype;ppufile:tcompilerppufile);
  1079. begin
  1080. inherited ppuload(t,ppufile);
  1081. place:=TCutPlace(ppufile.getbyte);
  1082. end;
  1083. procedure tai_cut.ppuwrite(ppufile:tcompilerppufile);
  1084. begin
  1085. inherited ppuwrite(ppufile);
  1086. ppufile.putbyte(byte(place));
  1087. end;
  1088. {****************************************************************************
  1089. Tai_Marker
  1090. ****************************************************************************}
  1091. constructor Tai_Marker.Create(_Kind: TMarker);
  1092. begin
  1093. Inherited Create;
  1094. typ := ait_marker;
  1095. Kind := _Kind;
  1096. end;
  1097. constructor Tai_Marker.ppuload(t:taitype;ppufile:tcompilerppufile);
  1098. begin
  1099. inherited ppuload(t,ppufile);
  1100. kind:=TMarker(ppufile.getbyte);
  1101. end;
  1102. procedure Tai_Marker.ppuwrite(ppufile:tcompilerppufile);
  1103. begin
  1104. inherited ppuwrite(ppufile);
  1105. ppufile.putbyte(byte(kind));
  1106. end;
  1107. {*****************************************************************************
  1108. tai_tempalloc
  1109. *****************************************************************************}
  1110. constructor tai_tempalloc.alloc(pos,size:longint);
  1111. begin
  1112. inherited Create;
  1113. typ:=ait_tempalloc;
  1114. allocation:=true;
  1115. temppos:=pos;
  1116. tempsize:=size;
  1117. {$ifdef EXTDEBUG}
  1118. problem:=nil;
  1119. {$endif EXTDEBUG}
  1120. end;
  1121. destructor tai_tempalloc.destroy;
  1122. begin
  1123. {$ifdef EXTDEBUG}
  1124. stringdispose(problem);
  1125. {$endif EXTDEBUG}
  1126. inherited destroy;
  1127. end;
  1128. constructor tai_tempalloc.dealloc(pos,size:longint);
  1129. begin
  1130. inherited Create;
  1131. typ:=ait_tempalloc;
  1132. allocation:=false;
  1133. temppos:=pos;
  1134. tempsize:=size;
  1135. {$ifdef EXTDEBUG}
  1136. problem:=nil;
  1137. {$endif EXTDEBUG}
  1138. end;
  1139. {$ifdef EXTDEBUG}
  1140. constructor tai_tempalloc.allocinfo(pos,size:longint;const st:string);
  1141. begin
  1142. inherited Create;
  1143. typ:=ait_tempalloc;
  1144. allocation:=false;
  1145. temppos:=pos;
  1146. tempsize:=size;
  1147. problem:=stringdup(st);
  1148. end;
  1149. {$endif EXTDEBUG}
  1150. constructor tai_tempalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
  1151. begin
  1152. inherited ppuload(t,ppufile);
  1153. temppos:=ppufile.getlongint;
  1154. tempsize:=ppufile.getlongint;
  1155. allocation:=boolean(ppufile.getbyte);
  1156. {$ifdef EXTDEBUG}
  1157. problem:=nil;
  1158. {$endif EXTDEBUG}
  1159. end;
  1160. procedure tai_tempalloc.ppuwrite(ppufile:tcompilerppufile);
  1161. begin
  1162. inherited ppuwrite(ppufile);
  1163. ppufile.putlongint(temppos);
  1164. ppufile.putlongint(tempsize);
  1165. ppufile.putbyte(byte(allocation));
  1166. end;
  1167. {*****************************************************************************
  1168. tai_regalloc
  1169. *****************************************************************************}
  1170. constructor tai_regalloc.alloc(r : tregister);
  1171. begin
  1172. inherited create;
  1173. typ:=ait_regalloc;
  1174. allocation:=true;
  1175. reg:=r;
  1176. end;
  1177. constructor tai_regalloc.dealloc(r : tregister);
  1178. begin
  1179. inherited create;
  1180. typ:=ait_regalloc;
  1181. allocation:=false;
  1182. reg:=r;
  1183. end;
  1184. constructor tai_regalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
  1185. begin
  1186. inherited ppuload(t,ppufile);
  1187. ppufile.getdata(reg,sizeof(Tregister));
  1188. allocation:=boolean(ppufile.getbyte);
  1189. end;
  1190. procedure tai_regalloc.ppuwrite(ppufile:tcompilerppufile);
  1191. begin
  1192. inherited ppuwrite(ppufile);
  1193. ppufile.putdata(reg,sizeof(Tregister));
  1194. ppufile.putbyte(byte(allocation));
  1195. end;
  1196. {*****************************************************************************
  1197. TaiInstruction
  1198. *****************************************************************************}
  1199. constructor taicpu_abstract.Create(op : tasmop);
  1200. begin
  1201. inherited create;
  1202. typ:=ait_instruction;
  1203. is_jmp:=false;
  1204. opcode:=op;
  1205. ops:=0;
  1206. fillchar(condition,sizeof(condition),0);
  1207. fillchar(oper,sizeof(oper),0);
  1208. end;
  1209. destructor taicpu_abstract.Destroy;
  1210. var
  1211. i : longint;
  1212. begin
  1213. for i:=0 to ops-1 do
  1214. case oper[i].typ of
  1215. top_ref:
  1216. dispose(oper[i].ref);
  1217. end;
  1218. inherited destroy;
  1219. end;
  1220. { ---------------------------------------------------------------------
  1221. Loading of operands.
  1222. ---------------------------------------------------------------------}
  1223. procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
  1224. begin
  1225. if opidx>=ops then
  1226. ops:=opidx+1;
  1227. with oper[opidx] do
  1228. begin
  1229. if typ=top_ref then
  1230. dispose(ref);
  1231. val:=l;
  1232. typ:=top_const;
  1233. end;
  1234. end;
  1235. procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
  1236. begin
  1237. if not assigned(s) then
  1238. internalerror(200204251);
  1239. if opidx>=ops then
  1240. ops:=opidx+1;
  1241. with oper[opidx] do
  1242. begin
  1243. if typ=top_ref then
  1244. dispose(ref);
  1245. sym:=s;
  1246. symofs:=sofs;
  1247. typ:=top_symbol;
  1248. end;
  1249. s.increfs;
  1250. end;
  1251. procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
  1252. begin
  1253. if (r.base.enum=R_NO) or (r.index.enum=R_NO) then
  1254. internalerror(200308192);
  1255. if opidx>=ops then
  1256. ops:=opidx+1;
  1257. with oper[opidx] do
  1258. begin
  1259. if typ<>top_ref then
  1260. new(ref);
  1261. ref^:=r;
  1262. {$ifdef i386}
  1263. { We allow this exception for i386, since overloading this would be
  1264. too much of a a speed penalty}
  1265. if ref^.segment.enum=R_INTREGISTER then
  1266. begin
  1267. if (ref^.segment.number <> NR_NO) and (ref^.segment.number <> NR_DS) then
  1268. segprefix:=ref^.segment;
  1269. end
  1270. else
  1271. if not(ref^.segment.enum in [R_DS,R_NO]) then
  1272. segprefix:=ref^.segment;
  1273. {$endif}
  1274. typ:=top_ref;
  1275. { mark symbol as used }
  1276. if assigned(ref^.symbol) then
  1277. ref^.symbol.increfs;
  1278. end;
  1279. end;
  1280. procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
  1281. begin
  1282. if opidx>=ops then
  1283. ops:=opidx+1;
  1284. with oper[opidx] do
  1285. begin
  1286. if typ=top_ref then
  1287. dispose(ref);
  1288. reg:=r;
  1289. typ:=top_reg;
  1290. end;
  1291. end;
  1292. procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
  1293. begin
  1294. if opidx>=ops then
  1295. ops:=opidx+1;
  1296. if oper[opidx].typ=top_ref then
  1297. dispose(oper[opidx].ref);
  1298. oper[opidx]:=o;
  1299. { copy also the reference }
  1300. if oper[opidx].typ=top_ref then
  1301. begin
  1302. new(oper[opidx].ref);
  1303. oper[opidx].ref^:=o.ref^;
  1304. end;
  1305. end;
  1306. {$ifdef NEWRA}
  1307. { ---------------------------------------------------------------------
  1308. Register allocator methods.
  1309. ---------------------------------------------------------------------}
  1310. function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
  1311. var
  1312. back:Tsupregset;
  1313. begin
  1314. back:=unusedregsint;
  1315. get_insert_pos:=p;
  1316. while (p<>nil) and (p.typ=ait_regalloc) do
  1317. begin
  1318. {Rewind the register allocation.}
  1319. if Tai_regalloc(p).allocation then
  1320. include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
  1321. else
  1322. begin
  1323. exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
  1324. if Tai_regalloc(p).reg.number shr 8=huntfor1 then
  1325. begin
  1326. get_insert_pos:=Tai(p.previous);
  1327. back:=unusedregsint;
  1328. end;
  1329. if Tai_regalloc(p).reg.number shr 8=huntfor2 then
  1330. begin
  1331. get_insert_pos:=Tai(p.previous);
  1332. back:=unusedregsint;
  1333. end;
  1334. if Tai_regalloc(p).reg.number shr 8=huntfor3 then
  1335. begin
  1336. get_insert_pos:=Tai(p.previous);
  1337. back:=unusedregsint;
  1338. end;
  1339. end;
  1340. p:=Tai(p.previous);
  1341. end;
  1342. unusedregsint:=back;
  1343. end;
  1344. procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset);
  1345. begin
  1346. {Forward the register allocation again.}
  1347. while (p<>self) do
  1348. begin
  1349. if p.typ<>ait_regalloc then
  1350. internalerror(200305311);
  1351. if Tai_regalloc(p).allocation then
  1352. exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
  1353. else
  1354. include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
  1355. p:=Tai(p.next);
  1356. end;
  1357. end;
  1358. {$endif NEWRA}
  1359. { ---------------------------------------------------------------------
  1360. Miscellaneous methods.
  1361. ---------------------------------------------------------------------}
  1362. procedure taicpu_abstract.SetCondition(const c:TAsmCond);
  1363. begin
  1364. condition:=c;
  1365. end;
  1366. Function taicpu_abstract.getcopy:TLinkedListItem;
  1367. var
  1368. i : longint;
  1369. p : TLinkedListItem;
  1370. begin
  1371. p:=inherited getcopy;
  1372. { make a copy of the references }
  1373. for i:=1 to ops do
  1374. if (taicpu_abstract(p).oper[i-1].typ=top_ref) then
  1375. begin
  1376. new(taicpu_abstract(p).oper[i-1].ref);
  1377. taicpu_abstract(p).oper[i-1].ref^:=oper[i-1].ref^;
  1378. end;
  1379. getcopy:=p;
  1380. end;
  1381. constructor taicpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
  1382. var
  1383. i : integer;
  1384. begin
  1385. inherited ppuload(t,ppufile);
  1386. { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
  1387. ppufile.getdata(condition,sizeof(tasmcond));
  1388. ops:=ppufile.getbyte;
  1389. for i:=1 to ops do
  1390. ppuloadoper(ppufile,oper[i-1]);
  1391. opcode:=tasmop(ppufile.getword);
  1392. {$ifdef i386}
  1393. ppufile.getdata(segprefix,sizeof(Tregister));
  1394. {$endif i386}
  1395. is_jmp:=boolean(ppufile.getbyte);
  1396. end;
  1397. procedure taicpu_abstract.ppuwrite(ppufile:tcompilerppufile);
  1398. var
  1399. i : integer;
  1400. begin
  1401. inherited ppuwrite(ppufile);
  1402. ppufile.putdata(condition,sizeof(tasmcond));
  1403. ppufile.putbyte(ops);
  1404. for i:=1 to ops do
  1405. ppuwriteoper(ppufile,oper[i-1]);
  1406. ppufile.putword(word(opcode));
  1407. {$ifdef i386}
  1408. ppufile.putdata(segprefix,sizeof(Tregister));
  1409. {$endif i386}
  1410. ppufile.putbyte(byte(is_jmp));
  1411. end;
  1412. procedure taicpu_abstract.derefimpl;
  1413. var i:byte;
  1414. begin
  1415. for i:=1 to ops do
  1416. ppuderefoper(oper[i-1]);
  1417. end;
  1418. {****************************************************************************
  1419. tai_align_abstract
  1420. ****************************************************************************}
  1421. constructor tai_align_abstract.Create(b: byte);
  1422. begin
  1423. inherited Create;
  1424. typ:=ait_align;
  1425. if b in [1,2,4,8,16,32] then
  1426. aligntype := b
  1427. else
  1428. aligntype := 1;
  1429. fillsize:=0;
  1430. fillop:=0;
  1431. use_op:=false;
  1432. end;
  1433. constructor tai_align_abstract.Create_op(b: byte; _op: byte);
  1434. begin
  1435. inherited Create;
  1436. typ:=ait_align;
  1437. if b in [1,2,4,8,16,32] then
  1438. aligntype := b
  1439. else
  1440. aligntype := 1;
  1441. fillsize:=0;
  1442. fillop:=_op;
  1443. use_op:=true;
  1444. end;
  1445. function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
  1446. begin
  1447. fillchar(buf,high(buf),fillop);
  1448. calculatefillbuf:=pchar(@buf);
  1449. end;
  1450. constructor tai_align_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
  1451. begin
  1452. inherited ppuload(t,ppufile);
  1453. aligntype:=ppufile.getbyte;
  1454. fillsize:=0;
  1455. fillop:=ppufile.getbyte;
  1456. use_op:=boolean(ppufile.getbyte);
  1457. end;
  1458. procedure tai_align_abstract.ppuwrite(ppufile:tcompilerppufile);
  1459. begin
  1460. inherited ppuwrite(ppufile);
  1461. ppufile.putbyte(aligntype);
  1462. ppufile.putbyte(fillop);
  1463. ppufile.putbyte(byte(use_op));
  1464. end;
  1465. {*****************************************************************************
  1466. TAAsmOutput
  1467. *****************************************************************************}
  1468. constructor taasmoutput.create;
  1469. begin
  1470. inherited create;
  1471. { make sure the optimizer won't remove the first tai of this list}
  1472. insert(tai_marker.create(marker_blockstart));
  1473. end;
  1474. function taasmoutput.getlasttaifilepos : pfileposinfo;
  1475. var
  1476. hp : tlinkedlistitem;
  1477. begin
  1478. getlasttaifilepos := nil;
  1479. if assigned(last) then
  1480. begin
  1481. { find the last file information record }
  1482. if not (tai(last).typ in SkipLineInfo) then
  1483. getlasttaifilepos:=@tailineinfo(last).fileinfo
  1484. else
  1485. { go through list backwards to find the first entry
  1486. with line information
  1487. }
  1488. begin
  1489. hp:=tai(last);
  1490. while assigned(hp) and (tai(hp).typ in SkipLineInfo) do
  1491. hp:=hp.Previous;
  1492. { found entry }
  1493. if assigned(hp) then
  1494. getlasttaifilepos:=@tailineinfo(hp).fileinfo
  1495. end;
  1496. end;
  1497. end;
  1498. procedure Taasmoutput.translate_registers(const table:Ttranstable);
  1499. var p,q:Tai;
  1500. i:shortint;
  1501. r:Preference;
  1502. begin
  1503. p:=Tai(first);
  1504. while assigned(p) do
  1505. begin
  1506. case p.typ of
  1507. ait_regalloc:
  1508. Tai_regalloc(p).reg.number:=(Tai_regalloc(p).reg.number and $ff) or
  1509. (table[Tai_regalloc(p).reg.number shr 8] shl 8);
  1510. ait_instruction:
  1511. begin
  1512. for i:=0 to Taicpu_abstract(p).ops-1 do
  1513. if Taicpu_abstract(p).oper[i].typ=Top_reg then
  1514. Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
  1515. (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8)
  1516. else if Taicpu_abstract(p).oper[i].typ=Top_ref then
  1517. begin
  1518. r:=Taicpu_abstract(p).oper[i].ref;
  1519. if r^.base.number<>NR_NO then
  1520. r^.base.number:=(r^.base.number and $ff) or
  1521. (table[r^.base.number shr 8] shl 8);
  1522. if r^.index.number<>NR_NO then
  1523. r^.index.number:=(r^.index.number and $ff) or
  1524. (table[r^.index.number shr 8] shl 8);
  1525. end;
  1526. if Taicpu_abstract(p).is_nop then
  1527. begin
  1528. q:=p;
  1529. p:=Tai(p.next);
  1530. remove(q);
  1531. continue;
  1532. end;
  1533. end;
  1534. end;
  1535. p:=Tai(p.next);
  1536. end;
  1537. end;
  1538. end.
  1539. {
  1540. $Log$
  1541. Revision 1.35 2003-08-21 14:47:41 peter
  1542. * remove convert_registers
  1543. Revision 1.34 2003/08/20 20:29:06 daniel
  1544. * Some more R_NO changes
  1545. * Preventive code to loadref added
  1546. Revision 1.33 2003/08/17 20:47:47 daniel
  1547. * Notranslation changed into -sr functionality
  1548. Revision 1.32 2003/08/17 16:59:20 jonas
  1549. * fixed regvars so they work with newra (at least for ppc)
  1550. * fixed some volatile register bugs
  1551. + -dnotranslation option for -dnewra, which causes the registers not to
  1552. be translated from virtual to normal registers. Requires support in
  1553. the assembler writer as well, which is only implemented in aggas/
  1554. agppcgas currently
  1555. Revision 1.31 2003/08/11 21:18:20 peter
  1556. * start of sparc support for newra
  1557. Revision 1.30 2003/07/02 16:43:48 jonas
  1558. * always add dummy marker object at the start of an assembler list, so
  1559. the optimizer can't remove the first object
  1560. Revision 1.29 2003/06/03 13:01:59 daniel
  1561. * Register allocator finished
  1562. Revision 1.28 2003/05/12 18:13:57 peter
  1563. * create rtti label using newasmsymboldata and update binding
  1564. only when calling tai_symbol.create
  1565. * tai_symbol.create_global added
  1566. Revision 1.27 2003/04/25 20:59:33 peter
  1567. * removed funcretn,funcretsym, function result is now in varsym
  1568. and aliases for result and function name are added using absolutesym
  1569. * vs_hidden parameter for funcret passed in parameter
  1570. * vs_hidden fixes
  1571. * writenode changed to printnode and released from extdebug
  1572. * -vp option added to generate a tree.log with the nodetree
  1573. * nicer printnode for statements, callnode
  1574. Revision 1.26 2002/04/25 16:12:09 florian
  1575. * fixed more problems with cpubase and x86-64
  1576. Revision 1.25 2003/04/25 08:25:26 daniel
  1577. * Ifdefs around a lot of calls to cleartempgen
  1578. * Fixed registers that are allocated but not freed in several nodes
  1579. * Tweak to register allocator to cause less spills
  1580. * 8-bit registers now interfere with esi,edi and ebp
  1581. Compiler can now compile rtl successfully when using new register
  1582. allocator
  1583. Revision 1.24 2003/04/24 13:03:01 florian
  1584. * comp is now written with its bit pattern to the ppu instead as an extended
  1585. Revision 1.23 2003/04/22 14:33:38 peter
  1586. * removed some notes/hints
  1587. Revision 1.22 2003/04/22 10:09:34 daniel
  1588. + Implemented the actual register allocator
  1589. + Scratch registers unavailable when new register allocator used
  1590. + maybe_save/maybe_restore unavailable when new register allocator used
  1591. Revision 1.21 2003/02/19 22:00:14 daniel
  1592. * Code generator converted to new register notation
  1593. - Horribily outdated todo.txt removed
  1594. Revision 1.20 2003/01/30 21:46:20 peter
  1595. * tai_const_symbol.createdataname added
  1596. Revision 1.19 2003/01/21 08:48:08 daniel
  1597. * Another 200301081 fixed
  1598. Revision 1.18 2003/01/09 20:40:59 daniel
  1599. * Converted some code in cgx86.pas to new register numbering
  1600. Revision 1.17 2003/01/09 15:49:56 daniel
  1601. * Added register conversion
  1602. Revision 1.16 2003/01/08 18:43:56 daniel
  1603. * Tregister changed into a record
  1604. Revision 1.15 2003/01/05 13:36:53 florian
  1605. * x86-64 compiles
  1606. + very basic support for float128 type (x86-64 only)
  1607. Revision 1.14 2002/12/06 17:50:21 peter
  1608. * symbol count fix merged
  1609. Revision 1.13 2002/11/17 16:31:55 carl
  1610. * memory optimization (3-4%) : cleanup of tai fields,
  1611. cleanup of tdef and tsym fields.
  1612. * make it work for m68k
  1613. Revision 1.12 2002/11/15 16:29:30 peter
  1614. * made tasmsymbol.refs private (merged)
  1615. Revision 1.11 2002/11/15 01:58:45 peter
  1616. * merged changes from 1.0.7 up to 04-11
  1617. - -V option for generating bug report tracing
  1618. - more tracing for option parsing
  1619. - errors for cdecl and high()
  1620. - win32 import stabs
  1621. - win32 records<=8 are returned in eax:edx (turned off by default)
  1622. - heaptrc update
  1623. - more info for temp management in .s file with EXTDEBUG
  1624. Revision 1.10 2002/11/09 15:38:03 carl
  1625. + NOOPT removed the optinfo field
  1626. Revision 1.9 2002/10/05 12:43:23 carl
  1627. * fixes for Delphi 6 compilation
  1628. (warning : Some features do not work under Delphi)
  1629. Revision 1.8 2002/08/19 19:36:42 peter
  1630. * More fixes for cross unit inlining, all tnodes are now implemented
  1631. * Moved pocall_internconst to po_internconst because it is not a
  1632. calling type at all and it conflicted when inlining of these small
  1633. functions was requested
  1634. Revision 1.7 2002/08/18 20:06:23 peter
  1635. * inlining is now also allowed in interface
  1636. * renamed write/load to ppuwrite/ppuload
  1637. * tnode storing in ppu
  1638. * nld,ncon,nbas are already updated for storing in ppu
  1639. Revision 1.6 2002/08/16 05:21:09 florian
  1640. * powerpc compilation fix
  1641. Revision 1.5 2002/08/15 19:10:35 peter
  1642. * first things tai,tnode storing in ppu
  1643. Revision 1.4 2002/08/11 14:32:25 peter
  1644. * renamed current_library to objectlibrary
  1645. Revision 1.3 2002/08/11 13:24:10 peter
  1646. * saving of asmsymbols in ppu supported
  1647. * asmsymbollist global is removed and moved into a new class
  1648. tasmlibrarydata that will hold the info of a .a file which
  1649. corresponds with a single module. Added librarydata to tmodule
  1650. to keep the library info stored for the module. In the future the
  1651. objectfiles will also be stored to the tasmlibrarydata class
  1652. * all getlabel/newasmsymbol and friends are moved to the new class
  1653. Revision 1.2 2002/08/05 18:27:48 carl
  1654. + more more more documentation
  1655. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  1656. Revision 1.1 2002/07/01 18:46:20 peter
  1657. * internal linker
  1658. * reorganized aasm layer
  1659. Revision 1.27 2002/05/18 13:34:04 peter
  1660. * readded missing revisions
  1661. Revision 1.25 2002/05/14 19:34:38 peter
  1662. * removed old logs and updated copyright year
  1663. Revision 1.24 2002/05/14 17:28:08 peter
  1664. * synchronized cpubase between powerpc and i386
  1665. * moved more tables from cpubase to cpuasm
  1666. * tai_align_abstract moved to tainst, cpuasm must define
  1667. the tai_align class now, which may be empty
  1668. Revision 1.23 2002/04/15 18:54:34 carl
  1669. - removed tcpuflags
  1670. Revision 1.22 2002/04/07 13:18:19 carl
  1671. + more documentation
  1672. Revision 1.21 2002/04/07 10:17:40 carl
  1673. - remove packenumfixed (requires version 1.0.2 or later to compile now!)
  1674. + changing some comments so its commented automatically
  1675. Revision 1.20 2002/03/24 19:04:31 carl
  1676. + patch for SPARC from Mazen NEIFER
  1677. }