FoxCodeGenerators.Mod 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280
  1. MODULE FoxCodeGenerators; (** AUTHOR ""; PURPOSE ""; *)
  2. IMPORT Diagnostics, Sections := FoxSections, Streams, BinaryCode := FoxBinaryCode, IntermediateCode := FoxIntermediateCode,
  3. IntermediateBackend := FoxIntermediateBackend, SyntaxTree := FoxSyntaxTree, Basic := FoxBasic, Global := FoxGlobal,
  4. StringPool, Strings, D := Debugging;
  5. CONST
  6. None=IntermediateCode.None;
  7. OptimizeRegisterTransfer*=0;
  8. TYPE
  9. (* ----------------------------------- register allocation ------------------------------------- *)
  10. AllocationArray=POINTER TO ARRAY OF RECORD
  11. first, last: LONGINT;
  12. END;
  13. RegisterAllocation*=OBJECT
  14. VAR
  15. table: AllocationArray;
  16. PROCEDURE &Init;
  17. VAR i: LONGINT;
  18. BEGIN
  19. IF table = NIL THEN NEW(table,64) END;
  20. FOR i := 0 TO LEN(table)-1 DO
  21. table[i].first := MAX(LONGINT);
  22. table[i].last := MIN(LONGINT);
  23. END;
  24. END Init;
  25. PROCEDURE Grow;
  26. VAR new: AllocationArray; i: LONGINT;
  27. BEGIN
  28. NEW(new,LEN(table)*2);
  29. FOR i := 0 TO LEN(table)-1 DO
  30. new[i] := table[i]
  31. END;
  32. FOR i := LEN(table) TO LEN(new)-1 DO
  33. new[i].first := MAX(LONGINT);
  34. new[i].last := MIN(LONGINT);
  35. END;
  36. table := new;
  37. END Grow;
  38. PROCEDURE Use(register, pc: LONGINT);
  39. BEGIN
  40. IF LEN(table) <= register THEN Grow END;
  41. IF table[register].first >pc THEN table[register].first := pc END;
  42. IF table[register].last <pc THEN table[register].last := pc END;
  43. END Use;
  44. END RegisterAllocation;
  45. RegisterEntry* = POINTER TO RECORD
  46. prev,next: RegisterEntry;
  47. register: LONGINT;
  48. registerClass: IntermediateCode.RegisterClass;
  49. type: IntermediateCode.Type;
  50. END;
  51. LiveRegisters*= OBJECT
  52. VAR first, last, cache: RegisterEntry;
  53. PROCEDURE &Init;
  54. BEGIN first := NIL; last := NIL; cache := NIL;
  55. END Init;
  56. PROCEDURE AddRegisterEntry(register: LONGINT; class: IntermediateCode.RegisterClass; type: IntermediateCode.Type);
  57. VAR new: RegisterEntry;
  58. BEGIN
  59. (* allocate *)
  60. IF cache # NIL THEN new := cache; cache := cache.next; ELSE NEW(new) END;
  61. new.next := NIL; new.prev := NIL;
  62. (* set *)
  63. new.register := register; new.registerClass := class; new.type := type;
  64. (* enter *)
  65. IF first = NIL THEN
  66. first := new; last:= new;
  67. ELSE
  68. new.next := first;
  69. first.prev := new;
  70. first := new
  71. END;
  72. END AddRegisterEntry;
  73. PROCEDURE RemoveRegisterEntry(register: LONGINT);
  74. VAR this: RegisterEntry;
  75. BEGIN
  76. (* search *)
  77. this := first;
  78. WHILE (this # NIL) & (this.register # register) DO
  79. this := this.next;
  80. END;
  81. (* remove *)
  82. IF this = NIL THEN RETURN END;
  83. IF this = first THEN first := first.next END;
  84. IF this = last THEN last := last.prev END;
  85. IF this.prev # NIL THEN this.prev.next := this.next END;
  86. IF this.next # NIL THEN this.next.prev := this.prev END;
  87. (* dispose *)
  88. this.next := cache; cache := this;
  89. END RemoveRegisterEntry;
  90. END LiveRegisters;
  91. GenericCodeGenerator*= OBJECT
  92. VAR
  93. diagnostics-: Diagnostics.Diagnostics; (* error stream *)
  94. module-: Sections.Module;
  95. dump*: Streams.Writer;
  96. in-: IntermediateCode.Section; out-: BinaryCode.Section;
  97. inPC-, outPC-: LONGINT;
  98. error* : BOOLEAN;
  99. allocation: RegisterAllocation;
  100. liveRegisters: LiveRegisters;
  101. inEmulation-: BOOLEAN;
  102. optimize: SET;
  103. (* generic *)
  104. PROCEDURE & InitGenerator*(diagnostics: Diagnostics.Diagnostics; optimize: BOOLEAN);
  105. BEGIN
  106. SELF.module := NIL;
  107. SELF.diagnostics := diagnostics;
  108. error := FALSE;
  109. NEW(allocation); NEW(liveRegisters);
  110. IF optimize THEN SELF.optimize := {0..31} ELSE SELF.optimize := {} END;
  111. END InitGenerator;
  112. PROCEDURE SetModule*(module: Sections.Module); (* needed for inline code for symbol reference *)
  113. BEGIN
  114. SELF.module := module;
  115. END SetModule;
  116. PROCEDURE Error*(position: Basic.Position; CONST message: ARRAY OF CHAR);
  117. VAR string:Basic.MessageString;
  118. BEGIN
  119. IF diagnostics # NIL THEN
  120. Basic.SegmentedNameToString(in.name, string);
  121. Basic.Error(diagnostics,string, position, message)
  122. END;
  123. IF dump # NIL THEN (* to see error in trace output also *)
  124. dump.String("Error: "); dump.String(message); dump.Ln; dump.Update;
  125. END;
  126. error := TRUE;
  127. END Error;
  128. (* generic *)
  129. PROCEDURE Section*(in: IntermediateCode.Section; out: BinaryCode.Section);
  130. VAR pc: LONGINT; name: Basic.SectionName; instruction: IntermediateCode.Instruction;
  131. moduleName, procedureName: SyntaxTree.IdentifierString;
  132. PROCEDURE ResolveLocalFixups;
  133. VAR fixup, next: BinaryCode.Fixup; dest: LONGINT; msg,string: Basic.MessageString; number: ARRAY 32 OF CHAR;
  134. BEGIN
  135. fixup := out.fixupList.firstFixup;
  136. out.fixupList.InitFixupList;
  137. WHILE fixup # NIL DO
  138. next := fixup.nextFixup;
  139. IF (fixup.symbol.name = in.name) & (fixup.mode = BinaryCode.Relative) THEN (* local relative fixup *)
  140. IF dump # NIL THEN
  141. dump.String("local fixup "); dump.Int(fixup.offset,1); dump.String(" <-- ");
  142. fixup.Dump(dump); dump.Ln; (*dump.Update;*)
  143. END;
  144. IF fixup.symbolOffset # 0 THEN
  145. dest := fixup.symbolOffset;
  146. dest := in.instructions[dest].pc;
  147. ELSE
  148. dest := 0;
  149. END;
  150. fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, dest+fixup.displacement);
  151. IF dump # NIL THEN
  152. dump.String("local fixup resolved: ");
  153. dump.Int(fixup.offset,1); dump.String(" <-- ");
  154. fixup.Dump(dump);
  155. dump.Ln; (*dump.Update;*)
  156. END;
  157. IF ~out.ApplyFixup(fixup) THEN
  158. COPY("fixup out of range: ", msg);
  159. string := fixup.symbol.name;
  160. Strings.Append(msg, string);
  161. Strings.Append(msg, ":");
  162. Strings.IntToStr(fixup.offset, number);
  163. Strings.Append(msg, number);
  164. Error(Basic.invalidPosition,msg)
  165. END
  166. ELSE
  167. out.fixupList.AddFixup(fixup);
  168. END;
  169. fixup := next;
  170. END;
  171. END ResolveLocalFixups;
  172. PROCEDURE GetRegisterAllocation;
  173. CONST MaxParameterRegisters=16;
  174. VAR pc,i: LONGINT; parameterRegisters: ARRAY MaxParameterRegisters OF IntermediateCode.Operand;
  175. PROCEDURE RegisterUsage(CONST instruction: IntermediateCode.Instruction);
  176. VAR i: LONGINT;
  177. PROCEDURE Use(CONST operand: IntermediateCode.Operand);
  178. VAR i: LONGINT;
  179. BEGIN
  180. IF operand.register > 0 THEN
  181. allocation.Use(operand.register,inPC);
  182. IF operand.registerClass.class = IntermediateCode.Parameter THEN (* store recent parameter registers *)
  183. parameterRegisters[operand.registerClass.number] := operand;
  184. END;
  185. END;
  186. IF operand.rule # NIL THEN
  187. FOR i := 0 TO LEN(operand.rule)-1 DO
  188. Use(operand.rule[i]);
  189. END;
  190. END;
  191. END Use;
  192. BEGIN
  193. Use(instruction.op1);
  194. Use(instruction.op2);
  195. Use(instruction.op3);
  196. IF instruction.opcode = IntermediateCode.call THEN (* mark all currently used parameter registers used in this instruction *)
  197. FOR i := 0 TO MaxParameterRegisters-1 DO
  198. Use(parameterRegisters[i]);
  199. IntermediateCode.InitOperand(parameterRegisters[i]);
  200. END;
  201. END;
  202. END RegisterUsage;
  203. BEGIN
  204. allocation.Init;
  205. FOR i := 0 TO MaxParameterRegisters-1 DO
  206. IntermediateCode.InitOperand(parameterRegisters[i]);
  207. END;
  208. FOR pc := 0 TO in.pc-1 DO
  209. inPC := pc;
  210. RegisterUsage(in.instructions[pc]);
  211. END;
  212. END GetRegisterAllocation;
  213. PROCEDURE Optimize;
  214. TYPE
  215. Entry= POINTER TO RECORD src, dest: LONGINT; next: Entry END;
  216. VAR
  217. pc: LONGINT;
  218. first: Entry;
  219. PROCEDURE AddMap(src, dest: LONGINT);
  220. VAR entry: Entry;
  221. BEGIN
  222. NEW(entry); entry.src := src; entry.dest := dest;
  223. entry.next := first;
  224. first := entry;
  225. END AddMap;
  226. PROCEDURE CheckMapped(VAR instruction: IntermediateCode.Instruction);
  227. VAR op1, op2, op3: IntermediateCode.Operand;
  228. PROCEDURE Map(CONST op: IntermediateCode.Operand): IntermediateCode.Operand;
  229. VAR entry: Entry; res: IntermediateCode.Operand; i: LONGINT;
  230. BEGIN
  231. res := op;
  232. entry := first;
  233. WHILE entry # NIL DO
  234. IF op.register = entry.src THEN
  235. IntermediateCode.SetRegister(res, entry.dest);
  236. END;
  237. entry := entry.next;
  238. END;
  239. IF op.rule # NIL THEN
  240. FOR i := 0 TO LEN(op.rule)-1 DO
  241. op.rule[i] := Map(op.rule[i]);
  242. END;
  243. END;
  244. RETURN res
  245. END Map;
  246. BEGIN
  247. op1 := Map(instruction.op1);
  248. op2 := Map(instruction.op2);
  249. op3 := Map(instruction.op3);
  250. IntermediateCode.InitInstruction(instruction, instruction.textPosition, instruction.opcode, op1, op2, op3);
  251. END CheckMapped;
  252. PROCEDURE CheckMov(VAR instruction: IntermediateCode.Instruction);
  253. VAR i: LONGINT; srcReg, destReg: LONGINT;
  254. BEGIN
  255. IF (instruction.opcode = IntermediateCode.mov) & (instruction.op1.mode = IntermediateCode.ModeRegister)
  256. & (instruction.op2.mode = IntermediateCode.ModeRegister) & IntermediateCode.TypeEquals(instruction.op1.type, instruction.op2.type) THEN
  257. destReg := instruction.op1.register;
  258. srcReg := instruction.op2.register;
  259. IF (destReg >= 0) & (allocation.table[destReg].first = pc) & (srcReg >= 0) & (allocation.table[srcReg].last = pc) THEN
  260. AddMap(destReg, srcReg);
  261. allocation.table[srcReg].last := allocation.table[destReg].last;
  262. IntermediateCode.InitInstruction0(instruction, instruction.textPosition, IntermediateCode.nop);
  263. END;
  264. END;
  265. END CheckMov;
  266. BEGIN
  267. first := NIL;
  268. FOR pc := 0 TO in.pc-1 DO
  269. IF OptimizeRegisterTransfer IN optimize THEN
  270. CheckMapped(in.instructions[pc]);
  271. CheckMov(in.instructions[pc]);
  272. END;
  273. END;
  274. END Optimize;
  275. PROCEDURE DumpInstruction(CONST instruction: IntermediateCode.Instruction);
  276. PROCEDURE Use(CONST operand: IntermediateCode.Operand);
  277. BEGIN
  278. IF FirstUse(operand.register)=inPC THEN
  279. dump.String(" ; +"); IntermediateCode.DumpRegister(dump,operand.register,operand.registerClass);
  280. END;
  281. IF LastUse(operand.register)=inPC THEN
  282. dump.String(" ; -"); IntermediateCode.DumpRegister(dump,operand.register, operand.registerClass);
  283. END;
  284. END Use;
  285. BEGIN
  286. dump.Int(pc, 1); dump.String(": "); IntermediateCode.DumpInstruction(dump, instruction);
  287. Use(instruction.op1);
  288. Use(instruction.op2);
  289. Use(instruction.op3);
  290. END DumpInstruction;
  291. PROCEDURE Emulate(VAR x: IntermediateCode.Instruction; CONST moduleName,procedureName: SyntaxTree.IdentifierString);
  292. VAR
  293. parSize: LONGINT; sectionName: Basic.SegmentedName; source: Sections.Section; op: IntermediateCode.Operand;
  294. instruction: IntermediateCode.Instruction;
  295. symbol: SyntaxTree.Symbol; fp: LONGINT;
  296. hasDestination: BOOLEAN;
  297. PROCEDURE Emit(instruction: IntermediateCode.Instruction; CONST str: ARRAY OF CHAR);
  298. BEGIN
  299. IF dump # NIL THEN
  300. dump.Int(pc, 1); dump.String(" (emulation ");dump.String(str); dump.String(") : "); IntermediateCode.DumpInstruction(dump, instruction); dump.Ln;
  301. END;
  302. Generate(instruction);
  303. END Emit;
  304. PROCEDURE SaveRegisters;
  305. VAR op: IntermediateCode.Operand; entry: RegisterEntry;
  306. BEGIN
  307. entry := liveRegisters.first;
  308. WHILE entry # NIL DO
  309. IF (FirstUse(entry.register) # pc) & (entry.register # x.op1.register) THEN
  310. IntermediateCode.InitRegister(op, entry.type,entry.registerClass, entry.register);
  311. Emit(IntermediateBackend.Push(x.textPosition,op),"save");
  312. END;
  313. entry := entry.next;
  314. END;
  315. END SaveRegisters;
  316. PROCEDURE RestoreRegisters;
  317. VAR op: IntermediateCode.Operand; entry: RegisterEntry; instruction: IntermediateCode.Instruction;
  318. BEGIN
  319. entry := liveRegisters.last;
  320. WHILE entry # NIL DO
  321. IF (FirstUse(entry.register) # pc) & (entry.register # x.op1.register) THEN
  322. IntermediateCode.InitRegister(op, entry.type,entry.registerClass, entry.register);
  323. Emit(IntermediateBackend.Pop(x.textPosition,op),"restore");
  324. END;
  325. entry := entry.prev;
  326. END;
  327. END RestoreRegisters;
  328. BEGIN
  329. inEmulation := TRUE;
  330. hasDestination := (IntermediateCode.Op1IsDestination IN IntermediateCode.instructionFormat[x.opcode].flags);
  331. ASSERT(x.op1.mode # IntermediateCode.Undefined);
  332. (* add import to import list -- raw insert, no check.
  333. checks will be performed by loader or linker -- we assume that a low-level runtime system programmer knows what he is doing
  334. *)
  335. SaveRegisters;
  336. IF ~module.imports.ContainsName(moduleName) THEN module.imports.AddName(moduleName) END;
  337. parSize := 0;
  338. IF (x.op1.mode # IntermediateCode.Undefined) & ~hasDestination THEN
  339. Emit(IntermediateBackend.Push(x.textPosition,x.op1),"par");
  340. INC(parSize, x.op1.type.sizeInBits);
  341. Basic.Align(parSize, module.system.addressSize);
  342. END;
  343. IF x.op2.mode # IntermediateCode.Undefined THEN
  344. Emit(IntermediateBackend.Push(x.textPosition,x.op2),"par");
  345. INC(parSize, x.op2.type.sizeInBits);
  346. Basic.Align(parSize, module.system.addressSize);
  347. END;
  348. IF x.op3.mode # IntermediateCode.Undefined THEN
  349. Emit(IntermediateBackend.Push(x.textPosition,x.op3),"par");
  350. INC(parSize, x.op3.type.sizeInBits);
  351. Basic.Align(parSize, module.system.addressSize);
  352. END;
  353. Basic.InitSegmentedName(sectionName);
  354. Basic.SuffixSegmentedName(sectionName, StringPool.GetIndex1(moduleName));
  355. Basic.SuffixSegmentedName(sectionName, StringPool.GetIndex1(procedureName));
  356. IF module.module # NIL THEN
  357. symbol := IntermediateBackend.GetSymbol(module.module.moduleScope, moduleName, procedureName);
  358. ELSE
  359. symbol := NIL
  360. END;
  361. IF symbol # NIL THEN fp := symbol.fingerprint.shallow ELSE fp := 0 END;
  362. IntermediateCode.InitAddress(op, IntermediateCode.GetType(module.system,module.system.addressType), sectionName , fp, 0);
  363. Emit(IntermediateBackend.Call(x.textPosition,op,IntermediateBackend.ToMemoryUnits(module.system,parSize)),"");
  364. IF hasDestination THEN
  365. Emit(IntermediateBackend.Result(x.textPosition,x.op1),"");
  366. END;
  367. RestoreRegisters;
  368. inEmulation := FALSE;
  369. END Emulate;
  370. PROCEDURE SetLiveness(CONST x: IntermediateCode.Instruction);
  371. (* currently only used to save registers in instruction emulation *)
  372. PROCEDURE CheckOperand(CONST operand: IntermediateCode.Operand);
  373. VAR i: LONGINT;
  374. BEGIN
  375. IF (operand.register >= 0) THEN
  376. IF FirstUse(operand.register) = pc THEN
  377. liveRegisters.AddRegisterEntry(operand.register, operand.registerClass, operand.type);
  378. END;
  379. IF LastUse(operand.register) = pc THEN
  380. liveRegisters.RemoveRegisterEntry(operand.register);
  381. END;
  382. END;
  383. IF operand.rule # NIL THEN
  384. FOR i := 0 TO LEN(operand.rule)-1 DO
  385. CheckOperand(operand.rule[i])
  386. END;
  387. END;
  388. END CheckOperand;
  389. BEGIN
  390. CheckOperand(x.op1);
  391. IF (x.op2.register # x.op1.register) OR (x.op2.rule # NIL) THEN
  392. CheckOperand(x.op2);
  393. END;
  394. IF (x.op3.register # x.op1.register) & (x.op3.register # x.op2.register) OR (x.op3.rule # NIL) THEN
  395. CheckOperand(x.op3);
  396. END;
  397. END SetLiveness;
  398. BEGIN
  399. inEmulation := FALSE;
  400. Basic.SegmentedNameToString(in.name, name);
  401. SELF.in := in; SELF.out := out;
  402. dump := out.comments;
  403. GetRegisterAllocation;
  404. IF optimize # {} THEN Optimize END;
  405. Prepare;
  406. FOR pc := 0 TO in.pc-1 DO
  407. inPC := pc; outPC := out.pc;
  408. in.SetPC(pc, outPC);
  409. IF pc = in.finally THEN out.SetFinally(out.pc) END;
  410. instruction := in.instructions[pc];
  411. SetLiveness(instruction);
  412. IF dump # NIL THEN DumpInstruction(instruction); dump.Ln END;
  413. CASE instruction.opcode OF
  414. IntermediateCode.data: EmitData(instruction);
  415. |IntermediateCode.reserve: EmitReserve(instruction);
  416. |IntermediateCode.label: EmitLabel(instruction);
  417. ELSE
  418. IF Supported(instruction, moduleName, procedureName) THEN
  419. Generate(instruction);
  420. PostGenerate(instruction);
  421. ELSE
  422. Emulate(instruction, moduleName, procedureName);
  423. PostGenerate(instruction);
  424. END
  425. END;
  426. END;
  427. (*CheckRegistersFree();*)
  428. ResolveLocalFixups;
  429. END Section;
  430. PROCEDURE FirstUse*(virtualRegister: LONGINT): LONGINT;
  431. BEGIN
  432. IF (virtualRegister > 0) THEN RETURN allocation.table[virtualRegister].first ELSE RETURN None END;
  433. END FirstUse;
  434. PROCEDURE LastUse*(virtualRegister: LONGINT): LONGINT;
  435. BEGIN
  436. IF (virtualRegister > 0) THEN RETURN allocation.table[virtualRegister].last ELSE RETURN None END;
  437. END LastUse;
  438. (*------------------- procedures that must be overwritten by implementers ----------------------*)
  439. (* supported instruction - provision for instruction emulation *)
  440. PROCEDURE Supported*(CONST instr: IntermediateCode.Instruction; VAR moduleName,procedureName: ARRAY OF CHAR): BOOLEAN;
  441. BEGIN
  442. moduleName := ""; procedureName := "";
  443. RETURN TRUE
  444. END Supported;
  445. (* generate procedure - is called for any instruction that cannot be output directly by the generic code generator *)
  446. PROCEDURE Generate*(VAR instr: IntermediateCode.Instruction);
  447. BEGIN (*HALT(100); *) (* abstract *)
  448. END Generate;
  449. PROCEDURE PostGenerate*(CONST instr: IntermediateCode.Instruction);
  450. BEGIN
  451. END PostGenerate;
  452. (* ---------------------- generically available code emission ------------------------- *)
  453. PROCEDURE GetDataSection*(): IntermediateCode.Section;
  454. VAR name: Basic.SegmentedName; section: IntermediateCode.Section;
  455. BEGIN
  456. Global.GetModuleSegmentedName(module.module, name);
  457. Basic.SuffixSegmentedName(name,Basic.MakeString("@Immediates"));
  458. section := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, name,NIL,TRUE);
  459. RETURN section
  460. END GetDataSection;
  461. PROCEDURE EmitData(CONST instruction: IntermediateCode.Instruction);
  462. VAR type: IntermediateCode.Type; fixup: BinaryCode.Fixup; pc: LONGINT;fixupFormat: BinaryCode.FixupPatterns;
  463. BEGIN
  464. type := instruction.op1.type;
  465. pc := out.pc;
  466. IF type.form IN IntermediateCode.Integer THEN
  467. out.PutBytes(instruction.op1.intValue,SHORT(type.sizeInBits DIV 8));
  468. ELSE
  469. IF type.sizeInBits = IntermediateCode.Bits32 THEN
  470. out.PutReal(SHORT(instruction.op1.floatValue));
  471. ELSIF type.sizeInBits = IntermediateCode.Bits64 THEN
  472. out.PutLongreal(instruction.op1.floatValue);
  473. ELSE Assert(FALSE,"no floats other than 32 or 64 bit")
  474. END;
  475. END;
  476. IF instruction.op1.symbol.name # "" THEN
  477. NEW(fixupFormat,1);
  478. fixupFormat[0].offset := 0;
  479. fixupFormat[0].bits := type.sizeInBits;
  480. fixup := BinaryCode.NewFixup(BinaryCode.Absolute,pc,instruction.op1.symbol,instruction.op1.symbolOffset,instruction.op1.offset,0,fixupFormat);
  481. out.fixupList.AddFixup(fixup);
  482. END;
  483. END EmitData;
  484. PROCEDURE EmitReserve(CONST instruction: IntermediateCode.Instruction);
  485. VAR sizeInUnits,i: LONGINT;
  486. BEGIN
  487. sizeInUnits := SHORT(instruction.op1.intValue);
  488. ASSERT(sizeInUnits >= 0); (* size is initialized to MIN(LONGINT), this checks if size field has been visited *)
  489. FOR i := 0 TO sizeInUnits-1 DO
  490. out.PutBits(0,out.os.unit);
  491. END;
  492. END EmitReserve;
  493. PROCEDURE EmitLabel(CONST instruction: IntermediateCode.Instruction);
  494. BEGIN
  495. out.AddLabel(instruction.textPosition);
  496. END EmitLabel;
  497. PROCEDURE Prepare*;
  498. BEGIN
  499. END Prepare;
  500. END GenericCodeGenerator;
  501. (* ----------------------- ticket based register allocation ------------------------------------- *)
  502. (* register mapping scheme
  503. virtual register number --> register mapping = part(0) --> ticket <--> physical register
  504. spill offset
  505. part(n) --> ticket <--> physical register
  506. spill offset
  507. *)
  508. Ticket*=POINTER TO RECORD
  509. next-: Ticket;
  510. type-: IntermediateCode.Type;
  511. class-: IntermediateCode.RegisterClass;
  512. lastuse-: LONGINT;
  513. spilled*, spillable*: BOOLEAN;
  514. register*, offset*: LONGINT;
  515. parts-: LONGINT;
  516. END;
  517. Tickets*=OBJECT
  518. VAR
  519. live-: Ticket;
  520. free: Ticket ;
  521. PROCEDURE &Init*;
  522. BEGIN
  523. live := NIL; free := NIL
  524. END Init;
  525. (* enter a new ticket into the list of live tickets, sorted by lastuse *)
  526. PROCEDURE Enter*(CONST class: IntermediateCode.RegisterClass; CONST type: IntermediateCode.Type; register: LONGINT; spillable, spilled: BOOLEAN; offset: LONGINT; lastuse: LONGINT): Ticket;
  527. VAR ticket,link: Ticket;
  528. BEGIN
  529. ASSERT(~spilled & (register # None) OR spilled & (offset # None));
  530. ASSERT(spillable OR ~spilled);
  531. IF free # NIL THEN ticket := free; free := free.next; ticket.next := NIL;
  532. ELSE NEW(ticket)
  533. END;
  534. ticket.type := type; ticket.class := class; ticket.register := register; ticket.spillable := spillable; ticket.spilled := spilled; ticket.offset := offset; ticket.lastuse := lastuse; ticket.parts := 0;
  535. IF (live = NIL) OR (live.lastuse > ticket.lastuse) THEN
  536. ticket.next := live; live := ticket
  537. ELSE
  538. link := live;
  539. WHILE (link.next # NIL) & (link.next.lastuse < ticket.lastuse) DO
  540. ASSERT((link.register # ticket.register) OR ticket.spilled);
  541. link := link.next;
  542. END;
  543. IF (link.register=ticket.register) & (~ticket.spilled & ~link.spilled) THEN Dump(D.Log); D.Update; END;
  544. ASSERT((link.register # ticket.register) OR ticket.spilled OR link.spilled);
  545. ticket.next := link.next; link.next := ticket;
  546. END;
  547. RETURN ticket
  548. END Enter;
  549. (* remove ticket from live list *)
  550. PROCEDURE Remove*(ticket: Ticket);
  551. VAR link: Ticket;
  552. BEGIN
  553. IF live=ticket THEN
  554. live := live.next;
  555. ELSE
  556. link := live;
  557. WHILE (link.next # NIL) & (link.next # ticket) DO
  558. link := link.next
  559. END;
  560. ASSERT(link.next=ticket);
  561. link.next := ticket.next;
  562. END;
  563. ticket.next := free; free := ticket
  564. END Remove;
  565. PROCEDURE Dump*(w: Streams.Writer);
  566. VAR ticket: Ticket;
  567. BEGIN
  568. w.String("---- tickets.live ----- "); w.Ln;
  569. ticket := live;
  570. WHILE ticket # NIL DO
  571. DumpTicket(w,ticket);
  572. w.Ln;
  573. ticket := ticket.next;
  574. END;
  575. END Dump;
  576. END Tickets;
  577. VirtualRegisterMappings=POINTER TO ARRAY OF Ticket;
  578. VirtualRegisters*=OBJECT
  579. VAR
  580. tickets: VirtualRegisterMappings;
  581. parts: LONGINT;
  582. firstMapped-, lastMapped-: LONGINT;
  583. PROCEDURE &Init*(parts: LONGINT);
  584. VAR i: LONGINT;
  585. BEGIN
  586. SELF.parts := parts;
  587. IF tickets = NIL THEN NEW(tickets,64*parts) END;
  588. FOR i := 0 TO LEN(tickets)-1 DO
  589. tickets[i]:=NIL;
  590. END;
  591. firstMapped := MAX(LONGINT); lastMapped := -1;
  592. END Init;
  593. PROCEDURE Grow;
  594. VAR new: VirtualRegisterMappings; i: LONGINT;
  595. BEGIN
  596. NEW(new,LEN(tickets)*2);
  597. FOR i := 0 TO LEN(tickets)-1 DO
  598. new[i] := tickets[i];
  599. END;
  600. FOR i := LEN(tickets) TO LEN(new)-1 DO
  601. new[i]:=NIL;
  602. END;
  603. tickets := new;
  604. END Grow;
  605. PROCEDURE Mapped*(register: LONGINT; part: LONGINT): Ticket;
  606. BEGIN
  607. ASSERT((part >=0) & (part < parts));
  608. IF (register > 0 ) & (register*parts < LEN(tickets)) THEN RETURN tickets[register * parts + part] ELSE RETURN NIL END;
  609. END Mapped;
  610. PROCEDURE SetMapped*(register: LONGINT; part: LONGINT; ticket: Ticket);
  611. BEGIN
  612. IF lastMapped < register THEN lastMapped := register END;
  613. IF firstMapped > register THEN firstMapped := register END;
  614. ASSERT((part >=0) & (part < parts));
  615. WHILE (register*parts >= LEN(tickets)) DO Grow END;
  616. tickets[register*parts+part] := ticket;
  617. INC(ticket.parts);
  618. END SetMapped;
  619. PROCEDURE Unmap*(register: LONGINT);
  620. VAR i: LONGINT;
  621. BEGIN
  622. IF (register > 0) & (register*parts < LEN(tickets)) THEN
  623. FOR i := 0 TO parts-1 DO
  624. tickets[register*parts+i] := NIL;
  625. END;
  626. IF firstMapped = register THEN
  627. WHILE (firstMapped * parts < LEN(tickets)) & (firstMapped <= lastMapped) & (Mapped(firstMapped,0)=NIL) DO
  628. INC(firstMapped);
  629. END;
  630. END;
  631. IF lastMapped = register THEN
  632. WHILE (lastMapped >= 0) & (lastMapped >= firstMapped) & (Mapped(lastMapped,0) = NIL) DO
  633. DEC(lastMapped)
  634. END;
  635. END;
  636. IF lastMapped < firstMapped THEN firstMapped := MAX(LONGINT); lastMapped := -1 END;
  637. END;
  638. END Unmap;
  639. PROCEDURE Parts*(): LONGINT;
  640. BEGIN RETURN parts
  641. END Parts;
  642. PROCEDURE Dump*(w: Streams.Writer);
  643. VAR register,part: LONGINT; ticket: Ticket;
  644. BEGIN
  645. w.String("---- virtual register mapping ----- "); w.Ln;
  646. register := 0;
  647. WHILE register*parts < LEN(tickets) DO
  648. FOR part := 0 TO parts-1 DO
  649. ticket := tickets[register*parts+part];
  650. IF ticket # NIL THEN
  651. w.String("register.part "); w.Int(register,1); w.String("."); w.Int(part,1); w.String(": ");
  652. DumpTicket(w,ticket); w.Ln;
  653. END;
  654. END;
  655. INC(register);
  656. END;
  657. END Dump;
  658. END VirtualRegisters;
  659. PhysicalRegisters*=OBJECT
  660. VAR
  661. PROCEDURE &InitPhysicalRegisters;
  662. END InitPhysicalRegisters;
  663. PROCEDURE Allocate*(index: LONGINT; virtualRegister: Ticket);
  664. END Allocate;
  665. PROCEDURE Mapped*(physical: LONGINT): Ticket;
  666. END Mapped;
  667. PROCEDURE Free*(index: LONGINT);
  668. END Free;
  669. PROCEDURE NextFree*(CONST type: IntermediateCode.Type): LONGINT;
  670. END NextFree;
  671. (* give a hint for the next register to return by NextFree *)
  672. PROCEDURE AllocationHint*(index: LONGINT);
  673. END AllocationHint;
  674. PROCEDURE SetReserved*(index: LONGINT; res: BOOLEAN);
  675. BEGIN
  676. END SetReserved;
  677. PROCEDURE Reserved*(index: LONGINT): BOOLEAN;
  678. BEGIN
  679. END Reserved;
  680. PROCEDURE Dump*(w: Streams.Writer);
  681. BEGIN
  682. END Dump;
  683. PROCEDURE NumberRegisters*(): LONGINT;
  684. BEGIN
  685. END NumberRegisters;
  686. END PhysicalRegisters;
  687. CONST MaxSpilledRegisters=64;
  688. TYPE
  689. SpillStack*=OBJECT
  690. VAR
  691. spillStack: ARRAY MaxSpilledRegisters OF Ticket; (* registers of spill stack position to virtual register, none if unused *)
  692. spillStackSize,maxSpillStackSize: LONGINT;
  693. PROCEDURE &Init*;
  694. VAR i: LONGINT;
  695. BEGIN
  696. spillStackSize := 0; maxSpillStackSize := 0;
  697. FOR i := 0 TO LEN(spillStack)-1 DO
  698. spillStack[i] := NIL;
  699. END;
  700. END Init;
  701. (* return next free spill offset in stack *)
  702. PROCEDURE NextFree*(): LONGINT;
  703. VAR i: LONGINT; index: Ticket;
  704. BEGIN
  705. i := 0;
  706. index := spillStack[i];
  707. WHILE (index # NIL) DO
  708. INC(i); index := spillStack[i];
  709. END;
  710. RETURN i
  711. END NextFree;
  712. PROCEDURE Allocate*(offset: LONGINT; ticket: Ticket);
  713. BEGIN
  714. spillStack[ticket.offset] := ticket;
  715. IF spillStackSize <= ticket.offset THEN spillStackSize := ticket.offset+1 END;
  716. IF maxSpillStackSize < spillStackSize THEN maxSpillStackSize := spillStackSize END;
  717. END Allocate;
  718. PROCEDURE Free*(offset: LONGINT);
  719. BEGIN
  720. spillStack[offset] := NIL;
  721. IF offset+1 = spillStackSize THEN (* rewind spillstack *)
  722. WHILE (offset >= 0) & (spillStack[offset]= NIL) DO
  723. DEC(offset);
  724. END;
  725. spillStackSize := offset+1;
  726. END;
  727. END Free;
  728. PROCEDURE Size*(): LONGINT;
  729. BEGIN RETURN spillStackSize
  730. END Size;
  731. PROCEDURE MaxSize*(): LONGINT;
  732. BEGIN RETURN maxSpillStackSize
  733. END MaxSize;
  734. PROCEDURE Dump*(w: Streams.Writer);
  735. VAR i: LONGINT;
  736. BEGIN
  737. w.String("---- spillstack -----");w.Ln;
  738. w.String("spillStackSize = "); w.Int(spillStackSize,1); w.Ln;
  739. w.String("maxSpillStackSze = "); w.Int(maxSpillStackSize,1); w.Ln;
  740. FOR i := 0 TO spillStackSize-1 DO
  741. IF spillStack[i]# NIL THEN DumpTicket(w,spillStack[i]);END
  742. END;
  743. END Dump;
  744. END SpillStack;
  745. GeneratorWithTickets*= OBJECT (GenericCodeGenerator)
  746. VAR
  747. physicalRegisters-: PhysicalRegisters; (* physical registers <-> tickets *)
  748. virtualRegisters-: VirtualRegisters; (* virtual registers --> tickets *)
  749. tickets-: Tickets; (* tickets <-> physical registers *)
  750. spillStack-: SpillStack; (* spill stack offset <-> ticket *)
  751. (* generic *)
  752. PROCEDURE & InitTicketGenerator*(diagnostics: Diagnostics.Diagnostics; optimize: BOOLEAN; numberRegisterParts: LONGINT; physicalRegisters: PhysicalRegisters);
  753. BEGIN
  754. InitGenerator(diagnostics, optimize);
  755. NEW(tickets);
  756. NEW(virtualRegisters,numberRegisterParts);
  757. NEW(spillStack);
  758. SELF.physicalRegisters := physicalRegisters;
  759. END InitTicketGenerator;
  760. PROCEDURE Section*(in: IntermediateCode.Section; out: BinaryCode.Section);
  761. VAR ticket: Ticket;
  762. BEGIN
  763. virtualRegisters.Init(virtualRegisters.parts);
  764. Section^(in,out);
  765. END Section;
  766. (*------------------- procedures that must be overwritten by implementers ----------------------*)
  767. (* input: type (such as that of an intermediate operand), output: type part *)
  768. PROCEDURE GetPartType*(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
  769. BEGIN HALT(100); (* abstract *)
  770. END GetPartType;
  771. PROCEDURE ToSpillStack*(ticket: Ticket);
  772. BEGIN HALT(100) (* abstract *)
  773. END ToSpillStack;
  774. PROCEDURE AllocateSpillStack*(size: LONGINT);
  775. BEGIN HALT(100) (* abstract *)
  776. END AllocateSpillStack;
  777. PROCEDURE ToRegister*(ticket: Ticket);
  778. BEGIN HALT(100) (* abstract *)
  779. END ToRegister;
  780. PROCEDURE ExchangeTickets*(ticket1,ticket2: Ticket);
  781. BEGIN HALT(100) (* abstract *)
  782. END ExchangeTickets;
  783. PROCEDURE ParameterRegister*(CONST type: IntermediateCode.Type; number: LONGINT): LONGINT;
  784. BEGIN HALT(100) (* abstract *)
  785. END ParameterRegister;
  786. (*---------------------------- ticket handling and register allocation ----------------------------*)
  787. (* Spill register of a ticket, if any *)
  788. PROCEDURE Spill*(ticket: Ticket);
  789. VAR register,offset,size: LONGINT;
  790. BEGIN
  791. IF (ticket = NIL) OR ~ticket.spillable OR ticket.spilled THEN RETURN END;
  792. register := ticket.register;
  793. offset := spillStack.NextFree();
  794. ticket.offset := offset;
  795. size := spillStack.Size();
  796. IF dump# NIL THEN dump.String("spillstack allocate (1) "); dump.Int(offset,1); dump.Ln; END;
  797. spillStack.Allocate(offset,ticket);
  798. size := spillStack.Size()-size;
  799. ASSERT(size>=0);
  800. IF size>0 THEN AllocateSpillStack(size) END;
  801. ToSpillStack(ticket);
  802. ticket.offset := offset;
  803. physicalRegisters.Free(register);
  804. ticket.spilled := TRUE;
  805. END Spill;
  806. (* Make sure a ticket reprents a physical register *)
  807. PROCEDURE UnSpill*(ticket: Ticket);
  808. VAR mapped:Ticket; register: LONGINT;
  809. PROCEDURE ExchangeSpill(ticket1, ticket2: Ticket): BOOLEAN;
  810. BEGIN
  811. IF ticket1.spilled THEN ASSERT(~ticket2.spilled); RETURN ExchangeSpill(ticket2,ticket1) END;
  812. IF (ticket1.type.sizeInBits # ticket2.type.sizeInBits)
  813. OR ~(ticket1.type.form IN IntermediateCode.Integer) OR ~(ticket2.type.form IN IntermediateCode.Integer)
  814. OR ticket1.spilled THEN
  815. RETURN FALSE
  816. END;
  817. ASSERT(~ticket1.spilled); ASSERT(ticket1.register # None);
  818. ASSERT(ticket2.spilled); ASSERT((ticket2.register = ticket1.register) OR (ticket2.register = None));
  819. ExchangeTickets(ticket1,ticket2);
  820. physicalRegisters.Free(ticket1.register);
  821. spillStack.Free(ticket2.offset);
  822. ticket2.register := ticket1.register;
  823. ticket1.offset := ticket2.offset;
  824. ticket1.spilled := TRUE;
  825. ticket2.spilled := FALSE;
  826. physicalRegisters.Allocate(ticket2.register,ticket2);
  827. IF dump# NIL THEN dump.String("spillstack allocate (2) "); dump.Int(ticket1.offset,1); dump.Ln; END;
  828. spillStack.Allocate(ticket1.offset,ticket1);
  829. RETURN TRUE
  830. END ExchangeSpill;
  831. PROCEDURE SpillToRegister(ticket: Ticket; register: LONGINT);
  832. VAR size: LONGINT;
  833. BEGIN
  834. ASSERT(~physicalRegisters.Reserved(ticket.register) OR (register = ticket.register));
  835. ticket.register := register;
  836. IF dump # NIL THEN
  837. dump.String(" allocate register : index="); dump.Int(ticket.register,1); dump.Ln;
  838. END;
  839. ToRegister(ticket);
  840. size := spillStack.Size();
  841. spillStack.Free(ticket.offset);
  842. ticket.spilled := FALSE;
  843. ticket.offset := 0;
  844. physicalRegisters.Allocate(register,ticket);
  845. size := spillStack.Size()-size;
  846. ASSERT(size<=0);
  847. IF size<0 THEN AllocateSpillStack(size) END;
  848. END SpillToRegister;
  849. BEGIN
  850. IF (ticket = NIL) OR ~ticket.spilled THEN RETURN END;
  851. register := ticket.register;
  852. IF register = None THEN
  853. register := physicalRegisters.NextFree(ticket.type);
  854. IF register # None THEN (* free register found rightaway*)
  855. SpillToRegister(ticket, register)
  856. ELSE
  857. mapped := GetPreferredSpill(ticket.type);
  858. IF ~ExchangeSpill(mapped, ticket) THEN
  859. register := ForceFreeRegister(ticket.type);
  860. SpillToRegister(ticket, register);
  861. END;
  862. END;
  863. ELSE
  864. mapped := physicalRegisters.Mapped(register);
  865. IF mapped = NIL THEN
  866. SpillToRegister(ticket, register)
  867. ELSIF ~ExchangeSpill(mapped, ticket) THEN
  868. WHILE mapped # NIL DO
  869. Spill(mapped);
  870. mapped := physicalRegisters.Mapped(ticket.register);
  871. END;
  872. SpillToRegister(ticket, register)
  873. END;
  874. END;
  875. END UnSpill;
  876. PROCEDURE GetPreferredSpill*(CONST type: IntermediateCode.Type): Ticket;
  877. VAR ticket,spill: Ticket;
  878. PROCEDURE Spillable(ticket: Ticket; best:BOOLEAN): BOOLEAN;
  879. BEGIN
  880. RETURN
  881. ~ticket.spilled & ticket.spillable & (ticket.register # None)
  882. & ((ticket.type.form = IntermediateCode.Float) = (type.form = IntermediateCode.Float)) (* don't spill float when int is needed *)
  883. & (~best OR (ticket.type.sizeInBits = type.sizeInBits))
  884. & (~physicalRegisters.Reserved(ticket.register))
  885. (*! check that register is not in use in current instruction*)
  886. END Spillable;
  887. BEGIN
  888. ticket := tickets.live;
  889. WHILE ticket # NIL DO
  890. IF Spillable(ticket,TRUE) THEN spill := ticket END;
  891. ticket := ticket.next
  892. END;
  893. IF ticket = NIL THEN
  894. ticket := tickets.live;
  895. WHILE ticket # NIL DO
  896. IF Spillable(ticket,FALSE) THEN spill := ticket END;
  897. ticket := ticket.next
  898. END;
  899. END;
  900. ASSERT(spill # NIL);
  901. RETURN spill
  902. END GetPreferredSpill;
  903. PROCEDURE ForceFreeRegister*(CONST type:IntermediateCode.Type): LONGINT;
  904. VAR tempReg: LONGINT; ticket: Ticket;
  905. BEGIN
  906. tempReg := physicalRegisters.NextFree(type);
  907. WHILE tempReg = None DO
  908. ticket := GetPreferredSpill(type);
  909. Spill(ticket);
  910. tempReg := physicalRegisters.NextFree(type);
  911. END;
  912. RETURN tempReg
  913. END ForceFreeRegister;
  914. PROCEDURE ReservePhysicalRegister*(CONST class: IntermediateCode.RegisterClass; CONST type: IntermediateCode.Type; register: LONGINT; lastUse: LONGINT): Ticket;
  915. VAR ticket: Ticket;
  916. BEGIN
  917. ticket := tickets.Enter(class, type,register,TRUE, FALSE,None,lastUse);
  918. IF dump # NIL THEN
  919. dump.String(" allocate register : index="); dump.Int(register,1); dump.Ln;
  920. END;
  921. physicalRegisters.Allocate(register, ticket);
  922. RETURN ticket
  923. END ReservePhysicalRegister;
  924. PROCEDURE TemporaryTicket*(CONST class: IntermediateCode.RegisterClass; CONST type: IntermediateCode.Type): Ticket;
  925. VAR register: LONGINT; ticket: Ticket;
  926. BEGIN
  927. IF type.form > IntermediateCode.Undefined THEN
  928. register := ForceFreeRegister(type);
  929. ticket := ReservePhysicalRegister(class,type,register,inPC);
  930. ticket.parts := 1;
  931. ELSE
  932. ticket := NIL
  933. END;
  934. RETURN ticket
  935. END TemporaryTicket;
  936. (*------------------- register mapping ----------------------*)
  937. PROCEDURE MapVirtualRegister*(virtualRegister: LONGINT; class: IntermediateCode.RegisterClass; type: IntermediateCode.Type; part: LONGINT);
  938. VAR partType: IntermediateCode.Type; lastuse:LONGINT;
  939. PROCEDURE MapTicket(CONST type: IntermediateCode.Type; lastuse:LONGINT);
  940. VAR index,offset,size: LONGINT; ticket: Ticket;
  941. BEGIN
  942. index := physicalRegisters.NextFree(type);
  943. IF index # None THEN
  944. ticket := tickets.Enter(class,type,index,TRUE, FALSE,0,lastuse);
  945. IF dump # NIL THEN
  946. dump.String(" allocate register : index="); dump.Int(index,1); dump.Ln;
  947. END;
  948. physicalRegisters.Allocate(index,ticket);
  949. physicalRegisters.SetReserved(index,TRUE);
  950. ELSE (* spill new ticket rightaway, no phyiscal register assigned yet *)
  951. offset := spillStack.NextFree();
  952. ticket := tickets.Enter(class,type,index,TRUE, TRUE,offset,lastuse);
  953. size := spillStack.Size();
  954. ticket.offset := offset;
  955. IF dump# NIL THEN dump.String("spillstack allocate (3) "); dump.Int(offset,1);dump.Ln; END;
  956. spillStack.Allocate(offset,ticket);
  957. size := spillStack.Size()-size;
  958. ASSERT(size>=0);
  959. IF size>0 THEN AllocateSpillStack(size) END;
  960. END;
  961. virtualRegisters.SetMapped(virtualRegister,part,ticket);
  962. END MapTicket;
  963. PROCEDURE AllocateThis(index: LONGINT);
  964. VAR ticket: Ticket;
  965. BEGIN
  966. ticket := physicalRegisters.Mapped(index);
  967. IF ticket # NIL THEN Spill(ticket) END;
  968. ticket := tickets.Enter(class, type, index, TRUE, FALSE,0,lastuse);
  969. IF dump # NIL THEN
  970. dump.String(" allocate register : index="); dump.Int(index,1); dump.Ln;
  971. END;
  972. physicalRegisters.Allocate(index,ticket);
  973. physicalRegisters.SetReserved(index, TRUE);
  974. virtualRegisters.SetMapped(virtualRegister,part,ticket);
  975. END AllocateThis;
  976. BEGIN
  977. IF virtualRegisters.Mapped(virtualRegister,part)=NIL THEN
  978. lastuse := LastUse(virtualRegister);
  979. GetPartType(type,part,partType);
  980. IF partType.form # IntermediateCode.Undefined THEN
  981. IF class.class = IntermediateCode.Parameter THEN
  982. AllocateThis(ParameterRegister(partType, class.number));
  983. ELSE
  984. MapTicket(partType,lastuse)
  985. END;
  986. END;
  987. END;
  988. END MapVirtualRegister;
  989. PROCEDURE ResetTicket(ticket: Ticket);
  990. BEGIN
  991. ticket.offset := 0;
  992. ticket.spilled := FALSE;
  993. ticket.register := None;
  994. ticket.parts := 0;
  995. END ResetTicket;
  996. PROCEDURE FreeTicket(ticket: Ticket);
  997. VAR size: LONGINT;
  998. BEGIN
  999. IF ticket.spilled THEN
  1000. IF dump # NIL THEN
  1001. dump.String(" free spilled register : ofs="); dump.Int(ticket.offset,1); dump.Ln;
  1002. END;
  1003. size := spillStack.Size();
  1004. spillStack.Free(ticket.offset);
  1005. size := spillStack.Size()-size;
  1006. ASSERT(size<=0);
  1007. IF size<0 THEN AllocateSpillStack(size) END;
  1008. ELSIF ticket.register # None THEN
  1009. IF dump # NIL THEN
  1010. dump.String("free register: index="); dump.Int(ticket.register,1); dump.Ln;
  1011. END;
  1012. physicalRegisters.SetReserved(ticket.register,FALSE);
  1013. physicalRegisters.Free(ticket.register);
  1014. ASSERT(~physicalRegisters.Reserved(ticket.register));
  1015. END;
  1016. END FreeTicket;
  1017. PROCEDURE RemapTicket(ticket: Ticket);
  1018. VAR size: LONGINT;
  1019. BEGIN
  1020. IF ~ticket.spilled THEN
  1021. IF dump # NIL THEN
  1022. dump.String(" remap register : index="); dump.Int(ticket.register,1); dump.Ln;
  1023. END;
  1024. physicalRegisters.Allocate(ticket.register,ticket);
  1025. physicalRegisters.SetReserved(ticket.register,TRUE);
  1026. ELSE (* spill new ticket rightaway, no phyiscal register assigned yet *)
  1027. size := spillStack.Size();
  1028. IF dump# NIL THEN dump.String("spillstack allocate (4)"); dump.Int(ticket.offset,1); dump.Ln; END;
  1029. spillStack.Allocate(ticket.offset,ticket);
  1030. size := spillStack.Size()-size;
  1031. ASSERT(size>=0);
  1032. IF size>0 THEN AllocateSpillStack(size) END;
  1033. END;
  1034. END RemapTicket;
  1035. (* unmap ticket: free register or spill stack position and remove ticket from list of live tickets *)
  1036. PROCEDURE UnmapTicket*(ticket: Ticket);
  1037. BEGIN
  1038. IF ticket = NIL THEN RETURN END;
  1039. FreeTicket(ticket);
  1040. tickets.Remove(ticket);
  1041. ResetTicket(ticket);
  1042. END UnmapTicket;
  1043. PROCEDURE TryAllocate*(CONST operand: IntermediateCode.Operand; part: LONGINT);
  1044. BEGIN
  1045. IF (FirstUse(operand.register) = inPC) & (virtualRegisters.Mapped(operand.register,part)=NIL) THEN
  1046. IF operand.mode = IntermediateCode.ModeMemory THEN
  1047. MapVirtualRegister(operand.register,operand.registerClass,IntermediateCode.GetType(module.system,module.system.addressType),part);
  1048. ELSE
  1049. MapVirtualRegister(operand.register,operand.registerClass, operand.type,part);
  1050. END;
  1051. ASSERT(virtualRegisters.Mapped(operand.register,part)#NIL);
  1052. END;
  1053. END TryAllocate;
  1054. PROCEDURE TryUnmap*(CONST operand: IntermediateCode.Operand);
  1055. VAR ticket: Ticket; part,i: LONGINT;
  1056. BEGIN
  1057. IF (operand.register >=0) & (LastUse(operand.register) = inPC) THEN
  1058. part := 0;
  1059. WHILE (part<virtualRegisters.Parts()) DO
  1060. ticket := virtualRegisters.Mapped(operand.register,part);
  1061. IF (ticket # NIL) THEN
  1062. virtualRegisters.Unmap(operand.register)
  1063. END;
  1064. INC(part);
  1065. END;
  1066. END;
  1067. IF operand.rule # NIL THEN
  1068. FOR i := 0 TO LEN(operand.rule)-1 DO
  1069. TryUnmap(operand.rule[i]);
  1070. END
  1071. END
  1072. END TryUnmap;
  1073. PROCEDURE ReleaseHint*(register: LONGINT);
  1074. VAR ticket: Ticket;
  1075. BEGIN
  1076. IF register >=0 THEN
  1077. ticket := physicalRegisters.Mapped(register);
  1078. IF (ticket # NIL) & (ticket.lastuse <= inPC) THEN
  1079. DEC(ticket.parts); (* to avoid freeing a register that is used at several parts of an operand *)
  1080. IF ticket.parts=0 THEN
  1081. physicalRegisters.SetReserved(register,FALSE);
  1082. UnmapTicket(ticket);
  1083. physicalRegisters.AllocationHint(register);
  1084. END;
  1085. END;
  1086. END;
  1087. END ReleaseHint;
  1088. (* increase usage counter of register mapped by ticket - allocated or not *)
  1089. PROCEDURE ReserveTicketRegister*(ticket: Ticket; reserved: BOOLEAN);
  1090. BEGIN
  1091. IF (ticket#NIL) & (ticket.register # None) THEN
  1092. physicalRegisters.SetReserved(ticket.register,reserved)
  1093. END;
  1094. END ReserveTicketRegister;
  1095. PROCEDURE ReserveOperandRegisters*(CONST operand: IntermediateCode.Operand; reserved: BOOLEAN);
  1096. VAR i: LONGINT; ticket: Ticket;
  1097. BEGIN
  1098. FOR i := 0 TO virtualRegisters.Parts()-1 DO
  1099. ticket := virtualRegisters.Mapped(operand.register,i);
  1100. IF ticket # NIL THEN
  1101. ReserveTicketRegister(ticket,reserved);
  1102. IF operand.mode = IntermediateCode.ModeMemory THEN
  1103. ticket.parts := virtualRegisters.Parts()
  1104. ELSE
  1105. ticket.parts := 1
  1106. END;
  1107. END;
  1108. END;
  1109. END ReserveOperandRegisters;
  1110. END GeneratorWithTickets;
  1111. PROCEDURE Assert(cond: BOOLEAN; CONST reason: ARRAY OF CHAR);
  1112. BEGIN ASSERT(cond);
  1113. END Assert;
  1114. PROCEDURE DumpTicket*(w: Streams.Writer; ticket: Ticket);
  1115. BEGIN
  1116. w.String("register "); w.Int(ticket.register,1);
  1117. w.String(" with type ");
  1118. IntermediateCode.DumpType(w,ticket.type);
  1119. IF ticket.spilled THEN w.String(" spilled at "); w.Int(ticket.offset,1) END;
  1120. w.String(" parts "); w.Int(ticket.parts,1);
  1121. w.String(" last use "); w.Int(ticket.lastuse,1);
  1122. END DumpTicket;
  1123. END FoxCodeGenerators.