rautils.pas 59 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974
  1. {
  2. Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
  3. This unit implements some support routines for assembler parsing
  4. independent of the processor
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. **********************************************************************}
  17. Unit RAUtils;
  18. {$i fpcdefs.inc}
  19. Interface
  20. Uses
  21. cutils,cclasses,
  22. globtype,aasmbase,aasmtai,aasmdata,cpubase,cpuinfo,cgbase,cgutils,
  23. symconst,symbase,symtype,symdef,symsym,constexp,symcpu;
  24. Const
  25. RPNMax = 10; { I think you only need 4, but just to be safe }
  26. OpMax = 25;
  27. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  28. {---------------------------------------------------------------------
  29. Instruction management
  30. ---------------------------------------------------------------------}
  31. type
  32. TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
  33. OPR_REFERENCE,OPR_REGISTER,OPR_COND,OPR_REGSET,
  34. OPR_SHIFTEROP,OPR_MODEFLAGS,OPR_SPECIALREG,
  35. OPR_REGPAIR,OPR_FENCEFLAGS,OPR_INDEXEDREG,OPR_FLOATCONSTANT,
  36. OPR_FUNCTYPE);
  37. TOprRec = record
  38. case typ:TOprType of
  39. OPR_NONE : ();
  40. {$if defined(AVR)}
  41. OPR_CONSTANT : (val:longint);
  42. {$elseif defined(i8086)}
  43. OPR_CONSTANT : (val:longint);
  44. {$elseif defined(Z80)}
  45. OPR_CONSTANT : (val:longint);
  46. {$else}
  47. OPR_CONSTANT : (val:aint);
  48. {$endif}
  49. OPR_SYMBOL : (symbol:tasmsymbol;symofs:aint;symseg:boolean;sym_farproc_entry:boolean);
  50. OPR_REFERENCE : (varsize:asizeint; constoffset: asizeint;ref_farproc_entry:boolean;ref:treference);
  51. OPR_LOCAL : (localvarsize, localconstoffset: asizeint;localsym:tabstractnormalvarsym;localsymofs:aint;localsegment,localindexreg:tregister;localscale:byte;localgetoffset,localforceref:boolean);
  52. OPR_REGISTER : (reg:tregister);
  53. {$ifdef m68k}
  54. OPR_REGSET : (regsetdata,regsetaddr,regsetfpu : tcpuregisterset);
  55. OPR_REGPAIR : (reghi,reglo: tregister);
  56. {$endif m68k}
  57. {$ifdef powerpc}
  58. OPR_COND : (cond : tasmcond);
  59. {$endif powerpc}
  60. {$ifdef POWERPC64}
  61. OPR_COND : (cond : tasmcond);
  62. {$endif POWERPC64}
  63. {$ifdef arm}
  64. OPR_REGSET : (regset : tcpuregisterset; regtype: tregistertype; subreg: tsubregister; usermode: boolean);
  65. OPR_SHIFTEROP : (shifterop : tshifterop);
  66. OPR_COND : (cc : tasmcond);
  67. OPR_MODEFLAGS : (flags : tcpumodeflags);
  68. OPR_SPECIALREG: (specialreg : tregister; specialregflags : tspecialregflags);
  69. {$endif arm}
  70. {$ifdef aarch64}
  71. OPR_REGSET : (basereg: tregister; nregs, regsetindex: byte);
  72. OPR_INDEXEDREG: (indexedreg: tregister; regindex: byte);
  73. OPR_SHIFTEROP : (shifterop : tshifterop);
  74. OPR_COND : (cc : tasmcond);
  75. {$endif aarch64}
  76. {$if defined(riscv32) or defined(riscv64)}
  77. OPR_FENCEFLAGS: (fenceflags : TFenceFlags);
  78. {$endif aarch64}
  79. {$ifdef wasm32}
  80. OPR_FLOATCONSTANT: (floatval:double);
  81. OPR_FUNCTYPE : (functype: TWasmFuncType);
  82. {$endif wasm32}
  83. end;
  84. TInstruction = class;
  85. TOperand = class
  86. opr : TOprRec;
  87. typesize : byte;
  88. haslabelref, { if the operand has a label, used in a reference like a
  89. var (e.g. 'mov ax, word ptr [label+5]', but *not*
  90. e.g. 'jmp label') }
  91. hasproc, { if the operand has a procedure/function reference }
  92. hastype, { if the operand has typecasted variable }
  93. hasvar : boolean; { if the operand is loaded with a variable }
  94. size : TCGSize;
  95. constructor create;virtual;
  96. destructor destroy;override;
  97. Procedure SetSize(_size:longint;force:boolean);virtual;
  98. Procedure SetCorrectSize(opcode:tasmop);virtual;
  99. Function SetupResult:boolean;virtual;
  100. Function SetupSelf:boolean;
  101. Function SetupOldEBP:boolean;
  102. Function SetupVar(const s:string;GetOffset : boolean): Boolean;
  103. function CheckOperand(ins : TInstruction): boolean; virtual;
  104. Procedure InitRef;
  105. Procedure InitRefConvertLocal;
  106. protected
  107. Procedure InitRefError;
  108. end;
  109. TCOperand = class of TOperand;
  110. TInstruction = class
  111. operands : array[1..max_operands] of toperand;
  112. opcode : tasmop;
  113. condition : tasmcond;
  114. ops : byte;
  115. labeled : boolean;
  116. filepos : tfileposinfo;
  117. constructor create(optype : tcoperand);virtual;
  118. destructor destroy;override;
  119. { converts the instruction to an instruction how it's used by the assembler writer
  120. and concats it to the passed list. The newly created item is returned if the
  121. instruction was valid, otherwise nil is returned }
  122. function ConcatInstruction(p:TAsmList) : tai;virtual;
  123. end;
  124. {---------------------------------------------------------------------}
  125. { Expression parser types }
  126. {---------------------------------------------------------------------}
  127. TExprOperator = record
  128. ch: char; { operator }
  129. is_prefix: boolean; { was it a prefix, possible prefixes are +,- and not }
  130. end;
  131. {**********************************************************************}
  132. { The following operators are supported: }
  133. { '+' : addition }
  134. { '-' : subtraction }
  135. { '*' : multiplication }
  136. { '/' : modulo division }
  137. { '^' : exclusive or }
  138. { '<' : shift left }
  139. { '>' : shift right }
  140. { '&' : bitwise and }
  141. { '|' : bitwise or }
  142. { '~' : bitwise complement }
  143. { '%' : modulo division }
  144. { nnn: longint numbers }
  145. { ( and ) parenthesis }
  146. { [ and ] another kind of parenthesis }
  147. {**********************************************************************}
  148. TExprParse = class
  149. public
  150. Constructor create;
  151. Destructor Destroy;override;
  152. Function Evaluate(Expr: String): tcgint;
  153. Function Priority(_Operator: Char): aint;
  154. private
  155. RPNStack : Array[1..RPNMax] of tcgint; { Stack For RPN calculator }
  156. RPNTop : tcgint;
  157. OpStack : Array[1..OpMax] of TExprOperator; { Operator stack For conversion }
  158. OpTop : tcgint;
  159. Procedure RPNPush(Num: tcgint);
  160. Function RPNPop: tcgint;
  161. Procedure RPNCalc(const token: String; prefix: boolean);
  162. Procedure OpPush(_Operator: char; prefix: boolean);
  163. { In reality returns TExprOperaotr }
  164. Procedure OpPop(var _Operator:TExprOperator);
  165. end;
  166. { Evaluate an expression string to a tcgint }
  167. Function CalculateExpression(const expression: string): tcgint;
  168. {---------------------------------------------------------------------}
  169. { String routines }
  170. {---------------------------------------------------------------------}
  171. Function ParseVal(const S:String;base:byte):tcgint;
  172. Function PadZero(Var s: String; n: byte): Boolean;
  173. Function EscapeToPascal(const s:string): string;
  174. {---------------------------------------------------------------------
  175. Symbol helper routines
  176. ---------------------------------------------------------------------}
  177. procedure AsmSearchSym(const s:string;out srsym:tsym;out srsymtable:TSymtable);
  178. Function GetRecordOffsetSize(s:string;out Offset: tcgint;out Size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
  179. Function SearchType(const hs:string;out size:tcgint): Boolean;
  180. Function SearchRecordType(const s:string): boolean;
  181. Function SearchIConstant(const s:string; var l:tcgint): boolean;
  182. Function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
  183. {---------------------------------------------------------------------
  184. Instruction generation routines
  185. ---------------------------------------------------------------------}
  186. Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
  187. Procedure ConcatConstant(p : TAsmList;value: tcgint; constsize:byte);
  188. Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
  189. Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
  190. Procedure ConcatString(p : TAsmList;s:string);
  191. procedure ConcatAlign(p:TAsmList;l:tcgint);
  192. Procedure ConcatPublic(p:TAsmList;const s : string);
  193. Procedure ConcatLocal(p:TAsmList;const s : string);
  194. Implementation
  195. uses
  196. SysUtils,
  197. defutil,systems,verbose,globals,
  198. symtable,paramgr,
  199. aasmcpu,
  200. procinfo,ngenutil;
  201. {*************************************************************************
  202. TExprParse
  203. *************************************************************************}
  204. Constructor TExprParse.create;
  205. Begin
  206. end;
  207. Procedure TExprParse.RPNPush(Num : tcgint);
  208. { Add an operand to the top of the RPN stack }
  209. begin
  210. if RPNTop < RPNMax then
  211. begin
  212. Inc(RPNTop);
  213. RPNStack[RPNTop]:=Num;
  214. end
  215. else
  216. Message(asmr_e_expr_illegal);
  217. end;
  218. Function TExprParse.RPNPop : tcgint;
  219. { Get the operand at the top of the RPN stack }
  220. begin
  221. RPNPop:=0;
  222. if RPNTop > 0 then
  223. begin
  224. RPNPop:=RPNStack[RPNTop];
  225. Dec(RPNTop);
  226. end
  227. else
  228. Message(asmr_e_expr_illegal);
  229. end;
  230. Procedure TExprParse.RPNCalc(const Token : String; prefix:boolean); { RPN Calculator }
  231. Var
  232. Temp : tcgint;
  233. n1,n2 : tcgint;
  234. LocalError : Integer;
  235. begin
  236. { Handle operators }
  237. if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/','&','|','%','^','~','<','>']) then
  238. Case Token[1] of
  239. '+' :
  240. Begin
  241. if not prefix then
  242. RPNPush(RPNPop + RPNPop);
  243. end;
  244. '-' :
  245. Begin
  246. if prefix then
  247. RPNPush(-(RPNPop))
  248. else
  249. begin
  250. n1:=RPNPop;
  251. n2:=RPNPop;
  252. RPNPush(n2 - n1);
  253. end;
  254. end;
  255. '*' : RPNPush(RPNPop * RPNPop);
  256. '&' :
  257. begin
  258. n1:=RPNPop;
  259. n2:=RPNPop;
  260. RPNPush(n2 and n1);
  261. end;
  262. '|' :
  263. begin
  264. n1:=RPNPop;
  265. n2:=RPNPop;
  266. RPNPush(n2 or n1);
  267. end;
  268. '~' : RPNPush(NOT RPNPop);
  269. '<' :
  270. begin
  271. n1:=RPNPop;
  272. n2:=RPNPop;
  273. RPNPush(n2 SHL n1);
  274. end;
  275. '>' :
  276. begin
  277. n1:=RPNPop;
  278. n2:=RPNPop;
  279. RPNPush(n2 SHR n1);
  280. end;
  281. '%' :
  282. begin
  283. Temp:=RPNPop;
  284. if Temp <> 0 then
  285. RPNPush(RPNPop mod Temp)
  286. else
  287. begin
  288. Message(asmr_e_expr_zero_divide);
  289. { push 1 for error recovery }
  290. RPNPush(1);
  291. end;
  292. end;
  293. '^' : RPNPush(RPNPop XOR RPNPop);
  294. '/' :
  295. begin
  296. Temp:=RPNPop;
  297. if Temp <> 0 then
  298. RPNPush(RPNPop div Temp)
  299. else
  300. begin
  301. Message(asmr_e_expr_zero_divide);
  302. { push 1 for error recovery }
  303. RPNPush(1);
  304. end;
  305. end;
  306. end
  307. else
  308. begin
  309. { Convert String to number and add to stack }
  310. Val(Token, Temp, LocalError);
  311. if LocalError = 0 then
  312. RPNPush(Temp)
  313. else
  314. begin
  315. Message(asmr_e_expr_illegal);
  316. { push 1 for error recovery }
  317. RPNPush(1);
  318. end;
  319. end;
  320. end;
  321. Procedure TExprParse.OpPush(_Operator : char;prefix: boolean);
  322. { Add an operator onto top of the stack }
  323. begin
  324. if OpTop < OpMax then
  325. begin
  326. Inc(OpTop);
  327. OpStack[OpTop].ch:=_Operator;
  328. OpStack[OpTop].is_prefix:=prefix;
  329. end
  330. else
  331. Message(asmr_e_expr_illegal);
  332. end;
  333. Procedure TExprParse.OpPop(var _Operator:TExprOperator);
  334. { Get operator at the top of the stack }
  335. begin
  336. if OpTop > 0 then
  337. begin
  338. _Operator:=OpStack[OpTop];
  339. Dec(OpTop);
  340. end
  341. else
  342. Message(asmr_e_expr_illegal);
  343. end;
  344. Function TExprParse.Priority(_Operator : Char) : aint;
  345. { Return priority of operator }
  346. { The greater the priority, the higher the precedence }
  347. begin
  348. Priority:=0;
  349. Case _Operator OF
  350. '(','[' :
  351. Priority:=0;
  352. '|','^','~' : // the lowest priority: OR, XOR, NOT
  353. Priority:=0;
  354. '&' : // bigger priority: AND
  355. Priority:=1;
  356. '+', '-' : // bigger priority: +, -
  357. Priority:=2;
  358. '*', '/','%','<','>' : // the highest priority: *, /, MOD, SHL, SHR
  359. Priority:=3;
  360. else
  361. Message(asmr_e_expr_illegal);
  362. end;
  363. end;
  364. Function TExprParse.Evaluate(Expr : String):tcgint;
  365. Var
  366. I : longint;
  367. Token : String;
  368. opr : TExprOperator;
  369. begin
  370. Evaluate:=0;
  371. { Reset stacks }
  372. OpTop :=0;
  373. RPNTop:=0;
  374. Token :='';
  375. { nothing to do ? }
  376. if Expr='' then
  377. exit;
  378. For I:=1 to Length(Expr) DO
  379. begin
  380. if Expr[I] in ['0'..'9'] then
  381. begin { Build multi-digit numbers }
  382. Token:=Token + Expr[I];
  383. if I = Length(Expr) then { Send last one to calculator }
  384. RPNCalc(Token,false);
  385. end
  386. else
  387. if Expr[I] in ['+', '-', '*', '/', '(', ')','[',']','^','&','|','%','~','<','>'] then
  388. begin
  389. if Token <> '' then
  390. begin { Send last built number to calc. }
  391. RPNCalc(Token,false);
  392. Token:='';
  393. end;
  394. Case Expr[I] OF
  395. '[' : OpPush('[',false);
  396. ']' : begin
  397. While (OpTop>0) and (OpStack[OpTop].ch <> '[') DO
  398. Begin
  399. OpPop(opr);
  400. RPNCalc(opr.ch,opr.is_prefix);
  401. end;
  402. OpPop(opr); { Pop off and ignore the '[' }
  403. end;
  404. '(' : OpPush('(',false);
  405. ')' : begin
  406. While (OpTop>0) and (OpStack[OpTop].ch <> '(') DO
  407. Begin
  408. OpPop(opr);
  409. RPNCalc(opr.ch,opr.is_prefix);
  410. end;
  411. OpPop(opr); { Pop off and ignore the '(' }
  412. end;
  413. '+','-','~' : Begin
  414. { workaround for -2147483648 }
  415. if (expr[I]='-') and (expr[i+1] in ['0'..'9']) then
  416. begin
  417. token:='-';
  418. expr[i]:='+';
  419. end;
  420. { if start of expression then surely a prefix }
  421. { or if previous char was also an operator }
  422. if (I = 1) or (not (Expr[I-1] in ['0'..'9',')'])) then
  423. OpPush(Expr[I],true)
  424. else
  425. Begin
  426. { Evaluate all higher priority operators }
  427. While (OpTop > 0) AND (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
  428. Begin
  429. OpPop(opr);
  430. RPNCalc(opr.ch,opr.is_prefix);
  431. end;
  432. OpPush(Expr[I],false);
  433. End;
  434. end;
  435. '*', '/',
  436. '^','|','&',
  437. '%','<','>' : begin
  438. While (OpTop > 0) and (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO
  439. Begin
  440. OpPop(opr);
  441. RPNCalc(opr.ch,opr.is_prefix);
  442. end;
  443. OpPush(Expr[I],false);
  444. end;
  445. end; { Case }
  446. end
  447. else
  448. Message(asmr_e_expr_illegal); { Handle bad input error }
  449. end;
  450. { Pop off the remaining operators }
  451. While OpTop > 0 do
  452. Begin
  453. OpPop(opr);
  454. RPNCalc(opr.ch,opr.is_prefix);
  455. end;
  456. { The result is stored on the top of the stack }
  457. Evaluate:=RPNPop;
  458. end;
  459. Destructor TExprParse.Destroy;
  460. Begin
  461. end;
  462. Function CalculateExpression(const expression: string): tcgint;
  463. var
  464. expr: TExprParse;
  465. Begin
  466. expr:=TExprParse.create;
  467. CalculateExpression:=expr.Evaluate(expression);
  468. expr.Free;
  469. expr := nil;
  470. end;
  471. {*************************************************************************}
  472. { String conversions/utils }
  473. {*************************************************************************}
  474. Function EscapeToPascal(const s:string): string;
  475. { converts a C styled string - which contains escape }
  476. { characters to a pascal style string. }
  477. var
  478. i,len : asizeint;
  479. hs : string;
  480. temp : string;
  481. c : char;
  482. Begin
  483. hs:='';
  484. len:=0;
  485. i:=0;
  486. while (i<length(s)) and (len<255) do
  487. begin
  488. Inc(i);
  489. if (s[i]='\') and (i<length(s)) then
  490. Begin
  491. inc(i);
  492. case s[i] of
  493. '\' :
  494. c:='\';
  495. 'b':
  496. c:=#8;
  497. 'f':
  498. c:=#12;
  499. 'n':
  500. c:=#10;
  501. 'r':
  502. c:=#13;
  503. 't':
  504. c:=#9;
  505. '"':
  506. c:='"';
  507. '0'..'7':
  508. Begin
  509. temp:=s[i];
  510. temp:=temp+s[i+1];
  511. temp:=temp+s[i+2];
  512. inc(i,2);
  513. c:=chr(ParseVal(temp,8));
  514. end;
  515. 'x':
  516. Begin
  517. temp:=s[i+1];
  518. temp:=temp+s[i+2];
  519. inc(i,2);
  520. c:=chr(ParseVal(temp,16));
  521. end;
  522. else
  523. Begin
  524. Message1(asmr_e_escape_seq_ignored,s[i]);
  525. c:=s[i];
  526. end;
  527. end;
  528. end
  529. else
  530. c:=s[i];
  531. inc(len);
  532. hs[len]:=c;
  533. end;
  534. hs[0]:=chr(len);
  535. EscapeToPascal:=hs;
  536. end;
  537. Function ParseVal(const S:String;base:byte):tcgint;
  538. { Converts a decimal string to tcgint }
  539. var
  540. code : integer;
  541. errmsg : word;
  542. prefix : string[2];
  543. Begin
  544. case base of
  545. 2 :
  546. begin
  547. errmsg:=asmr_e_error_converting_binary;
  548. prefix:='%';
  549. end;
  550. 8 :
  551. begin
  552. errmsg:=asmr_e_error_converting_octal;
  553. prefix:='&';
  554. end;
  555. 10 :
  556. begin
  557. errmsg:=asmr_e_error_converting_decimal;
  558. prefix:='';
  559. end;
  560. 16 :
  561. begin
  562. errmsg:=asmr_e_error_converting_hexadecimal;
  563. prefix:='$';
  564. end;
  565. else
  566. internalerror(200501202);
  567. end;
  568. val(prefix+s,result,code);
  569. if code<>0 then
  570. begin
  571. val(prefix+s,result,code);
  572. if code<>0 then
  573. begin
  574. Message1(errmsg,s);
  575. result:=0;
  576. end;
  577. end;
  578. end;
  579. Function PadZero(Var s: String; n: byte): Boolean;
  580. Begin
  581. PadZero:=TRUE;
  582. { Do some error checking first }
  583. if Length(s) = n then
  584. exit
  585. else
  586. if Length(s) > n then
  587. Begin
  588. PadZero:=FALSE;
  589. delete(s,n+1,length(s));
  590. exit;
  591. end
  592. else
  593. PadZero:=TRUE;
  594. { Fill it up with the specified character }
  595. fillchar(s[length(s)+1],n-1,#0);
  596. s[0]:=chr(n);
  597. end;
  598. {****************************************************************************
  599. TOperand
  600. ****************************************************************************}
  601. constructor TOperand.Create;
  602. begin
  603. size:=OS_NO;
  604. hasproc:=false;
  605. hastype:=false;
  606. hasvar:=false;
  607. FillChar(Opr,sizeof(Opr),0);
  608. end;
  609. destructor TOperand.destroy;
  610. begin
  611. end;
  612. Procedure TOperand.SetSize(_size:longint;force:boolean);
  613. begin
  614. if force or
  615. ((size = OS_NO) and (_size<=16)) then
  616. Begin
  617. case _size of
  618. 1 : size:=OS_8;
  619. 2 : size:=OS_16{ could be S_IS};
  620. 4 : size:=OS_32{ could be S_IL or S_FS};
  621. 8 : size:=OS_64{ could be S_D or S_FL};
  622. 10 : size:=OS_F80;
  623. 16 : size:=OS_128;
  624. end;
  625. end;
  626. end;
  627. Procedure TOperand.SetCorrectSize(opcode:tasmop);
  628. begin
  629. end;
  630. function TOperand.SetupResult:boolean;
  631. begin
  632. SetupResult:=false;
  633. { replace by correct offset. }
  634. with current_procinfo.procdef do
  635. if (not is_void(returndef)) then
  636. begin
  637. if (m_tp7 in current_settings.modeswitches) and
  638. not (df_generic in defoptions) and
  639. (po_assembler in procoptions) and
  640. (not paramanager.ret_in_param(returndef,current_procinfo.procdef)) then
  641. begin
  642. message(asmr_e_cannot_use_RESULT_here);
  643. exit;
  644. end;
  645. SetupResult:=setupvar('result',false)
  646. end
  647. else
  648. message(asmr_e_void_function);
  649. end;
  650. Function TOperand.SetupSelf:boolean;
  651. Begin
  652. SetupSelf:=false;
  653. if assigned(current_structdef) then
  654. SetupSelf:=setupvar('self',false)
  655. else
  656. Message(asmr_e_cannot_use_SELF_outside_a_method);
  657. end;
  658. Function TOperand.SetupOldEBP:boolean;
  659. Begin
  660. SetupOldEBP:=false;
  661. if current_procinfo.procdef.parast.symtablelevel>normal_function_level then
  662. SetupOldEBP:=setupvar('parentframe',false)
  663. else
  664. Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
  665. end;
  666. Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean;
  667. function symtable_has_localvarsyms(st:TSymtable):boolean;
  668. var
  669. sym : tsym;
  670. i : longint;
  671. begin
  672. result:=false;
  673. for i:=0 to st.SymList.Count-1 do
  674. begin
  675. sym:=tsym(st.SymList[i]);
  676. if sym.typ=localvarsym then
  677. begin
  678. result:=true;
  679. exit;
  680. end;
  681. end;
  682. end;
  683. procedure setconst(l:aint);
  684. begin
  685. { We return the address of the field, just like Delphi/TP }
  686. case opr.typ of
  687. OPR_NONE :
  688. begin
  689. opr.typ:=OPR_CONSTANT;
  690. opr.val:=l;
  691. end;
  692. OPR_CONSTANT :
  693. inc(opr.val,l);
  694. OPR_REFERENCE :
  695. inc(opr.ref.offset,l);
  696. OPR_LOCAL :
  697. inc(opr.localsymofs,l);
  698. else
  699. Message(asmr_e_invalid_operand_type);
  700. end;
  701. end;
  702. procedure setvarsize(sym: tabstractvarsym);
  703. var
  704. harrdef: tarraydef;
  705. l: asizeint;
  706. begin
  707. case sym.vardef.typ of
  708. orddef,
  709. enumdef,
  710. pointerdef,
  711. procvardef,
  712. floatdef :
  713. SetSize(sym.getsize,false);
  714. arraydef :
  715. begin
  716. { for arrays try to get the element size, take care of
  717. multiple indexes }
  718. harrdef:=tarraydef(sym.vardef);
  719. { calc array size }
  720. if is_special_array(harrdef) then
  721. l := -1
  722. else
  723. l := harrdef.size;
  724. case opr.typ of
  725. OPR_REFERENCE: opr.varsize := l;
  726. OPR_LOCAL: opr.localvarsize := l;
  727. else
  728. ;
  729. end;
  730. while assigned(harrdef.elementdef) and
  731. (harrdef.elementdef.typ=arraydef) do
  732. harrdef:=tarraydef(harrdef.elementdef);
  733. if not is_packed_array(harrdef) then
  734. SetSize(harrdef.elesize,false)
  735. else
  736. if (harrdef.elepackedbitsize mod 8) = 0 then
  737. SetSize(harrdef.elepackedbitsize div 8,false);
  738. end;
  739. recorddef:
  740. case opr.typ of
  741. OPR_REFERENCE: opr.varsize := sym.getsize;
  742. OPR_LOCAL: opr.localvarsize := sym.getsize;
  743. else
  744. ;
  745. end;
  746. else
  747. ;
  748. end;
  749. end;
  750. { search and sets up the correct fields in the Instr record }
  751. { for the NON-constant identifier passed to the routine. }
  752. { if not found returns FALSE. }
  753. var
  754. sym : tsym;
  755. srsymtable : TSymtable;
  756. {$ifdef x86}
  757. segreg,
  758. {$endif x86}
  759. indexreg : tregister;
  760. plist : ppropaccesslistitem;
  761. size_set_from_absolute : boolean = false;
  762. { offset fixup (in bytes), coming from an absolute declaration with an index
  763. (e.g. var tralala: word absolute moo[5]; ) }
  764. absoffset: asizeint=0;
  765. harrdef: tarraydef;
  766. tmpprocinfo: tprocinfo;
  767. Begin
  768. SetupVar:=false;
  769. asmsearchsym(s,sym,srsymtable);
  770. if sym = nil then
  771. exit;
  772. if sym.typ=absolutevarsym then
  773. begin
  774. case tabsolutevarsym(sym).abstyp of
  775. tovar:
  776. begin
  777. { Only support simple loads }
  778. plist:=tabsolutevarsym(sym).ref.firstsym;
  779. if assigned(plist) and
  780. (plist^.sltype=sl_load) then
  781. begin
  782. setvarsize(tabstractvarsym(sym));
  783. size_set_from_absolute:=true;
  784. sym:=plist^.sym;
  785. { Check if address can be resolved, but only if not an array }
  786. if (sym.typ=absolutevarsym) and (tabsolutevarsym(sym).abstyp=toaddr) and not
  787. (assigned(plist^.next) and (plist^.next^.sltype=sl_vec)) then
  788. begin
  789. initref;
  790. opr.ref.offset:=tabsolutevarsym(sym).addroffset;
  791. hasvar:=true;
  792. Result:=true;
  793. exit;
  794. end;
  795. { resolve the chain of array indexes (if there are any) }
  796. harrdef:=nil;
  797. while assigned(plist^.next) do
  798. begin
  799. plist:=plist^.next;
  800. if (plist^.sltype=sl_vec) and (tabstractvarsym(sym).vardef.typ=arraydef) then
  801. begin
  802. if harrdef=nil then
  803. harrdef:=tarraydef(tabstractvarsym(sym).vardef)
  804. else if harrdef.elementdef.typ=arraydef then
  805. harrdef:=tarraydef(harrdef.elementdef)
  806. else
  807. begin
  808. Message(asmr_e_unsupported_symbol_type);
  809. exit;
  810. end;
  811. if is_special_array(harrdef) then
  812. begin
  813. Message(asmr_e_unsupported_symbol_type);
  814. exit;
  815. end;
  816. if not is_packed_array(harrdef) then
  817. Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange))*harrdef.elesize)
  818. else if (Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize mod 8)=0 then
  819. Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize div 8))
  820. else
  821. Message(asmr_e_packed_element);
  822. end
  823. else
  824. begin
  825. Message(asmr_e_unsupported_symbol_type);
  826. exit;
  827. end;
  828. end;
  829. end
  830. else
  831. begin
  832. Message(asmr_e_unsupported_symbol_type);
  833. exit;
  834. end;
  835. end;
  836. toaddr:
  837. begin
  838. initref;
  839. opr.ref.offset:=tabsolutevarsym(sym).addroffset;
  840. setvarsize(tabstractvarsym(sym));
  841. size_set_from_absolute:=true;
  842. hasvar:=true;
  843. Result:=true;
  844. exit;
  845. end;
  846. else
  847. begin
  848. Message(asmr_e_unsupported_symbol_type);
  849. exit;
  850. end;
  851. end;
  852. end;
  853. case sym.typ of
  854. fieldvarsym :
  855. begin
  856. if not tabstractrecordsymtable(sym.owner).is_packed then
  857. setconst(absoffset+tfieldvarsym(sym).fieldoffset)
  858. else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
  859. setconst(absoffset+tfieldvarsym(sym).fieldoffset div 8)
  860. else
  861. Message(asmr_e_packed_element);
  862. if not size_set_from_absolute then
  863. setvarsize(tabstractvarsym(sym));
  864. hasvar:=true;
  865. SetupVar:=true;
  866. end;
  867. staticvarsym,
  868. localvarsym,
  869. paravarsym :
  870. begin
  871. { we always assume in asm statements that }
  872. { that the variable is valid. }
  873. tabstractvarsym(sym).varstate:=vs_readwritten;
  874. inc(tabstractvarsym(sym).refs);
  875. { variable can't be placed in a register }
  876. tabstractvarsym(sym).varregable:=vr_none;
  877. { and anything may happen with its address }
  878. tabstractvarsym(sym).addr_taken:=true;
  879. case sym.typ of
  880. staticvarsym :
  881. begin
  882. initref;
  883. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(sym).mangledname,AT_DATA);
  884. Inc(opr.ref.offset,absoffset);
  885. end;
  886. paravarsym,
  887. localvarsym :
  888. begin
  889. tmpprocinfo:=current_procinfo;
  890. while assigned(tmpprocinfo) do
  891. begin
  892. if (sym.owner=tmpprocinfo.procdef.localst) or
  893. (sym.owner=tmpprocinfo.procdef.parast) then
  894. begin
  895. tmpprocinfo.procdef.init_paraloc_info(calleeside);
  896. break;
  897. end;
  898. tmpprocinfo:=tmpprocinfo.parent;
  899. end;
  900. if opr.typ=OPR_REFERENCE then
  901. begin
  902. {$ifdef x86}
  903. segreg:=opr.ref.segment;
  904. {$endif x86}
  905. indexreg:=opr.ref.base;
  906. if opr.ref.index<>NR_NO then
  907. begin
  908. if indexreg=NR_NO then
  909. indexreg:=opr.ref.index
  910. else
  911. Message(asmr_e_multiple_index);
  912. end;
  913. end
  914. else
  915. begin
  916. {$ifdef x86}
  917. segreg:=NR_NO;
  918. {$endif x86}
  919. indexreg:=NR_NO;
  920. end;
  921. opr.typ:=OPR_LOCAL;
  922. if assigned(current_procinfo.parent) and
  923. not(po_inline in current_procinfo.procdef.procoptions) and
  924. (sym.owner<>current_procinfo.procdef.localst) and
  925. (sym.owner<>current_procinfo.procdef.parast) and
  926. (current_procinfo.procdef.localst.symtablelevel>normal_function_level) and
  927. symtable_has_localvarsyms(current_procinfo.procdef.localst) then
  928. message1(asmr_e_local_para_unreachable,s);
  929. opr.localsym:=tabstractnormalvarsym(sym);
  930. opr.localsymofs:=absoffset;
  931. {$ifdef x86}
  932. opr.localsegment:=segreg;
  933. {$endif x86}
  934. opr.localindexreg:=indexreg;
  935. opr.localscale:=0;
  936. opr.localgetoffset:=GetOffset;
  937. if paramanager.push_addr_param(tabstractvarsym(sym).varspez,tabstractvarsym(sym).vardef,current_procinfo.procdef.proccalloption) then
  938. SetSize(sizeof(pint),false);
  939. end;
  940. else
  941. ;
  942. end;
  943. if not size_set_from_absolute then
  944. setvarsize(tabstractvarsym(sym));
  945. hasvar:=true;
  946. SetupVar:=true;
  947. Exit;
  948. end;
  949. constsym :
  950. begin
  951. if tconstsym(sym).consttyp=constord then
  952. begin
  953. setconst(tconstsym(sym).value.valueord.svalue);
  954. SetupVar:=true;
  955. Exit;
  956. end;
  957. end;
  958. typesym :
  959. begin
  960. if ttypesym(sym).typedef.typ in [recorddef,objectdef] then
  961. begin
  962. setconst(0);
  963. SetupVar:=TRUE;
  964. Exit;
  965. end;
  966. end;
  967. procsym :
  968. begin
  969. if Tprocsym(sym).ProcdefList.Count>1 then
  970. Message(asmr_w_calling_overload_func);
  971. case opr.typ of
  972. OPR_REFERENCE:
  973. begin
  974. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
  975. Inc(opr.ref.offset,absoffset);
  976. {$ifdef i8086}
  977. opr.ref_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  978. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
  979. {$endif i8086}
  980. end;
  981. OPR_NONE:
  982. begin
  983. opr.typ:=OPR_SYMBOL;
  984. opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
  985. {$ifdef i8086}
  986. opr.sym_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  987. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
  988. {$endif i8086}
  989. opr.symofs:=absoffset;
  990. end;
  991. else
  992. Message(asmr_e_invalid_operand_type);
  993. end;
  994. hasproc:=true;
  995. hasvar:=true;
  996. SetupVar:=TRUE;
  997. Exit;
  998. end;
  999. {$ifdef i8086}
  1000. labelsym :
  1001. begin
  1002. case opr.typ of
  1003. OPR_REFERENCE:
  1004. begin
  1005. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tlabelsym(sym).mangledname,AT_FUNCTION);
  1006. Inc(opr.ref.offset,absoffset);
  1007. if opr.ref.segment=NR_NO then
  1008. opr.ref.segment:=NR_CS;
  1009. end;
  1010. else
  1011. begin
  1012. Message(asmr_e_unsupported_symbol_type);
  1013. exit;
  1014. end;
  1015. end;
  1016. haslabelref:=true;
  1017. hasvar:=true;
  1018. SetupVar:=TRUE;
  1019. Exit;
  1020. end
  1021. {$endif i8086}
  1022. else
  1023. begin
  1024. Message(asmr_e_unsupported_symbol_type);
  1025. exit;
  1026. end;
  1027. end;
  1028. end;
  1029. procedure TOperand.InitRef;
  1030. {*********************************************************************}
  1031. { Description: This routine first check if the opcode is of }
  1032. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  1033. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  1034. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  1035. { to point to the default segment. }
  1036. {*********************************************************************}
  1037. var
  1038. l : aint;
  1039. hsymofs : aint;
  1040. hsymbol : tasmsymbol;
  1041. reg : tregister;
  1042. hsym_farprocentry: Boolean;
  1043. Begin
  1044. case opr.typ of
  1045. OPR_REFERENCE :
  1046. exit;
  1047. OPR_CONSTANT :
  1048. begin
  1049. l:=opr.val;
  1050. opr.typ:=OPR_REFERENCE;
  1051. Fillchar(opr.ref,sizeof(treference),0);
  1052. opr.Ref.Offset:=l;
  1053. opr.varsize:=0;
  1054. opr.constoffset:=0;
  1055. opr.ref_farproc_entry:=false;
  1056. end;
  1057. OPR_NONE :
  1058. begin
  1059. opr.typ:=OPR_REFERENCE;
  1060. opr.varsize:=0;
  1061. opr.constoffset:=0;
  1062. opr.ref_farproc_entry:=false;
  1063. Fillchar(opr.ref,sizeof(treference),0);
  1064. end;
  1065. OPR_REGISTER :
  1066. begin
  1067. reg:=opr.reg;
  1068. opr.typ:=OPR_REFERENCE;
  1069. opr.varsize:=0;
  1070. opr.constoffset:=0;
  1071. opr.ref_farproc_entry:=false;
  1072. Fillchar(opr.ref,sizeof(treference),0);
  1073. opr.Ref.base:=reg;
  1074. end;
  1075. OPR_SYMBOL :
  1076. begin
  1077. hsymbol:=opr.symbol;
  1078. hsymofs:=opr.symofs;
  1079. hsym_farprocentry:=opr.sym_farproc_entry;
  1080. opr.typ:=OPR_REFERENCE;
  1081. opr.varsize:=0;
  1082. opr.constoffset:=0;
  1083. Fillchar(opr.ref,sizeof(treference),0);
  1084. opr.ref.symbol:=hsymbol;
  1085. opr.ref.offset:=hsymofs;
  1086. opr.ref_farproc_entry:=hsym_farprocentry;
  1087. end;
  1088. else
  1089. InitRefError;
  1090. end;
  1091. end;
  1092. procedure TOperand.InitRefConvertLocal;
  1093. var
  1094. localvarsize,localconstoffset: asizeint;
  1095. localsym:tabstractnormalvarsym;
  1096. localsymofs:aint;
  1097. {$ifdef x86}
  1098. localsegment,
  1099. {$endif x86}
  1100. localindexreg:tregister;
  1101. localscale:byte;
  1102. begin
  1103. if opr.typ=OPR_LOCAL then
  1104. begin
  1105. if AsmRegisterPara(opr.localsym) and
  1106. not opr.localgetoffset then
  1107. begin
  1108. localvarsize:=opr.localvarsize;
  1109. localconstoffset:=opr.localconstoffset;
  1110. localsym:=opr.localsym;
  1111. localsymofs:=opr.localsymofs;
  1112. {$ifdef x86}
  1113. localsegment:=opr.localsegment;
  1114. {$endif x86}
  1115. localindexreg:=opr.localindexreg;
  1116. localscale:=opr.localscale;
  1117. opr.typ:=OPR_REFERENCE;
  1118. hasvar:=false;
  1119. Fillchar(opr.ref,sizeof(treference),0);
  1120. opr.varsize:=localvarsize;
  1121. opr.constoffset:=localconstoffset;
  1122. opr.ref_farproc_entry:=false;
  1123. opr.ref.base:=tparavarsym(localsym).paraloc[calleeside].Location^.register;
  1124. opr.ref.offset:=localsymofs;
  1125. {$ifdef x86}
  1126. opr.ref.segment:=localsegment;
  1127. {$endif x86}
  1128. opr.ref.index:=localindexreg;
  1129. opr.ref.scalefactor:=localscale;
  1130. end
  1131. else
  1132. InitRefError;
  1133. end
  1134. else
  1135. InitRef;
  1136. end;
  1137. procedure TOperand.InitRefError;
  1138. begin
  1139. Message(asmr_e_invalid_operand_type);
  1140. { Recover }
  1141. opr.typ:=OPR_REFERENCE;
  1142. opr.varsize:=0;
  1143. opr.constoffset:=0;
  1144. opr.ref_farproc_entry:=false;
  1145. Fillchar(opr.ref,sizeof(treference),0);
  1146. end;
  1147. Function TOperand.CheckOperand(ins : TInstruction): boolean;
  1148. {*********************************************************************}
  1149. { Description: This routine checks if the operand is of }
  1150. { valid, and returns false if it isn't. Does nothing by default. }
  1151. {*********************************************************************}
  1152. begin
  1153. result:=true;
  1154. end;
  1155. {****************************************************************************
  1156. TInstruction
  1157. ****************************************************************************}
  1158. constructor TInstruction.create(optype : tcoperand);
  1159. var
  1160. i : longint;
  1161. Begin
  1162. { these field are set to 0 anyways by the constructor helper (FK)
  1163. Opcode:=A_NONE;
  1164. Condition:=C_NONE;
  1165. Ops:=0;
  1166. }
  1167. filepos:=current_filepos;
  1168. for i:=1 to max_operands do
  1169. Operands[i]:=optype.create;
  1170. Labeled:=false;
  1171. end;
  1172. destructor TInstruction.destroy;
  1173. var
  1174. i : longint;
  1175. Begin
  1176. for i:=1 to max_operands do
  1177. FreeAndNil(Operands[i]);
  1178. end;
  1179. function TInstruction.ConcatInstruction(p:TAsmList) : tai;
  1180. var
  1181. ai : taicpu;
  1182. i : longint;
  1183. begin
  1184. for i:=1 to Ops do
  1185. operands[i].CheckOperand(self);
  1186. ai:=taicpu.op_none(opcode);
  1187. ai.fileinfo:=filepos;
  1188. ai.Ops:=Ops;
  1189. ai.Allocate_oper(Ops);
  1190. for i:=1 to Ops do
  1191. with operands[i].opr do
  1192. begin
  1193. case typ of
  1194. OPR_CONSTANT :
  1195. ai.loadconst(i-1,val);
  1196. OPR_REGISTER:
  1197. ai.loadreg(i-1,reg);
  1198. OPR_SYMBOL:
  1199. ai.loadsymbol(i-1,symbol,symofs);
  1200. OPR_LOCAL :
  1201. begin
  1202. ai.loadlocal(i-1,localsym,localsymofs,localindexreg,
  1203. localscale,localgetoffset,localforceref);
  1204. {$ifdef x86}
  1205. ai.oper[i-1]^.localoper^.localsegment:=localsegment;
  1206. {$endif x86}
  1207. end;
  1208. OPR_REFERENCE:
  1209. ai.loadref(i-1,ref);
  1210. {$ifdef m68k}
  1211. OPR_REGSET:
  1212. ai.loadregset(i-1,regsetdata,regsetaddr,regsetfpu);
  1213. OPR_REGPAIR:
  1214. ai.loadregpair(i-1,reghi,reglo);
  1215. {$endif}
  1216. {$ifdef ARM}
  1217. OPR_REGSET:
  1218. ai.loadregset(i-1,regtype,subreg,regset,usermode);
  1219. OPR_MODEFLAGS:
  1220. ai.loadmodeflags(i-1,flags);
  1221. OPR_SPECIALREG:
  1222. ai.loadspecialreg(i-1,specialreg,specialregflags);
  1223. {$endif ARM}
  1224. {$if defined(arm) or defined(aarch64)}
  1225. OPR_SHIFTEROP:
  1226. ai.loadshifterop(i-1,shifterop);
  1227. OPR_COND:
  1228. ai.loadconditioncode(i-1,cc);
  1229. {$endif arm or aarch64}
  1230. {$ifdef aarch64}
  1231. OPR_REGSET:
  1232. ai.loadregset(i-1,basereg,nregs,regsetindex);
  1233. OPR_INDEXEDREG:
  1234. ai.loadindexedreg(i-1,indexedreg,regindex);
  1235. {$endif aarch64}
  1236. {$if defined(riscv32) or defined(riscv64)}
  1237. OPR_FENCEFLAGS:
  1238. ai.loadfenceflags(i-1,fenceflags);
  1239. {$endif riscv32 or riscv64}
  1240. {$ifdef wasm32}
  1241. OPR_FLOATCONSTANT:
  1242. case opcode of
  1243. a_f32_const:
  1244. ai.loadsingle(i-1,floatval);
  1245. a_f64_const:
  1246. ai.loaddouble(i-1,floatval);
  1247. else
  1248. internalerror(2024072001);
  1249. end;
  1250. OPR_FUNCTYPE:
  1251. ai.loadfunctype(i-1,functype);
  1252. {$endif wasm32}
  1253. { ignore wrong operand }
  1254. OPR_NONE:
  1255. ;
  1256. else
  1257. internalerror(200501051);
  1258. end;
  1259. end;
  1260. ai.SetCondition(condition);
  1261. { Concat the opcode or give an error }
  1262. if assigned(ai) then
  1263. p.concat(ai)
  1264. else
  1265. Message(asmr_e_invalid_opcode_and_operand);
  1266. result:=ai;
  1267. end;
  1268. {****************************************************************************
  1269. Symbol table helper routines
  1270. ****************************************************************************}
  1271. procedure AddAbsoluteSymRefs(sym: tabsolutevarsym); forward;
  1272. procedure MaybeAddSymRef(sym: tsym);
  1273. begin
  1274. case sym.typ of
  1275. absolutevarsym:
  1276. AddAbsoluteSymRefs(tabsolutevarsym(sym));
  1277. staticvarsym:
  1278. if not(vo_is_external in tstaticvarsym(sym).varoptions) then
  1279. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),tstaticvarsym(sym).vardef,true);
  1280. procsym:
  1281. begin
  1282. { if it's a pure assembler routine, the definition of the symbol will also
  1283. be in assembler and it can't be removed by the compiler (and if we mark
  1284. it as used anyway, clang will get into trouble) }
  1285. if not(po_assembler in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) and
  1286. not(po_external in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) then
  1287. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION),tprocdef(tprocsym(sym).ProcdefList[0]),true);
  1288. end;
  1289. else
  1290. ;
  1291. end;
  1292. end;
  1293. procedure AddAbsoluteSymRefs(sym: tabsolutevarsym);
  1294. var
  1295. symlist: ppropaccesslistitem;
  1296. begin
  1297. case sym.abstyp of
  1298. toaddr:
  1299. ;
  1300. toasm:
  1301. begin
  1302. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),sym.vardef,true);
  1303. end;
  1304. tovar:
  1305. begin
  1306. symlist:=tabsolutevarsym(sym).ref.firstsym;
  1307. repeat
  1308. case symlist^.sltype of
  1309. sl_load:
  1310. MaybeAddSymRef(symlist^.sym);
  1311. sl_subscript,
  1312. sl_absolutetype,
  1313. sl_typeconv,
  1314. sl_vec:
  1315. ;
  1316. else
  1317. internalerror(2009031401);
  1318. end;
  1319. symlist:=symlist^.next;
  1320. until not assigned(symlist);
  1321. end;
  1322. end;
  1323. end;
  1324. procedure AsmSearchSym(const s:string;out srsym:tsym;out srsymtable:TSymtable);
  1325. var
  1326. i : integer;
  1327. begin
  1328. i:=pos('.',s);
  1329. { allow unit.identifier }
  1330. if i>1 then
  1331. begin
  1332. searchsym(Copy(s,1,i-1),srsym,srsymtable);
  1333. if assigned(srsym) then
  1334. begin
  1335. if (srsym.typ=unitsym) and
  1336. (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
  1337. srsym.owner.iscurrentunit then
  1338. searchsym_in_module(tunitsym(srsym).module,Copy(s,i+1,255),srsym,srsymtable)
  1339. else
  1340. begin
  1341. srsym:=nil;
  1342. srsymtable:=nil;
  1343. end;
  1344. end;
  1345. end
  1346. else
  1347. searchsym(s,srsym,srsymtable);
  1348. { in asm routines, the function result variable, that matches the function
  1349. name should be avoided, because:
  1350. 1) there's already a @Result directive (even in TP7) that can be used, if
  1351. you want to access the function result
  1352. 2) there's no other way to disambiguate between the function result variable
  1353. and the function's address (using asm syntax only)
  1354. This fixes code, such as:
  1355. function test1: word;
  1356. begin
  1357. asm
  1358. mov ax, offset test1
  1359. end;
  1360. end;
  1361. and makes it work in a consistent manner as this code:
  1362. procedure test2;
  1363. begin
  1364. asm
  1365. mov ax, offset test2
  1366. end;
  1367. end; }
  1368. if assigned(srsym) and
  1369. assigned(srsymtable) and
  1370. (srsym.typ=absolutevarsym) and
  1371. (vo_is_funcret in tabsolutevarsym(srsym).varoptions) and
  1372. (srsymtable.symtabletype=localsymtable) and
  1373. assigned(srsymtable.defowner) and
  1374. (srsymtable.defowner.typ=procdef) and
  1375. (tprocdef(srsymtable.defowner).procsym.name=tabsolutevarsym(srsym).Name) then
  1376. begin
  1377. srsym:=tprocdef(srsymtable.defowner).procsym;
  1378. srsymtable:=srsym.Owner;
  1379. end;
  1380. { llvm can't catch symbol references from inline assembler blocks }
  1381. if assigned(srsym) then
  1382. MaybeAddSymRef(srsym);
  1383. end;
  1384. Function SearchType(const hs:string;out size:tcgint): Boolean;
  1385. var
  1386. srsym : tsym;
  1387. srsymtable : TSymtable;
  1388. begin
  1389. result:=false;
  1390. size:=0;
  1391. asmsearchsym(hs,srsym,srsymtable);
  1392. if assigned(srsym) and
  1393. (srsym.typ=typesym) then
  1394. begin
  1395. size:=ttypesym(srsym).typedef.size;
  1396. result:=true;
  1397. end;
  1398. end;
  1399. Function SearchRecordType(const s:string): boolean;
  1400. var
  1401. srsym : tsym;
  1402. srsymtable : TSymtable;
  1403. Begin
  1404. SearchRecordType:=false;
  1405. { Check the constants in symtable }
  1406. asmsearchsym(s,srsym,srsymtable);
  1407. if srsym <> nil then
  1408. Begin
  1409. case srsym.typ of
  1410. typesym :
  1411. begin
  1412. if ttypesym(srsym).typedef.typ in [recorddef,objectdef] then
  1413. begin
  1414. SearchRecordType:=true;
  1415. exit;
  1416. end;
  1417. end;
  1418. fieldvarsym :
  1419. begin
  1420. if (tfieldvarsym(srsym).vardef.typ in [recorddef,objectdef]) then
  1421. begin
  1422. SearchRecordType:=true;
  1423. exit;
  1424. end;
  1425. end;
  1426. else
  1427. ;
  1428. end;
  1429. end;
  1430. end;
  1431. Function SearchIConstant(const s:string; var l:tcgint): boolean;
  1432. {**********************************************************************}
  1433. { Description: Searches for a CONSTANT of name s in either the local }
  1434. { symbol list, then in the global symbol list, and returns the value }
  1435. { of that constant in l. Returns TRUE if successfull, if not found, }
  1436. { or if the constant is not of correct type, then returns FALSE }
  1437. { Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
  1438. { respectively. }
  1439. {**********************************************************************}
  1440. var
  1441. srsym : tsym;
  1442. srsymtable : TSymtable;
  1443. Begin
  1444. SearchIConstant:=false;
  1445. { check for TRUE or FALSE reserved words first }
  1446. if s = 'TRUE' then
  1447. Begin
  1448. SearchIConstant:=TRUE;
  1449. l:=1;
  1450. exit;
  1451. end;
  1452. if s = 'FALSE' then
  1453. Begin
  1454. SearchIConstant:=TRUE;
  1455. l:=0;
  1456. exit;
  1457. end;
  1458. { Check the constants in symtable }
  1459. asmsearchsym(s,srsym,srsymtable);
  1460. if srsym <> nil then
  1461. Begin
  1462. case srsym.typ of
  1463. constsym :
  1464. begin
  1465. if tconstsym(srsym).consttyp=constord then
  1466. Begin
  1467. l:=tconstsym(srsym).value.valueord.svalue;
  1468. SearchIConstant:=TRUE;
  1469. exit;
  1470. end;
  1471. end;
  1472. enumsym:
  1473. Begin
  1474. l:=tenumsym(srsym).value;
  1475. SearchIConstant:=TRUE;
  1476. exit;
  1477. end;
  1478. else
  1479. ;
  1480. end;
  1481. end;
  1482. end;
  1483. function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
  1484. begin
  1485. result:=
  1486. (po_assembler in current_procinfo.procdef.procoptions) and
  1487. (sym.typ=paravarsym) and
  1488. (tparavarsym(sym).paraloc[calleeside].Location^.Loc=LOC_REGISTER);
  1489. end;
  1490. Function GetRecordOffsetSize(s:string;out Offset: tcgint;out Size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
  1491. { search and returns the offset and size of records/objects of the base }
  1492. { with field name setup in field. }
  1493. { returns FALSE if not found. }
  1494. { used when base is a variable or a typed constant name. }
  1495. var
  1496. st : TSymtable;
  1497. harrdef : tarraydef;
  1498. sym : tsym;
  1499. srsymtable : TSymtable;
  1500. i : longint;
  1501. base : string;
  1502. procdef: tprocdef;
  1503. Begin
  1504. GetRecordOffsetSize:=FALSE;
  1505. Offset:=0;
  1506. Size:=0;
  1507. mangledname:='';
  1508. hastypecast:=false;
  1509. i:=pos('.',s);
  1510. if i=0 then
  1511. i:=255;
  1512. base:=Copy(s,1,i-1);
  1513. delete(s,1,i);
  1514. if base='SELF' then
  1515. st:=current_structdef.symtable
  1516. else
  1517. begin
  1518. asmsearchsym(base,sym,srsymtable);
  1519. { allow unitname.identifier }
  1520. if assigned(sym) and (sym.typ=unitsym) then
  1521. begin
  1522. i:=pos('.',s);
  1523. if i=0 then
  1524. i:=255;
  1525. base:=base+'.'+Copy(s,1,i-1);
  1526. delete(s,1,i);
  1527. asmsearchsym(base,sym,srsymtable);
  1528. end;
  1529. st:=nil;
  1530. { we can start with a var,type,typedconst }
  1531. if assigned(sym) then
  1532. case sym.typ of
  1533. staticvarsym,
  1534. localvarsym,
  1535. paravarsym :
  1536. st:=Tabstractvarsym(sym).vardef.GetSymtable(gs_record);
  1537. typesym :
  1538. st:=Ttypesym(sym).typedef.GetSymtable(gs_record);
  1539. else
  1540. ;
  1541. end
  1542. else
  1543. s:='';
  1544. end;
  1545. { now walk all recordsymtables }
  1546. while assigned(st) and (s<>'') do
  1547. begin
  1548. { load next field in base }
  1549. i:=pos('.',s);
  1550. if i=0 then
  1551. i:=255;
  1552. base:=Copy(s,1,i-1);
  1553. delete(s,1,i);
  1554. sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
  1555. if not assigned(sym) then
  1556. begin
  1557. Message(asmr_e_unknown_field);
  1558. GetRecordOffsetSize:=false;
  1559. exit;
  1560. end;
  1561. st:=nil;
  1562. case sym.typ of
  1563. fieldvarsym :
  1564. with Tfieldvarsym(sym) do
  1565. begin
  1566. if not tabstractrecordsymtable(sym.owner).is_packed then
  1567. inc(Offset,fieldoffset)
  1568. else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
  1569. inc(Offset,fieldoffset div 8)
  1570. else
  1571. Message(asmr_e_packed_element);
  1572. size:=getsize;
  1573. case vardef.typ of
  1574. arraydef :
  1575. begin
  1576. { for arrays try to get the element size, take care of
  1577. multiple indexes }
  1578. harrdef:=tarraydef(vardef);
  1579. while assigned(harrdef.elementdef) and
  1580. (harrdef.elementdef.typ=arraydef) do
  1581. harrdef:=tarraydef(harrdef.elementdef);
  1582. if not is_packed_array(harrdef) then
  1583. size:=harrdef.elesize
  1584. else
  1585. begin
  1586. if (harrdef.elepackedbitsize mod 8) <> 0 then
  1587. Message(asmr_e_packed_element);
  1588. size := (harrdef.elepackedbitsize + 7) div 8;
  1589. end;
  1590. end;
  1591. recorddef :
  1592. st:=trecorddef(vardef).symtable;
  1593. objectdef :
  1594. st:=tobjectdef(vardef).symtable;
  1595. else
  1596. ;
  1597. end;
  1598. end;
  1599. procsym:
  1600. begin
  1601. st:=nil;
  1602. if Tprocsym(sym).ProcdefList.Count>1 then
  1603. Message(asmr_w_calling_overload_func);
  1604. procdef:=tprocdef(tprocsym(sym).ProcdefList[0]);
  1605. if (not needvmtofs) then
  1606. begin
  1607. mangledname:=procdef.mangledname;
  1608. end
  1609. else
  1610. begin
  1611. { can only get the vmtoffset of virtual methods }
  1612. if not(po_virtualmethod in procdef.procoptions) or
  1613. is_objectpascal_helper(procdef.struct) then
  1614. Message1(asmr_e_no_vmtoffset_possible,FullTypeName(procdef,nil))
  1615. else
  1616. begin
  1617. { size = sizeof(target_system_pointer) }
  1618. size:=sizeof(pint);
  1619. offset:=tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)
  1620. end;
  1621. end;
  1622. { if something comes after the procsym, it's invalid assembler syntax }
  1623. GetRecordOffsetSize:=(s='');
  1624. exit;
  1625. end;
  1626. else
  1627. ;
  1628. end;
  1629. end;
  1630. { Support Field.Type as typecasting }
  1631. if (st=nil) and (s<>'') then
  1632. begin
  1633. asmsearchsym(s,sym,srsymtable);
  1634. if assigned(sym) and (sym.typ=typesym) then
  1635. begin
  1636. size:=ttypesym(sym).typedef.size;
  1637. s:='';
  1638. hastypecast:=true;
  1639. end;
  1640. end;
  1641. GetRecordOffsetSize:=(s='');
  1642. end;
  1643. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  1644. var
  1645. sym : tsym;
  1646. srsymtable : TSymtable;
  1647. hs : string;
  1648. Begin
  1649. hl:=nil;
  1650. SearchLabel:=false;
  1651. { Check for pascal labels, which are case insensetive }
  1652. hs:=upper(s);
  1653. asmsearchsym(hs,sym,srsymtable);
  1654. if sym=nil then
  1655. exit;
  1656. case sym.typ of
  1657. labelsym :
  1658. begin
  1659. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  1660. begin
  1661. {$ifndef LLVM}
  1662. { LLVM compiler requires that the static label RawThunkEnd
  1663. in packages/rtl-objpas/src/rtti.pp unit is set to nonlocal }
  1664. if (srsymtable.symtabletype=globalsymtable) or create_smartlink_library then
  1665. {$endif LLVM}
  1666. Tlabelsym(sym).nonlocal:=true;
  1667. if emit then
  1668. include(current_procinfo.flags,pi_has_interproclabel);
  1669. end;
  1670. if not(assigned(tlabelsym(sym).asmblocklabel)) then
  1671. if Tlabelsym(sym).nonlocal then
  1672. current_asmdata.getglobaljumplabel(tlabelsym(sym).asmblocklabel)
  1673. else
  1674. current_asmdata.getjumplabel(tlabelsym(sym).asmblocklabel);
  1675. hl:=tlabelsym(sym).asmblocklabel;
  1676. if emit then
  1677. begin
  1678. if tlabelsym(sym).defined then
  1679. Message(sym_e_label_already_defined);
  1680. tlabelsym(sym).defined:=true;
  1681. hl.defined_in_asmstatement:=true
  1682. end
  1683. else
  1684. tlabelsym(sym).used:=true;
  1685. SearchLabel:=true;
  1686. end;
  1687. else
  1688. ;
  1689. end;
  1690. end;
  1691. {*************************************************************************}
  1692. { Instruction Generation Utilities }
  1693. {*************************************************************************}
  1694. Procedure ConcatString(p : TAsmList;s:string);
  1695. {*********************************************************************}
  1696. { PROCEDURE ConcatString(s:string); }
  1697. { Description: This routine adds the character chain pointed to in }
  1698. { s to the instruction linked list. }
  1699. {*********************************************************************}
  1700. Begin
  1701. p.concat(Tai_string.Create(s));
  1702. end;
  1703. Procedure ConcatConstant(p: TAsmList; value: tcgint; constsize:byte);
  1704. {*********************************************************************}
  1705. { Description: This routine adds the value constant to the current }
  1706. { instruction linked list. }
  1707. {*********************************************************************}
  1708. var
  1709. rangelo,rangehi : int64;
  1710. Begin
  1711. case constsize of
  1712. 1 :
  1713. begin
  1714. p.concat(Tai_const.Create_8bit(byte(value)));
  1715. rangelo:=low(shortint);
  1716. rangehi:=high(byte);
  1717. end;
  1718. 2 :
  1719. begin
  1720. p.concat(Tai_const.Create_16bit(word(value)));
  1721. rangelo:=low(smallint);
  1722. rangehi:=high(word);
  1723. end;
  1724. 4 :
  1725. begin
  1726. p.concat(Tai_const.Create_32bit(longint(value)));
  1727. rangelo:=low(longint);
  1728. rangehi:=high(cardinal);
  1729. end;
  1730. 8 :
  1731. begin
  1732. p.concat(Tai_const.Create_64bit(int64(value)));
  1733. rangelo:=0;
  1734. rangehi:=0;
  1735. end;
  1736. else
  1737. internalerror(200405011);
  1738. end;
  1739. { check for out of bounds }
  1740. if (rangelo<>0) and
  1741. ((value>rangehi) or (value<rangelo)) then
  1742. Message(asmr_e_constant_out_of_bounds);
  1743. end;
  1744. Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
  1745. begin
  1746. {$ifdef i8086}
  1747. { 'DW xx' as well as 'DW OFFSET xx' are just near pointers }
  1748. if constsize=2 then
  1749. p.concat(Tai_const.Createname_near(sym,l))
  1750. else if constsize=4 then
  1751. begin
  1752. if isofs then
  1753. begin
  1754. { 'DD OFFSET xx' is a 32-bit offset; since we don't produce 32-bit
  1755. relocations yet, just do a 16-bit one and set the high word to 0 }
  1756. p.concat(Tai_const.Createname_near(sym,l));
  1757. p.concat(Tai_const.Create_16bit(0));
  1758. end
  1759. else
  1760. { 'DD xx' is a far pointer }
  1761. p.concat(Tai_const.Createname_far(sym,l));
  1762. end
  1763. else
  1764. internalerror(2018020701);
  1765. {$else i8086}
  1766. p.concat(Tai_const.Createname(sym,l));
  1767. {$endif i8086}
  1768. end;
  1769. Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
  1770. {***********************************************************************}
  1771. { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
  1772. { Description: This routine adds the value constant to the current }
  1773. { instruction linked list. }
  1774. { real_typ -> indicates the type of the real data to initialize: }
  1775. { s32real -> create a single node. }
  1776. { s64real -> create a double node. }
  1777. { s80real -> create an extended node. }
  1778. { s64bit -> create a comp node. }
  1779. { f32bit -> create a fixed node. (not used normally) }
  1780. {***********************************************************************}
  1781. Begin
  1782. case real_typ of
  1783. s32real : p.concat(tai_realconst.create_s32real(value));
  1784. s64real :
  1785. {$ifdef ARM}
  1786. if is_double_hilo_swapped then
  1787. p.concat(tai_realconst.create_s64real_hiloswapped(value))
  1788. else
  1789. {$endif ARM}
  1790. p.concat(tai_realconst.create_s64real(value));
  1791. s80real : p.concat(tai_realconst.create_s80real(value,s80floattype.size));
  1792. sc80real : p.concat(tai_realconst.create_s80real(value,sc80floattype.size));
  1793. s64comp : p.concat(tai_realconst.create_s64compreal(trunc(value)));
  1794. else
  1795. internalerror(2014050608);
  1796. end;
  1797. end;
  1798. Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
  1799. {*********************************************************************}
  1800. { PROCEDURE ConcatLabel }
  1801. { Description: This routine either emits a label or a labeled }
  1802. { instruction to the linked list of instructions. }
  1803. {*********************************************************************}
  1804. begin
  1805. p.concat(Tai_label.Create(l));
  1806. end;
  1807. procedure ConcatAlign(p:TAsmList;l:tcgint);
  1808. {*********************************************************************}
  1809. { PROCEDURE ConcatPublic }
  1810. { Description: This routine emits an global definition to the }
  1811. { linked list of instructions.(used by AT&T styled asm) }
  1812. {*********************************************************************}
  1813. begin
  1814. p.concat(Tai_align.Create(l));
  1815. end;
  1816. procedure ConcatPublic(p:TAsmList;const s : string);
  1817. {*********************************************************************}
  1818. { PROCEDURE ConcatPublic }
  1819. { Description: This routine emits an global definition to the }
  1820. { linked list of instructions.(used by AT&T styled asm) }
  1821. {*********************************************************************}
  1822. begin
  1823. p.concat(Tai_symbol.Createname_global(s,AT_LABEL,0,voidcodepointertype));
  1824. end;
  1825. procedure ConcatLocal(p:TAsmList;const s : string);
  1826. {*********************************************************************}
  1827. { PROCEDURE ConcatLocal }
  1828. { Description: This routine emits an local definition to the }
  1829. { linked list of instructions. }
  1830. {*********************************************************************}
  1831. begin
  1832. p.concat(Tai_symbol.Createname(s,AT_LABEL,0,voidcodepointertype));
  1833. end;
  1834. end.