ra386att.pas 155 KB

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