FoxARMBackend.Mod 150 KB

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