aasm.pas 33 KB

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