rautils.pas 52 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734
  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:tregisterlist);
  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:=SELF_POINTER_REG;
  739. opr.ref.offset:=tvarsym(sym).address;
  740. end;
  741. hasvar:=true;
  742. SetupVar:=true;
  743. Exit;
  744. end;
  745. globalsymtable,
  746. staticsymtable :
  747. opr.ref.symbol:=objectlibrary.newasmsymbol(tvarsym(sym).mangledname);
  748. parasymtable :
  749. begin
  750. { if we only want the offset we don't have to care
  751. the base will be zeroed after ! }
  752. if (lexlevel=tvarsym(sym).owner.symtablelevel) or
  753. { this below is wrong because there are two parast
  754. for global functions one of interface the second of
  755. implementation
  756. if (tvarsym(sym).owner=procinfo.def.parast) or }
  757. GetOffset then
  758. begin
  759. opr.ref.base:=procinfo.framepointer;
  760. end
  761. else
  762. begin
  763. if (aktprocdef.localst.datasize=0) and
  764. assigned(procinfo.parent) and
  765. (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
  766. { same problem as above !!
  767. (procinfo.parent^.sym.definition.parast=tvarsym(sym).owner) and }
  768. (lexlevel>normal_function_level) then
  769. opr.ref.base:=procinfo.parent.framepointer
  770. else
  771. message1(asmr_e_local_para_unreachable,s);
  772. end;
  773. opr.ref.offset:=tvarsym(sym).address;
  774. if (lexlevel=tvarsym(sym).owner.symtablelevel) then
  775. begin
  776. opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
  777. opr.ref.options:=ref_parafixup;
  778. end
  779. else
  780. begin
  781. opr.ref.offsetfixup:=0;
  782. opr.ref.options:=ref_none;
  783. end;
  784. if (tvarsym(sym).varspez=vs_var) or
  785. ((tvarsym(sym).varspez=vs_const) and
  786. paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
  787. SetSize(pointer_size,false);
  788. end;
  789. localsymtable :
  790. begin
  791. if (vo_is_external in tvarsym(sym).varoptions) then
  792. opr.ref.symbol:=objectlibrary.newasmsymbol(tvarsym(sym).mangledname)
  793. else
  794. begin
  795. { if we only want the offset we don't have to care
  796. the base will be zeroed after ! }
  797. if (lexlevel=tvarsym(sym).owner.symtablelevel) or
  798. {if (tvarsym(sym).owner=procinfo.def.localst) or}
  799. GetOffset then
  800. opr.ref.base:=procinfo.framepointer
  801. else
  802. begin
  803. if (aktprocdef.localst.datasize=0) and
  804. assigned(procinfo.parent) and
  805. (lexlevel=tvarsym(sym).owner.symtablelevel+1) and
  806. {(procinfo.parent^.sym.definition.localst=tvarsym(sym).owner) and}
  807. (lexlevel>normal_function_level) then
  808. opr.ref.base:=procinfo.parent.framepointer
  809. else
  810. message1(asmr_e_local_para_unreachable,s);
  811. end;
  812. opr.ref.offset:=-(tvarsym(sym).address);
  813. if (lexlevel=tvarsym(sym).owner.symtablelevel) then
  814. begin
  815. opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
  816. opr.ref.options:=ref_localfixup;
  817. end
  818. else
  819. begin
  820. opr.ref.offsetfixup:=0;
  821. opr.ref.options:=ref_none;
  822. end;
  823. end;
  824. if (tvarsym(sym).varspez in [vs_var,vs_out]) or
  825. ((tvarsym(sym).varspez=vs_const) and
  826. paramanager.push_addr_param(tvarsym(sym).vartype.def,aktprocdef.proccalloption)) then
  827. SetSize(pointer_size,false);
  828. end;
  829. end;
  830. case tvarsym(sym).vartype.def.deftype of
  831. orddef,
  832. enumdef,
  833. pointerdef,
  834. floatdef :
  835. SetSize(tvarsym(sym).getsize,false);
  836. arraydef :
  837. begin
  838. { for arrays try to get the element size, take care of
  839. multiple indexes }
  840. harrdef:=tarraydef(tvarsym(sym).vartype.def);
  841. while assigned(harrdef.elementtype.def) and
  842. (harrdef.elementtype.def.deftype=arraydef) do
  843. harrdef:=tarraydef(harrdef.elementtype.def);
  844. SetSize(harrdef.elesize,false);
  845. end;
  846. end;
  847. hasvar:=true;
  848. SetupVar:=true;
  849. Exit;
  850. end;
  851. typedconstsym :
  852. begin
  853. opr.ref.symbol:=objectlibrary.newasmsymbol(ttypedconstsym(sym).mangledname);
  854. case ttypedconstsym(sym).typedconsttype.def.deftype of
  855. orddef,
  856. enumdef,
  857. pointerdef,
  858. floatdef :
  859. SetSize(ttypedconstsym(sym).getsize,false);
  860. arraydef :
  861. begin
  862. { for arrays try to get the element size, take care of
  863. multiple indexes }
  864. harrdef:=tarraydef(ttypedconstsym(sym).typedconsttype.def);
  865. while assigned(harrdef.elementtype.def) and
  866. (harrdef.elementtype.def.deftype=arraydef) do
  867. harrdef:=tarraydef(harrdef.elementtype.def);
  868. SetSize(harrdef.elesize,false);
  869. end;
  870. end;
  871. hasvar:=true;
  872. SetupVar:=true;
  873. Exit;
  874. end;
  875. constsym :
  876. begin
  877. if tconstsym(sym).consttyp in [constint,constchar,constbool] then
  878. begin
  879. opr.typ:=OPR_CONSTANT;
  880. opr.val:=tconstsym(sym).value.valueord;
  881. SetupVar:=true;
  882. Exit;
  883. end;
  884. end;
  885. typesym :
  886. begin
  887. if ttypesym(sym).restype.def.deftype in [recorddef,objectdef] then
  888. begin
  889. opr.typ:=OPR_CONSTANT;
  890. opr.val:=0;
  891. SetupVar:=TRUE;
  892. Exit;
  893. end;
  894. end;
  895. procsym :
  896. begin
  897. if Tprocsym(sym).procdef_count>1 then
  898. Message(asmr_w_calling_overload_func);
  899. l:=opr.ref.offset;
  900. opr.typ:=OPR_SYMBOL;
  901. opr.symbol:=objectlibrary.newasmsymbol(tprocsym(sym).first_procdef.mangledname);
  902. opr.symofs:=l;
  903. hasvar:=true;
  904. SetupVar:=TRUE;
  905. Exit;
  906. end;
  907. else
  908. begin
  909. Message(asmr_e_unsupported_symbol_type);
  910. exit;
  911. end;
  912. end;
  913. end;
  914. { looks for internal names of variables and routines }
  915. Function TOperand.SetupDirectVar(const hs:string): Boolean;
  916. var
  917. p : tasmsymbol;
  918. begin
  919. SetupDirectVar:=false;
  920. p:=objectlibrary.getasmsymbol(hs);
  921. if assigned(p) then
  922. begin
  923. opr.ref.symbol:=p;
  924. hasvar:=true;
  925. SetupDirectVar:=true;
  926. end;
  927. end;
  928. procedure TOperand.InitRef;
  929. {*********************************************************************}
  930. { Description: This routine first check if the opcode is of }
  931. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  932. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  933. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  934. { to point to the default segment. }
  935. {*********************************************************************}
  936. Begin
  937. case opr.typ of
  938. OPR_REFERENCE:
  939. exit;
  940. OPR_NONE: ;
  941. else
  942. Message(asmr_e_invalid_operand_type);
  943. end;
  944. opr.typ := OPR_REFERENCE;
  945. Fillchar(opr.ref,sizeof(treference),0);
  946. end;
  947. procedure TOperand.BuildOperand;
  948. begin
  949. abstract;
  950. end;
  951. {****************************************************************************
  952. TInstruction
  953. ****************************************************************************}
  954. constructor TInstruction.create;
  955. Begin
  956. Opcode:=A_NONE;
  957. Opsize:=S_NO;
  958. Condition:=C_NONE;
  959. Ops:=0;
  960. InitOperands;
  961. Labeled:=false;
  962. end;
  963. destructor TInstruction.destroy;
  964. var
  965. i : longint;
  966. Begin
  967. for i:=1 to 3 do
  968. Operands[i].free;
  969. end;
  970. procedure TInstruction.InitOperands;
  971. var
  972. i : longint;
  973. begin
  974. for i:=1 to 3 do
  975. Operands[i].create;
  976. end;
  977. Procedure TInstruction.Swapoperands;
  978. Var
  979. p : toperand;
  980. Begin
  981. case Ops of
  982. 2 :
  983. begin
  984. p:=Operands[1];
  985. Operands[1]:=Operands[2];
  986. Operands[2]:=p;
  987. end;
  988. 3 :
  989. begin
  990. p:=Operands[1];
  991. Operands[1]:=Operands[3];
  992. Operands[3]:=p;
  993. end;
  994. end;
  995. end;
  996. procedure TInstruction.ConcatInstruction(p:TAAsmOutput);
  997. begin
  998. abstract;
  999. end;
  1000. procedure TInstruction.BuildOpcode;
  1001. begin
  1002. abstract;
  1003. end;
  1004. {***************************************************************************
  1005. TLocalLabel
  1006. ***************************************************************************}
  1007. constructor TLocalLabel.create(const n:string);
  1008. begin
  1009. inherited CreateName(n);
  1010. lab:=nil;
  1011. emitted:=false;
  1012. end;
  1013. function TLocalLabel.Gettasmlabel:tasmlabel;
  1014. begin
  1015. if not assigned(lab) then
  1016. begin
  1017. objectlibrary.getlabel(lab);
  1018. { this label is forced to be used so it's always written }
  1019. lab.increfs;
  1020. end;
  1021. Gettasmlabel:=lab;
  1022. end;
  1023. {***************************************************************************
  1024. TLocalLabelList
  1025. ***************************************************************************}
  1026. procedure LocalLabelEmitted(p:tnamedindexitem;arg:pointer);
  1027. begin
  1028. if not TLocalLabel(p).emitted then
  1029. Message1(asmr_e_unknown_label_identifier,p.name);
  1030. end;
  1031. procedure TLocalLabelList.CheckEmitted;
  1032. begin
  1033. ForEach_Static({$ifdef FPCPROCVAR}@{$endif}LocalLabelEmitted,nil)
  1034. end;
  1035. function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean;
  1036. var
  1037. lab : TLocalLabel;
  1038. Begin
  1039. CreateLocalLabel:=true;
  1040. { Check if it already is defined }
  1041. lab:=TLocalLabel(LocalLabellist.Search(s));
  1042. if not assigned(lab) then
  1043. begin
  1044. lab:=TLocalLabel.Create(s);
  1045. LocalLabellist.Insert(lab);
  1046. end;
  1047. { set emitted flag and check for dup syms }
  1048. if emit then
  1049. begin
  1050. if lab.Emitted then
  1051. begin
  1052. Message1(asmr_e_dup_local_sym,lab.Name);
  1053. CreateLocalLabel:=false;
  1054. end;
  1055. lab.Emitted:=true;
  1056. end;
  1057. hl:=lab.Gettasmlabel;
  1058. end;
  1059. {****************************************************************************
  1060. Symbol table helper routines
  1061. ****************************************************************************}
  1062. procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:tsymtable);
  1063. var
  1064. i : integer;
  1065. begin
  1066. i:=pos('.',s);
  1067. { allow unit.identifier }
  1068. if i>0 then
  1069. begin
  1070. searchsym(Copy(s,1,i-1),srsym,srsymtable);
  1071. if assigned(srsym) then
  1072. begin
  1073. if (srsym.typ=unitsym) and
  1074. (srsym.owner.unitid=0) then
  1075. srsym:=searchsymonlyin(tunitsym(srsym).unitsymtable,Copy(s,i+1,255))
  1076. else
  1077. srsym:=nil;
  1078. end;
  1079. end
  1080. else
  1081. searchsym(s,srsym,srsymtable);
  1082. end;
  1083. Function SearchType(const hs:string): Boolean;
  1084. var
  1085. srsym : tsym;
  1086. srsymtable : tsymtable;
  1087. begin
  1088. asmsearchsym(hs,srsym,srsymtable);
  1089. SearchType:=assigned(srsym) and
  1090. (srsym.typ=typesym);
  1091. end;
  1092. Function SearchRecordType(const s:string): boolean;
  1093. var
  1094. srsym : tsym;
  1095. srsymtable : tsymtable;
  1096. Begin
  1097. SearchRecordType:=false;
  1098. { Check the constants in symtable }
  1099. asmsearchsym(s,srsym,srsymtable);
  1100. if srsym <> nil then
  1101. Begin
  1102. case srsym.typ of
  1103. typesym :
  1104. begin
  1105. if ttypesym(srsym).restype.def.deftype in [recorddef,objectdef] then
  1106. begin
  1107. SearchRecordType:=true;
  1108. exit;
  1109. end;
  1110. end;
  1111. end;
  1112. end;
  1113. end;
  1114. Function SearchIConstant(const s:string; var l:longint): boolean;
  1115. {**********************************************************************}
  1116. { Description: Searches for a CONSTANT of name s in either the local }
  1117. { symbol list, then in the global symbol list, and returns the value }
  1118. { of that constant in l. Returns TRUE if successfull, if not found, }
  1119. { or if the constant is not of correct type, then returns FALSE }
  1120. { Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
  1121. { respectively. }
  1122. {**********************************************************************}
  1123. var
  1124. srsym : tsym;
  1125. srsymtable : tsymtable;
  1126. Begin
  1127. SearchIConstant:=false;
  1128. { check for TRUE or FALSE reserved words first }
  1129. if s = 'TRUE' then
  1130. Begin
  1131. SearchIConstant:=TRUE;
  1132. l:=1;
  1133. exit;
  1134. end;
  1135. if s = 'FALSE' then
  1136. Begin
  1137. SearchIConstant:=TRUE;
  1138. l:=0;
  1139. exit;
  1140. end;
  1141. { Check the constants in symtable }
  1142. asmsearchsym(s,srsym,srsymtable);
  1143. if srsym <> nil then
  1144. Begin
  1145. case srsym.typ of
  1146. constsym :
  1147. begin
  1148. if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
  1149. Begin
  1150. l:=tconstsym(srsym).value.valueord;
  1151. SearchIConstant:=TRUE;
  1152. exit;
  1153. end;
  1154. end;
  1155. enumsym:
  1156. Begin
  1157. l:=tenumsym(srsym).value;
  1158. SearchIConstant:=TRUE;
  1159. exit;
  1160. end;
  1161. end;
  1162. end;
  1163. end;
  1164. Function GetRecordOffsetSize(s:string;Var Offset: longint;var Size:longint):boolean;
  1165. { search and returns the offset and size of records/objects of the base }
  1166. { with field name setup in field. }
  1167. { returns FALSE if not found. }
  1168. { used when base is a variable or a typed constant name. }
  1169. var
  1170. st : tsymtable;
  1171. harrdef : tarraydef;
  1172. sym : tsym;
  1173. srsymtable : tsymtable;
  1174. i : longint;
  1175. base : string;
  1176. Begin
  1177. GetRecordOffsetSize:=FALSE;
  1178. Offset:=0;
  1179. Size:=0;
  1180. i:=pos('.',s);
  1181. if i=0 then
  1182. i:=255;
  1183. base:=Copy(s,1,i-1);
  1184. delete(s,1,i);
  1185. if base='SELF' then
  1186. st:=procinfo._class.symtable
  1187. else
  1188. begin
  1189. asmsearchsym(base,sym,srsymtable);
  1190. st:=nil;
  1191. { we can start with a var,type,typedconst }
  1192. case sym.typ of
  1193. varsym :
  1194. begin
  1195. case tvarsym(sym).vartype.def.deftype of
  1196. recorddef :
  1197. st:=trecorddef(tvarsym(sym).vartype.def).symtable;
  1198. objectdef :
  1199. st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
  1200. end;
  1201. end;
  1202. typesym :
  1203. begin
  1204. case ttypesym(sym).restype.def.deftype of
  1205. recorddef :
  1206. st:=trecorddef(ttypesym(sym).restype.def).symtable;
  1207. objectdef :
  1208. st:=tobjectdef(ttypesym(sym).restype.def).symtable;
  1209. end;
  1210. end;
  1211. typedconstsym :
  1212. begin
  1213. case ttypedconstsym(sym).typedconsttype.def.deftype of
  1214. recorddef :
  1215. st:=trecorddef(ttypedconstsym(sym).typedconsttype.def).symtable;
  1216. objectdef :
  1217. st:=tobjectdef(ttypedconstsym(sym).typedconsttype.def).symtable;
  1218. end;
  1219. end;
  1220. end;
  1221. end;
  1222. { now walk all recordsymtables }
  1223. while assigned(st) and (s<>'') do
  1224. begin
  1225. { load next field in base }
  1226. i:=pos('.',s);
  1227. if i=0 then
  1228. i:=255;
  1229. base:=Copy(s,1,i-1);
  1230. delete(s,1,i);
  1231. if st.symtabletype=objectsymtable then
  1232. sym:=search_class_member(tobjectdef(st.defowner),base)
  1233. else
  1234. sym:=tsym(st.search(base));
  1235. if not assigned(sym) then
  1236. begin
  1237. GetRecordOffsetSize:=false;
  1238. exit;
  1239. end;
  1240. st:=nil;
  1241. case sym.typ of
  1242. varsym :
  1243. begin
  1244. inc(Offset,tvarsym(sym).address);
  1245. Size:=tvarsym(sym).getsize;
  1246. case tvarsym(sym).vartype.def.deftype of
  1247. arraydef :
  1248. begin
  1249. { for arrays try to get the element size, take care of
  1250. multiple indexes }
  1251. harrdef:=tarraydef(tvarsym(sym).vartype.def);
  1252. while assigned(harrdef.elementtype.def) and
  1253. (harrdef.elementtype.def.deftype=arraydef) do
  1254. harrdef:=tarraydef(harrdef.elementtype.def);
  1255. size:=harrdef.elesize;
  1256. end;
  1257. recorddef :
  1258. st:=trecorddef(tvarsym(sym).vartype.def).symtable;
  1259. objectdef :
  1260. st:=tobjectdef(tvarsym(sym).vartype.def).symtable;
  1261. end;
  1262. end;
  1263. end;
  1264. end;
  1265. GetRecordOffsetSize:=(s='');
  1266. end;
  1267. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  1268. var
  1269. sym : tsym;
  1270. srsymtable : tsymtable;
  1271. hs : string;
  1272. Begin
  1273. hl:=nil;
  1274. SearchLabel:=false;
  1275. { Check for pascal labels, which are case insensetive }
  1276. hs:=upper(s);
  1277. asmsearchsym(hs,sym,srsymtable);
  1278. if sym=nil then
  1279. exit;
  1280. case sym.typ of
  1281. labelsym :
  1282. begin
  1283. hl:=tlabelsym(sym).lab;
  1284. if emit then
  1285. tlabelsym(sym).defined:=true
  1286. else
  1287. tlabelsym(sym).used:=true;
  1288. SearchLabel:=true;
  1289. exit;
  1290. end;
  1291. end;
  1292. end;
  1293. {*************************************************************************}
  1294. { Instruction Generation Utilities }
  1295. {*************************************************************************}
  1296. Procedure ConcatString(p : TAAsmoutput;s:string);
  1297. {*********************************************************************}
  1298. { PROCEDURE ConcatString(s:string); }
  1299. { Description: This routine adds the character chain pointed to in }
  1300. { s to the instruction linked list. }
  1301. {*********************************************************************}
  1302. Var
  1303. pc: PChar;
  1304. Begin
  1305. getmem(pc,length(s)+1);
  1306. p.concat(Tai_string.Create_length_pchar(strpcopy(pc,s),length(s)));
  1307. end;
  1308. Procedure ConcatPasString(p : TAAsmoutput;s:string);
  1309. {*********************************************************************}
  1310. { PROCEDURE ConcatPasString(s:string); }
  1311. { Description: This routine adds the character chain pointed to in }
  1312. { s to the instruction linked list, contrary to ConcatString it }
  1313. { uses a pascal style string, so it conserves null characters. }
  1314. {*********************************************************************}
  1315. Begin
  1316. p.concat(Tai_string.Create(s));
  1317. end;
  1318. Procedure ConcatDirect(p : TAAsmoutput;s:string);
  1319. {*********************************************************************}
  1320. { PROCEDURE ConcatDirect(s:string) }
  1321. { Description: This routine output the string directly to the asm }
  1322. { output, it is only sed when writing special labels in AT&T mode, }
  1323. { and should not be used without due consideration, since it may }
  1324. { cause problems. }
  1325. {*********************************************************************}
  1326. Var
  1327. pc: PChar;
  1328. Begin
  1329. getmem(pc,length(s)+1);
  1330. p.concat(Tai_direct.Create(strpcopy(pc,s)));
  1331. end;
  1332. Procedure ConcatConstant(p: TAAsmoutput; value: longint; maxvalue: longint);
  1333. {*********************************************************************}
  1334. { PROCEDURE ConcatConstant(value: longint; maxvalue: longint); }
  1335. { Description: This routine adds the value constant to the current }
  1336. { instruction linked list. }
  1337. { maxvalue -> indicates the size of the data to initialize: }
  1338. { $ff -> create a byte node. }
  1339. { $ffff -> create a word node. }
  1340. { $ffffffff -> create a dword node. }
  1341. {*********************************************************************}
  1342. Begin
  1343. if (maxvalue <> longint($ffffffff)) and (value > maxvalue) then
  1344. Begin
  1345. Message(asmr_e_constant_out_of_bounds);
  1346. { assuming a value of maxvalue }
  1347. value:=maxvalue;
  1348. end;
  1349. if maxvalue = $ff then
  1350. p.concat(Tai_const.Create_8bit(byte(value)))
  1351. else
  1352. if maxvalue = $ffff then
  1353. p.concat(Tai_const.Create_16bit(word(value)))
  1354. else
  1355. if maxvalue = longint($ffffffff) then
  1356. p.concat(Tai_const.Create_32bit(longint(value)));
  1357. end;
  1358. Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;l:longint);
  1359. begin
  1360. p.concat(Tai_const_symbol.Createname_offset(sym,l));
  1361. end;
  1362. Procedure ConcatRealConstant(p : TAAsmoutput;value: bestreal; real_typ : tfloattype);
  1363. {***********************************************************************}
  1364. { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
  1365. { Description: This routine adds the value constant to the current }
  1366. { instruction linked list. }
  1367. { real_typ -> indicates the type of the real data to initialize: }
  1368. { s32real -> create a single node. }
  1369. { s64real -> create a double node. }
  1370. { s80real -> create an extended node. }
  1371. { s64bit -> create a comp node. }
  1372. { f32bit -> create a fixed node. (not used normally) }
  1373. {***********************************************************************}
  1374. Begin
  1375. case real_typ of
  1376. s32real : p.concat(Tai_real_32bit.Create(value));
  1377. s64real : p.concat(Tai_real_64bit.Create(value));
  1378. s80real : p.concat(Tai_real_80bit.Create(value));
  1379. s64comp : p.concat(Tai_comp_64bit.Create(value));
  1380. end;
  1381. end;
  1382. Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel);
  1383. {*********************************************************************}
  1384. { PROCEDURE ConcatLabel }
  1385. { Description: This routine either emits a label or a labeled }
  1386. { instruction to the linked list of instructions. }
  1387. {*********************************************************************}
  1388. begin
  1389. p.concat(Tai_label.Create(l));
  1390. end;
  1391. procedure ConcatAlign(p:TAAsmoutput;l:longint);
  1392. {*********************************************************************}
  1393. { PROCEDURE ConcatPublic }
  1394. { Description: This routine emits an global definition to the }
  1395. { linked list of instructions.(used by AT&T styled asm) }
  1396. {*********************************************************************}
  1397. begin
  1398. p.concat(Tai_align.Create(l));
  1399. end;
  1400. procedure ConcatPublic(p:TAAsmoutput;const s : string);
  1401. {*********************************************************************}
  1402. { PROCEDURE ConcatPublic }
  1403. { Description: This routine emits an global definition to the }
  1404. { linked list of instructions.(used by AT&T styled asm) }
  1405. {*********************************************************************}
  1406. begin
  1407. p.concat(Tai_symbol.Createname_global(s,0));
  1408. end;
  1409. procedure ConcatLocal(p:TAAsmoutput;const s : string);
  1410. {*********************************************************************}
  1411. { PROCEDURE ConcatLocal }
  1412. { Description: This routine emits an local definition to the }
  1413. { linked list of instructions. }
  1414. {*********************************************************************}
  1415. begin
  1416. p.concat(Tai_symbol.Createname(s,0));
  1417. end;
  1418. Procedure ConcatGlobalBss(const s : string;size : longint);
  1419. {*********************************************************************}
  1420. { PROCEDURE ConcatGlobalBss }
  1421. { Description: This routine emits an global datablock to the }
  1422. { linked list of instructions. }
  1423. {*********************************************************************}
  1424. begin
  1425. bssSegment.concat(Tai_datablock.Create_global(s,size));
  1426. end;
  1427. Procedure ConcatLocalBss(const s : string;size : longint);
  1428. {*********************************************************************}
  1429. { PROCEDURE ConcatLocalBss }
  1430. { Description: This routine emits a local datablcok to the }
  1431. { linked list of instructions. }
  1432. {*********************************************************************}
  1433. begin
  1434. bssSegment.concat(Tai_datablock.Create(s,size));
  1435. end;
  1436. end.
  1437. {
  1438. $Log$
  1439. Revision 1.52 2003-01-08 18:43:56 daniel
  1440. * Tregister changed into a record
  1441. Revision 1.51 2002/12/14 15:02:03 carl
  1442. * maxoperands -> max_operands (for portability in rautils.pas)
  1443. * fix some range-check errors with loadconst
  1444. + add ncgadd unit to m68k
  1445. * some bugfix of a_param_reg with LOC_CREFERENCE
  1446. Revision 1.50 2002/11/25 17:43:23 peter
  1447. * splitted defbase in defutil,symutil,defcmp
  1448. * merged isconvertable and is_equal into compare_defs(_ext)
  1449. * made operator search faster by walking the list only once
  1450. Revision 1.49 2002/11/22 22:48:10 carl
  1451. * memory optimization with tconstsym (1.5%)
  1452. Revision 1.48 2002/11/18 17:31:59 peter
  1453. * pass proccalloption to ret_in_xxx and push_xxx functions
  1454. Revision 1.47 2002/11/15 16:29:31 peter
  1455. * made tasmsymbol.refs private (merged)
  1456. Revision 1.46 2002/09/03 16:26:27 daniel
  1457. * Make Tprocdef.defs protected
  1458. Revision 1.45 2002/08/25 19:25:20 peter
  1459. * sym.insert_in_data removed
  1460. * symtable.insertvardata/insertconstdata added
  1461. * removed insert_in_data call from symtable.insert, it needs to be
  1462. called separatly. This allows to deref the address calculation
  1463. * procedures now calculate the parast addresses after the procedure
  1464. directives are parsed. This fixes the cdecl parast problem
  1465. * push_addr_param has an extra argument that specifies if cdecl is used
  1466. or not
  1467. Revision 1.44 2002/08/17 09:23:41 florian
  1468. * first part of procinfo rewrite
  1469. Revision 1.43 2002/08/16 14:24:59 carl
  1470. * issameref() to test if two references are the same (then emit no opcodes)
  1471. + ret_in_reg to replace ret_in_acc
  1472. (fix some register allocation bugs at the same time)
  1473. + save_std_register now has an extra parameter which is the
  1474. usedinproc registers
  1475. Revision 1.42 2002/08/13 18:01:52 carl
  1476. * rename swatoperands to swapoperands
  1477. + m68k first compilable version (still needs a lot of testing):
  1478. assembler generator, system information , inline
  1479. assembler reader.
  1480. Revision 1.41 2002/08/12 15:08:40 carl
  1481. + stab register indexes for powerpc (moved from gdb to cpubase)
  1482. + tprocessor enumeration moved to cpuinfo
  1483. + linker in target_info is now a class
  1484. * many many updates for m68k (will soon start to compile)
  1485. - removed some ifdef or correct them for correct cpu
  1486. Revision 1.40 2002/08/11 14:32:27 peter
  1487. * renamed current_library to objectlibrary
  1488. Revision 1.39 2002/08/11 13:24:13 peter
  1489. * saving of asmsymbols in ppu supported
  1490. * asmsymbollist global is removed and moved into a new class
  1491. tasmlibrarydata that will hold the info of a .a file which
  1492. corresponds with a single module. Added librarydata to tmodule
  1493. to keep the library info stored for the module. In the future the
  1494. objectfiles will also be stored to the tasmlibrarydata class
  1495. * all getlabel/newasmsymbol and friends are moved to the new class
  1496. Revision 1.38 2002/07/20 11:57:57 florian
  1497. * types.pas renamed to defbase.pas because D6 contains a types
  1498. unit so this would conflicts if D6 programms are compiled
  1499. + Willamette/SSE2 instructions to assembler added
  1500. Revision 1.37 2002/07/11 14:41:28 florian
  1501. * start of the new generic parameter handling
  1502. Revision 1.36 2002/07/01 18:46:25 peter
  1503. * internal linker
  1504. * reorganized aasm layer
  1505. Revision 1.35 2002/05/18 13:34:17 peter
  1506. * readded missing revisions
  1507. Revision 1.34 2002/05/16 19:46:44 carl
  1508. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1509. + try to fix temp allocation (still in ifdef)
  1510. + generic constructor calls
  1511. + start of tassembler / tmodulebase class cleanup
  1512. Revision 1.31 2002/05/12 16:53:10 peter
  1513. * moved entry and exitcode to ncgutil and cgobj
  1514. * foreach gets extra argument for passing local data to the
  1515. iterator function
  1516. * -CR checks also class typecasts at runtime by changing them
  1517. into as
  1518. * fixed compiler to cycle with the -CR option
  1519. * fixed stabs with elf writer, finally the global variables can
  1520. be watched
  1521. * removed a lot of routines from cga unit and replaced them by
  1522. calls to cgobj
  1523. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1524. u32bit then the other is typecasted also to u32bit without giving
  1525. a rangecheck warning/error.
  1526. * fixed pascal calling method with reversing also the high tree in
  1527. the parast, detected by tcalcst3 test
  1528. Revision 1.30 2002/04/20 21:32:24 carl
  1529. + generic FPC_CHECKPOINTER
  1530. + first parameter offset in stack now portable
  1531. * rename some constants
  1532. + move some cpu stuff to other units
  1533. - remove unused constents
  1534. * fix stacksize for some targets
  1535. * fix generic size problems which depend now on EXTEND_SIZE constant
  1536. Revision 1.29 2002/04/15 19:02:35 carl
  1537. + target_info.size_of_pointer -> pointer_Size
  1538. Revision 1.28 2002/04/02 17:11:29 peter
  1539. * tlocation,treference update
  1540. * LOC_CONSTANT added for better constant handling
  1541. * secondadd splitted in multiple routines
  1542. * location_force_reg added for loading a location to a register
  1543. of a specified size
  1544. * secondassignment parses now first the right and then the left node
  1545. (this is compatible with Kylix). This saves a lot of push/pop especially
  1546. with string operations
  1547. * adapted some routines to use the new cg methods
  1548. Revision 1.27 2002/01/29 21:32:03 peter
  1549. * allow accessing locals in other lexlevel when the current assembler
  1550. routine doesn't have locals.
  1551. Revision 1.26 2002/01/24 18:25:50 peter
  1552. * implicit result variable generation for assembler routines
  1553. * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
  1554. }