FoxARMBackend.Mod 145 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555
  1. MODULE FoxARMBackend; (** AUTHOR ""; PURPOSE "backend for ARM (advanced RISC machines)"; *)
  2. IMPORT
  3. Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
  4. IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, CodeGenerators := FoxCodeGenerators, BinaryCode := FoxBinaryCode,
  5. SemanticChecker := FoxSemanticChecker, Formats := FoxFormats, Assembler := FoxARMAssembler, InstructionSet := FoxARMInstructionSet,
  6. SYSTEM, Diagnostics, Streams, Options, WMUtilities, Strings, ObjectFile, Scanner := FoxScanner, ObjectFileFormat := FoxGenericObjectFile,
  7. ActiveCells := FoxActiveCells, D := Debugging;
  8. CONST
  9. Trace = FALSE; (* general trace *)
  10. TraceFixups = FALSE;
  11. DefaultRuntimeModuleName = "ARMRuntime";
  12. None = -1;
  13. (* parts of an ARM operand *)
  14. Low = 0; High = 1;
  15. (* mnemonics of the ARM instruction set *)
  16. opADC = InstructionSet.opADC; opADD = InstructionSet.opADD;
  17. opAND = InstructionSet.opAND; opB = InstructionSet.opB;
  18. opBIC = InstructionSet.opBIC; opBKPT = InstructionSet.opBKPT;
  19. opBL = InstructionSet.opBL; opBLX = InstructionSet.opBLX;
  20. opBX = InstructionSet.opBX; opCDP = InstructionSet.opCDP;
  21. opCDP2 = InstructionSet.opCDP2; opCLZ = InstructionSet.opCLZ;
  22. opCMN = InstructionSet.opCMN; opCMP = InstructionSet.opCMP;
  23. opEOR = InstructionSet.opEOR; opFABSD = InstructionSet.opFABSD;
  24. opFABSS = InstructionSet.opFABSS; opFADDD = InstructionSet.opFADDD;
  25. opFADDS = InstructionSet.opFADDS; opFCMPD = InstructionSet.opFCMPD;
  26. opFCMPED = InstructionSet.opFCMPED; opFCMPES = InstructionSet.opFCMPES;
  27. opFCMPEZD = InstructionSet.opFCMPEZD; opFCMPEZS = InstructionSet.opFCMPEZS;
  28. opFCMPS = InstructionSet.opFCMPS; opFCMPZD = InstructionSet.opFCMPZD;
  29. opFCMPZS = InstructionSet.opFCMPZS; opFCPYD = InstructionSet.opFCPYD;
  30. opFCPYS = InstructionSet.opFCPYS; opFCVTDS = InstructionSet.opFCVTDS;
  31. opFCVTSD = InstructionSet.opFCVTSD; opFDIVD = InstructionSet.opFDIVD;
  32. opFDIVS = InstructionSet.opFDIVS; opFLDD = InstructionSet.opFLDD;
  33. opFLDMIAD = InstructionSet.opFLDMIAD; opFLDMIAS = InstructionSet.opFLDMIAS;
  34. opFLDMIAX = InstructionSet.opFLDMIAX; opFLDMDBD = InstructionSet.opFLDMDBD;
  35. opFLDMDBS = InstructionSet.opFLDMDBS; opFLDMDBX = InstructionSet.opFLDMDBX;
  36. opFLDS = InstructionSet.opFLDS; opFMACD = InstructionSet.opFMACD;
  37. opFMACS = InstructionSet.opFMACS; opFMDHR = InstructionSet.opFMDHR;
  38. opFMDLR = InstructionSet.opFMDLR; opFMRDH = InstructionSet.opFMRDH;
  39. opFMRDL = InstructionSet.opFMRDL; opFMRS = InstructionSet.opFMRS;
  40. opFMRX = InstructionSet.opFMRX; opFMSCD = InstructionSet.opFMSCD;
  41. opFMSCS = InstructionSet.opFMSCS; opFMSR = InstructionSet.opFMSR;
  42. opFMSTAT = InstructionSet.opFMSTAT; opFMULD = InstructionSet.opFMULD;
  43. opFMULS = InstructionSet.opFMULS; opFMXR = InstructionSet.opFMXR;
  44. opFNEGD = InstructionSet.opFNEGD; opFNEGS = InstructionSet.opFNEGS;
  45. opFNMACD = InstructionSet.opFNMACD; opFNMACS = InstructionSet.opFNMACS;
  46. opFNMSCD = InstructionSet.opFNMSCD; opFNMSCS = InstructionSet.opFNMSCS;
  47. opFNMULD = InstructionSet.opFNMULD ; opFNMULS = InstructionSet.opFNMULS;
  48. opFSITOD = InstructionSet.opFSITOD; opFSITOS = InstructionSet.opFSITOS;
  49. opFSQRTD = InstructionSet.opFSQRTD; opFSQRTS = InstructionSet.opFSQRTS;
  50. opFSTD = InstructionSet.opFSTD; opFSTMIAD = InstructionSet.opFSTMIAD;
  51. opFSTMIAS = InstructionSet.opFSTMIAS; opFSTMIAX = InstructionSet.opFSTMIAX;
  52. opFSTMDBD = InstructionSet.opFSTMDBD; opFSTMDBS = InstructionSet.opFSTMDBS;
  53. opFSTMDBX = InstructionSet.opFSTMDBX; opFSTS = InstructionSet.opFSTS;
  54. opFSUBD = InstructionSet.opFSUBD; opFSUBS = InstructionSet.opFSUBS;
  55. opFTOSID = InstructionSet.opFTOSID; opFTOSIZD = InstructionSet.opFTOSIZD;
  56. opFTOSIS = InstructionSet.opFTOSIS; opFTOSIZS = InstructionSet.opFTOSIZS;
  57. opFTOUID = InstructionSet.opFTOUID; opFTOUIZD = InstructionSet.opFTOUIZD;
  58. opFTOUIS = InstructionSet.opFTOUIS; opFTOUIZS = InstructionSet.opFTOUIZS;
  59. opFUITOD = InstructionSet.opFUITOD; opFUITOS = InstructionSet.opFUITOS;
  60. opLDC = InstructionSet.opLDC; opLDC2 = InstructionSet.opLDC2;
  61. opLDM = InstructionSet.opLDM; opLDR = InstructionSet.opLDR;
  62. opMCR = InstructionSet.opMCR; opMCR2 = InstructionSet.opMCR2;
  63. opMCRR = InstructionSet.opMCRR; opMLA = InstructionSet.opMLA;
  64. opMOV = InstructionSet.opMOV; opMRC = InstructionSet.opMRC;
  65. opMRC2 = InstructionSet.opMRC2; opMRRC = InstructionSet.opMRRC;
  66. opMRS = InstructionSet.opMRS; opMSR = InstructionSet.opMSR;
  67. opMUL = InstructionSet.opMUL; opMVN = InstructionSet.opMVN;
  68. opORR = InstructionSet.opORR; opPLD = InstructionSet.opPLD;
  69. opQADD = InstructionSet.opQADD; opQDADD = InstructionSet.opQDADD;
  70. opQDSUB = InstructionSet.opQDSUB; opQSUB = InstructionSet.opQSUB;
  71. opRSB = InstructionSet.opRSB; opRSC = InstructionSet.opRSC;
  72. opSBC = InstructionSet.opSBC; opSMLABB = InstructionSet.opSMLABB;
  73. opSMLABT = InstructionSet.opSMLABT; opSMLAL = InstructionSet.opSMLAL;
  74. opSMLATB = InstructionSet.opSMLATB; opSMLATT = InstructionSet.opSMLATT;
  75. opSMLALBB = InstructionSet.opSMLALBB; opSMLALBT = InstructionSet.opSMLALBT;
  76. opSMLALTB = InstructionSet.opSMLALTB; opSMLALTT = InstructionSet.opSMLALTT;
  77. opSMLAWB = InstructionSet.opSMLAWB; opSMLAWT = InstructionSet.opSMLAWT;
  78. opSMULBB = InstructionSet.opSMULBB; opSMULBT = InstructionSet.opSMULBT;
  79. opSMULTB = InstructionSet.opSMULTB; opSMULTT = InstructionSet.opSMULTT;
  80. opSMULWB = InstructionSet.opSMULWB; opSMULWT = InstructionSet.opSMULWT;
  81. opSMULL = InstructionSet.opSMULL; opSTC = InstructionSet.opSTC;
  82. opSTC2 = InstructionSet.opSTC2; opSTM = InstructionSet.opSTM;
  83. opSTR = InstructionSet.opSTR; opSUB = InstructionSet.opSUB;
  84. opSWI = InstructionSet.opSWI; opSWP = InstructionSet.opSWP;
  85. opTEQ = InstructionSet.opTEQ; opTST = InstructionSet.opTST;
  86. opUMLAL = InstructionSet.opUMLAL; opUMULL = InstructionSet.opUMULL;
  87. MaximumFixupDistance = (*4103*) 1024; (* = 2^12-1+8 (maximum distance [in bytes] between a symbol fixup location and an instruction that uses the symbol) *)
  88. (* builtin backend specific system instructions *)
  89. GetSP = 0; SetSP = 1;
  90. GetFP = 2; SetFP = 3;
  91. GetLNK = 4; SetLNK = 5;
  92. GetPC = 6; SetPC = 7;
  93. LDPSR = 8; STPSR = 9;
  94. LDCPR = 10; STCPR = 11;
  95. FLUSH = 12;
  96. NULL = 13; XOR = 14; MULD = 15; ADDC = 16;
  97. PACK = 17; UNPK = 18;
  98. UseFPUFlag = "useFPU";
  99. TYPE
  100. Operand = InstructionSet.Operand;
  101. Ticket = CodeGenerators.Ticket;
  102. (* a citation of a symbol, i.e., an ARM instruction that requires a symbol's address *)
  103. Citation = OBJECT
  104. VAR
  105. pc: LONGINT; (* program counter of the ARM instruction *)
  106. next: Citation;
  107. END Citation;
  108. (* a reference to a symbol and offset in IR units that is used by at least one instruction *)
  109. Reference = OBJECT
  110. VAR
  111. firstCitation, lastCitation: Citation; (* linked list of citations *)
  112. next: Reference;
  113. PROCEDURE & Init;
  114. BEGIN
  115. firstCitation := NIL; lastCitation := NIL; next := NIL;
  116. END Init;
  117. PROCEDURE AddCitation(pc: LONGINT);
  118. VAR
  119. citation: Citation;
  120. BEGIN
  121. NEW(citation); citation.pc := pc; citation.next := NIL;
  122. IF firstCitation = NIL THEN firstCitation := citation ELSE lastCitation.next := citation END;
  123. lastCitation := citation
  124. END AddCitation;
  125. END Reference;
  126. ImmediateReference = OBJECT (Reference)
  127. VAR value: LONGINT;
  128. PROCEDURE & InitImm(v: LONGINT);
  129. BEGIN
  130. Init;
  131. SELF.value := v;
  132. END InitImm;
  133. END ImmediateReference;
  134. (* a reference to a symbol and offset in IR units that is used by at least one instruction *)
  135. SymbolReference = OBJECT (Reference)
  136. VAR
  137. symbol: Sections.SectionName;
  138. fingerprint: LONGINT;
  139. symbolOffset: LONGINT; (* offset to the symbol in IR units *)
  140. PROCEDURE & InitSym(s: Sections.SectionName; fp: LONGINT; offs: LONGINT);
  141. BEGIN
  142. Init;
  143. SELF.symbol := s; SELF.symbolOffset := offs; fingerprint := fp;
  144. END InitSym;
  145. END SymbolReference;
  146. ListOfReferences = OBJECT
  147. VAR
  148. firstReference, lastReference: Reference; (* linked list of all symbol references *)
  149. referenceCount: LONGINT; (* the number of reference = length of the required fixup block *)
  150. pcOfFirstCitation: LONGINT; (* the PC of the first instruction that cites a symbol or immediate *)
  151. PROCEDURE & Init;
  152. BEGIN
  153. firstReference := NIL; lastReference := NIL;
  154. referenceCount := 0;
  155. pcOfFirstCitation := None;
  156. END Init;
  157. PROCEDURE AddSymbol(symbol: Sections.SectionName; fingerprint: LONGINT; symbolOffset: LONGINT; pc: LONGINT);
  158. VAR
  159. reference, foundReference: Reference; symbolReference: SymbolReference;
  160. BEGIN
  161. (* go through the list of symbol/offset-combinations and check if there already is an entry for the symbol and offset in question *)
  162. reference := firstReference;
  163. WHILE reference # NIL DO
  164. IF reference IS SymbolReference THEN
  165. WITH reference: SymbolReference DO
  166. IF (reference.symbol = symbol) & (reference.symbolOffset = symbolOffset) THEN
  167. foundReference := reference (* an entry already exists *)
  168. END;
  169. END;
  170. END;
  171. reference := reference.next
  172. END;
  173. IF foundReference # NIL THEN
  174. reference := foundReference
  175. ELSE
  176. (* no entry was found for the symbol/offset combination: create a new one *)
  177. NEW(symbolReference, symbol, fingerprint, symbolOffset);
  178. reference := symbolReference;
  179. IF firstReference = NIL THEN firstReference := reference ELSE lastReference.next := reference END;
  180. lastReference := reference;
  181. INC(referenceCount)
  182. END;
  183. (* add a citation to the reference *)
  184. reference.AddCitation(pc);
  185. IF pcOfFirstCitation = None THEN pcOfFirstCitation := pc END
  186. END AddSymbol;
  187. PROCEDURE AddImmediate(value: LONGINT; pc: LONGINT);
  188. VAR
  189. reference, foundReference: Reference; immediateReference: ImmediateReference;
  190. BEGIN
  191. (* go through the list of symbol/offset-combinations and check if there already is an entry for the symbol and offset in question *)
  192. reference := firstReference;
  193. WHILE reference # NIL DO
  194. IF reference IS ImmediateReference THEN
  195. WITH reference: ImmediateReference DO
  196. IF (reference.value = value) THEN
  197. foundReference := reference (* an entry already exists *)
  198. END;
  199. END;
  200. END;
  201. reference := reference.next
  202. END;
  203. IF foundReference # NIL THEN
  204. reference := foundReference
  205. ELSE
  206. (* no entry was found for the symbol/offset combination: create a new one *)
  207. NEW(immediateReference, value);
  208. reference := immediateReference;
  209. IF firstReference = NIL THEN firstReference := reference ELSE lastReference.next := reference END;
  210. lastReference := reference;
  211. INC(referenceCount)
  212. END;
  213. (* add a citation to the reference *)
  214. reference.AddCitation(pc);
  215. IF pcOfFirstCitation = None THEN pcOfFirstCitation := pc END
  216. END AddImmediate;
  217. END ListOfReferences;
  218. PhysicalRegisters* = OBJECT(CodeGenerators.PhysicalRegisters)
  219. VAR
  220. toVirtual: ARRAY InstructionSet.NumberRegisters OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
  221. reserved: ARRAY InstructionSet.NumberRegisters OF BOOLEAN;
  222. unusable: Ticket;
  223. hint: LONGINT;
  224. useFPU: BOOLEAN;
  225. PROCEDURE & InitPhysicalRegisters(supportFramePointer, useFPU, cooperative: BOOLEAN);
  226. VAR
  227. i: LONGINT;
  228. unusable: Ticket;
  229. BEGIN
  230. SELF.useFPU := useFPU;
  231. FOR i := 0 TO LEN(toVirtual) - 1 DO
  232. toVirtual[i] := NIL;
  233. reserved[i] := FALSE
  234. END;
  235. NEW(unusable);
  236. (* reserve special purpose registers *)
  237. toVirtual[InstructionSet.RES] := unusable; (* low part result register *)
  238. toVirtual[InstructionSet.RESHI] := unusable; (* high part result register *)
  239. toVirtual[InstructionSet.RESFS] := unusable; (* single precision floatin point result register *)
  240. toVirtual[InstructionSet.SP] := unusable; (* stack pointer *)
  241. toVirtual[InstructionSet.FP] := unusable; (* frame pointer *)
  242. toVirtual[InstructionSet.PC] := unusable; (* program counter *)
  243. toVirtual[InstructionSet.LR] := unusable; (* link register *)
  244. toVirtual[InstructionSet.CPSR] := unusable; (* current program state register *)
  245. toVirtual[InstructionSet.SPSR] := unusable; (* saved program state register *)
  246. IF cooperative THEN
  247. toVirtual[InstructionSet.R11] := unusable; (* current activity register *)
  248. END;
  249. (* disable coprocessor registers *)
  250. FOR i := InstructionSet.CR0 TO InstructionSet.CR15 DO toVirtual[i] := unusable END;
  251. IF ~useFPU THEN
  252. (* disable single precision VFP registers *)
  253. FOR i := InstructionSet.SR0 TO InstructionSet.SR15 DO toVirtual[i] := unusable END
  254. END;
  255. (* disable double precision VFP registers *)
  256. FOR i := InstructionSet.DR0 TO InstructionSet.DR15 DO toVirtual[i] := unusable END;
  257. END InitPhysicalRegisters;
  258. (** the number of physical registers **)
  259. PROCEDURE NumberRegisters(): LONGINT;
  260. BEGIN RETURN InstructionSet.NumberRegisters
  261. END NumberRegisters;
  262. (** allocate, i.e., map, a physical register to a ticket **)
  263. PROCEDURE Allocate(physicalRegisterNumber: LONGINT; ticket: Ticket);
  264. BEGIN
  265. ASSERT(~ticket.spilled);
  266. Assert(toVirtual[physicalRegisterNumber] = NIL,"register already allocated");
  267. toVirtual[physicalRegisterNumber] := ticket
  268. END Allocate;
  269. (** set whether a certain physical register is reserved or not **)
  270. PROCEDURE SetReserved(physicalRegisterNumber: LONGINT; isReserved: BOOLEAN);
  271. BEGIN reserved[physicalRegisterNumber] := isReserved
  272. END SetReserved;
  273. (** whether a certain physical register is reserved **)
  274. PROCEDURE Reserved(physicalRegisterNumber: LONGINT): BOOLEAN;
  275. BEGIN RETURN (physicalRegisterNumber > 0) & reserved[physicalRegisterNumber]
  276. END Reserved;
  277. (** free a certain physical register **)
  278. PROCEDURE Free(physicalRegisterNumber: LONGINT);
  279. BEGIN
  280. Assert((toVirtual[physicalRegisterNumber] # NIL), "register not reserved");
  281. toVirtual[physicalRegisterNumber] := NIL
  282. END Free;
  283. (** get the number of the next free physical register for a certain data type
  284. - if a register hint has been set, it is respected if possible
  285. **)
  286. PROCEDURE NextFree(CONST type: IntermediateCode.Type): LONGINT;
  287. VAR
  288. result, i: LONGINT;
  289. BEGIN
  290. result := None;
  291. IF (type.form IN IntermediateCode.Integer) OR ~useFPU THEN
  292. ASSERT(type.sizeInBits <= 32); (* integers of larger size have already been split *)
  293. (* allocate a regular general purpose ARM register *)
  294. FOR i := InstructionSet.R0 TO InstructionSet.R15 DO
  295. IF (toVirtual[i] = NIL) & ((result = None) OR (i = hint)) THEN result := i END
  296. END
  297. ELSIF type.form = IntermediateCode.Float THEN
  298. IF type.sizeInBits = 32 THEN
  299. (* allocate a single precision VFP register *)
  300. FOR i := InstructionSet.SR0 TO InstructionSet.SR31 DO
  301. IF (toVirtual[i] = NIL) & ((result = None) OR (i = hint)) THEN result := i END
  302. END
  303. ELSIF type.sizeInBits = 64 THEN
  304. (* allocate a double precision VFP register *)
  305. HALT(200); (* not supported yet *)
  306. ELSE
  307. HALT(100)
  308. END
  309. ELSE
  310. HALT(100)
  311. END;
  312. IF result # None THEN ASSERT(toVirtual[result] = NIL) END;
  313. RETURN result
  314. END NextFree;
  315. (** give the register allocator a hint on what physical register to use next **)
  316. PROCEDURE AllocationHint(physicalRegisterNumber: LONGINT);
  317. BEGIN hint := physicalRegisterNumber
  318. END AllocationHint;
  319. (** get the ticket that is currently mapped to a certain physical register **)
  320. PROCEDURE Mapped(physicalRegisterNumber: LONGINT): Ticket;
  321. BEGIN RETURN toVirtual[physicalRegisterNumber]
  322. END Mapped;
  323. (** dump the current register mapping to a stream **)
  324. PROCEDURE Dump(w: Streams.Writer);
  325. VAR i: LONGINT; virtual: Ticket;
  326. BEGIN
  327. w.String("---- registers ----"); w.Ln;
  328. FOR i := 0 TO LEN(toVirtual)-1 DO
  329. virtual := toVirtual[i];
  330. IF virtual # unusable THEN
  331. w.String("reg "); w.Int(i,1); w.String(": ");
  332. IF virtual = NIL THEN w.String("free")
  333. ELSE w.String(" r"); w.Int(virtual.register,1);
  334. END;
  335. IF reserved[i] THEN w.String("reserved") END;
  336. w.Ln
  337. END
  338. END
  339. END Dump;
  340. END PhysicalRegisters;
  341. CodeGeneratorARM = OBJECT(CodeGenerators.GeneratorWithTickets)
  342. VAR
  343. runtimeModuleName: SyntaxTree.IdentifierString;
  344. backend: BackendARM;
  345. opSP, opFP, opPC, opLR, opRES, opRESHI, opRESFS: InstructionSet.Operand;
  346. listOfReferences: ListOfReferences;
  347. spillStackStart, pushChainLength: LONGINT;
  348. stackSize: LONGINT; (* the size of the current stack frame *)
  349. stackSizeKnown: BOOLEAN; (* whether the size of the current stack frame is known at compile time *)
  350. inStackAllocation: BOOLEAN;
  351. fixupPattern: ObjectFile.FixupPatterns; (* pattern for an absolute 32-bit fixup *)
  352. PROCEDURE & InitGeneratorARM(CONST runtimeModuleName: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; backend: BackendARM);
  353. VAR
  354. physicalRegisters: PhysicalRegisters;
  355. BEGIN
  356. SELF.runtimeModuleName := runtimeModuleName;
  357. SELF.backend := backend;
  358. IF Trace THEN IF backend.useFPU THEN D.String("use FPU"); D.Ln ELSE D.String("don't use FPU"); D.Ln END END;
  359. NEW(physicalRegisters, TRUE, backend.useFPU, backend.cooperative);
  360. InitTicketGenerator(diagnostics, backend.optimize, 2, physicalRegisters);
  361. error := FALSE;
  362. inStackAllocation := FALSE;
  363. pushChainLength := 0;
  364. opSP := InstructionSet.NewRegister(InstructionSet.SP, None, None, 0);
  365. opFP := InstructionSet.NewRegister(InstructionSet.FP, None, None, 0);
  366. opPC := InstructionSet.NewRegister(InstructionSet.PC, None, None, 0);
  367. opLR := InstructionSet.NewRegister(InstructionSet.LR, None, None, 0);
  368. opRES := InstructionSet.NewRegister(InstructionSet.RES, None, None, 0);
  369. opRESHI := InstructionSet.NewRegister(InstructionSet.RESHI, None, None, 0);
  370. opRESFS := InstructionSet.NewRegister(InstructionSet.RESFS, None, None, 0);
  371. dump := NIL;
  372. NEW(fixupPattern, 1);
  373. fixupPattern[0].offset := 0;
  374. fixupPattern[0].bits := 32;
  375. NEW(listOfReferences);
  376. END InitGeneratorARM;
  377. (*------------------- overwritten methods ----------------------*)
  378. (* TODO: revise this *)
  379. PROCEDURE Section(in: IntermediateCode.Section; out: BinaryCode.Section);
  380. VAR
  381. oldSpillStackSize: LONGINT;
  382. PROCEDURE CheckEmptySpillStack(): BOOLEAN;
  383. BEGIN
  384. IF spillStack.Size() # 0 THEN
  385. Error(inPC,"implementation error, spill stack not cleared");
  386. IF dump # NIL THEN
  387. spillStack.Dump(dump);
  388. tickets.Dump(dump)
  389. END;
  390. RETURN FALSE
  391. ELSE
  392. RETURN TRUE
  393. END
  394. END CheckEmptySpillStack;
  395. BEGIN
  396. stackSizeKnown := TRUE;
  397. stackSize := 0; (* TODO: ok? *)
  398. tickets.Init; spillStack.Init; listOfReferences.Init;
  399. Section^(in, out); (* pass 1 *)
  400. EmitFinalFixupBlock; (* force the emission of fixups for all references *)
  401. IF stackSizeKnown = FALSE THEN
  402. tickets.Init; spillStack.Init; listOfReferences.Init;
  403. out.Reset;
  404. Section^(in, out); (* pass 2 *)
  405. EmitFinalFixupBlock (* force the emission of fixups for all references *)
  406. END;
  407. IF CheckEmptySpillStack() & (spillStack.MaxSize() > 0) THEN
  408. listOfReferences.Init;
  409. oldSpillStackSize := spillStack.MaxSize();
  410. out.Reset;
  411. Section^(in, out); (* pass 3 *)
  412. EmitFinalFixupBlock; (* force the emission of fixups for all references *)
  413. ASSERT(spillStack.MaxSize() = oldSpillStackSize);
  414. END;
  415. IF CheckEmptySpillStack() THEN END
  416. END Section;
  417. (* TODO: complete this *)
  418. (** whether the code generator can generate code for a certain intermediate code intstruction
  419. if not, the location of a runtime is returned **)
  420. PROCEDURE Supported(CONST irInstruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  421. VAR
  422. result: BOOLEAN; value: HUGEINT; exp: LONGINT;
  423. BEGIN
  424. CASE irInstruction.opcode OF
  425. | IntermediateCode.add, IntermediateCode.sub, IntermediateCode.mul, IntermediateCode.abs, IntermediateCode.neg:
  426. IF (irInstruction.opcode = IntermediateCode.mul) & IsInteger(irInstruction.op1) & IsInteger(irInstruction.op2) & (IsComplex(irInstruction.op1) OR IsComplex(irInstruction.op2)) THEN
  427. result := FALSE;
  428. ELSE
  429. result := backend.useFPU & IsSinglePrecisionFloat(irInstruction.op1) OR ~IsFloat(irInstruction.op1)
  430. END;
  431. | IntermediateCode.div:
  432. result := backend.useFPU & IsSinglePrecisionFloat(irInstruction.op1);
  433. (*
  434. result := result OR IntermediateCode.IsConstantInteger(irInstruction.op3,value) & PowerOf2(value,exp)
  435. *)
  436. | IntermediateCode.conv:
  437. result := backend.useFPU & (IsSinglePrecisionFloat(irInstruction.op1) OR IsSinglePrecisionFloat(irInstruction.op2)) OR ~IsFloat(irInstruction.op1) & ~IsFloat(irInstruction.op2) (* if no FPU and either operand is a float *)
  438. | IntermediateCode.mod:
  439. result := FALSE;
  440. (*
  441. result := IntermediateCode.IsConstantInteger(irInstruction.op3,value) & PowerOf2(value,exp)
  442. *)
  443. | IntermediateCode.rol, IntermediateCode.ror:
  444. result := ~IsComplex(irInstruction.op1)
  445. ELSE
  446. result := TRUE
  447. END;
  448. IF ~result THEN
  449. COPY(runtimeModuleName, moduleName);
  450. GetRuntimeProcedureName(irInstruction, procedureName);
  451. END;
  452. RETURN result
  453. END Supported;
  454. (* determines the name of a runtime procedure to handle a certain IR instruction *)
  455. PROCEDURE GetRuntimeProcedureName(CONST irInstruction: IntermediateCode.Instruction; VAR resultingName: ARRAY OF CHAR);
  456. PROCEDURE AppendType(VAR string: ARRAY OF CHAR; type: IntermediateCode.Type);
  457. VAR
  458. sizeString: ARRAY 3 OF CHAR;
  459. BEGIN
  460. CASE type.form OF
  461. | IntermediateCode.SignedInteger: Strings.AppendChar(string, 'S')
  462. | IntermediateCode.UnsignedInteger: Strings.AppendChar(string, 'U')
  463. | IntermediateCode.Float:Strings.AppendChar(string, 'F')
  464. ELSE HALT(200)
  465. END;
  466. Strings.IntToStr(type.sizeInBits, sizeString); Strings.Append(string, sizeString)
  467. END AppendType;
  468. BEGIN
  469. COPY(IntermediateCode.instructionFormat[irInstruction.opcode].name, resultingName);
  470. Strings.UpperCaseChar(resultingName[0]);
  471. AppendType(resultingName, irInstruction.op1.type);
  472. IF irInstruction.op1.mode # IntermediateCode.Undefined THEN
  473. IF (irInstruction.op1.type.form # irInstruction.op2.type.form) OR (irInstruction.op1.type.sizeInBits # irInstruction.op2.type.sizeInBits) THEN
  474. AppendType(resultingName, irInstruction.op2.type);
  475. END
  476. END;
  477. IF Trace THEN D.Ln; D.String(" runtime procedure name: "); D.String(resultingName); D.Ln; D.Update END
  478. END GetRuntimeProcedureName;
  479. (* check whether the instruction modifies the stack pointer (outside of a stack allocation )*)
  480. PROCEDURE CheckStackPointer(CONST destination: Operand);
  481. BEGIN
  482. IF stackSizeKnown & ~inStackAllocation THEN
  483. IF (destination.mode = InstructionSet.modeRegister) & (destination.register = InstructionSet.SP) THEN
  484. IF dump # NIL THEN dump.String("stackSize unkown"); dump.Ln END;
  485. stackSizeKnown := FALSE
  486. END
  487. END
  488. END CheckStackPointer;
  489. (** emit an ARM instruction with an arbitrary amount of operands **)
  490. PROCEDURE Emit(opCode, condition: LONGINT; flags: SET; CONST operands: ARRAY InstructionSet.MaxOperands OF Operand);
  491. VAR
  492. i: LONGINT;
  493. BEGIN
  494. (* check whether the instruction modifies the stack pointer *)
  495. CheckStackPointer(operands[0]);
  496. (*
  497. (* dump the instruction *)
  498. IF Trace THEN
  499. D.String("opCode="); D.Int(opCode, 0); D.Ln;
  500. D.String("condition="); D.Int(condition, 0); D.Ln;
  501. D.String("flags="); D.Set(flags); D.Ln;
  502. FOR i := 0 TO InstructionSet.MaxOperands - 1 DO
  503. D.String("operand #"); D.Int(i, 0); D.String(": ");
  504. InstructionSet.DumpOperand(D.Log, operands[i]);
  505. D.Ln
  506. END;
  507. D.Ln;
  508. D.Ln
  509. END;
  510. *)
  511. (* emit the instruction *)
  512. InstructionSet.Emit(opCode, condition, flags, operands, out)
  513. END Emit;
  514. (** emit an ARM instruction with no operand **)
  515. PROCEDURE Emit0(opCode: LONGINT);
  516. VAR
  517. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  518. BEGIN
  519. ASSERT(InstructionSet.MaxOperands = 6);
  520. operands[0] := emptyOperand;
  521. operands[1] := emptyOperand;
  522. operands[2] := emptyOperand;
  523. operands[3] := emptyOperand;
  524. operands[4] := emptyOperand;
  525. operands[5] := emptyOperand;
  526. Emit(opCode, InstructionSet.unconditional, {}, operands)
  527. END Emit0;
  528. (** emit an ARM instruction with 1 operand **)
  529. PROCEDURE Emit1(opCode: LONGINT; op: Operand);
  530. VAR
  531. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  532. BEGIN
  533. ASSERT(InstructionSet.MaxOperands = 6);
  534. operands[0] := op;
  535. operands[1] := emptyOperand;
  536. operands[2] := emptyOperand;
  537. operands[3] := emptyOperand;
  538. operands[4] := emptyOperand;
  539. operands[5] := emptyOperand;
  540. Emit(opCode, InstructionSet.unconditional, {}, operands)
  541. END Emit1;
  542. (** emit an ARM instruction with 2 operands **)
  543. PROCEDURE Emit2(opCode: LONGINT; op1, op2: Operand);
  544. VAR
  545. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  546. BEGIN
  547. ASSERT(InstructionSet.MaxOperands = 6);
  548. operands[0] := op1;
  549. operands[1] := op2;
  550. operands[2] := emptyOperand;
  551. operands[3] := emptyOperand;
  552. operands[4] := emptyOperand;
  553. operands[5] := emptyOperand;
  554. Emit(opCode, InstructionSet.unconditional, {}, operands)
  555. END Emit2;
  556. (** emit an ARM instruction with 3 operands **)
  557. PROCEDURE Emit3(opCode: LONGINT; op1, op2, op3: Operand);
  558. VAR
  559. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  560. BEGIN
  561. ASSERT(InstructionSet.MaxOperands = 6);
  562. operands[0] := op1;
  563. operands[1] := op2;
  564. operands[2] := op3;
  565. operands[3] := emptyOperand;
  566. operands[4] := emptyOperand;
  567. operands[5] := emptyOperand;
  568. Emit(opCode, InstructionSet.unconditional, {}, operands)
  569. END Emit3;
  570. (** emit an ARM instruction with 4 operands **)
  571. PROCEDURE Emit4(opCode: LONGINT; op1, op2, op3, op4: Operand);
  572. VAR
  573. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  574. BEGIN
  575. ASSERT(InstructionSet.MaxOperands = 6);
  576. operands[0] := op1;
  577. operands[1] := op2;
  578. operands[2] := op3;
  579. operands[3] := op4;
  580. operands[4] := emptyOperand;
  581. operands[5] := emptyOperand;
  582. Emit(opCode, InstructionSet.unconditional, {}, operands)
  583. END Emit4;
  584. (** emit an ARM instruction with 6 operands **)
  585. PROCEDURE Emit6(opCode: LONGINT; op1, op2, op3, op4, op5, op6: Operand);
  586. VAR
  587. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  588. BEGIN
  589. ASSERT(InstructionSet.MaxOperands = 6);
  590. operands[0] := op1;
  591. operands[1] := op2;
  592. operands[2] := op3;
  593. operands[3] := op4;
  594. operands[4] := op5;
  595. operands[5] := op6;
  596. Emit(opCode, InstructionSet.unconditional, {}, operands)
  597. END Emit6;
  598. (** emit an ARM instruction with 2 operands and certain flags **)
  599. PROCEDURE Emit2WithFlags(opCode: LONGINT; op1, op2: Operand; flags: SET);
  600. VAR
  601. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  602. BEGIN
  603. ASSERT(InstructionSet.MaxOperands = 6);
  604. operands[0] := op1;
  605. operands[1] := op2;
  606. operands[2] := emptyOperand;
  607. operands[3] := emptyOperand;
  608. operands[4] := emptyOperand;
  609. operands[5] := emptyOperand;
  610. Emit(opCode, InstructionSet.unconditional, flags, operands)
  611. END Emit2WithFlags;
  612. (** emit an ARM instruction with 3 operands and certain flags **)
  613. PROCEDURE Emit3WithFlags(opCode: LONGINT; op1, op2, op3: Operand; flags: SET);
  614. VAR
  615. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  616. BEGIN
  617. ASSERT(InstructionSet.MaxOperands = 6);
  618. operands[0] := op1;
  619. operands[1] := op2;
  620. operands[2] := op3;
  621. operands[3] := emptyOperand;
  622. operands[4] := emptyOperand;
  623. operands[5] := emptyOperand;
  624. Emit(opCode, InstructionSet.unconditional, flags, operands)
  625. END Emit3WithFlags;
  626. (** emit an ARM instruction with 1 operand and a condition **)
  627. PROCEDURE Emit1WithCondition(opCode: LONGINT; op1: Operand; condition: LONGINT);
  628. VAR
  629. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  630. BEGIN
  631. ASSERT(InstructionSet.MaxOperands = 6);
  632. operands[0] := op1;
  633. operands[1] := emptyOperand;
  634. operands[2] := emptyOperand;
  635. operands[3] := emptyOperand;
  636. operands[4] := emptyOperand;
  637. operands[5] := emptyOperand;
  638. Emit(opCode, condition, {}, operands)
  639. END Emit1WithCondition;
  640. (** emit an ARM instruction with 2 operands and a condition **)
  641. PROCEDURE Emit2WithCondition(opCode: LONGINT; op1, op2: Operand; condition: LONGINT);
  642. VAR
  643. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  644. BEGIN
  645. ASSERT(InstructionSet.MaxOperands = 6);
  646. operands[0] := op1;
  647. operands[1] := op2;
  648. operands[2] := emptyOperand;
  649. operands[3] := emptyOperand;
  650. operands[4] := emptyOperand;
  651. operands[5] := emptyOperand;
  652. Emit(opCode, condition, {}, operands)
  653. END Emit2WithCondition;
  654. (** emit an ARM instruction with 3 operands and a condition **)
  655. PROCEDURE Emit3WithCondition(opCode: LONGINT; op1, op2, op3: Operand; condition: LONGINT);
  656. VAR
  657. operands: ARRAY InstructionSet.MaxOperands OF Operand;
  658. BEGIN
  659. ASSERT(InstructionSet.MaxOperands = 6);
  660. operands[0] := op1;
  661. operands[1] := op2;
  662. operands[2] := op3;
  663. operands[3] := emptyOperand;
  664. operands[4] := emptyOperand;
  665. operands[5] := emptyOperand;
  666. Emit(opCode, condition, {}, operands)
  667. END Emit3WithCondition;
  668. (**
  669. - generate an arbitrary 32 bit value with as few as possible instructions and move the result into a specified target register
  670. - return the number of instructions required
  671. - if 'doEmit' is TRUE, emit the instructions
  672. **)
  673. PROCEDURE ValueComposition(value: LONGINT; doEmit: BOOLEAN; CONST targetRegister: Operand): LONGINT;
  674. VAR
  675. result: LONGINT;
  676. BEGIN
  677. IF doEmit THEN ASSERT(targetRegister.mode = InstructionSet.modeRegister) END;
  678. IF Trace & doEmit THEN D.Ln; D.String("original value: "); DBin(value, -32); D.String(" ("); D.Int(value, 0); D.String(") "); D.Ln; END;
  679. IF ValueComposition2(value, FALSE, emptyOperand) <= ValueComposition2(-value, FALSE, emptyOperand) + 1 THEN
  680. (* more efficient to calculate the value directly *)
  681. result := ValueComposition2(value, doEmit, targetRegister)
  682. ELSE
  683. (* more efficient to calculate the negation of the value and then negate it *)
  684. result := ValueComposition2(-value, doEmit, targetRegister) + 1;
  685. IF doEmit THEN
  686. Emit3(opRSB, targetRegister, targetRegister, InstructionSet.NewImmediate(0))
  687. END
  688. END;
  689. ASSERT((result >= 1) & (result <= 4));
  690. RETURN result
  691. END ValueComposition;
  692. (* note: used by 'ValueComposition'. do not call directly *)
  693. PROCEDURE ValueComposition2(value: LONGINT; doEmit: BOOLEAN; CONST targetRegister: Operand): LONGINT;
  694. VAR
  695. immediateOperand: Operand;
  696. result, position, partialValue, i: LONGINT;
  697. valueAsSet: SET;
  698. isFirst: BOOLEAN;
  699. BEGIN
  700. IF doEmit THEN ASSERT(targetRegister.mode = InstructionSet.modeRegister) END;
  701. IF Trace & doEmit THEN D.String("value to use: "); DBin(value, -32); D.String(" ("); D.Int(value, 0); D.String(") "); D.Ln; END;
  702. IF (value >= 0) & (value <= 255) THEN
  703. (* directly encodable as ARM immediate *)
  704. result := 1;
  705. IF doEmit THEN
  706. Emit2(opMOV, targetRegister, InstructionSet.NewImmediate(value))
  707. END
  708. ELSE
  709. valueAsSet := SYSTEM.VAL(SET, value);
  710. result := 0;
  711. position := 0;
  712. isFirst := TRUE;
  713. WHILE position < 32 DO
  714. IF (position IN valueAsSet) OR (position + 1 IN valueAsSet) THEN
  715. (* determine partial value for the 8 bit block *)
  716. partialValue := 0;
  717. FOR i := 7 TO 0 BY -1 DO
  718. partialValue := partialValue * 2;
  719. IF ((position + i) < 32) & ((position + i) IN valueAsSet) THEN INC(partialValue) END
  720. END;
  721. IF Trace & doEmit THEN
  722. D.String(" block found @ "); D.Int(position, 0); D.Ln;
  723. D.String(" unshifted partialValue: "); DBin(partialValue, -32); D.String(" ("); D.Int(partialValue, 0); D.String(") "); D.Ln;
  724. D.String(" shifted partialValue: "); DBin(ASH(partialValue, position), -32); D.String(" ("); D.Int(ASH(partialValue, position), 0); D.String(") "); D.Ln;
  725. END;
  726. ASSERT(~ODD(position));
  727. INC(result);
  728. IF doEmit THEN
  729. immediateOperand := InstructionSet.NewImmediate(ASH(partialValue, position)); (* TODO: check shift direction *)
  730. IF isFirst THEN
  731. Emit2(opMOV, targetRegister, immediateOperand);
  732. isFirst := FALSE
  733. ELSE
  734. Emit3(opADD, targetRegister, targetRegister, immediateOperand)
  735. END
  736. END;
  737. INC(position, 8)
  738. ELSE
  739. INC(position, 2)
  740. END
  741. END
  742. END;
  743. ASSERT((result >= 1) & (result <= 4));
  744. RETURN result
  745. END ValueComposition2;
  746. (** get the physical register number that corresponds to a virtual register number and part **)
  747. PROCEDURE PhysicalRegisterNumber(virtualRegisterNumber: LONGINT; part: LONGINT): LONGINT;
  748. VAR
  749. ticket: Ticket;
  750. result: LONGINT;
  751. BEGIN
  752. IF virtualRegisterNumber = IntermediateCode.FP THEN
  753. result := InstructionSet.FP
  754. ELSIF virtualRegisterNumber = IntermediateCode.SP THEN
  755. result := InstructionSet.SP
  756. ELSIF virtualRegisterNumber = IntermediateCode.LR THEN
  757. result := InstructionSet.LR
  758. ELSIF virtualRegisterNumber = IntermediateCode.AP THEN
  759. result := InstructionSet.R11
  760. ELSE
  761. ticket := virtualRegisters.Mapped(virtualRegisterNumber, part);
  762. IF ticket = NIL THEN
  763. result := None
  764. ELSE
  765. result := ticket.register
  766. END
  767. END;
  768. RETURN result
  769. END PhysicalRegisterNumber;
  770. (** get an ARM memory operand that represents a spill location (from a ticket) **)
  771. PROCEDURE GetSpillOperand(ticket: Ticket): Operand;
  772. VAR
  773. offset: LONGINT;
  774. result: Operand;
  775. BEGIN
  776. ASSERT(ticket.spilled);
  777. offset := spillStackStart + ticket.offset + 1; (* TODO: check this *)
  778. ASSERT((0 <= offset) & (offset < InstructionSet.Bits12));
  779. result := InstructionSet.NewImmediateOffsetMemory(PhysicalRegisterNumber(IntermediateCode.FP, Low), offset, {InstructionSet.Decrement});
  780. ASSERT(result.mode = InstructionSet.modeMemory);
  781. RETURN result
  782. END GetSpillOperand;
  783. (** get an ARM operand that represents a certain ticket (might be spilled or not) **)
  784. PROCEDURE OperandFromTicket(ticket: Ticket): Operand;
  785. VAR
  786. result: Operand;
  787. BEGIN
  788. ASSERT(ticket # NIL);
  789. IF ticket.spilled THEN
  790. (* the ticket is spilled *)
  791. result := GetSpillOperand(ticket)
  792. ELSE
  793. result := InstructionSet.NewRegister(ticket.register, None, None, 0)
  794. END;
  795. RETURN result
  796. END OperandFromTicket;
  797. (** get a free temporary register that holds data of a certain type **)
  798. PROCEDURE GetFreeRegister(CONST type: IntermediateCode.Type): Operand;
  799. VAR
  800. result: Operand;
  801. BEGIN
  802. result := OperandFromTicket(TemporaryTicket(IntermediateCode.GeneralPurposeRegister, type));
  803. ASSERT(result.mode = InstructionSet.modeRegister);
  804. RETURN result
  805. END GetFreeRegister;
  806. (** get a new free ARM register
  807. - if a register hint is provided that can hold data of the required type, it is returned instead
  808. **)
  809. PROCEDURE GetFreeRegisterOrHint(CONST type: IntermediateCode.Type; CONST registerHint: Operand): Operand;
  810. VAR
  811. result: Operand;
  812. BEGIN
  813. IF (registerHint.mode = InstructionSet.modeRegister) & IsRegisterForType(registerHint.register, type) THEN
  814. result := registerHint
  815. ELSE
  816. result := GetFreeRegister(type)
  817. END;
  818. ASSERT(result.mode = InstructionSet.modeRegister);
  819. RETURN result
  820. END GetFreeRegisterOrHint;
  821. (** whether a register can hold data of a certain IR type **)
  822. PROCEDURE IsRegisterForType(registerNumber: LONGINT; CONST type: IntermediateCode.Type): BOOLEAN;
  823. VAR
  824. result: BOOLEAN;
  825. BEGIN
  826. result := FALSE;
  827. IF type.form IN IntermediateCode.Integer THEN
  828. IF type.sizeInBits <= 32 THEN
  829. result := (registerNumber >= InstructionSet.R0) & (registerNumber <= InstructionSet.R15)
  830. END
  831. ELSIF type.form = IntermediateCode.Float THEN
  832. IF type.sizeInBits = 32 THEN
  833. result := (registerNumber >= InstructionSet.SR0) & (registerNumber <= InstructionSet.SR31)
  834. ELSE
  835. HALT(200)
  836. END
  837. ELSE
  838. HALT(100)
  839. END;
  840. RETURN result
  841. END IsRegisterForType;
  842. (** get an ARM register that that is set off by a certain amount **)
  843. PROCEDURE RegisterAfterAppliedOffset(register: Operand; offset: LONGINT; registerHint: Operand): Operand;
  844. VAR
  845. result, offsetOperand: Operand;
  846. BEGIN
  847. IF offset = 0 THEN
  848. result := register
  849. ELSE
  850. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  851. offsetOperand := OperandFromValue(ABS(offset), result); (* might be immediate operand or register (tempRegister is given as a register hint) *)
  852. IF offset > 0 THEN
  853. Emit3(opADD, result, register, offsetOperand)
  854. ELSE
  855. Emit3(opSUB, result, register, offsetOperand)
  856. END
  857. END;
  858. RETURN result
  859. END RegisterAfterAppliedOffset;
  860. (** get an ARM register from an IR register
  861. - use register hint if provided
  862. **)
  863. PROCEDURE RegisterFromIrRegister(CONST irRegisterOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  864. VAR
  865. result, offsetOperand, tempReg: Operand;
  866. BEGIN
  867. ASSERT(irRegisterOperand.mode = IntermediateCode.ModeRegister);
  868. result := InstructionSet.NewRegister(PhysicalRegisterNumber(irRegisterOperand.register, part), None, None, 0);
  869. result := RegisterAfterAppliedOffset(result, irRegisterOperand.offset, registerHint);
  870. ASSERT(result.mode = InstructionSet.modeRegister);
  871. RETURN result
  872. END RegisterFromIrRegister;
  873. PROCEDURE Load(targetRegister, memoryOperand: Operand; irType: IntermediateCode.Type);
  874. BEGIN
  875. IF (irType.form IN IntermediateCode.Integer) OR ~(backend.useFPU) THEN
  876. CASE irType.sizeInBits OF
  877. | 8: Emit2WithFlags(opLDR, targetRegister, memoryOperand, {InstructionSet.flagB}) (* LDRB *)
  878. | 16: Emit2WithFlags(opLDR, targetRegister, memoryOperand, {InstructionSet.flagH}) (* LDRH *)
  879. | 32: (* TM*)
  880. Emit2(opLDR, targetRegister, memoryOperand)
  881. ELSE HALT(100)
  882. END
  883. ELSIF irType.form = IntermediateCode.Float THEN
  884. ASSERT(irType.sizeInBits = 32, 200);
  885. Emit2(opFLDS, targetRegister, memoryOperand)
  886. ELSE
  887. HALT(100)
  888. END
  889. END Load;
  890. PROCEDURE Store(sourceRegister, memoryOperand: Operand; type: IntermediateCode.Type);
  891. BEGIN
  892. IF (type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  893. CASE type.sizeInBits OF
  894. | 8: Emit2WithFlags(opSTR, sourceRegister, memoryOperand, {InstructionSet.flagB}) (* STRB *)
  895. | 16: Emit2WithFlags(opSTR, sourceRegister, memoryOperand, {InstructionSet.flagH}) (* STRH *)
  896. | 32: Emit2(opSTR, sourceRegister, memoryOperand)
  897. ELSE HALT(100)
  898. END
  899. ELSIF type.form = IntermediateCode.Float THEN
  900. ASSERT(type.sizeInBits = 32, 200);
  901. Emit2(opFSTS, sourceRegister, memoryOperand)
  902. ELSE
  903. HALT(100)
  904. END
  905. END Store;
  906. (** get an ARM register that contains the address of a symbol/section
  907. - use register hint if provided **)
  908. PROCEDURE RegisterFromSymbol(symbol: Sections.SectionName; fingerprint: LONGINT; resolved: Sections.Section; symbolOffset: LONGINT; CONST registerHint: Operand): Operand;
  909. VAR
  910. address: LONGINT;
  911. result: Operand;
  912. irSection: IntermediateCode.Section;
  913. BEGIN
  914. IF resolved # NIL THEN
  915. irSection := resolved(IntermediateCode.Section);
  916. END;
  917. IF (irSection # NIL) & (irSection.resolved # NIL) & (irSection.resolved.os.fixed) THEN
  918. (* optimization: if the IR section is already resolved and positioned at a fixed location, no fixup is required *)
  919. address := irSection.resolved.os.alignment + irSection.instructions[symbolOffset].pc;
  920. result := RegisterFromValue(address, registerHint)
  921. ELSE
  922. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  923. listOfReferences.AddSymbol(symbol, fingerprint, symbolOffset, out.pc);
  924. Emit2(opLDR, result, InstructionSet.NewImmediateOffsetMemory(opPC.register, 0, {InstructionSet.Increment})); (* LDR ..., [PC, #+???] *)
  925. END;
  926. ASSERT(result.mode = InstructionSet.modeRegister);
  927. RETURN result
  928. END RegisterFromSymbol;
  929. (** get an ARM memory operand from an IR memory operand
  930. - note that the constraints on memory operands depend on the type of data (e.g., the allowed offset range is more restricted for memory operands on floating point values)
  931. **)
  932. PROCEDURE MemoryOperandFromIrMemoryOperand(VAR irMemoryOperand: IntermediateCode.Operand; part: LONGINT; CONST registerHint: Operand): Operand;
  933. VAR
  934. baseAddressRegisterNumber, offset: LONGINT;
  935. indexingMode: SET;
  936. result, baseAddressRegister, offsetRegister, tempRegister: Operand;
  937. BEGIN
  938. ASSERT(irMemoryOperand.mode = IntermediateCode.ModeMemory);
  939. (* determine base address register *)
  940. IF irMemoryOperand.register # IntermediateCode.None THEN
  941. (* case 1: [r1] or [r1 + 7] *)
  942. ASSERT(irMemoryOperand.symbol.name = "");
  943. baseAddressRegisterNumber := PhysicalRegisterNumber(irMemoryOperand.register, Low); (* addresses always are in the lower part *)
  944. ELSIF irMemoryOperand.symbol.name # "" THEN
  945. (* case 2: [symbol], [symbol:3], [symbol + 7] or [symbol:3 + 7] *)
  946. Resolve(irMemoryOperand);
  947. baseAddressRegister := RegisterFromSymbol(irMemoryOperand.symbol.name, irMemoryOperand.symbol.fingerprint, irMemoryOperand.resolved, irMemoryOperand.symbolOffset, registerHint);
  948. baseAddressRegisterNumber := baseAddressRegister.register
  949. ELSE
  950. (* case 3: [123456] *)
  951. ASSERT(irMemoryOperand.offset = 0);
  952. baseAddressRegister := RegisterFromValue(LONGINT(irMemoryOperand.intValue), registerHint);
  953. baseAddressRegisterNumber := baseAddressRegister.register
  954. END;
  955. ASSERT(baseAddressRegisterNumber # None);
  956. (* get offset of part in question *)
  957. offset := irMemoryOperand.offset + part * 4;
  958. (* determine indexing mode *)
  959. IF offset >= 0 THEN indexingMode := {InstructionSet.Increment} ELSE indexingMode := {InstructionSet.Decrement} END;
  960. IF irMemoryOperand.type.form IN IntermediateCode.Integer THEN
  961. (* regular ARM memory operand *)
  962. (*! LDRH supports only 8 bits immediates, while LDR and LDRB support 12 bits immediates *)
  963. IF ((irMemoryOperand.type.sizeInBits = 16) & (ABS(offset) < 256)) OR ((irMemoryOperand.type.sizeInBits # 16) & (ABS(offset) < InstructionSet.Bits12)) THEN
  964. (* offset can be encoded directly *)
  965. result := InstructionSet.NewImmediateOffsetMemory(baseAddressRegisterNumber, ABS(offset), indexingMode)
  966. ELSE
  967. (* offset has to be provided in a register *)
  968. offsetRegister := RegisterFromValue(ABS(offset), emptyOperand);
  969. result := InstructionSet.NewRegisterOffsetMemory(baseAddressRegisterNumber, offsetRegister.register, None, 0, indexingMode)
  970. END
  971. ELSIF irMemoryOperand.type.form = IntermediateCode.Float THEN
  972. (* VFP memory operand *)
  973. ASSERT((ABS(offset) MOD 4) = 0);
  974. IF ABS(offset) >= 1024 THEN
  975. (* offset cannot be encoded directly _> it has to be provided by means of an adapted base register *)
  976. tempRegister := RegisterFromValue(ABS(offset), emptyOperand);
  977. IF offset < 0 THEN
  978. Emit3(opSUB, tempRegister, tempRegister, baseAddressRegister)
  979. ELSE
  980. Emit3(opADD, tempRegister, tempRegister, baseAddressRegister)
  981. END;
  982. ReleaseHint(baseAddressRegister.register);
  983. baseAddressRegister := tempRegister;
  984. baseAddressRegisterNumber := baseAddressRegister.register;
  985. offset := 0;
  986. END;
  987. result := InstructionSet.NewImmediateOffsetMemory(baseAddressRegisterNumber, ABS(offset), indexingMode)
  988. ELSE
  989. HALT(100)
  990. END;
  991. ASSERT(result.mode = InstructionSet.modeMemory);
  992. RETURN result
  993. END MemoryOperandFromIrMemoryOperand;
  994. (** get an ARM immediate operand or register from any IR operand
  995. - if possible, the an immediate is returned
  996. - if needed, use register hint if provided
  997. **)
  998. PROCEDURE RegisterOrImmediateFromIrOperand(VAR irOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  999. VAR
  1000. result: Operand;
  1001. BEGIN
  1002. IF IrOperandIsDirectlyEncodable(irOperand, part) THEN
  1003. result := InstructionSet.NewImmediate(ValueOfPart(irOperand.intValue, part))
  1004. ELSE
  1005. result := RegisterFromIrOperand(irOperand, part, registerHint)
  1006. END;
  1007. RETURN result
  1008. END RegisterOrImmediateFromIrOperand;
  1009. (** get an ARM register operand from any IR operand
  1010. - use register hint if provided
  1011. **)
  1012. PROCEDURE RegisterFromIrOperand(VAR irOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  1013. VAR
  1014. value: LONGINT;
  1015. result: Operand;
  1016. BEGIN
  1017. CASE irOperand.mode OF
  1018. | IntermediateCode.ModeRegister:
  1019. ASSERT((irOperand.intValue = 0) & (irOperand.symbol.name = ""));
  1020. result := RegisterFromIrRegister(irOperand, part, registerHint)
  1021. | IntermediateCode.ModeMemory:
  1022. result := GetFreeRegisterOrHint(PartType(irOperand.type, part), registerHint);
  1023. Load(result, MemoryOperandFromIrMemoryOperand(irOperand, part, result), PartType(irOperand.type, part))
  1024. | IntermediateCode.ModeImmediate:
  1025. ASSERT(irOperand.register = IntermediateCode.None);
  1026. IF irOperand.symbol.name # "" THEN
  1027. Resolve(irOperand);
  1028. result := RegisterFromSymbol(irOperand.symbol.name, irOperand.symbol.fingerprint, irOperand.resolved, irOperand.symbolOffset, emptyOperand);
  1029. result := RegisterAfterAppliedOffset(result, irOperand.offset, registerHint);
  1030. ELSE
  1031. ASSERT(irOperand.offset = 0);
  1032. IF IsInteger(irOperand) THEN result := RegisterFromValue(ValueOfPart(irOperand.intValue, part), registerHint)
  1033. ELSIF ~backend.useFPU THEN
  1034. IF IsSinglePrecisionFloat(irOperand) THEN
  1035. result := RegisterFromValue(BinaryCode.ConvertReal(SHORT(irOperand.floatValue)), registerHint)
  1036. ELSE
  1037. result := RegisterFromValue(ValueOfPart(BinaryCode.ConvertLongreal(irOperand.floatValue),part), registerHint);
  1038. END;
  1039. ELSIF IsSinglePrecisionFloat(irOperand) THEN result := SinglePrecisionFloatRegisterFromValue(REAL(irOperand.floatValue), registerHint)
  1040. ELSE HALT(200)
  1041. END
  1042. END
  1043. ELSE
  1044. HALT(100)
  1045. END;
  1046. ASSERT(result.mode = InstructionSet.modeRegister);
  1047. RETURN result
  1048. END RegisterFromIrOperand;
  1049. (** whether an IR operand is complex, i.e., requires more than one ARM operands to be represented **)
  1050. PROCEDURE IsComplex(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1051. VAR
  1052. result: BOOLEAN;
  1053. BEGIN
  1054. IF (irOperand.type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  1055. result := irOperand.type.sizeInBits > 32 (* integers above 32 bits have to be represented in multiple registers *)
  1056. ELSIF irOperand.type.form = IntermediateCode.Float THEN
  1057. result := FALSE (* for all types of floating point numbers there are dedicated VFP registers *)
  1058. ELSE
  1059. HALT(100)
  1060. END;
  1061. RETURN result
  1062. END IsComplex;
  1063. (** whether an IR operand hold a single precision floating point value **)
  1064. PROCEDURE IsSinglePrecisionFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1065. BEGIN RETURN (irOperand.type.sizeInBits = 32) & (irOperand.type.form = IntermediateCode.Float)
  1066. END IsSinglePrecisionFloat;
  1067. (** whether an IR operand hold a single precision floating point value **)
  1068. PROCEDURE IsDoublePrecisionFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1069. BEGIN RETURN (irOperand.type.sizeInBits = 64) & (irOperand.type.form = IntermediateCode.Float)
  1070. END IsDoublePrecisionFloat;
  1071. PROCEDURE IsFloat(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1072. BEGIN
  1073. RETURN irOperand.type.form = IntermediateCode.Float
  1074. END IsFloat;
  1075. (** whether an IR operand hold am integer value **)
  1076. PROCEDURE IsInteger(CONST irOperand: IntermediateCode.Operand): BOOLEAN;
  1077. BEGIN RETURN irOperand.type.form IN IntermediateCode.Integer
  1078. END IsInteger;
  1079. PROCEDURE PartType(CONST type: IntermediateCode.Type; part: LONGINT): IntermediateCode.Type;
  1080. VAR
  1081. result: IntermediateCode.Type;
  1082. BEGIN
  1083. GetPartType(type, part, result);
  1084. RETURN result
  1085. END PartType;
  1086. (* the intermediate code type of a part
  1087. - a part type is by definition directly representable in a register *)
  1088. PROCEDURE GetPartType(CONST type: IntermediateCode.Type; part: LONGINT; VAR partType: IntermediateCode.Type);
  1089. BEGIN
  1090. ASSERT((part = Low) OR (part = High));
  1091. IF (type.form = IntermediateCode.Float) & backend.useFPU THEN
  1092. IF part = Low THEN
  1093. partType := type
  1094. ELSE
  1095. partType := IntermediateCode.undef
  1096. END
  1097. ELSIF (type.form IN IntermediateCode.Integer) OR ~backend.useFPU THEN
  1098. IF type.sizeInBits <= 32 THEN
  1099. IF part = Low THEN
  1100. partType := type
  1101. ELSE
  1102. partType := IntermediateCode.undef
  1103. END
  1104. ELSIF type.sizeInBits = 64 THEN
  1105. IF part = Low THEN
  1106. partType := IntermediateCode.NewType(IntermediateCode.UnsignedInteger, 32) (* conceptually the low part is always unsigned *)
  1107. ELSE
  1108. partType := IntermediateCode.NewType(type.form, 32)
  1109. END
  1110. ELSE
  1111. HALT(100)
  1112. END
  1113. ELSE
  1114. HALT(100)
  1115. END
  1116. END GetPartType;
  1117. (** the value of a 32 bit part **)
  1118. PROCEDURE ValueOfPart(value: HUGEINT; part: LONGINT): LONGINT;
  1119. VAR
  1120. result: LONGINT;
  1121. BEGIN
  1122. IF part = Low THEN
  1123. result := LONGINT(value) (* get the 32 least significant bits *)
  1124. ELSIF part = High THEN
  1125. result := LONGINT(ASH(value, -32)) (* get the 32 most significant bits *)
  1126. ELSE
  1127. HALT(100)
  1128. END;
  1129. RETURN result
  1130. END ValueOfPart;
  1131. (** whether a 32 bit value can be directly encoded as an ARM immediate (using a 8-bit base value and 4-bit half rotation) **)
  1132. PROCEDURE ValueIsDirectlyEncodable(value: LONGINT): BOOLEAN;
  1133. VAR
  1134. baseValue, halfRotation: LONGINT;
  1135. result: BOOLEAN;
  1136. BEGIN
  1137. result := InstructionSet.EncodeImmediate(value, baseValue, halfRotation);
  1138. RETURN result
  1139. END ValueIsDirectlyEncodable;
  1140. (* whether an IR operand (or part thereof) can be directly encoded as an ARM immediate *)
  1141. PROCEDURE IrOperandIsDirectlyEncodable(irOperand: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  1142. BEGIN RETURN
  1143. (irOperand.mode = IntermediateCode.ModeImmediate) &
  1144. (irOperand.symbol.name = "") &
  1145. (irOperand.type.form IN IntermediateCode.Integer) &
  1146. ValueIsDirectlyEncodable(ValueOfPart(irOperand.intValue, part))
  1147. END IrOperandIsDirectlyEncodable;
  1148. (* whether the negation of an IR operand (or part thereof) can be directly encoded as an ARM immediate *)
  1149. PROCEDURE NegatedIrOperandIsDirectlyEncodable(irOperand: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
  1150. BEGIN RETURN
  1151. (irOperand.mode = IntermediateCode.ModeImmediate) &
  1152. (irOperand.symbol.name = "") &
  1153. (irOperand.type.form IN IntermediateCode.Integer) &
  1154. ValueIsDirectlyEncodable(ValueOfPart(-irOperand.intValue, part)) (* note the minus sign *)
  1155. END NegatedIrOperandIsDirectlyEncodable;
  1156. (** generate code for a certain IR instruction **)
  1157. PROCEDURE Generate(VAR irInstruction: IntermediateCode.Instruction);
  1158. VAR
  1159. ticket: Ticket;
  1160. (* hwreg, lastUse: LONGINT; *)
  1161. BEGIN
  1162. (* CheckFixups; *)
  1163. EmitFixupBlockIfNeeded;
  1164. (*
  1165. IF ((irInstruction.opcode = IntermediateCode.mov) OR (irInstruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
  1166. hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
  1167. Spill(physicalRegisters.Mapped(hwreg));
  1168. lastUse := inPC+1;
  1169. WHILE (lastUse < in.pc) &
  1170. ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
  1171. INC(lastUse)
  1172. END;
  1173. ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
  1174. END;
  1175. *)
  1176. ReserveOperandRegisters(irInstruction.op1, TRUE);
  1177. ReserveOperandRegisters(irInstruction.op2, TRUE);
  1178. ReserveOperandRegisters(irInstruction.op3, TRUE);
  1179. CASE irInstruction.opcode OF
  1180. | IntermediateCode.nop: (* do nothing *)
  1181. | IntermediateCode.mov: EmitMov(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitMov(irInstruction, High) END
  1182. | IntermediateCode.conv: EmitConv(irInstruction)
  1183. | IntermediateCode.call: EmitCall(irInstruction)
  1184. | IntermediateCode.enter: EmitEnter(irInstruction)
  1185. | IntermediateCode.leave: EmitLeave(irInstruction)
  1186. | IntermediateCode.exit: EmitExit(irInstruction)
  1187. | IntermediateCode.return: EmitReturn(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitReturn(irInstruction, High) END;
  1188. | IntermediateCode.result: EmitResult(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitResult(irInstruction, High) END;
  1189. | IntermediateCode.trap: EmitTrap(irInstruction);
  1190. | IntermediateCode.br .. IntermediateCode.brlt: EmitBr(irInstruction)
  1191. | IntermediateCode.pop: EmitPop(irInstruction.op1, Low); IF IsComplex(irInstruction.op1) THEN EmitPop(irInstruction.op1, High) END
  1192. | IntermediateCode.push: IF IsComplex(irInstruction.op1) THEN EmitPush(irInstruction.op1, High) END; EmitPush(irInstruction.op1, Low)
  1193. | IntermediateCode.neg: EmitNeg(irInstruction)
  1194. | IntermediateCode.not: EmitNot(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitNot(irInstruction, High) END
  1195. | IntermediateCode.abs: EmitAbs(irInstruction)
  1196. | IntermediateCode.mul: EmitMul(irInstruction)
  1197. | IntermediateCode.div: EmitDiv(irInstruction)
  1198. | IntermediateCode.mod: EmitMod(irInstruction)
  1199. | IntermediateCode.sub, IntermediateCode.add: EmitAddOrSub(irInstruction)
  1200. | IntermediateCode.and: EmitAnd(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitAnd(irInstruction, High) END
  1201. | IntermediateCode.or: EmitOr(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitOr(irInstruction, High) END
  1202. | IntermediateCode.xor: EmitXor(irInstruction, Low); IF IsComplex(irInstruction.op1) THEN EmitXor(irInstruction, High) END
  1203. | IntermediateCode.shl: EmitShiftOrRotation(irInstruction)
  1204. | IntermediateCode.shr: EmitShiftOrRotation(irInstruction)
  1205. | IntermediateCode.rol: EmitShiftOrRotation(irInstruction)
  1206. | IntermediateCode.ror: EmitShiftOrRotation(irInstruction)
  1207. | IntermediateCode.copy: EmitCopy(irInstruction)
  1208. | IntermediateCode.fill: EmitFill(irInstruction, FALSE)
  1209. | IntermediateCode.asm: EmitAsm(irInstruction)
  1210. | IntermediateCode.special: EmitSpecial(irInstruction)
  1211. END;
  1212. ReserveOperandRegisters(irInstruction.op3, FALSE);
  1213. ReserveOperandRegisters(irInstruction.op2 ,FALSE);
  1214. ReserveOperandRegisters(irInstruction.op1, FALSE);
  1215. END Generate;
  1216. PROCEDURE PostGenerate(CONST instruction: IntermediateCode.Instruction);
  1217. VAR ticket: Ticket;
  1218. BEGIN
  1219. TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
  1220. ticket := tickets.live;
  1221. WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
  1222. UnmapTicket(ticket);
  1223. ticket := tickets.live
  1224. END;
  1225. END PostGenerate;
  1226. PROCEDURE EmitFinalFixupBlock;
  1227. BEGIN
  1228. IF listOfReferences.referenceCount > 0 THEN
  1229. ASSERT(in.pc > 0);
  1230. IF in.instructions[in.pc - 1].opcode # IntermediateCode.exit THEN
  1231. (* there is no exit instruction at the end of the IR section -> emit a branch that skips the fixup block (in particular used by @BodyStub procedures)*)
  1232. Emit1(opB, InstructionSet.NewImmediate((listOfReferences.referenceCount + 1) * 4 - 8))
  1233. END
  1234. END;
  1235. EmitFixupBlock; (* emit the fixup block *)
  1236. END EmitFinalFixupBlock;
  1237. (* if needed, emit fixup block for all used symbol references
  1238. - the fixup block is skipped by a branch instruction
  1239. - afterwards, the list of references is cleared
  1240. *)
  1241. PROCEDURE EmitFixupBlockIfNeeded;
  1242. BEGIN
  1243. IF out.pc - listOfReferences.pcOfFirstCitation + listOfReferences.referenceCount + 1 > MaximumFixupDistance THEN
  1244. Emit1(opB, InstructionSet.NewImmediate((listOfReferences.referenceCount + 1) * 4 - 8)); (* emit branch instruction that skips the fixup block *)
  1245. EmitFixupBlock; (* emit the fixup block *)
  1246. listOfReferences.Init (* clear the list *)
  1247. END
  1248. END EmitFixupBlockIfNeeded;
  1249. (* emit fixup block for all used symbol references, and clear the list *)
  1250. PROCEDURE EmitFixupBlock;
  1251. VAR
  1252. reference: Reference;
  1253. citation: Citation;
  1254. fixup: BinaryCode.Fixup;
  1255. patchValue: LONGINT;
  1256. identifier: ObjectFile.Identifier;
  1257. BEGIN
  1258. IF listOfReferences.referenceCount > 0 THEN
  1259. IF out.comments # NIL THEN
  1260. out.comments.String("REFERENCES BLOCK"); out.comments.String(" (");
  1261. out.comments.Int(listOfReferences.referenceCount, 0);
  1262. out.comments.String(" references):"); out.comments.Ln; out.comments.Update
  1263. END;
  1264. reference := listOfReferences.firstReference;
  1265. WHILE reference # NIL DO
  1266. (* 1. patch all of the citations, i.e., the LDR instructions that use the symbol reference *)
  1267. citation := reference.firstCitation;
  1268. WHILE citation # NIL DO
  1269. patchValue := out.pc - 8 - citation.pc;
  1270. ASSERT((0 <= patchValue) & (patchValue < InstructionSet.Bits12));
  1271. out.PutBitsAt(citation.pc, patchValue, 12);
  1272. citation := citation.next
  1273. END;
  1274. IF reference IS SymbolReference THEN
  1275. WITH reference: SymbolReference DO
  1276. (* alternative version that relies on the fixup mechanism:
  1277. NEW(fixupPattern12, 1);
  1278. fixupPattern12[0].offset := 0;
  1279. fixupPattern12[0].bits := 12;
  1280. fixup := BinaryCode.NewFixup(BinaryCode.Relative, entry.pc, in, 0, out.pc - 8, 0, fixupPattern12); (* TODO: determine the correct displacement *)
  1281. out.fixupList.AddFixup(fixup);
  1282. *)
  1283. (* 2. add an absolute fixup for the symbol reference and emit space *)
  1284. IF out.comments # NIL THEN
  1285. out.comments.String("fixup location for ");
  1286. Basic.WriteSegmentedName(out.comments, reference.symbol);
  1287. out.comments.String(":"); out.comments.Int(reference.symbolOffset, 0);
  1288. out.comments.String(" :"); out.comments.Ln; out.comments.Update
  1289. END;
  1290. identifier.name := reference.symbol;
  1291. identifier.fingerprint := reference.fingerprint;
  1292. fixup := BinaryCode.NewFixup(BinaryCode.Absolute, out.pc, identifier, reference.symbolOffset, 0, 0, fixupPattern);
  1293. out.fixupList.AddFixup(fixup);
  1294. out.PutBits(0, 32);
  1295. END;
  1296. ELSIF reference IS ImmediateReference THEN
  1297. WITH reference: ImmediateReference DO
  1298. IF out.comments # NIL THEN
  1299. out.comments.String("immediate value"); out.comments.Ln; out.comments.Update;
  1300. END;
  1301. out.PutBits(reference.value,32);
  1302. END
  1303. END;
  1304. reference := reference.next
  1305. END
  1306. END
  1307. END EmitFixupBlock;
  1308. (** get an ARM operand that hold a certain value
  1309. - if possible the value is returned as an ARM immediate operand
  1310. - otherwise a register is returned instead (if a register hint is present, it is used) **)
  1311. PROCEDURE OperandFromValue(value: LONGINT; registerHint: Operand): Operand;
  1312. VAR
  1313. result: Operand;
  1314. BEGIN
  1315. IF ValueIsDirectlyEncodable(value) THEN
  1316. result := InstructionSet.NewImmediate(value)
  1317. ELSE
  1318. result := RegisterFromValue(value, registerHint)
  1319. END;
  1320. RETURN result
  1321. END OperandFromValue;
  1322. (** get a single precision VFP register that holds a certain floating point value **)
  1323. PROCEDURE SinglePrecisionFloatRegisterFromValue(value: REAL; registerHint: Operand): Operand;
  1324. VAR
  1325. intValue, dummy: LONGINT;
  1326. result, temp: Operand;
  1327. BEGIN
  1328. intValue := SYSTEM.VAL(LONGINT, value);
  1329. (* alternative: integerValue := BinaryCode.ConvertReal(value) *)
  1330. temp := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  1331. dummy := ValueComposition(intValue, TRUE, temp);
  1332. result := GetFreeRegisterOrHint(IntermediateCode.FloatType(32), registerHint);
  1333. Emit2(opFMSR, result, temp);
  1334. ASSERT(result.mode = InstructionSet.modeRegister);
  1335. ASSERT((result.register >= InstructionSet.SR0) & (result.register <= InstructionSet.SR31));
  1336. RETURN result;
  1337. END SinglePrecisionFloatRegisterFromValue;
  1338. (** get an ARM register that holds a certain integer value
  1339. - if a register hint is present, it is used **)
  1340. PROCEDURE RegisterFromValue(value: LONGINT; registerHint: Operand): Operand;
  1341. VAR
  1342. dummy: LONGINT;
  1343. result: Operand;
  1344. BEGIN
  1345. result := GetFreeRegisterOrHint(IntermediateCode.SignedIntegerType(32), registerHint);
  1346. IF ValueComposition(value, FALSE, result) < 3 THEN
  1347. dummy := ValueComposition(value, TRUE, result);
  1348. ELSE
  1349. result := GetFreeRegisterOrHint(IntermediateCode.UnsignedIntegerType(32), registerHint);
  1350. listOfReferences.AddImmediate(value, out.pc);
  1351. Emit2(opLDR, result, InstructionSet.NewImmediateOffsetMemory(opPC.register, 0, {InstructionSet.Increment})); (* LDR ..., [PC, #+???] *)
  1352. END;
  1353. ASSERT(result.mode = InstructionSet.modeRegister);
  1354. ASSERT((result.register >= InstructionSet.R0) & (result.register <= InstructionSet.R15));
  1355. RETURN result
  1356. END RegisterFromValue;
  1357. (** allocate or deallocate on the stack
  1358. - note: updateStackSize is important as intermediate RETURNs should not change stack size
  1359. **)
  1360. PROCEDURE AllocateStack(allocationSize: LONGINT; doUpdateStackSize: BOOLEAN; clear: BOOLEAN);
  1361. VAR
  1362. operand, zero, count: InstructionSet.Operand; i: LONGINT;
  1363. BEGIN
  1364. inStackAllocation := TRUE;
  1365. operand := OperandFromValue(ABS(allocationSize), emptyOperand);
  1366. IF allocationSize > 0 THEN
  1367. IF clear THEN
  1368. zero := InstructionSet.NewRegister(0, None, None, 0);
  1369. Emit2(opMOV, zero , InstructionSet.NewImmediate(0));
  1370. IF allocationSize < 16 THEN
  1371. FOR i := 0 TO allocationSize-1 BY 4 DO
  1372. Emit2(opSTR, InstructionSet.NewRegister(0, None, None, 0), InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Decrement, InstructionSet.PreIndexed}));
  1373. END;
  1374. ELSE
  1375. count := InstructionSet.NewRegister(1, None, None, 0);
  1376. Emit1(opB, InstructionSet.NewImmediate(0)); (* PC offset = 8 ! Jump over immediate *)
  1377. out.PutBits(allocationSize DIV 4, 32);
  1378. Emit2(opLDR, count, InstructionSet.NewImmediateOffsetMemory(InstructionSet.PC, 8+4, {InstructionSet.Decrement}));
  1379. (* label *)
  1380. Emit2(opSTR, zero, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Decrement, InstructionSet.PreIndexed}));
  1381. Emit3WithFlags(opSUB, count, count, InstructionSet.NewImmediate(1),{InstructionSet.flagS});
  1382. Emit1WithCondition(opB, InstructionSet.NewImmediate(-8 -8), InstructionSet.conditionGT); (* label *)
  1383. END;
  1384. ELSE
  1385. Emit3(opSUB, opSP, opSP, operand) (* decreasing SP: allocation *)
  1386. END;
  1387. ELSIF allocationSize < 0 THEN
  1388. Emit3(opADD, opSP, opSP, operand) (* increasing SP: deallocation *)
  1389. END;
  1390. IF doUpdateStackSize THEN stackSize := stackSize + allocationSize END;
  1391. inStackAllocation := FALSE
  1392. END AllocateStack;
  1393. (** whether two ARM operands represent the same physical register **)
  1394. PROCEDURE IsSameRegister(CONST a, b: Operand): BOOLEAN;
  1395. BEGIN RETURN (a.mode = InstructionSet.modeRegister) & (b.mode = InstructionSet.modeRegister) & (a.register = b.register)
  1396. END IsSameRegister;
  1397. (** emit a MOV instruction if the two operands do not represent the same register
  1398. - for moves involving floating point registers special VFP instructions opFCPYS, opFMSR and opFMRS are used
  1399. **)
  1400. PROCEDURE MovIfDifferent(CONST a, b: Operand);
  1401. BEGIN
  1402. IF ~IsSameRegister(a, b) THEN
  1403. ASSERT(a.mode = InstructionSet.modeRegister);
  1404. IF IsRegisterForType(a.register, IntermediateCode.FloatType(32)) THEN
  1405. IF IsRegisterForType(b.register, IntermediateCode.FloatType(32)) THEN
  1406. (* mov float, float: *)
  1407. Emit2(opFCPYS, a, b)
  1408. ELSE
  1409. (* mov float, int: *)
  1410. Emit2(opFMSR, a, b)
  1411. END
  1412. ELSE
  1413. IF IsRegisterForType(b.register, IntermediateCode.FloatType(32)) THEN
  1414. (* mov int, float: *)
  1415. Emit2(opFMRS, a, b)
  1416. ELSE
  1417. (* mov int, int: *)
  1418. Emit2(opMOV, a, b)
  1419. END
  1420. END
  1421. END
  1422. END MovIfDifferent;
  1423. (** acquire an ARM register fr oa IR destination operand part
  1424. - if IR operand is a memory location, get a temporary register (if provided the hinted register is used)
  1425. - if IR operand is an IR register, get the ARM register that is mapped to the corresponding part
  1426. **)
  1427. PROCEDURE AcquireDestinationRegister(CONST irDestinationOperand: IntermediateCode.Operand; part: LONGINT; registerHint: Operand): Operand;
  1428. VAR
  1429. result: Operand;
  1430. BEGIN
  1431. IF irDestinationOperand.mode = IntermediateCode.ModeMemory THEN
  1432. result := GetFreeRegisterOrHint(PartType(irDestinationOperand.type, part), registerHint)
  1433. ELSIF irDestinationOperand.mode = IntermediateCode.ModeRegister THEN
  1434. ASSERT(irDestinationOperand.offset = 0);
  1435. IF virtualRegisters.Mapped(irDestinationOperand.register, part) = NIL THEN TryAllocate(irDestinationOperand, part) END; (* create the mapping if not yet done *)
  1436. result := InstructionSet.NewRegister(PhysicalRegisterNumber(irDestinationOperand.register, part), None, None, 0)
  1437. ELSE
  1438. HALT(100)
  1439. END;
  1440. ASSERT(result.mode = InstructionSet.modeRegister);
  1441. RETURN result
  1442. END AcquireDestinationRegister;
  1443. (** write the content of an ARM register to an IR destination operand (memory location or IR register)
  1444. - afterwards, try to release the register
  1445. **)
  1446. PROCEDURE WriteBack(VAR irDestinationOperand: IntermediateCode.Operand; part: LONGINT; register: Operand);
  1447. VAR
  1448. mappedArmRegister: Operand;
  1449. BEGIN
  1450. ASSERT(register.mode = InstructionSet.modeRegister);
  1451. IF irDestinationOperand.mode = IntermediateCode.ModeMemory THEN
  1452. Store(register, MemoryOperandFromIrMemoryOperand(irDestinationOperand, part, emptyOperand), PartType(irDestinationOperand.type, part))
  1453. ELSIF irDestinationOperand.mode = IntermediateCode.ModeRegister THEN
  1454. ASSERT((virtualRegisters.Mapped(irDestinationOperand.register, part) # NIL)
  1455. OR (irDestinationOperand.register = IntermediateCode.SP)
  1456. OR (irDestinationOperand.register = IntermediateCode.FP));
  1457. mappedArmRegister := InstructionSet.NewRegister(PhysicalRegisterNumber(irDestinationOperand.register, part), None, None, 0);
  1458. MovIfDifferent(mappedArmRegister, register)
  1459. ELSE
  1460. HALT(100)
  1461. END;
  1462. ReleaseHint(register.register)
  1463. END WriteBack;
  1464. PROCEDURE ZeroExtendOperand(operand: Operand; sizeInBits: LONGINT);
  1465. BEGIN
  1466. ASSERT(sizeInBits <= 32);
  1467. IF operand.mode = InstructionSet.modeRegister THEN
  1468. IF sizeInBits = 8 THEN
  1469. Emit3(opAND, operand, operand, InstructionSet.NewImmediate(255)); (* AND reg, reg, 11111111b *)
  1470. ELSIF sizeInBits = 16 THEN
  1471. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSL, None, 16));
  1472. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSR, None, 16))
  1473. ELSIF sizeInBits = 32 THEN
  1474. (* nothing to do *)
  1475. ELSE
  1476. HALT(100)
  1477. END
  1478. END
  1479. END ZeroExtendOperand;
  1480. PROCEDURE SignExtendOperand(operand: Operand; sizeInBits: LONGINT);
  1481. BEGIN
  1482. ASSERT(sizeInBits <= 32);
  1483. IF operand.mode = InstructionSet.modeRegister THEN
  1484. IF sizeInBits < 32 THEN
  1485. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftLSL, None, 32 - sizeInBits));
  1486. Emit2(opMOV, operand, InstructionSet.NewRegister(operand.register, InstructionSet.shiftASR, None, 32 - sizeInBits))
  1487. END
  1488. END
  1489. END SignExtendOperand;
  1490. (** sign or zero-extends the content of an operand to 32 bits, depending on the IR type **)
  1491. PROCEDURE SignOrZeroExtendOperand(operand: Operand; irType: IntermediateCode.Type);
  1492. BEGIN
  1493. ASSERT(irType.sizeInBits <= 32);
  1494. IF irType.form = IntermediateCode.UnsignedInteger THEN
  1495. ZeroExtendOperand(operand, irType.sizeInBits)
  1496. ELSE
  1497. SignExtendOperand(operand, irType.sizeInBits)
  1498. END
  1499. END SignOrZeroExtendOperand;
  1500. (* ACTUAL CODE GENERATION *)
  1501. PROCEDURE EmitPush(VAR irOperand: IntermediateCode.Operand; part: LONGINT);
  1502. VAR
  1503. register: Operand;
  1504. partType: IntermediateCode.Type;
  1505. (*pc: LONGINT;*)
  1506. BEGIN
  1507. register := RegisterFromIrOperand(irOperand, part, emptyOperand);
  1508. IF ~IsRegisterForType(register.register, IntermediateCode.FloatType(32)) THEN
  1509. Emit2(opSTR, register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Decrement, InstructionSet.PreIndexed}));
  1510. ELSE
  1511. partType := PartType(irOperand.type, part);
  1512. AllocateStack(MAX(4, partType.sizeInBits DIV 8), TRUE,FALSE);
  1513. Store(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}), PartType(irOperand.type, part));
  1514. END;
  1515. (*
  1516. (* optimization for push chains (THIS DOES NOT WORK IF inEmulation) *)
  1517. IF pushChainLength = 0 THEN
  1518. pc := inPC;
  1519. (* search for consecutive push instructions *)
  1520. WHILE (pc < in.pc) & (in.instructions[pc].opcode = IntermediateCode.push) DO
  1521. ASSERT(in.instructions[pc].op1.mode # IntermediateCode.Undefined);
  1522. INC(pushChainLength, MAX(4, in.instructions[pc].op1.type.sizeInBits DIV 8));
  1523. INC(pc)
  1524. END;
  1525. AllocateStack(pushChainLength, TRUE)
  1526. END;
  1527. DEC(pushChainLength, 4); (* for 64 bit operands, this procedure is executed twice -> the push chain will be decremented by 8 bytes *)
  1528. register := RegisterFromIrOperand(irOperand, part, emptyOperand);
  1529. ASSERT(pushChainLength < InstructionSet.Bits12, 100);
  1530. ASSERT((pushChainLength MOD 4) = 0);
  1531. Store(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, pushChainLength, {InstructionSet.Increment}), PartType(irOperand.type, part))
  1532. *)
  1533. END EmitPush;
  1534. PROCEDURE EmitPop(VAR irOperand: IntermediateCode.Operand; part: LONGINT);
  1535. VAR
  1536. register: Operand; partType: IntermediateCode.Type;
  1537. BEGIN
  1538. register := AcquireDestinationRegister(irOperand, part, emptyOperand);
  1539. IF ~IsRegisterForType(register.register, IntermediateCode.FloatType(32)) THEN
  1540. (*Emit2(opLDR, register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}));*)
  1541. Load(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}), PartType(irOperand.type, part));
  1542. ELSE
  1543. Load(register, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 0, {InstructionSet.Increment}), PartType(irOperand.type, part));
  1544. partType := PartType(irOperand.type, part);
  1545. AllocateStack(-MAX(4, partType.sizeInBits DIV 8), TRUE,FALSE);
  1546. END;
  1547. WriteBack(irOperand, part, register)
  1548. END EmitPop;
  1549. PROCEDURE Resolve(VAR op: IntermediateCode.Operand);
  1550. BEGIN
  1551. IF (op.symbol.name # "") & (op.resolved = NIL) THEN op.resolved := module.allSections.FindByName(op.symbol.name) END
  1552. END Resolve;
  1553. (* call <address>, <parSize> *)
  1554. PROCEDURE EmitCall(VAR irInstruction: IntermediateCode.Instruction);
  1555. VAR
  1556. code: BinaryCode.Section;
  1557. fixup, newFixup: BinaryCode.Fixup;
  1558. BEGIN
  1559. Resolve(irInstruction.op1);
  1560. IF (irInstruction.op1.resolved # NIL) & (irInstruction.op1.resolved.type = Sections.InlineCodeSection) THEN
  1561. (* call of an inline procedure: *)
  1562. code := irInstruction.op1.resolved(IntermediateCode.Section).resolved;
  1563. ASSERT(code # NIL); (* TODO: what if section is not yet resolved, i.e., code has not yet been generated? *)
  1564. IF (out.comments # NIL) THEN
  1565. out.comments.String("inlined code sequence:");
  1566. out.comments.Ln;
  1567. out.comments.Update;
  1568. END;
  1569. (* emit the generated code of the other section *)
  1570. out.CopyBits(code.os.bits, 0, code.os.bits.GetSize());
  1571. (* transfer the fixups *)
  1572. fixup := code.fixupList.firstFixup;
  1573. WHILE fixup # NIL DO
  1574. newFixup := BinaryCode.NewFixup(fixup.mode, fixup.offset + code.pc, fixup.symbol, fixup.symbolOffset, fixup.displacement, fixup.scale, fixup.pattern);
  1575. out.fixupList.AddFixup(newFixup);
  1576. fixup := fixup.nextFixup
  1577. END
  1578. ELSE
  1579. (* store the address of the procedure in a register and branch and link there *)
  1580. Emit1(opBLX, RegisterFromIrOperand(irInstruction.op1, Low, emptyOperand));
  1581. (* remove parameters on stack *)
  1582. AllocateStack(-LONGINT(irInstruction.op2.intValue), TRUE, FALSE)
  1583. END
  1584. END EmitCall;
  1585. (* enter <callingConvention>, <pafSize>, <numRegParams> *)
  1586. PROCEDURE EmitEnter(CONST irInstruction: IntermediateCode.Instruction);
  1587. VAR allocationSize: LONGINT;
  1588. BEGIN
  1589. (* store registers for interrupts, if required *)
  1590. IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN (* TODO: needed? *)
  1591. (* push R0-R11, FP and LR *)
  1592. Emit2WithFlags(opSTM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR, 0..11}), {InstructionSet.flagDB, InstructionSet.flagBaseRegisterUpdate});
  1593. Emit2(opMOV, opFP, opSP);
  1594. END;
  1595. stackSize := 0;
  1596. (* allocate space on stack for local variables *)
  1597. allocationSize := LONGINT(irInstruction.op2.intValue);
  1598. Basic.Align(allocationSize, 4); (* 4 byte alignment *)
  1599. AllocateStack(allocationSize, TRUE, backend.initLocals);
  1600. (* allocate space on stack for register spills *)
  1601. spillStackStart := -stackSize;
  1602. IF spillStack.MaxSize() > 0 THEN AllocateStack(spillStack.MaxSize(), TRUE, FALSE) END
  1603. END EmitEnter;
  1604. (* leave <callingConvention> *)
  1605. PROCEDURE EmitLeave(CONST irInstruction: IntermediateCode.Instruction);
  1606. BEGIN
  1607. (* LDMFD (Full Descending) aka LDMIA (Increment After) *)
  1608. IF (irInstruction.op1.intValue = SyntaxTree.InterruptCallingConvention) THEN
  1609. (* pop R0-R11, FP and LR *)
  1610. Emit2(opMOV, opSP, opFP);
  1611. Emit2WithFlags(opLDM, opSP, InstructionSet.NewRegisterList(0, {InstructionSet.FP, InstructionSet.LR, 0..11}), {InstructionSet.flagIA, InstructionSet.flagBaseRegisterUpdate})
  1612. END
  1613. END EmitLeave;
  1614. (* exit <parSize>, <pcOffset> *)
  1615. PROCEDURE EmitExit(CONST irInstruction: IntermediateCode.Instruction);
  1616. BEGIN
  1617. Emit2(opLDR, opLR, InstructionSet.NewImmediateOffsetMemory(InstructionSet.SP, 4, {InstructionSet.Increment, InstructionSet.PostIndexed}));
  1618. IF (irInstruction.op1.intValue = 0) & (irInstruction.op2.intValue # SyntaxTree.InterruptCallingConvention) THEN
  1619. (* Emit2(opMOV, opPC, opLR) *)
  1620. Emit1(opBX, opLR) (* recommended for better interoperability between ARM and Thumb *)
  1621. ELSE
  1622. IF (irInstruction.op2.intValue = SyntaxTree.InterruptCallingConvention) THEN
  1623. Emit3WithFlags(opSUB, opPC, opLR, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue)),{InstructionSet.flagS})
  1624. ELSE
  1625. (* exit from an ARM interrupt procedure that has a PC offset *)
  1626. Emit3(opSUB, opPC, opLR, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue)))
  1627. END;
  1628. END
  1629. END EmitExit;
  1630. PROCEDURE EmitMov(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1631. VAR
  1632. destinationRegister, sourceOperand: Operand;
  1633. BEGIN
  1634. IF irInstruction.op1.mode # IntermediateCode.ModeRegister THEN
  1635. (* optimization: mov [?], r? it is more optimal to determine the source operand first *)
  1636. sourceOperand := RegisterOrImmediateFromIrOperand(irInstruction.op2, part, emptyOperand);
  1637. destinationRegister := GetFreeRegisterOrHint(PartType(irInstruction.op2.type, part), sourceOperand) (* note that the source operand (possibly a register) is used as hint *)
  1638. ELSE
  1639. PrepareSingleSourceOpWithImmediate(irInstruction, part, destinationRegister, sourceOperand);
  1640. END;
  1641. MovIfDifferent(destinationRegister, sourceOperand);
  1642. WriteBack(irInstruction.op1, part, destinationRegister)
  1643. END EmitMov;
  1644. (* BITWISE LOGICAL OPERATIONS *)
  1645. PROCEDURE EmitNot(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1646. VAR
  1647. destination, source: Operand;
  1648. BEGIN
  1649. PrepareSingleSourceOpWithImmediate(irInstruction, part, destination, source);
  1650. Emit2(opMVN, destination, source); (* invert bits *)
  1651. WriteBack(irInstruction.op1, part, destination)
  1652. END EmitNot;
  1653. PROCEDURE EmitAnd(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1654. VAR
  1655. dummy: BOOLEAN;
  1656. destination, left, right: Operand;
  1657. BEGIN
  1658. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1659. Emit3(opAND, destination, left, right);
  1660. WriteBack(irInstruction.op1, part, destination)
  1661. END EmitAnd;
  1662. PROCEDURE EmitOr(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1663. VAR
  1664. dummy: BOOLEAN;
  1665. destination, left, right: Operand;
  1666. BEGIN
  1667. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1668. Emit3(opORR, destination, left, right);
  1669. WriteBack(irInstruction.op1, part, destination)
  1670. END EmitOr;
  1671. PROCEDURE EmitXor(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  1672. VAR
  1673. dummy: BOOLEAN;
  1674. destination, left, right: Operand;
  1675. BEGIN
  1676. PrepareDoubleSourceOpWithImmediate(irInstruction, part, destination, left, right, dummy);
  1677. Emit3(opEOR, destination, left, right);
  1678. WriteBack(irInstruction.op1, part, destination)
  1679. END EmitXor;
  1680. (* ARITHMETIC OPERATIONS *)
  1681. (*
  1682. - TODO: double precision floats
  1683. - note that for operand sizes 8 and 16, the unused bits of the result might be in a unpredictable state (sign/zero-extension is not done on purpose)
  1684. *)
  1685. PROCEDURE EmitAddOrSub(VAR irInstruction: IntermediateCode.Instruction);
  1686. VAR
  1687. destination, left, right: Operand;
  1688. (* registerSR0, registerSR1, registerSR2: Operand; *)
  1689. BEGIN
  1690. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1691. ASSERT(backend.useFPU);
  1692. PrepareDoubleSourceOp(irInstruction, Low, destination, left, right);
  1693. IF irInstruction.opcode = IntermediateCode.add THEN
  1694. Emit3(opFADDS, destination, left, right)
  1695. ELSE
  1696. Emit3(opFSUBS, destination, left, right)
  1697. END;
  1698. WriteBack(irInstruction.op1, Low, destination)
  1699. ELSIF IsInteger(irInstruction.op1) THEN
  1700. IF IsComplex(irInstruction.op1) THEN
  1701. EmitPartialAddOrSub(irInstruction, Low, TRUE);
  1702. EmitPartialAddOrSub(irInstruction, High, FALSE)
  1703. ELSE
  1704. EmitPartialAddOrSub(irInstruction, Low, FALSE)
  1705. END
  1706. ELSE
  1707. HALT(200)
  1708. END
  1709. END EmitAddOrSub;
  1710. PROCEDURE EmitPartialAddOrSub(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; doUpdateFlags: BOOLEAN);
  1711. VAR
  1712. destination, left, right, hint: Operand;
  1713. irDestination, irLeft, irRight: IntermediateCode.Operand;
  1714. operation: LONGINT;
  1715. doSwap, doNegateRight: BOOLEAN;
  1716. BEGIN
  1717. irDestination := irInstruction.op1; irLeft := irInstruction.op2; irRight := irInstruction.op3;
  1718. doSwap := FALSE; doNegateRight := FALSE; (* defaults *)
  1719. IF irInstruction.opcode = IntermediateCode.add THEN
  1720. IF IrOperandIsDirectlyEncodable(irRight, part) THEN
  1721. (* add r0, r1, 16 ~> ADD R0, R1, #16 *)
  1722. operation := opADD
  1723. ELSIF IrOperandIsDirectlyEncodable(irLeft, part) THEN
  1724. (* add r0, 16, r1 ~> ADD R0, R1, #16 *)
  1725. operation := opADD; doSwap := TRUE
  1726. ELSIF NegatedIrOperandIsDirectlyEncodable(irRight, part) THEN
  1727. (* add r0, r1, -16 ~> SUB R0, R1, #16 *)
  1728. operation := opSUB; doNegateRight := TRUE
  1729. ELSIF NegatedIrOperandIsDirectlyEncodable(irLeft, part) THEN
  1730. (* add r0, -16, r1 ~> SUB R0, R1, #16 *)
  1731. operation := opSUB; doSwap := TRUE; doNegateRight := TRUE
  1732. ELSE
  1733. operation := opADD
  1734. END
  1735. ELSIF irInstruction.opcode = IntermediateCode.sub THEN
  1736. IF IrOperandIsDirectlyEncodable(irRight, part) THEN
  1737. (* sub r0, r1, 16 ~> SUB R0, R1, #16 *)
  1738. operation := opSUB
  1739. ELSIF IrOperandIsDirectlyEncodable(irLeft, part) THEN
  1740. (* sub r0, 16, r1 ~> RSB R0, R1, #16 *)
  1741. operation := opRSB; doSwap := TRUE
  1742. ELSIF NegatedIrOperandIsDirectlyEncodable(irRight, part) THEN
  1743. (* sub r0, r1, -16 ~> ADD R0, R1, #16 *)
  1744. operation := opADD; doNegateRight := TRUE
  1745. ELSE
  1746. operation := opSUB
  1747. END
  1748. ELSE
  1749. HALT(100)
  1750. END;
  1751. (* get destination operand *)
  1752. destination := AcquireDestinationRegister(irDestination, part, emptyOperand);
  1753. (* get source operands *)
  1754. IF doSwap THEN SwapIrOperands(irLeft, irRight) END; (* if needed, swap operands *)
  1755. (* TODO: revise this! *)
  1756. IF IsSameRegister(right, destination) THEN hint := destination ELSE hint := emptyOperand END;
  1757. left := RegisterFromIrOperand(irLeft, part, hint);
  1758. IF doNegateRight THEN
  1759. ASSERT(NegatedIrOperandIsDirectlyEncodable(irRight, part));
  1760. right := InstructionSet.NewImmediate(-ValueOfPart(irRight.intValue, part))
  1761. ELSE
  1762. right := RegisterOrImmediateFromIrOperand(irRight, part, emptyOperand)
  1763. END;
  1764. (* if needed, use operation that incorporates carry *)
  1765. IF part # Low THEN
  1766. CASE operation OF
  1767. | opADD: operation := opADC
  1768. | opSUB: operation := opSBC
  1769. | opRSB: operation := opRSC
  1770. ELSE HALT(100)
  1771. END
  1772. END;
  1773. IF doUpdateFlags THEN
  1774. Emit3WithFlags(operation, destination, left, right, {InstructionSet.flagS})
  1775. ELSE
  1776. Emit3(operation, destination, left, right)
  1777. END;
  1778. WriteBack(irDestination, part, destination)
  1779. END EmitPartialAddOrSub;
  1780. PROCEDURE EmitMul(VAR irInstruction: IntermediateCode.Instruction);
  1781. VAR
  1782. destination, left, right: ARRAY 2 OF Operand;
  1783. BEGIN
  1784. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1785. ASSERT(backend.useFPU);
  1786. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1787. Emit3(opFMULS, destination[Low], left[Low], right[Low]);
  1788. WriteBack(irInstruction.op1, Low, destination[Low])
  1789. ELSIF IsInteger(irInstruction.op1) THEN
  1790. IF IsComplex(irInstruction.op1) THEN
  1791. ASSERT(irInstruction.op1.type.form = IntermediateCode.SignedInteger);
  1792. HALT(200);
  1793. (* TODO: fix signed 64 bit integer multiplication:
  1794. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1795. PrepareDoubleSourceOp(irInstruction, High, destination[High], left[High], right[High]);
  1796. Emit4(opSMULL, destination[Low], destination[High], left[Low], right[Low]); (* signed long multiplication *)
  1797. Emit3(opMLA, destination[High], left[Low], right[High]); (* multiply and accumulate *)
  1798. Emit3(opMLA, destination[High], left[High], right[Low]);
  1799. WriteBack(irInstruction.op1, Low, destination[Low]);
  1800. WriteBack(irInstruction.op1, High, destination[High]);
  1801. *)
  1802. ELSE
  1803. (* signed or unsigned integer multiplication: *)
  1804. PrepareDoubleSourceOp(irInstruction, Low, destination[Low], left[Low], right[Low]);
  1805. SignOrZeroExtendOperand(left[Low], irInstruction.op2.type);
  1806. SignOrZeroExtendOperand(right[Low], irInstruction.op3.type);
  1807. Emit3(opMUL, destination[Low], left[Low], right[Low]); (* note that the sign does not matter for the least 32 significant bits *)
  1808. WriteBack(irInstruction.op1, Low, destination[Low])
  1809. END
  1810. ELSE
  1811. HALT(200)
  1812. END
  1813. END EmitMul;
  1814. PROCEDURE EmitDiv(VAR irInstruction: IntermediateCode.Instruction);
  1815. VAR
  1816. destination, left, right: Operand;
  1817. BEGIN
  1818. IF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1819. ASSERT(backend.useFPU);
  1820. PrepareDoubleSourceOp(irInstruction, Low, destination, left, right);
  1821. Emit3(opFDIVS, destination, left, right);
  1822. WriteBack(irInstruction.op1, Low, destination)
  1823. ELSE
  1824. HALT(200)
  1825. END
  1826. END EmitDiv;
  1827. PROCEDURE EmitMod(CONST irInstruction: IntermediateCode.Instruction);
  1828. BEGIN HALT(100) (* handled by a runtime call *)
  1829. END EmitMod;
  1830. PROCEDURE EmitAbs(VAR irInstruction: IntermediateCode.Instruction);
  1831. VAR
  1832. destination, source: ARRAY 2 OF Operand;
  1833. zero: Operand;
  1834. BEGIN
  1835. IF IsInteger(irInstruction.op1) THEN
  1836. zero := InstructionSet.NewImmediate(0);
  1837. IF IsComplex(irInstruction.op1) THEN
  1838. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1839. PrepareSingleSourceOpWithImmediate(irInstruction, High, destination[High], source[High]);
  1840. MovIfDifferent(destination[Low], source[Low]);
  1841. MovIfDifferent(destination[High], source[High]);
  1842. (* negate the value if it is negative *)
  1843. IF irInstruction.op2.type.form = IntermediateCode.SignedInteger THEN
  1844. Emit2(opCMP, destination[High], zero); (* note that only the high part has to be looked at to determine the sign *)
  1845. Emit1WithCondition(opB, InstructionSet.NewImmediate(4), InstructionSet.conditionGE); (* BGE #4 = skip the following two instructions if greater or equal *)
  1846. Emit3WithFlags(opRSB, destination[Low], destination[Low], zero, {InstructionSet.flagS}); (* RSBS *)
  1847. Emit3(opRSC, destination[High], destination[High], zero); (* RSC - reverse subtraction with carry *)
  1848. END;
  1849. WriteBack(irInstruction.op1, Low, destination[Low]);
  1850. WriteBack(irInstruction.op1, High, destination[High])
  1851. ELSE
  1852. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1853. SignOrZeroExtendOperand(source[Low], irInstruction.op2.type);
  1854. MovIfDifferent(destination[Low], source[Low]);
  1855. (* negate the value if it is negative *)
  1856. IF irInstruction.op2.type.form = IntermediateCode.SignedInteger THEN
  1857. SignExtendOperand(destination[Low], irInstruction.op2.type.sizeInBits);
  1858. Emit2(opCMP, destination[Low], zero);
  1859. Emit3WithCondition(opRSB, destination[Low], destination[Low], zero, InstructionSet.conditionLT)
  1860. END;
  1861. WriteBack(irInstruction.op1, Low, destination[Low])
  1862. END
  1863. ELSIF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1864. ASSERT(backend.useFPU);
  1865. PrepareSingleSourceOp(irInstruction, Low, destination[Low], source[Low]);
  1866. Emit2(opFABSS, destination[Low], source[Low]);
  1867. WriteBack(irInstruction.op1, Low, destination[Low])
  1868. ELSE
  1869. HALT(200)
  1870. END
  1871. END EmitAbs;
  1872. (* TODO: floats *)
  1873. PROCEDURE EmitNeg(VAR irInstruction: IntermediateCode.Instruction);
  1874. VAR
  1875. destination, source: ARRAY 2 OF Operand;
  1876. zero: Operand;
  1877. BEGIN
  1878. IF IsInteger(irInstruction.op1) THEN
  1879. zero := InstructionSet.NewImmediate(0);
  1880. IF IsComplex(irInstruction.op1) THEN
  1881. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1882. PrepareSingleSourceOpWithImmediate(irInstruction, High, destination[High], source[High]);
  1883. Emit3WithFlags(opRSB, destination[Low], source[Low], zero, {InstructionSet.flagS}); (* RSBS *)
  1884. Emit3(opRSC, destination[High], source[High], zero); (* RSC - reverse subtraction with carry *)
  1885. WriteBack(irInstruction.op1, Low, destination[Low]);
  1886. WriteBack(irInstruction.op1, High, destination[High])
  1887. ELSE
  1888. PrepareSingleSourceOpWithImmediate(irInstruction, Low, destination[Low], source[Low]);
  1889. SignOrZeroExtendOperand(source[Low], irInstruction.op2.type);
  1890. Emit3(opRSB, destination[Low], source[Low], zero); (* reverse subtraction with zero *)
  1891. WriteBack(irInstruction.op1, Low, destination[Low])
  1892. END
  1893. ELSIF IsSinglePrecisionFloat(irInstruction.op1) THEN
  1894. ASSERT(backend.useFPU);
  1895. PrepareSingleSourceOp(irInstruction, Low, destination[Low], source[Low]);
  1896. Emit2(opFNEGS, destination[Low], source[Low]);
  1897. WriteBack(irInstruction.op1, Low, destination[Low])
  1898. ELSE
  1899. HALT(200)
  1900. END
  1901. END EmitNeg;
  1902. (*
  1903. - note that the ARM instructions ASR, LSL, LSR, ROR, etc. are actually aliases for a MOV with a shifted register operand
  1904. - note that ARM does not support LSL by 32 bits
  1905. - note that for operand sizes 8 and 16, the unused bits of the result might be in a unpredictable state (sign/zero-extension is not done on purpose)
  1906. *)
  1907. PROCEDURE EmitShiftOrRotation(VAR irInstruction: IntermediateCode.Instruction);
  1908. VAR
  1909. shiftAmountImmediate, shiftMode: LONGINT;
  1910. destination, source: ARRAY 2 OF Operand;
  1911. irShiftOperand: IntermediateCode.Operand;
  1912. temp, shiftAmountRegister: Operand;
  1913. BEGIN
  1914. ASSERT(IsInteger(irInstruction.op1), 100); (* shifts are only allowed on integers *)
  1915. destination[Low] := AcquireDestinationRegister(irInstruction.op1, Low, emptyOperand);
  1916. source[Low] := RegisterFromIrOperand(irInstruction.op2, Low, emptyOperand); (* note that the destination register cannot be used as hint for the source *)
  1917. IF IsComplex(irInstruction.op1) THEN
  1918. destination[High] := AcquireDestinationRegister(irInstruction.op1, High, emptyOperand);
  1919. source[High] := RegisterFromIrOperand(irInstruction.op2, High, emptyOperand); (* note that the destination register cannot be used as hint for the source *)
  1920. END;
  1921. irShiftOperand := irInstruction.op3;
  1922. ASSERT((irShiftOperand.type.form = IntermediateCode.UnsignedInteger) & ~IsComplex(irShiftOperand)); (* the shift operand is assumed to be a single part unsigned integer *)
  1923. (* use ARM register or shift immediate to represent IR shift operand *)
  1924. IF (irShiftOperand.mode = IntermediateCode.ModeImmediate) & (irShiftOperand.symbol.name = "") THEN
  1925. shiftAmountImmediate := LONGINT(irShiftOperand.intValue); (* note that at this point the shift amount could also be >= 32 *)
  1926. shiftAmountRegister := emptyOperand;
  1927. ASSERT(shiftAmountImmediate >= 0);
  1928. ELSE
  1929. shiftAmountImmediate := 0;
  1930. shiftAmountRegister := RegisterFromIrOperand(irShiftOperand, Low, emptyOperand);
  1931. ZeroExtendOperand(shiftAmountRegister, irShiftOperand.type.sizeInBits)
  1932. END;
  1933. CASE irInstruction.opcode OF
  1934. | IntermediateCode.ror, IntermediateCode.rol:
  1935. (* rotation: *)
  1936. IF IsComplex(irInstruction.op1) THEN HALT(100) END; (* complex rotations are handled as runtime calls *)
  1937. IF irInstruction.opcode = IntermediateCode.rol THEN
  1938. (* simple left rotation: rotate right with complementary rotation amount, since ARM does not support left rotations *)
  1939. IF shiftAmountRegister.register = None THEN
  1940. shiftAmountImmediate := 32 - shiftAmountImmediate
  1941. ELSE
  1942. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1943. Emit3(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32));
  1944. shiftAmountRegister := temp
  1945. END
  1946. END;
  1947. shiftAmountImmediate := shiftAmountImmediate MOD 32; (* make sure rotation amount is in range 0..31 *)
  1948. IF (shiftAmountRegister.register = None) & (shiftAmountImmediate = 0) THEN
  1949. (* simple rotation by 0: *)
  1950. Emit2(opMOV, destination[Low], source[Low])
  1951. ELSE
  1952. IF irInstruction.op1.type.sizeInBits = 8 THEN
  1953. (* simple 8 bit rotation: *)
  1954. ZeroExtendOperand(source[Low], 8);
  1955. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1956. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate));
  1957. Emit3(opORR, temp, temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 8));
  1958. Emit3(opORR, temp, temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 16));
  1959. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 24))
  1960. ELSIF irInstruction.op1.type.sizeInBits = 16 THEN
  1961. (* simple 16 bit rotation: *)
  1962. ZeroExtendOperand(source[Low], 16);
  1963. IF IsSameRegister(destination[Low], source[Low]) THEN temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) ELSE temp := destination[Low] END;
  1964. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate));
  1965. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(temp.register, InstructionSet.shiftLSR, None, 16))
  1966. ELSIF irInstruction.op1.type.sizeInBits = 32 THEN
  1967. (* simple 32 bit rotation: *)
  1968. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftROR, shiftAmountRegister.register, shiftAmountImmediate))
  1969. ELSE
  1970. HALT(100)
  1971. END
  1972. END
  1973. | IntermediateCode.shl:
  1974. (* left shift: *)
  1975. IF IsComplex(irInstruction.op1) THEN
  1976. (* complex left shift: *)
  1977. IF shiftAmountRegister.register = None THEN
  1978. (* complex left immediate shift: *)
  1979. IF shiftAmountImmediate = 0 THEN
  1980. Emit2(opMOV, destination[High], source[High]);
  1981. Emit2(opMOV, destination[Low], source[Low])
  1982. ELSIF (shiftAmountImmediate > 0) & (shiftAmountImmediate < 32) THEN
  1983. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  1984. Emit2(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, None, 32 - shiftAmountImmediate));
  1985. Emit3(opORR, destination[High], temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, None, shiftAmountImmediate));
  1986. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate))
  1987. ELSIF (shiftAmountImmediate >= 32) & (shiftAmountImmediate < 64) THEN
  1988. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate - 32));
  1989. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  1990. ELSIF shiftAmountImmediate >= 64 THEN
  1991. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  1992. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  1993. ELSE
  1994. HALT(100)
  1995. END
  1996. ELSE
  1997. (* complex left register shift: *)
  1998. IF ~IsSameRegister(destination[Low], source[Low]) THEN temp := destination[Low] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  1999. Emit2(opCMP, shiftAmountRegister, InstructionSet.NewImmediate(32));
  2000. (* shiftAmount < 32: *)
  2001. Emit3WithCondition(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionLT);
  2002. Emit2WithCondition(opMOV, temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, temp.register, 0), InstructionSet.conditionLT);
  2003. Emit3WithCondition(opORR, destination[High], temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2004. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2005. (* shift amount >= 32: *)
  2006. Emit3WithCondition(opSUB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionGE);
  2007. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, temp.register, 0), InstructionSet.conditionGE);
  2008. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewImmediate(0), InstructionSet.conditionGE)
  2009. END
  2010. ELSE
  2011. (* simple left shift: *)
  2012. IF shiftAmountRegister.register = None THEN
  2013. (* simple left immediate shift *)
  2014. IF (shiftAmountImmediate >= 0) & (shiftAmountImmediate < 32) THEN
  2015. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, None, shiftAmountImmediate)) (* note: LSL has to be in the range 0..31 *)
  2016. ELSIF shiftAmountImmediate >= 32 THEN
  2017. Emit2(opMOV, destination[Low], InstructionSet.NewImmediate(0))
  2018. ELSE
  2019. HALT(100)
  2020. END
  2021. ELSE
  2022. (* simple left register shift: *)
  2023. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSL, shiftAmountRegister.register, 0))
  2024. END
  2025. END
  2026. | IntermediateCode.shr:
  2027. (* right shift: *)
  2028. (* determine shift mode (depends on if source operand is signed) *)
  2029. IF irInstruction.op1.type.form = IntermediateCode.UnsignedInteger THEN
  2030. (* logical right shift: *)
  2031. shiftMode := InstructionSet.shiftLSR
  2032. ELSE
  2033. (* arithmetic right shift: *)
  2034. shiftMode := InstructionSet.shiftASR
  2035. END;
  2036. IF IsComplex(irInstruction.op1) THEN
  2037. (* complex right shift: *)
  2038. IF shiftAmountRegister.register = None THEN
  2039. (* complex right immediate shift: *)
  2040. IF shiftAmountImmediate = 0 THEN
  2041. Emit2(opMOV, destination[High], source[High]);
  2042. Emit2(opMOV, destination[Low], source[Low])
  2043. ELSIF (shiftAmountImmediate > 0) & (shiftAmountImmediate < 32) THEN
  2044. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  2045. Emit2(opMOV, temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, None, 32 - shiftAmountImmediate));
  2046. Emit3(opORR, destination[Low], temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, None, shiftAmountImmediate));
  2047. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, None, shiftAmountImmediate))
  2048. ELSIF shiftAmountImmediate >= 32 THEN
  2049. IF shiftAmountImmediate > 64 THEN shiftAmountImmediate := 64 END;
  2050. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[High].register, shiftMode, None, shiftAmountImmediate - 32));
  2051. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, None, 32))
  2052. ELSE
  2053. HALT(100)
  2054. END
  2055. ELSE
  2056. (* complex right register shift: *)
  2057. IF ~IsSameRegister(destination[High], source[High]) THEN temp := destination[High] ELSE temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)) END;
  2058. Emit2(opCMP, shiftAmountRegister, InstructionSet.NewImmediate(32));
  2059. (* shiftAmount < 32: *)
  2060. Emit3WithCondition(opRSB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionLT);
  2061. Emit2WithCondition(opMOV, temp, InstructionSet.NewRegister(source[High].register, InstructionSet.shiftLSL, temp.register, 0), InstructionSet.conditionLT);
  2062. Emit3WithCondition(opORR, destination[Low], temp, InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftLSR, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2063. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, shiftAmountRegister.register, 0), InstructionSet.conditionLT);
  2064. (* shift amount >= 32: *)
  2065. Emit3WithCondition(opSUB, temp, shiftAmountRegister, InstructionSet.NewImmediate(32), InstructionSet.conditionGE);
  2066. Emit2WithCondition(opMOV, destination[Low], InstructionSet.NewRegister(source[High].register, shiftMode, temp.register, 0), InstructionSet.conditionGE);
  2067. Emit2WithCondition(opMOV, destination[High], InstructionSet.NewRegister(source[High].register, shiftMode, shiftAmountRegister.register, 0), InstructionSet.conditionGE)
  2068. END
  2069. ELSE
  2070. (* simple right shift: *)
  2071. SignOrZeroExtendOperand(source[Low], irInstruction.op1.type);
  2072. IF shiftAmountRegister.register = None THEN
  2073. (* simple right immediate shift: *)
  2074. IF shiftAmountImmediate > 32 THEN shiftAmountImmediate := 32 END;
  2075. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, shiftMode, None, shiftAmountImmediate))
  2076. ELSE
  2077. (* simple right register shift: *)
  2078. Emit2(opMOV, destination[Low], InstructionSet.NewRegister(source[Low].register, shiftMode, shiftAmountRegister.register, 0))
  2079. END
  2080. END
  2081. ELSE
  2082. HALT(100)
  2083. END;
  2084. WriteBack(irInstruction.op1, Low, destination[Low]);
  2085. IF IsComplex(irInstruction.op1) THEN WriteBack(irInstruction.op1, High, destination[High]) END
  2086. END EmitShiftOrRotation;
  2087. PROCEDURE EmitAsm(CONST irInstruction: IntermediateCode.Instruction);
  2088. VAR
  2089. reader: Streams.StringReader;
  2090. procedure: SyntaxTree.Procedure;
  2091. scope: SyntaxTree.Scope;
  2092. symbol: SyntaxTree.Symbol;
  2093. assembler: Assembler.Assembler;
  2094. scanner: Scanner.AssemblerScanner;
  2095. len: LONGINT;
  2096. BEGIN
  2097. len := Strings.Length(irInstruction.op1.string^);
  2098. NEW(reader, len);
  2099. reader.Set(irInstruction.op1.string^);
  2100. (* determine scope of the section *)
  2101. symbol := in.symbol;
  2102. IF symbol = NIL THEN
  2103. scope := NIL
  2104. ELSE
  2105. procedure := symbol(SyntaxTree.Procedure);
  2106. scope := procedure.procedureScope
  2107. END;
  2108. NEW(assembler, diagnostics);
  2109. scanner := Scanner.NewAssemblerScanner(module.moduleName(*module.module.sourceName*), reader, LONGINT(irInstruction.op1.intValue) (* ? *), diagnostics);
  2110. assembler.InlineAssemble(scanner, in, scope, module);
  2111. error := error OR assembler.error
  2112. END EmitAsm;
  2113. PROCEDURE EmitSpecial(VAR instruction: IntermediateCode.Instruction);
  2114. VAR
  2115. psrNumber, code, a, b, c, d: LONGINT;
  2116. register, register2, register3, register4, temp, cpOperand, cpRegister1, cpRegister2, opCode1Operand, opCode2Operand: Operand;
  2117. BEGIN
  2118. CASE instruction.subtype OF
  2119. | GetSP: Emit2(opMOV, opRES, opSP)
  2120. | SetSP: Emit2(opMOV, opSP, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2121. | GetFP: Emit2(opMOV, opRES, opFP)
  2122. | SetFP: Emit2(opMOV, opFP, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2123. | GetLNK: Emit2(opMOV, opRES, opLR)
  2124. | SetLNK: Emit2(opMOV, opLR, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2125. | GetPC: Emit2(opMOV, opRES, opPC)
  2126. | SetPC: Emit2(opMOV, opPC, RegisterOrImmediateFromIrOperand(instruction.op1, Low, emptyOperand))
  2127. | LDPSR, STPSR:
  2128. ASSERT(instruction.op1.type.form IN IntermediateCode.Integer);
  2129. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2130. Error(instruction.textPosition,"first operand must be immediate")
  2131. ELSIF (instruction.op1.intValue < 0) OR (instruction.op1.intValue > 1) THEN
  2132. Error(instruction.textPosition,"first operand must be 0 or 1")
  2133. ELSE
  2134. IF instruction.op1.intValue = 0 THEN
  2135. psrNumber := InstructionSet.CPSR
  2136. ELSE
  2137. psrNumber := InstructionSet.SPSR
  2138. END;
  2139. register := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2140. IF instruction.subtype = LDPSR THEN
  2141. Emit2(opMSR, InstructionSet.NewRegisterWithFields(psrNumber, {InstructionSet.fieldF, InstructionSet.fieldC}), register)
  2142. ELSE
  2143. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2144. Emit2(opMRS, temp, InstructionSet.NewRegister(psrNumber, None, None, 0));
  2145. Emit2(opSTR, temp, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment}))
  2146. END
  2147. END
  2148. | LDCPR, STCPR:
  2149. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2150. Error(instruction.textPosition,"first operand must be immediate")
  2151. ELSIF (instruction.op2.mode # IntermediateCode.ModeImmediate) THEN
  2152. Error(instruction.textPosition,"second operand must be immediate")
  2153. ELSIF (instruction.op2.intValue < 0) OR (instruction.op2.intValue > 15) THEN
  2154. Error(instruction.textPosition,"second operand must be between 0 or 15")
  2155. ELSE
  2156. code := LONGINT(instruction.op1.intValue); (* code = a00bcdH *)
  2157. a := (code DIV 100000H) MOD 10H; (* opcode1 * 2 *)
  2158. b := (code DIV 100H) MOD 10H; (* coprocessor number *)
  2159. c := (code DIV 10H) MOD 10H; (* opcode2 * 2 *)
  2160. d := code MOD 10H; (* coprocessor register2 number *)
  2161. InstructionSet.InitCoprocessor(cpOperand, InstructionSet.CP0 + b);
  2162. InstructionSet.InitOpcode(opCode1Operand, a DIV 2);
  2163. register := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2164. InstructionSet.InitRegister(cpRegister1, InstructionSet.CR0 + LONGINT(instruction.op2.intValue), None, None, 0);
  2165. InstructionSet.InitRegister(cpRegister2, InstructionSet.CR0 + d, None, None, 0);
  2166. InstructionSet.InitOpcode(opCode2Operand, c DIV 2);
  2167. IF instruction.subtype = LDCPR THEN
  2168. Emit6(opMCR, cpOperand, opCode1Operand, register, cpRegister1, cpRegister2, opCode2Operand)
  2169. ELSE
  2170. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2171. Emit6(opMRC, cpOperand, opCode1Operand, temp, cpRegister1, cpRegister2, opCode2Operand);
  2172. Emit2(opSTR, temp, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment}))
  2173. END
  2174. END
  2175. | FLUSH:
  2176. IF instruction.op1.mode # IntermediateCode.ModeImmediate THEN
  2177. Error(instruction.textPosition,"first operand must be immediate")
  2178. ELSIF (instruction.op1.intValue < 0) OR (instruction.op2.intValue > 0FFH) THEN
  2179. Error(instruction.textPosition,"first operand must be between 0 and 255")
  2180. ELSE
  2181. code := LONGINT(instruction.op1.intValue); (* code = aaa1bbbbB *)
  2182. a := (code DIV 20H) MOD 8; (* coprocessor opcode 2 *)
  2183. b := (code MOD 10H); (* coprocessor register2 number *)
  2184. (* examples:
  2185. 9AH = 10011000B -> MCR p15, 0, R0, c7, c10, 4
  2186. 17H = 00010111B -> MCR p15, 0, R0, c7, c7, 0
  2187. *)
  2188. InstructionSet.InitCoprocessor(cpOperand, InstructionSet.CP15);
  2189. InstructionSet.InitOpcode(opCode1Operand, 0);
  2190. InstructionSet.InitRegister(register, InstructionSet.R0, None, None, 0);
  2191. InstructionSet.InitRegister(cpRegister1, InstructionSet.CR7, None, None, 0);
  2192. InstructionSet.InitRegister(cpRegister2, InstructionSet.CR0 + b, None, None, 0);
  2193. InstructionSet.InitOpcode(opCode2Operand, a);
  2194. Emit6(opMCR, cpOperand, opCode1Operand, register, cpRegister1, cpRegister2, opCode2Operand);
  2195. Emit2(opMOV, register, register); (* NOP (register = R0) *)
  2196. Emit2(opMOV, register, register); (* NOP *)
  2197. Emit2(opMOV, register, register); (* NOP *)
  2198. Emit2(opMOV, register, register) (* NOP *)
  2199. END
  2200. | NULL:
  2201. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2202. Emit3(opBIC, register, register, InstructionSet.NewImmediate(LONGINT(80000000H)));
  2203. Emit2(opCMP, register, InstructionSet.NewImmediate(0));
  2204. Emit2WithCondition(opMOV, opRES, InstructionSet.NewImmediate(1), InstructionSet.conditionEQ);
  2205. Emit2WithCondition(opMOV, opRES, InstructionSet.NewImmediate(0), InstructionSet.conditionNE);
  2206. | XOR:
  2207. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2208. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2209. (*
  2210. register3 := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2211. *)
  2212. Emit3(opEOR, opRES, register, register2);
  2213. | MULD:
  2214. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* note that 'register' contains an address *)
  2215. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2216. register3 := RegisterFromIrOperand(instruction.op3, Low, emptyOperand);
  2217. Emit4(opUMULL, opRES, opRESHI, register2, register3);
  2218. Emit2(opSTR, opRES, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* JCH: 15.05.2012 *)
  2219. Emit2(opSTR, opRESHI, InstructionSet.NewImmediateOffsetMemory(register.register, 4, {InstructionSet.Increment}))
  2220. | ADDC:
  2221. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand);
  2222. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand);
  2223. Emit3(opADC, opRES, register, register2)
  2224. | PACK:
  2225. (* PACK(x, y):
  2226. add y to the binary exponent of y. PACK(x, y) is equivalent to x := x * 2^y. *)
  2227. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* register = address of x *)
  2228. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand); (* register2 = value of y *)
  2229. register3 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)); (* a temporary INTEGER (!) register that is used to store a float *)
  2230. Emit2(opLDR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* register3 = value of x *)
  2231. Emit3(opADD, register3, register3, InstructionSet.NewRegister(register2.register, InstructionSet.shiftLSL, None, 23)); (* increase the (biased) exponent of x by y*)
  2232. Emit2(opSTR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})) (* store new value of x *)
  2233. | UNPK:
  2234. (* UNPK(x, y):
  2235. remove the binary exponent on x and put it into y. UNPK is the reverse operation of PACK. The resulting x is normalized, i.e. 1.0 <= x < 2.0.
  2236. *)
  2237. register := RegisterFromIrOperand(instruction.op1, Low, emptyOperand); (* register = address of x *)
  2238. register2 := RegisterFromIrOperand(instruction.op2, Low, emptyOperand); (* register2 = address of y *)
  2239. register3 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32)); (* a temporary INTEGER (!) register that is used to store a float *)
  2240. Emit2(opLDR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})); (* register3 = value of x *)
  2241. register4 := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2242. Emit2(opMOV, register4, InstructionSet.NewRegister(register3.register, InstructionSet.shiftLSR, None, 23)); (* register4 = biased exponent (and sign) of x *)
  2243. Emit3(opSUB, register4, register4, InstructionSet.NewImmediate(127)); (* register4 = exponent of x (biased exponent - 127) *)
  2244. Emit2(opSTR, register4, InstructionSet.NewImmediateOffsetMemory(register2.register, 0, {InstructionSet.Increment})); (* store exponent of x as value for y *)
  2245. Emit3(opSUB, register3, register3, InstructionSet.NewRegister(register4.register, InstructionSet.shiftLSL, None, 23)); (* reduce the biased exponent of x by the value of y *)
  2246. Emit2(opSTR, register3, InstructionSet.NewImmediateOffsetMemory(register.register, 0, {InstructionSet.Increment})) (* store new value of x *)
  2247. ELSE
  2248. HALT(100)
  2249. END
  2250. END EmitSpecial;
  2251. PROCEDURE EmitBr(VAR irInstruction: IntermediateCode.Instruction);
  2252. VAR
  2253. branchDistance: LONGINT;
  2254. isSwapped: BOOLEAN;
  2255. left, right: ARRAY 2 OF Operand;
  2256. temp: Operand;
  2257. irLeft, irRight: IntermediateCode.Operand;
  2258. fixup,failFixup: BinaryCode.Fixup;
  2259. fixupPatternList: ObjectFile.FixupPatterns;
  2260. identifier: ObjectFile.Identifier;
  2261. hiHit, hiFail, lowHit, lowFail: LONGINT;
  2262. PROCEDURE JmpDest(branchConditionCode: LONGINT);
  2263. BEGIN
  2264. IF (irInstruction.op1.mode = IntermediateCode.ModeImmediate) & (irInstruction.op1.symbol.name = in.name) & (irInstruction.op1.offset = 0) THEN
  2265. (* branch within same section at a certain IR offset *)
  2266. (* optimization: abort if branch is to the next instruction *)
  2267. IF irInstruction.op1.symbolOffset = inPC + 1 THEN
  2268. IF dump # NIL THEN dump.String("branch to next instruction ignored"); dump.Ln END;
  2269. RETURN
  2270. END;
  2271. IF irInstruction.op1.symbolOffset <= inPC THEN
  2272. (* backward branch: calculate the branch distance *)
  2273. branchDistance := in.instructions[irInstruction.op1.symbolOffset].pc - out.pc - 8;
  2274. ASSERT((-33554432 <= branchDistance) & (branchDistance <= 0) & ((ABS(branchDistance) MOD 4) = 0), 200);
  2275. ELSE
  2276. (* forward branch: the distance is not yet known, use some placeholder and add a relative fixup *)
  2277. branchDistance := -4;
  2278. (* TODO: what about a branch to the next instruction? this would require the fixup meachnism to patch a negative value! (-> -4) *)
  2279. NEW(fixupPatternList, 1);
  2280. fixupPatternList[0].offset := 0;
  2281. fixupPatternList[0].bits := 24;
  2282. identifier.name := in.name;
  2283. identifier.fingerprint := in.fingerprint;
  2284. fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, irInstruction.op1.symbolOffset, -8, -2, fixupPatternList);
  2285. out.fixupList.AddFixup(fixup)
  2286. END;
  2287. Emit1WithCondition(opB, InstructionSet.NewImmediate(branchDistance), branchConditionCode)
  2288. ELSE
  2289. (* any other type of branch -> do register branch *)
  2290. Emit1WithCondition(opBX, RegisterFromIrOperand(irInstruction.op1, Low, emptyOperand), branchConditionCode)
  2291. END;
  2292. END JmpDest;
  2293. PROCEDURE Cmp(CONST left, right: InstructionSet.Operand; float: BOOLEAN);
  2294. BEGIN
  2295. IF float THEN
  2296. IF ~backend.useFPU OR IsComplex(irLeft) (* 64 bit *) THEN
  2297. (* floating point comparisons without VFP unit *)
  2298. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2299. Emit3WithFlags(opAND, temp, left, right, {InstructionSet.flagS});
  2300. Emit2(opCMP, temp, InstructionSet.NewImmediate(0));
  2301. Emit1WithCondition(opB, InstructionSet.NewImmediate(4), InstructionSet.conditionLT); (* skip two instructions *)
  2302. Emit2(opCMP, left, right);
  2303. Emit1(opB, InstructionSet.NewImmediate(0)); (* skip one instructions *)
  2304. Emit2(opCMP, right, left);
  2305. ELSE
  2306. Emit2(opFCMPS, left, right);
  2307. Emit0(opFMSTAT); (* transfer the VFP flags to the standard ARM flags *)
  2308. END
  2309. ELSE
  2310. Emit2(opCMP, left, right);
  2311. END;
  2312. END Cmp;
  2313. BEGIN
  2314. hiFail := None;
  2315. hiHit := None;
  2316. IF irInstruction.opcode = IntermediateCode.br THEN
  2317. (* unconditional branch: *)
  2318. lowHit := InstructionSet.conditionAL
  2319. ELSE
  2320. (* conditional branch: *)
  2321. irLeft := irInstruction.op2; irRight := irInstruction.op3;
  2322. ASSERT((irLeft.type.form = irRight.type.form) & (irLeft.type.sizeInBits = irRight.type.sizeInBits));
  2323. IF IsInteger(irLeft) THEN
  2324. IF IsComplex(irLeft) THEN
  2325. CASE irInstruction.opcode OF
  2326. | IntermediateCode.breq, IntermediateCode.brne: (* left = right, left # right *)
  2327. lowHit := InstructionSet.conditionEQ;
  2328. left[High] := RegisterFromIrOperand(irLeft, High, emptyOperand);
  2329. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, emptyOperand);
  2330. Emit2(opCMP, left[High], right[High]);
  2331. left[Low] := RegisterFromIrOperand(irLeft, Low, left[High]);
  2332. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, right[High]);
  2333. Emit2WithCondition(opCMP, left[Low], right[Low], lowHit);
  2334. IF irInstruction.opcode = IntermediateCode.brne THEN lowHit := InstructionSet.conditionNE END;
  2335. | IntermediateCode.brlt, IntermediateCode.brge: (* left < right, left >= right *)
  2336. IF irInstruction.opcode = IntermediateCode.brlt THEN lowHit := InstructionSet.conditionLT ELSE lowHit := InstructionSet.conditionGE END;
  2337. ASSERT(irLeft.type.form = IntermediateCode.SignedInteger);
  2338. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2339. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, emptyOperand);
  2340. temp := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2341. Emit3WithFlags(opSUB, temp, left[Low], right[Low], {InstructionSet.flagS});
  2342. left[High] := RegisterFromIrOperand(irLeft, High, left[Low]);
  2343. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, right[Low]);
  2344. Emit3WithFlags(opSBC, temp, left[High], right[High], {InstructionSet.flagS}) (* the high part of the subtraction determines the sign *)
  2345. ELSE
  2346. HALT(100)
  2347. END
  2348. ELSE
  2349. ASSERT((irLeft.type.form IN IntermediateCode.Integer) & (irLeft.type.sizeInBits <= 32));
  2350. (* swap operands if beneficial *)
  2351. IF ~IrOperandIsDirectlyEncodable(irRight, Low) & IrOperandIsDirectlyEncodable(irLeft, Low) THEN
  2352. isSwapped := TRUE;
  2353. SwapIrOperands(irLeft, irRight)
  2354. END;
  2355. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2356. right[Low] := RegisterOrImmediateFromIrOperand(irRight, Low, emptyOperand);
  2357. SignOrZeroExtendOperand(left[Low], irLeft.type);
  2358. SignOrZeroExtendOperand(right[Low], irRight.type);
  2359. Cmp(left[Low], right[Low], FALSE);
  2360. (* determine condition code for the branch (take into consideration that operands could have been swapped) *)
  2361. CASE irInstruction.opcode OF
  2362. | IntermediateCode.breq: (* left = right *) lowHit := InstructionSet.conditionEQ
  2363. | IntermediateCode.brne: (* left # right *) lowHit := InstructionSet.conditionNE
  2364. | IntermediateCode.brlt: (* left < right *)
  2365. IF irInstruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2366. IF isSwapped THEN lowHit := InstructionSet.conditionHI ELSE lowHit := InstructionSet.conditionLO END
  2367. ELSE
  2368. IF isSwapped THEN lowHit := InstructionSet.conditionGT ELSE lowHit := InstructionSet.conditionLT END
  2369. END
  2370. | IntermediateCode.brge: (* left >= right *)
  2371. IF irInstruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
  2372. IF isSwapped THEN lowHit := InstructionSet.conditionLS ELSE lowHit := InstructionSet.conditionHS END
  2373. ELSE
  2374. IF isSwapped THEN lowHit := InstructionSet.conditionLE ELSE lowHit := InstructionSet.conditionGE END
  2375. END
  2376. ELSE HALT(100)
  2377. END
  2378. END
  2379. ELSIF IsSinglePrecisionFloat(irLeft) THEN
  2380. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2381. right[Low] := RegisterFromIrOperand(irRight, Low, emptyOperand);
  2382. Cmp(left[Low], right[Low], TRUE);
  2383. CASE irInstruction.opcode OF
  2384. | IntermediateCode.breq: (* left = right *) lowHit := InstructionSet.conditionEQ
  2385. | IntermediateCode.brne: (* left # right *) lowHit := InstructionSet.conditionNE
  2386. | IntermediateCode.brlt: (* left < right *) lowHit := InstructionSet.conditionLT
  2387. | IntermediateCode.brge: (* left >= right *) lowHit := InstructionSet.conditionGE
  2388. ELSE HALT(100)
  2389. END
  2390. ELSIF IsDoublePrecisionFloat(irLeft) THEN
  2391. CASE irInstruction.opcode OF
  2392. IntermediateCode.breq:
  2393. hiHit := None; hiFail := InstructionSet.conditionNE; lowHit := InstructionSet.conditionEQ
  2394. |IntermediateCode.brne:
  2395. hiHit := InstructionSet.conditionNE; hiFail := None; lowHit := InstructionSet.conditionNE
  2396. |IntermediateCode.brge:
  2397. IF isSwapped THEN
  2398. hiHit := InstructionSet.conditionLT; hiFail := InstructionSet.conditionGT; lowHit := InstructionSet.conditionLS
  2399. ELSE
  2400. hiHit := InstructionSet.conditionGT; hiFail := InstructionSet.conditionLT; lowHit := InstructionSet.conditionHS
  2401. END;
  2402. |IntermediateCode.brlt:
  2403. IF isSwapped THEN
  2404. hiHit := InstructionSet.conditionGT; hiFail := InstructionSet.conditionLT; lowHit := InstructionSet.conditionHI
  2405. ELSE
  2406. hiHit := InstructionSet.conditionLT; hiFail := InstructionSet.conditionGT; lowHit := InstructionSet.conditionLO
  2407. END;
  2408. END;
  2409. (*
  2410. compare hi part (as float)
  2411. if hiHit then br dest
  2412. elsif hiFail then br fail
  2413. else compare low part (as unsigned int)
  2414. if lowHit then br dest
  2415. end
  2416. end,
  2417. fail:
  2418. *)
  2419. (* hi part *)
  2420. left[High] := RegisterFromIrOperand(irLeft, High, emptyOperand);
  2421. right[High] := RegisterOrImmediateFromIrOperand(irRight, High, emptyOperand);
  2422. Cmp(left[High], right[High], TRUE);
  2423. IF hiHit # None THEN
  2424. JmpDest(hiHit)
  2425. END;
  2426. IF hiFail # None THEN
  2427. NEW(fixupPatternList, 1);
  2428. fixupPatternList[0].offset := 0;
  2429. fixupPatternList[0].bits := 24;
  2430. identifier.name := in.name;
  2431. identifier.fingerprint := in.fingerprint;
  2432. failFixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, irInstruction.op1.symbolOffset, -8, -2, fixupPatternList);
  2433. out.fixupList.AddFixup(failFixup);
  2434. Emit1WithCondition(opB, InstructionSet.NewImmediate(branchDistance), hiFail)
  2435. END;
  2436. (* low part *)
  2437. left[Low] := RegisterFromIrOperand(irLeft, Low, emptyOperand);
  2438. right[Low] := RegisterFromIrOperand(irRight, Low, emptyOperand);
  2439. Cmp(left[Low], right[Low], FALSE);
  2440. ELSE
  2441. HALT(200)
  2442. END
  2443. END;
  2444. JmpDest(lowHit);
  2445. IF failFixup # NIL THEN
  2446. failFixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+failFixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
  2447. failFixup.resolved := in;
  2448. END;
  2449. END EmitBr;
  2450. (* TODO: floats *)
  2451. PROCEDURE EmitConv(VAR irInstruction: IntermediateCode.Instruction);
  2452. VAR
  2453. irDestination, irSource: IntermediateCode.Operand;
  2454. destination, source: ARRAY 2 OF Operand;
  2455. temp: Operand;
  2456. partType: IntermediateCode.Type;
  2457. BEGIN
  2458. irDestination := irInstruction.op1; irSource := irInstruction.op2;
  2459. (* prepare operands *)
  2460. destination[Low] := AcquireDestinationRegister(irDestination, Low, emptyOperand); (* TODO: find more optimal register allocation *)
  2461. source[Low] := RegisterOrImmediateFromIrOperand(irSource, Low, destination[Low]);
  2462. IF IsComplex(irDestination) THEN destination[High]:= AcquireDestinationRegister(irDestination, High, emptyOperand) END;
  2463. IF IsComplex(irSource) THEN source[High] := RegisterOrImmediateFromIrOperand(irSource, High, destination[High]) END; (* note that the corresponding destination register is used as hint *)
  2464. IF IsInteger(irDestination) THEN
  2465. (* to integer: *)
  2466. IF IsComplex(irDestination) THEN
  2467. (* to complex integer: *)
  2468. IF IsInteger(irSource) THEN
  2469. (* integer to complex integer: *)
  2470. IF IsComplex(irSource) THEN
  2471. (* complex integer to complex integer: *)
  2472. MovIfDifferent(destination[Low], source[Low]);
  2473. MovIfDifferent(destination[High], source[High]);
  2474. ELSE
  2475. (* non-complex integer to complex integer: *)
  2476. SignOrZeroExtendOperand(source[Low], irSource.type);
  2477. MovIfDifferent(destination[Low], source[Low]);
  2478. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2479. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  2480. ELSE
  2481. (* for signed values the high part is set to 0...0 or 1...1, depending on the sign of the low part *)
  2482. Emit2(opMOV, destination[High], InstructionSet.NewRegister(source[Low].register, InstructionSet.shiftASR, None, 32))
  2483. END
  2484. END
  2485. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2486. ASSERT(backend.useFPU);
  2487. (* single precision float to complex integer: *)
  2488. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2489. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2490. (* single precision float to non-complex unsigned integer: *)
  2491. Emit2(opFTOUIS, temp, source[Low]);
  2492. ELSE
  2493. (* single precision float to non-complex signed integer: *)
  2494. Emit2(opFTOSIS, temp, source[Low]);
  2495. END;
  2496. Emit2(opFMRS, destination[Low], temp);
  2497. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2498. Emit2(opMOV, destination[High], InstructionSet.NewImmediate(0));
  2499. ELSE
  2500. (* for signed values the high part is set to 0...0 or 1...1, depending on the sign of the low part *)
  2501. Emit2(opMOV, destination[High], InstructionSet.NewRegister(destination[Low].register, InstructionSet.shiftASR, None, 32))
  2502. END
  2503. ELSE
  2504. (* anything else to complex-integer: *)
  2505. HALT(200)
  2506. END
  2507. ELSE
  2508. (* to non-complex integer: *)
  2509. IF IsInteger(irSource) THEN
  2510. (* integer to non-complex integer: ignore high part of source *)
  2511. GetPartType(irSource.type, Low, partType);
  2512. SignOrZeroExtendOperand(source[Low], partType);
  2513. MovIfDifferent(destination[Low], source[Low])
  2514. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2515. ASSERT(backend.useFPU);
  2516. (* single precision float to non-complex integer: *)
  2517. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2518. IF irDestination.type.form = IntermediateCode.UnsignedInteger THEN
  2519. (* single precision float to non-complex unsigned integer: *)
  2520. Emit2(opFTOUIS, temp, source[Low]);
  2521. ELSE
  2522. (* single precision float to non-complex signed integer: *)
  2523. Emit2(opFTOSIS, temp, source[Low]);
  2524. END;
  2525. Emit2(opFMRS, destination[Low], temp)
  2526. ELSE
  2527. (* anything to non-complex integer: *)
  2528. HALT(200)
  2529. END
  2530. END
  2531. ELSIF IsSinglePrecisionFloat(irDestination) THEN
  2532. (* to single precision float: *)
  2533. IF IsInteger(irSource) THEN
  2534. (* integer to single precision float: ignore high part of source *)
  2535. temp := GetFreeRegister(IntermediateCode.FloatType(32));
  2536. Emit2(opFMSR, temp, source[Low]);
  2537. IF irSource.type.form = IntermediateCode.UnsignedInteger THEN
  2538. (* non-complex unsigned integer to single precision float: *)
  2539. Emit2(opFUITOS, destination[Low], temp)
  2540. ELSE
  2541. (* non-complex signed integer to single precision float: *)
  2542. Emit2(opFSITOS, destination[Low], temp)
  2543. END
  2544. ELSIF IsSinglePrecisionFloat(irSource) THEN
  2545. (* single precision float to single precision float: *)
  2546. MovIfDifferent(destination[Low], source[Low])
  2547. ELSE
  2548. (* anything else to single precision float: *)
  2549. HALT(200)
  2550. END
  2551. ELSE
  2552. (* to anything else: *)
  2553. HALT(200)
  2554. END;
  2555. WriteBack(irDestination, Low, destination[Low]);
  2556. IF IsComplex(irDestination) THEN WriteBack(irInstruction.op1, High, destination[High]) END
  2557. END EmitConv;
  2558. (** get the register that is dedicated to store a return value of a function **)
  2559. PROCEDURE ResultRegister(part: LONGINT; type: IntermediateCode.Type): InstructionSet.Operand;
  2560. VAR
  2561. result: Operand;
  2562. BEGIN
  2563. IF (type.form IN IntermediateCode.Integer) OR ~(backend.useFPU) THEN
  2564. IF part = Low THEN result := opRES
  2565. ELSIF part = High THEN result := opRESHI
  2566. ELSE HALT(200)
  2567. END
  2568. ELSIF type.form = IntermediateCode.Float THEN
  2569. ASSERT(type.sizeInBits = 32, 200);
  2570. result := opRESFS
  2571. END;
  2572. RETURN result
  2573. END ResultRegister;
  2574. PROCEDURE EmitReturn(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  2575. VAR
  2576. source: Operand;
  2577. BEGIN
  2578. source := RegisterOrImmediateFromIrOperand(irInstruction.op1, part, ResultRegister(part, irInstruction.op1.type)); (* note: the result register is given as a hint *)
  2579. MovIfDifferent(ResultRegister(part, irInstruction.op1.type), source)
  2580. END EmitReturn;
  2581. PROCEDURE EmitResult(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT);
  2582. VAR
  2583. destinationRegister: Operand;
  2584. BEGIN
  2585. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2586. MovIfDifferent(destinationRegister, ResultRegister(part, irInstruction.op1.type));
  2587. WriteBack(irInstruction.op1, part, destinationRegister)
  2588. END EmitResult;
  2589. PROCEDURE EmitTrap(CONST irInstruction: IntermediateCode.Instruction);
  2590. BEGIN
  2591. ASSERT(irInstruction.op1.mode = IntermediateCode.ModeNumber);
  2592. Emit1(opSWI, InstructionSet.NewImmediate(LONGINT(irInstruction.op1.intValue))) (* software interrupt *)
  2593. END EmitTrap;
  2594. (* possible optimization: use a combination of LDR and LDRB (would be 4x faster on average) *)
  2595. PROCEDURE EmitCopy(VAR irInstruction: IntermediateCode.Instruction);
  2596. VAR
  2597. targetBaseReg, sourceBaseReg, length, lastSourceAddress, currentTargetReg, currentSourceReg, tempReg: Operand;
  2598. BEGIN
  2599. ASSERT((irInstruction.op1.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op1.type.sizeInBits = 32));
  2600. ASSERT((irInstruction.op2.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op2.type.sizeInBits = 32));
  2601. ASSERT((irInstruction.op3.type.form = IntermediateCode.UnsignedInteger) & (irInstruction.op3.type.sizeInBits = 32));
  2602. currentTargetReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2603. currentSourceReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2604. (* note that the registers that store the current addresses are used as hints: *)
  2605. targetBaseReg := RegisterFromIrOperand(irInstruction.op1, Low, currentTargetReg);
  2606. sourceBaseReg := RegisterFromIrOperand(irInstruction.op2, Low, currentSourceReg);
  2607. MovIfDifferent(currentTargetReg, targetBaseReg);
  2608. MovIfDifferent(currentSourceReg, sourceBaseReg);
  2609. lastSourceAddress := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2610. length := RegisterOrImmediateFromIrOperand(irInstruction.op3, Low, lastSourceAddress); (* note that the last source address register is used as hint*)
  2611. Emit3(opADD, lastSourceAddress, sourceBaseReg, length);
  2612. tempReg := GetFreeRegister(IntermediateCode.UnsignedIntegerType(32));
  2613. Emit2WithFlags(opLDR, tempReg, InstructionSet.NewImmediateOffsetMemory(currentSourceReg.register, 1, {InstructionSet.Increment, InstructionSet.PostIndexed}), {InstructionSet.flagB});
  2614. Emit2WithFlags(opSTR, tempReg, InstructionSet.NewImmediateOffsetMemory(currentTargetReg.register, 1, {InstructionSet.Increment, InstructionSet.PostIndexed}), {InstructionSet.flagB});
  2615. Emit2(opCMP, currentSourceReg, lastSourceAddress);
  2616. Emit1WithCondition(opB, InstructionSet.NewImmediate(-20), InstructionSet.conditionLT)
  2617. END EmitCopy;
  2618. PROCEDURE EmitFill(CONST irInstruction: IntermediateCode.Instruction; down: BOOLEAN);
  2619. BEGIN
  2620. HALT(200) (* note that this instruction is not used at the moment *)
  2621. END EmitFill;
  2622. (* PREPARATION OF OPERATIONS *)
  2623. (** swap a pair of IR operands **)
  2624. PROCEDURE SwapIrOperands(VAR left, right: IntermediateCode.Operand);
  2625. VAR
  2626. temp: IntermediateCode.Operand;
  2627. BEGIN
  2628. temp := left;
  2629. left := right;
  2630. right := temp
  2631. END SwapIrOperands;
  2632. PROCEDURE PrepareSingleSourceOp(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, sourceOperand: Operand);
  2633. BEGIN
  2634. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2635. sourceOperand := RegisterFromIrOperand(irInstruction.op2, part, destinationRegister); (* note that the destination register is used as hint *)
  2636. END PrepareSingleSourceOp;
  2637. PROCEDURE PrepareSingleSourceOpWithImmediate(VAR irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, sourceOperand: Operand);
  2638. BEGIN
  2639. destinationRegister := AcquireDestinationRegister(irInstruction.op1, part, emptyOperand);
  2640. sourceOperand := RegisterOrImmediateFromIrOperand(irInstruction.op2, part, destinationRegister); (* note that the destination register is used as hint *)
  2641. END PrepareSingleSourceOpWithImmediate;
  2642. PROCEDURE PrepareDoubleSourceOpWithImmediate(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, leftSourceOperand, rightSourceOperand: Operand; VAR isSwapped: BOOLEAN);
  2643. VAR
  2644. irDestination, irLeft, irRight: IntermediateCode.Operand;
  2645. BEGIN
  2646. irDestination := irInstruction.op1;
  2647. irLeft := irInstruction.op2;
  2648. irRight := irInstruction.op3;
  2649. destinationRegister:= AcquireDestinationRegister(irDestination, part, emptyOperand);
  2650. (* swap operands such that the right one is an immediate *)
  2651. IF IrOperandIsDirectlyEncodable(irLeft, part) & ~IrOperandIsDirectlyEncodable(irRight, part) THEN
  2652. SwapIrOperands(irLeft, irRight);
  2653. isSwapped := TRUE
  2654. ELSIF IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2655. SwapIrOperands(irLeft, irRight);
  2656. isSwapped := TRUE
  2657. ELSE
  2658. isSwapped := FALSE
  2659. END;
  2660. leftSourceOperand := RegisterFromIrOperand(irLeft, part, destinationRegister); (* the destination register is used as hint *)
  2661. IF IsSameRegister(leftSourceOperand, destinationRegister) THEN
  2662. rightSourceOperand := RegisterOrImmediateFromIrOperand(irRight, part, emptyOperand) (* no hint is provided *)
  2663. ELSE
  2664. rightSourceOperand := RegisterOrImmediateFromIrOperand(irRight, part, destinationRegister) (* the destination register is again used as hint *)
  2665. END
  2666. END PrepareDoubleSourceOpWithImmediate;
  2667. PROCEDURE PrepareDoubleSourceOp(CONST irInstruction: IntermediateCode.Instruction; part: LONGINT; VAR destinationRegister, leftSourceOperand, rightSourceOperand: Operand);
  2668. VAR
  2669. irDestination, irLeft, irRight: IntermediateCode.Operand;
  2670. BEGIN
  2671. irDestination := irInstruction.op1;
  2672. irLeft := irInstruction.op2;
  2673. irRight := irInstruction.op3;
  2674. destinationRegister:= AcquireDestinationRegister(irDestination, part, emptyOperand);
  2675. IF IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2676. leftSourceOperand := RegisterFromIrOperand(irLeft, part, emptyOperand); (* do not use destination register as hint *)
  2677. ELSE
  2678. leftSourceOperand := RegisterFromIrOperand(irLeft, part, destinationRegister); (* the destination register is used as hint *)
  2679. END;
  2680. IF IsSameRegister(leftSourceOperand, destinationRegister) OR IntermediateCode.OperandEquals(irRight, irDestination) THEN
  2681. rightSourceOperand := RegisterFromIrOperand(irRight, part, emptyOperand) (* no hint is provided *)
  2682. ELSE
  2683. rightSourceOperand := RegisterFromIrOperand(irRight, part, destinationRegister) (* the destination register is again used as hint *)
  2684. END
  2685. END PrepareDoubleSourceOp;
  2686. END CodeGeneratorARM;
  2687. BackendARM = OBJECT(IntermediateBackend.IntermediateBackend)
  2688. VAR
  2689. cg: CodeGeneratorARM;
  2690. system: Global.System;
  2691. useFPU: BOOLEAN;
  2692. initLocals: BOOLEAN;
  2693. PROCEDURE & InitBackendARM;
  2694. BEGIN
  2695. useFPU := FALSE;
  2696. InitIntermediateBackend;
  2697. SetRuntimeModuleName(DefaultRuntimeModuleName);
  2698. SetNewObjectFile(TRUE,FALSE);
  2699. system := NIL;
  2700. initLocals := TRUE;
  2701. SetHasLinkRegister;
  2702. END InitBackendARM;
  2703. PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System; activeCellsSpecification: ActiveCells.Specification);
  2704. BEGIN
  2705. Initialize^(diagnostics, log, flags, checker, system, activeCellsSpecification);
  2706. NEW(cg, runtimeModuleName, diagnostics, SELF)
  2707. END Initialize;
  2708. PROCEDURE EnterCustomBuiltins;
  2709. VAR
  2710. procedureType: SyntaxTree.ProcedureType;
  2711. parameter: SyntaxTree.Parameter;
  2712. PROCEDURE New;
  2713. BEGIN procedureType := SyntaxTree.NewProcedureType(-1, NIL)
  2714. END New;
  2715. PROCEDURE BoolRet;
  2716. BEGIN procedureType.SetReturnType(system.booleanType)
  2717. END BoolRet;
  2718. PROCEDURE IntRet;
  2719. BEGIN procedureType.SetReturnType(Global.Integer32)
  2720. END IntRet;
  2721. PROCEDURE IntPar;
  2722. BEGIN
  2723. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.ValueParameter);
  2724. parameter.SetType(Global.Integer32); procedureType.AddParameter(parameter)
  2725. END IntPar;
  2726. PROCEDURE IntVarPar;
  2727. BEGIN
  2728. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.VarParameter);
  2729. parameter.SetType(Global.Integer32); procedureType.AddParameter(parameter)
  2730. END IntVarPar;
  2731. PROCEDURE RealVarPar;
  2732. BEGIN
  2733. parameter := SyntaxTree.NewParameter(-1, procedureType, SyntaxTree.NewIdentifier(""), SyntaxTree.VarParameter);
  2734. parameter.SetType(Global.Float32); procedureType.AddParameter(parameter)
  2735. END RealVarPar;
  2736. PROCEDURE Finish(CONST name: ARRAY OF CHAR; number: SHORTINT);
  2737. BEGIN Global.NewCustomBuiltin(name, system.systemScope, number, procedureType);
  2738. END Finish;
  2739. BEGIN
  2740. New; IntRet; Finish("SP", GetSP);
  2741. New; IntPar; Finish("SetSP", SetSP);
  2742. New; IntRet; Finish("FP", GetFP);
  2743. New; IntPar; Finish("SetFP", SetFP);
  2744. New; IntRet; Finish("PC", GetPC);
  2745. New; IntPar; Finish("SetPC", SetPC);
  2746. New; IntRet; Finish("LNK", GetLNK);
  2747. New; IntPar; Finish("SetLNK", SetLNK);
  2748. New; IntPar; IntPar; Finish("LDPSR", LDPSR);
  2749. New; IntPar; IntVarPar; Finish("STPSR", STPSR);
  2750. New; IntPar; IntPar; IntPar; Finish("LDCPR", LDCPR);
  2751. New; IntPar; IntPar; IntVarPar; Finish("STCPR", STCPR);
  2752. New; IntPar; Finish("FLUSH", FLUSH);
  2753. New; BoolRet; IntPar; Finish("NULL", NULL);
  2754. New; IntRet; IntPar; IntPar; Finish("XOR", XOR);
  2755. New; IntVarPar; IntPar; IntPar; Finish("MULD", MULD);
  2756. New; IntVarPar; IntPar; IntPar; Finish("ADDC", ADDC);
  2757. New; RealVarPar; IntPar; Finish("PACK", PACK);
  2758. New; RealVarPar; IntVarPar; Finish("UNPK", UNPK);
  2759. END EnterCustomBuiltins;
  2760. PROCEDURE GetSystem(): Global.System;
  2761. BEGIN
  2762. (* create system object if not yet existing *)
  2763. IF system = NIL THEN
  2764. (* used stack frame layout:
  2765. param 1
  2766. param 2
  2767. ...
  2768. param n-1
  2769. FP+8 -> param n
  2770. FP+4 -> old LR
  2771. FP -> old FP
  2772. FP-4 -> local 1
  2773. local 2
  2774. ...
  2775. spill 1
  2776. spill 2
  2777. ....
  2778. *)
  2779. (*
  2780. codeUnit, dataUnit = 8, 8
  2781. addressSize = 32
  2782. minVarAlign, maxVarAlign = 32, 32
  2783. minParAlign, maxParAlign = 8, 32
  2784. offsetFirstPar = 32 * 2
  2785. registerParameters = 0
  2786. *)
  2787. NEW(system, 8, 8, 32, (*32*) 8, 32, 8, 32, 32 * 2, 0, cooperative);
  2788. IF oberon07 THEN
  2789. IF Trace THEN D.String("Oberon07"); D.Ln END;
  2790. Global.SetDefaultDeclarations(system, 32) (* each basic type uses at least 32 bits -> INTEGER will be 32 bits long *)
  2791. ELSE
  2792. IF Trace THEN D.String("not Oberon07"); D.Ln END;
  2793. Global.SetDefaultDeclarations(system, 8) (* INTEGER will be 16 bits long *)
  2794. END;
  2795. Global.SetDefaultOperators(system);
  2796. EnterCustomBuiltins
  2797. END;
  2798. RETURN system
  2799. END GetSystem;
  2800. (** whether the code generator can generate code for a certain IR instruction
  2801. if not, where to find the runtime procedure that is to be called instead **)
  2802. PROCEDURE SupportedInstruction(CONST irInstruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  2803. BEGIN
  2804. (* only necessary for binary object file format for symbol / module entry in IntermediateBackend *)
  2805. RETURN cg.Supported(irInstruction, moduleName, procedureName);
  2806. END SupportedInstruction;
  2807. (** whether a certain intermediate code immediate value can be directly appear in code
  2808. if not, the value is stored in a const section and loaded from there **)
  2809. PROCEDURE SupportedImmediate(CONST irImmediateOperand: IntermediateCode.Operand): BOOLEAN;
  2810. VAR
  2811. result: BOOLEAN;
  2812. BEGIN
  2813. (* TODO: remove this *)
  2814. RETURN TRUE; (* tentatively generate all immediates, as symbol fixups are not yet implemented *)
  2815. result := FALSE;
  2816. IF (irImmediateOperand.type.form IN IntermediateCode.Integer) & (irImmediateOperand.type.sizeInBits <= 32) THEN
  2817. (* 32 bit integers *)
  2818. IF cg.ValueIsDirectlyEncodable(LONGINT(irImmediateOperand.intValue)) THEN
  2819. (* the value can be directly encoded as an ARM immediate operand *)
  2820. result := TRUE
  2821. ELSIF cg.ValueComposition(LONGINT(irImmediateOperand.intValue), FALSE, emptyOperand) <= 2 THEN (* TODO: find reasonable limit *)
  2822. (* the value can be generated using a limited amount of intructions *)
  2823. result := TRUE
  2824. END
  2825. END;
  2826. RETURN result
  2827. END SupportedImmediate;
  2828. PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
  2829. VAR
  2830. in: Sections.Section;
  2831. out: BinaryCode.Section;
  2832. name: Basic.SectionName;
  2833. procedure: SyntaxTree.Procedure;
  2834. i, j, initialSectionCount: LONGINT;
  2835. (* recompute fixup positions and assign binary sections *)
  2836. PROCEDURE PatchFixups(section: BinaryCode.Section);
  2837. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; displacement,symbolOffset: LONGINT; in: IntermediateCode.Section;
  2838. symbol: Sections.Section;
  2839. BEGIN
  2840. fixup := section.fixupList.firstFixup;
  2841. WHILE fixup # NIL DO
  2842. symbol := module.allSections.FindByName(fixup.symbol.name);
  2843. IF (symbol # NIL) & (symbol(IntermediateCode.Section).resolved # NIL) THEN
  2844. resolved := symbol(IntermediateCode.Section).resolved(BinaryCode.Section);
  2845. in := symbol(IntermediateCode.Section);
  2846. symbolOffset := fixup.symbolOffset;
  2847. IF symbolOffset = in.pc THEN
  2848. displacement := resolved.pc
  2849. ELSIF (symbolOffset # 0) THEN
  2850. ASSERT(in.pc > symbolOffset);
  2851. displacement := in.instructions[symbolOffset].pc;
  2852. ELSE
  2853. displacement := 0;
  2854. END;
  2855. fixup.SetSymbol(fixup.symbol.name,fixup.symbol.fingerprint,0,fixup.displacement+displacement);
  2856. END;
  2857. fixup := fixup.nextFixup;
  2858. END;
  2859. END PatchFixups;
  2860. (*
  2861. PROCEDURE Resolve(VAR fixup: BinaryCode.Fixup);
  2862. BEGIN
  2863. IF (fixup.symbol.name # "") & (fixup.resolved = NIL) THEN fixup.resolved := module.allSections.FindByName(fixup.symbol.name) END;
  2864. END Resolve;
  2865. (* recompute fixup positions and assign binary sections *)
  2866. PROCEDURE PatchFixups(section: BinaryCode.Section);
  2867. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; symbolOffset, offsetWithinSection: LONGINT; in: IntermediateCode.Section;
  2868. BEGIN
  2869. fixup := section.fixupList.firstFixup;
  2870. WHILE fixup # NIL DO
  2871. Resolve(fixup);
  2872. IF (fixup.resolved # NIL) & (fixup.resolved(IntermediateCode.Section).resolved # NIL) THEN
  2873. resolved := fixup.resolved(IntermediateCode.Section).resolved(BinaryCode.Section);
  2874. in := fixup.resolved(IntermediateCode.Section);
  2875. (* TODO: is this correct? *)
  2876. symbolOffset := fixup.symbolOffset;
  2877. ASSERT(fixup.symbolOffset < in.pc);
  2878. IF (fixup.symbolOffset # 0) & (symbolOffset < in.pc) THEN
  2879. offsetWithinSection := in.instructions[fixup.symbolOffset].pc;
  2880. (*
  2881. (* TENTATIVE *)
  2882. D.String("FIXUP PATCH:"); D.Ln;
  2883. D.String(" symbol name: "); fixup.symbol.DumpName(D.Log); D.String("/");
  2884. D.String(" symbol offset: "); D.Int(fixup.symbolOffset, 0); D.Ln;
  2885. D.String(" offsetWithinSection"); D.Int(offsetWithinSection, 0); D.Ln;
  2886. D.String(" fixup.displacement (before)"); D.Int(fixup.displacement, 0); D.Ln; ; D.Ln;
  2887. D.Update;
  2888. *)
  2889. (* remove the fixup's symbol offset (in IR units) and change the displacement (in system units) accordingly: *)
  2890. fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, offsetWithinSection + fixup.displacement)
  2891. END
  2892. END;
  2893. fixup := fixup.nextFixup;
  2894. END;
  2895. END PatchFixups;
  2896. *)
  2897. BEGIN
  2898. cg.SetModule(module);
  2899. cg.dump := dump;
  2900. FOR i := 0 TO module.allSections.Length() - 1 DO
  2901. in := module.allSections.GetSection(i);
  2902. IF in.type = Sections.InlineCodeSection THEN
  2903. Basic.SegmentedNameToString(in.name, name);
  2904. out := ResolvedSection(in(IntermediateCode.Section));
  2905. cg.dump := out.comments;
  2906. cg.Section(in(IntermediateCode.Section), out);
  2907. IF in.symbol # NIL THEN
  2908. procedure := in.symbol(SyntaxTree.Procedure);
  2909. procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
  2910. END;
  2911. END
  2912. END;
  2913. initialSectionCount := 0;
  2914. REPEAT
  2915. j := initialSectionCount;
  2916. initialSectionCount := module.allSections.Length() ;
  2917. FOR i := j TO initialSectionCount - 1 DO
  2918. in := module.allSections.GetSection(i);
  2919. Basic.SegmentedNameToString(in.name, name);
  2920. IF (in.type # Sections.InlineCodeSection) & (in(IntermediateCode.Section).resolved = NIL) THEN
  2921. out := ResolvedSection(in(IntermediateCode.Section));
  2922. cg.Section(in(IntermediateCode.Section),out);
  2923. END
  2924. END
  2925. UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
  2926. FOR i := 0 TO module.allSections.Length() - 1 DO
  2927. in := module.allSections.GetSection(i);
  2928. Basic.SegmentedNameToString(in.name, name);
  2929. in := module.allSections.GetSection(i);
  2930. PatchFixups(in(IntermediateCode.Section).resolved)
  2931. END;
  2932. IF cg.error THEN Error("", Diagnostics.Invalid, Diagnostics.Invalid, "") END
  2933. END GenerateBinary;
  2934. (** create an ARM code module from an intermediate code module **)
  2935. PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
  2936. VAR
  2937. result: Formats.GeneratedModule;
  2938. BEGIN
  2939. ASSERT(intermediateCodeModule IS Sections.Module);
  2940. result := ProcessIntermediateCodeModule^(intermediateCodeModule);
  2941. IF ~error THEN
  2942. GenerateBinary(result(Sections.Module), dump);
  2943. IF dump # NIL THEN
  2944. dump.Ln; dump.Ln;
  2945. dump.String("------------------ binary code -------------------"); dump.Ln;
  2946. IF (traceString="") OR (traceString="*") THEN
  2947. result.Dump(dump);
  2948. dump.Update
  2949. ELSE
  2950. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  2951. dump.Update;
  2952. END
  2953. END;
  2954. END;
  2955. RETURN result
  2956. FINALLY
  2957. IF dump # NIL THEN
  2958. dump.Ln; dump.Ln;
  2959. dump.String("------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
  2960. IF (traceString="") OR (traceString="*") THEN
  2961. result.Dump(dump);
  2962. dump.Update
  2963. ELSE
  2964. Sections.DumpFiltered(dump,result(Sections.Module),traceString);
  2965. dump.Update;
  2966. END
  2967. END;
  2968. RETURN result
  2969. END ProcessIntermediateCodeModule;
  2970. PROCEDURE DefineOptions(options: Options.Options);
  2971. BEGIN
  2972. options.Add(0X, UseFPUFlag, Options.Flag);
  2973. options.Add(0X, "noInitLocals", Options.Flag);
  2974. DefineOptions^(options);
  2975. END DefineOptions;
  2976. PROCEDURE GetOptions(options: Options.Options);
  2977. BEGIN
  2978. IF options.GetFlag(UseFPUFlag) THEN useFPU := TRUE END;
  2979. IF options.GetFlag("noInitLocals") THEN initLocals := FALSE END;
  2980. GetOptions^(options);
  2981. END GetOptions;
  2982. PROCEDURE DefaultObjectFileFormat(): Formats.ObjectFileFormat;
  2983. BEGIN RETURN ObjectFileFormat.Get();
  2984. END DefaultObjectFileFormat;
  2985. PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
  2986. BEGIN RETURN NIL
  2987. END DefaultSymbolFileFormat;
  2988. (** get the name of the backend **)
  2989. PROCEDURE GetDescription(VAR instructionSet: ARRAY OF CHAR);
  2990. BEGIN instructionSet := "ARM"
  2991. END GetDescription;
  2992. PROCEDURE FindPC(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
  2993. VAR
  2994. section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
  2995. i: LONGINT; pooledName: Basic.SegmentedName;
  2996. BEGIN
  2997. module := ProcessSyntaxTreeModule(x);
  2998. Basic.ToSegmentedName(sectionName, pooledName);
  2999. i := 0;
  3000. REPEAT
  3001. section := module(Sections.Module).allSections.GetSection(i);
  3002. INC(i);
  3003. UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
  3004. IF section.name # pooledName THEN
  3005. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  3006. ELSE
  3007. binarySection := section(IntermediateCode.Section).resolved;
  3008. label := binarySection.labels;
  3009. WHILE (label # NIL) & (label.offset >= sectionOffset) DO
  3010. label := label.prev;
  3011. END;
  3012. IF label # NIL THEN
  3013. diagnostics.Information(module.module.sourceName,label.position,Diagnostics.Invalid," pc position");
  3014. ELSE
  3015. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  3016. END;
  3017. END;
  3018. END FindPC;
  3019. END BackendARM;
  3020. VAR
  3021. emptyOperand: Operand;
  3022. PROCEDURE Assert(condition: BOOLEAN; CONST message: ARRAY OF CHAR);
  3023. BEGIN ASSERT(condition, 100)
  3024. END Assert;
  3025. PROCEDURE Halt(CONST message: ARRAY OF CHAR);
  3026. BEGIN HALT(100)
  3027. END Halt;
  3028. PROCEDURE PowerOf2(val: HUGEINT; VAR exp: LONGINT): BOOLEAN;
  3029. BEGIN
  3030. IF val <= 0 THEN RETURN FALSE END;
  3031. exp := 0;
  3032. WHILE ~ODD(val) DO
  3033. val := val DIV 2;
  3034. INC(exp)
  3035. END;
  3036. RETURN val = 1
  3037. END PowerOf2;
  3038. (** get the ARM code section that corresponds to an intermediate code section **)
  3039. PROCEDURE ResolvedSection(irSection: IntermediateCode.Section): BinaryCode.Section;
  3040. VAR
  3041. result: BinaryCode.Section;
  3042. BEGIN
  3043. IF irSection.resolved = NIL THEN
  3044. NEW(result, irSection.type, irSection.priority, 8, irSection.name, irSection.comments # NIL, FALSE);
  3045. (* set fixed position or alignment
  3046. (also make sure that any section has an alignment of at least 4 bytes) *)
  3047. IF ~irSection.fixed & (irSection.positionOrAlignment < 4) THEN
  3048. result.SetAlignment(FALSE, 4)
  3049. ELSE
  3050. result.SetAlignment(irSection.fixed, irSection.positionOrAlignment);
  3051. END;
  3052. irSection.SetResolved(result)
  3053. ELSE
  3054. result := irSection.resolved
  3055. END;
  3056. RETURN result
  3057. END ResolvedSection;
  3058. (** initialize the module **)
  3059. PROCEDURE Init;
  3060. BEGIN InstructionSet.InitOperand(emptyOperand)
  3061. END Init;
  3062. (** get an instance of the ARM backend **)
  3063. PROCEDURE Get*(): Backend.Backend;
  3064. VAR
  3065. result: BackendARM;
  3066. BEGIN
  3067. NEW(result);
  3068. RETURN result
  3069. END Get;
  3070. (* only for testing purposes *)
  3071. PROCEDURE Test*;
  3072. VAR
  3073. codeGenerator: CodeGeneratorARM;
  3074. value, count: LONGINT;
  3075. BEGIN
  3076. NEW(codeGenerator, "", NIL, NIL);
  3077. FOR value := 0 TO 300 BY 1 DO
  3078. count := codeGenerator.ValueComposition(value, FALSE, emptyOperand);
  3079. D.String("value: "); D.Int(value, 0); D.String(" -> "); D.Int(count, 0); D.String(" instructions"); D.Ln;
  3080. END;
  3081. D.Ln; D.Update
  3082. END Test;
  3083. (* TODO: move this to Debugging.Mod or even Streams.Mod *)
  3084. (** write an integer in binary right-justified in a field of at least ABS(w) characters.
  3085. If w < 0 THEN ABS(w) least significant hex digits of 'value' are written (potentially including leading zeros or ones)
  3086. **)
  3087. PROCEDURE DBin*(value: HUGEINT; numberDigits: LONGINT);
  3088. CONST
  3089. MaxBitSize = SIZEOF(HUGEINT) * 8;
  3090. VAR
  3091. i, firstRelevantPos: LONGINT;
  3092. prefixWithSpaces: BOOLEAN;
  3093. chars: ARRAY MaxBitSize OF CHAR;
  3094. prefixChar: CHAR;
  3095. BEGIN
  3096. prefixWithSpaces := numberDigits >= 0;
  3097. numberDigits := ABS(numberDigits);
  3098. (*
  3099. - calculate an array containing the full bitstring
  3100. - determine the position of the first relevant digit
  3101. *)
  3102. firstRelevantPos := 0;
  3103. FOR i := MaxBitSize - 1 TO 0 BY -1 DO
  3104. IF ODD(value) THEN
  3105. chars[i] := '1';
  3106. firstRelevantPos := i (* occurence of a '1' -> changes the first relevant position *)
  3107. ELSE
  3108. chars[i] := '0'
  3109. END;
  3110. value := value DIV 2
  3111. END;
  3112. (* if space prefixing is enabled, limit the number of digits to the relevant digits *)
  3113. IF prefixWithSpaces THEN numberDigits := MAX(numberDigits, MaxBitSize - firstRelevantPos) END;
  3114. IF numberDigits > MaxBitSize THEN
  3115. IF prefixWithSpaces THEN prefixChar := ' ' ELSE prefixChar := chars[0] END; (* use spaces or sign bit *)
  3116. FOR i := 1 TO numberDigits - MaxBitSize DO D.Char(prefixChar) END;
  3117. numberDigits := MaxBitSize
  3118. END;
  3119. ASSERT((numberDigits >= 0) & (numberDigits <= MaxBitSize));
  3120. FOR i := MaxBitSize - numberDigits TO MaxBitSize - 1 DO
  3121. IF prefixWithSpaces & (i < firstRelevantPos) THEN D.Char(' ') ELSE D.Char(chars[i]) END
  3122. END;
  3123. D.Ln;
  3124. END DBin;
  3125. BEGIN
  3126. Init;
  3127. END FoxARMBackend.
  3128. SystemTools.FreeDownTo FoxARMBackend ~