10b57cec5SDimitry Andric //===- OcamlGCPrinter.cpp - Ocaml frametable emitter ----------------------===//
20b57cec5SDimitry Andric //
30b57cec5SDimitry Andric // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
40b57cec5SDimitry Andric // See https://llvm.org/LICENSE.txt for license information.
50b57cec5SDimitry Andric // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
60b57cec5SDimitry Andric //
70b57cec5SDimitry Andric //===----------------------------------------------------------------------===//
80b57cec5SDimitry Andric //
90b57cec5SDimitry Andric // This file implements printing the assembly code for an Ocaml frametable.
100b57cec5SDimitry Andric //
110b57cec5SDimitry Andric //===----------------------------------------------------------------------===//
120b57cec5SDimitry Andric 
130b57cec5SDimitry Andric #include "llvm/ADT/STLExtras.h"
140b57cec5SDimitry Andric #include "llvm/ADT/SmallString.h"
150b57cec5SDimitry Andric #include "llvm/ADT/Twine.h"
160b57cec5SDimitry Andric #include "llvm/CodeGen/AsmPrinter.h"
170b57cec5SDimitry Andric #include "llvm/CodeGen/GCMetadata.h"
180b57cec5SDimitry Andric #include "llvm/CodeGen/GCMetadataPrinter.h"
19fe6060f1SDimitry Andric #include "llvm/IR/BuiltinGCs.h"
200b57cec5SDimitry Andric #include "llvm/IR/DataLayout.h"
210b57cec5SDimitry Andric #include "llvm/IR/Function.h"
220b57cec5SDimitry Andric #include "llvm/IR/Mangler.h"
230b57cec5SDimitry Andric #include "llvm/IR/Module.h"
240b57cec5SDimitry Andric #include "llvm/MC/MCContext.h"
250b57cec5SDimitry Andric #include "llvm/MC/MCDirectives.h"
260b57cec5SDimitry Andric #include "llvm/MC/MCStreamer.h"
270b57cec5SDimitry Andric #include "llvm/Support/ErrorHandling.h"
280b57cec5SDimitry Andric #include "llvm/Target/TargetLoweringObjectFile.h"
290b57cec5SDimitry Andric #include <cctype>
300b57cec5SDimitry Andric #include <cstddef>
310b57cec5SDimitry Andric #include <cstdint>
320b57cec5SDimitry Andric #include <string>
330b57cec5SDimitry Andric 
340b57cec5SDimitry Andric using namespace llvm;
350b57cec5SDimitry Andric 
360b57cec5SDimitry Andric namespace {
370b57cec5SDimitry Andric 
380b57cec5SDimitry Andric class OcamlGCMetadataPrinter : public GCMetadataPrinter {
390b57cec5SDimitry Andric public:
400b57cec5SDimitry Andric   void beginAssembly(Module &M, GCModuleInfo &Info, AsmPrinter &AP) override;
410b57cec5SDimitry Andric   void finishAssembly(Module &M, GCModuleInfo &Info, AsmPrinter &AP) override;
420b57cec5SDimitry Andric };
430b57cec5SDimitry Andric 
440b57cec5SDimitry Andric } // end anonymous namespace
450b57cec5SDimitry Andric 
460b57cec5SDimitry Andric static GCMetadataPrinterRegistry::Add<OcamlGCMetadataPrinter>
470b57cec5SDimitry Andric     Y("ocaml", "ocaml 3.10-compatible collector");
480b57cec5SDimitry Andric 
linkOcamlGCPrinter()490b57cec5SDimitry Andric void llvm::linkOcamlGCPrinter() {}
500b57cec5SDimitry Andric 
EmitCamlGlobal(const Module & M,AsmPrinter & AP,const char * Id)510b57cec5SDimitry Andric static void EmitCamlGlobal(const Module &M, AsmPrinter &AP, const char *Id) {
520b57cec5SDimitry Andric   const std::string &MId = M.getModuleIdentifier();
530b57cec5SDimitry Andric 
540b57cec5SDimitry Andric   std::string SymName;
550b57cec5SDimitry Andric   SymName += "caml";
560b57cec5SDimitry Andric   size_t Letter = SymName.size();
570b57cec5SDimitry Andric   SymName.append(MId.begin(), llvm::find(MId, '.'));
580b57cec5SDimitry Andric   SymName += "__";
590b57cec5SDimitry Andric   SymName += Id;
600b57cec5SDimitry Andric 
610b57cec5SDimitry Andric   // Capitalize the first letter of the module name.
620b57cec5SDimitry Andric   SymName[Letter] = toupper(SymName[Letter]);
630b57cec5SDimitry Andric 
640b57cec5SDimitry Andric   SmallString<128> TmpStr;
650b57cec5SDimitry Andric   Mangler::getNameWithPrefix(TmpStr, SymName, M.getDataLayout());
660b57cec5SDimitry Andric 
670b57cec5SDimitry Andric   MCSymbol *Sym = AP.OutContext.getOrCreateSymbol(TmpStr);
680b57cec5SDimitry Andric 
695ffd83dbSDimitry Andric   AP.OutStreamer->emitSymbolAttribute(Sym, MCSA_Global);
705ffd83dbSDimitry Andric   AP.OutStreamer->emitLabel(Sym);
710b57cec5SDimitry Andric }
720b57cec5SDimitry Andric 
beginAssembly(Module & M,GCModuleInfo & Info,AsmPrinter & AP)730b57cec5SDimitry Andric void OcamlGCMetadataPrinter::beginAssembly(Module &M, GCModuleInfo &Info,
740b57cec5SDimitry Andric                                            AsmPrinter &AP) {
7581ad6265SDimitry Andric   AP.OutStreamer->switchSection(AP.getObjFileLowering().getTextSection());
760b57cec5SDimitry Andric   EmitCamlGlobal(M, AP, "code_begin");
770b57cec5SDimitry Andric 
7881ad6265SDimitry Andric   AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
790b57cec5SDimitry Andric   EmitCamlGlobal(M, AP, "data_begin");
800b57cec5SDimitry Andric }
810b57cec5SDimitry Andric 
820b57cec5SDimitry Andric /// emitAssembly - Print the frametable. The ocaml frametable format is thus:
830b57cec5SDimitry Andric ///
840b57cec5SDimitry Andric ///   extern "C" struct align(sizeof(intptr_t)) {
850b57cec5SDimitry Andric ///     uint16_t NumDescriptors;
860b57cec5SDimitry Andric ///     struct align(sizeof(intptr_t)) {
870b57cec5SDimitry Andric ///       void *ReturnAddress;
880b57cec5SDimitry Andric ///       uint16_t FrameSize;
890b57cec5SDimitry Andric ///       uint16_t NumLiveOffsets;
900b57cec5SDimitry Andric ///       uint16_t LiveOffsets[NumLiveOffsets];
910b57cec5SDimitry Andric ///     } Descriptors[NumDescriptors];
920b57cec5SDimitry Andric ///   } caml${module}__frametable;
930b57cec5SDimitry Andric ///
940b57cec5SDimitry Andric /// Note that this precludes programs from stack frames larger than 64K
950b57cec5SDimitry Andric /// (FrameSize and LiveOffsets would overflow). FrameTablePrinter will abort if
960b57cec5SDimitry Andric /// either condition is detected in a function which uses the GC.
970b57cec5SDimitry Andric ///
finishAssembly(Module & M,GCModuleInfo & Info,AsmPrinter & AP)980b57cec5SDimitry Andric void OcamlGCMetadataPrinter::finishAssembly(Module &M, GCModuleInfo &Info,
990b57cec5SDimitry Andric                                             AsmPrinter &AP) {
1000b57cec5SDimitry Andric   unsigned IntPtrSize = M.getDataLayout().getPointerSize();
1010b57cec5SDimitry Andric 
10281ad6265SDimitry Andric   AP.OutStreamer->switchSection(AP.getObjFileLowering().getTextSection());
1030b57cec5SDimitry Andric   EmitCamlGlobal(M, AP, "code_end");
1040b57cec5SDimitry Andric 
10581ad6265SDimitry Andric   AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
1060b57cec5SDimitry Andric   EmitCamlGlobal(M, AP, "data_end");
1070b57cec5SDimitry Andric 
1080b57cec5SDimitry Andric   // FIXME: Why does ocaml emit this??
1095ffd83dbSDimitry Andric   AP.OutStreamer->emitIntValue(0, IntPtrSize);
1100b57cec5SDimitry Andric 
11181ad6265SDimitry Andric   AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
1120b57cec5SDimitry Andric   EmitCamlGlobal(M, AP, "frametable");
1130b57cec5SDimitry Andric 
1140b57cec5SDimitry Andric   int NumDescriptors = 0;
1150eae32dcSDimitry Andric   for (std::unique_ptr<GCFunctionInfo> &FI :
1160eae32dcSDimitry Andric        llvm::make_range(Info.funcinfo_begin(), Info.funcinfo_end())) {
1170eae32dcSDimitry Andric     if (FI->getStrategy().getName() != getStrategy().getName())
1180b57cec5SDimitry Andric       // this function is managed by some other GC
1190b57cec5SDimitry Andric       continue;
1200eae32dcSDimitry Andric     NumDescriptors += FI->size();
1210b57cec5SDimitry Andric   }
1220b57cec5SDimitry Andric 
1230b57cec5SDimitry Andric   if (NumDescriptors >= 1 << 16) {
1240b57cec5SDimitry Andric     // Very rude!
1250b57cec5SDimitry Andric     report_fatal_error(" Too much descriptor for ocaml GC");
1260b57cec5SDimitry Andric   }
1270b57cec5SDimitry Andric   AP.emitInt16(NumDescriptors);
1285ffd83dbSDimitry Andric   AP.emitAlignment(IntPtrSize == 4 ? Align(4) : Align(8));
1290b57cec5SDimitry Andric 
1300eae32dcSDimitry Andric   for (std::unique_ptr<GCFunctionInfo> &FI :
1310eae32dcSDimitry Andric        llvm::make_range(Info.funcinfo_begin(), Info.funcinfo_end())) {
1320eae32dcSDimitry Andric     if (FI->getStrategy().getName() != getStrategy().getName())
1330b57cec5SDimitry Andric       // this function is managed by some other GC
1340b57cec5SDimitry Andric       continue;
1350b57cec5SDimitry Andric 
1360eae32dcSDimitry Andric     uint64_t FrameSize = FI->getFrameSize();
1370b57cec5SDimitry Andric     if (FrameSize >= 1 << 16) {
1380b57cec5SDimitry Andric       // Very rude!
1390eae32dcSDimitry Andric       report_fatal_error("Function '" + FI->getFunction().getName() +
1400b57cec5SDimitry Andric                          "' is too large for the ocaml GC! "
1410b57cec5SDimitry Andric                          "Frame size " +
142e8d8bef9SDimitry Andric                          Twine(FrameSize) +
143e8d8bef9SDimitry Andric                          ">= 65536.\n"
1440b57cec5SDimitry Andric                          "(" +
1450eae32dcSDimitry Andric                          Twine(reinterpret_cast<uintptr_t>(FI.get())) + ")");
1460b57cec5SDimitry Andric     }
1470b57cec5SDimitry Andric 
1480b57cec5SDimitry Andric     AP.OutStreamer->AddComment("live roots for " +
1490eae32dcSDimitry Andric                                Twine(FI->getFunction().getName()));
15081ad6265SDimitry Andric     AP.OutStreamer->addBlankLine();
1510b57cec5SDimitry Andric 
1520eae32dcSDimitry Andric     for (GCFunctionInfo::iterator J = FI->begin(), JE = FI->end(); J != JE;
1530eae32dcSDimitry Andric          ++J) {
1540eae32dcSDimitry Andric       size_t LiveCount = FI->live_size(J);
1550b57cec5SDimitry Andric       if (LiveCount >= 1 << 16) {
1560b57cec5SDimitry Andric         // Very rude!
1570eae32dcSDimitry Andric         report_fatal_error("Function '" + FI->getFunction().getName() +
1580b57cec5SDimitry Andric                            "' is too large for the ocaml GC! "
1590b57cec5SDimitry Andric                            "Live root count " +
1600b57cec5SDimitry Andric                            Twine(LiveCount) + " >= 65536.");
1610b57cec5SDimitry Andric       }
1620b57cec5SDimitry Andric 
1635ffd83dbSDimitry Andric       AP.OutStreamer->emitSymbolValue(J->Label, IntPtrSize);
1640b57cec5SDimitry Andric       AP.emitInt16(FrameSize);
1650b57cec5SDimitry Andric       AP.emitInt16(LiveCount);
1660b57cec5SDimitry Andric 
1670eae32dcSDimitry Andric       for (GCFunctionInfo::live_iterator K = FI->live_begin(J),
1680eae32dcSDimitry Andric                                          KE = FI->live_end(J);
1690b57cec5SDimitry Andric            K != KE; ++K) {
1700b57cec5SDimitry Andric         if (K->StackOffset >= 1 << 16) {
1710b57cec5SDimitry Andric           // Very rude!
1720b57cec5SDimitry Andric           report_fatal_error(
1730b57cec5SDimitry Andric               "GC root stack offset is outside of fixed stack frame and out "
1740b57cec5SDimitry Andric               "of range for ocaml GC!");
1750b57cec5SDimitry Andric         }
1760b57cec5SDimitry Andric         AP.emitInt16(K->StackOffset);
1770b57cec5SDimitry Andric       }
1780b57cec5SDimitry Andric 
1795ffd83dbSDimitry Andric       AP.emitAlignment(IntPtrSize == 4 ? Align(4) : Align(8));
1800b57cec5SDimitry Andric     }
1810b57cec5SDimitry Andric   }
1820b57cec5SDimitry Andric }
183