FoxARMBackend.Mod 154 KB

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