LLVM exception test with libgnat

adaexn.ll

; llvm-as adaexn.ll && llvm-ld -native adaexn.bc -L`gcc -print-libgcc-file-name | xargs dirname`/adalib -lgnat && ./a.out

; LLVM primitives
declare i8* @llvm.eh.exception() nounwind readonly
declare i32 @llvm.eh.selector(i8*, i8*, ...) nounwind
declare i32 @llvm.eh.typeid.for(i8*) nounwind

; libgcc
declare void @_Unwind_Resume(i8*)

; libgnat
declare void @__gnat_initialize([2 x i32]*)
declare void @__gnat_break_start()
declare void @system__standard_library__adafinal()
declare void @__gnat_finalize()
declare void @system__soft_links___elabb()
@system__soft_links_E = external global i1
declare void @system__secondary_stack___elabb()
@system__secondary_stack_E = external global i1
declare void @system__exception_table___elabb()
@system__exception_table_E = external global i1
@gnat_exit_status = external global i32
%range = type {i32, i32}
%string_access = type {i8*, %range*}
declare void @gnat__io__put_line__2(%string_access)
%exception = type opaque
declare void @ada__exceptions__raise_exception(%exception*, %string_access) noreturn
declare void @__gnat_begin_handler(i8*)
declare void @__gnat_end_handler(i8*)
declare i32 @__gnat_eh_personality(...)
@system__soft_links__abort_undefer = external global void ()*
@program_error = external constant %exception
@constraint_error = external constant %exception

@str0.d = private constant [13 x i8] c"Program_Error"
@str0.r = private constant %range {i32 1, i32 13}

define void @put_str0() {
  %arg = alloca %string_access
  %arg.d = getelementptr %string_access* %arg, i32 0, i32 0
  store i8* getelementptr ([13 x i8]* @str0.d, i32 0, i32 0), i8** %arg.d
  %arg.c = getelementptr %string_access* %arg, i32 0, i32 1
  store %range* @str0.r, %range** %arg.c
  %arg.val = load %string_access* %arg
  tail call void @gnat__io__put_line__2(%string_access %arg.val)
  ret void
}

@str1.d = private constant [16 x i8] c"Constraint_Error"
@str1.r = private constant %range {i32 1, i32 16}

define void @put_str1() {
  %arg = alloca %string_access
  %arg.d = getelementptr %string_access* %arg, i32 0, i32 0
  store i8* getelementptr ([16 x i8]* @str1.d, i32 0, i32 0), i8** %arg.d
  %arg.c = getelementptr %string_access* %arg, i32 0, i32 1
  store %range* @str1.r, %range** %arg.c
  %arg.val = load %string_access* %arg
  tail call void @gnat__io__put_line__2(%string_access %arg.val)
  ret void
}

@str2.d = private constant [7 x i8] c"Message"
@str2.r = private constant %range {i32 1, i32 7}

define i32 @main() {
; initialize runtime
  %seh = alloca [2 x i32]
  call void @__gnat_initialize([2 x i32]* %seh)
  call void @system__soft_links___elabb()
  store i1 1, i1* @system__soft_links_E
  call void @system__secondary_stack___elabb()
  store i1 1, i1* @system__secondary_stack_E
  call void @system__exception_table___elabb()
  store i1 1, i1* @system__exception_table_E
  call void @__gnat_break_start()

; raising
  %msg = alloca %string_access
  %msg.d = getelementptr %string_access* %msg, i32 0, i32 0
  store i8* getelementptr ([7 x i8]* @str2.d, i32 0, i32 0), i8** %msg.d
  %msg.c = getelementptr %string_access* %msg, i32 0, i32 1
  store %range* @str2.r, %range** %msg.c
  %msg.val = load %string_access* %msg
  invoke void @ada__exceptions__raise_exception(%exception* @program_error, %string_access %msg.val)
    to label %after
    unwind label %exception

exception:
  %exn = call i8* @llvm.eh.exception() nounwind
  %sel = call i32 (i8*, i8*, ...)* @llvm.eh.selector(
    i8* %exn,
    i8* bitcast (i32 (...)* @__gnat_eh_personality to i8*),
    i8* bitcast (%exception* @program_error to i8*),
    i8* bitcast (%exception* @constraint_error to i8*)) nounwind
  call void @__gnat_begin_handler(i8* %exn)
  %abort_undefer = load void ()** @system__soft_links__abort_undefer
  call void %abort_undefer()
  br label %when_pe

when_pe:
  %pe.typeid = call i32 @llvm.eh.typeid.for(i8* bitcast (%exception* @program_error to i8*)) nounwind
  %pe.comp = icmp eq i32 %sel, %pe.typeid
  br i1 %pe.comp, label %handle_pe, label %when_ce

handle_pe:
  invoke void @put_str0()
    to label %end_exception
    unwind label %raise_another

when_ce:
  %ce.typeid = call i32 @llvm.eh.typeid.for(i8* bitcast (%exception* @constraint_error to i8*)) nounwind
  %ce.comp = icmp eq i32 %sel, %ce.typeid
  br i1 %ce.comp, label %handle_ce, label %when_others

handle_ce:
  invoke void @put_str1()
    to label %end_exception
    unwind label %raise_another

when_others:
  unreachable

end_exception:
  call void @__gnat_end_handler(i8* %exn)
  br label %after

raise_another:
  %ra.exn = call i8* @llvm.eh.exception() nounwind
  %ra.sel = call i32 (i8*, i8*, ...)* @llvm.eh.selector(
    i8* %ra.exn,
    i8* bitcast (i32 (...)* @__gnat_eh_personality to i8*),
    i8* null) nounwind
  call void @__gnat_end_handler(i8* %exn)
  call void @_Unwind_Resume(i8* %ra.exn) noreturn
  unreachable

after:
; finalize runtime
  call void @system__standard_library__adafinal()
  call void @__gnat_finalize()
  %retval = load i32* @gnat_exit_status
  ret i32 %retval
}