2
0

rautils.pas 59 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973
  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. end;
  470. {*************************************************************************}
  471. { String conversions/utils }
  472. {*************************************************************************}
  473. Function EscapeToPascal(const s:string): string;
  474. { converts a C styled string - which contains escape }
  475. { characters to a pascal style string. }
  476. var
  477. i,len : asizeint;
  478. hs : string;
  479. temp : string;
  480. c : char;
  481. Begin
  482. hs:='';
  483. len:=0;
  484. i:=0;
  485. while (i<length(s)) and (len<255) do
  486. begin
  487. Inc(i);
  488. if (s[i]='\') and (i<length(s)) then
  489. Begin
  490. inc(i);
  491. case s[i] of
  492. '\' :
  493. c:='\';
  494. 'b':
  495. c:=#8;
  496. 'f':
  497. c:=#12;
  498. 'n':
  499. c:=#10;
  500. 'r':
  501. c:=#13;
  502. 't':
  503. c:=#9;
  504. '"':
  505. c:='"';
  506. '0'..'7':
  507. Begin
  508. temp:=s[i];
  509. temp:=temp+s[i+1];
  510. temp:=temp+s[i+2];
  511. inc(i,2);
  512. c:=chr(ParseVal(temp,8));
  513. end;
  514. 'x':
  515. Begin
  516. temp:=s[i+1];
  517. temp:=temp+s[i+2];
  518. inc(i,2);
  519. c:=chr(ParseVal(temp,16));
  520. end;
  521. else
  522. Begin
  523. Message1(asmr_e_escape_seq_ignored,s[i]);
  524. c:=s[i];
  525. end;
  526. end;
  527. end
  528. else
  529. c:=s[i];
  530. inc(len);
  531. hs[len]:=c;
  532. end;
  533. hs[0]:=chr(len);
  534. EscapeToPascal:=hs;
  535. end;
  536. Function ParseVal(const S:String;base:byte):tcgint;
  537. { Converts a decimal string to tcgint }
  538. var
  539. code : integer;
  540. errmsg : word;
  541. prefix : string[2];
  542. Begin
  543. case base of
  544. 2 :
  545. begin
  546. errmsg:=asmr_e_error_converting_binary;
  547. prefix:='%';
  548. end;
  549. 8 :
  550. begin
  551. errmsg:=asmr_e_error_converting_octal;
  552. prefix:='&';
  553. end;
  554. 10 :
  555. begin
  556. errmsg:=asmr_e_error_converting_decimal;
  557. prefix:='';
  558. end;
  559. 16 :
  560. begin
  561. errmsg:=asmr_e_error_converting_hexadecimal;
  562. prefix:='$';
  563. end;
  564. else
  565. internalerror(200501202);
  566. end;
  567. val(prefix+s,result,code);
  568. if code<>0 then
  569. begin
  570. val(prefix+s,result,code);
  571. if code<>0 then
  572. begin
  573. Message1(errmsg,s);
  574. result:=0;
  575. end;
  576. end;
  577. end;
  578. Function PadZero(Var s: String; n: byte): Boolean;
  579. Begin
  580. PadZero:=TRUE;
  581. { Do some error checking first }
  582. if Length(s) = n then
  583. exit
  584. else
  585. if Length(s) > n then
  586. Begin
  587. PadZero:=FALSE;
  588. delete(s,n+1,length(s));
  589. exit;
  590. end
  591. else
  592. PadZero:=TRUE;
  593. { Fill it up with the specified character }
  594. fillchar(s[length(s)+1],n-1,#0);
  595. s[0]:=chr(n);
  596. end;
  597. {****************************************************************************
  598. TOperand
  599. ****************************************************************************}
  600. constructor TOperand.Create;
  601. begin
  602. size:=OS_NO;
  603. hasproc:=false;
  604. hastype:=false;
  605. hasvar:=false;
  606. FillChar(Opr,sizeof(Opr),0);
  607. end;
  608. destructor TOperand.destroy;
  609. begin
  610. end;
  611. Procedure TOperand.SetSize(_size:longint;force:boolean);
  612. begin
  613. if force or
  614. ((size = OS_NO) and (_size<=16)) then
  615. Begin
  616. case _size of
  617. 1 : size:=OS_8;
  618. 2 : size:=OS_16{ could be S_IS};
  619. 4 : size:=OS_32{ could be S_IL or S_FS};
  620. 8 : size:=OS_64{ could be S_D or S_FL};
  621. 10 : size:=OS_F80;
  622. 16 : size:=OS_128;
  623. end;
  624. end;
  625. end;
  626. Procedure TOperand.SetCorrectSize(opcode:tasmop);
  627. begin
  628. end;
  629. function TOperand.SetupResult:boolean;
  630. begin
  631. SetupResult:=false;
  632. { replace by correct offset. }
  633. with current_procinfo.procdef do
  634. if (not is_void(returndef)) then
  635. begin
  636. if (m_tp7 in current_settings.modeswitches) and
  637. not (df_generic in defoptions) and
  638. (po_assembler in procoptions) and
  639. (not paramanager.ret_in_param(returndef,current_procinfo.procdef)) then
  640. begin
  641. message(asmr_e_cannot_use_RESULT_here);
  642. exit;
  643. end;
  644. SetupResult:=setupvar('result',false)
  645. end
  646. else
  647. message(asmr_e_void_function);
  648. end;
  649. Function TOperand.SetupSelf:boolean;
  650. Begin
  651. SetupSelf:=false;
  652. if assigned(current_structdef) then
  653. SetupSelf:=setupvar('self',false)
  654. else
  655. Message(asmr_e_cannot_use_SELF_outside_a_method);
  656. end;
  657. Function TOperand.SetupOldEBP:boolean;
  658. Begin
  659. SetupOldEBP:=false;
  660. if current_procinfo.procdef.parast.symtablelevel>normal_function_level then
  661. SetupOldEBP:=setupvar('parentframe',false)
  662. else
  663. Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
  664. end;
  665. Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean;
  666. function symtable_has_localvarsyms(st:TSymtable):boolean;
  667. var
  668. sym : tsym;
  669. i : longint;
  670. begin
  671. result:=false;
  672. for i:=0 to st.SymList.Count-1 do
  673. begin
  674. sym:=tsym(st.SymList[i]);
  675. if sym.typ=localvarsym then
  676. begin
  677. result:=true;
  678. exit;
  679. end;
  680. end;
  681. end;
  682. procedure setconst(l:aint);
  683. begin
  684. { We return the address of the field, just like Delphi/TP }
  685. case opr.typ of
  686. OPR_NONE :
  687. begin
  688. opr.typ:=OPR_CONSTANT;
  689. opr.val:=l;
  690. end;
  691. OPR_CONSTANT :
  692. inc(opr.val,l);
  693. OPR_REFERENCE :
  694. inc(opr.ref.offset,l);
  695. OPR_LOCAL :
  696. inc(opr.localsymofs,l);
  697. else
  698. Message(asmr_e_invalid_operand_type);
  699. end;
  700. end;
  701. procedure setvarsize(sym: tabstractvarsym);
  702. var
  703. harrdef: tarraydef;
  704. l: asizeint;
  705. begin
  706. case sym.vardef.typ of
  707. orddef,
  708. enumdef,
  709. pointerdef,
  710. procvardef,
  711. floatdef :
  712. SetSize(sym.getsize,false);
  713. arraydef :
  714. begin
  715. { for arrays try to get the element size, take care of
  716. multiple indexes }
  717. harrdef:=tarraydef(sym.vardef);
  718. { calc array size }
  719. if is_special_array(harrdef) then
  720. l := -1
  721. else
  722. l := harrdef.size;
  723. case opr.typ of
  724. OPR_REFERENCE: opr.varsize := l;
  725. OPR_LOCAL: opr.localvarsize := l;
  726. else
  727. ;
  728. end;
  729. while assigned(harrdef.elementdef) and
  730. (harrdef.elementdef.typ=arraydef) do
  731. harrdef:=tarraydef(harrdef.elementdef);
  732. if not is_packed_array(harrdef) then
  733. SetSize(harrdef.elesize,false)
  734. else
  735. if (harrdef.elepackedbitsize mod 8) = 0 then
  736. SetSize(harrdef.elepackedbitsize div 8,false);
  737. end;
  738. recorddef:
  739. case opr.typ of
  740. OPR_REFERENCE: opr.varsize := sym.getsize;
  741. OPR_LOCAL: opr.localvarsize := sym.getsize;
  742. else
  743. ;
  744. end;
  745. else
  746. ;
  747. end;
  748. end;
  749. { search and sets up the correct fields in the Instr record }
  750. { for the NON-constant identifier passed to the routine. }
  751. { if not found returns FALSE. }
  752. var
  753. sym : tsym;
  754. srsymtable : TSymtable;
  755. {$ifdef x86}
  756. segreg,
  757. {$endif x86}
  758. indexreg : tregister;
  759. plist : ppropaccesslistitem;
  760. size_set_from_absolute : boolean = false;
  761. { offset fixup (in bytes), coming from an absolute declaration with an index
  762. (e.g. var tralala: word absolute moo[5]; ) }
  763. absoffset: asizeint=0;
  764. harrdef: tarraydef;
  765. tmpprocinfo: tprocinfo;
  766. Begin
  767. SetupVar:=false;
  768. asmsearchsym(s,sym,srsymtable);
  769. if sym = nil then
  770. exit;
  771. if sym.typ=absolutevarsym then
  772. begin
  773. case tabsolutevarsym(sym).abstyp of
  774. tovar:
  775. begin
  776. { Only support simple loads }
  777. plist:=tabsolutevarsym(sym).ref.firstsym;
  778. if assigned(plist) and
  779. (plist^.sltype=sl_load) then
  780. begin
  781. setvarsize(tabstractvarsym(sym));
  782. size_set_from_absolute:=true;
  783. sym:=plist^.sym;
  784. { Check if address can be resolved, but only if not an array }
  785. if (sym.typ=absolutevarsym) and (tabsolutevarsym(sym).abstyp=toaddr) and not
  786. (assigned(plist^.next) and (plist^.next^.sltype=sl_vec)) then
  787. begin
  788. initref;
  789. opr.ref.offset:=tabsolutevarsym(sym).addroffset;
  790. hasvar:=true;
  791. Result:=true;
  792. exit;
  793. end;
  794. { resolve the chain of array indexes (if there are any) }
  795. harrdef:=nil;
  796. while assigned(plist^.next) do
  797. begin
  798. plist:=plist^.next;
  799. if (plist^.sltype=sl_vec) and (tabstractvarsym(sym).vardef.typ=arraydef) then
  800. begin
  801. if harrdef=nil then
  802. harrdef:=tarraydef(tabstractvarsym(sym).vardef)
  803. else if harrdef.elementdef.typ=arraydef then
  804. harrdef:=tarraydef(harrdef.elementdef)
  805. else
  806. begin
  807. Message(asmr_e_unsupported_symbol_type);
  808. exit;
  809. end;
  810. if is_special_array(harrdef) then
  811. begin
  812. Message(asmr_e_unsupported_symbol_type);
  813. exit;
  814. end;
  815. if not is_packed_array(harrdef) then
  816. Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange))*harrdef.elesize)
  817. else if (Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize mod 8)=0 then
  818. Inc(absoffset,asizeint(Int64(plist^.value-harrdef.lowrange)*harrdef.elepackedbitsize div 8))
  819. else
  820. Message(asmr_e_packed_element);
  821. end
  822. else
  823. begin
  824. Message(asmr_e_unsupported_symbol_type);
  825. exit;
  826. end;
  827. end;
  828. end
  829. else
  830. begin
  831. Message(asmr_e_unsupported_symbol_type);
  832. exit;
  833. end;
  834. end;
  835. toaddr:
  836. begin
  837. initref;
  838. opr.ref.offset:=tabsolutevarsym(sym).addroffset;
  839. setvarsize(tabstractvarsym(sym));
  840. size_set_from_absolute:=true;
  841. hasvar:=true;
  842. Result:=true;
  843. exit;
  844. end;
  845. else
  846. begin
  847. Message(asmr_e_unsupported_symbol_type);
  848. exit;
  849. end;
  850. end;
  851. end;
  852. case sym.typ of
  853. fieldvarsym :
  854. begin
  855. if not tabstractrecordsymtable(sym.owner).is_packed then
  856. setconst(absoffset+tfieldvarsym(sym).fieldoffset)
  857. else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
  858. setconst(absoffset+tfieldvarsym(sym).fieldoffset div 8)
  859. else
  860. Message(asmr_e_packed_element);
  861. if not size_set_from_absolute then
  862. setvarsize(tabstractvarsym(sym));
  863. hasvar:=true;
  864. SetupVar:=true;
  865. end;
  866. staticvarsym,
  867. localvarsym,
  868. paravarsym :
  869. begin
  870. { we always assume in asm statements that }
  871. { that the variable is valid. }
  872. tabstractvarsym(sym).varstate:=vs_readwritten;
  873. inc(tabstractvarsym(sym).refs);
  874. { variable can't be placed in a register }
  875. tabstractvarsym(sym).varregable:=vr_none;
  876. { and anything may happen with its address }
  877. tabstractvarsym(sym).addr_taken:=true;
  878. case sym.typ of
  879. staticvarsym :
  880. begin
  881. initref;
  882. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(sym).mangledname,AT_DATA);
  883. Inc(opr.ref.offset,absoffset);
  884. end;
  885. paravarsym,
  886. localvarsym :
  887. begin
  888. tmpprocinfo:=current_procinfo;
  889. while assigned(tmpprocinfo) do
  890. begin
  891. if (sym.owner=tmpprocinfo.procdef.localst) or
  892. (sym.owner=tmpprocinfo.procdef.parast) then
  893. begin
  894. tmpprocinfo.procdef.init_paraloc_info(calleeside);
  895. break;
  896. end;
  897. tmpprocinfo:=tmpprocinfo.parent;
  898. end;
  899. if opr.typ=OPR_REFERENCE then
  900. begin
  901. {$ifdef x86}
  902. segreg:=opr.ref.segment;
  903. {$endif x86}
  904. indexreg:=opr.ref.base;
  905. if opr.ref.index<>NR_NO then
  906. begin
  907. if indexreg=NR_NO then
  908. indexreg:=opr.ref.index
  909. else
  910. Message(asmr_e_multiple_index);
  911. end;
  912. end
  913. else
  914. begin
  915. {$ifdef x86}
  916. segreg:=NR_NO;
  917. {$endif x86}
  918. indexreg:=NR_NO;
  919. end;
  920. opr.typ:=OPR_LOCAL;
  921. if assigned(current_procinfo.parent) and
  922. not(po_inline in current_procinfo.procdef.procoptions) and
  923. (sym.owner<>current_procinfo.procdef.localst) and
  924. (sym.owner<>current_procinfo.procdef.parast) and
  925. (current_procinfo.procdef.localst.symtablelevel>normal_function_level) and
  926. symtable_has_localvarsyms(current_procinfo.procdef.localst) then
  927. message1(asmr_e_local_para_unreachable,s);
  928. opr.localsym:=tabstractnormalvarsym(sym);
  929. opr.localsymofs:=absoffset;
  930. {$ifdef x86}
  931. opr.localsegment:=segreg;
  932. {$endif x86}
  933. opr.localindexreg:=indexreg;
  934. opr.localscale:=0;
  935. opr.localgetoffset:=GetOffset;
  936. if paramanager.push_addr_param(tabstractvarsym(sym).varspez,tabstractvarsym(sym).vardef,current_procinfo.procdef.proccalloption) then
  937. SetSize(sizeof(pint),false);
  938. end;
  939. else
  940. ;
  941. end;
  942. if not size_set_from_absolute then
  943. setvarsize(tabstractvarsym(sym));
  944. hasvar:=true;
  945. SetupVar:=true;
  946. Exit;
  947. end;
  948. constsym :
  949. begin
  950. if tconstsym(sym).consttyp=constord then
  951. begin
  952. setconst(tconstsym(sym).value.valueord.svalue);
  953. SetupVar:=true;
  954. Exit;
  955. end;
  956. end;
  957. typesym :
  958. begin
  959. if ttypesym(sym).typedef.typ in [recorddef,objectdef] then
  960. begin
  961. setconst(0);
  962. SetupVar:=TRUE;
  963. Exit;
  964. end;
  965. end;
  966. procsym :
  967. begin
  968. if Tprocsym(sym).ProcdefList.Count>1 then
  969. Message(asmr_w_calling_overload_func);
  970. case opr.typ of
  971. OPR_REFERENCE:
  972. begin
  973. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
  974. Inc(opr.ref.offset,absoffset);
  975. {$ifdef i8086}
  976. opr.ref_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  977. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
  978. {$endif i8086}
  979. end;
  980. OPR_NONE:
  981. begin
  982. opr.typ:=OPR_SYMBOL;
  983. opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION);
  984. {$ifdef i8086}
  985. opr.sym_farproc_entry:=is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  986. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions);
  987. {$endif i8086}
  988. opr.symofs:=absoffset;
  989. end;
  990. else
  991. Message(asmr_e_invalid_operand_type);
  992. end;
  993. hasproc:=true;
  994. hasvar:=true;
  995. SetupVar:=TRUE;
  996. Exit;
  997. end;
  998. {$ifdef i8086}
  999. labelsym :
  1000. begin
  1001. case opr.typ of
  1002. OPR_REFERENCE:
  1003. begin
  1004. opr.ref.symbol:=current_asmdata.RefAsmSymbol(tlabelsym(sym).mangledname,AT_FUNCTION);
  1005. Inc(opr.ref.offset,absoffset);
  1006. if opr.ref.segment=NR_NO then
  1007. opr.ref.segment:=NR_CS;
  1008. end;
  1009. else
  1010. begin
  1011. Message(asmr_e_unsupported_symbol_type);
  1012. exit;
  1013. end;
  1014. end;
  1015. haslabelref:=true;
  1016. hasvar:=true;
  1017. SetupVar:=TRUE;
  1018. Exit;
  1019. end
  1020. {$endif i8086}
  1021. else
  1022. begin
  1023. Message(asmr_e_unsupported_symbol_type);
  1024. exit;
  1025. end;
  1026. end;
  1027. end;
  1028. procedure TOperand.InitRef;
  1029. {*********************************************************************}
  1030. { Description: This routine first check if the opcode is of }
  1031. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  1032. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  1033. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  1034. { to point to the default segment. }
  1035. {*********************************************************************}
  1036. var
  1037. l : aint;
  1038. hsymofs : aint;
  1039. hsymbol : tasmsymbol;
  1040. reg : tregister;
  1041. hsym_farprocentry: Boolean;
  1042. Begin
  1043. case opr.typ of
  1044. OPR_REFERENCE :
  1045. exit;
  1046. OPR_CONSTANT :
  1047. begin
  1048. l:=opr.val;
  1049. opr.typ:=OPR_REFERENCE;
  1050. Fillchar(opr.ref,sizeof(treference),0);
  1051. opr.Ref.Offset:=l;
  1052. opr.varsize:=0;
  1053. opr.constoffset:=0;
  1054. opr.ref_farproc_entry:=false;
  1055. end;
  1056. OPR_NONE :
  1057. begin
  1058. opr.typ:=OPR_REFERENCE;
  1059. opr.varsize:=0;
  1060. opr.constoffset:=0;
  1061. opr.ref_farproc_entry:=false;
  1062. Fillchar(opr.ref,sizeof(treference),0);
  1063. end;
  1064. OPR_REGISTER :
  1065. begin
  1066. reg:=opr.reg;
  1067. opr.typ:=OPR_REFERENCE;
  1068. opr.varsize:=0;
  1069. opr.constoffset:=0;
  1070. opr.ref_farproc_entry:=false;
  1071. Fillchar(opr.ref,sizeof(treference),0);
  1072. opr.Ref.base:=reg;
  1073. end;
  1074. OPR_SYMBOL :
  1075. begin
  1076. hsymbol:=opr.symbol;
  1077. hsymofs:=opr.symofs;
  1078. hsym_farprocentry:=opr.sym_farproc_entry;
  1079. opr.typ:=OPR_REFERENCE;
  1080. opr.varsize:=0;
  1081. opr.constoffset:=0;
  1082. Fillchar(opr.ref,sizeof(treference),0);
  1083. opr.ref.symbol:=hsymbol;
  1084. opr.ref.offset:=hsymofs;
  1085. opr.ref_farproc_entry:=hsym_farprocentry;
  1086. end;
  1087. else
  1088. InitRefError;
  1089. end;
  1090. end;
  1091. procedure TOperand.InitRefConvertLocal;
  1092. var
  1093. localvarsize,localconstoffset: asizeint;
  1094. localsym:tabstractnormalvarsym;
  1095. localsymofs:aint;
  1096. {$ifdef x86}
  1097. localsegment,
  1098. {$endif x86}
  1099. localindexreg:tregister;
  1100. localscale:byte;
  1101. begin
  1102. if opr.typ=OPR_LOCAL then
  1103. begin
  1104. if AsmRegisterPara(opr.localsym) and
  1105. not opr.localgetoffset then
  1106. begin
  1107. localvarsize:=opr.localvarsize;
  1108. localconstoffset:=opr.localconstoffset;
  1109. localsym:=opr.localsym;
  1110. localsymofs:=opr.localsymofs;
  1111. {$ifdef x86}
  1112. localsegment:=opr.localsegment;
  1113. {$endif x86}
  1114. localindexreg:=opr.localindexreg;
  1115. localscale:=opr.localscale;
  1116. opr.typ:=OPR_REFERENCE;
  1117. hasvar:=false;
  1118. Fillchar(opr.ref,sizeof(treference),0);
  1119. opr.varsize:=localvarsize;
  1120. opr.constoffset:=localconstoffset;
  1121. opr.ref_farproc_entry:=false;
  1122. opr.ref.base:=tparavarsym(localsym).paraloc[calleeside].Location^.register;
  1123. opr.ref.offset:=localsymofs;
  1124. {$ifdef x86}
  1125. opr.ref.segment:=localsegment;
  1126. {$endif x86}
  1127. opr.ref.index:=localindexreg;
  1128. opr.ref.scalefactor:=localscale;
  1129. end
  1130. else
  1131. InitRefError;
  1132. end
  1133. else
  1134. InitRef;
  1135. end;
  1136. procedure TOperand.InitRefError;
  1137. begin
  1138. Message(asmr_e_invalid_operand_type);
  1139. { Recover }
  1140. opr.typ:=OPR_REFERENCE;
  1141. opr.varsize:=0;
  1142. opr.constoffset:=0;
  1143. opr.ref_farproc_entry:=false;
  1144. Fillchar(opr.ref,sizeof(treference),0);
  1145. end;
  1146. Function TOperand.CheckOperand(ins : TInstruction): boolean;
  1147. {*********************************************************************}
  1148. { Description: This routine checks if the operand is of }
  1149. { valid, and returns false if it isn't. Does nothing by default. }
  1150. {*********************************************************************}
  1151. begin
  1152. result:=true;
  1153. end;
  1154. {****************************************************************************
  1155. TInstruction
  1156. ****************************************************************************}
  1157. constructor TInstruction.create(optype : tcoperand);
  1158. var
  1159. i : longint;
  1160. Begin
  1161. { these field are set to 0 anyways by the constructor helper (FK)
  1162. Opcode:=A_NONE;
  1163. Condition:=C_NONE;
  1164. Ops:=0;
  1165. }
  1166. filepos:=current_filepos;
  1167. for i:=1 to max_operands do
  1168. Operands[i]:=optype.create;
  1169. Labeled:=false;
  1170. end;
  1171. destructor TInstruction.destroy;
  1172. var
  1173. i : longint;
  1174. Begin
  1175. for i:=1 to max_operands do
  1176. Operands[i].free;
  1177. end;
  1178. function TInstruction.ConcatInstruction(p:TAsmList) : tai;
  1179. var
  1180. ai : taicpu;
  1181. i : longint;
  1182. begin
  1183. for i:=1 to Ops do
  1184. operands[i].CheckOperand(self);
  1185. ai:=taicpu.op_none(opcode);
  1186. ai.fileinfo:=filepos;
  1187. ai.Ops:=Ops;
  1188. ai.Allocate_oper(Ops);
  1189. for i:=1 to Ops do
  1190. with operands[i].opr do
  1191. begin
  1192. case typ of
  1193. OPR_CONSTANT :
  1194. ai.loadconst(i-1,val);
  1195. OPR_REGISTER:
  1196. ai.loadreg(i-1,reg);
  1197. OPR_SYMBOL:
  1198. ai.loadsymbol(i-1,symbol,symofs);
  1199. OPR_LOCAL :
  1200. begin
  1201. ai.loadlocal(i-1,localsym,localsymofs,localindexreg,
  1202. localscale,localgetoffset,localforceref);
  1203. {$ifdef x86}
  1204. ai.oper[i-1]^.localoper^.localsegment:=localsegment;
  1205. {$endif x86}
  1206. end;
  1207. OPR_REFERENCE:
  1208. ai.loadref(i-1,ref);
  1209. {$ifdef m68k}
  1210. OPR_REGSET:
  1211. ai.loadregset(i-1,regsetdata,regsetaddr,regsetfpu);
  1212. OPR_REGPAIR:
  1213. ai.loadregpair(i-1,reghi,reglo);
  1214. {$endif}
  1215. {$ifdef ARM}
  1216. OPR_REGSET:
  1217. ai.loadregset(i-1,regtype,subreg,regset,usermode);
  1218. OPR_MODEFLAGS:
  1219. ai.loadmodeflags(i-1,flags);
  1220. OPR_SPECIALREG:
  1221. ai.loadspecialreg(i-1,specialreg,specialregflags);
  1222. {$endif ARM}
  1223. {$if defined(arm) or defined(aarch64)}
  1224. OPR_SHIFTEROP:
  1225. ai.loadshifterop(i-1,shifterop);
  1226. OPR_COND:
  1227. ai.loadconditioncode(i-1,cc);
  1228. {$endif arm or aarch64}
  1229. {$ifdef aarch64}
  1230. OPR_REGSET:
  1231. ai.loadregset(i-1,basereg,nregs,regsetindex);
  1232. OPR_INDEXEDREG:
  1233. ai.loadindexedreg(i-1,indexedreg,regindex);
  1234. {$endif aarch64}
  1235. {$if defined(riscv32) or defined(riscv64)}
  1236. OPR_FENCEFLAGS:
  1237. ai.loadfenceflags(i-1,fenceflags);
  1238. {$endif riscv32 or riscv64}
  1239. {$ifdef wasm32}
  1240. OPR_FLOATCONSTANT:
  1241. case opcode of
  1242. a_f32_const:
  1243. ai.loadsingle(i-1,floatval);
  1244. a_f64_const:
  1245. ai.loaddouble(i-1,floatval);
  1246. else
  1247. internalerror(2024072001);
  1248. end;
  1249. OPR_FUNCTYPE:
  1250. ai.loadfunctype(i-1,functype);
  1251. {$endif wasm32}
  1252. { ignore wrong operand }
  1253. OPR_NONE:
  1254. ;
  1255. else
  1256. internalerror(200501051);
  1257. end;
  1258. end;
  1259. ai.SetCondition(condition);
  1260. { Concat the opcode or give an error }
  1261. if assigned(ai) then
  1262. p.concat(ai)
  1263. else
  1264. Message(asmr_e_invalid_opcode_and_operand);
  1265. result:=ai;
  1266. end;
  1267. {****************************************************************************
  1268. Symbol table helper routines
  1269. ****************************************************************************}
  1270. procedure AddAbsoluteSymRefs(sym: tabsolutevarsym); forward;
  1271. procedure MaybeAddSymRef(sym: tsym);
  1272. begin
  1273. case sym.typ of
  1274. absolutevarsym:
  1275. AddAbsoluteSymRefs(tabsolutevarsym(sym));
  1276. staticvarsym:
  1277. if not(vo_is_external in tstaticvarsym(sym).varoptions) then
  1278. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),tstaticvarsym(sym).vardef,true);
  1279. procsym:
  1280. begin
  1281. { if it's a pure assembler routine, the definition of the symbol will also
  1282. be in assembler and it can't be removed by the compiler (and if we mark
  1283. it as used anyway, clang will get into trouble) }
  1284. if not(po_assembler in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) and
  1285. not(po_external in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) then
  1286. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname,AT_FUNCTION),tprocdef(tprocsym(sym).ProcdefList[0]),true);
  1287. end;
  1288. else
  1289. ;
  1290. end;
  1291. end;
  1292. procedure AddAbsoluteSymRefs(sym: tabsolutevarsym);
  1293. var
  1294. symlist: ppropaccesslistitem;
  1295. begin
  1296. case sym.abstyp of
  1297. toaddr:
  1298. ;
  1299. toasm:
  1300. begin
  1301. cnodeutils.RegisterUsedAsmSym(current_asmdata.RefAsmSymbol(sym.mangledname,AT_DATA),sym.vardef,true);
  1302. end;
  1303. tovar:
  1304. begin
  1305. symlist:=tabsolutevarsym(sym).ref.firstsym;
  1306. repeat
  1307. case symlist^.sltype of
  1308. sl_load:
  1309. MaybeAddSymRef(symlist^.sym);
  1310. sl_subscript,
  1311. sl_absolutetype,
  1312. sl_typeconv,
  1313. sl_vec:
  1314. ;
  1315. else
  1316. internalerror(2009031401);
  1317. end;
  1318. symlist:=symlist^.next;
  1319. until not assigned(symlist);
  1320. end;
  1321. end;
  1322. end;
  1323. procedure AsmSearchSym(const s:string;out srsym:tsym;out srsymtable:TSymtable);
  1324. var
  1325. i : integer;
  1326. begin
  1327. i:=pos('.',s);
  1328. { allow unit.identifier }
  1329. if i>1 then
  1330. begin
  1331. searchsym(Copy(s,1,i-1),srsym,srsymtable);
  1332. if assigned(srsym) then
  1333. begin
  1334. if (srsym.typ=unitsym) and
  1335. (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
  1336. srsym.owner.iscurrentunit then
  1337. searchsym_in_module(tunitsym(srsym).module,Copy(s,i+1,255),srsym,srsymtable)
  1338. else
  1339. begin
  1340. srsym:=nil;
  1341. srsymtable:=nil;
  1342. end;
  1343. end;
  1344. end
  1345. else
  1346. searchsym(s,srsym,srsymtable);
  1347. { in asm routines, the function result variable, that matches the function
  1348. name should be avoided, because:
  1349. 1) there's already a @Result directive (even in TP7) that can be used, if
  1350. you want to access the function result
  1351. 2) there's no other way to disambiguate between the function result variable
  1352. and the function's address (using asm syntax only)
  1353. This fixes code, such as:
  1354. function test1: word;
  1355. begin
  1356. asm
  1357. mov ax, offset test1
  1358. end;
  1359. end;
  1360. and makes it work in a consistent manner as this code:
  1361. procedure test2;
  1362. begin
  1363. asm
  1364. mov ax, offset test2
  1365. end;
  1366. end; }
  1367. if assigned(srsym) and
  1368. assigned(srsymtable) and
  1369. (srsym.typ=absolutevarsym) and
  1370. (vo_is_funcret in tabsolutevarsym(srsym).varoptions) and
  1371. (srsymtable.symtabletype=localsymtable) and
  1372. assigned(srsymtable.defowner) and
  1373. (srsymtable.defowner.typ=procdef) and
  1374. (tprocdef(srsymtable.defowner).procsym.name=tabsolutevarsym(srsym).Name) then
  1375. begin
  1376. srsym:=tprocdef(srsymtable.defowner).procsym;
  1377. srsymtable:=srsym.Owner;
  1378. end;
  1379. { llvm can't catch symbol references from inline assembler blocks }
  1380. if assigned(srsym) then
  1381. MaybeAddSymRef(srsym);
  1382. end;
  1383. Function SearchType(const hs:string;out size:tcgint): Boolean;
  1384. var
  1385. srsym : tsym;
  1386. srsymtable : TSymtable;
  1387. begin
  1388. result:=false;
  1389. size:=0;
  1390. asmsearchsym(hs,srsym,srsymtable);
  1391. if assigned(srsym) and
  1392. (srsym.typ=typesym) then
  1393. begin
  1394. size:=ttypesym(srsym).typedef.size;
  1395. result:=true;
  1396. end;
  1397. end;
  1398. Function SearchRecordType(const s:string): boolean;
  1399. var
  1400. srsym : tsym;
  1401. srsymtable : TSymtable;
  1402. Begin
  1403. SearchRecordType:=false;
  1404. { Check the constants in symtable }
  1405. asmsearchsym(s,srsym,srsymtable);
  1406. if srsym <> nil then
  1407. Begin
  1408. case srsym.typ of
  1409. typesym :
  1410. begin
  1411. if ttypesym(srsym).typedef.typ in [recorddef,objectdef] then
  1412. begin
  1413. SearchRecordType:=true;
  1414. exit;
  1415. end;
  1416. end;
  1417. fieldvarsym :
  1418. begin
  1419. if (tfieldvarsym(srsym).vardef.typ in [recorddef,objectdef]) then
  1420. begin
  1421. SearchRecordType:=true;
  1422. exit;
  1423. end;
  1424. end;
  1425. else
  1426. ;
  1427. end;
  1428. end;
  1429. end;
  1430. Function SearchIConstant(const s:string; var l:tcgint): boolean;
  1431. {**********************************************************************}
  1432. { Description: Searches for a CONSTANT of name s in either the local }
  1433. { symbol list, then in the global symbol list, and returns the value }
  1434. { of that constant in l. Returns TRUE if successfull, if not found, }
  1435. { or if the constant is not of correct type, then returns FALSE }
  1436. { Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 }
  1437. { respectively. }
  1438. {**********************************************************************}
  1439. var
  1440. srsym : tsym;
  1441. srsymtable : TSymtable;
  1442. Begin
  1443. SearchIConstant:=false;
  1444. { check for TRUE or FALSE reserved words first }
  1445. if s = 'TRUE' then
  1446. Begin
  1447. SearchIConstant:=TRUE;
  1448. l:=1;
  1449. exit;
  1450. end;
  1451. if s = 'FALSE' then
  1452. Begin
  1453. SearchIConstant:=TRUE;
  1454. l:=0;
  1455. exit;
  1456. end;
  1457. { Check the constants in symtable }
  1458. asmsearchsym(s,srsym,srsymtable);
  1459. if srsym <> nil then
  1460. Begin
  1461. case srsym.typ of
  1462. constsym :
  1463. begin
  1464. if tconstsym(srsym).consttyp=constord then
  1465. Begin
  1466. l:=tconstsym(srsym).value.valueord.svalue;
  1467. SearchIConstant:=TRUE;
  1468. exit;
  1469. end;
  1470. end;
  1471. enumsym:
  1472. Begin
  1473. l:=tenumsym(srsym).value;
  1474. SearchIConstant:=TRUE;
  1475. exit;
  1476. end;
  1477. else
  1478. ;
  1479. end;
  1480. end;
  1481. end;
  1482. function AsmRegisterPara(sym: tabstractnormalvarsym): boolean;
  1483. begin
  1484. result:=
  1485. (po_assembler in current_procinfo.procdef.procoptions) and
  1486. (sym.typ=paravarsym) and
  1487. (tparavarsym(sym).paraloc[calleeside].Location^.Loc=LOC_REGISTER);
  1488. end;
  1489. Function GetRecordOffsetSize(s:string;out Offset: tcgint;out Size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
  1490. { search and returns the offset and size of records/objects of the base }
  1491. { with field name setup in field. }
  1492. { returns FALSE if not found. }
  1493. { used when base is a variable or a typed constant name. }
  1494. var
  1495. st : TSymtable;
  1496. harrdef : tarraydef;
  1497. sym : tsym;
  1498. srsymtable : TSymtable;
  1499. i : longint;
  1500. base : string;
  1501. procdef: tprocdef;
  1502. Begin
  1503. GetRecordOffsetSize:=FALSE;
  1504. Offset:=0;
  1505. Size:=0;
  1506. mangledname:='';
  1507. hastypecast:=false;
  1508. i:=pos('.',s);
  1509. if i=0 then
  1510. i:=255;
  1511. base:=Copy(s,1,i-1);
  1512. delete(s,1,i);
  1513. if base='SELF' then
  1514. st:=current_structdef.symtable
  1515. else
  1516. begin
  1517. asmsearchsym(base,sym,srsymtable);
  1518. { allow unitname.identifier }
  1519. if assigned(sym) and (sym.typ=unitsym) then
  1520. begin
  1521. i:=pos('.',s);
  1522. if i=0 then
  1523. i:=255;
  1524. base:=base+'.'+Copy(s,1,i-1);
  1525. delete(s,1,i);
  1526. asmsearchsym(base,sym,srsymtable);
  1527. end;
  1528. st:=nil;
  1529. { we can start with a var,type,typedconst }
  1530. if assigned(sym) then
  1531. case sym.typ of
  1532. staticvarsym,
  1533. localvarsym,
  1534. paravarsym :
  1535. st:=Tabstractvarsym(sym).vardef.GetSymtable(gs_record);
  1536. typesym :
  1537. st:=Ttypesym(sym).typedef.GetSymtable(gs_record);
  1538. else
  1539. ;
  1540. end
  1541. else
  1542. s:='';
  1543. end;
  1544. { now walk all recordsymtables }
  1545. while assigned(st) and (s<>'') do
  1546. begin
  1547. { load next field in base }
  1548. i:=pos('.',s);
  1549. if i=0 then
  1550. i:=255;
  1551. base:=Copy(s,1,i-1);
  1552. delete(s,1,i);
  1553. sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
  1554. if not assigned(sym) then
  1555. begin
  1556. Message(asmr_e_unknown_field);
  1557. GetRecordOffsetSize:=false;
  1558. exit;
  1559. end;
  1560. st:=nil;
  1561. case sym.typ of
  1562. fieldvarsym :
  1563. with Tfieldvarsym(sym) do
  1564. begin
  1565. if not tabstractrecordsymtable(sym.owner).is_packed then
  1566. inc(Offset,fieldoffset)
  1567. else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then
  1568. inc(Offset,fieldoffset div 8)
  1569. else
  1570. Message(asmr_e_packed_element);
  1571. size:=getsize;
  1572. case vardef.typ of
  1573. arraydef :
  1574. begin
  1575. { for arrays try to get the element size, take care of
  1576. multiple indexes }
  1577. harrdef:=tarraydef(vardef);
  1578. while assigned(harrdef.elementdef) and
  1579. (harrdef.elementdef.typ=arraydef) do
  1580. harrdef:=tarraydef(harrdef.elementdef);
  1581. if not is_packed_array(harrdef) then
  1582. size:=harrdef.elesize
  1583. else
  1584. begin
  1585. if (harrdef.elepackedbitsize mod 8) <> 0 then
  1586. Message(asmr_e_packed_element);
  1587. size := (harrdef.elepackedbitsize + 7) div 8;
  1588. end;
  1589. end;
  1590. recorddef :
  1591. st:=trecorddef(vardef).symtable;
  1592. objectdef :
  1593. st:=tobjectdef(vardef).symtable;
  1594. else
  1595. ;
  1596. end;
  1597. end;
  1598. procsym:
  1599. begin
  1600. st:=nil;
  1601. if Tprocsym(sym).ProcdefList.Count>1 then
  1602. Message(asmr_w_calling_overload_func);
  1603. procdef:=tprocdef(tprocsym(sym).ProcdefList[0]);
  1604. if (not needvmtofs) then
  1605. begin
  1606. mangledname:=procdef.mangledname;
  1607. end
  1608. else
  1609. begin
  1610. { can only get the vmtoffset of virtual methods }
  1611. if not(po_virtualmethod in procdef.procoptions) or
  1612. is_objectpascal_helper(procdef.struct) then
  1613. Message1(asmr_e_no_vmtoffset_possible,FullTypeName(procdef,nil))
  1614. else
  1615. begin
  1616. { size = sizeof(target_system_pointer) }
  1617. size:=sizeof(pint);
  1618. offset:=tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)
  1619. end;
  1620. end;
  1621. { if something comes after the procsym, it's invalid assembler syntax }
  1622. GetRecordOffsetSize:=(s='');
  1623. exit;
  1624. end;
  1625. else
  1626. ;
  1627. end;
  1628. end;
  1629. { Support Field.Type as typecasting }
  1630. if (st=nil) and (s<>'') then
  1631. begin
  1632. asmsearchsym(s,sym,srsymtable);
  1633. if assigned(sym) and (sym.typ=typesym) then
  1634. begin
  1635. size:=ttypesym(sym).typedef.size;
  1636. s:='';
  1637. hastypecast:=true;
  1638. end;
  1639. end;
  1640. GetRecordOffsetSize:=(s='');
  1641. end;
  1642. Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
  1643. var
  1644. sym : tsym;
  1645. srsymtable : TSymtable;
  1646. hs : string;
  1647. Begin
  1648. hl:=nil;
  1649. SearchLabel:=false;
  1650. { Check for pascal labels, which are case insensetive }
  1651. hs:=upper(s);
  1652. asmsearchsym(hs,sym,srsymtable);
  1653. if sym=nil then
  1654. exit;
  1655. case sym.typ of
  1656. labelsym :
  1657. begin
  1658. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  1659. begin
  1660. {$ifndef LLVM}
  1661. { LLVM compiler requires that the static label RawThunkEnd
  1662. in packages/rtl-objpas/src/rtti.pp unit is set to nonlocal }
  1663. if (srsymtable.symtabletype=globalsymtable) or create_smartlink_library then
  1664. {$endif LLVM}
  1665. Tlabelsym(sym).nonlocal:=true;
  1666. if emit then
  1667. include(current_procinfo.flags,pi_has_interproclabel);
  1668. end;
  1669. if not(assigned(tlabelsym(sym).asmblocklabel)) then
  1670. if Tlabelsym(sym).nonlocal then
  1671. current_asmdata.getglobaljumplabel(tlabelsym(sym).asmblocklabel)
  1672. else
  1673. current_asmdata.getjumplabel(tlabelsym(sym).asmblocklabel);
  1674. hl:=tlabelsym(sym).asmblocklabel;
  1675. if emit then
  1676. begin
  1677. if tlabelsym(sym).defined then
  1678. Message(sym_e_label_already_defined);
  1679. tlabelsym(sym).defined:=true;
  1680. hl.defined_in_asmstatement:=true
  1681. end
  1682. else
  1683. tlabelsym(sym).used:=true;
  1684. SearchLabel:=true;
  1685. end;
  1686. else
  1687. ;
  1688. end;
  1689. end;
  1690. {*************************************************************************}
  1691. { Instruction Generation Utilities }
  1692. {*************************************************************************}
  1693. Procedure ConcatString(p : TAsmList;s:string);
  1694. {*********************************************************************}
  1695. { PROCEDURE ConcatString(s:string); }
  1696. { Description: This routine adds the character chain pointed to in }
  1697. { s to the instruction linked list. }
  1698. {*********************************************************************}
  1699. Begin
  1700. p.concat(Tai_string.Create(s));
  1701. end;
  1702. Procedure ConcatConstant(p: TAsmList; value: tcgint; constsize:byte);
  1703. {*********************************************************************}
  1704. { Description: This routine adds the value constant to the current }
  1705. { instruction linked list. }
  1706. {*********************************************************************}
  1707. var
  1708. rangelo,rangehi : int64;
  1709. Begin
  1710. case constsize of
  1711. 1 :
  1712. begin
  1713. p.concat(Tai_const.Create_8bit(byte(value)));
  1714. rangelo:=low(shortint);
  1715. rangehi:=high(byte);
  1716. end;
  1717. 2 :
  1718. begin
  1719. p.concat(Tai_const.Create_16bit(word(value)));
  1720. rangelo:=low(smallint);
  1721. rangehi:=high(word);
  1722. end;
  1723. 4 :
  1724. begin
  1725. p.concat(Tai_const.Create_32bit(longint(value)));
  1726. rangelo:=low(longint);
  1727. rangehi:=high(cardinal);
  1728. end;
  1729. 8 :
  1730. begin
  1731. p.concat(Tai_const.Create_64bit(int64(value)));
  1732. rangelo:=0;
  1733. rangehi:=0;
  1734. end;
  1735. else
  1736. internalerror(200405011);
  1737. end;
  1738. { check for out of bounds }
  1739. if (rangelo<>0) and
  1740. ((value>rangehi) or (value<rangelo)) then
  1741. Message(asmr_e_constant_out_of_bounds);
  1742. end;
  1743. Procedure ConcatConstSymbol(p : TAsmList;const sym,endsym:string;symtyp:tasmsymtype;l:tcgint;constsize:byte;isofs:boolean);
  1744. begin
  1745. {$ifdef i8086}
  1746. { 'DW xx' as well as 'DW OFFSET xx' are just near pointers }
  1747. if constsize=2 then
  1748. p.concat(Tai_const.Createname_near(sym,l))
  1749. else if constsize=4 then
  1750. begin
  1751. if isofs then
  1752. begin
  1753. { 'DD OFFSET xx' is a 32-bit offset; since we don't produce 32-bit
  1754. relocations yet, just do a 16-bit one and set the high word to 0 }
  1755. p.concat(Tai_const.Createname_near(sym,l));
  1756. p.concat(Tai_const.Create_16bit(0));
  1757. end
  1758. else
  1759. { 'DD xx' is a far pointer }
  1760. p.concat(Tai_const.Createname_far(sym,l));
  1761. end
  1762. else
  1763. internalerror(2018020701);
  1764. {$else i8086}
  1765. p.concat(Tai_const.Createname(sym,l));
  1766. {$endif i8086}
  1767. end;
  1768. Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype);
  1769. {***********************************************************************}
  1770. { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); }
  1771. { Description: This routine adds the value constant to the current }
  1772. { instruction linked list. }
  1773. { real_typ -> indicates the type of the real data to initialize: }
  1774. { s32real -> create a single node. }
  1775. { s64real -> create a double node. }
  1776. { s80real -> create an extended node. }
  1777. { s64bit -> create a comp node. }
  1778. { f32bit -> create a fixed node. (not used normally) }
  1779. {***********************************************************************}
  1780. Begin
  1781. case real_typ of
  1782. s32real : p.concat(tai_realconst.create_s32real(value));
  1783. s64real :
  1784. {$ifdef ARM}
  1785. if is_double_hilo_swapped then
  1786. p.concat(tai_realconst.create_s64real_hiloswapped(value))
  1787. else
  1788. {$endif ARM}
  1789. p.concat(tai_realconst.create_s64real(value));
  1790. s80real : p.concat(tai_realconst.create_s80real(value,s80floattype.size));
  1791. sc80real : p.concat(tai_realconst.create_s80real(value,sc80floattype.size));
  1792. s64comp : p.concat(tai_realconst.create_s64compreal(trunc(value)));
  1793. else
  1794. internalerror(2014050608);
  1795. end;
  1796. end;
  1797. Procedure ConcatLabel(p: TAsmList;var l : tasmlabel);
  1798. {*********************************************************************}
  1799. { PROCEDURE ConcatLabel }
  1800. { Description: This routine either emits a label or a labeled }
  1801. { instruction to the linked list of instructions. }
  1802. {*********************************************************************}
  1803. begin
  1804. p.concat(Tai_label.Create(l));
  1805. end;
  1806. procedure ConcatAlign(p:TAsmList;l:tcgint);
  1807. {*********************************************************************}
  1808. { PROCEDURE ConcatPublic }
  1809. { Description: This routine emits an global definition to the }
  1810. { linked list of instructions.(used by AT&T styled asm) }
  1811. {*********************************************************************}
  1812. begin
  1813. p.concat(Tai_align.Create(l));
  1814. end;
  1815. procedure ConcatPublic(p:TAsmList;const s : string);
  1816. {*********************************************************************}
  1817. { PROCEDURE ConcatPublic }
  1818. { Description: This routine emits an global definition to the }
  1819. { linked list of instructions.(used by AT&T styled asm) }
  1820. {*********************************************************************}
  1821. begin
  1822. p.concat(Tai_symbol.Createname_global(s,AT_LABEL,0,voidcodepointertype));
  1823. end;
  1824. procedure ConcatLocal(p:TAsmList;const s : string);
  1825. {*********************************************************************}
  1826. { PROCEDURE ConcatLocal }
  1827. { Description: This routine emits an local definition to the }
  1828. { linked list of instructions. }
  1829. {*********************************************************************}
  1830. begin
  1831. p.concat(Tai_symbol.Createname(s,AT_LABEL,0,voidcodepointertype));
  1832. end;
  1833. end.