aasm.pas 29 KB

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