FoxTRMBackend.Mod 85 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501
  1. MODULE FoxTRMBackend; (** AUTHOR "fof"; PURPOSE "backend for the tiny register machine"; *)
  2. IMPORT
  3. Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
  4. IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, BinaryCode := FoxBinaryCode,
  5. SemanticChecker := FoxSemanticChecker, Formats := FoxFormats, Assembler := FoxTRMAssembler, InstructionSet := FoxTRMInstructionSet,
  6. SYSTEM, Diagnostics, Streams, Options, WMUtilities, Strings, ObjectFile, Scanner := FoxScanner, ObjectFileFormat := FoxIntermediateObjectFile,
  7. ActiveCells := FoxActiveCells, CodeGenerators := FoxCodeGenerators, D := Debugging,
  8. KernelLog;
  9. CONST
  10. TraceFixups = FALSE;
  11. DefaultRuntimeModuleName = "TRMRuntime";
  12. HaltIRQNumber=8;
  13. Registers = 8; None=-1;
  14. Low=0; High=1;
  15. FPSupported = TRUE; (* setting this to false increases code size slightly but also reduces register pressure *)
  16. opAND= InstructionSet.opAND; opBIC* = InstructionSet.opBIC;
  17. opOR= InstructionSet.opOR; opXOR= InstructionSet.opXOR;
  18. opADD= InstructionSet.opADD; opFADD = InstructionSet.opFADD; opSUB= InstructionSet.opSUB; opFSUB = InstructionSet.opFSUB;
  19. opMUL= InstructionSet.opMUL; opFMUL = InstructionSet.opFMUL; opNOT= InstructionSet.opNOT;
  20. opLDH= InstructionSet.opLDH;
  21. opMOV= InstructionSet.opMOV; opROR= InstructionSet.opROR;
  22. opBLR= InstructionSet.opBLR; opBR= InstructionSet.opBR;
  23. opIRET* = InstructionSet.opIRET; opLD= InstructionSet.opLD;
  24. opST= InstructionSet.opST; opBL= InstructionSet.opBL;
  25. opBEQ= InstructionSet.opBEQ; opBNE= InstructionSet.opBNE;
  26. opBAE= InstructionSet.opBAE; opBB= InstructionSet.opBB;
  27. opBN= InstructionSet.opBN; opBNN= InstructionSet.opBNN;
  28. opBO* = InstructionSet.opBO; opBNO* = InstructionSet.opBNO;
  29. opBA= InstructionSet.opBA; opBBE= InstructionSet.opBBE;
  30. opBGE= InstructionSet.opBGE; opBLT= InstructionSet.opBLT;
  31. opBGT= InstructionSet.opBGT; opBLE= InstructionSet.opBLE;
  32. opBT= InstructionSet.opBT; opBF* = InstructionSet.opBF;
  33. opSPSR* = InstructionSet.opSPSR;
  34. VectorSupportFlag = "vectorSupport";
  35. FloatingPointSupportFlag ="floatingPoint";
  36. FPSupportFlag = "supportFP";
  37. PatchSpartan6 ="patchSpartan6";
  38. TYPE
  39. Operand=InstructionSet.Operand;
  40. FixupEntry=POINTER TO RECORD
  41. maxPC: LONGINT;
  42. fixup: BinaryCode.Fixup;
  43. next: FixupEntry;
  44. END;
  45. ForwardFixupList=OBJECT
  46. VAR
  47. first,last: FixupEntry;
  48. PROCEDURE &Init;
  49. BEGIN
  50. first := NIL; last := NIL;
  51. END Init;
  52. PROCEDURE Enter(fixup: BinaryCode.Fixup; currentPC: LONGINT; bits: LONGINT);
  53. VAR entry: FixupEntry; maxPC: LONGINT;
  54. BEGIN
  55. maxPC := currentPC + ASH(1,bits-1) -1; (* signed *)
  56. NEW(entry); entry.fixup := fixup;
  57. entry.maxPC := maxPC-1; (* one instruction necessary to jump over the instruction *)
  58. IF first = NIL THEN first := entry; last := entry;
  59. ELSE
  60. ASSERT(last.maxPC <= maxPC); (* otherwise we have to insert sorted but this does not seem necessary *)
  61. last.next := entry;
  62. last := entry;
  63. END;
  64. END Enter;
  65. PROCEDURE Check(outPC: LONGINT): BinaryCode.Fixup;
  66. VAR fixup: BinaryCode.Fixup;
  67. BEGIN
  68. IF (first # NIL) & (outPC >= first.maxPC) THEN
  69. fixup := first.fixup;
  70. IF first = last THEN first := NIL; last := NIL ELSE first := first.next END;
  71. RETURN fixup;
  72. ELSE
  73. RETURN NIL
  74. END;
  75. END Check;
  76. END ForwardFixupList;
  77. Ticket=CodeGenerators.Ticket;
  78. PhysicalRegisters*=OBJECT (CodeGenerators.PhysicalRegisters)
  79. VAR
  80. toVirtual: ARRAY Registers OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
  81. reserved: ARRAY Registers OF BOOLEAN;
  82. unusable: Ticket;
  83. hint: LONGINT;
  84. PROCEDURE &InitPhysicalRegisters(supportFP: BOOLEAN);
  85. VAR i: LONGINT;
  86. BEGIN
  87. FOR i := 0 TO LEN(toVirtual)-1 DO
  88. toVirtual[i] := NIL;
  89. reserved[i] := FALSE;
  90. END;
  91. (* reserve stack and base pointer registers *)
  92. NEW(unusable);
  93. toVirtual[InstructionSet.SP] := unusable;
  94. toVirtual[InstructionSet.LR] := unusable;
  95. IF supportFP THEN
  96. toVirtual[InstructionSet.FP] := unusable
  97. END;
  98. END InitPhysicalRegisters;
  99. PROCEDURE SupportFP(b: BOOLEAN);
  100. BEGIN
  101. IF b THEN toVirtual[InstructionSet.FP] := unusable ELSE toVirtual[InstructionSet.FP] := NIL END;
  102. END SupportFP;
  103. PROCEDURE NumberRegisters(): LONGINT;
  104. BEGIN
  105. RETURN Registers
  106. END NumberRegisters;
  107. PROCEDURE Allocate(index: LONGINT; virtualRegister: Ticket);
  108. BEGIN
  109. Assert(toVirtual[index]=NIL,"register already allocated");
  110. toVirtual[index] := virtualRegister;
  111. ASSERT(~virtualRegister.spilled);
  112. END Allocate;
  113. PROCEDURE SetReserved(index: LONGINT; res: BOOLEAN);
  114. BEGIN
  115. reserved[index] := res;
  116. END SetReserved;
  117. PROCEDURE Reserved(index: LONGINT): BOOLEAN;
  118. BEGIN
  119. RETURN (index>0) & reserved[index]
  120. END Reserved;
  121. PROCEDURE Free(index: LONGINT);
  122. BEGIN
  123. Assert((toVirtual[index] # NIL),"register not reserved");
  124. toVirtual[index] := NIL;
  125. END Free;
  126. PROCEDURE NextFree(CONST type: IntermediateCode.Type):LONGINT;
  127. VAR i: LONGINT;
  128. BEGIN
  129. ASSERT(type.sizeInBits=32);
  130. i := 0;
  131. IF (hint # None) THEN
  132. IF toVirtual[hint] = NIL THEN i := hint END;
  133. hint := None
  134. END;
  135. WHILE (i<Registers) & (toVirtual[i] # NIL) DO
  136. INC(i);
  137. END;
  138. IF i=Registers THEN i := None END;
  139. RETURN i;
  140. END NextFree;
  141. PROCEDURE AllocationHint(index: LONGINT);
  142. BEGIN hint := index
  143. END AllocationHint;
  144. PROCEDURE Mapped(physical: LONGINT): Ticket;
  145. BEGIN
  146. RETURN toVirtual[physical]
  147. END Mapped;
  148. PROCEDURE Dump(w: Streams.Writer);
  149. VAR i: LONGINT; virtual: Ticket;
  150. BEGIN
  151. w.String("---- registers ----"); w.Ln;
  152. FOR i := 0 TO LEN(toVirtual)-1 DO
  153. virtual := toVirtual[i];
  154. IF virtual # unusable THEN
  155. w.String("reg "); w.Int(i,1); w.String(": ");
  156. IF virtual = NIL THEN w.String("free")
  157. ELSE w.String(" r"); w.Int(virtual.register,1);
  158. END;
  159. IF reserved[i] THEN w.String("reserved") END;
  160. w.Ln;
  161. END;
  162. END;
  163. END Dump;
  164. END PhysicalRegisters;
  165. CodeGeneratorTRM = OBJECT (CodeGenerators.GeneratorWithTickets)
  166. VAR
  167. opSP, opLR, opFP, null, noOperand: InstructionSet.Operand;
  168. instructionSet: InstructionSet.InstructionSet;
  169. stackSize, spillStackPosition: LONGINT;
  170. stackSizeKnown: BOOLEAN;
  171. inStackAllocation: BOOLEAN;
  172. runtimeModuleName: SyntaxTree.IdentifierString;
  173. forwardFixups: ForwardFixupList;
  174. spillStackStart: LONGINT;
  175. backend: BackendTRM;
  176. supportFP: BOOLEAN;
  177. pushChainLength: LONGINT;
  178. patchSpartan6: BOOLEAN;
  179. PROCEDURE SetInstructionSet(instructionSet: InstructionSet.InstructionSet);
  180. BEGIN
  181. SELF.instructionSet:=instructionSet;
  182. END SetInstructionSet;
  183. PROCEDURE &InitGeneratorTRM(CONST runtime: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; b: BackendTRM; instructionSet: InstructionSet.InstructionSet);
  184. VAR physicalRegisters: PhysicalRegisters;
  185. BEGIN
  186. inStackAllocation := FALSE;
  187. SELF.runtimeModuleName := runtime;
  188. SELF.instructionSet:=instructionSet;
  189. backend := b;
  190. NEW(physicalRegisters,FALSE);
  191. InitTicketGenerator(diagnostics, backend.optimize,2,physicalRegisters);
  192. error := FALSE;
  193. pushChainLength := 0;
  194. instructionSet.InitImmediate(null, 0, 0);
  195. instructionSet.InitOperand(noOperand);
  196. instructionSet.InitRegister(opSP, InstructionSet.SP);
  197. instructionSet.InitRegister(opLR, InstructionSet.LR);
  198. instructionSet.InitRegister(opFP, InstructionSet.FP);
  199. dump := NIL;
  200. patchSpartan6 := FALSE;
  201. NEW(forwardFixups);
  202. END InitGeneratorTRM;
  203. PROCEDURE CheckStackPointer(CONST dest: InstructionSet.Operand);
  204. BEGIN
  205. IF stackSizeKnown & ~inStackAllocation THEN
  206. IF(dest.type = InstructionSet.Register) & (dest.register = InstructionSet.SP) THEN
  207. IF dump # NIL THEN
  208. dump.String("stack size unknown ") ;
  209. END;
  210. stackSizeKnown := FALSE;
  211. END;
  212. END;
  213. END CheckStackPointer;
  214. PROCEDURE PatchSpartan6;
  215. VAR i: LONGINT; opx: InstructionSet.Operand;
  216. BEGIN
  217. IF patchSpartan6 THEN
  218. IF (out.os.fixed) & ((out.os.alignment + out.pc) MOD 1024 = 959) THEN
  219. instructionSet.InitImmediate(opx,0,16);
  220. instructionSet.Emit(InstructionSet.opBT, opx, emptyOperand, out);
  221. FOR i := 1 TO 16 DO
  222. out.PutBits(0,18);
  223. END;
  224. END;
  225. END;
  226. END PatchSpartan6;
  227. PROCEDURE Emit(op: LONGINT; CONST op1, op2: InstructionSet.Operand);
  228. VAR pc: LONGINT;
  229. BEGIN
  230. pc := (out.os.alignment + out.pc);
  231. ASSERT(~patchSpartan6 OR ~out.os.fixed OR ((out.os.alignment + out.pc) MOD 1024 < 960) OR ((out.os.alignment + out.pc) MOD 1024 > 975) );
  232. instructionSet.Emit(op, op1, op2, out);
  233. (* do this AFTER each instruction because otherwise presumptions on the size of the PC in the generator are wrong *)
  234. (* note, in general, by the inclusion of the following code, no assumptions are true about the actual size of instructions in code emission
  235. --> forward jumps do have to be patched in all cases
  236. *)
  237. PatchSpartan6;
  238. END Emit;
  239. PROCEDURE Emit2(op: LONGINT; CONST op1, op2: InstructionSet.Operand);
  240. BEGIN
  241. CheckStackPointer(op1);
  242. Emit(op, op1, op2);
  243. END Emit2;
  244. PROCEDURE Emit2N(op: LONGINT; CONST op1: InstructionSet.Operand; n: LONGINT);
  245. VAR op2: InstructionSet.Operand;
  246. BEGIN
  247. CheckStackPointer(op1);
  248. instructionSet.InitImmediate(op2,0,n);
  249. Emit(op, op1, op2);;
  250. END Emit2N;
  251. PROCEDURE Emit1(op: LONGINT; CONST op1: InstructionSet.Operand);
  252. BEGIN
  253. Emit(op, op1, emptyOperand);
  254. END Emit1;
  255. PROCEDURE Emit1N(op: LONGINT; n: LONGINT);
  256. VAR op1: InstructionSet.Operand;
  257. BEGIN
  258. instructionSet.InitImmediate(op1,0,n);
  259. Emit(op, op1, emptyOperand);
  260. END Emit1N;
  261. (*------------------- overwritten methods ----------------------*)
  262. PROCEDURE Section(in: IntermediateCode.Section; out: BinaryCode.Section);
  263. VAR oldSpillStackSize: LONGINT;
  264. PROCEDURE CheckEmptySpillStack(): BOOLEAN;
  265. BEGIN
  266. IF spillStack.Size()#0 THEN Error(inPC,"implementation error, spill stack not cleared");
  267. IF dump # NIL THEN
  268. spillStack.Dump(dump);
  269. tickets.Dump(dump);
  270. END;
  271. RETURN FALSE ELSE RETURN TRUE END;
  272. END CheckEmptySpillStack;
  273. BEGIN
  274. physicalRegisters(PhysicalRegisters).SupportFP(FPSupported);
  275. supportFP := FPSupported;
  276. tickets.Init;
  277. spillStack.Init;
  278. stackSizeKnown := TRUE;
  279. forwardFixups.Init;
  280. Section^(in,out);
  281. IF ~stackSizeKnown THEN
  282. supportFP := TRUE;
  283. tickets.Init;
  284. spillStack.Init;
  285. forwardFixups.Init;
  286. out.Reset;
  287. physicalRegisters(PhysicalRegisters).SupportFP(TRUE);
  288. Section^(in,out);
  289. END;
  290. IF CheckEmptySpillStack() & (spillStack.MaxSize() >0) THEN
  291. forwardFixups.Init;
  292. oldSpillStackSize := spillStack.MaxSize();
  293. out.Reset;
  294. Section^(in,out);
  295. ASSERT(spillStack.MaxSize() = oldSpillStackSize);
  296. END;
  297. IF CheckEmptySpillStack() THEN END;
  298. END Section;
  299. PROCEDURE Supported(CONST instr: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  300. VAR sizeInBits: LONGINT; form: LONGINT; opcode: LONGINT;
  301. BEGIN
  302. opcode := instr.opcode;
  303. form := instr.op1.type.form;
  304. COPY(runtimeModuleName, moduleName);
  305. IF opcode = IntermediateCode.conv THEN (* conversions between float and integer types in a library *)
  306. IF form = IntermediateCode.Float THEN
  307. IF instr.op2.type.form = IntermediateCode.Float THEN
  308. IF (instr.op1.type.sizeInBits = 32) & (instr.op2.type.sizeInBits = 64) THEN
  309. procedureName := "ConvertXR"; RETURN FALSE
  310. ELSIF (instr.op1.type.sizeInBits = 64) & (instr.op2.type.sizeInBits = 32) THEN
  311. procedureName := "ConvertRX"; RETURN FALSE
  312. ELSE HALT(100);
  313. END;
  314. ELSE
  315. ASSERT( instr.op2.type.form = IntermediateCode.SignedInteger);
  316. IF (instr.op2.type.sizeInBits = 32) THEN
  317. IF instr.op1.type.sizeInBits = 32 THEN
  318. procedureName := "ConvertIR"; RETURN FALSE
  319. ELSIF instr.op1.type.sizeInBits = 64 THEN
  320. procedureName := "ConvertHR"; RETURN FALSE
  321. ELSE HALT(100);
  322. END;
  323. ELSIF (instr.op2.type.sizeInBits=64) THEN
  324. IF instr.op1.type.sizeInBits = 32 THEN
  325. procedureName := "ConvertIX"; RETURN FALSE
  326. ELSIF instr.op1.type.sizeInBits = 64 THEN
  327. procedureName := "ConvertHX"; RETURN FALSE
  328. ELSE HALT(100);
  329. END;
  330. ELSE HALT(100);
  331. END
  332. END;
  333. ELSIF instr.op2.type.form = IntermediateCode.Float THEN
  334. ASSERT(instr.op1.type.form = IntermediateCode.SignedInteger);
  335. IF (instr.op2.type.sizeInBits = 32) THEN
  336. IF instr.op1.type.sizeInBits = 32 THEN
  337. procedureName := "ConvertRI"; RETURN FALSE
  338. ELSIF instr.op1.type.sizeInBits = 64 THEN
  339. procedureName := "ConvertRH"; RETURN FALSE
  340. ELSE HALT(100);
  341. END;
  342. ELSIF (instr.op2.type.sizeInBits=64) THEN
  343. IF instr.op1.type.sizeInBits = 32 THEN
  344. procedureName := "ConvertXI"; RETURN FALSE
  345. ELSIF instr.op1.type.sizeInBits = 64 THEN
  346. procedureName := "ConvertXH"; RETURN FALSE
  347. ELSE HALT(100);
  348. END;
  349. ELSE HALT(100);
  350. END
  351. END;
  352. ELSIF form IN IntermediateCode.Integer THEN
  353. IF instr.op1.type.sizeInBits = IntermediateCode.Bits64 THEN
  354. CASE instr.opcode OF
  355. IntermediateCode.div: procedureName := "DivH"; RETURN FALSE
  356. | IntermediateCode.mod: procedureName := "ModH"; RETURN FALSE
  357. | IntermediateCode.abs: procedureName := "AbsH"; RETURN FALSE;
  358. | IntermediateCode.shl :
  359. IF instr.op1.type.form = IntermediateCode.SignedInteger THEN
  360. procedureName := "AslH"; RETURN FALSE;
  361. ELSE
  362. procedureName := "LslH"; RETURN FALSE;
  363. END;
  364. | IntermediateCode.shr :
  365. IF instr.op1.type.form = IntermediateCode.SignedInteger THEN
  366. procedureName := "AsrH"; RETURN FALSE;
  367. ELSE
  368. procedureName := "LsrH"; RETURN FALSE;
  369. END;
  370. | IntermediateCode.ror: procedureName := "RorH"; RETURN FALSE;
  371. | IntermediateCode.rol: procedureName := "RolH"; RETURN FALSE;
  372. ELSE RETURN TRUE
  373. END
  374. ELSIF instr.op1.type.sizeInBits = IntermediateCode.Bits32 THEN
  375. CASE instr.opcode OF
  376. IntermediateCode.div: procedureName := "DivL"; RETURN FALSE
  377. | IntermediateCode.mod: procedureName := "ModL"; RETURN FALSE
  378. | IntermediateCode.mul:
  379. IF (Global.NoMulCapability IN backend.capabilities) THEN (*mul forbidden*)
  380. procedureName:="MulL"; RETURN FALSE
  381. ELSE
  382. RETURN TRUE;
  383. END
  384. ELSE
  385. RETURN TRUE
  386. END;
  387. ELSE
  388. sizeInBits := instr.op1.type.sizeInBits;
  389. HALT(100)
  390. END;
  391. ELSIF (form = IntermediateCode.Float) THEN
  392. IF instr.op1.type.sizeInBits = IntermediateCode.Bits64 THEN
  393. CASE instr.opcode OF
  394. | IntermediateCode.add: procedureName := "AddX"; RETURN FALSE;
  395. | IntermediateCode.sub: procedureName := "SubX"; RETURN FALSE;
  396. | IntermediateCode.mul: procedureName := "MulX"; RETURN FALSE;
  397. | IntermediateCode.div: procedureName := "DivX"; RETURN FALSE
  398. | IntermediateCode.abs: procedureName := "AbsX"; RETURN FALSE;
  399. ELSE RETURN TRUE
  400. END;
  401. ELSIF instr.op1.type.sizeInBits = IntermediateCode.Bits32 THEN
  402. CASE instr.opcode OF
  403. | IntermediateCode.add:
  404. IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
  405. ELSE procedureName := "AddR"; RETURN FALSE
  406. END
  407. | IntermediateCode.sub:
  408. IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
  409. ELSE procedureName := "SubR"; RETURN FALSE
  410. END
  411. | IntermediateCode.mul:
  412. IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
  413. ELSE procedureName := "MulR"; RETURN FALSE
  414. END
  415. | IntermediateCode.div: procedureName := "DivR"; RETURN FALSE
  416. | IntermediateCode.abs: procedureName := "AbsR"; RETURN FALSE;
  417. ELSE RETURN TRUE
  418. END;
  419. ELSE HALT(100)
  420. END;
  421. ELSIF form = IntermediateCode.Undefined THEN
  422. RETURN TRUE
  423. ELSE HALT(100)
  424. END;
  425. RETURN TRUE
  426. END Supported;
  427. (* input: type (such as that of an intermediate operand), output: low and high type (such as in low and high type of an operand) *)
  428. PROCEDURE GetPartType(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
  429. BEGIN
  430. ASSERT(type.sizeInBits >0); ASSERT(part < 2);
  431. IF (part = 0) OR (type.sizeInBits =64) THEN
  432. IntermediateCode.InitType(typePart,type.form,32);
  433. ELSE
  434. typePart := IntermediateCode.undef
  435. END;
  436. END GetPartType;
  437. PROCEDURE GetSpillOperand(ticket: Ticket; VAR mem: Operand);
  438. VAR offset: LONGINT; register: LONGINT;
  439. BEGIN
  440. D.String("spill stack used in "); Basic.WriteSegmentedName(D.Log, in.name); D.String(": "); D.Int(inPC,1); D.Ln;
  441. offset := spillStackPosition-ticket.offset; (* relative to logical frame pointer ! *)
  442. register := PhysicalRegister(IntermediateCode.FP,Low,offset);
  443. instructionSet.InitMemory(mem, register, offset);
  444. END GetSpillOperand;
  445. PROCEDURE ToSpillStack(ticket: Ticket);
  446. VAR mem, reg:Operand;
  447. BEGIN
  448. IF dump # NIL THEN dump.String("spill: "); CodeGenerators.DumpTicket(dump,ticket); dump.Ln; END;
  449. GetSpillOperand(ticket,mem);
  450. instructionSet.InitRegister(reg,ticket.register);
  451. Emit2(opST,reg,mem);
  452. END ToSpillStack;
  453. PROCEDURE AllocateSpillStack(size: LONGINT);
  454. BEGIN
  455. END AllocateSpillStack;
  456. PROCEDURE ToRegister(ticket: Ticket);
  457. VAR mem,reg: Operand;
  458. BEGIN
  459. IF dump # NIL THEN dump.String("unspill: "); CodeGenerators.DumpTicket(dump,ticket); dump.Ln END;
  460. GetSpillOperand(ticket,mem);
  461. instructionSet.InitRegister(reg,ticket.register);
  462. Emit2(opLD,reg,mem);
  463. END ToRegister;
  464. PROCEDURE ExchangeTickets(ticket1,ticket2: Ticket);
  465. VAR op1,op2,temp: Operand;
  466. BEGIN
  467. TicketToOperand(ticket1,op1);
  468. TicketToOperand(ticket2,op2);
  469. GetTemporaryRegister(temp);
  470. IF op1.type = InstructionSet.Register THEN
  471. ASSERT(op2.type = InstructionSet.Memory);
  472. Emit2(opMOV,temp,op1);
  473. Emit2(opLD,op1,op2);
  474. Emit2(opST,temp,op2);
  475. ELSE
  476. ASSERT(op2.type = InstructionSet.Register); ASSERT(op1.type = InstructionSet.Memory);
  477. Emit2(opMOV,temp,op2);
  478. Emit2(opLD,op2,op1);
  479. Emit2(opST,temp,op1);
  480. END;
  481. ReleaseHint(temp.register);
  482. (* spill stack not yet supported *)
  483. END ExchangeTickets;
  484. PROCEDURE CheckFixups;
  485. VAR fixup, forward, newFixup: BinaryCode.Fixup; fixupOp: InstructionSet.Operand; checkPC, iterCount: LONGINT;
  486. PROCEDURE CheckPC(): LONGINT;
  487. CONST safety=16; (* max number of TRM instructions to emit IR instruction *)
  488. BEGIN
  489. IF patchSpartan6 & out.os.fixed & ((out.pc+out.os.alignment) MOD 1024 < 960) & ((out.pc+out.os.alignment) MOD 1024 > 960-safety) THEN
  490. RETURN out.pc + safety + 16
  491. ELSE
  492. RETURN out.pc + safety (* assuming that an IR instruction can be emitted within at most 10 instructions *)
  493. END;
  494. END CheckPC;
  495. BEGIN
  496. fixup := forwardFixups.Check(CheckPC());
  497. iterCount:=0;
  498. WHILE(fixup # NIL) DO
  499. INC(iterCount);
  500. IF(iterCount>30) THEN
  501. D.String("too many iterations in forward fixup");D.Ln;
  502. HALT(100);
  503. END;
  504. (*problem: sometimes causes problems when there are large backwards jumps*)
  505. (*but is needed for long jumps in general*)
  506. (*!TODO: sometimes leads to infinite loop in instruction sizes <= 14*)
  507. (* sometimes, compiler continues to work fine without this section.*)
  508. (*apparently this section resolves the multihop jumps, but fails if it's supposed to go backward?*)
  509. IF fixup.symbolOffset < inPC THEN (* already resolved ok *)
  510. ELSE (* must be handled *)
  511. IF TraceFixups THEN
  512. D.String("relative branch fixup bits: ");D.Int(instructionSet.RelativeBranchFixupBits,1);
  513. D.String(" at inPC="); D.Int(inPC,1); D.String(", outPC="); D.Int(out.pc,1);
  514. D.String(", symbol offset=");D.Int(fixup.symbolOffset,1);
  515. D.String(", fixup from outPC = "); D.Int(fixup.offset,1); D.String(" to "); fixup.Dump(D.Log); D.String(" forwarded."); D.Ln;
  516. END;
  517. forward := BrForward(opBT);
  518. (*
  519. Emit1N(opBT, 1);
  520. *)
  521. newFixup := BinaryCode.NewFixup(fixup.mode, out.pc, fixup.symbol, fixup.symbolOffset, 0, 0, NIL);
  522. fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, fixup.displacement+out.pc);
  523. ASSERT(ABS(out.pc - fixup.displacement) < 512);
  524. instructionSet.InitFixup(fixupOp,0,newFixup);
  525. forwardFixups.Enter(newFixup, out.pc, instructionSet.RelativeBranchFixupBits);
  526. Emit1(opBT, fixupOp);
  527. SetTarget(forward);
  528. END;
  529. fixup := forwardFixups.Check(CheckPC());
  530. END;
  531. END CheckFixups;
  532. PROCEDURE IsComplex(CONST operand: IntermediateCode.Operand): BOOLEAN;
  533. BEGIN RETURN (operand.type.sizeInBits > 32)
  534. END IsComplex;
  535. PROCEDURE IsFloat(CONST operand: IntermediateCode.Operand): BOOLEAN;
  536. BEGIN RETURN operand.type.form = IntermediateCode.Float
  537. END IsFloat;
  538. PROCEDURE Generate(VAR instruction: IntermediateCode.Instruction);
  539. VAR opcode: SHORTINT; ticket: Ticket; hwreg, lastUse: LONGINT;
  540. BEGIN
  541. CheckFixups;
  542. (*
  543. IF ((instruction.opcode = IntermediateCode.mov) OR (instruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
  544. hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
  545. Spill(physicalRegisters.Mapped(hwreg));
  546. lastUse := inPC+1;
  547. WHILE (lastUse < in.pc) &
  548. ((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
  549. INC(lastUse)
  550. END;
  551. ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
  552. END;
  553. *)
  554. ReserveOperandRegisters(instruction.op1,TRUE); ReserveOperandRegisters(instruction.op2,TRUE);ReserveOperandRegisters(instruction.op3,TRUE);
  555. opcode := instruction.opcode;
  556. CASE opcode OF
  557. IntermediateCode.nop: (* do nothing *)
  558. |IntermediateCode.mov:
  559. EmitMov(instruction.op1,instruction.op2,Low);
  560. IF IsComplex(instruction.op1) THEN
  561. EmitMov(instruction.op1,instruction.op2,High)
  562. END;
  563. |IntermediateCode.conv: EmitConv(instruction);
  564. |IntermediateCode.call: EmitCall(instruction);
  565. |IntermediateCode.enter: EmitEnter(instruction);
  566. |IntermediateCode.leave: EmitLeave(instruction);
  567. |IntermediateCode.exit: EmitExit(instruction);
  568. |IntermediateCode.return:
  569. EmitReturn(instruction,Low);
  570. IF IsComplex(instruction.op1) THEN
  571. EmitReturn(instruction,High)
  572. END;
  573. |IntermediateCode.result:
  574. EmitResult(instruction,Low);
  575. IF IsComplex(instruction.op1) THEN
  576. EmitResult(instruction,High)
  577. END;
  578. |IntermediateCode.trap: EmitTrap(instruction);
  579. |IntermediateCode.br .. IntermediateCode.brlt: EmitBr(instruction)
  580. |IntermediateCode.pop:
  581. EmitPop(instruction.op1,Low);
  582. IF IsComplex(instruction.op1) THEN
  583. EmitPop(instruction.op1,High);
  584. END;
  585. |IntermediateCode.push:
  586. IF IsComplex(instruction.op1) THEN
  587. EmitPush(instruction.op1,High);
  588. END;
  589. EmitPush(instruction.op1,Low);
  590. |IntermediateCode.neg: EmitNeg(instruction);
  591. |IntermediateCode.not:
  592. EmitNot(instruction,Low);
  593. IF IsComplex(instruction.op1) THEN
  594. EmitNot(instruction,High)
  595. END;
  596. |IntermediateCode.abs: EmitAbs(instruction);
  597. |IntermediateCode.mul:
  598. IF IsFloat(instruction.op1) THEN
  599. EmitFMul(instruction)
  600. ELSE
  601. EmitMul(instruction)
  602. END
  603. |IntermediateCode.div: EmitDiv(instruction);
  604. |IntermediateCode.mod: EmitMod(instruction);
  605. |IntermediateCode.sub:
  606. IF IsFloat(instruction.op1) THEN
  607. EmitFSub(instruction)
  608. ELSE
  609. EmitSub(instruction)
  610. END
  611. |IntermediateCode.add:
  612. IF IsFloat(instruction.op1) THEN
  613. EmitFAdd(instruction)
  614. ELSE
  615. EmitAdd(instruction)
  616. END
  617. |IntermediateCode.and:
  618. EmitAnd(instruction,Low);
  619. IF IsComplex(instruction.op1) THEN
  620. EmitAnd(instruction,High);
  621. END;
  622. |IntermediateCode.or:
  623. EmitOr(instruction,Low);
  624. IF IsComplex(instruction.op1) THEN
  625. EmitOr(instruction,High)
  626. END;
  627. |IntermediateCode.xor:
  628. EmitXor(instruction,Low);
  629. IF IsComplex(instruction.op1) THEN
  630. EmitXor(instruction,High)
  631. END;
  632. |IntermediateCode.shl: EmitShift(instruction);
  633. |IntermediateCode.shr: EmitShift(instruction);
  634. |IntermediateCode.rol: EmitShift(instruction);
  635. |IntermediateCode.ror: EmitShift(instruction);
  636. |IntermediateCode.copy: EmitCopy(instruction);
  637. |IntermediateCode.fill: EmitFill(instruction, FALSE);
  638. |IntermediateCode.asm: EmitAsm(instruction);
  639. END;
  640. ReserveOperandRegisters(instruction.op3,FALSE); ReserveOperandRegisters(instruction.op2,FALSE); ReserveOperandRegisters(instruction.op1,FALSE);
  641. END Generate;
  642. PROCEDURE PostGenerate(CONST instruction: IntermediateCode.Instruction);
  643. VAR ticket: Ticket;
  644. BEGIN
  645. TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
  646. ticket := tickets.live;
  647. WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
  648. UnmapTicket(ticket);
  649. ticket := tickets.live
  650. END;
  651. END PostGenerate;
  652. PROCEDURE TicketToOperand(ticket:Ticket; VAR op: InstructionSet.Operand);
  653. BEGIN
  654. ASSERT(ticket # NIL);
  655. IF ticket.spilled THEN
  656. GetSpillOperand(ticket,op);
  657. ELSE
  658. instructionSet.InitRegister(op,ticket.register)
  659. END;
  660. END TicketToOperand;
  661. (* updateStackSize is important as intermediate RETURNS should not change stack size *)
  662. PROCEDURE AllocateStack(size: LONGINT; updateStackSize: BOOLEAN);
  663. VAR sizeOperand: InstructionSet.Operand;
  664. BEGIN
  665. inStackAllocation := TRUE;
  666. IF size > 0 THEN
  667. IF size < ASH(1,instructionSet.ImmediateFixupBits) THEN
  668. instructionSet.InitImmediate(sizeOperand, 0, size)
  669. ELSE
  670. ImmediateToOperand(size,Low,FALSE,instructionSet.ImmediateFixupBits,sizeOperand)
  671. END;
  672. Emit2(opSUB, opSP, sizeOperand);
  673. IF updateStackSize THEN INC(stackSize, size) END;
  674. ELSIF size < 0 THEN
  675. size := -size;
  676. IF size < ASH(1,instructionSet.ImmediateFixupBits) THEN
  677. instructionSet.InitImmediate(sizeOperand, 0, size);
  678. ELSE
  679. ImmediateToOperand(size,Low, FALSE, instructionSet.ImmediateFixupBits,sizeOperand);
  680. END;
  681. Emit2(opADD, opSP, sizeOperand);
  682. IF updateStackSize THEN DEC(stackSize, size) END;
  683. END;
  684. inStackAllocation := FALSE;
  685. END AllocateStack;
  686. PROCEDURE EmitEnter(CONST instr: IntermediateCode.Instruction);
  687. VAR cc: LONGINT; mem: InstructionSet.Operand;
  688. BEGIN
  689. stackSize := 0;
  690. (*
  691. stack layout:
  692. p1
  693. ...
  694. pm (parameters pushed by caller)
  695. LR (explicitly pushed by frontend because hasLinkRegister = TRUE)
  696. prev FP <-- FP = logicalFP (explicitly pushed by frontend)
  697. v1
  698. ...
  699. vn
  700. spill1 <- logicalFP + spillStackPosition (negative)
  701. ...
  702. spilln <-- SP
  703. *)
  704. cc := SHORT(instr.op1.intValue);
  705. spillStackPosition := - LONGINT(instr.op2.intValue)-1; (* relative to logical frame pointer ! *)
  706. AllocateStack(LONGINT(instr.op2.intValue+spillStack.MaxSize()), TRUE);
  707. END EmitEnter;
  708. PROCEDURE EmitLeave(CONST instr: IntermediateCode.Instruction);
  709. VAR cc: LONGINT; mem: InstructionSet.Operand;
  710. BEGIN
  711. IF ~supportFP THEN (* frame pointer might have been used *)
  712. AllocateStack(-stackSize, FALSE);
  713. Emit2(opMOV, opFP, opSP);
  714. END;
  715. END EmitLeave;
  716. PROCEDURE EmitExit(CONST instr: IntermediateCode.Instruction);
  717. VAR cc: LONGINT; mem: InstructionSet.Operand;
  718. BEGIN
  719. instructionSet.InitMemory(mem, InstructionSet.SP, 0);
  720. Emit2(opLD, opLR, mem);
  721. AllocateStack(-1,FALSE);
  722. Emit1(opBR, opLR);
  723. END EmitExit;
  724. PROCEDURE ResultRegister(part: LONGINT): InstructionSet.Operand;
  725. VAR register: InstructionSet.Operand;
  726. BEGIN
  727. IF part = Low THEN instructionSet.InitRegister(register,0)
  728. ELSE instructionSet.InitRegister(register,1)
  729. END;
  730. RETURN register
  731. END ResultRegister;
  732. PROCEDURE EmitResult(VAR instr: IntermediateCode.Instruction; part: LONGINT);
  733. VAR op,result: Operand;
  734. BEGIN
  735. AcquireDestinationRegister(instr.op1, part,op);
  736. result := ResultRegister(part);
  737. MovIfDifferent(op, result);
  738. ReleaseDestinationRegister(instr.op1,part,op);
  739. END EmitResult;
  740. PROCEDURE EmitReturn(VAR instr: IntermediateCode.Instruction; part: LONGINT);
  741. VAR op,result: Operand;
  742. BEGIN
  743. MakeRegister(instr.op1,part,op);
  744. result := ResultRegister(part);
  745. MovIfDifferent(result, op);
  746. END EmitReturn;
  747. PROCEDURE EmitMov(VAR vop1,vop2: IntermediateCode.Operand; part: LONGINT);
  748. VAR left,right: Operand; rightTicket: Ticket; neg: BOOLEAN;
  749. BEGIN
  750. rightTicket := NIL;
  751. IF vop2.mode = IntermediateCode.ModeMemory THEN
  752. (*GetMemory(vop2,part,right,rightTicket);*) (* done in load *)
  753. ELSIF ~UnsignedImmediate(vop2,part,instructionSet.ImmediateFixupBits,FALSE,neg,right) THEN
  754. MakeRegister(vop2,part,right);
  755. ReleaseHint(right.register);
  756. END;
  757. AcquireDestinationRegister(vop1,part,left);
  758. IF vop2.mode = IntermediateCode.ModeMemory THEN
  759. Load(vop2,part,left);
  760. ELSE
  761. MovIfDifferent(left, right);
  762. END;
  763. IF vop1.mode = IntermediateCode.ModeMemory THEN
  764. Store(vop1,part,left);
  765. END;
  766. ReleaseHint(left.register);
  767. END EmitMov;
  768. PROCEDURE EmitConv(VAR instr: IntermediateCode.Instruction);
  769. VAR left,right,temp: Operand;
  770. srcSize, destSize: LONGINT;
  771. BEGIN
  772. srcSize := instr.op2.type.sizeInBits;
  773. destSize := instr.op1.type.sizeInBits;
  774. ASSERT( (srcSize = 32) OR (srcSize = 64));
  775. ASSERT( (destSize = 32) OR (destSize = 64));
  776. ASSERT(instr.op1.type.form IN IntermediateCode.Integer);
  777. ASSERT(instr.op2.type.form IN IntermediateCode.Integer);
  778. IF srcSize >= destSize THEN
  779. MakeRegister(instr.op2,Low,right);
  780. ReleaseHint(right.register);
  781. AcquireDestinationRegister(instr.op1,Low,left);
  782. MovIfDifferent(left, right);
  783. ReleaseDestinationRegister(instr.op1,Low, left);
  784. ELSE
  785. MakeRegister(instr.op2, Low, right);
  786. ReleaseHint(right.register);
  787. AcquireDestinationRegister(instr.op1,Low,left);
  788. MovIfDifferent(left,right);
  789. ReleaseDestinationRegister(instr.op1,Low,left);
  790. IF (instr.op2.type.form = IntermediateCode.SignedInteger) & (instr.op1.type.form = IntermediateCode.SignedInteger) THEN
  791. GetTemporaryRegister(temp);
  792. Emit2(opMOV, temp,left);
  793. AcquireDestinationRegister(instr.op1,High,left);
  794. Emit2(opMOV, left, temp);
  795. Emit2N(opROR, temp, 31);
  796. Emit2N(opAND, temp, 1);
  797. Emit2(opNOT, left, temp);
  798. Emit2N(opADD, left, 1);
  799. ELSE
  800. AcquireDestinationRegister(instr.op1,High,left);
  801. Emit2N(opMOV, left, 0);
  802. END;
  803. ReleaseDestinationRegister(instr.op1,High,left);
  804. END;
  805. END EmitConv;
  806. PROCEDURE Resolve(VAR op: IntermediateCode.Operand);
  807. BEGIN
  808. IF (op.symbol.name # "") & (op.resolved = NIL) THEN
  809. op.resolved := module.allSections.FindByName(op.symbol.name)
  810. END;
  811. END Resolve;
  812. PROCEDURE EmitCall(VAR instruction: IntermediateCode.Instruction);
  813. VAR op: InstructionSet.Operand; section: IntermediateCode.Section; code: BinaryCode.Section; symbol: ObjectFile.Identifier;
  814. fixup, newFixup: BinaryCode.Fixup; pc: LONGINT; regOp: Operand; offset,reloffset: LONGINT;
  815. BEGIN
  816. IF (instruction.op1.symbol.name # "") & (instruction.op1.mode # IntermediateCode.ModeMemory) THEN
  817. Resolve(instruction.op1);
  818. IF instruction.op1.resolved # NIL THEN
  819. section := instruction.op1.resolved(IntermediateCode.Section);
  820. END;
  821. IF (section # NIL) & (section.type = Sections.InlineCodeSection) THEN
  822. code := section.resolved;
  823. ASSERT(code # NIL);
  824. out.CopyBits(code.os.bits, 0, code.os.bits.GetSize());
  825. fixup := code.fixupList.firstFixup;
  826. pc := code.pc;
  827. WHILE (fixup # NIL) DO
  828. newFixup := BinaryCode.NewFixup(fixup.mode, fixup.offset+pc, fixup.symbol, fixup.symbolOffset, fixup.displacement, fixup.scale, fixup.pattern);
  829. out.fixupList.AddFixup(newFixup);
  830. fixup := fixup.nextFixup;
  831. END;
  832. ELSE
  833. IF out.os.fixed THEN (* only if my own address is already known .. *)
  834. offset := GetSymbolOffset(instruction.op1, symbol);
  835. ELSE
  836. offset := instruction.op1.offset;
  837. Resolve(instruction.op1);
  838. symbol := instruction.op1.symbol;
  839. END;
  840. reloffset := offset - out.pc-out.os.alignment-1;
  841. IF symbol.name # "" THEN
  842. fixup := BinaryCode.NewFixup(BinaryCode.Relative,out.pc,symbol, offset, 0, 0, NIL);
  843. instructionSet.InitFixup(op, 32, fixup);
  844. Emit1(opBL, op);
  845. ELSIF (-ASH(1,instructionSet.BranchAndLinkFixupBits-1) <= reloffset) & (reloffset < ASH(1,instructionSet.BranchAndLinkFixupBits-1)) THEN
  846. ImmediateToOperand(reloffset, Low, TRUE, instructionSet.BranchAndLinkFixupBits,op);
  847. ASSERT(op.type = InstructionSet.Immediate);
  848. Emit1(opBL, op);
  849. ELSE
  850. GetTemporaryRegister(op);
  851. ImmediateToOperand(offset, Low, FALSE, instructionSet.ImmediateFixupBits,op);
  852. ASSERT(op.type = InstructionSet.Register);
  853. Emit2(opBLR, opLR, op);
  854. END;
  855. END;
  856. ELSE
  857. MakeRegister(instruction.op1,Low,regOp);
  858. Emit2(opBLR, opLR, regOp);
  859. END;
  860. AllocateStack(-SHORT(instruction.op2.intValue), TRUE)
  861. END EmitCall;
  862. PROCEDURE GetImmediate32(val: LONGINT; CONST reg: InstructionSet.Operand; emit: BOOLEAN): LONGINT;
  863. VAR ops: LONGINT; set: SET;
  864. PROCEDURE Add(val,pos: LONGINT; VAR first: BOOLEAN): LONGINT;
  865. VAR imm: InstructionSet.Operand; ops: LONGINT; op: InstructionSet.Operand;
  866. BEGIN
  867. instructionSet.InitImmediate(imm, 0, val);
  868. IF pos # 0 THEN
  869. IF first THEN
  870. ops := 2;
  871. IF emit THEN
  872. Emit2(opMOV, reg, imm);
  873. instructionSet.InitImmediate(imm, 0, 32-pos); (*!TODO: if instruction width is <=13, immediate for ror is so small it can't express this number!*)
  874. Emit2(opROR, reg, imm);
  875. END;
  876. ELSE
  877. ops := 3;
  878. IF emit THEN
  879. GetTemporaryRegister(op);
  880. Emit2(opMOV, op, imm);
  881. instructionSet.InitImmediate(imm, 0, 32-pos);
  882. Emit2(opROR, op, imm);
  883. Emit2(opADD, reg, op);
  884. ReleaseHint(op.register);
  885. END;
  886. END;
  887. ELSE
  888. ops := 1;
  889. IF emit THEN Emit2(opADD, reg, imm) END;
  890. END;
  891. first := FALSE;
  892. RETURN ops
  893. END Add;
  894. PROCEDURE Compute(val: SET): LONGINT;
  895. VAR v,i: LONGINT; ops: LONGINT; first: BOOLEAN;
  896. BEGIN
  897. v := 0; ops := 0; first := TRUE;
  898. FOR i := 31 TO 0 BY -1 DO
  899. v := v * 2;
  900. IF i IN val THEN INC(v) END;
  901. IF v*2 >= ASH(1,instructionSet.ImmediateFixupBits) THEN
  902. ops := ops + Add(v,i,first);
  903. v := 0;
  904. END;
  905. END;
  906. IF v # 0 THEN ops := ops + Add(v,0,first) END;
  907. RETURN ops
  908. END Compute;
  909. BEGIN
  910. set := SYSTEM.VAL(SET,val);
  911. ops := Compute(set);
  912. RETURN ops
  913. END GetImmediate32;
  914. PROCEDURE ImmediateToOperand(imm: HUGEINT; part: LONGINT; signed: BOOLEAN; bits: LONGINT; VAR op: Operand);
  915. VAR immOp: InstructionSet.Operand; maxImmValue, minImmValue : LONGINT;
  916. PROCEDURE ImmediateToOp32(imm: LONGINT; VAR op: InstructionSet.Operand);
  917. VAR ops: LONGINT;
  918. BEGIN
  919. IF (imm>=0) & (imm < ASH(1,instructionSet.ImmediateFixupBits)) THEN
  920. instructionSet.InitImmediate(immOp, 0, imm);
  921. Emit2(opMOV, op, immOp);
  922. ELSIF (imm <0) & (imm > MIN(LONGINT)) & (ABS(imm) < ASH(1,instructionSet.ImmediateFixupBits)) THEN
  923. instructionSet.InitImmediate(immOp, 0, 0);
  924. Emit2(opMOV, op, immOp);
  925. instructionSet.InitImmediate(immOp, 0, ABS(imm));
  926. Emit2(opSUB, op, immOp);
  927. ELSE
  928. ops := GetImmediate32(imm, op, TRUE);
  929. END;
  930. END ImmediateToOp32;
  931. BEGIN
  932. IF signed THEN
  933. minImmValue := -ASH(1,bits-1); maxImmValue := ASH(1,bits-1)-1;
  934. ELSE
  935. minImmValue := 0; maxImmValue := ASH(1,bits)-1
  936. END;
  937. IF (op.type # InstructionSet.Register) & (imm >=minImmValue) & (imm <=maxImmValue) THEN (* immediate operand *)
  938. IF part = Low THEN
  939. instructionSet.InitImmediate(op,0,SHORT(imm));
  940. ELSE
  941. instructionSet.InitImmediate(op,0,0);
  942. END;
  943. ELSE
  944. IF op.type # InstructionSet.Register THEN
  945. GetTemporaryRegister(op);
  946. END;
  947. IF part = Low THEN
  948. ImmediateToOp32(SHORT(imm), op)
  949. ELSE
  950. ImmediateToOp32(SHORT(imm DIV 10000H DIV 10000H),op);
  951. END
  952. END;
  953. END ImmediateToOperand;
  954. PROCEDURE MakeRegister(VAR vop: IntermediateCode.Operand; part: LONGINT; VAR rop: Operand);
  955. VAR virtualReg: LONGINT; tmp, imm: Operand; offset: LONGINT; symbol: ObjectFile.Identifier;
  956. sizeInBits: LONGINT;
  957. BEGIN
  958. (*InstructionSet.InitOperand(rop); *)
  959. instructionSet.InitOperand(imm);
  960. sizeInBits := vop.type.sizeInBits;
  961. virtualReg := vop.register;
  962. offset := GetSymbolOffset(vop,symbol);
  963. CASE vop.mode OF
  964. IntermediateCode.ModeMemory:
  965. GetTemporaryRegister(rop);
  966. Load(vop,part,rop);
  967. |IntermediateCode.ModeRegister:
  968. GetRegister(vop,part,rop);
  969. |IntermediateCode.ModeImmediate:
  970. IF symbol.name # "" THEN
  971. instructionSet.InitFixup(tmp, 14, BinaryCode.NewFixup(BinaryCode.Absolute,out.pc,vop.symbol, vop.symbolOffset, vop.offset,0,NIL));
  972. GetTemporaryRegister(rop);
  973. Emit2(opMOV, rop, tmp);
  974. ELSE
  975. IF vop.type.form IN IntermediateCode.Integer THEN
  976. ASSERT ((vop.intValue = 0) OR (offset = 0));
  977. ImmediateToOperand(vop.intValue+offset, part, FALSE, instructionSet.ImmediateFixupBits,rop);
  978. ELSE ASSERT(vop.type.form = IntermediateCode.Float); ASSERT(vop.type.sizeInBits=32);
  979. ImmediateToOperand(BinaryCode.ConvertReal(SHORT(vop.floatValue)),part,FALSE,instructionSet.ImmediateFixupBits,rop);
  980. END;
  981. IF rop.type # InstructionSet.Register THEN
  982. GetTemporaryRegister(tmp);
  983. Emit2(opMOV, tmp, rop);
  984. rop := tmp
  985. END;
  986. END;
  987. ELSE HALT(200)
  988. END;
  989. END MakeRegister;
  990. (* if the symbol has a statically known offset then return offset and set resulting section to nil, otherwise do not set resulting section to nil *)
  991. PROCEDURE GetSymbolOffset(VAR vop: IntermediateCode.Operand; VAR sectionName: ObjectFile.Identifier): LONGINT;
  992. VAR offset: LONGINT; section: Sections.Section;
  993. BEGIN
  994. sectionName := vop.symbol;
  995. Resolve(vop);
  996. section := vop.resolved; offset := vop.offset;
  997. IF (section # NIL) & (section(IntermediateCode.Section).resolved # NIL) & (section(IntermediateCode.Section).resolved.os.fixed) THEN
  998. INC(offset, section(IntermediateCode.Section).resolved.os.alignment);
  999. INC(offset, section(IntermediateCode.Section).instructions[vop.symbolOffset].pc);
  1000. sectionName.name := "";
  1001. END;
  1002. RETURN offset
  1003. END GetSymbolOffset;
  1004. PROCEDURE GetMemory(VAR vop: IntermediateCode.Operand; part: LONGINT; VAR memoryOperand: InstructionSet.Operand; ticket: Ticket);
  1005. VAR virtualReg: LONGINT; register: LONGINT; registerOperand, temporary: InstructionSet.Operand; symbol: ObjectFile.Identifier;
  1006. offset: LONGINT;
  1007. BEGIN
  1008. virtualReg := vop.register;
  1009. ASSERT(vop.mode = IntermediateCode.ModeMemory);
  1010. offset := GetSymbolOffset(vop, symbol) + part;
  1011. register := PhysicalRegister(vop.register,Low,offset);
  1012. IF register = None THEN
  1013. IF symbol.name = "" THEN
  1014. offset := offset + SHORT(vop.intValue);
  1015. END;
  1016. register := InstructionSet.None;
  1017. END;
  1018. IF (0<=offset) & (offset < ASH(1,instructionSet.MemoryOffsetFixupBits)) THEN
  1019. instructionSet.InitMemory(memoryOperand, register, offset);
  1020. ELSE
  1021. IF ticket = NIL THEN
  1022. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1023. END;
  1024. TicketToOperand(ticket, temporary);
  1025. ImmediateToOperand(offset, Low, FALSE, instructionSet.ImmediateFixupBits,temporary);
  1026. instructionSet.InitRegister(registerOperand,register);
  1027. IF register # InstructionSet.None THEN
  1028. Emit2(opADD,temporary,registerOperand);
  1029. END;
  1030. instructionSet.InitMemory(memoryOperand, temporary.register, 0);
  1031. END;
  1032. IF symbol.name # "" THEN
  1033. instructionSet.AddFixup(memoryOperand, BinaryCode.NewFixup(BinaryCode.Absolute, 0, symbol, vop.symbolOffset, offset, 0, NIL));
  1034. END;
  1035. END GetMemory;
  1036. PROCEDURE Load(VAR vop: IntermediateCode.Operand; part: LONGINT; CONST register: Operand);
  1037. VAR memoryOperand: Operand;
  1038. BEGIN
  1039. ASSERT(register.type = InstructionSet.Register);
  1040. GetMemory(vop,part,memoryOperand,physicalRegisters.Mapped(register.register));
  1041. Emit2(opLD,register,memoryOperand);
  1042. END Load;
  1043. PROCEDURE Store(VAR vop: IntermediateCode.Operand; part: LONGINT; CONST register: Operand);
  1044. VAR memoryOperand: Operand;
  1045. BEGIN
  1046. GetMemory(vop,part,memoryOperand,NIL);
  1047. Emit2(opST,register,memoryOperand);
  1048. END Store;
  1049. PROCEDURE UnsignedImmediate(vop: IntermediateCode.Operand; part: LONGINT; bits: LONGINT; allowNegation: BOOLEAN; VAR neg: BOOLEAN; VAR rop: Operand): BOOLEAN;
  1050. VAR value,offset : LONGINT; symbol: ObjectFile.Identifier;
  1051. BEGIN
  1052. IF (vop.mode = IntermediateCode.ModeImmediate) THEN
  1053. offset := GetSymbolOffset(vop, symbol);
  1054. IF part = Low THEN
  1055. value := SHORT(vop.intValue + offset);
  1056. ELSE
  1057. value := SHORT((vop.intValue + offset) DIV 1000H DIV 1000H);
  1058. END;
  1059. IF symbol.name # "" THEN RETURN FALSE
  1060. ELSIF vop.type.form = IntermediateCode.Float THEN RETURN FALSE
  1061. ELSIF (value >= 0) & (value < ASH(1,bits)) THEN
  1062. instructionSet.InitImmediate(rop, 0, value); neg := FALSE;
  1063. RETURN TRUE
  1064. ELSIF allowNegation & (value <0) & (value # MIN(LONGINT)) & (-value < ASH(1,bits)) THEN
  1065. instructionSet.InitImmediate(rop, 0, -value); neg := TRUE;
  1066. RETURN TRUE
  1067. END;
  1068. END;
  1069. RETURN FALSE
  1070. END UnsignedImmediate;
  1071. PROCEDURE HardwareIntegerRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  1072. BEGIN RETURN index
  1073. END HardwareIntegerRegister;
  1074. PROCEDURE HardwareFloatRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
  1075. BEGIN RETURN index
  1076. END HardwareFloatRegister;
  1077. PROCEDURE GetTypedHardwareRegister(index: LONGINT; type: IntermediateCode.Type): LONGINT;
  1078. VAR size: LONGINT;
  1079. BEGIN
  1080. IF type.form IN IntermediateCode.Integer THEN
  1081. RETURN HardwareIntegerRegister(index, type.sizeInBits)
  1082. ELSIF type.form = IntermediateCode.Float THEN
  1083. RETURN HardwareFloatRegister(index, type.sizeInBits)
  1084. ELSE
  1085. HALT(100);
  1086. END;
  1087. END GetTypedHardwareRegister;
  1088. PROCEDURE ParameterRegister(CONST type: IntermediateCode.Type; index: LONGINT): LONGINT;
  1089. BEGIN
  1090. RETURN GetTypedHardwareRegister(index, type)
  1091. END ParameterRegister;
  1092. PROCEDURE PhysicalRegister(virtualReg: LONGINT; part: LONGINT; VAR offset: LONGINT): LONGINT;
  1093. VAR register: LONGINT; fpOffset: LONGINT; ticket: Ticket;
  1094. BEGIN
  1095. IF virtualReg = IntermediateCode.FP THEN
  1096. IF stackSizeKnown THEN
  1097. register := InstructionSet.SP;
  1098. INC(offset, stackSize);
  1099. ELSE (* stack size unknown, actually fp must be supported *)
  1100. register := InstructionSet.FP;
  1101. END;
  1102. ELSIF virtualReg = IntermediateCode.SP THEN
  1103. register := InstructionSet.SP;
  1104. ELSIF virtualReg = IntermediateCode.LR THEN
  1105. register := InstructionSet.LR;
  1106. (*!ELSIF virtualReg <= IntermediateCode.ParameterRegister THEN
  1107. register := ParameterRegister(IntermediateCode.ParameterRegister-virtualReg, IntermediateCode.int32);
  1108. *)
  1109. ELSE
  1110. ticket := virtualRegisters.Mapped(virtualReg,part);
  1111. IF ticket = NIL THEN register := None
  1112. ELSE
  1113. UnSpill(ticket);
  1114. register := ticket.register
  1115. END;
  1116. END;
  1117. RETURN register
  1118. END PhysicalRegister;
  1119. PROCEDURE GetRegister(CONST virtual: IntermediateCode.Operand; part:LONGINT; VAR physical: Operand);
  1120. VAR type: IntermediateCode.Type; virtualRegister, physicalRegister: LONGINT;
  1121. tmp,imm: Operand; offset: LONGINT; ticket: Ticket; ops: LONGINT;
  1122. BEGIN
  1123. ASSERT(virtual.mode = IntermediateCode.ModeRegister);
  1124. GetPartType(virtual.type,part,type);
  1125. virtualRegister := virtual.register;
  1126. offset := virtual.offset;
  1127. physicalRegister := PhysicalRegister(virtual.register,part,offset);
  1128. instructionSet.InitRegister(physical, physicalRegister);
  1129. IF offset # 0 THEN
  1130. (*
  1131. offset := virtual.offset;
  1132. *)
  1133. Assert(type.form # IntermediateCode.Float,"forbidden offset on float");
  1134. ReleaseHint(physical.register);
  1135. GetTemporaryRegister(tmp);
  1136. MovIfDifferent(tmp, physical);
  1137. physical := tmp;
  1138. IF (offset >= 0) & (offset < ASH(1,instructionSet.ImmediateFixupBits)) THEN
  1139. instructionSet.InitImmediate(imm, 0, offset);
  1140. Emit2(opADD,physical,imm);
  1141. ELSIF (offset <0) & (-offset < ASH(1,instructionSet.ImmediateFixupBits)) THEN
  1142. instructionSet.InitImmediate(imm, 0, -offset);
  1143. Emit2(opSUB,physical,imm);
  1144. ELSE
  1145. GetTemporaryRegister(tmp);
  1146. ops := GetImmediate32(offset,tmp,TRUE);
  1147. Emit2(opADD,physical,tmp);
  1148. ReleaseHint(tmp.register);
  1149. END;
  1150. END;
  1151. END GetRegister;
  1152. PROCEDURE IsSameRegister(CONST a, b : InstructionSet.Operand) : BOOLEAN;
  1153. BEGIN
  1154. IF (a.fixup # NIL) OR (b.fixup # NIL) OR (a.type # InstructionSet.Register) OR (b.type # InstructionSet.Register) THEN RETURN FALSE END;
  1155. RETURN a.register = b.register;
  1156. END IsSameRegister;
  1157. PROCEDURE MovIfDifferent(CONST a,b: InstructionSet.Operand);
  1158. BEGIN
  1159. IF ~IsSameRegister(a,b) THEN Emit2(opMOV, a, b) END;
  1160. END MovIfDifferent;
  1161. PROCEDURE AcquireDestinationRegister(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Operand);
  1162. VAR type: IntermediateCode.Type;
  1163. BEGIN
  1164. GetPartType(vop.type,part,type);
  1165. IF vop.mode = IntermediateCode.ModeMemory THEN
  1166. GetTemporaryRegister(op);
  1167. ELSE
  1168. IF virtualRegisters.Mapped(vop.register,part)=NIL THEN
  1169. TryAllocate(vop,part);
  1170. END;
  1171. GetRegister(vop,part,op);
  1172. END;
  1173. END AcquireDestinationRegister;
  1174. PROCEDURE PrepareOp3(CONST instruction: IntermediateCode.Instruction;part: LONGINT; allowNegation: BOOLEAN; VAR negate: BOOLEAN; VAR dest, left, right: Assembler.Operand);
  1175. VAR vop1,vop2, vop3: IntermediateCode.Operand; op2: InstructionSet.Operand;
  1176. opx: Operand;
  1177. BEGIN
  1178. vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
  1179. IF (IntermediateCode.Commute23 IN IntermediateCode.instructionFormat[instruction.opcode].flags) THEN
  1180. IF IntermediateCode.OperandEquals(vop1,vop3) OR UnsignedImmediate(vop2,part,instructionSet.ImmediateFixupBits,FALSE,negate,right) THEN
  1181. vop3 := instruction.op2; vop2 := instruction.op3;
  1182. END;
  1183. END;
  1184. IF ~UnsignedImmediate(vop3, part, instructionSet.ImmediateFixupBits, allowNegation, negate,right) THEN
  1185. instructionSet.InitOperand(right);
  1186. MakeRegister(vop3,part,right);
  1187. END;
  1188. MakeRegister(vop2,part,op2);
  1189. ReleaseHint(op2.register);
  1190. AcquireDestinationRegister(vop1,part,left);
  1191. dest := left;
  1192. IF ~IsSameRegister(left,op2) THEN
  1193. IF IsSameRegister(left,right) THEN
  1194. GetTemporaryRegister(opx);
  1195. MovIfDifferent(opx, op2);
  1196. dest := left;
  1197. left := opx;
  1198. ELSE
  1199. MovIfDifferent(left, op2);
  1200. END;
  1201. END;
  1202. END PrepareOp3;
  1203. PROCEDURE PrepareFOp3(CONST instruction: IntermediateCode.Instruction; VAR dest, left, right: Assembler.Operand);
  1204. VAR vop1,vop2, vop3: IntermediateCode.Operand; op2: InstructionSet.Operand;
  1205. opx: Operand;
  1206. BEGIN
  1207. vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
  1208. instructionSet.InitOperand(right);
  1209. MakeRegister(vop3,Low,right);
  1210. MakeRegister(vop2,Low,op2);
  1211. ReleaseHint(op2.register);
  1212. AcquireDestinationRegister(vop1,Low,left);
  1213. dest := left;
  1214. IF ~IsSameRegister(left,op2) THEN
  1215. IF IsSameRegister(left,right) THEN
  1216. GetTemporaryRegister(opx);
  1217. MovIfDifferent(opx, op2);
  1218. dest := left;
  1219. left := opx;
  1220. ELSE
  1221. MovIfDifferent(left, op2);
  1222. END;
  1223. END;
  1224. END PrepareFOp3;
  1225. PROCEDURE PrepareOp2(CONST instruction: IntermediateCode.Instruction;part: LONGINT; allowNegation: BOOLEAN; VAR negate: BOOLEAN; VAR left, right: Assembler.Operand);
  1226. VAR vop1,vop2: IntermediateCode.Operand;
  1227. BEGIN
  1228. vop1 := instruction.op1; vop2 := instruction.op2;
  1229. IF ~UnsignedImmediate(vop2, part, instructionSet.ImmediateFixupBits, allowNegation, negate,right) THEN
  1230. instructionSet.InitOperand(right);
  1231. MakeRegister(vop2,part,right);
  1232. END;
  1233. ReleaseHint(right.register);
  1234. AcquireDestinationRegister(vop1,part,left);
  1235. END PrepareOp2;
  1236. PROCEDURE ReleaseDestinationRegister(VAR vop: IntermediateCode.Operand; part: LONGINT; left: Assembler.Operand);
  1237. BEGIN
  1238. IF vop.mode = IntermediateCode.ModeMemory THEN
  1239. ASSERT(left.type = InstructionSet.Register);
  1240. Store(vop,part,left);
  1241. ReleaseHint(left.register);
  1242. END;
  1243. END ReleaseDestinationRegister;
  1244. PROCEDURE FinishOp(VAR vop: IntermediateCode.Operand; part: LONGINT; dest, left: Assembler.Operand);
  1245. VAR op: Operand;
  1246. BEGIN
  1247. IF vop.mode = IntermediateCode.ModeMemory THEN
  1248. ASSERT(left.type = InstructionSet.Register);
  1249. Store(vop,part,left);
  1250. ReleaseHint(left.register);
  1251. ELSIF dest.register # left.register THEN
  1252. Emit2(opMOV, dest, left);
  1253. END;
  1254. END FinishOp;
  1255. PROCEDURE EmitAdd(VAR instruction: IntermediateCode.Instruction);
  1256. VAR destLow, destHigh, leftLow,rightLow,leftHigh,rightHigh: InstructionSet.Operand;negateLow,negateHigh: BOOLEAN;
  1257. fixup: BinaryCode.Fixup;
  1258. BEGIN
  1259. PrepareOp3(instruction,Low,TRUE,negateLow,destLow, leftLow,rightLow);
  1260. IF IsComplex(instruction.op1) THEN
  1261. PrepareOp3(instruction,High,TRUE,negateHigh,destHigh, leftHigh,rightHigh);
  1262. END;
  1263. IF negateLow THEN Emit2(opSUB,leftLow,rightLow) ELSE Emit2(opADD,leftLow,rightLow) END;
  1264. FinishOp(instruction.op1,Low,destLow, leftLow);
  1265. IF IsComplex(instruction.op1) THEN
  1266. fixup := BrForward(opBB);
  1267. (*
  1268. Emit1N(opBB, 1);
  1269. *)
  1270. Emit2N(opADD, leftHigh, 1);
  1271. SetTarget(fixup);
  1272. IF negateHigh THEN Emit2(opSUB,leftHigh,rightHigh) ELSE Emit2(opADD,leftHigh,rightHigh) END;
  1273. FinishOp(instruction.op1,High,destHigh, leftHigh);
  1274. END;
  1275. END EmitAdd;
  1276. PROCEDURE EmitFAdd(VAR instruction: IntermediateCode.Instruction);
  1277. VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
  1278. BEGIN
  1279. PrepareFOp3(instruction,destLow, leftLow,rightLow);
  1280. Emit2(opFADD,leftLow,rightLow);
  1281. FinishOp(instruction.op1,Low,destLow, leftLow);
  1282. END EmitFAdd;
  1283. PROCEDURE EmitSub(VAR instruction: IntermediateCode.Instruction);
  1284. VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN; fixup: BinaryCode.Fixup;
  1285. BEGIN
  1286. IF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) &
  1287. (instruction.op2.mode = IntermediateCode.ModeRegister) & (instruction.op2.register = IntermediateCode.SP) &
  1288. (instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.symbol.name = "") THEN
  1289. AllocateStack(SHORT(instruction.op3.intValue), TRUE); RETURN
  1290. END;
  1291. PrepareOp3(instruction,Low,TRUE,negateLow, destLow, leftLow,rightLow);
  1292. IF IsComplex(instruction.op1) THEN
  1293. PrepareOp3(instruction,High,TRUE,negateHigh,destHigh, leftHigh,rightHigh);
  1294. IF negateHigh THEN Emit2(opADD,leftHigh,rightHigh) ELSE Emit2(opSUB,leftHigh,rightHigh) END;
  1295. END;
  1296. IF negateLow THEN Emit2(opADD,leftLow,rightLow) ELSE Emit2(opSUB,leftLow,rightLow) END;
  1297. FinishOp(instruction.op1,Low,destLow, leftLow);
  1298. IF IsComplex(instruction.op1) THEN
  1299. fixup := BrForward(opBAE);
  1300. (*
  1301.  Emit1N(opBAE, 1);
  1302.  *)
  1303. Emit2N(opSUB,leftHigh, 1);
  1304. SetTarget(fixup);
  1305. FinishOp(instruction.op1,High,destHigh, leftHigh)
  1306. END;
  1307. END EmitSub;
  1308. PROCEDURE EmitFSub(VAR instruction: IntermediateCode.Instruction);
  1309. VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
  1310. BEGIN
  1311. PrepareFOp3(instruction,destLow, leftLow,rightLow);
  1312. Emit2(opFSUB,leftLow,rightLow);
  1313. FinishOp(instruction.op1,Low,destLow, leftLow);
  1314. END EmitFSub;
  1315. PROCEDURE EmitMul(VAR instruction: IntermediateCode.Instruction);
  1316. VAR negate: BOOLEAN;
  1317. op1Low, op2Low, op3Low, op1High, op2High, op3High, destLow, destHigh: Operand;
  1318. BEGIN
  1319. IF ~IsComplex(instruction.op1) THEN
  1320. PrepareOp3(instruction,Low,FALSE,negate,destLow, op1Low,op2Low);
  1321. Emit2(opMUL,op1Low,op2Low);
  1322. FinishOp(instruction.op1,Low,destLow, op1Low)
  1323. ELSE
  1324. AcquireDestinationRegister(instruction.op1,Low,op1Low);
  1325. AcquireDestinationRegister(instruction.op1,High,op1High);
  1326. MakeRegister(instruction.op2,Low,op2Low);
  1327. MakeRegister(instruction.op2,High,op2High);
  1328. MakeRegister(instruction.op3,Low,op3Low);
  1329. MakeRegister(instruction.op3,High,op3High);
  1330. Emit2(opMOV, op1Low, op2Low);
  1331. Emit2(opMUL, op1Low, op3Low);
  1332. Emit1(opLDH, op1High);
  1333. Emit2(opMUL, op2High, op3Low);
  1334. Emit2(opADD, op1High, op2High);
  1335. Emit2(opMUL, op2Low, op3High);
  1336. Emit2(opADD, op1High, op2Low);
  1337. ReleaseDestinationRegister(instruction.op1,Low,op1Low);
  1338. ReleaseDestinationRegister(instruction.op1,High,op1High);
  1339. END;
  1340. END EmitMul;
  1341. PROCEDURE EmitFMul(VAR instruction: IntermediateCode.Instruction);
  1342. VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
  1343. BEGIN
  1344. PrepareFOp3(instruction,destLow, leftLow,rightLow);
  1345. Emit2(opFMUL,leftLow,rightLow);
  1346. FinishOp(instruction.op1,Low,destLow, leftLow);
  1347. END EmitFMul;
  1348. PROCEDURE EmitDiv(CONST instr: IntermediateCode.Instruction);
  1349. BEGIN
  1350. HALT(100); (*! div is not supported by hardware, must be runtime call -- cf. method Supported *)
  1351. END EmitDiv;
  1352. (* undefined for float and huegint, huegint version as library *)
  1353. PROCEDURE EmitMod(CONST instr: IntermediateCode.Instruction);
  1354. BEGIN
  1355. HALT(100); (*! mod is not supported by hardware, must be runtime call -- cf. method Supported *)
  1356. END EmitMod;
  1357. PROCEDURE EmitAnd(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
  1358. VAR left, right, dest: Operand; negate: BOOLEAN;
  1359. BEGIN
  1360. PrepareOp3(instruction,part,FALSE,negate,dest,left,right);
  1361. Emit2(opAND,left,right);
  1362. FinishOp(instruction.op1, part,dest, left)
  1363. END EmitAnd;
  1364. PROCEDURE EmitOr(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
  1365. VAR left, right, dest: Operand; negate: BOOLEAN;
  1366. BEGIN
  1367. PrepareOp3(instruction,part,FALSE,negate,dest, left,right);
  1368. Emit2(opOR,left,right);
  1369. FinishOp(instruction.op1,part,dest, left)
  1370. END EmitOr;
  1371. PROCEDURE EmitXor(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
  1372. VAR dest, left, right: Operand; negate: BOOLEAN;
  1373. BEGIN
  1374. PrepareOp3(instruction,part,FALSE,negate,dest,left,right);
  1375. Emit2(opXOR,left,right);
  1376. FinishOp(instruction.op1,part,dest,left)
  1377. END EmitXor;
  1378. PROCEDURE GetTemporaryRegister(VAR op: Operand);
  1379. VAR ticket: Ticket;
  1380. BEGIN
  1381. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1382. TicketToOperand(ticket,op);
  1383. END GetTemporaryRegister;
  1384. PROCEDURE EmitShift(VAR instr: IntermediateCode.Instruction);
  1385. VAR op2, op3, dest, imm, one, opx, mask, opx2: Operand; shift: LONGINT; fixup, fixup2: BinaryCode.Fixup;
  1386. BEGIN
  1387. instructionSet.InitOperand(imm); instructionSet.InitOperand(one);
  1388. ASSERT(instr.op1.type.sizeInBits < 64);
  1389. AcquireDestinationRegister(instr.op1, Low, dest);
  1390. MakeRegister(instr.op2, Low, op2);
  1391. (*! caution: do not use dest and op2 / op3 more than once in one line: dest might be source (as in shl $1,1,$1) *)
  1392. IF instr.op3.mode = IntermediateCode.ModeImmediate THEN
  1393. shift := SHORT(instr.op3.intValue) MOD 32;
  1394. IF shift = 0 THEN
  1395. MovIfDifferent(dest, op2);
  1396. Emit2N(opROR, dest, shift);
  1397. ELSE
  1398. CASE instr.opcode OF
  1399. |IntermediateCode.ror:
  1400. MovIfDifferent(dest, op2);
  1401. Emit2N(opROR, dest, shift);
  1402. |IntermediateCode.rol:
  1403. MovIfDifferent(dest, op2);
  1404. Emit2N(opROR, dest, 32-shift);
  1405. |IntermediateCode.shl:
  1406. MovIfDifferent(dest, op2);
  1407. Emit2N(opROR, dest, 32-shift);
  1408. ImmediateToOperand(ASH(1, shift)-1, Low, FALSE, instructionSet.ImmediateFixupBits,imm);
  1409. Emit2(opBIC, dest, imm);
  1410. ReleaseHint(imm.register);
  1411. |IntermediateCode.shr:
  1412. IF instr.op1.type.form # IntermediateCode.SignedInteger THEN
  1413. (* logical shift right *)
  1414. ImmediateToOperand(ASH(1,shift)-1,Low,FALSE,instructionSet.ImmediateFixupBits,imm);
  1415. Emit2(opBIC, op2, imm);
  1416. MovIfDifferent(dest, op2);
  1417. Emit2N(opROR, dest, shift);
  1418. ReleaseHint(imm.register);
  1419. ELSE
  1420. (* arithmetic shift right *)
  1421. ImmediateToOperand(ASH(1,shift)-1,Low,FALSE,instructionSet.ImmediateFixupBits,imm);
  1422. MovIfDifferent(dest, op2);
  1423. Emit2(opOR,dest,dest);
  1424. fixup := BrForward(opBN);
  1425. (*
  1426. Emit1N(opBN, 2); (* if op2 < 0 then skip next two instructions *)
  1427. *)
  1428. Emit2(opBIC, dest,imm);
  1429. fixup2 := BrForward(opBT);
  1430. (*
  1431. Emit1N(opBT, 1); (* skip next instruction *)
  1432. *)
  1433. SetTarget(fixup);
  1434. Emit2(opOR, dest, imm);
  1435. SetTarget(fixup2);
  1436. Emit2N(opROR, dest, shift);
  1437. ReleaseHint(imm.register);
  1438. END;
  1439. END;
  1440. END;
  1441. ELSE
  1442. MakeRegister(instr.op3, Low, op3);
  1443. CASE instr.opcode OF
  1444. |IntermediateCode.ror:
  1445. Emit2(opROR, op2, op3);
  1446. MovIfDifferent(dest, op2);
  1447. |IntermediateCode.rol:
  1448. GetTemporaryRegister(imm);
  1449. ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits, imm);
  1450. Emit2(opSUB, imm, op3);
  1451. Emit2(opROR, op2, imm);
  1452. MovIfDifferent(dest, op2);
  1453. ReleaseHint(imm.register);
  1454. |IntermediateCode.shl:
  1455. GetTemporaryRegister(imm);
  1456. ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits,imm);
  1457. Emit2(opSUB, imm, op3);
  1458. Emit2(opROR, op2, imm);
  1459. IF IsSameRegister(dest, op2) THEN
  1460. GetTemporaryRegister(op2);
  1461. ELSE
  1462. Emit2(opMOV, dest, op2);
  1463. END;
  1464. (*GetTemporaryRegister(one,32);*)
  1465. ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits, op2);
  1466. Emit2(opROR, op2, imm);
  1467. Emit2N(opSUB, op2, 1);
  1468. Emit2(opBIC, dest, op2);
  1469. ReleaseHint(imm.register);
  1470. ReleaseHint(op2.register);
  1471. |IntermediateCode.shr:
  1472. IF instr.op1.type.form # IntermediateCode.SignedInteger THEN
  1473. GetTemporaryRegister(mask);
  1474. ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits,mask);
  1475. IF IsSameRegister(dest, op3) THEN
  1476. GetTemporaryRegister(opx);
  1477. Emit2(opMOV, opx, op3);
  1478. Emit2(opMOV, dest, op2);
  1479. op3 := opx;
  1480. ELSE
  1481. MovIfDifferent(dest, op2);
  1482. END;
  1483. IF physicalRegisters.NextFree(IntermediateCode.int32)#None THEN
  1484. GetTemporaryRegister(opx2);
  1485. ELSE
  1486. EmitPush(instr.op1,Low); (* save dest *)
  1487. opx2 := dest;
  1488. END;
  1489. Emit2N(opMOV, opx2, 32);
  1490. Emit2(opSUB, opx2, op3);
  1491. Emit2(opROR, mask, opx2);
  1492. Emit2N(opSUB, mask, 1);
  1493. IF opx2.register = dest.register THEN
  1494. EmitPop(instr.op1,Low); (* restore dest *)
  1495. ELSE
  1496. ReleaseHint(opx2.register);
  1497. END;
  1498. Emit2(opBIC, dest, mask);
  1499. Emit2(opROR, dest, op3);
  1500. ReleaseHint(opx.register);
  1501. ReleaseHint(mask.register);
  1502. ELSE
  1503. GetTemporaryRegister(imm);
  1504. ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits, imm);
  1505. Emit2(opSUB, imm, op3);
  1506. GetTemporaryRegister(one);
  1507. ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits, one);
  1508. Emit2(opROR, one, imm);
  1509. Emit2N(opSUB, one, 1);
  1510. Emit2(opOR, op2, op2); (* if negative *)
  1511. fixup := BrForward(opBN);
  1512. (*
  1513. Emit1N(opBN, 2); (* then skip next two instructions *)
  1514. *)
  1515. Emit2(opBIC, op2,one);
  1516. fixup2 := BrForward(opBT);
  1517. (*
  1518. Emit1N(opBT, 1); (* skip next instruction *)
  1519. *)
  1520. SetTarget(fixup);
  1521. Emit2(opOR, op2, one);
  1522. SetTarget(fixup2);
  1523. Emit2(opROR, op2, op3);
  1524. MovIfDifferent(dest, op2);
  1525. ReleaseHint(imm.register);
  1526. ReleaseHint(one.register);
  1527. END;
  1528. END;
  1529. END;
  1530. ReleaseDestinationRegister(instr.op1, Low, dest);
  1531. END EmitShift;
  1532. PROCEDURE EmitCopy(VAR instr: IntermediateCode.Instruction);
  1533. VAR op1, op2, op3: Operand; mem1, mem2: InstructionSet.Operand; reg: Operand;
  1534. prevSize, i: LONGINT; ticket: Ticket;
  1535. BEGIN
  1536. MakeRegister(instr.op1, Low, op1);
  1537. MakeRegister(instr.op2, Low, op2);
  1538. IF (instr.op3.mode = IntermediateCode.ModeImmediate) & (instr.op3.intValue < 16) THEN
  1539. GetTemporaryRegister(reg);
  1540. FOR i := 0 TO SHORT(instr.op3.intValue)-1 DO
  1541. instructionSet.InitMemory(mem1, op1.register, i);
  1542. instructionSet.InitMemory(mem2, op2.register, i);
  1543. Emit2(opLD, reg, mem2);
  1544. Emit2(opST, reg, mem1);
  1545. END;
  1546. ReleaseHint(reg.register);
  1547. ELSE
  1548. MakeRegister(instr.op3, Low, op3);
  1549. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1550. TicketToOperand(ticket,reg);
  1551. instructionSet.InitMemory(mem1, op1.register, 0);
  1552. instructionSet.InitMemory(mem2, op2.register, 0);
  1553. prevSize := out.pc;
  1554. Emit2(opLD, reg, mem2);
  1555. Emit2(opST, reg, mem1);
  1556. Emit2N(opADD, op1, 1);
  1557. Emit2N(opADD, op2, 1);
  1558. Emit2N(opSUB, op3, 1);
  1559. Emit1N(opBGT, -(out.pc-prevSize+1));
  1560. UnmapTicket(ticket);
  1561. END;
  1562. END EmitCopy;
  1563. PROCEDURE EmitFill(VAR instr: IntermediateCode.Instruction; down: BOOLEAN);
  1564. VAR op1, op2, op3: Operand; mem1: InstructionSet.Operand;
  1565. prevSize: LONGINT; i: LONGINT; ticket: Ticket;
  1566. BEGIN
  1567. MakeRegister(instr.op1, Low, op1);
  1568. MakeRegister(instr.op2, Low, op2);
  1569. IF ~down & (instr.op3.mode = IntermediateCode.ModeImmediate) & (instr.op3.intValue < 16) THEN
  1570. FOR i := 0 TO SHORT(instr.op3.intValue)-1 DO
  1571. instructionSet.InitMemory(mem1, op1.register, i);
  1572. Emit2(opST, op2, mem1);
  1573. END;
  1574. ELSE
  1575. MakeRegister(instr.op3, Low, op3);
  1576. instructionSet.InitMemory(mem1, op1.register, 0);
  1577. prevSize := out.pc;
  1578. Emit2(opST, op2, mem1);
  1579. IF down THEN
  1580. Emit2N(opSUB, op1, 1);
  1581. ELSE
  1582. Emit2N(opADD, op1, 1);
  1583. END;
  1584. Emit2N(opSUB, op3, 1);
  1585. Emit1N(opBGT, -(out.pc-prevSize+1));
  1586. UnmapTicket(ticket);
  1587. END;
  1588. END EmitFill;
  1589. PROCEDURE BrForward(op: LONGINT): BinaryCode.Fixup;
  1590. VAR fixupOp: InstructionSet.Operand; fixup: BinaryCode.Fixup; identifier: ObjectFile.Identifier;
  1591. BEGIN
  1592. identifier.name := in.name;
  1593. identifier.fingerprint := in.fingerprint;
  1594. fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, 0,0,0,NIL);
  1595. fixup.resolved := in;
  1596. instructionSet.InitFixup(fixupOp,32,fixup);
  1597. Emit1(op, fixupOp);
  1598. RETURN fixup;
  1599. END BrForward;
  1600. PROCEDURE SetTarget(fixup: BinaryCode.Fixup);
  1601. BEGIN
  1602. fixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+fixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
  1603. fixup.resolved := in;
  1604. END SetTarget;
  1605. PROCEDURE EmitBr (VAR instr: IntermediateCode.Instruction);
  1606. VAR dest, destPC, offset: LONGINT; target: Operand; reverse: BOOLEAN;
  1607. (* jump operands *) op2, op3: Operand; hiHit, hiFail, lowHit: LONGINT;
  1608. failPC: LONGINT;
  1609. pattern: ObjectFile.FixupPatterns; fixup, failFixup: BinaryCode.Fixup;
  1610. float,negate: BOOLEAN; identifier: ObjectFile.Identifier;
  1611. PROCEDURE JmpDest(brop: LONGINT);
  1612. VAR op1: Operand; fixupOp: InstructionSet.Operand; oldLR, thisPC: Operand; ticket1, ticket2: Ticket;
  1613. BEGIN
  1614. IF instr.op1.mode = IntermediateCode.ModeImmediate THEN
  1615. Assert(instr.op1.symbol.name # "", "branch without symbol destination");
  1616. dest := (instr.op1.symbolOffset); (* this is the offset in the in-data section (intermediate code), it is not byte-relative *)
  1617. destPC := in.instructions[dest].pc + instr.op1.offset;
  1618. offset := destPC - out.pc;
  1619. fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, instr.op1.symbol, instr.op1.symbolOffset, instr.op1.offset,0,NIL);
  1620. IF (fixup.symbol.name = in.name) & (fixup.symbolOffset > inPC) THEN (* forward jump *)
  1621. forwardFixups.Enter(fixup, out.pc, instructionSet.RelativeBranchFixupBits);
  1622. ELSIF (fixup.symbol.name = in.name) & (fixup.symbolOffset < inPC) THEN (* backward jump *)
  1623. ASSERT(offset < 0); offset := -offset;
  1624. IF offset >= ASH(1,instructionSet.RelativeBranchFixupBits-1)-1 THEN
  1625. (*D.String("fixup too far for immediate fixup, offset=");D.Int(offset,1);D.Ln;*)
  1626. (* cannot enter fixup / use immediate jump, jump too far *)
  1627. fixup := BrForward(instructionSet.inverseCondition[brop]); (* jump over absolute branch (skip) *)
  1628. (*
  1629. fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, in, 0,0,0,NIL);
  1630. InstructionSet.InitFixup(fixupOp,32,fixup);
  1631. Emit1(InstructionSet.inverseCondition[brop], fixupOp); (* jump over absolute branch (skip) *)
  1632. *)
  1633. (* do a relative register jump, an absolute jump would require a fixup with unpredictable size
  1634. => have to get program counter, misuse BL here:
  1635. MOV Rx, LR
  1636. BL 0; get PC of next line
  1637. MOV Ry, LR
  1638. MOV LR, Rx ; restore LR
  1639. ADD Ry, offset
  1640. BR R2
  1641. *)
  1642. ticket1 := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1643. ticket2 := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1644. TicketToOperand(ticket1,oldLR);
  1645. TicketToOperand(ticket2,thisPC);
  1646. Emit2(opMOV,oldLR, opLR);
  1647. Emit1N(opBL,0);
  1648. (* exactly here we have the current PC in LR, so we compute the offset here *)
  1649. offset := out.pc-destPC;
  1650. Emit2(opMOV, thisPC, opLR);
  1651. Emit2(opMOV, opLR, oldLR);
  1652. UnmapTicket(ticket1);
  1653. instructionSet.InitOperand(target);
  1654. ImmediateToOperand(offset,Low,FALSE, instructionSet.ImmediateFixupBits,target);
  1655. Emit2(opSUB, thisPC, target);
  1656. Emit1(InstructionSet.opBR, thisPC);
  1657. ReleaseHint(target.register);
  1658. (* patch fixup for skip long jump code *)
  1659. SetTarget(fixup);
  1660. (*
  1661. fixup.SetSymbol(in, 0, out.pc+fixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
  1662. *)
  1663. RETURN
  1664. END;
  1665. END;
  1666. instructionSet.InitFixup(target, 32, fixup);
  1667. (* fixup mask entered curing code emission *)
  1668. Emit1(brop, target);
  1669. ELSIF brop = opBT THEN (* register jump, unconditional *)
  1670. MakeRegister(instr.op1,Low,op1);
  1671. Emit1(opBR, op1);
  1672. ELSE
  1673. HALT(100); (* no conditional jump on register implemented *)
  1674. END;
  1675. END JmpDest;
  1676. PROCEDURE Cmp(left, right: InstructionSet.Operand);
  1677. VAR destOp: Operand; ticket: Ticket; fixup, fixup2: BinaryCode.Fixup;
  1678. BEGIN
  1679. IF float THEN
  1680. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1681. TicketToOperand(ticket,destOp);
  1682. Emit2(opMOV, destOp, left);
  1683. Emit2(opAND, destOp, right);
  1684. fixup := BrForward(opBN);
  1685. (*
  1686. Emit1N(opBN, 3);
  1687. *)
  1688. Emit2(opMOV, destOp, left);
  1689. Emit2(opSUB, destOp, right);
  1690. fixup2 := BrForward(opBT);
  1691. SetTarget(fixup);
  1692. (* Emit1N(opBT, 2); *)
  1693. Emit2(opMOV, destOp, right);
  1694. Emit2(opSUB, destOp, left);
  1695. SetTarget(fixup2);
  1696. UnmapTicket(ticket);
  1697. ELSE
  1698. IF (left.register >= 0) & (physicalRegisters.Mapped(left.register) = NIL) THEN
  1699. IF negate THEN
  1700. Emit2(opADD, left, right);
  1701. ELSE
  1702. Emit2(opSUB, left, right);
  1703. END;
  1704. ELSE
  1705. ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
  1706. TicketToOperand(ticket,destOp);
  1707. Emit2(opMOV, destOp, left);
  1708. IF negate THEN
  1709. Emit2(opADD, destOp, right);
  1710. ELSE
  1711. Emit2(opSUB, destOp, right);
  1712. END;
  1713. UnmapTicket(ticket);
  1714. END;
  1715. END;
  1716. END Cmp;
  1717. BEGIN
  1718. hiFail := None; hiHit := None; lowHit := None;
  1719. float := instr.op2.type.form = IntermediateCode.Float;
  1720. failPC := 0;
  1721. IF (instr.op1.symbol.name = in.name) & (instr.op1.symbolOffset = inPC +1) THEN (* jump to next instruction can be ignored *)
  1722. IF dump # NIL THEN dump.String("jump to next instruction ignored"); dump.Ln END;
  1723. RETURN
  1724. END;
  1725. IF instr.opcode = IntermediateCode.br THEN
  1726. JmpDest(opBT);
  1727. ELSE
  1728. (*
  1729. conditional branch
  1730. for 32 bit operands quite simple
  1731. cmp left right
  1732. brc(hit) target
  1733. ...
  1734. target:
  1735. ....
  1736. for 64 bit operands transformed to
  1737. cmp hi(left) hi(right)
  1738. brc(hiHit) target
  1739. brc(hiFail) fail
  1740. cmp low(left) low(right)
  1741. brc(lowHit) target
  1742. fail:
  1743. ....
  1744. target:
  1745. .....
  1746. *)
  1747. IF instr.op2.type.sizeInBits # 64 THEN
  1748. CASE instr.opcode OF
  1749. IntermediateCode.breq:
  1750. lowHit := opBEQ;
  1751. |IntermediateCode.brne:
  1752. lowHit := opBNE;
  1753. |IntermediateCode.brge:
  1754. IF instr.op2.type.form IN {IntermediateCode.SignedInteger, IntermediateCode.Float} THEN
  1755. IF reverse THEN lowHit := opBLE ELSE lowHit := opBGE END;
  1756. ELSIF instr.op2.type.form = IntermediateCode.UnsignedInteger THEN
  1757. IF reverse THEN lowHit := opBBE ELSE lowHit := opBAE END;
  1758. END;
  1759. |IntermediateCode.brlt:
  1760. IF instr.op2.type.form IN {IntermediateCode.SignedInteger, IntermediateCode.Float} THEN
  1761. IF reverse THEN lowHit := opBGT ELSE lowHit := opBLT END;
  1762. ELSIF instr.op2.type.form = IntermediateCode.UnsignedInteger THEN
  1763. IF reverse THEN lowHit := opBA ELSE lowHit := opBB END;
  1764. END;
  1765. END;
  1766. ELSE
  1767. Assert(instr.op2.type.form # IntermediateCode.UnsignedInteger, "no unsigned integer64 branch implemented");
  1768. CASE instr.opcode OF
  1769. IntermediateCode.breq:
  1770. hiHit := None; hiFail := opBNE; lowHit := opBEQ
  1771. |IntermediateCode.brne:
  1772. hiHit := opBNE; hiFail := None; lowHit := opBNE
  1773. |IntermediateCode.brge:
  1774. IF reverse THEN
  1775. hiHit := opBLT; hiFail := opBGT; lowHit := opBBE
  1776. ELSE
  1777. hiHit := opBGT; hiFail := opBLT; lowHit := opBAE
  1778. END;
  1779. |IntermediateCode.brlt:
  1780. IF reverse THEN
  1781. hiHit := opBGT; hiFail := opBLT; lowHit := opBA
  1782. ELSE
  1783. hiHit := opBLT; hiFail := opBGT; lowHit := opBB
  1784. END;
  1785. END;
  1786. MakeRegister(instr.op2, High, op2); negate := FALSE;
  1787. IF float THEN
  1788. MakeRegister(instr.op3, High, op3)
  1789. ELSIF ~UnsignedImmediate(instr.op3, High, instructionSet.ImmediateFixupBits, TRUE, negate,op3) THEN
  1790. MakeRegister(instr.op3, High, op3)
  1791. END;
  1792. Cmp(op2, op3);
  1793. ReleaseHint(op2.register); ReleaseHint(op3.register);
  1794. float := FALSE; (* lower bits must always be compared as (unsigned) integers *)
  1795. IF hiHit # None THEN
  1796. JmpDest(hiHit);
  1797. END;
  1798. IF hiFail # None THEN
  1799. NEW(pattern,1);
  1800. pattern[0].offset := 0; pattern[0].bits := instructionSet.RelativeBranchFixupBits;
  1801. identifier.name := in.name;
  1802. identifier.fingerprint := in.fingerprint;
  1803. failFixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, 0, 0, 0 , pattern);
  1804. failFixup.resolved := in;
  1805. instructionSet.InitImmediate(target,32,0);
  1806. instructionSet.AddFixup(target, failFixup);
  1807. Emit1(hiFail, target);
  1808. END;
  1809. (*ReleaseHint(op2.register);
  1810. ReleaseHint(op3.register);*)
  1811. END;
  1812. MakeRegister(instr.op2, Low, op2); negate := FALSE;
  1813. IF float THEN
  1814. MakeRegister(instr.op3, Low, op3)
  1815. ELSIF ~UnsignedImmediate(instr.op3, Low, instructionSet.ImmediateFixupBits, TRUE, negate,op3) THEN
  1816. MakeRegister(instr.op3, Low, op3)
  1817. END;
  1818. Cmp(op2, op3);
  1819. ReleaseHint(op2.register); ReleaseHint(op3.register);
  1820. ASSERT(lowHit # None);
  1821. JmpDest(lowHit);
  1822. IF hiFail # None THEN
  1823. failFixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+failFixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
  1824. failFixup.resolved := in;
  1825. END;
  1826. END;
  1827. END EmitBr;
  1828. PROCEDURE EmitPop(VAR vop: IntermediateCode.Operand; part: LONGINT);
  1829. VAR mem: InstructionSet.Operand; reg: Operand;
  1830. BEGIN
  1831. instructionSet.InitMemory(mem, InstructionSet.SP, 0);
  1832. AcquireDestinationRegister(vop, part, reg);
  1833. Emit2(opLD, reg, mem);
  1834. AllocateStack(-1, TRUE);
  1835. ReleaseDestinationRegister(vop, part, reg);
  1836. END EmitPop;
  1837. PROCEDURE EmitPush(VAR vop: IntermediateCode.Operand; part: LONGINT);
  1838. VAR mem: InstructionSet.Operand; reg: Operand; pc: LONGINT;
  1839. BEGIN
  1840. MakeRegister(vop, part, reg);
  1841. IF pushChainLength = 0 THEN (* check for chain of pushes *)
  1842. pc := inPC+1; pushChainLength := 1;
  1843. WHILE ~inEmulation & (pc < in.pc) & (in.instructions[pc].opcode = IntermediateCode.push) DO
  1844. INC(pc); INC(pushChainLength);
  1845. END;
  1846. AllocateStack(pushChainLength,TRUE);
  1847. END;
  1848. DEC(pushChainLength);
  1849. instructionSet.InitMemory(mem, InstructionSet.SP, pushChainLength);
  1850. Emit2(opST, reg, mem);
  1851. END EmitPush;
  1852. PROCEDURE EmitNeg(VAR instr: IntermediateCode.Instruction);
  1853. VAR leftLow, leftHigh, rightLow, rightHigh, reg: Operand; neg: BOOLEAN; fixup: BinaryCode.Fixup;
  1854. BEGIN
  1855. IF instr.op1.type.form IN IntermediateCode.Integer THEN
  1856. PrepareOp2(instr,Low,FALSE,neg,leftLow, rightLow);
  1857. Emit2(opNOT, leftLow, rightLow);
  1858. IF IsComplex(instr.op1) THEN
  1859. PrepareOp2(instr,High,FALSE,neg,leftHigh,rightHigh);
  1860. Emit2(opNOT, leftHigh, rightHigh);
  1861. END;
  1862. Emit2N(opADD,leftLow,1);
  1863. FinishOp(instr.op1,Low,leftLow, leftLow);
  1864. IF IsComplex(instr.op1) THEN
  1865. fixup := BrForward(opBB);
  1866. (*
  1867. Emit1N(opBB, 1);
  1868. *)
  1869. Emit2N(opADD, leftHigh, 1);
  1870. SetTarget(fixup);
  1871. FinishOp(instr.op1,High,leftHigh, leftHigh);
  1872. END;
  1873. ELSIF instr.op1.type.form = IntermediateCode.Float THEN
  1874. PrepareOp2(instr,Low,FALSE,neg,leftLow,rightLow);
  1875. IF IsComplex(instr.op1) THEN
  1876. PrepareOp2(instr,High,FALSE,neg,leftHigh,rightHigh);
  1877. END;
  1878. Emit2(opMOV,leftLow,rightLow);
  1879. IF ~IsComplex(instr.op1) THEN
  1880. reg := leftLow
  1881. ELSE ASSERT(instr.op1.type.sizeInBits=64);
  1882. Emit2(opMOV,leftHigh,rightHigh);
  1883. reg := leftHigh;
  1884. END;
  1885. Emit2N(opROR,reg,31);
  1886. Emit2N(opXOR,reg,1);
  1887. Emit2N(opROR,reg,1);
  1888. ReleaseDestinationRegister(instr.op1, Low, leftLow);
  1889. IF IsComplex(instr.op1) THEN
  1890. ReleaseDestinationRegister(instr.op1,High,leftHigh);
  1891. END;
  1892. END;
  1893. END EmitNeg;
  1894. PROCEDURE EmitNot(VAR instr: IntermediateCode.Instruction; part: LONGINT);
  1895. VAR left,right: Operand; negate: BOOLEAN;
  1896. BEGIN
  1897. PrepareOp2(instr,part,FALSE,negate,left,right);
  1898. Emit2(opNOT, left,right);
  1899. FinishOp(instr.op1,part,left,left);
  1900. END EmitNot;
  1901. PROCEDURE EmitAbs(VAR instr: IntermediateCode.Instruction);
  1902. VAR left,right: Operand; neg: BOOLEAN; fixup: BinaryCode.Fixup;
  1903. BEGIN
  1904. PrepareOp2(instr,Low,FALSE,neg,left,right);
  1905. Emit2(opMOV, left, right);
  1906. fixup := BrForward(opBNN);
  1907. (*
  1908. Emit1N(opBNN, 2);
  1909. *)
  1910. Emit2(opNOT, left,right);
  1911. Emit2N(opADD, left, 1);
  1912. SetTarget(fixup);
  1913. FinishOp(instr.op1,Low, left,left);
  1914. END EmitAbs;
  1915. PROCEDURE EmitTrap(CONST instr: IntermediateCode.Instruction);
  1916. VAR reg: Operand; reserve: Ticket;
  1917. BEGIN
  1918. instructionSet.InitRegister(reg, 0);
  1919. ImmediateToOperand(instr.op1.intValue,Low, FALSE, instructionSet.ImmediateFixupBits,reg);
  1920. IF physicalRegisters.Mapped(0)=NIL THEN
  1921. reserve := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,0,inPC);
  1922. ELSE
  1923. reserve := NIL
  1924. END;
  1925. GetTemporaryRegister(reg);
  1926. Emit2N(opMOV, reg, HaltIRQNumber);
  1927. Emit2(opBLR, opLR, reg);
  1928. ReleaseHint(reg.register);
  1929. IF reserve # NIL THEN UnmapTicket(reserve) END;
  1930. END EmitTrap;
  1931. PROCEDURE EmitAsm(CONST instr: IntermediateCode.Instruction);
  1932. VAR reader: Streams.StringReader; procedure: SyntaxTree.Procedure; scope: SyntaxTree.Scope;
  1933. len: LONGINT; symbol: SyntaxTree.Symbol; assembler: Assembler.Assembler;
  1934. scanner: Scanner.AssemblerScanner;
  1935. BEGIN
  1936. len := Strings.Length(instr.op1.string^);
  1937. NEW(reader, len);
  1938. reader.Set(instr.op1.string^);
  1939. symbol := in.symbol;
  1940. IF (symbol = NIL) THEN
  1941. scope := NIL
  1942. ELSE
  1943. procedure := symbol(SyntaxTree.Procedure);
  1944. scope := procedure.procedureScope;
  1945. END;
  1946. NEW(assembler, diagnostics, backend.capabilities,instructionSet );
  1947. scanner := Scanner.NewAssemblerScanner(module.moduleName(*module.module.sourceName*), reader, SHORT(instr.op1.intValue), diagnostics);
  1948. assembler.InlineAssemble(scanner, in, scope, module);
  1949. error := error OR assembler.error
  1950. END EmitAsm;
  1951. END CodeGeneratorTRM;
  1952. System = OBJECT (Global.System)
  1953. PROCEDURE SizeOf(type: SyntaxTree.Type): LONGINT;
  1954. BEGIN
  1955. type := type.resolved;
  1956. IF type IS SyntaxTree.BasicType THEN
  1957. IF (type.sizeInBits=64) THEN
  1958. RETURN 64
  1959. ELSE
  1960. RETURN 32
  1961. END
  1962. ELSE RETURN SizeOf^(type)
  1963. END;
  1964. END SizeOf;
  1965. END System;
  1966. BackendTRM = OBJECT (IntermediateBackend.IntermediateBackend)
  1967. VAR
  1968. cg: CodeGeneratorTRM;
  1969. patchSpartan6: BOOLEAN;
  1970. myInstructionSet: InstructionSet.InstructionSet;
  1971. PROCEDURE &InitBackendTRM;
  1972. BEGIN
  1973. InitIntermediateBackend;
  1974. SetRuntimeModuleName(DefaultRuntimeModuleName);
  1975. SetNewObjectFile(TRUE,TRUE);
  1976. myInstructionSet:=defaultInstructionSet;
  1977. SetHasLinkRegister;
  1978. END InitBackendTRM;
  1979. PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System;
  1980. activeCellsSpecification: ActiveCells.Specification);
  1981. VAR
  1982. BEGIN
  1983. Initialize^(diagnostics, log, flags, checker, system, activeCellsSpecification); (*goes up the inheritance hierarchy all the way to Backend.Mod*)
  1984. NEW(cg, runtimeModuleName, diagnostics, SELF,myInstructionSet);
  1985. cg.patchSpartan6 := patchSpartan6;
  1986. END Initialize;
  1987. PROCEDURE SetInstructionWidth* (instructionWidth: LONGINT); (*override*)
  1988. BEGIN
  1989. SetInstructionWidth^(instructionWidth);
  1990. NEW(myInstructionSet,instructionWidth);
  1991. cg.SetInstructionSet(myInstructionSet);
  1992. END SetInstructionWidth;
  1993. PROCEDURE GetSystem(): Global.System;
  1994. VAR system: System;
  1995. BEGIN
  1996. NEW(system, 18, 32, 32, 32, 32, 32, 32, 0(* parameter offset 0: handled locally *), 0 (* no pass of parameters in registers *) , cooperative);
  1997. Global.SetDefaultDeclarations(system,32);
  1998. Global.SetDefaultOperators(system);
  1999. RETURN system
  2000. END GetSystem;
  2001. PROCEDURE SupportedInstruction(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
  2002. BEGIN
  2003. RETURN cg.Supported(instruction, moduleName, procedureName);
  2004. END SupportedInstruction;
  2005. PROCEDURE SupportedImmediate(CONST immediate: IntermediateCode.Operand): BOOLEAN;
  2006. VAR reg: InstructionSet.Operand; int: LONGINT;
  2007. BEGIN
  2008. IF immediate.type.form IN IntermediateCode.Integer THEN
  2009. IF immediate.type.sizeInBits < 64 THEN
  2010. int := LONGINT(immediate.intValue);
  2011. RETURN ((ABS(int) < ASH(1,myInstructionSet.ImmediateFixupBits)) OR (cg.GetImmediate32(int, reg, FALSE) < 3))
  2012. ELSE
  2013. RETURN (ABS(immediate.intValue) < ASH(1,myInstructionSet.ImmediateFixupBits))
  2014. END;
  2015. ELSE
  2016. RETURN FALSE
  2017. END
  2018. END SupportedImmediate;
  2019. PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
  2020. VAR
  2021. in: Sections.Section;
  2022. out: BinaryCode.Section;
  2023. name: Basic.SectionName;
  2024. procedure: SyntaxTree.Procedure;
  2025. i, j, initialSectionCount: LONGINT;
  2026. PROCEDURE Resolve(VAR fixup: BinaryCode.Fixup);
  2027. BEGIN
  2028. IF (fixup.symbol.name #"") & (fixup.resolved = NIL) THEN
  2029. fixup.resolved := module.allSections.FindByName(fixup.symbol.name)
  2030. END;
  2031. END Resolve;
  2032. (* recompute fixup positions and assign binary sections *)
  2033. PROCEDURE PatchFixups(section: BinaryCode.Section);
  2034. VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; symbolOffset: LONGINT; in: IntermediateCode.Section;
  2035. BEGIN
  2036. fixup := section.fixupList.firstFixup;
  2037. WHILE fixup # NIL DO
  2038. Resolve(fixup);
  2039. IF (fixup.resolved # NIL) THEN
  2040. resolved := fixup.resolved(IntermediateCode.Section).resolved(BinaryCode.Section);
  2041. in := fixup.resolved(IntermediateCode.Section);
  2042. symbolOffset := fixup.symbolOffset;
  2043. IF (symbolOffset # 0) & (symbolOffset < in.pc) THEN
  2044. symbolOffset := in.instructions[symbolOffset].pc;
  2045. END;
  2046. fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, symbolOffset+fixup.displacement);
  2047. END;
  2048. fixup := fixup.nextFixup;
  2049. END;
  2050. END PatchFixups;
  2051. BEGIN
  2052. cg.SetModule(module);
  2053. cg.dump := dump;
  2054. FOR i := 0 TO module.allSections.Length() - 1 DO
  2055. in := module.allSections.GetSection(i);
  2056. in(IntermediateCode.Section).EnableComments(trace);
  2057. IF in.type = Sections.InlineCodeSection THEN
  2058. Basic.SegmentedNameToString(in.name, name);
  2059. out := ResolvedSection(in(IntermediateCode.Section));
  2060. cg.dump := out.comments;
  2061. SetInstructionWidth(out.os.unit);
  2062. cg.Section(in(IntermediateCode.Section), out); (*compilation*)
  2063. IF in.symbol # NIL THEN
  2064. procedure := in.symbol(SyntaxTree.Procedure);
  2065. procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
  2066. END;
  2067. END
  2068. END;
  2069. initialSectionCount := 0;
  2070. REPEAT
  2071. j := initialSectionCount;
  2072. initialSectionCount := module.allSections.Length() ;
  2073. FOR i := j TO initialSectionCount - 1 DO
  2074. in := module.allSections.GetSection(i);
  2075. IF (in.type # Sections.InlineCodeSection) (*& (in(IntermediateCode.Section).resolved = NIL) *) THEN
  2076. out := ResolvedSection(in(IntermediateCode.Section));
  2077. SetInstructionWidth(out.os.unit);
  2078. cg.Section(in(IntermediateCode.Section),out);
  2079. END
  2080. END
  2081. UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
  2082. (*
  2083. FOR i := 0 TO module.allSections.Length() - 1 DO
  2084. in := module.allSections.GetSection(i);
  2085. IF ~in.IsExternal() THEN
  2086. IF in.type # Sections.InlineCodeSection THEN
  2087. Basic.SegmentedNameToString(in.name, name);
  2088. out := ResolvedSection(in(IntermediateCode.Section));
  2089. cg.Section(in(IntermediateCode.Section), out);
  2090. END
  2091. END;
  2092. END;
  2093. *)
  2094. FOR i := 0 TO module.allSections.Length() - 1 DO
  2095. in := module.allSections.GetSection(i);
  2096. PatchFixups(in(IntermediateCode.Section).resolved)
  2097. END;
  2098. IF cg.error THEN Error("", Diagnostics.Invalid, Diagnostics.Invalid, "") END;
  2099. END GenerateBinary;
  2100. (* genasm *)
  2101. PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
  2102. VAR
  2103. result: Formats.GeneratedModule;
  2104. BEGIN
  2105. ASSERT(intermediateCodeModule IS Sections.Module);
  2106. result := ProcessIntermediateCodeModule^(intermediateCodeModule);
  2107. IF ~error THEN
  2108. GenerateBinary(result(Sections.Module), dump);
  2109. IF dump # NIL THEN
  2110. dump.Ln; dump.Ln;
  2111. dump.String("------------------ binary code -------------------"); dump.Ln;
  2112. IF (traceString="") OR (traceString="*") THEN
  2113. result.Dump(dump);
  2114. dump.Update
  2115. ELSE
  2116. Sections.DumpFiltered(dump, result(Sections.Module), traceString);
  2117. dump.Update;
  2118. END
  2119. END;
  2120. END;
  2121. RETURN result
  2122. FINALLY
  2123. IF dump # NIL THEN
  2124. dump.Ln; dump.Ln;
  2125. dump.String("------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
  2126. IF (traceString="") OR (traceString="*") THEN
  2127. result.Dump(dump);
  2128. dump.Update
  2129. ELSE
  2130. Sections.DumpFiltered(dump,result(Sections.Module),traceString);
  2131. dump.Update;
  2132. END
  2133. END;
  2134. RETURN result
  2135. END ProcessIntermediateCodeModule;
  2136. PROCEDURE DefineOptions(options: Options.Options);
  2137. BEGIN
  2138. options.Add(0X,VectorSupportFlag,Options.Flag);
  2139. options.Add(0X,FloatingPointSupportFlag,Options.Flag);
  2140. options.Add(0X,PatchSpartan6, Options.Flag);
  2141. DefineOptions^(options);
  2142. END DefineOptions;
  2143. PROCEDURE GetOptions(options: Options.Options);
  2144. VAR capabilities: SET;
  2145. BEGIN
  2146. capabilities := SELF.capabilities;
  2147. IF options.GetFlag(VectorSupportFlag) THEN INCL(capabilities, Global.VectorCapability) END;
  2148. IF options.GetFlag(FloatingPointSupportFlag) THEN INCL(capabilities, Global.FloatingPointCapability) END;
  2149. IF options.GetFlag(PatchSpartan6) THEN D.String("patchSpartan6=TRUE"); D.Ln; patchSpartan6 := TRUE END;
  2150. SetCapabilities(capabilities);
  2151. GetOptions^(options);
  2152. END GetOptions;
  2153. PROCEDURE DefaultObjectFileFormat(): Formats.ObjectFileFormat;
  2154. BEGIN RETURN ObjectFileFormat.Get();
  2155. END DefaultObjectFileFormat;
  2156. PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
  2157. BEGIN
  2158. RETURN NIL
  2159. END DefaultSymbolFileFormat;
  2160. PROCEDURE GetDescription(VAR instructionSet: ARRAY OF CHAR);
  2161. BEGIN instructionSet := "TRM"
  2162. END GetDescription;
  2163. PROCEDURE FindPC(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
  2164. VAR
  2165. section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
  2166. i: LONGINT; pooledName: Basic.SegmentedName;
  2167. BEGIN
  2168. module := ProcessSyntaxTreeModule(x);
  2169. Basic.ToSegmentedName(sectionName, pooledName);
  2170. i := 0;
  2171. REPEAT
  2172. section := module(Sections.Module).allSections.GetSection(i);
  2173. INC(i);
  2174. UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
  2175. IF section.name # pooledName THEN
  2176. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  2177. ELSE
  2178. binarySection := section(IntermediateCode.Section).resolved;
  2179. label := binarySection.labels;
  2180. WHILE (label # NIL) & (label.offset >= sectionOffset) DO
  2181. label := label.prev;
  2182. END;
  2183. IF label # NIL THEN
  2184. diagnostics.Information(module.module.sourceName,label.position,Diagnostics.Invalid," pc position");
  2185. ELSE
  2186. diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
  2187. END;
  2188. END;
  2189. END FindPC;
  2190. PROCEDURE CheckCodeAddress(VAR adr: LONGINT);
  2191. BEGIN
  2192. IF (patchSpartan6) & (adr MOD 1024 >= 959) (* need one instruction to jump, therefore include 959 in check *) & (adr MOD 1024 <= 975) THEN
  2193. adr := (adr DIV 1024) * 1024 +976;
  2194. END;
  2195. END CheckCodeAddress;
  2196. PROCEDURE ResolvedSection(in: IntermediateCode.Section): BinaryCode.Section;
  2197. VAR section: BinaryCode.Section; unit: LONGINT;
  2198. BEGIN
  2199. (*VAR and CONST sections go to the data memory, only code sections go to code memory
  2200. Note that data memory has 32 bit words while code has standard 18.
  2201. *)
  2202. IF in.bitsPerUnit # Sections.UnknownSize THEN
  2203. unit := in.bitsPerUnit;
  2204. ELSIF in.type IN {Sections.VarSection, Sections.ConstSection} THEN
  2205. unit := 32;
  2206. ELSE
  2207. IF (instructionWidth # Sections.UnknownSize) THEN
  2208. unit := instructionWidth;
  2209. ELSE
  2210. unit:=18;
  2211. END
  2212. END;
  2213. IF in.resolved = NIL THEN
  2214. NEW(section, in.type, in.priority, unit, in.name, in.comments # NIL, FALSE);
  2215. section.SetAlignment(in.fixed, in.positionOrAlignment);
  2216. in.SetResolved(section);
  2217. ELSE
  2218. section := in.resolved
  2219. END;
  2220. RETURN section
  2221. END ResolvedSection;
  2222. END BackendTRM;
  2223. VAR
  2224. defaultInstructionSet: InstructionSet.InstructionSet;
  2225. emptyOperand: InstructionSet.Operand;
  2226. PROCEDURE Assert(b: BOOLEAN; CONST s: ARRAY OF CHAR);
  2227. BEGIN
  2228. ASSERT(b, 100);
  2229. END Assert;
  2230. PROCEDURE Halt(CONST s: ARRAY OF CHAR);
  2231. BEGIN
  2232. HALT(100);
  2233. END Halt;
  2234. PROCEDURE Init;
  2235. BEGIN
  2236. NEW(defaultInstructionSet,18); (*TODO: maybe it's better to have all these init functions outside of instruction set object?*)
  2237. defaultInstructionSet.InitOperand(emptyOperand);
  2238. END Init;
  2239. PROCEDURE Get*(): Backend.Backend;
  2240. VAR backend: BackendTRM;
  2241. BEGIN NEW(backend); RETURN backend
  2242. END Get;
  2243. BEGIN
  2244. Init;
  2245. END FoxTRMBackend.
  2246. SystemTools.FreeDownTo FoxTRMBackend ~