FoxTRMBackend.Mod 85 KB

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