aasm.pas 32 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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. unit aasm;
  19. {$ifdef FPC}
  20. {$ifdef PACKENUMFIXED}
  21. {$PACKENUM 1}
  22. {$endif}
  23. {$endif}
  24. interface
  25. uses
  26. globtype,systems,cobjects,globals;
  27. type
  28. tait = (
  29. ait_none,
  30. ait_direct,
  31. ait_string,
  32. ait_label,
  33. ait_comment,
  34. ait_instruction,
  35. ait_datablock,
  36. ait_symbol,
  37. ait_symbol_end, { needed to calc the size of a symbol }
  38. ait_const_32bit,
  39. ait_const_16bit,
  40. ait_const_8bit,
  41. ait_const_symbol,
  42. ait_real_80bit,
  43. ait_real_64bit,
  44. ait_real_32bit,
  45. ait_comp_64bit,
  46. ait_align,
  47. ait_section,
  48. { the following is only used by the win32 version of the compiler }
  49. { and only the GNU AS Win32 is able to write it }
  50. ait_const_rva,
  51. ait_stabn,
  52. ait_stabs,
  53. ait_force_line,
  54. ait_stab_function_name,
  55. ait_cut, { used to split into tiny assembler files }
  56. ait_regalloc, { for register,temp allocation debugging }
  57. ait_tempalloc,
  58. ait_marker,
  59. { the follow is for the DEC Alpha }
  60. ait_frame,
  61. ait_ent,
  62. {$ifdef m68k}
  63. ait_labeled_instruction,
  64. {$endif m68k}
  65. { never used, makes insertation of new ait_ easier to type }
  66. { lazy guy !!!! ;-) (FK) }
  67. ait_dummy);
  68. tcpuflags = (cf_64bitaddr);
  69. tcpuflagset = set of tcpuflags;
  70. { ait_* types which don't result in executable code or which don't influence }
  71. { the way the program runs/behaves, but which may be encountered by the }
  72. { optimizer (= if it's sometimes added to the exprasm list). Update if you add }
  73. { a new ait type! }
  74. const
  75. SkipInstr = [ait_comment, ait_symbol,ait_force_line,ait_section
  76. {$ifdef GDB}
  77. ,ait_stabs, ait_stabn, ait_stab_function_name
  78. {$endif GDB}
  79. ,ait_regalloc, ait_tempalloc, ait_symbol_end
  80. ];
  81. { asm symbol functions }
  82. type
  83. TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
  84. TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
  85. pasmsymbol = ^tasmsymbol;
  86. tasmsymbol = object(tnamedindexobject)
  87. orgbind,
  88. bind : TAsmsymbind;
  89. typ : TAsmsymtype;
  90. proclocal : boolean;
  91. { the next fields are filled in the binary writer }
  92. section : tsection;
  93. idx : longint;
  94. address,
  95. size : longint;
  96. { this need to be incremented with every symbol loading into the
  97. paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
  98. refs : longint;
  99. { alternate symbol which can be used for 'renaming' needed for
  100. inlining }
  101. altsymbol : pasmsymbol;
  102. constructor init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  103. procedure reset;
  104. function is_used:boolean;
  105. procedure setbind(t:tasmsymbind);
  106. procedure setaddress(sec:tsection;offset,len:longint);
  107. procedure GenerateAltSymbol;
  108. end;
  109. pasmlabel = ^tasmlabel;
  110. tasmlabel = object(tasmsymbol)
  111. {$ifdef PACKENUMFIXED}
  112. { this is set by the pai_label.init }
  113. is_set,
  114. { is the label only there for getting an address (e.g. for i/o }
  115. { checks -> true) or is it a jump target (false) }
  116. is_addr : boolean;
  117. {$endif}
  118. labelnr : longint;
  119. {$ifndef PACKENUMFIXED}
  120. is_set,
  121. is_addr : boolean;
  122. {$endif}
  123. constructor init;
  124. constructor initdata;
  125. constructor initaddr;
  126. function name:string;virtual;
  127. end;
  128. pasmsymbollist = ^tasmsymbollist;
  129. tasmsymbollist = object(tdictionary)
  130. end;
  131. { the short name makes typing easier }
  132. pai = ^tai;
  133. tai = object(tlinkedlist_item)
  134. {$ifndef PACKENUMFIXED}
  135. typ : tait;
  136. {$endif}
  137. { pointer to record with optimizer info about this tai object }
  138. optinfo : pointer;
  139. fileinfo : tfileposinfo;
  140. {$ifdef PACKENUMFIXED}
  141. { still 3 bytes left after the next field }
  142. typ : tait;
  143. {$endif}
  144. constructor init;
  145. end;
  146. pai_string = ^tai_string;
  147. tai_string = object(tai)
  148. str : pchar;
  149. { extra len so the string can contain an \0 }
  150. len : longint;
  151. constructor init(const _str : string);
  152. constructor init_pchar(_str : pchar);
  153. constructor init_length_pchar(_str : pchar;length : longint);
  154. destructor done;virtual;
  155. end;
  156. { generates a common label }
  157. pai_symbol = ^tai_symbol;
  158. tai_symbol = object(tai)
  159. {$ifdef PACKENUMFIXED}
  160. is_global : boolean;
  161. {$endif}
  162. sym : pasmsymbol;
  163. size : longint;
  164. {$ifndef PACKENUMFIXED}
  165. is_global : boolean;
  166. {$endif}
  167. constructor init(_sym:PAsmSymbol;siz:longint);
  168. constructor initname(const _name : string;siz:longint);
  169. constructor initname_global(const _name : string;siz:longint);
  170. constructor initdataname(const _name : string;siz:longint);
  171. constructor initdataname_global(const _name : string;siz:longint);
  172. end;
  173. pai_symbol_end = ^tai_symbol_end;
  174. tai_symbol_end = object(tai)
  175. sym : pasmsymbol;
  176. constructor init(_sym:PAsmSymbol);
  177. constructor initname(const _name : string);
  178. end;
  179. pai_label = ^tai_label;
  180. tai_label = object(tai)
  181. {$ifdef PACKENUMFIXED}
  182. is_global : boolean;
  183. {$endif}
  184. l : pasmlabel;
  185. {$ifndef PACKENUMFIXED}
  186. is_global : boolean;
  187. {$endif}
  188. constructor init(_l : pasmlabel);
  189. end;
  190. pai_direct = ^tai_direct;
  191. tai_direct = object(tai)
  192. str : pchar;
  193. constructor init(_str : pchar);
  194. destructor done; virtual;
  195. end;
  196. { to insert a comment into the generated assembler file }
  197. pai_asm_comment = ^tai_asm_comment;
  198. tai_asm_comment = object(tai)
  199. str : pchar;
  200. constructor init(_str : pchar);
  201. destructor done; virtual;
  202. end;
  203. { alignment for operator }
  204. {$ifdef i386}
  205. pai_align_abstract = ^tai_align_abstract;
  206. tai_align_abstract = object(tai)
  207. {$else i386}
  208. pai_align = ^tai_align;
  209. tai_align = object(tai)
  210. {$endif i386}
  211. buf : array[0..63] of char; { buf used for fill }
  212. aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align }
  213. fillsize : byte; { real size to fill }
  214. fillop : byte; { value to fill with - optional }
  215. use_op : boolean;
  216. constructor init(b:byte);
  217. constructor init_op(b: byte; _op: byte);
  218. function getfillbuf:pchar;
  219. end;
  220. { Insert a section/segment directive }
  221. pai_section = ^tai_section;
  222. tai_section = object(tai)
  223. sec : tsection;
  224. constructor init(s : tsection);
  225. end;
  226. { generates an uninitializised data block }
  227. pai_datablock = ^tai_datablock;
  228. tai_datablock = object(tai)
  229. {$ifdef PACKENUMFIXED}
  230. is_global : boolean;
  231. {$endif}
  232. sym : pasmsymbol;
  233. size : longint;
  234. {$ifndef PACKENUMFIXED}
  235. is_global : boolean;
  236. {$endif}
  237. constructor init(const _name : string;_size : longint);
  238. constructor init_global(const _name : string;_size : longint);
  239. end;
  240. { generates a long integer (32 bit) }
  241. pai_const = ^tai_const;
  242. tai_const = object(tai)
  243. value : longint;
  244. constructor init_32bit(_value : longint);
  245. constructor init_16bit(_value : word);
  246. constructor init_8bit(_value : byte);
  247. end;
  248. pai_const_symbol = ^tai_const_symbol;
  249. tai_const_symbol = object(tai)
  250. sym : pasmsymbol;
  251. offset : longint;
  252. constructor init(_sym:PAsmSymbol);
  253. constructor init_offset(_sym:PAsmSymbol;ofs:longint);
  254. constructor init_rva(_sym:PAsmSymbol);
  255. constructor initname(const name:string);
  256. constructor initname_offset(const name:string;ofs:longint);
  257. constructor initname_rva(const name:string);
  258. end;
  259. { generates a single (32 bit real) }
  260. pai_real_32bit = ^tai_real_32bit;
  261. tai_real_32bit = object(tai)
  262. value : ts32real;
  263. constructor init(_value : ts32real);
  264. end;
  265. { generates a double (64 bit real) }
  266. pai_real_64bit = ^tai_real_64bit;
  267. tai_real_64bit = object(tai)
  268. value : ts64real;
  269. constructor init(_value : ts64real);
  270. end;
  271. { generates an extended (80 bit real) }
  272. pai_real_80bit = ^tai_real_80bit;
  273. tai_real_80bit = object(tai)
  274. value : ts80real;
  275. constructor init(_value : ts80real);
  276. end;
  277. { generates an comp (integer over 64 bits) }
  278. pai_comp_64bit = ^tai_comp_64bit;
  279. tai_comp_64bit = object(tai)
  280. value : ts64comp;
  281. constructor init(_value : ts64comp);
  282. end;
  283. { insert a cut to split into several smaller files }
  284. tcutplace=(cut_normal,cut_begin,cut_end);
  285. pai_cut = ^tai_cut;
  286. tai_cut = object(tai)
  287. place : tcutplace;
  288. constructor init;
  289. constructor init_begin;
  290. constructor init_end;
  291. end;
  292. TMarker = (NoPropInfoStart, NoPropInfoEnd,
  293. AsmBlockStart, AsmBlockEnd,
  294. InlineStart,InlineEnd);
  295. pai_marker = ^tai_marker;
  296. tai_marker = object(tai)
  297. Kind: TMarker;
  298. Constructor init(_Kind: TMarker);
  299. end;
  300. paitempalloc = ^taitempalloc;
  301. taitempalloc = object(tai)
  302. {$ifdef PACKENUMFIXED}
  303. allocation : boolean;
  304. {$endif}
  305. temppos,
  306. tempsize : longint;
  307. {$ifndef PACKENUMFIXED}
  308. allocation : boolean;
  309. {$endif}
  310. constructor alloc(pos,size:longint);
  311. constructor dealloc(pos,size:longint);
  312. end;
  313. { for each processor define the best precision }
  314. { bestreal is defined in globals }
  315. {$ifdef i386}
  316. const
  317. ait_bestreal = ait_real_80bit;
  318. type
  319. pai_bestreal = pai_real_80bit;
  320. tai_bestreal = tai_real_80bit;
  321. {$endif i386}
  322. {$ifdef m68k}
  323. const
  324. ait_bestreal = ait_real_32bit;
  325. type
  326. pai_bestreal = pai_real_32bit;
  327. tai_bestreal = tai_real_32bit;
  328. {$endif m68k}
  329. paasmoutput = ^taasmoutput;
  330. taasmoutput = object(tlinkedlist)
  331. function getlasttaifilepos : pfileposinfo;
  332. end;
  333. const
  334. { maximum of aasmoutput lists there will be }
  335. maxoutputlists = 10;
  336. var
  337. { temporary lists }
  338. exprasmlist,
  339. { default lists }
  340. datasegment,codesegment,bsssegment,
  341. debuglist,withdebuglist,consts,
  342. importssection,exportssection,
  343. resourcesection,rttilist,
  344. resourcestringlist : paasmoutput;
  345. { asm symbol list }
  346. asmsymbollist : pasmsymbollist;
  347. const
  348. nextaltnr : longint = 1;
  349. nextlabelnr : longint = 1;
  350. countlabelref : boolean = true;
  351. { make l as a new label }
  352. procedure getlabel(var l : pasmlabel);
  353. { make l as a new label and flag is_addr }
  354. procedure getaddrlabel(var l : pasmlabel);
  355. { make l as a new label and flag is_data }
  356. procedure getdatalabel(var l : pasmlabel);
  357. {just get a label number }
  358. procedure getlabelnr(var l : longint);
  359. function newasmsymbol(const s : string) : pasmsymbol;
  360. function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : pasmsymbol;
  361. function getasmsymbol(const s : string) : pasmsymbol;
  362. function renameasmsymbol(const sold, snew : string):pasmsymbol;
  363. procedure ResetAsmsymbolList;
  364. procedure ResetAsmSymbolListAltSymbol;
  365. procedure CheckAsmSymbolListUndefined;
  366. implementation
  367. uses
  368. strings,files,verbose;
  369. {****************************************************************************
  370. TAI
  371. ****************************************************************************}
  372. constructor tai.init;
  373. begin
  374. optinfo := nil;
  375. fileinfo:=aktfilepos;
  376. end;
  377. {****************************************************************************
  378. TAI_SECTION
  379. ****************************************************************************}
  380. constructor tai_section.init(s : tsection);
  381. begin
  382. inherited init;
  383. typ:=ait_section;
  384. sec:=s;
  385. end;
  386. {****************************************************************************
  387. TAI_DATABLOCK
  388. ****************************************************************************}
  389. constructor tai_datablock.init(const _name : string;_size : longint);
  390. begin
  391. inherited init;
  392. typ:=ait_datablock;
  393. sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  394. { keep things aligned }
  395. if _size<=0 then
  396. _size:=4;
  397. size:=_size;
  398. is_global:=false;
  399. end;
  400. constructor tai_datablock.init_global(const _name : string;_size : longint);
  401. begin
  402. inherited init;
  403. typ:=ait_datablock;
  404. sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  405. { keep things aligned }
  406. if _size<=0 then
  407. _size:=4;
  408. size:=_size;
  409. is_global:=true;
  410. end;
  411. {****************************************************************************
  412. TAI_SYMBOL
  413. ****************************************************************************}
  414. constructor tai_symbol.init(_sym:PAsmSymbol;siz:longint);
  415. begin
  416. inherited init;
  417. typ:=ait_symbol;
  418. sym:=_sym;
  419. size:=siz;
  420. is_global:=(sym^.bind=AB_GLOBAL);
  421. end;
  422. constructor tai_symbol.initname(const _name : string;siz:longint);
  423. begin
  424. inherited init;
  425. typ:=ait_symbol;
  426. sym:=newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
  427. size:=siz;
  428. is_global:=false;
  429. end;
  430. constructor tai_symbol.initname_global(const _name : string;siz:longint);
  431. begin
  432. inherited init;
  433. typ:=ait_symbol;
  434. sym:=newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
  435. size:=siz;
  436. is_global:=true;
  437. end;
  438. constructor tai_symbol.initdataname(const _name : string;siz:longint);
  439. begin
  440. inherited init;
  441. typ:=ait_symbol;
  442. sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
  443. size:=siz;
  444. is_global:=false;
  445. end;
  446. constructor tai_symbol.initdataname_global(const _name : string;siz:longint);
  447. begin
  448. inherited init;
  449. typ:=ait_symbol;
  450. sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
  451. size:=siz;
  452. is_global:=true;
  453. end;
  454. {****************************************************************************
  455. TAI_SYMBOL
  456. ****************************************************************************}
  457. constructor tai_symbol_end.init(_sym:PAsmSymbol);
  458. begin
  459. inherited init;
  460. typ:=ait_symbol_end;
  461. sym:=_sym;
  462. end;
  463. constructor tai_symbol_end.initname(const _name : string);
  464. begin
  465. inherited init;
  466. typ:=ait_symbol_end;
  467. sym:=newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
  468. end;
  469. {****************************************************************************
  470. TAI_CONST
  471. ****************************************************************************}
  472. constructor tai_const.init_32bit(_value : longint);
  473. begin
  474. inherited init;
  475. typ:=ait_const_32bit;
  476. value:=_value;
  477. end;
  478. constructor tai_const.init_16bit(_value : word);
  479. begin
  480. inherited init;
  481. typ:=ait_const_16bit;
  482. value:=_value;
  483. end;
  484. constructor tai_const.init_8bit(_value : byte);
  485. begin
  486. inherited init;
  487. typ:=ait_const_8bit;
  488. value:=_value;
  489. end;
  490. {****************************************************************************
  491. TAI_CONST_SYMBOL_OFFSET
  492. ****************************************************************************}
  493. constructor tai_const_symbol.init(_sym:PAsmSymbol);
  494. begin
  495. inherited init;
  496. typ:=ait_const_symbol;
  497. sym:=_sym;
  498. offset:=0;
  499. { update sym info }
  500. inc(sym^.refs);
  501. end;
  502. constructor tai_const_symbol.init_offset(_sym:PAsmSymbol;ofs:longint);
  503. begin
  504. inherited init;
  505. typ:=ait_const_symbol;
  506. sym:=_sym;
  507. offset:=ofs;
  508. { update sym info }
  509. inc(sym^.refs);
  510. end;
  511. constructor tai_const_symbol.init_rva(_sym:PAsmSymbol);
  512. begin
  513. inherited init;
  514. typ:=ait_const_rva;
  515. sym:=_sym;
  516. offset:=0;
  517. { update sym info }
  518. inc(sym^.refs);
  519. end;
  520. constructor tai_const_symbol.initname(const name:string);
  521. begin
  522. inherited init;
  523. typ:=ait_const_symbol;
  524. sym:=newasmsymbol(name);
  525. offset:=0;
  526. { update sym info }
  527. inc(sym^.refs);
  528. end;
  529. constructor tai_const_symbol.initname_offset(const name:string;ofs:longint);
  530. begin
  531. inherited init;
  532. typ:=ait_const_symbol;
  533. sym:=newasmsymbol(name);
  534. offset:=ofs;
  535. { update sym info }
  536. inc(sym^.refs);
  537. end;
  538. constructor tai_const_symbol.initname_rva(const name:string);
  539. begin
  540. inherited init;
  541. typ:=ait_const_rva;
  542. sym:=newasmsymbol(name);
  543. offset:=0;
  544. { update sym info }
  545. inc(sym^.refs);
  546. end;
  547. {****************************************************************************
  548. TAI_real_32bit
  549. ****************************************************************************}
  550. constructor tai_real_32bit.init(_value : ts32real);
  551. begin
  552. inherited init;
  553. typ:=ait_real_32bit;
  554. value:=_value;
  555. end;
  556. {****************************************************************************
  557. TAI_real_64bit
  558. ****************************************************************************}
  559. constructor tai_real_64bit.init(_value : ts64real);
  560. begin
  561. inherited init;
  562. typ:=ait_real_64bit;
  563. value:=_value;
  564. end;
  565. {****************************************************************************
  566. TAI_real_80bit
  567. ****************************************************************************}
  568. constructor tai_real_80bit.init(_value : ts80real);
  569. begin
  570. inherited init;
  571. typ:=ait_real_80bit;
  572. value:=_value;
  573. end;
  574. {****************************************************************************
  575. Tai_comp_64bit
  576. ****************************************************************************}
  577. constructor tai_comp_64bit.init(_value : ts64comp);
  578. begin
  579. inherited init;
  580. typ:=ait_comp_64bit;
  581. value:=_value;
  582. end;
  583. {****************************************************************************
  584. TAI_STRING
  585. ****************************************************************************}
  586. constructor tai_string.init(const _str : string);
  587. begin
  588. inherited init;
  589. typ:=ait_string;
  590. getmem(str,length(_str)+1);
  591. strpcopy(str,_str);
  592. len:=length(_str);
  593. end;
  594. constructor tai_string.init_pchar(_str : pchar);
  595. begin
  596. inherited init;
  597. typ:=ait_string;
  598. str:=_str;
  599. len:=strlen(_str);
  600. end;
  601. constructor tai_string.init_length_pchar(_str : pchar;length : longint);
  602. begin
  603. inherited init;
  604. typ:=ait_string;
  605. str:=_str;
  606. len:=length;
  607. end;
  608. destructor tai_string.done;
  609. begin
  610. { you can have #0 inside the strings so }
  611. if str<>nil then
  612. freemem(str,len+1);
  613. inherited done;
  614. end;
  615. {****************************************************************************
  616. TAI_LABEL
  617. ****************************************************************************}
  618. constructor tai_label.init(_l : pasmlabel);
  619. begin
  620. inherited init;
  621. typ:=ait_label;
  622. l:=_l;
  623. l^.is_set:=true;
  624. is_global:=(l^.bind=AB_GLOBAL);
  625. end;
  626. {****************************************************************************
  627. TAI_DIRECT
  628. ****************************************************************************}
  629. constructor tai_direct.init(_str : pchar);
  630. begin
  631. inherited init;
  632. typ:=ait_direct;
  633. str:=_str;
  634. end;
  635. destructor tai_direct.done;
  636. begin
  637. strdispose(str);
  638. inherited done;
  639. end;
  640. {****************************************************************************
  641. TAI_ASM_COMMENT comment to be inserted in the assembler file
  642. ****************************************************************************}
  643. constructor tai_asm_comment.init(_str : pchar);
  644. begin
  645. inherited init;
  646. typ:=ait_comment;
  647. str:=_str;
  648. end;
  649. destructor tai_asm_comment.done;
  650. begin
  651. strdispose(str);
  652. inherited done;
  653. end;
  654. {****************************************************************************
  655. TAI_ALIGN
  656. ****************************************************************************}
  657. {$ifdef i386}
  658. constructor tai_align_abstract.init(b: byte);
  659. {$else i386}
  660. constructor tai_align.init(b: byte);
  661. {$endif i386}
  662. begin
  663. inherited init;
  664. typ:=ait_align;
  665. if b in [1,2,4,8,16,32] then
  666. aligntype := b
  667. else
  668. aligntype := 1;
  669. fillsize:=0;
  670. fillop:=0;
  671. use_op:=false;
  672. end;
  673. {$ifdef i386}
  674. constructor tai_align_abstract.init_op(b: byte; _op: byte);
  675. {$else i386}
  676. constructor tai_align.init_op(b: byte; _op: byte);
  677. {$endif i386}
  678. begin
  679. inherited init;
  680. typ:=ait_align;
  681. if b in [1,2,4,8,16,32] then
  682. aligntype := b
  683. else
  684. aligntype := 1;
  685. fillsize:=0;
  686. fillop:=_op;
  687. use_op:=true;
  688. fillchar(buf,sizeof(buf),_op)
  689. end;
  690. {$ifdef i386}
  691. function tai_align_abstract.getfillbuf:pchar;
  692. {$else i386}
  693. function tai_align.getfillbuf:pchar;
  694. {$endif i386}
  695. begin
  696. getfillbuf:=@buf;
  697. end;
  698. {****************************************************************************
  699. TAI_CUT
  700. ****************************************************************************}
  701. constructor tai_cut.init;
  702. begin
  703. inherited init;
  704. typ:=ait_cut;
  705. place:=cut_normal;
  706. end;
  707. constructor tai_cut.init_begin;
  708. begin
  709. inherited init;
  710. typ:=ait_cut;
  711. place:=cut_begin;
  712. end;
  713. constructor tai_cut.init_end;
  714. begin
  715. inherited init;
  716. typ:=ait_cut;
  717. place:=cut_end;
  718. end;
  719. {****************************************************************************
  720. Tai_Marker
  721. ****************************************************************************}
  722. Constructor Tai_Marker.Init(_Kind: TMarker);
  723. Begin
  724. Inherited Init;
  725. typ := ait_marker;
  726. Kind := _Kind;
  727. End;
  728. {*****************************************************************************
  729. TaiTempAlloc
  730. *****************************************************************************}
  731. constructor taitempalloc.alloc(pos,size:longint);
  732. begin
  733. inherited init;
  734. typ:=ait_tempalloc;
  735. allocation:=true;
  736. temppos:=pos;
  737. tempsize:=size;
  738. end;
  739. constructor taitempalloc.dealloc(pos,size:longint);
  740. begin
  741. inherited init;
  742. typ:=ait_tempalloc;
  743. allocation:=false;
  744. temppos:=pos;
  745. tempsize:=size;
  746. end;
  747. {*****************************************************************************
  748. AsmSymbol
  749. *****************************************************************************}
  750. constructor tasmsymbol.init(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
  751. begin;
  752. {$IFDEF NEWST}
  753. inherited init(s);
  754. {$ELSE}
  755. inherited initname(s);
  756. {$ENDIF NEWST}
  757. reset;
  758. orgbind:=_bind;
  759. bind:=_bind;
  760. typ:=_typ;
  761. end;
  762. procedure tasmsymbol.GenerateAltSymbol;
  763. begin
  764. if not assigned(altsymbol) then
  765. begin
  766. new(altsymbol,init(name+'_'+tostr(nextaltnr),bind,typ));
  767. { also copy the amount of references }
  768. altsymbol^.refs:=refs;
  769. inc(nextaltnr);
  770. end;
  771. end;
  772. procedure tasmsymbol.reset;
  773. begin
  774. { reset section info }
  775. section:=sec_none;
  776. address:=0;
  777. size:=0;
  778. idx:=-1;
  779. bind:=AB_EXTERNAL;
  780. proclocal:=false;
  781. { mainly used to remove unused labels from the codesegment }
  782. refs:=0;
  783. end;
  784. function tasmsymbol.is_used:boolean;
  785. begin
  786. is_used:=(refs>0);
  787. end;
  788. procedure tasmsymbol.setbind(t:tasmsymbind);
  789. begin
  790. bind:=t;
  791. orgbind:=t;
  792. end;
  793. procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint);
  794. begin
  795. section:=sec;
  796. address:=offset;
  797. size:=len;
  798. { when the typ was reset to External, set it back to the original
  799. type it got when defined }
  800. if (bind=AB_EXTERNAL) and (orgbind<>AB_NONE) then
  801. bind:=orgbind;
  802. end;
  803. {*****************************************************************************
  804. AsmLabel
  805. *****************************************************************************}
  806. constructor tasmlabel.init;
  807. begin;
  808. labelnr:=nextlabelnr;
  809. inc(nextlabelnr);
  810. inherited init(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
  811. proclocal:=true;
  812. is_set:=false;
  813. is_addr := false;
  814. end;
  815. constructor tasmlabel.initdata;
  816. begin;
  817. labelnr:=nextlabelnr;
  818. inc(nextlabelnr);
  819. if (cs_create_smart in aktmoduleswitches) then
  820. inherited init('_$'+current_module^.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
  821. else
  822. inherited init(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
  823. is_set:=false;
  824. is_addr := false;
  825. { write it always }
  826. refs:=1;
  827. end;
  828. constructor tasmlabel.initaddr;
  829. begin;
  830. init;
  831. is_addr := true;
  832. end;
  833. function tasmlabel.name:string;
  834. begin
  835. name:=inherited name;
  836. inc(refs);
  837. end;
  838. {*****************************************************************************
  839. AsmSymbolList helpers
  840. *****************************************************************************}
  841. function newasmsymbol(const s : string) : pasmsymbol;
  842. var
  843. hp : pasmsymbol;
  844. begin
  845. hp:=pasmsymbol(asmsymbollist^.search(s));
  846. if assigned(hp) then
  847. begin
  848. newasmsymbol:=hp;
  849. exit;
  850. end;
  851. { Not found, insert it as an External }
  852. hp:=new(pasmsymbol,init(s,AB_EXTERNAL,AT_FUNCTION));
  853. asmsymbollist^.insert(hp);
  854. newasmsymbol:=hp;
  855. end;
  856. function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : pasmsymbol;
  857. var
  858. hp : pasmsymbol;
  859. begin
  860. hp:=pasmsymbol(asmsymbollist^.search(s));
  861. if assigned(hp) then
  862. hp^.setbind(_bind)
  863. else
  864. begin
  865. { Not found, insert it as an External }
  866. hp:=new(pasmsymbol,init(s,_bind,_typ));
  867. asmsymbollist^.insert(hp);
  868. end;
  869. newasmsymboltype:=hp;
  870. end;
  871. function getasmsymbol(const s : string) : pasmsymbol;
  872. begin
  873. getasmsymbol:=pasmsymbol(asmsymbollist^.search(s));
  874. end;
  875. { renames an asmsymbol }
  876. function renameasmsymbol(const sold, snew : string):pasmsymbol;
  877. begin
  878. renameasmsymbol:=pasmsymbol(asmsymbollist^.rename(sold,snew));
  879. end;
  880. procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
  881. begin
  882. pasmsymbol(p)^.reset;
  883. end;
  884. procedure ResetAsmsymbolList;
  885. begin
  886. asmsymbollist^.foreach({$ifndef TP}@{$endif}resetasmsym);
  887. end;
  888. procedure ResetAltSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
  889. begin
  890. pasmsymbol(p)^.altsymbol:=nil;
  891. end;
  892. procedure ResetAsmSymbolListAltSymbol;
  893. begin
  894. asmsymbollist^.foreach({$ifndef TP}@{$endif}resetaltsym);
  895. end;
  896. procedure checkundefinedasmsym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
  897. begin
  898. if (pasmsymbol(p)^.refs>0) and
  899. (pasmsymbol(p)^.section=Sec_none) and
  900. (pasmsymbol(p)^.bind<>AB_EXTERNAL) then
  901. Message1(asmw_e_undefined_label,pasmsymbol(p)^.name);
  902. end;
  903. procedure CheckAsmSymbolListUndefined;
  904. begin
  905. asmsymbollist^.foreach({$ifndef TP}@{$endif}checkundefinedasmsym);
  906. end;
  907. {*****************************************************************************
  908. Label Helpers
  909. *****************************************************************************}
  910. procedure getlabel(var l : pasmlabel);
  911. begin
  912. l:=new(pasmlabel,init);
  913. asmsymbollist^.insert(l);
  914. end;
  915. procedure getdatalabel(var l : pasmlabel);
  916. begin
  917. l:=new(pasmlabel,initdata);
  918. asmsymbollist^.insert(l);
  919. end;
  920. procedure getaddrlabel(var l : pasmlabel);
  921. begin
  922. l:=new(pasmlabel,initaddr);
  923. asmsymbollist^.insert(l);
  924. end;
  925. procedure RegenerateLabel(var l : pasmlabel);
  926. begin
  927. if l^.proclocal then
  928. getlabel(pasmlabel(l^.altsymbol))
  929. else
  930. getdatalabel(pasmlabel(l^.altsymbol));
  931. end;
  932. procedure getlabelnr(var l : longint);
  933. begin
  934. l:=nextlabelnr;
  935. inc(nextlabelnr);
  936. end;
  937. {*****************************************************************************
  938. TAAsmOutput
  939. *****************************************************************************}
  940. function taasmoutput.getlasttaifilepos : pfileposinfo;
  941. begin
  942. if assigned(last) then
  943. getlasttaifilepos:=@pai(last)^.fileinfo
  944. else
  945. getlasttaifilepos:=nil;
  946. end;
  947. end.
  948. {
  949. $Log$
  950. Revision 1.6 2000-08-09 19:49:44 peter
  951. * packenumfixed things so it compiles with 1.0.0 again
  952. Revision 1.5 2000/08/05 13:25:06 peter
  953. * packenum 1 fixes (merged)
  954. Revision 1.4 2000/07/21 15:14:01 jonas
  955. + added is_addr field for labels, if they are only used for getting the address
  956. (e.g. for io checks) and corresponding getaddrlabel() procedure
  957. Revision 1.3 2000/07/13 12:08:24 michael
  958. + patched to 1.1.0 with former 1.09patch from peter
  959. Revision 1.2 2000/07/13 11:32:28 michael
  960. + removed logs
  961. }