FoxARMBackend.Mod 161 KB

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