ra386int.pas 141 KB

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