├── .gitattributes ├── .gitignore ├── .gitlab-ci.yml ├── Makefile ├── Makefile.build ├── README.md ├── api ├── bind.sh ├── cuda-device.wrp ├── cuda-host.wrp ├── cuda_api_device.gpr ├── cuda_api_host.gpr ├── cuda_internal │ ├── cuda-internal.adb │ ├── cuda-internal.ads │ └── cuda.ads ├── device_static │ ├── cuda-device_atomic_functions.ads │ ├── cuda-runtime_api.adb │ ├── cuda-runtime_api.ads │ ├── cuda-storage_models.ads │ ├── cuda-vector_types.ads │ ├── cuda.adb │ ├── cuda.ads │ └── cuda_wrapper.ads ├── host_static │ ├── cuda-device_atomic_functions.ads │ ├── cuda-storage_models.adb │ └── cuda-storage_models.ads └── hotfix.pl ├── build-rts.py ├── compute_capability.sh ├── doc ├── Makefile ├── adacore-logo-white.png ├── build_architecture.rst ├── conf.py ├── favicon.ico ├── index.rst ├── installation.rst ├── intro.rst ├── limitations.rst ├── make.bat ├── marching.png ├── performances.rst ├── programming.rst └── tutorial.rst ├── env.sh ├── examples ├── 0_Introduction │ ├── asyncAPI │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ └── src │ │ │ ├── common │ │ │ ├── kernels.adb │ │ │ └── kernels.ads │ │ │ └── host │ │ │ └── main.adb │ ├── matrixMul │ │ ├── Makefile │ │ ├── README.md │ │ ├── device.gpr │ │ ├── host.gpr │ │ └── src │ │ │ ├── common │ │ │ ├── kernel.adb │ │ │ └── kernel.ads │ │ │ └── host │ │ │ ├── host.adb │ │ │ ├── host.ads │ │ │ ├── main.adb │ │ │ ├── ref.adb │ │ │ └── ref.ads │ ├── simpleStreams │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ └── src │ │ │ ├── common │ │ │ ├── kernels.adb │ │ │ ├── kernels.ads │ │ │ └── support.ads │ │ │ └── host │ │ │ └── main.adb │ └── vectorAdd │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ └── src │ │ ├── common │ │ ├── kernel.adb │ │ └── kernel.ads │ │ └── host │ │ └── main.adb ├── image_filtering │ ├── Makefile │ ├── data │ │ ├── noisy_miners_bathing.qoi │ │ └── readme.txt │ ├── device.gpr │ ├── host.gpr │ └── src │ │ ├── common │ │ ├── graphic.ads │ │ └── kernels │ │ │ ├── bilateral_kernel.adb │ │ │ └── bilateral_kernel.ads │ │ └── host │ │ ├── bilateral_host.adb │ │ ├── bilateral_host.ads │ │ ├── exporter │ │ ├── exporter.adb │ │ └── exporter.ads │ │ ├── importer │ │ ├── importer.adb │ │ └── importer.ads │ │ ├── main.adb │ │ ├── parameters │ │ ├── generic_line_parser.adb │ │ ├── generic_line_parser.ads │ │ ├── parameters.adb │ │ └── parameters.ads │ │ └── qoi │ │ ├── qoi.adb │ │ └── qoi.ads └── marching │ ├── Makefile │ ├── device.gpr │ ├── host.gpr │ ├── openglada │ ├── CHANGELOG │ ├── COPYING │ ├── Makefile │ ├── README.md │ ├── common │ │ ├── controls.adb │ │ ├── controls.ads │ │ ├── cube_data.ads │ │ ├── initialize.adb │ │ ├── initialize.ads │ │ ├── keyboard_mouse.adb │ │ ├── load_dds.adb │ │ ├── load_dds.ads │ │ ├── main_loop.adb │ │ ├── main_loop.ads │ │ ├── maths.adb │ │ ├── maths.ads │ │ ├── program_loader.adb │ │ ├── program_loader.ads │ │ ├── quaternions.adb │ │ ├── quaternions.ads │ │ ├── utilities.adb │ │ └── utilities.ads │ ├── generate.gpr │ ├── opengl-ftgl.gpr │ ├── opengl-glfw.gpr │ ├── opengl-soil.gpr │ ├── opengl.gpr │ ├── opengl_shared.gpr │ └── src │ │ ├── ftgl │ │ ├── ftgl-api.ads │ │ ├── ftgl-errors.ads │ │ ├── ftgl-fonts.adb │ │ ├── ftgl-fonts.ads │ │ └── ftgl.ads │ │ ├── generator │ │ ├── generate.adb │ │ ├── specs.adb │ │ ├── specs.ads │ │ ├── tokenization.adb │ │ └── tokenization.ads │ │ ├── gl │ │ ├── generated │ │ │ ├── gl-api-doubles.ads │ │ │ ├── gl-api-ints.ads │ │ │ ├── gl-api-shorts.ads │ │ │ ├── gl-api-singles.ads │ │ │ ├── gl-api-uints.ads │ │ │ ├── gl-api.ads │ │ │ └── gl-load_function_pointers.adb │ │ ├── implementation │ │ │ ├── auto_exceptions │ │ │ │ └── gl-raise_exception_on_opengl_error.adb │ │ │ ├── gl-algebra.adb │ │ │ ├── gl-api-subprogram_reference.ads │ │ │ ├── gl-attributes.adb │ │ │ ├── gl-blending.adb │ │ │ ├── gl-buffers.adb │ │ │ ├── gl-context.adb │ │ │ ├── gl-culling.adb │ │ │ ├── gl-enums-getter.ads │ │ │ ├── gl-enums-indexes.adb │ │ │ ├── gl-enums-indexes.ads │ │ │ ├── gl-enums-textures.ads │ │ │ ├── gl-enums.ads │ │ │ ├── gl-errors.adb │ │ │ ├── gl-files.adb │ │ │ ├── gl-fixed-lighting.adb │ │ │ ├── gl-fixed-matrix.adb │ │ │ ├── gl-fixed-textures.adb │ │ │ ├── gl-fixed.adb │ │ │ ├── gl-framebuffer.adb │ │ │ ├── gl-helpers.adb │ │ │ ├── gl-helpers.ads │ │ │ ├── gl-immediate.adb │ │ │ ├── gl-low_level-enums.ads │ │ │ ├── gl-low_level.ads │ │ │ ├── gl-matrices.adb │ │ │ ├── gl-objects-buffers.adb │ │ │ ├── gl-objects-framebuffers.adb │ │ │ ├── gl-objects-lists.adb │ │ │ ├── gl-objects-programs.adb │ │ │ ├── gl-objects-renderbuffers.adb │ │ │ ├── gl-objects-shaders.adb │ │ │ ├── gl-objects-textures-targets.adb │ │ │ ├── gl-objects-textures-with_1d_loader.adb │ │ │ ├── gl-objects-textures-with_2d_loader.adb │ │ │ ├── gl-objects-textures-with_3d_loader.adb │ │ │ ├── gl-objects-textures.adb │ │ │ ├── gl-objects-vertex_arrays.adb │ │ │ ├── gl-objects.adb │ │ │ ├── gl-pixels.adb │ │ │ ├── gl-raster.adb │ │ │ ├── gl-rasterization.adb │ │ │ ├── gl-tessellation.adb │ │ │ ├── gl-toggles.adb │ │ │ ├── gl-uniforms.adb │ │ │ ├── gl-vectors.adb │ │ │ ├── gl-window.adb │ │ │ ├── gl.adb │ │ │ └── no_auto_exceptions │ │ │ │ └── gl-raise_exception_on_opengl_error.adb │ │ ├── interface │ │ │ ├── gl-algebra.ads │ │ │ ├── gl-attributes.ads │ │ │ ├── gl-blending.ads │ │ │ ├── gl-buffers.ads │ │ │ ├── gl-context.ads │ │ │ ├── gl-culling.ads │ │ │ ├── gl-errors.ads │ │ │ ├── gl-files.ads │ │ │ ├── gl-fixed-lighting.ads │ │ │ ├── gl-fixed-matrix.ads │ │ │ ├── gl-fixed-textures.ads │ │ │ ├── gl-fixed.ads │ │ │ ├── gl-framebuffer.ads │ │ │ ├── gl-immediate.ads │ │ │ ├── gl-matrices.ads │ │ │ ├── gl-objects-buffers.ads │ │ │ ├── gl-objects-framebuffers.ads │ │ │ ├── gl-objects-lists.ads │ │ │ ├── gl-objects-programs.ads │ │ │ ├── gl-objects-renderbuffers.ads │ │ │ ├── gl-objects-shaders-lists.ads │ │ │ ├── gl-objects-shaders.ads │ │ │ ├── gl-objects-textures-targets.ads │ │ │ ├── gl-objects-textures-with_1d_loader.ads │ │ │ ├── gl-objects-textures-with_2d_loader.ads │ │ │ ├── gl-objects-textures-with_3d_loader.ads │ │ │ ├── gl-objects-textures.ads │ │ │ ├── gl-objects-vertex_arrays.ads │ │ │ ├── gl-objects.ads │ │ │ ├── gl-pixels.ads │ │ │ ├── gl-raster.ads │ │ │ ├── gl-rasterization.ads │ │ │ ├── gl-tessellation.ads │ │ │ ├── gl-toggles.ads │ │ │ ├── gl-types-colors.ads │ │ │ ├── gl-types.ads │ │ │ ├── gl-uniforms.ads │ │ │ ├── gl-vectors.ads │ │ │ ├── gl-window.ads │ │ │ └── gl.ads │ │ ├── mac │ │ │ ├── gl-api-mac_os_x.adb │ │ │ ├── gl-api-mac_os_x.ads │ │ │ ├── gl-api-subprogram_reference.adb │ │ │ └── gl-cgl.ads │ │ ├── specs │ │ │ ├── gl-api-doubles.spec │ │ │ ├── gl-api-ints.spec │ │ │ ├── gl-api-shorts.spec │ │ │ ├── gl-api-singles.spec │ │ │ ├── gl-api-uints.spec │ │ │ └── gl-api.spec │ │ ├── windows │ │ │ ├── gl-api-subprogram_reference.adb │ │ │ └── gl-wgl.ads │ │ └── x11 │ │ │ ├── gl-api-subprogram_reference.adb │ │ │ └── gl-glx.ads │ │ ├── glfw │ │ ├── v2 │ │ │ ├── glfw-api.ads │ │ │ ├── glfw-display-modes.adb │ │ │ ├── glfw-display-modes.ads │ │ │ ├── glfw-display.adb │ │ │ ├── glfw-display.ads │ │ │ ├── glfw-enums.ads │ │ │ ├── glfw-events-joysticks.adb │ │ │ ├── glfw-events-joysticks.ads │ │ │ ├── glfw-events-keys.adb │ │ │ ├── glfw-events-keys.ads │ │ │ ├── glfw-events-mouse.adb │ │ │ ├── glfw-events-mouse.ads │ │ │ ├── glfw-events.adb │ │ │ ├── glfw-events.ads │ │ │ ├── glfw.adb │ │ │ └── glfw.ads │ │ └── v3 │ │ │ ├── glfw-api.ads │ │ │ ├── glfw-enums.ads │ │ │ ├── glfw-errors.adb │ │ │ ├── glfw-errors.ads │ │ │ ├── glfw-input-joysticks.adb │ │ │ ├── glfw-input-joysticks.ads │ │ │ ├── glfw-input-keys.ads │ │ │ ├── glfw-input-mouse.ads │ │ │ ├── glfw-input.adb │ │ │ ├── glfw-input.ads │ │ │ ├── glfw-monitors.adb │ │ │ ├── glfw-monitors.ads │ │ │ ├── glfw-windows-clipboard.adb │ │ │ ├── glfw-windows-clipboard.ads │ │ │ ├── glfw-windows-context.adb │ │ │ ├── glfw-windows-context.ads │ │ │ ├── glfw-windows-hints.adb │ │ │ ├── glfw-windows-hints.ads │ │ │ ├── glfw-windows.adb │ │ │ ├── glfw-windows.ads │ │ │ ├── glfw.adb │ │ │ └── glfw.ads │ │ └── soil │ │ ├── SOIL_C.c │ │ ├── SOIL_C.h │ │ ├── image_DXT.c │ │ ├── image_DXT.h │ │ ├── image_helper.c │ │ ├── image_helper.h │ │ ├── soil-api.ads │ │ ├── soil-images.adb │ │ ├── soil-images.ads │ │ ├── soil.adb │ │ ├── soil.ads │ │ ├── stb_image_aug.c │ │ ├── stb_image_aug.h │ │ ├── stbi_DDS_aug.h │ │ └── stbi_DDS_aug_c.h │ └── src │ ├── common │ ├── colors.adb │ ├── colors.ads │ ├── data.ads │ └── geometry.ads │ ├── device_code │ ├── marching_cubes-data.ads │ ├── marching_cubes.adb │ └── marching_cubes.ads │ ├── host │ ├── cameras.adb │ ├── cameras.ads │ ├── main.adb │ ├── paths.ads │ ├── ui.adb │ └── ui.ads │ └── shaders │ ├── frag.glsl │ ├── pbr.fs │ ├── pbr.vs │ └── vert.glsl ├── gen-rts-sources.py ├── locate_cuda_root.sh ├── runtime ├── __init__.py ├── cuda_sources.py └── device_gnat │ ├── a-nagefl.ads │ ├── a-ngelfu.ads │ ├── a-nuaufl.ads │ ├── a-nuelfu.ads │ ├── a-numeri.ads │ ├── a-unccon.ads │ ├── ada.ads │ ├── i-c.ads │ ├── i-cexten.ads │ ├── i-cpoint.adb │ ├── i-cpoint.ads │ ├── i-cstrin.ads │ ├── interfac.ads │ ├── machcode.ads │ ├── s-assert.adb │ ├── s-assert.ads │ ├── s-atacco.ads │ ├── s-atoope.ads │ ├── s-atopex.adb │ ├── s-atopex.ads │ ├── s-atopri.ads │ ├── s-maccod.ads │ ├── s-memory.adb │ ├── s-memory.ads │ ├── s-parame.ads │ ├── s-stoele.adb │ ├── s-stoele.ads │ ├── s-unstyp.ads │ ├── system.ads │ └── unchconv.ads ├── setup.sh ├── testsuite ├── tests │ ├── examples │ │ ├── matrixMul │ │ │ ├── test.out │ │ │ └── test.yaml │ │ └── vectorAdd │ │ │ ├── test.out │ │ │ └── test.yaml │ └── text_oracle │ │ ├── vectorAdd_elab │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ ├── src │ │ │ ├── common │ │ │ │ ├── kernel.adb │ │ │ │ └── kernel.ads │ │ │ └── host │ │ │ │ └── main.adb │ │ ├── test.out │ │ └── test.yaml │ │ ├── vectorAdd_exception │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ ├── src │ │ │ ├── common │ │ │ │ ├── kernel.adb │ │ │ │ └── kernel.ads │ │ │ └── host │ │ │ │ └── main.adb │ │ ├── test.out │ │ └── test.yaml │ │ ├── vectorAdd_linked │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ ├── src │ │ │ ├── common │ │ │ │ ├── device_functions.adb │ │ │ │ ├── device_functions.ads │ │ │ │ ├── kernel.adb │ │ │ │ └── kernel.ads │ │ │ └── host │ │ │ │ └── main.adb │ │ ├── test.out │ │ └── test.yaml │ │ ├── vectorAdd_raw │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ ├── src │ │ │ ├── common │ │ │ │ ├── kernel.adb │ │ │ │ └── kernel.ads │ │ │ └── host │ │ │ │ └── main.adb │ │ ├── test.out │ │ └── test.yaml │ │ └── vectorSqrt │ │ ├── Makefile │ │ ├── device.gpr │ │ ├── host.gpr │ │ ├── src │ │ ├── common │ │ │ ├── kernel.adb │ │ │ └── kernel.ads │ │ └── host │ │ │ └── main.adb │ │ ├── test.out │ │ └── test.yaml └── testsuite.py ├── tutorial ├── Makefile ├── device.gpr ├── host.gpr ├── src │ ├── common │ │ ├── kernel.adb │ │ └── kernel.ads │ └── host │ │ └── main.adb └── src_completed │ ├── common │ ├── kernel.adb │ └── kernel.ads │ └── host │ └── main.adb ├── wrapper-Makefile └── wrapper ├── src ├── gnatcuda_wrapper.adb └── gnatvsn.ads └── wrapper.gpr /.gitattributes: -------------------------------------------------------------------------------- 1 | *.ads text eol=lf 2 | *.adb text eol=lf 3 | *.gpr text eol=lf 4 | *.txt text eol=lf 5 | *.c text eol=lf 6 | *.wrp text eol=lf 7 | *.py text eol=lf 8 | *.sh text eol=lf 9 | *.rst text eol=lf 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | obj/ 2 | lib/ 3 | api/device 4 | api/host 5 | install/ 6 | __pycache__/ 7 | .#* 8 | .clang-format 9 | doc/_build/ 10 | main 11 | out/ 12 | testsuite/out/ 13 | 14 | # files generated by setup.sh 15 | Makefile.env 16 | api/architecture.gpr 17 | runtime/device_gnat/libdevice.ads 18 | 19 | # vscode 20 | .vscode -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | stages: 2 | - test 3 | - build 4 | 5 | check_syntax: 6 | stage: test 7 | services: 8 | - image:lint 9 | 10 | script: 11 | - autolint --check --output-code-climate-report=code_quality_report.json . 12 | 13 | artifacts: 14 | when: always 15 | reports: 16 | codequality: code_quality_report.json 17 | 18 | build-doc: 19 | services: 20 | - image:ada-trainings 21 | stage: build 22 | script: 23 | - make -C doc html SPHINXOPTS="-W --keep-going -n" 24 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | export PATH := install/bin:$(PATH) 2 | 3 | # Path to BB runtime's source repo 4 | BB_SRC := $(realpath ../bb-runtimes) 5 | ifeq (, $(BB_SRC)) 6 | $(error "Could not locate BB-Runtimes' directory") 7 | endif 8 | # Path to GNAT's source repo 9 | GNAT_SRC := $(realpath ../gnat) 10 | ifeq (, $(GNAT_SRC)) 11 | $(error "Could not locate GNAT source's directory") 12 | endif 13 | 14 | local_llvm := $(shell which llvm-gcc) 15 | ifeq (, $(local_llvm)) 16 | $(error "No llvm-gcc in PATH") 17 | endif 18 | $(info "LLVM's GCC : $(local_llvm)") 19 | 20 | llvm_dir := $(shell dirname $(dir $(local_llvm))) 21 | ifeq (, $(llvm_dir)) 22 | $(error "Could not locate LLVM's directory") 23 | endif 24 | $(info "LLVM directory: $(llvm_dir)") 25 | 26 | cuda_dir := $(shell sh locate_cuda_root.sh) 27 | ifeq (, $(cuda_dir)) 28 | $(error "Could not locate CUDA's directory") 29 | endif 30 | $(info "CUDA directory: $(cuda_dir)") 31 | 32 | libdevice.bc := $(shell find -L $(cuda_dir) -iname "libdevice.*.bc" | head -n 1) 33 | ifeq (, $(libdevice.bc)) 34 | $(error "Could not locate libdevice.*.bc") 35 | endif 36 | $(info "libdevice.bc : $(libdevice.bc)") 37 | 38 | export PATH := $(cuda_dir)/bin:$(PATH) 39 | 40 | .PHONY: main clean runtime 41 | 42 | main: install/bin runtime 43 | 44 | runtime: 45 | @echo "======================= RUNTIME BUILDING" 46 | rm -rf install/include/rts-sources/device_gnat 47 | ./gen-rts-sources.py --bb-dir $(BB_SRC) --gnat $(GNAT_SRC)/src/ada --rts-profile=light 48 | ./build-rts.py --bb-dir $(BB_SRC) --rts-src-descriptor install/lib/gnat/rts-sources.json cuda-device --force -b --mcpu $(GPU_ARCH) 49 | rm -rf install/lib/rts-device-cuda 50 | mv install/device-cuda install/lib/rts-device-cuda 51 | cp -R runtime/device_gnat/* install/lib/rts-device-cuda/gnat/ 52 | rm -rf $(llvm_dir)/lib/rts-device-cuda 53 | cp -p install/include/rts-sources/device_gnat/* install/lib/rts-device-cuda/gnat/ 54 | cp -pR install/lib/rts-device-cuda $(llvm_dir)/lib/rts-device-cuda 55 | 56 | install/bin: 57 | @echo "======================= INSTALL SETUP" 58 | mkdir -p install 59 | mkdir -p install/bin 60 | 61 | uninstall: 62 | rm $(llvm_dir)/bin/cuda-gcc 63 | rm -rf $(llvm_dir)/lib/rts-device-cuda 64 | 65 | clean: 66 | rm -rf install 67 | -------------------------------------------------------------------------------- /Makefile.build: -------------------------------------------------------------------------------- 1 | mkfile_path := $(abspath $(lastword $(MAKEFILE_LIST))) 2 | SELF_DIR := $(dir $(mkfile_path)) 3 | 4 | include $(SELF_DIR)Makefile.env 5 | 6 | gnatcuda: host 7 | 8 | host: device 9 | # gprbuild currently doesn't pass ADA_INCLUDE_PATH to gnatbind. We need to 10 | # set that manually so that cuda.ads can be found 11 | export ADA_INCLUDE_PATH="$(SELF_DIR)api/host/cuda_raw_binding:$(SELF_DIR)/api/host/cuda_api:$(SELF_DIR)api/cuda_internal" ; \ 12 | gprbuild -P host -largs $(CURDIR)/lib/*.fatbin.o 13 | 14 | device: 15 | gprbuild -P device 16 | 17 | # Use double-colon to permit extensions to the rule 18 | # when this file is included in another Makefile 19 | clean:: 20 | rm -f main 21 | rm -rf obj 22 | rm -rf lib 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # GNAT for CUDA 2 | 3 | GNAT for CUDA® is a toolsuite that compiles Ada and SPARK code directly to 4 | NVIDIA GPUs. We leverage the CUDA toolsuite provided by NVIDIA in order to 5 | create a toolsuite that follows the same programming principles that CUDA 6 | developers are familiar with, while providing access to these mechanisms 7 | through the Ada and SPARK programming languages. 8 | 9 | ## Documentation 10 | 11 | Full documentation of the GNAT for CUDA project can be found in folder doc. 12 | Use the commands below to build the html version 13 | 14 | ``` 15 | cd doc 16 | make hmtl 17 | ``` 18 | 19 | Or consult documentation of the makefile to see additional build options 20 | 21 | ``` 22 | cd doc 23 | make help 24 | ``` 25 | 26 | ## Status 27 | Beta 28 | 29 | ## Quickstart 30 | 31 | See the installation instructions provided in the documentation, 32 | [doc/installation.rst](doc/installation.rst) in particular. 33 | 34 | -------------------------------------------------------------------------------- /api/cuda_api_device.gpr: -------------------------------------------------------------------------------- 1 | with "architecture"; 2 | 3 | library project CUDA_API_Device is 4 | for Target use "cuda"; 5 | 6 | type CUDA_Host_Option is ("x86_64-linux", "aarch64-linux"); 7 | CUDA_Host : CUDA_Host_Option := external ("CUDA_HOST", "x86_64-linux"); 8 | 9 | for Library_Dir use "lib"; 10 | for Library_Name use "cuda_api_device"; 11 | 12 | for Source_Dirs use ("device_static"); 13 | for Object_Dir use "obj/device"; 14 | 15 | Compiler_Options := ("-gnatX0", "-O2", "-gnatn", "-mcpu=" & Architecture.GPU_Arch); 16 | Binder_Options := ("-d_d"); 17 | Library_Options := ("-mcpu=" & Architecture.GPU_Arch, "-cuda-host=" & CUDA_Host); 18 | 19 | package Compiler is 20 | for Switches ("ada") use Compiler_Options; 21 | end Compiler; 22 | 23 | end CUDA_API_Device; 24 | -------------------------------------------------------------------------------- /api/cuda_api_host.gpr: -------------------------------------------------------------------------------- 1 | project CUDA_API_Host is 2 | type CUDA_Host_Option is ("x86_64-linux", "aarch64-linux"); 3 | CUDA_Host : CUDA_Host_Option := external ("CUDA_HOST", "x86_64-linux"); 4 | 5 | CUDA_Root := external ("CUDA_ROOT"); 6 | 7 | for Target use CUDA_Host; 8 | 9 | for Source_Dirs use ("host/cuda_api", "host/cuda_raw_binding", "cuda_internal", "host_static"); 10 | 11 | for Object_Dir use "obj/host"; 12 | 13 | Compiler_Options := ("-gnatX0", "-gnatd_c"); 14 | Linker_Options := ( 15 | "-L" & CUDA_Root & "/targets/" & CUDA_Host & "/lib", 16 | "-L" & CUDA_Root &"/targets/" & CUDA_Host & "/lib/stubs", 17 | "-lcudadevrt", 18 | "-lcudart_static", 19 | "-lrt", 20 | "-lpthread", 21 | "-ldl", 22 | "-Wl,--unresolved-symbols=ignore-all" 23 | ); 24 | Binder_Options := ("-d_c=device"); 25 | 26 | package Compiler is 27 | for Switches ("Ada") use Compiler_Options; 28 | end Compiler; 29 | 30 | end CUDA_API_Host; 31 | -------------------------------------------------------------------------------- /api/cuda_internal/cuda-internal.adb: -------------------------------------------------------------------------------- 1 | package body CUDA.Internal is 2 | 3 | procedure Launch_Kernel 4 | (Func : System.Address; 5 | Grid_Dim : Dim3; 6 | Block_Dim : Dim3; 7 | Args : System.Address; 8 | Shared_Mem : Interfaces.C.Unsigned_Long; 9 | Stream : CUDA.Driver_Types.Stream_T) 10 | is 11 | use Interfaces.C; 12 | 13 | function Internal 14 | (Func : System.Address; 15 | Grid_Dim : Dim3; 16 | Block_Dim : Dim3; 17 | Args : System.Address; 18 | Shared_Mem : Interfaces.C.Unsigned_Long; 19 | Stream : CUDA.Driver_Types.Stream_T) return Interfaces.C.int 20 | with Import => True, 21 | Convention => C, 22 | External_Name => "cudaLaunchKernel"; 23 | 24 | R : Interfaces.C.int; 25 | begin 26 | R := Internal (Func, Grid_Dim, Block_Dim, Args, Shared_Mem, Stream); 27 | 28 | if R /= 0 then 29 | raise Program_Error with "cudaLaunchKernel error:" & R'Img; 30 | end if; 31 | end Launch_Kernel; 32 | 33 | end CUDA.Internal; 34 | -------------------------------------------------------------------------------- /api/cuda_internal/cuda.ads: -------------------------------------------------------------------------------- 1 | -- This is a temporary workaround to ensure that cuda.internal is 2 | -- always linked in a CUDA application. Otherwise, the object is 3 | -- only referred to in the binder and doesn't get added at link-time. 4 | limited with CUDA.Internal; 5 | 6 | package CUDA is 7 | 8 | end CUDA; 9 | -------------------------------------------------------------------------------- /api/device_static/cuda-runtime_api.ads: -------------------------------------------------------------------------------- 1 | with Interfaces.C; 2 | with CUDA.Vector_Types; 3 | 4 | package CUDA.Runtime_Api is 5 | 6 | function Grid_Dim return CUDA.Vector_Types.Dim3 with 7 | Inline; 8 | function Block_Idx return CUDA.Vector_Types.Uint3 with 9 | Inline; 10 | function Block_Dim return CUDA.Vector_Types.Dim3 with 11 | Inline; 12 | function Thread_Idx return CUDA.Vector_Types.Uint3 with 13 | Inline; 14 | function Warp_Size return Interfaces.C.int with 15 | Inline; 16 | procedure Sync_Threads with Inline; 17 | -- bind CUDA procedure __syncthreads() 18 | -- which is a shorthand for LLVM intrinsic 19 | -- declare void @llvm.nvvm.barrier0() 20 | -- https://www.llvm.org/docs/NVPTXUsage.html#llvm-nvvm-barrier0 21 | 22 | end CUDA.Runtime_Api; 23 | -------------------------------------------------------------------------------- /api/device_static/cuda-storage_models.ads: -------------------------------------------------------------------------------- 1 | with System; use System; 2 | with System.Storage_Elements; use System.Storage_Elements; 3 | 4 | package CUDA.Storage_Models is 5 | 6 | type CUDA_Address is new System.Address; 7 | 8 | type CUDA_Storage_Model is limited record 9 | null; 10 | end record 11 | with Storage_Model_Type; 12 | 13 | type CUDA_Async_Storage_Model is limited record 14 | null; 15 | end record 16 | with Storage_Model_Type; 17 | 18 | Model : CUDA_Storage_Model; 19 | 20 | end CUDA.Storage_Models; 21 | -------------------------------------------------------------------------------- /api/device_static/cuda.adb: -------------------------------------------------------------------------------- 1 | with Interfaces.C.Strings; 2 | 3 | package body CUDA is 4 | 5 | procedure Last_Chance_Handler 6 | (File : System.Address; Line : Integer) 7 | is 8 | procedure Assert_Fail 9 | (Assertion : Interfaces.C.char_array; 10 | File : System.Address; 11 | Line : Interfaces.C.unsigned; 12 | Func : Interfaces.C.char_array; 13 | CharSize : Interfaces.C.size_t) 14 | with Import, 15 | Convention => C, 16 | Link_Name => "__assertfail"; 17 | begin 18 | Assert_Fail ( 19 | (1 => interfaces.C.char (ASCII.nul)), 20 | File, 21 | Interfaces.C.unsigned (Line), 22 | (1 => interfaces.C.char (ASCII.nul)), 23 | 1); 24 | end Last_Chance_Handler; 25 | 26 | end CUDA; 27 | -------------------------------------------------------------------------------- /api/device_static/cuda.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package CUDA is 4 | 5 | procedure Last_Chance_Handler 6 | (File : System.Address; Line : Integer); 7 | pragma Export (C, Last_Chance_Handler, "__gnat_last_chance_handler"); 8 | 9 | end CUDA; 10 | -------------------------------------------------------------------------------- /api/device_static/cuda_wrapper.ads: -------------------------------------------------------------------------------- 1 | generic 2 | type T is private; 3 | package CUDA_Wrapper is 4 | 5 | type T_Access is access all T; 6 | 7 | type Array_T is array (Natural range <>) of aliased T; 8 | type Array_Access is access all Array_T; 9 | 10 | end CUDA_Wrapper; 11 | -------------------------------------------------------------------------------- /api/host_static/cuda-device_atomic_functions.ads: -------------------------------------------------------------------------------- 1 | with Interfaces.C; use Interfaces.C; 2 | 3 | package CUDA.Device_Atomic_Functions is 4 | 5 | function Atomic_Add 6 | (Address : access int; Value : int; Ordering : int := 0) return int with 7 | Convention => Intrinsic, 8 | Import, 9 | External_Name => "__atomic_fetch_add_4"; 10 | 11 | function Atomic_Add 12 | (Address : access Integer; Value : Integer; Ordering : Integer := 0) return Integer with 13 | Convention => Intrinsic, 14 | Import, 15 | External_Name => "__atomic_fetch_add_4"; 16 | 17 | end CUDA.Device_Atomic_Functions; 18 | -------------------------------------------------------------------------------- /build-rts.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | # 3 | # Copyright (C) 2016-2020, AdaCore 4 | # 5 | # Python script to gather files for the bareboard runtime. 6 | # Don't use any fancy features. Ideally, this script should work with any 7 | # Python version starting from 2.6 (yes, it's very old but that's the system 8 | # python on oldest host). 9 | 10 | import os 11 | import sys 12 | 13 | # look for --bb-dir to add it to the sys path 14 | # also extract --mcpu 15 | path = None 16 | gpu_arch = None 17 | index = 0 18 | 19 | while index < len(sys.argv): 20 | arg = sys.argv[index] 21 | if arg.startswith("--bb-dir="): 22 | _, path = arg.split("=") 23 | sys.argv.remove(arg) 24 | break 25 | elif arg == "--bb-dir": 26 | path = sys.argv[index + 1] 27 | sys.argv.remove(sys.argv[index + 1]) 28 | sys.argv.remove(arg) 29 | elif arg == "--mcpu": 30 | gpu_arch = sys.argv[index + 1] 31 | sys.argv.remove(sys.argv[index + 1]) 32 | sys.argv.remove(arg) 33 | else: 34 | index += 1 35 | 36 | assert path is not None, "missing --bb-dir switch" 37 | sys.path.append(os.path.abspath(path)) 38 | 39 | # import the main build script 40 | import build_rts 41 | from support import add_source_search_path 42 | 43 | # now our runtime support 44 | from runtime import CUDADevice 45 | 46 | 47 | def build_configs(target): 48 | "Customized targets to build specific runtimes" 49 | if target == "cuda-device": 50 | t = CUDADevice() 51 | t.gpu_arch = gpu_arch 52 | else: 53 | assert False, "unexpected target '%s'" % target 54 | 55 | return t 56 | 57 | 58 | def instrument_bb_runtimes(): 59 | # Add this directory in the BSP sources search path 60 | PWD = os.path.dirname(__file__) 61 | add_source_search_path(PWD) 62 | add_source_search_path(os.path.join(PWD, "..")) 63 | 64 | # Patch build_rts.build_configs to return the customized targets 65 | build_rts.build_configs = build_configs 66 | 67 | 68 | if __name__ == "__main__": 69 | # patch bb-runtimes to use our sources 70 | instrument_bb_runtimes() 71 | # and build the runtime tree 72 | build_rts.main() 73 | # build_cuda() 74 | -------------------------------------------------------------------------------- /compute_capability.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -e 3 | 4 | usage() { 5 | echo "usage: $(basename "$0") [--expect-single | -s] [--no-expect-single | -S] [--compute-prefix | -c] [--sm-prefix | -C]" 6 | } 7 | 8 | expect_single=0 9 | compute_prefix=1 10 | while [ -n "$1" ]; do 11 | case $1 in 12 | -c|--compute-prefix) 13 | compute_prefix=1 14 | ;; 15 | -C|--sm-prefix) 16 | compute_prefix=0 17 | ;; 18 | -s|--expect-single) 19 | expect_single=1 20 | ;; 21 | -S|--no-expect-single) 22 | expect_single=0 23 | ;; 24 | -h|--help) 25 | usage 26 | exit 0 27 | ;; 28 | *) 29 | echo "unknown arg $1" >&2 30 | usage 31 | exit 2 32 | ;; 33 | esac 34 | 35 | shift 36 | done 37 | 38 | csv=$(nvidia-smi --query-gpu=compute_cap --format=csv) 39 | cap=$(echo "$csv" | tail -n +2 | tr -d '. \t') 40 | if [ -z "$cap" ]; then 41 | number=0 42 | else 43 | number=$(echo "$cap" | wc -l) 44 | fi 45 | 46 | # number of GPU 47 | if [ "$expect_single" -eq 0 ]; then 48 | echo "$number GPU" 49 | elif [ "$number" -ne 1 ]; then 50 | echo "expected a single GPU, found $number" >&2 51 | exit 1 52 | fi 53 | 54 | # capacity 55 | if [ "$number" -ne 0 ]; then 56 | echo "$cap" | while read -r c; do 57 | if [ $compute_prefix -eq 0 ]; then 58 | prefix="sm_" 59 | else 60 | prefix="compute_" 61 | fi 62 | echo "$prefix$c" 63 | done 64 | fi 65 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line, and also 5 | # from the environment for the first two. 6 | SPHINXOPTS ?= 7 | SPHINXBUILD ?= sphinx-build 8 | SOURCEDIR = . 9 | BUILDDIR = _build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | MAKEFILE = Makefile $(shell pwd)/Makefile 16 | 17 | .PHONY: help $(MAKEFILE) 18 | 19 | # Catch-all target: route all unknown targets to Sphinx using the new 20 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 21 | %: $(MAKEFILE) 22 | $(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 23 | -------------------------------------------------------------------------------- /doc/adacore-logo-white.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/cuda/74bfa151cff96345a74c3b2601f82148703ff927/doc/adacore-logo-white.png -------------------------------------------------------------------------------- /doc/conf.py: -------------------------------------------------------------------------------- 1 | # Configuration file for the Sphinx documentation builder. 2 | # 3 | # This file only contains a selection of the most common options. For a full 4 | # list see the documentation: 5 | # https://www.sphinx-doc.org/en/master/usage/configuration.html 6 | 7 | # -- Path setup -------------------------------------------------------------- 8 | 9 | # If extensions (or modules to document with autodoc) are in another directory, 10 | # add these directories to sys.path here. If the directory is relative to the 11 | # documentation root, use os.path.abspath to make it absolute, like shown here. 12 | # 13 | # import os 14 | # import sys 15 | # sys.path.insert(0, os.path.abspath('.')) 16 | 17 | 18 | # -- Project information ----------------------------------------------------- 19 | 20 | project = "GNAT for CUDA®" 21 | copyright = "2022, AdaCore" 22 | author = "AdaCore" 23 | 24 | 25 | # -- General configuration --------------------------------------------------- 26 | 27 | # Add any Sphinx extension module names here, as strings. They can be 28 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 29 | # ones. 30 | extensions = [] 31 | 32 | # Add any paths that contain templates here, relative to this directory. 33 | templates_path = ["_templates"] 34 | 35 | # List of patterns, relative to source directory, that match files and 36 | # directories to ignore when looking for source files. 37 | # This pattern also affects html_static_path and html_extra_path. 38 | exclude_patterns = ["_build", "Thumbs.db", ".DS_Store"] 39 | 40 | # -- Options for HTML output ------------------------------------------------- 41 | 42 | # The theme to use for HTML and HTML Help pages. See the documentation for 43 | # a list of builtin themes. 44 | # 45 | html_theme = "sphinx_rtd_theme" 46 | 47 | html_theme_options = { 48 | "style_nav_header_background": "#12284c", 49 | } 50 | 51 | html_logo = "adacore-logo-white.png" 52 | html_favicon = "favicon.ico" 53 | -------------------------------------------------------------------------------- /doc/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/cuda/74bfa151cff96345a74c3b2601f82148703ff927/doc/favicon.ico -------------------------------------------------------------------------------- /doc/index.rst: -------------------------------------------------------------------------------- 1 | .. GNAT for CUDA documentation master file, created by 2 | sphinx-quickstart on Wed May 4 17:13:54 2022. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Welcome to GNAT for CUDA®! 7 | ========================== 8 | 9 | .. toctree:: 10 | :numbered: 11 | :maxdepth: 2 12 | :caption: Contents: 13 | 14 | intro 15 | installation 16 | tutorial 17 | build_architecture 18 | programming 19 | performances 20 | limitations 21 | 22 | Indices and tables 23 | ================== 24 | 25 | * :ref:`genindex` 26 | * :ref:`search` 27 | -------------------------------------------------------------------------------- /doc/intro.rst: -------------------------------------------------------------------------------- 1 | ************************************** 2 | Welcome to GNAT for CUDA® 3 | ************************************** 4 | 5 | GNAT for CUDA® is a toolsuite that compiles Ada and SPARK code directly to 6 | NVIDIA GPUs. We leverage the CUDA toolsuite provided by NVIDIA in order to 7 | create a toolsuite that follows the same programming principles that CUDA 8 | developers are familiar with, while providing access to these mechanisms 9 | through the Ada and SPARK programming languages. 10 | 11 | This document assumes an advanced understanding of NVIDIA's CUDA 12 | toolsuite, documented `here `_. 13 | 14 | This product is currently under development and is presented as a prototype 15 | to allow engineers to experiment with its capabilities. More features will 16 | be added and the list of limitations reduced as work continues. 17 | 18 | CUDA® is a trademark of NVIDIA Corporation. 19 | -------------------------------------------------------------------------------- /doc/limitations.rst: -------------------------------------------------------------------------------- 1 | ************************************** 2 | Current Limitations 3 | ************************************** 4 | 5 | .. role:: switch(samp) 6 | 7 | - You can only link one standalone device library to a host 8 | program. However, that device library can itself include multiple 9 | static libraries. 10 | - Exception propagation is not supported on the device. 11 | - The binding to the CUDA API is incomplete, both on the host and the device. 12 | - Tagged types cannot be passed between the host and the device. 13 | - Parameters that can be passed to a :code:`CUDA_Execute` call are 14 | limited input mode. 15 | - The toolchain is only hosted on Linux; support for Windows hosts is 16 | not yet available. 17 | - Debugging is currently not supported on the device. The :switch:`-g` 18 | switch has no effect when compiling for the device. 19 | -------------------------------------------------------------------------------- /doc/make.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | pushd %~dp0 4 | 5 | REM Command file for Sphinx documentation 6 | 7 | if "%SPHINXBUILD%" == "" ( 8 | set SPHINXBUILD=sphinx-build 9 | ) 10 | set SOURCEDIR=. 11 | set BUILDDIR=_build 12 | 13 | if "%1" == "" goto help 14 | 15 | %SPHINXBUILD% >NUL 2>NUL 16 | if errorlevel 9009 ( 17 | echo. 18 | echo.The 'sphinx-build' command was not found. Make sure you have Sphinx 19 | echo.installed, then set the SPHINXBUILD environment variable to point 20 | echo.to the full path of the 'sphinx-build' executable. Alternatively you 21 | echo.may add the Sphinx directory to PATH. 22 | echo. 23 | echo.If you don't have Sphinx installed, grab it from 24 | echo.http://sphinx-doc.org/ 25 | exit /b 1 26 | ) 27 | 28 | %SPHINXBUILD% -M %1 %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 29 | goto end 30 | 31 | :help 32 | %SPHINXBUILD% -M help %SOURCEDIR% %BUILDDIR% %SPHINXOPTS% %O% 33 | 34 | :end 35 | popd 36 | -------------------------------------------------------------------------------- /doc/marching.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/cuda/74bfa151cff96345a74c3b2601f82148703ff927/doc/marching.png -------------------------------------------------------------------------------- /env.sh: -------------------------------------------------------------------------------- 1 | # shellcheck shell=sh 2 | # this file is SUPPOSED TO BE SOURCED 3 | # so, no shebang, no set -e 4 | 5 | # https://stackoverflow.com/a/28776166 6 | # Cannot detect if the script is being sourced from within a script 7 | # in that case set the env var NO_SOURCED_CHECK 8 | is_sourced() { 9 | if [ -n "$ZSH_VERSION" ]; then 10 | case $ZSH_EVAL_CONTEXT in *:file:*) return 0;; esac 11 | else # Add additional POSIX-compatible shell names here, if needed. 12 | case ${0##*/} in dash|-dash|bash|-bash|ksh|-ksh|sh|-sh) return 0;; esac 13 | fi 14 | return 1 # NOT sourced. 15 | } 16 | 17 | if [ -z "$NO_SOURCED_CHECK" ]; then 18 | if ! is_sourced || ! [ -f "$PWD/env.sh" ] ; then 19 | echo "This script is meant to be sourced from its own directory" 20 | exit 2 21 | fi 22 | fi 23 | 24 | CURRENT=$(pwd) 25 | ROOT="$CURRENT/.." 26 | 27 | # being sourced, must be super careful with error return value 28 | CUDA_ROOT=$("$SHELL" "$CURRENT/locate_cuda_root.sh") || return 2 29 | export CUDA_ROOT # direct export would gobble up eventual error 30 | 31 | export GPR_PROJECT_PATH="$ROOT/cuda/api/install/share/gpr" 32 | export PATH="$ROOT/llvm-ads/bin:$ROOT/uwrap/bin:$PATH:$ROOT/gnat-llvm/bin" 33 | -------------------------------------------------------------------------------- /examples/0_Introduction/asyncAPI/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../Makefile.build 2 | 3 | clean:: 4 | rm -f asyncAPI 5 | -------------------------------------------------------------------------------- /examples/0_Introduction/asyncAPI/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernels"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /examples/0_Introduction/asyncAPI/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use Cuda_Api_Host.Cuda_Host; 11 | 12 | package Builder is 13 | for Executable ("main.adb") use "asyncAPI"; 14 | end Builder; 15 | 16 | package Compiler is 17 | for Switches ("ada") use Cuda_Api_Host.Compiler_Options; 18 | end Compiler; 19 | 20 | package Linker is 21 | for Switches ("ada") use Cuda_Api_Host.Linker_Options; 22 | end Linker; 23 | 24 | package Binder is 25 | for Default_Switches ("ada") use Cuda_Api_Host.Binder_Options; 26 | end Binder; 27 | 28 | end Host; 29 | 30 | -------------------------------------------------------------------------------- /examples/0_Introduction/asyncAPI/src/common/kernels.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; 2 | with Interfaces.C; use Interfaces.C; 3 | 4 | package body Kernels is 5 | 6 | ---------------------- 7 | -- Increment_Kernel -- 8 | ---------------------- 9 | 10 | procedure Increment_Kernel 11 | (G_Data : Array_Device_Access; Inc_Value : Integer) 12 | is 13 | Offset : constant Integer := 14 | Integer (Block_IDx.X * Block_Dim.X + Thread_IDx.X); 15 | Idx : constant Integer := G_Data'First + Offset; 16 | begin 17 | G_Data (Idx) := G_Data (Idx) + Inc_Value; 18 | end Increment_Kernel; 19 | 20 | end Kernels; 21 | -------------------------------------------------------------------------------- /examples/0_Introduction/asyncAPI/src/common/kernels.ads: -------------------------------------------------------------------------------- 1 | with CUDA.Storage_Models; 2 | 3 | package Kernels is 4 | 5 | type Int_Array is array (Integer range <>) of Integer; 6 | 7 | Stream_Model : CUDA.Storage_Models.CUDA_Async_Storage_Model; 8 | 9 | type Array_Device_Access is access Int_Array with 10 | Designated_Storage_Model => Stream_Model; 11 | 12 | procedure Increment_Kernel 13 | (G_Data : Array_Device_Access; Inc_Value : Integer) with 14 | Cuda_Global; 15 | 16 | end Kernels; 17 | -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../Makefile.build 2 | -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/README.md: -------------------------------------------------------------------------------- 1 | # matrixMul - Matrix Multiplication (CUDA Runtime API Version) 2 | 3 | ## Description 4 | This sample demonstrates implementation of matrix multiplication in Ada. 5 | The goal is to translate the corresponding example from NVIDIA cuda-samples repository 6 | (https://github.com/NVIDIA/cuda-samples/tree/master/Samples/0_Introduction/matrixMul) 7 | as close as possible. The original C code is preserved in comments to illustrate 8 | the mapping from one language to the other. 9 | 10 | As a notable difference, the translation doesn't implement the -device 11 | argument. The code chooses the default GPU. 12 | 13 | The testing algorithm fills the input matrices with a constant value. 14 | It also contains a simple iterative computation of matrix multiplication, 15 | which can can be used for validating the computation when a si,le constant input is replaced with random values and/or for performance comparisons. 16 | 17 | ## Usage 18 | 19 | $ cd 20 | $ make 21 | 22 | Run with the default settings that multiply 320x320 matrix with 640x320 matrix 23 | 24 | $ ./main 25 | 26 | The matrix dimensions can be changes with corresponding parameters: 27 | 28 | $ ./main -wA=640 -hA=640 -wB=640 -hB=640 29 | 30 | Switches -? and --help print usage information: 31 | 32 | $ ./main -? 33 | [Matrix Multiply Using CUDA] - Starting... 34 | Usage [? | --help] 35 | [-wA=WidthA] [-hA=HeightA] (Width x Height of Matrix A) 36 | [-wB=WidthB] [-hB=HeightB] (Width x Height of Matrix B) 37 | Note: Outer matrix dimensions of A & B matrices must be equal. -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernel"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | with CUDA.Storage_Models; use CUDA.Storage_Models; 4 | 5 | with Interfaces.C; use Interfaces.C; 6 | 7 | package Kernel is 8 | 9 | Block_Size : constant unsigned := 32; 10 | 11 | type Float_Array is array (unsigned range <>) of Float; 12 | 13 | type Array_Device_Access is access Float_Array 14 | with Designated_Storage_Model => CUDA.Storage_Models.Model; 15 | 16 | -- /** 17 | -- * Matrix multiplication (CUDA Kernel) on the device: C = A * B 18 | -- * wA is A's width and wB is B's width 19 | -- */ 20 | -- template __global__ void MatrixMulCUDA(float *C, float *A, 21 | -- float *B, int wA, 22 | -- int wB) { 23 | procedure Matrix_Mul_CUDA 24 | (C : Array_Device_Access; 25 | A : Array_Device_Access; 26 | B : Array_Device_Access; 27 | A_Width : unsigned; 28 | B_Width : unsigned) 29 | with CUDA_Global; 30 | 31 | end Kernel; 32 | -- -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/src/host/host.ads: -------------------------------------------------------------------------------- 1 | with CUDA.Vector_Types; use CUDA.Vector_Types; 2 | 3 | package Host is 4 | function Matrix_Multiply 5 | (Dims_A, Dims_B : Dim3; Measure_Performance : Boolean := False) return Integer; 6 | 7 | end Host; 8 | -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/src/host/ref.adb: -------------------------------------------------------------------------------- 1 | With Ada.Text_IO; use Ada.Text_IO; 2 | 3 | package body Ref is 4 | procedure Matrix_Mul_Iter 5 | (C : out Float_Array; 6 | A : Float_Array; 7 | B : Float_Array; 8 | A_Width : unsigned; 9 | B_Width : unsigned) 10 | is 11 | M : unsigned := A'Length / A_Width; 12 | N : unsigned renames A_Width; 13 | P : unsigned renames B_Width; 14 | A_Idx : unsigned; 15 | B_Idx : unsigned; 16 | C_Idx : unsigned; 17 | 18 | function Serialize_Idx (X, Y, Width : unsigned) return unsigned is 19 | ((Y - 1) * Width + X); 20 | begin 21 | for M_Idx in 1 .. M loop 22 | for P_Idx in 1 .. P loop 23 | C_Idx := Serialize_Idx (M_Idx, P_Idx, M); 24 | C (C_Idx) := 0.0; 25 | for N_Idx in 1 .. N loop 26 | A_Idx := Serialize_Idx (N_Idx, M_Idx, N); 27 | B_Idx := Serialize_Idx (P_Idx, N_Idx, P); 28 | C (C_Idx) := C (C_Idx) + 29 | A (A_Idx) * B (B_Idx); 30 | end loop; 31 | end loop; 32 | end loop; 33 | end Matrix_Mul_Iter; 34 | 35 | procedure Test_Matrix_Mul_Iter 36 | is 37 | A_Width : constant unsigned := 3; 38 | A_Height : constant unsigned := 1; 39 | B_Width : constant unsigned := 4; 40 | B_Height : constant unsigned := A_Width; 41 | A : Float_Array (1 .. A_Width * A_Height) := (3.0, 4.0, 2.0); 42 | B : Float_Array (1 .. B_Width * B_Height) := 43 | (13.0, 9.0, 7.0, 15.0, 44 | 8.0, 7.0, 4.0, 6.0, 45 | 6.0, 4.0, 0.0, 3.0); 46 | C : Float_Array (1 .. A_Height * B_Width); 47 | begin 48 | Matrix_Mul_Iter (C, A, B, A_Width, B_Width); 49 | for I in C'Range loop 50 | Put_Line (C (I)'Img); 51 | end loop; 52 | end Test_Matrix_Mul_Iter; 53 | end Ref; -------------------------------------------------------------------------------- /examples/0_Introduction/matrixMul/src/host/ref.ads: -------------------------------------------------------------------------------- 1 | with Kernel; use Kernel; 2 | with Interfaces.C; use Interfaces.C; 3 | 4 | package Ref is 5 | procedure Matrix_Mul_Iter 6 | (C : out Float_Array; 7 | A : Float_Array; 8 | B : Float_Array; 9 | A_Width : unsigned; 10 | B_Width : unsigned); 11 | -- iterative version of matrix mutiplication 12 | procedure Test_Matrix_Mul_Iter; 13 | end Ref; -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../Makefile.build 2 | -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernels", "support"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/src/common/kernels.adb: -------------------------------------------------------------------------------- 1 | with Interfaces.C; use Interfaces.C; 2 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; 3 | 4 | package body Kernels is 5 | 6 | procedure Init_Array 7 | (G_Data : Integer_Array_Device_Access; 8 | From, To : Integer; 9 | Factor : Integer_Array_Device_Access; 10 | Num_Iterations : Integer) 11 | is 12 | Idx : Integer := Integer (Block_Idx.X * Block_Dim.X + Thread_Idx.X); 13 | begin 14 | for I in 1 .. Num_Iterations loop 15 | G_Data (From + Idx) := @ + Factor (Factor'First); 16 | end loop; 17 | end Init_Array; 18 | 19 | 20 | end Kernels; 21 | -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/src/common/kernels.ads: -------------------------------------------------------------------------------- 1 | with Support; use Support; 2 | 3 | package Kernels is 4 | 5 | procedure Init_Array 6 | (G_Data : Integer_Array_Device_Access; 7 | From, To : Integer; 8 | Factor : Integer_Array_Device_Access; 9 | Num_Iterations : Integer) with CUDA_Global; 10 | 11 | end Kernels; 12 | -------------------------------------------------------------------------------- /examples/0_Introduction/simpleStreams/src/common/support.ads: -------------------------------------------------------------------------------- 1 | with CUDA.Storage_Models; use CUDA.Storage_Models; 2 | 3 | package Support is 4 | 5 | Stream_Model : CUDA_Async_Storage_Model; 6 | 7 | type Integer_Array is array (Natural range <>) of Integer; 8 | 9 | type Integer_Array_Host_Access is access all Integer_Array; 10 | 11 | type Integer_Array_Device_Access is access Integer_Array 12 | with Designated_Storage_Model => Stream_Model; 13 | 14 | end Support; 15 | -------------------------------------------------------------------------------- /examples/0_Introduction/vectorAdd/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../Makefile.build 2 | -------------------------------------------------------------------------------- /examples/0_Introduction/vectorAdd/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernel"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /examples/0_Introduction/vectorAdd/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /examples/0_Introduction/vectorAdd/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | package body Kernel is 5 | 6 | procedure Vector_Add 7 | (A : Array_Device_Access; 8 | B : Array_Device_Access; 9 | C : Array_Device_Access) 10 | is 11 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 12 | begin 13 | if I < A'Length then 14 | C (C'First + I) := A (A'First + I) + B (B'First + I); 15 | end if; 16 | end Vector_Add; 17 | 18 | end Kernel; 19 | -------------------------------------------------------------------------------- /examples/0_Introduction/vectorAdd/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | with CUDA.Storage_Models; use CUDA.Storage_Models; 4 | 5 | package Kernel is 6 | 7 | type Float_Array is array (Integer range <>) of Float; 8 | 9 | type Array_Device_Access is access Float_Array 10 | with Designated_Storage_Model => CUDA.Storage_Models.Model; 11 | 12 | procedure Vector_Add 13 | (A : Array_Device_Access; 14 | B : Array_Device_Access; 15 | C : Array_Device_Access) 16 | with CUDA_Global; 17 | 18 | end Kernel; 19 | -------------------------------------------------------------------------------- /examples/image_filtering/Makefile: -------------------------------------------------------------------------------- 1 | include ../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /examples/image_filtering/data/noisy_miners_bathing.qoi: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdaCore/cuda/74bfa151cff96345a74c3b2601f82148703ff927/examples/image_filtering/data/noisy_miners_bathing.qoi -------------------------------------------------------------------------------- /examples/image_filtering/data/readme.txt: -------------------------------------------------------------------------------- 1 | The noisy_miners_bathing.qoi image is only convenience for you to see. This demo imports/exports QOI image format only. 2 | To view such QOI image format, you can install any tool/plugin found here: https://github.com/phoboslab/qoi 3 | If you are in a rush, use this online viewer: https://floooh.github.io/qoiview/qoiview.html 4 | 5 | source : https://en.wikipedia.org/wiki/File:Noisy_Miners_bathing.jpg 6 | -------------------------------------------------------------------------------- /examples/image_filtering/device.gpr: -------------------------------------------------------------------------------- 1 | -- with "cuda_api_device.gpr"; 2 | 3 | -- library project Device is 4 | 5 | -- for Languages use ("Ada"); 6 | -- for Source_Dirs use ("src/common"); 7 | -- for Object_Dir use "obj/device"; 8 | 9 | -- for Target use "cuda"; 10 | -- for Library_Name use "kernel"; 11 | -- for Library_Dir use "lib"; 12 | 13 | -- package Compiler is 14 | -- for Switches ("ada") use CUDA_API_Device.Compiler'Switches ("ada"); 15 | -- end Compiler; 16 | 17 | -- for Archive_Builder use CUDA_API_Device'Archive_Builder; 18 | 19 | -- end Device; 20 | 21 | -- with "cuda_api_device.gpr"; 22 | 23 | -- library project Device is 24 | 25 | -- for Languages use ("Ada"); 26 | -- for Source_Dirs use ("src/common", "src/common/kernels"); 27 | -- for Object_Dir use "obj/device"; 28 | 29 | -- for Target use "cuda"; 30 | -- for Library_Name use "device"; 31 | -- for Library_Dir use "lib"; 32 | -- for Library_Kind use "dynamic"; 33 | -- for Library_Interface use ("bilateral_kernel"); 34 | -- for Library_Standalone use "encapsulated"; 35 | 36 | -- package Compiler is 37 | -- for Switches ("ada") use CUDA_API_Device.Compiler'Switches ("ada"); 38 | -- end Compiler; 39 | 40 | -- package Binder is 41 | -- for Default_Switches ("ada") use CUDA_API_Device.Binder'Default_Switches ("ada") & ("-t"); 42 | -- end Binder; 43 | 44 | -- for Archive_Builder use CUDA_API_Device'Archive_Builder; 45 | 46 | -- end Device; 47 | 48 | with "cuda_api_device.gpr"; 49 | 50 | library project Device is 51 | 52 | for Languages use ("Ada"); 53 | for Source_Dirs use ("src/common", "src/common/kernels"); 54 | for Object_Dir use "obj/device"; 55 | 56 | for Target use "cuda"; 57 | for Library_Name use "device"; 58 | for Library_Dir use "lib"; 59 | for Library_Kind use "dynamic"; 60 | for Library_Interface use ("bilateral_kernel"); 61 | for Library_Standalone use "encapsulated"; 62 | 63 | package Compiler is 64 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 65 | end Compiler; 66 | 67 | package Binder is 68 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 69 | end Binder; 70 | 71 | for Library_Options use CUDA_API_Device.Library_Options; 72 | 73 | end Device; -------------------------------------------------------------------------------- /examples/image_filtering/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/**"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | -------------------------------------------------------------------------------- /examples/image_filtering/src/common/graphic.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2017, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | with CUDA.Storage_Models; 16 | 17 | package Graphic is 18 | 19 | package CSM renames CUDA.Storage_Models; 20 | 21 | type Rgb is record 22 | R, G, B : Float; 23 | end record; 24 | 25 | function "/" (Left : Rgb; Right : Float) return Rgb is 26 | (Left.R / Right, Left.G / Right, Left.B / Right); 27 | 28 | function "*" (Left : Rgb; Right : Float) return Rgb is 29 | (Left.R * Right, Left.G * Right, Left.B * Right); 30 | 31 | function "+" (Left : Rgb; Right : Rgb) return Rgb is 32 | (Left.R + Right.R, Left.G + Right.G, Left.B + Right.B); 33 | 34 | function Distance_Square (Left : Rgb; Right : Rgb) return Float is 35 | ((Left.R - Right.R) * (Left.R - Right.R) + 36 | (Left.G - Right.G) * (Left.G - Right.G) + 37 | (Left.B - Right.B) * (Left.B - Right.B)); 38 | 39 | type Image is array (Natural range <>, Natural range <>) of Rgb; 40 | type Image_Access is access all Image; 41 | 42 | type Image_Device_Access is access Image 43 | with Designated_Storage_Model => CSM.Model; 44 | 45 | end Graphic; 46 | -------------------------------------------------------------------------------- /examples/image_filtering/src/common/kernels/bilateral_kernel.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2017, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | with System; 16 | 17 | with Graphic; 18 | 19 | package Bilateral_Kernel is 20 | 21 | package G renames Graphic; 22 | 23 | procedure Bilateral 24 | (Img : G.Image; 25 | Filtered_Img : in out G.Image; 26 | Width : Integer; Height : Integer; Spatial_Stdev : Float; 27 | Color_Dist_Stdev : Float; I : Integer; J : Integer); 28 | 29 | procedure Bilateral_Cuda 30 | (Device_Img : G.Image_Device_Access; 31 | Device_Filtered_Img : G.Image_Device_Access; 32 | Width, Height : Integer; 33 | Spatial_Stdev, Color_Dist_Stdev : Float) 34 | with Cuda_Global; 35 | 36 | end Bilateral_Kernel; 37 | -------------------------------------------------------------------------------- /examples/image_filtering/src/host/bilateral_host.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2017, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | with Graphic; 16 | 17 | package Bilateral_Host is 18 | 19 | package G renames Graphic; 20 | 21 | procedure Bilateral_Cpu 22 | (Host_Img : G.Image; 23 | Host_Filtered_Img : in out G.Image; 24 | Width : Integer; Height : Integer; Spatial_Stdev : Float; 25 | Color_Dist_Stdev : Float); 26 | 27 | procedure Bilateral_Cuda 28 | (Host_Img : G.Image; 29 | Host_Filtered_Img : in out G.Image; 30 | Width : Integer; Height : Integer; Spatial_Stdev : Float; 31 | Color_Dist_Stdev : Float); 32 | 33 | end Bilateral_Host; 34 | -------------------------------------------------------------------------------- /examples/image_filtering/src/host/exporter/exporter.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2017, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | with Graphic; 16 | 17 | package Exporter is 18 | 19 | package G renames Graphic; 20 | 21 | procedure Dump_Qoi (Abs_Filename : String; Img : G.Image_Access); 22 | 23 | end Exporter; 24 | -------------------------------------------------------------------------------- /examples/image_filtering/src/host/importer/importer.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2017, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | with Graphic; 16 | 17 | package Importer is 18 | 19 | package G renames Graphic; 20 | 21 | Bad_Filename : exception; 22 | 23 | function Load_Qoi (Abs_Filename : String) return G.Image_Access; 24 | 25 | end Importer; 26 | -------------------------------------------------------------------------------- /examples/image_filtering/src/host/parameters/parameters.adb: -------------------------------------------------------------------------------- 1 | with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; 2 | 3 | with Ada.Text_IO; use Ada.Text_IO; 4 | 5 | package body Parameters is 6 | 7 | function "+" (Str : Unbounded_String) return String is (To_String (Str)); 8 | function "+" (Str : String) return Unbounded_String is (To_Unbounded_String (Str)); 9 | 10 | Image_Type : constant VString_Var := +".qoi"; 11 | Pat : constant Pattern := +Image_Type; 12 | 13 | procedure Set_Input_Image (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 14 | begin 15 | if Match (Value, Pat) then 16 | Result.Input_Image := Value; 17 | else 18 | raise Bad_extension; 19 | end if; 20 | end; 21 | 22 | procedure Set_Kernel (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 23 | begin 24 | Result.Kernel := Kernel_T'Value (+Value); 25 | end; 26 | 27 | procedure Set_Spatial_Stdev (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 28 | begin 29 | Result.Spatial_Stdev := Float'Value (+Value); 30 | end; 31 | 32 | procedure Set_Color_Dist_Stdev (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 33 | begin 34 | Result.Color_Dist_Stdev := Float'Value (+Value); 35 | end; 36 | 37 | procedure Set_Device (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 38 | begin 39 | Result.Device := Execution_Device_T'Value (+Value); 40 | end; 41 | 42 | procedure Set_Output_Image (Name : in Unbounded_String; Value : in Unbounded_String; Result : in out User_Parameters) is 43 | begin 44 | if Value = "" then 45 | declare 46 | Input_Image : Unbounded_String := Result.Input_Image; 47 | begin 48 | if Match (Input_Image, Pat, "") then 49 | Result.Output_Image := Input_Image & "_" & Result.Kernel'Image & ".qoi"; 50 | end if; 51 | end; 52 | elsif Match (Value, Pat) then 53 | Result.Output_Image := Value; 54 | else 55 | raise Bad_extension; 56 | end if; 57 | end; 58 | 59 | end Parameters; 60 | -------------------------------------------------------------------------------- /examples/image_filtering/src/host/parameters/parameters.ads: -------------------------------------------------------------------------------- 1 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 2 | 3 | package Parameters is 4 | 5 | type Execution_Device_T is (Cpu, Gpu); 6 | type Kernel_T is (Bilateral); 7 | 8 | Bad_Extension : exception; 9 | 10 | type User_Parameters is record 11 | Input_Image : Unbounded_String; 12 | Kernel : Kernel_T; 13 | Spatial_Stdev : Float; 14 | Color_Dist_Stdev : Float; 15 | Device : Execution_Device_T; 16 | Output_Image : Unbounded_String; 17 | end record; 18 | 19 | procedure Set_Input_Image 20 | (Name : in Unbounded_String; Value : in Unbounded_String; 21 | Result : in out User_Parameters); 22 | 23 | procedure Set_Kernel 24 | (Name : in Unbounded_String; Value : in Unbounded_String; 25 | Result : in out User_Parameters); 26 | 27 | procedure Set_Spatial_Stdev 28 | (Name : in Unbounded_String; Value : in Unbounded_String; 29 | Result : in out User_Parameters); 30 | 31 | procedure Set_Color_Dist_Stdev 32 | (Name : in Unbounded_String; Value : in Unbounded_String; 33 | Result : in out User_Parameters); 34 | 35 | procedure Set_Device 36 | (Name : in Unbounded_String; Value : in Unbounded_String; 37 | Result : in out User_Parameters); 38 | 39 | procedure Set_Output_Image 40 | (Name : in Unbounded_String; Value : in Unbounded_String; 41 | Result : in out User_Parameters); 42 | end Parameters; 43 | -------------------------------------------------------------------------------- /examples/marching/Makefile: -------------------------------------------------------------------------------- 1 | include ../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /examples/marching/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common", "src/device_code"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("marching_cubes", "data", "colors", "geometry"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /examples/marching/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | with "openglada/opengl-glfw.gpr"; 3 | 4 | project Host is 5 | 6 | for Exec_Dir use "."; 7 | for Object_Dir use "obj/host"; 8 | for Source_Dirs use ("src/**"); 9 | for Main use ("main.adb"); 10 | 11 | for Target use CUDA_API_Host.CUDA_Host; 12 | 13 | package Compiler is 14 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 15 | end Compiler; 16 | 17 | package Linker is 18 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 19 | end Linker; 20 | 21 | package Binder is 22 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 23 | end Binder; 24 | 25 | 26 | end Host; 27 | 28 | -------------------------------------------------------------------------------- /examples/marching/openglada/CHANGELOG: -------------------------------------------------------------------------------- 1 | v0.4.1 (upcoming): 2 | * Fixed an off-by-one bug in GL.Contexts 3 | v0.4: 4 | * Added packages: 5 | - GL.Culling 6 | - GL.Framebuffer 7 | - GL.Objects.Lists 8 | - GL.Rasterization 9 | * Renamed packages: 10 | - GL.Pixel_Data to GL.Pixels 11 | - GL.Objects.Buffer to GL.Objects.Buffers 12 | * Added missing functionality in: 13 | - GL.Blending (various) 14 | - GL.Buffers (various) 15 | - GL.Objects.Buffers (various) 16 | - GL.Objects.Framebuffers (various) 17 | - GL.Objects.Programs: 18 | * Attached_Shaders 19 | * Get_Program_Stage 20 | * Get_Subroutine_Index 21 | * Subroutine_Uniform_Locations 22 | - GL.Objects.Shaders (Release_Shader_Compiler) 23 | - GL.Objects.Textures: 24 | * Generate_Mipmap 25 | * Invalidate_Image 26 | * Invalidate_Sub_Image 27 | - GLFW.Windows (Set_Cursor_Mode, Disable_Callback) 28 | * GLFW 3: Raise exception if window creation fails 29 | * Added LIBRARY_TYPE scenario variable 30 | * Various bugfixes 31 | 32 | v0.3: 33 | * Added packages: 34 | - GL.Context 35 | - GL.Blending 36 | - GL.Raster 37 | - GL.Objects.Framebuffers 38 | - GL.Objects.Renderbuffers 39 | - GL.Objects.Textures.Targets 40 | * Overhauled texture API and made it possible to create and load data into 41 | all kinds of textures 42 | * Made exception raising optional by compile-time switch rather than by 43 | setting a flag at runtime (performance increasement). Exposed GL.Errors to 44 | manually handle errors if exceptions are disabled. 45 | * Added support for GLFW 3 46 | * Added support for SOIL 47 | * Added support for FTGL 48 | * Sanitized and cleaned up build system 49 | 50 | v0.2: 51 | 52 | * Added joystick support to GLFW wrapper. 53 | * Changed GL.Objects to require explicit initialization so the user 54 | can declare variables of derived types at library level. 55 | Breaks existing code. 56 | * Better handling of texture unit count 57 | * Added Makefile 58 | * Added proper README 59 | 60 | v0.1: 61 | 62 | * Initial release -------------------------------------------------------------------------------- /examples/marching/openglada/COPYING: -------------------------------------------------------------------------------- 1 | Copyright (c) 2011-2013, Felix Krause 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -------------------------------------------------------------------------------- /examples/marching/openglada/Makefile: -------------------------------------------------------------------------------- 1 | GNATFLAGS ?= 2 | GLFW_VERSION ?=3 3 | GPRBUILD = gprbuild ${GNATFLAGS} -p 4 | 5 | WINDOWING_BACKEND := windows 6 | UNAME := $(shell uname) 7 | ifeq ($(UNAME), Darwin) 8 | WINDOWING_BACKEND := quartz 9 | endif 10 | ifeq ($(UNAME), Linux) 11 | WINDOWING_BACKEND := x11 12 | endif 13 | 14 | WINDOWING_SYSTEM := -XWindowing_System=${WINDOWING_BACKEND} 15 | GLFW_VERSION := -XGLFW_Version=${GLFW_VERSION} 16 | LIBRARY_TYPE ?= static 17 | 18 | all: compile 19 | 20 | bin/generate: src/generator/generate.adb src/generator/specs.adb \ 21 | src/generator/specs.ads src/generator/tokenization.adb \ 22 | src/generator/tokenization.ads 23 | ${GPRBUILD} -P generate.gpr 24 | 25 | generate: bin/generate 26 | bin/generate 27 | 28 | compile: 29 | mkdir -p lib 30 | mkdir -p obj 31 | ${GPRBUILD} -P opengl-glfw.gpr ${WINDOWING_SYSTEM} ${GLFW_VERSION} 32 | 33 | clean: 34 | rm -rf ./obj ./bin ./lib 35 | 36 | tests: 37 | mkdir -p bin 38 | ${GPRBUILD} -P glfw_test.gpr ${WINDOWING_SYSTEM} ${GLFW_VERSION} 39 | ${GPRBUILD} -P opengl_test.gpr ${WINDOWING_SYSTEM} ${GLFW_VERSION} 40 | 41 | .PHONY: generate compile clean tests -------------------------------------------------------------------------------- /examples/marching/openglada/common/controls.ads: -------------------------------------------------------------------------------- 1 | 2 | with GL.Types; 3 | 4 | with Glfw.Windows; 5 | 6 | package Controls is 7 | Procedure Compute_Matrices_From_Inputs (Window : in out Glfw.Windows.Window; 8 | Projection_Matrix, View_Matrix : in out GL.Types.Singles.Matrix4); 9 | end Controls; 10 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/initialize.adb: -------------------------------------------------------------------------------- 1 | 2 | with Ada.Exceptions; use Ada.Exceptions; 3 | with Ada.Text_IO; use Ada.Text_IO; 4 | 5 | with Glfw; 6 | with Glfw.Input.Mouse; 7 | with Glfw.Windows; 8 | with Glfw.Windows.Context; 9 | with Glfw.Windows.Hints; 10 | 11 | with Utilities; 12 | 13 | procedure Initialize (Main_Window : in out Glfw.Windows.Window; 14 | Window_Title : String) is 15 | 16 | procedure Enable_Callbacks is 17 | begin 18 | Main_Window.Enable_Callback (Glfw.Windows.Callbacks.Size); 19 | Main_Window.Enable_Callback (Glfw.Windows.Callbacks.Key); 20 | end Enable_Callbacks; 21 | 22 | -- ------------------------------------------------------------------------ 23 | 24 | procedure Set_Window_Hints is 25 | Min_Major_Version : constant Integer := 3; 26 | Minor_Version : constant Integer := 2; 27 | begin 28 | Glfw.Windows.Hints.Set_Minimum_OpenGL_Version 29 | (Min_Major_Version, Minor_Version); 30 | Glfw.Windows.Hints.Set_Forward_Compat (True); 31 | Glfw.Windows.Hints.Set_Profile (Glfw.Windows.Context.Core_Profile); 32 | Glfw.Windows.Hints.Set_Debug_Context (True); 33 | -- Set samples to 16 before taking screen shots. 34 | Glfw.Windows.Hints.Set_Samples (4); 35 | end Set_Window_Hints; 36 | 37 | -- ------------------------------------------------------------------------ 38 | 39 | Window_Width : constant Glfw.Size := 800; 40 | Window_Height : constant Glfw.Size := 600; 41 | Cursor : Glfw.Input.Mouse.Cursor_Mode := Glfw.Input.Mouse.Hidden; 42 | begin 43 | Set_Window_Hints; 44 | Main_Window.Init (Window_Width, Window_Height, Window_Title); 45 | Glfw.Windows.Context.Make_Current (Main_Window'Access); 46 | Enable_Callbacks; 47 | Main_Window.Set_Cursor_Mode (Cursor); 48 | Utilities.Show_GL_Data; 49 | 50 | exception 51 | when others => 52 | Put_Line ("An exception occurred in Initialize."); 53 | raise; 54 | 55 | end Initialize; 56 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/initialize.ads: -------------------------------------------------------------------------------- 1 | with Glfw.Windows; 2 | 3 | procedure Initialize (Main_Window : in out Glfw.Windows.Window; 4 | Window_Title : String); 5 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/keyboard_mouse.adb: -------------------------------------------------------------------------------- 1 | 2 | with Ada.Exceptions; use Ada.Exceptions; 3 | with Ada.Text_IO; use Ada.Text_IO; 4 | 5 | with Glfw; 6 | with Glfw.Windows; 7 | 8 | with Initialize; 9 | with Main_Loop; 10 | 11 | procedure Keyboard_Mouse is 12 | Main_Window : Glfw.Windows.Window; 13 | Window_Title : String := "Tutorial 6 - Keyboard_Mouse Cube"; 14 | begin 15 | Glfw.Init; 16 | Initialize (Main_Window, Window_Title); 17 | Main_Loop (Main_Window); 18 | Glfw.Shutdown; 19 | exception 20 | when anError : Constraint_Error => 21 | Put ("Tutorial_6 returned constraint error: "); 22 | Put_Line (Exception_Information (anError)); 23 | 24 | when anError : others => 25 | Put_Line ("An exception occurred in Tutorial_6."); 26 | Put_Line (Exception_Information (anError)); 27 | end Keyboard_Mouse; 28 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/load_dds.ads: -------------------------------------------------------------------------------- 1 | 2 | -- This version of DDS loading procedure only supports compressed 3 | -- DDS files. 4 | 5 | with GL.Objects.Textures; 6 | 7 | procedure Load_DDS (File_Name : String; 8 | theTexture : out GL.Objects.Textures.Texture); 9 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/main_loop.ads: -------------------------------------------------------------------------------- 1 | 2 | with Glfw.Windows; 3 | 4 | procedure Main_Loop (Main_Window : in out Glfw.Windows.Window); 5 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/program_loader.ads: -------------------------------------------------------------------------------- 1 | with Ada.Strings.Unbounded; 2 | 3 | with GL.Objects.Shaders; 4 | with GL.Objects.Programs; 5 | 6 | package Program_Loader is 7 | type Shader_Source is private; 8 | 9 | type Shader_Sources is array (Positive range <>) of Shader_Source; 10 | 11 | Shader_Loading_Error : exception; 12 | 13 | function Src (Path : String; Kind : GL.Objects.Shaders.Shader_Type) 14 | return Shader_Source; 15 | 16 | function Program_From (List : Shader_Sources) 17 | return GL.Objects.Programs.Program; 18 | private 19 | type Shader_Source is record 20 | Path : Ada.Strings.Unbounded.Unbounded_String; 21 | Kind : GL.Objects.Shaders.Shader_Type; 22 | end record; 23 | end Program_Loader; 24 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/quaternions.ads: -------------------------------------------------------------------------------- 1 | 2 | generic 3 | type Real is digits <>; 4 | 5 | package Quaternions is 6 | type Quaternion is record 7 | A, B, C, D : Real; 8 | end record; 9 | 10 | function "abs" (Left : Quaternion) return Real; 11 | function Conj (Left : Quaternion) return Quaternion; 12 | function "-" (Left : Quaternion) return Quaternion; 13 | function "+" (Left, Right : Quaternion) return Quaternion; 14 | function "-" (Left, Right : Quaternion) return Quaternion; 15 | function "*" (Left : Quaternion; Right : Real) return Quaternion; 16 | function "*" (Left : Real; Right : Quaternion) return Quaternion; 17 | function "*" (Left, Right : Quaternion) return Quaternion; 18 | function Image (Left : Quaternion) return String; 19 | function Normalized (Left : Quaternion) return Quaternion; 20 | 21 | end Quaternions; 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/common/utilities.ads: -------------------------------------------------------------------------------- 1 | 2 | with GL.Objects.Buffers; 3 | with GL.Objects.Programs; 4 | with GL.Types; 5 | with GL.Types.Colors; 6 | 7 | with Glfw.Windows; 8 | 9 | with Maths; 10 | 11 | package Utilities is 12 | 13 | procedure Clear_All (Colour : GL.Types.Colors.Color); 14 | procedure Clear_Background_Colour (Colour : GL.Types.Colors.Color); 15 | procedure Clear_Background_Colour_And_Depth (Colour : GL.Types.Colors.Color); 16 | procedure Enable_Mouse_Callbacks (Window : in out Glfw.Windows.Window; Enable : Boolean); 17 | procedure Load_Element_Buffer is new 18 | GL.Objects.Buffers.Load_To_Buffer (GL.Types.Int_Pointers); 19 | procedure Load_Vertex_Buffer is new 20 | GL.Objects.Buffers.Load_To_Buffer (GL.Types.Singles.Vector2_Pointers); 21 | procedure Load_Vertex_Buffer is new 22 | GL.Objects.Buffers.Load_To_Buffer (GL.Types.Singles.Vector3_Pointers); 23 | procedure Load_Vertex_Buffer is new 24 | GL.Objects.Buffers.Load_To_Buffer (GL.Types.Singles.Vector4_Pointers); 25 | procedure Load_Vector5_Buffer is new GL.Objects.Buffers.Load_To_Buffer 26 | (Maths.Vector5_Pointers); 27 | procedure Load_Vector6_Buffer is new GL.Objects.Buffers.Load_To_Buffer 28 | (Maths.Vector6_Pointers); 29 | procedure Print_GL_Int_Array (Name : String; anArray : GL.Types.Int_Array); 30 | procedure Print_GL_Array3 (Name : String; anArray : GL.Types.Singles.Vector3_Array); 31 | procedure Print_GL_Array4 (Name : String; anArray : GL.Types.Singles.Vector4_Array); 32 | procedure Print_Array6 (Name : String; anArray : Maths.Vector6_Array); 33 | procedure Print_Matrix (Name : String; aMatrix : GL.Types.Singles.Matrix3); 34 | procedure Print_Matrix (Name : String; aMatrix : GL.Types.Singles.Matrix4); 35 | procedure Print_Vector (Name : String; aVector : GL.Types.Singles.Vector2); 36 | procedure Print_Vector (Name : String; aVector : GL.Types.Singles.Vector3); 37 | procedure Print_Vector (Name : String; aVector : GL.Types.Singles.Vector4); 38 | procedure Show_Shader_Info_Log (aProgram : gl.Objects.Programs.Program); 39 | procedure Show_Shader_Program_Data (aProgram : gl.Objects.Programs.Program); 40 | procedure Show_GL_Data; 41 | 42 | end Utilities; 43 | -------------------------------------------------------------------------------- /examples/marching/openglada/generate.gpr: -------------------------------------------------------------------------------- 1 | project Generate is 2 | for Main use ("generate.adb"); 3 | for Source_Dirs use ("src/generator"); 4 | for Object_Dir use "obj"; 5 | for Library_Dir use "lib"; 6 | for Exec_Dir use "bin"; 7 | end Generate; -------------------------------------------------------------------------------- /examples/marching/openglada/opengl-ftgl.gpr: -------------------------------------------------------------------------------- 1 | with "opengl_shared"; 2 | with "opengl"; 3 | 4 | library project OpenGL.Ftgl is 5 | for Languages use ("ada"); 6 | 7 | for Library_Name use "FtglAda"; 8 | 9 | for Source_Dirs use ("src/ftgl"); 10 | for Object_Dir use "obj"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use OpenGL_Shared'Library_Kind; 13 | 14 | package Ide renames OpenGL_Shared.Ide; 15 | package Builder renames OpenGL_Shared.Builder; 16 | package Compiler renames OpenGL_Shared.Compiler; 17 | 18 | package Linker is 19 | for Linker_Options use ("-lftgl"); 20 | end Linker; 21 | end OpenGL.Ftgl; 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/opengl-glfw.gpr: -------------------------------------------------------------------------------- 1 | with "opengl_shared"; 2 | with "opengl"; 3 | 4 | library project OpenGL.Glfw is 5 | for Languages use ("ada"); 6 | 7 | for Library_Name use "GlfwAda"; 8 | for Library_Kind use OpenGL_Shared'Library_Kind; 9 | 10 | type GLFW_Version_Type is ("2", "3"); 11 | GLFW_Version : GLFW_Version_Type := "3"; -- external ("GLFW_Version"); 12 | 13 | GLFW_Sources := ("src/glfw", "common"); 14 | 15 | -- Most tests need a GLFW window. An abstraction layer is provided 16 | -- so that the test work with GLFW 2 and 3. Test project can reference 17 | -- this variable in order to include the appropriate sources for 18 | -- the defined GLFW version. 19 | Shared_Test_Sources := ("tests/shared"); 20 | 21 | GLFW_Lib := ""; 22 | case GLFW_Version is 23 | when "2" => 24 | GLFW_Sources := GLFW_Sources & "src/glfw/v2"; 25 | Shared_Test_Sources := Shared_Test_Sources & "tests/shared/glfw2_backend"; 26 | GLFW_Lib := "-lglfw"; 27 | when "3" => 28 | GLFW_Sources := GLFW_Sources & "src/glfw/v3"; 29 | Shared_Test_Sources := Shared_Test_Sources & "tests/shared/glfw3_backend"; 30 | case OpenGL_Shared.Windowing_System is 31 | when "windows" => GLFW_Lib := "-lglfw3"; 32 | when "x11" | "quartz" => GLFW_Lib := "-lglfw"; 33 | end case; 34 | end case; 35 | 36 | for Source_Dirs use GLFW_Sources; 37 | for Object_Dir use "obj"; 38 | for Library_Dir use "lib"; 39 | 40 | package Ide renames OpenGL_Shared.Ide; 41 | package Builder renames OpenGL_Shared.Builder; 42 | package Compiler renames OpenGL_Shared.Compiler; 43 | 44 | package Linker is 45 | case OpenGL_Shared.Windowing_System is 46 | when "quartz" => 47 | for Linker_Options use (GLFW_Lib, "-Wl,-framework,Cocoa,-framework,IOKit,-L/usr/local/lib"); 48 | when "windows" => 49 | for Linker_Options use (GLFW_Lib, "-lwinmm", "-lgdi32"); 50 | when "x11" => 51 | -- -lX11 is already set in opengl.gpr 52 | for Linker_Options use (GLFW_Lib, "-pthread", "-lm", "-lXcursor", "-lXxf86vm", 53 | "-lXrandr", "-lXinerama", "-lXi", "-ldl"); 54 | end case; 55 | end Linker; 56 | end OpenGL.Glfw; 57 | -------------------------------------------------------------------------------- /examples/marching/openglada/opengl-soil.gpr: -------------------------------------------------------------------------------- 1 | with "opengl_shared"; 2 | with "opengl"; 3 | 4 | library project OpenGL.Soil is 5 | for Library_Name use "SoilAda"; 6 | 7 | for Languages use ("ada", "c"); 8 | 9 | for Source_Dirs use ("src/soil"); 10 | for Object_Dir use "obj"; 11 | for Library_Dir use "lib"; 12 | 13 | package Ide renames OpenGL_Shared.Ide; 14 | package Builder renames OpenGL_Shared.Builder; 15 | package Compiler is 16 | -- disable preprocessor warning for C (this is 3rd party code, we just 17 | -- want to compile it and hope it doesn't contain any actual bugs) 18 | for Default_Switches ("c") use ("-O2", "-s", "-Wp,-w"); 19 | for Default_Switches ("ada") use OpenGL_Shared.Compiler'Default_Switches ("ada"); 20 | end Compiler; 21 | end OpenGL.Soil; 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/opengl.gpr: -------------------------------------------------------------------------------- 1 | with "opengl_shared"; 2 | 3 | library project OpenGL is 4 | for Languages use ("ada"); 5 | 6 | for Library_Name use "OpenGLAda"; 7 | 8 | OpenGL_Sources := ("src/gl/interface", 9 | "src/gl/implementation", 10 | "src/gl/generated"); 11 | case OpenGL_Shared.Windowing_System is 12 | when "windows" => OpenGL_Sources := OpenGL_Sources & "src/gl/windows"; 13 | when "x11" => OpenGL_Sources := OpenGL_Sources & "src/gl/x11"; 14 | when "quartz" => OpenGL_Sources := OpenGL_Sources & "src/gl/mac"; 15 | end case; 16 | 17 | case OpenGL_Shared.Auto_Exceptions is 18 | when "enabled" => OpenGL_Sources := 19 | OpenGL_Sources & "src/gl/implementation/auto_exceptions"; 20 | when "disabled" => OpenGL_Sources := 21 | OpenGL_Sources & "src/gl/implementation/no_auto_exceptions"; 22 | end case; 23 | 24 | for Source_Dirs use OpenGL_Sources; 25 | for Object_Dir use "obj"; 26 | for Library_Dir use "lib"; 27 | for Library_Kind use OpenGL_Shared'Library_Kind; 28 | 29 | package Ide renames OpenGL_Shared.Ide; 30 | package Builder renames OpenGL_Shared.Builder; 31 | package Compiler renames OpenGL_Shared.Compiler; 32 | 33 | package Linker is 34 | case OpenGL_Shared.Windowing_System is 35 | when "windows" => 36 | for Linker_Options use ("-lOpenGL32", "-lGdi32"); 37 | 38 | when "x11" => 39 | for Linker_Options use ("-lGL", "-lX11"); 40 | 41 | when "quartz" => 42 | for Linker_Options use ("-Wl,-framework,OpenGL,-framework,CoreFoundation"); 43 | end case; 44 | end Linker; 45 | 46 | end OpenGL; 47 | -------------------------------------------------------------------------------- /examples/marching/openglada/opengl_shared.gpr: -------------------------------------------------------------------------------- 1 | project OpenGL_Shared is 2 | 3 | for Source_Files use (); 4 | 5 | -- Different operating systems need different linker 6 | -- flags. Moreover, some features (such as WGL, GLX, 7 | -- CGL) are only available on one specific platform. 8 | -- Supported values: 9 | -- * windows : Microsoft Windows 10 | -- * x11 : X Window System 11 | -- * quartz : Quartz Compositor (OS X) 12 | type Windowing_System_Type is ("windows", "x11", "quartz"); 13 | Windowing_System : Windowing_System_Type := "x11";-- external ("Windowing_System"); 14 | 15 | type Mode_Type is ("debug", "release"); 16 | Mode : Mode_Type := external ("Mode", "debug"); 17 | 18 | type Toggle_Type is ("enabled", "disabled"); 19 | Auto_Exceptions : Toggle_Type := external ("Auto_Exceptions", "enabled"); 20 | 21 | type Library_Kinds is ("static", "relocatable"); 22 | Library_Kind : Library_Kinds := external ("Library_Type", "static"); 23 | 24 | for Library_Kind use Library_Kind; 25 | 26 | package Ide is 27 | for Vcs_Kind use "Git"; 28 | end Ide; 29 | 30 | package Builder is 31 | case Mode is 32 | when "debug" => 33 | for Default_Switches ("ada") use ("-s", 34 | "-gnatE", 35 | "-g"); 36 | when "release" => 37 | for Default_Switches ("ada") use ("-s"); 38 | end case; 39 | end Builder; 40 | 41 | package Compiler is 42 | case Mode is 43 | when "debug" => 44 | for Default_Switches ("ada") use ("-gnat05", -- "-gnatwa", 45 | "-g", 46 | "-fstack-check"); 47 | when "release" => 48 | for Default_Switches ("ada") use ("-gnat05", -- "-gnatwa", 49 | "-O2", 50 | "-gnatn2", 51 | "-fstack-check"); 52 | end case; 53 | end Compiler; 54 | 55 | end OpenGL_Shared; 56 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/generator/generate.adb: -------------------------------------------------------------------------------- 1 | with Ada.Command_Line; 2 | with Ada.Directories; use Ada.Directories; 3 | with Ada.Exceptions; use Ada.Exceptions; 4 | with Ada.Text_IO; 5 | 6 | with Specs; 7 | 8 | procedure Generate is 9 | Proc : Specs.Processor; 10 | 11 | Source_Folder : constant String := "src/gl/specs"; 12 | Target_Folder : constant String := "src/gl/generated"; 13 | Interface_Folder : constant String := "src/gl/interface"; 14 | 15 | procedure Process_File (Directory_Entry : in Directory_Entry_Type) is 16 | Path : constant String := Full_Name (Directory_Entry); 17 | begin 18 | Ada.Text_IO.Put_Line ("Processing " & Path & " ..."); 19 | Specs.Parse_File (Proc, Path); 20 | Ada.Text_IO.Put_Line ("Done processing " & Path & " ."); 21 | end Process_File; 22 | 23 | begin 24 | Search (Source_Folder, "*.spec", (Ordinary_File => True, others => False), 25 | Process_File'Access); 26 | Create_Path (Target_Folder); 27 | declare 28 | use type Specs.Spec; 29 | Cur : Specs.Spec := Specs.First (Proc); 30 | begin 31 | while Cur /= Specs.No_Spec loop 32 | Specs.Write_API (Proc, Cur, Target_Folder); 33 | Cur := Specs.Next (Proc, Cur); 34 | end loop; 35 | end; 36 | Specs.Write_Init (Proc, Target_Folder); 37 | Specs.Write_Wrapper_Table (Proc, Target_Folder, Interface_Folder); 38 | exception when Error : Specs.Parsing_Error => 39 | Ada.Text_IO.Put_Line (Exception_Message (Error)); 40 | Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); 41 | end Generate; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/generated/gl-api-doubles.ads: -------------------------------------------------------------------------------- 1 | -- Autogenerated by Generate, do not edit 2 | package GL.API.Doubles is 3 | pragma Preelaborate; 4 | Vertex_Attrib1 : T1; 5 | Vertex_Attrib2 : T2; 6 | Vertex_Attrib2v : T3; 7 | Vertex_Attrib3 : T4; 8 | Vertex_Attrib3v : T5; 9 | Vertex_Attrib4 : T6; 10 | Vertex_Attrib4v : T7; 11 | end GL.API.Doubles; 12 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/generated/gl-api-ints.ads: -------------------------------------------------------------------------------- 1 | -- Autogenerated by Generate, do not edit 2 | package GL.API.Ints is 3 | pragma Preelaborate; 4 | Uniform1 : T8; 5 | Uniform1v : T9; 6 | Uniform2 : T10; 7 | Uniform2v : T11; 8 | Uniform3 : T12; 9 | Uniform3v : T13; 10 | Uniform4 : T14; 11 | Uniform4v : T15; 12 | Uniform_Matrix2 : T16; 13 | Uniform_Matrix3 : T17; 14 | Uniform_Matrix4 : T18; 15 | Vertex_Attrib1 : T19; 16 | Vertex_Attrib2 : T20; 17 | Vertex_Attrib2v : T21; 18 | Vertex_Attrib3 : T22; 19 | Vertex_Attrib3v : T23; 20 | Vertex_Attrib4 : T24; 21 | Vertex_Attrib4v : T25; 22 | end GL.API.Ints; 23 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/generated/gl-api-shorts.ads: -------------------------------------------------------------------------------- 1 | -- Autogenerated by Generate, do not edit 2 | package GL.API.Shorts is 3 | pragma Preelaborate; 4 | Vertex_Attrib1 : T26; 5 | Vertex_Attrib2 : T27; 6 | Vertex_Attrib2v : T28; 7 | Vertex_Attrib3 : T29; 8 | Vertex_Attrib3v : T30; 9 | Vertex_Attrib4 : T31; 10 | Vertex_Attrib4v : T32; 11 | end GL.API.Shorts; 12 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/generated/gl-api-singles.ads: -------------------------------------------------------------------------------- 1 | -- Autogenerated by Generate, do not edit 2 | package GL.API.Singles is 3 | pragma Preelaborate; 4 | Uniform1 : T33; 5 | Uniform1v : T34; 6 | Uniform2 : T35; 7 | Uniform2v : T36; 8 | Uniform3 : T37; 9 | Uniform3v : T38; 10 | Uniform4 : T39; 11 | Uniform4v : T40; 12 | Uniform_Matrix2 : T41; 13 | Uniform_Matrix3 : T42; 14 | Uniform_Matrix4 : T43; 15 | Vertex_Attrib1 : T44; 16 | Vertex_Attrib2 : T45; 17 | Vertex_Attrib2v : T46; 18 | Vertex_Attrib3 : T47; 19 | Vertex_Attrib3v : T48; 20 | Vertex_Attrib4 : T49; 21 | Vertex_Attrib4v : T50; 22 | end GL.API.Singles; 23 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/generated/gl-api-uints.ads: -------------------------------------------------------------------------------- 1 | -- Autogenerated by Generate, do not edit 2 | package GL.API.UInts is 3 | pragma Preelaborate; 4 | Uniform1 : T51; 5 | Uniform1v : T52; 6 | Uniform2 : T53; 7 | Uniform2v : T54; 8 | Uniform3 : T55; 9 | Uniform3v : T56; 10 | Uniform4 : T57; 11 | Uniform4v : T58; 12 | Uniform_Matrix2 : T59; 13 | Uniform_Matrix3 : T60; 14 | Uniform_Matrix4 : T61; 15 | Vertex_Attrib1 : T62; 16 | Vertex_Attrib2 : T63; 17 | Vertex_Attrib2v : T64; 18 | Vertex_Attrib3 : T65; 19 | Vertex_Attrib3v : T66; 20 | Vertex_Attrib4 : T67; 21 | Vertex_Attrib4v : T68; 22 | end GL.API.UInts; 23 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/auto_exceptions/gl-raise_exception_on_opengl_error.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Errors; 18 | 19 | separate (GL) 20 | procedure Raise_Exception_On_OpenGL_Error is 21 | begin 22 | case Errors.Error_Flag is 23 | when Errors.Invalid_Operation => raise Errors.Invalid_Operation_Error; 24 | when Errors.Invalid_Value => raise Errors.Invalid_Value_Error; 25 | when Errors.Invalid_Framebuffer_Operation => 26 | raise Errors.Invalid_Framebuffer_Operation_Error; 27 | when Errors.Out_Of_Memory => raise Errors.Out_Of_Memory_Error; 28 | when Errors.Stack_Overflow => raise Errors.Stack_Overflow_Error; 29 | when Errors.Stack_Underflow => raise Errors.Stack_Underflow_Error; 30 | when Errors.Invalid_Enum => raise Errors.Internal_Error; 31 | when Errors.No_Error => null; 32 | end case; 33 | exception 34 | when Constraint_Error => raise Errors.Internal_Error; 35 | end Raise_Exception_On_OpenGL_Error; 36 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-api-subprogram_reference.ads: -------------------------------------------------------------------------------- 1 | function GL.API.Subprogram_Reference (Function_Name : String) 2 | return System.Address; 3 | pragma Preelaborate (GL.API.Subprogram_Reference); -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-culling.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | with GL.Enums.Getter; 19 | 20 | package body GL.Culling is 21 | 22 | procedure Set_Front_Face (Face : Orientation) renames API.Front_Face; 23 | 24 | function Front_Face return Orientation is 25 | Ret : aliased Orientation; 26 | begin 27 | API.Get_Orientation (Enums.Getter.Cull_Face, Ret'Access); 28 | Raise_Exception_On_OpenGL_Error; 29 | return Ret; 30 | end Front_Face; 31 | 32 | procedure Set_Cull_Face (Selector : Face_Selector) renames API.Cull_Face; 33 | 34 | function Cull_Face return Face_Selector is 35 | Ret : aliased Face_Selector; 36 | begin 37 | API.Get_Face_Selector (Enums.Getter.Cull_Face_Mode, Ret'Access); 38 | Raise_Exception_On_OpenGL_Error; 39 | return Ret; 40 | end Cull_Face; 41 | 42 | end GL.Culling; 43 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-enums-indexes.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | 19 | package body GL.Enums.Indexes is 20 | 21 | function Representation (Value : Index) return Int is 22 | begin 23 | return Min_Representation + Value; 24 | end Representation; 25 | 26 | function Value (Representation : Int) return Index is 27 | begin 28 | return Representation - Min_Representation; 29 | end Value; 30 | 31 | function Get_Max return Int is 32 | Max : aliased Int; 33 | begin 34 | API.Get_Integer (Getter_Param, Max'Access); 35 | return Max - 1; 36 | end Get_Max; 37 | 38 | end GL.Enums.Indexes; 39 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-enums-indexes.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Types; 18 | with GL.Enums.Getter; 19 | 20 | generic 21 | Min_Representation : Types.Int; 22 | Getter_Param : Enums.Getter.Parameter; 23 | package GL.Enums.Indexes is 24 | pragma Preelaborate; 25 | 26 | use GL.Types; 27 | 28 | function Get_Max return Int; 29 | 30 | Max : constant Int := Get_Max; 31 | 32 | subtype Index is Int range 0 .. Max; 33 | 34 | function Representation (Value : Index) return Int; 35 | 36 | function Value (Representation : Int) return Index; 37 | 38 | end GL.Enums.Indexes; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-errors.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | 19 | package body GL.Errors is 20 | function Error_Flag return Error_Code renames API.Get_Error; 21 | end GL.Errors; 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-fixed.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | 19 | -- Fixed function pipeline. Deprecated in OpenGL 3.0. 20 | package body GL.Fixed is 21 | procedure Set_Vertex_Pointer (Length : Vertex_Length; 22 | Stride, Offset : Size) is 23 | 24 | begin 25 | API.Vertex_Pointer (Int (Length), Double_Type, 26 | Stride, Offset); 27 | Raise_Exception_On_OpenGL_Error; 28 | end Set_Vertex_Pointer; 29 | 30 | procedure Set_Color_Pointer (Stride, Offset : Size) is 31 | begin 32 | API.Color_Pointer (4, Single_Type, Stride, 33 | Int (Offset)); 34 | Raise_Exception_On_OpenGL_Error; 35 | end Set_Color_Pointer; 36 | 37 | procedure Enable (Capability : Client_Side_Capability) is 38 | begin 39 | API.Enable_Client_State (Capability); 40 | Raise_Exception_On_OpenGL_Error; 41 | end Enable; 42 | 43 | procedure Disable (Capability : Client_Side_Capability) is 44 | begin 45 | API.Disable_Client_State (Capability); 46 | Raise_Exception_On_OpenGL_Error; 47 | end Disable; 48 | end GL.Fixed; 49 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-helpers.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package body GL.Helpers is 18 | 19 | function Float_Array (Value : Colors.Color) return Low_Level.Single_Array is 20 | use GL.Types.Colors; 21 | begin 22 | return Low_Level.Single_Array' (1 => Value (R), 23 | 2 => Value (G), 24 | 3 => Value (B), 25 | 4 => Value (A)); 26 | end Float_Array; 27 | 28 | function Color (Value : Low_Level.Single_Array) return Colors.Color is 29 | use GL.Types.Colors; 30 | begin 31 | return Colors.Color' (R => Value (1), G => Value (2), B => Value (3), 32 | A => Value (4)); 33 | end Color; 34 | 35 | end GL.Helpers; 36 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-helpers.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Low_Level; 18 | with GL.Types.Colors; 19 | 20 | private package GL.Helpers is 21 | pragma Preelaborate; 22 | 23 | use GL.Types; 24 | 25 | function Float_Array (Value : Colors.Color) return Low_Level.Single_Array; 26 | function Color (Value : Low_Level.Single_Array) return Colors.Color; 27 | 28 | end GL.Helpers; 29 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-raster.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | 19 | package body GL.Raster is 20 | procedure Set_Pos (Position : Vector2) is 21 | begin 22 | API.Raster_Pos2 (Position); 23 | end Set_Pos; 24 | 25 | procedure Set_Pos (Position : Vector3) is 26 | begin 27 | API.Raster_Pos3 (Position); 28 | end Set_Pos; 29 | 30 | procedure Set_Pos (Position : Vector4) is 31 | begin 32 | API.Raster_Pos4 (Position); 33 | end Set_Pos; 34 | end GL.Raster; 35 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-tessellation.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2016, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | with GL.Enums; 19 | 20 | package body GL.Tessellation is 21 | 22 | procedure Set_Patch_Vertices (Value: Int) is 23 | begin 24 | API.Set_Patch_Parameter_Int (Enums.Vertices, Value); 25 | end Set_Patch_Vertices; 26 | 27 | procedure Set_Patch_Default_Inner_Level (Values: Single_Array) is 28 | begin 29 | API.Set_Patch_Parameter_Float_Array (Enums.Default_Inner_Level, Values); 30 | end Set_Patch_Default_Inner_Level; 31 | 32 | procedure Set_Patch_Default_Outer_Level (Values: Single_Array) is 33 | begin 34 | API.Set_Patch_Parameter_Float_Array (Enums.Default_Outer_Level, Values); 35 | end Set_Patch_Default_Outer_Level; 36 | end GL.Tessellation; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-toggles.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | 19 | package body GL.Toggles is 20 | procedure Enable (Subject : Toggle) is 21 | begin 22 | API.Enable (Subject); 23 | Raise_Exception_On_OpenGL_Error; 24 | end Enable; 25 | 26 | procedure Disable (Subject : Toggle) is 27 | begin 28 | API.Disable (Subject); 29 | Raise_Exception_On_OpenGL_Error; 30 | end Disable; 31 | 32 | procedure Set (Subject : Toggle; Value : Toggle_State) is 33 | begin 34 | if Value = Disabled then 35 | API.Disable (Subject); 36 | else 37 | API.Enable (Subject); 38 | end if; 39 | Raise_Exception_On_OpenGL_Error; 40 | end Set; 41 | 42 | function State (Subject : Toggle) return Toggle_State is 43 | Value : constant Low_Level.Bool := API.Is_Enabled (Subject); 44 | begin 45 | Raise_Exception_On_OpenGL_Error; 46 | if Value then 47 | return Enabled; 48 | else 49 | return Disabled; 50 | end if; 51 | end State; 52 | end GL.Toggles; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl-window.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | with GL.Enums.Getter; 19 | 20 | package body GL.Window is 21 | 22 | procedure Set_Viewport (X, Y : Int; Width, Height : Size) is 23 | begin 24 | GL.API.Viewport (X, Y, Width, Height); 25 | Raise_Exception_On_OpenGL_Error; 26 | end Set_Viewport; 27 | 28 | procedure Get_Viewport (X, Y : out Int; Width, Height : out Size) is 29 | Ret : Ints.Vector4; 30 | begin 31 | API.Get_Int_Vec4 (Enums.Getter.Viewport, Ret); 32 | Raise_Exception_On_OpenGL_Error; 33 | X := Ret (GL.X); 34 | Y := Ret (GL.Y); 35 | Width := Size (Ret (Z)); 36 | Height := Size (Ret (W)); 37 | end Get_Viewport; 38 | 39 | procedure Set_Depth_Range (Near, Far : Double) is 40 | begin 41 | API.Depth_Range (Near, Far); 42 | Raise_Exception_On_OpenGL_Error; 43 | end Set_Depth_Range; 44 | 45 | procedure Get_Depth_Range (Near, Far : out Double) is 46 | Ret : Doubles.Vector2; 47 | begin 48 | API.Get_Double_Vec2 (Enums.Getter.Depth_Range, Ret); 49 | Raise_Exception_On_OpenGL_Error; 50 | Near := Ret (X); 51 | Far := Ret (Y); 52 | end Get_Depth_Range; 53 | 54 | end GL.Window; 55 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/gl.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.API; 18 | with GL.Load_Function_Pointers; 19 | 20 | package body GL is 21 | 22 | procedure Init renames GL.Load_Function_Pointers; 23 | 24 | procedure Flush is 25 | begin 26 | API.Flush; 27 | end Flush; 28 | 29 | procedure Finish is 30 | begin 31 | API.Finish; 32 | end Finish; 33 | 34 | -- implementation depends on whether Auto_Exceptions has been enabled. 35 | procedure Raise_Exception_On_OpenGL_Error is separate; 36 | end GL; 37 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/implementation/no_auto_exceptions/gl-raise_exception_on_opengl_error.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | separate (GL) 18 | procedure Raise_Exception_On_OpenGL_Error is 19 | begin 20 | null; 21 | end Raise_Exception_On_OpenGL_Error; 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-context.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Ada.Strings.Unbounded; 18 | 19 | with GL.Types; 20 | 21 | package GL.Context is 22 | pragma Preelaborate; 23 | 24 | use GL.Types; 25 | 26 | type String_List is array (Positive range <>) of 27 | Ada.Strings.Unbounded.Unbounded_String; 28 | 29 | Null_String_List : constant String_List := (2 .. 1 => <>); 30 | 31 | -- these two require OpenGL 3: 32 | function Major_Version return Int; 33 | function Minor_Version return Int; 34 | 35 | -- legacy (deprecated in OpenGL 3) 36 | function Version_String return String; 37 | 38 | function Vendor return String; 39 | 40 | function Renderer return String; 41 | 42 | -- uses OpenGL 3 interface if available, otherwise old interface 43 | function Extensions return String_List; 44 | function Has_Extension (Name : String) return Boolean; 45 | 46 | function Primary_Shading_Language_Version return String; 47 | 48 | -- available since OpenGL 4.3: 49 | function Supported_Shading_Language_Versions return String_List; 50 | function Supports_Shading_Language_Version (Name : String) return Boolean; 51 | end GL.Context; 52 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-culling.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Types; 18 | 19 | private with GL.Low_Level; 20 | 21 | package GL.Culling is 22 | pragma Preelaborate; 23 | 24 | type Face_Selector is (Front, Back, Front_And_Back); 25 | 26 | use GL.Types; 27 | 28 | procedure Set_Front_Face (Face : Orientation); 29 | function Front_Face return Orientation; 30 | 31 | procedure Set_Cull_Face (Selector : Face_Selector); 32 | function Cull_Face return Face_Selector; 33 | 34 | private 35 | 36 | for Face_Selector use (Front => 16#0404#, 37 | Back => 16#0405#, 38 | Front_And_Back => 16#0408#); 39 | for Face_Selector'Size use Low_Level.Enum'Size; 40 | 41 | pragma Convention (StdCall, Set_Cull_Face); 42 | pragma Convention (StdCall, Set_Front_Face); 43 | end GL.Culling; 44 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-files.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Objects.Shaders; 18 | 19 | -- This package is an addition to the original OpenGL API and simplifies 20 | -- the handling of ressources located in files, like shader sources. 21 | package GL.Files is 22 | 23 | procedure Load_Shader_Source_From_File (Object : Objects.Shaders.Shader; 24 | File_Name : String); 25 | 26 | end GL.Files; 27 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-objects-lists.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2014, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | generic 18 | type Object_Type (<>) is new GL_Object with private; 19 | with function Generate_From_Id (Id : UInt) return Object_Type; 20 | package GL.Objects.Lists is 21 | pragma Preelaborate; 22 | 23 | type List (<>) is tagged private; 24 | 25 | type Cursor is private; 26 | 27 | No_Element : constant Cursor; 28 | 29 | function Create (Raw : UInt_Array) return List; 30 | 31 | function First (Object : List) return Cursor; 32 | function Last (Object : List) return Cursor; 33 | 34 | function Next (Current : Cursor) return Cursor; 35 | function Previous (Current : Cursor) return Cursor; 36 | 37 | function Has_Next (Current : Cursor) return Boolean; 38 | function Has_Previous (Current : Cursor) return Boolean; 39 | 40 | function Element (Current : Cursor) return Object_Type; 41 | 42 | private 43 | type List (Count : Size) is tagged record 44 | Contents : UInt_Array (1 .. Count); 45 | end record; 46 | 47 | type List_Access is access constant List; 48 | 49 | type Cursor is record 50 | Object : List_Access; 51 | Index : Size; 52 | end record; 53 | 54 | No_Element : constant Cursor := Cursor' (null, 0); 55 | 56 | end GL.Objects.Lists; 57 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-objects-shaders-lists.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2014, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Objects.Lists; 18 | 19 | package GL.Objects.Shaders.Lists is 20 | new GL.Objects.Lists (Shader, Create_From_Id); 21 | pragma Preelaborate (GL.Objects.Shaders.Lists); 22 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-objects-vertex_arrays.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package GL.Objects.Vertex_Arrays is 18 | 19 | type Vertex_Array_Object is new GL_Object with private; 20 | 21 | procedure Bind (Object : Vertex_Array_Object); 22 | 23 | procedure Draw_Arrays (Mode : Connection_Mode; First, Count : Size); 24 | 25 | function Current_Array_Object return Vertex_Array_Object; 26 | 27 | overriding 28 | procedure Initialize_Id (Object : in out Vertex_Array_Object); 29 | 30 | -- bind this object to unbind the current array object. 31 | Null_Array_Object : constant Vertex_Array_Object; 32 | private 33 | type Vertex_Array_Object is new GL_Object with null record; 34 | 35 | Null_Array_Object : constant Vertex_Array_Object 36 | := Vertex_Array_Object' (Ada.Finalization.Controlled with 37 | Reference => null); 38 | 39 | end GL.Objects.Vertex_Arrays; 40 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-raster.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Types; 18 | 19 | package GL.Raster is 20 | -- Obsolete as of OpenGL 3. Supplied here to support some older 3rd party 21 | -- functionality like Bitmap and Pixmap fonts of FTGL 22 | 23 | use GL.Types; 24 | use GL.Types.Doubles; 25 | 26 | procedure Set_Pos (Position : Vector2); 27 | procedure Set_Pos (Position : Vector3); 28 | procedure Set_Pos (Position : Vector4); 29 | end GL.Raster; 30 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-tessellation.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2016, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Types; 18 | 19 | package GL.Tessellation is 20 | pragma Preelaborate; 21 | 22 | use GL.Types; 23 | 24 | procedure Set_Patch_Vertices (Value: Int); 25 | 26 | procedure Set_Patch_Default_Inner_Level (Values: Single_Array); 27 | 28 | procedure Set_Patch_Default_Outer_Level (Values: Single_Array); 29 | end GL.Tessellation; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-types-colors.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C.Pointers; 18 | 19 | package GL.Types.Colors is 20 | pragma Preelaborate; 21 | 22 | type Color_Index is (R, G, B, A); 23 | subtype Basic_Color_Index is Color_Index range R .. B; 24 | 25 | subtype Component is Single range 0.0 .. 1.0; 26 | 27 | type Color is array (Color_Index) of aliased Component; 28 | type Basic_Color is array (Basic_Color_Index) of Component; 29 | 30 | pragma Convention (C, Color); 31 | pragma Convention (C, Basic_Color); 32 | 33 | type Color_Array is array (Size range <>) of aliased Color; 34 | type Basic_Color_Array is array (Size range <>) of aliased Basic_Color; 35 | 36 | package Color_Pointers is new Interfaces.C.Pointers 37 | (Size, Color, Color_Array, Color' (others => 0.0)); 38 | package Basic_Color_Pointers is new Interfaces.C.Pointers 39 | (Size, Basic_Color, Basic_Color_Array, Basic_Color' (others => 0.0)); 40 | end GL.Types.Colors; 41 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/interface/gl-window.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.Types; 18 | 19 | package GL.Window is 20 | use GL.Types; 21 | 22 | procedure Set_Viewport (X, Y : Int; Width, Height : Size); 23 | procedure Get_Viewport (X, Y : out Int; Width, Height : out Size); 24 | 25 | procedure Set_Depth_Range (Near, Far : Double); 26 | procedure Get_Depth_Range (Near, Far : out Double); 27 | 28 | end GL.Window; 29 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/mac/gl-api-mac_os_x.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package body GL.API.Mac_OS_X is 18 | OpenGLFramework_Cached : CFBundleRef; 19 | 20 | function OpenGLFramework return CFBundleRef is 21 | use type System.Address; 22 | begin 23 | if OpenGLFramework_Cached = System.Null_Address then 24 | declare 25 | OpenGLFramework_ID : constant CFStringRef 26 | := CFStringCreateWithCString (System.Null_Address, 27 | IFC.New_String ("com.apple.opengl"), 28 | kCFStringEncodingASCII); 29 | begin 30 | OpenGLFramework_Cached 31 | := CFBundleGetBundleWithIdentifier (OpenGLFramework_ID); 32 | end; 33 | end if; 34 | return OpenGLFramework_Cached; 35 | end OpenGLFramework; 36 | 37 | end GL.API.Mac_OS_X; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/mac/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | private with GL.API.Mac_OS_X; 18 | 19 | function GL.API.Subprogram_Reference (Function_Name : String) 20 | return System.Address is 21 | 22 | -- OSX-specific implementation uses CoreFoundation functions 23 | use GL.API.Mac_OS_X; 24 | 25 | package IFC renames Interfaces.C.Strings; 26 | 27 | GL_Function_Name_C : IFC.chars_ptr := IFC.New_String (Function_Name); 28 | 29 | Symbol_Name : constant CFStringRef := CFStringCreateWithCString 30 | (alloc => System.Null_Address, cStr => GL_Function_Name_C, 31 | encoding => kCFStringEncodingASCII); 32 | Result : constant System.Address := CFBundleGetFunctionPointerForName 33 | (bundle => OpenGLFramework, 34 | functionName => Symbol_Name); 35 | begin 36 | CFRelease (Symbol_Name); 37 | IFC.Free (GL_Function_Name_C); 38 | return Result; 39 | end GL.API.Subprogram_Reference; 40 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/specs/gl-api-doubles.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Doubles is 2 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Double) with 3 | Dynamic => "glVertexAttribL1d", 4 | Wrapper => "GL.Attributes.Set_Double"; 5 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Double) with 6 | Dynamic => "glVertexAttribL2d", 7 | Wrapper => "GL.Attributes.Set_Double"; 8 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 9 | Value : Types.Doubles.Vector2) with 10 | Dynamic => "glVertexAttribL2dv", 11 | Wrapper => "GL.Attributes.Set_Double"; 12 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Double) 13 | with Dynamic => "glVertexAttribL3d", 14 | Wrapper => "GL.Attributes.Set_Double"; 15 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 16 | Value : Types.Doubles.Vector3) with 17 | Dynamic => "glVertexAttribL3dv", 18 | Wrapper => "GL.Attributes.Set_Double"; 19 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 20 | V0, V1, V2, V3 : Double) with 21 | Dynamic => "glVertexAttribL4d", 22 | Wrapper => "GL.Attributes.Set_Double"; 23 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 24 | Value : Types.Doubles.Vector4) with 25 | Dynamic => "glVertexAttribL4dv", 26 | Wrapper => "GL.Attributes.Set_Double"; 27 | end GL.API.Doubles; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/specs/gl-api-shorts.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Shorts is 2 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Short) with 3 | Dynamic => "glVertexAttrib1s", 4 | Wrapper => "GL.Attributes.Set_Short"; 5 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Short) with 6 | Dynamic => "glVertexAttrib2s", 7 | Wrapper => "GL.Attributes.Set_Short"; 8 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 9 | Value : Shorts.Vector2) with 10 | Dynamic => "glVertexAttrib2sv", 11 | Wrapper => "GL.Attributes.Set_Short"; 12 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Short) 13 | with Dynamic => "glVertexAttrib3s", 14 | Wrapper => "GL.Attributes.Set_Short"; 15 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 16 | Value : Shorts.Vector3) with 17 | Dynamic => "glVertexAttrib3sv", 18 | Wrapper => "GL.Attributes.Set_Short"; 19 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 20 | V0, V1, V2, V3 : Short) with 21 | Dynamic => "glVertexAttrib4s", 22 | Wrapper => "GL.Attributes.Set_Short"; 23 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 24 | Value : Shorts.Vector4) with 25 | Dynamic => "glVertexAttrib4sv", 26 | Wrapper => "GL.Attributes.Set_Short"; 27 | end GL.API.Shorts; -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/windows/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.WGL; 18 | 19 | function GL.API.Subprogram_Reference (Function_Name : String) 20 | return System.Address is 21 | GL_Function_Name_C : Interfaces.C.Strings.chars_ptr 22 | := Interfaces.C.Strings.New_String (Function_Name); 23 | 24 | Result : constant System.Address 25 | := GL.WGL.wglGetProcAddress (GL_Function_Name_C); 26 | begin 27 | Interfaces.C.Strings.Free (GL_Function_Name_C); 28 | return Result; 29 | end GL.API.Subprogram_Reference; 30 | 31 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/gl/x11/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with GL.GLX; 18 | 19 | function GL.API.Subprogram_Reference (Function_Name : String) 20 | return System.Address is 21 | GL_Function_Name_C : Interfaces.C.Strings.chars_ptr 22 | := Interfaces.C.Strings.New_String (Function_Name); 23 | 24 | Result : constant System.Address 25 | := GL.GLX.Get_Proc_Address (GL_Function_Name_C); 26 | begin 27 | Interfaces.C.Strings.Free (GL_Function_Name_C); 28 | return Result; 29 | end GL.API.Subprogram_Reference; 30 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v2/glfw-display-modes.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package Glfw.Display.Modes is 18 | 19 | type Mode is record 20 | Width, Height : Natural; 21 | Red_Bits, Green_Bits, Blue_Bits : Natural; 22 | end record; 23 | 24 | type Mode_List is array (Positive range <>) of Mode; 25 | 26 | function Available_Modes return Mode_List; 27 | 28 | function Desktop_Mode return Mode; 29 | 30 | end Glfw.Display.Modes; 31 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v2/glfw-events-joysticks.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | private with Glfw.Enums; 18 | 19 | package Glfw.Events.Joysticks is 20 | use type Interfaces.C.C_float; 21 | 22 | -- GLFW supports up to 16 joysticks; they are indexed from 1 to 16. 23 | type Joystick_Index is range 1 .. 16; 24 | 25 | -- A Joystick object will link to the first joystick by default. 26 | type Joystick is tagged private; 27 | 28 | type Axis_Position is new Interfaces.C.C_float range -1.0 .. 1.0; 29 | type Axis_Positions is array (Positive range <>) of Axis_Position; 30 | 31 | function Index (Source : Joystick) return Joystick_Index; 32 | procedure Set_Index (Target : in out Joystick; Value : Joystick_Index); 33 | 34 | function Present (Source : Joystick) return Boolean; 35 | function Num_Axis (Source : Joystick) return Natural; 36 | function Num_Buttons (Source : Joystick) return Natural; 37 | 38 | procedure Get_Positions (Source : Joystick; Values : in out Axis_Positions); 39 | procedure Get_Buttons (Source : Joystick; Values : in out Button_States); 40 | 41 | private 42 | type Joystick is tagged record 43 | Raw_Index : Enums.Joystick_ID := Enums.Joystick_1; 44 | end record; 45 | end Glfw.Events.Joysticks; 46 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v2/glfw-events.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Glfw.Api; 18 | 19 | package body Glfw.Events is 20 | procedure Poll_Events is 21 | begin 22 | Api.Poll_Events; 23 | end Poll_Events; 24 | 25 | procedure Wait_For_Events is 26 | begin 27 | Api.Wait_Events; 28 | end Wait_For_Events; 29 | 30 | end Glfw.Events; 31 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v2/glfw-events.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C; 18 | 19 | package Glfw.Events is 20 | 21 | type Button_State is (Release, Press); 22 | type Button_States is array (Positive range <>) of Button_State; 23 | 24 | procedure Poll_Events; 25 | 26 | procedure Wait_For_Events; 27 | 28 | private 29 | for Button_State use (Release => 0, Press => 1); 30 | for Button_State'Size use Interfaces.C.int'Size; 31 | 32 | for Button_States'Component_Size use Interfaces.C.char'Size; 33 | pragma Convention (C, Button_States); 34 | end Glfw.Events; 35 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v2/glfw.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C; 18 | 19 | package Glfw is 20 | 21 | subtype Seconds is Interfaces.C.double; 22 | 23 | Initialization_Exception : exception; 24 | 25 | -- for convenience, besides executing GLFW's init procedures, this also calls 26 | -- GL.Init. 27 | procedure Init; 28 | 29 | procedure Terminate_Glfw; 30 | 31 | procedure Version (Major, Minor, Rev : out Natural); 32 | 33 | 34 | function Time return Seconds; 35 | 36 | procedure Set_Time (Value : Seconds); 37 | 38 | 39 | function Extension_Supported (Name : String) return Boolean; 40 | 41 | procedure GL_Version (Major, Minor, Rev : out Natural); 42 | 43 | procedure Toggle_Auto_Poll_Events (Enable : Boolean); 44 | 45 | private 46 | package C renames Interfaces.C; 47 | 48 | use type Interfaces.C.int; 49 | 50 | type Bool is new Boolean; 51 | 52 | 53 | 54 | for Bool use (False => 0, True => 1); 55 | for Bool'Size use C.int'Size; 56 | pragma Convention (C, Bool); 57 | 58 | end Glfw; 59 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-errors.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C.Strings; 18 | 19 | with Glfw.API; 20 | 21 | package body Glfw.Errors is 22 | 23 | Cur_Callback : Callback := null; 24 | 25 | procedure Raw_Handler (Code : Kind; 26 | Description : Interfaces.C.Strings.chars_ptr); 27 | pragma Convention (C, Raw_Handler); 28 | 29 | procedure Raw_Handler (Code : Kind; 30 | Description : Interfaces.C.Strings.chars_ptr) is 31 | begin 32 | if Cur_Callback /= null then 33 | Cur_Callback.all (Code, Interfaces.C.Strings.Value (Description)); 34 | end if; 35 | end Raw_Handler; 36 | 37 | procedure Set_Callback (Handler : Callback) is 38 | use type API.Error_Callback; 39 | Previous : API.Error_Callback; 40 | pragma Warnings (Off, Previous); 41 | begin 42 | Cur_Callback := Handler; 43 | if Handler = null then 44 | Previous := API.Set_Error_Callback (null); 45 | else 46 | Previous := API.Set_Error_Callback (Raw_Handler'Access); 47 | end if; 48 | end Set_Callback; 49 | 50 | end Glfw.Errors; 51 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-errors.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package Glfw.Errors is 18 | type Kind is (Not_Initialized, 19 | No_Current_Context, 20 | Invalid_Enum, 21 | Invalid_Value, 22 | Out_Of_Memory, 23 | API_Unavailable, 24 | Version_Unavailable, 25 | Platform_Error, 26 | Format_Unavailable); 27 | for Kind use (Not_Initialized => 16#00010001#, 28 | No_Current_Context => 16#00010002#, 29 | Invalid_Enum => 16#00010003#, 30 | Invalid_Value => 16#00010004#, 31 | Out_Of_Memory => 16#00010005#, 32 | API_Unavailable => 16#00010006#, 33 | Version_Unavailable => 16#00010007#, 34 | Platform_Error => 16#00010008#, 35 | Format_Unavailable => 16#00010009#); 36 | for Kind'Size use Interfaces.C.int'Size; 37 | 38 | type Callback is access procedure (Error : Kind; Description : String); 39 | 40 | procedure Set_Callback (Handler : Callback); 41 | end Glfw.Errors; 42 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-input-mouse.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package Glfw.Input.Mouse is 18 | 19 | type Button is new Interfaces.C.int range 0 .. 7; 20 | 21 | type Enter_Action is (Leaving, Entering); 22 | 23 | type Cursor_Mode is (Normal, Hidden, Disabled); 24 | 25 | Left_Button : constant := 0; 26 | Right_Button : constant := 1; 27 | Middle_Button : constant := 2; 28 | 29 | subtype Coordinate is Interfaces.C.double; 30 | subtype Scroll_Offset is Interfaces.C.double; 31 | 32 | private 33 | for Button'Size use Interfaces.C.int'Size; 34 | 35 | for Enter_Action use (Leaving => 0, 36 | Entering => 1); 37 | for Enter_Action'Size use C.int'Size; 38 | 39 | for Cursor_Mode use (Normal => 16#34001#, 40 | Hidden => 16#34002#, 41 | Disabled => 16#34003#); 42 | for Cursor_Mode'Size use Interfaces.C.int'Size; 43 | end Glfw.Input.Mouse; 44 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-input.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Glfw.API; 18 | 19 | package body Glfw.Input is 20 | 21 | procedure Poll_Events renames API.Poll_Events; 22 | 23 | procedure Wait_For_Events renames API.Wait_Events; 24 | 25 | end Glfw.Input; 26 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-input.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package Glfw.Input is 18 | type Button_State is (Released, Pressed); 19 | 20 | type Sticky_Toggle is (Sticky_Keys, Sticky_Mouse_Buttons); 21 | 22 | procedure Poll_Events; 23 | procedure Wait_For_Events; 24 | private 25 | for Button_State use (Released => 0, Pressed => 1); 26 | for Button_State'Size use Interfaces.C.int'Size; 27 | 28 | for Sticky_Toggle use (Sticky_Keys => 16#33002#, 29 | Sticky_Mouse_Buttons => 16#33003#); 30 | for Sticky_Toggle'Size use Interfaces.C.int'Size; 31 | 32 | -- just so we can implement them with rename 33 | pragma Convention (C, Poll_Events); 34 | pragma Convention (C, Wait_For_Events); 35 | 36 | end Glfw.Input; 37 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-windows-clipboard.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C.Strings; 18 | 19 | with Glfw.API; 20 | 21 | package body Glfw.Windows.Clipboard is 22 | 23 | function Get (Object : not null access Window'Class) return String is 24 | use type Interfaces.C.Strings.chars_ptr; 25 | 26 | Raw : constant Interfaces.C.Strings.chars_ptr 27 | := API.Get_Clipboard_String (Object.Handle); 28 | begin 29 | if Raw = Interfaces.C.Strings.Null_Ptr then 30 | raise Operation_Exception with "Could not get clipboard string"; 31 | end if; 32 | return Interfaces.C.Strings.Value (Raw); 33 | end Get; 34 | 35 | procedure Set (Object : not null access Window'Class; Value : String) is 36 | begin 37 | API.Set_Clipboard_String (Object.Handle, Interfaces.C.To_C (Value)); 38 | end Set; 39 | 40 | end Glfw.Windows.Clipboard; 41 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw-windows-clipboard.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | package Glfw.Windows.Clipboard is 18 | -- strings are UTF-8 encoded 19 | 20 | function Get (Object : not null access Window'Class) return String; 21 | 22 | procedure Set (Object : not null access Window'Class; Value : String); 23 | end Glfw.Windows.Clipboard; 24 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Glfw.Api; 18 | 19 | with Interfaces.C.Strings; 20 | 21 | package body Glfw is 22 | 23 | procedure Init is 24 | begin 25 | if Api.Init = 0 then 26 | raise Initialization_Exception; 27 | end if; 28 | end Init; 29 | 30 | procedure Shutdown is 31 | begin 32 | Api.Glfw_Terminate; 33 | end Shutdown; 34 | 35 | procedure Version (Major, Minor, Rev : out Natural) is 36 | Raw_Major, Raw_Minor, Raw_Rev : C.int; 37 | begin 38 | Api.Get_Version (Raw_Major, Raw_Minor, Raw_Rev); 39 | Major := Natural (Raw_Major); 40 | Minor := Natural (Raw_Minor); 41 | Rev := Natural (Raw_Rev); 42 | end Version; 43 | 44 | function Version_String return String is 45 | begin 46 | return Interfaces.C.Strings.Value (API.Get_Version_String); 47 | end Version_String; 48 | 49 | function Time return Seconds is 50 | begin 51 | return Api.Get_Time; 52 | end Time; 53 | 54 | procedure Set_Time (Value : Seconds) is 55 | begin 56 | Api.Set_Time (Value); 57 | end Set_Time; 58 | 59 | function Extension_Supported (Name : String) return Boolean is 60 | begin 61 | return Boolean (Api.Extension_Supported (Interfaces.C.To_C (Name))); 62 | end Extension_Supported; 63 | 64 | end Glfw; 65 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/glfw/v3/glfw.ads: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2013, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | with Interfaces.C; 18 | 19 | package Glfw is 20 | 21 | subtype Seconds is Interfaces.C.double; 22 | 23 | subtype Size is Interfaces.C.int range 0 .. Interfaces.C.int'Last; 24 | 25 | Initialization_Exception : exception; 26 | Operation_Exception : exception; 27 | 28 | -- for convenience, besides executing GLFW's init procedures, this also calls 29 | -- GL.Init. 30 | procedure Init; 31 | 32 | -- because terminate is a keyword in Ada 33 | procedure Shutdown; 34 | 35 | procedure Version (Major, Minor, Rev : out Natural); 36 | 37 | function Version_String return String; 38 | 39 | 40 | function Time return Seconds; 41 | 42 | procedure Set_Time (Value : Seconds); 43 | 44 | 45 | function Extension_Supported (Name : String) return Boolean; 46 | 47 | private 48 | package C renames Interfaces.C; 49 | 50 | use type Interfaces.C.int; 51 | 52 | type Bool is new Boolean; 53 | 54 | for Bool use (False => 0, True => 1); 55 | for Bool'Size use C.int'Size; 56 | pragma Convention (C, Bool); 57 | 58 | end Glfw; 59 | -------------------------------------------------------------------------------- /examples/marching/openglada/src/soil/stbi_DDS_aug.h: -------------------------------------------------------------------------------- 1 | /* 2 | adding DDS loading support to stbi 3 | */ 4 | 5 | #ifndef HEADER_STB_IMAGE_DDS_AUGMENTATION 6 | #define HEADER_STB_IMAGE_DDS_AUGMENTATION 7 | 8 | // is it a DDS file? 9 | extern int stbi_dds_test_memory (stbi_uc const *buffer, int len); 10 | 11 | extern stbi_uc *stbi_dds_load (char *filename, int *x, int *y, int *comp, int req_comp); 12 | extern stbi_uc *stbi_dds_load_from_memory (stbi_uc const *buffer, int len, int *x, int *y, int *comp, int req_comp); 13 | #ifndef STBI_NO_STDIO 14 | extern int stbi_dds_test_file (FILE *f); 15 | extern stbi_uc *stbi_dds_load_from_file (FILE *f, int *x, int *y, int *comp, int req_comp); 16 | #endif 17 | 18 | // 19 | // 20 | //// end header file ///////////////////////////////////////////////////// 21 | #endif // HEADER_STB_IMAGE_DDS_AUGMENTATION 22 | -------------------------------------------------------------------------------- /examples/marching/src/common/colors.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- Copyright (C) 2021, AdaCore -- 3 | -- This is free software; you can redistribute it and/or modify it under -- 4 | -- terms of the GNU General Public License as published by the Free Soft- -- 5 | -- ware Foundation; either version 3, or (at your option) any later ver- -- 6 | -- sion. This software is distributed in the hope that it will be useful, -- 7 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 8 | -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- 9 | -- License for more details. You should have received a copy of the GNU -- 10 | -- General Public License distributed with this software; see file -- 11 | -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- 12 | -- of the license. -- 13 | ------------------------------------------------------------------------------ 14 | 15 | package Colors is 16 | 17 | type RGB_T is record 18 | R, G, B : Float; 19 | end record; 20 | 21 | function "+" (Left, Right : RGB_T) return RGB_T is 22 | (Left.R + Right.R, Left.G + Right.G, Left.B + Right.B); 23 | 24 | function "-" (Left, Right : RGB_T) return RGB_T is 25 | (Left.R - Right.R, Left.G - Right.G, Left.B - Right.B); 26 | 27 | function "*" (Left : RGB_T; Right : Float) return RGB_T is 28 | (Left.R * Right, Left.G * Right, Left.B * Right); 29 | 30 | function "/" (Left : RGB_T; Right : Float) return RGB_T is 31 | (Left.R / Right, Left.G / Right, Left.B / Right); 32 | 33 | type HSL_T is record 34 | H, S, L : Float; 35 | end record; 36 | 37 | function HSL_To_RGB (Src : HSL_T) return RGB_T; 38 | 39 | function RGB_To_HSL (src : RGB_T) return HSL_T; 40 | 41 | end Colors; 42 | -------------------------------------------------------------------------------- /examples/marching/src/host/cameras.ads: -------------------------------------------------------------------------------- 1 | with GL.Types; use GL.Types; 2 | use GL.Types.Singles; 3 | 4 | with Maths; use Maths; 5 | 6 | package Cameras is 7 | 8 | type Camera_T is record 9 | Position : Vector3 := (0.0, 0.0, 0.0); 10 | Front : Vector3 := (0.0, 0.0, 1.0); 11 | Up : Vector3 := (1.0, 0.0, 0.0); 12 | Right : Vector3 := (0.0, 1.0, 0.0); 13 | World_Up : Vector3 := (1.0, 0.0, 0.0); 14 | 15 | Yaw : Degree := 0.0; 16 | Pitch : Degree := 0.0; 17 | 18 | Movement_Speed : Single := 0.0; 19 | Mouse_Sensitivity : Single := 0.0; 20 | Zoom : Degree := 0.0; 21 | end record; 22 | 23 | -- // Default camera values 24 | Default_Yaw : constant := -90.0; 25 | Default_Pitch : constant := 0.0; 26 | Default_Speed : constant := 2.5; 27 | Default_Sensitivity : constant := 0.1; 28 | Default_Zoom : constant := 45.0; 29 | 30 | function Create 31 | (Position : Vector3 := (0.0, 0.0, 0.0); Up : Vector3 := (0.0, 1.0, 0.0); 32 | Yaw : Degree := Default_Yaw; Pitch : Degree := Default_Pitch) 33 | return Camera_T; 34 | 35 | function Get_View_Matrix (Self : Camera_T) return Matrix4; 36 | 37 | procedure Process_Mouse_Movement 38 | (Self : in out Camera_T; X_Offset, Y_Offset : Single); 39 | 40 | procedure Process_Mouse_Scroll (Self : in out Camera_T; Y_Offset : Single); 41 | 42 | procedure Update_Camera_Vectors (Self : in out Camera_T); 43 | 44 | end Cameras; 45 | -------------------------------------------------------------------------------- /examples/marching/src/host/paths.ads: -------------------------------------------------------------------------------- 1 | with Ada.Command_Line; 2 | with GNAT.OS_Lib; 3 | with Ada.Directories; 4 | with Ada.Strings; use Ada.Strings; 5 | with Ada.Strings.Fixed; use Ada.Strings.Fixed; 6 | with Ada.Strings.Unbounded; 7 | 8 | package Paths is 9 | type Path is new String; 10 | 11 | function "+" (P : Path) return String is (String (P)); 12 | 13 | function "+" (S : Ada.Strings.Unbounded.Unbounded_String) return Path is 14 | (Path (Ada.Strings.Unbounded.To_String (S))); 15 | 16 | function Is_Absolute (P : Path) return Boolean is 17 | (GNAT.OS_Lib.Is_Absolute_Path (+P)); 18 | 19 | function Is_Directory (P : Path) return Boolean is 20 | (GNAT.OS_Lib.Is_Directory (+P)); 21 | 22 | function Is_Regular_File (P : Path) return Boolean is 23 | (GNAT.OS_Lib.Is_Regular_File (+P)); 24 | 25 | function Exists (P : Path) return Boolean is (Ada.Directories.Exists (+P)); 26 | 27 | function "/" (P1 : Path; P2 : Path) return Path is 28 | (P1 & GNAT.OS_Lib.Directory_Separator & P2) with 29 | Pre => not Is_Absolute (P2); 30 | 31 | Directory_Separator_Str : constant String (1 .. 1) := 32 | (1 => GNAT.OS_Lib.Directory_Separator); 33 | 34 | function Contains_Separator (S : String) return Boolean is 35 | (Index (S, Directory_Separator_Str) /= 0); 36 | 37 | function Parent (P : Path) return Path is 38 | (P 39 | (P'First .. 40 | Index (+P, Directory_Separator_Str, Going => Backward) - 1)) with 41 | Pre => Contains_Separator 42 | (+P) -- no path separator, no parent 43 | and P'Length > 1; -- single path separator, no parent 44 | 45 | function Root_Dir return Path 46 | -- Root dir of the project, based on the fact that main is placed in it 47 | is 48 | (Parent 49 | (Path 50 | (GNAT.OS_Lib.Normalize_Pathname 51 | (Ada.Command_Line.Command_Name)))) with 52 | Pre => Contains_Separator (Ada.Command_Line.Command_Name), 53 | Post => Is_Absolute (Root_Dir'Result) and Is_Directory (Root_Dir'Result); 54 | 55 | function Resolve_From_Root (File : Path) return Path is 56 | (if Is_Absolute (File) then File else Root_Dir / File) with 57 | Post => 58 | Is_Absolute (Resolve_From_Root'Result) and 59 | Exists (Resolve_From_Root'Result); 60 | 61 | end Paths; 62 | -------------------------------------------------------------------------------- /examples/marching/src/host/ui.ads: -------------------------------------------------------------------------------- 1 | with Geometry; use Geometry; 2 | with Ada.Numerics.Elementary_Functions; 3 | use Ada.Numerics.Elementary_Functions; 4 | 5 | package UI is 6 | 7 | procedure Initialize; 8 | 9 | procedure Finalize; 10 | 11 | procedure Draw (Verts : Vertex_Array; Tris : Triangle_Array; Running : out Boolean); 12 | 13 | function Length (R : Point_Real) return Float is 14 | (Sqrt (R.X ** 2 + R.Y ** 2 + R.Z ** 2)); 15 | 16 | function Normalize (R : Point_Real) return Point_Real is 17 | (declare 18 | L : constant Float := Length (R); 19 | begin 20 | (if L = 0.0 then 21 | (0.0, 0.0, 0.0) 22 | else 23 | R / L)); 24 | 25 | end UI; 26 | -------------------------------------------------------------------------------- /examples/marching/src/shaders/frag.glsl: -------------------------------------------------------------------------------- 1 | #version 410 2 | 3 | in VS_OUT 4 | { 5 | vec4 colour; 6 | } fs_in; 7 | 8 | out vec4 fragment_colour; 9 | 10 | void main() 11 | { 12 | fragment_colour = fs_in.colour; 13 | } 14 | 15 | // in VS_OUT 16 | // { 17 | // vec4 colour; 18 | // } fs_in; 19 | 20 | // out vec4 fragment_colour; 21 | 22 | // void main() 23 | // { 24 | // fragment_colour = fs_in.colour; 25 | // } 26 | -------------------------------------------------------------------------------- /examples/marching/src/shaders/pbr.vs: -------------------------------------------------------------------------------- 1 | #version 330 core 2 | 3 | // License https://creativecommons.org/licenses/by-nc/4.0/ 4 | // Author Joey de Vries 5 | // URL https://learnopengl.com/ 6 | // Twitter https://twitter.com/JoeyDeVriez 7 | 8 | layout (location = 0) in vec3 aPos; 9 | layout (location = 1) in vec2 aTexCoords; 10 | layout (location = 2) in vec3 aNormal; 11 | layout (location = 3) in vec3 aAlbedo; 12 | 13 | out vec2 TexCoords; 14 | out vec3 WorldPos; 15 | out vec3 Normal; 16 | out vec3 Albedo; 17 | 18 | uniform mat4 projection; 19 | uniform mat4 view; 20 | uniform mat4 model; 21 | 22 | void main() 23 | { 24 | TexCoords = aTexCoords; 25 | WorldPos = vec3(model * vec4(aPos, 1.0)); 26 | Normal = mat3(model) * aNormal; 27 | Albedo = aAlbedo; 28 | 29 | gl_Position = projection * view * vec4(WorldPos, 1.0); 30 | } 31 | -------------------------------------------------------------------------------- /examples/marching/src/shaders/vert.glsl: -------------------------------------------------------------------------------- 1 | #version 410 2 | 3 | in vec4 position; 4 | 5 | out VS_OUT { 6 | vec4 colour; 7 | } vs_out; 8 | 9 | uniform mat4 m_viewModel; 10 | uniform mat4 m_pvm; 11 | 12 | void main() { 13 | gl_Position = m_pvm * m_viewModel * position; 14 | vs_out.colour = 2.0 * position + vec4 (0.5, 0.5, 0.5, 0.0); 15 | } 16 | -------------------------------------------------------------------------------- /gen-rts-sources.py: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env python3 2 | # 3 | # Copyright (C) 2016-2020, AdaCore 4 | # 5 | # Python script to gather files for the bareboard runtime. 6 | # Don't use any fancy features. Ideally, this script should work with any 7 | # Python version starting from 2.6 (yes, it's very old but that's the system 8 | # python on oldest host). 9 | 10 | import os 11 | import sys 12 | 13 | # look for --bb-dir to add it to the sys path 14 | path = None 15 | take_next = False 16 | index = 0 17 | while index < len(sys.argv): 18 | arg = sys.argv[index] 19 | if arg.startswith("--bb-dir="): 20 | _, path = arg.split("=") 21 | sys.argv.remove(arg) 22 | break 23 | elif arg == "--bb-dir": 24 | take_next = True 25 | sys.argv.remove(arg) 26 | elif take_next: 27 | path = arg 28 | sys.argv.remove(arg) 29 | break 30 | else: 31 | index += 1 32 | 33 | assert path is not None, "missing --bb-dir switch" 34 | sys.path.append(os.path.abspath(path)) 35 | 36 | # also add ./runtime 37 | sys.path.append(os.path.join(os.path.dirname(__file__), "runtime")) 38 | 39 | # import our cuda gnat rts sources 40 | import cuda_sources 41 | 42 | # and replace in the original module before it is used by the 43 | # build_rts script and its dependencies 44 | import support.rts_sources.sources 45 | 46 | support.rts_sources.sources.all_scenarios = cuda_sources.rts_scenarios 47 | support.rts_sources.sources.sources = cuda_sources.rts_sources 48 | 49 | import gen_rts_sources 50 | from support import add_source_search_path 51 | 52 | 53 | def instrument_bb_runtimes(): 54 | # Add the runtime directory in the BSP sources search path 55 | PWD = os.path.join(os.path.dirname(__file__), "runtime") 56 | add_source_search_path(PWD) 57 | 58 | 59 | def main(): 60 | instrument_bb_runtimes() 61 | gen_rts_sources.main() 62 | 63 | 64 | if __name__ == "__main__": 65 | main() 66 | -------------------------------------------------------------------------------- /locate_cuda_root.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | set -e 3 | 4 | usage() { 5 | echo "usage: $(basename "$0") [-h] [cuda_root_directory]" 6 | echo "Tests and returns the path to the CUDA root, from either the " 7 | echo "environment, the argument given, or a very smart (not) heuristic" 8 | echo "" 9 | echo "optional arguments" 10 | echo " -h Display usage" 11 | echo " cuda_root_directory Directory to the CUDA install" 12 | echo "" 13 | echo "Output and exit status:" 14 | echo " In case the directory is invalid, return an error code." 15 | echo " Otherwise outputs the name of the directory, and exports" 16 | echo " the CUDA_ROOT environment variable to the directory." 17 | } 18 | 19 | assert() { 20 | set +e 21 | # Sub-shell for pipes... 22 | $SHELL -ec "$*" >/dev/null 2>&1 23 | fail=$? 24 | set -e 25 | if [ $fail -eq 1 ]; then 26 | echo "assert failed: $*" >&2 27 | exit 2 28 | fi 29 | } 30 | 31 | # Check args and display usage 32 | if [ $# -gt 1 ]; then 33 | echo "wrong number of arguments">&2 34 | echo 35 | usage 36 | exit 2 37 | fi 38 | 39 | if [ "$1" = "-h" ]; then 40 | usage 41 | exit 0 42 | fi 43 | 44 | # Locate root 45 | if [ -n "$1" ]; then 46 | ## Use argument 47 | CUDA_ROOT="$1" 48 | elif [ -n "$CUDA_ROOT" ]; then 49 | ## Use already set value 50 | true # no-op 51 | elif command -v nvcc >/dev/null; then 52 | ## Heuristic: $CUDA_ROOT/bin/nvcc 53 | nvcc=$(readlink -f "$(command -v nvcc)") 54 | assert test -f "$nvcc" 55 | CUDA_ROOT=$(dirname "$(dirname "$nvcc")") 56 | else 57 | ## Try a "standard" directory 58 | CUDA_ROOT="/usr/local/cuda" 59 | fi 60 | 61 | # Check root seems correct 62 | assert test -d "$(realpath "$CUDA_ROOT")" 63 | assert test -d "$CUDA_ROOT/include" 64 | assert test -f "$CUDA_ROOT/bin/ptxas" 65 | assert test -f "$CUDA_ROOT/bin/nvcc" 66 | assert "find -L '$CUDA_ROOT' -iname 'libdevice.*.bc' -print -quit | grep lib" 67 | 68 | # Result 69 | export CUDA_ROOT 70 | echo "$CUDA_ROOT" 71 | -------------------------------------------------------------------------------- /runtime/__init__.py: -------------------------------------------------------------------------------- 1 | from support.bsp_sources.target import DFBBTarget 2 | 3 | import os 4 | 5 | # cuda library 6 | CUDA_API = os.path.join(os.path.dirname(__file__), "..", "api") 7 | 8 | 9 | def add_source_dir(holder, subdir, path): 10 | for f in os.listdir(path): 11 | full = os.path.join(path, f) 12 | if os.path.isfile(full): 13 | holder.add_source(subdir, full) 14 | 15 | 16 | class CUDADevice(DFBBTarget): 17 | @property 18 | def name(self): 19 | return "cuda" 20 | 21 | @property 22 | def target(self): 23 | return "cuda" 24 | 25 | # @property 26 | # def readme_file(self): 27 | # return os.path.join(os.path.dirname(__file__), 'README') 28 | 29 | @property 30 | def system_ads(self): 31 | return {"device": "runtime/device_gnat/system.ads"} 32 | 33 | @property 34 | def compiler_switches(self): 35 | # The required compiler switches 36 | return (f"-mcpu={self.gpu_arch}",) 37 | 38 | def base_profile(self, profile): 39 | # No base profile as the CUDA runtime uses it's own sources. 40 | return "none" 41 | 42 | def amend_rts(self, rts_profile, cfg): 43 | super(CUDADevice, self).amend_rts("none", cfg) 44 | cfg.rts_vars["Cuda_Target"] = "device" 45 | # Add cuda sources. Probably better to put these in their own cuda 46 | # directory with their own make file. 47 | # add_source_dir(cfg, 'gnat', os.path.join(CUDA_API, 'device_static')) 48 | 49 | def __init__(self): 50 | super(CUDADevice, self).__init__() 51 | -------------------------------------------------------------------------------- /runtime/device_gnat/a-nuelfu.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- A D A . N U M E R I C S . E L E M E N T A R Y _ F U N C T I O N S -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | with Ada.Numerics.Generic_Elementary_Functions; 17 | 18 | package Ada.Numerics.Elementary_Functions is 19 | new Ada.Numerics.Generic_Elementary_Functions (Float); 20 | 21 | pragma Pure (Elementary_Functions); 22 | -------------------------------------------------------------------------------- /runtime/device_gnat/a-numeri.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- A D A . N U M E R I C S -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | package Ada.Numerics is 17 | pragma Pure; 18 | 19 | Pi : constant := 20 | 3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37511; 21 | 22 | e : constant := 23 | 2.71828_18284_59045_23536_02874_71352_66249_77572_47093_69996; 24 | 25 | end Ada.Numerics; 26 | -------------------------------------------------------------------------------- /runtime/device_gnat/a-unccon.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- A D A . U N C H E C K E D _ C O N V E R S I O N -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | generic 17 | type Source (<>) is limited private; 18 | type Target (<>) is limited private; 19 | 20 | function Ada.Unchecked_Conversion (S : Source) return Target; 21 | 22 | pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion); 23 | pragma Pure (Ada.Unchecked_Conversion); 24 | pragma Import (Intrinsic, Ada.Unchecked_Conversion); 25 | -------------------------------------------------------------------------------- /runtime/device_gnat/ada.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT RUN-TIME COMPONENTS -- 4 | -- -- 5 | -- A D A -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | package Ada is 17 | pragma No_Elaboration_Code_All; 18 | pragma Pure; 19 | 20 | end Ada; 21 | -------------------------------------------------------------------------------- /runtime/device_gnat/machcode.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- M A C H I N E _ C O D E -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | with System.Machine_Code; 17 | 18 | package Machine_Code renames System.Machine_Code; 19 | -------------------------------------------------------------------------------- /runtime/device_gnat/unchconv.ads: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------ 2 | -- -- 3 | -- GNAT COMPILER COMPONENTS -- 4 | -- -- 5 | -- U N C H E C K E D _ C O N V E R S I O N -- 6 | -- -- 7 | -- S p e c -- 8 | -- -- 9 | -- This specification is derived from the Ada Reference Manual for use with -- 10 | -- GNAT. In accordance with the copyright of that document, you can freely -- 11 | -- copy and modify this specification, provided that if you redistribute a -- 12 | -- modified version, any changes that you have made are clearly indicated. -- 13 | -- -- 14 | ------------------------------------------------------------------------------ 15 | 16 | generic 17 | type Source (<>) is limited private; 18 | type Target (<>) is limited private; 19 | 20 | function Unchecked_Conversion (S : Source) return Target; 21 | pragma Import (Intrinsic, Unchecked_Conversion); 22 | pragma Pure (Unchecked_Conversion); 23 | -------------------------------------------------------------------------------- /testsuite/tests/examples/matrixMul/test.out: -------------------------------------------------------------------------------- 1 | [Matrix Multiply Using CUDA] - Starting... 2 | MatrixA (320, 320), MatrixB (640, 320) 3 | Computing result using CUDA Kernel... 4 | done 5 | Computing result using Iteration... 6 | done 7 | Checking computed result for correctness: 8 | Correct cuda: 204800, errors: 0 9 | Correct iter: 204800, errors: 0 10 | Result = PASS 11 | -------------------------------------------------------------------------------- /testsuite/tests/examples/matrixMul/test.yaml: -------------------------------------------------------------------------------- 1 | driver: examples 2 | input_directory: "0_Introduction/matrixMul" 3 | -------------------------------------------------------------------------------- /testsuite/tests/examples/vectorAdd/test.out: -------------------------------------------------------------------------------- 1 | [Vector addition of 4096 elements] 2 | CUDA kernel launch with 16 blocks of 256 threads 3 | Copy output data from the CUDA device to the host memory 4 | Test PASSED 5 | Done 6 | -------------------------------------------------------------------------------- /testsuite/tests/examples/vectorAdd/test.yaml: -------------------------------------------------------------------------------- 1 | driver: examples 2 | input_directory: "0_Introduction/vectorAdd" 3 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Library_Interface use ("kernel"); 6 | 7 | for Languages use ("Ada"); 8 | for Source_Dirs use ("src/common"); 9 | for Object_Dir use "obj/device"; 10 | 11 | for Target use "cuda"; 12 | for Library_Name use "device"; 13 | for Library_Dir use "lib"; 14 | for Library_Standalone use "encapsulated"; 15 | for Library_Kind use "dynamic"; 16 | 17 | package Compiler is 18 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 19 | end Compiler; 20 | 21 | package Binder is 22 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 23 | end Binder; 24 | 25 | for Library_Options use CUDA_API_Device.Library_Options; 26 | 27 | end Device; 28 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | package body Kernel is 5 | 6 | procedure Vector_Add 7 | (A_Addr : System.Address; 8 | B_Addr : System.Address; 9 | C_Addr : System.Address; 10 | Num_Elements : Integer) 11 | is 12 | A : Float_Array (1..Num_Elements) with Address => A_Addr; 13 | B : Float_Array (1..Num_Elements) with Address => B_Addr; 14 | C : Float_Array (1..Num_Elements) with Address => C_Addr; 15 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 16 | begin 17 | if I < Num_Elements then 18 | C (C'First + I) := A (A'First + I) + B (B'First + I) + Elaborated_Value; 19 | end if; 20 | end Vector_Add; 21 | 22 | begin 23 | 24 | for I in 1 .. 10_000 loop 25 | Elaborated_Value := Elaborated_Value + 1.0; 26 | end loop; 27 | 28 | end Kernel; 29 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package Kernel is 4 | 5 | Elaborated_Value : Float := 0.0; 6 | 7 | type Float_Array is array (Integer range <>) of Float; 8 | 9 | type Access_Host_Float_Array is access all Float_Array; 10 | 11 | procedure Vector_Add 12 | (A_Addr : System.Address; 13 | B_Addr : System.Address; 14 | C_Addr : System.Address; 15 | Num_Elements : Integer) 16 | with CUDA_Global; 17 | 18 | end Kernel; 19 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/test.out: -------------------------------------------------------------------------------- 1 | [Vector addition of 4096 elements] 2 | CUDA kernel launch with 16 blocks of 256 threads 3 | Copy output data from the CUDA device to the host memory 4 | Test PASSED 5 | Done 6 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_elab/test.yaml: -------------------------------------------------------------------------------- 1 | driver: text_oracle 2 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernel"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | with System.Assertions; use System.Assertions; 5 | 6 | package body Kernel is 7 | 8 | procedure Vector_Add 9 | (A : Array_Device_Access; 10 | B : Array_Device_Access; 11 | C : Array_Device_Access) 12 | is 13 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 14 | begin 15 | C (C'First + I) := A (A'First + I) + B (B'First + I); 16 | end Vector_Add; 17 | 18 | end Kernel; 19 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | with CUDA.Storage_Models; use CUDA.Storage_Models; 4 | 5 | package Kernel is 6 | 7 | type Float_Array is array (Integer range <>) of Float; 8 | 9 | type Array_Device_Access is access Float_Array 10 | with Designated_Storage_Model => CUDA.Storage_Models.Model; 11 | 12 | procedure Vector_Add 13 | (A : Array_Device_Access; 14 | B : Array_Device_Access; 15 | C : Array_Device_Access) 16 | with CUDA_Global; 17 | 18 | end Kernel; 19 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/test.out: -------------------------------------------------------------------------------- 1 | [Vector addition of 4096 elements] 2 | CUDA kernel launch with 16 blocks of 257 threads 3 | Copy output data from the CUDA device to the host memory 4 | kernel.adb:15: : block: [15,0,0], thread: [256,0,0] Assertion `` failed. 5 | kernel.adb:15: : block: [15,0,0], thread: [241,0,0] Assertion `` failed. 6 | kernel.adb:15: : block: [15,0,0], thread: [242,0,0] Assertion `` failed. 7 | kernel.adb:15: : block: [15,0,0], thread: [243,0,0] Assertion `` failed. 8 | kernel.adb:15: : block: [15,0,0], thread: [244,0,0] Assertion `` failed. 9 | kernel.adb:15: : block: [15,0,0], thread: [245,0,0] Assertion `` failed. 10 | kernel.adb:15: : block: [15,0,0], thread: [246,0,0] Assertion `` failed. 11 | kernel.adb:15: : block: [15,0,0], thread: [247,0,0] Assertion `` failed. 12 | kernel.adb:15: : block: [15,0,0], thread: [248,0,0] Assertion `` failed. 13 | kernel.adb:15: : block: [15,0,0], thread: [249,0,0] Assertion `` failed. 14 | kernel.adb:15: : block: [15,0,0], thread: [250,0,0] Assertion `` failed. 15 | kernel.adb:15: : block: [15,0,0], thread: [251,0,0] Assertion `` failed. 16 | kernel.adb:15: : block: [15,0,0], thread: [252,0,0] Assertion `` failed. 17 | kernel.adb:15: : block: [15,0,0], thread: [253,0,0] Assertion `` failed. 18 | kernel.adb:15: : block: [15,0,0], thread: [254,0,0] Assertion `` failed. 19 | kernel.adb:15: : block: [15,0,0], thread: [255,0,0] Assertion `` failed. 20 | 21 | raised CUDA.EXCEPTIONS.ERROR_CUDAERRORASSERT 22 | >>>program returned status code 1 23 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_exception/test.yaml: -------------------------------------------------------------------------------- 1 | driver: text_oracle 2 | expect_failure: True 3 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Library_Interface use ("kernel"); 6 | 7 | for Languages use ("Ada"); 8 | for Source_Dirs use ("src/common"); 9 | for Object_Dir use "obj/device"; 10 | 11 | for Target use "cuda"; 12 | for Library_Name use "device"; 13 | for Library_Dir use "lib"; 14 | for Library_Standalone use "encapsulated"; 15 | for Library_Kind use "dynamic"; 16 | 17 | package Compiler is 18 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 19 | end Compiler; 20 | 21 | package Binder is 22 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 23 | end Binder; 24 | 25 | for Library_Options use CUDA_API_Device.Library_Options; 26 | 27 | end Device; 28 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/src/common/device_functions.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | package body Device_Functions is 5 | 6 | procedure Vector_Add_Device 7 | (A_Addr : System.Address; 8 | B_Addr : System.Address; 9 | C_Addr : System.Address; 10 | Num_Elements : Integer) 11 | is 12 | A : Float_Array (1..Num_Elements) with Address => A_Addr; 13 | B : Float_Array (1..Num_Elements) with Address => B_Addr; 14 | C : Float_Array (1..Num_Elements) with Address => C_Addr; 15 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 16 | begin 17 | if I < Num_Elements then 18 | C (C'First + I) := A (A'First + I) + B (B'First + I); 19 | end if; 20 | end Vector_Add_Device; 21 | 22 | end Device_Functions; 23 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/src/common/device_functions.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package Device_Functions is 4 | 5 | type Float_Array is array (Integer range <>) of Float; 6 | 7 | type Access_Host_Float_Array is access all Float_Array; 8 | 9 | procedure Vector_Add_Device 10 | (A_Addr : System.Address; 11 | B_Addr : System.Address; 12 | C_Addr : System.Address; 13 | Num_Elements : Integer); 14 | 15 | end Device_Functions; 16 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with Device_Functions; use Device_Functions; 2 | 3 | package body Kernel is 4 | 5 | procedure Vector_Add 6 | (A_Addr : System.Address; 7 | B_Addr : System.Address; 8 | C_Addr : System.Address; 9 | Num_Elements : Integer) 10 | is 11 | begin 12 | Vector_Add_Device (A_Addr, B_Addr, C_Addr, Num_Elements); 13 | end Vector_Add; 14 | 15 | end Kernel; 16 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package Kernel is 4 | 5 | type Float_Array is array (Integer range <>) of Float; 6 | 7 | type Access_Host_Float_Array is access all Float_Array; 8 | 9 | procedure Vector_Add 10 | (A_Addr : System.Address; 11 | B_Addr : System.Address; 12 | C_Addr : System.Address; 13 | Num_Elements : Integer) 14 | with CUDA_Global; 15 | 16 | end Kernel; 17 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/test.out: -------------------------------------------------------------------------------- 1 | [Vector addition of 4096 elements] 2 | CUDA kernel launch with 16 blocks of 256 threads 3 | Copy output data from the CUDA device to the host memory 4 | Test PASSED 5 | Done 6 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_linked/test.yaml: -------------------------------------------------------------------------------- 1 | driver: text_oracle 2 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Library_Interface use ("kernel"); 6 | 7 | for Languages use ("Ada"); 8 | for Source_Dirs use ("src/common"); 9 | for Object_Dir use "obj/device"; 10 | 11 | for Target use "cuda"; 12 | for Library_Name use "device"; 13 | for Library_Dir use "lib"; 14 | for Library_Standalone use "encapsulated"; 15 | for Library_Kind use "dynamic"; 16 | 17 | package Compiler is 18 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 19 | end Compiler; 20 | 21 | package Binder is 22 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 23 | end Binder; 24 | 25 | for Library_Options use CUDA_API_Device.Library_Options; 26 | 27 | end Device; 28 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | package body Kernel is 5 | 6 | procedure Vector_Add 7 | (A_Addr : System.Address; 8 | B_Addr : System.Address; 9 | C_Addr : System.Address; 10 | Num_Elements : Integer) 11 | is 12 | A : Float_Array (1..Num_Elements) with Address => A_Addr; 13 | B : Float_Array (1..Num_Elements) with Address => B_Addr; 14 | C : Float_Array (1..Num_Elements) with Address => C_Addr; 15 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 16 | begin 17 | if I < Num_Elements then 18 | C (C'First + I) := A (A'First + I) + B (B'First + I); 19 | end if; 20 | end Vector_Add; 21 | 22 | end Kernel; 23 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package Kernel is 4 | 5 | type Float_Array is array (Integer range <>) of Float; 6 | 7 | type Access_Host_Float_Array is access all Float_Array; 8 | 9 | procedure Vector_Add 10 | (A_Addr : System.Address; 11 | B_Addr : System.Address; 12 | C_Addr : System.Address; 13 | Num_Elements : Integer) 14 | with CUDA_Global; 15 | 16 | end Kernel; 17 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/test.out: -------------------------------------------------------------------------------- 1 | [Vector addition of 4096 elements] 2 | CUDA kernel launch with 16 blocks of 256 threads 3 | Copy output data from the CUDA device to the host memory 4 | Test PASSED 5 | Done 6 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorAdd_raw/test.yaml: -------------------------------------------------------------------------------- 1 | driver: text_oracle 2 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/Makefile: -------------------------------------------------------------------------------- 1 | include ../../../../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device.gpr"; 2 | 3 | library project Device is 4 | 5 | for Library_Interface use ("kernel"); 6 | 7 | for Languages use ("Ada"); 8 | for Source_Dirs use ("src/common"); 9 | for Object_Dir use "obj/device"; 10 | 11 | for Target use "cuda"; 12 | for Library_Name use "device"; 13 | for Library_Dir use "lib"; 14 | for Library_Standalone use "encapsulated"; 15 | for Library_Kind use "dynamic"; 16 | 17 | package Compiler is 18 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 19 | end Compiler; 20 | 21 | package Binder is 22 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 23 | end Binder; 24 | 25 | for Library_Options use CUDA_API_Device.Library_Options; 26 | 27 | end Device; 28 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host.gpr"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options; 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options; 22 | end Binder; 23 | 24 | end Host; 25 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; -- Block_Dim, Block_IDx, Thread_IDx 2 | with Interfaces.C; use Interfaces.C; -- Operators for Block_Dim, Block_IDx, Thread_IDx 3 | 4 | with Ada.Numerics; use Ada.Numerics; 5 | with Ada.Numerics.Generic_Elementary_Functions; 6 | 7 | 8 | package body Kernel is 9 | 10 | procedure Vector_Sqrt 11 | (A_Addr : System.Address; 12 | B_Addr : System.Address; 13 | Num_Elements : Integer) 14 | is 15 | A : Float_Array (1..Num_Elements) with Address => A_Addr; 16 | B : Float_Array (1..Num_Elements) with Address => B_Addr; 17 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 18 | package Elementary_Functions is new 19 | Ada.Numerics.Generic_Elementary_Functions (Float); 20 | begin 21 | if I < Num_Elements then 22 | B (B'First + I) := Elementary_Functions.Sqrt (A (A'First + I)); 23 | end if; 24 | end Vector_Sqrt; 25 | 26 | end Kernel; 27 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | package Kernel is 4 | 5 | type Float_Array is array (Integer range <>) of Float; 6 | 7 | type Access_Host_Float_Array is access all Float_Array; 8 | 9 | procedure Vector_Sqrt 10 | (A_Addr : System.Address; 11 | B_Addr : System.Address; 12 | Num_Elements : Integer) 13 | with CUDA_Global; 14 | 15 | end Kernel; 16 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/test.out: -------------------------------------------------------------------------------- 1 | [Vector sqrt of 512 elements] 2 | CUDA kernel launch with 2 blocks of 256 threads 3 | Copy output data from the CUDA device to the host memory 4 | Test PASSED 5 | Done 6 | -------------------------------------------------------------------------------- /testsuite/tests/text_oracle/vectorSqrt/test.yaml: -------------------------------------------------------------------------------- 1 | driver: text_oracle 2 | -------------------------------------------------------------------------------- /tutorial/Makefile: -------------------------------------------------------------------------------- 1 | include ../Makefile.build 2 | 3 | build: gnatcuda_build 4 | -------------------------------------------------------------------------------- /tutorial/device.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_device"; 2 | 3 | library project Device is 4 | 5 | for Languages use ("Ada"); 6 | for Source_Dirs use ("src/common"); 7 | for Object_Dir use "obj/device"; 8 | 9 | for Target use "cuda"; 10 | for Library_Name use "device"; 11 | for Library_Dir use "lib"; 12 | for Library_Kind use "dynamic"; 13 | for Library_Interface use ("kernel"); 14 | for Library_Standalone use "encapsulated"; 15 | 16 | package Compiler is 17 | for Switches ("ada") use CUDA_API_Device.Compiler_Options; 18 | end Compiler; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Device.Binder_Options; 22 | end Binder; 23 | 24 | for Library_Options use CUDA_API_Device.Library_Options; 25 | 26 | end Device; 27 | -------------------------------------------------------------------------------- /tutorial/host.gpr: -------------------------------------------------------------------------------- 1 | with "cuda_api_host"; 2 | 3 | project Host is 4 | 5 | for Exec_Dir use "."; 6 | for Object_Dir use "obj/host"; 7 | for Source_Dirs use ("src/common", "src/host"); 8 | for Main use ("main.adb"); 9 | 10 | for Target use CUDA_API_Host.CUDA_Host; 11 | 12 | package Compiler is 13 | for Switches ("ada") use CUDA_API_Host.Compiler_Options & ("-g"); 14 | end Compiler; 15 | 16 | package Linker is 17 | for Switches ("ada") use CUDA_API_Host.Linker_Options; 18 | end Linker; 19 | 20 | package Binder is 21 | for Default_Switches ("ada") use CUDA_API_Host.Binder_Options & ("-g"); 22 | end Binder; 23 | 24 | end Host; 25 | 26 | -------------------------------------------------------------------------------- /tutorial/src/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; 2 | with Interfaces.C; use Interfaces.C; 3 | 4 | package body Kernel is 5 | 6 | procedure Complex_Computation 7 | (A : Float_Array; B : Float_Array; C : out Float_Array; I : Integer) 8 | is 9 | begin 10 | if I < A'Length then 11 | for J in A'First + I .. A'Last loop 12 | for K in B'First + I .. B'Last loop 13 | C (C'First + I) := A (J) + B (K); 14 | end loop; 15 | end loop; 16 | end if; 17 | end Complex_Computation; 18 | 19 | end Kernel; 20 | -------------------------------------------------------------------------------- /tutorial/src/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | with CUDA.Storage_Models; use CUDA.Storage_Models; 4 | 5 | package Kernel is 6 | 7 | type Float_Array is array (Integer range <>) of Float; 8 | 9 | procedure Complex_Computation 10 | (A : Float_Array; 11 | B : Float_Array; 12 | C : out Float_Array; 13 | I : Integer); 14 | 15 | end Kernel; 16 | -------------------------------------------------------------------------------- /tutorial/src/host/main.adb: -------------------------------------------------------------------------------- 1 | with System; 2 | with Interfaces.C; use Interfaces.C; 3 | 4 | with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; 5 | with Ada.Text_IO; use Ada.Text_IO; 6 | 7 | with CUDA.Driver_Types; use CUDA.Driver_Types; 8 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; 9 | with CUDA.Stddef; 10 | with CUDA.Storage_Models; use CUDA.Storage_Models; 11 | 12 | with Kernel; use Kernel; 13 | 14 | with Ada.Unchecked_Deallocation; 15 | with Ada.Unchecked_Conversion; 16 | 17 | with Ada.Calendar; use Ada.Calendar; 18 | with Ada.Command_Line; use Ada.Command_Line; 19 | 20 | procedure Main is 21 | 22 | type Array_Host_Access is access all Float_Array; 23 | 24 | procedure Free is new 25 | Ada.Unchecked_Deallocation (Float_Array, Array_Host_Access); 26 | 27 | Num_Elements : Integer := 2 ** 8; 28 | 29 | H_A, H_B, H_C : Array_Host_Access; 30 | 31 | Gen : Generator; 32 | Err : Error_T; 33 | 34 | T0 : Time; 35 | Lapsed : Duration; 36 | begin 37 | if Ada.Command_Line.Argument_Count >= 1 then 38 | Num_Elements := 2 ** Integer'Value (Ada.Command_Line.Argument (1)); 39 | end if; 40 | 41 | H_A := new Float_Array (1 .. Num_Elements); 42 | H_B := new Float_Array (1 .. Num_Elements); 43 | H_C := new Float_Array (1 .. Num_Elements); 44 | 45 | H_A.all := (others => Float (Random (Gen))); 46 | H_B.all := (others => Float (Random (Gen))); 47 | 48 | T0 := Clock; 49 | 50 | for I in 0 .. Num_Elements - 1 loop 51 | Complex_Computation (H_A.all, H_B.all, H_C.all, I); 52 | end loop; 53 | 54 | Lapsed := Clock - T0; 55 | 56 | Put_Line ("Host processing took " & Lapsed'Img & " seconds"); 57 | 58 | T0 := Clock; 59 | 60 | -- INSERT HERE DEVICE CALL 61 | 62 | Lapsed := Clock - T0; 63 | 64 | Put_Line ("Device processing took " & Lapsed'Img & " seconds"); 65 | 66 | Free (H_A); 67 | Free (H_B); 68 | Free (H_C); 69 | end Main; 70 | -------------------------------------------------------------------------------- /tutorial/src_completed/common/kernel.adb: -------------------------------------------------------------------------------- 1 | with CUDA.Runtime_Api; use CUDA.Runtime_Api; 2 | with Interfaces.C; use Interfaces.C; 3 | 4 | package body Kernel is 5 | 6 | procedure Complex_Computation 7 | (A : Float_Array; 8 | B : Float_Array; 9 | C : out Float_Array; 10 | I : Integer) 11 | is 12 | begin 13 | if I < A'Length then 14 | for J in A'First + I .. A'Last loop 15 | for K in B'First + I .. B'Last loop 16 | C (C'First + I) := A (J) + B (K); 17 | end loop; 18 | end loop; 19 | end if; 20 | end Complex_Computation; 21 | 22 | procedure Device_Complex_Computation 23 | (A : Array_Device_Access; 24 | B : Array_Device_Access; 25 | C : Array_Device_Access) 26 | is 27 | I : Integer := Integer (Block_Dim.X * Block_IDx.X + Thread_IDx.X); 28 | begin 29 | Complex_Computation (A.all, B.all, C.all, I); 30 | end Device_Complex_Computation; 31 | 32 | end Kernel; 33 | -------------------------------------------------------------------------------- /tutorial/src_completed/common/kernel.ads: -------------------------------------------------------------------------------- 1 | with System; 2 | 3 | with CUDA.Storage_Models; use CUDA.Storage_Models; 4 | 5 | package Kernel is 6 | 7 | type Float_Array is array (Integer range <>) of Float; 8 | 9 | type Array_Device_Access is access Float_Array 10 | with Designated_Storage_Model => CUDA.Storage_Models.Model; 11 | 12 | procedure Complex_Computation 13 | (A : Float_Array; 14 | B : Float_Array; 15 | C : out Float_Array; 16 | I : Integer); 17 | 18 | procedure Device_Complex_Computation 19 | (A : Array_Device_Access; 20 | B : Array_Device_Access; 21 | C : Array_Device_Access) 22 | with CUDA_Global; 23 | 24 | end Kernel; 25 | -------------------------------------------------------------------------------- /wrapper-Makefile: -------------------------------------------------------------------------------- 1 | local_llvm := $(shell which llvm-gcc) 2 | ifeq (, $(local_llvm)) 3 | $(error "No llvm-gcc in PATH") 4 | endif 5 | $(info "LLVM's GCC : $(local_llvm)") 6 | 7 | llvm_dir := $(shell dirname $(dir $(local_llvm))) 8 | ifeq (, $(llvm_dir)) 9 | $(error "Could not locate LLVM's directory") 10 | endif 11 | $(info "LLVM directory: $(llvm_dir)") 12 | 13 | .PHONY: wrapper 14 | 15 | wrapper: 16 | @echo "======================= INSTALL SETUP" 17 | mkdir -p install/bin 18 | @echo "======================= WRAPPER BUILDING" 19 | gprbuild -p -P wrapper/wrapper.gpr 20 | cp wrapper/obj/gnatcuda_wrapper install/bin/cuda-gcc 21 | cp install/bin/cuda-gcc $(llvm_dir)/bin/cuda-gcc 22 | cp $(llvm_dir)/bin/llvm-gnatbind $(llvm_dir)/bin/cuda-gnatbind 23 | -------------------------------------------------------------------------------- /wrapper/wrapper.gpr: -------------------------------------------------------------------------------- 1 | project Wrapper is 2 | 3 | for Source_Dirs use ("src"); 4 | for Object_Dir use "obj"; 5 | for Main use ("gnatcuda_wrapper.adb"); 6 | 7 | package Compiler is 8 | for Switches ("ada") use ("-gnatX"); 9 | end Compiler; 10 | 11 | end Wrapper; 12 | 13 | --------------------------------------------------------------------------------