FoxARMBackend.Mod 155 KB

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