aasmtai.pas 61 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079
  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 convert_registers;
  428. procedure translate_registers(const table:Ttranstable);
  429. end;
  430. var
  431. { array with all class types for tais }
  432. aiclass : taiclassarray;
  433. { temporary lists }
  434. exprasmlist,
  435. { default lists }
  436. datasegment,codesegment,bsssegment,
  437. debuglist,withdebuglist,consts,
  438. importssection,exportssection,
  439. resourcesection,rttilist,
  440. resourcestringlist : taasmoutput;
  441. function ppuloadai(ppufile:tcompilerppufile):tai;
  442. procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
  443. implementation
  444. uses
  445. {$ifdef delphi}
  446. sysutils,
  447. {$else}
  448. strings,
  449. {$endif}
  450. verbose;
  451. const
  452. pputaimarker = 254;
  453. {****************************************************************************
  454. Helpers
  455. ****************************************************************************}
  456. function ppuloadai(ppufile:tcompilerppufile):tai;
  457. var
  458. b : byte;
  459. t : taitype;
  460. begin
  461. { marker }
  462. b:=ppufile.getbyte;
  463. if b<>pputaimarker then
  464. internalerror(200208181);
  465. { load nodetype }
  466. t:=taitype(ppufile.getbyte);
  467. if t<>ait_none then
  468. begin
  469. if t>high(taitype) then
  470. internalerror(200208182);
  471. if not assigned(aiclass[t]) then
  472. internalerror(200208183);
  473. {writeln('taiload: ',taitypestr[t]);}
  474. { generate tai of the correct class }
  475. ppuloadai:=aiclass[t].ppuload(t,ppufile);
  476. end
  477. else
  478. ppuloadai:=nil;
  479. end;
  480. procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
  481. begin
  482. { marker, read by ppuloadnode }
  483. ppufile.putbyte(pputaimarker);
  484. if assigned(n) then
  485. begin
  486. { type, read by ppuloadnode }
  487. ppufile.putbyte(byte(n.typ));
  488. {writeln('taiwrite: ',taitypestr[n.typ]);}
  489. n.ppuwrite(ppufile);
  490. end
  491. else
  492. ppufile.putbyte(byte(ait_none));
  493. end;
  494. {****************************************************************************
  495. TAI
  496. ****************************************************************************}
  497. constructor tai.Create;
  498. begin
  499. {$ifndef NOOPT}
  500. optinfo:=nil;
  501. {$endif NOOPT}
  502. end;
  503. constructor tai.ppuload(t:taitype;ppufile:tcompilerppufile);
  504. begin
  505. typ:=t;
  506. {$ifndef NOOPT}
  507. optinfo:=nil;
  508. {$endif}
  509. end;
  510. procedure tai.ppuwrite(ppufile:tcompilerppufile);
  511. begin
  512. end;
  513. procedure tai.derefimpl;
  514. begin
  515. end;
  516. {****************************************************************************
  517. TAILINEINFO
  518. ****************************************************************************}
  519. constructor tailineinfo.create;
  520. begin
  521. inherited create;
  522. fileinfo:=aktfilepos;
  523. end;
  524. constructor tailineinfo.ppuload(t:taitype;ppufile:tcompilerppufile);
  525. begin
  526. inherited ppuload(t,ppufile);
  527. ppufile.getposinfo(fileinfo);
  528. end;
  529. procedure tailineinfo.ppuwrite(ppufile:tcompilerppufile);
  530. begin
  531. inherited ppuwrite(ppufile);
  532. ppufile.putposinfo(fileinfo);
  533. end;
  534. {****************************************************************************
  535. TAI_SECTION
  536. ****************************************************************************}
  537. constructor tai_section.Create(s : TSection);
  538. begin
  539. inherited Create;
  540. typ:=ait_section;
  541. sec:=s;
  542. end;
  543. constructor tai_section.ppuload(t:taitype;ppufile:tcompilerppufile);
  544. begin
  545. inherited ppuload(t,ppufile);
  546. sec:=tsection(ppufile.getbyte);
  547. end;
  548. procedure tai_section.ppuwrite(ppufile:tcompilerppufile);
  549. begin
  550. inherited ppuwrite(ppufile);
  551. ppufile.putbyte(byte(sec));
  552. end;
  553. {****************************************************************************
  554. TAI_DATABLOCK
  555. ****************************************************************************}
  556. constructor tai_datablock.Create(const _name : string;_size : longint);
  557. begin
  558. inherited Create;
  559. typ:=ait_datablock;
  560. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  561. { keep things aligned }
  562. if _size<=0 then
  563. _size:=4;
  564. size:=_size;
  565. is_global:=false;
  566. end;
  567. constructor tai_datablock.Create_global(const _name : string;_size : longint);
  568. begin
  569. inherited Create;
  570. typ:=ait_datablock;
  571. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  572. { keep things aligned }
  573. if _size<=0 then
  574. _size:=4;
  575. size:=_size;
  576. is_global:=true;
  577. end;
  578. constructor tai_datablock.ppuload(t:taitype;ppufile:tcompilerppufile);
  579. begin
  580. inherited Create;
  581. sym:=ppufile.getasmsymbol;
  582. size:=ppufile.getlongint;
  583. is_global:=boolean(ppufile.getbyte);
  584. end;
  585. procedure tai_datablock.ppuwrite(ppufile:tcompilerppufile);
  586. begin
  587. inherited ppuwrite(ppufile);
  588. ppufile.putasmsymbol(sym);
  589. ppufile.putlongint(size);
  590. ppufile.putbyte(byte(is_global));
  591. end;
  592. procedure tai_datablock.derefimpl;
  593. begin
  594. objectlibrary.DerefAsmsymbol(sym);
  595. end;
  596. {****************************************************************************
  597. TAI_SYMBOL
  598. ****************************************************************************}
  599. constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
  600. begin
  601. inherited Create;
  602. typ:=ait_symbol;
  603. sym:=_sym;
  604. size:=siz;
  605. sym.defbind:=AB_LOCAL;
  606. is_global:=false;
  607. end;
  608. constructor tai_symbol.Create_global(_sym:tasmsymbol;siz:longint);
  609. begin
  610. inherited Create;
  611. typ:=ait_symbol;
  612. sym:=_sym;
  613. size:=siz;
  614. sym.defbind:=AB_GLOBAL;
  615. is_global:=true;
  616. end;
  617. constructor tai_symbol.Createname(const _name : string;siz:longint);
  618. begin
  619. inherited Create;
  620. typ:=ait_symbol;
  621. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
  622. size:=siz;
  623. is_global:=false;
  624. end;
  625. constructor tai_symbol.Createname_global(const _name : string;siz:longint);
  626. begin
  627. inherited Create;
  628. typ:=ait_symbol;
  629. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
  630. size:=siz;
  631. is_global:=true;
  632. end;
  633. constructor tai_symbol.Createdataname(const _name : string;siz:longint);
  634. begin
  635. inherited Create;
  636. typ:=ait_symbol;
  637. sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  638. size:=siz;
  639. is_global:=false;
  640. end;
  641. constructor tai_symbol.Createdataname_global(const _name : string;siz:longint);
  642. begin
  643. inherited Create;
  644. typ:=ait_symbol;
  645. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  646. size:=siz;
  647. is_global:=true;
  648. end;
  649. constructor tai_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
  650. begin
  651. inherited ppuload(t,ppufile);
  652. sym:=ppufile.getasmsymbol;
  653. size:=ppufile.getlongint;
  654. is_global:=boolean(ppufile.getbyte);
  655. end;
  656. procedure tai_symbol.ppuwrite(ppufile:tcompilerppufile);
  657. begin
  658. inherited ppuwrite(ppufile);
  659. ppufile.putasmsymbol(sym);
  660. ppufile.putlongint(size);
  661. ppufile.putbyte(byte(is_global));
  662. end;
  663. procedure tai_symbol.derefimpl;
  664. begin
  665. objectlibrary.DerefAsmsymbol(sym);
  666. end;
  667. {****************************************************************************
  668. TAI_SYMBOL
  669. ****************************************************************************}
  670. constructor tai_symbol_end.Create(_sym:tasmsymbol);
  671. begin
  672. inherited Create;
  673. typ:=ait_symbol_end;
  674. sym:=_sym;
  675. end;
  676. constructor tai_symbol_end.Createname(const _name : string);
  677. begin
  678. inherited Create;
  679. typ:=ait_symbol_end;
  680. sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
  681. end;
  682. constructor tai_symbol_end.ppuload(t:taitype;ppufile:tcompilerppufile);
  683. begin
  684. inherited ppuload(t,ppufile);
  685. sym:=ppufile.getasmsymbol;
  686. end;
  687. procedure tai_symbol_end.ppuwrite(ppufile:tcompilerppufile);
  688. begin
  689. inherited ppuwrite(ppufile);
  690. ppufile.putasmsymbol(sym);
  691. end;
  692. procedure tai_symbol_end.derefimpl;
  693. begin
  694. objectlibrary.DerefAsmsymbol(sym);
  695. end;
  696. {****************************************************************************
  697. TAI_CONST
  698. ****************************************************************************}
  699. constructor tai_const.Create_32bit(_value : longint);
  700. begin
  701. inherited Create;
  702. typ:=ait_const_32bit;
  703. value:=_value;
  704. end;
  705. constructor tai_const.Create_16bit(_value : word);
  706. begin
  707. inherited Create;
  708. typ:=ait_const_16bit;
  709. value:=_value;
  710. end;
  711. constructor tai_const.Create_8bit(_value : byte);
  712. begin
  713. inherited Create;
  714. typ:=ait_const_8bit;
  715. value:=_value;
  716. end;
  717. constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile);
  718. begin
  719. inherited ppuload(t,ppufile);
  720. value:=ppufile.getlongint;
  721. end;
  722. procedure tai_const.ppuwrite(ppufile:tcompilerppufile);
  723. begin
  724. inherited ppuwrite(ppufile);
  725. ppufile.putlongint(value);
  726. end;
  727. {****************************************************************************
  728. TAI_CONST_SYMBOL
  729. ****************************************************************************}
  730. constructor tai_const_symbol.Create(_sym:tasmsymbol);
  731. begin
  732. inherited Create;
  733. typ:=ait_const_symbol;
  734. sym:=_sym;
  735. offset:=0;
  736. { update sym info }
  737. sym.increfs;
  738. end;
  739. constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:longint);
  740. begin
  741. inherited Create;
  742. typ:=ait_const_symbol;
  743. sym:=_sym;
  744. offset:=ofs;
  745. { update sym info }
  746. sym.increfs;
  747. end;
  748. constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
  749. begin
  750. inherited Create;
  751. typ:=ait_const_rva;
  752. sym:=_sym;
  753. offset:=0;
  754. { update sym info }
  755. sym.increfs;
  756. end;
  757. constructor tai_const_symbol.Createname(const name:string);
  758. begin
  759. inherited Create;
  760. typ:=ait_const_symbol;
  761. sym:=objectlibrary.newasmsymbol(name);
  762. offset:=0;
  763. { update sym info }
  764. sym.increfs;
  765. end;
  766. constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
  767. begin
  768. inherited Create;
  769. typ:=ait_const_symbol;
  770. sym:=objectlibrary.newasmsymbol(name);
  771. offset:=ofs;
  772. { update sym info }
  773. sym.increfs;
  774. end;
  775. constructor tai_const_symbol.Createname_rva(const name:string);
  776. begin
  777. inherited Create;
  778. typ:=ait_const_rva;
  779. sym:=objectlibrary.newasmsymbol(name);
  780. offset:=0;
  781. { update sym info }
  782. sym.increfs;
  783. end;
  784. constructor tai_const_symbol.Createdataname(const name:string);
  785. begin
  786. inherited Create;
  787. typ:=ait_const_symbol;
  788. sym:=objectlibrary.newasmsymboltype(name,AB_EXTERNAL,AT_DATA);
  789. offset:=0;
  790. { update sym info }
  791. sym.increfs;
  792. end;
  793. constructor tai_const_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
  794. begin
  795. inherited ppuload(t,ppufile);
  796. sym:=ppufile.getasmsymbol;
  797. offset:=ppufile.getlongint;
  798. end;
  799. procedure tai_const_symbol.ppuwrite(ppufile:tcompilerppufile);
  800. begin
  801. inherited ppuwrite(ppufile);
  802. ppufile.putasmsymbol(sym);
  803. ppufile.putlongint(offset);
  804. end;
  805. procedure tai_const_symbol.derefimpl;
  806. begin
  807. objectlibrary.DerefAsmsymbol(sym);
  808. end;
  809. function tai_const_symbol.getcopy:tlinkedlistitem;
  810. begin
  811. getcopy:=inherited getcopy;
  812. { we need to increase the reference number }
  813. sym.increfs;
  814. end;
  815. {****************************************************************************
  816. TAI_real_32bit
  817. ****************************************************************************}
  818. constructor tai_real_32bit.Create(_value : ts32real);
  819. begin
  820. inherited Create;
  821. typ:=ait_real_32bit;
  822. value:=_value;
  823. end;
  824. constructor tai_real_32bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  825. begin
  826. inherited ppuload(t,ppufile);
  827. value:=ppufile.getreal;
  828. end;
  829. procedure tai_real_32bit.ppuwrite(ppufile:tcompilerppufile);
  830. begin
  831. inherited ppuwrite(ppufile);
  832. ppufile.putreal(value);
  833. end;
  834. {****************************************************************************
  835. TAI_real_64bit
  836. ****************************************************************************}
  837. constructor tai_real_64bit.Create(_value : ts64real);
  838. begin
  839. inherited Create;
  840. typ:=ait_real_64bit;
  841. value:=_value;
  842. end;
  843. constructor tai_real_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  844. begin
  845. inherited ppuload(t,ppufile);
  846. value:=ppufile.getreal;
  847. end;
  848. procedure tai_real_64bit.ppuwrite(ppufile:tcompilerppufile);
  849. begin
  850. inherited ppuwrite(ppufile);
  851. ppufile.putreal(value);
  852. end;
  853. {****************************************************************************
  854. TAI_real_80bit
  855. ****************************************************************************}
  856. constructor tai_real_80bit.Create(_value : ts80real);
  857. begin
  858. inherited Create;
  859. typ:=ait_real_80bit;
  860. value:=_value;
  861. end;
  862. constructor tai_real_80bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  863. begin
  864. inherited ppuload(t,ppufile);
  865. value:=ppufile.getreal;
  866. end;
  867. procedure tai_real_80bit.ppuwrite(ppufile:tcompilerppufile);
  868. begin
  869. inherited ppuwrite(ppufile);
  870. ppufile.putreal(value);
  871. end;
  872. {****************************************************************************
  873. Tai_comp_64bit
  874. ****************************************************************************}
  875. constructor tai_comp_64bit.Create(_value : ts64comp);
  876. begin
  877. inherited Create;
  878. typ:=ait_comp_64bit;
  879. value:=_value;
  880. end;
  881. constructor tai_comp_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
  882. begin
  883. inherited ppuload(t,ppufile);
  884. ppufile.putdata(value,sizeof(value));
  885. end;
  886. procedure tai_comp_64bit.ppuwrite(ppufile:tcompilerppufile);
  887. begin
  888. inherited ppuwrite(ppufile);
  889. ppufile.getdata(value,sizeof(value));
  890. end;
  891. {****************************************************************************
  892. TAI_STRING
  893. ****************************************************************************}
  894. constructor tai_string.Create(const _str : string);
  895. begin
  896. inherited Create;
  897. typ:=ait_string;
  898. len:=length(_str);
  899. getmem(str,len+1);
  900. strpcopy(str,_str);
  901. end;
  902. constructor tai_string.Create_pchar(_str : pchar);
  903. begin
  904. inherited Create;
  905. typ:=ait_string;
  906. str:=_str;
  907. len:=strlen(_str);
  908. end;
  909. constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
  910. begin
  911. inherited Create;
  912. typ:=ait_string;
  913. str:=_str;
  914. len:=length;
  915. end;
  916. destructor tai_string.destroy;
  917. begin
  918. { you can have #0 inside the strings so }
  919. if str<>nil then
  920. freemem(str,len+1);
  921. inherited Destroy;
  922. end;
  923. constructor tai_string.ppuload(t:taitype;ppufile:tcompilerppufile);
  924. begin
  925. inherited ppuload(t,ppufile);
  926. len:=ppufile.getlongint;
  927. getmem(str,len+1);
  928. ppufile.getdata(str^,len);
  929. str[len]:=#0;
  930. end;
  931. procedure tai_string.ppuwrite(ppufile:tcompilerppufile);
  932. begin
  933. inherited ppuwrite(ppufile);
  934. ppufile.putlongint(len);
  935. ppufile.putdata(str^,len);
  936. end;
  937. function tai_string.getcopy : tlinkedlistitem;
  938. var
  939. p : tlinkedlistitem;
  940. begin
  941. p:=inherited getcopy;
  942. getmem(tai_string(p).str,len+1);
  943. move(str^,tai_string(p).str^,len+1);
  944. getcopy:=p;
  945. end;
  946. {****************************************************************************
  947. TAI_LABEL
  948. ****************************************************************************}
  949. constructor tai_label.create(_l : tasmlabel);
  950. begin
  951. inherited Create;
  952. typ:=ait_label;
  953. l:=_l;
  954. l.is_set:=true;
  955. is_global:=(l.defbind=AB_GLOBAL);
  956. end;
  957. constructor tai_label.ppuload(t:taitype;ppufile:tcompilerppufile);
  958. begin
  959. inherited ppuload(t,ppufile);
  960. l:=tasmlabel(ppufile.getasmsymbol);
  961. is_global:=boolean(ppufile.getbyte);
  962. end;
  963. procedure tai_label.ppuwrite(ppufile:tcompilerppufile);
  964. begin
  965. inherited ppuwrite(ppufile);
  966. ppufile.putasmsymbol(l);
  967. ppufile.putbyte(byte(is_global));
  968. end;
  969. procedure tai_label.derefimpl;
  970. begin
  971. objectlibrary.DerefAsmsymbol(tasmsymbol(l));
  972. l.is_set:=true;
  973. end;
  974. {****************************************************************************
  975. TAI_DIRECT
  976. ****************************************************************************}
  977. constructor tai_direct.Create(_str : pchar);
  978. begin
  979. inherited Create;
  980. typ:=ait_direct;
  981. str:=_str;
  982. end;
  983. destructor tai_direct.destroy;
  984. begin
  985. strdispose(str);
  986. inherited Destroy;
  987. end;
  988. constructor tai_direct.ppuload(t:taitype;ppufile:tcompilerppufile);
  989. var
  990. len : longint;
  991. begin
  992. inherited ppuload(t,ppufile);
  993. len:=ppufile.getlongint;
  994. getmem(str,len+1);
  995. ppufile.getdata(str^,len);
  996. str[len]:=#0;
  997. end;
  998. procedure tai_direct.ppuwrite(ppufile:tcompilerppufile);
  999. var
  1000. len : longint;
  1001. begin
  1002. inherited ppuwrite(ppufile);
  1003. len:=strlen(str);
  1004. ppufile.putlongint(len);
  1005. ppufile.putdata(str^,len);
  1006. end;
  1007. function tai_direct.getcopy : tlinkedlistitem;
  1008. var
  1009. p : tlinkedlistitem;
  1010. begin
  1011. p:=inherited getcopy;
  1012. getmem(tai_direct(p).str,strlen(str)+1);
  1013. move(str^,tai_direct(p).str^,strlen(str)+1);
  1014. getcopy:=p;
  1015. end;
  1016. {****************************************************************************
  1017. tai_comment comment to be inserted in the assembler file
  1018. ****************************************************************************}
  1019. constructor tai_comment.Create(_str : pchar);
  1020. begin
  1021. inherited Create;
  1022. typ:=ait_comment;
  1023. str:=_str;
  1024. end;
  1025. destructor tai_comment.destroy;
  1026. begin
  1027. strdispose(str);
  1028. inherited Destroy;
  1029. end;
  1030. constructor tai_comment.ppuload(t:taitype;ppufile:tcompilerppufile);
  1031. var
  1032. len : longint;
  1033. begin
  1034. inherited ppuload(t,ppufile);
  1035. len:=ppufile.getlongint;
  1036. getmem(str,len+1);
  1037. ppufile.getdata(str^,len);
  1038. str[len]:=#0;
  1039. end;
  1040. procedure tai_comment.ppuwrite(ppufile:tcompilerppufile);
  1041. var
  1042. len : longint;
  1043. begin
  1044. inherited ppuwrite(ppufile);
  1045. len:=strlen(str);
  1046. ppufile.putlongint(len);
  1047. ppufile.putdata(str^,len);
  1048. end;
  1049. function tai_comment.getcopy : tlinkedlistitem;
  1050. var
  1051. p : tlinkedlistitem;
  1052. begin
  1053. p:=inherited getcopy;
  1054. getmem(tai_comment(p).str,strlen(str)+1);
  1055. move(str^,tai_comment(p).str^,strlen(str)+1);
  1056. getcopy:=p;
  1057. end;
  1058. {****************************************************************************
  1059. TAI_CUT
  1060. ****************************************************************************}
  1061. constructor tai_cut.Create;
  1062. begin
  1063. inherited Create;
  1064. typ:=ait_cut;
  1065. place:=cut_normal;
  1066. end;
  1067. constructor tai_cut.Create_begin;
  1068. begin
  1069. inherited Create;
  1070. typ:=ait_cut;
  1071. place:=cut_begin;
  1072. end;
  1073. constructor tai_cut.Create_end;
  1074. begin
  1075. inherited Create;
  1076. typ:=ait_cut;
  1077. place:=cut_end;
  1078. end;
  1079. constructor tai_cut.ppuload(t:taitype;ppufile:tcompilerppufile);
  1080. begin
  1081. inherited ppuload(t,ppufile);
  1082. place:=TCutPlace(ppufile.getbyte);
  1083. end;
  1084. procedure tai_cut.ppuwrite(ppufile:tcompilerppufile);
  1085. begin
  1086. inherited ppuwrite(ppufile);
  1087. ppufile.putbyte(byte(place));
  1088. end;
  1089. {****************************************************************************
  1090. Tai_Marker
  1091. ****************************************************************************}
  1092. constructor Tai_Marker.Create(_Kind: TMarker);
  1093. begin
  1094. Inherited Create;
  1095. typ := ait_marker;
  1096. Kind := _Kind;
  1097. end;
  1098. constructor Tai_Marker.ppuload(t:taitype;ppufile:tcompilerppufile);
  1099. begin
  1100. inherited ppuload(t,ppufile);
  1101. kind:=TMarker(ppufile.getbyte);
  1102. end;
  1103. procedure Tai_Marker.ppuwrite(ppufile:tcompilerppufile);
  1104. begin
  1105. inherited ppuwrite(ppufile);
  1106. ppufile.putbyte(byte(kind));
  1107. end;
  1108. {*****************************************************************************
  1109. tai_tempalloc
  1110. *****************************************************************************}
  1111. constructor tai_tempalloc.alloc(pos,size:longint);
  1112. begin
  1113. inherited Create;
  1114. typ:=ait_tempalloc;
  1115. allocation:=true;
  1116. temppos:=pos;
  1117. tempsize:=size;
  1118. {$ifdef EXTDEBUG}
  1119. problem:=nil;
  1120. {$endif EXTDEBUG}
  1121. end;
  1122. destructor tai_tempalloc.destroy;
  1123. begin
  1124. {$ifdef EXTDEBUG}
  1125. stringdispose(problem);
  1126. {$endif EXTDEBUG}
  1127. inherited destroy;
  1128. end;
  1129. constructor tai_tempalloc.dealloc(pos,size:longint);
  1130. begin
  1131. inherited Create;
  1132. typ:=ait_tempalloc;
  1133. allocation:=false;
  1134. temppos:=pos;
  1135. tempsize:=size;
  1136. {$ifdef EXTDEBUG}
  1137. problem:=nil;
  1138. {$endif EXTDEBUG}
  1139. end;
  1140. {$ifdef EXTDEBUG}
  1141. constructor tai_tempalloc.allocinfo(pos,size:longint;const st:string);
  1142. begin
  1143. inherited Create;
  1144. typ:=ait_tempalloc;
  1145. allocation:=false;
  1146. temppos:=pos;
  1147. tempsize:=size;
  1148. problem:=stringdup(st);
  1149. end;
  1150. {$endif EXTDEBUG}
  1151. constructor tai_tempalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
  1152. begin
  1153. inherited ppuload(t,ppufile);
  1154. temppos:=ppufile.getlongint;
  1155. tempsize:=ppufile.getlongint;
  1156. allocation:=boolean(ppufile.getbyte);
  1157. {$ifdef EXTDEBUG}
  1158. problem:=nil;
  1159. {$endif EXTDEBUG}
  1160. end;
  1161. procedure tai_tempalloc.ppuwrite(ppufile:tcompilerppufile);
  1162. begin
  1163. inherited ppuwrite(ppufile);
  1164. ppufile.putlongint(temppos);
  1165. ppufile.putlongint(tempsize);
  1166. ppufile.putbyte(byte(allocation));
  1167. end;
  1168. {*****************************************************************************
  1169. tai_regalloc
  1170. *****************************************************************************}
  1171. constructor tai_regalloc.alloc(r : tregister);
  1172. begin
  1173. inherited create;
  1174. typ:=ait_regalloc;
  1175. allocation:=true;
  1176. reg:=r;
  1177. end;
  1178. constructor tai_regalloc.dealloc(r : tregister);
  1179. begin
  1180. inherited create;
  1181. typ:=ait_regalloc;
  1182. allocation:=false;
  1183. reg:=r;
  1184. end;
  1185. constructor tai_regalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
  1186. begin
  1187. inherited ppuload(t,ppufile);
  1188. ppufile.getdata(reg,sizeof(Tregister));
  1189. allocation:=boolean(ppufile.getbyte);
  1190. end;
  1191. procedure tai_regalloc.ppuwrite(ppufile:tcompilerppufile);
  1192. begin
  1193. inherited ppuwrite(ppufile);
  1194. ppufile.putdata(reg,sizeof(Tregister));
  1195. ppufile.putbyte(byte(allocation));
  1196. end;
  1197. {*****************************************************************************
  1198. TaiInstruction
  1199. *****************************************************************************}
  1200. constructor taicpu_abstract.Create(op : tasmop);
  1201. begin
  1202. inherited create;
  1203. typ:=ait_instruction;
  1204. is_jmp:=false;
  1205. opcode:=op;
  1206. ops:=0;
  1207. fillchar(condition,sizeof(condition),0);
  1208. fillchar(oper,sizeof(oper),0);
  1209. end;
  1210. destructor taicpu_abstract.Destroy;
  1211. var
  1212. i : longint;
  1213. begin
  1214. for i:=0 to ops-1 do
  1215. case oper[i].typ of
  1216. top_ref:
  1217. dispose(oper[i].ref);
  1218. end;
  1219. inherited destroy;
  1220. end;
  1221. { ---------------------------------------------------------------------
  1222. Loading of operands.
  1223. ---------------------------------------------------------------------}
  1224. procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
  1225. begin
  1226. if opidx>=ops then
  1227. ops:=opidx+1;
  1228. with oper[opidx] do
  1229. begin
  1230. if typ=top_ref then
  1231. dispose(ref);
  1232. val:=l;
  1233. typ:=top_const;
  1234. end;
  1235. end;
  1236. procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
  1237. begin
  1238. if not assigned(s) then
  1239. internalerror(200204251);
  1240. if opidx>=ops then
  1241. ops:=opidx+1;
  1242. with oper[opidx] do
  1243. begin
  1244. if typ=top_ref then
  1245. dispose(ref);
  1246. sym:=s;
  1247. symofs:=sofs;
  1248. typ:=top_symbol;
  1249. end;
  1250. s.increfs;
  1251. end;
  1252. procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
  1253. begin
  1254. if (r.base.enum=R_NO) or (r.index.enum=R_NO) then
  1255. internalerror(200308192);
  1256. if opidx>=ops then
  1257. ops:=opidx+1;
  1258. with oper[opidx] do
  1259. begin
  1260. if typ<>top_ref then
  1261. new(ref);
  1262. ref^:=r;
  1263. {$ifdef i386}
  1264. { We allow this exception for i386, since overloading this would be
  1265. too much of a a speed penalty}
  1266. if ref^.segment.enum=R_INTREGISTER then
  1267. begin
  1268. if (ref^.segment.number <> NR_NO) and (ref^.segment.number <> NR_DS) then
  1269. segprefix:=ref^.segment;
  1270. end
  1271. else
  1272. if not(ref^.segment.enum in [R_DS,R_NO]) then
  1273. segprefix:=ref^.segment;
  1274. {$endif}
  1275. typ:=top_ref;
  1276. { mark symbol as used }
  1277. if assigned(ref^.symbol) then
  1278. ref^.symbol.increfs;
  1279. end;
  1280. end;
  1281. procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
  1282. begin
  1283. if opidx>=ops then
  1284. ops:=opidx+1;
  1285. with oper[opidx] do
  1286. begin
  1287. if typ=top_ref then
  1288. dispose(ref);
  1289. reg:=r;
  1290. typ:=top_reg;
  1291. end;
  1292. end;
  1293. procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
  1294. begin
  1295. if opidx>=ops then
  1296. ops:=opidx+1;
  1297. if oper[opidx].typ=top_ref then
  1298. dispose(oper[opidx].ref);
  1299. oper[opidx]:=o;
  1300. { copy also the reference }
  1301. if oper[opidx].typ=top_ref then
  1302. begin
  1303. new(oper[opidx].ref);
  1304. oper[opidx].ref^:=o.ref^;
  1305. end;
  1306. end;
  1307. {$ifdef NEWRA}
  1308. { ---------------------------------------------------------------------
  1309. Register allocator methods.
  1310. ---------------------------------------------------------------------}
  1311. function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
  1312. var
  1313. back:Tsupregset;
  1314. begin
  1315. back:=unusedregsint;
  1316. get_insert_pos:=p;
  1317. while (p<>nil) and (p.typ=ait_regalloc) do
  1318. begin
  1319. {Rewind the register allocation.}
  1320. if Tai_regalloc(p).allocation then
  1321. include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
  1322. else
  1323. begin
  1324. exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
  1325. if Tai_regalloc(p).reg.number shr 8=huntfor1 then
  1326. begin
  1327. get_insert_pos:=Tai(p.previous);
  1328. back:=unusedregsint;
  1329. end;
  1330. if Tai_regalloc(p).reg.number shr 8=huntfor2 then
  1331. begin
  1332. get_insert_pos:=Tai(p.previous);
  1333. back:=unusedregsint;
  1334. end;
  1335. if Tai_regalloc(p).reg.number shr 8=huntfor3 then
  1336. begin
  1337. get_insert_pos:=Tai(p.previous);
  1338. back:=unusedregsint;
  1339. end;
  1340. end;
  1341. p:=Tai(p.previous);
  1342. end;
  1343. unusedregsint:=back;
  1344. end;
  1345. procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset);
  1346. begin
  1347. {Forward the register allocation again.}
  1348. while (p<>self) do
  1349. begin
  1350. if p.typ<>ait_regalloc then
  1351. internalerror(200305311);
  1352. if Tai_regalloc(p).allocation then
  1353. exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
  1354. else
  1355. include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
  1356. p:=Tai(p.next);
  1357. end;
  1358. end;
  1359. {$endif NEWRA}
  1360. { ---------------------------------------------------------------------
  1361. Miscellaneous methods.
  1362. ---------------------------------------------------------------------}
  1363. procedure taicpu_abstract.SetCondition(const c:TAsmCond);
  1364. begin
  1365. condition:=c;
  1366. end;
  1367. Function taicpu_abstract.getcopy:TLinkedListItem;
  1368. var
  1369. i : longint;
  1370. p : TLinkedListItem;
  1371. begin
  1372. p:=inherited getcopy;
  1373. { make a copy of the references }
  1374. for i:=1 to ops do
  1375. if (taicpu_abstract(p).oper[i-1].typ=top_ref) then
  1376. begin
  1377. new(taicpu_abstract(p).oper[i-1].ref);
  1378. taicpu_abstract(p).oper[i-1].ref^:=oper[i-1].ref^;
  1379. end;
  1380. getcopy:=p;
  1381. end;
  1382. constructor taicpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
  1383. var
  1384. i : integer;
  1385. begin
  1386. inherited ppuload(t,ppufile);
  1387. { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
  1388. ppufile.getdata(condition,sizeof(tasmcond));
  1389. ops:=ppufile.getbyte;
  1390. for i:=1 to ops do
  1391. ppuloadoper(ppufile,oper[i-1]);
  1392. opcode:=tasmop(ppufile.getword);
  1393. {$ifdef i386}
  1394. ppufile.getdata(segprefix,sizeof(Tregister));
  1395. {$endif i386}
  1396. is_jmp:=boolean(ppufile.getbyte);
  1397. end;
  1398. procedure taicpu_abstract.ppuwrite(ppufile:tcompilerppufile);
  1399. var
  1400. i : integer;
  1401. begin
  1402. inherited ppuwrite(ppufile);
  1403. ppufile.putdata(condition,sizeof(tasmcond));
  1404. ppufile.putbyte(ops);
  1405. for i:=1 to ops do
  1406. ppuwriteoper(ppufile,oper[i-1]);
  1407. ppufile.putword(word(opcode));
  1408. {$ifdef i386}
  1409. ppufile.putdata(segprefix,sizeof(Tregister));
  1410. {$endif i386}
  1411. ppufile.putbyte(byte(is_jmp));
  1412. end;
  1413. procedure taicpu_abstract.derefimpl;
  1414. var i:byte;
  1415. begin
  1416. for i:=1 to ops do
  1417. ppuderefoper(oper[i-1]);
  1418. end;
  1419. {****************************************************************************
  1420. tai_align_abstract
  1421. ****************************************************************************}
  1422. constructor tai_align_abstract.Create(b: byte);
  1423. begin
  1424. inherited Create;
  1425. typ:=ait_align;
  1426. if b in [1,2,4,8,16,32] then
  1427. aligntype := b
  1428. else
  1429. aligntype := 1;
  1430. fillsize:=0;
  1431. fillop:=0;
  1432. use_op:=false;
  1433. end;
  1434. constructor tai_align_abstract.Create_op(b: byte; _op: byte);
  1435. begin
  1436. inherited Create;
  1437. typ:=ait_align;
  1438. if b in [1,2,4,8,16,32] then
  1439. aligntype := b
  1440. else
  1441. aligntype := 1;
  1442. fillsize:=0;
  1443. fillop:=_op;
  1444. use_op:=true;
  1445. end;
  1446. function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
  1447. begin
  1448. fillchar(buf,high(buf),fillop);
  1449. calculatefillbuf:=pchar(@buf);
  1450. end;
  1451. constructor tai_align_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
  1452. begin
  1453. inherited ppuload(t,ppufile);
  1454. aligntype:=ppufile.getbyte;
  1455. fillsize:=0;
  1456. fillop:=ppufile.getbyte;
  1457. use_op:=boolean(ppufile.getbyte);
  1458. end;
  1459. procedure tai_align_abstract.ppuwrite(ppufile:tcompilerppufile);
  1460. begin
  1461. inherited ppuwrite(ppufile);
  1462. ppufile.putbyte(aligntype);
  1463. ppufile.putbyte(fillop);
  1464. ppufile.putbyte(byte(use_op));
  1465. end;
  1466. {*****************************************************************************
  1467. TAAsmOutput
  1468. *****************************************************************************}
  1469. constructor taasmoutput.create;
  1470. begin
  1471. inherited create;
  1472. { make sure the optimizer won't remove the first tai of this list}
  1473. insert(tai_marker.create(marker_blockstart));
  1474. end;
  1475. function taasmoutput.getlasttaifilepos : pfileposinfo;
  1476. var
  1477. hp : tlinkedlistitem;
  1478. begin
  1479. getlasttaifilepos := nil;
  1480. if assigned(last) then
  1481. begin
  1482. { find the last file information record }
  1483. if not (tai(last).typ in SkipLineInfo) then
  1484. getlasttaifilepos:=@tailineinfo(last).fileinfo
  1485. else
  1486. { go through list backwards to find the first entry
  1487. with line information
  1488. }
  1489. begin
  1490. hp:=tai(last);
  1491. while assigned(hp) and (tai(hp).typ in SkipLineInfo) do
  1492. hp:=hp.Previous;
  1493. { found entry }
  1494. if assigned(hp) then
  1495. getlasttaifilepos:=@tailineinfo(hp).fileinfo
  1496. end;
  1497. end;
  1498. end;
  1499. procedure Taasmoutput.convert_registers;
  1500. var p:Tai;
  1501. i:shortint;
  1502. r:Preference;
  1503. begin
  1504. p:=Tai(first);
  1505. while assigned(p) do
  1506. begin
  1507. case p.typ of
  1508. ait_regalloc:
  1509. convert_register_to_enum(Tai_regalloc(p).reg);
  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. begin
  1515. if Taicpu_abstract(p).oper[i].reg.enum=R_NO then
  1516. internalerror(200302052);
  1517. convert_register_to_enum(Taicpu_abstract(p).oper[i].reg)
  1518. end
  1519. else if Taicpu_abstract(p).oper[i].typ=Top_ref then
  1520. begin
  1521. r:=Taicpu_abstract(p).oper[i].ref;
  1522. {$ifdef i386}
  1523. convert_register_to_enum(r^.segment);
  1524. {$endif i386}
  1525. convert_register_to_enum(r^.base);
  1526. convert_register_to_enum(r^.index);
  1527. end;
  1528. {$ifdef i386}
  1529. convert_register_to_enum(Taicpu_abstract(p).segprefix);
  1530. {$endif}
  1531. end;
  1532. end;
  1533. p:=Tai(p.next);
  1534. end;
  1535. end;
  1536. procedure Taasmoutput.translate_registers(const table:Ttranstable);
  1537. var p,q:Tai;
  1538. i:shortint;
  1539. r:Preference;
  1540. begin
  1541. p:=Tai(first);
  1542. while assigned(p) do
  1543. begin
  1544. case p.typ of
  1545. ait_regalloc:
  1546. Tai_regalloc(p).reg.number:=(Tai_regalloc(p).reg.number and $ff) or
  1547. (table[Tai_regalloc(p).reg.number shr 8] shl 8);
  1548. ait_instruction:
  1549. begin
  1550. for i:=0 to Taicpu_abstract(p).ops-1 do
  1551. if Taicpu_abstract(p).oper[i].typ=Top_reg then
  1552. Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
  1553. (table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8)
  1554. else if Taicpu_abstract(p).oper[i].typ=Top_ref then
  1555. begin
  1556. r:=Taicpu_abstract(p).oper[i].ref;
  1557. if r^.base.number<>NR_NO then
  1558. r^.base.number:=(r^.base.number and $ff) or
  1559. (table[r^.base.number shr 8] shl 8);
  1560. if r^.index.number<>NR_NO then
  1561. r^.index.number:=(r^.index.number and $ff) or
  1562. (table[r^.index.number shr 8] shl 8);
  1563. end;
  1564. if Taicpu_abstract(p).is_nop then
  1565. begin
  1566. q:=p;
  1567. p:=Tai(p.next);
  1568. remove(q);
  1569. continue;
  1570. end;
  1571. end;
  1572. end;
  1573. p:=Tai(p.next);
  1574. end;
  1575. end;
  1576. end.
  1577. {
  1578. $Log$
  1579. Revision 1.34 2003-08-20 20:29:06 daniel
  1580. * Some more R_NO changes
  1581. * Preventive code to loadref added
  1582. Revision 1.33 2003/08/17 20:47:47 daniel
  1583. * Notranslation changed into -sr functionality
  1584. Revision 1.32 2003/08/17 16:59:20 jonas
  1585. * fixed regvars so they work with newra (at least for ppc)
  1586. * fixed some volatile register bugs
  1587. + -dnotranslation option for -dnewra, which causes the registers not to
  1588. be translated from virtual to normal registers. Requires support in
  1589. the assembler writer as well, which is only implemented in aggas/
  1590. agppcgas currently
  1591. Revision 1.31 2003/08/11 21:18:20 peter
  1592. * start of sparc support for newra
  1593. Revision 1.30 2003/07/02 16:43:48 jonas
  1594. * always add dummy marker object at the start of an assembler list, so
  1595. the optimizer can't remove the first object
  1596. Revision 1.29 2003/06/03 13:01:59 daniel
  1597. * Register allocator finished
  1598. Revision 1.28 2003/05/12 18:13:57 peter
  1599. * create rtti label using newasmsymboldata and update binding
  1600. only when calling tai_symbol.create
  1601. * tai_symbol.create_global added
  1602. Revision 1.27 2003/04/25 20:59:33 peter
  1603. * removed funcretn,funcretsym, function result is now in varsym
  1604. and aliases for result and function name are added using absolutesym
  1605. * vs_hidden parameter for funcret passed in parameter
  1606. * vs_hidden fixes
  1607. * writenode changed to printnode and released from extdebug
  1608. * -vp option added to generate a tree.log with the nodetree
  1609. * nicer printnode for statements, callnode
  1610. Revision 1.26 2002/04/25 16:12:09 florian
  1611. * fixed more problems with cpubase and x86-64
  1612. Revision 1.25 2003/04/25 08:25:26 daniel
  1613. * Ifdefs around a lot of calls to cleartempgen
  1614. * Fixed registers that are allocated but not freed in several nodes
  1615. * Tweak to register allocator to cause less spills
  1616. * 8-bit registers now interfere with esi,edi and ebp
  1617. Compiler can now compile rtl successfully when using new register
  1618. allocator
  1619. Revision 1.24 2003/04/24 13:03:01 florian
  1620. * comp is now written with its bit pattern to the ppu instead as an extended
  1621. Revision 1.23 2003/04/22 14:33:38 peter
  1622. * removed some notes/hints
  1623. Revision 1.22 2003/04/22 10:09:34 daniel
  1624. + Implemented the actual register allocator
  1625. + Scratch registers unavailable when new register allocator used
  1626. + maybe_save/maybe_restore unavailable when new register allocator used
  1627. Revision 1.21 2003/02/19 22:00:14 daniel
  1628. * Code generator converted to new register notation
  1629. - Horribily outdated todo.txt removed
  1630. Revision 1.20 2003/01/30 21:46:20 peter
  1631. * tai_const_symbol.createdataname added
  1632. Revision 1.19 2003/01/21 08:48:08 daniel
  1633. * Another 200301081 fixed
  1634. Revision 1.18 2003/01/09 20:40:59 daniel
  1635. * Converted some code in cgx86.pas to new register numbering
  1636. Revision 1.17 2003/01/09 15:49:56 daniel
  1637. * Added register conversion
  1638. Revision 1.16 2003/01/08 18:43:56 daniel
  1639. * Tregister changed into a record
  1640. Revision 1.15 2003/01/05 13:36:53 florian
  1641. * x86-64 compiles
  1642. + very basic support for float128 type (x86-64 only)
  1643. Revision 1.14 2002/12/06 17:50:21 peter
  1644. * symbol count fix merged
  1645. Revision 1.13 2002/11/17 16:31:55 carl
  1646. * memory optimization (3-4%) : cleanup of tai fields,
  1647. cleanup of tdef and tsym fields.
  1648. * make it work for m68k
  1649. Revision 1.12 2002/11/15 16:29:30 peter
  1650. * made tasmsymbol.refs private (merged)
  1651. Revision 1.11 2002/11/15 01:58:45 peter
  1652. * merged changes from 1.0.7 up to 04-11
  1653. - -V option for generating bug report tracing
  1654. - more tracing for option parsing
  1655. - errors for cdecl and high()
  1656. - win32 import stabs
  1657. - win32 records<=8 are returned in eax:edx (turned off by default)
  1658. - heaptrc update
  1659. - more info for temp management in .s file with EXTDEBUG
  1660. Revision 1.10 2002/11/09 15:38:03 carl
  1661. + NOOPT removed the optinfo field
  1662. Revision 1.9 2002/10/05 12:43:23 carl
  1663. * fixes for Delphi 6 compilation
  1664. (warning : Some features do not work under Delphi)
  1665. Revision 1.8 2002/08/19 19:36:42 peter
  1666. * More fixes for cross unit inlining, all tnodes are now implemented
  1667. * Moved pocall_internconst to po_internconst because it is not a
  1668. calling type at all and it conflicted when inlining of these small
  1669. functions was requested
  1670. Revision 1.7 2002/08/18 20:06:23 peter
  1671. * inlining is now also allowed in interface
  1672. * renamed write/load to ppuwrite/ppuload
  1673. * tnode storing in ppu
  1674. * nld,ncon,nbas are already updated for storing in ppu
  1675. Revision 1.6 2002/08/16 05:21:09 florian
  1676. * powerpc compilation fix
  1677. Revision 1.5 2002/08/15 19:10:35 peter
  1678. * first things tai,tnode storing in ppu
  1679. Revision 1.4 2002/08/11 14:32:25 peter
  1680. * renamed current_library to objectlibrary
  1681. Revision 1.3 2002/08/11 13:24:10 peter
  1682. * saving of asmsymbols in ppu supported
  1683. * asmsymbollist global is removed and moved into a new class
  1684. tasmlibrarydata that will hold the info of a .a file which
  1685. corresponds with a single module. Added librarydata to tmodule
  1686. to keep the library info stored for the module. In the future the
  1687. objectfiles will also be stored to the tasmlibrarydata class
  1688. * all getlabel/newasmsymbol and friends are moved to the new class
  1689. Revision 1.2 2002/08/05 18:27:48 carl
  1690. + more more more documentation
  1691. + first version include/exclude (can't test though, not enough scratch for i386 :()...
  1692. Revision 1.1 2002/07/01 18:46:20 peter
  1693. * internal linker
  1694. * reorganized aasm layer
  1695. Revision 1.27 2002/05/18 13:34:04 peter
  1696. * readded missing revisions
  1697. Revision 1.25 2002/05/14 19:34:38 peter
  1698. * removed old logs and updated copyright year
  1699. Revision 1.24 2002/05/14 17:28:08 peter
  1700. * synchronized cpubase between powerpc and i386
  1701. * moved more tables from cpubase to cpuasm
  1702. * tai_align_abstract moved to tainst, cpuasm must define
  1703. the tai_align class now, which may be empty
  1704. Revision 1.23 2002/04/15 18:54:34 carl
  1705. - removed tcpuflags
  1706. Revision 1.22 2002/04/07 13:18:19 carl
  1707. + more documentation
  1708. Revision 1.21 2002/04/07 10:17:40 carl
  1709. - remove packenumfixed (requires version 1.0.2 or later to compile now!)
  1710. + changing some comments so its commented automatically
  1711. Revision 1.20 2002/03/24 19:04:31 carl
  1712. + patch for SPARC from Mazen NEIFER
  1713. }