12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728 |
- MODULE FoxAMDBackend; (** AUTHOR ""; PURPOSE ""; *)
- IMPORT
- Basic := FoxBasic, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
- IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, BinaryCode := FoxBinaryCode,
- InstructionSet := FoxAMD64InstructionSet, Assembler := FoxAMD64Assembler, SemanticChecker := FoxSemanticChecker, Formats := FoxFormats,
- Diagnostics, Streams, Options, Strings, ObjectFileFormat := FoxGenericObjectFile, Compiler,
- Machine, D := Debugging, CodeGenerators := FoxCodeGenerators, ObjectFile;
- CONST
- (* constants for the register allocator *)
- none=-1;
- RAX=InstructionSet.regRAX; RCX=InstructionSet.regRCX; RDX=InstructionSet.regRDX; RBX=InstructionSet.regRBX;
- RSP=InstructionSet.regRSP; RBP=InstructionSet.regRBP; RSI=InstructionSet.regRSI; RDI=InstructionSet.regRDI;
- R8=InstructionSet.regR8; R9=InstructionSet.regR9; R10=InstructionSet.regR10; R11=InstructionSet.regR11;
- R12=InstructionSet.regR12; R13=InstructionSet.regR13; R14=InstructionSet.regR14; R15=InstructionSet.regR15;
- EAX=InstructionSet.regEAX; ECX=InstructionSet.regECX; EDX=InstructionSet.regEDX; EBX=InstructionSet.regEBX;
- ESP=InstructionSet.regESP; EBP=InstructionSet.regEBP; ESI=InstructionSet.regESI; EDI=InstructionSet.regEDI;
- R8D=InstructionSet.regR8D; R9D=InstructionSet.regR9D; R10D=InstructionSet.regR10D; R11D=InstructionSet.regR11D;
- R12D=InstructionSet.regR12D; R13D=InstructionSet.regR13D; R14D=InstructionSet.regR14D; R15D=InstructionSet.regR15D;
- AX=InstructionSet.regAX; CX=InstructionSet.regCX; DX=InstructionSet.regDX; BX=InstructionSet.regBX;
- SI=InstructionSet.regSI; DI=InstructionSet.regDI; BP=InstructionSet.regBP; SP=InstructionSet.regSP;
- R8W=InstructionSet.regR8W; R9W=InstructionSet.regR9W; R10W=InstructionSet.regR10W; R11W=InstructionSet.regR11W;
- R12W=InstructionSet.regR12W; R13W=InstructionSet.regR13W; R14W=InstructionSet.regR14W; R15W=InstructionSet.regR15W;
- AL=InstructionSet.regAL; CL=InstructionSet.regCL; DL=InstructionSet.regDL; BL=InstructionSet.regBL; SIL=InstructionSet.regSIL;
- DIL=InstructionSet.regDIL; BPL=InstructionSet.regBPL; SPL=InstructionSet.regSPL;
- R8B=InstructionSet.regR8B; R9B=InstructionSet.regR9B; R10B=InstructionSet.regR10B; R11B=InstructionSet.regR11B;
- R12B=InstructionSet.regR12B; R13B=InstructionSet.regR13B; R14B=InstructionSet.regR14B; R15B=InstructionSet.regR15B;
- AH=InstructionSet.regAH; CH=InstructionSet.regCH; DH=InstructionSet.regDH; BH=InstructionSet.regBH;
- ST0=InstructionSet.regST0;
- XMM0 = InstructionSet.regXMM0;
- XMM7 = InstructionSet.regXMM7;
- YMM0 = InstructionSet.regYMM0;
- YMM7 = InstructionSet.regYMM7;
- Low=0; High=1;
- FrameSpillStack=TRUE;
- VAR registerOperands: ARRAY InstructionSet.numberRegisters OF Assembler.Operand;
- usePool: BOOLEAN;
- opEAX, opECX, opEDX, opEBX, opESP, opEBP,
- opESI, opEDI, opAX, opCX, opDX, opBX, opSI, opDI, opAL, opCL, opDL, opBL, opAH, opCH, opDH, opBH,opST0
- , opRSP, opRBP: Assembler.Operand;
- unusable,split,blocked,free: CodeGenerators.Ticket;
- traceStackSize: LONGINT;
- TYPE
- Ticket=CodeGenerators.Ticket;
- PhysicalRegisters*=OBJECT (CodeGenerators.PhysicalRegisters)
- VAR
- toVirtual: ARRAY InstructionSet.numberRegisters OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
- reserved: ARRAY InstructionSet.numberRegisters OF BOOLEAN;
- hint: LONGINT;
- useFPU: BOOLEAN;
- PROCEDURE &InitPhysicalRegisters(fpu,cooperative: BOOLEAN);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(toVirtual)-1 DO
- toVirtual[i] := NIL;
- reserved[i] := FALSE;
- END;
- (* reserve stack and base pointer registers *)
- toVirtual[BPL] := unusable;
- toVirtual[SPL] := unusable;
- toVirtual[BP] := unusable;
- toVirtual[SP] := unusable;
- toVirtual[EBP] := unusable;
- toVirtual[ESP] := unusable;
- toVirtual[RBP] := unusable;
- toVirtual[RSP] := unusable;
- hint := none;
- useFPU := fpu
- END InitPhysicalRegisters;
- PROCEDURE AllocationHint*(index: LONGINT);
- BEGIN hint := index
- END AllocationHint;
- PROCEDURE NumberRegisters*(): LONGINT;
- BEGIN
- RETURN LEN(toVirtual)
- END NumberRegisters;
- END PhysicalRegisters;
- PhysicalRegisters32=OBJECT (PhysicalRegisters) (* 32 bit implementation *)
- PROCEDURE & InitPhysicalRegisters32(fpu,cooperative: BOOLEAN);
- VAR i: LONGINT;
- BEGIN
- InitPhysicalRegisters(fpu,cooperative);
- (* disable registers that are only usable in 64 bit mode *)
- FOR i := 0 TO 31 DO
- toVirtual[i+RAX] := unusable;
- END;
- FOR i := 8 TO 15 DO
- toVirtual[i+AL] := unusable;
- toVirtual[i+AH] := unusable;
- toVirtual[i+EAX] := unusable;
- toVirtual[i+AX] := unusable;
- END;
- FOR i := 4 TO 7 DO
- toVirtual[i+AL] := unusable;
- toVirtual[i+AH] := unusable;
- END;
- FOR i := 0 TO LEN(reserved)-1 DO reserved[i] := FALSE END;
- END InitPhysicalRegisters32;
- PROCEDURE Allocate*(index: LONGINT; virtualRegister: Ticket);
- BEGIN
- (*
- D.String("allocate register x : index="); D.Int(index,1); D.Ln;
- *)
- Assert(toVirtual[index] = free,"register already allocated");
- toVirtual[index] := virtualRegister;
- IF index DIV 32 = 2 THEN (* 32 bit *)
- Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
- toVirtual[index MOD 32 + AX] := blocked;
- IF index MOD 32 < 4 THEN
- Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
- Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
- toVirtual[index MOD 32 + AL] := blocked;
- toVirtual[index MOD 32 + AH] := blocked;
- END;
- ELSIF index DIV 32 = 1 THEN (* 16 bit *)
- Assert(toVirtual[index MOD 8 + EAX] = free,"free register split");
- toVirtual[index MOD 32 + EAX] := split;
- IF index MOD 32 < 4 THEN
- Assert(toVirtual[index MOD 32 + AL] = free,"register already allocated");
- Assert(toVirtual[index MOD 32 + AH] = free,"register already allocated");
- toVirtual[index MOD 32 + AL] := blocked;
- toVirtual[index MOD 32 + AH] := blocked;
- END;
- ELSIF index DIV 32 = 0 THEN (* 8 bit *)
- Assert((toVirtual[index MOD 4 + EAX] = free) OR (toVirtual[index MOD 4 + EAX] = split),"free register blocked");
- Assert((toVirtual[index MOD 4 + AX] = free) OR (toVirtual[index MOD 4 + AX] = split),"free register blocked");
- toVirtual[index MOD 4 + EAX] := split;
- toVirtual[index MOD 4 + AX] := split;
- ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
- ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
- ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
- END;
- END Allocate;
- PROCEDURE SetReserved*(index: LONGINT; res: BOOLEAN);
- BEGIN
- IF index DIV 32 <=2 THEN
- index := index MOD 16;
- reserved[index+AH] := res;
- reserved[index+AL] := res;
- reserved[index+AX] := res;
- reserved[index+EAX] := res;
- ELSE
- reserved[index] := res;
- END;
- END SetReserved;
- PROCEDURE Reserved*(index: LONGINT): BOOLEAN;
- BEGIN
- RETURN (index>0) & reserved[index]
- END Reserved;
- PROCEDURE Free*(index: LONGINT);
- VAR x: Ticket;
- BEGIN
- (*
- D.String("free register x : index="); D.Int(index,1); D.Ln;
- *)
- x := toVirtual[index];
- Assert((toVirtual[index] # NIL),"register not reserved");
- toVirtual[index] := free;
- IF index DIV 32 =2 THEN (* 32 bit *)
- Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
- toVirtual[index MOD 32 + AX] := free;
- IF index MOD 32 < 4 THEN
- Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
- Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
- toVirtual[index MOD 32 + AL] := free;
- toVirtual[index MOD 32 + AH] := free;
- END;
- ELSIF index DIV 32 = 1 THEN (* 16 bit *)
- Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
- toVirtual[index MOD 32 + EAX] := free;
- IF index MOD 32 < 4 THEN
- Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
- Assert(toVirtual[index MOD 32 + AH] = blocked,"reserved register did not block");
- toVirtual[index MOD 32 + AL] := free;
- toVirtual[index MOD 32 + AH] := free;
- END;
- ELSIF index DIV 32 = 0 THEN (* 8 bit *)
- IF (toVirtual[index MOD 4 + AL] = free) & (toVirtual[index MOD 4 + AH] = free) THEN
- Assert(toVirtual[index MOD 4 + EAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 4 + AX] = split,"reserved register did not split");
- toVirtual[index MOD 4 + EAX] := free;
- toVirtual[index MOD 4 + AX] := free;
- END;
- ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
- ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
- ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
- END;
- END Free;
- PROCEDURE NextFree*(CONST type: IntermediateCode.Type):LONGINT;
- VAR i,sizeInBits,length, form: LONGINT;
- PROCEDURE GetGPHint(offset: LONGINT): LONGINT;
- VAR res: LONGINT;
- BEGIN
- IF (hint # none) & (hint >= AL) & (hint <= EDI) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint MOD 32 + offset ELSE res := none END;
- hint := none;
- RETURN res
- END GetGPHint;
- PROCEDURE GetHint(from,to: LONGINT): LONGINT;
- VAR res: LONGINT;
- BEGIN
- IF (hint # none) & (hint >= from) & (hint <= to) & (toVirtual[hint]=free) & ~Reserved(hint) THEN res := hint ELSE res := none END;
- hint := none;
- RETURN res
- END GetHint;
- PROCEDURE Get(from,to: LONGINT): LONGINT;
- VAR i: LONGINT;
- BEGIN
- i := from;
- IF from <= to THEN
- WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
- IF i > to THEN i := none END;
- ELSE
- WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
- IF i < to THEN i := none END;
- END;
- RETURN i
- END Get;
- BEGIN
- length := type.length;
- sizeInBits := type.sizeInBits;
- form := type.form;
- IF (type.length > 1) THEN
- IF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =4) THEN
- i := Get(XMM7, XMM0);
- ELSIF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =8) THEN
- i := Get(YMM7, YMM0);
- ELSE
- HALT(100)
- END
- ELSIF type.form IN IntermediateCode.Integer THEN
- sizeInBits := type.sizeInBits;
- IF type.sizeInBits = IntermediateCode.Bits8 THEN
- i := GetGPHint(AL);
- IF i = none THEN i := Get(BL, AL) END;
- IF i = none THEN i := Get(BH, AH) END;
- ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
- i := GetGPHint(AX);
- IF i = none THEN i := Get(DI, SI) END;
- IF i = none THEN i := Get(BX, AX) END;
- ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
- i := GetGPHint(EAX);
- IF i = none THEN i := Get(EDI,ESI) END;
- IF i = none THEN i := Get(EBX,EAX) END;
- ELSE HALT(100)
- END;
- ELSE
- ASSERT(type.form = IntermediateCode.Float);
- IF useFPU THEN
- i := Get(InstructionSet.regST0, InstructionSet.regST6);
- (* ST7 unusable as it is overwritten during arithmetic instructions *)
- ELSE
- i := GetHint(XMM0, XMM7);
- IF i = none THEN i := Get(XMM7, XMM0) END
- END;
- END;
- hint := none; (* reset *)
- RETURN i
- END NextFree;
- PROCEDURE Mapped*(physical: LONGINT): Ticket;
- VAR virtual: Ticket;
- BEGIN
- virtual := toVirtual[physical];
- IF virtual = blocked THEN virtual := Mapped(physical+32)
- ELSIF virtual = split THEN
- IF physical < 32 THEN virtual := Mapped(physical+16 MOD 32)
- ELSE virtual := Mapped(physical-32)
- END;
- END;
- ASSERT((virtual = free) OR (virtual = unusable) OR (toVirtual[virtual.register] = virtual));
- RETURN virtual
- END Mapped;
- PROCEDURE Dump*(w: Streams.Writer);
- VAR i: LONGINT; virtual: Ticket;
- BEGIN
- w.String("; ---- registers ----"); w.Ln;
- FOR i := 0 TO LEN(toVirtual)-1 DO
- virtual := toVirtual[i];
- IF virtual # unusable THEN
- w.String("reg "); w.Int(i,1); w.String(": ");
- IF virtual = free THEN w.String("free")
- ELSIF virtual = blocked THEN w.String("blocked")
- ELSIF virtual = split THEN w.String("split")
- ELSE w.String(" r"); w.Int(virtual.register,1);
- END;
- IF reserved[i] THEN w.String("reserved") END;
- w.Ln;
- END;
- END;
- END Dump;
- END PhysicalRegisters32;
- PhysicalRegisters64=OBJECT (PhysicalRegisters) (* 64 bit implementation *)
- PROCEDURE & InitPhysicalRegisters64(fpu,cooperative: BOOLEAN);
- BEGIN
- InitPhysicalRegisters(fpu,cooperative);
- END InitPhysicalRegisters64;
- PROCEDURE SetReserved*(index: LONGINT; res: BOOLEAN);
- BEGIN
- (*
- IF res THEN D.String("reserve ") ELSE D.String("unreserve ") END;
- D.String("register: index="); D.Int(index,1); D.Ln;
- *)
- IF index DIV 32 <=2 THEN
- index := index MOD 16;
- reserved[index+AH] := res;
- reserved[index+AL] := res;
- reserved[index+AX] := res;
- reserved[index+EAX] := res;
- reserved[index+RAX] := res;
- ELSE
- reserved[index] := res
- END;
- END SetReserved;
- PROCEDURE Reserved*(index: LONGINT): BOOLEAN;
- BEGIN
- RETURN reserved[index]
- END Reserved;
- PROCEDURE Allocate*(index: LONGINT; virtualRegister: Ticket);
- BEGIN
- (*
- D.String("allocate register x : index="); D.Int(index,1); D.Ln;
- *)
- Assert(toVirtual[index] = free,"register already allocated");
- toVirtual[index] := virtualRegister;
- IF index DIV 32 = 3 THEN (* 64 bit *)
- Assert(toVirtual[index MOD 32 + EAX] = free,"free register split");
- toVirtual[index MOD 32 + EAX] := blocked;
- toVirtual[index MOD 32 + AX] := blocked;
- toVirtual[index MOD 32 + AL] := blocked;
- ELSIF index DIV 32 = 2 THEN (* 32 bit *)
- Assert(toVirtual[index MOD 32 + AX] = free,"free register split");
- toVirtual[index MOD 32 + RAX] := split;
- toVirtual[index MOD 32 + AX] := blocked;
- toVirtual[index MOD 32 + AL] := blocked;
- ELSIF index DIV 32 = 1 THEN (* 16 bit *)
- toVirtual[index MOD 32 + RAX] := split;
- toVirtual[index MOD 32 + EAX] := split;
- toVirtual[index MOD 32 + AL] := blocked;
- ELSIF index DIV 32 = 0 THEN (* 8 bit *)
- toVirtual[index MOD 32 + RAX] := split;
- toVirtual[index MOD 32 + EAX] := split;
- toVirtual[index MOD 32 + AX] := split;
- ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
- ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
- ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
- END;
- END Allocate;
- PROCEDURE Free*(index: LONGINT);
- BEGIN
- (*
- D.String("release register x : index="); D.Int(index,1); D.Ln;
- *)
- Assert(toVirtual[index]#NIL,"register not reserved");
- toVirtual[index] := free;
- IF index DIV 32 =3 THEN (* 64 bit *)
- Assert(toVirtual[index MOD 32 + EAX] = blocked,"reserved register did not block");
- toVirtual[index MOD 32 + EAX] := free;
- toVirtual[index MOD 32 + AX] := free;
- toVirtual[index MOD 32 + AL] := free;
- ELSIF index DIV 32 =2 THEN (* 32 bit *)
- Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 32 + AX] = blocked,"reserved register did not block");
- Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not block");
- toVirtual[index MOD 32 + RAX] := free;
- toVirtual[index MOD 32 + AX] := free;
- toVirtual[index MOD 32 + AL] := free;
- ELSIF index DIV 32 = 1 THEN (* 16 bit *)
- Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 32 + AL] = blocked,"reserved register did not split");
- toVirtual[index MOD 32 + RAX] := free;
- toVirtual[index MOD 32 + EAX] := free;
- toVirtual[index MOD 32 + AL] := free;
- ELSIF index DIV 32 = 0 THEN (* 8 bit *)
- Assert(toVirtual[index MOD 32 + RAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 32 + EAX] = split,"reserved register did not split");
- Assert(toVirtual[index MOD 32 + AX] = split,"reserved register did not split");
- toVirtual[index MOD 32 + RAX] := free;
- toVirtual[index MOD 32 + EAX] := free;
- toVirtual[index MOD 32 + AX] := free;
- ELSIF (index >= XMM0) & (index <= XMM7) THEN (* vector register *)
- ELSIF (index >= YMM0) & (index <= YMM7) THEN (* vector register *)
- ELSE Assert( (index >=InstructionSet.regST0) & (index <= InstructionSet.regST7 ),"not a float register"); (* floats *)
- END;
- END Free;
- PROCEDURE NextFree*(CONST type: IntermediateCode.Type): LONGINT;
- VAR i: LONGINT;
- PROCEDURE GetGPHint(offset: LONGINT): LONGINT;
- VAR res: LONGINT;
- BEGIN
- IF (hint # none) & (hint >= AL) & (hint <= R15) & (toVirtual[hint MOD 32 + offset]=free) & ~Reserved(hint) THEN res := hint MOD 32 + offset ELSE res := none END;
- hint := none;
- RETURN res
- END GetGPHint;
- PROCEDURE Get(from,to: LONGINT): LONGINT;
- VAR i: LONGINT;
- BEGIN
- i := from;
- IF from <= to THEN
- WHILE (i <= to) & ((toVirtual[i]#free) OR Reserved(i)) DO INC(i) END;
- IF i > to THEN i := none END;
- ELSE
- WHILE (i >=to) & ((toVirtual[i]#free) OR Reserved(i)) DO DEC(i) END;
- IF i < to THEN i := none END;
- END;
- RETURN i
- END Get;
- BEGIN
- IF (type.length > 1) THEN
- IF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =4) THEN
- i := Get(XMM7, XMM0);
- ELSIF (* (type.form = IntermediateCode.Float) &*) (type.sizeInBits<=32) & (type.length =8) THEN
- i := Get(YMM7, YMM0);
- ELSE
- HALT(100)
- END
- ELSIF type.form IN IntermediateCode.Integer THEN
- IF type.sizeInBits = IntermediateCode.Bits8 THEN
- i := GetGPHint(AL);
- IF i = none THEN i := Get(BL, AL) END;
- IF i = none THEN i := Get(BH, AH) END;
- IF i = none THEN
- i := Get(AL,R15B)
- END;
- ELSIF type.sizeInBits = IntermediateCode.Bits16 THEN
- i := GetGPHint(AX);
- IF i = none THEN i := Get(DI, SI) END;
- IF i = none THEN i := Get(BX, AX) END;
- IF i = none THEN
- i := Get(AX,R15W);
- END;
- ELSIF type.sizeInBits = IntermediateCode.Bits32 THEN
- i := GetGPHint(EAX);
- IF i = none THEN i := Get(EDI,ESI) END;
- IF i = none THEN i := Get(EBX,EAX) END;
- IF i = none THEN
- i := Get(EAX,R15D);
- END;
- ELSIF type.sizeInBits = IntermediateCode.Bits64 THEN
- i := GetGPHint(RAX);
- IF i = none THEN i := Get(RDI,RSI) END;
- IF i = none THEN i := Get(RBX,RAX) END;
- IF i = none THEN
- i := Get(RAX, R15)
- END;
- ELSE HALT(100)
- END;
- ELSE
- ASSERT(type.form = IntermediateCode.Float);
- IF useFPU THEN
- i := Get(InstructionSet.regST0, InstructionSet.regST6);
- (* ST7 unusable as it is overwritten during arithmetic instructions *)
- ELSE
- i := Get(XMM7, XMM0)
- END;
- END;
- RETURN i;
- END NextFree;
- PROCEDURE Mapped*(physical: LONGINT): Ticket;
- VAR virtual: Ticket;
- BEGIN
- virtual := toVirtual[physical];
- IF virtual = blocked THEN RETURN Mapped(physical+32) END;
- IF virtual = split THEN RETURN Mapped(physical-32) END;
- RETURN virtual
- END Mapped;
- END PhysicalRegisters64;
- CodeGeneratorAMD64 = OBJECT (CodeGenerators.GeneratorWithTickets)
- VAR
- (* static generator state variables, considered constant during generation *)
- builtinsModuleName: SyntaxTree.IdentifierString;
- cpuBits: LONGINT;
- opBP, opSP, opRA, opRB, opRC, opRD, opRSI, opRDI, opR8, opR9, opR10, opR11, opR12, opR13, opR14, opR15: Assembler.Operand; (* base pointer, stack pointer, register A, depends on cpuBits*)
- BP, SP, RA, RD, RS, RC: LONGINT; (* base pointer and stack pointer register index, depends on cpuBits *)
- emitter: Assembler.Emitter; (* assembler generating and containing the machine code *)
- backend: BackendAMD64;
- (* register spill state *)
- stackSize: LONGINT;
- spillStackStart: LONGINT;
- (* floating point stack state *)
- fpStackPointer: LONGINT; (* floating point stack pointer, increases with allocation, decreases with releasing, used to determine current relative position on stack (as is necessary for intel FP instructions) *)
- (*
- FP register usage scheme:
- sp=1> FP0 - temp
- sp=0> FP0 - reg0 FP1 - reg0 sp=0> FP0 - reg0
- FP1 - reg1 FP2 - reg1 FP1 - reg1
- FP2 - reg2 FP3 - reg2 FP2 - reg2
- FP3 - reg3 = load op1 => FP4 - reg3 = op => FP3 - reg3
- FP4 - reg4 FP5 - reg4 FP4 - reg4
- FP5 - reg5 FP6 - reg5 FP5 - reg5
- FP6 - reg6 FP7 - reg6 FP6 - reg6
- FP7 - reg7 (reg7 lost) FP7 - reg7
- *)
- ap: Ticket;
- (* -------------------------- constructor -------------------------------*)
- PROCEDURE &InitGeneratorAMD64(CONST runtime: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; backend: BackendAMD64);
- VAR physicalRegisters: PhysicalRegisters; physicalRegisters32: PhysicalRegisters32; physicalRegisters64: PhysicalRegisters64;
- BEGIN
- SELF.backend := backend;
- builtinsModuleName := runtime;
- SELF.cpuBits := backend.bits;
- NEW(emitter,diagnostics);
- IF cpuBits=32 THEN
- NEW(physicalRegisters32, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters32; error := ~emitter.SetBits(32);
- opBP := opEBP; opSP := opESP; opRA := opEAX; opRB := opEBX; opRD := opEDX; opRDI := opEDI; opRSI := opESI; opRC := opECX;
- SP := ESP; BP := EBP; RA := EAX;
- RD := EDI; RS := ESI; RC := ECX;
- ASSERT(~error);
- ELSIF cpuBits=64 THEN
- NEW(physicalRegisters64, backend.forceFPU, backend.cooperative); physicalRegisters := physicalRegisters64; error := ~emitter.SetBits(64);
- opBP := opRBP; opSP := opRSP;
- opRA := registerOperands[RAX]; opRC := registerOperands[RCX];
- opRB := registerOperands[RBX]; opRD := registerOperands[RDX];
- opRDI := registerOperands[RDI]; opRSI := registerOperands[RSI];
- opR8 := registerOperands[R8]; opR9 := registerOperands[R9];
- opR10 := registerOperands[R10]; opR11 := registerOperands[R11];
- opR12 := registerOperands[R12]; opR13 := registerOperands[R13];
- opR14 := registerOperands[R14]; opR15 := registerOperands[R15];
- SP := RSP; BP := RBP; RA := RAX;
- RD := RDI; RS := RSI; RC := RCX;
- ASSERT(~error);
- ELSE Halt("no register allocator for bits other than 32 / 64 ");
- END;
- fpStackPointer := 0;
- InitTicketGenerator(diagnostics,backend.optimize,2,physicalRegisters);
- END InitGeneratorAMD64;
- (*------------------- overwritten methods ----------------------*)
- PROCEDURE Section*(in: IntermediateCode.Section; out: BinaryCode.Section);
- VAR oldSpillStackSize: LONGINT;
- PROCEDURE CheckEmptySpillStack;
- BEGIN
- IF spillStack.Size()#0 THEN Error(Basic.invalidPosition,"implementation error, spill stack not cleared") END;
- END CheckEmptySpillStack;
- BEGIN
- spillStack.Init;
- IF backend.cooperative THEN
- IF cpuBits=32 THEN
- ap := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.UnsignedIntegerType(cpuBits),ECX,in.pc);
- ELSE
- ap := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.UnsignedIntegerType(cpuBits),RBX,in.pc);
- END;
- ap.spillable := FALSE;
- END;
- emitter.SetCode(out);
- Section^(in,out);
- IF FrameSpillStack & (spillStack.MaxSize() >0) THEN
- oldSpillStackSize := spillStack.MaxSize();
- out.Reset;
- CheckEmptySpillStack;
- Section^(in,out);
- ASSERT(spillStack.MaxSize() = oldSpillStackSize);
- END;
- ASSERT(fpStackPointer = 0);
- CheckEmptySpillStack;
- IF backend.cooperative THEN
- UnmapTicket(ap);
- END;
- error := error OR emitter.error;
- END Section;
- PROCEDURE Supported*(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
- BEGIN
- COPY(builtinsModuleName, moduleName);
- IF (cpuBits=32) & (instruction.op2.type.sizeInBits = IntermediateCode.Bits64) & (instruction.op2.type.form IN IntermediateCode.Integer) THEN
- CASE instruction.opcode OF
- IntermediateCode.div:
- procedureName := "DivH"; RETURN FALSE
- | IntermediateCode.mul:
- procedureName := "MulH"; RETURN FALSE
- | IntermediateCode.mod :
- procedureName := "ModH"; RETURN FALSE
- | IntermediateCode.abs :
- procedureName := "AbsH"; RETURN FALSE;
- | IntermediateCode.shl :
- IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
- procedureName := "AslH"; RETURN FALSE;
- ELSE
- procedureName := "LslH"; RETURN FALSE;
- END;
- | IntermediateCode.shr :
- IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
- procedureName := "AsrH"; RETURN FALSE;
- ELSE
- procedureName := "LsrH"; RETURN FALSE;
- END;
- | IntermediateCode.ror :
- procedureName := "RorH"; RETURN FALSE;
- | IntermediateCode.rol :
- procedureName := "RolH"; RETURN FALSE;
- | IntermediateCode.cas :
- procedureName := "CasH"; RETURN FALSE;
- ELSE RETURN TRUE
- END;
- ELSIF ~backend.forceFPU & (instruction.opcode = IntermediateCode.conv) & (instruction.op1.type.form IN IntermediateCode.Integer) & (instruction.op2.type.form = IntermediateCode.Float) & IsComplex(instruction.op1) THEN
- IF instruction.op2.type.sizeInBits=32 THEN
- procedureName := "EntierRH"
- ELSE
- procedureName := "EntierXH"
- END;
- RETURN FALSE
- END;
- RETURN TRUE
- END Supported;
- (* input: type (such as that of an intermediate operand), output: low and high type (such as in low and high type of an operand) *)
- PROCEDURE GetPartType*(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
- BEGIN
- ASSERT(type.sizeInBits >0);
- IF (type.sizeInBits > cpuBits) & (type.form IN IntermediateCode.Integer) THEN
- IntermediateCode.InitType(typePart,type.form,32);
- ELSE ASSERT((type.form IN IntermediateCode.Integer) OR (type.form = IntermediateCode.Float));
- IF part=Low THEN typePart := type ELSE typePart := IntermediateCode.undef END;
- END;
- END GetPartType;
- (* simple move without conversion *)
- PROCEDURE Move(VAR dest, src: Assembler.Operand; CONST type: IntermediateCode.Type);
- BEGIN
- IF type.length > 1 THEN
- IF type.length = 4 THEN
- (*ASSERT(type.form = IntermediateCode.Float);*)
- IF Assembler.IsRegisterOperand(dest) & Assembler.IsRegisterOperand(src) THEN
- SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
- ELSIF (*(type.form = IntermediateCode.Float) & *) (type.sizeInBits = 32) THEN
- SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
- ELSIF (type.sizeInBits = 16) THEN
- SpecialMove(InstructionSet.opMOVQ, InstructionSet.opMOVQ, TRUE, dest, src, type);
- ELSIF (type.sizeInBits = 8) THEN
- SpecialMove(InstructionSet.opMOVD, InstructionSet.opMOVD, TRUE, dest, src, type);
- END;
- ELSIF type.length = 8 THEN
- (*ASSERT(type.form = IntermediateCode.Float);*)
- IF Assembler.IsRegisterOperand(dest) & Assembler.IsRegisterOperand(src) THEN
- SpecialMove(InstructionSet.opMOVUPS, InstructionSet.opMOVUPS, TRUE, dest, src, type);
- ELSIF (*(type.form = IntermediateCode.Float) & *) (type.sizeInBits = 32) THEN
- SpecialMove(InstructionSet.opVMOVUPS, InstructionSet.opVMOVUPS, TRUE, dest, src, type);
- ELSIF (type.sizeInBits = 16) THEN
- SpecialMove(InstructionSet.opVMOVQ, InstructionSet.opVMOVQ, TRUE, dest, src, type);
- ELSIF (type.sizeInBits = 8) THEN
- SpecialMove(InstructionSet.opVMOVD, InstructionSet.opVMOVD, TRUE, dest, src, type);
- END;
- ELSE
- (*
- ASSERT(type.form = IntermediateCode.Float);
- *)
- ASSERT(type.sizeInBits = 64);
- SpecialMove(InstructionSet.opMOVUPD, InstructionSet.opMOVUPS, TRUE, dest, src, type);
- END;
- ELSIF type.form = IntermediateCode.Float THEN
- IF type.sizeInBits = 32 THEN
- SpecialMove(InstructionSet.opMOVSS, InstructionSet.opMOVSS, TRUE, dest, src, type);
- ELSE
- SpecialMove(InstructionSet.opMOVSD, InstructionSet.opMOVSD, TRUE, dest, src, type);
- END;
- ELSE
- SpecialMove(InstructionSet.opMOV, InstructionSet.opMOV, TRUE, dest, src, type);
- END;
- END Move;
- PROCEDURE ToSpillStack*(ticket: Ticket);
- VAR op: Assembler.Operand;
- BEGIN
- IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
- emitter.Emit1(InstructionSet.opFLD,registerOperands[ticket.register]);
- INC(fpStackPointer);
- GetSpillOperand(ticket,op);
- emitter.Emit1(InstructionSet.opFSTP,op);
- DEC(fpStackPointer);
- ELSE
- GetSpillOperand(ticket,op);
- Move(op, registerOperands[ticket.register], ticket.type)
- END;
- END ToSpillStack;
- PROCEDURE AllocateSpillStack*(size: LONGINT);
- BEGIN
- IF ~FrameSpillStack THEN
- ModifyStackPointer(cpuBits DIV 8*size)
- END;
- END AllocateSpillStack;
- PROCEDURE ToRegister*(ticket: Ticket);
- VAR op: Assembler.Operand;
- BEGIN
- GetSpillOperand(ticket,op);
- emitter.Emit2(InstructionSet.opMOV,registerOperands[ticket.register],op);
- END ToRegister;
- PROCEDURE ExchangeTickets*(ticket1,ticket2: Ticket);
- VAR op1,op2: Assembler.Operand;
- BEGIN
- TicketToOperand(ticket1, op1);
- TicketToOperand(ticket2, op2);
- emitter.Emit2(InstructionSet.opXCHG, op1,op2);
- END ExchangeTickets;
- (*------------------- particular register mappings / operands ----------------------*)
- (* returns if a virtual register is mapped to the register set described by virtualRegisterMapping*)
- PROCEDURE MappedTo(CONST virtualRegister: LONGINT; part:LONGINT; physicalRegister: LONGINT): BOOLEAN;
- VAR ticket: Ticket;
- BEGIN
- IF (virtualRegister > 0) THEN
- ticket := virtualRegisters.Mapped(virtualRegister,part);
- RETURN (ticket # NIL) & ~(ticket.spilled) & (ticket.register = physicalRegister)
- ELSIF (virtualRegister = IntermediateCode.FP) THEN
- RETURN physicalRegister= BP
- ELSIF (virtualRegister = IntermediateCode.SP) THEN
- RETURN physicalRegister = SP
- ELSIF (virtualRegister = IntermediateCode.AP) THEN
- ASSERT(backend.cooperative);
- RETURN ~(ap.spilled) & (ap.register = physicalRegister)
- ELSE
- RETURN FALSE
- END;
- END MappedTo;
- PROCEDURE ResultRegister(CONST type: IntermediateCode.Type; part: LONGINT): LONGINT;
- BEGIN
- IF type.form IN IntermediateCode.Integer THEN
- CASE type.sizeInBits OF
- | 64:
- IF cpuBits = 32 THEN
- IF part = Low THEN RETURN EAX
- ELSE RETURN EDX
- END;
- ELSE
- ASSERT(part = Low);
- RETURN RAX
- END;
- | 32: ASSERT(part=Low); RETURN EAX
- | 16: ASSERT(part=Low); RETURN AX
- | 8: ASSERT(part=Low); RETURN AL
- END;
- ELSIF ~backend.forceFPU THEN
- RETURN XMM0
- ELSE ASSERT(type.form = IntermediateCode.Float);ASSERT(part=Low);
- RETURN ST0
- END;
- END ResultRegister;
- (*------------------- operand reflection ----------------------*)
- PROCEDURE IsMemoryOperand(vop: IntermediateCode.Operand; part: LONGINT): BOOLEAN;
- VAR ticket: Ticket;
- BEGIN
- IF vop.mode = IntermediateCode.ModeMemory THEN RETURN TRUE
- ELSIF vop.mode = IntermediateCode.ModeRegister THEN
- ticket := virtualRegisters.Mapped(vop.register,part);
- RETURN (ticket # NIL) & (ticket.spilled);
- ELSE RETURN FALSE
- END;
- END IsMemoryOperand;
- PROCEDURE IsRegister(CONST vop: IntermediateCode.Operand): BOOLEAN;
- BEGIN
- RETURN (vop.mode = IntermediateCode.ModeRegister) & (vop.offset = 0)
- END IsRegister;
- (* infer intermediate code type from physical operand as far as possible *)
- PROCEDURE PhysicalOperandType(CONST op:Assembler.Operand): IntermediateCode.Type;
- VAR type:IntermediateCode.Type;
- BEGIN
- IF op.type = Assembler.sti THEN
- IntermediateCode.InitType(type, IntermediateCode.Float, op.sizeInBytes*8)
- ELSE
- IntermediateCode.InitType(type, IntermediateCode.SignedInteger, op.sizeInBytes*8)
- END;
- RETURN type
- END PhysicalOperandType;
- (*------------------- operand generation ----------------------*)
- PROCEDURE GetSpillOperand(ticket: Ticket; VAR op: Assembler.Operand);
- BEGIN
- IF FrameSpillStack THEN
- op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8), BP , -(spillStackStart + cpuBits DIV 8 + ticket.offset*cpuBits DIV 8));
- ELSE
- op := Assembler.NewMem(SHORTINT(ticket.type.sizeInBits*ticket.type.length DIV 8),SP , (spillStack.Size()-ticket.offset)*cpuBits DIV 8);
- END;
- END GetSpillOperand;
- PROCEDURE TicketToOperand(ticket: Ticket; VAR op: Assembler.Operand);
- BEGIN
- IF (ticket = NIL) THEN
- Assembler.InitOperand(op)
- ELSIF ticket.spilled THEN
- GetSpillOperand(ticket,op)
- ELSE
- IF ticket.register = none THEN physicalRegisters.Dump(D.Log); tickets.Dump(D.Log); virtualRegisters.Dump(D.Log); D.Update; END;
- ASSERT(ticket.register # none);
- IF (ticket.type.form = IntermediateCode.Float) & backend.forceFPU THEN
- op := registerOperands[ticket.register+fpStackPointer]
- ELSE
- op := registerOperands[ticket.register];
- END;
- END;
- END TicketToOperand;
- PROCEDURE GetTemporaryRegister(type: IntermediateCode.Type; VAR op: Assembler.Operand);
- BEGIN
- TicketToOperand(TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type),op)
- END GetTemporaryRegister;
- PROCEDURE GetImmediateMem(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR imm: Assembler.Operand);
- VAR data: IntermediateCode.Section;pc: LONGINT; source, dest: Assembler.Operand; ticket: Ticket;
- BEGIN
- data := GetDataSection();
- pc := IntermediateBackend.EnterImmediate(data,vop);
- IF cpuBits = 64 THEN
- Assembler.InitImm(source,8,0);
- Assembler.SetSymbol(source,data.name,0,pc,0);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
- TicketToOperand(ticket,dest);
- emitter.Emit2(InstructionSet.opMOV,dest,source);
- Assembler.InitMem(imm, SHORT(vop.type.sizeInBits DIV 8), ticket.register, 0);
- ELSE
- Assembler.InitMem(imm, SHORT(vop.type.sizeInBits DIV 8) , Assembler.none,0);
- Assembler.SetSymbol(imm,data.name,0,pc,0);
- END;
- END GetImmediateMem;
- PROCEDURE GetImmediate(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand; forbidden16Bit,push: BOOLEAN);
- VAR type: IntermediateCode.Type; temp: Assembler.Operand; size: SHORTINT; value: HUGEINT;
- PROCEDURE IsImm8(value: HUGEINT): BOOLEAN;
- BEGIN
- RETURN (value >= -80H) & (value < 80H)
- END IsImm8;
- PROCEDURE IsImm16(value: HUGEINT): BOOLEAN;
- BEGIN
- RETURN (value >= -8000H) & (value < 10000H)
- END IsImm16;
- PROCEDURE IsImm32(value: HUGEINT): BOOLEAN;
- BEGIN
- value := value DIV 10000H DIV 10000H;
- RETURN (value = 0) OR (value=-1);
- END IsImm32;
-
- PROCEDURE IsSignedImm32(value: HUGEINT): BOOLEAN;
- BEGIN
- RETURN (value <= MAX(SIGNED32)) & (value >= MIN(SIGNED32));
- END IsSignedImm32;
-
- BEGIN
- ASSERT(virtual.mode = IntermediateCode.ModeImmediate);
- GetPartType(virtual.type,part,type);
- IF virtual.type.form IN IntermediateCode.Integer THEN
- IF IsComplex(virtual) THEN
- IF part = High THEN value := SHORT(virtual.intValue DIV 10000H DIV 10000H)
- ELSE value := virtual.intValue
- END;
- ELSE value := virtual.intValue
- END;
- IF virtual.symbol.name # "" THEN size := SHORT(type.sizeInBits DIV 8);
- ELSIF forbidden16Bit & IsImm16(value) & ~(IsImm8(value)) THEN size := Assembler.bits32;
- ELSIF (type.sizeInBits = 64) & (type.form = IntermediateCode.UnsignedInteger) & (value > MAX(LONGINT)) THEN
- size := 8; (* don't use negative signed 32-bit value to encode 64-bit unsigned value! *)
- ELSE size := 0
- END;
- Assembler.InitImm(physical,size ,value);
- IF virtual.symbol.name # "" THEN Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+part*Assembler.bits32) END;
- IF (cpuBits=64) & ((physical.sizeInBytes=8) OR ~IsImm32(value) OR push & ~IsSignedImm32(value)) THEN
- ASSERT(cpuBits=64);
- GetTemporaryRegister(IntermediateCode.int64,temp);
- emitter.Emit2(InstructionSet.opMOV,temp,physical);
- physical := temp;
- END;
- ELSE
- GetImmediateMem(virtual,part,physical);
- END;
- END GetImmediate;
- PROCEDURE GetMemory(CONST virtual: IntermediateCode.Operand; part: LONGINT; VAR physical: Assembler.Operand);
- VAR type: IntermediateCode.Type; virtualRegister, physicalRegister,offset: LONGINT; ticket,orig: Ticket; dest, source: Assembler.Operand;
- BEGIN
- ASSERT(virtual.mode = IntermediateCode.ModeMemory);
- GetPartType(virtual.type,part,type);
- IF virtual.register # IntermediateCode.None THEN
- virtualRegister := virtual.register;
- IF virtualRegister = IntermediateCode.FP THEN physicalRegister := BP;
- ELSIF virtualRegister = IntermediateCode.SP THEN physicalRegister := SP;
- ELSE
- IF virtualRegister = IntermediateCode.AP THEN
- ticket := ap;
- ELSE
- ticket := virtualRegisters.Mapped(virtualRegister,Low);
- END;
- IF ticket.spilled THEN
- IF physicalRegisters.Reserved(ticket.register) THEN
- orig := ticket;
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
- TicketToOperand(orig,source);
- TicketToOperand(ticket,dest);
- Move(dest,source,PhysicalOperandType(dest));
- physicalRegister := ticket.register;
- ELSE
- UnSpill(ticket);
- physicalRegister := ticket.register;
- END;
- ELSE
- physicalRegister := ticket.register;
- END;
- END;
- offset := virtual.offset;
- ASSERT(virtual.intValue = 0);
- ELSIF virtual.symbol.name = "" THEN
- physicalRegister := Assembler.none;
- offset := SHORT(virtual.intValue);
- ASSERT(virtual.offset = 0);
- ELSIF cpuBits = 64 THEN
- Assembler.InitImm(source,8,0);
- Assembler.SetSymbol(source,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateBackend.GetType(module.system,module.system.addressType));
- TicketToOperand(ticket,dest);
- emitter.Emit2(InstructionSet.opMOV,dest,source);
- physicalRegister := ticket.register;
- offset := 0;
- ASSERT(virtual.intValue = 0);
- ELSE
- physicalRegister := Assembler.none;
- offset := virtual.offset;
- ASSERT(virtual.intValue = 0);
- END;
- Assembler.InitMem(physical, SHORTINT(type.length * type.sizeInBits DIV 8) , physicalRegister, offset+ (cpuBits DIV 8) *part);
- IF (virtual.symbol.name # "") & (cpuBits # 64) THEN
- Assembler.SetSymbol(physical,virtual.symbol.name,virtual.symbol.fingerprint,virtual.symbolOffset,virtual.offset+ (cpuBits DIV 8) *part);
- END;
- END GetMemory;
-
- PROCEDURE GetRegister(CONST virtual: IntermediateCode.Operand; part:LONGINT; VAR physical: Assembler.Operand; VAR ticket: Ticket);
- VAR type: IntermediateCode.Type; virtualRegister, tempReg: LONGINT;
- tmp,imm: Assembler.Operand; index: LONGINT;
- BEGIN
- ASSERT(virtual.mode = IntermediateCode.ModeRegister);
- GetPartType(virtual.type,part,type);
- virtualRegister := virtual.register;
- IF (virtual.register > 0) THEN
- TicketToOperand(virtualRegisters.Mapped(virtual.register,part), physical);
- ELSIF virtual.register = IntermediateCode.FP THEN
- Assert(part=Low,"forbidden partitioned register on BP");
- physical := opBP;
- ELSIF virtual.register = IntermediateCode.SP THEN
- Assert(part=Low,"forbidden partitioned register on SP");
- physical := opSP;
- ELSIF virtual.register = IntermediateCode.AP THEN
- ASSERT(backend.cooperative);
- Assert(part=Low,"forbidden partitioned register on AP");
- TicketToOperand(ap, physical);
- ELSE HALT(100);
- END;
- IF virtual.offset # 0 THEN
- Assert(type.form # IntermediateCode.Float,"forbidden offset on float");
- IF ticket = NIL THEN
- tempReg := ForceFreeRegister(type);
- TicketToOperand(ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,tempReg,inPC),tmp);
- ELSE
- TicketToOperand(ticket, tmp);
- ticket := NIL;
- END;
- IF Assembler.IsRegisterOperand(physical) & (type.sizeInBits > 8) THEN
- Assembler.InitMem(physical,SHORTINT(type.length * type.sizeInBits DIV 8) , physical.register, virtual.offset);
- emitter.Emit2(InstructionSet.opLEA, tmp,physical);
- ELSE
- emitter.Emit2(InstructionSet.opMOV,tmp,physical);
- Assembler.InitImm(imm,0 ,virtual.offset);
- emitter.Emit2(InstructionSet.opADD,tmp,imm);
- END;
- physical := tmp;
- END;
- END GetRegister;
- (* make physical operand from virtual operand, if ticket given then write result into phyiscal register represented by ticket *)
- PROCEDURE MakeOperand(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand; ticket: Ticket);
- VAR tmp: Assembler.Operand;
- BEGIN
- TryAllocate(vop,part);
- CASE vop.mode OF
- IntermediateCode.ModeMemory: GetMemory(vop,part,op);
- |IntermediateCode.ModeRegister: GetRegister(vop,part,op,ticket);
- |IntermediateCode.ModeImmediate: GetImmediate(vop,part,op,FALSE,FALSE);
- END;
- IF ticket # NIL THEN
- TicketToOperand(ticket, tmp);
- emitter.Emit2(InstructionSet.opMOV, tmp, op);
- (* should work but does not
- IF Assembler.IsRegisterOperand(op) THEN ReleaseHint(op.register) END;
- *)
- op := tmp;
- END;
- END MakeOperand;
- (* make physical register operand from virtual operand *)
- PROCEDURE MakeRegister(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Assembler.Operand);
- VAR previous: Assembler.Operand; temp: Ticket;
- BEGIN
- MakeOperand(vop,part,op,NIL);
- IF ~Assembler.IsRegisterOperand(op) THEN
- previous := op;
- temp := TemporaryTicket(vop.registerClass,vop.type);
- TicketToOperand(temp,op);
- Move(op, previous, vop.type);
- END;
- END MakeRegister;
- (*------------------- helpers for code generation ----------------------*)
- (* move, potentially with conversion. parameter back used for moving back from temporary operand*)
- PROCEDURE SpecialMove(op, back: LONGINT; canStoreToMemory: BOOLEAN; VAR dest,src: Assembler.Operand; type: IntermediateCode.Type);
- VAR temp: Assembler.Operand; ticket: Ticket;
- BEGIN
- IF Assembler.SameOperand(src,dest) THEN (* do nothing *)
- ELSIF ~Assembler.IsMemoryOperand(dest) OR (~Assembler.IsMemoryOperand(src) & canStoreToMemory) THEN
- emitter.Emit2(op,dest,src);
- ELSE
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
- TicketToOperand(ticket,temp);
- emitter.Emit2(op,temp,src);
- emitter.Emit2(back,dest,temp);
- UnmapTicket(ticket);
- END;
- END SpecialMove;
- PROCEDURE ModifyStackPointer(sizeInBytes: HUGEINT);
- VAR sizeOp: Assembler.Operand; opcode: LONGINT;
- BEGIN
- ASSERT(sizeInBytes MOD (cpuBits DIV 8) = 0);
- IF sizeInBytes < 0 THEN
- sizeInBytes := -sizeInBytes; opcode := InstructionSet.opADD;
- ELSIF sizeInBytes > 0 THEN
- opcode := InstructionSet.opSUB;
- ELSE RETURN
- END;
- IF sizeInBytes < 128 THEN sizeOp := Assembler.NewImm8(sizeInBytes);
- ELSIF sizeInBytes < MAX(LONGINT) THEN sizeOp := Assembler.NewImm32(sizeInBytes);
- ELSE sizeOp := Assembler.NewImm64(sizeInBytes);
- END;
- emitter.Emit2(opcode,opSP,sizeOp);
- END ModifyStackPointer;
- (*------------------- generation = emit dispatch / emit procedures ----------------------*)
- PROCEDURE IsFloat(CONST operand: IntermediateCode.Operand): BOOLEAN;
- BEGIN RETURN operand.type.form = IntermediateCode.Float
- END IsFloat;
- PROCEDURE IsComplex(CONST operand: IntermediateCode.Operand): BOOLEAN;
- BEGIN RETURN (operand.type.form IN IntermediateCode.Integer) & (operand.type.sizeInBits > cpuBits)
- END IsComplex;
- PROCEDURE Generate*(VAR instruction: IntermediateCode.Instruction);
- VAR opcode: SHORTINT; ticket: Ticket; hwreg, lastUse, i, part: LONGINT;
- BEGIN
- (*!IF ((instruction.opcode = IntermediateCode.mov) OR (instruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
- hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
- Spill(physicalRegisters.Mapped(hwreg));
- lastUse := inPC+1;
- WHILE (lastUse < in.pc) &
- ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
- INC(lastUse)
- END;
- ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
- END;
- *)
- ReserveOperandRegisters(instruction.op1,TRUE); ReserveOperandRegisters(instruction.op2,TRUE);ReserveOperandRegisters(instruction.op3,TRUE);
- (*TryAllocate(instruction.op1,Low);
- IF IsComplex(instruction.op1) THEN TryAllocate(instruction.op1,High) END;
- *)
- opcode := instruction.opcode;
- CASE opcode OF
- IntermediateCode.nop: (* do nothing *)
- |IntermediateCode.mov:
- IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
- EmitMovFloat(instruction.op1,instruction.op2)
- ELSE EmitMov(instruction.op1,instruction.op2,Low);
- IF IsComplex(instruction.op1) THEN EmitMov(instruction.op1,instruction.op2, High) END;
- END;
- |IntermediateCode.conv:
- IF IsFloat(instruction.op1) OR IsFloat(instruction.op2) THEN
- EmitConvertFloat(instruction)
- ELSE
- EmitConvert(instruction.op1,instruction.op2,Low);
- IF IsComplex(instruction.op1) THEN EmitConvert(instruction.op1,instruction.op2,High) END;
- END;
- |IntermediateCode.call: EmitCall(instruction);
- |IntermediateCode.enter: EmitEnter(instruction);
- |IntermediateCode.leave: EmitLeave(instruction);
- |IntermediateCode.exit: EmitExit(instruction);
- |IntermediateCode.result:
- IF IsFloat(instruction.op1) & backend.forceFPU THEN
- EmitResultFPU(instruction)
- ELSE
- EmitResult(instruction);
- END;
- |IntermediateCode.return:
- IF IsFloat(instruction.op1) & backend.forceFPU THEN
- EmitReturnFPU(instruction)
- ELSE
- EmitReturn(instruction,Low);
- IF IsComplex(instruction.op1) THEN EmitReturn(instruction, High) END;
- END;
- |IntermediateCode.trap: EmitTrap(instruction);
- |IntermediateCode.br .. IntermediateCode.brlt: EmitBr(instruction)
- |IntermediateCode.pop:
- IF IsFloat(instruction.op1) THEN
- EmitPopFloat(instruction.op1)
- ELSE
- EmitPop(instruction.op1,Low);
- IF IsComplex(instruction.op1) THEN
- EmitPop(instruction.op1,High)
- END;
- END;
- |IntermediateCode.push:
- IF IsFloat(instruction.op1) THEN
- EmitPushFloat(instruction.op1)
- ELSE
- IF IsComplex(instruction.op1) THEN
- EmitPush(instruction.op1,High);
- END;
- EmitPush(instruction.op1,Low)
- END;
- |IntermediateCode.neg:
- IF IsFloat(instruction.op1) THEN
- IF backend.forceFPU THEN
- EmitArithmetic2FPU(instruction,InstructionSet.opFCHS)
- ELSE
- EmitNegXMM(instruction)
- END;
- ELSE EmitNeg(instruction);
- END;
- |IntermediateCode.not:
- Assert(~IsFloat(instruction.op1),"instruction not supported for float");
- EmitArithmetic2(instruction,Low,InstructionSet.opNOT);
- IF IsComplex(instruction.op1) THEN EmitArithmetic2(instruction, High, InstructionSet.opNOT) END;
- |IntermediateCode.abs:
- IF IsFloat(instruction.op1) THEN
- IF backend.forceFPU THEN
- EmitArithmetic2FPU(instruction,InstructionSet.opFABS)
- ELSE
- EmitAbsXMM(instruction)
- END;
- ELSE EmitAbs(instruction);
- END;
- |IntermediateCode.mul:
- IF IsFloat(instruction.op1) THEN
- IF backend.forceFPU THEN
- EmitArithmetic3FPU(instruction,InstructionSet.opFMUL)
- ELSE
- EmitArithmetic3XMM(instruction, InstructionSet.opMULSS, InstructionSet.opMULSD)
- END;
- ELSE
- EmitMul(instruction);
- END;
- |IntermediateCode.div:
- IF IsFloat(instruction.op1 )THEN
- IF backend.forceFPU THEN
- EmitArithmetic3FPU(instruction,InstructionSet.opFDIV)
- ELSE
- EmitArithmetic3XMM(instruction, InstructionSet.opDIVSS, InstructionSet.opDIVSD)
- END;
- ELSE
- EmitDivMod(instruction);
- END;
- |IntermediateCode.mod:
- Assert(~IsFloat(instruction.op1),"instruction not supported for float");
- EmitDivMod(instruction);
- |IntermediateCode.sub:
- IF IsFloat(instruction.op1) THEN
- IF backend.forceFPU THEN
- EmitArithmetic3FPU(instruction,InstructionSet.opFSUB)
- ELSE
- EmitArithmetic3XMM(instruction, InstructionSet.opSUBSS, InstructionSet.opSUBSD)
- END;
- ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opSUB);
- IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opSBB) END;
- END;
- |IntermediateCode.add:
- IF IsFloat(instruction.op1) THEN
- IF backend.forceFPU THEN
- EmitArithmetic3FPU(instruction,InstructionSet.opFADD)
- ELSE
- EmitArithmetic3XMM(instruction, InstructionSet.opADDSS, InstructionSet.opADDSD)
- END;
- ELSE EmitArithmetic3Part(instruction,Low,InstructionSet.opADD);
- IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, InstructionSet.opADC) END;
- END;
- |IntermediateCode.and:
- Assert(~IsFloat(instruction.op1),"operation not defined on float");
- EmitArithmetic3(instruction,InstructionSet.opAND);
- |IntermediateCode.or:
- Assert(~IsFloat(instruction.op1),"operation not defined on float");
- EmitArithmetic3(instruction,InstructionSet.opOR);
- |IntermediateCode.xor:
- Assert(~IsFloat(instruction.op1),"operation not defined on float");
- EmitArithmetic3(instruction,InstructionSet.opXOR);
- |IntermediateCode.shl: EmitShift(instruction);
- |IntermediateCode.shr: EmitShift(instruction);
- |IntermediateCode.rol: EmitShift(instruction);
- |IntermediateCode.ror: EmitShift(instruction);
- |IntermediateCode.cas: EmitCas(instruction);
- |IntermediateCode.copy: EmitCopy(instruction);
- |IntermediateCode.fill: EmitFill(instruction,FALSE);
- |IntermediateCode.asm: EmitAsm(instruction);
- END;
- ReserveOperandRegisters(instruction.op3,FALSE); ReserveOperandRegisters(instruction.op2,FALSE); ReserveOperandRegisters(instruction.op1,FALSE);
- END Generate;
- PROCEDURE PostGenerate*(CONST instruction: IntermediateCode.Instruction);
- VAR ticket: Ticket;
- BEGIN
- TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
- ticket := tickets.live;
- WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
- UnmapTicket(ticket);
- ticket := tickets.live
- END;
- END PostGenerate;
- (* enter procedure: generate PAF and clear stack *)
- PROCEDURE EmitEnter(CONST instruction: IntermediateCode.Instruction);
- VAR op1,imm,target: Assembler.Operand; cc,size,numberMachineWords,destPC,firstPC,secondPC,x: LONGINT; body: SyntaxTree.Body; name: Basic.SegmentedName;
- parametersSize: SIZE;
- CONST initialize=TRUE; FirstOffset = 5; SecondOffset = 11;
- BEGIN
- stackSize := SHORT(instruction.op2.intValue);
- size := stackSize;
- INC(traceStackSize, stackSize);
-
- IF initialize THEN
- (* always including this instruction make trace insertion possible *)
- IF backend.traceable THEN
- emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
- END;
- ASSERT(size MOD opRA.sizeInBytes = 0);
- numberMachineWords := size DIV opRA.sizeInBytes;
- IF numberMachineWords >0 THEN
- IF ~backend.traceable THEN
- emitter.Emit2(InstructionSet.opXOR,opRA,opRA);
- END;
- WHILE numberMachineWords MOD 4 # 0 DO
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- DEC(numberMachineWords);
- END;
- IF numberMachineWords >4 THEN
- Assembler.InitImm(imm, 0, numberMachineWords DIV 4);
- (* do not use EBX because it is not volative in WINAPI, do not use ECX: special register in COOP, do not use RD: register param in SysVABI *)
- IF cpuBits = 64 THEN
- emitter.Emit2(InstructionSet.opMOV, opR10, imm);
- destPC := out.pc;
- emitter.Emit1(InstructionSet.opDEC, opR10);
- ELSE
- emitter.Emit2(InstructionSet.opMOV, opRD, imm);
- destPC := out.pc;
- emitter.Emit1(InstructionSet.opDEC, opRD);
- END;
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- Assembler.InitOffset8(target,destPC);
- emitter.Emit1(InstructionSet.opJNZ, target)
- ELSE
- WHILE numberMachineWords >0 DO
- emitter.Emit1(InstructionSet.opPUSH, opRA);
- DEC(numberMachineWords);
- END;
- END;
- END;
- ModifyStackPointer (spillStack.MaxSize()*cpuBits DIV 8);
- ELSE
- ModifyStackPointer (size + spillStack.MaxSize());
- END;
- cc := SHORT(instruction.op1.intValue);
- IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
- IF cpuBits = 32 THEN
- (* the winapi calling convention presumes that all registers except EAX, EDX and ECX are retained by the callee *)
- emitter.Emit1(InstructionSet.opPUSH,opEBX);
- emitter.Emit1(InstructionSet.opPUSH,opEDI);
- emitter.Emit1(InstructionSet.opPUSH,opESI);
- ELSE ASSERT(cpuBits =64);
- emitter.Emit1(InstructionSet.opPUSH,opRB);
- emitter.Emit1(InstructionSet.opPUSH,opRDI);
- emitter.Emit1(InstructionSet.opPUSH,opRSI);
- emitter.Emit1(InstructionSet.opPUSH,opR12);
- emitter.Emit1(InstructionSet.opPUSH,opR13);
- emitter.Emit1(InstructionSet.opPUSH,opR14);
- emitter.Emit1(InstructionSet.opPUSH,opR15);
- END;
- END;
- spillStackStart := stackSize;
- END EmitEnter;
- PROCEDURE EmitLeave(CONST instruction: IntermediateCode.Instruction);
- VAR cc: LONGINT; offset: Assembler.Operand;
- BEGIN
- cc := SHORT(instruction.op1.intValue);
- IF (cc = SyntaxTree.WinAPICallingConvention) OR (cc = SyntaxTree.CCallingConvention) THEN
- IF cpuBits = 32 THEN
- emitter.Emit1(InstructionSet.opPOP,opESI);
- emitter.Emit1(InstructionSet.opPOP,opEDI);
- emitter.Emit1(InstructionSet.opPOP,opEBX);
- ELSE ASSERT(cpuBits =64);
- emitter.Emit1(InstructionSet.opPOP,opR15);
- emitter.Emit1(InstructionSet.opPOP,opR14);
- emitter.Emit1(InstructionSet.opPOP,opR13);
- emitter.Emit1(InstructionSet.opPOP,opR12);
- emitter.Emit1(InstructionSet.opPOP,opRSI);
- emitter.Emit1(InstructionSet.opPOP,opRDI);
- emitter.Emit1(InstructionSet.opPOP,opRB);
- END;
-
- END;
- END EmitLeave;
- PROCEDURE EmitExit(CONST instruction: IntermediateCode.Instruction);
- VAR parSize,cc: LONGINT; operand: Assembler.Operand;
- BEGIN
- cc := SHORT(instruction.op2.intValue);
- parSize := SHORT(instruction.op3.intValue);
- IF (parSize = 0) OR (cc = SyntaxTree.WinAPICallingConvention) & (cpuBits = 64) THEN
- emitter.Emit0(InstructionSet.opRET)
- ELSE (* e.g. for WINAPI calling convention *)
- operand := Assembler.NewImm16(parSize);
- emitter.Emit1(InstructionSet.opRET,operand)
- END;
- IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared") END;
- END EmitExit;
- PROCEDURE EmitReturnFPU(CONST instruction: IntermediateCode.Instruction);
- VAR operand: Assembler.Operand;
- BEGIN
- IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,Low, ST0) THEN
- (* nothing to do: result is already in return register *)
- ELSE
- MakeOperand(instruction.op1, Low, operand,NIL);
- emitter.Emit1(InstructionSet.opFLD,operand);
- (*
- not necessary to clear from top of stack as callee will clear
- INC(fpStackPointer);
- emitter.Emit1(InstructionSet.opFSTP,registerOperands[ST0+1]);
- DEC(fpStackPointer);
- *)
- END;
- END EmitReturnFPU;
- (* return operand
- store operand in return register or on fp stack
- *)
- PROCEDURE EmitReturn(CONST instruction: IntermediateCode.Instruction; part: LONGINT);
- VAR return,operand: Assembler.Operand; register: LONGINT; ticket: Ticket; type: IntermediateCode.Type;
- BEGIN
- register := ResultRegister(instruction.op1.type, part);
- IF IsRegister(instruction.op1) & MappedTo(instruction.op1.register,part, register) THEN
- (* nothing to do: result is already in return register *)
- ELSE
- GetPartType(instruction.op1.type,part, type);
- MakeOperand(instruction.op1, part, operand,NIL);
- Spill(physicalRegisters.Mapped(register));
- ticket := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,type,register,inPC);
- TicketToOperand(ticket, return);
- (* Mov takes care of potential register overlaps *)
- Move(return, operand, type);
- UnmapTicket(ticket);
- END;
- END EmitReturn;
- PROCEDURE EmitMovFloat(CONST vdest,vsrc:IntermediateCode.Operand);
- VAR dest,src, espm: Assembler.Operand; sizeInBytes: SHORTINT; stackSize: LONGINT; vcopy: IntermediateCode.Operand;
- BEGIN
- sizeInBytes := SHORTINT(vdest.type.sizeInBits DIV 8);
- stackSize := sizeInBytes;
- Basic.Align(stackSize, cpuBits DIV 8);
- IF vdest.type.form IN IntermediateCode.Integer THEN
- (* e.g. in SYSTEM.VAL(LONGINT, r) *)
- IF vsrc.mode = IntermediateCode.ModeMemory THEN
- vcopy := vsrc; IntermediateCode.SetType(vcopy,vdest.type);
- EmitMov(vdest, vcopy,Low);
- IF IsComplex(vdest) THEN
- EmitMov(vdest,vcopy,High);
- END;
- ELSE
- IF backend.forceFPU THEN
- MakeOperand(vsrc,Low,src,NIL);
- emitter.Emit1(InstructionSet.opFLD,src);
- INC(fpStackPointer);
- IF vdest.mode = IntermediateCode.ModeMemory THEN
- MakeOperand(vdest,Low,dest,NIL);
- Assembler.SetSize(dest,sizeInBytes);
- emitter.Emit1(InstructionSet.opFSTP,dest);
- DEC(fpStackPointer);
- ELSE
- ModifyStackPointer(stackSize);
- Assembler.InitMem(espm, sizeInBytes,SP,0);
- emitter.Emit1(InstructionSet.opFSTP,espm);
- DEC(fpStackPointer);
- MakeOperand(vdest,Low,dest,NIL);
- EmitPop(vdest,Low);
- IF IsComplex(vdest) THEN
- EmitPop(vdest,High);
- END;
- END;
- ELSE
- MakeOperand(vsrc, Low, src, NIL);
- IF vdest.mode = IntermediateCode.ModeMemory THEN
- MakeOperand(vdest, Low, dest, NIL);
- Move(dest, src, vsrc.type);
- ELSE (* need temporary stack argument *)
- ModifyStackPointer(stackSize);
- Assembler.InitMem(espm, sizeInBytes,SP,0);
- Move(espm, src, vsrc.type);
- MakeOperand(vdest,Low,dest,NIL);
- EmitPop(vdest,Low);
- IF IsComplex(vdest) THEN
- EmitPop(vdest,High);
- END;
- END;
- END;
- END;
- ELSIF vsrc.type.form IN IntermediateCode.Integer THEN
- (* e.g. in SYSTEM.VAL(REAL, i) *)
- IF vdest.mode = IntermediateCode.ModeMemory THEN
- vcopy := vdest; IntermediateCode.SetType(vcopy,vsrc.type);
- EmitMov(vcopy, vsrc,Low);
- IF IsComplex(vsrc) THEN
- EmitMov(vcopy,vsrc,High);
- END;
- ELSE
- IF backend.forceFPU THEN
- IF vsrc.mode = IntermediateCode.ModeMemory THEN
- MakeOperand(vsrc,Low,src,NIL);
- Assembler.SetSize(src,sizeInBytes);
- emitter.Emit1(InstructionSet.opFLD,src);
- ELSE
- IF IsComplex(vsrc) THEN
- EmitPush(vsrc,High);
- END;
- EmitPush(vsrc,Low);
- Assembler.InitMem(espm, sizeInBytes,SP,0);
- emitter.Emit1(InstructionSet.opFLD,espm);
- ASSERT(sizeInBytes >0);
- ModifyStackPointer(-stackSize);
- END;
- INC(fpStackPointer);
- MakeOperand(vdest,Low,dest,NIL);
- emitter.Emit1(InstructionSet.opFSTP,dest);
- DEC(fpStackPointer);
- ELSE
- IF vsrc.mode = IntermediateCode.ModeMemory THEN
- MakeOperand(vsrc,Low,src,NIL);
- Assembler.SetSize(src,sizeInBytes);
- MakeOperand(vdest,Low,dest,NIL);
- Move(dest, src, vdest.type);
- ELSE
- IF IsComplex(vsrc) THEN
- EmitPush(vsrc,High);
- END;
- EmitPush(vsrc,Low);
- Assembler.InitMem(espm, sizeInBytes,SP,0);
- MakeOperand(vdest, Low, dest, NIL);
- Move(dest, espm, vdest.type);
- ModifyStackPointer(-stackSize);
- END;
- END;
- END;
- ELSE
- IF backend.forceFPU THEN
- MakeOperand(vsrc,Low,src,NIL);
- emitter.Emit1(InstructionSet.opFLD,src);
- INC(fpStackPointer);
- MakeOperand(vdest,Low,dest,NIL);
- emitter.Emit1(InstructionSet.opFSTP,dest);
- DEC(fpStackPointer);
- ELSE
- MakeOperand(vsrc, Low, src, NIL);
- MakeOperand(vdest, Low, dest, NIL);
- Move(dest, src, vdest.type)
- END;
- END;
- END EmitMovFloat;
- PROCEDURE EmitMov(CONST vdest,vsrc: IntermediateCode.Operand; part: LONGINT);
- VAR op1,op2: Assembler.Operand; tmp: IntermediateCode.Operand;
- t: CodeGenerators.Ticket;
- type: IntermediateCode.Type;
- offset: LONGINT;
- BEGIN
- IF (vdest.mode = IntermediateCode.ModeRegister) & (vsrc.mode = IntermediateCode.ModeRegister) & (vsrc.type.sizeInBits > 8) & (vsrc.offset # 0)THEN
- (* MOV R1, R2+offset => LEA EAX, [EBX+offset] *)
- tmp := vsrc;
- IntermediateCode.MakeMemory(tmp,vsrc.type);
- MakeOperand(tmp,part,op2,NIL);
- (*
- ReleaseHint(op2.register);
- *)
- MakeOperand(vdest,part,op1,NIL);
- t := virtualRegisters.Mapped(vdest.register,part);
- IF (t # NIL) & (t.spilled) THEN
- UnSpill(t); (* make sure this has not spilled *)
- MakeOperand(vdest,part, op1,NIL);
- END;
- emitter.Emit2(InstructionSet.opLEA,op1,op2);
- ELSE
- MakeOperand(vsrc,part,op2,NIL);
- MakeOperand(vdest,part,op1,NIL);
- GetPartType(vsrc.type, part, type);
- Move(op1,op2, type);
- END;
- END EmitMov;
- PROCEDURE EmitConvertFloat(CONST instruction: IntermediateCode.Instruction);
- VAR destType, srcType, dtype: IntermediateCode.Type; dest,src,espm,imm: Assembler.Operand; sizeInBytes, index: LONGINT;
- temp, temp2, temp3, temp4, zero: Assembler.Operand; ticket: Ticket; vdest, vsrc: IntermediateCode.Operand;
- unsigned: BOOLEAN;
- BEGIN
- vdest := instruction.op1; vsrc := instruction.op2;
- srcType := vsrc.type;
- destType := vdest.type;
- IF destType.form = IntermediateCode.Float THEN
- CASE srcType.form OF
- |IntermediateCode.Float: (* just a move *)
- IF backend.forceFPU THEN
- EmitMovFloat(vdest, vsrc);
- ELSE
- MakeOperand(vsrc,Low,src,NIL);
- MakeOperand(vdest, Low, dest, NIL);
- IF srcType.sizeInBits = 32 THEN
- SpecialMove(InstructionSet.opCVTSS2SD, InstructionSet.opMOVSS, FALSE, dest, src, destType)
- ELSE
- SpecialMove(InstructionSet.opCVTSD2SS, InstructionSet.opMOVSD, FALSE, dest, src, destType)
- END;
- END;
- |IntermediateCode.SignedInteger, IntermediateCode.UnsignedInteger:
- (* put value to stack and then read from stack via Float *)
- unsigned := srcType.form = IntermediateCode.UnsignedInteger;
- IF vsrc.type.sizeInBits < IntermediateCode.Bits32 THEN
- MakeOperand(vsrc,Low,src,NIL);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
- TicketToOperand(ticket,temp);
- IF unsigned THEN
- emitter.Emit2(InstructionSet.opMOVZX,temp,src);
- ELSE
- emitter.Emit2(InstructionSet.opMOVSX,temp,src);
- END;
- IF backend.forceFPU THEN (* via stack *)
- emitter.Emit1(InstructionSet.opPUSH,temp);
- UnmapTicket(ticket);
- sizeInBytes := temp.sizeInBytes;
- ELSE (* via register *)
- espm := temp;
- sizeInBytes := 0
- END;
- ELSIF IsComplex(vsrc) THEN (* via stack *)
- EmitPush(vsrc,High);
- EmitPush(vsrc,Low);
- sizeInBytes := 8
- ELSIF unsigned & (cpuBits=32) & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN (* UNSIGNED32 *)
- sizeInBytes := 8;
- Assembler.InitImm(zero,0,0);
- emitter.Emit1(InstructionSet.opPUSH,zero);
- EmitPush(vsrc,Low);
- ELSIF unsigned & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN (* UNSIGNED32 on 64-bit *)
- MakeRegister(vsrc, Low, src);
- index := src.register;
- index := index MOD 32 + RAX;
- src := registerOperands[index];
- espm := src;
- ELSE
- IF backend.forceFPU THEN (* via stack *)
- EmitPush(vsrc,Low);
- sizeInBytes := SHORTINT(cpuBits DIV 8);
- ELSE (* via memory or register *)
- sizeInBytes := 0;
- MakeOperand(vsrc,Low,src,NIL);
- IF Assembler.IsImmediateOperand(src) THEN (* use temporary register *)
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
- TicketToOperand(ticket,temp);
- IF unsigned THEN
- emitter.Emit2(InstructionSet.opMOVZX,temp,src);
- ELSE
- emitter.Emit2(InstructionSet.opMOVSX,temp,src);
- END;
- espm := temp
- ELSE
- espm := src
- END;
- END
- END;
- IF sizeInBytes > 0 THEN
- Assembler.InitMem(espm, SHORTINT(sizeInBytes),SP,0);
- END;
- IF backend.forceFPU THEN
- emitter.Emit1(InstructionSet.opFILD,espm);
- INC(fpStackPointer);
- ASSERT(sizeInBytes >0);
- Basic.Align(sizeInBytes, cpuBits DIV 8);
- ModifyStackPointer(-sizeInBytes);
- MakeOperand(vdest,Low,dest,NIL);
- emitter.Emit1(InstructionSet.opFSTP,dest);
- DEC(fpStackPointer);
- ELSIF IsComplex(vsrc) OR unsigned & (cpuBits=32) & ( vsrc.type.sizeInBits = IntermediateCode.Bits32) THEN
- emitter.Emit1(InstructionSet.opFILD,espm);
- MakeOperand(vdest,Low,dest,NIL);
- IF Assembler.IsMemoryOperand(dest) THEN
- emitter.Emit1(InstructionSet.opFSTP,dest);
- ELSE (* must be register *)
- emitter.Emit1(InstructionSet.opFSTP,espm);
- emitter.Emit2(InstructionSet.opMOVQ,dest,espm);
- IF destType.sizeInBits = 32 THEN
- emitter.Emit2(InstructionSet.opCVTSD2SS, dest,dest);
- END;
- END;
- ModifyStackPointer(-sizeInBytes);
- ELSE
- MakeOperand(vdest,Low,dest,NIL);
- IF destType.sizeInBits = 32 THEN
- emitter.Emit2(InstructionSet.opCVTSI2SS, dest, espm)
- ELSE
- emitter.Emit2(InstructionSet.opCVTSI2SD, dest, espm)
- END;
- ModifyStackPointer(-sizeInBytes);
- END;
- END;
- ELSE
- ASSERT(destType.form IN IntermediateCode.Integer);
- ASSERT(srcType.form = IntermediateCode.Float);
- Assert(vdest.type.form = IntermediateCode.SignedInteger, "no entier as result for unsigned integer");
- MakeOperand(vsrc,Low,src,NIL);
- IF ~backend.forceFPU THEN
- MakeOperand(vdest,Low,dest,ticket);
- GetTemporaryRegister(srcType, temp);
- GetTemporaryRegister(srcType, temp3);
- IF destType.sizeInBits < 32 THEN
- IntermediateCode.InitType(dtype, destType.form, 32);
- GetTemporaryRegister(dtype, temp4);
- ELSE
- dtype := destType;
- temp4 := dest;
- END;
- GetTemporaryRegister(dtype, temp2);
- IF srcType.sizeInBits = 32 THEN
- (* convert truncated -> negative numbers round up !*)
- emitter.Emit2(InstructionSet.opCVTTSS2SI, temp4, src);
- (* back to temporary mmx register *)
- emitter.Emit2(InstructionSet.opCVTSI2SS, temp, temp4);
- (* subtract *)
- emitter.Emit2(InstructionSet.opMOVSS, temp3, src);
- emitter.Emit2(InstructionSet.opSUBSS, temp3, temp);
- (* back to a GP register in order to determine the sign bit *)
- ELSE
- emitter.Emit2(InstructionSet.opCVTTSD2SI, temp4, src);
- emitter.Emit2(InstructionSet.opCVTSI2SD, temp, temp4);
- emitter.Emit2(InstructionSet.opMOVSD, temp3, src);
- emitter.Emit2(InstructionSet.opSUBSD, temp3, temp);
- emitter.Emit2(InstructionSet.opCVTSD2SS, temp3, temp3);
- END;
- emitter.Emit2(InstructionSet.opMOVD, temp2, temp3);
- Assembler.InitImm(imm, 0 ,srcType.sizeInBits-1);
- emitter.Emit2(InstructionSet.opBT, temp2, imm);
- Assembler.InitImm(imm, 0 ,0);
- emitter.Emit2(InstructionSet.opSBB, temp4, imm);
- IF dtype.sizeInBits # destType.sizeInBits THEN
- index := temp4.register;
- CASE destType.sizeInBits OF (* choose low part accordingly *)
- IntermediateCode.Bits8: index := index MOD 32 + AL;
- |IntermediateCode.Bits16: index := index MOD 32 + AX;
- |IntermediateCode.Bits32: index := index MOD 32 + EAX;
- END;
- temp4 := registerOperands[index];
- emitter.Emit2(InstructionSet.opMOV, dest, temp4);
- END
- ELSE
- emitter.Emit1(InstructionSet.opFLD,src); INC(fpStackPointer);
- MakeOperand(vdest,Low,dest,NIL);
- IF destType.sizeInBits = IntermediateCode.Bits64 THEN ModifyStackPointer(12) ELSE ModifyStackPointer(8) END;
- Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
- emitter.Emit1(InstructionSet.opFNSTCW,espm);
- emitter.Emit0(InstructionSet.opFWAIT);
- Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,0);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
- TicketToOperand(ticket,temp);
- emitter.Emit2(InstructionSet.opMOV,temp,espm);
- imm := Assembler.NewImm32(0F3FFH);
- emitter.Emit2(InstructionSet.opAND,temp,imm);
- imm := Assembler.NewImm32(0400H);
- emitter.Emit2(InstructionSet.opOR,temp,imm);
- Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
- emitter.Emit2(InstructionSet.opMOV,espm,temp);
- Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,4);
- emitter.Emit1(InstructionSet.opFLDCW,espm);
- IF destType.sizeInBits = IntermediateCode.Bits64 THEN
- Assembler.InitMem(espm,IntermediateCode.Bits64 DIV 8,SP,4);
- emitter.Emit1(InstructionSet.opFISTP,espm);DEC(fpStackPointer);
- emitter.Emit0(InstructionSet.opFWAIT);
- ELSE
- Assembler.InitMem(espm,IntermediateCode.Bits32 DIV 8,SP,4);
- emitter.Emit1(InstructionSet.opFISTP,espm); DEC(fpStackPointer);
- emitter.Emit0(InstructionSet.opFWAIT);
- END;
- Assembler.InitMem(espm,IntermediateCode.Bits16 DIV 8,SP,0);
- emitter.Emit1(InstructionSet.opFLDCW,espm);
- emitter.Emit1(InstructionSet.opPOP,temp);
- UnmapTicket(ticket);
- emitter.Emit1(InstructionSet.opPOP,dest);
- IF IsComplex(vdest) THEN
- MakeOperand(vdest,High,dest,NIL);
- emitter.Emit1(InstructionSet.opPOP,dest);
- END;
- END;
- END;
- END EmitConvertFloat;
- PROCEDURE EmitConvert(CONST vdest, vsrc: IntermediateCode.Operand; part: LONGINT);
- VAR destType, srcType: IntermediateCode.Type; op1,op2: Assembler.Operand; index: LONGINT; nul: Assembler.Operand;
- ticket: Ticket; vop: IntermediateCode.Operand; ediReserved, esiReserved: BOOLEAN;
- eax, edx: Ticket; symbol: ObjectFile.Identifier; offset: LONGINT;
- BEGIN
- GetPartType(vdest.type,part, destType);
- GetPartType(vsrc.type,part,srcType);
- ASSERT(vdest.type.form IN IntermediateCode.Integer);
- ASSERT(destType.form IN IntermediateCode.Integer);
- IF destType.sizeInBits < srcType.sizeInBits THEN (* SHORT *)
- ASSERT(part # High);
- MakeOperand(vdest,part,op1,NIL);
- IF vsrc.mode = IntermediateCode.ModeImmediate THEN
- vop := vsrc;
- IntermediateCode.SetType(vop,destType);
- MakeOperand(vop,part,op2,NIL);
- ELSE
- MakeOperand(vsrc,part,op2,NIL);
- IF Assembler.IsRegisterOperand(op1) & ((op1.register DIV 32 >0) (* not 8 bit register *) OR (op1.register DIV 16 = 0) & (physicalRegisters.Mapped(op1.register MOD 16 + AH)=free) (* low 8 bit register with free upper part *)) THEN
- (* try EAX <- EDI for dest = AL or AX, src=EDI *)
- index := op1.register;
- CASE srcType.sizeInBits OF
- IntermediateCode.Bits16: index := index MOD 32 + AX;
- |IntermediateCode.Bits32: index := index MOD 32 + EAX;
- |IntermediateCode.Bits64: index := index MOD 32 + RAX;
- END;
- op1 := registerOperands[index];
- ELSE
- (* reserve register with a low part *)
- IF destType.sizeInBits=8 THEN (* make sure that allocated temporary register has a low part with 8 bits, i.e. exclude ESI or EDI *)
- ediReserved := physicalRegisters.Reserved(EDI);
- esiReserved := physicalRegisters.Reserved(ESI);
- physicalRegisters.SetReserved(EDI,TRUE); physicalRegisters.SetReserved(ESI,TRUE);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* register with low part *)
- physicalRegisters.SetReserved(EDI,ediReserved); physicalRegisters.SetReserved(ESI,esiReserved);
- ELSE
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,srcType); (* any register with low part *)
- END;
- MakeOperand(vsrc,part,op2,ticket); (* stores op2 in ticket register *)
- index := op2.register;
- CASE destType.sizeInBits OF (* choose low part accordingly *)
- IntermediateCode.Bits8: index := index MOD 32 + AL;
- |IntermediateCode.Bits16: index := index MOD 32 + AX;
- |IntermediateCode.Bits32: index := index MOD 32 + EAX;
- END;
- op2 := registerOperands[index];
- END;
- Move(op1,op2,PhysicalOperandType(op1));
- END;
- ELSIF destType.sizeInBits > srcType.sizeInBits THEN (* (implicit) LONG *)
- IF part = High THEN
- IF destType.form = IntermediateCode.SignedInteger THEN
- Spill(physicalRegisters.Mapped(EAX));
- eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
- Spill(physicalRegisters.Mapped(EDX));
- edx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
- IF vsrc.type.sizeInBits < 32 THEN
- MakeOperand(vsrc,Low,op2,NIL);
- SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, opEAX,op2,PhysicalOperandType(opEAX));
- ELSE
- MakeOperand(vsrc,Low,op2,eax);
- END;
- emitter.Emit0(InstructionSet.opCDQ);
- MakeOperand(vdest,High,op1,NIL);
- emitter.Emit2(InstructionSet.opMOV,op1,opEDX);
- UnmapTicket(eax); UnmapTicket(edx);
- ELSE
- MakeOperand(vdest,part,op1,NIL);
- IF (vdest.mode = IntermediateCode.ModeRegister) THEN
- emitter.Emit2(InstructionSet.opXOR,op1,op1)
- ELSE
- Assembler.InitImm(nul,0,0);
- emitter.Emit2(InstructionSet.opMOV,op1,nul);
- END;
- END;
- ELSE
- ASSERT(part=Low);
- MakeOperand(vdest,part,op1,NIL);
- MakeOperand(vsrc,part,op2,NIL);
- IF srcType.sizeInBits = destType.sizeInBits THEN
- Move(op1,op2,PhysicalOperandType(op1));
- ELSIF srcType.form = IntermediateCode.SignedInteger THEN
- IF srcType.sizeInBits=32 THEN (* 64 bits only *)
- ASSERT(cpuBits=64);
- SpecialMove(InstructionSet.opMOVSXD,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
- ELSE
- SpecialMove(InstructionSet.opMOVSX,InstructionSet.opMOV, FALSE, op1,op2,PhysicalOperandType(op1));
- END;
- ELSE
- ASSERT(srcType.form = IntermediateCode.UnsignedInteger);
- IF srcType.sizeInBits=32 THEN (* 64 bits only *)
- ASSERT(cpuBits=64);
- IF Assembler.IsRegisterOperand(op1) THEN
- Move( registerOperands[op1.register MOD 32 + EAX], op2,srcType);
- ELSE
- ASSERT(Assembler.IsMemoryOperand(op1));
- symbol := op1.symbol; offset := op1.offset;
- Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement);
- Assembler.SetSymbol(op1,symbol.name,symbol.fingerprint,offset,op1.displacement);
- Move( op1, op2, srcType);
- Assembler.InitMem(op1,Assembler.bits32,op1.register, op1.displacement+Assembler.bits32);
- Assembler.SetSymbol(op1,symbol.name, symbol.fingerprint,offset,op1.displacement);
- Assembler.InitImm(op2,0,0);
- Move( op1, op2,srcType);
- END;
- ELSE
- SpecialMove(InstructionSet.opMOVZX, InstructionSet.opMOV, FALSE, op1, op2,PhysicalOperandType(op1))
- END;
- END;
- END;
- ELSE (* destType.sizeInBits = srcType.sizeInBits) *)
- EmitMov(vdest,vsrc,part);
- END;
- END EmitConvert;
- PROCEDURE EmitResult(CONST instruction: IntermediateCode.Instruction);
- VAR result, resultHigh, op, opHigh: Assembler.Operand; register, highRegister: LONGINT; lowReserved, highReserved: BOOLEAN; type: IntermediateCode.Type;
- BEGIN
- IF ~IsComplex(instruction.op1) THEN
- register := ResultRegister(instruction.op1.type,Low);
- result := registerOperands[register];
- MakeOperand(instruction.op1,Low,op,NIL);
- GetPartType(instruction.op1.type, Low, type);
- Move(op,result,type);
- ELSE
- register := ResultRegister(instruction.op1.type,Low);
- result := registerOperands[register];
- highRegister := ResultRegister(instruction.op1.type, High);
- resultHigh := registerOperands[highRegister];
- (* make sure that result registers are not used during emission of Low / High *)
- lowReserved := physicalRegisters.Reserved(register);
- physicalRegisters.SetReserved(register, TRUE);
- highReserved := physicalRegisters.Reserved(highRegister);
- physicalRegisters.SetReserved(highRegister,TRUE);
-
- MakeOperand(instruction.op1,Low,op, NIL);
- IF Assembler.SameOperand(op, resultHigh) THEN
- emitter.Emit2(InstructionSet.opXCHG, result, resultHigh); (* low register already mapped ok *)
- MakeOperand(instruction.op1, High, opHigh, NIL);
- GetPartType(instruction.op1.type, High, type);
- Move(opHigh, result, type);
- ELSE
- GetPartType(instruction.op1.type, Low, type);
- Move(op, result, type);
- MakeOperand(instruction.op1,High, opHigh, NIL);
- GetPartType(instruction.op1.type, High, type);
- Move(opHigh, resultHigh, type);
- END;
- physicalRegisters.SetReserved(register, lowReserved);
- physicalRegisters.SetReserved(highRegister, highReserved);
- END;
- END EmitResult;
- PROCEDURE EmitResultFPU(CONST instruction: IntermediateCode.Instruction);
- VAR op: Assembler.Operand;
- BEGIN
- INC(fpStackPointer); (* callee has left the result on top of stack, don't have to allocate here *)
- MakeOperand(instruction.op1,Low,op,NIL);
- emitter.Emit1(InstructionSet.opFSTP,op);
- DEC(fpStackPointer);
- (*
- UnmapTicket(ticket);
- *)
- END EmitResultFPU;
- PROCEDURE EmitCall(CONST instruction: IntermediateCode.Instruction);
- VAR fixup: Sections.Section; target, op: Assembler.Operand;
- code: SyntaxTree.Code; emitterFixup,newFixup: BinaryCode.Fixup; resolved: BinaryCode.Section; pc: LONGINT;
- BEGIN
- IF fpStackPointer # 0 THEN Error(instruction.textPosition,"compiler implementation error: fp stack not cleared before call") END;
- IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
- fixup := module.allSections.FindByName(instruction.op1.symbol.name);
- IF (fixup # NIL) & (fixup.type = Sections.InlineCodeSection) THEN
- pc := out.pc;
- (* resolved must be available at this point ! *)
- resolved := fixup(IntermediateCode.Section).resolved;
- IF resolved # NIL THEN
- emitter.code.CopyBits(resolved.os.bits,0,resolved.os.bits.GetSize());
- emitterFixup := resolved.fixupList.firstFixup;
- WHILE (emitterFixup # NIL) DO
- newFixup := BinaryCode.NewFixup(emitterFixup.mode,emitterFixup.offset+pc,emitterFixup.symbol,emitterFixup.symbolOffset,emitterFixup.displacement,emitterFixup.scale,emitterFixup.pattern);
- out.fixupList.AddFixup(newFixup);
- emitterFixup := emitterFixup.nextFixup;
- END;
- END;
- ELSIF cpuBits = 64 THEN
- MakeOperand(instruction.op1,Low,op,NIL);
- emitter.Emit1(InstructionSet.opCALL,op);
- ModifyStackPointer (-instruction.op2.intValue);
- ELSE
- Assembler.InitOffset32(target,instruction.op1.intValue);
- Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.offset,0);
- emitter.Emit1(InstructionSet.opCALL,target);
- ModifyStackPointer (-instruction.op2.intValue);
- END;
- ELSE
- MakeOperand(instruction.op1,Low,op,NIL);
- emitter.Emit1(InstructionSet.opCALL,op);
- ModifyStackPointer (-instruction.op2.intValue);
- END;
- END EmitCall;
- (*
- register allocation
- instruction dest, src1, src2
- preconditions
- dest is memory operand or dest is register with offset = 0
- src1 and src2 may be immediates, registers with or without offset and memory operands
- 1.) translation into two-operand code
- a) dest = src1 (no assumption on src2, src2=src1 is permitted )
- i) dest and src2 are both memory operands or src2 is a register with offset # 0
- alloc temp register
- mov temp, src2
- instruction2 dest, temp
- ii) dest or src2 is not a memory operand
- instruction2 dest, src2
- b) dest = src2
- => src2 is not a register with offset # 0
- alloc temp register
- mov dest, src1
- mov temp, src2
- instruction2 dest, temp
- c) dest # src2
- mov dest, src1
- i) dest and src2 are both memory operands or src2 is a register with offset # 0
- allocate temp register
- mov temp, src2
- instruction2 dest, temp
- ii)
- instruction2 dest, src2
- 1'.) translation into one operand code
- instruction dest, src1
- a) dest = src1
- => src1 is not a register with offset # 0
- instruction1 dest
- b) dest # src1
- mov dest, src1
- instruction1 dest
- 2.) register allocation
- precondition: src1 and src2 are already allocated
- a) dest is already allocated
- go on according to 1.
- b) dest needs to be allocated
- check if register is free
- i) yes: allocate free register and go on with 1.
- ii) no: spill last register in livelist, map register and go on with 1.
- *)
- PROCEDURE PrepareOp3(CONST instruction: IntermediateCode.Instruction;part: LONGINT; VAR left, right: Assembler.Operand; VAR ticket: Ticket);
- VAR vop1,vop2, vop3: IntermediateCode.Operand; op1,op2,op3,temp: Assembler.Operand; type: IntermediateCode.Type;
- t: Ticket;
- BEGIN
- ticket := NIL;
- GetPartType(instruction.op1.type,part,type);
- vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
- IF IntermediateCode.OperandEquals(vop1,vop3) & (IntermediateCode.Commute23 IN IntermediateCode.instructionFormat[instruction.opcode].flags) THEN
- vop3 := instruction.op2; vop2 := instruction.op3;
- END;
- MakeOperand(vop3,part, op3,NIL);
- IF (vop1.mode = IntermediateCode.ModeRegister) & (~IsMemoryOperand(vop1,part)) & (vop1.register # vop3.register) THEN
- IF (vop2.mode = IntermediateCode.ModeRegister) & (vop2.register = vop1.register) & (vop2.offset = 0) THEN
- (* same register *)
- MakeOperand(vop1,part, op1,NIL);
- ELSE
- MakeOperand(vop2,part, op2,NIL);
- (*
- ReleaseHint(op2.register);
- *)
- MakeOperand(vop1,part, op1,NIL);
- Move(op1, op2, type);
- t := virtualRegisters.Mapped(vop1.register,part);
- IF (t # NIL) & (t.spilled) THEN
- UnSpill(t); (* make sure this has not spilled *)
- MakeOperand(vop1,part, op1,NIL);
- END;
- END;
- left := op1; right := op3;
- ELSIF IntermediateCode.OperandEquals(vop1,vop2) & (~IsMemoryOperand(vop1,part) OR ~IsMemoryOperand(vop3,part)) THEN
- MakeOperand(vop1,part, op1,NIL);
- left := op1; right := op3;
- ELSE
- MakeOperand(vop1,part, op1,NIL);
- MakeOperand(vop2,part, op2,NIL);
- (*ReleaseHint(op2.register);*)
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
- TicketToOperand(ticket,temp);
- Move(temp, op2, type);
- left := temp; right := op3;
- END;
- END PrepareOp3;
- PROCEDURE PrepareOp2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; VAR left: Assembler.Operand;VAR ticket: Ticket);
- VAR op2: Assembler.Operand; imm: Assembler.Operand; sizeInBits: INTEGER; type: IntermediateCode.Type;
- BEGIN
- ticket := NIL;
- GetPartType(instruction.op1.type,part,type);
- IF (instruction.op1.mode = IntermediateCode.ModeRegister) THEN
- MakeOperand(instruction.op1,part,left,NIL);
- MakeOperand(instruction.op2,part,op2,NIL);
- IF (instruction.op2.mode = IntermediateCode.ModeRegister) & (instruction.op2.register = instruction.op1.register) & (instruction.op2.offset = 0) THEN
- ELSE
- Move(left, op2, type);
- IF (instruction.op2.offset # 0) & ~IsMemoryOperand(instruction.op2,part) THEN
- GetPartType(instruction.op2.type,part,type);
- sizeInBits := type.sizeInBits;
- Assembler.InitImm(imm,0,instruction.op2.offset);
- emitter.Emit2(InstructionSet.opADD,left,imm);
- END;
- END;
- ELSIF IntermediateCode.OperandEquals(instruction.op1,instruction.op2) & ((instruction.op1.mode # IntermediateCode.ModeMemory) OR (instruction.op3.mode # IntermediateCode.ModeMemory)) THEN
- MakeOperand(instruction.op1,part,left,NIL);
- ELSE
- MakeOperand(instruction.op2,part, op2,NIL);
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,type);
- TicketToOperand(ticket,left);
- Move(left, op2, type);
- END;
- END PrepareOp2;
- PROCEDURE FinishOp(CONST vop: IntermediateCode.Operand; part: LONGINT; left: Assembler.Operand; ticket: Ticket);
- VAR op1: Assembler.Operand;
- BEGIN
- IF ticket # NIL THEN
- MakeOperand(vop,part, op1,NIL);
- Move(op1,left,vop.type);
- UnmapTicket(ticket);
- END;
- END FinishOp;
- PROCEDURE EmitArithmetic3Part(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
- VAR left,right: Assembler.Operand; ticket: Ticket;
- BEGIN
- PrepareOp3(instruction, part, left,right,ticket);
- emitter.Emit2(opcode,left,right);
- FinishOp(instruction.op1,part,left,ticket);
- END EmitArithmetic3Part;
- PROCEDURE EmitArithmetic3(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
- BEGIN
- EmitArithmetic3Part(instruction,Low,opcode);
- IF IsComplex(instruction.op1) THEN EmitArithmetic3Part(instruction, High, opcode) END;
- END EmitArithmetic3;
- PROCEDURE EmitArithmetic3XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
- VAR op: LONGINT;
- BEGIN
- IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
- EmitArithmetic3Part(instruction, Low, op);
- END EmitArithmetic3XMM;
- PROCEDURE EmitArithmetic2(CONST instruction: IntermediateCode.Instruction; part: LONGINT; opcode: LONGINT);
- VAR left:Assembler.Operand;ticket: Ticket;
- BEGIN
- PrepareOp2(instruction,part,left,ticket);
- emitter.Emit1(opcode,left);
- FinishOp(instruction.op1,part,left,ticket);
- END EmitArithmetic2;
- PROCEDURE EmitArithmetic2XMM(CONST instruction: IntermediateCode.Instruction; op32, op64: LONGINT);
- VAR op: LONGINT;
- BEGIN
- IF instruction.op1.type.sizeInBits = 32 THEN op := op32 ELSE op := op64 END;
- EmitArithmetic2(instruction, Low, op);
- END EmitArithmetic2XMM;
- PROCEDURE EmitArithmetic3FPU(CONST instruction: IntermediateCode.Instruction; op: LONGINT);
- VAR op1,op2,op3: Assembler.Operand;
- BEGIN
- MakeOperand(instruction.op2,Low,op2,NIL);
- emitter.Emit1(InstructionSet.opFLD,op2);
- INC(fpStackPointer);
- MakeOperand(instruction.op3,Low,op3,NIL);
- IF instruction.op3.mode = IntermediateCode.ModeRegister THEN
- emitter.Emit2(op,opST0,op3);
- ELSE
- emitter.Emit1(op,op3);
- END;
- MakeOperand(instruction.op1,Low,op1,NIL);
- emitter.Emit1(InstructionSet.opFSTP,op1);
- DEC(fpStackPointer);
- END EmitArithmetic3FPU;
- PROCEDURE EmitArithmetic2FPU(CONST instruction: IntermediateCode.Instruction; opcode: LONGINT);
- VAR op1,op2: Assembler.Operand;
- BEGIN
- MakeOperand(instruction.op2,Low,op2,NIL);
- emitter.Emit1(InstructionSet.opFLD,op2);
- INC(fpStackPointer);
- emitter.Emit0(opcode);
- MakeOperand(instruction.op1,Low,op1,NIL);
- emitter.Emit1(InstructionSet.opFSTP,op1);
- DEC(fpStackPointer);
- END EmitArithmetic2FPU;
- PROCEDURE EmitMul(CONST instruction: IntermediateCode.Instruction);
- VAR op1,op2,op3,temp: Assembler.Operand; ra,rd: Ticket;
- value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
- inst: IntermediateCode.Instruction;
- BEGIN
- IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
- IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
- IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shl, instruction.op1, instruction.op2, iop3);
- EmitShift(inst);
- RETURN;
- END;
- ASSERT(~IsComplex(instruction.op1));
- ASSERT(instruction.op1.type.form IN IntermediateCode.Integer);
- IF (instruction.op1.type.sizeInBits = IntermediateCode.Bits8) THEN
- Spill(physicalRegisters.Mapped(AL));
- Spill(physicalRegisters.Mapped(AH));
- ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
- rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AH,inPC);
- MakeOperand(instruction.op1,Low,op1,NIL);
- MakeOperand(instruction.op2,Low,op2,ra);
- IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
- MakeOperand(instruction.op3,Low,op3,rd);
- ELSE
- MakeOperand(instruction.op3,Low,op3,NIL);
- END;
- emitter.Emit1(InstructionSet.opIMUL,op3);
- emitter.Emit2(InstructionSet.opMOV,op1,opAL);
- UnmapTicket(ra);
- UnmapTicket(rd);
- ELSE
- MakeOperand(instruction.op1,Low,op1,NIL);
- MakeOperand(instruction.op2,Low,op2,NIL);
- MakeOperand(instruction.op3,Low,op3,NIL);
- IF ~Assembler.IsRegisterOperand(op1) THEN
- temp := op1;
- ra := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
- TicketToOperand(ra,op1);
- END;
- IF Assembler.SameOperand(op1,op3) THEN temp := op2; op2 := op3; op3 := temp END;
- IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
- IF Assembler.IsImmediateOperand(op3) THEN
- emitter.Emit3(InstructionSet.opIMUL,op1,op2,op3);
- ELSIF Assembler.IsRegisterOperand(op2) & (op2.register = op1.register) THEN
- IF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
- emitter.Emit2(InstructionSet.opIMUL,op1,op3);
- ELSE
- rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
- TicketToOperand(rd,temp);
- Move(temp,op3,instruction.op1.type);
- emitter.Emit2(InstructionSet.opIMUL,op1,temp);
- UnmapTicket(rd);
- END;
- ELSE
- Move(op1,op3,PhysicalOperandType(op1));
- emitter.Emit2(InstructionSet.opIMUL,op1,op2);
- END
- ELSIF Assembler.IsRegisterOperand(op3) OR Assembler.IsMemoryOperand(op3) THEN
- IF Assembler.IsImmediateOperand(op2) THEN
- emitter.Emit3(InstructionSet.opIMUL,op1,op3,op2);
- ELSIF Assembler.IsRegisterOperand(op3) & (op2.register = op1.register) THEN
- IF Assembler.IsRegisterOperand(op2) OR Assembler.IsMemoryOperand(op2) THEN
- emitter.Emit2(InstructionSet.opIMUL,op1,op2);
- ELSE
- rd := TemporaryTicket(instruction.op1.registerClass,instruction.op1.type);
- TicketToOperand(rd,temp);
- Move(temp,op2,instruction.op1.type);
- emitter.Emit2(InstructionSet.opIMUL,op1,temp);
- UnmapTicket(rd);
- END;
- ELSE
- Move(op1,op2,PhysicalOperandType(op1));
- emitter.Emit2(InstructionSet.opIMUL,op1,op3);
- END;
- END;
- IF ra # NIL THEN
- Move(temp,op1,PhysicalOperandType(op1));
- UnmapTicket(ra);
- END;
- END;
- END EmitMul;
- PROCEDURE EmitDivMod(CONST instruction: IntermediateCode.Instruction);
- VAR
- dividend,quotient,remainder,imm,target,memop: Assembler.Operand;
- op1,op2,op3: Assembler.Operand; ra,rd: Ticket;
- size: LONGINT;
- value: HUGEINT; exp: LONGINT; iop3: IntermediateCode.Operand;
- inst: IntermediateCode.Instruction;
- BEGIN
- IF IntermediateCode.IsConstantInteger(instruction.op3,value) & IntermediateBackend.PowerOf2(value,exp) THEN
- IF instruction.opcode = IntermediateCode.div THEN
- IntermediateCode.InitImmediate(iop3, IntermediateCode.uint32, exp);
- IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.shr, instruction.op1, instruction.op2, iop3);
- EmitShift(inst);
- RETURN;
- ELSE
- IntermediateCode.InitImmediate(iop3, instruction.op3.type, value-1);
- IntermediateCode.InitInstruction(inst, Basic.invalidPosition, IntermediateCode.and, instruction.op1, instruction.op2, iop3);
- EmitArithmetic3(inst,InstructionSet.opAND);
- RETURN;
- END;
- END;
- (*
- In general it must obviously hold that
- a = (a div b) * b + a mod b and
- for all integers a,b#0, and c.
- For positive numbers a and b this holds if
- a div b = max{integer i: i*b <= b} = Entier(a/b)
- and
- a mod b = a-(a div b)*b = min{c >=0: c = a-i*b, integer i}
- Example
- 11 div 3 = 3 (3*3 = 9)
- 11 mod 3 = 2 (=11-9)
- for negative a there are two definitions for mod possible:
- (i) mathematical definition with
- a mod b >= 0:
- a mod b = min{ c >=0: c = a-i*b, integer i} >= 0
- this corresponds with rounding down
- a div b = Entier(a/b) <= a/b
- (ii) symmetric definition with
- (-a) mod' b = -(a mod' b) and
- (-a) div' b = -(a div' b)
- corresponding with rounding to zero
- a div' b = RoundToZero(a/b)
- Examples
- (i) -11 div 3 = -4 (3*(-4) = -12)
- -11 mod 3 = 1 (=-11-(-12))
- (ii) -11 div' 3 = -(11 div 3) = -3 (3*(-3)= -9)
- -11 mod' 3 = -2 (=-11-(-9))
- The behaviour for negative b can, in the symmetrical case, be deduced as
- (ii) symmetric definition
- a div' (-b) = (-a) div' b = -(a div' b)
- a mod' (-b) = a- a div' (-b) * (-b) = a mod' b
- In the mathematical case it is not so easy. It turns out that the definitions
- a DIV b = Entier(a/b) = max{integer i: i*b <= b}
- and
- a MOD b = min { c >=0 : c = a-i*b, integer i} >= 0
- are not compliant with
- a = (a DIV b) * b + a MOD b
- if b <= 0.
- Proof: assume that b<0, then
- a - Entier(a/b) * b >= 0
- <=_> a >= Entier(a/b) * b
- <=> Entier(a/b) >= a/b (contradiction to definition of Entier).
- OBERON ADOPTS THE MATHEMATICAL DEFINITION !
- For integers a and b (b>0) it holds that
- a DIV b = Entier(a/b) <= a/b
- a MOD b = min{ c >=0: c = b-i*a, integer i} = a - a DIV b * b
- The behaviour for b < 0 is explicitely undefined.
- *)
- (*
- AX / regMem8 = AL (remainder AH)
- DX:AX / regmem16 = AX (remainder DX)
- EDX:EAX / regmem32 = EAX (remainder EDX)
- RDX:EAX / regmem64 = RAX (remainder RDX)
- 1.) EAX <- source1
- 2.) CDQ
- 3.) IDIV source2
- 3.) SHL EDX
- 4.) SBB EAX,1
- result is in EAX
- *)
- MakeOperand(instruction.op2,Low,op2,NIL);
- CASE instruction.op1.type.sizeInBits OF
- IntermediateCode.Bits8:
- Spill(physicalRegisters.Mapped(AL)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int8,AL,inPC);
- emitter.Emit2(InstructionSet.opMOV,opAL,op2);
- dividend := opAX;
- quotient := opAL;
- remainder := opAH;
- emitter.Emit0(InstructionSet.opCBW);
- | IntermediateCode.Bits16:
- Spill(physicalRegisters.Mapped(AX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,AX,inPC);
- emitter.Emit2(InstructionSet.opMOV,opAX,op2);
- Spill(physicalRegisters.Mapped(DX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int16,DX,inPC);
- dividend := opAX;
- quotient := dividend;
- remainder := opDX;
- emitter.Emit0(InstructionSet.opCWD);
- | IntermediateCode.Bits32:
- Spill(physicalRegisters.Mapped(EAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
- emitter.Emit2(InstructionSet.opMOV,opEAX,op2);
- Spill(physicalRegisters.Mapped(EDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EDX,inPC);
- dividend := opEAX;
- quotient := dividend;
- remainder := opEDX;
- emitter.Emit0(InstructionSet.opCDQ);
- | IntermediateCode.Bits64:
- Spill(physicalRegisters.Mapped(RAX)); ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RAX,inPC);
- emitter.Emit2(InstructionSet.opMOV,opRA,op2);
- Spill(physicalRegisters.Mapped(RDX)); rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int64,RDX,inPC);
- dividend := opRA;
- quotient := dividend;
- remainder := registerOperands[RDX];
- emitter.Emit0(InstructionSet.opCQO);
- END;
- (* registers might have been changed, so we make the operands now *)
- MakeOperand(instruction.op1,Low,op1,NIL);
- MakeOperand(instruction.op2,Low,op2,NIL);
- MakeOperand(instruction.op3,Low,op3,NIL);
- IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
- size := instruction.op3.type.sizeInBits DIV 8;
- Basic.Align(size, cpuBits DIV 8 );
- ModifyStackPointer(size);
- Assembler.InitMem(memop,SHORT(instruction.op3.type.sizeInBits DIV 8),SP,0);
- emitter.Emit2(InstructionSet.opMOV,memop,op3);
- op3 := memop;
- END;
- emitter.Emit1(InstructionSet.opIDIV,op3);
- IF instruction.opcode = IntermediateCode.mod THEN
- imm := Assembler.NewImm8 (0);
- emitter.Emit2(InstructionSet.opCMP, remainder, imm);
- Assembler.InitImm8(target,0);
- emitter.Emit1(InstructionSet.opJGE, target);
- emitter.Emit2( InstructionSet.opADD, remainder, op3);
- emitter.code.PutByteAt(target.pc,(emitter.code.pc -target.pc )-1);
- emitter.Emit2(InstructionSet.opMOV, op1, remainder);
- ELSE
- imm := Assembler.NewImm8 (1);
- emitter.Emit2(InstructionSet.opSHL, remainder, imm);
- imm := Assembler.NewImm8 (0);
- emitter.Emit2(InstructionSet.opSBB, quotient, imm);
- emitter.Emit2(InstructionSet.opMOV, op1, quotient);
- END;
- IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
- size := instruction.op3.type.sizeInBits DIV 8;
- Basic.Align(size, cpuBits DIV 8 );
- ModifyStackPointer(-size);
- END;
- END EmitDivMod;
- PROCEDURE EmitShift(CONST instruction: IntermediateCode.Instruction);
- VAR
- shift: Assembler.Operand;
- op: LONGINT;
- op1,op2,op3,dest,temporary,op1High,op2High: Assembler.Operand;
- index: SHORTINT; temp: Assembler.Operand;
- left: BOOLEAN;
- ecx,ticket: Ticket;
- BEGIN
- Assert(instruction.op1.type.form IN IntermediateCode.Integer,"must be integer operand");
- IF instruction.op1.type.form = IntermediateCode.UnsignedInteger THEN
- IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSHR; left := FALSE;
- ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSHL; left := TRUE;
- ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
- ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
- END;
- ELSE
- IF instruction.opcode = IntermediateCode.shr THEN op := InstructionSet.opSAR; left := FALSE;
- ELSIF instruction.opcode = IntermediateCode.shl THEN op := InstructionSet.opSAL; left := TRUE;
- ELSIF instruction.opcode = IntermediateCode.ror THEN op := InstructionSet.opROR; left := FALSE;
- ELSIF instruction.opcode = IntermediateCode.rol THEN op := InstructionSet.opROL; left := TRUE;
- END;
- END;
- IF instruction.op3.mode # IntermediateCode.ModeImmediate THEN
- IF backend.cooperative THEN ap.spillable := TRUE END;
- Spill(physicalRegisters.Mapped(ECX));
- ecx := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,ECX,inPC);
- END;
- (*GetTemporaryRegister(instruction.op2.type,dest);*)
- MakeOperand(instruction.op1,Low,op1,NIL);
- IF ~Assembler.IsRegisterOperand(op1) THEN GetTemporaryRegister(instruction.op2.type,dest) ELSE dest := op1 END;
- MakeOperand(instruction.op2,Low,op2,NIL);
- MakeOperand(instruction.op3,Low,op3,NIL);
- IF instruction.op3.mode = IntermediateCode.ModeImmediate THEN
- Assembler.InitImm8(shift,instruction.op3.intValue);
- ELSE
- CASE instruction.op3.type.sizeInBits OF
- IntermediateCode.Bits8: index := CL;
- |IntermediateCode.Bits16: index := CX;
- |IntermediateCode.Bits32: index := ECX;
- |IntermediateCode.Bits64: index := RCX;
- END;
- (*
- IF (physicalRegisters.toVirtual[index] # free) & ((physicalRegisters.toVirtual[index] # instruction.op1.register) OR (instruction.op1.mode # IntermediateCode.ModeRegister)) THEN
- Spill();
- (*
- emitter.Emit1(InstructionSet.opPUSH,opECX);
- ecxPushed := TRUE;
- *)
- END;
- *)
- ticket := virtualRegisters.Mapped(instruction.op3.register,Low);
- IF (instruction.op3.mode # IntermediateCode.ModeRegister) OR (ticket = NIL) OR (ticket.spilled) OR (ticket.register # index) THEN
- emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op3);
- END;
- shift := opCL;
- END;
- IF ~IsComplex(instruction.op1) THEN
- Move(dest,op2,PhysicalOperandType(dest));
- emitter.Emit2 (op, dest,shift);
- Move(op1,dest,PhysicalOperandType(op1));
- ELSIF left THEN
- MakeOperand(instruction.op1,High,op1High,NIL);
- MakeOperand(instruction.op2,High,op2High,NIL);
- IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
- Move(op1,op2,PhysicalOperandType(op1));
- Move(op1High,op2High,PhysicalOperandType(op1High))
- END;
- IF (instruction.opcode=IntermediateCode.rol) THEN
- (* |high| <- |low| <- |temp=high| *)
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
- TicketToOperand(ticket,temp);
- emitter.Emit2( InstructionSet.opMOV, temp, op1High);
- emitter.Emit3( InstructionSet.opSHLD,op1High, op1, shift);
- emitter.Emit3( InstructionSet.opSHLD, op1, temp, shift);
- UnmapTicket(ticket);
- ELSE
- (* |high| <- |low| *)
- emitter.Emit3( InstructionSet.opSHLD, op1,op1High,shift);
- emitter.Emit2( op, op1,shift);
- END;
- ELSE
- IF ~IntermediateCode.OperandEquals(instruction.op1,instruction.op2) THEN
- Move(op1,op2,PhysicalOperandType(op1))
- END;
- IF instruction.opcode=IntermediateCode.ror THEN
- (* |temp=low| -> |high| -> |low| *)
- ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
- TicketToOperand(ticket,temp);
- emitter.Emit2( InstructionSet.opMOV, temporary, op1);
- emitter.Emit3( InstructionSet.opSHRD,op1, op1High, shift);
- emitter.Emit3( InstructionSet.opSHRD, op1High, temporary, shift);
- UnmapTicket(ticket);
- ELSE
- (* |high| -> |low| *)
- emitter.Emit3( InstructionSet.opSHRD, op1,op1High,shift);
- emitter.Emit2( op, op1High, shift);
- END;
- END;
- IF backend.cooperative & (instruction.op3.mode # IntermediateCode.ModeImmediate) THEN
- UnmapTicket(ecx);
- UnSpill(ap);
- ap.spillable := FALSE;
- END;
- END EmitShift;
- PROCEDURE EmitCas(CONST instruction: IntermediateCode.Instruction);
- VAR ra: Ticket; op1,op2,op3,mem: Assembler.Operand; register: LONGINT;
- BEGIN
- CASE instruction.op2.type.sizeInBits OF
- | IntermediateCode.Bits8: register := AL;
- | IntermediateCode.Bits16: register := AX;
- | IntermediateCode.Bits32: register := EAX;
- | IntermediateCode.Bits64: register := RAX;
- END;
- Spill(physicalRegisters.Mapped(register));
- ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op2.type,register,inPC);
- IF IntermediateCode.OperandEquals (instruction.op2,instruction.op3) THEN
- MakeRegister(instruction.op1,Low,op1(*,ra*));
- Assembler.InitMem(mem,SHORT(instruction.op2.type.sizeInBits DIV 8),op1.register,0);
- TicketToOperand(ra, op2);
- emitter.Emit2(InstructionSet.opMOV,op2,mem);
- ELSE
- MakeOperand(instruction.op2,Low,op2,ra);
- MakeRegister(instruction.op1,Low,op1);
- Assembler.InitMem(mem,SHORT(instruction.op2.type.sizeInBits DIV 8),op1.register,0);
- MakeRegister(instruction.op3,Low,op3);
- emitter.EmitPrefix (InstructionSet.prfLOCK);
- emitter.Emit2(InstructionSet.opCMPXCHG,mem,op3);
- END;
- END EmitCas;
- PROCEDURE EmitCopy(CONST instruction: IntermediateCode.Instruction);
- VAR op1,op2,op3: Assembler.Operand; rs, rd, rc, t: Ticket; temp,imm: Assembler.Operand; source, dest: IntermediateCode.Operand; size: HUGEINT;type: IntermediateCode.Type;
- BEGIN
- IF IntermediateCode.IsConstantInteger(instruction.op3, size) & ((size=8) OR (size = 4) OR (size = 2) OR (size=1)) & (size * 8 <= cpuBits) THEN
- MakeRegister(instruction.op1,Low,op1);
- Assembler.InitMem(op1,SHORTINT(size),op1.register,0);
- MakeRegister(instruction.op2,Low,op2);
- Assembler.InitMem(op2,SHORTINT(size),op2.register,0);
- type := IntermediateCode.NewType(IntermediateCode.SignedInteger, SHORTINT(size*8));
- rd := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, type);
- TicketToOperand(rd,op3);
-
-
- Move(op3, op2, type);
- Move(op1, op3, type);
- ELSE
- Spill(physicalRegisters.Mapped(RS));
- Spill(physicalRegisters.Mapped(RD));
- IF backend.cooperative THEN ap.spillable := TRUE END;
- Spill(physicalRegisters.Mapped(RC));
- rs := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RS,inPC);
- rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RD,inPC);
- rc := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RC,inPC);
- MakeOperand(instruction.op1,Low,op1,rd);
- MakeOperand(instruction.op2,Low,op2,rs);
- IF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) & IntermediateCode.IsConstantInteger(instruction.op3, size) & (size >= 4096) THEN
- (* special case on stack: copy downwards for possible stack allocation *)
- IF size MOD 4 # 0 THEN
- imm := Assembler.NewImm32(size-1);
- emitter.Emit2(InstructionSet.opADD, opRDI, imm);
- emitter.Emit2(InstructionSet.opADD, opRSI, imm);
- imm := Assembler.NewImm32(size MOD 4);
- emitter.Emit2(InstructionSet.opMOV, opRC, imm);
- emitter.Emit0(InstructionSet.opSTD); (* copy down *)
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSB);
- imm := Assembler.NewImm32(size DIV 4);
- emitter.Emit2(InstructionSet.opMOV, opRC, imm);
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSD);
- ELSE
- imm := Assembler.NewImm32(size-4);
- emitter.Emit2(InstructionSet.opADD, opRDI, imm);
- emitter.Emit2(InstructionSet.opADD, opRSI, imm);
- imm := Assembler.NewImm32(size DIV 4);
- emitter.Emit2(InstructionSet.opMOV, opRC, imm);
- emitter.Emit0(InstructionSet.opSTD); (* copy down *)
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSD);
- END
- ELSIF IntermediateCode.IsConstantInteger(instruction.op3, size) THEN
- imm := Assembler.NewImm32(size DIV 4);
- emitter.Emit2(InstructionSet.opMOV, opRC, imm);
- emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSD);
- IF size MOD 4 # 0 THEN
- imm := Assembler.NewImm32(size MOD 4);
- emitter.Emit2(InstructionSet.opMOV, opRC, imm);
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSB);
- END;
- (* this does not work in the kernel -- for whatever reasons *)
- ELSIF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) THEN
- MakeOperand(instruction.op3,Low,op3,rc);
- t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, instruction.op1.type);
- TicketToOperand(t, temp);
- emitter.Emit2(InstructionSet.opADD, opRSI, opRC);
- emitter.Emit2(InstructionSet.opADD, opRDI, opRC);
- imm := Assembler.NewImm8(1);
- emitter.Emit2(InstructionSet.opSUB, opRSI, imm);
- emitter.Emit2(InstructionSet.opSUB, opRDI, imm);
- emitter.Emit2(InstructionSet.opMOV, temp, opRC);
- imm := Assembler.NewImm8(3);
- emitter.Emit2(InstructionSet.opAND, opRC, imm);
- emitter.Emit0(InstructionSet.opSTD); (* copy downwards *)
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSB);
- imm := Assembler.NewImm8(2);
- emitter.Emit2(InstructionSet.opMOV, opRC, temp);
- emitter.Emit2(InstructionSet.opSHR, opRC, imm);
- imm := Assembler.NewImm8(3);
- emitter.Emit2(InstructionSet.opSUB, opRSI, imm);
- emitter.Emit2(InstructionSet.opSUB, opRDI, imm);
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSD);
- emitter.Emit0(InstructionSet.opCLD);
- ELSE
- MakeOperand(instruction.op3,Low,op3,rc);
- t := TemporaryTicket(IntermediateCode.GeneralPurposeRegister, instruction.op1.type);
- TicketToOperand(t, temp);
- emitter.Emit2(InstructionSet.opMOV, temp, opRC);
- imm := Assembler.NewImm8(3);
- emitter.Emit2(InstructionSet.opAND, temp, imm);
- imm := Assembler.NewImm8(2);
- emitter.Emit2(InstructionSet.opSHR, opRC, imm);
- emitter.Emit0(InstructionSet.opCLD); (* copy upwards *)
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSD);
- emitter.Emit2(InstructionSet.opMOV, opRC, temp);
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(InstructionSet.opMOVSB);
- END;
- UnmapTicket(rs);
- UnmapTicket(rd);
- UnmapTicket(rc);
- IF backend.cooperative THEN
- UnSpill(ap);
- ap.spillable := FALSE;
- END;
- END;
- END EmitCopy;
- PROCEDURE EmitFill(CONST instruction: IntermediateCode.Instruction; down: BOOLEAN);
- VAR reg,sizeInBits,i: LONGINT;val, value, size, dest: Assembler.Operand;
- op: LONGINT;
- rd, rc: Ticket;
- BEGIN
- IF FALSE & (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op2.symbol.name = "") & (instruction.op2.intValue < 5) THEN
- sizeInBits := instruction.op3.type.sizeInBits;
- IF sizeInBits = IntermediateCode.Bits8 THEN value := opAL;
- ELSIF sizeInBits = IntermediateCode.Bits16 THEN value := opAX;
- ELSIF sizeInBits = IntermediateCode.Bits32 THEN value := opEAX;
- ELSE HALT(200)
- END;
- MakeOperand(instruction.op1,Low,dest,NIL);
- IF instruction.op1.mode = IntermediateCode.ModeRegister THEN reg := dest.register
- ELSE emitter.Emit2(InstructionSet.opMOV,opEDX,dest); reg := EDX;
- END;
- IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
- emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
- ELSE
- MakeOperand(instruction.op3,Low,value,NIL);
- END;
- FOR i := 0 TO SHORT(instruction.op2.intValue)-1 DO
- IF down THEN
- Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8)),reg,-i*sizeInBits DIV 8);
- ELSE
- Assembler.InitMem(dest,SHORT(SHORT(sizeInBits DIV 8 )),reg,i*sizeInBits DIV 8);
- END;
- emitter.Emit2(InstructionSet.opMOV,dest,value);
- END;
- ELSE
- Spill(physicalRegisters.Mapped(RD));
- IF backend.cooperative THEN ap.spillable := TRUE END;
- Spill(physicalRegisters.Mapped(RC));
- rd := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RD,inPC);
- rc := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,instruction.op1.type,RC,inPC);
- MakeOperand(instruction.op1,Low,dest,rd);
- MakeOperand(instruction.op2,Low,size,rc);
- MakeOperand(instruction.op3,Low,value,NIL);
- (*
- emitter.Emit2(InstructionSet.opMOV,opRDI, op1[Low]);
- emitter.Emit2(InstructionSet.opMOV,opRC, op3[Low]);
- *)
- CASE instruction.op3.type.sizeInBits OF
- IntermediateCode.Bits8: val := opAL; op := InstructionSet.opSTOSB;
- |IntermediateCode.Bits16: val := opAX; op := InstructionSet.opSTOSW;
- |IntermediateCode.Bits32: val := opEAX; op := InstructionSet.opSTOSD;
- ELSE Halt("only supported for upto 32 bit integers ");
- END;
- IF (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.type.form IN IntermediateCode.Integer) & (instruction.op3.intValue = 0) THEN
- emitter.Emit2(InstructionSet.opXOR,opEAX,opEAX);
- ELSE
- emitter.Emit2(InstructionSet.opMOV,val,value);
- END;
- IF down THEN
- emitter.Emit0(InstructionSet.opSTD); (* fill downwards *)
- ELSE
- emitter.Emit0(InstructionSet.opCLD); (* fill upwards *)
- END;
- emitter.EmitPrefix (InstructionSet.prfREP);
- emitter.Emit0(op);
- IF down THEN (* needed as calls to windows crash otherwise *)
- emitter.Emit0(InstructionSet.opCLD);
- END;
- UnmapTicket(rc);
- IF backend.cooperative THEN
- UnSpill(ap);
- ap.spillable := FALSE;
- END;
- END;
- END EmitFill;
- PROCEDURE EmitBr (CONST instruction: IntermediateCode.Instruction);
- VAR dest,destPC,offset: LONGINT; target: Assembler.Operand;hit,fail: LONGINT; reverse: BOOLEAN;
- (* jump operands *) left,right,temp: Assembler.Operand;
- failOp: Assembler.Operand; failPC: LONGINT;
- PROCEDURE JmpDest(brop: LONGINT);
- BEGIN
- IF instruction.op1.mode = IntermediateCode.ModeImmediate THEN
- IF instruction.op1.symbol.name = in.name THEN
- dest := (instruction.op1.symbolOffset); (* this is the offset in the in-data section (intermediate code), it is not byte- *)
- destPC := (in.instructions[dest].pc );
- offset := destPC - (out.pc );
- IF dest > inPC THEN (* forward jump *)
- Assembler.InitOffset32(target,0);
- Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
- emitter.Emit1(brop,target);
- ELSIF ABS(offset) <= 126 THEN
- Assembler.InitOffset8(target,destPC);
- emitter.Emit1(brop,target);
- ELSE
- Assembler.InitOffset32(target,destPC);
- emitter.Emit1(brop,target);
- END;
- ELSIF cpuBits = 64 THEN
- MakeOperand(instruction.op1,Low,target,NIL);
- emitter.Emit1(brop,target);
- ELSE
- Assembler.InitOffset32(target,instruction.op1.intValue);
- Assembler.SetSymbol(target,instruction.op1.symbol.name,instruction.op1.symbol.fingerprint,instruction.op1.symbolOffset,instruction.op1.offset);
- emitter.Emit1(brop,target);
- END;
- ELSE
- MakeOperand(instruction.op1,Low,target,NIL);
- emitter.Emit1(brop,target);
- END;
- END JmpDest;
- PROCEDURE CmpFloat;
- BEGIN
- IF backend.forceFPU THEN
- MakeOperand(instruction.op2,Low,left,NIL);
- emitter.Emit1(InstructionSet.opFLD,left); INC(fpStackPointer);
- MakeOperand(instruction.op3,Low,right,NIL);
- emitter.Emit1(InstructionSet.opFCOMP,right); DEC(fpStackPointer);
- emitter.Emit1(InstructionSet.opFNSTSW,opAX);
- emitter.Emit0(InstructionSet.opSAHF);
- ELSE
- MakeRegister(instruction.op2,Low,left);
- MakeOperand(instruction.op3,Low,right,NIL);
- IF instruction.op2.type.sizeInBits = 32 THEN
- emitter.Emit2(InstructionSet.opCOMISS, left, right);
- ELSE
- emitter.Emit2(InstructionSet.opCOMISD, left, right);
- END
- END;
- END CmpFloat;
- PROCEDURE Cmp(part: LONGINT; VAR reverse: BOOLEAN);
- VAR type: IntermediateCode.Type; left,right: Assembler.Operand;
- BEGIN
- IF (instruction.op2.mode = IntermediateCode.ModeImmediate) & (instruction.op3.mode = IntermediateCode.ModeImmediate) THEN
- reverse := FALSE;
- GetPartType(instruction.op2.type,part,type);
- GetTemporaryRegister(type,temp);
- MakeOperand(instruction.op2,part,left,NIL);
- MakeOperand(instruction.op3,part,right,NIL);
- Move(temp,left, type);
- left := temp;
- ELSIF instruction.op2.mode = IntermediateCode.ModeImmediate THEN
- reverse := TRUE;
- MakeOperand(instruction.op2,part,right,NIL);
- MakeOperand(instruction.op3,part,left,NIL);
- ELSIF IsMemoryOperand(instruction.op2,part) & IsMemoryOperand(instruction.op3,part) THEN
- reverse := FALSE;
- GetPartType(instruction.op2.type,part,type);
- GetTemporaryRegister(type,temp);
- MakeOperand(instruction.op2,part,left,NIL);
- MakeOperand(instruction.op3,part,right,NIL);
- Move(temp,right,type);
- right := temp;
- ELSE
- reverse := FALSE;
- MakeOperand(instruction.op2,part,left,NIL);
- MakeOperand(instruction.op3,part,right,NIL);
- END;
- emitter.Emit2(InstructionSet.opCMP,left,right);
- END Cmp;
- BEGIN
- IF (instruction.op1.symbol.name = in.name) & (instruction.op1.symbolOffset = inPC +1) THEN (* jump to next instruction can be ignored *)
- IF dump # NIL THEN dump.String("jump to next instruction ignored"); dump.Ln END;
- RETURN
- END;
- failPC := 0;
- IF instruction.opcode = IntermediateCode.br THEN
- hit := InstructionSet.opJMP
- ELSIF instruction.op2.type.form = IntermediateCode.Float THEN
- CmpFloat;
- CASE instruction.opcode OF
- IntermediateCode.breq: hit := InstructionSet.opJE;
- |IntermediateCode.brne:hit := InstructionSet.opJNE;
- |IntermediateCode.brge: hit := InstructionSet.opJAE
- |IntermediateCode.brlt: hit := InstructionSet.opJB
- END;
- ELSE
- IF ~IsComplex(instruction.op2) THEN
- Cmp(Low,reverse);
- CASE instruction.opcode OF
- IntermediateCode.breq: hit := InstructionSet.opJE;
- |IntermediateCode.brne: hit := InstructionSet.opJNE;
- |IntermediateCode.brge:
- IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJLE ELSE hit := InstructionSet.opJGE END;
- ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
- END;
- |IntermediateCode.brlt:
- IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJG ELSE hit := InstructionSet.opJL END;
- ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
- END;
- END;
- ELSE
- Cmp(High,reverse);
- CASE instruction.opcode OF
- IntermediateCode.breq: hit := 0; fail := InstructionSet.opJNE;
- |IntermediateCode.brne: hit := InstructionSet.opJNE; fail := 0;
- |IntermediateCode.brge:
- IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJL; fail := InstructionSet.opJG ELSE hit := InstructionSet.opJG; fail := InstructionSet.opJL END;
- ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJB; fail := InstructionSet.opJA ELSE hit := InstructionSet.opJA; fail := InstructionSet.opJB END;
- END;
- |IntermediateCode.brlt:
- IF instruction.op2.type.form = IntermediateCode.SignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJG; fail := InstructionSet.opJL ELSE hit := InstructionSet.opJL; fail := InstructionSet.opJG END;
- ELSIF instruction.op2.type.form = IntermediateCode.UnsignedInteger THEN
- IF reverse THEN hit := InstructionSet.opJA; fail := InstructionSet.opJB ELSE hit := InstructionSet.opJB; fail := InstructionSet.opJA END;
- END;
- END;
- IF hit # 0 THEN JmpDest(hit) END;
- IF fail # 0 THEN
- failPC := out.pc; (* to avoid potential value overflow problem, will be patched anyway *)
- Assembler.InitOffset8(failOp,failPC );
- emitter.Emit1(fail,failOp);
- failPC := failOp.pc;
- END;
- Cmp(Low,reverse);
- CASE instruction.opcode OF
- IntermediateCode.breq: hit := InstructionSet.opJE
- |IntermediateCode.brne: hit := InstructionSet.opJNE
- |IntermediateCode.brge:
- IF reverse THEN hit := InstructionSet.opJBE ELSE hit := InstructionSet.opJAE END;
- |IntermediateCode.brlt:
- IF reverse THEN hit := InstructionSet.opJA ELSE hit := InstructionSet.opJB END;
- END;
- END;
- END;
- JmpDest(hit);
- IF failPC > 0 THEN out.PutByteAt(failPC,(out.pc-failPC)-1); END;
- END EmitBr;
- PROCEDURE EmitPush(CONST vop: IntermediateCode.Operand; part: LONGINT);
- VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
- BEGIN
- GetPartType(vop.type,part,type);
- ASSERT(type.form IN IntermediateCode.Integer);
- IF vop.mode = IntermediateCode.ModeImmediate THEN (* may not push 16 bit immediate: strange instruction in 32 / 64 bit mode *)
- GetImmediate(vop,part,op1,TRUE,TRUE);
- emitter.Emit1(InstructionSet.opPUSH,op1);
- ELSIF (type.sizeInBits = cpuBits) THEN
- MakeOperand(vop,part,op1,NIL);
- emitter.Emit1(InstructionSet.opPUSH,op1);
- ELSE
- ASSERT(type.sizeInBits < cpuBits);
- MakeOperand(vop,part,op1,NIL);
- IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
- index := op1.register MOD 32 + opRA.register;
- emitter.Emit1(InstructionSet.opPUSH, registerOperands[index]);
- ELSE
- WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
- IntermediateCode.InitType(cpuType,IntermediateCode.SignedInteger,SHORT(cpuBits));
- ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
- CASE type.sizeInBits OF
- 8: index := AL
- |16: index := AX
- |32: index := EAX
- |64: index := RAX
- END;
- emitter.Emit2(InstructionSet.opMOV,registerOperands[index],op1);
- emitter.Emit1(InstructionSet.opPUSH,opRA);
- UnmapTicket(ra);
- END;
- END;
- END EmitPush;
- PROCEDURE EmitPop(CONST vop: IntermediateCode.Operand; part: LONGINT);
- VAR index: LONGINT; type,cpuType: IntermediateCode.Type; op1: Assembler.Operand; ra: Ticket;
- BEGIN
- GetPartType(vop.type,part,type);
- ASSERT(type.form IN IntermediateCode.Integer);
- IF (type.sizeInBits = cpuBits) THEN
- MakeOperand(vop,part,op1,NIL);
- emitter.Emit1(InstructionSet.opPOP,op1);
- ELSE
- ASSERT(type.sizeInBits < cpuBits);
- MakeOperand(vop,part,op1,NIL);
- IF Assembler.IsRegisterOperand(op1) & ~((cpuBits=32) & (type.sizeInBits=8) & (op1.register >= AH)) THEN
- index := op1.register MOD 32 + opRA.register;
- emitter.Emit1(InstructionSet.opPOP, registerOperands[index]);
- ELSE
- WHILE physicalRegisters.Mapped(opRA.register) # free DO Spill(physicalRegisters.Mapped(opRA.register)) END;
- IntermediateCode.InitType(cpuType, IntermediateCode.SignedInteger, SHORT(cpuBits));
- ra := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,cpuType,opRA.register,inPC);
- emitter.Emit1(InstructionSet.opPOP,opRA);
- CASE type.sizeInBits OF
- 8: index := AL
- |16: index := AX
- |32: index := EAX
- |64: index := RAX
- END;
- emitter.Emit2(InstructionSet.opMOV, op1, registerOperands[index]);
- UnmapTicket(ra);
- END;
- END;
- END EmitPop;
- PROCEDURE EmitPushFloat(CONST vop: IntermediateCode.Operand);
- VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
- BEGIN
- MakeOperand(vop,Low,op,NIL);
- length := vop.type.length;
- IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
- emitter.Emit1(InstructionSet.opPUSH,op);
- ELSE
- sizeInBytes := vop.type.sizeInBits DIV 8;
- length := vop.type.length;
- IF sizeInBytes * length * 8 < cpuBits THEN
- ModifyStackPointer(cpuBits DIV 8);
- ELSE
- ModifyStackPointer(sizeInBytes*length);
- END;
- Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
- IF backend.forceFPU THEN
- emitter.Emit1(InstructionSet.opFLD,op); INC(fpStackPointer);
- emitter.Emit1(InstructionSet.opFSTP,memop); DEC(fpStackPointer);
- ELSE
- Move(memop, op, vop.type)
- END
- END;
- END EmitPushFloat;
- PROCEDURE EmitPopFloat(CONST vop: IntermediateCode.Operand);
- VAR sizeInBytes,length: LONGINT; memop: Assembler.Operand; op: Assembler.Operand;
- BEGIN
- sizeInBytes := vop.type.sizeInBits DIV 8;
- length := vop.type.length;
- IF (vop.mode = IntermediateCode.ModeMemory) & (vop.type.sizeInBits*length =cpuBits) THEN
- MakeOperand(vop,Low,op,NIL);
- emitter.Emit1(InstructionSet.opPOP,op);
- ELSE
- Assembler.InitMem(memop, SHORTINT(sizeInBytes*length),SP,0);
- IF backend.forceFPU THEN
- emitter.Emit1(InstructionSet.opFLD,memop);
- INC(fpStackPointer);
- MakeOperand(vop,Low,op,NIL);
- emitter.Emit1(InstructionSet.opFSTP,op);
- DEC(fpStackPointer);
- ASSERT(sizeInBytes > 0);
- ELSE
- MakeOperand(vop,Low,op,NIL);
- Move(op, memop, vop.type)
- END;
- IF sizeInBytes * length * 8 < cpuBits THEN
- ModifyStackPointer(-cpuBits DIV 8);
- ELSE
- ModifyStackPointer(-sizeInBytes*length);
- END;
- END;
- END EmitPopFloat;
- PROCEDURE EmitNeg(CONST instruction: IntermediateCode.Instruction);
- VAR opLow,opHigh: Assembler.Operand; minusOne: Assembler.Operand; ticketLow,ticketHigh: Ticket;
- BEGIN
- IF IsComplex(instruction.op1) THEN
- PrepareOp2(instruction,High,opHigh,ticketHigh);
- PrepareOp2(instruction,Low,opLow,ticketLow);
- emitter.Emit1(InstructionSet.opNOT,opHigh);
- emitter.Emit1(InstructionSet.opNEG,opLow);
- Assembler.InitImm8(minusOne,-1);
- emitter.Emit2(InstructionSet.opSBB,opHigh,minusOne);
- FinishOp(instruction.op1,High,opHigh,ticketHigh);
- FinishOp(instruction.op1,Low,opLow,ticketLow);
- ELSE
- EmitArithmetic2(instruction,Low,InstructionSet.opNEG);
- END;
- END EmitNeg;
- PROCEDURE EmitNegXMM(CONST instruction: IntermediateCode.Instruction);
- VAR temp, op: Assembler.Operand; ticket: Ticket;
- BEGIN
- PrepareOp2(instruction, Low, op, ticket);
- GetTemporaryRegister(instruction.op1.type,temp);
- IF instruction.op1.type.sizeInBits = 32 THEN
- emitter.Emit2(InstructionSet.opXORPS, temp, temp);
- emitter.Emit2(InstructionSet.opSUBPS, temp, op);
- emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
- ELSE
- emitter.Emit2(InstructionSet.opXORPD, temp, temp);
- emitter.Emit2(InstructionSet.opSUBPD, temp, op);
- emitter.Emit2(InstructionSet.opMOVAPS, op, temp);
- END;
- FinishOp(instruction.op1, Low, op, ticket);
- END EmitNegXMM;
- PROCEDURE EmitAbs(CONST instruction: IntermediateCode.Instruction);
- VAR op1,op2: Assembler.Operand; source,imm: Assembler.Operand; eax: Ticket;
- BEGIN
- Assert(~IsComplex(instruction.op1),"complex Abs not supported");
- IF instruction.op1.type.form = IntermediateCode.SignedInteger THEN
- Spill(physicalRegisters.Mapped(EAX));
- eax := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,EAX,inPC);
- MakeOperand(instruction.op1,Low,op1,NIL);
- MakeOperand(instruction.op2,Low,op2,NIL);
- CASE instruction.op1.type.sizeInBits OF
- | IntermediateCode.Bits8: imm := Assembler.NewImm8 (7); source := opAL;
- | IntermediateCode.Bits16: imm := Assembler.NewImm8 (15); source := opAX;
- | IntermediateCode.Bits32: imm := Assembler.NewImm8 (31); source := opEAX;
- | IntermediateCode.Bits64: imm := Assembler.NewImm8 (63); source := registerOperands[RAX];
- END;
- emitter.Emit2 (InstructionSet.opMOV, source,op2);
- emitter.Emit2 (InstructionSet.opMOV, op1,source);
- emitter.Emit2 (InstructionSet.opSAR, source, imm);
- emitter.Emit2 (InstructionSet.opXOR, op1, source);
- emitter.Emit2 (InstructionSet.opSUB, op1, source);
- UnmapTicket(eax);
- ELSE Halt("Abs does not make sense on unsigned integer")
- END;
- END EmitAbs;
- PROCEDURE EmitAbsXMM(CONST instruction: IntermediateCode.Instruction);
- VAR temp, op: Assembler.Operand; ticket: Ticket;
- BEGIN
- PrepareOp2(instruction, Low, op, ticket);
- GetTemporaryRegister(instruction.op1.type,temp);
- IF instruction.op1.type.sizeInBits = 32 THEN
- emitter.Emit2(InstructionSet.opXORPS, temp, temp);
- emitter.Emit2(InstructionSet.opSUBPS, temp, op);
- emitter.Emit2(InstructionSet.opMAXPS, op, temp);
- ELSE
- emitter.Emit2(InstructionSet.opXORPD, temp, temp);
- emitter.Emit2(InstructionSet.opSUBPD, temp, op);
- emitter.Emit2(InstructionSet.opMAXPD, op, temp);
- END;
- FinishOp(instruction.op1, Low, op, ticket);
- END EmitAbsXMM;
- PROCEDURE EmitTrap(CONST instruction: IntermediateCode.Instruction);
- VAR operand: Assembler.Operand;
- BEGIN
- IF instruction.op1.intValue < 80H THEN
- operand := Assembler.NewImm8(instruction.op1.intValue);
- ELSE
- operand := Assembler.NewImm32(instruction.op1.intValue);
- END;
- emitter.Emit1(InstructionSet.opPUSH, operand);
- emitter.Emit0(InstructionSet.opINT3);
- END EmitTrap;
- PROCEDURE EmitAsm(CONST instruction: IntermediateCode.Instruction);
- VAR reader: Streams.StringReader; procedure: SyntaxTree.Procedure; scope: SyntaxTree.Scope;
- len: LONGINT; symbol: SyntaxTree.Symbol; assembler: Assembler.Assembly;
- inr, outr: IntermediateCode.Rules;
- string: SyntaxTree.SourceCode;
- i: LONGINT;
- reg, dest: Assembler.Operand;
- map: Assembler.RegisterMap;
- register: LONGINT;
- ticket: Ticket;
- BEGIN
- IF instruction.op2.mode = IntermediateCode.ModeRule THEN inr := instruction.op2.rule ELSE inr := NIL END;
- IF instruction.op3.mode = IntermediateCode.ModeRule THEN outr := instruction.op3.rule ELSE outr := NIL END;
- string := instruction.op1.string;
- NEW(map);
- IF inr # NIL THEN
- FOR i := 0 TO LEN(inr)-1 DO
- MakeRegister(inr[i], 0, reg);
- ASSERT(map.Find(inr[i].string^) < 0);
- map.Add(inr[i].string, reg.register)
- END;
- END;
- IF outr # NIL THEN
- FOR i := 0 TO LEN(outr)-1 DO
- IF (map.Find(outr[i].string^) < 0) THEN
- GetTemporaryRegister(outr[i].type,reg);
- map.Add(outr[i].string, reg.register)
- END;
- END;
- END;
- len := Strings.Length(string^);
- NEW(reader,len);
- reader.Set(string^);
- symbol := in.symbol;
- procedure := symbol(SyntaxTree.Procedure);
- scope := procedure.procedureScope;
- NEW(assembler,diagnostics,emitter);
- assembler.useLineNumbers := Compiler.UseLineNumbers IN backend.flags;
- assembler.Assemble(reader,instruction.textPosition,scope,in,in,module,procedure.access * SyntaxTree.Public # {}, procedure.isInline, map) ;
- error := error OR assembler.error;
- IF outr # NIL THEN
- FOR i := 0 TO LEN(outr)-1 DO
- IF outr[i].mode # IntermediateCode.Undefined THEN
- register := map.Find(outr[i].string^);
- ticket := physicalRegisters.Mapped(register);
- IF ticket.lastuse = inPC THEN UnmapTicket(ticket); physicalRegisters.AllocationHint(register) END; (* try to reuse register here *)
- Assembler.InitRegister(reg, register);
- MakeOperand(outr[i], Low, dest, NIL);
- Move( dest, reg,outr[i].type)
- END;
- END;
- END;
- (*
- IntermediateCode.SetString(instruction.op1, string);
- *)
- END EmitAsm;
- END CodeGeneratorAMD64;
- BackendAMD64= OBJECT (IntermediateBackend.IntermediateBackend)
- VAR
- cg: CodeGeneratorAMD64;
- bits: LONGINT;
- traceable: BOOLEAN;
- forceFPU: BOOLEAN;
- winAPIRegisters: ARRAY 4 OF LONGINT;
- cRegisters: ARRAY 6 OF LONGINT;
- intParameterIndex: WORD;
- floatParameterIndex: WORD;
- PROCEDURE &InitBackendAMD64;
- BEGIN
- InitIntermediateBackend;
- bits := 32;
- forceFPU := FALSE;
-
- winAPIRegisters[0] := RCX - RAX;
- winAPIRegisters[1] := RDX - RAX;
- winAPIRegisters[2] := R8 - RAX;
- winAPIRegisters[3] := R9 - RAX;
-
- cRegisters[0] := RDI - RAX;
- cRegisters[1] := RSI - RAX;
- cRegisters[2] := RDX - RAX;
- cRegisters[3] := RCX - RAX;
- cRegisters[4] := R8 - RAX;
- cRegisters[5] := R9 - RAX;
-
- SetName("AMD");
- END InitBackendAMD64;
- PROCEDURE Initialize*(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System);
- BEGIN
- Initialize^(diagnostics,log, flags,checker,system); NEW(cg, builtinsModuleName, diagnostics, SELF);
- END Initialize;
- PROCEDURE GetSystem*(): Global.System;
- VAR system: Global.System;
- PROCEDURE AddRegister(CONST name: Scanner.IdentifierString; val: LONGINT);
- BEGIN
- Global.NewConstant(name,val,system.shortintType,system.systemScope)
- END AddRegister;
- PROCEDURE AddRegisters;
- BEGIN
- (* system constants *)
- AddRegister("EAX",InstructionSet.regEAX); AddRegister("ECX", InstructionSet.regECX);
- AddRegister( "EDX", InstructionSet.regEDX); AddRegister( "EBX", InstructionSet.regEBX);
- AddRegister( "ESP", InstructionSet.regESP); AddRegister( "EBP", InstructionSet.regEBP);
- AddRegister( "ESI", InstructionSet.regESI); AddRegister( "EDI", InstructionSet.regEDI);
- AddRegister( "AX", InstructionSet.regAX); AddRegister( "CX", InstructionSet.regCX);
- AddRegister( "DX", InstructionSet.regDX); AddRegister( "BX", InstructionSet.regBX);
- AddRegister( "AL", InstructionSet.regAL); AddRegister( "CL", InstructionSet.regCL);
- AddRegister( "DL", InstructionSet.regDL); AddRegister( "BL", InstructionSet.regBL);
- AddRegister( "AH", InstructionSet.regAH); AddRegister( "CH", InstructionSet.regCH);
- AddRegister( "DH", InstructionSet.regDH); AddRegister( "BH", InstructionSet.regBH);
- AddRegister( "RAX", InstructionSet.regRAX); AddRegister( "RCX", InstructionSet.regRCX);
- AddRegister( "RDX", InstructionSet.regRDX); AddRegister( "RBX", InstructionSet.regRBX);
- AddRegister( "RSP", InstructionSet.regRSP); AddRegister( "RBP", InstructionSet.regRBP);
- AddRegister( "RSI", InstructionSet.regRSI); AddRegister( "RDI", InstructionSet.regRDI);
- AddRegister( "R8", InstructionSet.regR8); AddRegister( "R9", InstructionSet.regR9);
- AddRegister( "R10", InstructionSet.regR10); AddRegister( "R11", InstructionSet.regR11);
- AddRegister( "R12", InstructionSet.regR12); AddRegister( "R13", InstructionSet.regR13);
- AddRegister( "R14", InstructionSet.regR14); AddRegister( "R15", InstructionSet.regR15);
- AddRegister( "R8D", InstructionSet.regR8D); AddRegister( "R9D", InstructionSet.regR9D);
- AddRegister( "R10D", InstructionSet.regR10D); AddRegister( "R11D", InstructionSet.regR11D);
- AddRegister( "R12D", InstructionSet.regR12D); AddRegister( "R13D", InstructionSet.regR13D);
- AddRegister( "R14D", InstructionSet.regR14D); AddRegister( "R15D", InstructionSet.regR15D);
- AddRegister( "R8W", InstructionSet.regR8W); AddRegister( "R9W", InstructionSet.regR9W);
- AddRegister( "R10W", InstructionSet.regR10W); AddRegister( "R11W", InstructionSet.regR11W);
- AddRegister( "R12W", InstructionSet.regR12W); AddRegister( "R13W", InstructionSet.regR13W);
- AddRegister( "R14W", InstructionSet.regR14W); AddRegister( "R15W", InstructionSet.regR15W);
- AddRegister( "R8B", InstructionSet.regR8B); AddRegister( "R9B", InstructionSet.regR9B);
- AddRegister( "R10B", InstructionSet.regR10B); AddRegister( "R11B", InstructionSet.regR11B);
- AddRegister( "R12B", InstructionSet.regR12B); AddRegister( "R13B", InstructionSet.regR13B);
- AddRegister( "R14B", InstructionSet.regR14B); AddRegister( "R15B", InstructionSet.regR15B);
- END AddRegisters;
- BEGIN
- IF system = NIL THEN
- IF bits=32 THEN
- NEW(system,8,8,32, 8,32,32,32,64,cooperative);
- Global.SetDefaultDeclarations(system,8);
- Global.SetDefaultOperators(system);
- ELSE
- NEW(system,8,8,64,8,64,64,64,128,cooperative);
- Global.SetDefaultDeclarations(system,8);
- Global.SetDefaultOperators(system);
- END;
- system.SetRegisterPassCallback(CanPassInRegister);
- AddRegisters
- END;
- RETURN system
- END GetSystem;
-
- (* returns the following register (or part thereof)
- 0: regRAX;
- 1: regRCX;
- 2: regRDX;
- 3: regRBX;
- 4: regRSP;
- 5: regRBP;
- 6: regRSI;
- 7: regRDI;
- 8 .. 15: regRx;
- *)
- PROCEDURE HardwareIntegerRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
- BEGIN
- index := index MOD 32;
- sizeInBits := sizeInBits DIV 8;
- WHILE sizeInBits > 1 DO (* jump to register section that corresponds to the number of bits *)
- INC(index,32);
- sizeInBits := sizeInBits DIV 2;
- END;
- RETURN index
- END HardwareIntegerRegister;
- PROCEDURE HardwareFloatRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
- BEGIN
- ASSERT((sizeInBits = 32) OR (sizeInBits = 64));
- RETURN XMM0 + index;
- END HardwareFloatRegister;
-
- PROCEDURE ResetParameterRegisters*;
- BEGIN
- intParameterIndex := 0;
- floatParameterIndex := 0;
- END ResetParameterRegisters;
-
- PROCEDURE GetParameterRegister*(callingConvention: SyntaxTree.CallingConvention; type: IntermediateCode.Type; VAR register: WORD): BOOLEAN;
- VAR index: WORD;
- BEGIN
- IF bits = 32 THEN register := -1; RETURN FALSE END;
-
- IF type.form IN IntermediateCode.Integer THEN
- CASE callingConvention OF
- |SyntaxTree.WinAPICallingConvention:
- IF intParameterIndex >= 4 THEN register := -1; RETURN FALSE END;
- index := winAPIRegisters[intParameterIndex];
- |SyntaxTree.CCallingConvention:
- IF intParameterIndex >= 6 THEN register := -1; RETURN FALSE END;
- index := cRegisters[intParameterIndex];
- ELSE
- register := -1; RETURN FALSE;
- END;
- INC (intParameterIndex);
- register := HardwareIntegerRegister(RAX + index, type.sizeInBits);
- RETURN TRUE;
- ELSIF type.form = IntermediateCode.Float THEN
- CASE callingConvention OF
- |SyntaxTree.WinAPICallingConvention:
- IF intParameterIndex >= 4 THEN register := -1; RETURN FALSE END;
- index := intParameterIndex;
- INC(intParameterIndex);
- |SyntaxTree.CCallingConvention:
- IF floatParameterIndex >= 8 THEN register := -1; RETURN FALSE END;
- index := floatParameterIndex;
- INC(floatParameterIndex);
- ELSE
- register := -1; RETURN FALSE;
- END;
- register := HardwareFloatRegister(index, type.sizeInBits);
- RETURN TRUE;
- ELSE
- HALT(100);
- END;
- END GetParameterRegister;
- PROCEDURE SupportedInstruction*(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
- BEGIN
- RETURN cg.Supported(instruction,moduleName,procedureName);
- END SupportedInstruction;
- PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
- VAR
- in: Sections.Section;
- out: BinaryCode.Section;
- name: Basic.SegmentedName;
- procedure: SyntaxTree.Procedure;
- i, j, initialSectionCount: LONGINT;
- (* recompute fixup positions and assign binary sections *)
- PROCEDURE PatchFixups(section: BinaryCode.Section);
- VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; displacement,symbolOffset: LONGINT; in: IntermediateCode.Section;
- symbol: Sections.Section;
- BEGIN
- fixup := section.fixupList.firstFixup;
- WHILE fixup # NIL DO
- symbol := module.allSections.FindByName(fixup.symbol.name);
- IF (symbol # NIL) & (symbol(IntermediateCode.Section).resolved # NIL) THEN
- resolved := symbol(IntermediateCode.Section).resolved(BinaryCode.Section);
- in := symbol(IntermediateCode.Section);
- symbolOffset := fixup.symbolOffset;
- IF symbolOffset = in.pc THEN
- displacement := resolved.pc
- ELSIF (symbolOffset # 0) THEN
- ASSERT(in.pc > symbolOffset);
- displacement := in.instructions[symbolOffset].pc;
- ELSE
- displacement := 0;
- END;
- fixup.SetSymbol(fixup.symbol.name,fixup.symbol.fingerprint,0,fixup.displacement+displacement);
- END;
- fixup := fixup.nextFixup;
- END;
- END PatchFixups;
- BEGIN
- cg.SetModule(module);
- FOR i := 0 TO module.allSections.Length() - 1 DO
- in := module.allSections.GetSection(i);
- IF in.type = Sections.InlineCodeSection THEN
- name := in.name;
- out := ResolvedSection(in(IntermediateCode.Section));
- cg.Section(in(IntermediateCode.Section),out);
- procedure := in.symbol(SyntaxTree.Procedure);
- IF procedure.procedureScope.body.code # NIL THEN
- procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
- END;
- END
- END;
- initialSectionCount := 0;
- REPEAT
- j := initialSectionCount;
- initialSectionCount := module.allSections.Length() ;
- FOR i := j TO initialSectionCount - 1 DO
- in := module.allSections.GetSection(i);
- IF (in.type # Sections.InlineCodeSection) & (in(IntermediateCode.Section).resolved = NIL) THEN
- name := in.name;
- out := ResolvedSection(in(IntermediateCode.Section));
- cg.Section(in(IntermediateCode.Section),out);
- IF out.os.type = Sections.VarSection THEN
- IF out.pc = 1 THEN out.SetAlignment(FALSE,1)
- ELSIF out.pc = 2 THEN out.SetAlignment(FALSE,2)
- ELSIF (out.pc > 4) & (bits > 32) THEN out.SetAlignment(FALSE,8)
- ELSIF (out.pc > 2) THEN out.SetAlignment(FALSE,4)
- END;
- ELSIF out.os.type = Sections.ConstSection THEN
- out.SetAlignment(FALSE,bits DIV 8);
- END;
- END
- END
- UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
- (*
- FOR i := 0 TO module.allSections.Length() - 1 DO
- in := module.allSections.GetSection(i);
- IF in.kind = Sections.CaseTableKind THEN
- IF in(IntermediateCode.Section).resolved = NIL THEN
- out := ResolvedSection(in(IntermediateCode.Section));
- cg.Section(in(IntermediateCode.Section),out);
- END
- END
- END;
- *)
- FOR i := 0 TO module.allSections.Length() - 1 DO
- in := module.allSections.GetSection(i);
- PatchFixups(in(IntermediateCode.Section).resolved)
- END;
- (*
- FOR i := 0 TO module.allSections.Length() - 1 DO
- in := module.allSections.GetSection(i);
- IF in.kind = Sections.CaseTableKind THEN
- PatchFixups(in(IntermediateCode.Section).resolved)
- END
- END;
- *)
- IF cg.error THEN Error("",Basic.invalidPosition, Streams.Invalid,"") END;
- END GenerateBinary;
- (* genasm *)
- PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
- VAR
- result: Formats.GeneratedModule;
- BEGIN
- ASSERT(intermediateCodeModule IS Sections.Module);
- result := ProcessIntermediateCodeModule^(intermediateCodeModule);
- IF ~error THEN
- GenerateBinary(result(Sections.Module),dump);
- IF dump # NIL THEN
- dump.Ln; dump.Ln;
- dump.String(";------------------ binary code -------------------"); dump.Ln;
- IF (traceString="") OR (traceString="*") THEN
- result.Dump(dump);
- dump.Update
- ELSE
- Sections.DumpFiltered(dump, result(Sections.Module), traceString);
- dump.Update;
- END
- END;
- END;
- RETURN result
- FINALLY
- IF dump # NIL THEN
- dump.Ln; dump.Ln;
- dump.String("; ------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
- IF (traceString="") OR (traceString="*") THEN
- result.Dump(dump);
- dump.Update
- ELSE
- Sections.DumpFiltered(dump, result(Sections.Module), traceString);
- dump.Update;
- END
- END;
- HALT(100); (* do not continue compiling after trap *)
- RETURN result
- END ProcessIntermediateCodeModule;
- PROCEDURE FindPC*(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
- VAR
- section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
- i: LONGINT; pooledName: Basic.SegmentedName;
- BEGIN
- module := ProcessSyntaxTreeModule(x);
- Basic.ToSegmentedName(sectionName, pooledName);
- i := 0;
- REPEAT
- section := module(Sections.Module).allSections.GetSection(i);
- INC(i);
- UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
- IF section.name # pooledName THEN
- Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
- ELSE
- binarySection := section(IntermediateCode.Section).resolved;
- IF binarySection # NIL THEN
- label := binarySection.labels;
- WHILE (label # NIL) & (label.offset >= sectionOffset) DO
- label := label.prev;
- END;
- END;
- IF label # NIL THEN
- Basic.Information(diagnostics, module.module.sourceName,label.position, " pc position");
- ELSE
- Basic.Error(diagnostics, module.module.sourceName,Basic.invalidPosition, " could not locate pc");
- END;
- END;
- END FindPC;
- PROCEDURE CanPassInRegister*(type: SyntaxTree.Type): BOOLEAN;
- VAR length: LONGINT; baseType: SyntaxTree.Type; b: BOOLEAN;
- BEGIN
- b := SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.FloatType) &
- (baseType.sizeInBits <= 32) & (length = 4);
- b := b OR SemanticChecker.IsStaticMathArray(type, length, baseType) & (baseType IS SyntaxTree.CharacterType) &
- (baseType.sizeInBits = 8) & (length = 4);
- b := b OR SemanticChecker.IsStaticArray(type, baseType, length) & (baseType.resolved IS SyntaxTree.CharacterType) &
- (baseType.resolved.sizeInBits = 8) & (length = 4);
- RETURN b
- END CanPassInRegister;
- PROCEDURE GetDescription*(VAR instructionSet: ARRAY OF CHAR);
- BEGIN instructionSet := "AMD";
- END GetDescription;
- PROCEDURE DefineOptions*(options: Options.Options);
- BEGIN
- options.Add(0X,"bits",Options.Integer);
- options.Add(0X,"traceable", Options.Flag);
- options.Add(0X,"useFPU", Options.Flag);
- DefineOptions^(options);
- END DefineOptions;
- PROCEDURE GetOptions*(options: Options.Options);
- BEGIN
- IF ~options.GetInteger("bits",bits) THEN bits := 32 END;
- traceable := options.GetFlag("traceable");
- forceFPU := options.GetFlag("useFPU");
- GetOptions^(options);
- END GetOptions;
- PROCEDURE DefaultObjectFileFormat*(): Formats.ObjectFileFormat;
- BEGIN RETURN ObjectFileFormat.Get();
- END DefaultObjectFileFormat;
- PROCEDURE DefaultSymbolFileFormat*(): Formats.SymbolFileFormat;
- BEGIN
- RETURN NIL
- END DefaultSymbolFileFormat;
- END BackendAMD64;
- (** the number of regular sections in a section list **)
- PROCEDURE RegularSectionCount(sectionList: Sections.SectionList): LONGINT;
- VAR
- section: Sections.Section;
- i, result: LONGINT;
- BEGIN
- result := 0;
- FOR i := 0 TO sectionList.Length() - 1 DO
- section := sectionList.GetSection(i);
- INC(result)
- END;
- RETURN result
- END RegularSectionCount;
- PROCEDURE Assert(b: BOOLEAN; CONST s: ARRAY OF CHAR);
- BEGIN
- ASSERT(b,100);
- END Assert;
- PROCEDURE Halt(CONST s: ARRAY OF CHAR);
- BEGIN
- HALT(100);
- END Halt;
- PROCEDURE ResolvedSection(in: IntermediateCode.Section): BinaryCode.Section;
- VAR section: BinaryCode.Section;
- BEGIN
- IF in.resolved = NIL THEN
- NEW(section,in.type, 8, in.name,in.comments # NIL,FALSE);
- section.SetAlignment(in.fixed, in.positionOrAlignment);
- in.SetResolved(section);
- ELSE
- section := in.resolved
- END;
- RETURN section
- END ResolvedSection;
- PROCEDURE Init;
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(registerOperands)-1 DO
- Assembler.InitRegister(registerOperands[i],i);
- END;
- opEAX := registerOperands[EAX];
- opEBX := registerOperands[EBX];
- opECX := registerOperands[ECX];
- opEDX := registerOperands[EDX];
- opESI := registerOperands[ESI];
- opEDI := registerOperands[EDI];
- opEBP := registerOperands[EBP];
- opESP := registerOperands[ESP];
- opRSP := registerOperands[RSP];
- opRBP := registerOperands[RBP];
- opAX := registerOperands[AX];
- opBX := registerOperands[BX];
- opCX := registerOperands[CX];
- opDX := registerOperands[DX];
- opSI := registerOperands[SI];
- opDI := registerOperands[DI];
- opAL := registerOperands[AL];
- opBL := registerOperands[BL];
- opCL := registerOperands[CL];
- opDL := registerOperands[DL];
- opAH := registerOperands[AH];
- opBH := registerOperands[BH];
- opCH := registerOperands[CH];
- opDH := registerOperands[DH];
- opST0 := registerOperands[ST0];
- NEW(unusable); NEW(blocked); NEW(split); free := NIL;
- END Init;
- PROCEDURE Get*(): Backend.Backend;
- VAR backend: BackendAMD64;
- BEGIN NEW(backend); RETURN backend
- END Get;
- PROCEDURE Trace*;
- BEGIN
- TRACE(traceStackSize);
- END Trace;
- BEGIN
- traceStackSize := 0;
- Init;
- usePool := Machine.NumberOfProcessors()>1;
- END FoxAMDBackend.
- System.FreeDownTo FoxAMDBackend ~
|