ra386att.pas 165 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140
  1. {
  2. $Id$
  3. Copyright (c) 1997-98 by Carl Eric Codere
  4. Does the parsing for the AT&T styled inline assembler.
  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. }
  18. Unit Ra386att;
  19. {$ifdef TP}
  20. {$N+,E+}
  21. {$endif TP}
  22. {**********************************************************************}
  23. { WARNING }
  24. {**********************************************************************}
  25. { Any modification in the order or removal of terms in the tables }
  26. { in i386.pas and intasmi3.pas will BREAK the code in this unit, }
  27. { unless the appropriate changes are made to this unit. Addition }
  28. { of terms though, will not change the code herein. }
  29. {**********************************************************************}
  30. {--------------------------------------------------------------------}
  31. { LEFT TO DO: }
  32. {--------------------------------------------------------------------}
  33. { o Handle record offsets }
  34. { o Add support imul,shld and shrd. }
  35. { o Add support for nor operators. }
  36. { o Bugfix of ao_imm8s for IMUL. (Currently the 3 operand imul will }
  37. { be considered as invalid because I use ao_imm8 and the table }
  38. { uses ao_imm8s). }
  39. { o In ConcatOpCode add more checking regarding suffixes and }
  40. { destination registers. (started but unfinished). }
  41. {--------------------------------------------------------------------}
  42. Interface
  43. uses
  44. globtype,i386,tree;
  45. function assemble: ptree;
  46. const
  47. { this variable is TRUE if the lookup tables have already been setup }
  48. { for fast access. On the first call to assemble the tables are setup }
  49. { and stay set up. }
  50. _asmsorted: boolean = FALSE;
  51. firstreg = R_EAX;
  52. lastreg = R_ST7;
  53. { Hack to support all opcodes in the i386 table }
  54. { only tokens up to and including lastop_in_table }
  55. { are checked for validity, otherwise... }
  56. lastop_in_table = A_EMMS;
  57. type
  58. tiasmops = array[firstop..lastop] of string[7];
  59. piasmops = ^tiasmops;
  60. var
  61. previous_was_id : boolean;
  62. { sorted tables of opcodes }
  63. iasmops: piasmops;
  64. { uppercased tables of registers }
  65. iasmregs: array[firstreg..lastreg] of string[6];
  66. Implementation
  67. Uses
  68. files,aasm,globals,AsmUtils,strings,hcodegen,scanner,systems,
  69. cobjects,verbose,symtable,types;
  70. type
  71. tinteltoken = (
  72. AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_HEXNUM,AS_OCTALNUM,
  73. AS_BINNUM,AS_REALNUM,AS_COMMA,AS_LPAREN,
  74. AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_INTNUM,
  75. AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR,
  76. {------------------ Assembler directives --------------------}
  77. AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,AS_ALIGN,AS_ASCII,
  78. AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,
  79. AS_DATA,AS_TEXT,AS_END,
  80. {------------------ Assembler Operators --------------------}
  81. AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR);
  82. tasmkeyword = string[8];
  83. const
  84. { These tokens should be modified accordingly to the modifications }
  85. { in the different enumerations. }
  86. firstdirective = AS_DB;
  87. lastdirective = AS_END;
  88. firstsreg = R_CS;
  89. lastsreg = R_SS;
  90. _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
  91. _count_asmprefixes = 5;
  92. _count_asmspecialops = 25;
  93. _count_asmoverrides = 3;
  94. _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
  95. ('.byte','.word','.long','.quad','.globl','.align','.ascii',
  96. '.asciz','.lcomm','.comm','.single','.double','.tfloat',
  97. '.data','.text','END');
  98. {------------------ Missing opcodes from std list ----------------}
  99. _asmprefixes: array[0.._count_asmprefixes] of tasmkeyword = (
  100. 'REPNE','REPE','REP','REPZ','REPNZ','LOCK');
  101. _prefixtokens: array[0.._count_asmprefixes] of tasmop = (
  102. A_REPNE,A_REPE,A_REP,A_REPE,A_REPNE,A_LOCK);
  103. _specialops: array[0.._count_asmspecialops] of tasmkeyword = (
  104. 'CMPSB','CMPSW','CMPSL','INSB','INSW','INSL','OUTSB','OUTSW','OUTSL',
  105. 'SCASB','SCASW','SCASL','STOSB','STOSW','STOSL','MOVSB','MOVSW','MOVSL',
  106. 'LODSB','LODSW','LODSL','LOCK','SEGCS','SEGDS','SEGES','SEGSS');
  107. _specialopstokens: array[0.._count_asmspecialops] of tasmop = (
  108. A_CMPS,A_CMPS,A_CMPS,A_INS,A_INS,A_INS,A_OUTS,A_OUTS,A_OUTS,
  109. A_SCAS,A_SCAS,A_SCAS,A_STOS,A_STOS,A_STOS,A_MOVS,A_MOVS,A_MOVS,
  110. A_LODS,A_LODS,A_LODS,A_LOCK,A_NONE,A_NONE,A_NONE,A_NONE);
  111. {------------------------------------------------------------------}
  112. { register type definition table for easier searching }
  113. _regtypes:array[firstreg..lastreg] of longint =
  114. (ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,
  115. ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,
  116. ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,
  117. ao_none,ao_sreg2,ao_sreg2,ao_sreg2,ao_sreg3,ao_sreg3,ao_sreg2,
  118. ao_floatacc,ao_floatacc,ao_floatreg,ao_floatreg,ao_floatreg,ao_floatreg,
  119. ao_floatreg,ao_floatreg,ao_floatreg);
  120. _regsizes: array[firstreg..lastreg] of topsize =
  121. (S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
  122. S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
  123. S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
  124. { segment register }
  125. S_W,S_W,S_W,S_W,S_W,S_W,S_W,
  126. { can also be S_S or S_T - must be checked at run-time }
  127. S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL);
  128. {topsize = (S_NO,S_B,S_W,S_L,S_BW,S_BL,S_WL,
  129. S_IS,S_IL,S_IQ,S_FS,S_FL,S_FX,S_D);}
  130. _constsizes: array[S_NO..S_FS] of longint =
  131. (0,ao_imm8,ao_imm16,ao_imm32,0,0,0,ao_imm16,ao_imm32,0,ao_imm32);
  132. { converts from AT&T style to non-specific style... }
  133. _fpusizes:array[A_FILDQ..A_FIDIVRS] of topsize = (
  134. {'fildq','filds',}
  135. S_IQ,S_IS,
  136. {'fildl','fldl','fldt','fistq','fists','fistl','fstl','fsts',}
  137. S_IL,S_FL,S_FX,S_IQ,S_IS,S_IL,S_FL,S_FS,
  138. {'fstps','fistpl','fstpl','fistps','fistpq','fstpt','fcomps',}
  139. S_FS,S_IL,S_FL,S_IS,S_IQ,S_FX,S_FS,
  140. {'ficompl','fcompl','ficomps','fcoms','ficoml','fcoml','ficoms',}
  141. S_IL,S_FL,S_IS,S_FS,S_IL,S_FL,S_IS,
  142. {'fiaddl','faddl','fiadds','fisubl','fsubl','fisubs','fsubs',}
  143. S_IL,S_FL,S_IS,S_IL,S_FL,S_FS,S_IS,S_FS,
  144. {'fsubr','fsubrs','fisubrl','fsubrl','fisubrs','fmuls','fimull',}
  145. S_NO,S_FS,S_IL,S_FL,S_IS,S_FS,S_IL,
  146. {'fmull','fimuls','fdivs','fidivl','fdivl','fidivs','fdivrs',}
  147. S_FL,S_IL,S_FS,S_IL,S_FL,S_IS,S_FS,
  148. {'fidivrl','fdivrl',}
  149. S_IL,S_FL);
  150. _fpuopcodes:array[A_FILDQ..A_FIDIVRS] of tasmop = (
  151. A_FILD,A_FILD,A_FILD,A_FLD,A_FLD,A_FIST,A_FIST,A_FIST,A_FST,A_FST,
  152. A_FSTP,A_FISTP,A_FSTP,A_FISTP,A_FISTP,A_FSTP,
  153. A_FCOMP,A_FICOMP,A_FCOMP,A_FICOMP,
  154. A_FCOM,A_FICOM,A_FCOM,A_FICOM,A_FIADD,A_FADD,A_FIADD,
  155. A_FISUB,A_FSUB,A_FISUB,A_FSUB,A_FSUB,A_FSUBR,A_FISUBR,
  156. A_FSUBR,A_FISUBR,A_FMUL,A_FIMUL,A_FMUL,A_FIMUL,A_FDIV,A_FIDIV,
  157. A_FDIV,A_FIDIV,A_FDIVR,A_FIDIVR,A_FDIVR,A_FIDIVR);
  158. const
  159. newline = #10;
  160. firsttoken : boolean = TRUE;
  161. operandnum : byte = 0;
  162. charcount: byte = 0;
  163. var
  164. p : paasmoutput;
  165. actasmtoken: tinteltoken;
  166. actasmpattern: string;
  167. c: char;
  168. Instr: TInstruction;
  169. labellist: TAsmLabelList;
  170. line: string; { CHanged from const to var, there is a bug in 0.9.1 which
  171. doesn't allow 255-char constant strings. MVC}
  172. Procedure SetupTables;
  173. { creates uppercased symbol tables. }
  174. var
  175. i: tasmop;
  176. j: tregister;
  177. Begin
  178. Message(assem_d_creating_lookup_tables);
  179. { opcodes }
  180. new(iasmops);
  181. for i:=firstop to lastop do
  182. iasmops^[i] := upper(att_op2str[i]);
  183. { opcodes }
  184. for j:=firstreg to lastreg do
  185. iasmregs[j] := upper(att_reg2str[j]);
  186. end;
  187. {---------------------------------------------------------------------}
  188. { Routines for the tokenizing }
  189. {---------------------------------------------------------------------}
  190. function is_asmopcode(const s: string):Boolean;
  191. {*********************************************************************}
  192. { FUNCTION is_asmopcode(s: string):Boolean }
  193. { Description: Determines if the s string is a valid opcode }
  194. { if so returns TRUE otherwise returns FALSE. }
  195. {*********************************************************************}
  196. var
  197. i: tasmop;
  198. j: byte;
  199. hs: topsize;
  200. hid: string;
  201. Begin
  202. is_asmopcode := FALSE;
  203. { first search for extended opcodes }
  204. for j:=0 to _count_asmspecialops do
  205. Begin
  206. if s = _specialops[j] then
  207. Begin
  208. is_asmopcode:=TRUE;
  209. exit;
  210. end;
  211. end;
  212. for i:=firstop to lastop do
  213. Begin
  214. if s=iasmops^[i] then
  215. begin
  216. is_asmopcode := TRUE;
  217. exit
  218. end;
  219. end;
  220. { not found yet ... }
  221. { search for all possible suffixes }
  222. for hs:=S_WL downto S_B do
  223. if copy(s,length(s)-length(att_opsize2str[hs])+1,
  224. length(att_opsize2str[hs]))=upper(att_opsize2str[hs]) then
  225. begin
  226. { here we search the entire table... }
  227. hid:=copy(s,1,length(s)-length(att_opsize2str[hs]));
  228. for i:=firstop to lastop do
  229. if (length(hid) > 0) and (hid=iasmops^[i]) then
  230. begin
  231. is_asmopcode := TRUE;
  232. exit;
  233. end;
  234. end;
  235. end;
  236. Procedure is_asmdirective(const s: string; var token: tinteltoken);
  237. {*********************************************************************}
  238. { FUNCTION is_asmdirective(s: string; var token: tinteltoken):Boolean }
  239. { Description: Determines if the s string is a valid directive }
  240. { (an operator can occur in operand fields, while a directive cannot) }
  241. { if so returns the directive token, otherwise does not change token.}
  242. {*********************************************************************}
  243. var
  244. i:byte;
  245. Begin
  246. for i:=0 to _count_asmdirectives do
  247. begin
  248. if s=_asmdirectives[i] then
  249. begin
  250. token := tinteltoken(longint(firstdirective)+i);
  251. exit;
  252. end;
  253. end;
  254. end;
  255. Procedure is_register(const s: string; var token: tinteltoken);
  256. {*********************************************************************}
  257. { PROCEDURE is_register(s: string; var token: tinteltoken); }
  258. { Description: Determines if the s string is a valid register, if }
  259. { so return token equal to A_REGISTER, otherwise does not change token}
  260. {*********************************************************************}
  261. Var
  262. i: tregister;
  263. Begin
  264. for i:=firstreg to lastreg do
  265. begin
  266. if s=iasmregs[i] then
  267. begin
  268. token := AS_REGISTER;
  269. exit;
  270. end;
  271. end;
  272. end;
  273. Function GetToken: tinteltoken;
  274. {*********************************************************************}
  275. { FUNCTION GetToken: tinteltoken; }
  276. { Description: This routine returns intel assembler tokens and }
  277. { does some minor syntax error checking. }
  278. {*********************************************************************}
  279. var
  280. token: tinteltoken;
  281. forcelabel: boolean;
  282. errorflag : boolean;
  283. temp: string;
  284. code: integer;
  285. value: byte;
  286. begin
  287. errorflag := FALSE;
  288. forcelabel := FALSE;
  289. actasmpattern :='';
  290. {* INIT TOKEN TO NOTHING *}
  291. token := AS_NONE;
  292. { while space and tab , continue scan... }
  293. while c in [' ',#9] do
  294. c:=current_scanner^.asmgetchar;
  295. { Possiblities for first token in a statement: }
  296. { Local Label, Label, Directive, Prefix or Opcode.... }
  297. if firsttoken and not (c in [newline,#13,'{',';']) then
  298. begin
  299. current_scanner^.gettokenpos;
  300. firsttoken := FALSE;
  301. { directive or local labe }
  302. if c = '.' then
  303. begin
  304. actasmpattern := c;
  305. { Let us point to the next character }
  306. c := current_scanner^.asmgetchar;
  307. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  308. begin
  309. actasmpattern := actasmpattern + c;
  310. c := current_scanner^.asmgetchar;
  311. end;
  312. { this is a local label... }
  313. if (actasmpattern[2] = 'L') and (c = ':') then
  314. Begin
  315. { local variables are case sensitive }
  316. gettoken := AS_LLABEL;
  317. { delete .L }
  318. delete(actasmpattern,1,2);
  319. { point to next character ... }
  320. c := current_scanner^.asmgetchar;
  321. exit;
  322. end
  323. { must be a directive }
  324. else
  325. Begin
  326. { directives are case sensitive!! }
  327. is_asmdirective(actasmpattern, token);
  328. if (token <> AS_NONE) then
  329. Begin
  330. gettoken := token;
  331. exit;
  332. end
  333. else
  334. Message1(assem_e_not_directive_or_local_symbol,actasmpattern);
  335. end;
  336. end; { endif }
  337. { only opcodes and global labels are allowed now. }
  338. while c in ['A'..'Z','a'..'z','0'..'9','_'] do
  339. begin
  340. actasmpattern := actasmpattern + c;
  341. c := current_scanner^.asmgetchar;
  342. end;
  343. if c = ':' then
  344. begin
  345. { uppervar(actasmpattern);
  346. Carl, you cannot change the label to upper
  347. if you want to be able to read in system unit
  348. don't forget that ATT syntax is case sensitive
  349. for labels !! (PM) }
  350. token := AS_LABEL;
  351. { let us point to the next character }
  352. c := current_scanner^.asmgetchar;
  353. gettoken := token;
  354. exit;
  355. end;
  356. If is_asmopcode(upper(actasmpattern)) then
  357. Begin
  358. uppervar(actasmpattern);
  359. gettoken := AS_OPCODE;
  360. exit;
  361. end
  362. else
  363. if upper(actasmpattern) = 'END' then
  364. begin
  365. gettoken := AS_END;
  366. exit;
  367. end
  368. else
  369. begin
  370. gettoken := AS_NONE;
  371. Message(assem_e_invalid_operand);
  372. end;
  373. end
  374. else { else firsttoken }
  375. { Here we must handle all possible cases }
  376. begin
  377. case c of
  378. '.': { possiblities : - local label reference , such as in jmp @local1 }
  379. { - field of object/record }
  380. { - directive. }
  381. begin
  382. if previous_was_id then
  383. begin
  384. c:=current_scanner^.asmgetchar;
  385. gettoken:=AS_DOT;
  386. exit;
  387. end;
  388. actasmpattern := c;
  389. c:= current_scanner^.asmgetchar;
  390. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  391. begin
  392. actasmpattern := actasmpattern + c;
  393. c := current_scanner^.asmgetchar;
  394. end;
  395. is_asmdirective(actasmpattern,token);
  396. { if directive }
  397. if (token <> AS_NONE) then
  398. begin
  399. gettoken := token;
  400. exit;
  401. end;
  402. { local label references and directives }
  403. { are case sensitive }
  404. gettoken := AS_ID;
  405. exit;
  406. end;
  407. { identifier, register, opcode, prefix or directive }
  408. '_','A'..'Z','a'..'z': begin
  409. actasmpattern := c;
  410. c:= current_scanner^.asmgetchar;
  411. while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
  412. begin
  413. actasmpattern := actasmpattern + c;
  414. c := current_scanner^.asmgetchar;
  415. end;
  416. { pascal is not case sensitive! }
  417. { therefore variables which are }
  418. { outside the scope of the asm }
  419. { block, should not be made case }
  420. { sensitive... !!!!! }
  421. uppervar(actasmpattern);
  422. If is_asmopcode(actasmpattern) then
  423. Begin
  424. gettoken := AS_OPCODE;
  425. exit;
  426. end;
  427. { we handle this directive separately from }
  428. { others. }
  429. if actasmpattern = 'END' then
  430. Begin
  431. gettoken := AS_END;
  432. exit;
  433. end;
  434. { if found }
  435. if (token <> AS_NONE) then
  436. begin
  437. gettoken := token;
  438. exit;
  439. end
  440. { this is surely an identifier }
  441. else
  442. token := AS_ID;
  443. gettoken := token;
  444. exit;
  445. end;
  446. '&': begin
  447. c:=current_scanner^.asmgetchar;
  448. gettoken := AS_AND;
  449. end;
  450. { character }
  451. '''' : begin
  452. c:=current_scanner^.asmgetchar;
  453. if c = '\' then
  454. Begin
  455. { escape sequence }
  456. c:=current_scanner^.asmgetchar;
  457. case c of
  458. newline: Message(scan_f_string_exceeds_line);
  459. 't': actasmpattern:=#09;
  460. 'b': actasmpattern:=#08;
  461. '\': actasmpattern:='\';
  462. 'f': actasmpattern:=#12;
  463. 'n': actasmpattern:=#10;
  464. 'r': actasmpattern:=#13;
  465. '"': actasmpattern:='"';
  466. { octal number }
  467. '0'..'7':
  468. begin
  469. temp:=c;
  470. temp:=temp+current_scanner^.asmgetchar;
  471. temp:=temp+current_scanner^.asmgetchar;
  472. val(octaltodec(temp),value,code);
  473. if (code <> 0) then
  474. Message1(assem_e_error_in_octal_const,temp);
  475. actasmpattern:=chr(value);
  476. end;
  477. { hexadecimal number }
  478. 'x':
  479. begin
  480. temp:=current_scanner^.asmgetchar;
  481. temp:=temp+current_scanner^.asmgetchar;
  482. val(hextodec(temp),value,code);
  483. if (code <> 0) then
  484. Message1(assem_e_error_in_hex_const,temp);
  485. actasmpattern:=chr(value);
  486. end;
  487. else
  488. Begin
  489. Message(assem_e_escape_seq_ignored);
  490. actasmpattern:=c;
  491. end
  492. end; { end case }
  493. end
  494. else
  495. actasmpattern:=c;
  496. gettoken := AS_STRING;
  497. c:=current_scanner^.asmgetchar;
  498. exit;
  499. end;
  500. { string }
  501. '"' :
  502. begin
  503. actasmpattern:='';
  504. while true do
  505. Begin
  506. c:=current_scanner^.asmgetchar;
  507. case c of
  508. '\': Begin
  509. { escape sequences }
  510. c:=current_scanner^.asmgetchar;
  511. case c of
  512. newline: Message(scan_f_string_exceeds_line);
  513. 't': actasmpattern:=actasmpattern+#09;
  514. 'b': actasmpattern:=actasmpattern+#08;
  515. '\': actasmpattern:=actasmpattern+'\';
  516. 'f': actasmpattern:=actasmpattern+#12;
  517. 'n': actasmpattern:=actasmpattern+#10;
  518. 'r': actasmpattern:=actasmpattern+#13;
  519. '"': actasmpattern:=actasmpattern+'"';
  520. { octal number }
  521. '0'..'7':
  522. begin
  523. temp:=c;
  524. temp:=temp+current_scanner^.asmgetchar;
  525. temp:=temp+current_scanner^.asmgetchar;
  526. val(octaltodec(temp),value,code);
  527. if (code <> 0) then
  528. Message1(assem_e_error_in_octal_const,temp);
  529. actasmpattern:=actasmpattern+chr(value);
  530. end;
  531. { hexadecimal number }
  532. 'x':
  533. begin
  534. temp:=current_scanner^.asmgetchar;
  535. temp:=temp+current_scanner^.asmgetchar;
  536. val(hextodec(temp),value,code);
  537. if (code <> 0) then
  538. Message1(assem_e_error_in_hex_const,temp);
  539. actasmpattern:=actasmpattern+chr(value);
  540. end;
  541. else
  542. Begin
  543. Message(assem_e_escape_seq_ignored);
  544. actasmpattern:=actasmpattern+c;
  545. end
  546. end; { end case }
  547. end;
  548. '"': begin
  549. c:=current_scanner^.asmgetchar;
  550. break;
  551. end;
  552. newline: Message(scan_f_string_exceeds_line);
  553. else
  554. actasmpattern:=actasmpattern+c;
  555. end;
  556. end; { end case }
  557. token := AS_STRING;
  558. gettoken := token;
  559. exit;
  560. end;
  561. '$' : begin
  562. gettoken := AS_DOLLAR;
  563. c:=current_scanner^.asmgetchar;
  564. exit;
  565. end;
  566. ',' : begin
  567. gettoken := AS_COMMA;
  568. c:=current_scanner^.asmgetchar;
  569. exit;
  570. end;
  571. '<' : begin
  572. gettoken := AS_SHL;
  573. c := current_scanner^.asmgetchar;
  574. if c = '<' then
  575. c := current_scanner^.asmgetchar;
  576. exit;
  577. end;
  578. '>' : begin
  579. gettoken := AS_SHL;
  580. c := current_scanner^.asmgetchar;
  581. if c = '>' then
  582. c := current_scanner^.asmgetchar;
  583. exit;
  584. end;
  585. '|' : begin
  586. gettoken := AS_OR;
  587. c := current_scanner^.asmgetchar;
  588. exit;
  589. end;
  590. '^' : begin
  591. gettoken := AS_XOR;
  592. c := current_scanner^.asmgetchar;
  593. exit;
  594. end;
  595. '!' : begin
  596. Message(assem_e_nor_not_supported);
  597. c := current_scanner^.asmgetchar;
  598. gettoken := AS_NONE;
  599. exit;
  600. end;
  601. '(' : begin
  602. gettoken := AS_LPAREN;
  603. c:=current_scanner^.asmgetchar;
  604. exit;
  605. end;
  606. ')' : begin
  607. gettoken := AS_RPAREN;
  608. c:=current_scanner^.asmgetchar;
  609. exit;
  610. end;
  611. ':' : begin
  612. gettoken := AS_COLON;
  613. c:=current_scanner^.asmgetchar;
  614. exit;
  615. end;
  616. '+' : begin
  617. gettoken := AS_PLUS;
  618. c:=current_scanner^.asmgetchar;
  619. exit;
  620. end;
  621. '-' : begin
  622. gettoken := AS_MINUS;
  623. c:=current_scanner^.asmgetchar;
  624. exit;
  625. end;
  626. '*' : begin
  627. gettoken := AS_STAR;
  628. c:=current_scanner^.asmgetchar;
  629. exit;
  630. end;
  631. '/' : begin
  632. c:=current_scanner^.asmgetchar;
  633. { att styled comment }
  634. if c='/' then
  635. begin
  636. repeat
  637. c:=current_scanner^.asmgetchar;
  638. until c=newline;
  639. firsttoken := TRUE;
  640. gettoken:=AS_SEPARATOR;
  641. c:=current_scanner^.asmgetchar;
  642. exit;
  643. end
  644. else
  645. begin
  646. gettoken := AS_SLASH;
  647. c:=current_scanner^.asmgetchar;
  648. exit;
  649. end;
  650. end;
  651. { register or modulo }
  652. { only register supported }
  653. { for the moment. }
  654. '%' : begin
  655. actasmpattern := c;
  656. c:=current_scanner^.asmgetchar;
  657. while c in ['a'..'z','A'..'Z','0'..'9'] do
  658. Begin
  659. actasmpattern := actasmpattern + c;
  660. c:=current_scanner^.asmgetchar;
  661. end;
  662. token := AS_NONE;
  663. uppervar(actasmpattern);
  664. if (actasmpattern = '%ST') and (c='(') then
  665. Begin
  666. actasmpattern:=actasmpattern+c;
  667. c:=current_scanner^.asmgetchar;
  668. if c in ['0'..'9'] then
  669. actasmpattern := actasmpattern + c
  670. else
  671. Message(assem_e_invalid_fpu_register);
  672. c:=current_scanner^.asmgetchar;
  673. if c <> ')' then
  674. Message(assem_e_invalid_fpu_register)
  675. else
  676. Begin
  677. actasmpattern := actasmpattern + c;
  678. c:=current_scanner^.asmgetchar; { let us point to next character. }
  679. end;
  680. end;
  681. is_register(actasmpattern, token);
  682. { if found }
  683. if (token <> AS_NONE) then
  684. begin
  685. gettoken := token;
  686. exit;
  687. end
  688. else
  689. begin
  690. Message(assem_w_modulo_not_supported);
  691. gettoken := AS_NONE;
  692. end;
  693. end;
  694. { integer number }
  695. '1'..'9': begin
  696. actasmpattern := c;
  697. c := current_scanner^.asmgetchar;
  698. while c in ['0'..'9'] do
  699. Begin
  700. actasmpattern := actasmpattern + c;
  701. c:= current_scanner^.asmgetchar;
  702. end;
  703. gettoken := AS_INTNUM;
  704. exit;
  705. end;
  706. '0': begin
  707. { octal,hexa,real or binary number. }
  708. actasmpattern := c;
  709. c:=current_scanner^.asmgetchar;
  710. case upcase(c) of
  711. { binary }
  712. 'B': Begin
  713. c:=current_scanner^.asmgetchar;
  714. while c in ['0','1'] do
  715. Begin
  716. actasmpattern := actasmpattern + c;
  717. c := current_scanner^.asmgetchar;
  718. end;
  719. gettoken := AS_BINNUM;
  720. exit;
  721. end;
  722. { real }
  723. 'D': Begin
  724. c:=current_scanner^.asmgetchar;
  725. { get ridd of the 0d }
  726. if (c='+') or (c='-') then
  727. begin
  728. actasmpattern:=c;
  729. c:=current_scanner^.asmgetchar;
  730. end
  731. else
  732. actasmpattern:='';
  733. while c in ['0'..'9'] do
  734. Begin
  735. actasmpattern := actasmpattern + c;
  736. c:= current_scanner^.asmgetchar;
  737. end;
  738. if c='.' then
  739. begin
  740. actasmpattern := actasmpattern + c;
  741. c:=current_scanner^.asmgetchar;
  742. while c in ['0'..'9'] do
  743. Begin
  744. actasmpattern := actasmpattern + c;
  745. c:= current_scanner^.asmgetchar;
  746. end;
  747. if upcase(c) = 'E' then
  748. begin
  749. actasmpattern := actasmpattern + c;
  750. c:=current_scanner^.asmgetchar;
  751. if (c = '+') or (c = '-') then
  752. begin
  753. actasmpattern := actasmpattern + c;
  754. c:=current_scanner^.asmgetchar;
  755. end;
  756. while c in ['0'..'9'] do
  757. Begin
  758. actasmpattern := actasmpattern + c;
  759. c:= current_scanner^.asmgetchar;
  760. end;
  761. end;
  762. gettoken := AS_REALNUM;
  763. exit;
  764. end
  765. else
  766. begin
  767. Message1(assem_e_invalid_float_const,actasmpattern+c);
  768. gettoken:=AS_NONE;
  769. end;
  770. end;
  771. { hexadecimal }
  772. 'X': Begin
  773. c:=current_scanner^.asmgetchar;
  774. while c in ['0'..'9','a'..'f','A'..'F'] do
  775. Begin
  776. actasmpattern := actasmpattern + c;
  777. c := current_scanner^.asmgetchar;
  778. end;
  779. gettoken := AS_HEXNUM;
  780. exit;
  781. end;
  782. { octal }
  783. '1'..'7': begin
  784. actasmpattern := actasmpattern + c;
  785. while c in ['0'..'7'] do
  786. Begin
  787. actasmpattern := actasmpattern + c;
  788. c := current_scanner^.asmgetchar;
  789. end;
  790. gettoken := AS_OCTALNUM;
  791. exit;
  792. end;
  793. else { octal number zero value...}
  794. Begin
  795. gettoken := AS_OCTALNUM;
  796. exit;
  797. end;
  798. end; { end case }
  799. end;
  800. '{',#13,newline,';' : begin
  801. { the comment is read by asmgetchar }
  802. c:=current_scanner^.asmgetchar;
  803. firsttoken := TRUE;
  804. gettoken:=AS_SEPARATOR;
  805. end;
  806. else
  807. Begin
  808. Message(scan_f_illegal_char);
  809. end;
  810. end; { end case }
  811. end; { end else if }
  812. end;
  813. {---------------------------------------------------------------------}
  814. { Routines for the output }
  815. {---------------------------------------------------------------------}
  816. { looks for internal names of variables and routines }
  817. Function SearchDirectVar(var Instr: TInstruction; const hs:string;operandnum:byte): Boolean;
  818. var
  819. p : pai_external;
  820. Begin
  821. SearchDirectVar:=false;
  822. { search in the list of internals }
  823. p:=search_assembler_symbol(internals,hs,EXT_ANY);
  824. if p=nil then
  825. p:=search_assembler_symbol(externals,hs,EXT_ANY);
  826. if p<>nil then
  827. begin
  828. { get symbol name }
  829. { free the memory before changing the symbol name. }
  830. if assigned(instr.operands[operandnum].ref.symbol) then
  831. FreeMem(instr.operands[operandnum].ref.symbol,
  832. length(instr.operands[operandnum].ref.symbol^)+1);
  833. instr.operands[operandnum].ref.symbol:=newpasstr(strpas(p^.name));
  834. case p^.exttyp of
  835. EXT_BYTE : instr.operands[operandnum].size := S_B;
  836. EXT_WORD : instr.operands[operandnum].size := S_W;
  837. EXT_NEAR,EXT_FAR,EXT_PROC,EXT_DWORD,EXT_CODEPTR,EXT_DATAPTR:
  838. instr.operands[operandnum].size := S_L;
  839. EXT_QWORD : instr.operands[operandnum].size := S_FL;
  840. EXT_TBYTE : instr.operands[operandnum].size := S_FX;
  841. else
  842. { this is in the case where the instruction is LEA }
  843. { or something like that, in that case size is not }
  844. { important. }
  845. instr.operands[operandnum].size := S_NO;
  846. end;
  847. SearchDirectVar := TRUE;
  848. Exit;
  849. end;
  850. end;
  851. { returns an appropriate ao_xxxx flag indicating the type }
  852. { of operand. }
  853. function findtype(Var Opr: TOperand): longint;
  854. Begin
  855. With Opr do
  856. Begin
  857. case operandtype of
  858. OPR_REFERENCE: Begin
  859. if assigned(ref.symbol) then
  860. { check if in local label list }
  861. { if so then it is considered }
  862. { as a displacement. }
  863. Begin
  864. if labellist.search(ref.symbol^) <> nil then
  865. findtype := ao_disp
  866. else
  867. findtype := ao_mem; { probably a mem ref. }
  868. end
  869. else
  870. findtype := ao_mem;
  871. end;
  872. OPR_CONSTANT: Begin
  873. { check if there is not already a default size }
  874. if opr.size <> S_NO then
  875. Begin
  876. findtype := _constsizes[opr.size];
  877. exit;
  878. end;
  879. if val < $ff then
  880. Begin
  881. findtype := ao_imm8;
  882. opr.size := S_B;
  883. end
  884. else if val < $ffff then
  885. Begin
  886. findtype := ao_imm16;
  887. opr.size := S_W;
  888. end
  889. else
  890. Begin
  891. findtype := ao_imm32;
  892. opr.size := S_L;
  893. end
  894. end;
  895. OPR_REGISTER: Begin
  896. findtype := _regtypes[reg];
  897. exit;
  898. end;
  899. OPR_SYMBOL: Begin
  900. findtype := ao_jumpabsolute;
  901. end;
  902. OPR_NONE: Begin
  903. findtype := 0;
  904. end;
  905. else
  906. Begin
  907. Message(assem_f_internal_error_in_findtype);
  908. end;
  909. end;
  910. end;
  911. end;
  912. Procedure HandleExtend(var instr: TInstruction);
  913. { Handles MOVZX, MOVSX ... }
  914. var
  915. instruc: tasmop;
  916. opsize : topsize;
  917. Begin
  918. instruc:=instr.getinstruction;
  919. { if we have A_MOVZX/A_MOVSX here, there is a big problem }
  920. { it should never happen, because it is already replaced }
  921. { by ConcatOpcode! }
  922. Case instruc of
  923. A_MOVZX,A_MOVSX: Message(assem_f_internal_error_in_handleextend);
  924. A_MOVSB, A_MOVSBL:
  925. Begin
  926. instruc := A_MOVSX;
  927. { Indirect memory reference with register }
  928. { no size determined, therefore we determine it }
  929. { with the suffix. }
  930. if instr.operands[1].size = S_NO then
  931. instr.operands[1].size := S_B;
  932. end;
  933. A_MOVSBW:
  934. Begin
  935. instruc := A_MOVSX;
  936. { Indirect memory reference with register }
  937. { no size determined, therefore we determine it }
  938. { with the suffix. }
  939. if instr.operands[1].size = S_NO then
  940. instr.operands[1].size := S_B;
  941. end;
  942. A_MOVSWL:
  943. Begin
  944. instruc := A_MOVSX;
  945. { Indirect memory reference with register }
  946. { no size determined, therefore we determine it }
  947. { with the suffix. }
  948. if instr.operands[1].size = S_NO then
  949. instr.operands[1].size := S_W;
  950. end;
  951. A_MOVZB:
  952. Begin
  953. instruc := A_MOVZX;
  954. { Indirect memory reference with register }
  955. { no size determined, therefore we determine it }
  956. { with the suffix. }
  957. if instr.operands[1].size = S_NO then
  958. instr.operands[1].size := S_B;
  959. end;
  960. A_MOVZWL:
  961. Begin
  962. instruc := A_MOVZX;
  963. { Indirect memory reference with register }
  964. { no size determined, therefore we determine it }
  965. { with the suffix. }
  966. if instr.operands[1].size = S_NO then
  967. instr.operands[1].size := S_W;
  968. end;
  969. End;
  970. With instr do
  971. Begin
  972. if operands[1].size = S_B then
  973. Begin
  974. if operands[2].size = S_L then
  975. opsize := S_BL
  976. else
  977. if operands[2].size = S_W then
  978. opsize := S_BW
  979. else
  980. begin
  981. Message(assem_e_invalid_size_movzx);
  982. exit;
  983. end;
  984. end
  985. else
  986. if operands[1].size = S_W then
  987. Begin
  988. if operands[2].size = S_L then
  989. opsize := S_WL
  990. else
  991. begin
  992. Message(assem_e_invalid_size_movzx);
  993. exit;
  994. end;
  995. end
  996. else
  997. begin
  998. Message(assem_e_invalid_size_movzx);
  999. exit;
  1000. end;
  1001. if operands[1].operandtype = OPR_REGISTER then
  1002. Begin
  1003. if operands[2].operandtype <> OPR_REGISTER then
  1004. Message(assem_e_invalid_opcode) { exit...}
  1005. else
  1006. p^.concat(new(pai386,op_reg_reg(instruc,opsize,
  1007. operands[1].reg,operands[2].reg)));
  1008. end
  1009. else
  1010. if operands[1].operandtype = OPR_REFERENCE then
  1011. Begin
  1012. if operands[2].operandtype <> OPR_REGISTER then
  1013. Message(assem_e_invalid_opcode) {exit...}
  1014. else
  1015. p^.concat(new(pai386,op_ref_reg(instruc,opsize,
  1016. newreference(operands[1].ref),operands[2].reg)));
  1017. end
  1018. end; { end with }
  1019. end;
  1020. Procedure ConcatOpCode(var instr: TInstruction);
  1021. {*********************************************************************}
  1022. { First Pass: }
  1023. { - If this is a three operand opcode: }
  1024. { imul,shld,and shrd -> check them manually. }
  1025. {*********************************************************************}
  1026. var
  1027. fits : boolean;
  1028. i: longint;
  1029. opsize: topsize;
  1030. optyp1, optyp2, optyp3: longint;
  1031. instruc: tasmop;
  1032. href : treference;
  1033. Begin
  1034. fits := FALSE;
  1035. for i:=1 to instr.numops do
  1036. Begin
  1037. case instr.operands[i].operandtype of
  1038. OPR_REGISTER: instr.operands[i].size :=
  1039. _regsizes[instr.operands[i].reg];
  1040. end; { end case }
  1041. end; { endif }
  1042. { setup specific instructions for first pass }
  1043. instruc := instr.getinstruction;
  1044. Case instruc Of
  1045. A_LEA,A_LDS,A_LSS,A_LES,A_LFS,A_LGS:
  1046. Begin
  1047. if instr.operands[2].size <> S_L then
  1048. Begin
  1049. Message(assem_e_16bit_base_in_32bit_segment);
  1050. exit;
  1051. end; { endif }
  1052. end;
  1053. End;
  1054. With instr do
  1055. Begin
  1056. for i:=1 to numops do
  1057. Begin
  1058. With operands[i] do
  1059. Begin
  1060. { check for 16-bit bases/indexes and emit an error. }
  1061. { we cannot only emit a warning since gas does not }
  1062. { accept 16-bit indexes and bases. }
  1063. if (operandtype = OPR_REFERENCE) and
  1064. ((ref.base <> R_NO) or
  1065. (ref.index <> R_NO)) then
  1066. Begin
  1067. { index or base defined. }
  1068. if (ref.base <> R_NO) then
  1069. Begin
  1070. if not (ref.base in
  1071. [R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESI,R_EDI,R_ESP]) then
  1072. Message(assem_e_16bit_base_in_32bit_segment);
  1073. end;
  1074. { index or base defined. }
  1075. if (ref.index <> R_NO) then
  1076. Begin
  1077. if not (ref.index in
  1078. [R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESI,R_EDI,R_ESP]) then
  1079. Message(assem_e_16bit_index_in_32bit_segment);
  1080. end;
  1081. end;
  1082. { Check for constants without bases/indexes in memory }
  1083. { references. }
  1084. { Update: allow constant references under Go32v2, to }
  1085. { access data in the bios data segmement (JM) }
  1086. {$ifndef Go32v2}
  1087. if (operandtype = OPR_REFERENCE) and
  1088. (ref.base = R_NO) and
  1089. (ref.index = R_NO) and
  1090. (ref.symbol = nil) and
  1091. (ref.offset <> 0) then
  1092. Begin
  1093. ref.isintvalue := TRUE;
  1094. Message(assem_e_const_ref_not_allowed);
  1095. end;
  1096. {$endif Go32v2}
  1097. opinfo := findtype(operands[i]);
  1098. end; { end with }
  1099. end; {endfor}
  1100. { TAKE CARE OF SPECIAL OPCODES, TAKE CARE OF THEM INDIVUALLY. }
  1101. { ALL THE REST ARE TAKEN CARE BY OPCODE TABLE AND THIRD PASS. }
  1102. { is this right for ratti386 ? (PM) }
  1103. { almost... here we check for the size of registers and references }
  1104. { to determine the correct gas opcode to use, because if the token }
  1105. { is A_MOVSX or A_MOVZX then that means that the person forgot to }
  1106. { specify the size.. }
  1107. { if memory size is not specified, will of course give out an error}
  1108. Case instruc Of
  1109. A_MOVSX:
  1110. Begin
  1111. if numops = 2 then
  1112. begin
  1113. if stropsize = S_BL then
  1114. begin
  1115. operands[1].size := S_B;
  1116. stropsize := S_NO;
  1117. operands[2].size := S_L;
  1118. addinstr(A_MOVSBL)
  1119. end
  1120. else
  1121. if stropsize = S_WL then
  1122. begin
  1123. operands[1].size := S_W;
  1124. stropsize := S_NO;
  1125. operands[2].size := S_L;
  1126. addinstr(A_MOVSWL)
  1127. end
  1128. else
  1129. if stropsize = S_BW then
  1130. begin
  1131. operands[1].size := S_B;
  1132. stropsize := S_NO;
  1133. operands[2].size := S_W;
  1134. addinstr(A_MOVSBW)
  1135. end
  1136. else
  1137. if (operands[1].size = S_B) and
  1138. (operands[2].size = S_W) then
  1139. addinstr(A_MOVSBW)
  1140. else
  1141. if (operands[1].size = S_B) and
  1142. (operands[2].size = S_L) then
  1143. addinstr(A_MOVSBL)
  1144. else
  1145. if (operands[1].size = S_W) and
  1146. (operands[2].size = S_L) then
  1147. addinstr(A_MOVSWL)
  1148. else
  1149. begin
  1150. Message(assem_e_invalid_size_movzx);
  1151. exit;
  1152. end;
  1153. instruc := getinstruction; { reload instruction }
  1154. end
  1155. else
  1156. begin
  1157. Message(assem_e_too_many_operands);
  1158. exit;
  1159. end;
  1160. end;
  1161. A_MOVZX:
  1162. Begin
  1163. if numops = 2 then
  1164. Begin
  1165. if stropsize = S_BW then
  1166. begin
  1167. operands[1].size := S_B;
  1168. stropsize := S_NO;
  1169. operands[2].size := S_W;
  1170. addinstr(A_MOVZB)
  1171. end
  1172. else
  1173. if stropsize = S_BL then
  1174. begin
  1175. operands[1].size := S_B;
  1176. stropsize := S_NO;
  1177. operands[2].size := S_L;
  1178. addinstr(A_MOVZB)
  1179. end
  1180. else
  1181. if stropsize = S_WL then
  1182. begin
  1183. operands[1].size := S_W;
  1184. stropsize := S_NO;
  1185. operands[2].size := S_L;
  1186. addinstr(A_MOVZWL)
  1187. end
  1188. else
  1189. { change the instruction to conform to GAS }
  1190. if (operands[1].size = S_B) and
  1191. (operands[2].size in [S_W,S_L]) then
  1192. addinstr(A_MOVZB)
  1193. else
  1194. if (operands[1].size = S_W) and
  1195. (operands[2].size = S_L) then
  1196. addinstr(A_MOVZWL)
  1197. else
  1198. begin
  1199. Message(assem_e_invalid_size_movzx);
  1200. exit;
  1201. end;
  1202. instruc := getinstruction; { reload instruction }
  1203. end
  1204. else
  1205. Begin
  1206. Message(assem_e_too_many_operands);
  1207. exit;
  1208. end;
  1209. end;
  1210. A_FWAIT: FWaitWarning;
  1211. A_BT,A_BTC,A_BTR,A_BTS:
  1212. Begin
  1213. if numops = 2 then
  1214. Begin
  1215. if (operands[1].operandtype = OPR_CONSTANT)
  1216. and (operands[1].val <= $ff) then
  1217. Begin
  1218. operands[1].opinfo := ao_imm8;
  1219. { no operand size if using constant. }
  1220. operands[1].size := S_NO;
  1221. fits := TRUE;
  1222. end
  1223. end
  1224. else
  1225. Begin
  1226. Message(assem_e_invalid_opcode_and_operand);
  1227. exit;
  1228. end;
  1229. end;
  1230. A_ENTER:
  1231. Begin
  1232. if numops =2 then
  1233. Begin
  1234. if (operands[1].operandtype = OPR_CONSTANT) and
  1235. (operands[1].val <= $ffff) then
  1236. Begin
  1237. operands[1].opinfo := ao_imm16;
  1238. end { endif }
  1239. end { endif }
  1240. else
  1241. Begin
  1242. Message(assem_e_invalid_opcode_and_operand);
  1243. exit;
  1244. end
  1245. end;
  1246. { Handle special opcodes for the opcode }
  1247. { table. Set them up correctly. }
  1248. A_INS,A_IN:
  1249. Begin
  1250. if numops =2 then
  1251. Begin
  1252. if (operands[1].operandtype = OPR_REGISTER) and
  1253. (operands[1].reg = R_DX) then
  1254. Begin
  1255. operands[1].opinfo := ao_inoutportreg;
  1256. if (operands[2].operandtype = OPR_REGISTER) and
  1257. (operands[2].reg in [R_EAX,R_AX,R_AL]) and
  1258. (instruc = A_IN) then
  1259. Begin
  1260. operands[2].opinfo := ao_acc;
  1261. case operands[2].reg of
  1262. R_EAX: operands[2].size := S_L;
  1263. R_AX: operands[2].size := S_W;
  1264. R_AL: operands[2].size := S_B;
  1265. end;
  1266. end
  1267. end
  1268. else
  1269. if (operands[1].operandtype = OPR_CONSTANT) and
  1270. (operands[1].val <= $ff) And
  1271. (instruc = A_IN) then
  1272. Begin
  1273. operands[1].opinfo := ao_imm8;
  1274. operands[1].size := S_B;
  1275. if (operands[2].operandtype = OPR_REGISTER) and
  1276. (operands[2].reg in [R_EAX,R_AX,R_AL]) and
  1277. (instruc = A_IN) then
  1278. Begin
  1279. operands[2].opinfo := ao_acc;
  1280. end
  1281. end;
  1282. end
  1283. else
  1284. Begin
  1285. Message(assem_e_invalid_opcode_and_operand);
  1286. exit;
  1287. end;
  1288. end;
  1289. A_OUTS,A_OUT:
  1290. Begin
  1291. if numops =2 then
  1292. Begin
  1293. if (operands[2].operandtype = OPR_REGISTER) and
  1294. (operands[2].reg = R_DX) then
  1295. Begin
  1296. operands[2].opinfo := ao_inoutportreg;
  1297. if (operands[1].operandtype = OPR_REGISTER) and
  1298. (operands[1].reg in [R_EAX,R_AX,R_AL]) and
  1299. (instruc = A_OUT) then
  1300. Begin
  1301. operands[1].opinfo := ao_acc;
  1302. fits := TRUE;
  1303. end
  1304. end
  1305. else
  1306. if (operands[2].operandtype = OPR_CONSTANT) and
  1307. (operands[2].val <= $ff) and
  1308. (instruc = A_OUT) then
  1309. Begin
  1310. operands[2].opinfo := ao_imm8;
  1311. operands[2].size := S_B;
  1312. if (operands[1].operandtype = OPR_REGISTER) and
  1313. (operands[1].reg in [R_EAX,R_AX,R_AL]) and
  1314. (instruc = A_OUT) then
  1315. Begin
  1316. operands[1].opinfo := ao_acc;
  1317. fits := TRUE;
  1318. end
  1319. end;
  1320. end
  1321. else
  1322. Begin
  1323. Message(assem_e_invalid_opcode_and_operand);
  1324. exit;
  1325. end;
  1326. end;
  1327. A_RCL,A_RCR,A_ROL,A_ROR,A_SAL,A_SAR,A_SHL,A_SHR:
  1328. Begin
  1329. if numops =2 then
  1330. Begin
  1331. if (operands[1].operandtype = OPR_REGISTER) and
  1332. (operands[1].reg = R_CL) then
  1333. Begin
  1334. operands[1].opinfo := ao_shiftcount
  1335. end
  1336. else
  1337. if (operands[1].operandtype = OPR_CONSTANT) and
  1338. (operands[1].val <= $ff) then
  1339. Begin
  1340. operands[1].opinfo := ao_imm8;
  1341. operands[1].size := S_B;
  1342. end;
  1343. end
  1344. else { if numops = 2 }
  1345. Begin
  1346. Message(assem_e_invalid_opcode_and_operand);
  1347. exit;
  1348. end;
  1349. end;
  1350. { this did not work (PM) }
  1351. A_DIV, A_IDIV:
  1352. Begin
  1353. if (operands[2].operandtype = OPR_REGISTER) and
  1354. (operands[2].reg in [R_AL,R_AX,R_EAX]) then
  1355. operands[2].opinfo := ao_acc;
  1356. end;
  1357. A_FNSTSW, A_FSTSW:
  1358. Begin
  1359. { %ax can be omitted in ATT syntax }
  1360. if numops = 0 then
  1361. Begin
  1362. numops:=1;
  1363. operands[1].operandtype:=OPR_REGISTER;
  1364. operands[1].reg:=R_AX;
  1365. operands[1].opinfo := ao_acc;
  1366. end
  1367. else
  1368. if numops = 1 then
  1369. Begin
  1370. if (operands[1].operandtype = OPR_REGISTER) and
  1371. (operands[1].reg = R_AX) then
  1372. operands[1].opinfo := ao_acc;
  1373. end
  1374. else
  1375. Begin
  1376. Message(assem_e_invalid_opcode_and_operand);
  1377. exit;
  1378. end;
  1379. end;
  1380. A_SHLD,A_SHRD:
  1381. { these instruction are fully parsed individually on pass three }
  1382. { so we just do a summary checking here. }
  1383. Begin
  1384. if numops = 3 then
  1385. Begin
  1386. if (operands[1].operandtype = OPR_CONSTANT) and
  1387. (operands[1].val <= $ff) then
  1388. Begin
  1389. operands[1].opinfo := ao_imm8;
  1390. operands[1].size := S_B;
  1391. end;
  1392. end
  1393. else
  1394. Begin
  1395. Message(assem_e_invalid_opcode_and_operand);
  1396. exit;
  1397. end;
  1398. end;
  1399. A_INT:
  1400. Begin
  1401. if numops = 1 then
  1402. Begin
  1403. if (operands[1].operandtype = OPR_CONSTANT) and
  1404. (operands[1].val <= $ff) then
  1405. operands[1].opinfo := ao_imm8;
  1406. end
  1407. end;
  1408. A_RET:
  1409. Begin
  1410. if numops =1 then
  1411. Begin
  1412. if (operands[1].operandtype = OPR_CONSTANT) and
  1413. (operands[1].val <= $ffff) then
  1414. operands[1].opinfo := ao_imm16;
  1415. end
  1416. end;
  1417. { all string instructions have default memory }
  1418. { location which are ignored. Take care of }
  1419. { those. }
  1420. { Here could be added the code for segment }
  1421. { overrides. }
  1422. A_SCAS,A_CMPS,A_STOS,A_LODS:
  1423. Begin
  1424. if numops =1 then
  1425. Begin
  1426. if (operands[1].operandtype = OPR_REFERENCE) and
  1427. (assigned(operands[1].ref.symbol)) then
  1428. Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
  1429. operands[1].operandtype := OPR_NONE;
  1430. numops := 0;
  1431. end;
  1432. end;
  1433. A_XLAT:
  1434. Begin
  1435. { handle special TP syntax case for XLAT }
  1436. { here we accept XLAT, XLATB and XLAT m8 }
  1437. if (numops = 1) or (numops = 0) then
  1438. Begin
  1439. if (operands[1].operandtype = OPR_REFERENCE) and
  1440. (assigned(operands[1].ref.symbol)) then
  1441. Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
  1442. operands[1].operandtype := OPR_NONE;
  1443. numops := 0;
  1444. { always a byte for XLAT }
  1445. instr.stropsize := S_B;
  1446. end;
  1447. end;
  1448. { ------------------------------------------------------------------- }
  1449. { ------------------------- SIZE CHECK ------------------------------ }
  1450. { ------------- presently done only for most used opcodes ---------- }
  1451. { Checks if the suffix concords with the destination size , if }
  1452. { not gives out an error. (This check is stricter then gas but is }
  1453. { REQUIRED for intasmi3) }
  1454. A_MOV,A_ADD,A_SUB,A_ADC,A_SBB,A_CMP,A_AND,A_OR,A_TEST,A_XOR:
  1455. begin
  1456. if (instr.stropsize <> S_NO) and
  1457. (instr.operands[2].size <> S_NO) then
  1458. if (instr.stropsize <> instr.operands[2].size) then
  1459. begin
  1460. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1461. exit;
  1462. end;
  1463. end;
  1464. A_DEC,A_INC,A_NOT,A_NEG:
  1465. begin
  1466. if (instr.stropsize <> S_NO) and
  1467. (instr.operands[1].size <> S_NO) then
  1468. if (instr.stropsize <> instr.operands[1].size) then
  1469. begin
  1470. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1471. exit;
  1472. end;
  1473. end;
  1474. A_PUSH:
  1475. Begin
  1476. if (instr.operands[1].operandtype = OPR_CONSTANT) and
  1477. (instr.stropsize = S_NO) then
  1478. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1479. end;
  1480. End; { case }
  1481. {we have to start a new case because A_INS etc are already handled before
  1482. as well... (JM)}
  1483. Case instruc of
  1484. A_INS,A_MOVS,A_OUTS:
  1485. Begin
  1486. if numops =2 then
  1487. Begin
  1488. if (operands[2].operandtype = OPR_REFERENCE) and
  1489. (assigned(operands[2].ref.symbol)) then
  1490. Freemem(operands[2].ref.symbol,length(operands[2].ref.symbol^)+1);
  1491. if (operands[1].operandtype = OPR_REFERENCE) and
  1492. (assigned(operands[1].ref.symbol)) then
  1493. Freemem(operands[1].ref.symbol,length(operands[2].ref.symbol^)+1);
  1494. operands[2].operandtype := OPR_NONE;
  1495. operands[1].operandtype := OPR_NONE;
  1496. numops := 0;
  1497. end;
  1498. end;
  1499. { handle parameter for segment overrides }
  1500. end; { case }
  1501. { ------------------------------------------------------------------- }
  1502. { copy them to local variables }
  1503. { for faster access }
  1504. optyp1:=operands[1].opinfo;
  1505. optyp2:=operands[2].opinfo;
  1506. optyp3:=operands[3].opinfo;
  1507. end; { end with }
  1508. { after reading the operands }
  1509. { search the instruction }
  1510. { setup startvalue from cache }
  1511. if ins_cache[instruc]<>-1 then
  1512. i:=ins_cache[instruc]
  1513. else i:=0;
  1514. { I think this is too dangerous for me therefore i decided that for }
  1515. { the att version only if the processor > i386 or we are compiling }
  1516. { the system unit then this will be allowed... }
  1517. if (instruc > lastop_in_table) then
  1518. begin
  1519. Message1(assem_w_opcode_not_in_table,upper(att_op2str[instruc]));
  1520. fits:=true;
  1521. end
  1522. else while not(fits) do
  1523. begin
  1524. { set the instruction cache, if the instruction }
  1525. { occurs the first time }
  1526. if (it[i].i=instruc) and (ins_cache[instruc]=-1) then
  1527. ins_cache[instruc]:=i;
  1528. if (it[i].i=instruc) and (instr.numops=it[i].ops) then
  1529. begin
  1530. { first fit }
  1531. case instr.numops of
  1532. 0 : begin
  1533. fits:=true;
  1534. break;
  1535. end;
  1536. 1 :
  1537. Begin
  1538. if (optyp1 and it[i].o1)<>0 then
  1539. Begin
  1540. fits:=true;
  1541. break;
  1542. end;
  1543. { I consider sign-extended 8bit value to }
  1544. { be equal to immediate 8bit therefore }
  1545. { convert... }
  1546. if (optyp1 = ao_imm8) then
  1547. Begin
  1548. { check if this is a simple sign extend. }
  1549. if (it[i].o1<>ao_imm8s) then
  1550. Begin
  1551. fits:=true;
  1552. break;
  1553. end;
  1554. end;
  1555. end;
  1556. 2 : if ((optyp1 and it[i].o1)<>0) and
  1557. ((optyp2 and it[i].o2)<>0) then
  1558. Begin
  1559. fits:=true;
  1560. break;
  1561. end
  1562. { if the operands can be swaped }
  1563. { then swap them }
  1564. else if ((it[i].m and af_d)<>0) and
  1565. ((optyp1 and it[i].o2)<>0) and
  1566. ((optyp2 and it[i].o1)<>0) then
  1567. begin
  1568. fits:=true;
  1569. break;
  1570. end;
  1571. 3 : if ((optyp1 and it[i].o1)<>0) and
  1572. ((optyp2 and it[i].o2)<>0) and
  1573. ((optyp3 and it[i].o3)<>0) then
  1574. Begin
  1575. fits:=true;
  1576. break;
  1577. end;
  1578. end; { end case }
  1579. end; { endif }
  1580. if it[i].i=A_NONE then
  1581. begin
  1582. { NO MATCH! }
  1583. Message(assem_e_invalid_opcode_and_operand);
  1584. exit;
  1585. end;
  1586. inc(i);
  1587. end; { end while }
  1588. { We add the opcode to the opcode linked list }
  1589. if fits then
  1590. Begin
  1591. if instr.getprefix <> A_NONE then
  1592. Begin
  1593. p^.concat(new(pai386,op_none(instr.getprefix,S_NO)));
  1594. end;
  1595. { change from AT&T styled floating point to }
  1596. { intel styled floating point with valid size }
  1597. { we use these instructions so it does not }
  1598. { mess up intasmi3 }
  1599. if (instruc >= A_FILDQ) and (instruc <= A_FIDIVRS) then
  1600. Begin
  1601. instr.stropsize := _fpusizes[instruc];
  1602. instr.addinstr(_fpuopcodes[instruc]);
  1603. instruc := instr.getinstruction;
  1604. end;
  1605. case instr.numops of
  1606. 0:
  1607. if instr.stropsize <> S_NO then
  1608. { is this a string operation opcode or xlat then check }
  1609. { the size of the operation. }
  1610. p^.concat(new(pai386,op_none(instruc,instr.stropsize)))
  1611. else
  1612. p^.concat(new(pai386,op_none(instruc,S_NO)));
  1613. 1: Begin
  1614. case instr.operands[1].operandtype of
  1615. { GAS requires that the size be set in the case of a push }
  1616. { constant value, }
  1617. OPR_CONSTANT:
  1618. Begin
  1619. if instruc = A_PUSH then
  1620. Begin
  1621. if instr.stropsize <> S_NO then
  1622. p^.concat(new(pai386,op_const(instruc,
  1623. instr.stropsize, instr.operands[1].val)))
  1624. else
  1625. Message(assem_e_invalid_opcode_and_operand);
  1626. end
  1627. else
  1628. p^.concat(new(pai386,op_const(instruc,
  1629. S_NO, instr.operands[1].val)));
  1630. end;
  1631. OPR_REGISTER:
  1632. Begin
  1633. if (instr.stropsize<>S_NO) then
  1634. opsize:=instr.stropsize
  1635. else
  1636. opsize:=instr.operands[1].size;
  1637. p^.concat(new(pai386,op_reg(instruc,opsize,instr.operands[1].reg)));
  1638. End;
  1639. OPR_SYMBOL:
  1640. Begin
  1641. p^.concat(new(pai386,op_csymbol(instruc,
  1642. instr.stropsize, newcsymbol(instr.operands[1].symbol^,0))));
  1643. End;
  1644. OPR_REFERENCE:
  1645. { now first check suffix ... }
  1646. if instr.stropsize <> S_NO then
  1647. Begin
  1648. p^.concat(new(pai386,op_ref(instruc,
  1649. instr.stropsize,newreference(instr.operands[1].ref))));
  1650. end
  1651. { no suffix... therefore resort using intel styled checking .. }
  1652. else if (instr.operands[1].size <> S_NO) and
  1653. Not ((instruc = A_CALL) or (instruc = A_JMP)) then
  1654. Begin
  1655. p^.concat(new(pai386,op_ref(instruc,
  1656. instr.operands[1].size,newreference(instr.operands[1].ref))));
  1657. end
  1658. else
  1659. Begin
  1660. { special jmp and call case with }
  1661. { symbolic references. }
  1662. Case instruc of
  1663. A_CALL,A_JMP,A_FNSTCW,A_FSTCW,A_FLDCW,A_FNSTSW,
  1664. A_FSTSW,A_FLDENV,A_FSTENV,A_FNSAVE,A_FSAVE:
  1665. Begin
  1666. p^.concat(new(pai386,op_ref(instruc,
  1667. S_NO,newreference(instr.operands[1].ref))));
  1668. end
  1669. else
  1670. Message(assem_e_invalid_opcode_and_operand);
  1671. End
  1672. end;
  1673. { This either crashed the compiler or the symbol would always be nil! }
  1674. { The problem is here is I didn't see any way of adding the labeled }
  1675. { symbol in the internal list, since i think from what i see in aasm }
  1676. { that these will automatically be declared as external ?? }
  1677. { note: has to be changed to a case if ever activated again to avoid }
  1678. { range problems (JM) }
  1679. { if (instruc in [A_JO,A_JNO,A_JB,A_JC,A_JNAE,
  1680. A_JNB,A_JNC,A_JAE,A_JE,A_JZ,A_JNE,A_JNZ,A_JBE,A_JNA,A_JNBE,
  1681. A_JA,A_JS,A_JNS,A_JP,A_JPE,A_JNP,A_JPO,A_JL,A_JNGE,A_JNL,A_JGE,
  1682. A_JLE,A_JNG,A_JNLE,A_JG,A_JCXZ,A_JECXZ,A_LOOP,A_LOOPZ,A_LOOPE,
  1683. A_LOOPNZ,A_LOOPNE,A_JMP,A_CALL]) then
  1684. Begin
  1685. if assigned(instr.operands[1].ref.symbol) then
  1686. p^.concat(new(pai386,op_csymbol(instruc,
  1687. S_NO,newcsymbol(instr.operands[1].ref.symbol^,instr.operands[1].ref.offset))))
  1688. else
  1689. Message(assem_e_invalid_opcode_and_operand);
  1690. end
  1691. else
  1692. else
  1693. Message(assem_e_invalid_opcode_and_operand);
  1694. end;}
  1695. OPR_NONE: Begin
  1696. Message(assem_f_internal_error_in_concatopcode);
  1697. end;
  1698. else
  1699. Begin
  1700. Message(assem_f_internal_error_in_concatopcode);
  1701. end;
  1702. end;
  1703. end;
  1704. 2:
  1705. Begin
  1706. Case instruc Of
  1707. A_MOVSX,A_MOVZX,A_MOVSB,A_MOVSBL,A_MOVSBW,A_MOVSWL,
  1708. A_MOVZB,A_MOVZWL:
  1709. { movzx and movsx }
  1710. HandleExtend(instr);
  1711. else
  1712. { other instructions }
  1713. Begin
  1714. With instr do
  1715. Begin
  1716. { source }
  1717. opsize := operands[1].size;
  1718. case operands[1].operandtype of
  1719. { reg,reg }
  1720. { reg,ref }
  1721. { const,reg -- IN/OUT }
  1722. OPR_REGISTER:
  1723. Begin
  1724. case operands[2].operandtype of
  1725. OPR_REGISTER:
  1726. { correction: according to the DJGPP FAQ, gas }
  1727. { doesn't even check correctly the size of }
  1728. { operands, therefore let us specify a size! }
  1729. { as in the GAS docs... destination tells us }
  1730. { the size! This might give out invalid output }
  1731. { in some very rare cases (because the size }
  1732. { checking is still not perfect). }
  1733. if (opsize = operands[2].size) then
  1734. begin
  1735. p^.concat(new(pai386,op_reg_reg(instruc,
  1736. opsize,operands[1].reg,operands[2].reg)));
  1737. end
  1738. else
  1739. Case instruc of
  1740. A_IN:
  1741. p^.concat(new(pai386,op_reg_reg(instruc,
  1742. operands[2].size,operands[1].reg,operands[2].reg)));
  1743. A_OUT:
  1744. p^.concat(new(pai386,op_reg_reg(instruc,
  1745. operands[1].size,operands[1].reg,operands[2].reg)));
  1746. { these do not require any size specification. }
  1747. A_SAL,A_SAR,A_SHL,A_SHR,A_ROL,A_ROR,A_RCR,
  1748. A_RCL:
  1749. { outs and ins are already taken care by }
  1750. { the first pass. }
  1751. p^.concat(new(pai386,op_reg_reg(instruc,
  1752. S_NO,operands[1].reg,operands[2].reg)))
  1753. else
  1754. if stropsize <> S_NO then
  1755. Begin
  1756. p^.concat(new(pai386,op_reg_reg(instruc,
  1757. stropsize,operands[1].reg,operands[2].reg)))
  1758. end
  1759. else
  1760. Begin
  1761. Message(assem_e_invalid_opcode_and_operand);
  1762. end;
  1763. end; {case instruc of}
  1764. OPR_REFERENCE:
  1765. { variable name. }
  1766. { here we must check the instruction type }
  1767. { before deciding if to use and compare }
  1768. { any sizes. }
  1769. if assigned(operands[2].ref.symbol) then
  1770. Begin
  1771. if stropsize <> S_NO then
  1772. Begin
  1773. p^.concat(new(pai386,op_reg_ref(instruc,
  1774. stropsize,operands[1].reg,newreference(operands[2].ref))))
  1775. end
  1776. else
  1777. if (opsize = operands[2].size) Then
  1778. p^.concat(new(pai386,op_reg_ref(instruc,
  1779. opsize,operands[1].reg,newreference(operands[2].ref))))
  1780. else
  1781. Case instruc of
  1782. A_RCL,A_RCR,A_ROL,A_ROR,A_SAL,A_SAR,
  1783. A_SHR,A_SHL:
  1784. p^.concat(new(pai386,op_reg_ref(instruc,
  1785. opsize,operands[1].reg,newreference(operands[2].ref))))
  1786. else
  1787. Message(assem_e_invalid_size_in_ref);
  1788. end
  1789. end
  1790. else
  1791. Begin
  1792. { register reference }
  1793. if stropsize <> S_NO then
  1794. Begin
  1795. p^.concat(new(pai386,op_reg_ref(instruc,
  1796. stropsize,operands[1].reg,newreference(operands[2].ref))))
  1797. end
  1798. else
  1799. if (opsize = operands[2].size) or
  1800. (operands[2].size = S_NO) then
  1801. p^.concat(new(pai386,op_reg_ref(instruc,
  1802. opsize,operands[1].reg,newreference(operands[2].ref))))
  1803. else
  1804. Message(assem_e_invalid_size_in_ref);
  1805. end;
  1806. OPR_CONSTANT: { OUT }
  1807. begin
  1808. { determine first with suffix }
  1809. if instruc = A_OUT then
  1810. begin
  1811. if instr.stropsize <> S_NO then
  1812. p^.concat(new(pai386,op_reg_const(instruc,stropsize,
  1813. instr.operands[1].reg, instr.operands[2].val)))
  1814. else
  1815. p^.concat(new(pai386,op_reg_const(instruc,S_NO,
  1816. instr.operands[1].reg, instr.operands[2].val)));
  1817. end
  1818. else
  1819. Message(assem_e_invalid_opcode);
  1820. end;
  1821. else { else case }
  1822. Begin
  1823. Message(assem_f_internal_error_in_concatopcode);
  1824. end;
  1825. end; { end inner case }
  1826. end;
  1827. { const,reg }
  1828. { const,const }
  1829. { const,ref }
  1830. OPR_CONSTANT:
  1831. case instr.operands[2].operandtype of
  1832. { constant, constant does not have a specific size. }
  1833. OPR_CONSTANT:
  1834. p^.concat(new(pai386,op_const_const(instruc,
  1835. S_NO,operands[1].val,operands[2].val)));
  1836. OPR_REFERENCE:
  1837. Begin
  1838. { check for suffix first ... }
  1839. if (instr.stropsize <> S_NO) then
  1840. Begin
  1841. p^.concat(new(pai386,op_const_ref(instruc,
  1842. stropsize,operands[1].val,
  1843. newreference(operands[2].ref))))
  1844. end
  1845. else
  1846. { resort to intel styled checking ... }
  1847. if (operands[1].val <= $ff) and
  1848. (operands[2].size in [S_B,S_W,S_L]) then
  1849. p^.concat(new(pai386,op_const_ref(instruc,
  1850. operands[2].size,operands[1].val,
  1851. newreference(operands[2].ref))))
  1852. else
  1853. if (operands[1].val <= $ffff) and
  1854. (operands[2].size in [S_W,S_L]) then
  1855. p^.concat(new(pai386,op_const_ref(instruc,
  1856. operands[2].size,operands[1].val,
  1857. newreference(operands[2].ref))))
  1858. else
  1859. if (operands[1].val <= $7fffffff) and
  1860. (operands[2].size in [S_L]) then
  1861. p^.concat(new(pai386,op_const_ref(instruc,
  1862. operands[2].size,operands[1].val,
  1863. newreference(operands[2].ref))))
  1864. else
  1865. Message(assem_e_invalid_size_in_ref);
  1866. end;
  1867. OPR_REGISTER:
  1868. Begin
  1869. { size of opcode determined by register }
  1870. if (operands[1].val <= $ff) and
  1871. (operands[2].size in [S_B,S_W,S_L]) then
  1872. p^.concat(new(pai386,op_const_reg(instruc,
  1873. operands[2].size,operands[1].val,
  1874. operands[2].reg)))
  1875. else
  1876. if (operands[1].val <= $ffff) and
  1877. (operands[2].size in [S_W,S_L]) then
  1878. p^.concat(new(pai386,op_const_reg(instruc,
  1879. operands[2].size,operands[1].val,
  1880. operands[2].reg)))
  1881. else
  1882. if (operands[1].val <= $7fffffff) and
  1883. (operands[2].size in [S_L]) then
  1884. p^.concat(new(pai386,op_const_reg(instruc,
  1885. operands[2].size,operands[1].val,
  1886. operands[2].reg)))
  1887. else
  1888. Message(assem_e_invalid_opcode_size);
  1889. end;
  1890. else
  1891. Begin
  1892. Message(assem_f_internal_error_in_concatopcode);
  1893. end;
  1894. end; { end case }
  1895. { sym,reg }
  1896. OPR_SYMBOL:
  1897. case instr.operands[2].operandtype of
  1898. OPR_REGISTER:
  1899. Begin
  1900. Case instruc of
  1901. A_LDS,A_LES,A_LFS,A_LGS,A_LSS:
  1902. opsize:=S_NO
  1903. else
  1904. if stropsize<>S_NO then
  1905. opsize:=stropsize
  1906. else
  1907. if (opsize<>operands[2].size) then
  1908. Message(assem_e_invalid_opcode_and_operand);
  1909. { create an temporary reference }
  1910. End; {case}
  1911. reset_reference(href);
  1912. href.symbol:=stringdup(instr.operands[1].symbol^);
  1913. p^.concat(new(pai386,op_ref_reg(instruc,opsize,
  1914. newreference(href),operands[2].reg)));
  1915. clear_reference(href);
  1916. end;
  1917. else
  1918. Begin
  1919. Message(assem_f_internal_error_in_concatopcode);
  1920. end;
  1921. end; { end inner case }
  1922. { ref,reg }
  1923. { ref,ref }
  1924. OPR_REFERENCE:
  1925. case instr.operands[2].operandtype of
  1926. OPR_REGISTER:
  1927. if assigned(operands[1].ref.symbol) then
  1928. { global variable }
  1929. Begin
  1930. Case instruc Of
  1931. A_LDS,A_LES,A_LFS,A_LGS,A_LSS:
  1932. opsize:=S_NO
  1933. else
  1934. if stropsize<>S_NO then
  1935. opsize:=stropsize
  1936. else
  1937. if (opsize<>operands[2].size) then
  1938. Message(assem_e_invalid_opcode_and_operand);
  1939. end; { case }
  1940. p^.concat(new(pai386,op_ref_reg(instruc,
  1941. opsize,newreference(operands[1].ref),operands[2].reg)));
  1942. end
  1943. else
  1944. Begin
  1945. { register reference }
  1946. { possiblities:1) local variable which }
  1947. { has been replaced by bp and offset }
  1948. { in this case size should be valid }
  1949. { 2) Indirect register }
  1950. { adressing, 2nd operand determines }
  1951. { size. }
  1952. if (stropsize <> S_NO) then
  1953. Begin
  1954. p^.concat(new(pai386,op_ref_reg(instruc,
  1955. stropsize,newreference(operands[1].ref),
  1956. operands[2].reg)))
  1957. end
  1958. else
  1959. if (opsize = operands[2].size) or
  1960. (opsize = S_NO) then
  1961. Begin
  1962. p^.concat(new(pai386,op_ref_reg(instruc,
  1963. operands[2].size,newreference(operands[1].ref),
  1964. operands[2].reg)));
  1965. end
  1966. else
  1967. Message(assem_e_invalid_size_in_ref);
  1968. end;
  1969. OPR_REFERENCE: { special opcodes }
  1970. p^.concat(new(pai386,op_ref_ref(instruc,
  1971. opsize,newreference(operands[1].ref),
  1972. newreference(operands[2].ref))));
  1973. else
  1974. Begin
  1975. Message(assem_f_internal_error_in_concatopcode);
  1976. end;
  1977. end; { end inner case }
  1978. end; { end case }
  1979. end; { end with }
  1980. end; {end else of case instruc of movsx ... }
  1981. end; { end case movsx ...}
  1982. end;
  1983. 3: Begin
  1984. { only imul, shld and shrd }
  1985. { middle must be a register }
  1986. if (instruc = A_SHLD) Or (instruc = A_SHRD) and
  1987. (instr.operands[2].operandtype = OPR_REGISTER) then
  1988. Begin
  1989. case instr.operands[2].size of
  1990. S_W: if instr.operands[1].operandtype = OPR_CONSTANT then
  1991. Begin
  1992. if instr.operands[1].val <= $ff then
  1993. Begin
  1994. if instr.operands[3].size in [S_W] then
  1995. Begin
  1996. case instr.operands[3].operandtype of
  1997. OPR_REFERENCE: { MISSING !!!! } ;
  1998. OPR_REGISTER: p^.concat(new(pai386,
  1999. op_const_reg_reg(instruc, S_W,
  2000. instr.operands[1].val, instr.operands[2].reg,
  2001. instr.operands[3].reg)));
  2002. else
  2003. Message(assem_e_invalid_opcode_and_operand);
  2004. end;
  2005. end
  2006. else
  2007. Message(assem_e_invalid_opcode_and_operand);
  2008. end;
  2009. end
  2010. else
  2011. Message(assem_e_invalid_opcode_and_operand);
  2012. S_L: if instr.operands[1].operandtype = OPR_CONSTANT then
  2013. Begin
  2014. if instr.operands[1].val <= $ff then
  2015. Begin
  2016. if instr.operands[3].size in [S_L] then
  2017. Begin
  2018. case instr.operands[3].operandtype of
  2019. OPR_REFERENCE: { MISSING !!!! } ;
  2020. OPR_REGISTER: p^.concat(new(pai386,
  2021. op_const_reg_reg(instruc, S_L,
  2022. instr.operands[1].val, instr.operands[2].reg,
  2023. instr.operands[3].reg)));
  2024. else
  2025. Message(assem_e_invalid_opcode_and_operand);
  2026. end;
  2027. end
  2028. else
  2029. Message(assem_e_invalid_opcode_and_operand);
  2030. end;
  2031. end
  2032. else
  2033. Message(assem_e_invalid_opcode_and_operand);
  2034. else
  2035. Message(assem_e_invalid_opcode_and_operand);
  2036. end; { end case }
  2037. end
  2038. else
  2039. if (instruc = A_IMUL) and (instr.operands[3].operandtype
  2040. = OPR_REGISTER) then
  2041. Begin
  2042. case instr.operands[3].size of
  2043. S_W: if instr.operands[1].operandtype = OPR_CONSTANT then
  2044. Begin
  2045. if instr.operands[1].val <= $ffff then
  2046. Begin
  2047. if instr.operands[2].size in [S_W] then
  2048. Begin
  2049. case instr.operands[2].operandtype of
  2050. OPR_REFERENCE: { MISSING !!!! } ;
  2051. OPR_REGISTER: p^.concat(new(pai386,
  2052. op_const_reg_reg(instruc, S_W,
  2053. instr.operands[1].val, instr.operands[2].reg,
  2054. instr.operands[3].reg)));
  2055. else
  2056. Message(assem_e_invalid_opcode_and_operand);
  2057. end; { end case }
  2058. end
  2059. else
  2060. Message(assem_e_invalid_opcode_and_operand);
  2061. end;
  2062. end
  2063. else
  2064. Message(assem_e_invalid_opcode_and_operand);
  2065. S_L: if instr.operands[1].operandtype = OPR_CONSTANT then
  2066. Begin
  2067. if instr.operands[1].val <= $7fffffff then
  2068. Begin
  2069. if instr.operands[2].size in [S_L] then
  2070. Begin
  2071. case instr.operands[2].operandtype of
  2072. OPR_REFERENCE: { MISSING !!!! } ;
  2073. OPR_REGISTER: p^.concat(new(pai386,
  2074. op_const_reg_reg(instruc, S_L,
  2075. instr.operands[1].val, instr.operands[2].reg,
  2076. instr.operands[3].reg)));
  2077. else
  2078. Message(assem_e_invalid_opcode_and_operand);
  2079. end; { end case }
  2080. end
  2081. else
  2082. Message(assem_e_invalid_opcode_and_operand);
  2083. end;
  2084. end
  2085. else
  2086. Message(assem_e_invalid_opcode_and_operand);
  2087. else
  2088. Message(assem_e_invalid_middle_sized_operand);
  2089. end; { end case }
  2090. end { endif }
  2091. else
  2092. Message(assem_e_invalid_three_operand_opcode);
  2093. end;
  2094. end; { end case }
  2095. end;
  2096. end;
  2097. Procedure ConcatLabeledInstr(var instr: TInstruction);
  2098. Var instruct : tasmop;
  2099. i : longint;
  2100. Begin
  2101. instruct:=instr.getinstruction;
  2102. Case instruct Of
  2103. A_JO,A_JNO,A_JB,A_JC,A_JNAE,
  2104. A_JNB,A_JNC,A_JAE,A_JE,A_JZ,A_JNE,A_JNZ,A_JBE,A_JNA,A_JNBE,
  2105. A_JA,A_JS,A_JNS,A_JP,A_JPE,A_JNP,A_JPO,A_JL,A_JNGE,A_JNL,A_JGE,
  2106. A_JLE,A_JNG,A_JNLE,A_JG,A_JCXZ,A_JECXZ,A_LOOP,A_LOOPZ,A_LOOPE,
  2107. A_LOOPNZ,A_LOOPNE,A_JMP,A_CALL:
  2108. Begin
  2109. if (instr.numops <> 1) then
  2110. Message(assem_e_invalid_labeled_opcode)
  2111. else if instr.operands[1].operandtype <> OPR_LABINSTR then
  2112. Message(assem_e_invalid_labeled_opcode)
  2113. else if assigned(instr.operands[1].hl) then
  2114. ConcatLabel(p,instruct, instr.operands[1].hl)
  2115. else
  2116. Begin
  2117. Message(assem_f_internal_error_in_concatlabeledinstr);
  2118. end;
  2119. end;
  2120. A_MOV: { move from/to rel8 };
  2121. else
  2122. if (cs_compilesystem in aktmoduleswitches) then
  2123. begin
  2124. for i:=1 to instr.numops do
  2125. if instr.operands[i].operandtype=OPR_LABINSTR then
  2126. begin
  2127. instr.operands[i].operandtype:=OPR_REFERENCE;
  2128. instr.operands[i].ref.symbol:=newpasstr(lab2str(instr.operands[i].hl) );
  2129. instr.operands[i].opinfo:=ao_mem;
  2130. instr.operands[i].ref.base:=R_NO;
  2131. instr.operands[i].ref.index:=R_NO;
  2132. instr.operands[i].ref.segment:=R_DEFAULT_SEG;
  2133. instr.operands[i].ref.offset:=0;
  2134. end;
  2135. { handle now as an ordinary opcode }
  2136. concatopcode(instr);
  2137. end
  2138. else
  2139. Message1(assem_e_invalid_operand,'');
  2140. end; { case }
  2141. end;
  2142. {---------------------------------------------------------------------}
  2143. { Routines for the parsing }
  2144. {---------------------------------------------------------------------}
  2145. procedure consume(t : tinteltoken);
  2146. begin
  2147. if t<>actasmtoken then
  2148. Message(assem_e_syntax_error);
  2149. actasmtoken:=gettoken;
  2150. { if the token must be ignored, then }
  2151. { get another token to parse. }
  2152. if actasmtoken = AS_NONE then
  2153. actasmtoken := gettoken;
  2154. end;
  2155. function findregister(const s : string): tregister;
  2156. {*********************************************************************}
  2157. { FUNCTION findregister(s: string):tasmop; }
  2158. { Description: Determines if the s string is a valid register, }
  2159. { if so returns correct tregister token, or R_NO if not found. }
  2160. {*********************************************************************}
  2161. var
  2162. i: tregister;
  2163. begin
  2164. findregister := R_NO;
  2165. for i:=firstreg to lastreg do
  2166. if s = iasmregs[i] then
  2167. Begin
  2168. findregister := i;
  2169. exit;
  2170. end;
  2171. end;
  2172. function findprefix(const s: string; var token: tasmop): boolean;
  2173. var i: byte;
  2174. Begin
  2175. findprefix := FALSE;
  2176. for i:=0 to _count_asmprefixes do
  2177. Begin
  2178. if s = _asmprefixes[i] then
  2179. begin
  2180. token := _prefixtokens[i];
  2181. findprefix := TRUE;
  2182. exit;
  2183. end;
  2184. end;
  2185. end;
  2186. function findsegment(const s:string): tregister;
  2187. {*********************************************************************}
  2188. { FUNCTION findsegment(s: string):tasmop; }
  2189. { Description: Determines if the s string is a valid segment register}
  2190. { if so returns correct tregister token, or R_NO if not found. }
  2191. {*********************************************************************}
  2192. var
  2193. i: tregister;
  2194. Begin
  2195. findsegment := R_DEFAULT_SEG;
  2196. for i:=firstsreg to lastsreg do
  2197. if s = iasmregs[i] then
  2198. Begin
  2199. findsegment := i;
  2200. exit;
  2201. end;
  2202. end;
  2203. function findopcode(const s: string): tasmop;
  2204. {*********************************************************************}
  2205. { FUNCTION findopcode(s: string): tasmop; }
  2206. { Description: Determines if the s string is a valid opcode }
  2207. { if so returns correct tasmop token. }
  2208. {*********************************************************************}
  2209. var
  2210. i: tasmop;
  2211. j: byte;
  2212. hs: topsize;
  2213. hid: string;
  2214. Begin
  2215. findopcode := A_NONE;
  2216. { first search for extended opcodes }
  2217. { now, in this case, we must use the suffix }
  2218. { to determine the size of the instruction }
  2219. for j:=0 to _count_asmspecialops do
  2220. Begin
  2221. if s = _specialops[j] then
  2222. Begin
  2223. findopcode := _specialopstokens[j];
  2224. { set the size }
  2225. case s[length(s)] of
  2226. 'B': instr.stropsize := S_B;
  2227. 'L': instr.stropsize := S_L;
  2228. 'W': instr.stropsize := S_W;
  2229. end;
  2230. exit;
  2231. end;
  2232. end;
  2233. for i:=firstop to lastop do
  2234. Begin
  2235. if s=iasmops^[i] then
  2236. begin
  2237. findopcode := i;
  2238. instr.stropsize := S_NO;
  2239. exit;
  2240. end;
  2241. end;
  2242. { not found yet ... }
  2243. { search for all possible suffixes }
  2244. for hs:=S_WL downto S_B do
  2245. if copy(s,length(s)-length(att_opsize2str[hs])+1,
  2246. length(att_opsize2str[hs]))=upper(att_opsize2str[hs]) then
  2247. begin
  2248. hid:=copy(s,1,length(s)-length(att_opsize2str[hs]));
  2249. for i:=firstop to lastop do
  2250. if (length(hid) > 0) and (hid=iasmops^[i]) then
  2251. begin
  2252. findopcode := i;
  2253. instr.stropsize := hs;
  2254. exit;
  2255. end;
  2256. end;
  2257. end;
  2258. Function CheckPrefix(prefix: tasmop; opcode:tasmop): Boolean;
  2259. { Checks if the prefix is valid with the following instruction }
  2260. { return false if not, otherwise true }
  2261. Begin
  2262. CheckPrefix := TRUE;
  2263. Case prefix of
  2264. A_REP,A_REPNE,A_REPE:
  2265. Case opcode Of
  2266. A_SCAS,A_INS,A_OUTS,A_MOVS,
  2267. A_CMPS,A_LODS,A_STOS:;
  2268. Else
  2269. Begin
  2270. CheckPrefix := FALSE;
  2271. exit;
  2272. end;
  2273. End;
  2274. A_LOCK:
  2275. Case opcode Of
  2276. A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,
  2277. A_ADC,A_SBB,A_AND,A_SUB,A_XOR,A_NOT,A_NEG,A_INC,A_DEC:;
  2278. Else
  2279. Begin
  2280. CheckPrefix := FALSE;
  2281. Exit;
  2282. end;
  2283. End;
  2284. A_NONE: exit; { no prefix here }
  2285. else
  2286. CheckPrefix := FALSE;
  2287. end; { end case }
  2288. end;
  2289. Procedure InitAsmRef(var instr: TInstruction);
  2290. {*********************************************************************}
  2291. { Description: This routine first check if the instruction is of }
  2292. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  2293. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  2294. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  2295. { to point to the default segment. }
  2296. {*********************************************************************}
  2297. Begin
  2298. With instr do
  2299. Begin
  2300. case operands[operandnum].operandtype of
  2301. OPR_REFERENCE: exit;
  2302. OPR_NONE: ;
  2303. else
  2304. Message(assem_e_invalid_operand_type);
  2305. end;
  2306. operands[operandnum].operandtype := OPR_REFERENCE;
  2307. operands[operandnum].ref.segment := R_DEFAULT_SEG;
  2308. end;
  2309. end;
  2310. Function CheckOverride(segreg: tregister; var instr: TInstruction): Boolean;
  2311. { Check if the override is valid, and if so then }
  2312. { update the instr variable accordingly. }
  2313. Begin
  2314. CheckOverride := FALSE;
  2315. Case instr.getinstruction of
  2316. A_MOVS,A_XLAT,A_CMPS:
  2317. Begin
  2318. CheckOverride := TRUE;
  2319. Message(assem_e_segment_override_not_supported);
  2320. end
  2321. end
  2322. end;
  2323. Function CalculateExpression(expression: string): longint;
  2324. var
  2325. expr: TExprParse;
  2326. Begin
  2327. expr.Init;
  2328. CalculateExpression := expr.Evaluate(expression);
  2329. expr.Done;
  2330. end;
  2331. Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
  2332. {*********************************************************************}
  2333. { PROCEDURE GetRecordOffsetSize }
  2334. { Description: This routine builds up a record offset after a AS_DOT }
  2335. { token is encountered. }
  2336. { On entry actasmtoken should be equal to AS_DOT }
  2337. {*********************************************************************}
  2338. { EXIT CONDITION: On exit the routine should point to either the }
  2339. { AS_COMMA or AS_SEPARATOR token. }
  2340. { Warning: This is called recursively. }
  2341. {*********************************************************************}
  2342. var
  2343. toffset,tsize : longint;
  2344. Begin
  2345. offset:=0;
  2346. size:=0;
  2347. Consume(AS_DOT);
  2348. if actasmtoken = AS_ID then
  2349. Begin
  2350. if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
  2351. not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
  2352. begin
  2353. Message(assem_e_syntax_error);
  2354. toffset:=0;
  2355. tsize:=0;
  2356. end;
  2357. inc(offset,toffset);
  2358. size:=tsize;
  2359. Consume(AS_ID);
  2360. case actasmtoken of
  2361. AS_SEPARATOR,
  2362. AS_COMMA : exit;
  2363. AS_DOT : begin
  2364. GetRecordOffsetSize(expr,toffset,tsize);
  2365. inc(offset,toffset);
  2366. size:=tsize;
  2367. end;
  2368. else
  2369. Begin
  2370. Message(assem_e_syntax_error);
  2371. repeat
  2372. consume(actasmtoken)
  2373. until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
  2374. exit;
  2375. end;
  2376. end;
  2377. end
  2378. else
  2379. Begin
  2380. Message(assem_e_syntax_error);
  2381. repeat
  2382. consume(actasmtoken)
  2383. until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
  2384. end;
  2385. end;
  2386. Function BuildExpression: longint;
  2387. {*********************************************************************}
  2388. { FUNCTION BuildExpression: longint }
  2389. { Description: This routine calculates a constant expression to }
  2390. { a given value. The return value is the value calculated from }
  2391. { the expression. }
  2392. { The following tokens (not strings) are recognized: }
  2393. { (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  2394. {*********************************************************************}
  2395. { ENTRY: On entry the token should be any valid expression token. }
  2396. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  2397. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2398. { invalid tokens. }
  2399. {*********************************************************************}
  2400. var expr: string;
  2401. tempstr: string;
  2402. l,k : longint;
  2403. errorflag: boolean;
  2404. Begin
  2405. errorflag := FALSE;
  2406. expr := '';
  2407. tempstr := '';
  2408. Repeat
  2409. Case actasmtoken of
  2410. AS_LPAREN: Begin
  2411. Consume(AS_LPAREN);
  2412. expr := expr + '(';
  2413. end;
  2414. AS_RPAREN: Begin
  2415. Consume(AS_RPAREN);
  2416. expr := expr + ')';
  2417. end;
  2418. AS_SHL: Begin
  2419. Consume(AS_SHL);
  2420. expr := expr + '<';
  2421. end;
  2422. AS_SHR: Begin
  2423. Consume(AS_SHR);
  2424. expr := expr + '>';
  2425. end;
  2426. AS_SLASH: Begin
  2427. Consume(AS_SLASH);
  2428. expr := expr + '/';
  2429. end;
  2430. AS_MOD: Begin
  2431. Consume(AS_MOD);
  2432. expr := expr + '%';
  2433. end;
  2434. AS_STAR: Begin
  2435. Consume(AS_STAR);
  2436. expr := expr + '*';
  2437. end;
  2438. AS_PLUS: Begin
  2439. Consume(AS_PLUS);
  2440. expr := expr + '+';
  2441. end;
  2442. AS_MINUS: Begin
  2443. Consume(AS_MINUS);
  2444. expr := expr + '-';
  2445. end;
  2446. AS_AND: Begin
  2447. Consume(AS_AND);
  2448. expr := expr + '&';
  2449. end;
  2450. AS_NOT: Begin
  2451. Consume(AS_NOT);
  2452. expr := expr + '~';
  2453. end;
  2454. AS_XOR: Begin
  2455. Consume(AS_XOR);
  2456. expr := expr + '^';
  2457. end;
  2458. AS_OR: Begin
  2459. Consume(AS_OR);
  2460. expr := expr + '|';
  2461. end;
  2462. AS_ID: Begin
  2463. tempstr:=actasmpattern;
  2464. previous_was_id:=TRUE;
  2465. consume(AS_ID);
  2466. if actasmtoken=AS_DOT then
  2467. begin
  2468. GetRecordOffsetSize(tempstr,l,k);
  2469. str(l, tempstr);
  2470. expr := expr + tempstr;
  2471. end
  2472. else
  2473. begin
  2474. if SearchIConstant(tempstr,l) then
  2475. begin
  2476. str(l, tempstr);
  2477. expr := expr + tempstr;
  2478. end
  2479. else
  2480. Message1(assem_e_invalid_const_symbol,actasmpattern);
  2481. end;
  2482. end;
  2483. AS_INTNUM: Begin
  2484. expr := expr + actasmpattern;
  2485. Consume(AS_INTNUM);
  2486. end;
  2487. AS_BINNUM: Begin
  2488. tempstr := BinaryToDec(actasmpattern);
  2489. if tempstr = '' then
  2490. Message(assem_f_error_converting_bin);
  2491. expr:=expr+tempstr;
  2492. Consume(AS_BINNUM);
  2493. end;
  2494. AS_HEXNUM: Begin
  2495. tempstr := HexToDec(actasmpattern);
  2496. if tempstr = '' then
  2497. Message(assem_f_error_converting_hex);
  2498. expr:=expr+tempstr;
  2499. Consume(AS_HEXNUM);
  2500. end;
  2501. AS_OCTALNUM: Begin
  2502. tempstr := OctalToDec(actasmpattern);
  2503. if tempstr = '' then
  2504. Message(assem_f_error_converting_octal);
  2505. expr:=expr+tempstr;
  2506. Consume(AS_OCTALNUM);
  2507. end;
  2508. { go to next term }
  2509. AS_COMMA: Begin
  2510. if not ErrorFlag then
  2511. BuildExpression := CalculateExpression(expr)
  2512. else
  2513. BuildExpression := 0;
  2514. Exit;
  2515. end;
  2516. { go to next symbol }
  2517. AS_SEPARATOR: Begin
  2518. if not ErrorFlag then
  2519. BuildExpression := CalculateExpression(expr)
  2520. else
  2521. BuildExpression := 0;
  2522. Exit;
  2523. end;
  2524. else
  2525. Begin
  2526. { only write error once. }
  2527. if not errorflag then
  2528. Message(assem_e_invalid_constant_expression);
  2529. { consume tokens until we find COMMA or SEPARATOR }
  2530. Consume(actasmtoken);
  2531. errorflag := TRUE;
  2532. End;
  2533. end;
  2534. Until false;
  2535. end;
  2536. Procedure BuildRealConstant(typ : tfloattype);
  2537. {*********************************************************************}
  2538. { PROCEDURE BuilRealConst }
  2539. { Description: This routine calculates a constant expression to }
  2540. { a given value. The return value is the value calculated from }
  2541. { the expression. }
  2542. { The following tokens (not strings) are recognized: }
  2543. { +/-,numbers and real numbers }
  2544. {*********************************************************************}
  2545. { ENTRY: On entry the token should be any valid expression token. }
  2546. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  2547. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2548. { invalid tokens. }
  2549. {*********************************************************************}
  2550. var expr: string;
  2551. tempstr: string;
  2552. r : bestreal;
  2553. code : word;
  2554. negativ : boolean;
  2555. errorflag: boolean;
  2556. Begin
  2557. errorflag := FALSE;
  2558. Repeat
  2559. negativ:=false;
  2560. expr := '';
  2561. tempstr := '';
  2562. if actasmtoken=AS_PLUS then Consume(AS_PLUS)
  2563. else if actasmtoken=AS_MINUS then
  2564. begin
  2565. negativ:=true;
  2566. consume(AS_MINUS);
  2567. end;
  2568. Case actasmtoken of
  2569. AS_INTNUM: Begin
  2570. expr := actasmpattern;
  2571. Consume(AS_INTNUM);
  2572. end;
  2573. AS_REALNUM: Begin
  2574. expr := actasmpattern;
  2575. { in ATT syntax you have 0d in front of the real }
  2576. { should this be forced ? yes i think so, as to }
  2577. { conform to gas as much as possible. }
  2578. if (expr[1]='0') and (upper(expr[2])='D') then
  2579. expr:=copy(expr,3,255);
  2580. Consume(AS_REALNUM);
  2581. end;
  2582. AS_BINNUM: Begin
  2583. { checking for real constants with this should use }
  2584. { real DECODING otherwise the compiler will crash! }
  2585. Message(assem_w_float_bin_ignored);
  2586. Consume(AS_BINNUM);
  2587. end;
  2588. AS_HEXNUM: Begin
  2589. { checking for real constants with this should use }
  2590. { real DECODING otherwise the compiler will crash! }
  2591. Message(assem_w_float_hex_ignored);
  2592. Consume(AS_HEXNUM);
  2593. end;
  2594. AS_OCTALNUM: Begin
  2595. { checking for real constants with this should use }
  2596. { real DECODING otherwise the compiler will crash! }
  2597. { xxxToDec using reals could be a solution, but the }
  2598. { problem is that these will crash the m68k compiler }
  2599. { when compiling -- because of lack of good fpu }
  2600. { support. }
  2601. Message(assem_w_float_octal_ignored);
  2602. Consume(AS_OCTALNUM);
  2603. end;
  2604. else
  2605. Begin
  2606. { only write error once. }
  2607. if not errorflag then
  2608. Message(assem_e_invalid_real_const);
  2609. { consume tokens until we find COMMA or SEPARATOR }
  2610. Consume(actasmtoken);
  2611. errorflag := TRUE;
  2612. End;
  2613. end;
  2614. { go to next term }
  2615. if (actasmtoken=AS_COMMA) or (actasmtoken=AS_SEPARATOR) then
  2616. Begin
  2617. if negativ then expr:='-'+expr;
  2618. val(expr,r,code);
  2619. if code<>0 then
  2620. Begin
  2621. r:=0;
  2622. Message(assem_e_invalid_real_const);
  2623. ConcatRealConstant(p,r,typ);
  2624. End
  2625. else
  2626. Begin
  2627. ConcatRealConstant(p,r,typ);
  2628. End;
  2629. end
  2630. else
  2631. Message(assem_e_invalid_real_const);
  2632. Until actasmtoken=AS_SEPARATOR;
  2633. end;
  2634. Procedure BuildScaling(Var instr: TInstruction);
  2635. {*********************************************************************}
  2636. { Takes care of parsing expression starting from the scaling value }
  2637. { up to and including possible field specifiers. }
  2638. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR }
  2639. { or AS_COMMA. On entry should point to the AS_COMMA token. }
  2640. {*********************************************************************}
  2641. var str:string;
  2642. l: longint;
  2643. code: integer;
  2644. Begin
  2645. Consume(AS_COMMA);
  2646. if (instr.operands[operandnum].ref.scalefactor <> 0)
  2647. and (instr.operands[operandnum].ref.scalefactor <> 1) then
  2648. Message(assem_f_internal_error_in_buildscale);
  2649. case actasmtoken of
  2650. AS_INTNUM: str := actasmpattern;
  2651. AS_HEXNUM: str := HexToDec(actasmpattern);
  2652. AS_BINNUM: str := BinaryToDec(actasmpattern);
  2653. AS_OCTALNUM: str := OctalToDec(actasmpattern);
  2654. else
  2655. Message(assem_e_syntax_error);
  2656. end;
  2657. val(str, l, code);
  2658. if code <> 0 then
  2659. Message(assem_e_invalid_scaling_factor);
  2660. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
  2661. begin
  2662. instr.operands[operandnum].ref.scalefactor := l;
  2663. end
  2664. else
  2665. Begin
  2666. Message(assem_e_invalid_scaling_value);
  2667. instr.operands[operandnum].ref.scalefactor := 0;
  2668. end;
  2669. if instr.operands[operandnum].ref.index = R_NO then
  2670. Begin
  2671. Message(assem_e_scaling_value_only_allowed_with_index);
  2672. instr.operands[operandnum].ref.scalefactor := 0;
  2673. end;
  2674. { Consume the scaling number }
  2675. Consume(actasmtoken);
  2676. if actasmtoken = AS_RPAREN then
  2677. Consume(AS_RPAREN)
  2678. else
  2679. Message(assem_e_invalid_scaling_value);
  2680. { // .Field.Field ... or separator/comma // }
  2681. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then
  2682. Begin
  2683. end
  2684. else
  2685. Message(assem_e_syntax_error);
  2686. end;
  2687. Function BuildRefExpression(BetweenBrackets: Boolean): longint;
  2688. {*********************************************************************}
  2689. { FUNCTION BuildRefExpression: longint }
  2690. { Description: This routine calculates a constant offset expression }
  2691. { to a given value. The return value is the value calculated from }
  2692. { the expression. }
  2693. { If BetweenBrackets is false, it's an offset before the brackets of }
  2694. { a reference, such as 16(%ebp), otherwise it's one in between }
  2695. { brackets, such as fs:(0x046c) }
  2696. { The following tokens (not strings) are recognized: }
  2697. { SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  2698. {*********************************************************************}
  2699. { ENTRY: On entry the token should be any valid expression token. }
  2700. { EXIT: On Exit the token points to the LPAREN token. }
  2701. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2702. { invalid tokens. }
  2703. {*********************************************************************}
  2704. var tempstr: string;
  2705. expr: string;
  2706. l,k : longint;
  2707. errorflag : boolean;
  2708. Begin
  2709. errorflag := FALSE;
  2710. tempstr := '';
  2711. expr := '';
  2712. Repeat
  2713. Case actasmtoken of
  2714. AS_RPAREN: Begin
  2715. If Not(BetweenBrackets) Then
  2716. Begin
  2717. Message(assem_e_parenthesis_are_not_allowed);
  2718. Consume(AS_RPAREN);
  2719. End
  2720. Else
  2721. Begin
  2722. { in this case a closing parenthesis denotes the end
  2723. of the expression }
  2724. If Not ErrorFlag Then
  2725. BuildRefExpression := CalculateExpression(expr)
  2726. else
  2727. BuildRefExpression := 0;
  2728. { no longer in an expression }
  2729. exit;
  2730. End
  2731. end;
  2732. AS_SHL: Begin
  2733. Consume(AS_SHL);
  2734. expr := expr + '<';
  2735. end;
  2736. AS_SHR: Begin
  2737. Consume(AS_SHR);
  2738. expr := expr + '>';
  2739. end;
  2740. AS_SLASH: Begin
  2741. Consume(AS_SLASH);
  2742. expr := expr + '/';
  2743. end;
  2744. AS_MOD: Begin
  2745. Consume(AS_MOD);
  2746. expr := expr + '%';
  2747. end;
  2748. AS_STAR: Begin
  2749. Consume(AS_STAR);
  2750. expr := expr + '*';
  2751. end;
  2752. AS_PLUS: Begin
  2753. Consume(AS_PLUS);
  2754. expr := expr + '+';
  2755. end;
  2756. AS_MINUS: Begin
  2757. Consume(AS_MINUS);
  2758. expr := expr + '-';
  2759. end;
  2760. AS_AND: Begin
  2761. Consume(AS_AND);
  2762. expr := expr + '&';
  2763. end;
  2764. AS_NOT: Begin
  2765. Consume(AS_NOT);
  2766. expr := expr + '~';
  2767. end;
  2768. AS_XOR: Begin
  2769. Consume(AS_XOR);
  2770. expr := expr + '^';
  2771. end;
  2772. AS_OR: Begin
  2773. Consume(AS_OR);
  2774. expr := expr + '|';
  2775. end;
  2776. { End of reference }
  2777. AS_LPAREN: Begin
  2778. If Not(BetweenBrackets) Then
  2779. Begin
  2780. if not ErrorFlag then
  2781. BuildRefExpression := CalculateExpression(expr)
  2782. else
  2783. BuildRefExpression := 0;
  2784. { no longer in an expression }
  2785. exit;
  2786. End
  2787. Else
  2788. Begin
  2789. Message(assem_e_parenthesis_are_not_allowed);
  2790. Consume(AS_RPAREN);
  2791. End
  2792. end;
  2793. AS_ID:
  2794. Begin
  2795. tempstr:=actasmpattern;
  2796. consume(AS_ID);
  2797. if actasmtoken=AS_DOT then
  2798. begin
  2799. GetRecordOffsetSize(tempstr,l,k);
  2800. str(l, tempstr);
  2801. expr := expr + tempstr;
  2802. end
  2803. else
  2804. begin
  2805. if SearchIConstant(tempstr,l) then
  2806. begin
  2807. str(l, tempstr);
  2808. expr := expr + tempstr;
  2809. end
  2810. else
  2811. Message1(assem_e_invalid_const_symbol,tempstr);
  2812. end;
  2813. end;
  2814. AS_INTNUM: Begin
  2815. expr := expr + actasmpattern;
  2816. Consume(AS_INTNUM);
  2817. end;
  2818. AS_BINNUM: Begin
  2819. tempstr := BinaryToDec(actasmpattern);
  2820. if tempstr = '' then
  2821. Message(assem_f_error_converting_bin);
  2822. expr:=expr+tempstr;
  2823. Consume(AS_BINNUM);
  2824. end;
  2825. AS_HEXNUM: Begin
  2826. tempstr := HexToDec(actasmpattern);
  2827. if tempstr = '' then
  2828. Message(assem_f_error_converting_hex);
  2829. expr:=expr+tempstr;
  2830. Consume(AS_HEXNUM);
  2831. end;
  2832. AS_OCTALNUM: Begin
  2833. tempstr := OctalToDec(actasmpattern);
  2834. if tempstr = '' then
  2835. Message(assem_f_error_converting_octal);
  2836. expr:=expr+tempstr;
  2837. Consume(AS_OCTALNUM);
  2838. end;
  2839. else
  2840. Begin
  2841. { write error only once. }
  2842. if not errorflag then
  2843. Message(assem_e_invalid_constant_expression);
  2844. BuildRefExpression := 0;
  2845. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then exit;
  2846. { consume tokens until we find COMMA or SEPARATOR }
  2847. Consume(actasmtoken);
  2848. errorflag := TRUE;
  2849. end;
  2850. end;
  2851. Until false;
  2852. end;
  2853. Procedure BuildReference(var Instr: TInstruction);
  2854. {*********************************************************************}
  2855. { PROCEDURE BuildBracketExpression }
  2856. { Description: This routine builds up an expression after a LPAREN }
  2857. { token is encountered. }
  2858. { On entry actasmtoken should be equal to AS_LPAREN }
  2859. {*********************************************************************}
  2860. { EXIT CONDITION: On exit the routine should point to either the }
  2861. { AS_COMMA or AS_SEPARATOR token. }
  2862. {*********************************************************************}
  2863. var
  2864. l:longint;
  2865. code: integer;
  2866. str: string;
  2867. Begin
  2868. Consume(AS_LPAREN);
  2869. initAsmRef(instr);
  2870. Case actasmtoken of
  2871. { absolute offset, such as fs:(0x046c) }
  2872. AS_HEXNUM,AS_INTNUM,AS_MINUS,
  2873. AS_BINNUM,AS_OCTALNUM,AS_PLUS:
  2874. Begin
  2875. If Instr.Operands[OperandNum].Ref.Offset <> 0 Then
  2876. { offset(offset) is invalid }
  2877. Begin
  2878. Message(assem_e_invalid_reference);
  2879. while actasmtoken <> AS_SEPARATOR do
  2880. Consume(actasmtoken);
  2881. End
  2882. Else
  2883. Begin
  2884. Instr.Operands[OperandNum].Ref.Offset := BuildRefExpression(True);
  2885. if actasmtoken <> AS_RPAREN then
  2886. Begin
  2887. Message(assem_e_invalid_reference);
  2888. while actasmtoken <> AS_SEPARATOR do
  2889. Consume(actasmtoken);
  2890. end
  2891. else
  2892. Begin
  2893. Consume(AS_RPAREN);
  2894. if not (actasmtoken in [AS_COMMA, AS_SEPARATOR]) then
  2895. Begin
  2896. { error recovery ... }
  2897. Message(assem_e_invalid_reference);
  2898. while actasmtoken <> AS_SEPARATOR do
  2899. Consume(actasmtoken);
  2900. end;
  2901. end;
  2902. End;
  2903. exit;
  2904. End;
  2905. { // (reg ... // }
  2906. AS_REGISTER: Begin
  2907. { Check if there is already a base (mostly ebp,esp) than this is
  2908. not allowed,becuase it will give crashing code }
  2909. if instr.operands[operandnum].ref.base<>R_NO then
  2910. Message(assem_e_cannot_index_relative_var);
  2911. instr.operands[operandnum].ref.base := findregister(actasmpattern);
  2912. Consume(AS_REGISTER);
  2913. { can either be a register or a right parenthesis }
  2914. { // (reg) // }
  2915. if actasmtoken=AS_RPAREN then Begin
  2916. Consume(AS_RPAREN);
  2917. if not (actasmtoken in [AS_COMMA,
  2918. AS_SEPARATOR]) then
  2919. Begin
  2920. Message(assem_e_invalid_reference);
  2921. { error recovery ... }
  2922. while actasmtoken <> AS_SEPARATOR do
  2923. Consume(actasmtoken);
  2924. end;
  2925. exit;
  2926. end;
  2927. { // (reg,reg .. // }
  2928. { we need a comman here !! }
  2929. { oops.. }
  2930. Consume(AS_COMMA);
  2931. Case actasmtoken of
  2932. AS_REGISTER: Begin
  2933. instr.operands[operandnum].ref.index :=
  2934. findregister(actasmpattern);
  2935. Consume(AS_REGISTER);
  2936. { check for scaling ... }
  2937. case actasmtoken of
  2938. AS_RPAREN:
  2939. Begin
  2940. Consume(AS_RPAREN);
  2941. if not (actasmtoken in [AS_COMMA,
  2942. AS_SEPARATOR]) then
  2943. Begin
  2944. { error recovery ... }
  2945. Message(assem_e_invalid_reference);
  2946. while actasmtoken <> AS_SEPARATOR do
  2947. Consume(actasmtoken);
  2948. end;
  2949. exit;
  2950. end;
  2951. AS_COMMA:
  2952. Begin
  2953. BuildScaling(instr);
  2954. end;
  2955. else
  2956. Begin
  2957. Message(assem_e_invalid_reference_syntax);
  2958. while (actasmtoken <> AS_SEPARATOR) do
  2959. Consume(actasmtoken);
  2960. end;
  2961. end; { end case }
  2962. end;
  2963. else
  2964. Begin
  2965. Message(assem_e_invalid_reference_syntax);
  2966. while (actasmtoken <> AS_SEPARATOR) do
  2967. Consume(actasmtoken);
  2968. end;
  2969. end; {end case }
  2970. end;
  2971. { // (, ... // }
  2972. AS_COMMA: { can either be scaling, or index }
  2973. Begin
  2974. Consume(AS_COMMA);
  2975. case actasmtoken of
  2976. AS_REGISTER: Begin
  2977. instr.operands[operandnum].ref.index :=
  2978. findregister(actasmpattern);
  2979. Consume(AS_REGISTER);
  2980. { check for scaling ... }
  2981. case actasmtoken of
  2982. AS_RPAREN:
  2983. Begin
  2984. Consume(AS_RPAREN);
  2985. if not (actasmtoken in [AS_COMMA,
  2986. AS_SEPARATOR]) then
  2987. Begin
  2988. { error recovery ... }
  2989. Message(assem_e_invalid_reference);
  2990. while actasmtoken <> AS_SEPARATOR do
  2991. Consume(actasmtoken);
  2992. end;
  2993. exit;
  2994. end;
  2995. AS_COMMA:
  2996. Begin
  2997. BuildScaling(instr);
  2998. end;
  2999. else
  3000. Begin
  3001. Message(assem_e_invalid_reference_syntax);
  3002. while (actasmtoken <> AS_SEPARATOR) do
  3003. Consume(actasmtoken);
  3004. end;
  3005. end; {end case }
  3006. end;
  3007. AS_HEXNUM,AS_INTNUM, { we have to process the scaling }
  3008. AS_BINNUM,AS_OCTALNUM: { directly here... }
  3009. Begin
  3010. case actasmtoken of
  3011. AS_INTNUM: str :=
  3012. actasmpattern;
  3013. AS_HEXNUM: str :=
  3014. HexToDec(actasmpattern);
  3015. AS_BINNUM: str :=
  3016. BinaryToDec(actasmpattern);
  3017. AS_OCTALNUM: str :=
  3018. OctalToDec(actasmpattern);
  3019. else
  3020. Message(assem_e_syntax_error);
  3021. end; { end case }
  3022. val(str, l, code);
  3023. if code <> 0 then
  3024. Message(assem_e_invalid_scaling_factor);
  3025. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
  3026. begin
  3027. instr.operands[operandnum].
  3028. ref.scalefactor := l;
  3029. end
  3030. else
  3031. Begin
  3032. Message(assem_e_invalid_scaling_value);
  3033. instr.operands[operandnum].
  3034. ref.scalefactor := 0;
  3035. end;
  3036. Consume(actasmtoken);
  3037. if actasmtoken <> AS_RPAREN then
  3038. Begin
  3039. Message(assem_e_invalid_scaling_value);
  3040. while actasmtoken <> AS_SEPARATOR do
  3041. Consume(actasmtoken);
  3042. end
  3043. else
  3044. Begin
  3045. Consume(AS_RPAREN);
  3046. if not (actasmtoken in [AS_COMMA,
  3047. AS_SEPARATOR]) then
  3048. Begin
  3049. { error recovery ... }
  3050. Message(assem_e_invalid_reference);
  3051. while actasmtoken <> AS_SEPARATOR do
  3052. Consume(actasmtoken);
  3053. end;
  3054. exit;
  3055. end;
  3056. end;
  3057. else
  3058. Begin
  3059. Message(assem_e_invalid_reference_syntax);
  3060. while (actasmtoken <> AS_SEPARATOR) do
  3061. Consume(actasmtoken);
  3062. end;
  3063. end; { end case }
  3064. end;
  3065. else
  3066. Begin
  3067. Message(assem_e_invalid_reference_syntax);
  3068. while (actasmtoken <> AS_SEPARATOR) do
  3069. Consume(actasmtoken);
  3070. end;
  3071. end; { end case }
  3072. end;
  3073. Procedure BuildOperand(var instr: TInstruction);
  3074. {*********************************************************************}
  3075. { EXIT CONDITION: On exit the routine should point to either the }
  3076. { AS_COMMA or AS_SEPARATOR token. }
  3077. {*********************************************************************}
  3078. var
  3079. tempstr: string;
  3080. expr: string;
  3081. lab: Pasmlabel;
  3082. hl: plabel;
  3083. tsize,
  3084. toffset : longint;
  3085. Begin
  3086. tempstr := '';
  3087. expr := '';
  3088. case actasmtoken of
  3089. { // Memory reference // }
  3090. AS_LPAREN:
  3091. Begin
  3092. initAsmRef(instr);
  3093. BuildReference(instr);
  3094. end;
  3095. { // Constant expression // }
  3096. AS_DOLLAR: Begin
  3097. Consume(AS_DOLLAR);
  3098. if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_CONSTANT]) then
  3099. Message(assem_e_invalid_operand_type);
  3100. { identifiers are handled by BuildExpression }
  3101. instr.operands[operandnum].operandtype := OPR_CONSTANT;
  3102. instr.operands[operandnum].val :=BuildExpression;
  3103. end;
  3104. { // Constant memory offset . // }
  3105. { // This must absolutely be followed by ( // }
  3106. AS_HEXNUM,AS_INTNUM,AS_MINUS,
  3107. AS_BINNUM,AS_OCTALNUM,AS_PLUS:
  3108. Begin
  3109. InitAsmRef(instr);
  3110. instr.operands[operandnum].ref.offset:=BuildRefExpression(False);
  3111. BuildReference(instr);
  3112. end;
  3113. { // Call from memory address // }
  3114. AS_STAR: Begin
  3115. Consume(AS_STAR);
  3116. InitAsmRef(instr);
  3117. if not CreateVarInstr(instr,actasmpattern,operandnum) then
  3118. Message(assem_e_syn_opcode_operand);
  3119. end;
  3120. { // A constant expression, or a Variable ref. // }
  3121. AS_ID: Begin
  3122. { // Local label. // }
  3123. if (actasmpattern[1] ='.') and (actasmpattern[2] = 'L') then
  3124. Begin
  3125. Begin
  3126. delete(actasmpattern,1,1);
  3127. delete(actasmpattern,1,1);
  3128. if actasmpattern = '' then
  3129. Message(assem_e_null_label_ref_not_allowed);
  3130. lab := labellist.search(actasmpattern);
  3131. { check if the label is already defined }
  3132. { if so, we then check if the plabel is }
  3133. { non-nil, if so we add it to instruction }
  3134. if assigned(lab) then
  3135. Begin
  3136. if assigned(lab^.lab) then
  3137. Begin
  3138. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3139. instr.operands[operandnum].hl := lab^.lab;
  3140. instr.labeled := TRUE;
  3141. end;
  3142. end
  3143. else
  3144. { the label does not exist, create it }
  3145. { emit the opcode, but set that the }
  3146. { label has not been emitted }
  3147. Begin
  3148. getlabel(hl);
  3149. labellist.insert(actasmpattern,hl,FALSE);
  3150. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3151. instr.operands[operandnum].hl := hl;
  3152. instr.labeled := TRUE;
  3153. end;
  3154. end;
  3155. Consume(AS_ID);
  3156. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  3157. Begin
  3158. Message(assem_e_syntax_error);
  3159. end;
  3160. end
  3161. { probably a variable or normal expression }
  3162. { or a procedure (such as in CALL ID) }
  3163. else
  3164. Begin
  3165. { check if this is a label, if so then }
  3166. { emit it as a label. }
  3167. if SearchLabel(actasmpattern,hl) then
  3168. Begin
  3169. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3170. instr.operands[operandnum].hl := hl;
  3171. instr.labeled := TRUE;
  3172. Consume(AS_ID);
  3173. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  3174. Message(assem_e_syntax_error);
  3175. end
  3176. else
  3177. { is it a normal variable ? }
  3178. Begin
  3179. { context for scanner }
  3180. previous_was_id:=TRUE;
  3181. initAsmRef(instr);
  3182. if not CreateVarInstr(instr,actasmpattern,operandnum) then
  3183. Begin
  3184. { look for special symbols ... }
  3185. if actasmpattern = '__RESULT' then
  3186. SetUpResult(instr,operandnum)
  3187. else
  3188. if actasmpattern = '__SELF' then
  3189. Begin
  3190. if assigned(procinfo._class) then
  3191. Begin
  3192. instr.operands[operandnum].operandtype := OPR_REFERENCE;
  3193. instr.operands[operandnum].ref.offset :=
  3194. procinfo.ESI_offset;
  3195. instr.operands[operandnum].ref.base :=
  3196. procinfo.framepointer;
  3197. end
  3198. else
  3199. Message(assem_e_cannot_use___SELF_outside_methode);
  3200. end
  3201. else
  3202. if actasmpattern = '__OLDEBP' then
  3203. Begin
  3204. if lexlevel>normal_function_level then
  3205. Begin
  3206. instr.operands[operandnum].operandtype := OPR_REFERENCE;
  3207. instr.operands[operandnum].ref.offset :=
  3208. procinfo.framepointer_offset;
  3209. instr.operands[operandnum].ref.base :=
  3210. procinfo.framepointer;
  3211. end
  3212. else
  3213. Message(assem_e_cannot_use___OLDEBP_outside_nested_procedure);
  3214. end { endif actasmpattern = '__OLDEBP' }
  3215. else
  3216. { check for direct symbolic names }
  3217. { only if compiling the system unit }
  3218. if (cs_compilesystem in aktmoduleswitches) then
  3219. begin
  3220. if not SearchDirectVar(instr,actasmpattern,operandnum) then
  3221. Begin
  3222. { not found, finally ... add it anyways ... }
  3223. Message1(assem_w_id_supposed_external,actasmpattern);
  3224. instr.operands[operandnum].ref.symbol := newpasstr(actasmpattern);
  3225. end;
  3226. end
  3227. else
  3228. Message1(assem_e_unknown_id,actasmpattern);
  3229. end;
  3230. { constant expression? }
  3231. if (instr.operands[operandnum].operandtype=OPR_CONSTANT) then
  3232. instr.operands[operandnum].val := BuildExpression
  3233. else
  3234. begin
  3235. expr := actasmpattern;
  3236. Consume(AS_ID);
  3237. case actasmtoken of
  3238. AS_LPAREN: Begin
  3239. { indexing }
  3240. previous_was_id:=FALSE;
  3241. BuildReference(instr);
  3242. end;
  3243. AS_DOT : Begin
  3244. GetRecordOffsetSize(expr,toffset,tsize);
  3245. inc(instr.operands[operandnum].ref.offset,toffset);
  3246. SetOperandSize(instr,operandnum,tsize);
  3247. end;
  3248. AS_SEPARATOR,AS_COMMA: ;
  3249. else
  3250. Message(assem_e_syntax_error);
  3251. end; { end case }
  3252. end;
  3253. { restore normal context }
  3254. previous_was_id := FALSE;
  3255. end; { end if }
  3256. end; { end if }
  3257. end; { end this case }
  3258. { // Register, a variable reference or a constant reference // }
  3259. AS_REGISTER: Begin
  3260. { save the type of register used. }
  3261. tempstr := actasmpattern;
  3262. Consume(AS_REGISTER);
  3263. if actasmtoken = AS_COLON then
  3264. Begin
  3265. Consume(AS_COLON);
  3266. initAsmRef(instr);
  3267. instr.operands[operandnum].ref.segment := findsegment(tempstr);
  3268. { here we can have either an identifier }
  3269. { or a constant, where either can be }
  3270. { followed by a parenthesis... }
  3271. { // Constant memory offset . // }
  3272. { // This must absolutely be followed by ( // }
  3273. case actasmtoken of
  3274. AS_HEXNUM,AS_INTNUM,AS_MINUS,
  3275. AS_BINNUM,AS_OCTALNUM,AS_PLUS
  3276. : Begin
  3277. instr.operands[operandnum].
  3278. ref.offset:=BuildRefExpression(False);
  3279. BuildReference(instr);
  3280. end;
  3281. AS_LPAREN: BuildReference(instr);
  3282. { only a variable is allowed ... }
  3283. AS_ID: Begin
  3284. { is it a normal variable ? }
  3285. if not CreateVarInstr(instr,actasmpattern,operandnum)
  3286. then
  3287. begin
  3288. { check for direct symbolic names }
  3289. { only if compiling the system unit }
  3290. if (cs_compilesystem in aktmoduleswitches) then
  3291. begin
  3292. if not SearchDirectVar(instr,actasmpattern,operandnum) then
  3293. Message(assem_e_invalid_seg_override);
  3294. end
  3295. else
  3296. Message(assem_e_invalid_seg_override);
  3297. end;
  3298. Consume(actasmtoken);
  3299. case actasmtoken of
  3300. AS_SEPARATOR,AS_COMMA: ;
  3301. AS_LPAREN: BuildReference(instr);
  3302. else
  3303. Begin
  3304. Message(assem_e_invalid_seg_override);
  3305. Consume(actasmtoken);
  3306. end;
  3307. end; {end case }
  3308. end;
  3309. else
  3310. Begin
  3311. Message(assem_e_invalid_seg_override);
  3312. Consume(actasmtoken);
  3313. end;
  3314. end; { end case }
  3315. end
  3316. { // Simple register // }
  3317. else if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then
  3318. Begin
  3319. if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_REGISTER]) then
  3320. Message(assem_e_invalid_operand_type);
  3321. instr.operands[operandnum].operandtype := OPR_REGISTER;
  3322. instr.operands[operandnum].reg := findregister(tempstr);
  3323. end
  3324. else
  3325. Message1(assem_e_syn_register,tempstr);
  3326. end;
  3327. AS_SEPARATOR, AS_COMMA: ;
  3328. else
  3329. Begin
  3330. Message(assem_e_syn_opcode_operand);
  3331. Consume(actasmtoken);
  3332. end;
  3333. end; { end case }
  3334. end;
  3335. Procedure BuildConstant(maxvalue: longint);
  3336. {*********************************************************************}
  3337. { PROCEDURE BuildConstant }
  3338. { Description: This routine takes care of parsing a DB,DD,or DW }
  3339. { line and adding those to the assembler node. Expressions, range- }
  3340. { checking are fullly taken care of. }
  3341. { maxvalue: $ff -> indicates that this is a DB node. }
  3342. { $ffff -> indicates that this is a DW node. }
  3343. { $ffffffff -> indicates that this is a DD node. }
  3344. {*********************************************************************}
  3345. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3346. {*********************************************************************}
  3347. var
  3348. strlength: byte;
  3349. expr: string;
  3350. value : longint;
  3351. Begin
  3352. Repeat
  3353. Case actasmtoken of
  3354. AS_STRING: Begin
  3355. if maxvalue = $ff then
  3356. strlength := 1
  3357. else
  3358. Message(assem_e_string_not_allowed_as_const);
  3359. expr := actasmpattern;
  3360. if length(expr) > 1 then
  3361. Message(assem_e_string_not_allowed_as_const);
  3362. Consume(AS_STRING);
  3363. Case actasmtoken of
  3364. AS_COMMA: Consume(AS_COMMA);
  3365. AS_SEPARATOR: ;
  3366. else
  3367. Message(assem_e_invalid_string_expression);
  3368. end; { end case }
  3369. ConcatString(p,expr);
  3370. end;
  3371. AS_INTNUM,AS_BINNUM,
  3372. AS_OCTALNUM,AS_HEXNUM:
  3373. Begin
  3374. value:=BuildExpression;
  3375. ConcatConstant(p,value,maxvalue);
  3376. end;
  3377. AS_ID:
  3378. Begin
  3379. value:=BuildExpression;
  3380. if value > maxvalue then
  3381. Begin
  3382. Message(assem_e_expression_out_of_bounds);
  3383. { assuming a value of maxvalue }
  3384. value := maxvalue;
  3385. end;
  3386. ConcatConstant(p,value,maxvalue);
  3387. end;
  3388. { These terms can start an assembler expression }
  3389. AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: Begin
  3390. value := BuildExpression;
  3391. ConcatConstant(p,value,maxvalue);
  3392. end;
  3393. AS_COMMA: BEGIN
  3394. Consume(AS_COMMA);
  3395. END;
  3396. AS_SEPARATOR: ;
  3397. else
  3398. Begin
  3399. Message(assem_f_internal_error_in_buildconstant);
  3400. end;
  3401. end; { end case }
  3402. Until actasmtoken = AS_SEPARATOR;
  3403. end;
  3404. Procedure BuildStringConstant(asciiz: boolean);
  3405. {*********************************************************************}
  3406. { PROCEDURE BuildStringConstant }
  3407. { Description: Takes care of a ASCII, or ASCIIZ directive. }
  3408. { asciiz: boolean -> if true then string will be null terminated. }
  3409. {*********************************************************************}
  3410. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3411. { On ENTRY: Token should point to AS_STRING }
  3412. {*********************************************************************}
  3413. var
  3414. expr: string;
  3415. errorflag : boolean;
  3416. Begin
  3417. errorflag := FALSE;
  3418. Repeat
  3419. Case actasmtoken of
  3420. AS_STRING: Begin
  3421. expr:=actasmpattern;
  3422. if asciiz then
  3423. expr:=expr+#0;
  3424. ConcatPasString(p,expr);
  3425. Consume(AS_STRING);
  3426. end;
  3427. AS_COMMA: BEGIN
  3428. Consume(AS_COMMA);
  3429. END;
  3430. AS_SEPARATOR: ;
  3431. else
  3432. Begin
  3433. Consume(actasmtoken);
  3434. if not errorflag then
  3435. Message(assem_e_invalid_string_expression);
  3436. errorflag := TRUE;
  3437. end;
  3438. end; { end case }
  3439. Until actasmtoken = AS_SEPARATOR;
  3440. end;
  3441. Procedure BuildOpCode;
  3442. {*********************************************************************}
  3443. { PROCEDURE BuildOpcode; }
  3444. { Description: Parses the intel opcode and operands, and writes it }
  3445. { in the TInstruction object. }
  3446. {*********************************************************************}
  3447. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3448. { On ENTRY: Token should point to AS_OPCODE }
  3449. {*********************************************************************}
  3450. var asmtok: tasmop;
  3451. op: tasmop;
  3452. expr: string;
  3453. segreg: tregister;
  3454. Begin
  3455. expr := '';
  3456. asmtok := A_NONE; { assmume no prefix }
  3457. segreg := R_NO; { assume no segment override }
  3458. { // prefix seg opcode // }
  3459. { // prefix opcode // }
  3460. if findprefix(actasmpattern,asmtok) then
  3461. Begin
  3462. { standard opcode prefix }
  3463. if asmtok <> A_NONE then
  3464. instr.addprefix(asmtok);
  3465. Consume(AS_OPCODE);
  3466. end;
  3467. { // opcode // }
  3468. { allow for newline as in gas styled syntax }
  3469. { under DOS you get two AS_SEPARATOR !! }
  3470. while actasmtoken=AS_SEPARATOR do
  3471. Consume(AS_SEPARATOR);
  3472. if (actasmtoken <> AS_OPCODE) then
  3473. Begin
  3474. Message(assem_e_invalid_or_missing_opcode);
  3475. { error recovery }
  3476. While not (actasmtoken in [AS_SEPARATOR,AS_COMMA,AS_END]) do
  3477. Consume(actasmtoken);
  3478. exit;
  3479. end
  3480. else
  3481. Begin
  3482. op := findopcode(actasmpattern);
  3483. instr.addinstr(op);
  3484. { // Valid combination of prefix and instruction ? // }
  3485. if (asmtok <> A_NONE) and (NOT CheckPrefix(asmtok,op)) then
  3486. Message1(assem_e_invalid_prefix_and_opcode,actasmpattern);
  3487. Consume(AS_OPCODE);
  3488. { // Zero operand opcode ? // }
  3489. if actasmtoken in [AS_SEPARATOR,AS_END] then
  3490. exit
  3491. else
  3492. operandnum := 1;
  3493. end;
  3494. repeat
  3495. case actasmtoken of
  3496. { // Operand delimiter // }
  3497. AS_COMMA: Begin
  3498. if operandnum > MaxOperands then
  3499. Message(assem_e_too_many_operands)
  3500. else
  3501. Inc(operandnum);
  3502. Consume(AS_COMMA);
  3503. end;
  3504. { // End of asm operands for this opcode // }
  3505. AS_SEPARATOR,
  3506. AS_END : break;
  3507. else
  3508. BuildOperand(instr);
  3509. end; { end case }
  3510. until false;
  3511. end;
  3512. Function Assemble: Ptree;
  3513. {*********************************************************************}
  3514. { PROCEDURE Assemble; }
  3515. { Description: Parses the att assembler syntax, parsing is done }
  3516. { according to GAs rules. }
  3517. {*********************************************************************}
  3518. Var
  3519. hl: plabel;
  3520. labelptr,nextlabel : pasmlabel;
  3521. commname : string;
  3522. store_p : paasmoutput;
  3523. Begin
  3524. Message(assem_d_start_att);
  3525. firsttoken := TRUE;
  3526. operandnum := 0;
  3527. if assigned(procinfo.retdef) and
  3528. (is_fpu(procinfo.retdef) or
  3529. ret_in_acc(procinfo.retdef)) then
  3530. procinfo.funcret_is_valid:=true;
  3531. { sets up all opcode and register tables in uppercase }
  3532. if not _asmsorted then
  3533. Begin
  3534. SetupTables;
  3535. _asmsorted := TRUE;
  3536. end;
  3537. p:=new(paasmoutput,init);
  3538. { save pointer code section }
  3539. store_p:=p;
  3540. { setup label linked list }
  3541. labellist.init;
  3542. c:=current_scanner^.asmgetchar;
  3543. actasmtoken:=gettoken;
  3544. repeat
  3545. case actasmtoken of
  3546. AS_LLABEL: Begin
  3547. labelptr := labellist.search(actasmpattern);
  3548. if not assigned(labelptr) then
  3549. Begin
  3550. getlabel(hl);
  3551. labellist.insert(actasmpattern,hl,TRUE);
  3552. ConcatLabel(p,A_LABEL,hl);
  3553. end
  3554. else
  3555. { the label has already been inserted into the }
  3556. { label list, either as an instruction label (in}
  3557. { this case it has not been emitted), or as a }
  3558. { duplicate local symbol (in this case it has }
  3559. { already been emitted). }
  3560. Begin
  3561. if labelptr^.emitted then
  3562. Message1(assem_e_dup_local_sym,'.L'+labelptr^.name^)
  3563. else
  3564. Begin
  3565. if assigned(labelptr^.lab) then
  3566. ConcatLabel(p,A_LABEL,labelptr^.lab);
  3567. labelptr^.emitted := TRUE;
  3568. end;
  3569. end;
  3570. Consume(AS_LLABEL);
  3571. end;
  3572. AS_LABEL: Begin
  3573. { when looking for Pascal labels, these must }
  3574. { be in uppercase. }
  3575. if SearchLabel(upper(actasmpattern),hl) then
  3576. ConcatLabel(p,A_LABEL, hl)
  3577. else
  3578. Begin
  3579. if (cs_compilesystem in aktmoduleswitches) then
  3580. begin
  3581. Message1(assem_e_unknown_label_identifer,actasmpattern);
  3582. { once again we don't know what it represents }
  3583. { so we simply concatenate it }
  3584. ConcatLocal(p,actasmpattern);
  3585. end
  3586. else
  3587. Message1(assem_e_unknown_label_identifer,actasmpattern);
  3588. end;
  3589. Consume(AS_LABEL);
  3590. end;
  3591. AS_DW: Begin
  3592. Consume(AS_DW);
  3593. BuildConstant($ffff);
  3594. end;
  3595. AS_DATA: Begin
  3596. { -- this should only be allowed for system development -- }
  3597. { i think this should be fixed in the dos unit, and }
  3598. { not here. }
  3599. if (cs_compilesystem in aktmoduleswitches) then
  3600. p:=datasegment
  3601. else
  3602. Message(assem_e_switching_sections_not_allowed);
  3603. Consume(AS_DATA);
  3604. end;
  3605. AS_TEXT: Begin
  3606. { -- this should only be allowed for system development -- }
  3607. { i think this should be fixed in the dos unit, and }
  3608. { not here. }
  3609. if (cs_compilesystem in aktmoduleswitches) then
  3610. p:=store_p
  3611. else
  3612. Message(assem_e_switching_sections_not_allowed);
  3613. Consume(AS_TEXT);
  3614. end;
  3615. AS_DB: Begin
  3616. Consume(AS_DB);
  3617. BuildConstant($ff);
  3618. end;
  3619. AS_DD: Begin
  3620. Consume(AS_DD);
  3621. BuildConstant($ffffffff);
  3622. end;
  3623. AS_DQ: Begin
  3624. Consume(AS_DQ);
  3625. BuildRealConstant(s64bit);
  3626. end;
  3627. AS_SINGLE: Begin
  3628. Consume(AS_SINGLE);
  3629. BuildRealConstant(s32real);
  3630. end;
  3631. AS_DOUBLE: Begin
  3632. Consume(AS_DOUBLE);
  3633. BuildRealConstant(s64real);
  3634. end;
  3635. AS_EXTENDED: Begin
  3636. Consume(AS_EXTENDED);
  3637. BuildRealConstant(s80real);
  3638. end;
  3639. AS_GLOBAL:
  3640. Begin
  3641. { normal units should not be able to declare }
  3642. { direct label names like this... anyhow }
  3643. { procedural calls in asm blocks are }
  3644. { supposedely replaced automatically }
  3645. if (cs_compilesystem in aktmoduleswitches) then
  3646. begin
  3647. Consume(AS_GLOBAL);
  3648. if actasmtoken <> AS_ID then
  3649. Message(assem_e_invalid_global_def)
  3650. else
  3651. ConcatPublic(p,actasmpattern);
  3652. Consume(actasmtoken);
  3653. if actasmtoken <> AS_SEPARATOR then
  3654. Begin
  3655. Message(assem_e_line_separator_expected);
  3656. while actasmtoken <> AS_SEPARATOR do
  3657. Consume(actasmtoken);
  3658. end;
  3659. end
  3660. else
  3661. begin
  3662. Message(assem_w_globl_not_supported);
  3663. while actasmtoken <> AS_SEPARATOR do
  3664. Consume(actasmtoken);
  3665. end;
  3666. end;
  3667. AS_ALIGN: Begin
  3668. Message(assem_w_align_not_supported);
  3669. while actasmtoken <> AS_SEPARATOR do
  3670. Consume(actasmtoken);
  3671. end;
  3672. AS_ASCIIZ: Begin
  3673. Consume(AS_ASCIIZ);
  3674. BuildStringConstant(TRUE);
  3675. end;
  3676. AS_ASCII: Begin
  3677. Consume(AS_ASCII);
  3678. BuildStringConstant(FALSE);
  3679. end;
  3680. AS_LCOMM: Begin
  3681. { -- this should only be allowed for system development -- }
  3682. { -- otherwise may mess up future enhancements we might -- }
  3683. { -- add. -- }
  3684. if (cs_compilesystem in aktmoduleswitches) then
  3685. begin
  3686. Consume(AS_LCOMM);
  3687. if actasmtoken <> AS_ID then
  3688. begin
  3689. Message(assem_e_invalid_lcomm_def);
  3690. { error recovery }
  3691. while actasmtoken <> AS_SEPARATOR do
  3692. Consume(actasmtoken);
  3693. end
  3694. else
  3695. begin
  3696. commname:=actasmpattern;
  3697. Consume(AS_COMMA);
  3698. ConcatLocalBss(actasmpattern,BuildExpression);
  3699. if actasmtoken <> AS_SEPARATOR then
  3700. Begin
  3701. Message(assem_e_line_separator_expected);
  3702. while actasmtoken <> AS_SEPARATOR do
  3703. Consume(actasmtoken);
  3704. end;
  3705. end;
  3706. end
  3707. else
  3708. begin
  3709. Message(assem_w_lcomm_not_supported);
  3710. while actasmtoken <> AS_SEPARATOR do
  3711. Consume(actasmtoken);
  3712. end;
  3713. end;
  3714. AS_COMM: Begin
  3715. { -- this should only be allowed for system development -- }
  3716. { -- otherwise may mess up future enhancements we might -- }
  3717. { -- add. -- }
  3718. if (cs_compilesystem in aktmoduleswitches) then
  3719. begin
  3720. Consume(AS_COMM);
  3721. if actasmtoken <> AS_ID then
  3722. begin
  3723. Message(assem_e_invalid_comm_def);
  3724. { error recovery }
  3725. while actasmtoken <> AS_SEPARATOR do
  3726. Consume(actasmtoken);
  3727. end
  3728. else
  3729. begin
  3730. commname:=actasmpattern;
  3731. Consume(AS_COMMA);
  3732. ConcatGlobalBss(actasmpattern,BuildExpression);
  3733. if actasmtoken <> AS_SEPARATOR then
  3734. Begin
  3735. Message(assem_e_line_separator_expected);
  3736. while actasmtoken <> AS_SEPARATOR do
  3737. Consume(actasmtoken);
  3738. end;
  3739. end;
  3740. end
  3741. else
  3742. begin
  3743. Message(assem_w_comm_not_supported);
  3744. while actasmtoken <> AS_SEPARATOR do
  3745. Consume(actasmtoken);
  3746. end;
  3747. end;
  3748. AS_OPCODE: Begin
  3749. instr.init;
  3750. BuildOpcode;
  3751. instr.numops := operandnum;
  3752. if instr.labeled then
  3753. ConcatLabeledInstr(instr)
  3754. else
  3755. ConcatOpCode(instr);
  3756. instr.done;
  3757. end;
  3758. AS_SEPARATOR:Begin
  3759. Consume(AS_SEPARATOR);
  3760. { let us go back to the first operand }
  3761. operandnum := 0;
  3762. end;
  3763. AS_END: break; { end assembly block }
  3764. else
  3765. Begin
  3766. Message(assem_e_assemble_node_syntax_error);
  3767. { error recovery }
  3768. Consume(actasmtoken);
  3769. end;
  3770. end; { end case }
  3771. until false;
  3772. { check if there were undefined symbols. }
  3773. { if so, then list each of those undefined }
  3774. { labels. }
  3775. if assigned(labellist.First) then
  3776. Begin
  3777. labelptr := labellist.First;
  3778. While labelptr <> nil do
  3779. Begin
  3780. nextlabel:=labelptr^.next;
  3781. if not labelptr^.emitted then
  3782. Message1(assem_e_local_sym_not_found_in_asm_statement,'.L'+labelptr^.name^);
  3783. labelptr:=nextlabel;
  3784. end;
  3785. end;
  3786. if p<>store_p then
  3787. begin
  3788. Message(assem_e_assembler_code_not_returned_to_text);
  3789. p:=store_p;
  3790. end;
  3791. assemble := genasmnode(p);
  3792. labellist.done;
  3793. Message(assem_d_finish_att);
  3794. end;
  3795. var
  3796. old_exit: pointer;
  3797. procedure ra386att_exit;{$ifndef FPC}far;{$endif}
  3798. begin
  3799. if assigned(iasmops) then
  3800. dispose(iasmops);
  3801. exitproc:=old_exit;
  3802. end;
  3803. Begin
  3804. previous_was_id := FALSE;
  3805. line:='';
  3806. { you will get range problems here }
  3807. if lastop_in_table > last_instruction_in_cache then
  3808. Internalerror(2111);
  3809. old_exit := exitproc;
  3810. exitproc := @ra386att_exit;
  3811. end.
  3812. {
  3813. $Log$
  3814. Revision 1.26 1998-12-11 00:03:42 peter
  3815. + globtype,tokens,version unit splitted from globals
  3816. Revision 1.25 1998/12/09 13:23:40 jonas
  3817. * replaced two "in [A_...]" constructs I had missed before
  3818. * for shrd/shld: "if operands[1].operandtype = OPR_CONSTANT" instead of
  3819. "if operands[3].operandtype ..."
  3820. Revision 1.24 1998/12/08 23:03:48 jonas
  3821. * allow constant offsets for go32v2 in assembler blocks
  3822. Revision 1.23 1998/12/02 16:23:33 jonas
  3823. * changed "if longintvar in set" to case or "if () or () .." statements
  3824. * tree.pas: changed inlinenumber (and associated constructor/vars) to a byte
  3825. Revision 1.22 1998/11/29 12:47:21 peter
  3826. * fixes for 'asm sti end;'
  3827. Revision 1.21 1998/11/16 15:38:54 peter
  3828. * fixed instruct not in table msg
  3829. Revision 1.20 1998/11/13 15:40:27 pierre
  3830. + added -Se in Makefile cvstest target
  3831. + lexlevel cleanup
  3832. normal_function_level main_program_level and unit_init_level defined
  3833. * tins_cache grown to A_EMMS (gave range check error in asm readers)
  3834. (test added in code !)
  3835. * -Un option was wrong
  3836. * _FAIL and _SELF only keyword inside
  3837. constructors and methods respectively
  3838. Revision 1.19 1998/11/13 10:12:16 peter
  3839. * constant fixes
  3840. Revision 1.18 1998/11/05 23:48:26 peter
  3841. * recordtype.field support in constant expressions
  3842. * fixed imul for oa_imm8 which was not allowed
  3843. * fixed reading of local typed constants
  3844. * fixed comment reading which is not any longer a separator
  3845. Revision 1.17 1998/10/28 21:34:39 peter
  3846. * fixed some opsize
  3847. Revision 1.16 1998/10/28 00:08:48 peter
  3848. + leal procsym,eax is now allowed
  3849. + constants are now handled also when starting an expression
  3850. + call *pointer is now allowed
  3851. Revision 1.15 1998/10/13 16:50:16 pierre
  3852. * undid some changes of Peter that made the compiler wrong
  3853. for m68k (I had to reinsert some ifdefs)
  3854. * removed several memory leaks under m68k
  3855. * removed the meory leaks for assembler readers
  3856. * cross compiling shoud work again better
  3857. ( crosscompiling sysamiga works
  3858. but as68k still complain about some code !)
  3859. Revision 1.14 1998/10/07 04:28:52 carl
  3860. * bugfix of in/out with gas (ins/outs still left though)
  3861. * bugfix of wrong error output with concatlabel
  3862. * gettoken always returns something valid now
  3863. Revision 1.13 1998/09/24 17:52:31 carl
  3864. * bugfix from fix branch
  3865. Revision 1.12.2.1 1998/09/24 17:47:16 carl
  3866. * bugfix with objects/records access
  3867. Revision 1.12 1998/09/03 17:08:46 pierre
  3868. * better lines for stabs
  3869. (no scroll back to if before else part
  3870. no return to case line at jump outside case)
  3871. + source lines also if not in order
  3872. Revision 1.11 1998/09/02 15:16:44 carl
  3873. * indirect register refs with movsx/movzx fixed
  3874. Revision 1.10 1998/09/02 01:24:09 carl
  3875. * bugfix of PUSH opcode with constants
  3876. Revision 1.9 1998/08/21 08:45:49 pierre
  3877. * better line info for asm statements
  3878. Revision 1.8 1998/08/19 16:07:54 jonas
  3879. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  3880. Revision 1.7 1998/08/10 23:57:23 peter
  3881. * use bestreal instead of extended
  3882. Revision 1.6 1998/08/10 14:50:21 peter
  3883. + localswitches, moduleswitches, globalswitches splitting
  3884. Revision 1.5 1998/07/14 14:46:58 peter
  3885. * released NEWINPUT
  3886. Revision 1.4 1998/07/08 15:06:41 daniel
  3887. + $N+,E+ added for TP.
  3888. Revision 1.3 1998/07/07 11:20:07 peter
  3889. + NEWINPUT for a better inputfile and scanner object
  3890. Revision 1.2 1998/06/24 14:06:36 peter
  3891. * fixed the name changes
  3892. Revision 1.1 1998/06/23 14:00:17 peter
  3893. * renamed RA* units
  3894. Revision 1.13 1998/06/16 08:56:29 peter
  3895. + targetcpu
  3896. * cleaner pmodules for newppu
  3897. Revision 1.12 1998/06/12 10:32:35 pierre
  3898. * column problem hopefully solved
  3899. + C vars declaration changed
  3900. Revision 1.11 1998/05/31 14:13:35 peter
  3901. * fixed call bugs with assembler readers
  3902. + OPR_SYMBOL to hold a symbol in the asm parser
  3903. * fixed staticsymtable vars which were acessed through %ebp instead of
  3904. name
  3905. Revision 1.10 1998/05/30 14:31:08 peter
  3906. + $ASMMODE
  3907. Revision 1.9 1998/05/29 09:58:16 pierre
  3908. * OPR_REGISTER for 1 arg was missing in ratti386.pas
  3909. (probably a merging problem)
  3910. * errors at start of line were lost
  3911. Revision 1.8 1998/05/28 16:34:36 carl
  3912. * call bugfix
  3913. * operand with regs bugfix (manual patch in both cases)
  3914. Revision 1.7 1998/05/23 01:21:27 peter
  3915. + aktasmmode, aktoptprocessor, aktoutputformat
  3916. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  3917. + $LIBNAME to set the library name where the unit will be put in
  3918. * splitted cgi386 a bit (codeseg to large for bp7)
  3919. * nasm, tasm works again. nasm moved to ag386nsm.pas
  3920. Revision 1.6 1998/05/20 09:42:37 pierre
  3921. + UseTokenInfo now default
  3922. * unit in interface uses and implementation uses gives error now
  3923. * only one error for unknown symbol (uses lastsymknown boolean)
  3924. the problem came from the label code !
  3925. + first inlined procedures and function work
  3926. (warning there might be allowed cases were the result is still wrong !!)
  3927. * UseBrower updated gives a global list of all position of all used symbols
  3928. with switch -gb
  3929. Revision 1.5 1998/04/29 13:52:23 peter
  3930. * small optimize fix
  3931. Revision 1.4 1998/04/29 10:34:04 pierre
  3932. + added some code for ansistring (not complete nor working yet)
  3933. * corrected operator overloading
  3934. * corrected nasm output
  3935. + started inline procedures
  3936. + added starstarn : use ** for exponentiation (^ gave problems)
  3937. + started UseTokenInfo cond to get accurate positions
  3938. Revision 1.3 1998/04/08 16:58:07 pierre
  3939. * several bugfixes
  3940. ADD ADC and AND are also sign extended
  3941. nasm output OK (program still crashes at end
  3942. and creates wrong assembler files !!)
  3943. procsym types sym in tdef removed !!
  3944. }