FoxCodeGenerators.Mod 41 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284
  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: LONGINT; CONST message: ARRAY OF CHAR);
  117. VAR string:Basic.MessageString;
  118. BEGIN
  119. IF diagnostics # NIL THEN
  120. Basic.SegmentedNameToString(in.name, string);
  121. diagnostics.Error(string, position, Diagnostics.Invalid, 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(inPC,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. IF pc = in.validPAFEnter THEN out.EnterValidPAF END;
  411. IF pc = in.validPAFExit THEN out.ExitValidPAF END;
  412. instruction := in.instructions[pc];
  413. SetLiveness(instruction);
  414. IF dump # NIL THEN DumpInstruction(instruction); dump.Ln END;
  415. CASE instruction.opcode OF
  416. IntermediateCode.data: EmitData(instruction);
  417. |IntermediateCode.reserve: EmitReserve(instruction);
  418. |IntermediateCode.label: EmitLabel(instruction);
  419. ELSE
  420. IF Supported(instruction, moduleName, procedureName) THEN
  421. Generate(instruction);
  422. PostGenerate(instruction);
  423. ELSE
  424. Emulate(instruction, moduleName, procedureName);
  425. PostGenerate(instruction);
  426. END
  427. END;
  428. END;
  429. (*CheckRegistersFree();*)
  430. ResolveLocalFixups;
  431. END Section;
  432. PROCEDURE FirstUse*(virtualRegister: LONGINT): LONGINT;
  433. BEGIN
  434. IF (virtualRegister > 0) THEN RETURN allocation.table[virtualRegister].first ELSE RETURN None END;
  435. END FirstUse;
  436. PROCEDURE LastUse*(virtualRegister: LONGINT): LONGINT;
  437. BEGIN
  438. IF (virtualRegister > 0) THEN RETURN allocation.table[virtualRegister].last ELSE RETURN None END;
  439. END LastUse;
  440. (*------------------- procedures that must be overwritten by implementers ----------------------*)
  441. (* supported instruction - provision for instruction emulation *)
  442. PROCEDURE Supported*(CONST instr: IntermediateCode.Instruction; VAR moduleName,procedureName: ARRAY OF CHAR): BOOLEAN;
  443. BEGIN
  444. moduleName := ""; procedureName := "";
  445. RETURN TRUE
  446. END Supported;
  447. (* generate procedure - is called for any instruction that cannot be output directly by the generic code generator *)
  448. PROCEDURE Generate*(VAR instr: IntermediateCode.Instruction);
  449. BEGIN (*HALT(100); *) (* abstract *)
  450. END Generate;
  451. PROCEDURE PostGenerate*(CONST instr: IntermediateCode.Instruction);
  452. BEGIN
  453. END PostGenerate;
  454. (* ---------------------- generically available code emission ------------------------- *)
  455. PROCEDURE GetDataSection*(): IntermediateCode.Section;
  456. VAR name: Basic.SegmentedName; section: IntermediateCode.Section;
  457. BEGIN
  458. Global.GetModuleSegmentedName(module.module, name);
  459. Basic.SuffixSegmentedName(name,Basic.MakeString("@Immediates"));
  460. section := IntermediateCode.NewSection(module.allSections, Sections.ConstSection, name,NIL,TRUE);
  461. RETURN section
  462. END GetDataSection;
  463. PROCEDURE EmitData(CONST instruction: IntermediateCode.Instruction);
  464. VAR type: IntermediateCode.Type; fixup: BinaryCode.Fixup; pc: LONGINT;fixupFormat: BinaryCode.FixupPatterns;
  465. BEGIN
  466. type := instruction.op1.type;
  467. pc := out.pc;
  468. IF type.form IN IntermediateCode.Integer THEN
  469. out.PutBytes(instruction.op1.intValue,SHORT(type.sizeInBits DIV 8));
  470. ELSE
  471. IF type.sizeInBits = IntermediateCode.Bits32 THEN
  472. out.PutReal(SHORT(instruction.op1.floatValue));
  473. ELSIF type.sizeInBits = IntermediateCode.Bits64 THEN
  474. out.PutLongreal(instruction.op1.floatValue);
  475. ELSE Assert(FALSE,"no floats other than 32 or 64 bit")
  476. END;
  477. END;
  478. IF instruction.op1.symbol.name # "" THEN
  479. NEW(fixupFormat,1);
  480. fixupFormat[0].offset := 0;
  481. fixupFormat[0].bits := type.sizeInBits;
  482. fixup := BinaryCode.NewFixup(BinaryCode.Absolute,pc,instruction.op1.symbol,instruction.op1.symbolOffset,instruction.op1.offset,0,fixupFormat);
  483. out.fixupList.AddFixup(fixup);
  484. END;
  485. END EmitData;
  486. PROCEDURE EmitReserve(CONST instruction: IntermediateCode.Instruction);
  487. VAR sizeInUnits,i: LONGINT;
  488. BEGIN
  489. sizeInUnits := SHORT(instruction.op1.intValue);
  490. ASSERT(sizeInUnits >= 0); (* size is initialized to MIN(LONGINT), this checks if size field has been visited *)
  491. FOR i := 0 TO sizeInUnits-1 DO
  492. out.PutBits(0,out.os.unit);
  493. END;
  494. END EmitReserve;
  495. PROCEDURE EmitLabel(CONST instruction: IntermediateCode.Instruction);
  496. VAR position: LONGINT;
  497. BEGIN
  498. position := SHORT(instruction.op1.intValue);
  499. out.AddLabel(position);
  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. PROCEDURE ParameterRegister*(CONST type: IntermediateCode.Type; number: LONGINT): LONGINT;
  788. BEGIN HALT(100) (* abstract *)
  789. END ParameterRegister;
  790. (*---------------------------- ticket handling and register allocation ----------------------------*)
  791. (* Spill register of a ticket, if any *)
  792. PROCEDURE Spill*(ticket: Ticket);
  793. VAR register,offset,size: LONGINT;
  794. BEGIN
  795. IF (ticket = NIL) OR ~ticket.spillable OR ticket.spilled THEN RETURN END;
  796. register := ticket.register;
  797. offset := spillStack.NextFree();
  798. ticket.offset := offset;
  799. size := spillStack.Size();
  800. IF dump# NIL THEN dump.String("spillstack allocate (1) "); dump.Int(offset,1); dump.Ln; END;
  801. spillStack.Allocate(offset,ticket);
  802. size := spillStack.Size()-size;
  803. ASSERT(size>=0);
  804. IF size>0 THEN AllocateSpillStack(size) END;
  805. ToSpillStack(ticket);
  806. ticket.offset := offset;
  807. physicalRegisters.Free(register);
  808. ticket.spilled := TRUE;
  809. END Spill;
  810. (* Make sure a ticket reprents a physical register *)
  811. PROCEDURE UnSpill*(ticket: Ticket);
  812. VAR mapped:Ticket; register: LONGINT;
  813. PROCEDURE ExchangeSpill(ticket1, ticket2: Ticket): BOOLEAN;
  814. BEGIN
  815. IF ticket1.spilled THEN ASSERT(~ticket2.spilled); RETURN ExchangeSpill(ticket2,ticket1) END;
  816. IF (ticket1.type.sizeInBits # ticket2.type.sizeInBits)
  817. OR ~(ticket1.type.form IN IntermediateCode.Integer) OR ~(ticket2.type.form IN IntermediateCode.Integer)
  818. OR ticket1.spilled THEN
  819. RETURN FALSE
  820. END;
  821. ASSERT(~ticket1.spilled); ASSERT(ticket1.register # None);
  822. ASSERT(ticket2.spilled); ASSERT((ticket2.register = ticket1.register) OR (ticket2.register = None));
  823. ExchangeTickets(ticket1,ticket2);
  824. physicalRegisters.Free(ticket1.register);
  825. spillStack.Free(ticket2.offset);
  826. ticket2.register := ticket1.register;
  827. ticket1.offset := ticket2.offset;
  828. ticket1.spilled := TRUE;
  829. ticket2.spilled := FALSE;
  830. physicalRegisters.Allocate(ticket2.register,ticket2);
  831. IF dump# NIL THEN dump.String("spillstack allocate (2) "); dump.Int(ticket1.offset,1); dump.Ln; END;
  832. spillStack.Allocate(ticket1.offset,ticket1);
  833. RETURN TRUE
  834. END ExchangeSpill;
  835. PROCEDURE SpillToRegister(ticket: Ticket; register: LONGINT);
  836. VAR size: LONGINT;
  837. BEGIN
  838. ASSERT(~physicalRegisters.Reserved(ticket.register) OR (register = ticket.register));
  839. ticket.register := register;
  840. IF dump # NIL THEN
  841. dump.String(" allocate register : index="); dump.Int(ticket.register,1); dump.Ln;
  842. END;
  843. ToRegister(ticket);
  844. size := spillStack.Size();
  845. spillStack.Free(ticket.offset);
  846. ticket.spilled := FALSE;
  847. ticket.offset := 0;
  848. physicalRegisters.Allocate(register,ticket);
  849. size := spillStack.Size()-size;
  850. ASSERT(size<=0);
  851. IF size<0 THEN AllocateSpillStack(size) END;
  852. END SpillToRegister;
  853. BEGIN
  854. IF (ticket = NIL) OR ~ticket.spilled THEN RETURN END;
  855. register := ticket.register;
  856. IF register = None THEN
  857. register := physicalRegisters.NextFree(ticket.type);
  858. IF register # None THEN (* free register found rightaway*)
  859. SpillToRegister(ticket, register)
  860. ELSE
  861. mapped := GetPreferredSpill(ticket.type);
  862. IF ~ExchangeSpill(mapped, ticket) THEN
  863. register := ForceFreeRegister(ticket.type);
  864. SpillToRegister(ticket, register);
  865. END;
  866. END;
  867. ELSE
  868. mapped := physicalRegisters.Mapped(register);
  869. IF mapped = NIL THEN
  870. SpillToRegister(ticket, register)
  871. ELSIF ~ExchangeSpill(mapped, ticket) THEN
  872. WHILE mapped # NIL DO
  873. Spill(mapped);
  874. mapped := physicalRegisters.Mapped(ticket.register);
  875. END;
  876. SpillToRegister(ticket, register)
  877. END;
  878. END;
  879. END UnSpill;
  880. PROCEDURE GetPreferredSpill*(CONST type: IntermediateCode.Type): Ticket;
  881. VAR ticket,spill: Ticket;
  882. PROCEDURE Spillable(ticket: Ticket; best:BOOLEAN): BOOLEAN;
  883. BEGIN
  884. RETURN
  885. ~ticket.spilled & ticket.spillable & (ticket.register # None)
  886. & ((ticket.type.form = IntermediateCode.Float) = (type.form = IntermediateCode.Float)) (* don't spill float when int is needed *)
  887. & (~best OR (ticket.type.sizeInBits = type.sizeInBits))
  888. & (~physicalRegisters.Reserved(ticket.register))
  889. (*! check that register is not in use in current instruction*)
  890. END Spillable;
  891. BEGIN
  892. ticket := tickets.live;
  893. WHILE ticket # NIL DO
  894. IF Spillable(ticket,TRUE) THEN spill := ticket END;
  895. ticket := ticket.next
  896. END;
  897. IF ticket = NIL THEN
  898. ticket := tickets.live;
  899. WHILE ticket # NIL DO
  900. IF Spillable(ticket,FALSE) THEN spill := ticket END;
  901. ticket := ticket.next
  902. END;
  903. END;
  904. ASSERT(spill # NIL);
  905. RETURN spill
  906. END GetPreferredSpill;
  907. PROCEDURE ForceFreeRegister*(CONST type:IntermediateCode.Type): LONGINT;
  908. VAR tempReg: LONGINT; ticket: Ticket;
  909. BEGIN
  910. tempReg := physicalRegisters.NextFree(type);
  911. WHILE tempReg = None DO
  912. ticket := GetPreferredSpill(type);
  913. Spill(ticket);
  914. tempReg := physicalRegisters.NextFree(type);
  915. END;
  916. RETURN tempReg
  917. END ForceFreeRegister;
  918. PROCEDURE ReservePhysicalRegister*(CONST class: IntermediateCode.RegisterClass; CONST type: IntermediateCode.Type; register: LONGINT; lastUse: LONGINT): Ticket;
  919. VAR ticket: Ticket;
  920. BEGIN
  921. ticket := tickets.Enter(class, type,register,TRUE, FALSE,None,lastUse);
  922. IF dump # NIL THEN
  923. dump.String(" allocate register : index="); dump.Int(register,1); dump.Ln;
  924. END;
  925. physicalRegisters.Allocate(register, ticket);
  926. RETURN ticket
  927. END ReservePhysicalRegister;
  928. PROCEDURE TemporaryTicket*(CONST class: IntermediateCode.RegisterClass; CONST type: IntermediateCode.Type): Ticket;
  929. VAR register: LONGINT; ticket: Ticket;
  930. BEGIN
  931. IF type.form > IntermediateCode.Undefined THEN
  932. register := ForceFreeRegister(type);
  933. ticket := ReservePhysicalRegister(class,type,register,inPC);
  934. ticket.parts := 1;
  935. ELSE
  936. ticket := NIL
  937. END;
  938. RETURN ticket
  939. END TemporaryTicket;
  940. (*------------------- register mapping ----------------------*)
  941. PROCEDURE MapVirtualRegister*(virtualRegister: LONGINT; class: IntermediateCode.RegisterClass; type: IntermediateCode.Type; part: LONGINT);
  942. VAR partType: IntermediateCode.Type; lastuse:LONGINT;
  943. PROCEDURE MapTicket(CONST type: IntermediateCode.Type; lastuse:LONGINT);
  944. VAR index,offset,size: LONGINT; ticket: Ticket;
  945. BEGIN
  946. index := physicalRegisters.NextFree(type);
  947. IF index # None THEN
  948. ticket := tickets.Enter(class,type,index,TRUE, FALSE,0,lastuse);
  949. IF dump # NIL THEN
  950. dump.String(" allocate register : index="); dump.Int(index,1); dump.Ln;
  951. END;
  952. physicalRegisters.Allocate(index,ticket);
  953. physicalRegisters.SetReserved(index,TRUE);
  954. ELSE (* spill new ticket rightaway, no phyiscal register assigned yet *)
  955. offset := spillStack.NextFree();
  956. ticket := tickets.Enter(class,type,index,TRUE, TRUE,offset,lastuse);
  957. size := spillStack.Size();
  958. ticket.offset := offset;
  959. IF dump# NIL THEN dump.String("spillstack allocate (3) "); dump.Int(offset,1);dump.Ln; END;
  960. spillStack.Allocate(offset,ticket);
  961. size := spillStack.Size()-size;
  962. ASSERT(size>=0);
  963. IF size>0 THEN AllocateSpillStack(size) END;
  964. END;
  965. virtualRegisters.SetMapped(virtualRegister,part,ticket);
  966. END MapTicket;
  967. PROCEDURE AllocateThis(index: LONGINT);
  968. VAR ticket: Ticket;
  969. BEGIN
  970. ticket := physicalRegisters.Mapped(index);
  971. IF ticket # NIL THEN Spill(ticket) END;
  972. ticket := tickets.Enter(class, type, index, TRUE, FALSE,0,lastuse);
  973. IF dump # NIL THEN
  974. dump.String(" allocate register : index="); dump.Int(index,1); dump.Ln;
  975. END;
  976. physicalRegisters.Allocate(index,ticket);
  977. physicalRegisters.SetReserved(index, TRUE);
  978. virtualRegisters.SetMapped(virtualRegister,part,ticket);
  979. END AllocateThis;
  980. BEGIN
  981. IF virtualRegisters.Mapped(virtualRegister,part)=NIL THEN
  982. lastuse := LastUse(virtualRegister);
  983. GetPartType(type,part,partType);
  984. IF partType.form # IntermediateCode.Undefined THEN
  985. IF class.class = IntermediateCode.Parameter THEN
  986. AllocateThis(ParameterRegister(partType, class.number));
  987. ELSE
  988. MapTicket(partType,lastuse)
  989. END;
  990. END;
  991. END;
  992. END MapVirtualRegister;
  993. PROCEDURE ResetTicket(ticket: Ticket);
  994. BEGIN
  995. ticket.offset := 0;
  996. ticket.spilled := FALSE;
  997. ticket.register := None;
  998. ticket.parts := 0;
  999. END ResetTicket;
  1000. PROCEDURE FreeTicket(ticket: Ticket);
  1001. VAR size: LONGINT;
  1002. BEGIN
  1003. IF ticket.spilled THEN
  1004. IF dump # NIL THEN
  1005. dump.String(" free spilled register : ofs="); dump.Int(ticket.offset,1); dump.Ln;
  1006. END;
  1007. size := spillStack.Size();
  1008. spillStack.Free(ticket.offset);
  1009. size := spillStack.Size()-size;
  1010. ASSERT(size<=0);
  1011. IF size<0 THEN AllocateSpillStack(size) END;
  1012. ELSIF ticket.register # None THEN
  1013. IF dump # NIL THEN
  1014. dump.String("free register: index="); dump.Int(ticket.register,1); dump.Ln;
  1015. END;
  1016. physicalRegisters.SetReserved(ticket.register,FALSE);
  1017. physicalRegisters.Free(ticket.register);
  1018. ASSERT(~physicalRegisters.Reserved(ticket.register));
  1019. END;
  1020. END FreeTicket;
  1021. PROCEDURE RemapTicket(ticket: Ticket);
  1022. VAR size: LONGINT;
  1023. BEGIN
  1024. IF ~ticket.spilled THEN
  1025. IF dump # NIL THEN
  1026. dump.String(" remap register : index="); dump.Int(ticket.register,1); dump.Ln;
  1027. END;
  1028. physicalRegisters.Allocate(ticket.register,ticket);
  1029. physicalRegisters.SetReserved(ticket.register,TRUE);
  1030. ELSE (* spill new ticket rightaway, no phyiscal register assigned yet *)
  1031. size := spillStack.Size();
  1032. IF dump# NIL THEN dump.String("spillstack allocate (4)"); dump.Int(ticket.offset,1); dump.Ln; END;
  1033. spillStack.Allocate(ticket.offset,ticket);
  1034. size := spillStack.Size()-size;
  1035. ASSERT(size>=0);
  1036. IF size>0 THEN AllocateSpillStack(size) END;
  1037. END;
  1038. END RemapTicket;
  1039. (* unmap ticket: free register or spill stack position and remove ticket from list of live tickets *)
  1040. PROCEDURE UnmapTicket*(ticket: Ticket);
  1041. BEGIN
  1042. IF ticket = NIL THEN RETURN END;
  1043. FreeTicket(ticket);
  1044. tickets.Remove(ticket);
  1045. ResetTicket(ticket);
  1046. END UnmapTicket;
  1047. PROCEDURE TryAllocate*(CONST operand: IntermediateCode.Operand; part: LONGINT);
  1048. BEGIN
  1049. IF (FirstUse(operand.register) = inPC) & (virtualRegisters.Mapped(operand.register,part)=NIL) THEN
  1050. IF operand.mode = IntermediateCode.ModeMemory THEN
  1051. MapVirtualRegister(operand.register,operand.registerClass,IntermediateCode.GetType(module.system,module.system.addressType),part);
  1052. ELSE
  1053. MapVirtualRegister(operand.register,operand.registerClass, operand.type,part);
  1054. END;
  1055. ASSERT(virtualRegisters.Mapped(operand.register,part)#NIL);
  1056. END;
  1057. END TryAllocate;
  1058. PROCEDURE TryUnmap*(CONST operand: IntermediateCode.Operand);
  1059. VAR ticket: Ticket; part,i: LONGINT;
  1060. BEGIN
  1061. IF (operand.register >=0) & (LastUse(operand.register) = inPC) THEN
  1062. part := 0;
  1063. WHILE (part<virtualRegisters.Parts()) DO
  1064. ticket := virtualRegisters.Mapped(operand.register,part);
  1065. IF (ticket # NIL) THEN
  1066. virtualRegisters.Unmap(operand.register)
  1067. END;
  1068. INC(part);
  1069. END;
  1070. END;
  1071. IF operand.rule # NIL THEN
  1072. FOR i := 0 TO LEN(operand.rule)-1 DO
  1073. TryUnmap(operand.rule[i]);
  1074. END
  1075. END
  1076. END TryUnmap;
  1077. PROCEDURE ReleaseHint*(register: LONGINT);
  1078. VAR ticket: Ticket;
  1079. BEGIN
  1080. IF register >=0 THEN
  1081. ticket := physicalRegisters.Mapped(register);
  1082. IF (ticket # NIL) & (ticket.lastuse <= inPC) THEN
  1083. DEC(ticket.parts); (* to avoid freeing a register that is used at several parts of an operand *)
  1084. IF ticket.parts=0 THEN
  1085. physicalRegisters.SetReserved(register,FALSE);
  1086. UnmapTicket(ticket);
  1087. physicalRegisters.AllocationHint(register);
  1088. END;
  1089. END;
  1090. END;
  1091. END ReleaseHint;
  1092. (* increase usage counter of register mapped by ticket - allocated or not *)
  1093. PROCEDURE ReserveTicketRegister*(ticket: Ticket; reserved: BOOLEAN);
  1094. BEGIN
  1095. IF (ticket#NIL) & (ticket.register # None) THEN
  1096. physicalRegisters.SetReserved(ticket.register,reserved)
  1097. END;
  1098. END ReserveTicketRegister;
  1099. PROCEDURE ReserveOperandRegisters*(CONST operand: IntermediateCode.Operand; reserved: BOOLEAN);
  1100. VAR i: LONGINT; ticket: Ticket;
  1101. BEGIN
  1102. FOR i := 0 TO virtualRegisters.Parts()-1 DO
  1103. ticket := virtualRegisters.Mapped(operand.register,i);
  1104. IF ticket # NIL THEN
  1105. ReserveTicketRegister(ticket,reserved);
  1106. IF operand.mode = IntermediateCode.ModeMemory THEN
  1107. ticket.parts := virtualRegisters.Parts()
  1108. ELSE
  1109. ticket.parts := 1
  1110. END;
  1111. END;
  1112. END;
  1113. END ReserveOperandRegisters;
  1114. END GeneratorWithTickets;
  1115. PROCEDURE Assert(cond: BOOLEAN; CONST reason: ARRAY OF CHAR);
  1116. BEGIN ASSERT(cond);
  1117. END Assert;
  1118. PROCEDURE DumpTicket*(w: Streams.Writer; ticket: Ticket);
  1119. BEGIN
  1120. w.String("register "); w.Int(ticket.register,1);
  1121. w.String(" with type ");
  1122. IntermediateCode.DumpType(w,ticket.type);
  1123. IF ticket.spilled THEN w.String(" spilled at "); w.Int(ticket.offset,1) END;
  1124. w.String(" parts "); w.Int(ticket.parts,1);
  1125. w.String(" last use "); w.Int(ticket.lastuse,1);
  1126. END DumpTicket;
  1127. END FoxCodeGenerators.