109467b48Spatrick //===- OcamlGCPrinter.cpp - Ocaml frametable emitter ----------------------===//
209467b48Spatrick //
309467b48Spatrick // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
409467b48Spatrick // See https://llvm.org/LICENSE.txt for license information.
509467b48Spatrick // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
609467b48Spatrick //
709467b48Spatrick //===----------------------------------------------------------------------===//
809467b48Spatrick //
909467b48Spatrick // This file implements printing the assembly code for an Ocaml frametable.
1009467b48Spatrick //
1109467b48Spatrick //===----------------------------------------------------------------------===//
1209467b48Spatrick
1309467b48Spatrick #include "llvm/ADT/STLExtras.h"
1409467b48Spatrick #include "llvm/ADT/SmallString.h"
1509467b48Spatrick #include "llvm/ADT/Twine.h"
1609467b48Spatrick #include "llvm/CodeGen/AsmPrinter.h"
1709467b48Spatrick #include "llvm/CodeGen/GCMetadata.h"
1809467b48Spatrick #include "llvm/CodeGen/GCMetadataPrinter.h"
1973471bf0Spatrick #include "llvm/IR/BuiltinGCs.h"
2009467b48Spatrick #include "llvm/IR/DataLayout.h"
2109467b48Spatrick #include "llvm/IR/Function.h"
2209467b48Spatrick #include "llvm/IR/Mangler.h"
2309467b48Spatrick #include "llvm/IR/Module.h"
2409467b48Spatrick #include "llvm/MC/MCContext.h"
2509467b48Spatrick #include "llvm/MC/MCDirectives.h"
2609467b48Spatrick #include "llvm/MC/MCStreamer.h"
2709467b48Spatrick #include "llvm/Support/ErrorHandling.h"
2809467b48Spatrick #include "llvm/Target/TargetLoweringObjectFile.h"
2909467b48Spatrick #include <cctype>
3009467b48Spatrick #include <cstddef>
3109467b48Spatrick #include <cstdint>
3209467b48Spatrick #include <string>
3309467b48Spatrick
3409467b48Spatrick using namespace llvm;
3509467b48Spatrick
3609467b48Spatrick namespace {
3709467b48Spatrick
3809467b48Spatrick class OcamlGCMetadataPrinter : public GCMetadataPrinter {
3909467b48Spatrick public:
4009467b48Spatrick void beginAssembly(Module &M, GCModuleInfo &Info, AsmPrinter &AP) override;
4109467b48Spatrick void finishAssembly(Module &M, GCModuleInfo &Info, AsmPrinter &AP) override;
4209467b48Spatrick };
4309467b48Spatrick
4409467b48Spatrick } // end anonymous namespace
4509467b48Spatrick
4609467b48Spatrick static GCMetadataPrinterRegistry::Add<OcamlGCMetadataPrinter>
4709467b48Spatrick Y("ocaml", "ocaml 3.10-compatible collector");
4809467b48Spatrick
linkOcamlGCPrinter()4909467b48Spatrick void llvm::linkOcamlGCPrinter() {}
5009467b48Spatrick
EmitCamlGlobal(const Module & M,AsmPrinter & AP,const char * Id)5109467b48Spatrick static void EmitCamlGlobal(const Module &M, AsmPrinter &AP, const char *Id) {
5209467b48Spatrick const std::string &MId = M.getModuleIdentifier();
5309467b48Spatrick
5409467b48Spatrick std::string SymName;
5509467b48Spatrick SymName += "caml";
5609467b48Spatrick size_t Letter = SymName.size();
5709467b48Spatrick SymName.append(MId.begin(), llvm::find(MId, '.'));
5809467b48Spatrick SymName += "__";
5909467b48Spatrick SymName += Id;
6009467b48Spatrick
6109467b48Spatrick // Capitalize the first letter of the module name.
6209467b48Spatrick SymName[Letter] = toupper(SymName[Letter]);
6309467b48Spatrick
6409467b48Spatrick SmallString<128> TmpStr;
6509467b48Spatrick Mangler::getNameWithPrefix(TmpStr, SymName, M.getDataLayout());
6609467b48Spatrick
6709467b48Spatrick MCSymbol *Sym = AP.OutContext.getOrCreateSymbol(TmpStr);
6809467b48Spatrick
69097a140dSpatrick AP.OutStreamer->emitSymbolAttribute(Sym, MCSA_Global);
70097a140dSpatrick AP.OutStreamer->emitLabel(Sym);
7109467b48Spatrick }
7209467b48Spatrick
beginAssembly(Module & M,GCModuleInfo & Info,AsmPrinter & AP)7309467b48Spatrick void OcamlGCMetadataPrinter::beginAssembly(Module &M, GCModuleInfo &Info,
7409467b48Spatrick AsmPrinter &AP) {
75*d415bd75Srobert AP.OutStreamer->switchSection(AP.getObjFileLowering().getTextSection());
7609467b48Spatrick EmitCamlGlobal(M, AP, "code_begin");
7709467b48Spatrick
78*d415bd75Srobert AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
7909467b48Spatrick EmitCamlGlobal(M, AP, "data_begin");
8009467b48Spatrick }
8109467b48Spatrick
8209467b48Spatrick /// emitAssembly - Print the frametable. The ocaml frametable format is thus:
8309467b48Spatrick ///
8409467b48Spatrick /// extern "C" struct align(sizeof(intptr_t)) {
8509467b48Spatrick /// uint16_t NumDescriptors;
8609467b48Spatrick /// struct align(sizeof(intptr_t)) {
8709467b48Spatrick /// void *ReturnAddress;
8809467b48Spatrick /// uint16_t FrameSize;
8909467b48Spatrick /// uint16_t NumLiveOffsets;
9009467b48Spatrick /// uint16_t LiveOffsets[NumLiveOffsets];
9109467b48Spatrick /// } Descriptors[NumDescriptors];
9209467b48Spatrick /// } caml${module}__frametable;
9309467b48Spatrick ///
9409467b48Spatrick /// Note that this precludes programs from stack frames larger than 64K
9509467b48Spatrick /// (FrameSize and LiveOffsets would overflow). FrameTablePrinter will abort if
9609467b48Spatrick /// either condition is detected in a function which uses the GC.
9709467b48Spatrick ///
finishAssembly(Module & M,GCModuleInfo & Info,AsmPrinter & AP)9809467b48Spatrick void OcamlGCMetadataPrinter::finishAssembly(Module &M, GCModuleInfo &Info,
9909467b48Spatrick AsmPrinter &AP) {
10009467b48Spatrick unsigned IntPtrSize = M.getDataLayout().getPointerSize();
10109467b48Spatrick
102*d415bd75Srobert AP.OutStreamer->switchSection(AP.getObjFileLowering().getTextSection());
10309467b48Spatrick EmitCamlGlobal(M, AP, "code_end");
10409467b48Spatrick
105*d415bd75Srobert AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
10609467b48Spatrick EmitCamlGlobal(M, AP, "data_end");
10709467b48Spatrick
10809467b48Spatrick // FIXME: Why does ocaml emit this??
109097a140dSpatrick AP.OutStreamer->emitIntValue(0, IntPtrSize);
11009467b48Spatrick
111*d415bd75Srobert AP.OutStreamer->switchSection(AP.getObjFileLowering().getDataSection());
11209467b48Spatrick EmitCamlGlobal(M, AP, "frametable");
11309467b48Spatrick
11409467b48Spatrick int NumDescriptors = 0;
115*d415bd75Srobert for (std::unique_ptr<GCFunctionInfo> &FI :
116*d415bd75Srobert llvm::make_range(Info.funcinfo_begin(), Info.funcinfo_end())) {
117*d415bd75Srobert if (FI->getStrategy().getName() != getStrategy().getName())
11809467b48Spatrick // this function is managed by some other GC
11909467b48Spatrick continue;
120*d415bd75Srobert NumDescriptors += FI->size();
12109467b48Spatrick }
12209467b48Spatrick
12309467b48Spatrick if (NumDescriptors >= 1 << 16) {
12409467b48Spatrick // Very rude!
12509467b48Spatrick report_fatal_error(" Too much descriptor for ocaml GC");
12609467b48Spatrick }
12709467b48Spatrick AP.emitInt16(NumDescriptors);
128097a140dSpatrick AP.emitAlignment(IntPtrSize == 4 ? Align(4) : Align(8));
12909467b48Spatrick
130*d415bd75Srobert for (std::unique_ptr<GCFunctionInfo> &FI :
131*d415bd75Srobert llvm::make_range(Info.funcinfo_begin(), Info.funcinfo_end())) {
132*d415bd75Srobert if (FI->getStrategy().getName() != getStrategy().getName())
13309467b48Spatrick // this function is managed by some other GC
13409467b48Spatrick continue;
13509467b48Spatrick
136*d415bd75Srobert uint64_t FrameSize = FI->getFrameSize();
13709467b48Spatrick if (FrameSize >= 1 << 16) {
13809467b48Spatrick // Very rude!
139*d415bd75Srobert report_fatal_error("Function '" + FI->getFunction().getName() +
14009467b48Spatrick "' is too large for the ocaml GC! "
14109467b48Spatrick "Frame size " +
14273471bf0Spatrick Twine(FrameSize) +
14373471bf0Spatrick ">= 65536.\n"
14409467b48Spatrick "(" +
145*d415bd75Srobert Twine(reinterpret_cast<uintptr_t>(FI.get())) + ")");
14609467b48Spatrick }
14709467b48Spatrick
14809467b48Spatrick AP.OutStreamer->AddComment("live roots for " +
149*d415bd75Srobert Twine(FI->getFunction().getName()));
150*d415bd75Srobert AP.OutStreamer->addBlankLine();
15109467b48Spatrick
152*d415bd75Srobert for (GCFunctionInfo::iterator J = FI->begin(), JE = FI->end(); J != JE;
153*d415bd75Srobert ++J) {
154*d415bd75Srobert size_t LiveCount = FI->live_size(J);
15509467b48Spatrick if (LiveCount >= 1 << 16) {
15609467b48Spatrick // Very rude!
157*d415bd75Srobert report_fatal_error("Function '" + FI->getFunction().getName() +
15809467b48Spatrick "' is too large for the ocaml GC! "
15909467b48Spatrick "Live root count " +
16009467b48Spatrick Twine(LiveCount) + " >= 65536.");
16109467b48Spatrick }
16209467b48Spatrick
163097a140dSpatrick AP.OutStreamer->emitSymbolValue(J->Label, IntPtrSize);
16409467b48Spatrick AP.emitInt16(FrameSize);
16509467b48Spatrick AP.emitInt16(LiveCount);
16609467b48Spatrick
167*d415bd75Srobert for (GCFunctionInfo::live_iterator K = FI->live_begin(J),
168*d415bd75Srobert KE = FI->live_end(J);
16909467b48Spatrick K != KE; ++K) {
17009467b48Spatrick if (K->StackOffset >= 1 << 16) {
17109467b48Spatrick // Very rude!
17209467b48Spatrick report_fatal_error(
17309467b48Spatrick "GC root stack offset is outside of fixed stack frame and out "
17409467b48Spatrick "of range for ocaml GC!");
17509467b48Spatrick }
17609467b48Spatrick AP.emitInt16(K->StackOffset);
17709467b48Spatrick }
17809467b48Spatrick
179097a140dSpatrick AP.emitAlignment(IntPtrSize == 4 ? Align(4) : Align(8));
18009467b48Spatrick }
18109467b48Spatrick }
18209467b48Spatrick }
183