aasm.pas 33 KB

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