aasm.pas 33 KB

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