aasm.pas 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 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. interface
  20. uses
  21. globtype,systems,cobjects,files,globals;
  22. type
  23. tait = (
  24. ait_none,
  25. ait_direct,
  26. ait_string,
  27. ait_label,
  28. ait_comment,
  29. ait_instruction,
  30. ait_datablock,
  31. ait_symbol,
  32. ait_symbol_end, { needed to calc the size of a symbol }
  33. ait_const_32bit,
  34. ait_const_16bit,
  35. ait_const_8bit,
  36. ait_const_symbol,
  37. ait_real_80bit,
  38. ait_real_64bit,
  39. ait_real_32bit,
  40. ait_comp_64bit,
  41. ait_align,
  42. ait_section,
  43. { the following is only used by the win32 version of the compiler }
  44. { and only the GNU AS Win32 is able to write it }
  45. ait_const_rva,
  46. ait_stabn,
  47. ait_stabs,
  48. ait_force_line,
  49. ait_stab_function_name,
  50. ait_cut, { used to split into tiny assembler files }
  51. ait_regalloc, { for register,temp allocation debugging }
  52. ait_tempalloc,
  53. ait_marker,
  54. { never used, makes insertation of new ait_ easier to type }
  55. ait_dummy);
  56. { asm symbol functions }
  57. type
  58. TAsmsymtype=(AS_EXTERNAL,AS_LOCAL,AS_GLOBAL);
  59. pasmsymbol = ^tasmsymbol;
  60. tasmsymbol = object(tnamedindexobject)
  61. typ : TAsmsymtype;
  62. { this need te incremented with every symbol loading into the
  63. paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
  64. refs : longint;
  65. { the next fields are filled in the binary writer }
  66. idx : longint;
  67. section : tsection;
  68. address,
  69. size : longint;
  70. constructor init(const s:string;_typ:TAsmsymtype);
  71. procedure reset;
  72. function is_used:boolean;
  73. procedure setaddress(sec:tsection;offset,len:longint);
  74. end;
  75. pasmlabel = ^tasmlabel;
  76. tasmlabel = object(tasmsymbol)
  77. labelnr : longint;
  78. { this is set by the pai_label.init }
  79. is_set : boolean;
  80. constructor init;
  81. constructor initdata;
  82. function name:string;virtual;
  83. end;
  84. pasmsymbollist = ^tasmsymbollist;
  85. tasmsymbollist = object(tdictionary)
  86. end;
  87. { the short name makes typing easier }
  88. pai = ^tai;
  89. tai = object(tlinkedlist_item)
  90. typ : tait;
  91. { pointer to record with optimizer info about this tai object }
  92. optinfo : pointer;
  93. fileinfo : tfileposinfo;
  94. constructor init;
  95. end;
  96. pai_string = ^tai_string;
  97. tai_string = object(tai)
  98. str : pchar;
  99. { extra len so the string can contain an \0 }
  100. len : longint;
  101. constructor init(const _str : string);
  102. constructor init_pchar(_str : pchar);
  103. constructor init_length_pchar(_str : pchar;length : longint);
  104. destructor done;virtual;
  105. end;
  106. { generates a common label }
  107. pai_symbol = ^tai_symbol;
  108. tai_symbol = object(tai)
  109. sym : pasmsymbol;
  110. is_global : boolean;
  111. size : longint;
  112. constructor init(_sym:PAsmSymbol;siz:longint);
  113. constructor initname(const _name : string;siz:longint);
  114. constructor initname_global(const _name : string;siz:longint);
  115. end;
  116. pai_symbol_end = ^tai_symbol_end;
  117. tai_symbol_end = object(tai)
  118. sym : pasmsymbol;
  119. constructor init(_sym:PAsmSymbol);
  120. constructor initname(const _name : string);
  121. end;
  122. pai_label = ^tai_label;
  123. tai_label = object(tai)
  124. l : pasmlabel;
  125. is_global : boolean;
  126. constructor init(_l : pasmlabel);
  127. end;
  128. pai_direct = ^tai_direct;
  129. tai_direct = object(tai)
  130. str : pchar;
  131. constructor init(_str : pchar);
  132. destructor done; virtual;
  133. end;
  134. { to insert a comment into the generated assembler file }
  135. pai_asm_comment = ^tai_asm_comment;
  136. tai_asm_comment = object(tai)
  137. str : pchar;
  138. constructor init(_str : pchar);
  139. destructor done; virtual;
  140. end;
  141. { alignment for operator }
  142. pai_align = ^tai_align;
  143. tai_align = object(tai)
  144. aligntype : byte; { 1 = no align, 2 = word align, 4 = dword align }
  145. fillsize : byte; { real size to fill }
  146. fillop : byte; { value to fill with - optional }
  147. use_op : boolean;
  148. constructor init(b:byte);
  149. constructor init_op(b: byte; _op: byte);
  150. end;
  151. { Insert a section/segment directive }
  152. pai_section = ^tai_section;
  153. tai_section = object(tai)
  154. sec : tsection;
  155. constructor init(s : tsection);
  156. end;
  157. { generates an uninitializised data block }
  158. pai_datablock = ^tai_datablock;
  159. tai_datablock = object(tai)
  160. sym : pasmsymbol;
  161. size : longint;
  162. is_global : boolean;
  163. constructor init(const _name : string;_size : longint);
  164. constructor init_global(const _name : string;_size : longint);
  165. end;
  166. { generates a long integer (32 bit) }
  167. pai_const = ^tai_const;
  168. tai_const = object(tai)
  169. value : longint;
  170. constructor init_32bit(_value : longint);
  171. constructor init_16bit(_value : word);
  172. constructor init_8bit(_value : byte);
  173. end;
  174. pai_const_symbol = ^tai_const_symbol;
  175. tai_const_symbol = object(tai)
  176. sym : pasmsymbol;
  177. offset : longint;
  178. constructor init(_sym:PAsmSymbol);
  179. constructor init_offset(_sym:PAsmSymbol;ofs:longint);
  180. constructor init_rva(_sym:PAsmSymbol);
  181. constructor initname(const name:string);
  182. constructor initname_offset(const name:string;ofs:longint);
  183. constructor initname_rva(const name:string);
  184. end;
  185. { generates a single (32 bit real) }
  186. pai_real_32bit = ^tai_real_32bit;
  187. tai_real_32bit = object(tai)
  188. value : ts32real;
  189. constructor init(_value : ts32real);
  190. end;
  191. { generates a double (64 bit real) }
  192. pai_real_64bit = ^tai_real_64bit;
  193. tai_real_64bit = object(tai)
  194. value : ts64real;
  195. constructor init(_value : ts64real);
  196. end;
  197. { generates an extended (80 bit real) }
  198. pai_real_80bit = ^tai_real_80bit;
  199. tai_real_80bit = object(tai)
  200. value : ts80real;
  201. constructor init(_value : ts80real);
  202. end;
  203. { generates an comp (integer over 64 bits) }
  204. pai_comp_64bit = ^tai_comp_64bit;
  205. tai_comp_64bit = object(tai)
  206. value : ts64comp;
  207. constructor init(_value : ts64comp);
  208. end;
  209. { insert a cut to split into several smaller files }
  210. pai_cut = ^tai_cut;
  211. tai_cut = object(tai)
  212. endname : boolean;
  213. constructor init;
  214. constructor init_end;
  215. end;
  216. TMarker = (NoPropInfoStart, NoPropInfoEnd, AsmBlockStart, AsmBlockEnd);
  217. pai_marker = ^tai_marker;
  218. tai_marker = object(tai)
  219. Kind: TMarker;
  220. Constructor init(_Kind: TMarker);
  221. end;
  222. paitempalloc = ^taitempalloc;
  223. taitempalloc = object(tai)
  224. allocation : boolean;
  225. temppos,
  226. tempsize : longint;
  227. constructor alloc(pos,size:longint);
  228. constructor dealloc(pos,size:longint);
  229. end;
  230. { for each processor define the best precision }
  231. { bestreal is defined in globals }
  232. {$ifdef i386}
  233. const
  234. ait_bestreal = ait_real_80bit;
  235. type
  236. pai_bestreal = pai_real_80bit;
  237. tai_bestreal = tai_real_80bit;
  238. {$endif i386}
  239. {$ifdef m68k}
  240. const
  241. ait_bestreal = ait_real_32bit;
  242. type
  243. pai_bestreal = pai_real_32bit;
  244. tai_bestreal = tai_real_32bit;
  245. {$endif m68k}
  246. paasmoutput = ^taasmoutput;
  247. taasmoutput = object(tlinkedlist)
  248. function getlasttaifilepos : pfileposinfo;
  249. end;
  250. const
  251. { maximum of aasmoutput lists there will be }
  252. maxoutputlists = 10;
  253. var
  254. { temporary lists }
  255. exprasmlist,
  256. { default lists }
  257. datasegment,codesegment,bsssegment,
  258. debuglist,consts,
  259. importssection,exportssection,
  260. resourcesection,rttilist,
  261. resourcestringlist : paasmoutput;
  262. { asm symbol list }
  263. asmsymbollist : pasmsymbollist;
  264. const
  265. nextlabelnr : longint = 1;
  266. countlabelref : boolean = true;
  267. { make l as a new label }
  268. procedure getlabel(var l : pasmlabel);
  269. { make l as a new label and flag is_data }
  270. procedure getdatalabel(var l : pasmlabel);
  271. { free a label }
  272. procedure freelabel(var l : pasmlabel);
  273. {just get a label number }
  274. procedure getlabelnr(var l : longint);
  275. function newasmsymbol(const s : string) : pasmsymbol;
  276. function newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
  277. function getasmsymbol(const s : string) : pasmsymbol;
  278. function renameasmsymbol(const sold, snew : string):pasmsymbol;
  279. procedure ResetAsmsymbolList;
  280. implementation
  281. uses
  282. strings,verbose;
  283. {****************************************************************************
  284. TAI
  285. ****************************************************************************}
  286. constructor tai.init;
  287. begin
  288. optinfo := nil;
  289. fileinfo:=aktfilepos;
  290. end;
  291. {****************************************************************************
  292. TAI_SECTION
  293. ****************************************************************************}
  294. constructor tai_section.init(s : tsection);
  295. begin
  296. inherited init;
  297. typ:=ait_section;
  298. sec:=s;
  299. end;
  300. {****************************************************************************
  301. TAI_DATABLOCK
  302. ****************************************************************************}
  303. constructor tai_datablock.init(const _name : string;_size : longint);
  304. begin
  305. inherited init;
  306. typ:=ait_datablock;
  307. sym:=newasmsymboltyp(_name,AS_LOCAL);
  308. size:=_size;
  309. is_global:=false;
  310. end;
  311. constructor tai_datablock.init_global(const _name : string;_size : longint);
  312. begin
  313. inherited init;
  314. typ:=ait_datablock;
  315. sym:=newasmsymboltyp(_name,AS_GLOBAL);
  316. size:=_size;
  317. is_global:=true;
  318. end;
  319. {****************************************************************************
  320. TAI_SYMBOL
  321. ****************************************************************************}
  322. constructor tai_symbol.init(_sym:PAsmSymbol;siz:longint);
  323. begin
  324. inherited init;
  325. typ:=ait_symbol;
  326. sym:=_sym;
  327. size:=siz;
  328. is_global:=(sym^.typ=AS_GLOBAL);
  329. end;
  330. constructor tai_symbol.initname(const _name : string;siz:longint);
  331. begin
  332. inherited init;
  333. typ:=ait_symbol;
  334. sym:=newasmsymboltyp(_name,AS_LOCAL);
  335. size:=siz;
  336. is_global:=false;
  337. end;
  338. constructor tai_symbol.initname_global(const _name : string;siz:longint);
  339. begin
  340. inherited init;
  341. typ:=ait_symbol;
  342. sym:=newasmsymboltyp(_name,AS_GLOBAL);
  343. size:=siz;
  344. is_global:=true;
  345. end;
  346. {****************************************************************************
  347. TAI_SYMBOL
  348. ****************************************************************************}
  349. constructor tai_symbol_end.init(_sym:PAsmSymbol);
  350. begin
  351. inherited init;
  352. typ:=ait_symbol_end;
  353. sym:=_sym;
  354. end;
  355. constructor tai_symbol_end.initname(const _name : string);
  356. begin
  357. inherited init;
  358. typ:=ait_symbol_end;
  359. sym:=newasmsymboltyp(_name,AS_GLOBAL);
  360. end;
  361. {****************************************************************************
  362. TAI_CONST
  363. ****************************************************************************}
  364. constructor tai_const.init_32bit(_value : longint);
  365. begin
  366. inherited init;
  367. typ:=ait_const_32bit;
  368. value:=_value;
  369. end;
  370. constructor tai_const.init_16bit(_value : word);
  371. begin
  372. inherited init;
  373. typ:=ait_const_16bit;
  374. value:=_value;
  375. end;
  376. constructor tai_const.init_8bit(_value : byte);
  377. begin
  378. inherited init;
  379. typ:=ait_const_8bit;
  380. value:=_value;
  381. end;
  382. {****************************************************************************
  383. TAI_CONST_SYMBOL_OFFSET
  384. ****************************************************************************}
  385. constructor tai_const_symbol.init(_sym:PAsmSymbol);
  386. begin
  387. inherited init;
  388. typ:=ait_const_symbol;
  389. sym:=_sym;
  390. offset:=0;
  391. { update sym info }
  392. inc(sym^.refs);
  393. end;
  394. constructor tai_const_symbol.init_offset(_sym:PAsmSymbol;ofs:longint);
  395. begin
  396. inherited init;
  397. typ:=ait_const_symbol;
  398. sym:=_sym;
  399. offset:=ofs;
  400. { update sym info }
  401. inc(sym^.refs);
  402. end;
  403. constructor tai_const_symbol.init_rva(_sym:PAsmSymbol);
  404. begin
  405. inherited init;
  406. typ:=ait_const_rva;
  407. sym:=_sym;
  408. offset:=0;
  409. { update sym info }
  410. inc(sym^.refs);
  411. end;
  412. constructor tai_const_symbol.initname(const name:string);
  413. begin
  414. inherited init;
  415. typ:=ait_const_symbol;
  416. sym:=newasmsymbol(name);
  417. offset:=0;
  418. { update sym info }
  419. inc(sym^.refs);
  420. end;
  421. constructor tai_const_symbol.initname_offset(const name:string;ofs:longint);
  422. begin
  423. inherited init;
  424. typ:=ait_const_symbol;
  425. sym:=newasmsymbol(name);
  426. offset:=ofs;
  427. { update sym info }
  428. inc(sym^.refs);
  429. end;
  430. constructor tai_const_symbol.initname_rva(const name:string);
  431. begin
  432. inherited init;
  433. typ:=ait_const_rva;
  434. sym:=newasmsymbol(name);
  435. offset:=0;
  436. { update sym info }
  437. inc(sym^.refs);
  438. end;
  439. {****************************************************************************
  440. TAI_real_32bit
  441. ****************************************************************************}
  442. constructor tai_real_32bit.init(_value : ts32real);
  443. begin
  444. inherited init;
  445. typ:=ait_real_32bit;
  446. value:=_value;
  447. end;
  448. {****************************************************************************
  449. TAI_real_64bit
  450. ****************************************************************************}
  451. constructor tai_real_64bit.init(_value : ts64real);
  452. begin
  453. inherited init;
  454. typ:=ait_real_64bit;
  455. value:=_value;
  456. end;
  457. {****************************************************************************
  458. TAI_real_80bit
  459. ****************************************************************************}
  460. constructor tai_real_80bit.init(_value : ts80real);
  461. begin
  462. inherited init;
  463. typ:=ait_real_80bit;
  464. value:=_value;
  465. end;
  466. {****************************************************************************
  467. Tai_comp_64bit
  468. ****************************************************************************}
  469. constructor tai_comp_64bit.init(_value : ts64comp);
  470. begin
  471. inherited init;
  472. typ:=ait_comp_64bit;
  473. value:=_value;
  474. end;
  475. {****************************************************************************
  476. TAI_STRING
  477. ****************************************************************************}
  478. constructor tai_string.init(const _str : string);
  479. begin
  480. inherited init;
  481. typ:=ait_string;
  482. getmem(str,length(_str)+1);
  483. strpcopy(str,_str);
  484. len:=length(_str);
  485. end;
  486. constructor tai_string.init_pchar(_str : pchar);
  487. begin
  488. inherited init;
  489. typ:=ait_string;
  490. str:=_str;
  491. len:=strlen(_str);
  492. end;
  493. constructor tai_string.init_length_pchar(_str : pchar;length : longint);
  494. begin
  495. inherited init;
  496. typ:=ait_string;
  497. str:=_str;
  498. len:=length;
  499. end;
  500. destructor tai_string.done;
  501. begin
  502. { you can have #0 inside the strings so }
  503. if str<>nil then
  504. freemem(str,len+1);
  505. inherited done;
  506. end;
  507. {****************************************************************************
  508. TAI_LABEL
  509. ****************************************************************************}
  510. constructor tai_label.init(_l : pasmlabel);
  511. begin
  512. inherited init;
  513. typ:=ait_label;
  514. l:=_l;
  515. l^.is_set:=true;
  516. is_global:=(l^.typ=AS_GLOBAL);
  517. end;
  518. {****************************************************************************
  519. TAI_DIRECT
  520. ****************************************************************************}
  521. constructor tai_direct.init(_str : pchar);
  522. begin
  523. inherited init;
  524. typ:=ait_direct;
  525. str:=_str;
  526. end;
  527. destructor tai_direct.done;
  528. begin
  529. strdispose(str);
  530. inherited done;
  531. end;
  532. {****************************************************************************
  533. TAI_ASM_COMMENT comment to be inserted in the assembler file
  534. ****************************************************************************}
  535. constructor tai_asm_comment.init(_str : pchar);
  536. begin
  537. inherited init;
  538. typ:=ait_comment;
  539. str:=_str;
  540. end;
  541. destructor tai_asm_comment.done;
  542. begin
  543. strdispose(str);
  544. inherited done;
  545. end;
  546. {****************************************************************************
  547. TAI_ALIGN
  548. ****************************************************************************}
  549. constructor tai_align.init(b: byte);
  550. begin
  551. inherited init;
  552. typ:=ait_align;
  553. if b in [1,2,4,8,16] then
  554. aligntype := b
  555. else
  556. aligntype := 1;
  557. fillsize:=0;
  558. fillop:=0;
  559. use_op:=false;
  560. end;
  561. constructor tai_align.init_op(b: byte; _op: byte);
  562. begin
  563. inherited init;
  564. typ:=ait_align;
  565. if b in [1,2,4,8,16] then
  566. aligntype := b
  567. else
  568. aligntype := 1;
  569. fillsize:=0;
  570. fillop:=_op;
  571. use_op:=true;
  572. end;
  573. {****************************************************************************
  574. TAI_CUT
  575. ****************************************************************************}
  576. constructor tai_cut.init;
  577. begin
  578. inherited init;
  579. typ:=ait_cut;
  580. endname:=false;
  581. end;
  582. constructor tai_cut.init_end;
  583. begin
  584. inherited init;
  585. typ:=ait_cut;
  586. endname:=true;
  587. end;
  588. {****************************************************************************
  589. Tai_Marker
  590. ****************************************************************************}
  591. Constructor Tai_Marker.Init(_Kind: TMarker);
  592. Begin
  593. Inherited Init;
  594. typ := ait_marker;
  595. Kind := _Kind;
  596. End;
  597. {*****************************************************************************
  598. TaiTempAlloc
  599. *****************************************************************************}
  600. constructor taitempalloc.alloc(pos,size:longint);
  601. begin
  602. inherited init;
  603. typ:=ait_tempalloc;
  604. allocation:=true;
  605. temppos:=pos;
  606. tempsize:=size;
  607. end;
  608. constructor taitempalloc.dealloc(pos,size:longint);
  609. begin
  610. inherited init;
  611. typ:=ait_tempalloc;
  612. allocation:=false;
  613. temppos:=pos;
  614. tempsize:=size;
  615. end;
  616. {*****************************************************************************
  617. AsmSymbol
  618. *****************************************************************************}
  619. constructor tasmsymbol.init(const s:string;_typ:TAsmsymtype);
  620. begin;
  621. inherited initname(s);
  622. reset;
  623. typ:=_typ;
  624. end;
  625. procedure tasmsymbol.reset;
  626. begin
  627. section:=sec_none;
  628. address:=0;
  629. size:=0;
  630. idx:=-1;
  631. typ:=AS_EXTERNAL;
  632. { mainly used to remove unused labels from the codesegment }
  633. refs:=0;
  634. end;
  635. function tasmsymbol.is_used:boolean;
  636. begin
  637. is_used:=(refs>0);
  638. end;
  639. procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint);
  640. begin
  641. section:=sec;
  642. address:=offset;
  643. size:=len;
  644. end;
  645. {*****************************************************************************
  646. AsmLabel
  647. *****************************************************************************}
  648. constructor tasmlabel.init;
  649. begin;
  650. labelnr:=nextlabelnr;
  651. inc(nextlabelnr);
  652. inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
  653. is_set:=false;
  654. end;
  655. constructor tasmlabel.initdata;
  656. begin;
  657. labelnr:=nextlabelnr;
  658. inc(nextlabelnr);
  659. if (cs_smartlink in aktmoduleswitches) then
  660. inherited init('_$'+current_module^.modulename^+'$_L'+tostr(labelnr),AS_GLOBAL)
  661. else
  662. inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
  663. is_set:=false;
  664. { write it always }
  665. refs:=1;
  666. end;
  667. function tasmlabel.name:string;
  668. begin
  669. name:=inherited name;
  670. inc(refs);
  671. end;
  672. {*****************************************************************************
  673. AsmSymbolList helpers
  674. *****************************************************************************}
  675. function newasmsymbol(const s : string) : pasmsymbol;
  676. var
  677. hp : pasmsymbol;
  678. begin
  679. hp:=pasmsymbol(asmsymbollist^.search(s));
  680. if assigned(hp) then
  681. begin
  682. newasmsymbol:=hp;
  683. exit;
  684. end;
  685. { Not found, insert it as an External }
  686. hp:=new(pasmsymbol,init(s,AS_EXTERNAL));
  687. asmsymbollist^.insert(hp);
  688. newasmsymbol:=hp;
  689. end;
  690. function newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
  691. var
  692. hp : pasmsymbol;
  693. begin
  694. hp:=pasmsymbol(asmsymbollist^.search(s));
  695. if assigned(hp) then
  696. begin
  697. hp^.typ:=_typ;
  698. newasmsymboltyp:=hp;
  699. exit;
  700. end;
  701. { Not found, insert it as an External }
  702. hp:=new(pasmsymbol,init(s,_typ));
  703. asmsymbollist^.insert(hp);
  704. newasmsymboltyp:=hp;
  705. end;
  706. function getasmsymbol(const s : string) : pasmsymbol;
  707. begin
  708. getasmsymbol:=pasmsymbol(asmsymbollist^.search(s));
  709. end;
  710. { renames an asmsymbol }
  711. function renameasmsymbol(const sold, snew : string):pasmsymbol;
  712. {$ifdef nodictonaryrename}
  713. var
  714. hpold,hpnew : pasmsymbol;
  715. begin
  716. hpnew:=pasmsymbol(asmsymbollist^.search(snew));
  717. if assigned(hpnew) then
  718. internalerror(405405);
  719. hpold:=pasmsymbol(asmsymbollist^.search(sold));
  720. if not assigned(hpold) then
  721. internalerror(405406);
  722. hpnew:=new(pasmsymbol,init(sold));
  723. { replace the old one }
  724. { WARNING this heavily depends on the
  725. feature that tdictionnary.insert does not delete
  726. the tree element that it replaces !! }
  727. asmsymbollist^.replace_existing:=true;
  728. asmsymbollist^.insert(hpnew);
  729. asmsymbollist^.replace_existing:=false;
  730. { restore the tree }
  731. hpnew^.left:=hpold^.left;
  732. hpnew^.right:=hpold^.right;
  733. stringdispose(hpold^._name);
  734. hpold^._name:=stringdup(snew);
  735. hpold^.speedvalue:=getspeedvalue(snew);
  736. { now reinsert it at right location !! }
  737. asmsymbollist^.insert(hpold);
  738. renameasmsymbol:=hpold;
  739. end;
  740. {$else}
  741. begin
  742. renameasmsymbol:=pasmsymbol(asmsymbollist^.rename(sold,snew));
  743. end;
  744. {$endif}
  745. procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
  746. begin
  747. pasmsymbol(p)^.reset;
  748. end;
  749. procedure ResetAsmsymbolList;
  750. begin
  751. asmsymbollist^.foreach({$ifndef TP}@{$endif}resetasmsym);
  752. end;
  753. {*****************************************************************************
  754. Label Helpers
  755. *****************************************************************************}
  756. procedure getlabel(var l : pasmlabel);
  757. begin
  758. l:=new(pasmlabel,init);
  759. asmsymbollist^.insert(l);
  760. end;
  761. procedure getdatalabel(var l : pasmlabel);
  762. begin
  763. l:=new(pasmlabel,initdata);
  764. asmsymbollist^.insert(l);
  765. end;
  766. procedure freelabel(var l : pasmlabel);
  767. begin
  768. { nothing to do, the dispose of the asmsymbollist will do it }
  769. l:=nil;
  770. end;
  771. procedure getlabelnr(var l : longint);
  772. begin
  773. l:=nextlabelnr;
  774. inc(nextlabelnr);
  775. end;
  776. {*****************************************************************************
  777. TAAsmOutput
  778. *****************************************************************************}
  779. function taasmoutput.getlasttaifilepos : pfileposinfo;
  780. begin
  781. if assigned(last) then
  782. getlasttaifilepos:=@pai(last)^.fileinfo
  783. else
  784. getlasttaifilepos:=nil;
  785. end;
  786. end.
  787. {
  788. $Log$
  789. Revision 1.57 1999-08-02 21:01:41 michael
  790. * Moved toperand type back =(
  791. Revision 1.56 1999/08/02 20:45:47 michael
  792. * Moved toperand type to aasm
  793. Revision 1.55 1999/08/01 23:55:55 michael
  794. * Moved taitempalloc
  795. Revision 1.54 1999/07/29 20:53:55 peter
  796. * write .size also
  797. Revision 1.53 1999/07/22 09:37:28 florian
  798. + resourcestring implemented
  799. + start of longstring support
  800. Revision 1.52 1999/07/03 00:26:01 peter
  801. * ag386bin doesn't destroy the aasmoutput lists anymore
  802. Revision 1.51 1999/06/02 22:43:57 pierre
  803. * previous wrong log corrected
  804. Revision 1.50 1999/06/02 22:25:24 pierre
  805. * changed $ifdef FPC @ into $ifndef TP
  806. Revision 1.49 1999/06/01 14:45:41 peter
  807. * @procvar is now always needed for FPC
  808. Revision 1.48 1999/05/28 09:11:39 peter
  809. * also count ref when asmlabel^.name is used
  810. Revision 1.47 1999/05/27 19:43:55 peter
  811. * removed oldasm
  812. * plabel -> pasmlabel
  813. * -a switches to source writing automaticly
  814. * assembler readers OOPed
  815. * asmsymbol automaticly external
  816. * jumptables and other label fixes for asm readers
  817. Revision 1.46 1999/05/21 13:54:38 peter
  818. * NEWLAB for label as symbol
  819. Revision 1.45 1999/05/20 22:18:51 pierre
  820. * fix from Peter for double bug reported 20/05/1999
  821. Revision 1.44 1999/05/12 00:19:34 peter
  822. * removed R_DEFAULT_SEG
  823. * uniform float names
  824. Revision 1.43 1999/05/08 20:38:02 jonas
  825. * seperate OPTimizer INFO pointer field in tai object
  826. Revision 1.42 1999/05/06 09:05:05 peter
  827. * generic write_float and str_float
  828. * fixed constant float conversions
  829. Revision 1.41 1999/05/02 22:41:46 peter
  830. * moved section names to systems
  831. * fixed nasm,intel writer
  832. Revision 1.40 1999/04/21 09:43:28 peter
  833. * storenumber works
  834. * fixed some typos in double_checksum
  835. + incompatible types type1 and type2 message (with storenumber)
  836. Revision 1.39 1999/04/16 11:49:36 peter
  837. + tempalloc
  838. + -at to show temp alloc info in .s file
  839. Revision 1.38 1999/04/14 09:14:44 peter
  840. * first things to store the symbol/def number in the ppu
  841. Revision 1.37 1999/03/10 13:25:42 pierre
  842. section order changed to get closer output from coff writer
  843. Revision 1.36 1999/03/08 14:51:04 peter
  844. + smartlinking for ag386bin
  845. Revision 1.35 1999/03/05 13:09:48 peter
  846. * first things for tai_cut support for ag386bin
  847. Revision 1.34 1999/03/03 11:59:27 pierre
  848. + getasmsymbol to search for existing assembler symbol only
  849. Revision 1.33 1999/03/02 02:56:08 peter
  850. + stabs support for binary writers
  851. * more fixes and missing updates from the previous commit :(
  852. Revision 1.32 1999/03/01 13:31:59 pierre
  853. * external used before implemented problem fixed
  854. Revision 1.31 1999/02/25 21:02:16 peter
  855. * ag386bin updates
  856. + coff writer
  857. Revision 1.30 1999/02/17 10:16:24 peter
  858. * small fixes for the binary writer
  859. Revision 1.29 1998/12/29 18:48:24 jonas
  860. + optimize pascal code surrounding assembler blocks
  861. Revision 1.28 1998/12/16 00:27:16 peter
  862. * removed some obsolete version checks
  863. Revision 1.27 1998/12/11 00:02:37 peter
  864. + globtype,tokens,version unit splitted from globals
  865. Revision 1.26 1998/12/01 23:36:31 pierre
  866. * zero padded alignment was buggy
  867. Revision 1.25 1998/11/30 09:42:52 pierre
  868. * some range check bugs fixed (still not working !)
  869. + added DLL writing support for win32 (also accepts variables)
  870. + TempAnsi for code that could be used for Temporary ansi strings
  871. handling
  872. Revision 1.24 1998/11/12 11:19:30 pierre
  873. * fix for first line of function break
  874. Revision 1.23 1998/10/14 15:56:37 pierre
  875. * all references to comp suppressed for m68k
  876. Revision 1.22 1998/10/12 12:20:38 pierre
  877. + added tai_const_symbol_offset
  878. for r : pointer = @var.field;
  879. * better message for different arg names on implementation
  880. of function
  881. Revision 1.21 1998/10/08 17:17:07 pierre
  882. * current_module old scanner tagged as invalid if unit is recompiled
  883. + added ppheap for better info on tracegetmem of heaptrc
  884. (adds line column and file index)
  885. * several memory leaks removed ith help of heaptrc !!
  886. Revision 1.20 1998/10/06 17:16:31 pierre
  887. * some memory leaks fixed (thanks to Peter for heaptrc !)
  888. Revision 1.19 1998/10/01 20:19:11 jonas
  889. + ait_marker support
  890. Revision 1.18 1998/09/20 17:11:25 jonas
  891. * released REGALLOC
  892. Revision 1.17 1998/09/07 18:33:31 peter
  893. + smartlinking for win95 imports
  894. Revision 1.16 1998/09/03 17:08:37 pierre
  895. * better lines for stabs
  896. (no scroll back to if before else part
  897. no return to case line at jump outside case)
  898. + source lines also if not in order
  899. Revision 1.15 1998/08/11 15:31:36 peter
  900. * write extended to ppu file
  901. * new version 0.99.7
  902. Revision 1.14 1998/08/10 23:56:03 peter
  903. * fixed extended writing
  904. Revision 1.13 1998/08/10 14:49:33 peter
  905. + localswitches, moduleswitches, globalswitches splitting
  906. Revision 1.12 1998/07/14 14:46:36 peter
  907. * released NEWINPUT
  908. Revision 1.11 1998/07/07 11:19:50 peter
  909. + NEWINPUT for a better inputfile and scanner object
  910. Revision 1.10 1998/06/08 22:59:41 peter
  911. * smartlinking works for win32
  912. * some defines to exclude some compiler parts
  913. Revision 1.9 1998/06/04 23:51:26 peter
  914. * m68k compiles
  915. + .def file creation moved to gendef.pas so it could also be used
  916. for win32
  917. Revision 1.8 1998/05/23 01:20:53 peter
  918. + aktasmmode, aktoptprocessor, aktoutputformat
  919. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  920. + $LIBNAME to set the library name where the unit will be put in
  921. * splitted cgi386 a bit (codeseg to large for bp7)
  922. * nasm, tasm works again. nasm moved to ag386nsm.pas
  923. Revision 1.7 1998/05/07 00:16:59 peter
  924. * smartlinking for sets
  925. + consts labels are now concated/generated in hcodegen
  926. * moved some cpu code to cga and some none cpu depended code from cga
  927. to tree and hcodegen and cleanup of hcodegen
  928. * assembling .. output reduced for smartlinking ;)
  929. Revision 1.6 1998/05/06 18:36:53 peter
  930. * tai_section extended with code,data,bss sections and enumerated type
  931. * ident 'compiled by FPC' moved to pmodules
  932. * small fix for smartlink
  933. Revision 1.5 1998/05/01 07:43:52 florian
  934. + basics for rtti implemented
  935. + switch $m (generate rtti for published sections)
  936. Revision 1.4 1998/04/29 10:33:40 pierre
  937. + added some code for ansistring (not complete nor working yet)
  938. * corrected operator overloading
  939. * corrected nasm output
  940. + started inline procedures
  941. + added starstarn : use ** for exponentiation (^ gave problems)
  942. + started UseTokenInfo cond to get accurate positions
  943. Revision 1.3 1998/04/27 23:10:27 peter
  944. + new scanner
  945. * $makelib -> if smartlink
  946. * small filename fixes pmodule.setfilename
  947. * moved import from files.pas -> import.pas
  948. Revision 1.2 1998/04/09 15:46:37 florian
  949. + register allocation tracing stuff added
  950. }