aasm.pas 31 KB

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