diff --git a/extra/central/authors.txt b/extra/central/authors.txt new file mode 100644 index 0000000000..5645cd91bd --- /dev/null +++ b/extra/central/authors.txt @@ -0,0 +1 @@ +Matthew Willis diff --git a/extra/central/central-docs.factor b/extra/central/central-docs.factor new file mode 100644 index 0000000000..458f528c53 --- /dev/null +++ b/extra/central/central-docs.factor @@ -0,0 +1,16 @@ +USING: central destructors help.markup help.syntax ; + +HELP: CENTRAL: +{ $description + "This parsing word defines a pair of words useful for " + "implementing the \"central\" pattern: " { $snippet "symbol" } " and " + { $snippet "with-symbol" } ". This is a middle ground between excessive " + "stack manipulation and full-out locals, meant to solve the case where " + "one object is operated on by several related words." +} ; + +HELP: DISPOSABLE-CENTRAL: +{ $description + "Like " { $link POSTPONE: CENTRAL: } ", but generates " { $snippet "with-" } + " words that are wrapped in a " { $link with-disposal } "." +} ; \ No newline at end of file diff --git a/extra/central/central-tests.factor b/extra/central/central-tests.factor new file mode 100644 index 0000000000..3dbcbf32fc --- /dev/null +++ b/extra/central/central-tests.factor @@ -0,0 +1,19 @@ +USING: accessors central destructors kernel math tools.test ; + +IN: scratchpad + +CENTRAL: test-central + +[ 3 ] [ 3 [ test-central ] with-test-central ] unit-test + +TUPLE: test-disp-cent value disposed ; + +! A phony destructor that adds 1 to the value so we can make sure it got called. +M: test-disp-cent dispose* dup value>> 1+ >>value drop ; + +DISPOSABLE-CENTRAL: t-d-c + +: test-t-d-c ( -- n ) + test-disp-cent new 3 >>value [ t-d-c ] with-t-d-c value>> ; + +[ 4 ] [ test-t-d-c ] unit-test \ No newline at end of file diff --git a/extra/central/central.factor b/extra/central/central.factor new file mode 100644 index 0000000000..f7175141dd --- /dev/null +++ b/extra/central/central.factor @@ -0,0 +1,28 @@ +USING: destructors kernel lexer namespaces parser sequences words ; + +IN: central + +: define-central-getter ( word -- ) + dup [ get ] curry (( -- obj )) define-declared ; + +: define-centrals ( str -- getter setter ) + [ create-in dup define-central-getter ] + [ "with-" prepend create-in dup make-inline ] bi ; + +: central-setter-def ( word with-word -- with-word quot ) + [ with-variable ] with ; + +: disposable-setter-def ( word with-word -- with-word quot ) + [ pick [ drop with-variable ] with-disposal ] with ; + +: declare-central ( with-word quot -- ) (( object quot -- )) define-declared ; + +: define-central ( word-name -- ) + define-centrals central-setter-def declare-central ; + +: define-disposable-central ( word-name -- ) + define-centrals disposable-setter-def declare-central ; + +SYNTAX: CENTRAL: ( -- ) scan define-central ; + +SYNTAX: DISPOSABLE-CENTRAL: ( -- ) scan define-disposable-central ; \ No newline at end of file diff --git a/extra/central/tags.txt b/extra/central/tags.txt new file mode 100644 index 0000000000..f4274299b1 --- /dev/null +++ b/extra/central/tags.txt @@ -0,0 +1 @@ +extensions diff --git a/extra/llvm/authors.txt b/extra/llvm/authors.txt new file mode 100644 index 0000000000..5645cd91bd --- /dev/null +++ b/extra/llvm/authors.txt @@ -0,0 +1 @@ +Matthew Willis diff --git a/extra/llvm/core/core.factor b/extra/llvm/core/core.factor new file mode 100644 index 0000000000..00a395d3b2 --- /dev/null +++ b/extra/llvm/core/core.factor @@ -0,0 +1,418 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.libraries alien.syntax ; + +IN: llvm.core + +<< + +"LLVMSystem" "/usr/local/lib/libLLVMSystem.dylib" "cdecl" add-library + +"LLVMSupport" "/usr/local/lib/libLLVMSupport.dylib" "cdecl" add-library + +"LLVMCore" "/usr/local/lib/libLLVMCore.dylib" "cdecl" add-library + +"LLVMBitReader" "/usr/local/lib/libLLVMBitReader.dylib" "cdecl" add-library + +>> + +! llvm-c/Core.h + +LIBRARY: LLVMCore + +TYPEDEF: uint unsigned +TYPEDEF: unsigned enum + +CONSTANT: LLVMZExtAttribute BIN: 1 +CONSTANT: LLVMSExtAttribute BIN: 10 +CONSTANT: LLVMNoReturnAttribute BIN: 100 +CONSTANT: LLVMInRegAttribute BIN: 1000 +CONSTANT: LLVMStructRetAttribute BIN: 10000 +CONSTANT: LLVMNoUnwindAttribute BIN: 100000 +CONSTANT: LLVMNoAliasAttribute BIN: 1000000 +CONSTANT: LLVMByValAttribute BIN: 10000000 +CONSTANT: LLVMNestAttribute BIN: 100000000 +CONSTANT: LLVMReadNoneAttribute BIN: 1000000000 +CONSTANT: LLVMReadOnlyAttribute BIN: 10000000000 +TYPEDEF: enum LLVMAttribute; + +C-ENUM: + LLVMVoidTypeKind + LLVMFloatTypeKind + LLVMDoubleTypeKind + LLVMX86_FP80TypeKind + LLVMFP128TypeKind + LLVMPPC_FP128TypeKind + LLVMLabelTypeKind + LLVMMetadataTypeKind + LLVMIntegerTypeKind + LLVMFunctionTypeKind + LLVMStructTypeKind + LLVMArrayTypeKind + LLVMPointerTypeKind + LLVMOpaqueTypeKind + LLVMVectorTypeKind ; +TYPEDEF: enum LLVMTypeKind + +C-ENUM: + LLVMExternalLinkage + LLVMLinkOnceLinkage + LLVMWeakLinkage + LLVMAppendingLinkage + LLVMInternalLinkage + LLVMDLLImportLinkage + LLVMDLLExportLinkage + LLVMExternalWeakLinkage + LLVMGhostLinkage ; +TYPEDEF: enum LLVMLinkage + +C-ENUM: + LLVMDefaultVisibility + LLVMHiddenVisibility + LLVMProtectedVisibility ; +TYPEDEF: enum LLVMVisibility + +CONSTANT: LLVMCCallConv 0 +CONSTANT: LLVMFastCallConv 8 +CONSTANT: LLVMColdCallConv 9 +CONSTANT: LLVMX86StdcallCallConv 64 +CONSTANT: LLVMX86FastcallCallConv 65 +TYPEDEF: enum LLVMCallConv + +CONSTANT: LLVMIntEQ 32 +CONSTANT: LLVMIntNE 33 +CONSTANT: LLVMIntUGT 34 +CONSTANT: LLVMIntUGE 35 +CONSTANT: LLVMIntULT 36 +CONSTANT: LLVMIntULE 37 +CONSTANT: LLVMIntSGT 38 +CONSTANT: LLVMIntSGE 39 +CONSTANT: LLVMIntSLT 40 +CONSTANT: LLVMIntSLE 41 +TYPEDEF: enum LLVMIntPredicate + +C-ENUM: + LLVMRealPredicateFalse + LLVMRealOEQ + LLVMRealOGT + LLVMRealOGE + LLVMRealOLT + LLVMRealOLE + LLVMRealONE + LLVMRealORD + LLVMRealUNO + LLVMRealUEQ + LLVMRealUGT + LLVMRealUGE + LLVMRealULT + LLVMRealULE + LLVMRealUNE + LLVMRealPredicateTrue ; +TYPEDEF: enum LLVMRealPredicate + +! Opaque Types + +TYPEDEF: void* LLVMModuleRef + +TYPEDEF: void* LLVMPassManagerRef + +TYPEDEF: void* LLVMModuleProviderRef + +TYPEDEF: void* LLVMTypeRef + +TYPEDEF: void* LLVMTypeHandleRef + +TYPEDEF: void* LLVMValueRef + +TYPEDEF: void* LLVMBasicBlockRef + +TYPEDEF: void* LLVMBuilderRef + +TYPEDEF: void* LLVMMemoryBufferRef + +! Functions + +FUNCTION: void LLVMDisposeMessage ( char* Message ) ; + +FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( char* ModuleID ) ; + +FUNCTION: int LLVMAddTypeName ( LLVMModuleRef M, char* Name, LLVMTypeRef Ty ) ; + +FUNCTION: void LLVMDisposeModule ( LLVMModuleRef M ) ; + +FUNCTION: void LLVMDumpModule ( LLVMModuleRef M ) ; + +FUNCTION: LLVMModuleProviderRef +LLVMCreateModuleProviderForExistingModule ( LLVMModuleRef M ) ; + +FUNCTION: void LLVMDisposeModuleProvider ( LLVMModuleProviderRef MP ) ; + +! Types + +! LLVM types conform to the following hierarchy: +! +! types: +! integer type +! real type +! function type +! sequence types: +! array type +! pointer type +! vector type +! void type +! label type +! opaque type + +! See llvm::LLVMTypeKind::getTypeID. +FUNCTION: LLVMTypeKind LLVMGetTypeKind ( LLVMTypeRef Ty ) ; + +! Operations on integer types +FUNCTION: LLVMTypeRef LLVMInt1Type ( ) ; +FUNCTION: LLVMTypeRef LLVMInt8Type ( ) ; +FUNCTION: LLVMTypeRef LLVMInt16Type ( ) ; +FUNCTION: LLVMTypeRef LLVMInt32Type ( ) ; +FUNCTION: LLVMTypeRef LLVMInt64Type ( ) ; +FUNCTION: LLVMTypeRef LLVMIntType ( unsigned NumBits ) ; +FUNCTION: unsigned LLVMGetIntTypeWidth ( LLVMTypeRef IntegerTy ) ; + +! Operations on real types +FUNCTION: LLVMTypeRef LLVMFloatType ( ) ; +FUNCTION: LLVMTypeRef LLVMDoubleType ( ) ; +FUNCTION: LLVMTypeRef LLVMX86FP80Type ( ) ; +FUNCTION: LLVMTypeRef LLVMFP128Type ( ) ; +FUNCTION: LLVMTypeRef LLVMPPCFP128Type ( ) ; + +! Operations on function types +FUNCTION: LLVMTypeRef +LLVMFunctionType ( LLVMTypeRef ReturnType, LLVMTypeRef* ParamTypes, unsigned ParamCount, int IsVarArg ) ; +FUNCTION: int LLVMIsFunctionVarArg ( LLVMTypeRef FunctionTy ) ; +FUNCTION: LLVMTypeRef LLVMGetReturnType ( LLVMTypeRef FunctionTy ) ; +FUNCTION: unsigned LLVMCountParamTypes ( LLVMTypeRef FunctionTy ) ; +FUNCTION: void LLVMGetParamTypes ( LLVMTypeRef FunctionTy, LLVMTypeRef* Dest ) ; + +! Operations on struct types +FUNCTION: LLVMTypeRef +LLVMStructType ( LLVMTypeRef* ElementTypes, unsigned ElementCount, int Packed ) ; +FUNCTION: unsigned LLVMCountStructElementTypes ( LLVMTypeRef StructTy ) ; +FUNCTION: void LLVMGetStructElementTypes ( LLVMTypeRef StructTy, LLVMTypeRef* Dest ) ; +FUNCTION: int LLVMIsPackedStruct ( LLVMTypeRef StructTy ) ; + +! Operations on array, pointer, and vector types (sequence types) +FUNCTION: LLVMTypeRef LLVMArrayType ( LLVMTypeRef ElementType, unsigned ElementCount ) ; +FUNCTION: LLVMTypeRef LLVMPointerType ( LLVMTypeRef ElementType, unsigned AddressSpace ) ; +FUNCTION: LLVMTypeRef LLVMVectorType ( LLVMTypeRef ElementType, unsigned ElementCount ) ; + +FUNCTION: LLVMTypeRef LLVMGetElementType ( LLVMTypeRef Ty ) ; +FUNCTION: unsigned LLVMGetArrayLength ( LLVMTypeRef ArrayTy ) ; +FUNCTION: unsigned LLVMGetPointerAddressSpace ( LLVMTypeRef PointerTy ) ; +FUNCTION: unsigned LLVMGetVectorSize ( LLVMTypeRef VectorTy ) ; + +! Operations on other types +FUNCTION: LLVMTypeRef LLVMVoidType ( ) ; +FUNCTION: LLVMTypeRef LLVMLabelType ( ) ; +FUNCTION: LLVMTypeRef LLVMOpaqueType ( ) ; + +! Operations on type handles +FUNCTION: LLVMTypeHandleRef LLVMCreateTypeHandle ( LLVMTypeRef PotentiallyAbstractTy ) ; +FUNCTION: void LLVMRefineType ( LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy ) ; +FUNCTION: LLVMTypeRef LLVMResolveTypeHandle ( LLVMTypeHandleRef TypeHandle ) ; +FUNCTION: void LLVMDisposeTypeHandle ( LLVMTypeHandleRef TypeHandle ) ; + +! Types end + +FUNCTION: unsigned LLVMCountParams ( LLVMValueRef Fn ) ; + +FUNCTION: void LLVMGetParams ( LLVMValueRef Fn, LLVMValueRef* Params ) ; + +FUNCTION: LLVMValueRef +LLVMAddFunction ( LLVMModuleRef M, char* Name, LLVMTypeRef FunctionTy ) ; + +FUNCTION: LLVMValueRef LLVMGetFirstFunction ( LLVMModuleRef M ) ; + +FUNCTION: LLVMValueRef LLVMGetNextFunction ( LLVMValueRef Fn ) ; + +FUNCTION: unsigned LLVMGetFunctionCallConv ( LLVMValueRef Fn ) ; + +FUNCTION: void LLVMSetFunctionCallConv ( LLVMValueRef Fn, unsigned CC ) ; + +FUNCTION: LLVMBasicBlockRef +LLVMAppendBasicBlock ( LLVMValueRef Fn, char* Name ) ; + +FUNCTION: LLVMValueRef LLVMGetBasicBlockParent ( LLVMBasicBlockRef BB ) ; + +! Values + +FUNCTION: LLVMTypeRef LLVMTypeOf ( LLVMValueRef Val ) ; +FUNCTION: char* LLVMGetValueName ( LLVMValueRef Val ) ; +FUNCTION: void LLVMSetValueName ( LLVMValueRef Val, char* Name ) ; +FUNCTION: void LLVMDumpValue ( LLVMValueRef Val ) ; + +! Instruction Builders + +FUNCTION: LLVMBuilderRef LLVMCreateBuilder ( ) ; +FUNCTION: void LLVMPositionBuilder +( LLVMBuilderRef Builder, LLVMBasicBlockRef Block, LLVMValueRef Instr ) ; +FUNCTION: void LLVMPositionBuilderBefore +( LLVMBuilderRef Builder, LLVMValueRef Instr ) ; +FUNCTION: void LLVMPositionBuilderAtEnd +( LLVMBuilderRef Builder, LLVMBasicBlockRef Block ) ; +FUNCTION: LLVMBasicBlockRef LLVMGetInsertBlock +( LLVMBuilderRef Builder ) ; +FUNCTION: void LLVMClearInsertionPosition +( LLVMBuilderRef Builder ) ; +FUNCTION: void LLVMInsertIntoBuilder +( LLVMBuilderRef Builder, LLVMValueRef Instr ) ; +FUNCTION: void LLVMDisposeBuilder +( LLVMBuilderRef Builder ) ; + +! IB Terminators + +FUNCTION: LLVMValueRef LLVMBuildRetVoid +( LLVMBuilderRef Builder ) ; +FUNCTION: LLVMValueRef LLVMBuildRet +( LLVMBuilderRef Builder, LLVMValueRef V ) ; +FUNCTION: LLVMValueRef LLVMBuildBr +( LLVMBuilderRef Builder, LLVMBasicBlockRef Dest ) ; +FUNCTION: LLVMValueRef LLVMBuildCondBr +( LLVMBuilderRef Builder, LLVMValueRef If, LLVMBasicBlockRef Then, LLVMBasicBlockRef Else ) ; +FUNCTION: LLVMValueRef LLVMBuildSwitch +( LLVMBuilderRef Builder, LLVMValueRef V, LLVMBasicBlockRef Else, unsigned NumCases ) ; +FUNCTION: LLVMValueRef LLVMBuildInvoke +( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, + LLVMBasicBlockRef Then, LLVMBasicBlockRef Catch, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildUnwind +( LLVMBuilderRef Builder ) ; +FUNCTION: LLVMValueRef LLVMBuildUnreachable +( LLVMBuilderRef Builder ) ; + +! IB Add Case to Switch + +FUNCTION: void LLVMAddCase +( LLVMValueRef Switch, LLVMValueRef OnVal, LLVMBasicBlockRef Dest ) ; + +! IB Arithmetic + +FUNCTION: LLVMValueRef LLVMBuildAdd +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSub +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildMul +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildUDiv +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSDiv +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFDiv +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildURem +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSRem +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFRem +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildShl +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildLShr +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildAShr +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildAnd +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildOr +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildXor +( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildNeg +( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildNot +( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ; + +! IB Memory + +FUNCTION: LLVMValueRef LLVMBuildMalloc +( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildArrayMalloc +( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildAlloca +( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildArrayAlloca +( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFree +( LLVMBuilderRef Builder, LLVMValueRef PointerVal ) ; +FUNCTION: LLVMValueRef LLVMBuildLoad +( LLVMBuilderRef Builder, LLVMValueRef PointerVal, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildStore +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMValueRef Ptr ) ; +FUNCTION: LLVMValueRef LLVMBuildGEP +( LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef* Indices, + unsigned NumIndices, char* Name ) ; + +! IB Casts + +FUNCTION: LLVMValueRef LLVMBuildTrunc +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildZExt +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSExt +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFPToUI +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFPToSI +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildUIToFP +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSIToFP +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFPTrunc +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFPExt +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildPtrToInt +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildIntToPtr +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildBitCast +( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ; + +! IB Comparisons + +FUNCTION: LLVMValueRef LLVMBuildICmp +( LLVMBuilderRef Builder, LLVMIntPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildFCmp +( LLVMBuilderRef Builder, LLVMRealPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ; + +! IB Misc Instructions + +FUNCTION: LLVMValueRef LLVMBuildPhi +( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildCall +( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildSelect +( LLVMBuilderRef Builder, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildVAArg +( LLVMBuilderRef Builder, LLVMValueRef List, LLVMTypeRef Ty, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildExtractElement +( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef Index, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildInsertElement +( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef EltVal, LLVMValueRef Index, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildShuffleVector +( LLVMBuilderRef Builder, LLVMValueRef V1, LLVMValueRef V2, LLVMValueRef Mask, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildExtractValue +( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, char* Name ) ; +FUNCTION: LLVMValueRef LLVMBuildInsertValue +( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, char* Name ) ; + +! Memory Buffers/Bit Reader + +FUNCTION: int LLVMCreateMemoryBufferWithContentsOfFile +( char* Path, LLVMMemoryBufferRef* OutMemBuf, char** OutMessage ) ; + +FUNCTION: void LLVMDisposeMemoryBuffer ( LLVMMemoryBufferRef MemBuf ) ; + +LIBRARY: LLVMBitReader + +FUNCTION: int LLVMParseBitcode +( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, char** OutMessage ) ; + +FUNCTION: int LLVMGetBitcodeModuleProvider +( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, char** OutMessage ) ; diff --git a/extra/llvm/engine/engine.factor b/extra/llvm/engine/engine.factor new file mode 100644 index 0000000000..1fa7ef01d6 --- /dev/null +++ b/extra/llvm/engine/engine.factor @@ -0,0 +1,68 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.libraries alien.syntax llvm.core ; +IN: llvm.engine + +<< + +"LLVMExecutionEngine" "/usr/local/lib/libLLVMExecutionEngine.dylib" "cdecl" add-library + +"LLVMTarget" "/usr/local/lib/libLLVMTarget.dylib" "cdecl" add-library + +"LLVMAnalysis" "/usr/local/lib/libLLVMAnalysis.dylib" "cdecl" add-library + +"LLVMipa" "/usr/local/lib/libLLVMipa.dylib" "cdecl" add-library + +"LLVMTransformUtils" "/usr/local/lib/libLLVMTransformUtils.dylib" "cdecl" add-library + +"LLVMScalarOpts" "/usr/local/lib/libLLVMScalarOpts.dylib" "cdecl" add-library + +"LLVMCodeGen" "/usr/local/lib/libLLVMCodeGen.dylib" "cdecl" add-library + +"LLVMAsmPrinter" "/usr/local/lib/libLLVMAsmPrinter.dylib" "cdecl" add-library + +"LLVMSelectionDAG" "/usr/local/lib/libLLVMSelectionDAG.dylib" "cdecl" add-library + +"LLVMX86CodeGen" "/usr/local/lib/libLLVMX86CodeGen.dylib" "cdecl" add-library + +"LLVMJIT" "/usr/local/lib/libLLVMJIT.dylib" "cdecl" add-library + +"LLVMInterpreter.dylib" "/usr/local/lib/libLLVMInterpreter.dylib" "cdecl" add-library + +>> + +! llvm-c/ExecutionEngine.h + +LIBRARY: LLVMExecutionEngine + +TYPEDEF: void* LLVMGenericValueRef +TYPEDEF: void* LLVMExecutionEngineRef + +FUNCTION: LLVMGenericValueRef LLVMCreateGenericValueOfInt +( LLVMTypeRef Ty, ulonglong N, int IsSigned ) ; + +FUNCTION: ulonglong LLVMGenericValueToInt +( LLVMGenericValueRef GenVal, int IsSigned ) ; + +FUNCTION: int LLVMCreateExecutionEngine +( LLVMExecutionEngineRef *OutEE, LLVMModuleProviderRef MP, char** OutError ) ; + +FUNCTION: int LLVMCreateJITCompiler +( LLVMExecutionEngineRef* OutJIT, LLVMModuleProviderRef MP, unsigned OptLevel, char** OutError ) ; + +FUNCTION: void LLVMDisposeExecutionEngine ( LLVMExecutionEngineRef EE ) ; + +FUNCTION: void LLVMFreeMachineCodeForFunction ( LLVMExecutionEngineRef EE, LLVMValueRef F ) ; + +FUNCTION: void LLVMAddModuleProvider ( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP ) ; + +FUNCTION: int LLVMRemoveModuleProvider +( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, char** OutError ) ; + +FUNCTION: int LLVMFindFunction +( LLVMExecutionEngineRef EE, char* Name, LLVMValueRef* OutFn ) ; + +FUNCTION: void* LLVMGetPointerToGlobal ( LLVMExecutionEngineRef EE, LLVMValueRef Global ) ; + +FUNCTION: LLVMGenericValueRef LLVMRunFunction +( LLVMExecutionEngineRef EE, LLVMValueRef F, unsigned NumArgs, LLVMGenericValueRef* Args ) ; \ No newline at end of file diff --git a/extra/llvm/invoker/invoker-tests.factor b/extra/llvm/invoker/invoker-tests.factor new file mode 100644 index 0000000000..9041c22f71 --- /dev/null +++ b/extra/llvm/invoker/invoker-tests.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.llvm io.pathnames llvm.invoker llvm.reader tools.test ; + +[ 3 ] [ + << "resource:extra/llvm/reader/add.bc" install-bc >> 1 2 add +] unit-test \ No newline at end of file diff --git a/extra/llvm/invoker/invoker.factor b/extra/llvm/invoker/invoker.factor new file mode 100644 index 0000000000..bb1b06bcf3 --- /dev/null +++ b/extra/llvm/invoker/invoker.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien arrays assocs compiler.units effects +io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader +llvm.types make namespaces sequences specialized-arrays.alien +vocabs words ; + +IN: llvm.invoker + +! get function name, ret type, param types and names + +! load module +! iterate through functions in a module + +TUPLE: function name alien return params ; + +: params ( llvm-function -- param-list ) + dup LLVMCountParams + [ LLVMGetParams ] keep >array + [ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ; + +: ( LLVMValueRef -- function ) + function new + over LLVMGetValueName >>name + over LLVMTypeOf tref> type>> return>> >>return + swap params >>params ; + +: (functions) ( llvm-function -- ) + [ dup , LLVMGetNextFunction (functions) ] when* ; + +: functions ( llvm-module -- functions ) + LLVMGetFirstFunction [ (functions) ] { } make [ ] map ; + +: function-effect ( function -- effect ) + [ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi ; + +: install-function ( function -- ) + dup name>> "alien.llvm" create-vocab drop + "alien.llvm" create swap + [ + dup name>> function-pointer , + dup return>> c-type , + dup params>> [ second c-type ] map , + "cdecl" , \ alien-indirect , + ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ; + +: install-module ( name -- ) + thejit get mps>> at [ + module>> functions [ install-function ] each + ] [ "no such module" throw ] if* ; + +: install-bc ( path -- ) + [ normalize-path ] [ file-name ] bi + [ load-into-jit ] keep install-module ; + +<< "alien.llvm" create-vocab drop >> \ No newline at end of file diff --git a/extra/llvm/jit/jit-tests.factor b/extra/llvm/jit/jit-tests.factor new file mode 100644 index 0000000000..5dc2b2c96f --- /dev/null +++ b/extra/llvm/jit/jit-tests.factor @@ -0,0 +1,5 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: destructors llvm.jit llvm.wrappers tools.test ; + +[ ] [ "test" "test" add-module "test" remove-module ] unit-test \ No newline at end of file diff --git a/extra/llvm/jit/jit.factor b/extra/llvm/jit/jit.factor new file mode 100644 index 0000000000..f58851fe6f --- /dev/null +++ b/extra/llvm/jit/jit.factor @@ -0,0 +1,49 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.syntax assocs destructors +kernel llvm.core llvm.engine llvm.wrappers namespaces ; + +IN: llvm.jit + +SYMBOL: thejit + +TUPLE: jit ee mps ; + +: empty-engine ( -- engine ) + "initial-module" ; + +: ( -- jit ) + jit new empty-engine >>ee H{ } clone >>mps ; + +: (remove-functions) ( function -- ) + thejit get ee>> value>> over LLVMFreeMachineCodeForFunction + LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ; + +: remove-functions ( module -- ) + ! free machine code for each function in module + LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ; + +: remove-provider ( provider -- ) + thejit get ee>> value>> swap value>> f f + [ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when* + *void* module new swap >>value + [ value>> remove-functions ] with-disposal ; + +: remove-module ( name -- ) + dup thejit get mps>> at [ + remove-provider + thejit get mps>> delete-at + ] [ drop ] if* ; + +: add-module ( module name -- ) + [ ] dip [ remove-module ] keep + thejit get ee>> value>> pick + [ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal + thejit get mps>> set-at ; + +: function-pointer ( name -- alien ) + thejit get ee>> value>> dup + rot f [ LLVMFindFunction drop ] keep + *void* LLVMGetPointerToGlobal ; + +thejit [ ] initialize \ No newline at end of file diff --git a/extra/llvm/reader/add.bc b/extra/llvm/reader/add.bc new file mode 100644 index 0000000000..c0ba738d25 Binary files /dev/null and b/extra/llvm/reader/add.bc differ diff --git a/extra/llvm/reader/add.ll b/extra/llvm/reader/add.ll new file mode 100644 index 0000000000..4ac57a2af3 --- /dev/null +++ b/extra/llvm/reader/add.ll @@ -0,0 +1,5 @@ +define i32 @add(i32 %x, i32 %y) { +entry: + %sum = add i32 %x, %y + ret i32 %sum +} diff --git a/extra/llvm/reader/reader.factor b/extra/llvm/reader/reader.factor new file mode 100644 index 0000000000..8c324b41e4 --- /dev/null +++ b/extra/llvm/reader/reader.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.syntax destructors kernel +llvm.core llvm.engine llvm.jit llvm.wrappers ; + +IN: llvm.reader + +: buffer>module ( buffer -- module ) + [ + value>> f f + [ LLVMParseBitcode drop ] 2keep + *void* [ llvm-throw ] when* *void* + module new swap >>value + ] with-disposal ; + +: load-module ( path -- module ) + buffer>module ; + +: load-into-jit ( path name -- ) + [ load-module ] dip add-module ; \ No newline at end of file diff --git a/extra/llvm/tags.txt b/extra/llvm/tags.txt new file mode 100644 index 0000000000..bb863cf9a0 --- /dev/null +++ b/extra/llvm/tags.txt @@ -0,0 +1 @@ +bindings diff --git a/extra/llvm/types/types-tests.factor b/extra/llvm/types/types-tests.factor new file mode 100644 index 0000000000..d715fe97df --- /dev/null +++ b/extra/llvm/types/types-tests.factor @@ -0,0 +1,40 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel llvm.types sequences tools.test ; + +[ T{ integer f 32 } ] [ " i32 " parse-type ] unit-test +[ float ] [ " float " parse-type ] unit-test +[ T{ pointer f f x86_fp80 } ] [ " x86_fp80 * " parse-type ] unit-test +[ T{ vector f f 4 T{ integer f 32 } } ] [ " < 4 x i32 > " parse-type ] unit-test +[ T{ struct f f { float double } f } ] [ TYPE: { float , double } ; ] unit-test +[ T{ array f f 0 float } ] [ TYPE: [ 0 x float ] ; ] unit-test + +[ label void metadata ] +[ [ " label " " void " " metadata " ] [ parse-type ] each ] unit-test + +[ T{ function f f float { float float } t } ] +[ TYPE: float ( float , float , ... ) ; ] unit-test + +[ T{ struct f f { float TYPE: i32 (i32)* ; } t } ] +[ TYPE: < { float, i32 (i32)* } > ; ] unit-test + +[ t ] [ TYPE: i32 ; TYPE: i32 ; [ >tref ] bi@ = ] unit-test +[ t ] [ TYPE: i32 * ; TYPE: i32 * ; [ >tref ] bi@ = ] unit-test + +[ TYPE: i32 ; ] [ TYPE: i32 ; >tref tref> ] unit-test +[ TYPE: float ; ] [ TYPE: float ; >tref tref> ] unit-test +[ TYPE: double ; ] [ TYPE: double ; >tref tref> ] unit-test +[ TYPE: x86_fp80 ; ] [ TYPE: x86_fp80 ; >tref tref> ] unit-test +[ TYPE: fp128 ; ] [ TYPE: fp128 ; >tref tref> ] unit-test +[ TYPE: ppc_fp128 ; ] [ TYPE: ppc_fp128 ; >tref tref> ] unit-test +[ TYPE: opaque ; ] [ TYPE: opaque ; >tref tref> ] unit-test +[ TYPE: label ; ] [ TYPE: label ; >tref tref> ] unit-test +[ TYPE: void ; ] [ TYPE: void ; >tref tref> ] unit-test +[ TYPE: i32* ; ] [ TYPE: i32* ; >tref tref> ] unit-test +[ TYPE: < 2 x i32 > ; ] [ TYPE: < 2 x i32 > ; >tref tref> ] unit-test +[ TYPE: [ 0 x i32 ] ; ] [ TYPE: [ 0 x i32 ] ; >tref tref> ] unit-test +[ TYPE: { i32, i32 } ; ] [ TYPE: { i32, i32 } ; >tref tref> ] unit-test +[ TYPE: < { i32, i32 } > ; ] [ TYPE: < { i32, i32 } > ; >tref tref> ] unit-test +[ TYPE: i32 ( i32 ) ; ] [ TYPE: i32 ( i32 ) ; >tref tref> ] unit-test +[ TYPE: \1* ; ] [ TYPE: \1* ; >tref tref> ] unit-test +[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test \ No newline at end of file diff --git a/extra/llvm/types/types.factor b/extra/llvm/types/types.factor new file mode 100644 index 0000000000..a88c45c6cf --- /dev/null +++ b/extra/llvm/types/types.factor @@ -0,0 +1,246 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators kernel llvm.core +locals math.parser math multiline +namespaces parser peg.ebnf sequences +sequences.deep specialized-arrays.alien strings vocabs words ; + +IN: llvm.types + +! Type resolution strategy: +! pass 1: +! create the type with uprefs mapped to opaque types +! cache typerefs in enclosing types for pass 2 +! if our type is concrete, then we are done +! +! pass 2: +! wrap our abstract type in a type handle +! create a second type, using the cached enclosing type info +! resolve the first type to the second +! +GENERIC: (>tref) ( type -- LLVMTypeRef ) +GENERIC: ((tref>)) ( LLVMTypeRef type -- type ) +GENERIC: c-type ( type -- str ) + +! default implementation for simple types +M: object ((tref>)) nip ; +: unsupported-type ( -- ) + "cannot generate c-type: unsupported llvm type" throw ; +M: object c-type unsupported-type ; + +TUPLE: integer size ; +C: integer + +M: integer (>tref) size>> LLVMIntType ; +M: integer ((tref>)) swap LLVMGetIntTypeWidth >>size ; +M: integer c-type size>> { + { 64 [ "longlong" ] } + { 32 [ "int" ] } + { 16 [ "short" ] } + { 8 [ "char" ] } + [ unsupported-type ] +} case ; + +SINGLETONS: float double x86_fp80 fp128 ppc_fp128 ; + +M: float (>tref) drop LLVMFloatType ; +M: double (>tref) drop LLVMDoubleType ; +M: double c-type drop "double" ; +M: x86_fp80 (>tref) drop LLVMX86FP80Type ; +M: fp128 (>tref) drop LLVMFP128Type ; +M: ppc_fp128 (>tref) drop LLVMPPCFP128Type ; + +SINGLETONS: opaque label void metadata ; + +M: opaque (>tref) drop LLVMOpaqueType ; +M: label (>tref) drop LLVMLabelType ; +M: void (>tref) drop LLVMVoidType ; +M: void c-type drop "void" ; +M: metadata (>tref) drop + "metadata types unsupported by llvm c bindings" throw ; + +! enclosing types cache their llvm refs during +! the first pass, used in the second pass to +! resolve uprefs +TUPLE: enclosing cached ; + +GENERIC: clean ( type -- ) +GENERIC: clean* ( type -- ) +M: object clean drop ; +M: enclosing clean f >>cached clean* ; + +! builds the stack of types that uprefs need to refer to +SYMBOL: types +:: push-type ( type quot: ( type -- LLVMTypeRef ) -- LLVMTypeRef ) + type types get push + type quot call( type -- LLVMTypeRef ) + types get pop over >>cached drop ; + +DEFER: +:: push-ref ( ref quot: ( LLVMTypeRef -- type ) -- type ) + ref types get index + [ types get length swap - ] [ + ref types get push + ref quot call( LLVMTypeRef -- type ) + types get pop drop + ] if* ; + +GENERIC: (>tref)* ( type -- LLVMTypeRef ) +M: enclosing (>tref) [ (>tref)* ] push-type ; + +DEFER: type-kind +GENERIC: (tref>)* ( LLVMTypeRef type -- type ) +M: enclosing ((tref>)) [ (tref>)* ] curry push-ref ; + +: (tref>) ( LLVMTypeRef -- type ) dup type-kind ((tref>)) ; + +TUPLE: pointer < enclosing type ; +: ( t -- o ) pointer new swap >>type ; + +M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ; +M: pointer clean* type>> clean ; +M: pointer (tref>)* swap LLVMGetElementType (tref>) >>type ; +M: pointer c-type type>> 8 = "char*" "void*" ? ; + +TUPLE: vector < enclosing size type ; +: ( s t -- o ) + vector new + swap >>type swap >>size ; + +M: vector (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMVectorType ; +M: vector clean* type>> clean ; +M: vector (tref>)* + over LLVMGetElementType (tref>) >>type + swap LLVMGetVectorSize >>size ; + +TUPLE: struct < enclosing types packed? ; +: ( ts p? -- o ) + struct new + swap >>packed? swap >>types ; + +M: struct (>tref)* + [ types>> [ (>tref) ] map >void*-array ] + [ types>> length ] + [ packed?>> 1 0 ? ] tri LLVMStructType ; +M: struct clean* types>> [ clean ] each ; +M: struct (tref>)* + over LLVMIsPackedStruct 0 = not >>packed? + swap dup LLVMCountStructElementTypes + [ LLVMGetStructElementTypes ] keep >array + [ (tref>) ] map >>types ; + +TUPLE: array < enclosing size type ; +: ( s t -- o ) + array new + swap >>type swap >>size ; + +M: array (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMArrayType ; +M: array clean* type>> clean ; +M: array (tref>)* + over LLVMGetElementType (tref>) >>type + swap LLVMGetArrayLength >>size ; + +SYMBOL: ... +TUPLE: function < enclosing return params vararg? ; +: ( ret params var? -- o ) + function new + swap >>vararg? swap >>params swap >>return ; + +M: function (>tref)* { + [ return>> (>tref) ] + [ params>> [ (>tref) ] map >void*-array ] + [ params>> length ] + [ vararg?>> 1 0 ? ] +} cleave LLVMFunctionType ; +M: function clean* [ return>> clean ] [ params>> [ clean ] each ] bi ; +M: function (tref>)* + over LLVMIsFunctionVarArg 0 = not >>vararg? + over LLVMGetReturnType (tref>) >>return + swap dup LLVMCountParamTypes + [ LLVMGetParamTypes ] keep >array + [ (tref>) ] map >>params ; + +: type-kind ( LLVMTypeRef -- class ) + LLVMGetTypeKind { + { LLVMVoidTypeKind [ void ] } + { LLVMFloatTypeKind [ float ] } + { LLVMDoubleTypeKind [ double ] } + { LLVMX86_FP80TypeKind [ x86_fp80 ] } + { LLVMFP128TypeKind [ fp128 ] } + { LLVMPPC_FP128TypeKind [ ppc_fp128 ] } + { LLVMLabelTypeKind [ label ] } + { LLVMIntegerTypeKind [ integer new ] } + { LLVMFunctionTypeKind [ function new ] } + { LLVMStructTypeKind [ struct new ] } + { LLVMArrayTypeKind [ array new ] } + { LLVMPointerTypeKind [ pointer new ] } + { LLVMOpaqueTypeKind [ opaque ] } + { LLVMVectorTypeKind [ vector new ] } + } case ; + +TUPLE: up-ref height ; +C: up-ref + +M: up-ref (>tref) + types get length swap height>> - types get nth + cached>> [ LLVMOpaqueType ] unless* ; + +: resolve-types ( typeref typeref -- typeref ) + over LLVMCreateTypeHandle [ LLVMRefineType ] dip + [ LLVMResolveTypeHandle ] keep LLVMDisposeTypeHandle ; + +: >tref-caching ( type -- LLVMTypeRef ) + V{ } clone types [ (>tref) ] with-variable ; + +: >tref ( type -- LLVMTypeRef ) + [ >tref-caching ] [ >tref-caching ] [ clean ] tri + 2dup = [ drop ] [ resolve-types ] if ; + +: tref> ( LLVMTypeRef -- type ) + V{ } clone types [ (tref>) ] with-variable ; + +: t. ( type -- ) + >tref + "type-info" LLVMModuleCreateWithName + [ "t" rot LLVMAddTypeName drop ] + [ LLVMDumpModule ] + [ LLVMDisposeModule ] tri ; + +EBNF: parse-type + +WhiteSpace = " "* + +Zero = "0" => [[ drop 0 ]] +LeadingDigit = [1-9] +DecimalDigit = [0-9] +Number = LeadingDigit:d (DecimalDigit)*:ds => [[ ds d prefix string>number ]] +WhiteNumberSpace = WhiteSpace Number:n WhiteSpace => [[ n ]] +WhiteZeroSpace = WhiteSpace (Zero | Number):n WhiteSpace => [[ n ]] + +Integer = "i" Number:n => [[ n ]] +FloatingPoint = ( "float" | "double" | "x86_fp80" | "fp128" | "ppc_fp128" ) => [[ "llvm.types" vocab lookup ]] +LabelVoidMetadata = ( "label" | "void" | "metadata" | "opaque" ) => [[ "llvm.types" vocab lookup ]] +Primitive = LabelVoidMetadata | FloatingPoint +Pointer = T:t WhiteSpace "*" => [[ t ]] +Vector = "<" WhiteNumberSpace:n "x" Type:t ">" => [[ n t ]] +StructureTypesList = "," Type:t => [[ t ]] +Structure = "{" Type:t (StructureTypesList)*:ts "}" => [[ ts t prefix >array f ]] +Array = "[" WhiteZeroSpace:n "x" Type:t "]" => [[ n t ]] +NoFunctionParams = "(" WhiteSpace ")" => [[ drop { } ]] +VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]] +ParamListContinued = "," (Type | VarArgs):t => [[ t ]] +ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]] +Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts delete ] when t ts >array rot ]] +PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t ]] +UpReference = "\\" Number:n => [[ n ]] +Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]] + +T = Pointer | Function | Primitive | Integer | Vector | Structure | PackedStructure | Array | UpReference | Name + +Type = WhiteSpace T:t WhiteSpace => [[ t ]] + +Program = Type + +;EBNF + +SYNTAX: TYPE: ";" parse-multiline-string parse-type parsed ; \ No newline at end of file diff --git a/extra/llvm/wrappers/wrappers-tests.factor b/extra/llvm/wrappers/wrappers-tests.factor new file mode 100644 index 0000000000..b9f3a7ad32 --- /dev/null +++ b/extra/llvm/wrappers/wrappers-tests.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: destructors kernel llvm.wrappers sequences tools.test vocabs ; + +[ ] [ "test" dispose ] unit-test +[ ] [ "test" dispose ] unit-test +[ ] [ "llvm.jit" vocabs member? [ "test" dispose ] unless ] unit-test \ No newline at end of file diff --git a/extra/llvm/wrappers/wrappers.factor b/extra/llvm/wrappers/wrappers.factor new file mode 100644 index 0000000000..a1d757e7e9 --- /dev/null +++ b/extra/llvm/wrappers/wrappers.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2009 Matthew Willis. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.strings +io.encodings.utf8 destructors kernel +llvm.core llvm.engine ; + +IN: llvm.wrappers + +: llvm-throw ( char* -- ) + [ utf8 alien>string ] [ LLVMDisposeMessage ] bi throw ; + +: ( alien class -- disposable ) new swap >>value ; + +TUPLE: module value disposed ; +M: module dispose* value>> LLVMDisposeModule ; + +: ( name -- module ) + LLVMModuleCreateWithName module ; + +TUPLE: provider value module disposed ; +M: provider dispose* value>> LLVMDisposeModuleProvider ; + +: (provider) ( module -- provider ) + [ value>> LLVMCreateModuleProviderForExistingModule provider ] + [ t >>disposed value>> ] bi + >>module ; + +: ( module -- provider ) + [ (provider) ] with-disposal ; + +TUPLE: engine value disposed ; +M: engine dispose* value>> LLVMDisposeExecutionEngine ; + +: (engine) ( provider -- engine ) + [ + value>> f f + [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep + *void* [ llvm-throw ] when* *void* + ] + [ t >>disposed drop ] bi + engine ; + +: ( provider -- engine ) + [ (engine) ] with-disposal ; + +: (add-block) ( name -- basic-block ) + "function" swap LLVMAppendBasicBlock ; + +TUPLE: builder value disposed ; +M: builder dispose* value>> LLVMDisposeBuilder ; + +: ( name -- builder ) + (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep + builder ; + +TUPLE: buffer value disposed ; +M: buffer dispose* value>> LLVMDisposeMemoryBuffer ; + +: ( path -- module ) + f f + [ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep + *void* [ llvm-throw ] when* *void* buffer ; \ No newline at end of file