FoxARMBackend.Mod 157 KB

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