2
0

aasm.pas 30 KB

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