FoxAMDBackend.Mod 138 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618
  1. MODULE FoxAMDBackend; (** AUTHOR ""; PURPOSE ""; *)
  2. IMPORT
  3. Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
  4. IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, BinaryCode := FoxBinaryCode,
  5. InstructionSet := FoxAMD64InstructionSet, Assembler := FoxAMD64Assembler, SemanticChecker := FoxSemanticChecker, Formats := FoxFormats,
  6. Diagnostics, Streams, Options, Strings, ObjectFileFormat := FoxBinaryObjectFile, Compiler,
  7. Machine, D := Debugging, CodeGenerators := FoxCodeGenerators, ObjectFile;
  8. CONST
  9. (* constants for the register allocator *)
  10. none=-1;
  11. RAX=InstructionSet.regRAX; RCX=InstructionSet.regRCX; RDX=InstructionSet.regRDX; RBX=InstructionSet.regRBX;
  12. RSP=InstructionSet.regRSP; RBP=InstructionSet.regRBP; RSI=InstructionSet.regRSI; RDI=InstructionSet.regRDI;
  13. R8=InstructionSet.regR8; R9=InstructionSet.regR9; R10=InstructionSet.regR10; R11=InstructionSet.regR11;
  14. R12=InstructionSet.regR12; R13=InstructionSet.regR13; R14=InstructionSet.regR14; R15=InstructionSet.regR15;
  15. EAX=InstructionSet.regEAX; ECX=InstructionSet.regECX; EDX=InstructionSet.regEDX; EBX=InstructionSet.regEBX;
  16. ESP=InstructionSet.regESP; EBP=InstructionSet.regEBP; ESI=InstructionSet.regESI; EDI=InstructionSet.regEDI;
  17. R8D=InstructionSet.regR8D; R9D=InstructionSet.regR9D; R10D=InstructionSet.regR10D; R11D=InstructionSet.regR11D;
  18. R12D=InstructionSet.regR12D; R13D=InstructionSet.regR13D; R14D=InstructionSet.regR14D; R15D=InstructionSet.regR15D;
  19. AX=InstructionSet.regAX; CX=InstructionSet.regCX; DX=InstructionSet.regDX; BX=InstructionSet.regBX;
  20. SI=InstructionSet.regSI; DI=InstructionSet.regDI; BP=InstructionSet.regBP; SP=InstructionSet.regSP;
  21. R8W=InstructionSet.regR8W; R9W=InstructionSet.regR9W; R10W=InstructionSet.regR10W; R11W=InstructionSet.regR11W;
  22. R12W=InstructionSet.regR12W; R13W=InstructionSet.regR13W; R14W=InstructionSet.regR14W; R15W=InstructionSet.regR15W;
  23. AL=InstructionSet.regAL; CL=InstructionSet.regCL; DL=InstructionSet.regDL; BL=InstructionSet.regBL; SIL=InstructionSet.regSIL;
  24. DIL=InstructionSet.regDIL; BPL=InstructionSet.regBPL; SPL=InstructionSet.regSPL;
  25. R8B=InstructionSet.regR8B; R9B=InstructionSet.regR9B; R10B=InstructionSet.regR10B; R11B=InstructionSet.regR11B;
  26. R12B=InstructionSet.regR12B; R13B=InstructionSet.regR13B; R14B=InstructionSet.regR14B; R15B=InstructionSet.regR15B;
  27. AH=InstructionSet.regAH; CH=InstructionSet.regCH; DH=InstructionSet.regDH; BH=InstructionSet.regBH;
  28. ST0=InstructionSet.regST0;
  29. XMM0 = InstructionSet.regXMM0;
  30. XMM7 = InstructionSet.regXMM7;
  31. Low=0; High=1;
  32. FrameSpillStack=TRUE;
  33. VAR registerOperands: ARRAY InstructionSet.numberRegisters OF Assembler.Operand;
  34. usePool: BOOLEAN;
  35. opEAX, opECX, opEDX, opEBX, opESP, opEBP,
  36. opESI, opEDI, opAX, opCX, opDX, opBX, opSI, opDI, opAL, opCL, opDL, opBL, opAH, opCH, opDH, opBH,opST0
  37. , opRSP, opRBP: Assembler.Operand;
  38. unusable,split,blocked,free: CodeGenerators.Ticket;
  39. traceStackSize: LONGINT;
  40. TYPE
  41. Ticket=CodeGenerators.Ticket;
  42. PhysicalRegisters*=OBJECT (CodeGenerators.PhysicalRegisters)
  43. VAR
  44. toVirtual: ARRAY InstructionSet.numberRegisters OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
  45. reserved: ARRAY InstructionSet.numberRegisters OF BOOLEAN;
  46. hint: LONGINT;
  47. useFPU: BOOLEAN;
  48. PROCEDURE &InitPhysicalRegisters(fpu,cooperative: BOOLEAN);
  49. VAR i: LONGINT;
  50. BEGIN
  51. FOR i := 0 TO LEN(toVirtual)-1 DO
  52. toVirtual[i] := NIL;
  53. reserved[i] := FALSE;
  54. END;
  55. (* reserve stack and base pointer registers *)
  56. toVirtual[BPL] := unusable;
  57. toVirtual[SPL] := unusable;
  58. toVirtual[BP] := unusable;
  59. toVirtual[SP] := unusable;
  60. toVirtual[EBP] := unusable;
  61. toVirtual[ESP] := unusable;
  62. toVirtual[RBP] := unusable;
  63. toVirtual[RSP] := unusable;
  64. hint := none;
  65. useFPU := fpu
  66. END InitPhysicalRegisters;
  67. PROCEDURE AllocationHint(index: LONGINT);
  68. BEGIN hint := index
  69. END AllocationHint;
  70. PROCEDURE NumberRegisters(): LONGINT;
  71. BEGIN
  72. RETURN LEN(toVirtual)
  73. END NumberRegisters;
  74. END PhysicalRegisters;
  75. PhysicalRegisters32=OBJECT (PhysicalRegisters) (* 32 bit implementation *)
  76. PROCEDURE & InitPhysicalRegisters32(fpu,cooperative: BOOLEAN);
  77. VAR i: LONGINT;
  78. BEGIN
  79. InitPhysicalRegisters(fpu,cooperative);
  80. (* disable registers that are only usable in 64 bit mode *)
  81. FOR i := 0 TO 31 DO
  82. toVirtual[i+RAX] := unusable;
  83. END;
  84. FOR i := 8 TO 15 DO
  85. toVirtual[i+AL] := unusable;
  86. toVirtual[i+AH] := unusable;
  87. toVirtual[i+EAX] := unusable;
  88. toVirtual[i+AX] := unusable;
  89. END;
  90. FOR i := 4 TO 7 DO
  91. toVirtual[i+AL] := unusable;
  92. toVirtual[i+AH] := unusable;
  93. END;
  94. FOR i := 0 TO LEN(reserved)-1 DO reserved[i] := FALSE END;
  95. END InitPhysicalRegisters32;
  96. PROCEDURE Allocate(index: LONGINT; virtualRegister: Ticket);
  97. BEGIN
  98. (*
  99. D.String("allocate register x : index="); D.Int(index,1); D.Ln;
  100. *)
  101. Assert(toVirtual[index] = free,"register already allocated");
  102. toVirtual[index] := virtualRegister;
  103. IF index DIV 32 = 2 THEN (* 32 bit *)
  104. Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
  105. toVirtual[index MOD 32 + AX] := blocked;
  106. IF index MOD 32 < 4 THEN
  107. Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
  108. Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
  109. toVirtual[index MOD 32 + AL] := blocked;
  110. toVirtual[index MOD 32 + AH] := blocked;
  111. END;
  112. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  113. Assert(toVirtual[index MOD 8 + EAX] = free,"free register split");
  114. toVirtual[index MOD 32 + EAX] := split;
  115. IF index MOD 32 < 4 THEN
  116. Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
  117. Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
  118. toVirtual[index MOD 32 + AL] := blocked;
  119. toVirtual[index MOD 32 + AH] := blocked;
  120. END;
  121. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  122. Assert((toVirtual[index MOD 4 + EAX] = free) OR (toVirtual[index MOD 4 + EAX] = split),"free register blocked");
  123. Assert((toVirtual[index MOD 4 + AX] = free) OR (toVirtual[index MOD 4 + AX] = split),"free register blocked");
  124. toVirtual[index MOD 4 + EAX] := split;
  125. toVirtual[index MOD 4 + AX] := split;
  126. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  127. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  128. END;
  129. END Allocate;
  130. PROCEDURE SetReserved(index: LONGINT; res: BOOLEAN);
  131. BEGIN
  132. IF index DIV 32 <=2 THEN
  133. index := index MOD 16;
  134. reserved[index+AH] := res;
  135. reserved[index+AL] := res;
  136. reserved[index+AX] := res;
  137. reserved[index+EAX] := res;
  138. ELSE
  139. reserved[index] := res;
  140. END;
  141. END SetReserved;
  142. PROCEDURE Reserved(index: LONGINT): BOOLEAN;
  143. BEGIN
  144. RETURN (index>0) & reserved[index]
  145. END Reserved;
  146. PROCEDURE Free(index: LONGINT);
  147. VAR x: Ticket;
  148. BEGIN
  149. (*
  150. D.String("free register x : index="); D.Int(index,1); D.Ln;
  151. *)
  152. x := toVirtual[index];
  153. Assert((toVirtual[index] # NIL),"register not reserved");
  154. toVirtual[index] := free;
  155. IF index DIV 32 =2 THEN (* 32 bit *)
  156. Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
  157. toVirtual[index MOD 32 + AX] := free;
  158. IF index MOD 32 < 4 THEN
  159. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  160. Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
  161. toVirtual[index MOD 32 + AL] := free;
  162. toVirtual[index MOD 32 + AH] := free;
  163. END;
  164. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  165. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  166. toVirtual[index MOD 32 + EAX] := free;
  167. IF index MOD 32 < 4 THEN
  168. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  169. Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
  170. toVirtual[index MOD 32 + AL] := free;
  171. toVirtual[index MOD 32 + AH] := free;
  172. END;
  173. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  174. IF (toVirtual[index MOD 4 + AL] = free) & (toVirtual[index MOD 4 + AH] = free) THEN
  175. Assert(toVirtual[index MOD 4 + EAX] = split,"reserved register did not split");
  176. Assert(toVirtual[index MOD 4 + AX] = split,"reserved register did not split");
  177. toVirtual[index MOD 4 + EAX] := free;
  178. toVirtual[index MOD 4 + AX] := free;
  179. END;
  180. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  181. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  182. END;
  183. END Free;
  184. PROCEDURE NextFree(CONST type: IntermediateCode.Type):LONGINT;
  185. VAR i,sizeInBits,length, form: LONGINT;
  186. PROCEDURE GetGPHint(offset: LONGINT): LONGINT;
  187. VAR res: LONGINT;
  188. BEGIN
  189. IF (hint # none) & (hint >= AL) & (hint <= EDI) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint MOD 32 + offset ELSE res := none END;
  190. hint := none;
  191. RETURN res
  192. END GetGPHint;
  193. PROCEDURE GetHint(from,to: LONGINT): LONGINT;
  194. VAR res: LONGINT;
  195. BEGIN
  196. IF (hint # none) & (hint >= from) & (hint <= to) & (toVirtual[hint]=free) & ~Reserved(hint) THEN res := hint ELSE res := none END;
  197. hint := none;
  198. RETURN res
  199. END GetHint;
  200. PROCEDURE Get(from,to: LONGINT): LONGINT;
  201. VAR i: LONGINT;
  202. BEGIN
  203. i := from;
  204. IF from <= to THEN
  205. WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
  206. IF i > to THEN i := none END;
  207. ELSE
  208. WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
  209. IF i < to THEN i := none END;
  210. END;
  211. RETURN i
  212. END Get;
  213. BEGIN
  214. length := type.length;
  215. sizeInBits := type.sizeInBits;
  216. form := type.form;
  217. IF (type.length > 1) THEN
  218. IF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =4) THEN
  219. i := Get(XMM7, XMM0);
  220. ELSE
  221. HALT(100)
  222. END
  223. ELSIF type.form IN IntermediateCode.Integer THEN
  224. sizeInBits := type.sizeInBits;
  225. IF type.sizeInBits = IntermediateCode.Bits8 THEN
  226. i := GetGPHint(AL);
  227. IF i = none THEN i := Get(BL, AL) END;
  228. IF i = none THEN i := Get(BH, AH) END;
  229. ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
  230. i := GetGPHint(AX);
  231. IF i = none THEN i := Get(DI, SI) END;
  232. IF i = none THEN i := Get(BX, AX) END;
  233. ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
  234. i := GetGPHint(EAX);
  235. IF i = none THEN i := Get(EDI,ESI) END;
  236. IF i = none THEN i := Get(EBX,EAX) END;
  237. ELSE HALT(100)
  238. END;
  239. ELSE
  240. ASSERT(type.form = IntermediateCode.Float);
  241. IF useFPU THEN
  242. i := Get(InstructionSet.regST0, InstructionSet.regST6);
  243. (* ST7 unusable as it is overwritten during arithmetic instructions *)
  244. ELSE
  245. i := GetHint(XMM0, XMM7);
  246. IF i = none THEN i := Get(XMM7, XMM0) END
  247. END;
  248. END;
  249. hint := none; (* reset *)
  250. RETURN i
  251. END NextFree;
  252. PROCEDURE Mapped(physical: LONGINT): Ticket;
  253. VAR virtual: Ticket;
  254. BEGIN
  255. virtual := toVirtual[physical];
  256. IF virtual = blocked THEN virtual := Mapped(physical+32)
  257. ELSIF virtual = split THEN
  258. IF physical < 32 THEN virtual := Mapped(physical+16 MOD 32)
  259. ELSE virtual := Mapped(physical-32)
  260. END;
  261. END;
  262. ASSERT((virtual = free) OR (virtual = unusable) OR (toVirtual[virtual.register] = virtual));
  263. RETURN virtual
  264. END Mapped;
  265. PROCEDURE Dump(w: Streams.Writer);
  266. VAR i: LONGINT; virtual: Ticket;
  267. BEGIN
  268. w.String("; ---- registers ----"); w.Ln;
  269. FOR i := 0 TO LEN(toVirtual)-1 DO
  270. virtual := toVirtual[i];
  271. IF virtual # unusable THEN
  272. w.String("reg "); w.Int(i,1); w.String(": ");
  273. IF virtual = free THEN w.String("free")
  274. ELSIF virtual = blocked THEN w.String("blocked")
  275. ELSIF virtual = split THEN w.String("split")
  276. ELSE w.String(" r"); w.Int(virtual.register,1);
  277. END;
  278. IF reserved[i] THEN w.String("reserved") END;
  279. w.Ln;
  280. END;
  281. END;
  282. END Dump;
  283. END PhysicalRegisters32;
  284. PhysicalRegisters64=OBJECT (PhysicalRegisters) (* 64 bit implementation *)
  285. PROCEDURE & InitPhysicalRegisters64(fpu,cooperative: BOOLEAN);
  286. BEGIN
  287. InitPhysicalRegisters(fpu,cooperative);
  288. END InitPhysicalRegisters64;
  289. PROCEDURE SetReserved(index: LONGINT; res: BOOLEAN);
  290. BEGIN
  291. (*
  292. IF res THEN D.String("reserve ") ELSE D.String("unreserve ") END;
  293. D.String("register: index="); D.Int(index,1); D.Ln;
  294. *)
  295. IF index DIV 32 <=2 THEN
  296. index := index MOD 16;
  297. reserved[index+AH] := res;
  298. reserved[index+AL] := res;
  299. reserved[index+AX] := res;
  300. reserved[index+EAX] := res;
  301. reserved[index+RAX] := res;
  302. ELSE
  303. reserved[index] := res
  304. END;
  305. END SetReserved;
  306. PROCEDURE Reserved(index: LONGINT): BOOLEAN;
  307. BEGIN
  308. RETURN reserved[index]
  309. END Reserved;
  310. PROCEDURE Allocate(index: LONGINT; virtualRegister: Ticket);
  311. BEGIN
  312. (*
  313. D.String("allocate register x : index="); D.Int(index,1); D.Ln;
  314. *)
  315. Assert(toVirtual[index] = free,"register already allocated");
  316. toVirtual[index] := virtualRegister;
  317. IF index DIV 32 = 3 THEN (* 64 bit *)
  318. Assert(toVirtual[index MOD 32 + EAX] = free,"free register split");
  319. toVirtual[index MOD 32 + EAX] := blocked;
  320. toVirtual[index MOD 32 + AX] := blocked;
  321. toVirtual[index MOD 32 + AL] := blocked;
  322. ELSIF index DIV 32 = 2 THEN (* 32 bit *)
  323. Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
  324. toVirtual[index MOD 32 + RAX] := split;
  325. toVirtual[index MOD 32 + AX] := blocked;
  326. toVirtual[index MOD 32 + AL] := blocked;
  327. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  328. toVirtual[index MOD 32 + RAX] := split;
  329. toVirtual[index MOD 32 + EAX] := split;
  330. toVirtual[index MOD 32 + AL] := blocked;
  331. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  332. toVirtual[index MOD 32 + RAX] := split;
  333. toVirtual[index MOD 32 + EAX] := split;
  334. toVirtual[index MOD 32 + AX] := split;
  335. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  336. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  337. END;
  338. END Allocate;
  339. PROCEDURE Free(index: LONGINT);
  340. BEGIN
  341. (*
  342. D.String("release register x : index="); D.Int(index,1); D.Ln;
  343. *)
  344. Assert(toVirtual[index]#NIL,"register not reserved");
  345. toVirtual[index] := free;
  346. IF index DIV 32 =3 THEN (* 64 bit *)
  347. Assert(toVirtual[index MOD 32 + EAX] = blocked,"reserved register did not block");
  348. toVirtual[index MOD 32 + EAX] := free;
  349. toVirtual[index MOD 32 + AX] := free;
  350. toVirtual[index MOD 32 + AL] := free;
  351. ELSIF index DIV 32 =2 THEN (* 32 bit *)
  352. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  353. Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
  354. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
  355. toVirtual[index MOD 32 + RAX] := free;
  356. toVirtual[index MOD 32 + AX] := free;
  357. toVirtual[index MOD 32 + AL] := free;
  358. ELSIF index DIV 32 = 1 THEN (* 16 bit *)
  359. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  360. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  361. Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not split");
  362. toVirtual[index MOD 32 + RAX] := free;
  363. toVirtual[index MOD 32 + EAX] := free;
  364. toVirtual[index MOD 32 + AL] := free;
  365. ELSIF index DIV 32 = 0 THEN (* 8 bit *)
  366. Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
  367. Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
  368. Assert(toVirtual[index MOD 32 + AX] = split,"reserved register did not split");
  369. toVirtual[index MOD 32 + RAX] := free;
  370. toVirtual[index MOD 32 + EAX] := free;
  371. toVirtual[index MOD 32 + AX] := free;
  372. ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
  373. ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
  374. END;
  375. END Free;
  376. PROCEDURE NextFree(CONST type: IntermediateCode.Type): LONGINT;
  377. VAR i: LONGINT;
  378. PROCEDURE GetHint(offset: LONGINT): LONGINT;
  379. VAR res: LONGINT;
  380. BEGIN
  381. IF (hint # none) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint ELSE res := none END;
  382. hint := none;
  383. RETURN res
  384. END GetHint;
  385. PROCEDURE Get(from,to: LONGINT): LONGINT;
  386. VAR i: LONGINT;
  387. BEGIN
  388. i := from;
  389. IF from <= to THEN
  390. WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
  391. IF i > to THEN i := none END;
  392. ELSE
  393. WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
  394. IF i < to THEN i := none END;
  395. END;
  396. RETURN i
  397. END Get;
  398. BEGIN
  399. IF type.form IN IntermediateCode.Integer THEN
  400. IF type.sizeInBits = IntermediateCode.Bits8 THEN
  401. i := GetHint(AL);
  402. IF i = none THEN i := Get(BL, AL) END;
  403. IF i = none THEN i := Get(BH, AH) END;
  404. IF i = none THEN
  405. i := Get(AL,R15B)
  406. END;
  407. ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
  408. i := GetHint(AX);
  409. IF i = none THEN i := Get(DI, SI) END;
  410. IF i = none THEN i := Get(BX, AX) END;
  411. IF i = none THEN
  412. i := Get(AX,R15W);
  413. END;
  414. ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
  415. i := GetHint(EAX);
  416. IF i = none THEN i := Get(EDI,ESI) END;
  417. IF i = none THEN i := Get(EBX,EAX) END;
  418. IF i = none THEN
  419. i := Get(EAX,R15D);
  420. END;
  421. ELSIF type.sizeInBits = IntermediateCode.Bits64 THEN
  422. i := GetHint(RAX);
  423. IF i = none THEN i := Get(RDI,RSI) END;
  424. IF i = none THEN i := Get(RBX,RAX) END;
  425. IF i = none THEN
  426. i := Get(RAX, R15)
  427. END;
  428. ELSE HALT(100)
  429. END;
  430. ELSE
  431. ASSERT(type.form = IntermediateCode.Float);
  432. IF useFPU THEN
  433. i := Get(InstructionSet.regST0, InstructionSet.regST6);
  434. (* ST7 unusable as it is overwritten during arithmetic instructions *)
  435. ELSE
  436. i := Get(XMM7, XMM0)
  437. END;
  438. END;
  439. RETURN i;
  440. END NextFree;
  441. PROCEDURE Mapped(physical: LONGINT): Ticket;
  442. VAR virtual: Ticket;
  443. BEGIN
  444. virtual := toVirtual[physical];
  445. IF virtual = blocked THEN RETURN Mapped(physical+32) END;
  446. IF virtual = split THEN RETURN Mapped(physical-32) END;
  447. RETURN virtual
  448. END Mapped;
  449. END PhysicalRegisters64;
  450. CodeGeneratorAMD64 = OBJECT (CodeGenerators.GeneratorWithTickets)
  451. VAR
  452. (* static generator state variables, considered constant during generation *)
  453. runtimeModuleName: SyntaxTree.IdentifierString;
  454. cpuBits: LONGINT;
  455. opBP, opSP, opRA, opRB, opRC, opRD, opRSI, opRDI, opR8, opR9, opR10, opR11, opR12, opR13, opR14, opR15: Assembler.Operand; (* base pointer, stack pointer, register A, depends on cpuBits*)
  456. BP, SP, RA, RD, RS, RC: LONGINT; (* base pointer and stack pointer register index, depends on cpuBits *)
  457. emitter: Assembler.Emitter; (* assembler generating and containing the machine code *)
  458. backend: BackendAMD64;
  459. (* register spill state *)
  460. stackSize: LONGINT;
  461. spillStackStart: LONGINT;
  462. (* floating point stack state *)
  463. fpStackPointer: LONGINT; (* floating point stack pointer, increases with allocation, decreases with releasing, used to determine current relative position on stack (as is necessary for intel FP instructions) *)
  464. (*
  465. FP register usage scheme:
  466. sp=1> FP0 - temp
  467. sp=0> FP0 - reg0 FP1 - reg0 sp=0> FP0 - reg0
  468. FP1 - reg1 FP2 - reg1 FP1 - reg1
  469. FP2 - reg2 FP3 - reg2 FP2 - reg2
  470. FP3 - reg3 = load op1 => FP4 - reg3 = op => FP3 - reg3
  471. FP4 - reg4 FP5 - reg4 FP4 - reg4
  472. FP5 - reg5 FP6 - reg5 FP5 - reg5
  473. FP6 - reg6 FP7 - reg6 FP6 - reg6
  474. FP7 - reg7 (reg7 lost) FP7 - reg7
  475. *)
  476. ap: Ticket;
  477. (* -------------------------- constructor -------------------------------*)
  478. PROCEDURE &InitGeneratorAMD64(CONST runtime: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; backend: BackendAMD64);
  479. VAR physicalRegisters: PhysicalRegisters; physicalRegisters32: PhysicalRegisters32; physicalRegisters64: PhysicalRegisters64;
  480. BEGIN
  481. SELF.backend := backend;
  482. runtimeModuleName := runtime;
  483. SELF.cpuBits := backend.bits;
  484. NEW(emitter,diagnostics);
  485. IF cpuBits=32 THEN
  486. NEW(physicalRegisters32, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters32; error := ~emitter.SetBits(32);
  487. opBP := opEBP; opSP := opESP; opRA := opEAX; opRB := opEBX; opRD := opEDX; opRDI := opEDI; opRSI := opESI; opRC := opECX;
  488. SP := ESP; BP := EBP; RA := EAX;
  489. RD := EDI; RS := ESI; RC := ECX;
  490. ASSERT(~error);
  491. ELSIF cpuBits=64 THEN
  492. NEW(physicalRegisters64, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters64; error := ~emitter.SetBits(64);
  493. opBP := opRBP; opSP := opRSP;
  494. opRA := registerOperands[RAX]; opRC := registerOperands[RCX];
  495. opRB := registerOperands[RBX]; opRD := registerOperands[RDX];
  496. opRDI := registerOperands[RDI]; opRSI := registerOperands[RSI];
  497. opR8 := registerOperands[R8]; opR9 := registerOperands[R9];
  498. opR10 := registerOperands[R10]; opR11 := registerOperands[R11];
  499. opR12 := registerOperands[R12]; opR13 := registerOperands[R13];
  500. opR14 := registerOperands[R14]; opR15 := registerOperands[R15];
  501. SP := RSP; BP := RBP; RA := RAX;
  502. RD := RDI; RS := RSI; RC := RCX;
  503. ASSERT(~error);
  504. ELSE Halt("no register allocator for bits other than 32 / 64 ");
  505. END;
  506. fpStackPointer := 0;
  507. InitTicketGenerator(diagnostics,backend.optimize,2,physicalRegisters);
  508. END InitGeneratorAMD64;
  509. (*------------------- overwritten methods ----------------------*)
  510. PROCEDURE Section(in: IntermediateCode.Section; out: BinaryCode.Section);
  511. VAR oldSpillStackSize: LONGINT;
  512. PROCEDURE CheckEmptySpillStack;
  513. BEGIN
  514. IF spillStack.Size()#0 THEN Error(Basic.invalidPosition,"implementation error, spill stack not cleared") END;
  515. END CheckEmptySpillStack;
  516. BEGIN
  517. spillStack.Init;
  518. IF backend.cooperative THEN
  519. ap := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.UnsignedIntegerType(cpuBits),RC,in.pc);
  520. ap.spillable := FALSE;
  521. END;
  522. emitter.SetCode(out);
  523. Section^(in,out);
  524. IF FrameSpillStack & (spillStack.MaxSize() >0) THEN
  525. oldSpillStackSize := spillStack.MaxSize();
  526. out.Reset;
  527. CheckEmptySpillStack;
  528. Section^(in,out);
  529. ASSERT(spillStack.MaxSize() = oldSpillStackSize);
  530. END;
  531. ASSERT(fpStackPointer = 0);
  532. CheckEmptySpillStack;
  533. IF backend.cooperative THEN
  534. UnmapTicket(ap);
  535. END;
  536. error := error OR emitter.error;
  537. END Section;
  538. PROCEDURE Supported(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  539. BEGIN
  540. COPY(runtimeModuleName, moduleName);
  541. IF (cpuBits=32) & (instruction.op2.type.sizeInBits = IntermediateCode.Bits64) & (instruction.op2.type.form IN IntermediateCode.Integer) THEN
  542. CASE instruction.opcode OF
  543. IntermediateCode.div:
  544. procedureName := "DivH"; RETURN FALSE
  545. | IntermediateCode.mul:
  546. procedureName := "MulH"; RETURN FALSE
  547. | IntermediateCode.mod :
  548. procedureName := "ModH"; RETURN FALSE
  549. | IntermediateCode.abs :
  550. procedureName := "AbsH"; RETURN FALSE;
  551. | IntermediateCode.shl :
  552. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  553. procedureName := "AslH"; RETURN FALSE;
  554. ELSE
  555. procedureName := "LslH"; RETURN FALSE;
  556. END;
  557. | IntermediateCode.shr :
  558. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  559. procedureName := "AsrH"; RETURN FALSE;
  560. ELSE
  561. procedureName := "LsrH"; RETURN FALSE;
  562. END;
  563. | IntermediateCode.ror :
  564. procedureName := "RorH"; RETURN FALSE;
  565. | IntermediateCode.rol :
  566. procedureName := "RolH"; RETURN FALSE;
  567. | IntermediateCode.cas :
  568. procedureName := "CasH"; RETURN FALSE;
  569. ELSE RETURN TRUE
  570. END;
  571. ELSIF ~backend.forceFPU & (instruction.opcode = IntermediateCode.conv) & (instruction.op1.type.form IN IntermediateCode.Integer) & (instruction.op2.type.form = IntermediateCode.Float) & IsComplex(instruction.op1) THEN
  572. IF instruction.op2.type.sizeInBits=32 THEN
  573. procedureName := "EntierRH"
  574. ELSE
  575. procedureName := "EntierXH"
  576. END;
  577. RETURN FALSE
  578. END;
  579. RETURN TRUE
  580. END Supported;
  581. (* input: type (such as that of an intermediate operand), output: low and high type (such as in low and high type of an operand) *)
  582. PROCEDURE GetPartType(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
  583. BEGIN
  584. ASSERT(type.sizeInBits >0);
  585. IF (type.sizeInBits > cpuBits) & (type.form IN IntermediateCode.Integer) THEN
  586. IntermediateCode.InitType(typePart,type.form,32);
  587. ELSE ASSERT((type.form IN IntermediateCode.Integer) OR (type.form = IntermediateCode.Float));
  588. IF part=Low THEN typePart := type ELSE typePart := IntermediateCode.undef END;
  589. END;
  590. END GetPartType;
  591. (* simple move without conversion *)
  592. PROCEDURE Move(VAR dest, src: Assembler.Operand; CONST type: IntermediateCode.Type);
  593. BEGIN
  594. IF type.length > 1 THEN
  595. IF type.length = 4 THEN
  596. (*ASSERT(type.form = IntermediateCode.Float);*)
  597. IF (*(type.form = IntermediateCode.Float) & *) (type.sizeInBits = 32) THEN
  598. SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  599. ELSIF (type.sizeInBits = 16) THEN
  600. SpecialMove(InstructionSet.opMOVQ, InstructionSet.opMOVQ, TRUE, dest, src, type);
  601. ELSIF (type.sizeInBits = 8) THEN
  602. SpecialMove(InstructionSet.opMOVD, InstructionSet.opMOVD, TRUE, dest, src, type);
  603. END;
  604. ELSE
  605. (*
  606. ASSERT(type.form = IntermediateCode.Float);
  607. *)
  608. ASSERT(type.sizeInBits = 64);
  609. SpecialMove(InstructionSet.opMOVUPD, InstructionSet.opMOVUPS, TRUE, dest, src, type);
  610. END;
  611. ELSIF type.form = IntermediateCode.Float THEN
  612. IF type.sizeInBits = 32 THEN
  613. SpecialMove(InstructionSet.opMOVSS, InstructionSet.opMOVSS, TRUE, dest, src, type);
  614. ELSE
  615. SpecialMove(InstructionSet.opMOVSD, InstructionSet.opMOVSD, TRUE, dest, src, type);
  616. END;
  617. ELSE
  618. SpecialMove(InstructionSet.opMOV, InstructionSet.opMOV, TRUE, dest, src, type);
  619. END;
  620. END Move;
  621. PROCEDURE ToSpillStack(ticket: Ticket);
  622. VAR op: Assembler.Operand;
  623. BEGIN
  624. IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
  625. emitter.Emit1(InstructionSet.opFLD,registerOperands[ticket.register]);
  626. INC(fpStackPointer);
  627. GetSpillOperand(ticket,op);
  628. emitter.Emit1(InstructionSet.opFSTP,op);
  629. DEC(fpStackPointer);
  630. ELSE
  631. GetSpillOperand(ticket,op);
  632. Move(op, registerOperands[ticket.register], ticket.type)
  633. END;
  634. END ToSpillStack;
  635. PROCEDURE AllocateSpillStack(size: LONGINT);
  636. BEGIN
  637. IF ~FrameSpillStack THEN
  638. AllocateStack(cpuBits DIV 8*size)
  639. END;
  640. END AllocateSpillStack;
  641. PROCEDURE ToRegister(ticket: Ticket);
  642. VAR op: Assembler.Operand;
  643. BEGIN
  644. GetSpillOperand(ticket,op);
  645. emitter.Emit2(InstructionSet.opMOV,registerOperands[ticket.register],op);
  646. END ToRegister;
  647. PROCEDURE ExchangeTickets(ticket1,ticket2: Ticket);
  648. VAR op1,op2: Assembler.Operand;
  649. BEGIN
  650. TicketToOperand(ticket1, op1);
  651. TicketToOperand(ticket2, op2);
  652. emitter.Emit2(InstructionSet.opXCHG, op1,op2);
  653. END ExchangeTickets;
  654. (*------------------- particular register mappings / operands ----------------------*)
  655. (* returns if a virtual register is mapped to the register set described by virtualRegisterMapping*)
  656. PROCEDURE MappedTo(CONST virtualRegister: LONGINT; part:LONGINT; physicalRegister: LONGINT): BOOLEAN;
  657. VAR ticket: Ticket;
  658. BEGIN
  659. IF (virtualRegister > 0) THEN
  660. ticket := virtualRegisters.Mapped(virtualRegister,part);
  661. RETURN (ticket # NIL) & ~(ticket.spilled) & (ticket.register = physicalRegister)
  662. ELSIF (virtualRegister = IntermediateCode.FP) THEN
  663. RETURN physicalRegister= BP
  664. ELSIF (virtualRegister = IntermediateCode.SP) THEN
  665. RETURN physicalRegister = SP
  666. ELSIF (virtualRegister = IntermediateCode.AP) THEN
  667. ASSERT(backend.cooperative);
  668. RETURN ~(ap.spilled) & (ap.register = physicalRegister)
  669. ELSE
  670. RETURN FALSE
  671. END;
  672. END MappedTo;
  673. PROCEDURE ResultRegister(CONST type: IntermediateCode.Type; part: LONGINT): LONGINT;
  674. BEGIN
  675. IF type.form IN IntermediateCode.Integer THEN
  676. CASE type.sizeInBits OF
  677. | 64:
  678. IF cpuBits = 32 THEN
  679. IF part = Low THEN RETURN EAX
  680. ELSE RETURN EDX
  681. END;
  682. ELSE
  683. ASSERT(part = Low);
  684. RETURN RAX
  685. END;
  686. | 32: ASSERT(part=Low); RETURN EAX
  687. | 16: ASSERT(part=Low); RETURN AX
  688. | 8: ASSERT(part=Low); RETURN AL
  689. END;
  690. ELSIF ~backend.forceFPU THEN
  691. RETURN XMM0
  692. ELSE ASSERT(type.form = IntermediateCode.Float);ASSERT(part=Low);
  693. RETURN ST0
  694. END;
  695. END ResultRegister;
  696. (*------------------- operand reflection ----------------------*)
  697. PROCEDURE IsMemoryOperand(vop: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  698. VAR ticket: Ticket;
  699. BEGIN
  700. IF vop.mode = IntermediateCode.ModeMemory THEN RETURN TRUE
  701. ELSIF vop.mode = IntermediateCode.ModeRegister THEN
  702. ticket := virtualRegisters.Mapped(vop.register,part);
  703. RETURN (ticket # NIL) & (ticket.spilled);
  704. ELSE RETURN FALSE
  705. END;
  706. END IsMemoryOperand;
  707. PROCEDURE IsRegister(CONST vop: IntermediateCode.Operand): BOOLEAN;
  708. BEGIN
  709. RETURN (vop.mode = IntermediateCode.ModeRegister) & (vop.offset = 0)
  710. END IsRegister;
  711. (* infer intermediate code type from physical operand as far as possible *)
  712. PROCEDURE PhysicalOperandType(CONST op:Assembler.Operand): IntermediateCode.Type;
  713. VAR type:IntermediateCode.Type;
  714. BEGIN
  715. IF op.type = Assembler.sti THEN
  716. IntermediateCode.InitType(type, IntermediateCode.Float, op.sizeInBytes*8)
  717. ELSE
  718. IntermediateCode.InitType(type, IntermediateCode.SignedInteger, op.sizeInBytes*8)
  719. END;
  720. RETURN type
  721. END PhysicalOperandType;
  722. (*------------------- operand generation ----------------------*)
  723. PROCEDURE GetSpillOperand(ticket: Ticket; VAR op: Assembler.Operand);
  724. BEGIN
  725. IF FrameSpillStack THEN
  726. op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8), BP , -(spillStackStart + cpuBits DIV 8 + ticket.offset*cpuBits DIV 8));
  727. ELSE
  728. op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8),SP , (spillStack.Size()-ticket.offset)*cpuBits DIV 8);
  729. END;
  730. END GetSpillOperand;
  731. PROCEDURE TicketToOperand(ticket: Ticket; VAR op: Assembler.Operand);
  732. BEGIN
  733. IF (ticket = NIL) THEN
  734. Assembler.InitOperand(op)
  735. ELSIF ticket.spilled THEN
  736. GetSpillOperand(ticket,op)
  737. ELSE
  738. IF ticket.register = none THEN physicalRegisters.Dump(D.Log); tickets.Dump(D.Log); virtualRegisters.Dump(D.Log); D.Update; END;
  739. ASSERT(ticket.register # none);
  740. IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
  741. op := registerOperands[ticket.register+fpStackPointer]
  742. ELSE
  743. op := registerOperands[ticket.register];
  744. END;
  745. END;
  746. END TicketToOperand;
  747. PROCEDURE GetTemporaryRegister(type: IntermediateCode.Type; VAR op: Assembler.Operand);
  748. BEGIN
  749. TicketToOperand(TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type),op)
  750. END GetTemporaryRegister;
  751. PROCEDURE GetImmediateMem(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR imm: Assembler.Operand);
  752. VAR data: IntermediateCode.Section;pc: LONGINT;
  753. BEGIN
  754. data := GetDataSection();
  755. pc := IntermediateBackend.EnterImmediate(data,vop);
  756. Assembler.InitMem(imm, SHORT(vop.type.sizeInBits DIV 8) , Assembler.none,0);
  757. Assembler.SetSymbol(imm,data.name,0,pc,0);
  758. END GetImmediateMem;
  759. PROCEDURE GetImmediate(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand; forbidden16Bit: BOOLEAN);
  760. VAR type: IntermediateCode.Type; temp: Assembler.Operand; size: SHORTINT; value: HUGEINT;
  761. PROCEDURE IsImm8(value: HUGEINT): BOOLEAN;
  762. BEGIN
  763. RETURN (value >= -80H) & (value < 80H)
  764. END IsImm8;
  765. PROCEDURE IsImm16(value: HUGEINT): BOOLEAN;
  766. BEGIN
  767. RETURN (value >= -8000H) & (value < 10000H)
  768. END IsImm16;
  769. PROCEDURE IsImm32(value: HUGEINT): BOOLEAN;
  770. BEGIN
  771. value := value DIV 10000H DIV 10000H;
  772. RETURN (value = 0) OR (value=-1);
  773. END IsImm32;
  774. BEGIN
  775. ASSERT(virtual.mode = IntermediateCode.ModeImmediate);
  776. GetPartType(virtual.type,part,type);
  777. IF virtual.type.form IN IntermediateCode.Integer THEN
  778. IF IsComplex(virtual) THEN
  779. IF part = High THEN value := SHORT(virtual.intValue DIV 10000H DIV 10000H)
  780. ELSE value := virtual.intValue
  781. END;
  782. ELSE value := virtual.intValue
  783. END;
  784. IF virtual.symbol.name # "" THEN size := SHORT(type.sizeInBits DIV 8);
  785. ELSIF forbidden16Bit & IsImm16(value) & ~(IsImm8(value)) THEN size := Assembler.bits32;
  786. ELSIF (type.sizeInBits = 64) & (type.form = IntermediateCode.UnsignedInteger) & (value > MAX(LONGINT)) THEN
  787. size := 8; (* don't use negative signed 32-bit value to encode 64-bit unsigned value! *)
  788. ELSE size := 0
  789. END;
  790. Assembler.InitImm(physical,size ,value);
  791. IF virtual.symbol.name # "" THEN Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+part*Assembler.bits32) END;
  792. IF (cpuBits=64) & ((physical.sizeInBytes=8) OR ~IsImm32(value)) THEN
  793. ASSERT(cpuBits=64);
  794. GetTemporaryRegister(IntermediateCode.int64,temp);
  795. emitter.Emit2(InstructionSet.opMOV,temp,physical);
  796. physical := temp;
  797. END;
  798. ELSE
  799. GetImmediateMem(virtual,part,physical);
  800. END;
  801. END GetImmediate;
  802. PROCEDURE GetMemory(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand);
  803. VAR type: IntermediateCode.Type; virtualRegister, physicalRegister,offset: LONGINT; ticket,orig: Ticket; dest, source: Assembler.Operand;
  804. BEGIN
  805. ASSERT(virtual.mode = IntermediateCode.ModeMemory);
  806. GetPartType(virtual.type,part,type);
  807. IF virtual.register # IntermediateCode.None THEN
  808. virtualRegister := virtual.register;
  809. IF virtualRegister = IntermediateCode.FP THEN physicalRegister := BP;
  810. ELSIF virtualRegister = IntermediateCode.SP THEN physicalRegister := SP;
  811. ELSE
  812. IF virtualRegister = IntermediateCode.AP THEN
  813. ticket := ap;
  814. ELSE
  815. ticket := virtualRegisters.Mapped(virtualRegister,Low);
  816. END;
  817. IF ticket.spilled THEN
  818. IF physicalRegisters.Reserved(ticket.register) THEN
  819. orig := ticket;
  820. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
  821. TicketToOperand(orig,source);
  822. TicketToOperand(ticket,dest);
  823. Move(dest,source,PhysicalOperandType(dest));
  824. physicalRegister := ticket.register;
  825. ELSE
  826. UnSpill(ticket);
  827. physicalRegister := ticket.register;
  828. END;
  829. ELSE
  830. physicalRegister := ticket.register;
  831. END;
  832. END;
  833. offset := virtual.offset;
  834. ASSERT(virtual.intValue = 0);
  835. ELSIF virtual.symbol.name # "" THEN
  836. physicalRegister := Assembler.none;
  837. offset := virtual.offset;
  838. ASSERT(virtual.intValue = 0);
  839. ELSE
  840. physicalRegister := Assembler.none;
  841. offset := SHORT(virtual.intValue);
  842. ASSERT(virtual.offset = 0);
  843. END;
  844. Assembler.InitMem(physical, SHORTINT(type.length * type.sizeInBits DIV 8) , physicalRegister, offset+4*part);
  845. IF virtual.symbol.name # "" THEN
  846. Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+4*part);
  847. END;
  848. END GetMemory;
  849. PROCEDURE HardwareIntegerRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  850. BEGIN
  851. index := index MOD 32;
  852. sizeInBits := sizeInBits DIV 8;
  853. WHILE sizeInBits > 1 DO (* jump to register section that corresponds to the number of bits *)
  854. INC(index,32);
  855. sizeInBits := sizeInBits DIV 2;
  856. END;
  857. RETURN index
  858. END HardwareIntegerRegister;
  859. PROCEDURE HardwareFloatRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  860. BEGIN HALT(200); (* not yet implemented *)
  861. END HardwareFloatRegister;
  862. PROCEDURE GetTypedHardwareRegister(index: LONGINT; type: IntermediateCode.Type): LONGINT;
  863. VAR size: LONGINT;
  864. BEGIN
  865. IF type.form IN IntermediateCode.Integer THEN
  866. RETURN HardwareIntegerRegister(index, type.sizeInBits)
  867. ELSIF type.form = IntermediateCode.Float THEN
  868. RETURN HardwareFloatRegister(index, type.sizeInBits)
  869. ELSE
  870. HALT(100);
  871. END;
  872. END GetTypedHardwareRegister;
  873. (* returns the following register (or part thereof)
  874. 0: regRAX;
  875. 1: regRCX;
  876. 2: regRDX;
  877. 3: regRBX;
  878. 4: regRSP;
  879. 5: regRBP;
  880. 6: regRSI;
  881. 7: regRDI;
  882. 8 .. 15: regRx;
  883. *)
  884. PROCEDURE ParameterRegister(CONST type: IntermediateCode.Type; index: LONGINT): LONGINT;
  885. VAR physical: LONGINT;
  886. BEGIN
  887. RETURN GetTypedHardwareRegister(RAX + index, type);
  888. ASSERT(0 <= index);
  889. ASSERT(index <= 15);
  890. RETURN physical;
  891. END ParameterRegister;
  892. PROCEDURE GetRegister(CONST virtual: IntermediateCode.Operand; part:LONGINT; VAR physical: Assembler.Operand; VAR ticket: Ticket);
  893. VAR type: IntermediateCode.Type; virtualRegister, tempReg: LONGINT;
  894. tmp,imm: Assembler.Operand; index: LONGINT;
  895. BEGIN
  896. ASSERT(virtual.mode = IntermediateCode.ModeRegister);
  897. GetPartType(virtual.type,part,type);
  898. virtualRegister := virtual.register;
  899. IF (virtual.register > 0) THEN
  900. TicketToOperand(virtualRegisters.Mapped(virtual.register,part), physical);
  901. ELSIF virtual.register = IntermediateCode.FP THEN
  902. Assert(part=Low,"forbidden partitioned register on BP");
  903. physical := opBP;
  904. ELSIF virtual.register = IntermediateCode.SP THEN
  905. Assert(part=Low,"forbidden partitioned register on SP");
  906. physical := opSP;
  907. ELSIF virtual.register = IntermediateCode.AP THEN
  908. ASSERT(backend.cooperative);
  909. Assert(part=Low,"forbidden partitioned register on AP");
  910. TicketToOperand(ap, physical);
  911. ELSE HALT(100);
  912. END;
  913. IF virtual.offset # 0 THEN
  914. Assert(type.form # IntermediateCode.Float,"forbidden offset on float");
  915. IF ticket = NIL THEN
  916. tempReg := ForceFreeRegister(type);
  917. TicketToOperand(ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,tempReg,inPC),tmp);
  918. ELSE
  919. TicketToOperand(ticket, tmp);
  920. ticket := NIL;
  921. END;
  922. IF Assembler.IsRegisterOperand(physical) & (type.sizeInBits > 8) THEN
  923. Assembler.InitMem(physical,SHORTINT(type.length * type.sizeInBits DIV 8) , physical.register, virtual.offset);
  924. emitter.Emit2(InstructionSet.opLEA, tmp,physical);
  925. ELSE
  926. emitter.Emit2(InstructionSet.opMOV,tmp,physical);
  927. Assembler.InitImm(imm,0 ,virtual.offset);
  928. emitter.Emit2(InstructionSet.opADD,tmp,imm);
  929. END;
  930. physical := tmp;
  931. END;
  932. END GetRegister;
  933. (* make physical operand from virtual operand, if ticket given then write result into phyiscal register represented by ticket *)
  934. PROCEDURE MakeOperand(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand; ticket: Ticket);
  935. VAR tmp: Assembler.Operand;
  936. BEGIN
  937. TryAllocate(vop,part);
  938. CASE vop.mode OF
  939. IntermediateCode.ModeMemory: GetMemory(vop,part,op);
  940. |IntermediateCode.ModeRegister: GetRegister(vop,part,op,ticket);
  941. |IntermediateCode.ModeImmediate: GetImmediate(vop,part,op,FALSE);
  942. END;
  943. IF ticket # NIL THEN
  944. TicketToOperand(ticket, tmp);
  945. emitter.Emit2(InstructionSet.opMOV, tmp, op);
  946. (* should work but does not
  947. IF Assembler.IsRegisterOperand(op) THEN ReleaseHint(op.register) END;
  948. *)
  949. op := tmp;
  950. END;
  951. END MakeOperand;
  952. (* make physical register operand from virtual operand *)
  953. PROCEDURE MakeRegister(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand);
  954. VAR previous: Assembler.Operand; temp: Ticket;
  955. BEGIN
  956. MakeOperand(vop,part,op,NIL);
  957. IF ~Assembler.IsRegisterOperand(op) THEN
  958. previous := op;
  959. temp := TemporaryTicket(vop.registerClass,vop.type);
  960. TicketToOperand(temp,op);
  961. Move(op, previous, vop.type);
  962. END;
  963. END MakeRegister;
  964. (*------------------- helpers for code generation ----------------------*)
  965. (* move, potentially with conversion. parameter back used for moving back from temporary operand*)
  966. PROCEDURE SpecialMove(op, back: LONGINT; canStoreToMemory: BOOLEAN; VAR dest,src: Assembler.Operand; type: IntermediateCode.Type);
  967. VAR temp: Assembler.Operand; ticket: Ticket;
  968. BEGIN
  969. IF Assembler.SameOperand(src,dest) THEN (* do nothing *)
  970. ELSIF ~Assembler.IsMemoryOperand(dest) OR (~Assembler.IsMemoryOperand(src) & canStoreToMemory) THEN
  971. emitter.Emit2(op,dest,src);
  972. ELSE
  973. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  974. TicketToOperand(ticket,temp);
  975. emitter.Emit2(op,temp,src);
  976. emitter.Emit2(back,dest,temp);
  977. UnmapTicket(ticket);
  978. END;
  979. END SpecialMove;
  980. PROCEDURE AllocateStack(sizeInBytes: LONGINT);
  981. VAR sizeOp: Assembler.Operand; opcode: LONGINT;
  982. BEGIN
  983. ASSERT(sizeInBytes MOD 4 (* (cpuBits DIV 8) *) = 0);
  984. IF sizeInBytes < 0 THEN
  985. sizeInBytes := -sizeInBytes; opcode := InstructionSet.opADD;
  986. ELSIF sizeInBytes > 0 THEN
  987. opcode := InstructionSet.opSUB;
  988. ELSE RETURN
  989. END;
  990. IF sizeInBytes < 128 THEN sizeOp := Assembler.NewImm8(sizeInBytes);
  991. ELSE sizeOp := Assembler.NewImm32(sizeInBytes);
  992. END;
  993. emitter.Emit2(opcode,opSP,sizeOp);
  994. END AllocateStack;
  995. (*------------------- generation = emit dispatch / emit procedures ----------------------*)
  996. PROCEDURE IsFloat(CONST operand: IntermediateCode.Operand): BOOLEAN;
  997. BEGIN RETURN operand.type.form = IntermediateCode.Float
  998. END IsFloat;
  999. PROCEDURE IsComplex(CONST operand: IntermediateCode.Operand): BOOLEAN;
  1000. BEGIN RETURN (operand.type.form IN IntermediateCode.Integer) & (operand.type.sizeInBits > cpuBits)
  1001. END IsComplex;
  1002. PROCEDURE Generate(VAR instruction: IntermediateCode.Instruction);
  1003. VAR opcode: SHORTINT; ticket: Ticket; hwreg, lastUse, i, part: LONGINT;
  1004. BEGIN
  1005. (*!IF ((instruction.opcode = IntermediateCode.mov) OR (instruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
  1006. hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
  1007. Spill(physicalRegisters.Mapped(hwreg));
  1008. lastUse := inPC+1;
  1009. WHILE (lastUse < in.pc) &
  1010. ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
  1011. INC(lastUse)
  1012. END;
  1013. ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
  1014. END;
  1015. *)
  1016. ReserveOperandRegisters(instruction.op1,TRUE); ReserveOperandRegisters(instruction.op2,TRUE);ReserveOperandRegisters(instruction.op3,TRUE);
  1017. (*TryAllocate(instruction.op1,Low);
  1018. IF IsComplex(instruction.op1) THEN TryAllocate(instruction.op1,High) END;
  1019. *)
  1020. opcode := instruction.opcode;
  1021. CASE opcode OF
  1022. IntermediateCode.nop: (* do nothing *)
  1023. |IntermediateCode.mov:
  1024. IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
  1025. EmitMovFloat(instruction.op1,instruction.op2)
  1026. ELSE EmitMov(instruction.op1,instruction.op2,Low);
  1027. IF IsComplex(instruction.op1) THEN EmitMov(instruction.op1,instruction.op2, High) END;
  1028. END;
  1029. |IntermediateCode.conv:
  1030. IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
  1031. EmitConvertFloat(instruction)
  1032. ELSE
  1033. EmitConvert(instruction.op1,instruction.op2,Low);
  1034. IF IsComplex(instruction.op1) THEN EmitConvert(instruction.op1,instruction.op2,High) END;
  1035. END;
  1036. |IntermediateCode.call: EmitCall(instruction);
  1037. |IntermediateCode.enter: EmitEnter(instruction);
  1038. |IntermediateCode.leave: EmitLeave(instruction);
  1039. |IntermediateCode.exit: EmitExit(instruction);
  1040. |IntermediateCode.result:
  1041. IF IsFloat(instruction.op1) & backend.forceFPU THEN
  1042. EmitResultFPU(instruction)
  1043. ELSE
  1044. EmitResult(instruction);
  1045. END;
  1046. |IntermediateCode.return:
  1047. IF IsFloat(instruction.op1) & backend.forceFPU THEN
  1048. EmitReturnFPU(instruction)
  1049. ELSE
  1050. EmitReturn(instruction,Low);
  1051. IF IsComplex(instruction.op1) THEN EmitReturn(instruction, High) END;
  1052. END;
  1053. |IntermediateCode.trap: EmitTrap(instruction);
  1054. |IntermediateCode.br .. IntermediateCode.brlt: EmitBr(instruction)
  1055. |IntermediateCode.pop:
  1056. IF IsFloat(instruction.op1) THEN
  1057. EmitPopFloat(instruction.op1)
  1058. ELSE
  1059. EmitPop(instruction.op1,Low);
  1060. IF IsComplex(instruction.op1) THEN
  1061. EmitPop(instruction.op1,High)
  1062. END;
  1063. END;
  1064. |IntermediateCode.push:
  1065. IF IsFloat(instruction.op1) THEN
  1066. EmitPushFloat(instruction.op1)
  1067. ELSE
  1068. IF IsComplex(instruction.op1) THEN
  1069. EmitPush(instruction.op1,High);
  1070. END;
  1071. EmitPush(instruction.op1,Low)
  1072. END;
  1073. |IntermediateCode.neg:
  1074. IF IsFloat(instruction.op1) THEN
  1075. IF backend.forceFPU THEN
  1076. EmitArithmetic2FPU(instruction,InstructionSet.opFCHS)
  1077. ELSE
  1078. EmitNegXMM(instruction)
  1079. END;
  1080. ELSE EmitNeg(instruction);
  1081. END;
  1082. |IntermediateCode.not:
  1083. Assert(~IsFloat(instruction.op1),"instruction not supported for float");
  1084. EmitArithmetic2(instruction,Low,InstructionSet.opNOT);
  1085. IF IsComplex(instruction.op1) THEN EmitArithmetic2(instruction, High, InstructionSet.opNOT) END;
  1086. |IntermediateCode.abs:
  1087. IF IsFloat(instruction.op1) THEN
  1088. IF backend.forceFPU THEN
  1089. EmitArithmetic2FPU(instruction,InstructionSet.opFABS)
  1090. ELSE
  1091. EmitAbsXMM(instruction)
  1092. END;
  1093. ELSE EmitAbs(instruction);
  1094. END;
  1095. |IntermediateCode.mul:
  1096. IF IsFloat(instruction.op1) THEN
  1097. IF backend.forceFPU THEN
  1098. EmitArithmetic3FPU(instruction,InstructionSet.opFMUL)
  1099. ELSE
  1100. EmitArithmetic3XMM(instruction, InstructionSet.opMULSS, InstructionSet.opMULSD)
  1101. END;
  1102. ELSE
  1103. EmitMul(instruction);
  1104. END;
  1105. |IntermediateCode.div:
  1106. IF IsFloat(instruction.op1 )THEN
  1107. IF backend.forceFPU THEN
  1108. EmitArithmetic3FPU(instruction,InstructionSet.opFDIV)
  1109. ELSE
  1110. EmitArithmetic3XMM(instruction, InstructionSet.opDIVSS, InstructionSet.opDIVSD)
  1111. END;
  1112. ELSE
  1113. EmitDivMod(instruction);
  1114. END;
  1115. |IntermediateCode.mod:
  1116. Assert(~IsFloat(instruction.op1),"instruction not supported for float");
  1117. EmitDivMod(instruction);
  1118. |IntermediateCode.sub:
  1119. IF IsFloat(instruction.op1) THEN
  1120. IF backend.forceFPU THEN
  1121. EmitArithmetic3FPU(instruction,InstructionSet.opFSUB)
  1122. ELSE
  1123. EmitArithmetic3XMM(instruction, InstructionSet.opSUBSS, InstructionSet.opSUBSD)
  1124. END;
  1125. ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opSUB);
  1126. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opSBB) END;
  1127. END;
  1128. |IntermediateCode.add:
  1129. IF IsFloat(instruction.op1) THEN
  1130. IF backend.forceFPU THEN
  1131. EmitArithmetic3FPU(instruction,InstructionSet.opFADD)
  1132. ELSE
  1133. EmitArithmetic3XMM(instruction, InstructionSet.opADDSS, InstructionSet.opADDSD)
  1134. END;
  1135. ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opADD);
  1136. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opADC) END;
  1137. END;
  1138. |IntermediateCode.and:
  1139. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1140. EmitArithmetic3(instruction,InstructionSet.opAND);
  1141. |IntermediateCode.or:
  1142. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1143. EmitArithmetic3(instruction,InstructionSet.opOR);
  1144. |IntermediateCode.xor:
  1145. Assert(~IsFloat(instruction.op1),"operation not defined on float");
  1146. EmitArithmetic3(instruction,InstructionSet.opXOR);
  1147. |IntermediateCode.shl: EmitShift(instruction);
  1148. |IntermediateCode.shr: EmitShift(instruction);
  1149. |IntermediateCode.rol: EmitShift(instruction);
  1150. |IntermediateCode.ror: EmitShift(instruction);
  1151. |IntermediateCode.cas: EmitCas(instruction);
  1152. |IntermediateCode.copy: EmitCopy(instruction);
  1153. |IntermediateCode.fill: EmitFill(instruction,FALSE);
  1154. |IntermediateCode.asm: EmitAsm(instruction);
  1155. END;
  1156. ReserveOperandRegisters(instruction.op3,FALSE); ReserveOperandRegisters(instruction.op2,FALSE); ReserveOperandRegisters(instruction.op1,FALSE);
  1157. END Generate;
  1158. PROCEDURE PostGenerate(CONST instruction: IntermediateCode.Instruction);
  1159. VAR ticket: Ticket;
  1160. BEGIN
  1161. TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
  1162. ticket := tickets.live;
  1163. WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
  1164. UnmapTicket(ticket);
  1165. ticket := tickets.live
  1166. END;
  1167. END PostGenerate;
  1168. (* enter procedure: generate PAF and clear stack *)
  1169. PROCEDURE EmitEnter(CONST instruction: IntermediateCode.Instruction);
  1170. VAR op1,imm,target: Assembler.Operand; cc,size,numberMachineWords,destPC,firstPC,secondPC,x: LONGINT; body: SyntaxTree.Body; name: Basic.SegmentedName;
  1171. parametersSize: SIZE;
  1172. CONST initialize=TRUE; FirstOffset = 5; SecondOffset = 11;
  1173. BEGIN
  1174. stackSize := SHORT(instruction.op2.intValue);
  1175. size := stackSize;
  1176. INC(traceStackSize, stackSize);
  1177. IF initialize THEN
  1178. (* always including this instruction make trace insertion possible *)
  1179. IF backend.traceable THEN
  1180. emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
  1181. END;
  1182. ASSERT(size MOD opRA.sizeInBytes = 0);
  1183. numberMachineWords := size DIV opRA.sizeInBytes;
  1184. IF numberMachineWords >0 THEN
  1185. IF ~backend.traceable THEN
  1186. emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
  1187. END;
  1188. WHILE numberMachineWords MOD 4 # 0 DO
  1189. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1190. DEC(numberMachineWords);
  1191. END;
  1192. IF numberMachineWords >4 THEN
  1193. Assembler.InitImm(imm, 0, numberMachineWords DIV 4);
  1194. (* do not use EBX because it is not volative in WINAPI, do not use ECX: special register in COOP *)
  1195. emitter.Emit2(InstructionSet.opMOV, opRD, imm);
  1196. destPC := out.pc;
  1197. emitter.Emit1(InstructionSet.opDEC, opRD);
  1198. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1199. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1200. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1201. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1202. Assembler.InitOffset8(target,destPC);
  1203. emitter.Emit1(InstructionSet.opJNZ, target)
  1204. ELSE
  1205. WHILE numberMachineWords >0 DO
  1206. emitter.Emit1(InstructionSet.opPUSH, opRA);
  1207. DEC(numberMachineWords);
  1208. END;
  1209. END;
  1210. END;
  1211. IF spillStack.MaxSize()>0 THEN (* register spill stack, does not have to be initialized *)
  1212. op1 := Assembler.NewImm32(spillStack.MaxSize()*cpuBits DIV 8);
  1213. emitter.Emit2(InstructionSet.opSUB,opSP,op1);
  1214. END;
  1215. ELSE
  1216. op1 := Assembler.NewImm32(size+ spillStack.MaxSize());
  1217. emitter.Emit2(InstructionSet.opSUB,opSP,op1);
  1218. END;
  1219. cc := SHORT(instruction.op1.intValue);
  1220. IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
  1221. IF cpuBits = 32 THEN
  1222. (* the winapi calling convention presumes that all registers except EAX, EDX and ECX are retained by the callee *)
  1223. emitter.Emit1(InstructionSet.opPUSH,opEBX);
  1224. emitter.Emit1(InstructionSet.opPUSH,opEDI);
  1225. emitter.Emit1(InstructionSet.opPUSH,opESI);
  1226. ELSE ASSERT(cpuBits =64);
  1227. emitter.Emit1(InstructionSet.opPUSH,opRB);
  1228. emitter.Emit1(InstructionSet.opPUSH,opRDI);
  1229. emitter.Emit1(InstructionSet.opPUSH,opRSI);
  1230. emitter.Emit1(InstructionSet.opPUSH,opR12);
  1231. emitter.Emit1(InstructionSet.opPUSH,opR13);
  1232. emitter.Emit1(InstructionSet.opPUSH,opR14);
  1233. emitter.Emit1(InstructionSet.opPUSH,opR15);
  1234. END;
  1235. END;
  1236. spillStackStart := stackSize;
  1237. END EmitEnter;
  1238. PROCEDURE EmitLeave(CONST instruction: IntermediateCode.Instruction);
  1239. VAR cc: LONGINT; offset: Assembler.Operand;
  1240. BEGIN
  1241. cc := SHORT(instruction.op1.intValue);
  1242. IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
  1243. IF cpuBits = 32 THEN
  1244. emitter.Emit1(InstructionSet.opPOP,opESI);
  1245. emitter.Emit1(InstructionSet.opPOP,opEDI);
  1246. emitter.Emit1(InstructionSet.opPOP,opEBX);
  1247. ELSE ASSERT(cpuBits =64);
  1248. emitter.Emit1(InstructionSet.opPOP,opR15);
  1249. emitter.Emit1(InstructionSet.opPOP,opR14);
  1250. emitter.Emit1(InstructionSet.opPOP,opR13);
  1251. emitter.Emit1(InstructionSet.opPOP,opR12);
  1252. emitter.Emit1(InstructionSet.opPOP,opRSI);
  1253. emitter.Emit1(InstructionSet.opPOP,opRDI);
  1254. emitter.Emit1(InstructionSet.opPOP,opRB);
  1255. END;
  1256. END;
  1257. END EmitLeave;
  1258. PROCEDURE EmitExit(CONST instruction: IntermediateCode.Instruction);
  1259. VAR parSize,cc: LONGINT; operand: Assembler.Operand;
  1260. BEGIN
  1261. cc := SHORT(instruction.op2.intValue);
  1262. parSize := SHORT(instruction.op3.intValue);
  1263. IF (parSize = 0) OR (cc = SyntaxTree.WinAPICallingConvention) & (cpuBits = 64) THEN
  1264. emitter.Emit0(InstructionSet.opRET)
  1265. ELSE (* e.g. for WINAPI calling convention *)
  1266. operand := Assembler.NewImm16(parSize);
  1267. emitter.Emit1(InstructionSet.opRET,operand)
  1268. END;
  1269. IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared") END;
  1270. END EmitExit;
  1271. PROCEDURE EmitReturnFPU(CONST instruction: IntermediateCode.Instruction);
  1272. VAR operand: Assembler.Operand;
  1273. BEGIN
  1274. IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,Low, ST0) THEN
  1275. (* nothing to do: result is already in return register *)
  1276. ELSE
  1277. MakeOperand(instruction.op1, Low, operand,NIL);
  1278. emitter.Emit1(InstructionSet.opFLD,operand);
  1279. (*
  1280. not necessary to clear from top of stack as callee will clear
  1281. INC(fpStackPointer);
  1282. emitter.Emit1(InstructionSet.opFSTP,registerOperands[ST0+1]);
  1283. DEC(fpStackPointer);
  1284. *)
  1285. END;
  1286. END EmitReturnFPU;
  1287. (* return operand
  1288. store operand in return register or on fp stack
  1289. *)
  1290. PROCEDURE EmitReturn(CONST instruction: IntermediateCode.Instruction; part: LONGINT);
  1291. VAR return,operand: Assembler.Operand; register: LONGINT; ticket: Ticket; type: IntermediateCode.Type;
  1292. BEGIN
  1293. register := ResultRegister(instruction.op1.type, part);
  1294. IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,part, register) THEN
  1295. (* nothing to do: result is already in return register *)
  1296. ELSE
  1297. GetPartType(instruction.op1.type,part, type);
  1298. MakeOperand(instruction.op1, part, operand,NIL);
  1299. Spill(physicalRegisters.Mapped(register));
  1300. ticket := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,register,inPC);
  1301. TicketToOperand(ticket, return);
  1302. (* Mov takes care of potential register overlaps *)
  1303. Move(return, operand, type);
  1304. UnmapTicket(ticket);
  1305. END;
  1306. END EmitReturn;
  1307. PROCEDURE EmitMovFloat(CONST vdest,vsrc:IntermediateCode.Operand);
  1308. VAR dest,src, espm: Assembler.Operand; sizeInBytes: SHORTINT; vcopy: IntermediateCode.Operand;
  1309. BEGIN
  1310. sizeInBytes := SHORTINT(vdest.type.sizeInBits DIV 8);
  1311. IF vdest.type.form IN IntermediateCode.Integer THEN
  1312. (* e.g. in SYSTEM.VAL(LONGINT, r) *)
  1313. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1314. vcopy := vsrc; IntermediateCode.SetType(vcopy,vdest.type);
  1315. EmitMov(vdest, vcopy,Low);
  1316. IF IsComplex(vdest) THEN
  1317. EmitMov(vdest,vcopy,High);
  1318. END;
  1319. ELSE
  1320. IF backend.forceFPU THEN
  1321. MakeOperand(vsrc,Low,src,NIL);
  1322. emitter.Emit1(InstructionSet.opFLD,src);
  1323. INC(fpStackPointer);
  1324. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1325. MakeOperand(vdest,Low,dest,NIL);
  1326. Assembler.SetSize(dest,sizeInBytes);
  1327. emitter.Emit1(InstructionSet.opFSTP,dest);
  1328. DEC(fpStackPointer);
  1329. ELSE
  1330. AllocateStack(sizeInBytes);
  1331. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1332. emitter.Emit1(InstructionSet.opFSTP,espm);
  1333. DEC(fpStackPointer);
  1334. MakeOperand(vdest,Low,dest,NIL);
  1335. EmitPop(vdest,Low);
  1336. IF IsComplex(vdest) THEN
  1337. EmitPop(vdest,High);
  1338. END;
  1339. END;
  1340. ELSE
  1341. MakeOperand(vsrc, Low, src, NIL);
  1342. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1343. MakeOperand(vdest, Low, dest, NIL);
  1344. Move(dest, src, vsrc.type);
  1345. ELSE (* need temporary stack argument *)
  1346. AllocateStack(sizeInBytes);
  1347. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1348. Move(espm, src, vsrc.type);
  1349. MakeOperand(vdest,Low,dest,NIL);
  1350. EmitPop(vdest,Low);
  1351. IF IsComplex(vdest) THEN
  1352. EmitPop(vdest,High);
  1353. END;
  1354. END;
  1355. END;
  1356. END;
  1357. ELSIF vsrc.type.form IN IntermediateCode.Integer THEN
  1358. (* e.g. in SYSTEM.VAL(REAL, i) *)
  1359. IF vdest.mode = IntermediateCode.ModeMemory THEN
  1360. vcopy := vdest; IntermediateCode.SetType(vcopy,vsrc.type);
  1361. EmitMov(vcopy, vsrc,Low);
  1362. IF IsComplex(vsrc) THEN
  1363. EmitMov(vcopy,vsrc,High);
  1364. END;
  1365. ELSE
  1366. IF backend.forceFPU THEN
  1367. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1368. MakeOperand(vsrc,Low,src,NIL);
  1369. Assembler.SetSize(src,sizeInBytes);
  1370. emitter.Emit1(InstructionSet.opFLD,src);
  1371. ELSE
  1372. IF IsComplex(vsrc) THEN
  1373. EmitPush(vsrc,High);
  1374. END;
  1375. EmitPush(vsrc,Low);
  1376. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1377. emitter.Emit1(InstructionSet.opFLD,espm);
  1378. ASSERT(sizeInBytes >0);
  1379. AllocateStack(-sizeInBytes);
  1380. END;
  1381. INC(fpStackPointer);
  1382. MakeOperand(vdest,Low,dest,NIL);
  1383. emitter.Emit1(InstructionSet.opFSTP,dest);
  1384. DEC(fpStackPointer);
  1385. ELSE
  1386. IF vsrc.mode = IntermediateCode.ModeMemory THEN
  1387. MakeOperand(vsrc,Low,src,NIL);
  1388. Assembler.SetSize(src,sizeInBytes);
  1389. MakeOperand(vdest,Low,dest,NIL);
  1390. Move(dest, src, vdest.type);
  1391. ELSE
  1392. IF IsComplex(vsrc) THEN
  1393. EmitPush(vsrc,High);
  1394. END;
  1395. EmitPush(vsrc,Low);
  1396. Assembler.InitMem(espm, sizeInBytes,SP,0);
  1397. MakeOperand(vdest, Low, dest, NIL);
  1398. Move(dest, espm, vdest.type);
  1399. AllocateStack(-sizeInBytes);
  1400. END;
  1401. END;
  1402. END;
  1403. ELSE
  1404. IF backend.forceFPU THEN
  1405. MakeOperand(vsrc,Low,src,NIL);
  1406. emitter.Emit1(InstructionSet.opFLD,src);
  1407. INC(fpStackPointer);
  1408. MakeOperand(vdest,Low,dest,NIL);
  1409. emitter.Emit1(InstructionSet.opFSTP,dest);
  1410. DEC(fpStackPointer);
  1411. ELSE
  1412. MakeOperand(vsrc, Low, src, NIL);
  1413. MakeOperand(vdest, Low, dest, NIL);
  1414. Move(dest, src, vdest.type)
  1415. END;
  1416. END;
  1417. END EmitMovFloat;
  1418. PROCEDURE EmitMov(CONST vdest,vsrc: IntermediateCode.Operand; part: LONGINT);
  1419. VAR op1,op2: Assembler.Operand; tmp: IntermediateCode.Operand;
  1420. t: CodeGenerators.Ticket;
  1421. type: IntermediateCode.Type;
  1422. offset: LONGINT;
  1423. BEGIN
  1424. IF (vdest.mode = IntermediateCode.ModeRegister) & (vsrc.mode = IntermediateCode.ModeRegister) & (vsrc.type.sizeInBits > 8) & (vsrc.offset # 0)THEN
  1425. (* MOV R1, R2+offset => LEA EAX, [EBX+offset] *)
  1426. tmp := vsrc;
  1427. IntermediateCode.MakeMemory(tmp,vsrc.type);
  1428. MakeOperand(tmp,part,op2,NIL);
  1429. (*
  1430. ReleaseHint(op2.register);
  1431. *)
  1432. MakeOperand(vdest,part,op1,NIL);
  1433. t := virtualRegisters.Mapped(vdest.register,part);
  1434. IF (t # NIL) & (t.spilled) THEN
  1435. UnSpill(t); (* make sure this has not spilled *)
  1436. MakeOperand(vdest,part, op1,NIL);
  1437. END;
  1438. emitter.Emit2(InstructionSet.opLEA,op1,op2);
  1439. ELSE
  1440. MakeOperand(vsrc,part,op2,NIL);
  1441. MakeOperand(vdest,part,op1,NIL);
  1442. GetPartType(vsrc.type, part, type);
  1443. Move(op1,op2, type);
  1444. END;
  1445. END EmitMov;
  1446. PROCEDURE EmitConvertFloat(CONST instruction: IntermediateCode.Instruction);
  1447. VAR destType, srcType, dtype: IntermediateCode.Type; dest,src,espm,imm: Assembler.Operand; sizeInBytes, index: LONGINT;
  1448. temp, temp2, temp3, temp4: Assembler.Operand; ticket: Ticket; vdest, vsrc: IntermediateCode.Operand;
  1449. BEGIN
  1450. vdest := instruction.op1; vsrc := instruction.op2;
  1451. srcType := vsrc.type;
  1452. destType := vdest.type;
  1453. IF destType.form = IntermediateCode.Float THEN
  1454. CASE srcType.form OF
  1455. |IntermediateCode.Float: (* just a move *)
  1456. IF backend.forceFPU THEN
  1457. EmitMovFloat(vdest, vsrc);
  1458. ELSE
  1459. MakeOperand(vsrc,Low,src,NIL);
  1460. MakeOperand(vdest, Low, dest, NIL);
  1461. IF srcType.sizeInBits = 32 THEN
  1462. SpecialMove(InstructionSet.opCVTSS2SD, InstructionSet.opMOVSS, FALSE, dest, src, destType)
  1463. ELSE
  1464. SpecialMove(InstructionSet.opCVTSD2SS, InstructionSet.opMOVSD, FALSE, dest, src, destType)
  1465. END;
  1466. END;
  1467. |IntermediateCode.SignedInteger:
  1468. (* put value to stack and then read from stack via Float *)
  1469. IF vsrc.type.sizeInBits < IntermediateCode.Bits32 THEN
  1470. MakeOperand(vsrc,Low,src,NIL);
  1471. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1472. TicketToOperand(ticket,temp);
  1473. emitter.Emit2(InstructionSet.opMOVSX,temp,src);
  1474. IF backend.forceFPU THEN (* via stack *)
  1475. emitter.Emit1(InstructionSet.opPUSH,temp);
  1476. UnmapTicket(ticket);
  1477. sizeInBytes := temp.sizeInBytes;
  1478. ELSE (* via register *)
  1479. espm := temp;
  1480. sizeInBytes := 0
  1481. END;
  1482. ELSIF IsComplex(vsrc) THEN (* via stack *)
  1483. EmitPush(vsrc,High);
  1484. EmitPush(vsrc,Low);
  1485. sizeInBytes := 8
  1486. ELSE
  1487. IF backend.forceFPU THEN (* via stack *)
  1488. EmitPush(vsrc,Low);
  1489. sizeInBytes := SHORTINT(4 (* cpuBits DIV 8*)) (*SHORT(srcType.sizeInBits DIV 8)*);
  1490. ELSE (* via memory or register *)
  1491. sizeInBytes := 0;
  1492. MakeOperand(vsrc,Low,src,NIL);
  1493. IF Assembler.IsImmediateOperand(src) THEN (* use temporary register *)
  1494. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1495. TicketToOperand(ticket,temp);
  1496. emitter.Emit2(InstructionSet.opMOVSX,temp,src);
  1497. espm := temp
  1498. ELSE
  1499. espm := src
  1500. END;
  1501. END
  1502. END;
  1503. IF sizeInBytes > 0 THEN
  1504. Assembler.InitMem(espm, SHORTINT(sizeInBytes),SP,0);
  1505. END;
  1506. IF backend.forceFPU THEN
  1507. emitter.Emit1(InstructionSet.opFILD,espm);
  1508. INC(fpStackPointer);
  1509. ASSERT(sizeInBytes >0);
  1510. Basic.Align(sizeInBytes, 4 (* cpuBits DIV 8*));
  1511. AllocateStack(-sizeInBytes);
  1512. MakeOperand(vdest,Low,dest,NIL);
  1513. emitter.Emit1(InstructionSet.opFSTP,dest);
  1514. DEC(fpStackPointer);
  1515. ELSIF IsComplex(vsrc) THEN
  1516. emitter.Emit1(InstructionSet.opFILD,espm);
  1517. MakeOperand(vdest,Low,dest,NIL);
  1518. IF Assembler.IsMemoryOperand(dest) THEN
  1519. emitter.Emit1(InstructionSet.opFSTP,dest);
  1520. ELSE (* must be register *)
  1521. emitter.Emit1(InstructionSet.opFSTP,espm);
  1522. emitter.Emit2(InstructionSet.opMOVQ,dest,espm);
  1523. IF destType.sizeInBits = 32 THEN
  1524. emitter.Emit2(InstructionSet.opCVTSD2SS, dest,dest);
  1525. END;
  1526. END;
  1527. AllocateStack(-sizeInBytes);
  1528. ELSE
  1529. MakeOperand(vdest,Low,dest,NIL);
  1530. IF destType.sizeInBits = 32 THEN
  1531. emitter.Emit2(InstructionSet.opCVTSI2SS, dest, espm)
  1532. ELSE
  1533. emitter.Emit2(InstructionSet.opCVTSI2SD, dest, espm)
  1534. END;
  1535. AllocateStack(-sizeInBytes);
  1536. END;
  1537. END;
  1538. ELSE
  1539. ASSERT(destType.form IN IntermediateCode.Integer);
  1540. ASSERT(srcType.form = IntermediateCode.Float);
  1541. Assert(vdest.type.form = IntermediateCode.SignedInteger, "no entier as result for unsigned integer");
  1542. MakeOperand(vsrc,Low,src,NIL);
  1543. IF ~backend.forceFPU THEN
  1544. MakeOperand(vdest,Low,dest,ticket);
  1545. GetTemporaryRegister(srcType, temp);
  1546. GetTemporaryRegister(srcType, temp3);
  1547. IF destType.sizeInBits < 32 THEN
  1548. IntermediateCode.InitType(dtype, destType.form, 32);
  1549. GetTemporaryRegister(dtype, temp4);
  1550. ELSE
  1551. dtype := destType;
  1552. temp4 := dest;
  1553. END;
  1554. GetTemporaryRegister(dtype, temp2);
  1555. IF srcType.sizeInBits = 32 THEN
  1556. (* convert truncated -> negative numbers round up !*)
  1557. emitter.Emit2(InstructionSet.opCVTTSS2SI, temp4, src);
  1558. (* back to temporary mmx register *)
  1559. emitter.Emit2(InstructionSet.opCVTSI2SS, temp, temp4);
  1560. (* subtract *)
  1561. emitter.Emit2(InstructionSet.opMOVSS, temp3, src);
  1562. emitter.Emit2(InstructionSet.opSUBSS, temp3, temp);
  1563. (* back to a GP register in order to determine the sign bit *)
  1564. ELSE
  1565. emitter.Emit2(InstructionSet.opCVTTSD2SI, temp4, src);
  1566. emitter.Emit2(InstructionSet.opCVTSI2SD, temp, temp4);
  1567. emitter.Emit2(InstructionSet.opMOVSD, temp3, src);
  1568. emitter.Emit2(InstructionSet.opSUBSD, temp3, temp);
  1569. emitter.Emit2(InstructionSet.opCVTSD2SS, temp3, temp3);
  1570. END;
  1571. emitter.Emit2(InstructionSet.opMOVD, temp2, temp3);
  1572. Assembler.InitImm(imm, 0 ,srcType.sizeInBits-1);
  1573. emitter.Emit2(InstructionSet.opBT, temp2, imm);
  1574. Assembler.InitImm(imm, 0 ,0);
  1575. emitter.Emit2(InstructionSet.opSBB, temp4, imm);
  1576. IF dtype.sizeInBits # destType.sizeInBits THEN
  1577. index := temp4.register;
  1578. CASE destType.sizeInBits OF (* choose low part accordingly *)
  1579. IntermediateCode.Bits8: index := index MOD 32 + AL;
  1580. |IntermediateCode.Bits16: index := index MOD 32 + AX;
  1581. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1582. END;
  1583. temp4 := registerOperands[index];
  1584. emitter.Emit2(InstructionSet.opMOV, dest, temp4);
  1585. END
  1586. ELSE
  1587. emitter.Emit1(InstructionSet.opFLD,src); INC(fpStackPointer);
  1588. MakeOperand(vdest,Low,dest,NIL);
  1589. IF destType.sizeInBits = IntermediateCode.Bits64 THEN AllocateStack(12) ELSE AllocateStack(8) END;
  1590. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
  1591. emitter.Emit1(InstructionSet.opFNSTCW,espm);
  1592. emitter.Emit0(InstructionSet.opFWAIT);
  1593. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,0);
  1594. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1595. TicketToOperand(ticket,temp);
  1596. emitter.Emit2(InstructionSet.opMOV,temp,espm);
  1597. imm := Assembler.NewImm32(0F3FFH);
  1598. emitter.Emit2(InstructionSet.opAND,temp,imm);
  1599. imm := Assembler.NewImm32(0400H);
  1600. emitter.Emit2(InstructionSet.opOR,temp,imm);
  1601. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
  1602. emitter.Emit2(InstructionSet.opMOV,espm,temp);
  1603. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,4);
  1604. emitter.Emit1(InstructionSet.opFLDCW,espm);
  1605. IF destType.sizeInBits = IntermediateCode.Bits64 THEN
  1606. Assembler.InitMem(espm,IntermediateCode.Bits64 DIV 8,SP,4);
  1607. emitter.Emit1(InstructionSet.opFISTP,espm);DEC(fpStackPointer);
  1608. emitter.Emit0(InstructionSet.opFWAIT);
  1609. ELSE
  1610. Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
  1611. emitter.Emit1(InstructionSet.opFISTP,espm); DEC(fpStackPointer);
  1612. emitter.Emit0(InstructionSet.opFWAIT);
  1613. END;
  1614. Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
  1615. emitter.Emit1(InstructionSet.opFLDCW,espm);
  1616. emitter.Emit1(InstructionSet.opPOP,temp);
  1617. UnmapTicket(ticket);
  1618. emitter.Emit1(InstructionSet.opPOP,dest);
  1619. IF IsComplex(vdest) THEN
  1620. MakeOperand(vdest,High,dest,NIL);
  1621. emitter.Emit1(InstructionSet.opPOP,dest);
  1622. END;
  1623. END;
  1624. END;
  1625. END EmitConvertFloat;
  1626. PROCEDURE EmitConvert(CONST vdest, vsrc: IntermediateCode.Operand; part: LONGINT);
  1627. VAR destType, srcType: IntermediateCode.Type; op1,op2: Assembler.Operand; index: LONGINT; nul: Assembler.Operand;
  1628. ticket: Ticket; vop: IntermediateCode.Operand; ediReserved, esiReserved: BOOLEAN;
  1629. eax, edx: Ticket; symbol: ObjectFile.Identifier; offset: LONGINT;
  1630. BEGIN
  1631. GetPartType(vdest.type,part, destType);
  1632. GetPartType(vsrc.type,part,srcType);
  1633. ASSERT(vdest.type.form IN IntermediateCode.Integer);
  1634. ASSERT(destType.form IN IntermediateCode.Integer);
  1635. IF destType.sizeInBits < srcType.sizeInBits THEN (* SHORT *)
  1636. ASSERT(part # High);
  1637. MakeOperand(vdest,part,op1,NIL);
  1638. IF vsrc.mode = IntermediateCode.ModeImmediate THEN
  1639. vop := vsrc;
  1640. IntermediateCode.SetType(vop,destType);
  1641. MakeOperand(vop,part,op2,NIL);
  1642. ELSE
  1643. MakeOperand(vsrc,part,op2,NIL);
  1644. IF Assembler.IsRegisterOperand(op1) & ((op1.register DIV 32 >0) (* not 8 bit register *) OR (op1.register DIV 16 = 0) & (physicalRegisters.Mapped(op1.register MOD 16 + AH)=free) (* low 8 bit register with free upper part *)) THEN
  1645. (* try EAX <- EDI for dest = AL or AX, src=EDI *)
  1646. index := op1.register;
  1647. CASE srcType.sizeInBits OF
  1648. IntermediateCode.Bits16: index := index MOD 32 + AX;
  1649. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1650. |IntermediateCode.Bits64: index := index MOD 32 + RAX;
  1651. END;
  1652. op1 := registerOperands[index];
  1653. ELSE
  1654. (* reserve register with a low part *)
  1655. IF destType.sizeInBits=8 THEN (* make sure that allocated temporary register has a low part with 8 bits, i.e. exclude ESI or EDI *)
  1656. ediReserved := physicalRegisters.Reserved(EDI);
  1657. esiReserved := physicalRegisters.Reserved(ESI);
  1658. physicalRegisters.SetReserved(EDI,TRUE); physicalRegisters.SetReserved(ESI,TRUE);
  1659. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* register with low part *)
  1660. physicalRegisters.SetReserved(EDI,ediReserved); physicalRegisters.SetReserved(ESI,esiReserved);
  1661. ELSE
  1662. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* any register with low part *)
  1663. END;
  1664. MakeOperand(vsrc,part,op2,ticket); (* stores op2 in ticket register *)
  1665. index := op2.register;
  1666. CASE destType.sizeInBits OF (* choose low part accordingly *)
  1667. IntermediateCode.Bits8: index := index MOD 32 + AL;
  1668. |IntermediateCode.Bits16: index := index MOD 32 + AX;
  1669. |IntermediateCode.Bits32: index := index MOD 32 + EAX;
  1670. END;
  1671. op2 := registerOperands[index];
  1672. END;
  1673. Move(op1,op2,PhysicalOperandType(op1));
  1674. END;
  1675. ELSIF destType.sizeInBits > srcType.sizeInBits THEN (* (implicit) LONG *)
  1676. IF part = High THEN
  1677. IF destType.form = IntermediateCode.SignedInteger THEN
  1678. Spill(physicalRegisters.Mapped(EAX));
  1679. eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  1680. Spill(physicalRegisters.Mapped(EDX));
  1681. edx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
  1682. IF vsrc.type.sizeInBits < 32 THEN
  1683. MakeOperand(vsrc,Low,op2,NIL);
  1684. SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, opEAX,op2,PhysicalOperandType(opEAX));
  1685. ELSE
  1686. MakeOperand(vsrc,Low,op2,eax);
  1687. END;
  1688. emitter.Emit0(InstructionSet.opCDQ);
  1689. MakeOperand(vdest,High,op1,NIL);
  1690. emitter.Emit2(InstructionSet.opMOV,op1,opEDX);
  1691. UnmapTicket(eax); UnmapTicket(edx);
  1692. ELSE
  1693. MakeOperand(vdest,part,op1,NIL);
  1694. IF (vdest.mode = IntermediateCode.ModeRegister) THEN
  1695. emitter.Emit2(InstructionSet.opXOR,op1,op1)
  1696. ELSE
  1697. Assembler.InitImm(nul,0,0);
  1698. emitter.Emit2(InstructionSet.opMOV,op1,nul);
  1699. END;
  1700. END;
  1701. ELSE
  1702. ASSERT(part=Low);
  1703. MakeOperand(vdest,part,op1,NIL);
  1704. MakeOperand(vsrc,part,op2,NIL);
  1705. IF srcType.sizeInBits = destType.sizeInBits THEN
  1706. Move(op1,op2,PhysicalOperandType(op1));
  1707. ELSIF srcType.form = IntermediateCode.SignedInteger THEN
  1708. IF srcType.sizeInBits=32 THEN (* 64 bits only *)
  1709. ASSERT(cpuBits=64);
  1710. SpecialMove(InstructionSet.opMOVSXD,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
  1711. ELSE
  1712. SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
  1713. END;
  1714. ELSE
  1715. ASSERT(srcType.form = IntermediateCode.UnsignedInteger);
  1716. IF srcType.sizeInBits=32 THEN (* 64 bits only *)
  1717. ASSERT(cpuBits=64);
  1718. IF Assembler.IsRegisterOperand(op1) THEN
  1719. Move( registerOperands[op1.register MOD 32 + EAX], op2,srcType);
  1720. ELSE
  1721. ASSERT(Assembler.IsMemoryOperand(op1));
  1722. symbol := op1.symbol; offset := op1.offset;
  1723. Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement);
  1724. Assembler.SetSymbol(op1,symbol.name,symbol.fingerprint,offset,op1.displacement);
  1725. Move( op1, op2, srcType);
  1726. Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement+Assembler.bits32);
  1727. Assembler.SetSymbol(op1,symbol.name, symbol.fingerprint,offset,op1.displacement);
  1728. Assembler.InitImm(op2,0,0);
  1729. Move( op1, op2,srcType);
  1730. END;
  1731. ELSE
  1732. SpecialMove(InstructionSet.opMOVZX, InstructionSet.opMOV, FALSE, op1, op2,PhysicalOperandType(op1))
  1733. END;
  1734. END;
  1735. END;
  1736. ELSE (* destType.sizeInBits = srcType.sizeInBits) *)
  1737. EmitMov(vdest,vsrc,part);
  1738. END;
  1739. END EmitConvert;
  1740. PROCEDURE EmitResult(CONST instruction: IntermediateCode.Instruction);
  1741. VAR result, resultHigh, op, opHigh: Assembler.Operand; register, highRegister: LONGINT; lowReserved, highReserved: BOOLEAN; type: IntermediateCode.Type;
  1742. BEGIN
  1743. IF ~IsComplex(instruction.op1) THEN
  1744. register := ResultRegister(instruction.op1.type,Low);
  1745. result := registerOperands[register];
  1746. MakeOperand(instruction.op1,Low,op,NIL);
  1747. GetPartType(instruction.op1.type, Low, type);
  1748. Move(op,result,type);
  1749. ELSE
  1750. register := ResultRegister(instruction.op1.type,Low);
  1751. result := registerOperands[register];
  1752. highRegister := ResultRegister(instruction.op1.type, High);
  1753. resultHigh := registerOperands[highRegister];
  1754. (* make sure that result registers are not used during emission of Low / High *)
  1755. lowReserved := physicalRegisters.Reserved(register);
  1756. physicalRegisters.SetReserved(register, TRUE);
  1757. highReserved := physicalRegisters.Reserved(highRegister);
  1758. physicalRegisters.SetReserved(highRegister,TRUE);
  1759. MakeOperand(instruction.op1,Low,op, NIL);
  1760. IF Assembler.SameOperand(op, resultHigh) THEN
  1761. emitter.Emit2(InstructionSet.opXCHG, result, resultHigh); (* low register already mapped ok *)
  1762. MakeOperand(instruction.op1, High, opHigh, NIL);
  1763. GetPartType(instruction.op1.type, High, type);
  1764. Move(opHigh, result, type);
  1765. ELSE
  1766. GetPartType(instruction.op1.type, Low, type);
  1767. Move(op, result, type);
  1768. MakeOperand(instruction.op1,High, opHigh, NIL);
  1769. GetPartType(instruction.op1.type, High, type);
  1770. Move(opHigh, resultHigh, type);
  1771. END;
  1772. physicalRegisters.SetReserved(register, lowReserved);
  1773. physicalRegisters.SetReserved(highRegister, highReserved);
  1774. END;
  1775. END EmitResult;
  1776. PROCEDURE EmitResultFPU(CONST instruction: IntermediateCode.Instruction);
  1777. VAR op: Assembler.Operand;
  1778. BEGIN
  1779. INC(fpStackPointer); (* callee has left the result on top of stack, don't have to allocate here *)
  1780. MakeOperand(instruction.op1,Low,op,NIL);
  1781. emitter.Emit1(InstructionSet.opFSTP,op);
  1782. DEC(fpStackPointer);
  1783. (*
  1784. UnmapTicket(ticket);
  1785. *)
  1786. END EmitResultFPU;
  1787. PROCEDURE EmitCall(CONST instruction: IntermediateCode.Instruction);
  1788. VAR fixup: Sections.Section; target, op, parSize: Assembler.Operand;
  1789. code: SyntaxTree.Code; emitterFixup,newFixup: BinaryCode.Fixup; resolved: BinaryCode.Section; pc: LONGINT;
  1790. BEGIN
  1791. IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared before call") END;
  1792. IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
  1793. fixup := module.allSections.FindByName(instruction.op1.symbol.name);
  1794. IF (fixup # NIL) & (fixup.type = Sections.InlineCodeSection) THEN
  1795. pc := out.pc;
  1796. (* resolved must be available at this point ! *)
  1797. resolved := fixup(IntermediateCode.Section).resolved;
  1798. IF resolved # NIL THEN
  1799. emitter.code.CopyBits(resolved.os.bits,0,resolved.os.bits.GetSize());
  1800. emitterFixup := resolved.fixupList.firstFixup;
  1801. WHILE (emitterFixup # NIL) DO
  1802. newFixup := BinaryCode.NewFixup(emitterFixup.mode,emitterFixup.offset+pc,emitterFixup.symbol,emitterFixup.symbolOffset,emitterFixup.displacement,emitterFixup.scale,emitterFixup.pattern);
  1803. out.fixupList.AddFixup(newFixup);
  1804. emitterFixup := emitterFixup.nextFixup;
  1805. END;
  1806. END;
  1807. ELSE
  1808. Assembler.InitOffset32(target,instruction.op1.intValue);
  1809. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.offset,0);
  1810. emitter.Emit1(InstructionSet.opCALL,target);
  1811. Assembler.InitOffset32(parSize,instruction.op2.intValue);
  1812. IF parSize.val # 0 THEN emitter.Emit2(InstructionSet.opADD,opSP,parSize) END;
  1813. END;
  1814. ELSE
  1815. MakeOperand(instruction.op1,Low,op,NIL);
  1816. emitter.Emit1(InstructionSet.opCALL,op);
  1817. Assembler.InitOffset32(parSize,instruction.op2.intValue);
  1818. IF parSize.val # 0 THEN emitter.Emit2(InstructionSet.opADD,opSP,parSize) END;
  1819. END;
  1820. END EmitCall;
  1821. (*
  1822. register allocation
  1823. instruction dest, src1, src2
  1824. preconditions
  1825. dest is memory operand or dest is register with offset = 0
  1826. src1 and src2 may be immediates, registers with or without offset and memory operands
  1827. 1.) translation into two-operand code
  1828. a) dest = src1 (no assumption on src2, src2=src1 is permitted )
  1829. i) dest and src2 are both memory operands or src2 is a register with offset # 0
  1830. alloc temp register
  1831. mov temp, src2
  1832. instruction2 dest, temp
  1833. ii) dest or src2 is not a memory operand
  1834. instruction2 dest, src2
  1835. b) dest = src2
  1836. => src2 is not a register with offset # 0
  1837. alloc temp register
  1838. mov dest, src1
  1839. mov temp, src2
  1840. instruction2 dest, temp
  1841. c) dest # src2
  1842. mov dest, src1
  1843. i) dest and src2 are both memory operands or src2 is a register with offset # 0
  1844. allocate temp register
  1845. mov temp, src2
  1846. instruction2 dest, temp
  1847. ii)
  1848. instruction2 dest, src2
  1849. 1'.) translation into one operand code
  1850. instruction dest, src1
  1851. a) dest = src1
  1852. => src1 is not a register with offset # 0
  1853. instruction1 dest
  1854. b) dest # src1
  1855. mov dest, src1
  1856. instruction1 dest
  1857. 2.) register allocation
  1858. precondition: src1 and src2 are already allocated
  1859. a) dest is already allocated
  1860. go on according to 1.
  1861. b) dest needs to be allocated
  1862. check if register is free
  1863. i) yes: allocate free register and go on with 1.
  1864. ii) no: spill last register in livelist, map register and go on with 1.
  1865. *)
  1866. PROCEDURE PrepareOp3(CONST instruction: IntermediateCode.Instruction;part: LONGINT; VAR left, right: Assembler.Operand; VAR ticket: Ticket);
  1867. VAR vop1,vop2, vop3: IntermediateCode.Operand; op1,op2,op3,temp: Assembler.Operand; type: IntermediateCode.Type;
  1868. t: Ticket;
  1869. BEGIN
  1870. ticket := NIL;
  1871. GetPartType(instruction.op1.type,part,type);
  1872. vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
  1873. IF IntermediateCode.OperandEquals(vop1,vop3) & (IntermediateCode.Commute23 IN IntermediateCode.instructionFormat[instruction.opcode].flags) THEN
  1874. vop3 := instruction.op2; vop2 := instruction.op3;
  1875. END;
  1876. MakeOperand(vop3,part, op3,NIL);
  1877. IF (vop1.mode = IntermediateCode.ModeRegister) & (~IsMemoryOperand(vop1,part)) & (vop1.register # vop3.register) THEN
  1878. IF (vop2.mode = IntermediateCode.ModeRegister) & (vop2.register = vop1.register) & (vop2.offset = 0) THEN
  1879. (* same register *)
  1880. MakeOperand(vop1,part, op1,NIL);
  1881. ELSE
  1882. MakeOperand(vop2,part, op2,NIL);
  1883. (*
  1884. ReleaseHint(op2.register);
  1885. *)
  1886. MakeOperand(vop1,part, op1,NIL);
  1887. Move(op1, op2, type);
  1888. t := virtualRegisters.Mapped(vop1.register,part);
  1889. IF (t # NIL) & (t.spilled) THEN
  1890. UnSpill(t); (* make sure this has not spilled *)
  1891. MakeOperand(vop1,part, op1,NIL);
  1892. END;
  1893. END;
  1894. left := op1; right := op3;
  1895. ELSIF IntermediateCode.OperandEquals(vop1,vop2) & (~IsMemoryOperand(vop1,part) OR ~IsMemoryOperand(vop3,part)) THEN
  1896. MakeOperand(vop1,part, op1,NIL);
  1897. left := op1; right := op3;
  1898. ELSE
  1899. MakeOperand(vop1,part, op1,NIL);
  1900. MakeOperand(vop2,part, op2,NIL);
  1901. (*ReleaseHint(op2.register);*)
  1902. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  1903. TicketToOperand(ticket,temp);
  1904. Move(temp, op2, type);
  1905. left := temp; right := op3;
  1906. END;
  1907. END PrepareOp3;
  1908. PROCEDURE PrepareOp2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; VAR left: Assembler.Operand;VAR ticket: Ticket);
  1909. VAR op2: Assembler.Operand; imm: Assembler.Operand; sizeInBits: INTEGER; type: IntermediateCode.Type;
  1910. BEGIN
  1911. ticket := NIL;
  1912. GetPartType(instruction.op1.type,part,type);
  1913. IF (instruction.op1.mode = IntermediateCode.ModeRegister) THEN
  1914. MakeOperand(instruction.op1,part,left,NIL);
  1915. MakeOperand(instruction.op2,part,op2,NIL);
  1916. IF (instruction.op2.mode = IntermediateCode.ModeRegister) & (instruction.op2.register = instruction.op1.register) & (instruction.op2.offset = 0) THEN
  1917. ELSE
  1918. Move(left, op2, type);
  1919. IF (instruction.op2.offset # 0) & ~IsMemoryOperand(instruction.op2,part) THEN
  1920. GetPartType(instruction.op2.type,part,type);
  1921. sizeInBits := type.sizeInBits;
  1922. Assembler.InitImm(imm,0,instruction.op2.offset);
  1923. emitter.Emit2(InstructionSet.opADD,left,imm);
  1924. END;
  1925. END;
  1926. ELSIF IntermediateCode.OperandEquals(instruction.op1,instruction.op2) & ((instruction.op1.mode # IntermediateCode.ModeMemory) OR (instruction.op3.mode # IntermediateCode.ModeMemory)) THEN
  1927. MakeOperand(instruction.op1,part,left,NIL);
  1928. ELSE
  1929. MakeOperand(instruction.op2,part, op2,NIL);
  1930. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
  1931. TicketToOperand(ticket,left);
  1932. Move(left, op2, type);
  1933. END;
  1934. END PrepareOp2;
  1935. PROCEDURE FinishOp(CONST vop: IntermediateCode.Operand; part: LONGINT; left: Assembler.Operand; ticket: Ticket);
  1936. VAR op1: Assembler.Operand;
  1937. BEGIN
  1938. IF ticket # NIL THEN
  1939. MakeOperand(vop,part, op1,NIL);
  1940. Move(op1,left,vop.type);
  1941. UnmapTicket(ticket);
  1942. END;
  1943. END FinishOp;
  1944. PROCEDURE EmitArithmetic3Part(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
  1945. VAR left,right: Assembler.Operand; ticket: Ticket;
  1946. BEGIN
  1947. PrepareOp3(instruction, part, left,right,ticket);
  1948. emitter.Emit2(opcode,left,right);
  1949. FinishOp(instruction.op1,part,left,ticket);
  1950. END EmitArithmetic3Part;
  1951. PROCEDURE EmitArithmetic3(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
  1952. BEGIN
  1953. EmitArithmetic3Part(instruction,Low,opcode);
  1954. IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, opcode) END;
  1955. END EmitArithmetic3;
  1956. PROCEDURE EmitArithmetic3XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
  1957. VAR op: LONGINT;
  1958. BEGIN
  1959. IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
  1960. EmitArithmetic3Part(instruction, Low, op);
  1961. END EmitArithmetic3XMM;
  1962. PROCEDURE EmitArithmetic2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
  1963. VAR left:Assembler.Operand;ticket: Ticket;
  1964. BEGIN
  1965. PrepareOp2(instruction,part,left,ticket);
  1966. emitter.Emit1(opcode,left);
  1967. FinishOp(instruction.op1,part,left,ticket);
  1968. END EmitArithmetic2;
  1969. PROCEDURE EmitArithmetic2XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
  1970. VAR op: LONGINT;
  1971. BEGIN
  1972. IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
  1973. EmitArithmetic2(instruction, Low, op);
  1974. END EmitArithmetic2XMM;
  1975. PROCEDURE EmitArithmetic3FPU(CONST instruction: IntermediateCode.Instruction; op: LONGINT);
  1976. VAR op1,op2,op3: Assembler.Operand;
  1977. BEGIN
  1978. MakeOperand(instruction.op2,Low,op2,NIL);
  1979. emitter.Emit1(InstructionSet.opFLD,op2);
  1980. INC(fpStackPointer);
  1981. MakeOperand(instruction.op3,Low,op3,NIL);
  1982. IF instruction.op3.mode = IntermediateCode.ModeRegister THEN
  1983. emitter.Emit2(op,opST0,op3);
  1984. ELSE
  1985. emitter.Emit1(op,op3);
  1986. END;
  1987. MakeOperand(instruction.op1,Low,op1,NIL);
  1988. emitter.Emit1(InstructionSet.opFSTP,op1);
  1989. DEC(fpStackPointer);
  1990. END EmitArithmetic3FPU;
  1991. PROCEDURE EmitArithmetic2FPU(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
  1992. VAR op1,op2: Assembler.Operand;
  1993. BEGIN
  1994. MakeOperand(instruction.op2,Low,op2,NIL);
  1995. emitter.Emit1(InstructionSet.opFLD,op2);
  1996. INC(fpStackPointer);
  1997. emitter.Emit0(opcode);
  1998. MakeOperand(instruction.op1,Low,op1,NIL);
  1999. emitter.Emit1(InstructionSet.opFSTP,op1);
  2000. DEC(fpStackPointer);
  2001. END EmitArithmetic2FPU;
  2002. PROCEDURE EmitMul(CONST instruction: IntermediateCode.Instruction);
  2003. VAR op1,op2,op3,temp: Assembler.Operand; ra,rd: Ticket;
  2004. value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
  2005. inst: IntermediateCode.Instruction;
  2006. BEGIN
  2007. IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
  2008. IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
  2009. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shl, instruction.op1, instruction.op2, iop3);
  2010. EmitShift(inst);
  2011. RETURN;
  2012. END;
  2013. ASSERT(~IsComplex(instruction.op1));
  2014. ASSERT(instruction.op1.type.form IN IntermediateCode.Integer);
  2015. IF (instruction.op1.type.sizeInBits = IntermediateCode.Bits8) THEN
  2016. Spill(physicalRegisters.Mapped(AL));
  2017. Spill(physicalRegisters.Mapped(AH));
  2018. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
  2019. rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AH,inPC);
  2020. MakeOperand(instruction.op1,Low,op1,NIL);
  2021. MakeOperand(instruction.op2,Low,op2,ra);
  2022. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2023. MakeOperand(instruction.op3,Low,op3,rd);
  2024. ELSE
  2025. MakeOperand(instruction.op3,Low,op3,NIL);
  2026. END;
  2027. emitter.Emit1(InstructionSet.opIMUL,op3);
  2028. emitter.Emit2(InstructionSet.opMOV,op1,opAL);
  2029. UnmapTicket(ra);
  2030. UnmapTicket(rd);
  2031. ELSE
  2032. MakeOperand(instruction.op1,Low,op1,NIL);
  2033. MakeOperand(instruction.op2,Low,op2,NIL);
  2034. MakeOperand(instruction.op3,Low,op3,NIL);
  2035. IF ~Assembler.IsRegisterOperand(op1) THEN
  2036. temp := op1;
  2037. ra := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2038. TicketToOperand(ra,op1);
  2039. END;
  2040. IF Assembler.SameOperand(op1,op3) THEN temp := op2; op2 := op3; op3 := temp END;
  2041. IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
  2042. IF Assembler.IsImmediateOperand(op3) THEN
  2043. emitter.Emit3(InstructionSet.opIMUL,op1,op2,op3);
  2044. ELSIF Assembler.IsRegisterOperand(op2) & (op2.register = op1.register) THEN
  2045. IF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
  2046. emitter.Emit2(InstructionSet.opIMUL,op1,op3);
  2047. ELSE
  2048. rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2049. TicketToOperand(rd,temp);
  2050. Move(temp,op3,instruction.op1.type);
  2051. emitter.Emit2(InstructionSet.opIMUL,op1,temp);
  2052. UnmapTicket(rd);
  2053. END;
  2054. ELSE
  2055. Move(op1,op3,PhysicalOperandType(op1));
  2056. emitter.Emit2(InstructionSet.opIMUL,op1,op2);
  2057. END
  2058. ELSIF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
  2059. IF Assembler.IsImmediateOperand(op2) THEN
  2060. emitter.Emit3(InstructionSet.opIMUL,op1,op3,op2);
  2061. ELSIF Assembler.IsRegisterOperand(op3) & (op2.register = op1.register) THEN
  2062. IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
  2063. emitter.Emit2(InstructionSet.opIMUL,op1,op2);
  2064. ELSE
  2065. rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
  2066. TicketToOperand(rd,temp);
  2067. Move(temp,op2,instruction.op1.type);
  2068. emitter.Emit2(InstructionSet.opIMUL,op1,temp);
  2069. UnmapTicket(rd);
  2070. END;
  2071. ELSE
  2072. Move(op1,op2,PhysicalOperandType(op1));
  2073. emitter.Emit2(InstructionSet.opIMUL,op1,op3);
  2074. END;
  2075. END;
  2076. IF ra # NIL THEN
  2077. Move(temp,op1,PhysicalOperandType(op1));
  2078. UnmapTicket(ra);
  2079. END;
  2080. END;
  2081. END EmitMul;
  2082. PROCEDURE EmitDivMod(CONST instruction: IntermediateCode.Instruction);
  2083. VAR
  2084. dividend,quotient,remainder,imm,target,memop: Assembler.Operand;
  2085. op1,op2,op3: Assembler.Operand; ra,rd: Ticket;
  2086. size: LONGINT;
  2087. value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
  2088. inst: IntermediateCode.Instruction;
  2089. BEGIN
  2090. IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
  2091. IF instruction.opcode = IntermediateCode.div THEN
  2092. IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
  2093. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shr, instruction.op1, instruction.op2, iop3);
  2094. EmitShift(inst);
  2095. RETURN;
  2096. ELSE
  2097. IntermediateCode.InitImmediate(iop3, instruction.op3.type, value-1);
  2098. IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.and, instruction.op1, instruction.op2, iop3);
  2099. EmitArithmetic3(inst,InstructionSet.opAND);
  2100. RETURN;
  2101. END;
  2102. END;
  2103. (*
  2104. In general it must obviously hold that
  2105. a = (a div b) * b + a mod b and
  2106. for all integers a,b#0, and c.
  2107. For positive numbers a and b this holds if
  2108. a div b = max{integer i: i*b <= b} = Entier(a/b)
  2109. and
  2110. a mod b = a-(a div b)*b = min{c >=0: c = a-i*b, integer i}
  2111. Example
  2112. 11 div 3 = 3 (3*3 = 9)
  2113. 11 mod 3 = 2 (=11-9)
  2114. for negative a there are two definitions for mod possible:
  2115. (i) mathematical definition with
  2116. a mod b >= 0:
  2117. a mod b = min{ c >=0: c = a-i*b, integer i} >= 0
  2118. this corresponds with rounding down
  2119. a div b = Entier(a/b) <= a/b
  2120. (ii) symmetric definition with
  2121. (-a) mod' b = -(a mod' b) and
  2122. (-a) div' b = -(a div' b)
  2123. corresponding with rounding to zero
  2124. a div' b = RoundToZero(a/b)
  2125. Examples
  2126. (i) -11 div 3 = -4 (3*(-4) = -12)
  2127. -11 mod 3 = 1 (=-11-(-12))
  2128. (ii) -11 div' 3 = -(11 div 3) = -3 (3*(-3)= -9)
  2129. -11 mod' 3 = -2 (=-11-(-9))
  2130. The behaviour for negative b can, in the symmetrical case, be deduced as
  2131. (ii) symmetric definition
  2132. a div' (-b) = (-a) div' b = -(a div' b)
  2133. a mod' (-b) = a- a div' (-b) * (-b) = a mod' b
  2134. In the mathematical case it is not so easy. It turns out that the definitions
  2135. a DIV b = Entier(a/b) = max{integer i: i*b <= b}
  2136. and
  2137. a MOD b = min { c >=0 : c = a-i*b, integer i} >= 0
  2138. are not compliant with
  2139. a = (a DIV b) * b + a MOD b
  2140. if b <= 0.
  2141. Proof: assume that b<0, then
  2142. a - Entier(a/b) * b >= 0
  2143. <=_> a >= Entier(a/b) * b
  2144. <=> Entier(a/b) >= a/b (contradiction to definition of Entier).
  2145. OBERON ADOPTS THE MATHEMATICAL DEFINITION !
  2146. For integers a and b (b>0) it holds that
  2147. a DIV b = Entier(a/b) <= a/b
  2148. a MOD b = min{ c >=0: c = b-i*a, integer i} = a - a DIV b * b
  2149. The behaviour for b < 0 is explicitely undefined.
  2150. *)
  2151. (*
  2152. AX / regMem8 = AL (remainder AH)
  2153. DX:AX / regmem16 = AX (remainder DX)
  2154. EDX:EAX / regmem32 = EAX (remainder EDX)
  2155. RDX:EAX / regmem64 = RAX (remainder RDX)
  2156. 1.) EAX <- source1
  2157. 2.) CDQ
  2158. 3.) IDIV source2
  2159. 3.) SHL EDX
  2160. 4.) SBB EAX,1
  2161. result is in EAX
  2162. *)
  2163. MakeOperand(instruction.op2,Low,op2,NIL);
  2164. CASE instruction.op1.type.sizeInBits OF
  2165. IntermediateCode.Bits8:
  2166. Spill(physicalRegisters.Mapped(AL)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
  2167. emitter.Emit2(InstructionSet.opMOV,opAL,op2);
  2168. dividend := opAX;
  2169. quotient := opAL;
  2170. remainder := opAH;
  2171. emitter.Emit0(InstructionSet.opCBW);
  2172. | IntermediateCode.Bits16:
  2173. Spill(physicalRegisters.Mapped(AX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,AX,inPC);
  2174. emitter.Emit2(InstructionSet.opMOV,opAX,op2);
  2175. Spill(physicalRegisters.Mapped(DX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,DX,inPC);
  2176. dividend := opAX;
  2177. quotient := dividend;
  2178. remainder := opDX;
  2179. emitter.Emit0(InstructionSet.opCWD);
  2180. | IntermediateCode.Bits32:
  2181. Spill(physicalRegisters.Mapped(EAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  2182. emitter.Emit2(InstructionSet.opMOV,opEAX,op2);
  2183. Spill(physicalRegisters.Mapped(EDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
  2184. dividend := opEAX;
  2185. quotient := dividend;
  2186. remainder := opEDX;
  2187. emitter.Emit0(InstructionSet.opCDQ);
  2188. | IntermediateCode.Bits64:
  2189. Spill(physicalRegisters.Mapped(RAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RAX,inPC);
  2190. emitter.Emit2(InstructionSet.opMOV,opRA,op2);
  2191. Spill(physicalRegisters.Mapped(RDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RDX,inPC);
  2192. dividend := opRA;
  2193. quotient := dividend;
  2194. remainder := registerOperands[RDX];
  2195. emitter.Emit0(InstructionSet.opCQO);
  2196. END;
  2197. (* registers might have been changed, so we make the operands now *)
  2198. MakeOperand(instruction.op1,Low,op1,NIL);
  2199. MakeOperand(instruction.op2,Low,op2,NIL);
  2200. MakeOperand(instruction.op3,Low,op3,NIL);
  2201. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2202. size := instruction.op3.type.sizeInBits DIV 8;
  2203. Basic.Align(size, 4 (* cpuBits DIV 8 *) );
  2204. AllocateStack(size);
  2205. Assembler.InitMem(memop,SHORT(instruction.op3.type.sizeInBits DIV 8),SP,0);
  2206. emitter.Emit2(InstructionSet.opMOV,memop,op3);
  2207. op3 := memop;
  2208. END;
  2209. emitter.Emit1(InstructionSet.opIDIV,op3);
  2210. IF instruction.opcode = IntermediateCode.mod THEN
  2211. imm := Assembler.NewImm8 (0);
  2212. emitter.Emit2(InstructionSet.opCMP, remainder, imm);
  2213. Assembler.InitImm8(target,0);
  2214. emitter.Emit1(InstructionSet.opJGE, target);
  2215. emitter.Emit2( InstructionSet.opADD, remainder, op3);
  2216. emitter.code.PutByteAt(target.pc,(emitter.code.pc -target.pc )-1);
  2217. emitter.Emit2(InstructionSet.opMOV, op1, remainder);
  2218. ELSE
  2219. imm := Assembler.NewImm8 (1);
  2220. emitter.Emit2(InstructionSet.opSHL, remainder, imm);
  2221. imm := Assembler.NewImm8 (0);
  2222. emitter.Emit2(InstructionSet.opSBB, quotient, imm);
  2223. emitter.Emit2(InstructionSet.opMOV, op1, quotient);
  2224. END;
  2225. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2226. size := instruction.op3.type.sizeInBits DIV 8;
  2227. Basic.Align(size, 4 (* cpuBits DIV 8*) );
  2228. AllocateStack(-size);
  2229. END;
  2230. END EmitDivMod;
  2231. PROCEDURE EmitShift(CONST instruction: IntermediateCode.Instruction);
  2232. VAR
  2233. shift: Assembler.Operand;
  2234. op: LONGINT;
  2235. op1,op2,op3,dest,temporary,op1High,op2High: Assembler.Operand;
  2236. index: SHORTINT; temp: Assembler.Operand;
  2237. left: BOOLEAN;
  2238. ecx,ticket: Ticket;
  2239. BEGIN
  2240. Assert(instruction.op1.type.form IN IntermediateCode.Integer,"must be integer operand");
  2241. IF instruction.op1.type.form = IntermediateCode.UnsignedInteger THEN
  2242. IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSHR; left := FALSE;
  2243. ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSHL; left := TRUE;
  2244. ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
  2245. ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
  2246. END;
  2247. ELSE
  2248. IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSAR; left := FALSE;
  2249. ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSAL; left := TRUE;
  2250. ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
  2251. ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
  2252. END;
  2253. END;
  2254. IF instruction.op3.mode # IntermediateCode.ModeImmediate THEN
  2255. IF backend.cooperative THEN ap.spillable := TRUE END;
  2256. Spill(physicalRegisters.Mapped(ECX));
  2257. ecx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,ECX,inPC);
  2258. END;
  2259. (*GetTemporaryRegister(instruction.op2.type,dest);*)
  2260. MakeOperand(instruction.op1,Low,op1,NIL);
  2261. IF ~Assembler.IsRegisterOperand(op1) THEN GetTemporaryRegister(instruction.op2.type,dest) ELSE dest := op1 END;
  2262. MakeOperand(instruction.op2,Low,op2,NIL);
  2263. MakeOperand(instruction.op3,Low,op3,NIL);
  2264. IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
  2265. Assembler.InitImm8(shift,instruction.op3.intValue);
  2266. ELSE
  2267. CASE instruction.op3.type.sizeInBits OF
  2268. IntermediateCode.Bits8: index := CL;
  2269. |IntermediateCode.Bits16: index := CX;
  2270. |IntermediateCode.Bits32: index := ECX;
  2271. |IntermediateCode.Bits64: index := RCX;
  2272. END;
  2273. (*
  2274. IF (physicalRegisters.toVirtual[index] # free) & ((physicalRegisters.toVirtual[index] # instruction.op1.register) OR (instruction.op1.mode # IntermediateCode.ModeRegister)) THEN
  2275. Spill();
  2276. (*
  2277. emitter.Emit1(InstructionSet.opPUSH,opECX);
  2278. ecxPushed := TRUE;
  2279. *)
  2280. END;
  2281. *)
  2282. ticket := virtualRegisters.Mapped(instruction.op3.register,Low);
  2283. IF (instruction.op3.mode # IntermediateCode.ModeRegister) OR (ticket = NIL) OR (ticket.spilled) OR (ticket.register # index) THEN
  2284. emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op3);
  2285. END;
  2286. shift := opCL;
  2287. END;
  2288. IF ~IsComplex(instruction.op1) THEN
  2289. Move(dest,op2,PhysicalOperandType(dest));
  2290. emitter.Emit2 (op, dest,shift);
  2291. Move(op1,dest,PhysicalOperandType(op1));
  2292. ELSIF left THEN
  2293. MakeOperand(instruction.op1,High,op1High,NIL);
  2294. MakeOperand(instruction.op2,High,op2High,NIL);
  2295. IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
  2296. Move(op1,op2,PhysicalOperandType(op1));
  2297. Move(op1High,op2High,PhysicalOperandType(op1High))
  2298. END;
  2299. IF (instruction.opcode=IntermediateCode.rol) THEN
  2300. (* |high| <- |low| <- |temp=high| *)
  2301. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  2302. TicketToOperand(ticket,temp);
  2303. emitter.Emit2( InstructionSet.opMOV, temp, op1High);
  2304. emitter.Emit3( InstructionSet.opSHLD,op1High, op1, shift);
  2305. emitter.Emit3( InstructionSet.opSHLD, op1, temp, shift);
  2306. UnmapTicket(ticket);
  2307. ELSE
  2308. (* |high| <- |low| *)
  2309. emitter.Emit3( InstructionSet.opSHLD, op1,op1High,shift);
  2310. emitter.Emit2( op, op1,shift);
  2311. END;
  2312. ELSE
  2313. IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
  2314. Move(op1,op2,PhysicalOperandType(op1))
  2315. END;
  2316. IF instruction.opcode=IntermediateCode.ror THEN
  2317. (* |temp=low| -> |high| -> |low| *)
  2318. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  2319. TicketToOperand(ticket,temp);
  2320. emitter.Emit2( InstructionSet.opMOV, temporary, op1);
  2321. emitter.Emit3( InstructionSet.opSHRD,op1, op1High, shift);
  2322. emitter.Emit3( InstructionSet.opSHRD, op1High, temporary, shift);
  2323. UnmapTicket(ticket);
  2324. ELSE
  2325. (* |high| -> |low| *)
  2326. emitter.Emit3( InstructionSet.opSHRD, op1,op1High,shift);
  2327. emitter.Emit2( op, op1High, shift);
  2328. END;
  2329. END;
  2330. IF backend.cooperative & (instruction.op3.mode # IntermediateCode.ModeImmediate) THEN
  2331. UnmapTicket(ecx);
  2332. UnSpill(ap);
  2333. ap.spillable := FALSE;
  2334. END;
  2335. END EmitShift;
  2336. PROCEDURE EmitCas(CONST instruction: IntermediateCode.Instruction);
  2337. VAR ra: Ticket; op1,op2,op3,mem: Assembler.Operand; register: LONGINT;
  2338. BEGIN
  2339. CASE instruction.op2.type.sizeInBits OF
  2340. | IntermediateCode.Bits8: register := AL;
  2341. | IntermediateCode.Bits16: register := AX;
  2342. | IntermediateCode.Bits32: register := EAX;
  2343. | IntermediateCode.Bits64: register := RAX;
  2344. END;
  2345. Spill(physicalRegisters.Mapped(register));
  2346. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op2.type,register,inPC);
  2347. IF IntermediateCode.OperandEquals (instruction.op2,instruction.op3) THEN
  2348. MakeOperand(instruction.op1,Low,op1,ra);
  2349. Assembler.InitMem(mem,SHORT(instruction.op1.type.sizeInBits DIV 8),op1.register,0);
  2350. emitter.Emit2(InstructionSet.opMOV,op1,mem);
  2351. ELSE
  2352. MakeOperand(instruction.op2,Low,op2,ra);
  2353. MakeRegister(instruction.op1,Low,op1);
  2354. Assembler.InitMem(mem,SHORT(instruction.op2.type.sizeInBits DIV 8),op1.register,0);
  2355. MakeRegister(instruction.op3,Low,op3);
  2356. emitter.EmitPrefix (InstructionSet.prfLOCK);
  2357. emitter.Emit2(InstructionSet.opCMPXCHG,mem,op3);
  2358. END;
  2359. END EmitCas;
  2360. PROCEDURE EmitCopy(CONST instruction: IntermediateCode.Instruction);
  2361. VAR op1,op2,op3: Assembler.Operand; esi, edi, ecx, t: Ticket; temp,imm: Assembler.Operand; source, dest: IntermediateCode.Operand; size: HUGEINT;
  2362. BEGIN
  2363. IF IntermediateCode.IsConstantInteger(instruction.op3, size) & (size = 4) THEN
  2364. Spill(physicalRegisters.Mapped(ESI));
  2365. Spill(physicalRegisters.Mapped(EDI));
  2366. esi := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,RS,inPC);
  2367. edi := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,RD,inPC);
  2368. MakeOperand(instruction.op1,Low,op1,edi);
  2369. MakeOperand(instruction.op2,Low,op2,esi);
  2370. emitter.Emit0(InstructionSet.opMOVSD);
  2371. UnmapTicket(esi);
  2372. UnmapTicket(edi);
  2373. ELSE
  2374. Spill(physicalRegisters.Mapped(ESI));
  2375. Spill(physicalRegisters.Mapped(EDI));
  2376. IF backend.cooperative THEN ap.spillable := TRUE END;
  2377. Spill(physicalRegisters.Mapped(ECX));
  2378. esi := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,RS,inPC);
  2379. edi := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,RD,inPC);
  2380. ecx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,RC,inPC);
  2381. MakeOperand(instruction.op1,Low,op1,edi);
  2382. MakeOperand(instruction.op2,Low,op2,esi);
  2383. IF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) & IntermediateCode.IsConstantInteger(instruction.op3, size) & (size >= 4096) THEN
  2384. (* special case on stack: copy downwards for possible stack allocation *)
  2385. IF size MOD 4 # 0 THEN
  2386. imm := Assembler.NewImm32(size-1);
  2387. emitter.Emit2(InstructionSet.opADD, opEDI, imm);
  2388. emitter.Emit2(InstructionSet.opADD, opESI, imm);
  2389. imm := Assembler.NewImm32(size MOD 4);
  2390. emitter.Emit2(InstructionSet.opMOV, opECX, imm);
  2391. emitter.Emit0(InstructionSet.opSTD); (* copy down *)
  2392. emitter.EmitPrefix (InstructionSet.prfREP);
  2393. emitter.Emit0(InstructionSet.opMOVSB);
  2394. imm := Assembler.NewImm32(size DIV 4);
  2395. emitter.Emit2(InstructionSet.opMOV, opECX, imm);
  2396. emitter.EmitPrefix (InstructionSet.prfREP);
  2397. emitter.Emit0(InstructionSet.opMOVSD);
  2398. ELSE
  2399. imm := Assembler.NewImm32(size-4);
  2400. emitter.Emit2(InstructionSet.opADD, opEDI, imm);
  2401. emitter.Emit2(InstructionSet.opADD, opESI, imm);
  2402. imm := Assembler.NewImm32(size DIV 4);
  2403. emitter.Emit2(InstructionSet.opMOV, opECX, imm);
  2404. emitter.Emit0(InstructionSet.opSTD); (* copy down *)
  2405. emitter.EmitPrefix (InstructionSet.prfREP);
  2406. emitter.Emit0(InstructionSet.opMOVSD);
  2407. END
  2408. ELSIF IntermediateCode.IsConstantInteger(instruction.op3, size) THEN
  2409. imm := Assembler.NewImm32(size DIV 4);
  2410. emitter.Emit2(InstructionSet.opMOV, opECX, imm);
  2411. emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
  2412. emitter.EmitPrefix (InstructionSet.prfREP);
  2413. emitter.Emit0(InstructionSet.opMOVSD);
  2414. IF size MOD 4 # 0 THEN
  2415. imm := Assembler.NewImm32(size MOD 4);
  2416. emitter.Emit2(InstructionSet.opMOV, opECX, imm);
  2417. emitter.EmitPrefix (InstructionSet.prfREP);
  2418. emitter.Emit0(InstructionSet.opMOVSB);
  2419. END;
  2420. (* this does not work in the kernel -- for whatever reasons *)
  2421. ELSIF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) THEN
  2422. MakeOperand(instruction.op3,Low,op3,ecx);
  2423. t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, IntermediateCode.int32);
  2424. TicketToOperand(t, temp);
  2425. emitter.Emit2(InstructionSet.opADD, opESI, opECX);
  2426. emitter.Emit2(InstructionSet.opADD, opEDI, opECX);
  2427. imm := Assembler.NewImm8(1);
  2428. emitter.Emit2(InstructionSet.opSUB, opESI, imm);
  2429. emitter.Emit2(InstructionSet.opSUB, opEDI, imm);
  2430. emitter.Emit2(InstructionSet.opMOV, temp, opECX);
  2431. imm := Assembler.NewImm8(3);
  2432. emitter.Emit2(InstructionSet.opAND, opECX, imm);
  2433. emitter.Emit0(InstructionSet.opSTD); (* copy downwards *)
  2434. emitter.EmitPrefix (InstructionSet.prfREP);
  2435. emitter.Emit0(InstructionSet.opMOVSB);
  2436. imm := Assembler.NewImm8(2);
  2437. emitter.Emit2(InstructionSet.opMOV, opECX, temp);
  2438. emitter.Emit2(InstructionSet.opSHR, opECX, imm);
  2439. imm := Assembler.NewImm8(3);
  2440. emitter.Emit2(InstructionSet.opSUB, opESI, imm);
  2441. emitter.Emit2(InstructionSet.opSUB, opEDI, imm);
  2442. emitter.EmitPrefix (InstructionSet.prfREP);
  2443. emitter.Emit0(InstructionSet.opMOVSD);
  2444. emitter.Emit0(InstructionSet.opCLD);
  2445. ELSE
  2446. MakeOperand(instruction.op3,Low,op3,ecx);
  2447. t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, IntermediateCode.int32);
  2448. TicketToOperand(t, temp);
  2449. emitter.Emit2(InstructionSet.opMOV, temp, opECX);
  2450. imm := Assembler.NewImm8(3);
  2451. emitter.Emit2(InstructionSet.opAND, temp, imm);
  2452. imm := Assembler.NewImm8(2);
  2453. emitter.Emit2(InstructionSet.opSHR, opECX, imm);
  2454. emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
  2455. emitter.EmitPrefix (InstructionSet.prfREP);
  2456. emitter.Emit0(InstructionSet.opMOVSD);
  2457. emitter.Emit2(InstructionSet.opMOV, opECX, temp);
  2458. emitter.EmitPrefix (InstructionSet.prfREP);
  2459. emitter.Emit0(InstructionSet.opMOVSB);
  2460. END;
  2461. UnmapTicket(esi);
  2462. UnmapTicket(edi);
  2463. UnmapTicket(ecx);
  2464. IF backend.cooperative THEN
  2465. UnSpill(ap);
  2466. ap.spillable := FALSE;
  2467. END;
  2468. END;
  2469. END EmitCopy;
  2470. PROCEDURE EmitFill(CONST instruction: IntermediateCode.Instruction; down: BOOLEAN);
  2471. VAR reg,sizeInBits,i: LONGINT;val, value, size, dest: Assembler.Operand;
  2472. op: LONGINT;
  2473. edi, ecx: Ticket;
  2474. BEGIN
  2475. IF FALSE & (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op2.symbol.name = "") & (instruction.op2.intValue < 5) THEN
  2476. sizeInBits := instruction.op3.type.sizeInBits;
  2477. IF sizeInBits = IntermediateCode.Bits8 THEN value := opAL;
  2478. ELSIF sizeInBits = IntermediateCode.Bits16 THEN value := opAX;
  2479. ELSIF sizeInBits = IntermediateCode.Bits32 THEN value := opEAX;
  2480. ELSE HALT(200)
  2481. END;
  2482. MakeOperand(instruction.op1,Low,dest,NIL);
  2483. IF instruction.op1.mode = IntermediateCode.ModeRegister THEN reg := dest.register
  2484. ELSE emitter.Emit2(InstructionSet.opMOV,opEDX,dest); reg := EDX;
  2485. END;
  2486. IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
  2487. emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
  2488. ELSE
  2489. MakeOperand(instruction.op3,Low,value,NIL);
  2490. END;
  2491. FOR i := 0 TO SHORT(instruction.op2.intValue)-1 DO
  2492. IF down THEN
  2493. Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8)),reg,-i*sizeInBits DIV 8);
  2494. ELSE
  2495. Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8 )),reg,i*sizeInBits DIV 8);
  2496. END;
  2497. emitter.Emit2(InstructionSet.opMOV,dest,value);
  2498. END;
  2499. ELSE
  2500. Spill(physicalRegisters.Mapped(EDI));
  2501. IF backend.cooperative THEN ap.spillable := TRUE END;
  2502. Spill(physicalRegisters.Mapped(ECX));
  2503. edi := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDI,inPC);
  2504. ecx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,ECX,inPC);
  2505. MakeOperand(instruction.op1,Low,dest,edi);
  2506. MakeOperand(instruction.op2,Low,size,ecx);
  2507. MakeOperand(instruction.op3,Low,value,NIL);
  2508. (*
  2509. emitter.Emit2(InstructionSet.opMOV,opEDI, op1[Low]);
  2510. emitter.Emit2(InstructionSet.opMOV,opECX, op3[Low]);
  2511. *)
  2512. CASE instruction.op3.type.sizeInBits OF
  2513. IntermediateCode.Bits8: val := opAL; op := InstructionSet.opSTOSB;
  2514. |IntermediateCode.Bits16: val := opAX; op := InstructionSet.opSTOSW;
  2515. |IntermediateCode.Bits32: val := opEAX; op := InstructionSet.opSTOSD;
  2516. ELSE Halt("only supported for upto 32 bit integers ");
  2517. END;
  2518. IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
  2519. emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
  2520. ELSE
  2521. emitter.Emit2(InstructionSet.opMOV,val,value);
  2522. END;
  2523. IF down THEN
  2524. emitter.Emit0(InstructionSet.opSTD); (* fill downwards *)
  2525. ELSE
  2526. emitter.Emit0(InstructionSet.opCLD); (* fill upwards *)
  2527. END;
  2528. emitter.EmitPrefix (InstructionSet.prfREP);
  2529. emitter.Emit0(op);
  2530. IF down THEN (* needed as calls to windows crash otherwise *)
  2531. emitter.Emit0(InstructionSet.opCLD);
  2532. END;
  2533. UnmapTicket(ecx);
  2534. IF backend.cooperative THEN
  2535. UnSpill(ap);
  2536. ap.spillable := FALSE;
  2537. END;
  2538. END;
  2539. END EmitFill;
  2540. PROCEDURE EmitBr (CONST instruction: IntermediateCode.Instruction);
  2541. VAR dest,destPC,offset: LONGINT; target: Assembler.Operand;hit,fail: LONGINT; reverse: BOOLEAN;
  2542. (* jump operands *) left,right,temp: Assembler.Operand;
  2543. failOp: Assembler.Operand; failPC: LONGINT;
  2544. PROCEDURE JmpDest(brop: LONGINT);
  2545. BEGIN
  2546. IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
  2547. IF instruction.op1.symbol.name # in.name THEN
  2548. Assembler.InitOffset32(target,instruction.op1.intValue);
  2549. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
  2550. emitter.Emit1(brop,target);
  2551. ELSE
  2552. dest := (instruction.op1.symbolOffset); (* this is the offset in the in-data section (intermediate code), it is not byte- *)
  2553. destPC := (in.instructions[dest].pc );
  2554. offset := destPC - (out.pc );
  2555. IF dest > inPC THEN (* forward jump *)
  2556. Assembler.InitOffset32(target,0);
  2557. Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
  2558. emitter.Emit1(brop,target);
  2559. ELSIF ABS(offset) <= 126 THEN
  2560. Assembler.InitOffset8(target,destPC);
  2561. emitter.Emit1(brop,target);
  2562. ELSE
  2563. Assembler.InitOffset32(target,destPC);
  2564. emitter.Emit1(brop,target);
  2565. END;
  2566. END;
  2567. ELSE
  2568. MakeOperand(instruction.op1,Low,target,NIL);
  2569. emitter.Emit1(brop,target);
  2570. END;
  2571. END JmpDest;
  2572. PROCEDURE CmpFloat;
  2573. BEGIN
  2574. IF backend.forceFPU THEN
  2575. MakeOperand(instruction.op2,Low,left,NIL);
  2576. emitter.Emit1(InstructionSet.opFLD,left); INC(fpStackPointer);
  2577. MakeOperand(instruction.op3,Low,right,NIL);
  2578. emitter.Emit1(InstructionSet.opFCOMP,right); DEC(fpStackPointer);
  2579. emitter.Emit1(InstructionSet.opFNSTSW,opAX);
  2580. emitter.Emit0(InstructionSet.opSAHF);
  2581. ELSE
  2582. MakeRegister(instruction.op2,Low,left);
  2583. MakeOperand(instruction.op3,Low,right,NIL);
  2584. IF instruction.op2.type.sizeInBits = 32 THEN
  2585. emitter.Emit2(InstructionSet.opCOMISS, left, right);
  2586. ELSE
  2587. emitter.Emit2(InstructionSet.opCOMISD, left, right);
  2588. END
  2589. END;
  2590. END CmpFloat;
  2591. PROCEDURE Cmp(part: LONGINT; VAR reverse: BOOLEAN);
  2592. VAR type: IntermediateCode.Type; left,right: Assembler.Operand;
  2593. BEGIN
  2594. IF (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op3.mode = IntermediateCode.ModeImmediate) THEN
  2595. reverse := FALSE;
  2596. GetPartType(instruction.op2.type,part,type);
  2597. GetTemporaryRegister(type,temp);
  2598. MakeOperand(instruction.op2,part,left,NIL);
  2599. MakeOperand(instruction.op3,part,right,NIL);
  2600. Move(temp,left, type);
  2601. left := temp;
  2602. ELSIF instruction.op2.mode = IntermediateCode.ModeImmediate THEN
  2603. reverse := TRUE;
  2604. MakeOperand(instruction.op2,part,right,NIL);
  2605. MakeOperand(instruction.op3,part,left,NIL);
  2606. ELSIF IsMemoryOperand(instruction.op2,part) & IsMemoryOperand(instruction.op3,part) THEN
  2607. reverse := FALSE;
  2608. GetPartType(instruction.op2.type,part,type);
  2609. GetTemporaryRegister(type,temp);
  2610. MakeOperand(instruction.op2,part,left,NIL);
  2611. MakeOperand(instruction.op3,part,right,NIL);
  2612. Move(temp,right,type);
  2613. right := temp;
  2614. ELSE
  2615. reverse := FALSE;
  2616. MakeOperand(instruction.op2,part,left,NIL);
  2617. MakeOperand(instruction.op3,part,right,NIL);
  2618. END;
  2619. emitter.Emit2(InstructionSet.opCMP,left,right);
  2620. END Cmp;
  2621. BEGIN
  2622. IF (instruction.op1.symbol.name = in.name) & (instruction.op1.symbolOffset = inPC +1) THEN (* jump to next instruction can be ignored *)
  2623. IF dump # NIL THEN dump.String("jump to next instruction ignored"); dump.Ln END;
  2624. RETURN
  2625. END;
  2626. failPC := 0;
  2627. IF instruction.opcode = IntermediateCode.br THEN
  2628. hit := InstructionSet.opJMP
  2629. ELSIF instruction.op2.type.form = IntermediateCode.Float THEN
  2630. CmpFloat;
  2631. CASE instruction.opcode OF
  2632. IntermediateCode.breq: hit := InstructionSet.opJE;
  2633. |IntermediateCode.brne:hit := InstructionSet.opJNE;
  2634. |IntermediateCode.brge: hit := InstructionSet.opJAE
  2635. |IntermediateCode.brlt: hit := InstructionSet.opJB
  2636. END;
  2637. ELSE
  2638. IF ~IsComplex(instruction.op2) THEN
  2639. Cmp(Low,reverse);
  2640. CASE instruction.opcode OF
  2641. IntermediateCode.breq: hit := InstructionSet.opJE;
  2642. |IntermediateCode.brne: hit := InstructionSet.opJNE;
  2643. |IntermediateCode.brge:
  2644. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2645. IF reverse THEN hit := InstructionSet.opJLE ELSE hit := InstructionSet.opJGE END;
  2646. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2647. IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
  2648. END;
  2649. |IntermediateCode.brlt:
  2650. IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
  2651. IF reverse THEN hit := InstructionSet.opJG ELSE hit := InstructionSet.opJL END;
  2652. ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2653. IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
  2654. END;
  2655. END;
  2656. ELSE
  2657. Assert(instruction.op2.type.form = IntermediateCode.SignedInteger,"no unsigned integer64");
  2658. Cmp(High,reverse);
  2659. CASE instruction.opcode OF
  2660. IntermediateCode.breq: hit := 0; fail := InstructionSet.opJNE;
  2661. |IntermediateCode.brne: hit := InstructionSet.opJNE; fail := 0;
  2662. |IntermediateCode.brge:
  2663. IF reverse THEN hit := InstructionSet.opJL; fail := InstructionSet.opJG;
  2664. ELSE hit := InstructionSet.opJG; fail := InstructionSet.opJL
  2665. END;
  2666. |IntermediateCode.brlt:
  2667. IF reverse THEN hit := InstructionSet.opJG; fail := InstructionSet.opJL
  2668. ELSE hit := InstructionSet.opJL; fail := InstructionSet.opJG
  2669. END;
  2670. END;
  2671. IF hit # 0 THEN JmpDest(hit) END;
  2672. IF fail # 0 THEN
  2673. failPC := out.pc; (* to avoid potential value overflow problem, will be patched anyway *)
  2674. Assembler.InitOffset8(failOp,failPC );
  2675. emitter.Emit1(fail,failOp);
  2676. failPC := failOp.pc;
  2677. END;
  2678. Cmp(Low,reverse);
  2679. CASE instruction.opcode OF
  2680. IntermediateCode.breq: hit := InstructionSet.opJE
  2681. |IntermediateCode.brne: hit := InstructionSet.opJNE
  2682. |IntermediateCode.brge:
  2683. IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
  2684. |IntermediateCode.brlt:
  2685. IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
  2686. END;
  2687. END;
  2688. END;
  2689. JmpDest(hit);
  2690. IF failPC > 0 THEN out.PutByteAt(failPC,(out.pc-failPC)-1); END;
  2691. END EmitBr;
  2692. PROCEDURE EmitPush(CONST vop: IntermediateCode.Operand; part: LONGINT);
  2693. VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
  2694. BEGIN
  2695. GetPartType(vop.type,part,type);
  2696. ASSERT(type.form IN IntermediateCode.Integer);
  2697. IF vop.mode = IntermediateCode.ModeImmediate THEN (* may not push 16 bit immediate: strange instruction in 32 / 64 bit mode *)
  2698. GetImmediate(vop,part,op1,TRUE);
  2699. emitter.Emit1(InstructionSet.opPUSH,op1);
  2700. ELSIF (type.sizeInBits = cpuBits) THEN
  2701. MakeOperand(vop,part,op1,NIL);
  2702. emitter.Emit1(InstructionSet.opPUSH,op1);
  2703. ELSE
  2704. ASSERT(type.sizeInBits < cpuBits);
  2705. MakeOperand(vop,part,op1,NIL);
  2706. IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
  2707. index := op1.register MOD 32 + opRA.register;
  2708. emitter.Emit1(InstructionSet.opPUSH, registerOperands[index]);
  2709. ELSE
  2710. WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
  2711. IntermediateCode.InitType(cpuType,IntermediateCode.SignedInteger,SHORT(cpuBits));
  2712. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
  2713. CASE type.sizeInBits OF
  2714. 8: index := AL
  2715. |16: index := AX
  2716. |32: index := EAX
  2717. |64: index := RAX
  2718. END;
  2719. emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op1);
  2720. emitter.Emit1(InstructionSet.opPUSH,opRA);
  2721. UnmapTicket(ra);
  2722. END;
  2723. END;
  2724. END EmitPush;
  2725. PROCEDURE EmitPop(CONST vop: IntermediateCode.Operand; part: LONGINT);
  2726. VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
  2727. BEGIN
  2728. GetPartType(vop.type,part,type);
  2729. ASSERT(type.form IN IntermediateCode.Integer);
  2730. IF (type.sizeInBits = cpuBits) THEN
  2731. MakeOperand(vop,part,op1,NIL);
  2732. emitter.Emit1(InstructionSet.opPOP,op1);
  2733. ELSE
  2734. ASSERT(type.sizeInBits < cpuBits);
  2735. MakeOperand(vop,part,op1,NIL);
  2736. IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
  2737. index := op1.register MOD 32 + opRA.register;
  2738. emitter.Emit1(InstructionSet.opPOP, registerOperands[index]);
  2739. ELSE
  2740. WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
  2741. IntermediateCode.InitType(cpuType, IntermediateCode.SignedInteger, SHORT(cpuBits));
  2742. ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
  2743. emitter.Emit1(InstructionSet.opPOP,opRA);
  2744. CASE type.sizeInBits OF
  2745. 8: index := AL
  2746. |16: index := AX
  2747. |32: index := EAX
  2748. |64: index := RAX
  2749. END;
  2750. emitter.Emit2(InstructionSet.opMOV, op1, registerOperands[index]);
  2751. UnmapTicket(ra);
  2752. END;
  2753. END;
  2754. END EmitPop;
  2755. PROCEDURE EmitPushFloat(CONST vop: IntermediateCode.Operand);
  2756. VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
  2757. BEGIN
  2758. MakeOperand(vop,Low,op,NIL);
  2759. length := vop.type.length;
  2760. IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
  2761. emitter.Emit1(InstructionSet.opPUSH,op);
  2762. ELSE
  2763. sizeInBytes := vop.type.sizeInBits DIV 8;
  2764. length := vop.type.length;
  2765. IF sizeInBytes * length * 8 < cpuBits THEN
  2766. AllocateStack(cpuBits DIV 8);
  2767. ELSE
  2768. AllocateStack(sizeInBytes*length);
  2769. END;
  2770. Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
  2771. IF backend.forceFPU THEN
  2772. emitter.Emit1(InstructionSet.opFLD,op); INC(fpStackPointer);
  2773. emitter.Emit1(InstructionSet.opFSTP,memop); DEC(fpStackPointer);
  2774. ELSE
  2775. Move(memop, op, vop.type)
  2776. END
  2777. END;
  2778. END EmitPushFloat;
  2779. PROCEDURE EmitPopFloat(CONST vop: IntermediateCode.Operand);
  2780. VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
  2781. BEGIN
  2782. sizeInBytes := vop.type.sizeInBits DIV 8;
  2783. length := vop.type.length;
  2784. IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
  2785. MakeOperand(vop,Low,op,NIL);
  2786. emitter.Emit1(InstructionSet.opPOP,op);
  2787. ELSE
  2788. Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
  2789. IF backend.forceFPU THEN
  2790. emitter.Emit1(InstructionSet.opFLD,memop);
  2791. INC(fpStackPointer);
  2792. MakeOperand(vop,Low,op,NIL);
  2793. emitter.Emit1(InstructionSet.opFSTP,op);
  2794. DEC(fpStackPointer);
  2795. ASSERT(sizeInBytes > 0);
  2796. ELSE
  2797. MakeOperand(vop,Low,op,NIL);
  2798. Move(op, memop, vop.type)
  2799. END;
  2800. AllocateStack(-sizeInBytes*length);
  2801. END;
  2802. END EmitPopFloat;
  2803. PROCEDURE EmitNeg(CONST instruction: IntermediateCode.Instruction);
  2804. VAR opLow,opHigh: Assembler.Operand; minusOne: Assembler.Operand; ticketLow,ticketHigh: Ticket;
  2805. BEGIN
  2806. IF IsComplex(instruction.op1) THEN
  2807. PrepareOp2(instruction,High,opHigh,ticketHigh);
  2808. PrepareOp2(instruction,Low,opLow,ticketLow);
  2809. emitter.Emit1(InstructionSet.opNOT,opHigh);
  2810. emitter.Emit1(InstructionSet.opNEG,opLow);
  2811. Assembler.InitImm8(minusOne,-1);
  2812. emitter.Emit2(InstructionSet.opSBB,opHigh,minusOne);
  2813. FinishOp(instruction.op1,High,opHigh,ticketHigh);
  2814. FinishOp(instruction.op1,Low,opLow,ticketLow);
  2815. ELSE
  2816. EmitArithmetic2(instruction,Low,InstructionSet.opNEG);
  2817. END;
  2818. END EmitNeg;
  2819. PROCEDURE EmitNegXMM(CONST instruction: IntermediateCode.Instruction);
  2820. VAR temp, op: Assembler.Operand; ticket: Ticket;
  2821. BEGIN
  2822. PrepareOp2(instruction, Low, op, ticket);
  2823. GetTemporaryRegister(instruction.op1.type,temp);
  2824. IF instruction.op1.type.sizeInBits = 32 THEN
  2825. emitter.Emit2(InstructionSet.opXORPS, temp, temp);
  2826. emitter.Emit2(InstructionSet.opSUBPS, temp, op);
  2827. emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
  2828. ELSE
  2829. emitter.Emit2(InstructionSet.opXORPD, temp, temp);
  2830. emitter.Emit2(InstructionSet.opSUBPD, temp, op);
  2831. emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
  2832. END;
  2833. FinishOp(instruction.op1, Low, op, ticket);
  2834. END EmitNegXMM;
  2835. PROCEDURE EmitAbs(CONST instruction: IntermediateCode.Instruction);
  2836. VAR op1,op2: Assembler.Operand; source,imm: Assembler.Operand; eax: Ticket;
  2837. BEGIN
  2838. Assert(~IsComplex(instruction.op1),"complex Abs not supported");
  2839. IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
  2840. Spill(physicalRegisters.Mapped(EAX));
  2841. eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
  2842. MakeOperand(instruction.op1,Low,op1,NIL);
  2843. MakeOperand(instruction.op2,Low,op2,NIL);
  2844. CASE instruction.op1.type.sizeInBits OF
  2845. | IntermediateCode.Bits8: imm := Assembler.NewImm8 (7); source := opAL;
  2846. | IntermediateCode.Bits16: imm := Assembler.NewImm8 (15); source := opAX;
  2847. | IntermediateCode.Bits32: imm := Assembler.NewImm8 (31); source := opEAX;
  2848. | IntermediateCode.Bits64: imm := Assembler.NewImm8 (63); source := registerOperands[RAX];
  2849. END;
  2850. emitter.Emit2 (InstructionSet.opMOV, source,op2);
  2851. emitter.Emit2 (InstructionSet.opMOV, op1,source);
  2852. emitter.Emit2 (InstructionSet.opSAR, source, imm);
  2853. emitter.Emit2 (InstructionSet.opXOR, op1, source);
  2854. emitter.Emit2 (InstructionSet.opSUB, op1, source);
  2855. UnmapTicket(eax);
  2856. ELSE Halt("Abs does not make sense on unsigned integer")
  2857. END;
  2858. END EmitAbs;
  2859. PROCEDURE EmitAbsXMM(CONST instruction: IntermediateCode.Instruction);
  2860. VAR temp, op: Assembler.Operand; ticket: Ticket;
  2861. BEGIN
  2862. PrepareOp2(instruction, Low, op, ticket);
  2863. GetTemporaryRegister(instruction.op1.type,temp);
  2864. IF instruction.op1.type.sizeInBits = 32 THEN
  2865. emitter.Emit2(InstructionSet.opXORPS, temp, temp);
  2866. emitter.Emit2(InstructionSet.opSUBPS, temp, op);
  2867. emitter.Emit2(InstructionSet.opMAXPS, op, temp);
  2868. ELSE
  2869. emitter.Emit2(InstructionSet.opXORPD, temp, temp);
  2870. emitter.Emit2(InstructionSet.opSUBPD, temp, op);
  2871. emitter.Emit2(InstructionSet.opMAXPD, op, temp);
  2872. END;
  2873. FinishOp(instruction.op1, Low, op, ticket);
  2874. END EmitAbsXMM;
  2875. PROCEDURE EmitTrap(CONST instruction: IntermediateCode.Instruction);
  2876. VAR operand: Assembler.Operand;
  2877. BEGIN
  2878. IF instruction.op1.intValue < 80H THEN
  2879. operand := Assembler.NewImm8(instruction.op1.intValue);
  2880. ELSE
  2881. operand := Assembler.NewImm32(instruction.op1.intValue);
  2882. END;
  2883. emitter.Emit1(InstructionSet.opPUSH, operand);
  2884. emitter.Emit0(InstructionSet.opINT3);
  2885. END EmitTrap;
  2886. PROCEDURE EmitAsm(CONST instruction: IntermediateCode.Instruction);
  2887. VAR reader: Streams.StringReader; procedure: SyntaxTree.Procedure; scope: SyntaxTree.Scope;
  2888. len: LONGINT; symbol: SyntaxTree.Symbol; assembler: Assembler.Assembly;
  2889. inr, outr: IntermediateCode.Rules;
  2890. string: SyntaxTree.SourceCode;
  2891. i: LONGINT;
  2892. reg, dest: Assembler.Operand;
  2893. map: Assembler.RegisterMap;
  2894. register: LONGINT;
  2895. ticket: Ticket;
  2896. BEGIN
  2897. IF instruction.op2.mode = IntermediateCode.ModeRule THEN inr := instruction.op2.rule ELSE inr := NIL END;
  2898. IF instruction.op3.mode = IntermediateCode.ModeRule THEN outr := instruction.op3.rule ELSE outr := NIL END;
  2899. string := instruction.op1.string;
  2900. NEW(map);
  2901. IF inr # NIL THEN
  2902. FOR i := 0 TO LEN(inr)-1 DO
  2903. MakeRegister(inr[i], 0, reg);
  2904. ASSERT(map.Find(inr[i].string^) < 0);
  2905. map.Add(inr[i].string, reg.register)
  2906. END;
  2907. END;
  2908. IF outr # NIL THEN
  2909. FOR i := 0 TO LEN(outr)-1 DO
  2910. IF (map.Find(outr[i].string^) < 0) THEN
  2911. GetTemporaryRegister(outr[i].type,reg);
  2912. map.Add(outr[i].string, reg.register)
  2913. END;
  2914. END;
  2915. END;
  2916. len := Strings.Length(string^);
  2917. NEW(reader,len);
  2918. reader.Set(string^);
  2919. symbol := in.symbol;
  2920. procedure := symbol(SyntaxTree.Procedure);
  2921. scope := procedure.procedureScope;
  2922. NEW(assembler,diagnostics,emitter);
  2923. assembler.useLineNumbers := Compiler.UseLineNumbers IN backend.flags;
  2924. assembler.Assemble(reader,instruction.textPosition,scope,in,in,module,procedure.access * SyntaxTree.Public # {}, procedure.isInline, map) ;
  2925. error := error OR assembler.error;
  2926. IF outr # NIL THEN
  2927. FOR i := 0 TO LEN(outr)-1 DO
  2928. IF outr[i].mode # IntermediateCode.Undefined THEN
  2929. register := map.Find(outr[i].string^);
  2930. ticket := physicalRegisters.Mapped(register);
  2931. IF ticket.lastuse = inPC THEN UnmapTicket(ticket); physicalRegisters.AllocationHint(register) END; (* try to reuse register here *)
  2932. Assembler.InitRegister(reg, register);
  2933. MakeOperand(outr[i], Low, dest, NIL);
  2934. Move( dest, reg,outr[i].type)
  2935. END;
  2936. END;
  2937. END;
  2938. (*
  2939. IntermediateCode.SetString(instruction.op1, string);
  2940. *)
  2941. END EmitAsm;
  2942. END CodeGeneratorAMD64;
  2943. BackendAMD64= OBJECT (IntermediateBackend.IntermediateBackend)
  2944. VAR
  2945. cg: CodeGeneratorAMD64;
  2946. bits: LONGINT;
  2947. traceable: BOOLEAN;
  2948. forceFPU: BOOLEAN;
  2949. winAPIRegisters, cRegisters: Backend.Registers;
  2950. PROCEDURE &InitBackendAMD64;
  2951. BEGIN
  2952. InitIntermediateBackend;
  2953. bits := 32;
  2954. forceFPU := FALSE;
  2955. NEW(winAPIRegisters, 4);
  2956. winAPIRegisters[0] := RCX - RAX;
  2957. winAPIRegisters[1] := RDX - RAX;
  2958. winAPIRegisters[2] := R8 - RAX;
  2959. winAPIRegisters[3] := R9 - RAX;
  2960. NEW(cRegisters, 6);
  2961. cRegisters[0] := RDI - RAX;
  2962. cRegisters[1] := RSI - RAX;
  2963. cRegisters[2] := RDX - RAX;
  2964. cRegisters[3] := RCX - RAX;
  2965. cRegisters[4] := R8 - RAX;
  2966. cRegisters[5] := R9 - RAX;
  2967. SetName("AMD");
  2968. END InitBackendAMD64;
  2969. PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System);
  2970. BEGIN
  2971. Initialize^(diagnostics,log, flags,checker,system); NEW(cg, runtimeModuleName, diagnostics, SELF);
  2972. END Initialize;
  2973. PROCEDURE GetSystem(): Global.System;
  2974. VAR system: Global.System;
  2975. PROCEDURE AddRegister(CONST name: Scanner.IdentifierString; val: LONGINT);
  2976. BEGIN
  2977. Global.NewConstant(name,val,system.shortintType,system.systemScope)
  2978. END AddRegister;
  2979. PROCEDURE AddRegisters;
  2980. BEGIN
  2981. (* system constants *)
  2982. AddRegister("EAX",InstructionSet.regEAX); AddRegister("ECX", InstructionSet.regECX);
  2983. AddRegister( "EDX", InstructionSet.regEDX); AddRegister( "EBX", InstructionSet.regEBX);
  2984. AddRegister( "ESP", InstructionSet.regESP); AddRegister( "EBP", InstructionSet.regEBP);
  2985. AddRegister( "ESI", InstructionSet.regESI); AddRegister( "EDI", InstructionSet.regEDI);
  2986. AddRegister( "AX", InstructionSet.regAX); AddRegister( "CX", InstructionSet.regCX);
  2987. AddRegister( "DX", InstructionSet.regDX); AddRegister( "BX", InstructionSet.regBX);
  2988. AddRegister( "AL", InstructionSet.regAL); AddRegister( "CL", InstructionSet.regCL);
  2989. AddRegister( "DL", InstructionSet.regDL); AddRegister( "BL", InstructionSet.regBL);
  2990. AddRegister( "AH", InstructionSet.regAH); AddRegister( "CH", InstructionSet.regCH);
  2991. AddRegister( "DH", InstructionSet.regDH); AddRegister( "BH", InstructionSet.regBH);
  2992. AddRegister( "RAX", InstructionSet.regRAX); AddRegister( "RCX", InstructionSet.regRCX);
  2993. AddRegister( "RDX", InstructionSet.regRDX); AddRegister( "RBX", InstructionSet.regRBX);
  2994. AddRegister( "RSP", InstructionSet.regRSP); AddRegister( "RBP", InstructionSet.regRBP);
  2995. AddRegister( "RSI", InstructionSet.regRSI); AddRegister( "RDI", InstructionSet.regRDI);
  2996. AddRegister( "R8", InstructionSet.regR8); AddRegister( "R9", InstructionSet.regR9);
  2997. AddRegister( "R10", InstructionSet.regR10); AddRegister( "R11", InstructionSet.regR11);
  2998. AddRegister( "R12", InstructionSet.regR12); AddRegister( "R13", InstructionSet.regR13);
  2999. AddRegister( "R14", InstructionSet.regR14); AddRegister( "R15", InstructionSet.regR15);
  3000. AddRegister( "R8D", InstructionSet.regR8D); AddRegister( "R9D", InstructionSet.regR9D);
  3001. AddRegister( "R10D", InstructionSet.regR10D); AddRegister( "R11D", InstructionSet.regR11D);
  3002. AddRegister( "R12D", InstructionSet.regR12D); AddRegister( "R13D", InstructionSet.regR13D);
  3003. AddRegister( "R14D", InstructionSet.regR14D); AddRegister( "R15D", InstructionSet.regR15D);
  3004. AddRegister( "R8W", InstructionSet.regR8W); AddRegister( "R9W", InstructionSet.regR9W);
  3005. AddRegister( "R10W", InstructionSet.regR10W); AddRegister( "R11W", InstructionSet.regR11W);
  3006. AddRegister( "R12W", InstructionSet.regR12W); AddRegister( "R13W", InstructionSet.regR13W);
  3007. AddRegister( "R14W", InstructionSet.regR14W); AddRegister( "R15W", InstructionSet.regR15W);
  3008. AddRegister( "R8B", InstructionSet.regR8B); AddRegister( "R9B", InstructionSet.regR9B);
  3009. AddRegister( "R10B", InstructionSet.regR10B); AddRegister( "R11B", InstructionSet.regR11B);
  3010. AddRegister( "R12B", InstructionSet.regR12B); AddRegister( "R13B", InstructionSet.regR13B);
  3011. AddRegister( "R14B", InstructionSet.regR14B); AddRegister( "R15B", InstructionSet.regR15B);
  3012. END AddRegisters;
  3013. BEGIN
  3014. IF system = NIL THEN
  3015. IF bits=32 THEN
  3016. NEW(system,8,8,32, 8,32,32,32,64,cooperative);
  3017. Global.SetDefaultDeclarations(system,8);
  3018. Global.SetDefaultOperators(system);
  3019. ELSE
  3020. NEW(system,8,8,64,8,64,64,64,128,cooperative);
  3021. Global.SetDefaultDeclarations(system,8);
  3022. Global.SetDefaultOperators(system);
  3023. END;
  3024. system.SetRegisterPassCallback(CanPassInRegister);
  3025. AddRegisters
  3026. END;
  3027. RETURN system
  3028. END GetSystem;
  3029. (* return index of general purpose register used as parameter register in calling convention *)
  3030. PROCEDURE GetParameterRegisters*(callingConvention: SyntaxTree.CallingConvention): Backend.Registers;
  3031. BEGIN
  3032. IF bits = 32 THEN
  3033. RETURN NIL;
  3034. ELSE
  3035. CASE callingConvention OF
  3036. SyntaxTree.CCallingConvention: RETURN cRegisters;
  3037. |SyntaxTree.WinAPICallingConvention: RETURN winAPIRegisters;
  3038. |SyntaxTree.DarwinCCallingConvention: RETURN cRegisters;
  3039. ELSE
  3040. RETURN NIL;
  3041. END;
  3042. END
  3043. END GetParameterRegisters;
  3044. PROCEDURE SupportedInstruction(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  3045. BEGIN
  3046. RETURN cg.Supported(instruction,moduleName,procedureName);
  3047. END SupportedInstruction;
  3048. PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
  3049. VAR
  3050. in: Sections.Section;
  3051. out: BinaryCode.Section;
  3052. name: Basic.SegmentedName;
  3053. procedure: SyntaxTree.Procedure;
  3054. i, j, initialSectionCount: LONGINT;
  3055. (* recompute fixup positions and assign binary sections *)
  3056. PROCEDURE PatchFixups(section: BinaryCode.Section);
  3057. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; displacement,symbolOffset: LONGINT; in: IntermediateCode.Section;
  3058. symbol: Sections.Section;
  3059. BEGIN
  3060. fixup := section.fixupList.firstFixup;
  3061. WHILE fixup # NIL DO
  3062. symbol := module.allSections.FindByName(fixup.symbol.name);
  3063. IF (symbol # NIL) & (symbol(IntermediateCode.Section).resolved # NIL) THEN
  3064. resolved := symbol(IntermediateCode.Section).resolved(BinaryCode.Section);
  3065. in := symbol(IntermediateCode.Section);
  3066. symbolOffset := fixup.symbolOffset;
  3067. IF symbolOffset = in.pc THEN
  3068. displacement := resolved.pc
  3069. ELSIF (symbolOffset # 0) THEN
  3070. ASSERT(in.pc > symbolOffset);
  3071. displacement := in.instructions[symbolOffset].pc;
  3072. ELSE
  3073. displacement := 0;
  3074. END;
  3075. fixup.SetSymbol(fixup.symbol.name,fixup.symbol.fingerprint,0,fixup.displacement+displacement);
  3076. END;
  3077. fixup := fixup.nextFixup;
  3078. END;
  3079. END PatchFixups;
  3080. BEGIN
  3081. cg.SetModule(module);
  3082. FOR i := 0 TO module.allSections.Length() - 1 DO
  3083. in := module.allSections.GetSection(i);
  3084. IF in.type = Sections.InlineCodeSection THEN
  3085. name := in.name;
  3086. out := ResolvedSection(in(IntermediateCode.Section));
  3087. cg.Section(in(IntermediateCode.Section),out);
  3088. procedure := in.symbol(SyntaxTree.Procedure);
  3089. IF procedure.procedureScope.body.code # NIL THEN
  3090. procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
  3091. END;
  3092. END
  3093. END;
  3094. initialSectionCount := 0;
  3095. REPEAT
  3096. j := initialSectionCount;
  3097. initialSectionCount := module.allSections.Length() ;
  3098. FOR i := j TO initialSectionCount - 1 DO
  3099. in := module.allSections.GetSection(i);
  3100. IF (in.type # Sections.InlineCodeSection) & (in(IntermediateCode.Section).resolved = NIL) THEN
  3101. name := in.name;
  3102. out := ResolvedSection(in(IntermediateCode.Section));
  3103. cg.Section(in(IntermediateCode.Section),out);
  3104. IF out.os.type = Sections.VarSection THEN
  3105. IF out.pc = 1 THEN out.SetAlignment(FALSE,1)
  3106. ELSIF out.pc = 2 THEN out.SetAlignment(FALSE,2)
  3107. ELSIF (out.pc > 4) & (bits > 32) THEN out.SetAlignment(FALSE,8)
  3108. ELSIF (out.pc > 2) THEN out.SetAlignment(FALSE,4)
  3109. END;
  3110. ELSIF out.os.type = Sections.ConstSection THEN
  3111. out.SetAlignment(FALSE,bits DIV 8);
  3112. END;
  3113. END
  3114. END
  3115. UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
  3116. (*
  3117. FOR i := 0 TO module.allSections.Length() - 1 DO
  3118. in := module.allSections.GetSection(i);
  3119. IF in.kind = Sections.CaseTableKind THEN
  3120. IF in(IntermediateCode.Section).resolved = NIL THEN
  3121. out := ResolvedSection(in(IntermediateCode.Section));
  3122. cg.Section(in(IntermediateCode.Section),out);
  3123. END
  3124. END
  3125. END;
  3126. *)
  3127. FOR i := 0 TO module.allSections.Length() - 1 DO
  3128. in := module.allSections.GetSection(i);
  3129. PatchFixups(in(IntermediateCode.Section).resolved)
  3130. END;
  3131. (*
  3132. FOR i := 0 TO module.allSections.Length() - 1 DO
  3133. in := module.allSections.GetSection(i);
  3134. IF in.kind = Sections.CaseTableKind THEN
  3135. PatchFixups(in(IntermediateCode.Section).resolved)
  3136. END
  3137. END;
  3138. *)
  3139. IF cg.error THEN Error("",Basic.invalidPosition, Diagnostics.Invalid,"") END;
  3140. END GenerateBinary;
  3141. (* genasm *)
  3142. PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
  3143. VAR
  3144. result: Formats.GeneratedModule;
  3145. BEGIN
  3146. ASSERT(intermediateCodeModule IS Sections.Module);
  3147. result := ProcessIntermediateCodeModule^(intermediateCodeModule);
  3148. IF ~error THEN
  3149. GenerateBinary(result(Sections.Module),dump);
  3150. IF dump # NIL THEN
  3151. dump.Ln; dump.Ln;
  3152. dump.String(";------------------ binary code -------------------"); dump.Ln;
  3153. IF (traceString="") OR (traceString="*") THEN
  3154. result.Dump(dump);
  3155. dump.Update
  3156. ELSE
  3157. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  3158. dump.Update;
  3159. END
  3160. END;
  3161. END;
  3162. RETURN result
  3163. FINALLY
  3164. IF dump # NIL THEN
  3165. dump.Ln; dump.Ln;
  3166. dump.String("; ------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
  3167. IF (traceString="") OR (traceString="*") THEN
  3168. result.Dump(dump);
  3169. dump.Update
  3170. ELSE
  3171. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  3172. dump.Update;
  3173. END
  3174. END;
  3175. HALT(100); (* do not continue compiling after trap *)
  3176. RETURN result
  3177. END ProcessIntermediateCodeModule;
  3178. PROCEDURE FindPC(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
  3179. VAR
  3180. section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
  3181. i: LONGINT; pooledName: Basic.SegmentedName;
  3182. BEGIN
  3183. module := ProcessSyntaxTreeModule(x);
  3184. Basic.ToSegmentedName(sectionName, pooledName);
  3185. i := 0;
  3186. REPEAT
  3187. section := module(Sections.Module).allSections.GetSection(i);
  3188. INC(i);
  3189. UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
  3190. IF section.name # pooledName THEN
  3191. Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
  3192. ELSE
  3193. binarySection := section(IntermediateCode.Section).resolved;
  3194. IF binarySection # NIL THEN
  3195. label := binarySection.labels;
  3196. WHILE (label # NIL) & (label.offset >= sectionOffset) DO
  3197. label := label.prev;
  3198. END;
  3199. END;
  3200. IF label # NIL THEN
  3201. Basic.Information(diagnostics, module.module.sourceName,label.position, " pc position");
  3202. ELSE
  3203. Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
  3204. END;
  3205. END;
  3206. END FindPC;
  3207. PROCEDURE CanPassInRegister*(type: SyntaxTree.Type): BOOLEAN;
  3208. VAR length: LONGINT; baseType: SyntaxTree.Type; b: BOOLEAN;
  3209. BEGIN
  3210. b := SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.FloatType) &
  3211. (baseType.sizeInBits <= 32) & (length = 4);
  3212. b := b OR SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.CharacterType) &
  3213. (baseType.sizeInBits = 8) & (length = 4);
  3214. b := b OR SemanticChecker.IsStaticArray(type, baseType, length) & (baseType.resolved IS SyntaxTree.CharacterType) &
  3215. (baseType.resolved.sizeInBits = 8) & (length = 4);
  3216. RETURN b
  3217. END CanPassInRegister;
  3218. PROCEDURE GetDescription*(VAR instructionSet: ARRAY OF CHAR);
  3219. BEGIN instructionSet := "AMD";
  3220. END GetDescription;
  3221. PROCEDURE DefineOptions(options: Options.Options);
  3222. BEGIN
  3223. options.Add(0X,"bits",Options.Integer);
  3224. options.Add(0X,"traceable", Options.Flag);
  3225. options.Add(0X,"useFPU", Options.Flag);
  3226. DefineOptions^(options);
  3227. END DefineOptions;
  3228. PROCEDURE GetOptions(options: Options.Options);
  3229. BEGIN
  3230. IF ~options.GetInteger("bits",bits) THEN bits := 32 END;
  3231. traceable := options.GetFlag("traceable");
  3232. forceFPU := options.GetFlag("useFPU");
  3233. GetOptions^(options);
  3234. END GetOptions;
  3235. PROCEDURE DefaultObjectFileFormat(): Formats.ObjectFileFormat;
  3236. BEGIN RETURN ObjectFileFormat.Get();
  3237. END DefaultObjectFileFormat;
  3238. PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
  3239. BEGIN
  3240. RETURN NIL
  3241. END DefaultSymbolFileFormat;
  3242. END BackendAMD64;
  3243. (** the number of regular sections in a section list **)
  3244. PROCEDURE RegularSectionCount(sectionList: Sections.SectionList): LONGINT;
  3245. VAR
  3246. section: Sections.Section;
  3247. i, result: LONGINT;
  3248. BEGIN
  3249. result := 0;
  3250. FOR i := 0 TO sectionList.Length() - 1 DO
  3251. section := sectionList.GetSection(i);
  3252. INC(result)
  3253. END;
  3254. RETURN result
  3255. END RegularSectionCount;
  3256. PROCEDURE Assert(b: BOOLEAN; CONST s: ARRAY OF CHAR);
  3257. BEGIN
  3258. ASSERT(b,100);
  3259. END Assert;
  3260. PROCEDURE Halt(CONST s: ARRAY OF CHAR);
  3261. BEGIN
  3262. HALT(100);
  3263. END Halt;
  3264. PROCEDURE ResolvedSection(in: IntermediateCode.Section): BinaryCode.Section;
  3265. VAR section: BinaryCode.Section;
  3266. BEGIN
  3267. IF in.resolved = NIL THEN
  3268. NEW(section,in.type, in.priority, 8, in.name,in.comments # NIL,FALSE);
  3269. section.SetAlignment(in.fixed, in.positionOrAlignment);
  3270. in.SetResolved(section);
  3271. ELSE
  3272. section := in.resolved
  3273. END;
  3274. RETURN section
  3275. END ResolvedSection;
  3276. PROCEDURE Init;
  3277. VAR i: LONGINT;
  3278. BEGIN
  3279. FOR i := 0 TO LEN(registerOperands)-1 DO
  3280. Assembler.InitRegister(registerOperands[i],i);
  3281. END;
  3282. opEAX := registerOperands[EAX];
  3283. opEBX := registerOperands[EBX];
  3284. opECX := registerOperands[ECX];
  3285. opEDX := registerOperands[EDX];
  3286. opESI := registerOperands[ESI];
  3287. opEDI := registerOperands[EDI];
  3288. opEBP := registerOperands[EBP];
  3289. opESP := registerOperands[ESP];
  3290. opRSP := registerOperands[RSP];
  3291. opRBP := registerOperands[RBP];
  3292. opAX := registerOperands[AX];
  3293. opBX := registerOperands[BX];
  3294. opCX := registerOperands[CX];
  3295. opDX := registerOperands[DX];
  3296. opSI := registerOperands[SI];
  3297. opDI := registerOperands[DI];
  3298. opAL := registerOperands[AL];
  3299. opBL := registerOperands[BL];
  3300. opCL := registerOperands[CL];
  3301. opDL := registerOperands[DL];
  3302. opAH := registerOperands[AH];
  3303. opBH := registerOperands[BH];
  3304. opCH := registerOperands[CH];
  3305. opDH := registerOperands[DH];
  3306. opST0 := registerOperands[ST0];
  3307. NEW(unusable); NEW(blocked); NEW(split); free := NIL;
  3308. END Init;
  3309. PROCEDURE Get*(): Backend.Backend;
  3310. VAR backend: BackendAMD64;
  3311. BEGIN NEW(backend); RETURN backend
  3312. END Get;
  3313. PROCEDURE Trace*;
  3314. BEGIN
  3315. TRACE(traceStackSize);
  3316. END Trace;
  3317. BEGIN
  3318. traceStackSize := 0;
  3319. Init;
  3320. usePool := Machine.NumberOfProcessors()>1;
  3321. END FoxAMDBackend.
  3322. SystemTools.FreeDownTo FoxAMDBackend ~