FoxCodeGenerators.Mod 41 KB

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