ra386att.pas 151 KB

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