ra386att.pas 159 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026
  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. 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_POPFD;
  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. if (instruc in [A_MOVZX,A_MOVSX]) then
  923. Message(assem_f_internal_error_in_handleextend)
  924. else
  925. if (instruc = A_MOVSB) or (instruc = A_MOVSBL) then
  926. Begin
  927. instruc := A_MOVSX;
  928. { Indirect memory reference with register }
  929. { no size determined, therefore we determine it }
  930. { with the suffix. }
  931. if instr.operands[1].size = S_NO then
  932. instr.operands[1].size := S_B;
  933. end
  934. else
  935. if (instruc = A_MOVSBW) then
  936. Begin
  937. instruc := A_MOVSX;
  938. { Indirect memory reference with register }
  939. { no size determined, therefore we determine it }
  940. { with the suffix. }
  941. if instr.operands[1].size = S_NO then
  942. instr.operands[1].size := S_B;
  943. end
  944. else
  945. if (instruc = A_MOVSWL) then
  946. Begin
  947. instruc := A_MOVSX;
  948. { Indirect memory reference with register }
  949. { no size determined, therefore we determine it }
  950. { with the suffix. }
  951. if instr.operands[1].size = S_NO then
  952. instr.operands[1].size := S_W;
  953. end
  954. else
  955. if (instruc = A_MOVZB) then
  956. Begin
  957. instruc := A_MOVZX;
  958. { Indirect memory reference with register }
  959. { no size determined, therefore we determine it }
  960. { with the suffix. }
  961. if instr.operands[1].size = S_NO then
  962. instr.operands[1].size := S_B;
  963. end
  964. else
  965. if (instruc = A_MOVZWL) then
  966. Begin
  967. instruc := A_MOVZX;
  968. { Indirect memory reference with register }
  969. { no size determined, therefore we determine it }
  970. { with the suffix. }
  971. if instr.operands[1].size = S_NO then
  972. instr.operands[1].size := S_W;
  973. end;
  974. With instr do
  975. Begin
  976. if operands[1].size = S_B then
  977. Begin
  978. if operands[2].size = S_L then
  979. opsize := S_BL
  980. else
  981. if operands[2].size = S_W then
  982. opsize := S_BW
  983. else
  984. begin
  985. Message(assem_e_invalid_size_movzx);
  986. exit;
  987. end;
  988. end
  989. else
  990. if operands[1].size = S_W then
  991. Begin
  992. if operands[2].size = S_L then
  993. opsize := S_WL
  994. else
  995. begin
  996. Message(assem_e_invalid_size_movzx);
  997. exit;
  998. end;
  999. end
  1000. else
  1001. begin
  1002. Message(assem_e_invalid_size_movzx);
  1003. exit;
  1004. end;
  1005. if operands[1].operandtype = OPR_REGISTER then
  1006. Begin
  1007. if operands[2].operandtype <> OPR_REGISTER then
  1008. Message(assem_e_invalid_opcode) { exit...}
  1009. else
  1010. p^.concat(new(pai386,op_reg_reg(instruc,opsize,
  1011. operands[1].reg,operands[2].reg)));
  1012. end
  1013. else
  1014. if operands[1].operandtype = OPR_REFERENCE then
  1015. Begin
  1016. if operands[2].operandtype <> OPR_REGISTER then
  1017. Message(assem_e_invalid_opcode) {exit...}
  1018. else
  1019. p^.concat(new(pai386,op_ref_reg(instruc,opsize,
  1020. newreference(operands[1].ref),operands[2].reg)));
  1021. end
  1022. end; { end with }
  1023. end;
  1024. Procedure ConcatOpCode(var instr: TInstruction);
  1025. {*********************************************************************}
  1026. { First Pass: }
  1027. { - If this is a three operand opcode: }
  1028. { imul,shld,and shrd -> check them manually. }
  1029. {*********************************************************************}
  1030. var
  1031. fits : boolean;
  1032. i: longint;
  1033. opsize: topsize;
  1034. optyp1, optyp2, optyp3: longint;
  1035. instruc: tasmop;
  1036. href : treference;
  1037. Begin
  1038. fits := FALSE;
  1039. for i:=1 to instr.numops do
  1040. Begin
  1041. case instr.operands[i].operandtype of
  1042. OPR_REGISTER: instr.operands[i].size :=
  1043. _regsizes[instr.operands[i].reg];
  1044. end; { end case }
  1045. end; { endif }
  1046. { setup specific instructions for first pass }
  1047. instruc := instr.getinstruction;
  1048. if (instruc in [A_LEA,A_LDS,A_LSS,A_LES,A_LFS,A_LGS]) then
  1049. Begin
  1050. if instr.operands[2].size <> S_L then
  1051. Begin
  1052. Message(assem_e_16bit_base_in_32bit_segment);
  1053. exit;
  1054. end; { endif }
  1055. end;
  1056. With instr do
  1057. Begin
  1058. for i:=1 to numops do
  1059. Begin
  1060. With operands[i] do
  1061. Begin
  1062. { check for 16-bit bases/indexes and emit an error. }
  1063. { we cannot only emit a warning since gas does not }
  1064. { accept 16-bit indexes and bases. }
  1065. if (operandtype = OPR_REFERENCE) and
  1066. ((ref.base <> R_NO) or
  1067. (ref.index <> R_NO)) then
  1068. Begin
  1069. { index or base defined. }
  1070. if (ref.base <> R_NO) then
  1071. Begin
  1072. if not (ref.base in
  1073. [R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESI,R_EDI,R_ESP]) then
  1074. Message(assem_e_16bit_base_in_32bit_segment);
  1075. end;
  1076. { index or base defined. }
  1077. if (ref.index <> R_NO) then
  1078. Begin
  1079. if not (ref.index in
  1080. [R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESI,R_EDI,R_ESP]) then
  1081. Message(assem_e_16bit_index_in_32bit_segment);
  1082. end;
  1083. end;
  1084. { Check for constants without bases/indexes in memory }
  1085. { references. }
  1086. if (operandtype = OPR_REFERENCE) and
  1087. (ref.base = R_NO) and
  1088. (ref.index = R_NO) and
  1089. (ref.symbol = nil) and
  1090. (ref.offset <> 0) then
  1091. Begin
  1092. ref.isintvalue := TRUE;
  1093. Message(assem_e_const_ref_not_allowed);
  1094. end;
  1095. opinfo := findtype(operands[i]);
  1096. end; { end with }
  1097. end; {endfor}
  1098. { TAKE CARE OF SPECIAL OPCODES, TAKE CARE OF THEM INDIVUALLY. }
  1099. { ALL THE REST ARE TAKEN CARE BY OPCODE TABLE AND THIRD PASS. }
  1100. { is this right for ratti386 ? (PM) }
  1101. { almost... here we check for the size of registers and references }
  1102. { to determine the correct gas opcode to use, because if the token }
  1103. { is A_MOVSX or A_MOVZX then that means that the person forgot to }
  1104. { specify the size.. }
  1105. { if memory size is not specified, will of course give out an error}
  1106. if instruc = A_MOVSX then
  1107. Begin
  1108. if numops = 2 then
  1109. begin
  1110. if stropsize = S_BL then
  1111. begin
  1112. operands[1].size := S_B;
  1113. stropsize := S_NO;
  1114. operands[2].size := S_L;
  1115. addinstr(A_MOVSBL)
  1116. end
  1117. else
  1118. if stropsize = S_WL then
  1119. begin
  1120. operands[1].size := S_W;
  1121. stropsize := S_NO;
  1122. operands[2].size := S_L;
  1123. addinstr(A_MOVSWL)
  1124. end
  1125. else
  1126. if stropsize = S_BW then
  1127. begin
  1128. operands[1].size := S_B;
  1129. stropsize := S_NO;
  1130. operands[2].size := S_W;
  1131. addinstr(A_MOVSBW)
  1132. end
  1133. else
  1134. if (operands[1].size = S_B) and (operands[2].size = S_W) then
  1135. addinstr(A_MOVSBW)
  1136. else
  1137. if (operands[1].size = S_B) and (operands[2].size = S_L) then
  1138. addinstr(A_MOVSBL)
  1139. else
  1140. if (operands[1].size = S_W) and (operands[2].size = S_L) then
  1141. addinstr(A_MOVSWL)
  1142. else
  1143. begin
  1144. Message(assem_e_invalid_size_movzx);
  1145. exit;
  1146. end;
  1147. instruc := getinstruction; { reload instruction }
  1148. end
  1149. else
  1150. begin
  1151. Message(assem_e_too_many_operands);
  1152. exit;
  1153. end;
  1154. end
  1155. else
  1156. if instruc = A_MOVZX then
  1157. Begin
  1158. if numops = 2 then
  1159. Begin
  1160. if stropsize = S_BW then
  1161. begin
  1162. operands[1].size := S_B;
  1163. stropsize := S_NO;
  1164. operands[2].size := S_W;
  1165. addinstr(A_MOVZB)
  1166. end
  1167. else
  1168. if stropsize = S_BL then
  1169. begin
  1170. operands[1].size := S_B;
  1171. stropsize := S_NO;
  1172. operands[2].size := S_L;
  1173. addinstr(A_MOVZB)
  1174. end
  1175. else
  1176. if stropsize = S_WL then
  1177. begin
  1178. operands[1].size := S_W;
  1179. stropsize := S_NO;
  1180. operands[2].size := S_L;
  1181. addinstr(A_MOVZWL)
  1182. end
  1183. else
  1184. { change the instruction to conform to GAS }
  1185. if (operands[1].size = S_B) and (operands[2].size in [S_W,S_L]) then
  1186. addinstr(A_MOVZB)
  1187. else
  1188. if (operands[1].size = S_W) and (operands[2].size = S_L) then
  1189. addinstr(A_MOVZWL)
  1190. else
  1191. begin
  1192. Message(assem_e_invalid_size_movzx);
  1193. exit;
  1194. end;
  1195. instruc := getinstruction; { reload instruction }
  1196. end
  1197. else
  1198. Begin
  1199. Message(assem_e_too_many_operands);
  1200. exit;
  1201. end;
  1202. end
  1203. else
  1204. if instruc = A_FWAIT then
  1205. FWaitWarning
  1206. else
  1207. if (instruc in [A_BT,A_BTC,A_BTR,A_BTS]) then
  1208. Begin
  1209. if numops = 2 then
  1210. Begin
  1211. if (operands[1].operandtype = OPR_CONSTANT)
  1212. and (operands[1].val <= $ff) then
  1213. Begin
  1214. operands[1].opinfo := ao_imm8;
  1215. { no operand size if using constant. }
  1216. operands[1].size := S_NO;
  1217. fits := TRUE;
  1218. end
  1219. end
  1220. else
  1221. Begin
  1222. Message(assem_e_invalid_opcode_and_operand);
  1223. exit;
  1224. end;
  1225. end
  1226. else
  1227. if instruc = A_ENTER then
  1228. Begin
  1229. if numops =2 then
  1230. Begin
  1231. if (operands[1].operandtype = OPR_CONSTANT) and
  1232. (operands[1].val <= $ffff) then
  1233. Begin
  1234. operands[1].opinfo := ao_imm16;
  1235. end { endif }
  1236. end { endif }
  1237. else
  1238. Begin
  1239. Message(assem_e_invalid_opcode_and_operand);
  1240. exit;
  1241. end
  1242. end { endif }
  1243. else
  1244. { Handle special opcodes for the opcode }
  1245. { table. Set them up correctly. }
  1246. if (instruc in [A_INS,A_IN]) then
  1247. Begin
  1248. if numops =2 then
  1249. Begin
  1250. if (operands[1].operandtype = OPR_REGISTER) and (operands[1].reg = R_DX)
  1251. then
  1252. Begin
  1253. operands[1].opinfo := ao_inoutportreg;
  1254. if (operands[2].operandtype = OPR_REGISTER) and
  1255. (operands[2].reg in [R_EAX,R_AX,R_AL]) and
  1256. (instruc = A_IN) then
  1257. Begin
  1258. operands[2].opinfo := ao_acc;
  1259. case operands[2].reg of
  1260. R_EAX: operands[2].size := S_L;
  1261. R_AX: operands[2].size := S_W;
  1262. R_AL: operands[2].size := S_B;
  1263. end;
  1264. end
  1265. end
  1266. else
  1267. if (operands[1].operandtype = OPR_CONSTANT) and (operands[1].val <= $ff)
  1268. and (instruc = A_IN) then
  1269. Begin
  1270. operands[1].opinfo := ao_imm8;
  1271. operands[1].size := S_B;
  1272. if (operands[2].operandtype = OPR_REGISTER) and
  1273. (operands[2].reg in [R_EAX,R_AX,R_AL]) and
  1274. (instruc = A_IN) then
  1275. Begin
  1276. operands[2].opinfo := ao_acc;
  1277. end
  1278. end;
  1279. end
  1280. else
  1281. Begin
  1282. Message(assem_e_invalid_opcode_and_operand);
  1283. exit;
  1284. end;
  1285. end
  1286. else
  1287. if (instruc in [A_OUTS,A_OUT]) then
  1288. Begin
  1289. if numops =2 then
  1290. Begin
  1291. if (operands[2].operandtype = OPR_REGISTER) and (operands[2].reg = R_DX)
  1292. then
  1293. Begin
  1294. operands[2].opinfo := ao_inoutportreg;
  1295. if (operands[1].operandtype = OPR_REGISTER) and
  1296. (operands[1].reg in [R_EAX,R_AX,R_AL]) and
  1297. (instruc = A_OUT) then
  1298. Begin
  1299. operands[1].opinfo := ao_acc;
  1300. fits := TRUE;
  1301. end
  1302. end
  1303. else
  1304. if (operands[2].operandtype = OPR_CONSTANT) and (operands[2].val <= $ff)
  1305. and (instruc = A_OUT) then
  1306. Begin
  1307. operands[2].opinfo := ao_imm8;
  1308. operands[2].size := S_B;
  1309. if (operands[1].operandtype = OPR_REGISTER) and
  1310. (operands[1].reg in [R_EAX,R_AX,R_AL]) and
  1311. (instruc = A_OUT) then
  1312. Begin
  1313. operands[1].opinfo := ao_acc;
  1314. fits := TRUE;
  1315. end
  1316. end;
  1317. end
  1318. else
  1319. Begin
  1320. Message(assem_e_invalid_opcode_and_operand);
  1321. exit;
  1322. end;
  1323. end
  1324. else
  1325. if instruc in [A_RCL,A_RCR,A_ROL,A_ROR,A_SAL,A_SAR,A_SHL,A_SHR] then
  1326. { if RCL,ROL,... }
  1327. Begin
  1328. if numops =2 then
  1329. Begin
  1330. if (operands[1].operandtype = OPR_REGISTER) and (operands[1].reg = R_CL)
  1331. then
  1332. Begin
  1333. operands[1].opinfo := ao_shiftcount
  1334. end
  1335. else
  1336. if (operands[1].operandtype = OPR_CONSTANT) and
  1337. (operands[1].val <= $ff) then
  1338. Begin
  1339. operands[1].opinfo := ao_imm8;
  1340. operands[1].size := S_B;
  1341. end;
  1342. end
  1343. else { if numops = 2 }
  1344. Begin
  1345. Message(assem_e_invalid_opcode_and_operand);
  1346. exit;
  1347. end;
  1348. end
  1349. { endif ROL,RCL ... }
  1350. else
  1351. { this did not work (PM) }
  1352. if instruc in [A_DIV, A_IDIV] then
  1353. Begin
  1354. if (operands[2].operandtype = OPR_REGISTER) and
  1355. (operands[2].reg in [R_AL,R_AX,R_EAX]) then
  1356. operands[2].opinfo := ao_acc;
  1357. end
  1358. else
  1359. if (instruc = A_FNSTSW) or (instruc = A_FSTSW) then
  1360. Begin
  1361. { %ax can be omitted in ATT syntax }
  1362. if numops = 0 then
  1363. Begin
  1364. numops:=1;
  1365. operands[1].operandtype:=OPR_REGISTER;
  1366. operands[1].reg:=R_AX;
  1367. operands[1].opinfo := ao_acc;
  1368. end
  1369. else if numops = 1 then
  1370. Begin
  1371. if (operands[1].operandtype = OPR_REGISTER) and
  1372. (operands[1].reg = R_AX) then
  1373. operands[1].opinfo := ao_acc;
  1374. end
  1375. else
  1376. Begin
  1377. Message(assem_e_invalid_opcode_and_operand);
  1378. exit;
  1379. end;
  1380. end
  1381. else
  1382. if (instruc = A_SHLD) or (instruc = A_SHRD) then
  1383. { these instruction are fully parsed individually on pass three }
  1384. { so we just do a summary checking here. }
  1385. Begin
  1386. if numops = 3 then
  1387. Begin
  1388. if (operands[3].operandtype = OPR_CONSTANT)
  1389. and (operands[3].val <= $ff) then
  1390. Begin
  1391. operands[3].opinfo := ao_imm8;
  1392. operands[3].size := S_B;
  1393. end;
  1394. end
  1395. else
  1396. Begin
  1397. Message(assem_e_invalid_opcode_and_operand);
  1398. exit;
  1399. end;
  1400. end
  1401. else
  1402. if instruc = A_INT then
  1403. Begin
  1404. if numops = 1 then
  1405. Begin
  1406. if (operands[1].operandtype = OPR_CONSTANT) and
  1407. (operands[1].val <= $ff) then
  1408. operands[1].opinfo := ao_imm8;
  1409. end
  1410. end
  1411. else
  1412. if instruc = A_RET then
  1413. Begin
  1414. if numops =1 then
  1415. Begin
  1416. if (operands[1].operandtype = OPR_CONSTANT) and
  1417. (operands[1].val <= $ffff) then
  1418. operands[1].opinfo := ao_imm16;
  1419. end
  1420. end; { endif }
  1421. { all string instructions have default memory }
  1422. { location which are ignored. Take care of }
  1423. { those. }
  1424. { Here could be added the code for segment }
  1425. { overrides. }
  1426. if instruc in [A_SCAS,A_CMPS,A_STOS,A_LODS] then
  1427. Begin
  1428. if numops =1 then
  1429. Begin
  1430. if (operands[1].operandtype = OPR_REFERENCE) and
  1431. (assigned(operands[1].ref.symbol)) then
  1432. Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
  1433. operands[1].operandtype := OPR_NONE;
  1434. numops := 0;
  1435. end;
  1436. end; { endif }
  1437. if instruc in [A_INS,A_MOVS,A_OUTS] then
  1438. Begin
  1439. if numops =2 then
  1440. Begin
  1441. if (operands[2].operandtype = OPR_REFERENCE) and
  1442. (assigned(operands[2].ref.symbol)) then
  1443. Freemem(operands[2].ref.symbol,length(operands[2].ref.symbol^)+1);
  1444. if (operands[1].operandtype = OPR_REFERENCE) and
  1445. (assigned(operands[1].ref.symbol)) then
  1446. Freemem(operands[1].ref.symbol,length(operands[2].ref.symbol^)+1);
  1447. operands[2].operandtype := OPR_NONE;
  1448. operands[1].operandtype := OPR_NONE;
  1449. numops := 0;
  1450. end;
  1451. end;
  1452. { handle parameter for segment overrides }
  1453. if instruc = A_XLAT then
  1454. Begin
  1455. { handle special TP syntax case for XLAT }
  1456. { here we accept XLAT, XLATB and XLAT m8 }
  1457. if (numops = 1) or (numops = 0) then
  1458. Begin
  1459. if (operands[1].operandtype = OPR_REFERENCE) and
  1460. (assigned(operands[1].ref.symbol)) then
  1461. Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
  1462. operands[1].operandtype := OPR_NONE;
  1463. numops := 0;
  1464. { always a byte for XLAT }
  1465. instr.stropsize := S_B;
  1466. end;
  1467. end
  1468. else
  1469. { ------------------------------------------------------------------- }
  1470. { ------------------------- SIZE CHECK ------------------------------ }
  1471. { ------------- presently done only for most used opcodes ---------- }
  1472. { Checks if the suffix concords with the destination size , if }
  1473. { not gives out an error. (This check is stricter then gas but is }
  1474. { REQUIRED for intasmi3) }
  1475. if instruc in [A_MOV,A_ADD,A_SUB,A_ADC,A_SBB,A_CMP,A_AND,A_OR,A_TEST,A_XOR] then
  1476. begin
  1477. if (instr.stropsize <> S_NO) and (instr.operands[2].size <> S_NO) then
  1478. if (instr.stropsize <> instr.operands[2].size) then
  1479. begin
  1480. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1481. exit;
  1482. end;
  1483. end
  1484. else
  1485. if instruc in [A_DEC,A_INC,A_NOT,A_NEG] then
  1486. begin
  1487. if (instr.stropsize <> S_NO) and (instr.operands[1].size <> S_NO) then
  1488. if (instr.stropsize <> instr.operands[1].size) then
  1489. begin
  1490. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1491. exit;
  1492. end;
  1493. end
  1494. else
  1495. if instruc = A_PUSH then
  1496. Begin
  1497. if (instr.operands[1].operandtype = OPR_CONSTANT) and
  1498. (instr.stropsize = S_NO) then
  1499. Message(assem_e_size_suffix_and_dest_reg_dont_match);
  1500. end;
  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) and
  1518. ((cs_compilesystem in aktmoduleswitches) or (aktoptprocessor=Class386)) then
  1519. begin
  1520. Message1(assem_w_opcode_not_in_table,att_op2str[instruc]);
  1521. fits:=true;
  1522. end
  1523. else while not(fits) do
  1524. begin
  1525. { set the instruction cache, if the instruction }
  1526. { occurs the first time }
  1527. if (it[i].i=instruc) and (ins_cache[instruc]=-1) then
  1528. ins_cache[instruc]:=i;
  1529. if (it[i].i=instruc) and (instr.numops=it[i].ops) then
  1530. begin
  1531. { first fit }
  1532. case instr.numops of
  1533. 0 : begin
  1534. fits:=true;
  1535. break;
  1536. end;
  1537. 1 :
  1538. Begin
  1539. if (optyp1 and it[i].o1)<>0 then
  1540. Begin
  1541. fits:=true;
  1542. break;
  1543. end;
  1544. { I consider sign-extended 8bit value to }
  1545. { be equal to immediate 8bit therefore }
  1546. { convert... }
  1547. if (optyp1 = ao_imm8) then
  1548. Begin
  1549. { check if this is a simple sign extend. }
  1550. if (it[i].o1<>ao_imm8s) then
  1551. Begin
  1552. fits:=true;
  1553. break;
  1554. end;
  1555. end;
  1556. end;
  1557. 2 : if ((optyp1 and it[i].o1)<>0) and
  1558. ((optyp2 and it[i].o2)<>0) then
  1559. Begin
  1560. fits:=true;
  1561. break;
  1562. end
  1563. { if the operands can be swaped }
  1564. { then swap them }
  1565. else if ((it[i].m and af_d)<>0) and
  1566. ((optyp1 and it[i].o2)<>0) and
  1567. ((optyp2 and it[i].o1)<>0) then
  1568. begin
  1569. fits:=true;
  1570. break;
  1571. end;
  1572. 3 : if ((optyp1 and it[i].o1)<>0) and
  1573. ((optyp2 and it[i].o2)<>0) and
  1574. ((optyp3 and it[i].o3)<>0) then
  1575. Begin
  1576. fits:=true;
  1577. break;
  1578. end;
  1579. end; { end case }
  1580. end; { endif }
  1581. if it[i].i=A_NONE then
  1582. begin
  1583. { NO MATCH! }
  1584. Message(assem_e_invalid_opcode_and_operand);
  1585. exit;
  1586. end;
  1587. inc(i);
  1588. end; { end while }
  1589. { We add the opcode to the opcode linked list }
  1590. if fits then
  1591. Begin
  1592. if instr.getprefix <> A_NONE then
  1593. Begin
  1594. p^.concat(new(pai386,op_none(instr.getprefix,S_NO)));
  1595. end;
  1596. { change from AT&T styled floating point to }
  1597. { intel styled floating point with valid size }
  1598. { we use these instructions so it does not }
  1599. { mess up intasmi3 }
  1600. if (instruc >= A_FILDQ) and (instruc <= A_FIDIVRS) then
  1601. Begin
  1602. instr.stropsize := _fpusizes[instruc];
  1603. instr.addinstr(_fpuopcodes[instruc]);
  1604. instruc := instr.getinstruction;
  1605. end;
  1606. case instr.numops of
  1607. 0:
  1608. if instr.stropsize <> S_NO then
  1609. { is this a string operation opcode or xlat then check }
  1610. { the size of the operation. }
  1611. p^.concat(new(pai386,op_none(instruc,instr.stropsize)))
  1612. else
  1613. p^.concat(new(pai386,op_none(instruc,S_NO)));
  1614. 1: Begin
  1615. case instr.operands[1].operandtype of
  1616. { GAS requires that the size be set in the case of a push }
  1617. { constant value, }
  1618. OPR_CONSTANT:
  1619. Begin
  1620. if instruc = A_PUSH then
  1621. Begin
  1622. if instr.stropsize <> S_NO then
  1623. p^.concat(new(pai386,op_const(instruc,
  1624. instr.stropsize, instr.operands[1].val)))
  1625. else
  1626. Message(assem_e_invalid_opcode_and_operand);
  1627. end
  1628. else
  1629. p^.concat(new(pai386,op_const(instruc,
  1630. S_NO, instr.operands[1].val)));
  1631. end;
  1632. OPR_REGISTER:
  1633. Begin
  1634. if (instr.stropsize<>S_NO) then
  1635. opsize:=instr.stropsize
  1636. else
  1637. opsize:=instr.operands[1].size;
  1638. p^.concat(new(pai386,op_reg(instruc,opsize,instr.operands[1].reg)));
  1639. End;
  1640. OPR_SYMBOL:
  1641. Begin
  1642. p^.concat(new(pai386,op_csymbol(instruc,
  1643. instr.stropsize, newcsymbol(instr.operands[1].symbol^,0))));
  1644. End;
  1645. OPR_REFERENCE:
  1646. { now first check suffix ... }
  1647. if instr.stropsize <> S_NO then
  1648. Begin
  1649. p^.concat(new(pai386,op_ref(instruc,
  1650. instr.stropsize,newreference(instr.operands[1].ref))));
  1651. end
  1652. { no suffix... therefore resort using intel styled checking .. }
  1653. else if (instr.operands[1].size <> S_NO) and NOT (instruc in [A_CALL,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. if (instruc in [A_CALL,A_JMP]) or
  1663. (instruc = A_FNSTCW) or
  1664. (instruc = A_FSTCW) or
  1665. (instruc = A_FLDCW) or
  1666. (instruc = A_FNSTSW) or
  1667. (instruc = A_FSTSW) or
  1668. (instruc = A_FLDENV) or
  1669. (instruc = A_FSTENV) or
  1670. (instruc = A_FNSAVE) or
  1671. (instruc = A_FSAVE) then
  1672. Begin
  1673. p^.concat(new(pai386,op_ref(instruc,
  1674. S_NO,newreference(instr.operands[1].ref))));
  1675. end
  1676. else
  1677. Message(assem_e_invalid_opcode_and_operand);
  1678. end;
  1679. { This either crashed the compiler or the symbol would always be nil! }
  1680. { The problem is here is I didn't see any way of adding the labeled }
  1681. { symbol in the internal list, since i think from what i see in aasm }
  1682. { that these will automatically be declared as external ?? }
  1683. { if (instruc in [A_JO,A_JNO,A_JB,A_JC,A_JNAE,
  1684. A_JNB,A_JNC,A_JAE,A_JE,A_JZ,A_JNE,A_JNZ,A_JBE,A_JNA,A_JNBE,
  1685. A_JA,A_JS,A_JNS,A_JP,A_JPE,A_JNP,A_JPO,A_JL,A_JNGE,A_JNL,A_JGE,
  1686. A_JLE,A_JNG,A_JNLE,A_JG,A_JCXZ,A_JECXZ,A_LOOP,A_LOOPZ,A_LOOPE,
  1687. A_LOOPNZ,A_LOOPNE,A_JMP,A_CALL]) then
  1688. Begin
  1689. if assigned(instr.operands[1].ref.symbol) then
  1690. p^.concat(new(pai386,op_csymbol(instruc,
  1691. S_NO,newcsymbol(instr.operands[1].ref.symbol^,instr.operands[1].ref.offset))))
  1692. else
  1693. Message(assem_e_invalid_opcode_and_operand);
  1694. end
  1695. else
  1696. else
  1697. Message(assem_e_invalid_opcode_and_operand);
  1698. end;}
  1699. OPR_NONE: Begin
  1700. Message(assem_f_internal_error_in_concatopcode);
  1701. end;
  1702. else
  1703. Begin
  1704. Message(assem_f_internal_error_in_concatopcode);
  1705. end;
  1706. end;
  1707. end;
  1708. 2:
  1709. Begin
  1710. if instruc in [A_MOVSX,A_MOVZX,A_MOVSB,A_MOVSBL,A_MOVSBW,
  1711. A_MOVSWL,A_MOVZB,A_MOVZWL] then
  1712. { movzx and movsx }
  1713. HandleExtend(instr)
  1714. else
  1715. { other instructions }
  1716. Begin
  1717. With instr do
  1718. Begin
  1719. { source }
  1720. opsize := operands[1].size;
  1721. case operands[1].operandtype of
  1722. { reg,reg }
  1723. { reg,ref }
  1724. { const,reg -- IN/OUT }
  1725. OPR_REGISTER:
  1726. Begin
  1727. case operands[2].operandtype of
  1728. OPR_REGISTER:
  1729. { correction: according to the DJGPP FAQ, gas }
  1730. { doesn't even check correctly the size of }
  1731. { operands, therefore let us specify a size! }
  1732. { as in the GAS docs... destination tells us }
  1733. { the size! This might give out invalid output }
  1734. { in some very rare cases (because the size }
  1735. { checking is still not perfect). }
  1736. if (opsize = operands[2].size) then
  1737. begin
  1738. p^.concat(new(pai386,op_reg_reg(instruc,
  1739. opsize,operands[1].reg,operands[2].reg)));
  1740. end
  1741. else
  1742. if instruc = A_IN then
  1743. p^.concat(new(pai386,op_reg_reg(instruc,
  1744. operands[2].size,operands[1].reg,operands[2].reg)))
  1745. else
  1746. if instruc = A_OUT then
  1747. p^.concat(new(pai386,op_reg_reg(instruc,
  1748. operands[1].size,operands[1].reg,operands[2].reg)))
  1749. else
  1750. { these do not require any size specification. }
  1751. if (instruc in [A_SAL,A_SAR,A_SHL,A_SHR,A_ROL,
  1752. A_ROR,A_RCR,A_RCL]) then
  1753. { outs and ins are already taken care by }
  1754. { the first pass. }
  1755. p^.concat(new(pai386,op_reg_reg(instruc,
  1756. S_NO,operands[1].reg,operands[2].reg)))
  1757. else
  1758. if stropsize <> S_NO then
  1759. Begin
  1760. p^.concat(new(pai386,op_reg_reg(instruc,
  1761. stropsize,operands[1].reg,operands[2].reg)))
  1762. end
  1763. else
  1764. Begin
  1765. Message(assem_e_invalid_opcode_and_operand);
  1766. end;
  1767. OPR_REFERENCE:
  1768. { variable name. }
  1769. { here we must check the instruction type }
  1770. { before deciding if to use and compare }
  1771. { any sizes. }
  1772. if assigned(operands[2].ref.symbol) then
  1773. Begin
  1774. if stropsize <> S_NO then
  1775. Begin
  1776. p^.concat(new(pai386,op_reg_ref(instruc,
  1777. stropsize,operands[1].reg,newreference(operands[2].ref))))
  1778. end
  1779. else
  1780. if (opsize = operands[2].size) or (instruc in
  1781. [A_RCL,A_RCR,A_ROL,A_ROR,A_SAL,A_SAR,A_SHR,A_SHL]) then
  1782. p^.concat(new(pai386,op_reg_ref(instruc,
  1783. opsize,operands[1].reg,newreference(operands[2].ref))))
  1784. else
  1785. Message(assem_e_invalid_size_in_ref);
  1786. end
  1787. else
  1788. Begin
  1789. { register reference }
  1790. if stropsize <> S_NO then
  1791. Begin
  1792. p^.concat(new(pai386,op_reg_ref(instruc,
  1793. stropsize,operands[1].reg,newreference(operands[2].ref))))
  1794. end
  1795. else
  1796. if (opsize = operands[2].size) or (operands[2].size = S_NO) then
  1797. p^.concat(new(pai386,op_reg_ref(instruc,
  1798. opsize,operands[1].reg,newreference(operands[2].ref))))
  1799. else
  1800. Message(assem_e_invalid_size_in_ref);
  1801. end;
  1802. OPR_CONSTANT: { OUT }
  1803. begin
  1804. { determine first with suffix }
  1805. if instruc = A_OUT then
  1806. begin
  1807. if instr.stropsize <> S_NO then
  1808. p^.concat(new(pai386,op_reg_const(instruc,stropsize,
  1809. instr.operands[1].reg, instr.operands[2].val)))
  1810. else
  1811. p^.concat(new(pai386,op_reg_const(instruc,S_NO,
  1812. instr.operands[1].reg, instr.operands[2].val)));
  1813. end
  1814. else
  1815. Message(assem_e_invalid_opcode);
  1816. end;
  1817. else { else case }
  1818. Begin
  1819. Message(assem_f_internal_error_in_concatopcode);
  1820. end;
  1821. end; { end inner case }
  1822. end;
  1823. { const,reg }
  1824. { const,const }
  1825. { const,ref }
  1826. OPR_CONSTANT:
  1827. case instr.operands[2].operandtype of
  1828. { constant, constant does not have a specific size. }
  1829. OPR_CONSTANT:
  1830. p^.concat(new(pai386,op_const_const(instruc,
  1831. S_NO,operands[1].val,operands[2].val)));
  1832. OPR_REFERENCE:
  1833. Begin
  1834. { check for suffix first ... }
  1835. if (instr.stropsize <> S_NO) then
  1836. Begin
  1837. p^.concat(new(pai386,op_const_ref(instruc,
  1838. stropsize,operands[1].val,
  1839. newreference(operands[2].ref))))
  1840. end
  1841. else
  1842. { resort to intel styled checking ... }
  1843. if (operands[1].val <= $ff) and
  1844. (operands[2].size in [S_B,S_W,S_L]) then
  1845. p^.concat(new(pai386,op_const_ref(instruc,
  1846. operands[2].size,operands[1].val,
  1847. newreference(operands[2].ref))))
  1848. else
  1849. if (operands[1].val <= $ffff) and
  1850. (operands[2].size in [S_W,S_L]) then
  1851. p^.concat(new(pai386,op_const_ref(instruc,
  1852. operands[2].size,operands[1].val,
  1853. newreference(operands[2].ref))))
  1854. else
  1855. if (operands[1].val <= $7fffffff) and
  1856. (operands[2].size in [S_L]) then
  1857. p^.concat(new(pai386,op_const_ref(instruc,
  1858. operands[2].size,operands[1].val,
  1859. newreference(operands[2].ref))))
  1860. else
  1861. Message(assem_e_invalid_size_in_ref);
  1862. end;
  1863. OPR_REGISTER:
  1864. Begin
  1865. { size of opcode determined by register }
  1866. if (operands[1].val <= $ff) and
  1867. (operands[2].size in [S_B,S_W,S_L]) then
  1868. p^.concat(new(pai386,op_const_reg(instruc,
  1869. operands[2].size,operands[1].val,
  1870. operands[2].reg)))
  1871. else
  1872. if (operands[1].val <= $ffff) and
  1873. (operands[2].size in [S_W,S_L]) then
  1874. p^.concat(new(pai386,op_const_reg(instruc,
  1875. operands[2].size,operands[1].val,
  1876. operands[2].reg)))
  1877. else
  1878. if (operands[1].val <= $7fffffff) and
  1879. (operands[2].size in [S_L]) then
  1880. p^.concat(new(pai386,op_const_reg(instruc,
  1881. operands[2].size,operands[1].val,
  1882. operands[2].reg)))
  1883. else
  1884. Message(assem_e_invalid_opcode_size);
  1885. end;
  1886. else
  1887. Begin
  1888. Message(assem_f_internal_error_in_concatopcode);
  1889. end;
  1890. end; { end case }
  1891. { sym,reg }
  1892. OPR_SYMBOL:
  1893. case instr.operands[2].operandtype of
  1894. OPR_REGISTER:
  1895. Begin
  1896. if instruc in [A_LDS,A_LES,A_LFS,A_LGS,A_LSS] then
  1897. opsize:=S_NO
  1898. else
  1899. if stropsize<>S_NO then
  1900. opsize:=stropsize
  1901. else
  1902. if (opsize<>operands[2].size) then
  1903. Message(assem_e_invalid_opcode_and_operand);
  1904. { create an temporary reference }
  1905. reset_reference(href);
  1906. href.symbol:=stringdup(instr.operands[1].symbol^);
  1907. p^.concat(new(pai386,op_ref_reg(instruc,opsize,
  1908. newreference(href),operands[2].reg)));
  1909. clear_reference(href);
  1910. end;
  1911. else
  1912. Begin
  1913. Message(assem_f_internal_error_in_concatopcode);
  1914. end;
  1915. end; { end inner case }
  1916. { ref,reg }
  1917. { ref,ref }
  1918. OPR_REFERENCE:
  1919. case instr.operands[2].operandtype of
  1920. OPR_REGISTER:
  1921. if assigned(operands[1].ref.symbol) then
  1922. { global variable }
  1923. Begin
  1924. if instruc in [A_LDS,A_LES,A_LFS,A_LGS,A_LSS] then
  1925. opsize:=S_NO
  1926. else
  1927. if stropsize<>S_NO then
  1928. opsize:=stropsize
  1929. else
  1930. if (opsize<>operands[2].size) then
  1931. Message(assem_e_invalid_opcode_and_operand);
  1932. p^.concat(new(pai386,op_ref_reg(instruc,
  1933. opsize,newreference(operands[1].ref),operands[2].reg)));
  1934. end
  1935. else
  1936. Begin
  1937. { register reference }
  1938. { possiblities:1) local variable which }
  1939. { has been replaced by bp and offset }
  1940. { in this case size should be valid }
  1941. { 2) Indirect register }
  1942. { adressing, 2nd operand determines }
  1943. { size. }
  1944. if (stropsize <> S_NO) then
  1945. Begin
  1946. p^.concat(new(pai386,op_ref_reg(instruc,
  1947. stropsize,newreference(operands[1].ref),
  1948. operands[2].reg)))
  1949. end
  1950. else
  1951. if (opsize = operands[2].size) or (opsize = S_NO) then
  1952. Begin
  1953. p^.concat(new(pai386,op_ref_reg(instruc,
  1954. operands[2].size,newreference(operands[1].ref),
  1955. operands[2].reg)));
  1956. end
  1957. else
  1958. Message(assem_e_invalid_size_in_ref);
  1959. end;
  1960. OPR_REFERENCE: { special opcodes }
  1961. p^.concat(new(pai386,op_ref_ref(instruc,
  1962. opsize,newreference(operands[1].ref),
  1963. newreference(operands[2].ref))));
  1964. else
  1965. Begin
  1966. Message(assem_f_internal_error_in_concatopcode);
  1967. end;
  1968. end; { end inner case }
  1969. end; { end case }
  1970. end; { end with }
  1971. end; {end if movsx... }
  1972. end;
  1973. 3: Begin
  1974. { only imul, shld and shrd }
  1975. { middle must be a register }
  1976. if (instruc in [A_SHLD,A_SHRD]) and (instr.operands[2].operandtype =
  1977. OPR_REGISTER) then
  1978. Begin
  1979. case instr.operands[2].size of
  1980. S_W: if instr.operands[1].operandtype = OPR_CONSTANT then
  1981. Begin
  1982. if instr.operands[1].val <= $ff then
  1983. Begin
  1984. if instr.operands[3].size in [S_W] then
  1985. Begin
  1986. case instr.operands[3].operandtype of
  1987. OPR_REFERENCE: { MISSING !!!! } ;
  1988. OPR_REGISTER: p^.concat(new(pai386,
  1989. op_const_reg_reg(instruc, S_W,
  1990. instr.operands[1].val, instr.operands[2].reg,
  1991. instr.operands[3].reg)));
  1992. else
  1993. Message(assem_e_invalid_opcode_and_operand);
  1994. end;
  1995. end
  1996. else
  1997. Message(assem_e_invalid_opcode_and_operand);
  1998. end;
  1999. end
  2000. else
  2001. Message(assem_e_invalid_opcode_and_operand);
  2002. S_L: if instr.operands[1].operandtype = OPR_CONSTANT then
  2003. Begin
  2004. if instr.operands[1].val <= $ff then
  2005. Begin
  2006. if instr.operands[3].size in [S_L] then
  2007. Begin
  2008. case instr.operands[3].operandtype of
  2009. OPR_REFERENCE: { MISSING !!!! } ;
  2010. OPR_REGISTER: p^.concat(new(pai386,
  2011. op_const_reg_reg(instruc, S_L,
  2012. instr.operands[1].val, instr.operands[2].reg,
  2013. instr.operands[3].reg)));
  2014. else
  2015. Message(assem_e_invalid_opcode_and_operand);
  2016. end;
  2017. end
  2018. else
  2019. Message(assem_e_invalid_opcode_and_operand);
  2020. end;
  2021. end
  2022. else
  2023. Message(assem_e_invalid_opcode_and_operand);
  2024. else
  2025. Message(assem_e_invalid_opcode_and_operand);
  2026. end; { end case }
  2027. end
  2028. else
  2029. if (instruc in [A_IMUL]) and (instr.operands[3].operandtype
  2030. = OPR_REGISTER) then
  2031. Begin
  2032. case instr.operands[3].size of
  2033. S_W: if instr.operands[1].operandtype = OPR_CONSTANT then
  2034. Begin
  2035. if instr.operands[1].val <= $ffff then
  2036. Begin
  2037. if instr.operands[2].size in [S_W] then
  2038. Begin
  2039. case instr.operands[2].operandtype of
  2040. OPR_REFERENCE: { MISSING !!!! } ;
  2041. OPR_REGISTER: p^.concat(new(pai386,
  2042. op_const_reg_reg(instruc, S_W,
  2043. instr.operands[1].val, instr.operands[2].reg,
  2044. instr.operands[3].reg)));
  2045. else
  2046. Message(assem_e_invalid_opcode_and_operand);
  2047. end; { end case }
  2048. end
  2049. else
  2050. Message(assem_e_invalid_opcode_and_operand);
  2051. end;
  2052. end
  2053. else
  2054. Message(assem_e_invalid_opcode_and_operand);
  2055. S_L: if instr.operands[1].operandtype = OPR_CONSTANT then
  2056. Begin
  2057. if instr.operands[1].val <= $7fffffff then
  2058. Begin
  2059. if instr.operands[2].size in [S_L] then
  2060. Begin
  2061. case instr.operands[2].operandtype of
  2062. OPR_REFERENCE: { MISSING !!!! } ;
  2063. OPR_REGISTER: p^.concat(new(pai386,
  2064. op_const_reg_reg(instruc, S_L,
  2065. instr.operands[1].val, instr.operands[2].reg,
  2066. instr.operands[3].reg)));
  2067. else
  2068. Message(assem_e_invalid_opcode_and_operand);
  2069. end; { end case }
  2070. end
  2071. else
  2072. Message(assem_e_invalid_opcode_and_operand);
  2073. end;
  2074. end
  2075. else
  2076. Message(assem_e_invalid_opcode_and_operand);
  2077. else
  2078. Message(assem_e_invalid_middle_sized_operand);
  2079. end; { end case }
  2080. end { endif }
  2081. else
  2082. Message(assem_e_invalid_three_operand_opcode);
  2083. end;
  2084. end; { end case }
  2085. end;
  2086. end;
  2087. Procedure ConcatLabeledInstr(var instr: TInstruction);
  2088. Var instruct : tasmop;
  2089. i : longint;
  2090. Begin
  2091. instruct:=instr.getinstruction;
  2092. if (instruct in [A_JO,A_JNO,A_JB,A_JC,A_JNAE,
  2093. A_JNB,A_JNC,A_JAE,A_JE,A_JZ,A_JNE,A_JNZ,A_JBE,A_JNA,A_JNBE,
  2094. A_JA,A_JS,A_JNS,A_JP,A_JPE,A_JNP,A_JPO,A_JL,A_JNGE,A_JNL,A_JGE,
  2095. A_JLE,A_JNG,A_JNLE,A_JG,A_JCXZ,A_JECXZ,A_LOOP,A_LOOPZ,A_LOOPE,
  2096. A_LOOPNZ,A_LOOPNE,A_MOV,A_JMP,A_CALL]) then
  2097. Begin
  2098. if (instr.numops <> 1) then
  2099. Message(assem_e_invalid_labeled_opcode)
  2100. else if instr.operands[1].operandtype <> OPR_LABINSTR then
  2101. Message(assem_e_invalid_labeled_opcode)
  2102. else if assigned(instr.operands[1].hl) then
  2103. ConcatLabel(p,instruct, instr.operands[1].hl)
  2104. else
  2105. Begin
  2106. Message(assem_f_internal_error_in_concatlabeledinstr);
  2107. end;
  2108. end
  2109. else
  2110. if (cs_compilesystem in aktmoduleswitches) then
  2111. begin
  2112. for i:=1 to instr.numops do
  2113. if instr.operands[i].operandtype=OPR_LABINSTR then
  2114. begin
  2115. instr.operands[i].operandtype:=OPR_REFERENCE;
  2116. instr.operands[i].ref.symbol:=newpasstr(lab2str(instr.operands[i].hl) );
  2117. instr.operands[i].opinfo:=ao_mem;
  2118. instr.operands[i].ref.base:=R_NO;
  2119. instr.operands[i].ref.index:=R_NO;
  2120. instr.operands[i].ref.segment:=R_DEFAULT_SEG;
  2121. instr.operands[i].ref.offset:=0;
  2122. end;
  2123. { handle now as an ordinary opcode }
  2124. concatopcode(instr);
  2125. end
  2126. else
  2127. Message1(assem_e_invalid_operand,'');
  2128. end;
  2129. {---------------------------------------------------------------------}
  2130. { Routines for the parsing }
  2131. {---------------------------------------------------------------------}
  2132. procedure consume(t : tinteltoken);
  2133. begin
  2134. if t<>actasmtoken then
  2135. Message(assem_e_syntax_error);
  2136. actasmtoken:=gettoken;
  2137. { if the token must be ignored, then }
  2138. { get another token to parse. }
  2139. if actasmtoken = AS_NONE then
  2140. actasmtoken := gettoken;
  2141. end;
  2142. function findregister(const s : string): tregister;
  2143. {*********************************************************************}
  2144. { FUNCTION findregister(s: string):tasmop; }
  2145. { Description: Determines if the s string is a valid register, }
  2146. { if so returns correct tregister token, or R_NO if not found. }
  2147. {*********************************************************************}
  2148. var
  2149. i: tregister;
  2150. begin
  2151. findregister := R_NO;
  2152. for i:=firstreg to lastreg do
  2153. if s = iasmregs[i] then
  2154. Begin
  2155. findregister := i;
  2156. exit;
  2157. end;
  2158. end;
  2159. function findprefix(const s: string; var token: tasmop): boolean;
  2160. var i: byte;
  2161. Begin
  2162. findprefix := FALSE;
  2163. for i:=0 to _count_asmprefixes do
  2164. Begin
  2165. if s = _asmprefixes[i] then
  2166. begin
  2167. token := _prefixtokens[i];
  2168. findprefix := TRUE;
  2169. exit;
  2170. end;
  2171. end;
  2172. end;
  2173. function findsegment(const s:string): tregister;
  2174. {*********************************************************************}
  2175. { FUNCTION findsegment(s: string):tasmop; }
  2176. { Description: Determines if the s string is a valid segment register}
  2177. { if so returns correct tregister token, or R_NO if not found. }
  2178. {*********************************************************************}
  2179. var
  2180. i: tregister;
  2181. Begin
  2182. findsegment := R_DEFAULT_SEG;
  2183. for i:=firstsreg to lastsreg do
  2184. if s = iasmregs[i] then
  2185. Begin
  2186. findsegment := i;
  2187. exit;
  2188. end;
  2189. end;
  2190. function findopcode(const s: string): tasmop;
  2191. {*********************************************************************}
  2192. { FUNCTION findopcode(s: string): tasmop; }
  2193. { Description: Determines if the s string is a valid opcode }
  2194. { if so returns correct tasmop token. }
  2195. {*********************************************************************}
  2196. var
  2197. i: tasmop;
  2198. j: byte;
  2199. hs: topsize;
  2200. hid: string;
  2201. Begin
  2202. findopcode := A_NONE;
  2203. { first search for extended opcodes }
  2204. { now, in this case, we must use the suffix }
  2205. { to determine the size of the instruction }
  2206. for j:=0 to _count_asmspecialops do
  2207. Begin
  2208. if s = _specialops[j] then
  2209. Begin
  2210. findopcode := _specialopstokens[j];
  2211. { set the size }
  2212. case s[length(s)] of
  2213. 'B': instr.stropsize := S_B;
  2214. 'L': instr.stropsize := S_L;
  2215. 'W': instr.stropsize := S_W;
  2216. end;
  2217. exit;
  2218. end;
  2219. end;
  2220. for i:=firstop to lastop do
  2221. Begin
  2222. if s=iasmops^[i] then
  2223. begin
  2224. findopcode := i;
  2225. instr.stropsize := S_NO;
  2226. exit;
  2227. end;
  2228. end;
  2229. { not found yet ... }
  2230. { search for all possible suffixes }
  2231. for hs:=S_WL downto S_B do
  2232. if copy(s,length(s)-length(att_opsize2str[hs])+1,
  2233. length(att_opsize2str[hs]))=upper(att_opsize2str[hs]) then
  2234. begin
  2235. hid:=copy(s,1,length(s)-length(att_opsize2str[hs]));
  2236. for i:=firstop to lastop do
  2237. if (length(hid) > 0) and (hid=iasmops^[i]) then
  2238. begin
  2239. findopcode := i;
  2240. instr.stropsize := hs;
  2241. exit;
  2242. end;
  2243. end;
  2244. end;
  2245. Function CheckPrefix(prefix: tasmop; opcode:tasmop): Boolean;
  2246. { Checks if the prefix is valid with the following instruction }
  2247. { return false if not, otherwise true }
  2248. Begin
  2249. CheckPrefix := TRUE;
  2250. Case prefix of
  2251. A_REP,A_REPNE,A_REPE: if not (opcode in [A_SCAS,A_INS,A_OUTS,A_MOVS,
  2252. A_CMPS,A_LODS,A_STOS]) then
  2253. Begin
  2254. CheckPrefix := FALSE;
  2255. exit;
  2256. end;
  2257. A_LOCK: if not (opcode in [A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,
  2258. A_ADC,A_SBB,A_AND,A_SUB,A_XOR,A_NOT,A_NEG,A_INC,A_DEC]) then
  2259. Begin
  2260. CheckPrefix := FALSE;
  2261. Exit;
  2262. end;
  2263. A_NONE: exit; { no prefix here }
  2264. else
  2265. CheckPrefix := FALSE;
  2266. end; { end case }
  2267. end;
  2268. Procedure InitAsmRef(var instr: TInstruction);
  2269. {*********************************************************************}
  2270. { Description: This routine first check if the instruction is of }
  2271. { type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. }
  2272. { If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up }
  2273. { the operand type to OPR_REFERENCE, as well as setting up the ref }
  2274. { to point to the default segment. }
  2275. {*********************************************************************}
  2276. Begin
  2277. With instr do
  2278. Begin
  2279. case operands[operandnum].operandtype of
  2280. OPR_REFERENCE: exit;
  2281. OPR_NONE: ;
  2282. else
  2283. Message(assem_e_invalid_operand_type);
  2284. end;
  2285. operands[operandnum].operandtype := OPR_REFERENCE;
  2286. operands[operandnum].ref.segment := R_DEFAULT_SEG;
  2287. end;
  2288. end;
  2289. Function CheckOverride(segreg: tregister; var instr: TInstruction): Boolean;
  2290. { Check if the override is valid, and if so then }
  2291. { update the instr variable accordingly. }
  2292. Begin
  2293. CheckOverride := FALSE;
  2294. if instr.getinstruction in [A_MOVS,A_XLAT,A_CMPS] then
  2295. Begin
  2296. CheckOverride := TRUE;
  2297. Message(assem_e_segment_override_not_supported);
  2298. end
  2299. end;
  2300. Function CalculateExpression(expression: string): longint;
  2301. var
  2302. expr: TExprParse;
  2303. Begin
  2304. expr.Init;
  2305. CalculateExpression := expr.Evaluate(expression);
  2306. expr.Done;
  2307. end;
  2308. Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
  2309. {*********************************************************************}
  2310. { PROCEDURE GetRecordOffsetSize }
  2311. { Description: This routine builds up a record offset after a AS_DOT }
  2312. { token is encountered. }
  2313. { On entry actasmtoken should be equal to AS_DOT }
  2314. {*********************************************************************}
  2315. { EXIT CONDITION: On exit the routine should point to either the }
  2316. { AS_COMMA or AS_SEPARATOR token. }
  2317. { Warning: This is called recursively. }
  2318. {*********************************************************************}
  2319. var
  2320. toffset,tsize : longint;
  2321. Begin
  2322. offset:=0;
  2323. size:=0;
  2324. Consume(AS_DOT);
  2325. if actasmtoken = AS_ID then
  2326. Begin
  2327. if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
  2328. not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
  2329. begin
  2330. Message(assem_e_syntax_error);
  2331. toffset:=0;
  2332. tsize:=0;
  2333. end;
  2334. inc(offset,toffset);
  2335. size:=tsize;
  2336. Consume(AS_ID);
  2337. case actasmtoken of
  2338. AS_SEPARATOR,
  2339. AS_COMMA : exit;
  2340. AS_DOT : begin
  2341. GetRecordOffsetSize(expr,toffset,tsize);
  2342. inc(offset,toffset);
  2343. size:=tsize;
  2344. end;
  2345. else
  2346. Begin
  2347. Message(assem_e_syntax_error);
  2348. repeat
  2349. consume(actasmtoken)
  2350. until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
  2351. exit;
  2352. end;
  2353. end;
  2354. end
  2355. else
  2356. Begin
  2357. Message(assem_e_syntax_error);
  2358. repeat
  2359. consume(actasmtoken)
  2360. until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
  2361. end;
  2362. end;
  2363. Function BuildExpression: longint;
  2364. {*********************************************************************}
  2365. { FUNCTION BuildExpression: longint }
  2366. { Description: This routine calculates a constant expression to }
  2367. { a given value. The return value is the value calculated from }
  2368. { the expression. }
  2369. { The following tokens (not strings) are recognized: }
  2370. { (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  2371. {*********************************************************************}
  2372. { ENTRY: On entry the token should be any valid expression token. }
  2373. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  2374. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2375. { invalid tokens. }
  2376. {*********************************************************************}
  2377. var expr: string;
  2378. tempstr: string;
  2379. l,k : longint;
  2380. errorflag: boolean;
  2381. Begin
  2382. errorflag := FALSE;
  2383. expr := '';
  2384. tempstr := '';
  2385. Repeat
  2386. Case actasmtoken of
  2387. AS_LPAREN: Begin
  2388. Consume(AS_LPAREN);
  2389. expr := expr + '(';
  2390. end;
  2391. AS_RPAREN: Begin
  2392. Consume(AS_RPAREN);
  2393. expr := expr + ')';
  2394. end;
  2395. AS_SHL: Begin
  2396. Consume(AS_SHL);
  2397. expr := expr + '<';
  2398. end;
  2399. AS_SHR: Begin
  2400. Consume(AS_SHR);
  2401. expr := expr + '>';
  2402. end;
  2403. AS_SLASH: Begin
  2404. Consume(AS_SLASH);
  2405. expr := expr + '/';
  2406. end;
  2407. AS_MOD: Begin
  2408. Consume(AS_MOD);
  2409. expr := expr + '%';
  2410. end;
  2411. AS_STAR: Begin
  2412. Consume(AS_STAR);
  2413. expr := expr + '*';
  2414. end;
  2415. AS_PLUS: Begin
  2416. Consume(AS_PLUS);
  2417. expr := expr + '+';
  2418. end;
  2419. AS_MINUS: Begin
  2420. Consume(AS_MINUS);
  2421. expr := expr + '-';
  2422. end;
  2423. AS_AND: Begin
  2424. Consume(AS_AND);
  2425. expr := expr + '&';
  2426. end;
  2427. AS_NOT: Begin
  2428. Consume(AS_NOT);
  2429. expr := expr + '~';
  2430. end;
  2431. AS_XOR: Begin
  2432. Consume(AS_XOR);
  2433. expr := expr + '^';
  2434. end;
  2435. AS_OR: Begin
  2436. Consume(AS_OR);
  2437. expr := expr + '|';
  2438. end;
  2439. AS_ID: Begin
  2440. tempstr:=actasmpattern;
  2441. previous_was_id:=TRUE;
  2442. consume(AS_ID);
  2443. if actasmtoken=AS_DOT then
  2444. begin
  2445. GetRecordOffsetSize(tempstr,l,k);
  2446. str(l, tempstr);
  2447. expr := expr + tempstr;
  2448. end
  2449. else
  2450. begin
  2451. if SearchIConstant(actasmpattern,l) then
  2452. begin
  2453. str(l, tempstr);
  2454. expr := expr + tempstr;
  2455. end
  2456. else
  2457. Message1(assem_e_invalid_const_symbol,actasmpattern);
  2458. end;
  2459. end;
  2460. AS_INTNUM: Begin
  2461. expr := expr + actasmpattern;
  2462. Consume(AS_INTNUM);
  2463. end;
  2464. AS_BINNUM: Begin
  2465. tempstr := BinaryToDec(actasmpattern);
  2466. if tempstr = '' then
  2467. Message(assem_f_error_converting_bin);
  2468. expr:=expr+tempstr;
  2469. Consume(AS_BINNUM);
  2470. end;
  2471. AS_HEXNUM: Begin
  2472. tempstr := HexToDec(actasmpattern);
  2473. if tempstr = '' then
  2474. Message(assem_f_error_converting_hex);
  2475. expr:=expr+tempstr;
  2476. Consume(AS_HEXNUM);
  2477. end;
  2478. AS_OCTALNUM: Begin
  2479. tempstr := OctalToDec(actasmpattern);
  2480. if tempstr = '' then
  2481. Message(assem_f_error_converting_octal);
  2482. expr:=expr+tempstr;
  2483. Consume(AS_OCTALNUM);
  2484. end;
  2485. { go to next term }
  2486. AS_COMMA: Begin
  2487. if not ErrorFlag then
  2488. BuildExpression := CalculateExpression(expr)
  2489. else
  2490. BuildExpression := 0;
  2491. Exit;
  2492. end;
  2493. { go to next symbol }
  2494. AS_SEPARATOR: Begin
  2495. if not ErrorFlag then
  2496. BuildExpression := CalculateExpression(expr)
  2497. else
  2498. BuildExpression := 0;
  2499. Exit;
  2500. end;
  2501. else
  2502. Begin
  2503. { only write error once. }
  2504. if not errorflag then
  2505. Message(assem_e_invalid_constant_expression);
  2506. { consume tokens until we find COMMA or SEPARATOR }
  2507. Consume(actasmtoken);
  2508. errorflag := TRUE;
  2509. End;
  2510. end;
  2511. Until false;
  2512. end;
  2513. Procedure BuildRealConstant(typ : tfloattype);
  2514. {*********************************************************************}
  2515. { PROCEDURE BuilRealConst }
  2516. { Description: This routine calculates a constant expression to }
  2517. { a given value. The return value is the value calculated from }
  2518. { the expression. }
  2519. { The following tokens (not strings) are recognized: }
  2520. { +/-,numbers and real numbers }
  2521. {*********************************************************************}
  2522. { ENTRY: On entry the token should be any valid expression token. }
  2523. { EXIT: On Exit the token points to either COMMA or SEPARATOR }
  2524. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2525. { invalid tokens. }
  2526. {*********************************************************************}
  2527. var expr: string;
  2528. tempstr: string;
  2529. r : bestreal;
  2530. code : word;
  2531. negativ : boolean;
  2532. errorflag: boolean;
  2533. Begin
  2534. errorflag := FALSE;
  2535. Repeat
  2536. negativ:=false;
  2537. expr := '';
  2538. tempstr := '';
  2539. if actasmtoken=AS_PLUS then Consume(AS_PLUS)
  2540. else if actasmtoken=AS_MINUS then
  2541. begin
  2542. negativ:=true;
  2543. consume(AS_MINUS);
  2544. end;
  2545. Case actasmtoken of
  2546. AS_INTNUM: Begin
  2547. expr := actasmpattern;
  2548. Consume(AS_INTNUM);
  2549. end;
  2550. AS_REALNUM: Begin
  2551. expr := actasmpattern;
  2552. { in ATT syntax you have 0d in front of the real }
  2553. { should this be forced ? yes i think so, as to }
  2554. { conform to gas as much as possible. }
  2555. if (expr[1]='0') and (upper(expr[2])='D') then
  2556. expr:=copy(expr,3,255);
  2557. Consume(AS_REALNUM);
  2558. end;
  2559. AS_BINNUM: Begin
  2560. { checking for real constants with this should use }
  2561. { real DECODING otherwise the compiler will crash! }
  2562. Message(assem_w_float_bin_ignored);
  2563. Consume(AS_BINNUM);
  2564. end;
  2565. AS_HEXNUM: Begin
  2566. { checking for real constants with this should use }
  2567. { real DECODING otherwise the compiler will crash! }
  2568. Message(assem_w_float_hex_ignored);
  2569. Consume(AS_HEXNUM);
  2570. end;
  2571. AS_OCTALNUM: Begin
  2572. { checking for real constants with this should use }
  2573. { real DECODING otherwise the compiler will crash! }
  2574. { xxxToDec using reals could be a solution, but the }
  2575. { problem is that these will crash the m68k compiler }
  2576. { when compiling -- because of lack of good fpu }
  2577. { support. }
  2578. Message(assem_w_float_octal_ignored);
  2579. Consume(AS_OCTALNUM);
  2580. end;
  2581. else
  2582. Begin
  2583. { only write error once. }
  2584. if not errorflag then
  2585. Message(assem_e_invalid_real_const);
  2586. { consume tokens until we find COMMA or SEPARATOR }
  2587. Consume(actasmtoken);
  2588. errorflag := TRUE;
  2589. End;
  2590. end;
  2591. { go to next term }
  2592. if (actasmtoken=AS_COMMA) or (actasmtoken=AS_SEPARATOR) then
  2593. Begin
  2594. if negativ then expr:='-'+expr;
  2595. val(expr,r,code);
  2596. if code<>0 then
  2597. Begin
  2598. r:=0;
  2599. Message(assem_e_invalid_real_const);
  2600. ConcatRealConstant(p,r,typ);
  2601. End
  2602. else
  2603. Begin
  2604. ConcatRealConstant(p,r,typ);
  2605. End;
  2606. end
  2607. else
  2608. Message(assem_e_invalid_real_const);
  2609. Until actasmtoken=AS_SEPARATOR;
  2610. end;
  2611. Procedure BuildScaling(Var instr: TInstruction);
  2612. {*********************************************************************}
  2613. { Takes care of parsing expression starting from the scaling value }
  2614. { up to and including possible field specifiers. }
  2615. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR }
  2616. { or AS_COMMA. On entry should point to the AS_COMMA token. }
  2617. {*********************************************************************}
  2618. var str:string;
  2619. l: longint;
  2620. code: integer;
  2621. Begin
  2622. Consume(AS_COMMA);
  2623. if (instr.operands[operandnum].ref.scalefactor <> 0)
  2624. and (instr.operands[operandnum].ref.scalefactor <> 1) then
  2625. Message(assem_f_internal_error_in_buildscale);
  2626. case actasmtoken of
  2627. AS_INTNUM: str := actasmpattern;
  2628. AS_HEXNUM: str := HexToDec(actasmpattern);
  2629. AS_BINNUM: str := BinaryToDec(actasmpattern);
  2630. AS_OCTALNUM: str := OctalToDec(actasmpattern);
  2631. else
  2632. Message(assem_e_syntax_error);
  2633. end;
  2634. val(str, l, code);
  2635. if code <> 0 then
  2636. Message(assem_e_invalid_scaling_factor);
  2637. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
  2638. begin
  2639. instr.operands[operandnum].ref.scalefactor := l;
  2640. end
  2641. else
  2642. Begin
  2643. Message(assem_e_invalid_scaling_value);
  2644. instr.operands[operandnum].ref.scalefactor := 0;
  2645. end;
  2646. if instr.operands[operandnum].ref.index = R_NO then
  2647. Begin
  2648. Message(assem_e_scaling_value_only_allowed_with_index);
  2649. instr.operands[operandnum].ref.scalefactor := 0;
  2650. end;
  2651. { Consume the scaling number }
  2652. Consume(actasmtoken);
  2653. if actasmtoken = AS_RPAREN then
  2654. Consume(AS_RPAREN)
  2655. else
  2656. Message(assem_e_invalid_scaling_value);
  2657. { // .Field.Field ... or separator/comma // }
  2658. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then
  2659. Begin
  2660. end
  2661. else
  2662. Message(assem_e_syntax_error);
  2663. end;
  2664. Function BuildRefExpression: longint;
  2665. {*********************************************************************}
  2666. { FUNCTION BuildExpression: longint }
  2667. { Description: This routine calculates a constant expression to }
  2668. { a given value. The return value is the value calculated from }
  2669. { the expression. }
  2670. { The following tokens (not strings) are recognized: }
  2671. { SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. }
  2672. {*********************************************************************}
  2673. { ENTRY: On entry the token should be any valid expression token. }
  2674. { EXIT: On Exit the token points to the LPAREN token. }
  2675. { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
  2676. { invalid tokens. }
  2677. {*********************************************************************}
  2678. var tempstr: string;
  2679. expr: string;
  2680. l,k : longint;
  2681. errorflag : boolean;
  2682. Begin
  2683. errorflag := FALSE;
  2684. tempstr := '';
  2685. expr := '';
  2686. Repeat
  2687. Case actasmtoken of
  2688. AS_RPAREN: Begin
  2689. Message(assem_e_parenthesis_are_not_allowed);
  2690. Consume(AS_RPAREN);
  2691. end;
  2692. AS_SHL: Begin
  2693. Consume(AS_SHL);
  2694. expr := expr + '<';
  2695. end;
  2696. AS_SHR: Begin
  2697. Consume(AS_SHR);
  2698. expr := expr + '>';
  2699. end;
  2700. AS_SLASH: Begin
  2701. Consume(AS_SLASH);
  2702. expr := expr + '/';
  2703. end;
  2704. AS_MOD: Begin
  2705. Consume(AS_MOD);
  2706. expr := expr + '%';
  2707. end;
  2708. AS_STAR: Begin
  2709. Consume(AS_STAR);
  2710. expr := expr + '*';
  2711. end;
  2712. AS_PLUS: Begin
  2713. Consume(AS_PLUS);
  2714. expr := expr + '+';
  2715. end;
  2716. AS_MINUS: Begin
  2717. Consume(AS_MINUS);
  2718. expr := expr + '-';
  2719. end;
  2720. AS_AND: Begin
  2721. Consume(AS_AND);
  2722. expr := expr + '&';
  2723. end;
  2724. AS_NOT: Begin
  2725. Consume(AS_NOT);
  2726. expr := expr + '~';
  2727. end;
  2728. AS_XOR: Begin
  2729. Consume(AS_XOR);
  2730. expr := expr + '^';
  2731. end;
  2732. AS_OR: Begin
  2733. Consume(AS_OR);
  2734. expr := expr + '|';
  2735. end;
  2736. { End of reference }
  2737. AS_LPAREN: Begin
  2738. if not ErrorFlag then
  2739. BuildRefExpression := CalculateExpression(expr)
  2740. else
  2741. BuildRefExpression := 0;
  2742. { no longer in an expression }
  2743. exit;
  2744. end;
  2745. AS_ID:
  2746. Begin
  2747. tempstr:=actasmpattern;
  2748. consume(AS_ID);
  2749. if actasmtoken=AS_DOT then
  2750. begin
  2751. GetRecordOffsetSize(tempstr,l,k);
  2752. str(l, tempstr);
  2753. expr := expr + tempstr;
  2754. end
  2755. else
  2756. begin
  2757. if SearchIConstant(actasmpattern,l) then
  2758. begin
  2759. str(l, tempstr);
  2760. expr := expr + tempstr;
  2761. end
  2762. else
  2763. Message1(assem_e_invalid_const_symbol,actasmpattern);
  2764. end;
  2765. end;
  2766. AS_INTNUM: Begin
  2767. expr := expr + actasmpattern;
  2768. Consume(AS_INTNUM);
  2769. end;
  2770. AS_BINNUM: Begin
  2771. tempstr := BinaryToDec(actasmpattern);
  2772. if tempstr = '' then
  2773. Message(assem_f_error_converting_bin);
  2774. expr:=expr+tempstr;
  2775. Consume(AS_BINNUM);
  2776. end;
  2777. AS_HEXNUM: Begin
  2778. tempstr := HexToDec(actasmpattern);
  2779. if tempstr = '' then
  2780. Message(assem_f_error_converting_hex);
  2781. expr:=expr+tempstr;
  2782. Consume(AS_HEXNUM);
  2783. end;
  2784. AS_OCTALNUM: Begin
  2785. tempstr := OctalToDec(actasmpattern);
  2786. if tempstr = '' then
  2787. Message(assem_f_error_converting_octal);
  2788. expr:=expr+tempstr;
  2789. Consume(AS_OCTALNUM);
  2790. end;
  2791. else
  2792. Begin
  2793. { write error only once. }
  2794. if not errorflag then
  2795. Message(assem_e_invalid_constant_expression);
  2796. BuildRefExpression := 0;
  2797. if actasmtoken in [AS_COMMA,AS_SEPARATOR] then exit;
  2798. { consume tokens until we find COMMA or SEPARATOR }
  2799. Consume(actasmtoken);
  2800. errorflag := TRUE;
  2801. end;
  2802. end;
  2803. Until false;
  2804. end;
  2805. Procedure BuildReference(var Instr: TInstruction);
  2806. {*********************************************************************}
  2807. { PROCEDURE BuildBracketExpression }
  2808. { Description: This routine builds up an expression after a LPAREN }
  2809. { token is encountered. }
  2810. { On entry actasmtoken should be equal to AS_LPAREN }
  2811. {*********************************************************************}
  2812. { EXIT CONDITION: On exit the routine should point to either the }
  2813. { AS_COMMA or AS_SEPARATOR token. }
  2814. {*********************************************************************}
  2815. var
  2816. l:longint;
  2817. code: integer;
  2818. str: string;
  2819. Begin
  2820. Consume(AS_LPAREN);
  2821. initAsmRef(instr);
  2822. Case actasmtoken of
  2823. { // (reg ... // }
  2824. AS_REGISTER: Begin
  2825. { Check if there is already a base (mostly ebp,esp) than this is
  2826. not allowed,becuase it will give crashing code }
  2827. if instr.operands[operandnum].ref.base<>R_NO then
  2828. Message(assem_e_cannot_index_relative_var);
  2829. instr.operands[operandnum].ref.base := findregister(actasmpattern);
  2830. Consume(AS_REGISTER);
  2831. { can either be a register or a right parenthesis }
  2832. { // (reg) // }
  2833. if actasmtoken=AS_RPAREN then Begin
  2834. Consume(AS_RPAREN);
  2835. if not (actasmtoken in [AS_COMMA,
  2836. AS_SEPARATOR]) then
  2837. Begin
  2838. Message(assem_e_invalid_reference);
  2839. { error recovery ... }
  2840. while actasmtoken <> AS_SEPARATOR do
  2841. Consume(actasmtoken);
  2842. end;
  2843. exit;
  2844. end;
  2845. { // (reg,reg .. // }
  2846. { we need a comman here !! }
  2847. { oops.. }
  2848. Consume(AS_COMMA);
  2849. Case actasmtoken of
  2850. AS_REGISTER: Begin
  2851. instr.operands[operandnum].ref.index :=
  2852. findregister(actasmpattern);
  2853. Consume(AS_REGISTER);
  2854. { check for scaling ... }
  2855. case actasmtoken of
  2856. AS_RPAREN:
  2857. Begin
  2858. Consume(AS_RPAREN);
  2859. if not (actasmtoken in [AS_COMMA,
  2860. AS_SEPARATOR]) then
  2861. Begin
  2862. { error recovery ... }
  2863. Message(assem_e_invalid_reference);
  2864. while actasmtoken <> AS_SEPARATOR do
  2865. Consume(actasmtoken);
  2866. end;
  2867. exit;
  2868. end;
  2869. AS_COMMA:
  2870. Begin
  2871. BuildScaling(instr);
  2872. end;
  2873. else
  2874. Begin
  2875. Message(assem_e_invalid_reference_syntax);
  2876. while (actasmtoken <> AS_SEPARATOR) do
  2877. Consume(actasmtoken);
  2878. end;
  2879. end; { end case }
  2880. end;
  2881. else
  2882. Begin
  2883. Message(assem_e_invalid_reference_syntax);
  2884. while (actasmtoken <> AS_SEPARATOR) do
  2885. Consume(actasmtoken);
  2886. end;
  2887. end; {end case }
  2888. end;
  2889. { // (, ... // }
  2890. AS_COMMA: { can either be scaling, or index }
  2891. Begin
  2892. Consume(AS_COMMA);
  2893. case actasmtoken of
  2894. AS_REGISTER: Begin
  2895. instr.operands[operandnum].ref.index :=
  2896. findregister(actasmpattern);
  2897. Consume(AS_REGISTER);
  2898. { check for scaling ... }
  2899. case actasmtoken of
  2900. AS_RPAREN:
  2901. Begin
  2902. Consume(AS_RPAREN);
  2903. if not (actasmtoken in [AS_COMMA,
  2904. AS_SEPARATOR]) then
  2905. Begin
  2906. { error recovery ... }
  2907. Message(assem_e_invalid_reference);
  2908. while actasmtoken <> AS_SEPARATOR do
  2909. Consume(actasmtoken);
  2910. end;
  2911. exit;
  2912. end;
  2913. AS_COMMA:
  2914. Begin
  2915. BuildScaling(instr);
  2916. end;
  2917. else
  2918. Begin
  2919. Message(assem_e_invalid_reference_syntax);
  2920. while (actasmtoken <> AS_SEPARATOR) do
  2921. Consume(actasmtoken);
  2922. end;
  2923. end; {end case }
  2924. end;
  2925. AS_HEXNUM,AS_INTNUM, { we have to process the scaling }
  2926. AS_BINNUM,AS_OCTALNUM: { directly here... }
  2927. Begin
  2928. case actasmtoken of
  2929. AS_INTNUM: str :=
  2930. actasmpattern;
  2931. AS_HEXNUM: str :=
  2932. HexToDec(actasmpattern);
  2933. AS_BINNUM: str :=
  2934. BinaryToDec(actasmpattern);
  2935. AS_OCTALNUM: str :=
  2936. OctalToDec(actasmpattern);
  2937. else
  2938. Message(assem_e_syntax_error);
  2939. end; { end case }
  2940. val(str, l, code);
  2941. if code <> 0 then
  2942. Message(assem_e_invalid_scaling_factor);
  2943. if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then
  2944. begin
  2945. instr.operands[operandnum].
  2946. ref.scalefactor := l;
  2947. end
  2948. else
  2949. Begin
  2950. Message(assem_e_invalid_scaling_value);
  2951. instr.operands[operandnum].
  2952. ref.scalefactor := 0;
  2953. end;
  2954. Consume(actasmtoken);
  2955. if actasmtoken <> AS_RPAREN then
  2956. Begin
  2957. Message(assem_e_invalid_scaling_value);
  2958. while actasmtoken <> AS_SEPARATOR do
  2959. Consume(actasmtoken);
  2960. end
  2961. else
  2962. Begin
  2963. Consume(AS_RPAREN);
  2964. if not (actasmtoken in [AS_COMMA,
  2965. AS_SEPARATOR]) then
  2966. Begin
  2967. { error recovery ... }
  2968. Message(assem_e_invalid_reference);
  2969. while actasmtoken <> AS_SEPARATOR do
  2970. Consume(actasmtoken);
  2971. end;
  2972. exit;
  2973. end;
  2974. end;
  2975. else
  2976. Begin
  2977. Message(assem_e_invalid_reference_syntax);
  2978. while (actasmtoken <> AS_SEPARATOR) do
  2979. Consume(actasmtoken);
  2980. end;
  2981. end; { end case }
  2982. end;
  2983. else
  2984. Begin
  2985. Message(assem_e_invalid_reference_syntax);
  2986. while (actasmtoken <> AS_SEPARATOR) do
  2987. Consume(actasmtoken);
  2988. end;
  2989. end; { end case }
  2990. end;
  2991. Procedure BuildOperand(var instr: TInstruction);
  2992. {*********************************************************************}
  2993. { EXIT CONDITION: On exit the routine should point to either the }
  2994. { AS_COMMA or AS_SEPARATOR token. }
  2995. {*********************************************************************}
  2996. var
  2997. tempstr: string;
  2998. expr: string;
  2999. lab: Pasmlabel;
  3000. hl: plabel;
  3001. tsize,
  3002. toffset : longint;
  3003. Begin
  3004. tempstr := '';
  3005. expr := '';
  3006. case actasmtoken of
  3007. { // Memory reference // }
  3008. AS_LPAREN:
  3009. Begin
  3010. initAsmRef(instr);
  3011. BuildReference(instr);
  3012. end;
  3013. { // Constant expression // }
  3014. AS_DOLLAR: Begin
  3015. Consume(AS_DOLLAR);
  3016. if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_CONSTANT]) then
  3017. Message(assem_e_invalid_operand_type);
  3018. { identifiers are handled by BuildExpression }
  3019. instr.operands[operandnum].operandtype := OPR_CONSTANT;
  3020. instr.operands[operandnum].val :=BuildExpression;
  3021. end;
  3022. { // Constant memory offset . // }
  3023. { // This must absolutely be followed by ( // }
  3024. AS_HEXNUM,AS_INTNUM,AS_MINUS,
  3025. AS_BINNUM,AS_OCTALNUM,AS_PLUS:
  3026. Begin
  3027. InitAsmRef(instr);
  3028. instr.operands[operandnum].ref.offset:=BuildRefExpression;
  3029. BuildReference(instr);
  3030. end;
  3031. { // Call from memory address // }
  3032. AS_STAR: Begin
  3033. Consume(AS_STAR);
  3034. InitAsmRef(instr);
  3035. if not CreateVarInstr(instr,actasmpattern,operandnum) then
  3036. Message(assem_e_syn_opcode_operand);
  3037. end;
  3038. { // A constant expression, or a Variable ref. // }
  3039. AS_ID: Begin
  3040. { // Local label. // }
  3041. if (actasmpattern[1] ='.') and (actasmpattern[2] = 'L') then
  3042. Begin
  3043. Begin
  3044. delete(actasmpattern,1,1);
  3045. delete(actasmpattern,1,1);
  3046. if actasmpattern = '' then
  3047. Message(assem_e_null_label_ref_not_allowed);
  3048. lab := labellist.search(actasmpattern);
  3049. { check if the label is already defined }
  3050. { if so, we then check if the plabel is }
  3051. { non-nil, if so we add it to instruction }
  3052. if assigned(lab) then
  3053. Begin
  3054. if assigned(lab^.lab) then
  3055. Begin
  3056. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3057. instr.operands[operandnum].hl := lab^.lab;
  3058. instr.labeled := TRUE;
  3059. end;
  3060. end
  3061. else
  3062. { the label does not exist, create it }
  3063. { emit the opcode, but set that the }
  3064. { label has not been emitted }
  3065. Begin
  3066. getlabel(hl);
  3067. labellist.insert(actasmpattern,hl,FALSE);
  3068. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3069. instr.operands[operandnum].hl := hl;
  3070. instr.labeled := TRUE;
  3071. end;
  3072. end;
  3073. Consume(AS_ID);
  3074. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  3075. Begin
  3076. Message(assem_e_syntax_error);
  3077. end;
  3078. end
  3079. { probably a variable or normal expression }
  3080. { or a procedure (such as in CALL ID) }
  3081. else
  3082. Begin
  3083. { check if this is a label, if so then }
  3084. { emit it as a label. }
  3085. if SearchLabel(actasmpattern,hl) then
  3086. Begin
  3087. instr.operands[operandnum].operandtype := OPR_LABINSTR;
  3088. instr.operands[operandnum].hl := hl;
  3089. instr.labeled := TRUE;
  3090. Consume(AS_ID);
  3091. if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
  3092. Message(assem_e_syntax_error);
  3093. end
  3094. else
  3095. { is it a normal variable ? }
  3096. Begin
  3097. { context for scanner }
  3098. previous_was_id:=TRUE;
  3099. initAsmRef(instr);
  3100. if not CreateVarInstr(instr,actasmpattern,operandnum) then
  3101. Begin
  3102. { look for special symbols ... }
  3103. if actasmpattern = '__RESULT' then
  3104. SetUpResult(instr,operandnum)
  3105. else
  3106. if actasmpattern = '__SELF' then
  3107. Begin
  3108. if assigned(procinfo._class) then
  3109. Begin
  3110. instr.operands[operandnum].operandtype := OPR_REFERENCE;
  3111. instr.operands[operandnum].ref.offset :=
  3112. procinfo.ESI_offset;
  3113. instr.operands[operandnum].ref.base :=
  3114. procinfo.framepointer;
  3115. end
  3116. else
  3117. Message(assem_e_cannot_use___SELF_outside_methode);
  3118. end
  3119. else
  3120. if actasmpattern = '__OLDEBP' then
  3121. Begin
  3122. if lexlevel>2 then
  3123. Begin
  3124. instr.operands[operandnum].operandtype := OPR_REFERENCE;
  3125. instr.operands[operandnum].ref.offset :=
  3126. procinfo.framepointer_offset;
  3127. instr.operands[operandnum].ref.base :=
  3128. procinfo.framepointer;
  3129. end
  3130. else
  3131. Message(assem_e_cannot_use___OLDEBP_outside_nested_procedure);
  3132. end { endif actasmpattern = '__OLDEBP' }
  3133. else
  3134. { check for direct symbolic names }
  3135. { only if compiling the system unit }
  3136. if (cs_compilesystem in aktmoduleswitches) then
  3137. begin
  3138. if not SearchDirectVar(instr,actasmpattern,operandnum) then
  3139. Begin
  3140. { not found, finally ... add it anyways ... }
  3141. Message1(assem_w_id_supposed_external,actasmpattern);
  3142. instr.operands[operandnum].ref.symbol := newpasstr(actasmpattern);
  3143. end;
  3144. end
  3145. else
  3146. Message1(assem_e_unknown_id,actasmpattern);
  3147. end;
  3148. { constant expression? }
  3149. if (instr.operands[operandnum].operandtype=OPR_CONSTANT) then
  3150. instr.operands[operandnum].val := BuildExpression
  3151. else
  3152. begin
  3153. expr := actasmpattern;
  3154. Consume(AS_ID);
  3155. case actasmtoken of
  3156. AS_LPAREN: Begin
  3157. { indexing }
  3158. previous_was_id:=FALSE;
  3159. BuildReference(instr);
  3160. end;
  3161. AS_DOT : Begin
  3162. GetRecordOffsetSize(expr,toffset,tsize);
  3163. inc(instr.operands[operandnum].ref.offset,toffset);
  3164. SetOperandSize(instr,operandnum,tsize);
  3165. end;
  3166. AS_SEPARATOR,AS_COMMA: ;
  3167. else
  3168. Message(assem_e_syntax_error);
  3169. end; { end case }
  3170. end;
  3171. { restore normal context }
  3172. previous_was_id := FALSE;
  3173. end; { end if }
  3174. end; { end if }
  3175. end; { end this case }
  3176. { // Register, a variable reference or a constant reference // }
  3177. AS_REGISTER: Begin
  3178. { save the type of register used. }
  3179. tempstr := actasmpattern;
  3180. Consume(AS_REGISTER);
  3181. if actasmtoken = AS_COLON then
  3182. Begin
  3183. Consume(AS_COLON);
  3184. initAsmRef(instr);
  3185. instr.operands[operandnum].ref.segment := findsegment(tempstr);
  3186. { here we can have either an identifier }
  3187. { or a constant, where either can be }
  3188. { followed by a parenthesis... }
  3189. { // Constant memory offset . // }
  3190. { // This must absolutely be followed by ( // }
  3191. case actasmtoken of
  3192. AS_HEXNUM,AS_INTNUM,AS_MINUS,
  3193. AS_BINNUM,AS_OCTALNUM,AS_PLUS
  3194. : Begin
  3195. instr.operands[operandnum].
  3196. ref.offset:=BuildRefExpression;
  3197. BuildReference(instr);
  3198. end;
  3199. AS_LPAREN: BuildReference(instr);
  3200. { only a variable is allowed ... }
  3201. AS_ID: Begin
  3202. { is it a normal variable ? }
  3203. if not CreateVarInstr(instr,actasmpattern,operandnum)
  3204. then
  3205. begin
  3206. { check for direct symbolic names }
  3207. { only if compiling the system unit }
  3208. if (cs_compilesystem in aktmoduleswitches) then
  3209. begin
  3210. if not SearchDirectVar(instr,actasmpattern,operandnum) then
  3211. Message(assem_e_invalid_seg_override);
  3212. end
  3213. else
  3214. Message(assem_e_invalid_seg_override);
  3215. end;
  3216. Consume(actasmtoken);
  3217. case actasmtoken of
  3218. AS_SEPARATOR,AS_COMMA: ;
  3219. AS_LPAREN: BuildReference(instr);
  3220. else
  3221. Begin
  3222. Message(assem_e_invalid_seg_override);
  3223. Consume(actasmtoken);
  3224. end;
  3225. end; {end case }
  3226. end;
  3227. else
  3228. Begin
  3229. Message(assem_e_invalid_seg_override);
  3230. Consume(actasmtoken);
  3231. end;
  3232. end; { end case }
  3233. end
  3234. { // Simple register // }
  3235. else if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then
  3236. Begin
  3237. if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_REGISTER]) then
  3238. Message(assem_e_invalid_operand_type);
  3239. instr.operands[operandnum].operandtype := OPR_REGISTER;
  3240. instr.operands[operandnum].reg := findregister(tempstr);
  3241. end
  3242. else
  3243. Message1(assem_e_syn_register,tempstr);
  3244. end;
  3245. AS_SEPARATOR, AS_COMMA: ;
  3246. else
  3247. Begin
  3248. Message(assem_e_syn_opcode_operand);
  3249. Consume(actasmtoken);
  3250. end;
  3251. end; { end case }
  3252. end;
  3253. Procedure BuildConstant(maxvalue: longint);
  3254. {*********************************************************************}
  3255. { PROCEDURE BuildConstant }
  3256. { Description: This routine takes care of parsing a DB,DD,or DW }
  3257. { line and adding those to the assembler node. Expressions, range- }
  3258. { checking are fullly taken care of. }
  3259. { maxvalue: $ff -> indicates that this is a DB node. }
  3260. { $ffff -> indicates that this is a DW node. }
  3261. { $ffffffff -> indicates that this is a DD node. }
  3262. {*********************************************************************}
  3263. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3264. {*********************************************************************}
  3265. var
  3266. strlength: byte;
  3267. expr: string;
  3268. value : longint;
  3269. Begin
  3270. Repeat
  3271. Case actasmtoken of
  3272. AS_STRING: Begin
  3273. if maxvalue = $ff then
  3274. strlength := 1
  3275. else
  3276. Message(assem_e_string_not_allowed_as_const);
  3277. expr := actasmpattern;
  3278. if length(expr) > 1 then
  3279. Message(assem_e_string_not_allowed_as_const);
  3280. Consume(AS_STRING);
  3281. Case actasmtoken of
  3282. AS_COMMA: Consume(AS_COMMA);
  3283. AS_SEPARATOR: ;
  3284. else
  3285. Message(assem_e_invalid_string_expression);
  3286. end; { end case }
  3287. ConcatString(p,expr);
  3288. end;
  3289. AS_INTNUM,AS_BINNUM,
  3290. AS_OCTALNUM,AS_HEXNUM:
  3291. Begin
  3292. value:=BuildExpression;
  3293. ConcatConstant(p,value,maxvalue);
  3294. end;
  3295. AS_ID:
  3296. Begin
  3297. value:=BuildExpression;
  3298. if value > maxvalue then
  3299. Begin
  3300. Message(assem_e_expression_out_of_bounds);
  3301. { assuming a value of maxvalue }
  3302. value := maxvalue;
  3303. end;
  3304. ConcatConstant(p,value,maxvalue);
  3305. end;
  3306. { These terms can start an assembler expression }
  3307. AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: Begin
  3308. value := BuildExpression;
  3309. ConcatConstant(p,value,maxvalue);
  3310. end;
  3311. AS_COMMA: BEGIN
  3312. Consume(AS_COMMA);
  3313. END;
  3314. AS_SEPARATOR: ;
  3315. else
  3316. Begin
  3317. Message(assem_f_internal_error_in_buildconstant);
  3318. end;
  3319. end; { end case }
  3320. Until actasmtoken = AS_SEPARATOR;
  3321. end;
  3322. Procedure BuildStringConstant(asciiz: boolean);
  3323. {*********************************************************************}
  3324. { PROCEDURE BuildStringConstant }
  3325. { Description: Takes care of a ASCII, or ASCIIZ directive. }
  3326. { asciiz: boolean -> if true then string will be null terminated. }
  3327. {*********************************************************************}
  3328. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3329. { On ENTRY: Token should point to AS_STRING }
  3330. {*********************************************************************}
  3331. var
  3332. expr: string;
  3333. errorflag : boolean;
  3334. Begin
  3335. errorflag := FALSE;
  3336. Repeat
  3337. Case actasmtoken of
  3338. AS_STRING: Begin
  3339. expr:=actasmpattern;
  3340. if asciiz then
  3341. expr:=expr+#0;
  3342. ConcatPasString(p,expr);
  3343. Consume(AS_STRING);
  3344. end;
  3345. AS_COMMA: BEGIN
  3346. Consume(AS_COMMA);
  3347. END;
  3348. AS_SEPARATOR: ;
  3349. else
  3350. Begin
  3351. Consume(actasmtoken);
  3352. if not errorflag then
  3353. Message(assem_e_invalid_string_expression);
  3354. errorflag := TRUE;
  3355. end;
  3356. end; { end case }
  3357. Until actasmtoken = AS_SEPARATOR;
  3358. end;
  3359. Procedure BuildOpCode;
  3360. {*********************************************************************}
  3361. { PROCEDURE BuildOpcode; }
  3362. { Description: Parses the intel opcode and operands, and writes it }
  3363. { in the TInstruction object. }
  3364. {*********************************************************************}
  3365. { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. }
  3366. { On ENTRY: Token should point to AS_OPCODE }
  3367. {*********************************************************************}
  3368. var asmtok: tasmop;
  3369. op: tasmop;
  3370. expr: string;
  3371. segreg: tregister;
  3372. Begin
  3373. expr := '';
  3374. asmtok := A_NONE; { assmume no prefix }
  3375. segreg := R_NO; { assume no segment override }
  3376. { // prefix seg opcode // }
  3377. { // prefix opcode // }
  3378. if findprefix(actasmpattern,asmtok) then
  3379. Begin
  3380. { standard opcode prefix }
  3381. if asmtok <> A_NONE then
  3382. instr.addprefix(asmtok);
  3383. Consume(AS_OPCODE);
  3384. end;
  3385. { // opcode // }
  3386. { allow for newline as in gas styled syntax }
  3387. { under DOS you get two AS_SEPARATOR !! }
  3388. while actasmtoken=AS_SEPARATOR do
  3389. Consume(AS_SEPARATOR);
  3390. if (actasmtoken <> AS_OPCODE) then
  3391. Begin
  3392. Message(assem_e_invalid_or_missing_opcode);
  3393. { error recovery }
  3394. While not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do
  3395. Consume(actasmtoken);
  3396. exit;
  3397. end
  3398. else
  3399. Begin
  3400. op := findopcode(actasmpattern);
  3401. instr.addinstr(op);
  3402. { // Valid combination of prefix and instruction ? // }
  3403. if (asmtok <> A_NONE) and (NOT CheckPrefix(asmtok,op)) then
  3404. Message1(assem_e_invalid_prefix_and_opcode,actasmpattern);
  3405. Consume(AS_OPCODE);
  3406. { // Zero operand opcode ? // }
  3407. if actasmtoken = AS_SEPARATOR then
  3408. exit
  3409. else
  3410. operandnum := 1;
  3411. end;
  3412. While actasmtoken <> AS_SEPARATOR do
  3413. Begin
  3414. case actasmtoken of
  3415. { // Operand delimiter // }
  3416. AS_COMMA: Begin
  3417. if operandnum > MaxOperands then
  3418. Message(assem_e_too_many_operands)
  3419. else
  3420. Inc(operandnum);
  3421. Consume(AS_COMMA);
  3422. end;
  3423. { // End of asm operands for this opcode // }
  3424. AS_SEPARATOR: ;
  3425. else
  3426. BuildOperand(instr);
  3427. end; { end case }
  3428. end; { end while }
  3429. end;
  3430. Function Assemble: Ptree;
  3431. {*********************************************************************}
  3432. { PROCEDURE Assemble; }
  3433. { Description: Parses the att assembler syntax, parsing is done }
  3434. { according to GAs rules. }
  3435. {*********************************************************************}
  3436. Var
  3437. hl: plabel;
  3438. labelptr,nextlabel : pasmlabel;
  3439. commname : string;
  3440. store_p : paasmoutput;
  3441. Begin
  3442. Message(assem_d_start_att);
  3443. firsttoken := TRUE;
  3444. operandnum := 0;
  3445. if assigned(procinfo.retdef) and
  3446. (is_fpu(procinfo.retdef) or
  3447. ret_in_acc(procinfo.retdef)) then
  3448. procinfo.funcret_is_valid:=true;
  3449. { sets up all opcode and register tables in uppercase }
  3450. if not _asmsorted then
  3451. Begin
  3452. SetupTables;
  3453. _asmsorted := TRUE;
  3454. end;
  3455. p:=new(paasmoutput,init);
  3456. { save pointer code section }
  3457. store_p:=p;
  3458. { setup label linked list }
  3459. labellist.init;
  3460. c:=current_scanner^.asmgetchar;
  3461. actasmtoken:=gettoken;
  3462. while actasmtoken<>AS_END do
  3463. Begin
  3464. case actasmtoken of
  3465. AS_LLABEL: Begin
  3466. labelptr := labellist.search(actasmpattern);
  3467. if not assigned(labelptr) then
  3468. Begin
  3469. getlabel(hl);
  3470. labellist.insert(actasmpattern,hl,TRUE);
  3471. ConcatLabel(p,A_LABEL,hl);
  3472. end
  3473. else
  3474. { the label has already been inserted into the }
  3475. { label list, either as an instruction label (in}
  3476. { this case it has not been emitted), or as a }
  3477. { duplicate local symbol (in this case it has }
  3478. { already been emitted). }
  3479. Begin
  3480. if labelptr^.emitted then
  3481. Message1(assem_e_dup_local_sym,'.L'+labelptr^.name^)
  3482. else
  3483. Begin
  3484. if assigned(labelptr^.lab) then
  3485. ConcatLabel(p,A_LABEL,labelptr^.lab);
  3486. labelptr^.emitted := TRUE;
  3487. end;
  3488. end;
  3489. Consume(AS_LLABEL);
  3490. end;
  3491. AS_LABEL: Begin
  3492. { when looking for Pascal labels, these must }
  3493. { be in uppercase. }
  3494. if SearchLabel(upper(actasmpattern),hl) then
  3495. ConcatLabel(p,A_LABEL, hl)
  3496. else
  3497. Begin
  3498. if (cs_compilesystem in aktmoduleswitches) then
  3499. begin
  3500. Message1(assem_e_unknown_label_identifer,actasmpattern);
  3501. { once again we don't know what it represents }
  3502. { so we simply concatenate it }
  3503. ConcatLocal(p,actasmpattern);
  3504. end
  3505. else
  3506. Message1(assem_e_unknown_label_identifer,actasmpattern);
  3507. end;
  3508. Consume(AS_LABEL);
  3509. end;
  3510. AS_DW: Begin
  3511. Consume(AS_DW);
  3512. BuildConstant($ffff);
  3513. end;
  3514. AS_DATA: Begin
  3515. { -- this should only be allowed for system development -- }
  3516. { i think this should be fixed in the dos unit, and }
  3517. { not here. }
  3518. if (cs_compilesystem in aktmoduleswitches) then
  3519. p:=datasegment
  3520. else
  3521. Message(assem_e_switching_sections_not_allowed);
  3522. Consume(AS_DATA);
  3523. end;
  3524. AS_TEXT: Begin
  3525. { -- this should only be allowed for system development -- }
  3526. { i think this should be fixed in the dos unit, and }
  3527. { not here. }
  3528. if (cs_compilesystem in aktmoduleswitches) then
  3529. p:=store_p
  3530. else
  3531. Message(assem_e_switching_sections_not_allowed);
  3532. Consume(AS_TEXT);
  3533. end;
  3534. AS_DB: Begin
  3535. Consume(AS_DB);
  3536. BuildConstant($ff);
  3537. end;
  3538. AS_DD: Begin
  3539. Consume(AS_DD);
  3540. BuildConstant($ffffffff);
  3541. end;
  3542. AS_DQ: Begin
  3543. Consume(AS_DQ);
  3544. BuildRealConstant(s64bit);
  3545. end;
  3546. AS_SINGLE: Begin
  3547. Consume(AS_SINGLE);
  3548. BuildRealConstant(s32real);
  3549. end;
  3550. AS_DOUBLE: Begin
  3551. Consume(AS_DOUBLE);
  3552. BuildRealConstant(s64real);
  3553. end;
  3554. AS_EXTENDED: Begin
  3555. Consume(AS_EXTENDED);
  3556. BuildRealConstant(s80real);
  3557. end;
  3558. AS_GLOBAL:
  3559. Begin
  3560. { normal units should not be able to declare }
  3561. { direct label names like this... anyhow }
  3562. { procedural calls in asm blocks are }
  3563. { supposedely replaced automatically }
  3564. if (cs_compilesystem in aktmoduleswitches) then
  3565. begin
  3566. Consume(AS_GLOBAL);
  3567. if actasmtoken <> AS_ID then
  3568. Message(assem_e_invalid_global_def)
  3569. else
  3570. ConcatPublic(p,actasmpattern);
  3571. Consume(actasmtoken);
  3572. if actasmtoken <> AS_SEPARATOR then
  3573. Begin
  3574. Message(assem_e_line_separator_expected);
  3575. while actasmtoken <> AS_SEPARATOR do
  3576. Consume(actasmtoken);
  3577. end;
  3578. end
  3579. else
  3580. begin
  3581. Message(assem_w_globl_not_supported);
  3582. while actasmtoken <> AS_SEPARATOR do
  3583. Consume(actasmtoken);
  3584. end;
  3585. end;
  3586. AS_ALIGN: Begin
  3587. Message(assem_w_align_not_supported);
  3588. while actasmtoken <> AS_SEPARATOR do
  3589. Consume(actasmtoken);
  3590. end;
  3591. AS_ASCIIZ: Begin
  3592. Consume(AS_ASCIIZ);
  3593. BuildStringConstant(TRUE);
  3594. end;
  3595. AS_ASCII: Begin
  3596. Consume(AS_ASCII);
  3597. BuildStringConstant(FALSE);
  3598. end;
  3599. AS_LCOMM: Begin
  3600. { -- this should only be allowed for system development -- }
  3601. { -- otherwise may mess up future enhancements we might -- }
  3602. { -- add. -- }
  3603. if (cs_compilesystem in aktmoduleswitches) then
  3604. begin
  3605. Consume(AS_LCOMM);
  3606. if actasmtoken <> AS_ID then
  3607. begin
  3608. Message(assem_e_invalid_lcomm_def);
  3609. { error recovery }
  3610. while actasmtoken <> AS_SEPARATOR do
  3611. Consume(actasmtoken);
  3612. end
  3613. else
  3614. begin
  3615. commname:=actasmpattern;
  3616. Consume(AS_COMMA);
  3617. ConcatLocalBss(actasmpattern,BuildExpression);
  3618. if actasmtoken <> AS_SEPARATOR then
  3619. Begin
  3620. Message(assem_e_line_separator_expected);
  3621. while actasmtoken <> AS_SEPARATOR do
  3622. Consume(actasmtoken);
  3623. end;
  3624. end;
  3625. end
  3626. else
  3627. begin
  3628. Message(assem_w_lcomm_not_supported);
  3629. while actasmtoken <> AS_SEPARATOR do
  3630. Consume(actasmtoken);
  3631. end;
  3632. end;
  3633. AS_COMM: Begin
  3634. { -- this should only be allowed for system development -- }
  3635. { -- otherwise may mess up future enhancements we might -- }
  3636. { -- add. -- }
  3637. if (cs_compilesystem in aktmoduleswitches) then
  3638. begin
  3639. Consume(AS_COMM);
  3640. if actasmtoken <> AS_ID then
  3641. begin
  3642. Message(assem_e_invalid_comm_def);
  3643. { error recovery }
  3644. while actasmtoken <> AS_SEPARATOR do
  3645. Consume(actasmtoken);
  3646. end
  3647. else
  3648. begin
  3649. commname:=actasmpattern;
  3650. Consume(AS_COMMA);
  3651. ConcatGlobalBss(actasmpattern,BuildExpression);
  3652. if actasmtoken <> AS_SEPARATOR then
  3653. Begin
  3654. Message(assem_e_line_separator_expected);
  3655. while actasmtoken <> AS_SEPARATOR do
  3656. Consume(actasmtoken);
  3657. end;
  3658. end;
  3659. end
  3660. else
  3661. begin
  3662. Message(assem_w_comm_not_supported);
  3663. while actasmtoken <> AS_SEPARATOR do
  3664. Consume(actasmtoken);
  3665. end;
  3666. end;
  3667. AS_OPCODE: Begin
  3668. instr.init;
  3669. BuildOpcode;
  3670. instr.numops := operandnum;
  3671. if instr.labeled then
  3672. ConcatLabeledInstr(instr)
  3673. else
  3674. ConcatOpCode(instr);
  3675. instr.done;
  3676. end;
  3677. AS_SEPARATOR:Begin
  3678. Consume(AS_SEPARATOR);
  3679. { let us go back to the first operand }
  3680. operandnum := 0;
  3681. end;
  3682. AS_END: ; { end assembly block }
  3683. else
  3684. Begin
  3685. Message(assem_e_assemble_node_syntax_error);
  3686. { error recovery }
  3687. Consume(actasmtoken);
  3688. end;
  3689. end; { end case }
  3690. end; { end while }
  3691. { check if there were undefined symbols. }
  3692. { if so, then list each of those undefined }
  3693. { labels. }
  3694. if assigned(labellist.First) then
  3695. Begin
  3696. labelptr := labellist.First;
  3697. While labelptr <> nil do
  3698. Begin
  3699. nextlabel:=labelptr^.next;
  3700. if not labelptr^.emitted then
  3701. Message1(assem_e_local_sym_not_found_in_asm_statement,'.L'+labelptr^.name^);
  3702. labelptr:=nextlabel;
  3703. end;
  3704. end;
  3705. if p<>store_p then
  3706. begin
  3707. Message(assem_e_assembler_code_not_returned_to_text);
  3708. p:=store_p;
  3709. end;
  3710. assemble := genasmnode(p);
  3711. labellist.done;
  3712. Message(assem_d_finish_att);
  3713. end;
  3714. var
  3715. old_exit: pointer;
  3716. procedure ra386att_exit;{$ifndef FPC}far;{$endif}
  3717. begin
  3718. if assigned(iasmops) then
  3719. dispose(iasmops);
  3720. exitproc:=old_exit;
  3721. end;
  3722. Begin
  3723. previous_was_id := FALSE;
  3724. line:=''; { Initialization of line variable.
  3725. No 255 char const string in version 0.9.1 MVC}
  3726. old_exit := exitproc;
  3727. exitproc := @ra386att_exit;
  3728. end.
  3729. {
  3730. $Log$
  3731. Revision 1.18 1998-11-05 23:48:26 peter
  3732. * recordtype.field support in constant expressions
  3733. * fixed imul for oa_imm8 which was not allowed
  3734. * fixed reading of local typed constants
  3735. * fixed comment reading which is not any longer a separator
  3736. Revision 1.17 1998/10/28 21:34:39 peter
  3737. * fixed some opsize
  3738. Revision 1.16 1998/10/28 00:08:48 peter
  3739. + leal procsym,eax is now allowed
  3740. + constants are now handled also when starting an expression
  3741. + call *pointer is now allowed
  3742. Revision 1.15 1998/10/13 16:50:16 pierre
  3743. * undid some changes of Peter that made the compiler wrong
  3744. for m68k (I had to reinsert some ifdefs)
  3745. * removed several memory leaks under m68k
  3746. * removed the meory leaks for assembler readers
  3747. * cross compiling shoud work again better
  3748. ( crosscompiling sysamiga works
  3749. but as68k still complain about some code !)
  3750. Revision 1.14 1998/10/07 04:28:52 carl
  3751. * bugfix of in/out with gas (ins/outs still left though)
  3752. * bugfix of wrong error output with concatlabel
  3753. * gettoken always returns something valid now
  3754. Revision 1.13 1998/09/24 17:52:31 carl
  3755. * bugfix from fix branch
  3756. Revision 1.12.2.1 1998/09/24 17:47:16 carl
  3757. * bugfix with objects/records access
  3758. Revision 1.12 1998/09/03 17:08:46 pierre
  3759. * better lines for stabs
  3760. (no scroll back to if before else part
  3761. no return to case line at jump outside case)
  3762. + source lines also if not in order
  3763. Revision 1.11 1998/09/02 15:16:44 carl
  3764. * indirect register refs with movsx/movzx fixed
  3765. Revision 1.10 1998/09/02 01:24:09 carl
  3766. * bugfix of PUSH opcode with constants
  3767. Revision 1.9 1998/08/21 08:45:49 pierre
  3768. * better line info for asm statements
  3769. Revision 1.8 1998/08/19 16:07:54 jonas
  3770. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  3771. Revision 1.7 1998/08/10 23:57:23 peter
  3772. * use bestreal instead of extended
  3773. Revision 1.6 1998/08/10 14:50:21 peter
  3774. + localswitches, moduleswitches, globalswitches splitting
  3775. Revision 1.5 1998/07/14 14:46:58 peter
  3776. * released NEWINPUT
  3777. Revision 1.4 1998/07/08 15:06:41 daniel
  3778. + $N+,E+ added for TP.
  3779. Revision 1.3 1998/07/07 11:20:07 peter
  3780. + NEWINPUT for a better inputfile and scanner object
  3781. Revision 1.2 1998/06/24 14:06:36 peter
  3782. * fixed the name changes
  3783. Revision 1.1 1998/06/23 14:00:17 peter
  3784. * renamed RA* units
  3785. Revision 1.13 1998/06/16 08:56:29 peter
  3786. + targetcpu
  3787. * cleaner pmodules for newppu
  3788. Revision 1.12 1998/06/12 10:32:35 pierre
  3789. * column problem hopefully solved
  3790. + C vars declaration changed
  3791. Revision 1.11 1998/05/31 14:13:35 peter
  3792. * fixed call bugs with assembler readers
  3793. + OPR_SYMBOL to hold a symbol in the asm parser
  3794. * fixed staticsymtable vars which were acessed through %ebp instead of
  3795. name
  3796. Revision 1.10 1998/05/30 14:31:08 peter
  3797. + $ASMMODE
  3798. Revision 1.9 1998/05/29 09:58:16 pierre
  3799. * OPR_REGISTER for 1 arg was missing in ratti386.pas
  3800. (probably a merging problem)
  3801. * errors at start of line were lost
  3802. Revision 1.8 1998/05/28 16:34:36 carl
  3803. * call bugfix
  3804. * operand with regs bugfix (manual patch in both cases)
  3805. Revision 1.7 1998/05/23 01:21:27 peter
  3806. + aktasmmode, aktoptprocessor, aktoutputformat
  3807. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  3808. + $LIBNAME to set the library name where the unit will be put in
  3809. * splitted cgi386 a bit (codeseg to large for bp7)
  3810. * nasm, tasm works again. nasm moved to ag386nsm.pas
  3811. Revision 1.6 1998/05/20 09:42:37 pierre
  3812. + UseTokenInfo now default
  3813. * unit in interface uses and implementation uses gives error now
  3814. * only one error for unknown symbol (uses lastsymknown boolean)
  3815. the problem came from the label code !
  3816. + first inlined procedures and function work
  3817. (warning there might be allowed cases were the result is still wrong !!)
  3818. * UseBrower updated gives a global list of all position of all used symbols
  3819. with switch -gb
  3820. Revision 1.5 1998/04/29 13:52:23 peter
  3821. * small optimize fix
  3822. Revision 1.4 1998/04/29 10:34:04 pierre
  3823. + added some code for ansistring (not complete nor working yet)
  3824. * corrected operator overloading
  3825. * corrected nasm output
  3826. + started inline procedures
  3827. + added starstarn : use ** for exponentiation (^ gave problems)
  3828. + started UseTokenInfo cond to get accurate positions
  3829. Revision 1.3 1998/04/08 16:58:07 pierre
  3830. * several bugfixes
  3831. ADD ADC and AND are also sign extended
  3832. nasm output OK (program still crashes at end
  3833. and creates wrong assembler files !!)
  3834. procsym types sym in tdef removed !!
  3835. }