FoxARMBackend.Mod 162 KB

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