ramos6502asm.pas 77 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194
  1. {
  2. Copyright (c) 2025 by Nikolay Nikolov
  3. Does the parsing for the MOS Technology 6502 styled inline assembler.
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. Unit ramos6502asm;
  18. {$i fpcdefs.inc}
  19. Interface
  20. uses
  21. cclasses,
  22. globtype,
  23. rasm,ramos6502,
  24. aasmbase,cpubase;
  25. type
  26. tasmtoken = (
  27. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
  28. AS_REALNUM,AS_COMMA,AS_LPAREN,
  29. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_LESSTHAN,AS_GREATERTHAN,
  30. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_CONDITION,AS_SLASH,AS_DOLLAR,
  31. AS_HASH,AS_LSBRACKET,AS_RSBRACKET,AS_LBRACKET,AS_RBRACKET,
  32. AS_EQUAL,
  33. {------------------ Assembler directives --------------------}
  34. AS_DEFB,AS_DEFW,AS_AREA,AS_END,
  35. {------------------ Assembler Operators --------------------}
  36. AS_TYPE,AS_OFFSET,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT,
  37. AS_RELTYPE, // common token for relocation types
  38. {------------------ Target-specific directive ---------------}
  39. AS_TARGET_DIRECTIVE
  40. );
  41. tasmkeyword = string[10];
  42. const
  43. { These tokens should be modified accordingly to the modifications }
  44. { in the different enumerations. }
  45. firstdirective = AS_DEFB;
  46. lastdirective = AS_END;
  47. token2str : array[tasmtoken] of tasmkeyword=(
  48. '','Label','LLabel','string','integer',
  49. 'float',',','(',
  50. ')',':','.','+','-','*','<','>',
  51. ';','identifier','register','opcode','condition','/','$',
  52. '#','{','}','[',']',
  53. '=',
  54. 'defb','defw','area','END',
  55. 'TYPE','OFFSET','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','reltype',
  56. 'directive');
  57. type
  58. { input flags for BuildConstSymbolExpression }
  59. tconstsymbolexpressioninputflag = (
  60. cseif_needofs,
  61. cseif_isref,
  62. cseif_startingminus,
  63. { allows using full reference-like syntax for constsymbol expressions,
  64. for example:
  65. Rec.Str[5] -> Rec.Str+5 }
  66. cseif_referencelike
  67. );
  68. tconstsymbolexpressioninputflags = set of tconstsymbolexpressioninputflag;
  69. { output flags for BuildConstSymbolExpression }
  70. tconstsymbolexpressionoutputflag = (
  71. cseof_isseg,
  72. cseof_is_farproc_entry,
  73. cseof_hasofs
  74. );
  75. tconstsymbolexpressionoutputflags = set of tconstsymbolexpressionoutputflag;
  76. { tmos6502reader }
  77. tmos6502reader = class(tasmreader)
  78. actasmcond : TAsmCond;
  79. actasmpattern_origcase : string;
  80. actasmtoken : tasmtoken;
  81. prevasmtoken : tasmtoken;
  82. inexpression : boolean;
  83. procedure SetupTables;
  84. procedure GetToken;
  85. function consume(t : tasmtoken):boolean;
  86. procedure RecoverConsume(allowcomma:boolean);
  87. procedure AddReferences(dest,src : tmos6502operand);
  88. function is_locallabel(const s:string):boolean;
  89. function is_asmopcode(const s: string):boolean;
  90. function is_register(const s:string):boolean;
  91. procedure BuildRecordOffsetSize(const expr: string;out offset:tcgint;out size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean);
  92. procedure BuildConstSymbolExpression(in_flags: tconstsymbolexpressioninputflags;out value:tcgint;out asmsym:string;out asmsymtyp:TAsmsymtype;out size:tcgint;out out_flags:tconstsymbolexpressionoutputflags);
  93. function BuildConstExpression:longint;
  94. function BuildRefConstExpression(out size:tcgint;startingminus:boolean=false):longint;
  95. procedure BuildConstantOperand(oper: tmos6502operand);
  96. procedure BuildReference(oper : tmos6502operand);
  97. procedure BuildOperand(oper: tmos6502operand;iscalljmp: boolean);
  98. procedure BuildOpCode(instr:TMOS6502Instruction);
  99. procedure handleopcode;
  100. function Assemble: tlinkedlist;override;
  101. end;
  102. Implementation
  103. uses
  104. { helpers }
  105. cutils,
  106. { global }
  107. globals,verbose,
  108. systems,
  109. { aasm }
  110. cpuinfo,aasmtai,aasmdata,aasmcpu,
  111. { symtable }
  112. symconst,symbase,symtype,symsym,symtable,symdef,symutil,
  113. { parser }
  114. scanner,pbase,
  115. procinfo,
  116. rabase,rautils,
  117. cgbase,cgutils,cgobj
  118. ;
  119. {*****************************************************************************
  120. tmos6502reader
  121. *****************************************************************************}
  122. procedure tmos6502reader.SetupTables;
  123. var
  124. i: TAsmOp;
  125. cond: TAsmCond;
  126. begin
  127. iasmops:=TFPHashList.create;
  128. for i:=firstop to lastop do
  129. if i<>A_Bxx then
  130. iasmops.Add(upper(std_op2str[i]),Pointer(PtrInt(i)));
  131. for cond in TAsmCond do
  132. if cond<>C_None then
  133. iasmops.Add('B'+uppercond2str[cond],Pointer(PtrInt(A_Bxx)));
  134. end;
  135. procedure tmos6502reader.GetToken;
  136. var
  137. len: Integer;
  138. begin
  139. c:=scanner.c;
  140. { save old token and reset new token }
  141. prevasmtoken:=actasmtoken;
  142. actasmtoken:=AS_NONE;
  143. { reset }
  144. actasmpattern:='';
  145. { while space and tab , continue scan... }
  146. while c in [' ',#9] do
  147. c:=current_scanner.asmgetchar;
  148. { get token pos }
  149. if not (c in [#10,#13,'{',';','/','(']) then
  150. current_scanner.gettokenpos;
  151. { Local Label, Label, Directive, Prefix or Opcode }
  152. if firsttoken and not(c in [#10,#13,';']) then
  153. begin
  154. firsttoken:=FALSE;
  155. len:=0;
  156. { only opcodes, global and local labels are allowed now. }
  157. while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
  158. begin
  159. inc(len);
  160. actasmpattern[len]:=c;
  161. c:=current_scanner.asmgetchar;
  162. end;
  163. actasmpattern[0]:=chr(len);
  164. actasmpattern_origcase:=actasmpattern;
  165. { Opcode ? }
  166. if is_asmopcode(upper(actasmpattern)) then
  167. begin
  168. uppervar(actasmpattern);
  169. exit;
  170. end;
  171. { End of assemblerblock ? }
  172. if upper(actasmpattern) = 'END' then
  173. begin
  174. actasmtoken:=AS_END;
  175. exit;
  176. end;
  177. { Local label ? }
  178. if is_locallabel(actasmpattern) then
  179. begin
  180. actasmtoken:=AS_LLABEL;
  181. firsttoken:=true;
  182. exit;
  183. end
  184. else
  185. begin
  186. actasmtoken:=AS_LABEL;
  187. firsttoken:=true;
  188. exit;
  189. end;
  190. end
  191. else { else firsttoken }
  192. { Here we must handle all possible cases }
  193. begin
  194. case c of
  195. { identifier, register, prefix or directive }
  196. '_','A'..'Z','a'..'z':
  197. begin
  198. len:=0;
  199. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  200. begin
  201. inc(len);
  202. actasmpattern[len]:=c;
  203. c:=current_scanner.asmgetchar;
  204. end;
  205. actasmpattern[0]:=chr(len);
  206. actasmpattern_origcase:=actasmpattern;
  207. uppervar(actasmpattern);
  208. { check for end which is a reserved word unlike the opcodes }
  209. if actasmpattern = 'END' then
  210. begin
  211. actasmtoken:=AS_END;
  212. exit;
  213. end;
  214. if is_register(actasmpattern) then
  215. begin
  216. actasmtoken:=AS_REGISTER;
  217. { is it an alternate register? }
  218. if (c='''') and is_register(actasmpattern+'''') then
  219. begin
  220. actasmpattern:=actasmpattern+c;
  221. c:=current_scanner.asmgetchar;
  222. end;
  223. exit;
  224. end;
  225. { if next is a '.' and this is a unitsym then we also need to
  226. parse the identifier }
  227. //if (c='.') then
  228. // begin
  229. // searchsym(actasmpattern,srsym,srsymtable);
  230. // if assigned(srsym) and
  231. // (srsym.typ=unitsym) and
  232. // (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and
  233. // srsym.owner.iscurrentunit then
  234. // begin
  235. // actasmpattern:=actasmpattern+c;
  236. // c:=current_scanner.asmgetchar;
  237. // while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  238. // begin
  239. // actasmpattern:=actasmpattern + upcase(c);
  240. // c:=current_scanner.asmgetchar;
  241. // end;
  242. // end;
  243. // end;
  244. actasmtoken:=AS_ID;
  245. exit;
  246. end;
  247. '0'..'9': { integer number }
  248. begin
  249. len:=0;
  250. while c in ['0'..'9'] do
  251. Begin
  252. inc(len);
  253. actasmpattern[len]:=c;
  254. c:=current_scanner.asmgetchar;
  255. end;
  256. actasmpattern[0]:=chr(len);
  257. actasmpattern:=tostr(ParseVal(actasmpattern,10));
  258. actasmtoken:=AS_INTNUM;
  259. exit;
  260. end;
  261. '$': { hex number }
  262. begin
  263. actasmpattern:='';
  264. c:=current_scanner.asmgetchar;
  265. while c in ['0'..'9','a'..'f','A'..'F'] do
  266. Begin
  267. actasmpattern:=actasmpattern + c;
  268. c:=current_scanner.asmgetchar;
  269. end;
  270. actasmpattern:=tostr(ParseVal(actasmpattern,16));
  271. actasmtoken:=AS_INTNUM;
  272. exit;
  273. end;
  274. '%': { binary number }
  275. begin
  276. actasmpattern:='';
  277. c:=current_scanner.asmgetchar;
  278. while c in ['0','1'] do
  279. Begin
  280. actasmpattern:=actasmpattern + c;
  281. c:=current_scanner.asmgetchar;
  282. end;
  283. actasmpattern:=tostr(ParseVal(actasmpattern,2));
  284. actasmtoken:=AS_INTNUM;
  285. exit;
  286. end;
  287. '#' :
  288. begin
  289. actasmtoken:=AS_HASH;
  290. c:=current_scanner.asmgetchar;
  291. exit;
  292. end;
  293. ',' :
  294. begin
  295. actasmtoken:=AS_COMMA;
  296. c:=current_scanner.asmgetchar;
  297. exit;
  298. end;
  299. '(' :
  300. begin
  301. actasmtoken:=AS_LPAREN;
  302. c:=current_scanner.asmgetchar;
  303. exit;
  304. end;
  305. ')' :
  306. begin
  307. actasmtoken:=AS_RPAREN;
  308. c:=current_scanner.asmgetchar;
  309. exit;
  310. end;
  311. '+' :
  312. begin
  313. actasmtoken:=AS_PLUS;
  314. c:=current_scanner.asmgetchar;
  315. exit;
  316. end;
  317. '-' :
  318. begin
  319. actasmtoken:=AS_MINUS;
  320. c:=current_scanner.asmgetchar;
  321. exit;
  322. end;
  323. '<' :
  324. begin
  325. actasmtoken:=AS_LESSTHAN;
  326. c:=current_scanner.asmgetchar;
  327. exit;
  328. end;
  329. '>' :
  330. begin
  331. actasmtoken:=AS_GREATERTHAN;
  332. c:=current_scanner.asmgetchar;
  333. exit;
  334. end;
  335. #13,#10:
  336. begin
  337. current_scanner.linebreak;
  338. c:=current_scanner.asmgetchar;
  339. firsttoken:=TRUE;
  340. actasmtoken:=AS_SEPARATOR;
  341. exit;
  342. end;
  343. ';' :
  344. begin
  345. { skip comment }
  346. repeat
  347. c:=current_scanner.asmgetchar;
  348. until c in [#13,#10,#26];
  349. firsttoken:=TRUE;
  350. actasmtoken:=AS_SEPARATOR;
  351. exit;
  352. end;
  353. else
  354. current_scanner.illegal_char(c);
  355. end;
  356. end;
  357. end;
  358. function tmos6502reader.consume(t : tasmtoken):boolean;
  359. begin
  360. Consume:=true;
  361. if t<>actasmtoken then
  362. begin
  363. Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
  364. Consume:=false;
  365. end;
  366. repeat
  367. gettoken;
  368. until actasmtoken<>AS_NONE;
  369. end;
  370. procedure tmos6502reader.RecoverConsume(allowcomma:boolean);
  371. begin
  372. while not (actasmtoken in [AS_SEPARATOR,AS_END]) do
  373. begin
  374. if allowcomma and (actasmtoken=AS_COMMA) then
  375. break;
  376. Consume(actasmtoken);
  377. end;
  378. end;
  379. procedure tmos6502reader.AddReferences(dest,src : tmos6502operand);
  380. procedure AddRegister(reg:tregister;scalefactor:byte);
  381. begin
  382. if reg=NR_NO then
  383. exit;
  384. if (dest.opr.ref.base=NR_NO) and (scalefactor=1) then
  385. begin
  386. dest.opr.ref.base:=reg;
  387. exit;
  388. end;
  389. if dest.opr.ref.index=NR_NO then
  390. begin
  391. dest.opr.ref.index:=reg;
  392. dest.opr.ref.scalefactor:=scalefactor;
  393. exit;
  394. end;
  395. if dest.opr.ref.index=reg then
  396. begin
  397. Inc(dest.opr.ref.scalefactor,scalefactor);
  398. exit;
  399. end;
  400. Message(asmr_e_multiple_index);
  401. end;
  402. var
  403. tmplocal: TOprRec;
  404. segreg: TRegister;
  405. begin
  406. case dest.opr.typ of
  407. OPR_REFERENCE:
  408. begin
  409. case src.opr.typ of
  410. OPR_REFERENCE:
  411. begin
  412. AddRegister(src.opr.ref.base,1);
  413. AddRegister(src.opr.ref.index,src.opr.ref.scalefactor);
  414. Inc(dest.opr.ref.offset,src.opr.ref.offset);
  415. Inc(dest.opr.constoffset,src.opr.constoffset);
  416. dest.haslabelref:=dest.haslabelref or src.haslabelref;
  417. dest.hasproc:=dest.hasproc or src.hasproc;
  418. dest.hasvar:=dest.hasvar or src.hasvar;
  419. if assigned(src.opr.ref.symbol) then
  420. begin
  421. if assigned(dest.opr.ref.symbol) then
  422. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  423. dest.opr.ref.symbol:=src.opr.ref.symbol;
  424. end;
  425. if assigned(src.opr.ref.relsymbol) then
  426. begin
  427. if assigned(dest.opr.ref.relsymbol) then
  428. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  429. dest.opr.ref.relsymbol:=src.opr.ref.relsymbol;
  430. end;
  431. if dest.opr.ref.refaddr=addr_no then
  432. dest.opr.ref.refaddr:=src.opr.ref.refaddr;
  433. end;
  434. OPR_LOCAL:
  435. begin
  436. tmplocal:=src.opr;
  437. if dest.opr.ref.base<>NR_NO then
  438. begin
  439. if tmplocal.localindexreg=NR_NO then
  440. begin
  441. tmplocal.localindexreg:=dest.opr.ref.base;
  442. tmplocal.localscale:=0;
  443. end
  444. else if tmplocal.localindexreg=dest.opr.ref.base then
  445. tmplocal.localscale:=Min(tmplocal.localscale,1)+1
  446. else
  447. Message(asmr_e_multiple_index);
  448. end;
  449. if dest.opr.ref.index<>NR_NO then
  450. begin
  451. if tmplocal.localindexreg=NR_NO then
  452. begin
  453. tmplocal.localindexreg:=dest.opr.ref.index;
  454. tmplocal.localscale:=dest.opr.ref.scalefactor;
  455. end
  456. else if tmplocal.localindexreg=dest.opr.ref.index then
  457. tmplocal.localscale:=Min(tmplocal.localscale,1)+Min(dest.opr.ref.scalefactor,1)
  458. else
  459. Message(asmr_e_multiple_index);
  460. end;
  461. Inc(tmplocal.localconstoffset,dest.opr.constoffset);
  462. Inc(tmplocal.localsymofs,dest.opr.ref.offset);
  463. dest.opr:=tmplocal;
  464. end;
  465. else
  466. internalerror(2018030711);
  467. end;
  468. end;
  469. OPR_LOCAL:
  470. begin
  471. case src.opr.typ of
  472. OPR_REFERENCE:
  473. begin
  474. if src.opr.ref.base<>NR_NO then
  475. begin
  476. if dest.opr.localindexreg=NR_NO then
  477. begin
  478. dest.opr.localindexreg:=src.opr.ref.base;
  479. dest.opr.localscale:=0;
  480. end
  481. else if dest.opr.localindexreg=src.opr.ref.base then
  482. dest.opr.localscale:=Min(dest.opr.localscale,1)+1
  483. else
  484. Message(asmr_e_multiple_index);
  485. end;
  486. if src.opr.ref.index<>NR_NO then
  487. begin
  488. if dest.opr.localindexreg=NR_NO then
  489. begin
  490. dest.opr.localindexreg:=src.opr.ref.index;
  491. dest.opr.localscale:=src.opr.ref.scalefactor;
  492. end
  493. else if dest.opr.localindexreg=src.opr.ref.index then
  494. dest.opr.localscale:=Min(dest.opr.localscale,1)+Min(src.opr.ref.scalefactor,1)
  495. else
  496. Message(asmr_e_multiple_index);
  497. end;
  498. Inc(dest.opr.localconstoffset,src.opr.constoffset);
  499. Inc(dest.opr.localsymofs,src.opr.ref.offset);
  500. end;
  501. OPR_LOCAL:
  502. Message(asmr_e_no_local_or_para_allowed);
  503. else
  504. internalerror(2018030713);
  505. end;
  506. end;
  507. else
  508. internalerror(2018030712);
  509. end;
  510. end;
  511. function tmos6502reader.is_locallabel(const s:string):boolean;
  512. begin
  513. is_locallabel:=(length(s)>1) and (s[1]='@');
  514. end;
  515. function tmos6502reader.is_asmopcode(const s: string):boolean;
  516. var
  517. cond: TAsmCond;
  518. condstr: String;
  519. begin
  520. actcondition:=C_None;
  521. actopcode:=tasmop(PtrUInt(iasmops.Find(s)));
  522. if actopcode<>A_NONE then
  523. begin
  524. actasmtoken:=AS_OPCODE;
  525. is_asmopcode:=true;
  526. if actopcode=A_Bxx then
  527. begin
  528. condstr:=Copy(s,2,2);
  529. for cond in TAsmCond do
  530. if (cond<>C_None) and (uppercond2str[cond]=condstr) then
  531. begin
  532. actasmcond:=cond;
  533. exit;
  534. end;
  535. end;
  536. end
  537. else
  538. is_asmopcode:=false;
  539. end;
  540. function tmos6502reader.is_register(const s:string):boolean;
  541. begin
  542. is_register:=false;
  543. actasmregister:=std_regnum_search(lower(s));
  544. if is_6502_general_purpose_register(actasmregister) then
  545. begin
  546. is_register:=true;
  547. actasmtoken:=AS_REGISTER;
  548. end
  549. else
  550. actasmregister:=NR_NO;
  551. end;
  552. procedure tmos6502reader.BuildRecordOffsetSize(const expr: string;out offset:tcgint;out size:tcgint; out mangledname: string; needvmtofs: boolean; out hastypecast: boolean);
  553. var
  554. s: string;
  555. Begin
  556. offset:=0;
  557. size:=0;
  558. mangledname:='';
  559. hastypecast:=false;
  560. s:=expr;
  561. while (actasmtoken=AS_DOT) do
  562. begin
  563. Consume(AS_DOT);
  564. if actasmtoken in [AS_ID,AS_REGISTER] then
  565. begin
  566. s:=s+'.'+actasmpattern;
  567. consume(actasmtoken);
  568. end
  569. else
  570. begin
  571. Consume(AS_ID);
  572. RecoverConsume(true);
  573. break;
  574. end;
  575. end;
  576. if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs,hastypecast) then
  577. Message(asmr_e_building_record_offset);
  578. end;
  579. procedure tmos6502reader.BuildConstSymbolExpression(in_flags: tconstsymbolexpressioninputflags;out value:tcgint;out asmsym:string;out asmsymtyp:TAsmsymtype;out size:tcgint;out out_flags:tconstsymbolexpressionoutputflags);
  580. var
  581. tempstr,expr,hs,mangledname : string;
  582. parenlevel : longint;
  583. l,k : tcgint;
  584. hasparen,
  585. errorflag,
  586. needvmtofs : boolean;
  587. prevtok : tasmtoken;
  588. hl : tasmlabel;
  589. hssymtyp : Tasmsymtype;
  590. def : tdef;
  591. sym : tsym;
  592. srsymtable : TSymtable;
  593. hastypecast : boolean;
  594. begin
  595. { reset }
  596. value:=0;
  597. asmsym:='';
  598. asmsymtyp:=AT_DATA;
  599. size:=0;
  600. out_flags:=[];
  601. errorflag:=FALSE;
  602. tempstr:='';
  603. expr:='';
  604. if cseif_startingminus in in_flags then
  605. expr:='-';
  606. inexpression:=TRUE;
  607. parenlevel:=0;
  608. sym:=nil;
  609. needvmtofs:=FALSE;
  610. Repeat
  611. { Support ugly delphi constructs like: [ECX].1+2[EDX] }
  612. if (cseif_isref in in_flags) and (actasmtoken=AS_LBRACKET) then
  613. break;
  614. if (cseif_referencelike in in_flags) and
  615. (actasmtoken in [AS_LBRACKET,AS_RBRACKET]) then
  616. case actasmtoken of
  617. AS_LBRACKET:
  618. begin
  619. Consume(AS_LBRACKET);
  620. if (length(expr)>0) and
  621. not (expr[length(expr)] in ['+','-']) then
  622. expr:=expr+'+';
  623. expr:=expr+'[';
  624. end;
  625. AS_RBRACKET:
  626. begin
  627. Consume(AS_RBRACKET);
  628. expr:=expr+']';
  629. end;
  630. else
  631. ;
  632. end;
  633. Case actasmtoken of
  634. AS_LPAREN:
  635. Begin
  636. Consume(AS_LPAREN);
  637. expr:=expr + '(';
  638. inc(parenlevel);
  639. end;
  640. AS_RPAREN:
  641. Begin
  642. { Keep the AS_PAREN in actasmtoken, it is maybe a typecast }
  643. if parenlevel=0 then
  644. break;
  645. Consume(AS_RPAREN);
  646. expr:=expr + ')';
  647. dec(parenlevel);
  648. end;
  649. AS_SHL:
  650. Begin
  651. Consume(AS_SHL);
  652. expr:=expr + '<';
  653. end;
  654. AS_SHR:
  655. Begin
  656. Consume(AS_SHR);
  657. expr:=expr + '>';
  658. end;
  659. AS_SLASH:
  660. Begin
  661. Consume(AS_SLASH);
  662. expr:=expr + '/';
  663. end;
  664. AS_MOD:
  665. Begin
  666. Consume(AS_MOD);
  667. expr:=expr + '%';
  668. end;
  669. AS_STAR:
  670. Begin
  671. Consume(AS_STAR);
  672. if (cseif_isref in in_flags) and (actasmtoken=AS_REGISTER) then
  673. break;
  674. expr:=expr + '*';
  675. end;
  676. AS_PLUS:
  677. Begin
  678. Consume(AS_PLUS);
  679. if (cseif_isref in in_flags) and ((actasmtoken=AS_REGISTER) or (actasmtoken=AS_LBRACKET)) then
  680. break;
  681. expr:=expr + '+';
  682. end;
  683. AS_MINUS:
  684. Begin
  685. Consume(AS_MINUS);
  686. expr:=expr + '-';
  687. end;
  688. AS_AND:
  689. Begin
  690. Consume(AS_AND);
  691. expr:=expr + '&';
  692. end;
  693. AS_NOT:
  694. Begin
  695. Consume(AS_NOT);
  696. expr:=expr + '~';
  697. end;
  698. AS_XOR:
  699. Begin
  700. Consume(AS_XOR);
  701. expr:=expr + '^';
  702. end;
  703. AS_OR:
  704. Begin
  705. Consume(AS_OR);
  706. expr:=expr + '|';
  707. end;
  708. AS_INTNUM:
  709. Begin
  710. expr:=expr + actasmpattern;
  711. Consume(AS_INTNUM);
  712. end;
  713. {$ifdef i8086}
  714. AS_SEG:
  715. begin
  716. include(out_flags,cseof_isseg);
  717. Consume(actasmtoken);
  718. if actasmtoken<>AS_ID then
  719. Message(asmr_e_seg_without_identifier);
  720. end;
  721. {$endif i8086}
  722. AS_VMTOFFSET,
  723. AS_OFFSET:
  724. begin
  725. if (actasmtoken = AS_OFFSET) then
  726. begin
  727. include(in_flags,cseif_needofs);
  728. include(out_flags,cseof_hasofs);
  729. end
  730. else
  731. needvmtofs:=true;
  732. Consume(actasmtoken);
  733. if actasmtoken<>AS_ID then
  734. Message(asmr_e_offset_without_identifier);
  735. end;
  736. AS_SIZEOF,
  737. AS_TYPE:
  738. begin
  739. l:=0;
  740. hasparen:=false;
  741. Consume(actasmtoken);
  742. if actasmtoken=AS_LPAREN then
  743. begin
  744. hasparen:=true;
  745. Consume(AS_LPAREN);
  746. end;
  747. if actasmtoken<>AS_ID then
  748. Message(asmr_e_type_without_identifier)
  749. else
  750. begin
  751. tempstr:=actasmpattern;
  752. Consume(AS_ID);
  753. if actasmtoken=AS_DOT then
  754. begin
  755. BuildRecordOffsetSize(tempstr,k,l,mangledname,false,hastypecast);
  756. if mangledname<>'' then
  757. { procsym }
  758. Message(asmr_e_wrong_sym_type);
  759. if hastypecast then
  760. end
  761. else
  762. begin
  763. asmsearchsym(tempstr,sym,srsymtable);
  764. if assigned(sym) then
  765. begin
  766. case sym.typ of
  767. staticvarsym,
  768. localvarsym,
  769. paravarsym :
  770. l:=tabstractvarsym(sym).getsize;
  771. typesym :
  772. l:=ttypesym(sym).typedef.size;
  773. else
  774. Message(asmr_e_wrong_sym_type);
  775. end;
  776. end
  777. else
  778. Message1(sym_e_unknown_id,tempstr);
  779. end;
  780. end;
  781. str(l, tempstr);
  782. expr:=expr + tempstr;
  783. if hasparen then
  784. Consume(AS_RPAREN);
  785. end;
  786. //AS_PTR :
  787. // begin
  788. // { Support ugly delphi constructs like <constant> PTR [ref] }
  789. // break;
  790. // end;
  791. AS_STRING:
  792. begin
  793. l:=0;
  794. case Length(actasmpattern) of
  795. 1 :
  796. l:=ord(actasmpattern[1]);
  797. 2 :
  798. l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
  799. 3 :
  800. l:=ord(actasmpattern[3]) +
  801. Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
  802. 4 :
  803. l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
  804. Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
  805. else
  806. Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
  807. end;
  808. str(l, tempstr);
  809. expr:=expr + tempstr;
  810. Consume(AS_STRING);
  811. end;
  812. AS_ID:
  813. begin
  814. hs:='';
  815. hssymtyp:=AT_DATA;
  816. def:=nil;
  817. tempstr:=actasmpattern;
  818. prevtok:=prevasmtoken;
  819. { stop parsing a constant expression if we find an opcode after a
  820. non-operator like "db $66 mov eax,ebx" }
  821. if (prevtok in [AS_ID,AS_INTNUM,AS_RPAREN]) and
  822. is_asmopcode(actasmpattern) then
  823. break;
  824. consume(AS_ID);
  825. if (tempstr='@CODE') or (tempstr='@DATA') then
  826. begin
  827. if asmsym='' then
  828. begin
  829. asmsym:=tempstr;
  830. asmsymtyp:=AT_SECTION;
  831. end
  832. else
  833. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  834. end
  835. else if SearchIConstant(tempstr,l) then
  836. begin
  837. str(l, tempstr);
  838. expr:=expr + tempstr;
  839. end
  840. else
  841. begin
  842. if is_locallabel(tempstr) then
  843. begin
  844. CreateLocalLabel(tempstr,hl,false);
  845. hs:=hl.name;
  846. hssymtyp:=AT_FUNCTION;
  847. end
  848. else
  849. if SearchLabel(tempstr,hl,false) then
  850. begin
  851. hs:=hl.name;
  852. hssymtyp:=AT_FUNCTION;
  853. end
  854. else
  855. begin
  856. asmsearchsym(tempstr,sym,srsymtable);
  857. if assigned(sym) then
  858. begin
  859. case sym.typ of
  860. staticvarsym :
  861. begin
  862. hs:=tstaticvarsym(sym).mangledname;
  863. def:=tstaticvarsym(sym).vardef;
  864. end;
  865. localvarsym,
  866. paravarsym :
  867. begin
  868. Message(asmr_e_no_local_or_para_allowed);
  869. end;
  870. procsym :
  871. begin
  872. if Tprocsym(sym).ProcdefList.Count>1 then
  873. Message(asmr_w_calling_overload_func);
  874. hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname;
  875. {$ifdef i8086}
  876. if is_proc_far(tprocdef(tprocsym(sym).ProcdefList[0]))
  877. and not (po_interrupt in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) then
  878. include(out_flags,cseof_is_farproc_entry)
  879. else
  880. exclude(out_flags,cseof_is_farproc_entry);
  881. {$endif i8086}
  882. hssymtyp:=AT_FUNCTION;
  883. end;
  884. typesym :
  885. begin
  886. if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
  887. Message(asmr_e_wrong_sym_type);
  888. size:=ttypesym(sym).typedef.size;
  889. end;
  890. fieldvarsym :
  891. begin
  892. tempstr:=upper(tdef(sym.owner.defowner).GetTypeName)+'.'+tempstr;
  893. end;
  894. else
  895. Message(asmr_e_wrong_sym_type);
  896. end;
  897. end
  898. else
  899. Message1(sym_e_unknown_id,tempstr);
  900. end;
  901. { symbol found? }
  902. if hs<>'' then
  903. begin
  904. if asmsym='' then
  905. begin
  906. asmsym:=hs;
  907. asmsymtyp:=hssymtyp;
  908. end
  909. else
  910. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  911. if (expr='') or (expr[length(expr)]='+') then
  912. begin
  913. { don't remove the + if there could be a record field }
  914. if actasmtoken<>AS_DOT then
  915. delete(expr,length(expr),1);
  916. end
  917. else if (cseif_needofs in in_flags) then
  918. begin
  919. if (prevtok<>AS_OFFSET) then
  920. Message(asmr_e_need_offset);
  921. end
  922. else
  923. Message(asmr_e_only_add_relocatable_symbol);
  924. end;
  925. if (actasmtoken=AS_DOT) or
  926. (assigned(sym) and
  927. is_normal_fieldvarsym(sym)) then
  928. begin
  929. BuildRecordOffsetSize(tempstr,l,size,hs,needvmtofs,hastypecast);
  930. if hs <> '' then
  931. hssymtyp:=AT_FUNCTION
  932. else
  933. begin
  934. str(l, tempstr);
  935. expr:=expr + tempstr;
  936. end
  937. end
  938. else if (actasmtoken<>AS_DOT) and
  939. assigned(sym) and
  940. (sym.typ=typesym) and
  941. (ttypesym(sym).typedef.typ in [recorddef,objectdef]) then
  942. begin
  943. { just a record type (without being followed by dot)
  944. evaluates to 0. Ugly, but TP7 compatible. }
  945. expr:=expr+'0';
  946. end
  947. else
  948. begin
  949. if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
  950. delete(expr,length(expr),1);
  951. end;
  952. if (actasmtoken=AS_LBRACKET) and
  953. assigned(def) and
  954. (def.typ=arraydef) then
  955. begin
  956. consume(AS_LBRACKET);
  957. l:=BuildConstExpression;
  958. if l<tarraydef(def).lowrange then
  959. begin
  960. Message(asmr_e_constant_out_of_bounds);
  961. l:=0;
  962. end
  963. else
  964. l:=(l-tarraydef(def).lowrange)*tarraydef(def).elesize;
  965. str(l, tempstr);
  966. expr:=expr + '+' + tempstr;
  967. consume(AS_RBRACKET);
  968. end;
  969. end;
  970. { check if there are wrong operator used like / or mod etc. }
  971. if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
  972. Message(asmr_e_only_add_relocatable_symbol);
  973. end;
  974. //AS_ALIGN,
  975. AS_DEFB,
  976. AS_DEFW,
  977. AS_END,
  978. AS_RBRACKET,
  979. AS_SEPARATOR,
  980. AS_COMMA,
  981. AS_COLON:
  982. break;
  983. else
  984. begin
  985. { write error only once. }
  986. if not errorflag then
  987. Message(asmr_e_invalid_constant_expression);
  988. { consume tokens until we find COMMA or SEPARATOR }
  989. Consume(actasmtoken);
  990. errorflag:=TRUE;
  991. end;
  992. end;
  993. Until false;
  994. { calculate expression }
  995. if not ErrorFlag then
  996. value:=CalculateExpression(expr)
  997. else
  998. value:=0;
  999. { no longer in an expression }
  1000. inexpression:=FALSE;
  1001. end;
  1002. function tmos6502reader.BuildConstExpression:longint;
  1003. var
  1004. l,size : tcgint;
  1005. hs : string;
  1006. hssymtyp : TAsmsymtype;
  1007. out_flags : tconstsymbolexpressionoutputflags;
  1008. begin
  1009. BuildConstSymbolExpression([],l,hs,hssymtyp,size,out_flags);
  1010. if hs<>'' then
  1011. Message(asmr_e_relocatable_symbol_not_allowed);
  1012. BuildConstExpression:=l;
  1013. end;
  1014. function tmos6502reader.BuildRefConstExpression(out size:tcgint;startingminus:boolean=false):longint;
  1015. var
  1016. l : tcgint;
  1017. hs : string;
  1018. hssymtyp : TAsmsymtype;
  1019. in_flags : tconstsymbolexpressioninputflags;
  1020. out_flags : tconstsymbolexpressionoutputflags;
  1021. begin
  1022. in_flags:=[cseif_isref];
  1023. if startingminus then
  1024. include(in_flags,cseif_startingminus);
  1025. BuildConstSymbolExpression(in_flags,l,hs,hssymtyp,size,out_flags);
  1026. if hs<>'' then
  1027. Message(asmr_e_relocatable_symbol_not_allowed);
  1028. BuildRefConstExpression:=l;
  1029. end;
  1030. procedure tmos6502reader.BuildConstantOperand(oper: tmos6502operand);
  1031. var
  1032. l,size : tcgint;
  1033. tempstr : string;
  1034. tempsymtyp : tasmsymtype;
  1035. cse_out_flags : tconstsymbolexpressionoutputflags;
  1036. forceaddrtype: Boolean;
  1037. newaddrtype: trefaddr;
  1038. begin
  1039. if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
  1040. Message(asmr_e_invalid_operand_type);
  1041. case actasmtoken of
  1042. AS_LESSTHAN:
  1043. begin
  1044. Consume(AS_LESSTHAN);
  1045. forceaddrtype:=true;
  1046. newaddrtype:=addr_lo8;
  1047. end;
  1048. AS_GREATERTHAN:
  1049. begin
  1050. Consume(AS_GREATERTHAN);
  1051. forceaddrtype:=true;
  1052. newaddrtype:=addr_hi8;
  1053. end;
  1054. else
  1055. forceaddrtype:=false;
  1056. end;
  1057. BuildConstSymbolExpression([],l,tempstr,tempsymtyp,size,cse_out_flags);
  1058. if tempstr<>'' then
  1059. begin
  1060. oper.opr.typ:=OPR_SYMBOL;
  1061. oper.opr.symofs:=l;
  1062. oper.opr.symbol:=current_asmdata.RefAsmSymbol(tempstr,tempsymtyp);
  1063. oper.opr.symseg:=cseof_isseg in cse_out_flags;
  1064. oper.opr.sym_farproc_entry:=cseof_is_farproc_entry in cse_out_flags;
  1065. if forceaddrtype then
  1066. begin
  1067. oper.InitRef;
  1068. oper.opr.ref.refaddr:=newaddrtype;
  1069. end
  1070. end
  1071. else
  1072. if oper.opr.typ=OPR_NONE then
  1073. begin
  1074. oper.opr.typ:=OPR_CONSTANT;
  1075. oper.opr.val:=l;
  1076. end
  1077. else
  1078. inc(oper.opr.val,l);
  1079. if forceaddrtype and (oper.opr.typ=OPR_CONSTANT) then
  1080. case newaddrtype of
  1081. addr_lo8:
  1082. oper.opr.val:=oper.opr.val and $FF;
  1083. addr_hi8:
  1084. oper.opr.val:=oper.opr.val shr 8;
  1085. else
  1086. internalerror(2025102303);
  1087. end;
  1088. end;
  1089. procedure tmos6502reader.BuildReference(oper : tmos6502operand);
  1090. var
  1091. scale : byte;
  1092. k,l,size : tcgint;
  1093. tempstr,hs : string;
  1094. tempsymtyp : tasmsymtype;
  1095. code : integer;
  1096. hreg : tregister;
  1097. GotStar,GotOffset,HadVar,
  1098. GotPlus,Negative,BracketlessReference : boolean;
  1099. hl : tasmlabel;
  1100. hastypecast: boolean;
  1101. tmpoper: tmos6502operand;
  1102. cse_in_flags: tconstsymbolexpressioninputflags;
  1103. cse_out_flags: tconstsymbolexpressionoutputflags;
  1104. begin
  1105. if actasmtoken=AS_LPAREN then
  1106. begin
  1107. Consume(AS_LPAREN);
  1108. BracketlessReference:=false;
  1109. end
  1110. else
  1111. BracketlessReference:=true;
  1112. if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
  1113. oper.InitRef;
  1114. GotStar:=false;
  1115. GotPlus:=true;
  1116. GotOffset:=false;
  1117. Negative:=false;
  1118. Scale:=0;
  1119. repeat
  1120. if GotOffset and (actasmtoken<>AS_ID) then
  1121. Message(asmr_e_invalid_reference_syntax);
  1122. Case actasmtoken of
  1123. AS_ID, { Constant reference expression OR variable reference expression }
  1124. AS_VMTOFFSET:
  1125. Begin
  1126. if not GotPlus then
  1127. Message(asmr_e_invalid_reference_syntax);
  1128. GotStar:=false;
  1129. GotPlus:=false;
  1130. if (actasmtoken = AS_VMTOFFSET) or
  1131. (SearchIConstant(actasmpattern,l) or
  1132. SearchRecordType(actasmpattern)) then
  1133. begin
  1134. l:=BuildRefConstExpression(size,negative);
  1135. if size<>0 then
  1136. oper.SetSize(size,false);
  1137. negative:=false; { "l" was negated if necessary }
  1138. GotPlus:=(prevasmtoken=AS_PLUS);
  1139. GotStar:=(prevasmtoken=AS_STAR);
  1140. case oper.opr.typ of
  1141. OPR_LOCAL :
  1142. begin
  1143. if GotStar then
  1144. Message(asmr_e_invalid_reference_syntax);
  1145. Inc(oper.opr.localsymofs,l);
  1146. end;
  1147. OPR_REFERENCE :
  1148. begin
  1149. if GotStar then
  1150. oper.opr.ref.scalefactor:=l
  1151. else
  1152. Inc(oper.opr.ref.offset,l);
  1153. end;
  1154. else
  1155. internalerror(2019050715);
  1156. end;
  1157. end
  1158. else
  1159. Begin
  1160. if negative and not oper.hasvar then
  1161. Message(asmr_e_only_add_relocatable_symbol)
  1162. else if oper.hasvar and not GotOffset and
  1163. (not negative or assigned(oper.opr.ref.relsymbol)) then
  1164. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1165. HadVar:=oper.hasvar and GotOffset;
  1166. tempstr:=actasmpattern;
  1167. Consume(AS_ID);
  1168. { typecasting? }
  1169. if (actasmtoken=AS_LPAREN) and
  1170. SearchType(tempstr,l) then
  1171. begin
  1172. oper.hastype:=true;
  1173. oper.typesize:=l;
  1174. Consume(AS_LPAREN);
  1175. BuildOperand(oper,false);
  1176. Consume(AS_RPAREN);
  1177. end
  1178. else
  1179. if is_locallabel(tempstr) then
  1180. begin
  1181. CreateLocalLabel(tempstr,hl,false);
  1182. oper.InitRef;
  1183. oper.haslabelref:=true;
  1184. if not negative then
  1185. begin
  1186. oper.opr.ref.symbol:=hl;
  1187. oper.hasvar:=true;
  1188. end
  1189. else
  1190. oper.opr.ref.relsymbol:=hl;
  1191. {$ifdef i8086}
  1192. if oper.opr.ref.segment=NR_NO then
  1193. oper.opr.ref.segment:=NR_CS;
  1194. {$endif i8086}
  1195. end
  1196. else
  1197. if oper.SetupVar(tempstr,GotOffset) then
  1198. begin
  1199. { convert OPR_LOCAL register para into a reference base }
  1200. if (oper.opr.typ=OPR_LOCAL) and
  1201. AsmRegisterPara(oper.opr.localsym) then
  1202. oper.InitRefConvertLocal
  1203. else
  1204. begin
  1205. {$ifdef x86_64}
  1206. if actasmtoken=AS_WRT then
  1207. begin
  1208. if (oper.opr.typ=OPR_REFERENCE) then
  1209. begin
  1210. Consume(AS_WRT);
  1211. Consume(AS___GOTPCREL);
  1212. if (oper.opr.ref.base<>NR_NO) or
  1213. (oper.opr.ref.index<>NR_NO) or
  1214. (oper.opr.ref.offset<>0) then
  1215. Message(asmr_e_wrong_gotpcrel_intel_syntax);
  1216. if tf_no_pic_supported in target_info.flags then
  1217. Message(asmr_e_no_gotpcrel_support);
  1218. oper.opr.ref.refaddr:=addr_pic;
  1219. oper.opr.ref.base:=NR_RIP;
  1220. end
  1221. else
  1222. message(asmr_e_invalid_reference_syntax);
  1223. end;
  1224. {$endif x86_64}
  1225. end;
  1226. end
  1227. else
  1228. Message1(sym_e_unknown_id,tempstr);
  1229. { record.field ? }
  1230. if actasmtoken=AS_DOT then
  1231. begin
  1232. BuildRecordOffsetSize(tempstr,l,k,hs,false,hastypecast);
  1233. if (hs<>'') then
  1234. Message(asmr_e_invalid_symbol_ref);
  1235. case oper.opr.typ of
  1236. OPR_LOCAL :
  1237. inc(oper.opr.localsymofs,l);
  1238. OPR_REFERENCE :
  1239. inc(oper.opr.ref.offset,l);
  1240. else
  1241. internalerror(2019050716);
  1242. end;
  1243. if hastypecast then
  1244. oper.hastype:=true;
  1245. oper.SetSize(k,false);
  1246. end;
  1247. if GotOffset then
  1248. begin
  1249. if oper.hasvar and (oper.opr.ref.base=current_procinfo.framepointer) then
  1250. begin
  1251. if (oper.opr.typ=OPR_REFERENCE) then
  1252. oper.opr.ref.base:=NR_NO;
  1253. oper.hasvar:=hadvar;
  1254. end
  1255. else
  1256. begin
  1257. if oper.hasvar and hadvar then
  1258. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1259. { should we allow ?? }
  1260. end;
  1261. end;
  1262. end;
  1263. GotOffset:=false;
  1264. end;
  1265. AS_PLUS :
  1266. Begin
  1267. Consume(AS_PLUS);
  1268. Negative:=false;
  1269. GotPlus:=true;
  1270. GotStar:=false;
  1271. Scale:=0;
  1272. end;
  1273. AS_DOT :
  1274. Begin
  1275. { Handle like a + }
  1276. Consume(AS_DOT);
  1277. Negative:=false;
  1278. GotPlus:=true;
  1279. GotStar:=false;
  1280. Scale:=0;
  1281. end;
  1282. AS_MINUS :
  1283. begin
  1284. Consume(AS_MINUS);
  1285. Negative:=true;
  1286. GotPlus:=true;
  1287. GotStar:=false;
  1288. Scale:=0;
  1289. end;
  1290. AS_STAR : { Scaling, with eax*4 order }
  1291. begin
  1292. Consume(AS_STAR);
  1293. hs:='';
  1294. l:=0;
  1295. case actasmtoken of
  1296. AS_ID,
  1297. AS_LPAREN :
  1298. l:=BuildConstExpression;
  1299. AS_INTNUM:
  1300. Begin
  1301. hs:=actasmpattern;
  1302. Consume(AS_INTNUM);
  1303. end;
  1304. AS_REGISTER :
  1305. begin
  1306. case oper.opr.typ of
  1307. OPR_REFERENCE :
  1308. begin
  1309. if oper.opr.ref.scalefactor=0 then
  1310. begin
  1311. if scale<>0 then
  1312. begin
  1313. oper.opr.ref.scalefactor:=scale;
  1314. scale:=0;
  1315. end
  1316. else
  1317. Message(asmr_e_wrong_scale_factor);
  1318. end
  1319. else
  1320. Message(asmr_e_invalid_reference_syntax);
  1321. end;
  1322. OPR_LOCAL :
  1323. begin
  1324. if oper.opr.localscale=0 then
  1325. begin
  1326. if scale<>0 then
  1327. begin
  1328. oper.opr.localscale:=scale;
  1329. scale:=0;
  1330. end
  1331. else
  1332. Message(asmr_e_wrong_scale_factor);
  1333. end
  1334. else
  1335. Message(asmr_e_invalid_reference_syntax);
  1336. end;
  1337. else
  1338. internalerror(2019050719);
  1339. end;
  1340. end;
  1341. else
  1342. Message(asmr_e_invalid_reference_syntax);
  1343. end;
  1344. if actasmtoken<>AS_REGISTER then
  1345. begin
  1346. if hs<>'' then
  1347. val(hs,l,code);
  1348. case oper.opr.typ of
  1349. OPR_REFERENCE :
  1350. oper.opr.ref.scalefactor:=l;
  1351. OPR_LOCAL :
  1352. oper.opr.localscale:=l;
  1353. else
  1354. internalerror(2019050717);
  1355. end;
  1356. if l>9 then
  1357. Message(asmr_e_wrong_scale_factor);
  1358. end;
  1359. GotPlus:=false;
  1360. GotStar:=false;
  1361. end;
  1362. AS_REGISTER :
  1363. begin
  1364. hreg:=actasmregister;
  1365. Consume(AS_REGISTER);
  1366. if not((GotPlus and (not Negative)) or
  1367. GotStar) then
  1368. Message(asmr_e_invalid_reference_syntax);
  1369. { this register will be the index:
  1370. 1. just read a *
  1371. 2. next token is a *
  1372. 3. base register is already used }
  1373. case oper.opr.typ of
  1374. OPR_LOCAL :
  1375. begin
  1376. if (oper.opr.localindexreg<>NR_NO) then
  1377. Message(asmr_e_multiple_index);
  1378. oper.opr.localindexreg:=hreg;
  1379. if scale<>0 then
  1380. begin
  1381. oper.opr.localscale:=scale;
  1382. scale:=0;
  1383. end;
  1384. end;
  1385. OPR_REFERENCE :
  1386. begin
  1387. if (GotStar) or
  1388. (actasmtoken=AS_STAR) or
  1389. (oper.opr.ref.base<>NR_NO) then
  1390. begin
  1391. if (oper.opr.ref.index<>NR_NO) then
  1392. Message(asmr_e_multiple_index);
  1393. oper.opr.ref.index:=hreg;
  1394. if scale<>0 then
  1395. begin
  1396. oper.opr.ref.scalefactor:=scale;
  1397. scale:=0;
  1398. end;
  1399. end
  1400. else
  1401. begin
  1402. oper.opr.ref.base:=hreg;
  1403. {$ifdef x86_64}
  1404. { non-GOT based RIP-relative accesses are also position-independent }
  1405. if (oper.opr.ref.base=NR_RIP) and
  1406. (oper.opr.ref.refaddr<>addr_pic) then
  1407. oper.opr.ref.refaddr:=addr_pic_no_got;
  1408. {$endif x86_64}
  1409. end;
  1410. end;
  1411. else
  1412. internalerror(2019050718);
  1413. end;
  1414. GotPlus:=false;
  1415. GotStar:=false;
  1416. end;
  1417. AS_OFFSET :
  1418. begin
  1419. Consume(AS_OFFSET);
  1420. GotOffset:=true;
  1421. end;
  1422. AS_TYPE,
  1423. AS_NOT,
  1424. AS_STRING,
  1425. AS_INTNUM,
  1426. AS_LPAREN : { Constant reference expression }
  1427. begin
  1428. if not GotPlus and not GotStar then
  1429. Message(asmr_e_invalid_reference_syntax);
  1430. cse_in_flags:=[cseif_isref];
  1431. if GotPlus and negative then
  1432. include(cse_in_flags,cseif_startingminus);
  1433. BuildConstSymbolExpression(cse_in_flags,l,tempstr,tempsymtyp,size,cse_out_flags);
  1434. { already handled by BuildConstSymbolExpression(); must be
  1435. handled there to avoid [reg-1+1] being interpreted as
  1436. [reg-(1+1)] }
  1437. negative:=false;
  1438. if tempstr<>'' then
  1439. begin
  1440. if GotStar then
  1441. Message(asmr_e_only_add_relocatable_symbol);
  1442. if not assigned(oper.opr.ref.symbol) then
  1443. begin
  1444. oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr,tempsymtyp);
  1445. {$ifdef i8086}
  1446. if cseof_isseg in cse_out_flags then
  1447. begin
  1448. if not (oper.opr.ref.refaddr in [addr_fardataseg,addr_dgroup]) then
  1449. oper.opr.ref.refaddr:=addr_seg;
  1450. end
  1451. else if (tempsymtyp=AT_FUNCTION) and (oper.opr.ref.segment=NR_NO) then
  1452. oper.opr.ref.segment:=NR_CS;
  1453. {$endif i8086}
  1454. end
  1455. else
  1456. Message(asmr_e_cant_have_multiple_relocatable_symbols);
  1457. end;
  1458. case oper.opr.typ of
  1459. OPR_REFERENCE :
  1460. begin
  1461. if GotStar then
  1462. oper.opr.ref.scalefactor:=l
  1463. else if (prevasmtoken = AS_STAR) then
  1464. begin
  1465. if scale<>0 then
  1466. scale:=l*scale
  1467. else
  1468. scale:=l;
  1469. end
  1470. else
  1471. begin
  1472. Inc(oper.opr.ref.offset,l);
  1473. Inc(oper.opr.constoffset,l);
  1474. end;
  1475. end;
  1476. OPR_LOCAL :
  1477. begin
  1478. if GotStar then
  1479. oper.opr.localscale:=l
  1480. else if (prevasmtoken = AS_STAR) then
  1481. begin
  1482. if scale<>0 then
  1483. scale:=l*scale
  1484. else
  1485. scale:=l;
  1486. end
  1487. else
  1488. Inc(oper.opr.localsymofs,l);
  1489. end;
  1490. else
  1491. internalerror(2019050714);
  1492. end;
  1493. GotPlus:=(prevasmtoken=AS_PLUS) or
  1494. (prevasmtoken=AS_MINUS);
  1495. if GotPlus then
  1496. negative := prevasmtoken = AS_MINUS;
  1497. GotStar:=(prevasmtoken=AS_STAR);
  1498. end;
  1499. //AS_LBRACKET :
  1500. // begin
  1501. // if (GotPlus and Negative) or GotStar then
  1502. // Message(asmr_e_invalid_reference_syntax);
  1503. // tmpoper:=Tz80Operand.create;
  1504. // BuildReference(tmpoper);
  1505. // AddReferences(oper,tmpoper);
  1506. // tmpoper.Free;
  1507. // GotPlus:=false;
  1508. // GotStar:=false;
  1509. // end;
  1510. AS_RPAREN :
  1511. begin
  1512. if GotPlus or GotStar or BracketlessReference then
  1513. Message(asmr_e_invalid_reference_syntax);
  1514. Consume(AS_RPAREN);
  1515. if actasmtoken=AS_COMMA then
  1516. begin
  1517. Consume(AS_COMMA);
  1518. if actasmtoken<>AS_REGISTER then
  1519. begin
  1520. Message(asmr_e_invalid_reference_syntax);
  1521. RecoverConsume(true);
  1522. break;
  1523. end;
  1524. hreg:=actasmregister;
  1525. Consume(AS_REGISTER);
  1526. if hreg<>NR_Y then
  1527. begin
  1528. Message(asmr_e_invalid_reference_syntax);
  1529. RecoverConsume(true);
  1530. break;
  1531. end;
  1532. case oper.opr.typ of
  1533. OPR_REFERENCE :
  1534. begin
  1535. if oper.opr.ref.base<>NR_NO then
  1536. internalerror(2025102302);
  1537. oper.opr.ref.base:=hreg;
  1538. oper.opr.ref.addressmode:=taddressmode.AM_INDIRECT;
  1539. end;
  1540. else
  1541. internalerror(2025102301);
  1542. end;
  1543. end;
  1544. //if actasmtoken=AS_LPAREN then
  1545. // begin
  1546. // tmpoper:=Tmos6502Operand.create;
  1547. // BuildReference(tmpoper);
  1548. // AddReferences(oper,tmpoper);
  1549. // tmpoper.Free;
  1550. // end;
  1551. break;
  1552. end;
  1553. AS_COMMA:
  1554. begin
  1555. Consume(AS_COMMA);
  1556. if actasmtoken<>AS_REGISTER then
  1557. begin
  1558. Message(asmr_e_invalid_reference_syntax);
  1559. RecoverConsume(true);
  1560. break;
  1561. end;
  1562. hreg:=actasmregister;
  1563. Consume(AS_REGISTER);
  1564. if (hreg<>NR_X) and (hreg<>NR_Y) then
  1565. begin
  1566. Message(asmr_e_invalid_reference_syntax);
  1567. RecoverConsume(true);
  1568. break;
  1569. end;
  1570. if not BracketlessReference and (hreg<>NR_X) then
  1571. begin
  1572. Message(asmr_e_invalid_reference_syntax);
  1573. RecoverConsume(true);
  1574. break;
  1575. end;
  1576. case oper.opr.typ of
  1577. OPR_REFERENCE :
  1578. begin
  1579. if oper.opr.ref.base<>NR_NO then
  1580. internalerror(2025102302);
  1581. oper.opr.ref.base:=hreg;
  1582. end;
  1583. else
  1584. internalerror(2025102301);
  1585. end;
  1586. if not BracketlessReference then
  1587. begin
  1588. Consume(AS_RPAREN);
  1589. oper.opr.ref.addressmode:=taddressmode.AM_INDIRECT;
  1590. end;
  1591. break;
  1592. end;
  1593. AS_SEPARATOR,
  1594. AS_END:
  1595. begin
  1596. if not BracketlessReference then
  1597. begin
  1598. Message(asmr_e_invalid_reference_syntax);
  1599. RecoverConsume(true);
  1600. end;
  1601. break;
  1602. end;
  1603. else
  1604. Begin
  1605. Message(asmr_e_invalid_reference_syntax);
  1606. RecoverConsume(true);
  1607. break;
  1608. end;
  1609. end;
  1610. until false;
  1611. end;
  1612. procedure tmos6502reader.BuildOperand(oper: tmos6502operand;iscalljmp: boolean);
  1613. //procedure AddLabelOperand(hl:tasmlabel);
  1614. //begin
  1615. // if (oper.opr.typ=OPR_NONE) and
  1616. // is_calljmp(actopcode) then
  1617. // begin
  1618. // oper.opr.typ:=OPR_SYMBOL;
  1619. // oper.opr.symbol:=hl;
  1620. // end
  1621. // else
  1622. // begin
  1623. // oper.InitRef;
  1624. // oper.opr.ref.symbol:=hl;
  1625. // oper.haslabelref:=true;
  1626. // end;
  1627. //end;
  1628. var
  1629. l: tcgint;
  1630. tsize: tcgint;
  1631. // expr: string;
  1632. // hl: tasmlabel;
  1633. begin
  1634. repeat
  1635. case actasmtoken of
  1636. //AS_OFFSET,
  1637. //AS_SIZEOF,
  1638. //AS_VMTOFFSET,
  1639. //AS_TYPE,
  1640. //AS_NOT,
  1641. AS_ID,
  1642. //AS_LPAREN,
  1643. AS_STRING,
  1644. AS_PLUS,
  1645. AS_MINUS,
  1646. AS_INTNUM :
  1647. begin
  1648. if iscalljmp then
  1649. BuildConstantOperand(oper)
  1650. else
  1651. BuildReference(oper);
  1652. //case oper.opr.typ of
  1653. // OPR_REFERENCE :
  1654. // begin
  1655. // l := BuildRefConstExpression(tsize);
  1656. // if tsize<>0 then
  1657. // oper.SetSize(tsize,false);
  1658. // inc(oper.opr.ref.offset,l);
  1659. // inc(oper.opr.constoffset,l);
  1660. // end;
  1661. // OPR_LOCAL :
  1662. // begin
  1663. // l := BuildConstExpression;
  1664. // inc(oper.opr.localsymofs,l);
  1665. // inc(oper.opr.localconstoffset,l);
  1666. // end;
  1667. //
  1668. // OPR_NONE,
  1669. // OPR_CONSTANT :
  1670. // BuildConstantOperand(oper);
  1671. // else
  1672. // Message(asmr_e_invalid_operand_type);
  1673. //end;
  1674. end;
  1675. AS_LPAREN:
  1676. begin
  1677. BuildReference(oper);
  1678. end;
  1679. AS_HASH:
  1680. begin
  1681. if iscalljmp then
  1682. begin
  1683. Message(asmr_e_syn_operand);
  1684. RecoverConsume(true);
  1685. break;
  1686. end;
  1687. Consume(AS_HASH);
  1688. BuildConstantOperand(oper);
  1689. end;
  1690. //AS_ID : { A constant expression, or a Variable ref. }
  1691. // Begin
  1692. // { Label or Special symbol reference? }
  1693. // if actasmpattern[1] = '@' then
  1694. // Begin
  1695. // if actasmpattern = '@RESULT' then
  1696. // Begin
  1697. // oper.SetupResult;
  1698. // Consume(AS_ID);
  1699. // expr:='result';
  1700. // end
  1701. // else
  1702. // if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
  1703. // begin
  1704. // Message(asmr_w_CODE_and_DATA_not_supported);
  1705. // Consume(AS_ID);
  1706. // end
  1707. // else
  1708. // { Local Label }
  1709. // begin
  1710. // CreateLocalLabel(actasmpattern,hl,false);
  1711. // Consume(AS_ID);
  1712. // AddLabelOperand(hl);
  1713. // end;
  1714. // end
  1715. // else
  1716. // { support result for delphi modes }
  1717. // if (m_objpas in current_settings.modeswitches) and (actasmpattern='RESULT') then
  1718. // begin
  1719. // oper.SetUpResult;
  1720. // Consume(AS_ID);
  1721. // expr:='result';
  1722. // end
  1723. // { probably a variable or normal expression }
  1724. // { or a procedure (such as in CALL ID) }
  1725. // else
  1726. // Begin
  1727. // { is it a constant ? }
  1728. // if SearchIConstant(actasmpattern,l) then
  1729. // Begin
  1730. // case oper.opr.typ of
  1731. // OPR_REFERENCE :
  1732. // begin
  1733. // l := BuildRefConstExpression(tsize);
  1734. // if tsize<>0 then
  1735. // oper.SetSize(tsize,false);
  1736. // inc(oper.opr.ref.offset,l);
  1737. // inc(oper.opr.constoffset,l);
  1738. // end;
  1739. //
  1740. // OPR_LOCAL :
  1741. // begin
  1742. // l := BuildRefConstExpression(tsize);
  1743. // if tsize<>0 then
  1744. // oper.SetSize(tsize,false);
  1745. // inc(oper.opr.localsymofs,l);
  1746. // inc(oper.opr.localconstoffset,l);
  1747. // end;
  1748. // OPR_NONE,
  1749. // OPR_CONSTANT :
  1750. // BuildConstantOperand(oper);
  1751. // else
  1752. // Message(asmr_e_invalid_operand_type);
  1753. // end;
  1754. // end
  1755. // else
  1756. // { Check for pascal label }
  1757. // if SearchLabel(actasmpattern,hl,false) then
  1758. // begin
  1759. // Consume(AS_ID);
  1760. // AddLabelOperand(hl);
  1761. // end
  1762. // else
  1763. // { is it a normal variable ? }
  1764. // Begin
  1765. // expr:=actasmpattern;
  1766. // Consume(AS_ID);
  1767. //
  1768. //
  1769. // { typecasting? }
  1770. // if SearchType(expr,l) then
  1771. // begin
  1772. // oper.hastype:=true;
  1773. // oper.typesize:=l;
  1774. // case actasmtoken of
  1775. // AS_LPAREN :
  1776. // begin
  1777. // { Support Type([Reference]) }
  1778. // Consume(AS_LPAREN);
  1779. // BuildOperand(oper,true);
  1780. // { Delphi also supports Type(Register) and
  1781. // interprets it the same as Type([Register]). }
  1782. // if (oper.opr.typ = OPR_REGISTER) then
  1783. // { This also sets base to the register. }
  1784. // oper.InitRef;
  1785. // Consume(AS_RPAREN);
  1786. // end;
  1787. // //AS_LBRACKET :
  1788. // // begin
  1789. // // { Support Var.Type[Index] }
  1790. // // { Convert @label.Byte[1] to reference }
  1791. // // if oper.opr.typ=OPR_SYMBOL then
  1792. // // oper.initref;
  1793. // // end;
  1794. // else
  1795. // ;
  1796. // end;
  1797. // end
  1798. // else
  1799. // begin
  1800. // if not oper.SetupVar(expr,false) then
  1801. // Begin
  1802. // { not a variable, check special variables.. }
  1803. // if expr = 'SELF' then
  1804. // begin
  1805. // oper.SetupSelf;
  1806. // expr:='self';
  1807. // end
  1808. // else
  1809. // begin
  1810. // Message1(sym_e_unknown_id,expr);
  1811. // expr:='';
  1812. // end;
  1813. // end;
  1814. // { indexed access to variable? }
  1815. // //if actasmtoken=AS_LBRACKET then
  1816. // // begin
  1817. // // { ... then the operand size is not known anymore }
  1818. // // oper.size:=OS_NO;
  1819. // // BuildReference(oper);
  1820. // // end;
  1821. // end;
  1822. // end;
  1823. // end;
  1824. // end;
  1825. AS_REGISTER : { Register, a variable reference or a constant reference }
  1826. begin
  1827. Consume(AS_REGISTER);
  1828. { Simple register }
  1829. if (oper.opr.typ <> OPR_NONE) then
  1830. Message(asmr_e_syn_operand);
  1831. oper.opr.typ:=OPR_REGISTER;
  1832. oper.opr.reg:=actasmregister;
  1833. oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true);
  1834. end;
  1835. AS_SEPARATOR,
  1836. AS_END,
  1837. AS_COMMA:
  1838. begin
  1839. break;
  1840. end;
  1841. else
  1842. begin
  1843. Message(asmr_e_syn_operand);
  1844. RecoverConsume(true);
  1845. break;
  1846. end;
  1847. end;
  1848. until false;
  1849. end;
  1850. procedure tmos6502reader.BuildOpCode(instr:TMOS6502Instruction);
  1851. var
  1852. operandnum: Integer;
  1853. begin
  1854. instr.opcode:=actopcode;
  1855. if actopcode=A_Bxx then
  1856. instr.condition:=actasmcond;
  1857. operandnum:=1;
  1858. Consume(AS_OPCODE);
  1859. { Zero operand opcode ? }
  1860. if actasmtoken in [AS_SEPARATOR,AS_END] then
  1861. exit;
  1862. { Read Operands }
  1863. repeat
  1864. case actasmtoken of
  1865. { End of asm operands for this opcode }
  1866. AS_END,
  1867. AS_SEPARATOR :
  1868. break;
  1869. { Operand delimiter }
  1870. AS_COMMA :
  1871. begin
  1872. { should have something before the comma }
  1873. if instr.operands[operandnum].opr.typ=OPR_NONE then
  1874. Message(asmr_e_syntax_error);
  1875. if operandnum >= max_operands then
  1876. Message(asmr_e_too_many_operands)
  1877. else
  1878. Inc(operandnum);
  1879. Consume(AS_COMMA);
  1880. end;
  1881. else
  1882. BuildOperand(instr.Operands[operandnum] as tmos6502operand,is_calljmp(instr.opcode));
  1883. end;
  1884. until false;
  1885. instr.ops:=operandnum;
  1886. end;
  1887. procedure tmos6502reader.handleopcode;
  1888. var
  1889. instr: TMOS6502Instruction;
  1890. begin
  1891. instr:=TMOS6502Instruction.create(TMOS6502Operand);
  1892. BuildOpcode(instr);
  1893. with instr do
  1894. begin
  1895. //CheckNonCommutativeOpcodes;
  1896. //AddReferenceSizes;
  1897. //SetInstructionOpsize;
  1898. //CheckOperandSizes;
  1899. ConcatInstruction(curlist);
  1900. end;
  1901. instr.Free;
  1902. end;
  1903. function tmos6502reader.Assemble: tlinkedlist;
  1904. var
  1905. hl: tasmlabel;
  1906. sectionname: String;
  1907. section: tai_section;
  1908. lastsectype : TAsmSectiontype;
  1909. begin
  1910. Message1(asmr_d_start_reading,'MOS Technology 6502');
  1911. firsttoken:=TRUE;
  1912. { sets up all opcode and register tables in uppercase }
  1913. if not _asmsorted then
  1914. begin
  1915. SetupTables;
  1916. _asmsorted:=TRUE;
  1917. end;
  1918. curlist:=TAsmList.Create;
  1919. { we might need to know which parameters are passed in registers }
  1920. if not parse_generic then
  1921. current_procinfo.generate_parameter_info;
  1922. { start tokenizer }
  1923. gettoken;
  1924. lastsectype:=sec_code;
  1925. { main loop }
  1926. repeat
  1927. case actasmtoken of
  1928. AS_LLABEL:
  1929. Begin
  1930. if CreateLocalLabel(actasmpattern,hl,true) then
  1931. ConcatLabel(curlist,hl);
  1932. Consume(AS_LLABEL);
  1933. end;
  1934. AS_LABEL:
  1935. Begin
  1936. if SearchLabel(upper(actasmpattern),hl,true) then
  1937. begin
  1938. if hl.is_public then
  1939. ConcatPublic(curlist,actasmpattern_origcase);
  1940. ConcatLabel(curlist,hl);
  1941. end
  1942. else
  1943. Message1(asmr_e_unknown_label_identifier,actasmpattern);
  1944. Consume(AS_LABEL);
  1945. end;
  1946. AS_END:
  1947. begin
  1948. break; { end assembly block }
  1949. end;
  1950. AS_SEPARATOR:
  1951. begin
  1952. Consume(AS_SEPARATOR);
  1953. end;
  1954. //AS_DEFB :
  1955. // Begin
  1956. // inexpression:=true;
  1957. // Consume(AS_DEFB);
  1958. // BuildConstant(1);
  1959. // inexpression:=false;
  1960. // end;
  1961. //
  1962. //AS_DEFW :
  1963. // Begin
  1964. // inexpression:=true;
  1965. // Consume(AS_DEFW);
  1966. // BuildConstant(2);
  1967. // inexpression:=false;
  1968. // end;
  1969. //
  1970. //AS_AREA :
  1971. // begin
  1972. // Consume(AS_AREA);
  1973. // sectionname:=actasmpattern;
  1974. // {secflags:=[];
  1975. // secprogbits:=SPB_None;}
  1976. // Consume(AS_STRING);
  1977. // {if actasmtoken=AS_COMMA then
  1978. // begin
  1979. // Consume(AS_COMMA);
  1980. // if actasmtoken=AS_STRING then
  1981. // begin
  1982. // case actasmpattern of
  1983. // 'a':
  1984. // Include(secflags,SF_A);
  1985. // 'w':
  1986. // Include(secflags,SF_W);
  1987. // 'x':
  1988. // Include(secflags,SF_X);
  1989. // '':
  1990. // ;
  1991. // else
  1992. // Message(asmr_e_syntax_error);
  1993. // end;
  1994. // Consume(AS_STRING);
  1995. // if actasmtoken=AS_COMMA then
  1996. // begin
  1997. // Consume(AS_COMMA);
  1998. // if (actasmtoken=AS_MOD) or (actasmtoken=AS_AT) then
  1999. // begin
  2000. // Consume(actasmtoken);
  2001. // if actasmtoken=AS_ID then
  2002. // begin
  2003. // case actasmpattern of
  2004. // 'PROGBITS':
  2005. // secprogbits:=SPB_PROGBITS;
  2006. // 'NOBITS':
  2007. // secprogbits:=SPB_NOBITS;
  2008. // 'NOTE':
  2009. // secprogbits:=SPB_NOTE;
  2010. // else
  2011. // Message(asmr_e_syntax_error);
  2012. // end;
  2013. // Consume(AS_ID);
  2014. // end
  2015. // else
  2016. // Message(asmr_e_syntax_error);
  2017. // end
  2018. // else
  2019. // Message(asmr_e_syntax_error);
  2020. // end;
  2021. // end
  2022. // else
  2023. // Message(asmr_e_syntax_error);
  2024. // end;}
  2025. //
  2026. // //curList.concat(tai_section.create(sec_user, actasmpattern, 0));
  2027. // section:=new_section(curlist, sec_user, sectionname, 0);
  2028. // lastsectype:=sec_user;
  2029. // //section.secflags:=secflags;
  2030. // //section.secprogbits:=secprogbits;
  2031. // end;
  2032. AS_OPCODE:
  2033. begin
  2034. HandleOpCode;
  2035. end;
  2036. else
  2037. begin
  2038. Message(asmr_e_syntax_error);
  2039. RecoverConsume(false);
  2040. end;
  2041. end;
  2042. until false;
  2043. { are we back in the code section? }
  2044. if lastsectype<>sec_code then
  2045. begin
  2046. //Message(asmr_w_assembler_code_not_returned_to_text);
  2047. new_section(curList,sec_code,lower(current_procinfo.procdef.mangledname),0);
  2048. end;
  2049. { check that all referenced local labels are defined }
  2050. checklocallabels;
  2051. { Return the list in an asmnode }
  2052. assemble:=curlist;
  2053. Message1(asmr_d_finish_reading,'MOS Technology 6502');
  2054. end;
  2055. {*****************************************************************************
  2056. Initialize
  2057. *****************************************************************************}
  2058. const
  2059. asmmode_mos6502_standard_info : tasmmodeinfo =
  2060. (
  2061. id : asmmode_standard;
  2062. idtxt : 'STANDARD';
  2063. casmreader : tmos6502reader;
  2064. );
  2065. initialization
  2066. RegisterAsmMode(asmmode_mos6502_standard_info);
  2067. end.