aasm.pas 32 KB

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