src/llvm/module.slate

   1 define: #Module &parents: {Pointer} &slots: { #name }.
   2 Module traits atSlotNamed: #printName put: 'Module'.
   3
   4 "LLVMModuleRef LLVMModuleCreateWithName(const char *ModuleID);"
   5 m@(Module traits) new &name [
   6   name `defaultsTo: 'default'.
   7   newModule ::= m newWithHandle: (
   8     Lib primitives LLVMModuleCreateWithName applyTo: {name}
   9   ).
  10   newModule name := name.
  11   newModule
  12 ].
  13
  14 "void LLVMDisposeModule(LLVMModuleRef M);"
  15 m@(Module traits) dispose [
  16   Lib primitives LLVMDisposeModule applyTo: {m handle}.
  17 ].
  18
  19 "int LLVMVerifyModule(LLVMModuleRef M, LLVMVerifierFailureAction Action,
  20                      char **OutMessage);"
  21 m@(Module traits) verify &failureAction [
  22   failureAction `defaultsTo: VerifierFailureAction ReturnStatus.
  23   message := ByteArray new &capacity: bytesPerWord.
  24   returnValue := Lib primitives LLVMVerifyModule applyTo: { m handle. failureAction. message }.
  25   message allSatisfy: #isZero `er ifFalse: [
  26     Lib primitives LLVMDisposeMessage applyTo: { message }.
  27   ].
  28   returnValue
  29 ].
  30
  31 "void LLVMDumpModule(LLVMModuleRef M);"
  32 m@(Module traits) dump [
  33   Lib primitives LLVMDumpModule applyTo: {m handle}.
  34 ].
  35
  36 "int LLVMWriteBitcodeToFile(LLVMModuleRef M, const char *Path);"
  37 m@(Module traits) save &fileName [
  38   fileName `defaultsTo: (m name ; '.bc').
  39   Lib primitives LLVMWriteBitcodeToFile applyTo: {m handle. fileName}
  40 ].
  41
  42 "const char *LLVMGetDataLayout(LLVMModuleRef M);"
  43 m@(Module traits) dataLayout [
  44   Lib primitives LLVMGetDataLayout applyTo: {m handle}
  45 ].
  46
  47 "void LLVMSetDataLayout(LLVMModuleRef M, const char *Triple);"
  48 m@(Module traits) dataLayout: triple@(String traits) [
  49   Lib primitives LLVMSetDataLayout applyTo: {m handle. triple}.
  50 ].
  51
  52 "const char *LLVMGetTarget(LLVMModuleRef M);"
  53 m@(Module traits) target [
  54   Lib primitives LLVMGetTarget applyTo: {m handle}
  55 ].
  56
  57 "void LLVMSetTarget(LLVMModuleRef M, const char *Triple);"
  58 m@(Module traits) target: triple@(String traits) [
  59   Lib primitives LLVMSetTarget applyTo: {m handle. triple}.
  60 ].
  61
  62 "void LLVMDeleteTypeName(LLVMModuleRef M, const char *Name);"
  63 m@(Module traits) deleteTypeNamed: name@(String traits) [
  64   Lib primitives LLVMDeleteTypeName applyTo: {m handle. name }.
  65 ].
  66
  67 "int LLVMAddTypeName(LLVMModuleRef M, const char *Name, LLVMTypeRef Ty);"
  68 m@(Module traits) addTypeNamed: name@(String traits) type: type@(Type traits) [
  69   Lib primitives LLVMAddTypeName applyTo: {m handle. name. type handle }
  70 ].
  71
  72 "-------------------------------Operations on global variables------------------------------------"
  73
  74 "LLVMValueRef LLVMAddGlobal(LLVMModuleRef M, LLVMTypeRef Ty, const char *Name);"
  75 m@(Module traits) addGlobalNamed: name@(String traits) type: type@(Type traits) [
  76   Value GlobalVariable newWithHandle: (
  77     Lib primitives LLVMAddGlobal applyTo: {m handle. type handle. name }
  78   )
  79 ].
  80
  81 "LLVMValueRef LLVMGetNamedGlobal(LLVMModuleRef M, const char *Name);"
  82 m@(Module traits) globalNamed: name@(String traits) [
  83   Value GlobalVariable newWithHandle: (
  84     Lib primitives LLVMGetNamedGlobal applyTo: {m handle. name }
  85   )
  86 ].
  87
  88 "-------------------------------Operations on function variables------------------------------------"
  89
  90 "LLVMValueRef LLVMAddFunction(LLVMModuleRef M, const char *Name,
  91                              LLVMTypeRef FunctionTy);"
  92 m@(Module traits) addFunctionNamed: name@(String traits) type: type@(Type Function traits) [
  93   Value Function newWithHandle: (
  94     Lib primitives LLVMAddFunction applyTo: {m handle. name. type handle }
  95   )
  96 ].
  97
  98 "LLVMValueRef LLVMGetNamedFunction(LLVMModuleRef M, const char *Name);"
  99 m@(Module traits) functionNamed: name@(String traits) [
 100   Value Function newWithHandle: (
 101     Lib primitives LLVMGetNamedFunction applyTo: {m handle. name }
 102   )
 103 ].
 104
 105 define: #SlateModule &parents: {Module} &slots: {
 106   #structObject. #structObjectPtr. #environmentFunction. #literalAtFunction. #selectorAtFunction.
 107   #findMethodAndSendWithArgs.  #nilObject. #falseObject. #trueObject
 108 }.
 109 SlateModule traits atSlotNamed: #printName put: 'SlateModule'.
 110
 111 m@(SlateModule traits) new &name [
 112   resend `>> [ declareStructures. declareGlobalVariables. declareFunctions. ]
 113 ].
 114
 115 m@(SlateModule traits) declareStructures [
 116   objectOpaque ::= Type Opaque new holder.
 117   m structObject := Type Struct new &elementTypes: {
 118     Type Integer32.  "header"
 119     Type Integer32.  "objectSize"
 120     Type Integer32.  "payloadSize"
 121     (Type Pointer newFor: objectOpaque resolve)  "map"
 122   }.
 123   objectOpaque resolve refineTo: m structObject.
 124   m structObject := objectOpaque resolve.
 125   m addTypeNamed: 'struct.Object' type: m structObject.
 126   m structObjectPtr := Type Pointer newFor: m structObject.
 127 ].
 128
 129 m@(SlateModule traits) declareGlobalVariables [
 130   m nilObject := m addGlobalNamed: 'nilObject' type: m structObjectPtr.
 131   m trueObject := m addGlobalNamed: 'trueObject' type: m structObjectPtr.
 132   m falseObject := m addGlobalNamed: 'falseObject' type: m structObjectPtr.
 133 ].
 134
 135 m@(SlateModule traits) declareFunctions
 136 [| functionType |
 137   "struct Object *environment( void )"
 138   functionType := Type Function new &returnType: m structObjectPtr.
 139   m environmentFunction := m addFunctionNamed: 'environment' type: functionType.
 140
 141   "struct Object *literalAt( struct Object *index )"
 142   functionType := Type Function new &returnType: m structObjectPtr &paramaterTypes: {m structObjectPtr}.
 143   m literalAtFunction := m addFunctionNamed: 'literalAt' type: functionType.
 144   (m literalAtFunction parameterAt: 0) name := 'index'.
 145
 146   "struct Object *selectorAt( struct Object *index )"
 147   functionType := Type Function new &returnType: m structObjectPtr &paramaterTypes: {m structObjectPtr}.
 148   m selectorAtFunction := m addFunctionNamed: 'selectorAt' type: functionType.
 149   (m selectorAtFunction parameterAt: 0) name := 'index'.
 150
 151   "struct Object *findMethodAndSendWithArgs( struct Object *selector, struct Object *arity, ... )"
 152   functionType := Type Function new &returnType: m structObjectPtr &paramaterTypes: {m structObjectPtr. m structObjectPtr} &isVarArg: True.
 153   m findMethodAndSendWithArgs := m addFunctionNamed: 'findMethodAndSendWithArgs' type: functionType.
 154   (m findMethodAndSendWithArgs parameterAt: 0) name := 'selector'.
 155   (m findMethodAndSendWithArgs parameterAt: 1) name := 'arity'.
 156 ].