FoxAMDBackend.Mod 138 KB

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