ra386att.pas 145 KB

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