rautils.pas 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
  4. This unit implements some support routines for assembler parsing
  5. independent of the processor
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. **********************************************************************}
  18. Unit RAUtils;
  19. {$i fpcdefs.inc}
  20. Interface
  21. Uses
  22. cutils,cclasses,
  23. globtype,aasmbase,aasmtai,cpubase,cpuinfo,
  24. symconst,symbase,symtype,symdef;
  25. Const
  26. RPNMax = 10; { I think you only need 4, but just to be safe }
  27. OpMax = 25;
  28. {---------------------------------------------------------------------
  29. Local Label Management
  30. ---------------------------------------------------------------------}
  31. Type
  32. { Each local label has this structure associated with it }
  33. TLocalLabel = class(TNamedIndexItem)
  34. Emitted : boolean;
  35. constructor Create(const n:string);
  36. function Gettasmlabel:tasmlabel;
  37. private
  38. lab : tasmlabel;
  39. end;
  40. TLocalLabelList = class(TDictionary)
  41. procedure CheckEmitted;
  42. end;
  43. var
  44. LocalLabelList : TLocalLabelList;
  45. function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean;
  46. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  47. {---------------------------------------------------------------------
  48. Instruction management
  49. ---------------------------------------------------------------------}
  50. type
  51. TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,
  52. OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
  53. TOprRec = record
  54. case typ:TOprType of
  55. OPR_NONE : ();
  56. OPR_CONSTANT : (val:longint);
  57. OPR_SYMBOL : (symbol:tasmsymbol;symofs:longint);
  58. OPR_REFERENCE : (ref:treference);
  59. OPR_REGISTER : (reg:tregister);
  60. {$ifdef m68k}
  61. OPR_REGLIST : (reglist:Tsupregset);
  62. {$else not m68k}
  63. OPR_REGLIST : ();
  64. {$endif m68k}
  65. end;
  66. TOperand = class
  67. size : topsize;
  68. hastype, { if the operand has typecasted variable }
  69. hasvar : boolean; { if the operand is loaded with a variable }
  70. opr : TOprRec;
  71. constructor create;
  72. destructor destroy;override;
  73. Procedure BuildOperand;virtual;
  74. Procedure SetSize(_size:longint;force:boolean);
  75. Procedure SetCorrectSize(opcode:tasmop);virtual;
  76. Function SetupResult:boolean;virtual;
  77. Function SetupSelf:boolean;
  78. Function SetupOldEBP:boolean;
  79. Function SetupVar(const s:string;GetOffset : boolean): Boolean;
  80. Function SetupDirectVar(const hs:string): Boolean;
  81. Procedure InitRef;
  82. end;
  83. TInstruction = class
  84. opcode : tasmop;
  85. opsize : topsize;
  86. condition : tasmcond;
  87. ops : byte;
  88. labeled : boolean;
  89. operands : array[1..max_operands] of toperand;
  90. constructor create;
  91. destructor destroy;override;
  92. Procedure InitOperands;virtual;
  93. Procedure BuildOpcode;virtual;
  94. procedure ConcatInstruction(p:TAAsmoutput);virtual;
  95. Procedure Swapoperands;
  96. end;
  97. {---------------------------------------------------------------------}
  98. { Expression parser types }
  99. {---------------------------------------------------------------------}
  100. TExprOperator = record
  101. ch: char; { operator }
  102. is_prefix: boolean; { was it a prefix, possible prefixes are +,- and not }
  103. end;
  104. String15 = String[15];
  105. {**********************************************************************}
  106. { The following operators are supported: }
  107. { '+' : addition }
  108. { '-' : subtraction }
  109. { '*' : multiplication }
  110. { '/' : modulo division }
  111. { '^' : exclusive or }
  112. { '<' : shift left }
  113. { '>' : shift right }
  114. { '&' : bitwise and }
  115. { '|' : bitwise or }
  116. { '~' : bitwise complement }
  117. { '%' : modulo division }
  118. { nnn: longint numbers }
  119. { ( and ) parenthesis }
  120. {**********************************************************************}
  121. TExprParse = class
  122. public
  123. Constructor create;
  124. Destructor Destroy;override;
  125. Function Evaluate(Expr: String): longint;
  126. Function Priority(_Operator: Char): longint;
  127. private
  128. RPNStack : Array[1..RPNMax] of longint; { Stack For RPN calculator }
  129. RPNTop : longint;
  130. OpStack : Array[1..OpMax] of TExprOperator; { Operator stack For conversion }
  131. OpTop : longint;
  132. Procedure RPNPush(Num: Longint);
  133. Function RPNPop: Longint;
  134. Procedure RPNCalc(token: String15; prefix: boolean);
  135. Procedure OpPush(_Operator: char; prefix: boolean);
  136. { In reality returns TExprOperaotr }
  137. Procedure OpPop(var _Operator:TExprOperator);
  138. end;
  139. { Evaluate an expression string to a longint }
  140. Function CalculateExpression(const expression: string): longint;
  141. {---------------------------------------------------------------------}
  142. { String routines }
  143. {---------------------------------------------------------------------}
  144. Function ValDecimal(const S:String):longint;
  145. Function ValOctal(const S:String):longint;
  146. Function ValBinary(const S:String):longint;
  147. Function ValHexaDecimal(const S:String):longint;
  148. Function PadZero(Var s: String; n: byte): Boolean;
  149. Function EscapeToPascal(const s:string): string;
  150. {---------------------------------------------------------------------
  151. Symbol helper routines
  152. ---------------------------------------------------------------------}
  153. procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:tsymtable);
  154. Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):boolean;
  155. Function SearchType(const hs:string): Boolean;
  156. Function SearchRecordType(const s:string): boolean;
  157. Function SearchIConstant(const s:string; var l:longint): boolean;
  158. {---------------------------------------------------------------------
  159. Instruction generation routines
  160. ---------------------------------------------------------------------}
  161. Procedure ConcatPasString(p : TAAsmoutput;s:string);
  162. Procedure ConcatDirect(p : TAAsmoutput;s:string);
  163. Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
  164. Procedure ConcatConstant(p : TAAsmoutput;value: longint; maxvalue: longint);
  165. Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
  166. Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
  167. Procedure ConcatString(p : TAAsmoutput;s:string);
  168. procedure ConcatAlign(p:TAAsmoutput;l:longint);
  169. Procedure ConcatPublic(p:TAAsmoutput;const s : string);
  170. Procedure ConcatLocal(p:TAAsmoutput;const s : string);
  171. Procedure ConcatGlobalBss(const s : string;size : longint);
  172. Procedure ConcatLocalBss(const s : string;size : longint);
  173. Implementation
  174. uses
  175. {$ifdef delphi}
  176. sysutils,
  177. {$else}
  178. strings,
  179. {$endif}
  180. defutil,systems,verbose,globals,
  181. symsym,symtable,paramgr,
  182. aasmcpu,
  183. cgbase;
  184. {*************************************************************************
  185. TExprParse
  186. *************************************************************************}
  187. Constructor TExprParse.create;
  188. Begin
  189. end;
  190. Procedure TExprParse.RPNPush(Num : longint);
  191. { Add an operand to the top of the RPN stack }
  192. begin
  193. if RPNTop < RPNMax then
  194. begin
  195. Inc(RPNTop);
  196. RPNStack[RPNTop]:=Num;
  197. end
  198. else
  199. Message(asmr_e_expr_illegal);
  200. end;
  201. Function TExprParse.RPNPop : longint;
  202. { Get the operand at the top of the RPN stack }
  203. begin
  204. if RPNTop > 0 then
  205. begin
  206. RPNPop:=RPNStack[RPNTop];
  207. Dec(RPNTop);
  208. end
  209. else
  210. Message(asmr_e_expr_illegal);
  211. end;
  212. Procedure TExprParse.RPNCalc(Token : String15; prefix:boolean); { RPN Calculator }
  213. Var
  214. Temp : longint;
  215. n1,n2 : longint;
  216. LocalError : Integer;
  217. begin
  218. { Handle operators }
  219. if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/','&','|','%','^','~','<','>']) then
  220. Case Token[1] of
  221. '+' :
  222. Begin
  223. if not prefix then
  224. RPNPush(RPNPop + RPNPop);
  225. end;
  226. '-' :
  227. Begin
  228. if prefix then
  229. RPNPush(-(RPNPop))
  230. else
  231. begin
  232. n1:=RPNPop;
  233. n2:=RPNPop;
  234. RPNPush(n2 - n1);
  235. end;
  236. end;
  237. '*' : RPNPush(RPNPop * RPNPop);
  238. '&' :
  239. begin
  240. n1:=RPNPop;
  241. n2:=RPNPop;
  242. RPNPush(n2 and n1);
  243. end;
  244. '|' :
  245. begin
  246. n1:=RPNPop;
  247. n2:=RPNPop;
  248. RPNPush(n2 or n1);
  249. end;
  250. '~' : RPNPush(NOT RPNPop);
  251. '<' :
  252. begin
  253. n1:=RPNPop;
  254. n2:=RPNPop;
  255. RPNPush(n2 SHL n1);
  256. end;
  257. '>' :
  258. begin
  259. n1:=RPNPop;
  260. n2:=RPNPop;
  261. RPNPush(n2 SHR n1);
  262. end;
  263. '%' :
  264. begin
  265. Temp:=RPNPop;
  266. if Temp <> 0 then
  267. RPNPush(RPNPop mod Temp)
  268. else
  269. begin
  270. Message(asmr_e_expr_zero_divide);
  271. { push 1 for error recovery }
  272. RPNPush(1);
  273. end;
  274. end;
  275. '^' : RPNPush(RPNPop XOR RPNPop);
  276. '/' :
  277. begin
  278. Temp:=RPNPop;
  279. if Temp <> 0 then
  280. RPNPush(RPNPop div Temp)
  281. else
  282. begin
  283. Message(asmr_e_expr_zero_divide);
  284. { push 1 for error recovery }
  285. RPNPush(1);
  286. end;
  287. end;
  288. end
  289. else
  290. begin
  291. { Convert String to number and add to stack }
  292. Val(Token, Temp, LocalError);
  293. if LocalError = 0 then
  294. RPNPush(Temp)
  295. else
  296. begin
  297. Message(asmr_e_expr_illegal);
  298. { push 1 for error recovery }
  299. RPNPush(1);
  300. end;
  301. end;
  302. end;
  303. Procedure TExprParse.OpPush(_Operator : char;prefix: boolean);
  304. { Add an operator onto top of the stack }
  305. begin
  306. if OpTop < OpMax then
  307. begin
  308. Inc(OpTop);
  309. OpStack[OpTop].ch:=_Operator;
  310. OpStack[OpTop].is_prefix:=prefix;
  311. end
  312. else
  313. Message(asmr_e_expr_illegal);
  314. end;
  315. Procedure TExprParse.OpPop(var _Operator:TExprOperator);
  316. { Get operator at the top of the stack }
  317. begin
  318. if OpTop > 0 then
  319. begin
  320. _Operator:=OpStack[OpTop];
  321. Dec(OpTop);
  322. end
  323. else
  324. Message(asmr_e_expr_illegal);
  325. end;
  326. Function TExprParse.Priority(_Operator : Char) : longint;
  327. { Return priority of operator }
  328. { The greater the priority, the higher the precedence }
  329. begin
  330. Case _Operator OF
  331. '(' :
  332. Priority:=0;
  333. '+', '-' :
  334. Priority:=1;
  335. '*', '/','%','<','>' :
  336. Priority:=2;
  337. '|','&','^','~' :
  338. Priority:=0;
  339. else
  340. Message(asmr_e_expr_illegal);
  341. end;
  342. end;
  343. Function TExprParse.Evaluate(Expr : String):longint;
  344. Var
  345. I : LongInt;
  346. Token : String15;
  347. opr : TExprOperator;
  348. begin
  349. Evaluate:=0;
  350. { Reset stacks }
  351. OpTop :=0;
  352. RPNTop:=0;
  353. Token :='';
  354. { nothing to do ? }
  355. if Expr='' then
  356. exit;
  357. For I:=1 to Length(Expr) DO
  358. begin
  359. if Expr[I] in ['0'..'9'] then
  360. begin { Build multi-digit numbers }
  361. Token:=Token + Expr[I];
  362. if I = Length(Expr) then { Send last one to calculator }
  363. RPNCalc(Token,false);
  364. end
  365. else
  366. if Expr[I] in ['+', '-', '*', '/', '(', ')','^','&','|','%','~','<','>'] then
  367. begin
  368. if Token <> '' then
  369. begin { Send last built number to calc. }
  370. RPNCalc(Token,false);
  371. Token:='';
  372. end;
  373. Case Expr[I] OF
  374. '(' : OpPush('(',false);
  375. ')' : begin
  376. While OpStack[OpTop].ch <> '(' DO
  377. Begin
  378. OpPop(opr);
  379. RPNCalc(opr.ch,opr.is_prefix);
  380. end;
  381. OpPop(opr); { Pop off and ignore the '(' }
  382. end;
  383. '+','-','~' : Begin
  384. { workaround for -2147483648 }
  385. if (expr[I]='-') and (expr[i+1] in ['0'..'9']) then
  386. begin
  387. token:='-';
  388. expr[i]:='+';
  389. end;
  390. { if start of expression then surely a prefix }
  391. { or if previous char was also an operator }
  392. if (I = 1) or (not (Expr[I-1] in ['0'..'9','(',')'])) then
  393. OpPush(Expr[I],true)
  394. else
  395. Begin
  396. { Evaluate all higher priority operators }
  397. While (OpTop > 0) AND (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
  398. Begin
  399. OpPop(opr);
  400. RPNCalc(opr.ch,opr.is_prefix);
  401. end;
  402. OpPush(Expr[I],false);
  403. End;
  404. end;
  405. '*', '/',
  406. '^','|','&',
  407. '%','<','>' : begin
  408. While (OpTop > 0) and (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
  409. Begin
  410. OpPop(opr);
  411. RPNCalc(opr.ch,opr.is_prefix);
  412. end;
  413. OpPush(Expr[I],false);
  414. end;
  415. end; { Case }
  416. end
  417. else
  418. Message(asmr_e_expr_illegal); { Handle bad input error }
  419. end;
  420. { Pop off the remaining operators }
  421. While OpTop > 0 do
  422. Begin
  423. OpPop(opr);
  424. RPNCalc(opr.ch,opr.is_prefix);
  425. end;
  426. { The result is stored on the top of the stack }
  427. Evaluate:=RPNPop;
  428. end;
  429. Destructor TExprParse.Destroy;
  430. Begin
  431. end;
  432. Function CalculateExpression(const expression: string): longint;
  433. var
  434. expr: TExprParse;
  435. Begin
  436. expr:=TExprParse.create;
  437. CalculateExpression:=expr.Evaluate(expression);
  438. expr.Free;
  439. end;
  440. {*************************************************************************}
  441. { String conversions/utils }
  442. {*************************************************************************}
  443. Function EscapeToPascal(const s:string): string;
  444. { converts a C styled string - which contains escape }
  445. { characters to a pascal style string. }
  446. var
  447. i,len : longint;
  448. hs : string;
  449. temp : string;
  450. c : char;
  451. Begin
  452. hs:='';
  453. len:=0;
  454. i:=0;
  455. while (i<length(s)) and (len<255) do
  456. begin
  457. Inc(i);
  458. if (s[i]='\') and (i<length(s)) then
  459. Begin
  460. inc(i);
  461. case s[i] of
  462. '\' :
  463. c:='\';
  464. 'b':
  465. c:=#8;
  466. 'f':
  467. c:=#12;
  468. 'n':
  469. c:=#10;
  470. 'r':
  471. c:=#13;
  472. 't':
  473. c:=#9;
  474. '"':
  475. c:='"';
  476. '0'..'7':
  477. Begin
  478. temp:=s[i];
  479. temp:=temp+s[i+1];
  480. temp:=temp+s[i+2];
  481. inc(i,2);
  482. c:=chr(ValOctal(temp));
  483. end;
  484. 'x':
  485. Begin
  486. temp:=s[i+1];
  487. temp:=temp+s[i+2];
  488. inc(i,2);
  489. c:=chr(ValHexaDecimal(temp));
  490. end;
  491. else
  492. Begin
  493. Message1(asmr_e_escape_seq_ignored,s[i]);
  494. c:=s[i];
  495. end;
  496. end;
  497. end
  498. else
  499. c:=s[i];
  500. inc(len);
  501. hs[len]:=c;
  502. end;
  503. hs[0]:=chr(len);
  504. EscapeToPascal:=hs;
  505. end;
  506. Function ValDecimal(const S:String):longint;
  507. { Converts a decimal string to longint }
  508. var
  509. vs,c : longint;
  510. Begin
  511. vs:=0;
  512. for c:=1 to length(s) do
  513. begin
  514. vs:=vs*10;
  515. if s[c] in ['0'..'9'] then
  516. inc(vs,ord(s[c])-ord('0'))
  517. else
  518. begin
  519. Message1(asmr_e_error_converting_decimal,s);
  520. ValDecimal:=0;
  521. exit;
  522. end;
  523. end;
  524. ValDecimal:=vs;
  525. end;
  526. Function ValOctal(const S:String):longint;
  527. { Converts an octal string to longint }
  528. var
  529. vs,c : longint;
  530. Begin
  531. vs:=0;
  532. for c:=1 to length(s) do
  533. begin
  534. vs:=vs shl 3;
  535. if s[c] in ['0'..'7'] then
  536. inc(vs,ord(s[c])-ord('0'))
  537. else
  538. begin
  539. Message1(asmr_e_error_converting_octal,s);
  540. ValOctal:=0;
  541. exit;
  542. end;
  543. end;
  544. ValOctal:=vs;
  545. end;
  546. Function ValBinary(const S:String):longint;
  547. { Converts a binary string to longint }
  548. var
  549. vs,c : longint;
  550. Begin
  551. vs:=0;
  552. for c:=1 to length(s) do
  553. begin
  554. vs:=vs shl 1;
  555. if s[c] in ['0'..'1'] then
  556. inc(vs,ord(s[c])-ord('0'))
  557. else
  558. begin
  559. Message1(asmr_e_error_converting_binary,s);
  560. ValBinary:=0;
  561. exit;
  562. end;
  563. end;
  564. ValBinary:=vs;
  565. end;
  566. Function ValHexadecimal(const S:String):longint;
  567. { Converts a binary string to longint }
  568. var
  569. vs,c : longint;
  570. Begin
  571. vs:=0;
  572. for c:=1 to length(s) do
  573. begin
  574. vs:=vs shl 4;
  575. case s[c] of
  576. '0'..'9' :
  577. inc(vs,ord(s[c])-ord('0'));
  578. 'A'..'F' :
  579. inc(vs,ord(s[c])-ord('A')+10);
  580. 'a'..'f' :
  581. inc(vs,ord(s[c])-ord('a')+10);
  582. else
  583. begin
  584. Message1(asmr_e_error_converting_hexadecimal,s);
  585. ValHexadecimal:=0;
  586. exit;
  587. end;
  588. end;
  589. end;
  590. ValHexadecimal:=vs;
  591. end;
  592. Function PadZero(Var s: String; n: byte): Boolean;
  593. Begin
  594. PadZero:=TRUE;
  595. { Do some error checking first }
  596. if Length(s) = n then
  597. exit
  598. else
  599. if Length(s) > n then
  600. Begin
  601. PadZero:=FALSE;
  602. delete(s,n+1,length(s));
  603. exit;
  604. end
  605. else
  606. PadZero:=TRUE;
  607. { Fill it up with the specified character }
  608. fillchar(s[length(s)+1],n-1,#0);
  609. s[0]:=chr(n);
  610. end;
  611. {****************************************************************************
  612. TOperand
  613. ****************************************************************************}
  614. constructor TOperand.Create;
  615. begin
  616. size:=S_NO;
  617. hastype:=false;
  618. hasvar:=false;
  619. FillChar(Opr,sizeof(Opr),0);
  620. end;
  621. destructor TOperand.destroy;
  622. begin
  623. end;
  624. Procedure TOperand.SetCorrectSize(opcode:tasmop);
  625. begin
  626. end;
  627. Procedure TOperand.SetSize(_size:longint;force:boolean);
  628. begin
  629. if force or
  630. ((size = S_NO) and (_size<=extended_size)) then
  631. Begin
  632. case _size of
  633. 1 : size:=S_B;
  634. 2 : size:=S_W{ could be S_IS};
  635. 4 : size:=S_L{ could be S_IL or S_FS};
  636. 8 : size:=S_IQ{ could be S_D or S_FL};
  637. else
  638. begin
  639. { extended_size can also be 8, resulting in a
  640. duplicate label }
  641. if _size=extended_size then
  642. size:=S_FX;
  643. end;
  644. end;
  645. end;
  646. end;
  647. Function TOperand.SetupResult:boolean;
  648. Begin
  649. SetupResult:=false;
  650. { replace by correct offset. }
  651. if (not is_void(aktprocdef.rettype.def)) then
  652. begin
  653. if (m_tp7 in aktmodeswitches) and
  654. paramanager.ret_in_reg(aktprocdef.rettype.def,aktprocdef.proccalloption) then
  655. begin
  656. Message(asmr_e_cannot_use_RESULT_here);
  657. exit;
  658. end;
  659. opr.ref.offset:=procinfo.return_offset;
  660. opr.ref.base:= procinfo.framepointer;
  661. opr.ref.options:=ref_parafixup;
  662. { always assume that the result is valid. }
  663. tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
  664. { increase reference count, this is also used to check
  665. if the result variable is actually used or not }
  666. inc(tfuncretsym(aktprocdef.funcretsym).refcount);
  667. SetupResult:=true;
  668. end
  669. else
  670. Message(asmr_e_void_function);
  671. end;
  672. Function TOperand.SetupSelf:boolean;
  673. Begin
  674. SetupSelf:=false;
  675. if assigned(procinfo._class) then
  676. Begin
  677. opr.typ:=OPR_REFERENCE;
  678. opr.ref.offset:=procinfo.selfpointer_offset;
  679. opr.ref.base:=procinfo.framepointer;
  680. opr.ref.options:=ref_selffixup;
  681. SetupSelf:=true;
  682. end
  683. else
  684. Message(asmr_e_cannot_use_SELF_outside_a_method);
  685. end;
  686. Function TOperand.SetupOldEBP:boolean;
  687. Begin
  688. SetupOldEBP:=false;
  689. if lexlevel>normal_function_level then
  690. Begin
  691. opr.typ:=OPR_REFERENCE;
  692. opr.ref.offset:=procinfo.framepointer_offset;
  693. opr.ref.base:=procinfo.framepointer;
  694. opr.ref.options:=ref_parafixup;
  695. SetupOldEBP:=true;
  696. end
  697. else
  698. Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
  699. end;
  700. Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean;
  701. { search and sets up the correct fields in the Instr record }
  702. { for the NON-constant identifier passed to the routine. }
  703. { if not found returns FALSE. }
  704. var
  705. sym : tsym;
  706. srsymtable : tsymtable;
  707. harrdef : tarraydef;
  708. l : longint;
  709. Begin
  710. SetupVar:=false;
  711. asmsearchsym(s,sym,srsymtable);
  712. if sym = nil then
  713. exit;
  714. case sym.typ of
  715. varsym :
  716. begin
  717. { we always assume in asm statements that }
  718. { that the variable is valid. }
  719. tvarsym(sym).varstate:=vs_used;
  720. inc(tvarsym(sym).refs);
  721. case tvarsym(sym).owner.symtabletype of
  722. objectsymtable :
  723. begin
  724. { this is not allowed, because we don't know if the self
  725. register is still free, and loading it first is also
  726. not possible, because this could break code }
  727. { Be TP/Delphi compatible in Delphi or TP modes }
  728. if (m_tp7 in aktmodeswitches) or
  729. (m_delphi in aktmodeswitches) then
  730. begin
  731. opr.typ:=OPR_CONSTANT;
  732. opr.val:=tvarsym(sym).address;
  733. end
  734. { I do not agree here people using method vars should ensure
  735. that %esi is valid there }
  736. else
  737. begin
  738. opr.ref.base.enum:=R_INTREGISTER;
  739. opr.ref.base.number:=NR_SELF_POINTER_REG;
  740. opr.ref.offset:=tvarsym(sym).address;
  741. end;
  742. hasvar:=true;
  743. SetupVar:=true;
  744. Exit;
  745. end;
  746. globalsymtable,
  747. staticsymtable :
  748. opr.ref.symbol:=objectlibrary.newasmsymbol(tvarsym(sym).mangledname);
  749. parasymtable :
  750. begin
  751. { if we only want the offset we don't have to care
  752. the base will be zeroed after ! }
  753. if (lexlevel=tvarsym(sym).owner.symtablelevel) or
  754. { this below is wrong because there are two parast
  755. for global functions one of interface the second of
  756. implementation
  757. if (tvarsym(sym).owner=procinfo.def.parast) or }
  758. GetOffset then
  759. begin
  760. opr.ref.base:=procinfo.framepointer;
  761. end
  762. else
  763. begin
  764. if (aktprocdef.localst.datasize=0) and
  765. assigned(procinfo.parent) and
  766. (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
  767. { same problem as above !!
  768. (procinfo.parent^.sym.definition.parast=tvarsym(sym).owner) and }
  769. (lexlevel>normal_function_level) then
  770. opr.ref.base:=procinfo.parent.framepointer
  771. else
  772. message1(asmr_e_local_para_unreachable,s);
  773. end;
  774. opr.ref.offset:=tvarsym(sym).address;
  775. if (lexlevel=tvarsym(sym).owner.symtablelevel) then
  776. begin
  777. opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
  778. opr.ref.options:=ref_parafixup;
  779. end
  780. else
  781. begin
  782. opr.ref.offsetfixup:=0;
  783. opr.ref.options:=ref_none;
  784. end;
  785. if (tvarsym(sym).varspez=vs_var) or
  786. ((tvarsym(sym).varspez=vs_const) and
  787. paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
  788. SetSize(pointer_size,false);
  789. end;
  790. localsymtable :
  791. begin
  792. if (vo_is_external in tvarsym(sym).varoptions) then
  793. opr.ref.symbol:=objectlibrary.newasmsymbol(tvarsym(sym).mangledname)
  794. else
  795. begin
  796. { if we only want the offset we don't have to care
  797. the base will be zeroed after ! }
  798. if (lexlevel=tvarsym(sym).owner.symtablelevel) or
  799. {if (tvarsym(sym).owner=procinfo.def.localst) or}
  800. GetOffset then
  801. opr.ref.base:=procinfo.framepointer
  802. else
  803. begin
  804. if (aktprocdef.localst.datasize=0) and
  805. assigned(procinfo.parent) and
  806. (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
  807. {(procinfo.parent^.sym.definition.localst=tvarsym(sym).owner) and}
  808. (lexlevel>normal_function_level) then
  809. opr.ref.base:=procinfo.parent.framepointer
  810. else
  811. message1(asmr_e_local_para_unreachable,s);
  812. end;
  813. opr.ref.offset:=-(tvarsym(sym).address);
  814. if (lexlevel=tvarsym(sym).owner.symtablelevel) then
  815. begin
  816. opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
  817. opr.ref.options:=ref_localfixup;
  818. end
  819. else
  820. begin
  821. opr.ref.offsetfixup:=0;
  822. opr.ref.options:=ref_none;
  823. end;
  824. end;
  825. if (tvarsym(sym).varspez in [vs_var,vs_out]) or
  826. ((tvarsym(sym).varspez=vs_const) and
  827. paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
  828. SetSize(pointer_size,false);
  829. end;
  830. end;
  831. case tvarsym(sym).vartype.def.deftype of
  832. orddef,
  833. enumdef,
  834. pointerdef,
  835. floatdef :
  836. SetSize(tvarsym(sym).getsize,false);
  837. arraydef :
  838. begin
  839. { for arrays try to get the element size, take care of
  840. multiple indexes }
  841. harrdef:=tarraydef(tvarsym(sym).vartype.def);
  842. while assigned(harrdef.elementtype.def) and
  843. (harrdef.elementtype.def.deftype=arraydef) do
  844. harrdef:=tarraydef(harrdef.elementtype.def);
  845. SetSize(harrdef.elesize,false);
  846. end;
  847. end;
  848. hasvar:=true;
  849. SetupVar:=true;
  850. Exit;
  851. end;
  852. typedconstsym :
  853. begin
  854. opr.ref.symbol:=objectlibrary.newasmsymbol(ttypedconstsym(sym).mangledname);
  855. case ttypedconstsym(sym).typedconsttype.def.deftype of
  856. orddef,
  857. enumdef,
  858. pointerdef,
  859. floatdef :
  860. SetSize(ttypedconstsym(sym).getsize,false);
  861. arraydef :
  862. begin
  863. { for arrays try to get the element size, take care of
  864. multiple indexes }
  865. harrdef:=tarraydef(ttypedconstsym(sym).typedconsttype.def);
  866. while assigned(harrdef.elementtype.def) and
  867. (harrdef.elementtype.def.deftype=arraydef) do
  868. harrdef:=tarraydef(harrdef.elementtype.def);
  869. SetSize(harrdef.elesize,false);
  870. end;
  871. end;
  872. hasvar:=true;
  873. SetupVar:=true;
  874. Exit;
  875. end;
  876. constsym :
  877. begin
  878. if tconstsym(sym).consttyp in [constint,constchar,constbool] then
  879. begin
  880. opr.typ:=OPR_CONSTANT;
  881. opr.val:=tconstsym(sym).value.valueord;
  882. SetupVar:=true;
  883. Exit;
  884. end;
  885. end;
  886. typesym :
  887. begin
  888. if ttypesym(sym).restype.def.deftype in [recorddef,objectdef] then
  889. begin
  890. opr.typ:=OPR_CONSTANT;
  891. opr.val:=0;
  892. SetupVar:=TRUE;
  893. Exit;
  894. end;
  895. end;
  896. procsym :
  897. begin
  898. if Tprocsym(sym).procdef_count>1 then
  899. Message(asmr_w_calling_overload_func);
  900. l:=opr.ref.offset;
  901. opr.typ:=OPR_SYMBOL;
  902. opr.symbol:=objectlibrary.newasmsymbol(tprocsym(sym).first_procdef.mangledname);
  903. opr.symofs:=l;
  904. hasvar:=true;
  905. SetupVar:=TRUE;
  906. Exit;
  907. end;
  908. else
  909. begin
  910. Message(asmr_e_unsupported_symbol_type);
  911. exit;
  912. end;
  913. end;
  914. end;
  915. { looks for internal names of variables and routines }
  916. Function TOperand.SetupDirectVar(const hs:string): Boolean;
  917. var
  918. p : tasmsymbol;
  919. begin
  920. SetupDirectVar:=false;
  921. p:=objectlibrary.getasmsymbol(hs);
  922. if assigned(p) then
  923. begin
  924. opr.ref.symbol:=p;
  925. hasvar:=true;
  926. SetupDirectVar:=true;
  927. end;
  928. end;
  929. procedure TOperand.InitRef;
  930. {*********************************************************************}
  931. { Description: This routine first check if the opcode is of }
  932. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  933. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  934. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  935. { to point to the default segment. }
  936. {*********************************************************************}
  937. Begin
  938. case opr.typ of
  939. OPR_REFERENCE:
  940. exit;
  941. OPR_NONE: ;
  942. else
  943. Message(asmr_e_invalid_operand_type);
  944. end;
  945. opr.typ := OPR_REFERENCE;
  946. Fillchar(opr.ref,sizeof(treference),0);
  947. {$ifdef i386}
  948. opr.ref.segment.enum:=R_INTREGISTER;
  949. {$endif}
  950. opr.ref.index.enum:=R_INTREGISTER;
  951. opr.ref.base.enum:=R_INTREGISTER;
  952. end;
  953. procedure TOperand.BuildOperand;
  954. begin
  955. abstract;
  956. end;
  957. {****************************************************************************
  958. TInstruction
  959. ****************************************************************************}
  960. constructor TInstruction.create;
  961. Begin
  962. Opcode:=A_NONE;
  963. Opsize:=S_NO;
  964. Condition:=C_NONE;
  965. Ops:=0;
  966. InitOperands;
  967. Labeled:=false;
  968. end;
  969. destructor TInstruction.destroy;
  970. var
  971. i : longint;
  972. Begin
  973. for i:=1 to 3 do
  974. Operands[i].free;
  975. end;
  976. procedure TInstruction.InitOperands;
  977. var
  978. i : longint;
  979. begin
  980. for i:=1 to 3 do
  981. Operands[i].create;
  982. end;
  983. Procedure TInstruction.Swapoperands;
  984. Var
  985. p : toperand;
  986. Begin
  987. case Ops of
  988. 2 :
  989. begin
  990. p:=Operands[1];
  991. Operands[1]:=Operands[2];
  992. Operands[2]:=p;
  993. end;
  994. 3 :
  995. begin
  996. p:=Operands[1];
  997. Operands[1]:=Operands[3];
  998. Operands[3]:=p;
  999. end;
  1000. end;
  1001. end;
  1002. procedure TInstruction.ConcatInstruction(p:TAAsmOutput);
  1003. begin
  1004. abstract;
  1005. end;
  1006. procedure TInstruction.BuildOpcode;
  1007. begin
  1008. abstract;
  1009. end;
  1010. {***************************************************************************
  1011. TLocalLabel
  1012. ***************************************************************************}
  1013. constructor TLocalLabel.create(const n:string);
  1014. begin
  1015. inherited CreateName(n);
  1016. lab:=nil;
  1017. emitted:=false;
  1018. end;
  1019. function TLocalLabel.Gettasmlabel:tasmlabel;
  1020. begin
  1021. if not assigned(lab) then
  1022. begin
  1023. objectlibrary.getlabel(lab);
  1024. { this label is forced to be used so it's always written }
  1025. lab.increfs;
  1026. end;
  1027. Gettasmlabel:=lab;
  1028. end;
  1029. {***************************************************************************
  1030. TLocalLabelList
  1031. ***************************************************************************}
  1032. procedure LocalLabelEmitted(p:tnamedindexitem;arg:pointer);
  1033. begin
  1034. if not TLocalLabel(p).emitted then
  1035. Message1(asmr_e_unknown_label_identifier,p.name);
  1036. end;
  1037. procedure TLocalLabelList.CheckEmitted;
  1038. begin
  1039. ForEach_Static({$ifdef FPCPROCVAR}@{$endif}LocalLabelEmitted,nil)
  1040. end;
  1041. function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean;
  1042. var
  1043. lab : TLocalLabel;
  1044. Begin
  1045. CreateLocalLabel:=true;
  1046. { Check if it already is defined }
  1047. lab:=TLocalLabel(LocalLabellist.Search(s));
  1048. if not assigned(lab) then
  1049. begin
  1050. lab:=TLocalLabel.Create(s);
  1051. LocalLabellist.Insert(lab);
  1052. end;
  1053. { set emitted flag and check for dup syms }
  1054. if emit then
  1055. begin
  1056. if lab.Emitted then
  1057. begin
  1058. Message1(asmr_e_dup_local_sym,lab.Name);
  1059. CreateLocalLabel:=false;
  1060. end;
  1061. lab.Emitted:=true;
  1062. end;
  1063. hl:=lab.Gettasmlabel;
  1064. end;
  1065. {****************************************************************************
  1066. Symbol table helper routines
  1067. ****************************************************************************}
  1068. procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:tsymtable);
  1069. var
  1070. i : integer;
  1071. begin
  1072. i:=pos('.',s);
  1073. { allow unit.identifier }
  1074. if i>0 then
  1075. begin
  1076. searchsym(Copy(s,1,i-1),srsym,srsymtable);
  1077. if assigned(srsym) then
  1078. begin
  1079. if (srsym.typ=unitsym) and
  1080. (srsym.owner.unitid=0) then
  1081. srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,Copy(s,i+1,255))
  1082. else
  1083. srsym:=nil;
  1084. end;
  1085. end
  1086. else
  1087. searchsym(s,srsym,srsymtable);
  1088. end;
  1089. Function SearchType(const hs:string): Boolean;
  1090. var
  1091. srsym : tsym;
  1092. srsymtable : tsymtable;
  1093. begin
  1094. asmsearchsym(hs,srsym,srsymtable);
  1095. SearchType:=assigned(srsym) and
  1096. (srsym.typ=typesym);
  1097. end;
  1098. Function SearchRecordType(const s:string): boolean;
  1099. var
  1100. srsym : tsym;
  1101. srsymtable : tsymtable;
  1102. Begin
  1103. SearchRecordType:=false;
  1104. { Check the constants in symtable }
  1105. asmsearchsym(s,srsym,srsymtable);
  1106. if srsym <> nil then
  1107. Begin
  1108. case srsym.typ of
  1109. typesym :
  1110. begin
  1111. if ttypesym(srsym).restype.def.deftype in [recorddef,objectdef] then
  1112. begin
  1113. SearchRecordType:=true;
  1114. exit;
  1115. end;
  1116. end;
  1117. end;
  1118. end;
  1119. end;
  1120. Function SearchIConstant(const s:string; var l:longint): boolean;
  1121. {**********************************************************************}
  1122. { Description: Searches for a CONSTANT of name s in either the local }
  1123. { symbol list, then in the global symbol list, and returns the value }
  1124. { of that constant in l. Returns TRUE if successfull, if not found, }
  1125. { or if the constant is not of correct type, then returns FALSE }
  1126. { Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
  1127. { respectively. }
  1128. {**********************************************************************}
  1129. var
  1130. srsym : tsym;
  1131. srsymtable : tsymtable;
  1132. Begin
  1133. SearchIConstant:=false;
  1134. { check for TRUE or FALSE reserved words first }
  1135. if s = 'TRUE' then
  1136. Begin
  1137. SearchIConstant:=TRUE;
  1138. l:=1;
  1139. exit;
  1140. end;
  1141. if s = 'FALSE' then
  1142. Begin
  1143. SearchIConstant:=TRUE;
  1144. l:=0;
  1145. exit;
  1146. end;
  1147. { Check the constants in symtable }
  1148. asmsearchsym(s,srsym,srsymtable);
  1149. if srsym <> nil then
  1150. Begin
  1151. case srsym.typ of
  1152. constsym :
  1153. begin
  1154. if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
  1155. Begin
  1156. l:=tconstsym(srsym).value.valueord;
  1157. SearchIConstant:=TRUE;
  1158. exit;
  1159. end;
  1160. end;
  1161. enumsym:
  1162. Begin
  1163. l:=tenumsym(srsym).value;
  1164. SearchIConstant:=TRUE;
  1165. exit;
  1166. end;
  1167. end;
  1168. end;
  1169. end;
  1170. Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):boolean;
  1171. { search and returns the offset and size of records/objects of the base }
  1172. { with field name setup in field. }
  1173. { returns FALSE if not found. }
  1174. { used when base is a variable or a typed constant name. }
  1175. var
  1176. st : tsymtable;
  1177. harrdef : tarraydef;
  1178. sym : tsym;
  1179. srsymtable : tsymtable;
  1180. i : longint;
  1181. base : string;
  1182. Begin
  1183. GetRecordOffsetSize:=FALSE;
  1184. Offset:=0;
  1185. Size:=0;
  1186. i:=pos('.',s);
  1187. if i=0 then
  1188. i:=255;
  1189. base:=Copy(s,1,i-1);
  1190. delete(s,1,i);
  1191. if base='SELF' then
  1192. st:=procinfo._class.symtable
  1193. else
  1194. begin
  1195. asmsearchsym(base,sym,srsymtable);
  1196. st:=nil;
  1197. { we can start with a var,type,typedconst }
  1198. case sym.typ of
  1199. varsym :
  1200. begin
  1201. case tvarsym(sym).vartype.def.deftype of
  1202. recorddef :
  1203. st:=trecorddef(tvarsym(sym).vartype.def).symtable;
  1204. objectdef :
  1205. st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
  1206. end;
  1207. end;
  1208. typesym :
  1209. begin
  1210. case ttypesym(sym).restype.def.deftype of
  1211. recorddef :
  1212. st:=trecorddef(ttypesym(sym).restype.def).symtable;
  1213. objectdef :
  1214. st:=tobjectdef(ttypesym(sym).restype.def).symtable;
  1215. end;
  1216. end;
  1217. typedconstsym :
  1218. begin
  1219. case ttypedconstsym(sym).typedconsttype.def.deftype of
  1220. recorddef :
  1221. st:=trecorddef(ttypedconstsym(sym).typedconsttype.def).symtable;
  1222. objectdef :
  1223. st:=tobjectdef(ttypedconstsym(sym).typedconsttype.def).symtable;
  1224. end;
  1225. end;
  1226. end;
  1227. end;
  1228. { now walk all recordsymtables }
  1229. while assigned(st) and (s<>'') do
  1230. begin
  1231. { load next field in base }
  1232. i:=pos('.',s);
  1233. if i=0 then
  1234. i:=255;
  1235. base:=Copy(s,1,i-1);
  1236. delete(s,1,i);
  1237. if st.symtabletype=objectsymtable then
  1238. sym:=search_class_member(tobjectdef(st.defowner),base)
  1239. else
  1240. sym:=tsym(st.search(base));
  1241. if not assigned(sym) then
  1242. begin
  1243. GetRecordOffsetSize:=false;
  1244. exit;
  1245. end;
  1246. st:=nil;
  1247. case sym.typ of
  1248. varsym :
  1249. begin
  1250. inc(Offset,tvarsym(sym).address);
  1251. Size:=tvarsym(sym).getsize;
  1252. case tvarsym(sym).vartype.def.deftype of
  1253. arraydef :
  1254. begin
  1255. { for arrays try to get the element size, take care of
  1256. multiple indexes }
  1257. harrdef:=tarraydef(tvarsym(sym).vartype.def);
  1258. while assigned(harrdef.elementtype.def) and
  1259. (harrdef.elementtype.def.deftype=arraydef) do
  1260. harrdef:=tarraydef(harrdef.elementtype.def);
  1261. size:=harrdef.elesize;
  1262. end;
  1263. recorddef :
  1264. st:=trecorddef(tvarsym(sym).vartype.def).symtable;
  1265. objectdef :
  1266. st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
  1267. end;
  1268. end;
  1269. end;
  1270. end;
  1271. GetRecordOffsetSize:=(s='');
  1272. end;
  1273. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  1274. var
  1275. sym : tsym;
  1276. srsymtable : tsymtable;
  1277. hs : string;
  1278. Begin
  1279. hl:=nil;
  1280. SearchLabel:=false;
  1281. { Check for pascal labels, which are case insensetive }
  1282. hs:=upper(s);
  1283. asmsearchsym(hs,sym,srsymtable);
  1284. if sym=nil then
  1285. exit;
  1286. case sym.typ of
  1287. labelsym :
  1288. begin
  1289. hl:=tlabelsym(sym).lab;
  1290. if emit then
  1291. tlabelsym(sym).defined:=true
  1292. else
  1293. tlabelsym(sym).used:=true;
  1294. SearchLabel:=true;
  1295. exit;
  1296. end;
  1297. end;
  1298. end;
  1299. {*************************************************************************}
  1300. { Instruction Generation Utilities }
  1301. {*************************************************************************}
  1302. Procedure ConcatString(p : TAAsmoutput;s:string);
  1303. {*********************************************************************}
  1304. { PROCEDURE ConcatString(s:string); }
  1305. { Description: This routine adds the character chain pointed to in }
  1306. { s to the instruction linked list. }
  1307. {*********************************************************************}
  1308. Var
  1309. pc: PChar;
  1310. Begin
  1311. getmem(pc,length(s)+1);
  1312. p.concat(Tai_string.Create_length_pchar(strpcopy(pc,s),length(s)));
  1313. end;
  1314. Procedure ConcatPasString(p : TAAsmoutput;s:string);
  1315. {*********************************************************************}
  1316. { PROCEDURE ConcatPasString(s:string); }
  1317. { Description: This routine adds the character chain pointed to in }
  1318. { s to the instruction linked list, contrary to ConcatString it }
  1319. { uses a pascal style string, so it conserves null characters. }
  1320. {*********************************************************************}
  1321. Begin
  1322. p.concat(Tai_string.Create(s));
  1323. end;
  1324. Procedure ConcatDirect(p : TAAsmoutput;s:string);
  1325. {*********************************************************************}
  1326. { PROCEDURE ConcatDirect(s:string) }
  1327. { Description: This routine output the string directly to the asm }
  1328. { output, it is only sed when writing special labels in AT&T mode, }
  1329. { and should not be used without due consideration, since it may }
  1330. { cause problems. }
  1331. {*********************************************************************}
  1332. Var
  1333. pc: PChar;
  1334. Begin
  1335. getmem(pc,length(s)+1);
  1336. p.concat(Tai_direct.Create(strpcopy(pc,s)));
  1337. end;
  1338. Procedure ConcatConstant(p: TAAsmoutput; value: longint; maxvalue: longint);
  1339. {*********************************************************************}
  1340. { PROCEDURE ConcatConstant(value: longint; maxvalue: longint); }
  1341. { Description: This routine adds the value constant to the current }
  1342. { instruction linked list. }
  1343. { maxvalue -> indicates the size of the data to initialize: }
  1344. { $ff -> create a byte node. }
  1345. { $ffff -> create a word node. }
  1346. { $ffffffff -> create a dword node. }
  1347. {*********************************************************************}
  1348. Begin
  1349. if (maxvalue <> longint($ffffffff)) and (value > maxvalue) then
  1350. Begin
  1351. Message(asmr_e_constant_out_of_bounds);
  1352. { assuming a value of maxvalue }
  1353. value:=maxvalue;
  1354. end;
  1355. if maxvalue = $ff then
  1356. p.concat(Tai_const.Create_8bit(byte(value)))
  1357. else
  1358. if maxvalue = $ffff then
  1359. p.concat(Tai_const.Create_16bit(word(value)))
  1360. else
  1361. if maxvalue = longint($ffffffff) then
  1362. p.concat(Tai_const.Create_32bit(longint(value)));
  1363. end;
  1364. Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
  1365. begin
  1366. p.concat(Tai_const_symbol.Createname_offset(sym,l));
  1367. end;
  1368. Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
  1369. {***********************************************************************}
  1370. { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
  1371. { Description: This routine adds the value constant to the current }
  1372. { instruction linked list. }
  1373. { real_typ -> indicates the type of the real data to initialize: }
  1374. { s32real -> create a single node. }
  1375. { s64real -> create a double node. }
  1376. { s80real -> create an extended node. }
  1377. { s64bit -> create a comp node. }
  1378. { f32bit -> create a fixed node. (not used normally) }
  1379. {***********************************************************************}
  1380. Begin
  1381. case real_typ of
  1382. s32real : p.concat(Tai_real_32bit.Create(value));
  1383. s64real : p.concat(Tai_real_64bit.Create(value));
  1384. s80real : p.concat(Tai_real_80bit.Create(value));
  1385. s64comp : p.concat(Tai_comp_64bit.Create(value));
  1386. end;
  1387. end;
  1388. Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
  1389. {*********************************************************************}
  1390. { PROCEDURE ConcatLabel }
  1391. { Description: This routine either emits a label or a labeled }
  1392. { instruction to the linked list of instructions. }
  1393. {*********************************************************************}
  1394. begin
  1395. p.concat(Tai_label.Create(l));
  1396. end;
  1397. procedure ConcatAlign(p:TAAsmoutput;l:longint);
  1398. {*********************************************************************}
  1399. { PROCEDURE ConcatPublic }
  1400. { Description: This routine emits an global definition to the }
  1401. { linked list of instructions.(used by AT&T styled asm) }
  1402. {*********************************************************************}
  1403. begin
  1404. p.concat(Tai_align.Create(l));
  1405. end;
  1406. procedure ConcatPublic(p:TAAsmoutput;const s : string);
  1407. {*********************************************************************}
  1408. { PROCEDURE ConcatPublic }
  1409. { Description: This routine emits an global definition to the }
  1410. { linked list of instructions.(used by AT&T styled asm) }
  1411. {*********************************************************************}
  1412. begin
  1413. p.concat(Tai_symbol.Createname_global(s,0));
  1414. end;
  1415. procedure ConcatLocal(p:TAAsmoutput;const s : string);
  1416. {*********************************************************************}
  1417. { PROCEDURE ConcatLocal }
  1418. { Description: This routine emits an local definition to the }
  1419. { linked list of instructions. }
  1420. {*********************************************************************}
  1421. begin
  1422. p.concat(Tai_symbol.Createname(s,0));
  1423. end;
  1424. Procedure ConcatGlobalBss(const s : string;size : longint);
  1425. {*********************************************************************}
  1426. { PROCEDURE ConcatGlobalBss }
  1427. { Description: This routine emits an global datablock to the }
  1428. { linked list of instructions. }
  1429. {*********************************************************************}
  1430. begin
  1431. bssSegment.concat(Tai_datablock.Create_global(s,size));
  1432. end;
  1433. Procedure ConcatLocalBss(const s : string;size : longint);
  1434. {*********************************************************************}
  1435. { PROCEDURE ConcatLocalBss }
  1436. { Description: This routine emits a local datablcok to the }
  1437. { linked list of instructions. }
  1438. {*********************************************************************}
  1439. begin
  1440. bssSegment.concat(Tai_datablock.Create(s,size));
  1441. end;
  1442. end.
  1443. {
  1444. $Log$
  1445. Revision 1.53 2003-02-19 22:00:14 daniel
  1446. * Code generator converted to new register notation
  1447. - Horribily outdated todo.txt removed
  1448. Revision 1.52 2003/01/08 18:43:56 daniel
  1449. * Tregister changed into a record
  1450. Revision 1.51 2002/12/14 15:02:03 carl
  1451. * maxoperands -> max_operands (for portability in rautils.pas)
  1452. * fix some range-check errors with loadconst
  1453. + add ncgadd unit to m68k
  1454. * some bugfix of a_param_reg with LOC_CREFERENCE
  1455. Revision 1.50 2002/11/25 17:43:23 peter
  1456. * splitted defbase in defutil,symutil,defcmp
  1457. * merged isconvertable and is_equal into compare_defs(_ext)
  1458. * made operator search faster by walking the list only once
  1459. Revision 1.49 2002/11/22 22:48:10 carl
  1460. * memory optimization with tconstsym (1.5%)
  1461. Revision 1.48 2002/11/18 17:31:59 peter
  1462. * pass proccalloption to ret_in_xxx and push_xxx functions
  1463. Revision 1.47 2002/11/15 16:29:31 peter
  1464. * made tasmsymbol.refs private (merged)
  1465. Revision 1.46 2002/09/03 16:26:27 daniel
  1466. * Make Tprocdef.defs protected
  1467. Revision 1.45 2002/08/25 19:25:20 peter
  1468. * sym.insert_in_data removed
  1469. * symtable.insertvardata/insertconstdata added
  1470. * removed insert_in_data call from symtable.insert, it needs to be
  1471. called separatly. This allows to deref the address calculation
  1472. * procedures now calculate the parast addresses after the procedure
  1473. directives are parsed. This fixes the cdecl parast problem
  1474. * push_addr_param has an extra argument that specifies if cdecl is used
  1475. or not
  1476. Revision 1.44 2002/08/17 09:23:41 florian
  1477. * first part of procinfo rewrite
  1478. Revision 1.43 2002/08/16 14:24:59 carl
  1479. * issameref() to test if two references are the same (then emit no opcodes)
  1480. + ret_in_reg to replace ret_in_acc
  1481. (fix some register allocation bugs at the same time)
  1482. + save_std_register now has an extra parameter which is the
  1483. usedinproc registers
  1484. Revision 1.42 2002/08/13 18:01:52 carl
  1485. * rename swatoperands to swapoperands
  1486. + m68k first compilable version (still needs a lot of testing):
  1487. assembler generator, system information , inline
  1488. assembler reader.
  1489. Revision 1.41 2002/08/12 15:08:40 carl
  1490. + stab register indexes for powerpc (moved from gdb to cpubase)
  1491. + tprocessor enumeration moved to cpuinfo
  1492. + linker in target_info is now a class
  1493. * many many updates for m68k (will soon start to compile)
  1494. - removed some ifdef or correct them for correct cpu
  1495. Revision 1.40 2002/08/11 14:32:27 peter
  1496. * renamed current_library to objectlibrary
  1497. Revision 1.39 2002/08/11 13:24:13 peter
  1498. * saving of asmsymbols in ppu supported
  1499. * asmsymbollist global is removed and moved into a new class
  1500. tasmlibrarydata that will hold the info of a .a file which
  1501. corresponds with a single module. Added librarydata to tmodule
  1502. to keep the library info stored for the module. In the future the
  1503. objectfiles will also be stored to the tasmlibrarydata class
  1504. * all getlabel/newasmsymbol and friends are moved to the new class
  1505. Revision 1.38 2002/07/20 11:57:57 florian
  1506. * types.pas renamed to defbase.pas because D6 contains a types
  1507. unit so this would conflicts if D6 programms are compiled
  1508. + Willamette/SSE2 instructions to assembler added
  1509. Revision 1.37 2002/07/11 14:41:28 florian
  1510. * start of the new generic parameter handling
  1511. Revision 1.36 2002/07/01 18:46:25 peter
  1512. * internal linker
  1513. * reorganized aasm layer
  1514. Revision 1.35 2002/05/18 13:34:17 peter
  1515. * readded missing revisions
  1516. Revision 1.34 2002/05/16 19:46:44 carl
  1517. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1518. + try to fix temp allocation (still in ifdef)
  1519. + generic constructor calls
  1520. + start of tassembler / tmodulebase class cleanup
  1521. Revision 1.31 2002/05/12 16:53:10 peter
  1522. * moved entry and exitcode to ncgutil and cgobj
  1523. * foreach gets extra argument for passing local data to the
  1524. iterator function
  1525. * -CR checks also class typecasts at runtime by changing them
  1526. into as
  1527. * fixed compiler to cycle with the -CR option
  1528. * fixed stabs with elf writer, finally the global variables can
  1529. be watched
  1530. * removed a lot of routines from cga unit and replaced them by
  1531. calls to cgobj
  1532. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1533. u32bit then the other is typecasted also to u32bit without giving
  1534. a rangecheck warning/error.
  1535. * fixed pascal calling method with reversing also the high tree in
  1536. the parast, detected by tcalcst3 test
  1537. Revision 1.30 2002/04/20 21:32:24 carl
  1538. + generic FPC_CHECKPOINTER
  1539. + first parameter offset in stack now portable
  1540. * rename some constants
  1541. + move some cpu stuff to other units
  1542. - remove unused constents
  1543. * fix stacksize for some targets
  1544. * fix generic size problems which depend now on EXTEND_SIZE constant
  1545. Revision 1.29 2002/04/15 19:02:35 carl
  1546. + target_info.size_of_pointer -> pointer_Size
  1547. Revision 1.28 2002/04/02 17:11:29 peter
  1548. * tlocation,treference update
  1549. * LOC_CONSTANT added for better constant handling
  1550. * secondadd splitted in multiple routines
  1551. * location_force_reg added for loading a location to a register
  1552. of a specified size
  1553. * secondassignment parses now first the right and then the left node
  1554. (this is compatible with Kylix). This saves a lot of push/pop especially
  1555. with string operations
  1556. * adapted some routines to use the new cg methods
  1557. Revision 1.27 2002/01/29 21:32:03 peter
  1558. * allow accessing locals in other lexlevel when the current assembler
  1559. routine doesn't have locals.
  1560. Revision 1.26 2002/01/24 18:25:50 peter
  1561. * implicit result variable generation for assembler routines
  1562. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  1563. }