From d6b7c96c3eb29b9244ece0c046d3f372ff432d04 Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Wed, 23 Jun 2010 21:03:09 -0700 Subject: Populate tree. --- src/Makefile | 391 +- src/README | 28 + src/boot/be/abi.ml | 207 + src/boot/be/asm.ml | 755 +++ src/boot/be/elf.ml | 1760 +++++++ src/boot/be/il.ml | 1135 +++++ src/boot/be/macho.ml | 1184 +++++ src/boot/be/pe.ml | 1149 +++++ src/boot/be/ra.ml | 664 +++ src/boot/be/x86.ml | 2205 +++++++++ src/boot/driver/lib.ml | 232 + src/boot/driver/llvm/glue.ml | 37 + src/boot/driver/main.ml | 421 ++ src/boot/driver/session.ml | 111 + src/boot/driver/x86/glue.ml | 16 + src/boot/fe/ast.ml | 1360 ++++++ src/boot/fe/cexp.ml | 762 +++ src/boot/fe/item.ml | 1139 +++++ src/boot/fe/lexer.mll | 362 ++ src/boot/fe/parser.ml | 374 ++ src/boot/fe/pexp.ml | 1354 ++++++ src/boot/fe/token.ml | 308 ++ src/boot/llvm/llabi.ml | 69 + src/boot/llvm/llasm.ml | 192 + src/boot/llvm/llemit.ml | 36 + src/boot/llvm/llfinal.ml | 96 + src/boot/llvm/lltrans.ml | 938 ++++ src/boot/me/alias.ml | 134 + src/boot/me/dead.ml | 121 + src/boot/me/dwarf.ml | 3019 ++++++++++++ src/boot/me/effect.ml | 313 ++ src/boot/me/layout.ml | 470 ++ src/boot/me/loop.ml | 163 + src/boot/me/resolve.ml | 959 ++++ src/boot/me/semant.ml | 1969 ++++++++ src/boot/me/trans.ml | 5031 ++++++++++++++++++++ src/boot/me/transutil.ml | 238 + src/boot/me/type.ml | 1294 +++++ src/boot/me/typestate.ml | 1089 +++++ src/boot/me/walk.ml | 687 +++ src/boot/util/bits.ml | 107 + src/boot/util/common.ml | 709 +++ src/comp/driver/rustc.rs | 12 + src/comp/fe/lexer.rs | 0 src/comp/fe/parser.rs | 0 src/comp/rustc.rc | 20 + src/etc/tidy.py | 25 + src/etc/x86.supp | 14 + src/lib/_int.rs | 20 + src/lib/_io.rs | 36 + src/lib/_str.rs | 23 + src/lib/_u8.rs | 20 + src/lib/_vec.rs | 30 + src/lib/linux_os.rs | 19 + src/lib/macos_os.rs | 19 + src/lib/std.rc | 35 + src/lib/sys.rs | 7 + src/lib/win32_os.rs | 9 + src/rt/bigint/bigint.h | 294 ++ src/rt/bigint/bigint_ext.cpp | 553 +++ src/rt/bigint/bigint_int.cpp | 1428 ++++++ src/rt/bigint/low_primes.h | 1069 +++++ src/rt/isaac/rand.h | 56 + src/rt/isaac/randport.cpp | 134 + src/rt/isaac/standard.h | 57 + src/rt/memcheck.h | 309 ++ src/rt/rust.cpp | 267 ++ src/rt/rust.h | 49 + src/rt/rust_builtin.cpp | 129 + src/rt/rust_chan.cpp | 34 + src/rt/rust_chan.h | 22 + src/rt/rust_comm.cpp | 199 + src/rt/rust_crate.cpp | 63 + src/rt/rust_crate_cache.cpp | 306 ++ src/rt/rust_crate_reader.cpp | 578 +++ src/rt/rust_dom.cpp | 271 ++ src/rt/rust_dwarf.h | 198 + src/rt/rust_internal.h | 730 +++ src/rt/rust_log.cpp | 117 + src/rt/rust_log.h | 59 + src/rt/rust_task.cpp | 474 ++ src/rt/rust_timer.cpp | 97 + src/rt/rust_upcall.cpp | 654 +++ src/rt/rust_util.h | 155 + src/rt/sync/fair_ticket_lock.cpp | 43 + src/rt/sync/fair_ticket_lock.h | 15 + src/rt/sync/lock_free_queue.cpp | 37 + src/rt/sync/lock_free_queue.h | 15 + src/rt/sync/spin_lock.cpp | 47 + src/rt/sync/spin_lock.h | 14 + src/rt/uthash/uthash.h | 766 +++ src/rt/uthash/utlist.h | 280 ++ src/rt/util/array_list.h | 69 + src/rt/valgrind.h | 3926 +++++++++++++++ src/test/bench/shootout/ackermann.rs | 25 + src/test/bench/shootout/binary-trees.rs | 15 + src/test/bench/shootout/fibo.rs | 22 + src/test/compile-fail/arg-count-mismatch.rs | 9 + src/test/compile-fail/arg-type-mismatch.rs | 10 + src/test/compile-fail/bad-env-capture.rs | 10 + src/test/compile-fail/bad-main.rs | 4 + src/test/compile-fail/bad-name.rs | 6 + src/test/compile-fail/bad-type-env-capture.rs | 3 + src/test/compile-fail/bogus-tag.rs | 19 + src/test/compile-fail/comm-makes-io.rs | 6 + src/test/compile-fail/dead-code-be.rs | 11 + src/test/compile-fail/dead-code-ret.rs | 11 + src/test/compile-fail/direct-obj-fn-call.rs | 12 + src/test/compile-fail/export.rs | 14 + src/test/compile-fail/fru-extra-field.rs | 9 + src/test/compile-fail/fru-typestate.rs | 10 + src/test/compile-fail/impure-pred.rs | 19 + .../compile-fail/infinite-tag-type-recursion.rs | 9 + .../compile-fail/infinite-vec-type-recursion.rs | 9 + src/test/compile-fail/io-infects-caller.rs | 10 + src/test/compile-fail/log-type-error.rs | 6 + src/test/compile-fail/native-makes-unsafe.rs | 9 + src/test/compile-fail/not-a-pred.rs | 16 + src/test/compile-fail/output-type-mismatch.rs | 9 + src/test/compile-fail/pred-on-wrong-slots.rs | 20 + src/test/compile-fail/rec-missing-fields.rs | 10 + src/test/compile-fail/return-uninit.rs | 10 + src/test/compile-fail/slot-as-pred.rs | 14 + src/test/compile-fail/spawn-non-nil-fn.rs | 9 + src/test/compile-fail/type-shadow.rs | 12 + src/test/compile-fail/unnecessary-io.rs | 4 + src/test/compile-fail/unnecessary-unsafe.rs | 4 + src/test/compile-fail/unsafe-infects-caller.rs | 13 + src/test/compile-fail/while-bypass.rs | 13 + src/test/compile-fail/while-expr.rs | 7 + src/test/compile-fail/while-type-error.rs | 7 + .../compile-fail/writing-through-read-alias.rs | 14 + src/test/run-fail/explicit-fail.rs | 5 + src/test/run-fail/fail.rs | 5 + src/test/run-fail/linked-failure.rs | 14 + src/test/run-fail/pred.rs | 17 + src/test/run-fail/str-overrun.rs | 16 + src/test/run-fail/vec-overrun.rs | 11 + src/test/run-fail/vec-underrun.rs | 11 + src/test/run-pass/acyclic-unwind.rs | 30 + src/test/run-pass/alt-tag.rs | 39 + src/test/run-pass/argv.rs | 9 + src/test/run-pass/basic.rs | 50 + src/test/run-pass/bind-obj-ctor.rs | 17 + src/test/run-pass/bind-thunk.rs | 11 + src/test/run-pass/bind-trivial.rs | 11 + src/test/run-pass/bitwise.rs | 21 + src/test/run-pass/box-unbox.rs | 10 + src/test/run-pass/cast.rs | 16 + src/test/run-pass/char.rs | 12 + src/test/run-pass/clone-with-exterior.rs | 10 + src/test/run-pass/comm.rs | 16 + src/test/run-pass/command-line-args.rs | 3 + src/test/run-pass/complex.rs | 32 + src/test/run-pass/dead-code-one-arm-if.rs | 8 + src/test/run-pass/deep.rs | 14 + src/test/run-pass/div-mod.rs | 17 + src/test/run-pass/drop-on-ret.rs | 12 + src/test/run-pass/else-if.rs | 19 + src/test/run-pass/export-non-interference.rs | 6 + src/test/run-pass/exterior.rs | 18 + src/test/run-pass/fact.rs | 21 + src/test/run-pass/foreach-put-structured.rs | 22 + src/test/run-pass/foreach-simple-outer-slot.rs | 22 + src/test/run-pass/foreach-simple.rs | 17 + src/test/run-pass/fun-call-variants.rs | 19 + src/test/run-pass/fun-indirect-call.rs | 11 + src/test/run-pass/generic-derived-type.rs | 17 + src/test/run-pass/generic-drop-glue.rs | 9 + src/test/run-pass/generic-exterior-box.rs | 13 + src/test/run-pass/generic-fn-infer.rs | 13 + src/test/run-pass/generic-fn.rs | 32 + src/test/run-pass/generic-obj-with-derived-type.rs | 17 + src/test/run-pass/generic-obj.rs | 24 + src/test/run-pass/generic-recursive-tag.rs | 5 + src/test/run-pass/generic-tag-alt.rs | 9 + src/test/run-pass/generic-tag.rs | 6 + src/test/run-pass/generic-type-synonym.rs | 4 + src/test/run-pass/generic-type.rs | 6 + src/test/run-pass/hello.rs | 6 + src/test/run-pass/i32-sub.rs | 8 + src/test/run-pass/i8-incr.rs | 9 + src/test/run-pass/import.rs | 14 + src/test/run-pass/inner-module.rs | 17 + src/test/run-pass/int.rs | 6 + src/test/run-pass/large-records.rs | 14 + src/test/run-pass/lazy-and-or.rs | 22 + src/test/run-pass/lazychan.rs | 23 + src/test/run-pass/linear-for-loop.rs | 38 + src/test/run-pass/list.rs | 7 + src/test/run-pass/many.rs | 19 + src/test/run-pass/mlist-cycle.rs | 10 + src/test/run-pass/mlist.rs | 7 + src/test/run-pass/mutable-vec-drop.rs | 4 + src/test/run-pass/mutual-recursion-group.rs | 11 + src/test/run-pass/native-mod-src/inner.rs | 12 + src/test/run-pass/native-mod.rc | 16 + src/test/run-pass/native-opaque-type.rs | 7 + src/test/run-pass/native-src/native.rs | 7 + src/test/run-pass/native.rc | 12 + src/test/run-pass/obj-as.rs | 21 + src/test/run-pass/obj-drop.rs | 6 + src/test/run-pass/obj-dtor.rs | 33 + src/test/run-pass/obj-with-vec.rs | 11 + src/test/run-pass/opeq.rs | 22 + src/test/run-pass/pred.rs | 18 + src/test/run-pass/preempt.rs | 26 + src/test/run-pass/readalias.rs | 12 + src/test/run-pass/rec-auto.rs | 9 + src/test/run-pass/rec-extend.rs | 19 + src/test/run-pass/rec-tup.rs | 25 + src/test/run-pass/rec.rs | 23 + src/test/run-pass/return-nil.rs | 8 + src/test/run-pass/simple-obj.rs | 12 + src/test/run-pass/spawn-fn.rs | 18 + src/test/run-pass/spawn.rs | 10 + src/test/run-pass/stateful-obj.rs | 23 + src/test/run-pass/str-append.rs | 8 + src/test/run-pass/str-concat.rs | 9 + src/test/run-pass/str-idx.rs | 7 + src/test/run-pass/syntax-extension.rs | 4 + src/test/run-pass/tag.rs | 14 + src/test/run-pass/tail-cps.rs | 34 + src/test/run-pass/tail-direct.rs | 24 + src/test/run-pass/task-comm.rs | 127 + src/test/run-pass/threads.rs | 16 + src/test/run-pass/tup.rs | 19 + src/test/run-pass/type-sizes.rs | 20 + src/test/run-pass/u32-decr.rs | 8 + src/test/run-pass/u8-incr-decr.rs | 12 + src/test/run-pass/u8-incr.rs | 12 + src/test/run-pass/uint.rs | 6 + src/test/run-pass/unit.rs | 13 + src/test/run-pass/user.rs | 14 + src/test/run-pass/utf8.rs | 48 + src/test/run-pass/vec-append.rs | 10 + src/test/run-pass/vec-concat.rs | 11 + src/test/run-pass/vec-drop.rs | 4 + src/test/run-pass/vec-slice.rs | 6 + src/test/run-pass/vec.rs | 13 + src/test/run-pass/writealias.rs | 13 + src/test/run-pass/yield.rs | 20 + src/test/run-pass/yield2.rs | 10 + 243 files changed, 49419 insertions(+), 166 deletions(-) create mode 100644 src/README create mode 100644 src/boot/be/abi.ml create mode 100644 src/boot/be/asm.ml create mode 100644 src/boot/be/elf.ml create mode 100644 src/boot/be/il.ml create mode 100644 src/boot/be/macho.ml create mode 100644 src/boot/be/pe.ml create mode 100644 src/boot/be/ra.ml create mode 100644 src/boot/be/x86.ml create mode 100644 src/boot/driver/lib.ml create mode 100644 src/boot/driver/llvm/glue.ml create mode 100644 src/boot/driver/main.ml create mode 100644 src/boot/driver/session.ml create mode 100644 src/boot/driver/x86/glue.ml create mode 100644 src/boot/fe/ast.ml create mode 100644 src/boot/fe/cexp.ml create mode 100644 src/boot/fe/item.ml create mode 100644 src/boot/fe/lexer.mll create mode 100644 src/boot/fe/parser.ml create mode 100644 src/boot/fe/pexp.ml create mode 100644 src/boot/fe/token.ml create mode 100644 src/boot/llvm/llabi.ml create mode 100644 src/boot/llvm/llasm.ml create mode 100644 src/boot/llvm/llemit.ml create mode 100644 src/boot/llvm/llfinal.ml create mode 100644 src/boot/llvm/lltrans.ml create mode 100644 src/boot/me/alias.ml create mode 100644 src/boot/me/dead.ml create mode 100644 src/boot/me/dwarf.ml create mode 100644 src/boot/me/effect.ml create mode 100644 src/boot/me/layout.ml create mode 100644 src/boot/me/loop.ml create mode 100644 src/boot/me/resolve.ml create mode 100644 src/boot/me/semant.ml create mode 100644 src/boot/me/trans.ml create mode 100644 src/boot/me/transutil.ml create mode 100644 src/boot/me/type.ml create mode 100644 src/boot/me/typestate.ml create mode 100644 src/boot/me/walk.ml create mode 100644 src/boot/util/bits.ml create mode 100644 src/boot/util/common.ml create mode 100644 src/comp/driver/rustc.rs create mode 100644 src/comp/fe/lexer.rs create mode 100644 src/comp/fe/parser.rs create mode 100644 src/comp/rustc.rc create mode 100644 src/etc/tidy.py create mode 100644 src/etc/x86.supp create mode 100644 src/lib/_int.rs create mode 100644 src/lib/_io.rs create mode 100644 src/lib/_str.rs create mode 100644 src/lib/_u8.rs create mode 100644 src/lib/_vec.rs create mode 100644 src/lib/linux_os.rs create mode 100644 src/lib/macos_os.rs create mode 100644 src/lib/std.rc create mode 100644 src/lib/sys.rs create mode 100644 src/lib/win32_os.rs create mode 100644 src/rt/bigint/bigint.h create mode 100644 src/rt/bigint/bigint_ext.cpp create mode 100644 src/rt/bigint/bigint_int.cpp create mode 100644 src/rt/bigint/low_primes.h create mode 100644 src/rt/isaac/rand.h create mode 100644 src/rt/isaac/randport.cpp create mode 100644 src/rt/isaac/standard.h create mode 100644 src/rt/memcheck.h create mode 100644 src/rt/rust.cpp create mode 100644 src/rt/rust.h create mode 100644 src/rt/rust_builtin.cpp create mode 100644 src/rt/rust_chan.cpp create mode 100644 src/rt/rust_chan.h create mode 100644 src/rt/rust_comm.cpp create mode 100644 src/rt/rust_crate.cpp create mode 100644 src/rt/rust_crate_cache.cpp create mode 100644 src/rt/rust_crate_reader.cpp create mode 100644 src/rt/rust_dom.cpp create mode 100644 src/rt/rust_dwarf.h create mode 100644 src/rt/rust_internal.h create mode 100644 src/rt/rust_log.cpp create mode 100644 src/rt/rust_log.h create mode 100644 src/rt/rust_task.cpp create mode 100644 src/rt/rust_timer.cpp create mode 100644 src/rt/rust_upcall.cpp create mode 100644 src/rt/rust_util.h create mode 100644 src/rt/sync/fair_ticket_lock.cpp create mode 100644 src/rt/sync/fair_ticket_lock.h create mode 100644 src/rt/sync/lock_free_queue.cpp create mode 100644 src/rt/sync/lock_free_queue.h create mode 100644 src/rt/sync/spin_lock.cpp create mode 100644 src/rt/sync/spin_lock.h create mode 100644 src/rt/uthash/uthash.h create mode 100644 src/rt/uthash/utlist.h create mode 100644 src/rt/util/array_list.h create mode 100644 src/rt/valgrind.h create mode 100644 src/test/bench/shootout/ackermann.rs create mode 100644 src/test/bench/shootout/binary-trees.rs create mode 100644 src/test/bench/shootout/fibo.rs create mode 100644 src/test/compile-fail/arg-count-mismatch.rs create mode 100644 src/test/compile-fail/arg-type-mismatch.rs create mode 100644 src/test/compile-fail/bad-env-capture.rs create mode 100644 src/test/compile-fail/bad-main.rs create mode 100644 src/test/compile-fail/bad-name.rs create mode 100644 src/test/compile-fail/bad-type-env-capture.rs create mode 100644 src/test/compile-fail/bogus-tag.rs create mode 100644 src/test/compile-fail/comm-makes-io.rs create mode 100644 src/test/compile-fail/dead-code-be.rs create mode 100644 src/test/compile-fail/dead-code-ret.rs create mode 100644 src/test/compile-fail/direct-obj-fn-call.rs create mode 100644 src/test/compile-fail/export.rs create mode 100644 src/test/compile-fail/fru-extra-field.rs create mode 100644 src/test/compile-fail/fru-typestate.rs create mode 100644 src/test/compile-fail/impure-pred.rs create mode 100644 src/test/compile-fail/infinite-tag-type-recursion.rs create mode 100644 src/test/compile-fail/infinite-vec-type-recursion.rs create mode 100644 src/test/compile-fail/io-infects-caller.rs create mode 100644 src/test/compile-fail/log-type-error.rs create mode 100644 src/test/compile-fail/native-makes-unsafe.rs create mode 100644 src/test/compile-fail/not-a-pred.rs create mode 100644 src/test/compile-fail/output-type-mismatch.rs create mode 100644 src/test/compile-fail/pred-on-wrong-slots.rs create mode 100644 src/test/compile-fail/rec-missing-fields.rs create mode 100644 src/test/compile-fail/return-uninit.rs create mode 100644 src/test/compile-fail/slot-as-pred.rs create mode 100644 src/test/compile-fail/spawn-non-nil-fn.rs create mode 100644 src/test/compile-fail/type-shadow.rs create mode 100644 src/test/compile-fail/unnecessary-io.rs create mode 100644 src/test/compile-fail/unnecessary-unsafe.rs create mode 100644 src/test/compile-fail/unsafe-infects-caller.rs create mode 100644 src/test/compile-fail/while-bypass.rs create mode 100644 src/test/compile-fail/while-expr.rs create mode 100644 src/test/compile-fail/while-type-error.rs create mode 100644 src/test/compile-fail/writing-through-read-alias.rs create mode 100644 src/test/run-fail/explicit-fail.rs create mode 100644 src/test/run-fail/fail.rs create mode 100644 src/test/run-fail/linked-failure.rs create mode 100644 src/test/run-fail/pred.rs create mode 100644 src/test/run-fail/str-overrun.rs create mode 100644 src/test/run-fail/vec-overrun.rs create mode 100644 src/test/run-fail/vec-underrun.rs create mode 100644 src/test/run-pass/acyclic-unwind.rs create mode 100644 src/test/run-pass/alt-tag.rs create mode 100644 src/test/run-pass/argv.rs create mode 100644 src/test/run-pass/basic.rs create mode 100644 src/test/run-pass/bind-obj-ctor.rs create mode 100644 src/test/run-pass/bind-thunk.rs create mode 100644 src/test/run-pass/bind-trivial.rs create mode 100644 src/test/run-pass/bitwise.rs create mode 100644 src/test/run-pass/box-unbox.rs create mode 100644 src/test/run-pass/cast.rs create mode 100644 src/test/run-pass/char.rs create mode 100644 src/test/run-pass/clone-with-exterior.rs create mode 100644 src/test/run-pass/comm.rs create mode 100644 src/test/run-pass/command-line-args.rs create mode 100644 src/test/run-pass/complex.rs create mode 100644 src/test/run-pass/dead-code-one-arm-if.rs create mode 100644 src/test/run-pass/deep.rs create mode 100644 src/test/run-pass/div-mod.rs create mode 100644 src/test/run-pass/drop-on-ret.rs create mode 100644 src/test/run-pass/else-if.rs create mode 100644 src/test/run-pass/export-non-interference.rs create mode 100644 src/test/run-pass/exterior.rs create mode 100644 src/test/run-pass/fact.rs create mode 100644 src/test/run-pass/foreach-put-structured.rs create mode 100644 src/test/run-pass/foreach-simple-outer-slot.rs create mode 100644 src/test/run-pass/foreach-simple.rs create mode 100644 src/test/run-pass/fun-call-variants.rs create mode 100644 src/test/run-pass/fun-indirect-call.rs create mode 100644 src/test/run-pass/generic-derived-type.rs create mode 100644 src/test/run-pass/generic-drop-glue.rs create mode 100644 src/test/run-pass/generic-exterior-box.rs create mode 100644 src/test/run-pass/generic-fn-infer.rs create mode 100644 src/test/run-pass/generic-fn.rs create mode 100644 src/test/run-pass/generic-obj-with-derived-type.rs create mode 100644 src/test/run-pass/generic-obj.rs create mode 100644 src/test/run-pass/generic-recursive-tag.rs create mode 100644 src/test/run-pass/generic-tag-alt.rs create mode 100644 src/test/run-pass/generic-tag.rs create mode 100644 src/test/run-pass/generic-type-synonym.rs create mode 100644 src/test/run-pass/generic-type.rs create mode 100644 src/test/run-pass/hello.rs create mode 100644 src/test/run-pass/i32-sub.rs create mode 100644 src/test/run-pass/i8-incr.rs create mode 100644 src/test/run-pass/import.rs create mode 100644 src/test/run-pass/inner-module.rs create mode 100644 src/test/run-pass/int.rs create mode 100644 src/test/run-pass/large-records.rs create mode 100644 src/test/run-pass/lazy-and-or.rs create mode 100644 src/test/run-pass/lazychan.rs create mode 100644 src/test/run-pass/linear-for-loop.rs create mode 100644 src/test/run-pass/list.rs create mode 100644 src/test/run-pass/many.rs create mode 100644 src/test/run-pass/mlist-cycle.rs create mode 100644 src/test/run-pass/mlist.rs create mode 100644 src/test/run-pass/mutable-vec-drop.rs create mode 100644 src/test/run-pass/mutual-recursion-group.rs create mode 100644 src/test/run-pass/native-mod-src/inner.rs create mode 100644 src/test/run-pass/native-mod.rc create mode 100644 src/test/run-pass/native-opaque-type.rs create mode 100644 src/test/run-pass/native-src/native.rs create mode 100644 src/test/run-pass/native.rc create mode 100644 src/test/run-pass/obj-as.rs create mode 100644 src/test/run-pass/obj-drop.rs create mode 100644 src/test/run-pass/obj-dtor.rs create mode 100644 src/test/run-pass/obj-with-vec.rs create mode 100644 src/test/run-pass/opeq.rs create mode 100644 src/test/run-pass/pred.rs create mode 100644 src/test/run-pass/preempt.rs create mode 100644 src/test/run-pass/readalias.rs create mode 100644 src/test/run-pass/rec-auto.rs create mode 100644 src/test/run-pass/rec-extend.rs create mode 100644 src/test/run-pass/rec-tup.rs create mode 100644 src/test/run-pass/rec.rs create mode 100644 src/test/run-pass/return-nil.rs create mode 100644 src/test/run-pass/simple-obj.rs create mode 100644 src/test/run-pass/spawn-fn.rs create mode 100644 src/test/run-pass/spawn.rs create mode 100644 src/test/run-pass/stateful-obj.rs create mode 100644 src/test/run-pass/str-append.rs create mode 100644 src/test/run-pass/str-concat.rs create mode 100644 src/test/run-pass/str-idx.rs create mode 100644 src/test/run-pass/syntax-extension.rs create mode 100644 src/test/run-pass/tag.rs create mode 100644 src/test/run-pass/tail-cps.rs create mode 100644 src/test/run-pass/tail-direct.rs create mode 100644 src/test/run-pass/task-comm.rs create mode 100644 src/test/run-pass/threads.rs create mode 100644 src/test/run-pass/tup.rs create mode 100644 src/test/run-pass/type-sizes.rs create mode 100644 src/test/run-pass/u32-decr.rs create mode 100644 src/test/run-pass/u8-incr-decr.rs create mode 100644 src/test/run-pass/u8-incr.rs create mode 100644 src/test/run-pass/uint.rs create mode 100644 src/test/run-pass/unit.rs create mode 100644 src/test/run-pass/user.rs create mode 100644 src/test/run-pass/utf8.rs create mode 100644 src/test/run-pass/vec-append.rs create mode 100644 src/test/run-pass/vec-concat.rs create mode 100644 src/test/run-pass/vec-drop.rs create mode 100644 src/test/run-pass/vec-slice.rs create mode 100644 src/test/run-pass/vec.rs create mode 100644 src/test/run-pass/writealias.rs create mode 100644 src/test/run-pass/yield.rs create mode 100644 src/test/run-pass/yield2.rs (limited to 'src') diff --git a/src/Makefile b/src/Makefile index 95d530df..5d4e6aa0 100644 --- a/src/Makefile +++ b/src/Makefile @@ -19,27 +19,29 @@ endif CFG_INFO := $(info cfg: building on $(CFG_OSTYPE) $(CFG_CPUTYPE)) -CFG_GCC_COMPILE_FLAGS := +CFG_GCC_CFLAGS := CFG_GCC_LINK_FLAGS := CFG_VALGRIND := CFG_LLVM_CONFIG := llvm-config -CFG_BOOT_FLAGS := +CFG_BOOT_FLAGS := $(FLAGS) ifeq ($(CFG_OSTYPE), Linux) CFG_RUNTIME := librustrt.so CFG_STDLIB := libstd.so - CFG_GCC_COMPILE_FLAGS += -fPIC + CFG_GCC_CFLAGS += -fPIC CFG_GCC_LINK_FLAGS += -shared -fPIC -ldl -lpthread ifeq ($(CFG_CPUTYPE), x86_64) - CFG_GCC_COMPILE_FLAGS += -m32 + CFG_GCC_CFLAGS += -m32 CFG_GCC_LINK_FLAGS += -m32 endif CFG_NATIVE := 1 CFG_UNIXY := 1 CFG_VALGRIND := $(shell which valgrind) ifdef CFG_VALGRIND - CFG_VALGRIND += --run-libc-freeres=no --leak-check=full --quiet --vex-iropt-level=0 + CFG_VALGRIND += --leak-check=full \ + --quiet --vex-iropt-level=0 \ + --suppressions=etc/x86.supp endif endif @@ -52,7 +54,7 @@ ifeq ($(CFG_OSTYPE), Darwin) # "on an i386" when the whole userspace is 64-bit and the compiler # emits 64-bit binaries by default. So we just force -m32 here. Smarter # approaches welcome! - CFG_GCC_COMPILE_FLAGS += -m32 + CFG_GCC_CFLAGS += -m32 CFG_GCC_LINK_FLAGS += -m32 endif @@ -73,7 +75,7 @@ ifdef CFG_WINDOWSY CFG_EXE_SUFFIX := .exe CFG_BOOT := ./rustboot.exe CFG_COMPILER := ./rustc.exe - CFG_GCC_COMPILE_FLAGS += -march=i686 + CFG_GCC_CFLAGS += -march=i686 CFG_GCC_LINK_FLAGS += -shared -fPIC CFG_RUN_TARG = $(1) # FIXME: support msvc at some point @@ -99,10 +101,10 @@ ifdef CFG_UNIXY endif CFG_OBJ_SUFFIX := .o CFG_EXE_SUFFIX := .exe - CFG_GCC_COMPILE_FLAGS := + CFG_GCC_CFLAGS := CFG_GCC_LINK_FLAGS := -shared ifeq ($(CFG_CPUTYPE), x86_64) - CFG_GCC_COMPILE_FLAGS += -m32 + CFG_GCC_CFLAGS += -m32 CFG_GCC_LINK_FLAGS += -m32 endif endif @@ -110,11 +112,11 @@ endif ifdef CFG_GCC CFG_INFO := $(info cfg: using gcc) - CFG_GCC_COMPILE_FLAGS += -Wall -Werror -fno-rtti -fno-exceptions -g + CFG_GCC_CFLAGS += -Wall -Werror -fno-rtti -fno-exceptions -g CFG_GCC_LINK_FLAGS += -g - CFG_COMPILE_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_COMPILE_FLAGS) -c -o $(1) $(2) + CFG_COMPILE_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_CFLAGS) -c -o $(1) $(2) CFG_LINK_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_LINK_FLAGS) -o $(1) - CFG_DEPEND_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_COMPILE_FLAGS) -MT "$(1)" -MM $(2) + CFG_DEPEND_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_CFLAGS) -MT "$(1)" -MM $(2) else CFG_ERR := $(error please try on a system with gcc) endif @@ -153,7 +155,8 @@ ifneq ($(CFG_LLVM_CONFIG),) $(info cfg: using LLVM version 2.8svn) else CFG_LLVM_CONFIG := - $(info cfg: incompatible LLVM version $(CFG_LLVM_VERSION), expected 2.8svn) + $(info cfg: incompatible LLVM version $(CFG_LLVM_VERSION), \ + expected 2.8svn) endif endif ifdef CFG_LLVM_CONFIG @@ -161,11 +164,12 @@ ifdef CFG_LLVM_CONFIG WHERE := $(shell ocamlc -where) LLVM_LIBS := llvm.cma llvm_bitwriter.cma LLVM_NATIVE_LIBS := llvm.cmxa llvm_bitwiter.cmxa - LLVM_CLIBS := $(shell for c in `$(CFG_LLVM_CONFIG) --ldflags --libs` -lllvm -lllvm_bitwriter; do echo -cclib && echo $$c; done | xargs echo) + LLVM_CLIBS := $(shell for c in `$(CFG_LLVM_CONFIG) --ldflags --libs` \ + -lllvm -lllvm_bitwriter; do echo -cclib && echo $$c; done | xargs echo) LLVM_INCS := -I boot/llvm -I $(WHERE) - LLVM_MLS := $(addprefix boot/llvm/, llabi.ml llasm.ml llfinal.ml lltrans.ml \ - llemit.ml) - CFG_LLC_COMPILE_FLAGS := -march=x86 + LLVM_MLS := $(addprefix boot/llvm/, llabi.ml llasm.ml llfinal.ml \ + lltrans.ml llemit.ml) + CFG_LLC_CFLAGS := -march=x86 $(info cfg: found llvm-config at $(CFG_LLVM_CONFIG)) else VARIANT=x86 @@ -190,7 +194,8 @@ ML_INCS := -I boot/fe -I boot/me -I boot/be -I boot/driver/$(VARIANT) \ ML_LIBS := unix.cma nums.cma bigarray.cma ML_NATIVE_LIBS := unix.cmxa nums.cmxa bigarray.cmxa OCAMLC_FLAGS := -g $(ML_INCS) -w Ael -warn-error Ael -OCAMLOPT_FLAGS := $(ML_INCS) -w Ael -warn-error Ael $(CFG_OCAMLOPT_PROFILE_FLAGS) +OCAMLOPT_FLAGS := $(ML_INCS) -w Ael -warn-error Ael \ + $(CFG_OCAMLOPT_PROFILE_FLAGS) ifdef CFG_LLVM_CONFIG ML_LIBS += $(LLVM_LIBS) -custom -cclib -lstdc++ $(LLVM_CLIBS) @@ -205,11 +210,12 @@ DRIVER_BOT_MLS := $(addprefix boot/driver/, session.ml) BE_MLS := $(addprefix boot/be/, x86.ml ra.ml pe.ml elf.ml \ macho.ml) IL_MLS := $(addprefix boot/be/, asm.ml il.ml abi.ml) -ME_MLS := $(addprefix boot/me/, walk.ml semant.ml resolve.ml alias.ml type.ml dead.ml \ - typestate.ml mode.ml mutable.ml gctype.ml loop.ml layout.ml transutil.ml \ - trans.ml dwarf.ml) -FE_MLS := $(addprefix boot/fe/, ast.ml token.ml lexer.ml parser.ml pexp.ml item.ml cexp.ml) -DRIVER_TOP_MLS := $(addprefix boot/driver/, $(VARIANT)/glue.ml lib.ml main.ml) +ME_MLS := $(addprefix boot/me/, walk.ml semant.ml resolve.ml alias.ml \ + type.ml dead.ml effect.ml typestate.ml loop.ml layout.ml \ + transutil.ml trans.ml dwarf.ml) +FE_MLS := $(addprefix boot/fe/, ast.ml token.ml lexer.ml parser.ml pexp.ml \ + item.ml cexp.ml) +DRIVER_TOP_MLS := $(addprefix boot/driver/, lib.ml $(VARIANT)/glue.ml main.ml) BOOT_MLS := $(UTIL_BOT_MLS) $(DRIVER_BOT_MLS) $(FE_MLS) $(IL_MLS) $(ME_MLS) \ $(BE_MLS) $(LLVM_MLS) $(DRIVER_TOP_MLS) @@ -226,8 +232,12 @@ RUNTIME_CS := rt/rust.cpp \ rt/rust_comm.cpp \ rt/rust_dom.cpp \ rt/rust_task.cpp \ + rt/rust_chan.cpp \ rt/rust_upcall.cpp \ + rt/rust_log.cpp \ + rt/rust_timer.cpp \ rt/isaac/randport.cpp + RUNTIME_HDR := rt/rust.h \ rt/rust_dwarf.h \ rt/rust_internal.h \ @@ -253,7 +263,8 @@ $(CFG_RUNTIME): $(RUNTIME_OBJS) $(MKFILES) $(RUNTIME_HDR) $(CFG_STDLIB): $(STDLIB_CRATE) $(CFG_BOOT) $(MKFILES) @$(call CFG_ECHO, compile: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -shared -o $@ $(STDLIB_CRATE) + $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) \ + -shared -o $@ $(STDLIB_CRATE) %$(CFG_OBJ_SUFFIX): %.cpp $(MKFILES) @$(call CFG_ECHO, compile: $<) @@ -262,7 +273,8 @@ $(CFG_STDLIB): $(STDLIB_CRATE) $(CFG_BOOT) $(MKFILES) ifdef CFG_NATIVE $(CFG_BOOT): $(BOOT_CMXS) $(MKFILES) @$(call CFG_ECHO, compile: $<) - $(CFG_QUIET)ocamlopt$(OPT) -o $@ $(OCAMLOPT_FLAGS) $(ML_NATIVE_LIBS) $(BOOT_CMXS) + $(CFG_QUIET)ocamlopt$(OPT) -o $@ $(OCAMLOPT_FLAGS) $(ML_NATIVE_LIBS) \ + $(BOOT_CMXS) else $(CFG_BOOT): $(BOOT_CMOS) $(MKFILES) @$(call CFG_ECHO, compile: $<) @@ -288,7 +300,7 @@ endif # Main compiler targets and rules ###################################################################### -$(CFG_COMPILER): $(COMPILER_CRATE) $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) +$(CFG_COMPILER): $(COMPILER_INPUTS) $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) @$(call CFG_ECHO, compile: $<) $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $< $(CFG_QUIET)chmod 0755 $@ @@ -302,13 +314,17 @@ self: $(CFG_COMPILER) # Testing ###################################################################### -TEST_XFAILS_X86 := test/run-pass/mlist_cycle.rs \ +TEST_XFAILS_X86 := test/run-pass/mlist-cycle.rs \ test/run-pass/clone-with-exterior.rs \ + test/run-pass/obj-as.rs \ test/run-pass/rec-auto.rs \ test/run-pass/vec-slice.rs \ test/run-pass/generic-fn-infer.rs \ + test/run-pass/generic-recursive-tag.rs \ test/run-pass/generic-tag.rs \ + test/run-pass/generic-tag-alt.rs \ test/run-pass/bind-obj-ctor.rs \ + test/run-pass/task-comm.rs \ test/compile-fail/rec-missing-fields.rs \ test/compile-fail/infinite-tag-type-recursion.rs \ test/compile-fail/infinite-vec-type-recursion.rs @@ -316,61 +332,74 @@ TEST_XFAILS_X86 := test/run-pass/mlist_cycle.rs \ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ acyclic-unwind.rs \ alt-tag.rs \ + argv.rs \ basic.rs \ bind-obj-ctor.rs \ bind-thunk.rs \ bind-trivial.rs \ + bitwise.rs \ + box-unbox.rs \ cast.rs \ char.rs \ clone-with-exterior.rs \ comm.rs \ + command-line-args.rs \ complex.rs \ dead-code-one-arm-if.rs \ deep.rs \ div-mod.rs \ drop-on-ret.rs \ + else-if.rs \ + export-non-interference.rs \ exterior.rs \ - foreach-simple.rs \ - foreach-simple-outer-slot.rs \ foreach-put-structured.rs \ - vec-slice.rs \ - simple-obj.rs \ - import.rs \ + foreach-simple-outer-slot.rs \ + foreach-simple.rs \ fun-call-variants.rs \ fun-indirect-call.rs \ generic-derived-type.rs \ generic-drop-glue.rs \ + generic-exterior-box.rs \ + generic-fn-infer.rs \ generic-fn.rs \ - generic-obj.rs \ generic-obj-with-derived-type.rs \ + generic-obj.rs \ + generic-recursive-tag.rs \ + generic-tag-alt.rs \ generic-tag.rs \ + generic-type-synonym.rs \ generic-type.rs \ - generic-fn-infer.rs \ - vec-append.rs \ - vec-concat.rs \ - vec-drop.rs \ - mutable-vec-drop.rs \ + i32-sub.rs \ + i8-incr.rs \ + import.rs \ inner-module.rs \ large-records.rs \ + lazy-and-or.rs \ lazychan.rs \ linear-for-loop.rs \ + list.rs \ many.rs \ + mlist-cycle.rs \ mlist.rs \ - mlist_cycle.rs \ + mutable-vec-drop.rs \ mutual-recursion-group.rs \ + native-mod.rc \ + native-opaque-type.rs \ native.rc \ - command-line-args.rs \ - native_mod.rc \ + obj-as.rs \ + obj-drop.rs \ + obj-dtor.rs \ + obj-with-vec.rs \ opeq.rs \ + preempt.rs \ pred.rs \ readalias.rs \ rec-auto.rs \ rec-extend.rs \ + rec-tup.rs \ rec.rs \ - rec_tup.rs \ return-nil.rs \ - i32-sub.rs \ - i8-incr.rs \ + simple-obj.rs \ spawn-fn.rs \ spawn.rs \ stateful-obj.rs \ @@ -383,31 +412,31 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ tail-direct.rs \ threads.rs \ tup.rs \ + type-sizes.rs \ u32-decr.rs \ u8-incr-decr.rs \ u8-incr.rs \ unit.rs \ user.rs \ + utf8.rs \ + vec-append.rs \ + vec-concat.rs \ + vec-drop.rs \ + vec-slice.rs \ vec.rs \ writealias.rs \ yield.rs \ yield2.rs \ - native-opaque-type.rs \ - type-sizes.rs \ - obj-drop.rs \ - obj-dtor.rs \ - obj-with-vec.rs \ - else-if.rs \ - lazy-and-or.rs \ + task-comm.rs \ ) \ $(addprefix test/run-fail/, \ explicit-fail.rs \ fail.rs \ linked-failure.rs \ pred.rs \ - vec_overrun.rs \ - str_overrun.rs \ - vec_underrun.rs \ + vec-overrun.rs \ + str-overrun.rs \ + vec-underrun.rs \ ) \ $(addprefix test/compile-fail/, \ rec-missing-fields.rs \ @@ -416,93 +445,109 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ ) ifdef CFG_WINDOWSY -TEST_XFAILS_X86 += test/run-pass/native_mod.rc -TEST_XFAILS_LLVM += test/run-pass/native_mod.rc +TEST_XFAILS_X86 += test/run-pass/native-mod.rc +TEST_XFAILS_LLVM += test/run-pass/native-mod.rc +else +TEST_XFAILS_X86 += test/run-pass/preempt.rs +TEST_XFAILS_LLVM += test/run-pass/preempt.rs endif -TEST_RUN_PASS_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-pass/*.rc)) -TEST_RUN_PASS_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-pass/*.rc)) -TEST_RUN_PASS_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-pass/*.rs)) -TEST_RUN_PASS_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-pass/*.rs)) -TEST_RUN_PASS_EXTRAS := $(wildcard test/run-pass/*/*.rs) -TEST_RUN_PASS_EXES_X86 := \ - $(TEST_RUN_PASS_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ - $(TEST_RUN_PASS_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) -TEST_RUN_PASS_EXES_LLVM := \ - $(TEST_RUN_PASS_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ - $(TEST_RUN_PASS_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) -TEST_RUN_PASS_OUTS_X86 := \ - $(TEST_RUN_PASS_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) -TEST_RUN_PASS_OUTS_LLVM := \ - $(TEST_RUN_PASS_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) - - -TEST_RUN_FAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-fail/*.rc)) -TEST_RUN_FAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-fail/*.rc)) -TEST_RUN_FAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-fail/*.rs)) -TEST_RUN_FAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-fail/*.rs)) -TEST_RUN_FAIL_EXTRAS := $(wildcard test/run-fail/*/*.rs) -TEST_RUN_FAIL_EXES_X86 := \ - $(TEST_RUN_FAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ - $(TEST_RUN_FAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) -TEST_RUN_FAIL_EXES_LLVM := \ - $(TEST_RUN_FAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ - $(TEST_RUN_FAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) -TEST_RUN_FAIL_OUTS_X86 := \ - $(TEST_RUN_FAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) -TEST_RUN_FAIL_OUTS_LLVM := \ - $(TEST_RUN_FAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) - - -TEST_COMPILE_FAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/compile-fail/*.rc)) -TEST_COMPILE_FAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/compile-fail/*.rc)) -TEST_COMPILE_FAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/compile-fail/*.rs)) -TEST_COMPILE_FAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/compile-fail/*.rs)) -TEST_COMPILE_FAIL_EXTRAS := $(wildcard test/compile-fail/*/*.rs) -TEST_COMPILE_FAIL_EXES_X86 := \ - $(TEST_COMPILE_FAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ - $(TEST_COMPILE_FAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) -TEST_COMPILE_FAIL_EXES_LLVM := \ - $(TEST_COMPILE_FAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ - $(TEST_COMPILE_FAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) -TEST_COMPILE_FAIL_OUTS_X86 := \ - $(TEST_COMPILE_FAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) -TEST_COMPILE_FAIL_OUTS_LLVM := \ - $(TEST_COMPILE_FAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) - -ALL_TEST_CRATES := $(TEST_COMPILE_FAIL_CRATES_X86) \ - $(TEST_RUN_FAIL_CRATES_X86) \ - $(TEST_RUN_PASS_CRATES_X86) - -ALL_TEST_SOURCES := $(TEST_COMPILE_FAIL_SOURCES_X86) \ - $(TEST_RUN_FAIL_SOURCES_X86) \ - $(TEST_RUN_PASS_SOURCES_X86) +RPASS_RC := $(wildcard test/run-pass/*.rc) +RPASS_RS := $(wildcard test/run-pass/*.rs) +RFAIL_RC := $(wildcard test/run-fail/*.rc) +RFAIL_RS := $(wildcard test/run-fail/*.rs) +CFAIL_RC := $(wildcard test/compile-fail/*.rc) +CFAIL_RS := $(wildcard test/compile-fail/*.rs) + +TEST_RPASS_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RPASS_RC)) +TEST_RPASS_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RPASS_RC)) +TEST_RPASS_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RPASS_RS)) +TEST_RPASS_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RPASS_RS)) +TEST_RPASS_EXTRAS := $(wildcard test/run-pass/*/*.rs) +TEST_RPASS_EXES_X86 := \ + $(TEST_RPASS_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ + $(TEST_RPASS_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) +TEST_RPASS_EXES_LLVM := \ + $(TEST_RPASS_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ + $(TEST_RPASS_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) +TEST_RPASS_OUTS_X86 := \ + $(TEST_RPASS_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) +TEST_RPASS_OUTS_LLVM := \ + $(TEST_RPASS_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) + + +TEST_RFAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RFAIL_RC)) +TEST_RFAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RFAIL_RC)) +TEST_RFAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RFAIL_RS)) +TEST_RFAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RFAIL_RS)) +TEST_RFAIL_EXTRAS := $(wildcard test/run-fail/*/*.rs) +TEST_RFAIL_EXES_X86 := \ + $(TEST_RFAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ + $(TEST_RFAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) +TEST_RFAIL_EXES_LLVM := \ + $(TEST_RFAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ + $(TEST_RFAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) +TEST_RFAIL_OUTS_X86 := \ + $(TEST_RFAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) +TEST_RFAIL_OUTS_LLVM := \ + $(TEST_RFAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) + + +TEST_CFAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(CFAIL_RC)) +TEST_CFAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(CFAIL_RC)) +TEST_CFAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(CFAIL_RS)) +TEST_CFAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(CFAIL_RS)) +TEST_CFAIL_EXTRAS := $(wildcard test/compile-fail/*/*.rs) +TEST_CFAIL_EXES_X86 := \ + $(TEST_CFAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \ + $(TEST_CFAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX)) +TEST_CFAIL_EXES_LLVM := \ + $(TEST_CFAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \ + $(TEST_CFAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX)) +TEST_CFAIL_OUTS_X86 := \ + $(TEST_CFAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out) +TEST_CFAIL_OUTS_LLVM := \ + $(TEST_CFAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out) + +ALL_TEST_CRATES := $(TEST_CFAIL_CRATES_X86) \ + $(TEST_RFAIL_CRATES_X86) \ + $(TEST_RPASS_CRATES_X86) + +ALL_TEST_SOURCES := $(TEST_CFAIL_SOURCES_X86) \ + $(TEST_RFAIL_SOURCES_X86) \ + $(TEST_RPASS_SOURCES_X86) ALL_TEST_INPUTS := $(wildcard test/*/*.rs test/*/*/*.rs test/*/*.rc) -check_nocompile: $(TEST_COMPILE_FAIL_OUTS_X86) +check_nocompile: $(TEST_CFAIL_OUTS_X86) + +check: tidy \ + $(TEST_RPASS_EXES_X86) $(TEST_RFAIL_EXES_X86) \ + $(TEST_RPASS_OUTS_X86) $(TEST_RFAIL_OUTS_X86) \ + $(TEST_CFAIL_OUTS_X86) -check: $(TEST_RUN_PASS_EXES_X86) $(TEST_RUN_FAIL_EXES_X86) \ - $(TEST_RUN_PASS_OUTS_X86) $(TEST_RUN_FAIL_OUTS_X86) \ - $(TEST_COMPILE_FAIL_OUTS_X86) ifeq ($(VARIANT),llvm) -ALL_TEST_CRATES += $(TEST_COMPILE_FAIL_CRATES_LLVM) \ - $(TEST_RUN_FAIL_CRATES_LLVM) \ - $(TEST_RUN_PASS_CRATES_LLVM) +ALL_TEST_CRATES += $(TEST_CFAIL_CRATES_LLVM) \ + $(TEST_RFAIL_CRATES_LLVM) \ + $(TEST_RPASS_CRATES_LLVM) -ALL_TEST_SOURCES += $(TEST_COMPILE_FAIL_SOURCES_LLVM) \ - $(TEST_RUN_FAIL_SOURCES_LLVM) \ - $(TEST_RUN_PASS_SOURCES_LLVM) +ALL_TEST_SOURCES += $(TEST_CFAIL_SOURCES_LLVM) \ + $(TEST_RFAIL_SOURCES_LLVM) \ + $(TEST_RPASS_SOURCES_LLVM) -check_nocompile: $(TEST_COMPILE_FAIL_OUTS_LLVM) +check_nocompile: $(TEST_CFAIL_OUTS_LLVM) -check: $(TEST_RUN_PASS_EXES_LLVM) $(TEST_RUN_FAIL_EXES_LLVM) \ - $(TEST_RUN_PASS_OUTS_LLVM) $(TEST_RUN_FAIL_OUTS_LLVM) \ - $(TEST_COMPILE_FAIL_OUTS_LLVM) +check: tidy \ + $(TEST_RPASS_EXES_LLVM) $(TEST_RFAIL_EXES_LLVM) \ + $(TEST_RPASS_OUTS_LLVM) $(TEST_RFAIL_OUTS_LLVM) \ + $(TEST_CFAIL_OUTS_LLVM) endif +REQ := $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) +BOOT := $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) + test/run-pass/%.out: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) @$(call CFG_ECHO, run: $<) $(CFG_QUIET)$(call CFG_RUN_TARG, $<) > $@ @@ -510,55 +555,57 @@ test/run-pass/%.out: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) test/run-fail/%.out: test/run-fail/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME) @$(call CFG_ECHO, run: $<) $(CFG_QUIET)rm -f $@ - $(CFG_QUIET)$(call CFG_RUN_TARG, $<) >$@ 2>&1 ; X=$$? ; if [ $$X -eq 0 ] ; then exit 1 ; else exit 0 ; fi - $(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $(basename $(basename $@)).rs | tr -d '\n\r'`" $@ + $(CFG_QUIET)$(call CFG_RUN_TARG, $<) >$@ 2>&1 ; X=$$? ; \ + if [ $$X -eq 0 ] ; then exit 1 ; else exit 0 ; fi + $(CFG_QUIET)grep --text --quiet \ + "`awk -F: '/error-pattern/ { print $$2 }' \ + $(basename $(basename $@)).rs | tr -d '\n\r'`" $@ -test/compile-fail/%.x86.out: test/compile-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME) +test/compile-fail/%.x86.out: test/compile-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [x86]: $<) $(CFG_QUIET)rm -f $@ - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true - $(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@ + $(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true + $(CFG_QUIET)grep --text --quiet \ + "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@ -test/compile-fail/%.llvm.out: test/compile-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME) +test/compile-fail/%.llvm.out: test/compile-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [llvm]: $<) $(CFG_QUIET)rm -f $@ - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true - $(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@ + $(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true + $(CFG_QUIET)grep --text --quiet \ + "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@ -test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rc $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) +test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rc $(REQ) @$(call CFG_ECHO, compile [x86]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $< - $(CFG_QUIET)chmod 0755 $@ + $(BOOT) -o $@ $< %.s: %.bc @$(call CFG_ECHO, compile [llvm]: $<) - $(CFG_QUIET)llc $(CFG_LLC_COMPILE_FLAGS) -o $@ $< + $(CFG_QUIET)llc $(CFG_LLC_CFLAGS) -o $@ $< %.llvm$(CFG_EXE_SUFFIX): %.s $(CFG_RUNTIME) @$(call CFG_ECHO, compile [llvm]: $<) - $(CFG_QUIET)gcc $(CFG_GCC_COMPILE_FLAGS) -o $@ $< -L. -lrustrt + $(CFG_QUIET)gcc $(CFG_GCC_CFLAGS) -o $@ $< -L. -lrustrt -test/run-pass/%.bc: test/run-pass/%.rc $(CFG_BOOT) $(CFG_STDLIB) +test/run-pass/%.bc: test/run-pass/%.rc $(REQ) @$(call CFG_ECHO, compile [llvm]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $< + $(BOOT) -o $@ -llvm $< -test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rs $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) +test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rs $(REQ) @$(call CFG_ECHO, compile [x86]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $< - $(CFG_QUIET)chmod 0755 $@ + $(BOOT) -o $@ $< -test/run-pass/%.bc: test/run-pass/%.rs $(CFG_BOOT) $(CFG_STDLIB) +test/run-pass/%.bc: test/run-pass/%.rs $(REQ) @$(call CFG_ECHO, compile [llvm]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $< + $(BOOT) -o $@ -llvm $< -test/run-fail/%.x86$(CFG_EXE_SUFFIX): test/run-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) +test/run-fail/%.x86$(CFG_EXE_SUFFIX): test/run-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [x86]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $< - $(CFG_QUIET)chmod 0755 $@ + $(BOOT) -o $@ $< -test/run-fail/%.bc: test/run-fail/%.rs $(CFG_BOOT) $(CFG_STDLIB) +test/run-fail/%.bc: test/run-fail/%.rs $(REQ) @$(call CFG_ECHO, compile [llvm]: $<) - $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $< + $(BOOT) -o $@ -llvm $< ###################################################################### @@ -570,7 +617,9 @@ C_DEPFILES := $(RUNTIME_CS:%.cpp=%.d) %.d: %.cpp $(MKFILES) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)$(call CFG_DEPEND_C, $@ $(patsubst %.cpp, %$(CFG_OBJ_SUFFIX), $<), $(RUNTIME_INCS)) $< $(CFG_PATH_MUNGE) >$@ + $(CFG_QUIET)$(call CFG_DEPEND_C, $@ \ + $(patsubst %.cpp, %$(CFG_OBJ_SUFFIX), $<), \ + $(RUNTIME_INCS)) $< $(CFG_PATH_MUNGE) >$@ %.d: %.ml $(MKFILES) @$(call CFG_ECHO, dep: $<) @@ -593,15 +642,15 @@ CRATE_DEPFILES := $(ALL_TEST_CRATES:%.rc=%.d) $(STDLIB_DEPFILE) $(STDLIB_DEPFILE): $(STDLIB_CRATE) $(MKFILES) $(CFG_BOOT) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -shared -rdeps $< $(CFG_PATH_MUNGE) >$@ + $(BOOT) -shared -rdeps $< $(CFG_PATH_MUNGE) >$@ %.d: %.rc $(MKFILES) $(CFG_BOOT) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -rdeps $< $(CFG_PATH_MUNGE) >$@ + $(BOOT) -rdeps $< $(CFG_PATH_MUNGE) >$@ %.d: %.rs $(MKFILES) $(CFG_BOOT) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -rdeps $< $(CFG_PATH_MUNGE) >$@ + $(BOOT) -rdeps $< $(CFG_PATH_MUNGE) >$@ ifneq ($(MAKECMDGOALS),clean) -include $(CRATE_DEPFILES) @@ -622,8 +671,9 @@ PKG_3RDPARTY := rt/valgrind.h rt/memcheck.h \ rt/bigint/bigint.h rt/bigint/bigint_int.cpp \ rt/bigint/bigint_ext.cpp rt/bigint/low_primes.h PKG_FILES := README \ + $(wildcard etc/*.*) \ $(MKFILES) $(BOOT_MLS) boot/fe/lexer.mll \ - $(COMPILER_CRATE) $(COMPILER_INPUTS) \ + $(COMPILER_INPUTS) \ $(STDLIB_CRATE) $(STDLIB_INPUTS) \ $(RUNTIME_CS) $(RUNTIME_HDR) $(PKG_3RDPARTY) \ $(ALL_TEST_INPUTS) @@ -658,20 +708,29 @@ distcheck: # Cleanup ###################################################################### -.PHONY: clean +.PHONY: clean tidy + +tidy: + @$(call CFG_ECHO, check: formatting) + $(CFG_QUIET) python etc/tidy.py \ + $(wildcard ../*.txt) \ + ../README \ + $(filter-out boot/fe/lexer.ml $(PKG_3RDPARTY), $(PKG_FILES)) clean: @$(call CFG_ECHO, cleaning) - $(CFG_QUIET)rm -f $(RUNTIME_OBJS) $(BOOT_CMOS) $(BOOT_CMIS) $(BOOT_CMXS) $(BOOT_OBJS) + $(CFG_QUIET)rm -f $(RUNTIME_OBJS) + $(CFG_QUIET)rm -f $(BOOT_CMOS) $(BOOT_CMIS) $(BOOT_CMXS) $(BOOT_OBJS) $(CFG_QUIET)rm -f $(CFG_COMPILER) $(CFG_QUIET)rm -f $(ML_DEPFILES) $(C_DEPFILES) $(CRATE_DEPFILES) $(CFG_QUIET)rm -f boot/fe/lexer.ml $(CFG_QUIET)rm -f $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB) - $(CFG_QUIET)rm -f $(TEST_RUN_PASS_EXES_X86) $(TEST_RUN_PASS_OUTS_X86) - $(CFG_QUIET)rm -f $(TEST_RUN_PASS_EXES_LLVM) $(TEST_RUN_PASS_OUTS_LLVM) - $(CFG_QUIET)rm -f $(TEST_RUN_FAIL_EXES_X86) $(TEST_RUN_FAIL_OUTS_X86) - $(CFG_QUIET)rm -f $(TEST_RUN_FAIL_EXES_LLVM) $(TEST_RUN_FAIL_OUTS_LLVM) - $(CFG_QUIET)rm -f $(TEST_COMPILE_FAIL_EXES_X86) $(TEST_COMPILE_FAIL_OUTS_X86) - $(CFG_QUIET)rm -f $(TEST_COMPILE_FAIL_EXES_LLVM) $(TEST_COMPILE_FAIL_OUTS_LLVM) + $(CFG_QUIET)rm -f $(TEST_RPASS_EXES_X86) $(TEST_RPASS_OUTS_X86) + $(CFG_QUIET)rm -f $(TEST_RPASS_EXES_LLVM) $(TEST_RPASS_OUTS_LLVM) + $(CFG_QUIET)rm -f $(TEST_RFAIL_EXES_X86) $(TEST_RFAIL_OUTS_X86) + $(CFG_QUIET)rm -f $(TEST_RFAIL_EXES_LLVM) $(TEST_RFAIL_OUTS_LLVM) + $(CFG_QUIET)rm -f $(TEST_CFAIL_EXES_X86) $(TEST_CFAIL_OUTS_X86) + $(CFG_QUIET)rm -f $(TEST_CFAIL_EXES_LLVM) $(TEST_CFAIL_OUTS_LLVM) $(CFG_QUIET)rm -Rf $(PKG_NAME)-*.tar.gz dist - $(CFG_QUIET)rm -f $(foreach ext,cmx cmi cmo cma o a d exe,$(wildcard boot/*/*.$(ext) boot/*/*/*.$(ext))) + $(CFG_QUIET)rm -f $(foreach ext,cmx cmi cmo cma o a d exe,\ + $(wildcard boot/*/*.$(ext) boot/*/*/*.$(ext))) diff --git a/src/README b/src/README new file mode 100644 index 00000000..c51709d0 --- /dev/null +++ b/src/README @@ -0,0 +1,28 @@ +This is preliminary version of the Rust compiler. + +Source layout: + +boot/ The bootstrap compiler +boot/fe - Front end (lexer, parser, AST) +boot/me - Middle end (resolve, check, layout, trans) +boot/be - Back end (IL, RA, insns, asm, objfiles) +boot/util - Ubiquitous helpers +boot/llvm - LLVM-based alternative back end +boot/driver - Compiler driver + +comp/ The self-hosted compiler (doesn't exist yet) +comp/* - Same structure as in boot/ + +rt/ The runtime system +rt/rust_*.cpp - The majority of the runtime services +rt/isaac - The PRNG used for pseudo-random choices in the runtime +rt/bigint - The bigint library used for the 'big' type +rt/uthash - Small hashtable-and-list library for C, used in runtime +rt/{sync,util} - Small utility classes for the runtime. + +test/ Testsuite (for both bootstrap and self-hosted) +test/compile-fail - Tests that should fail to compile +test/run-fail - Tests that should compile, run and fail +test/run-pass - Tests that should compile, run and succeed + +Please be gentle, it's a work in progress. diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml new file mode 100644 index 00000000..fd9ca750 --- /dev/null +++ b/src/boot/be/abi.ml @@ -0,0 +1,207 @@ + +(* + * The 'abi' structure is pretty much just a grab-bag of machine + * dependencies and structure-layout information. Part of the latter + * is shared with trans and semant. + * + * Make some attempt to factor it as time goes by. + *) + +(* Word offsets for structure fields in rust-internal.h, and elsewhere in + compiler. *) + +let rc_base_field_refcnt = 0;; + +let task_field_refcnt = rc_base_field_refcnt;; +let task_field_stk = task_field_refcnt + 1;; +let task_field_runtime_sp = task_field_stk + 1;; +let task_field_rust_sp = task_field_runtime_sp + 1;; +let task_field_gc_alloc_chain = task_field_rust_sp + 1;; +let task_field_dom = task_field_gc_alloc_chain + 1;; +let n_visible_task_fields = task_field_dom + 1;; + +let dom_field_interrupt_flag = 0;; + +let frame_glue_fns_field_mark = 0;; +let frame_glue_fns_field_drop = 1;; +let frame_glue_fns_field_reloc = 2;; + +let exterior_rc_slot_field_refcnt = 0;; +let exterior_rc_slot_field_body = 1;; + +let exterior_gc_slot_field_next = (-2);; +let exterior_gc_slot_field_ctrl = (-1);; +let exterior_gc_slot_field_refcnt = 0;; +let exterior_gc_slot_field_body = 1;; + +let exterior_rc_header_size = 1;; +let exterior_gc_header_size = 3;; + +let exterior_gc_malloc_return_adjustment = 2;; + +let stk_field_valgrind_id = 0 + 1;; +let stk_field_limit = stk_field_valgrind_id + 1;; +let stk_field_data = stk_field_limit + 1;; + +let binding_size = 2;; +let binding_field_item = 0;; +let binding_field_binding = 1;; + +let general_code_alignment = 16;; + +let tydesc_field_first_param = 0;; +let tydesc_field_size = 1;; +let tydesc_field_align = 2;; +let tydesc_field_copy_glue = 3;; +let tydesc_field_drop_glue = 4;; +let tydesc_field_free_glue = 5;; +let tydesc_field_mark_glue = 6;; +let tydesc_field_obj_drop_glue = 7;; + +let vec_elt_rc = 0;; +let vec_elt_alloc = 1;; +let vec_elt_fill = 2;; +let vec_elt_data = 3;; + +let calltup_elt_out_ptr = 0;; +let calltup_elt_task_ptr = 1;; +let calltup_elt_ty_params = 2;; +let calltup_elt_args = 3;; +let calltup_elt_iterator_args = 4;; +let calltup_elt_indirect_args = 5;; + +let iterator_args_elt_block_fn = 0;; +let iterator_args_elt_outer_frame_ptr = 1;; + +let indirect_args_elt_closure = 0;; + +(* ty_params, src, dst, tydesc, taskptr. *) +let worst_case_glue_call_args = 5;; + +type abi = + { + abi_word_sz: int64; + abi_word_bits: Il.bits; + abi_word_ty: Common.ty_mach; + + abi_is_2addr_machine: bool; + abi_has_pcrel_data: bool; + abi_has_pcrel_code: bool; + + abi_n_hardregs: int; + abi_str_of_hardreg: (int -> string); + + abi_prealloc_quad: (Il.quad' -> Il.quad'); + abi_constrain_vregs: (Il.quad -> Bits.t array -> unit); + + abi_emit_fn_prologue: (Il.emitter + -> Common.size (* framesz *) + -> Common.size (* callsz *) + -> Common.nabi + -> Common.fixup (* grow_task *) + -> unit); + + abi_emit_fn_epilogue: (Il.emitter -> unit); + + abi_emit_fn_tail_call: (Il.emitter + -> int64 (* caller_callsz *) + -> int64 (* caller_argsz *) + -> Il.code (* callee_code *) + -> int64 (* callee_argsz *) + -> unit); + + abi_clobbers: (Il.quad -> Il.hreg list); + + abi_emit_native_call: (Il.emitter + -> Il.cell (* ret *) + -> Common.nabi + -> Common.fixup (* callee *) + -> Il.operand array (* args *) + -> unit); + + abi_emit_native_void_call: (Il.emitter + -> Common.nabi + -> Common.fixup (* callee *) + -> Il.operand array (* args *) + -> unit); + + abi_emit_native_call_in_thunk: (Il.emitter + -> Il.cell (* ret *) + -> Common.nabi + -> Il.operand (* callee *) + -> Il.operand array (* args *) + -> unit); + abi_emit_inline_memcpy: (Il.emitter + -> int64 (* n_bytes *) + -> Il.reg (* dst_ptr *) + -> Il.reg (* src_ptr *) + -> Il.reg (* tmp_reg *) + -> bool (* ascending *) + -> unit); + + (* Global glue. *) + abi_activate: (Il.emitter -> unit); + abi_yield: (Il.emitter -> unit); + abi_unwind: (Il.emitter -> Common.nabi -> Common.fixup -> unit); + abi_get_next_pc_thunk: + ((Il.reg (* output *) + * Common.fixup (* thunk in objfile *) + * (Il.emitter -> unit)) (* fn to make thunk *) + option); + + abi_sp_reg: Il.reg; + abi_fp_reg: Il.reg; + abi_dwarf_fp_reg: int; + abi_tp_cell: Il.cell; + abi_implicit_args_sz: int64; + abi_frame_base_sz: int64; + abi_frame_info_sz: int64; + abi_spill_slot: (Il.spill -> Il.mem); + } +;; + +let load_fixup_addr + (e:Il.emitter) + (out_reg:Il.reg) + (fix:Common.fixup) + (rty:Il.referent_ty) + : unit = + + let cell = Il.Reg (out_reg, Il.AddrTy rty) in + let op = Il.ImmPtr (fix, rty) in + Il.emit e (Il.lea cell op); +;; + +let load_fixup_codeptr + (e:Il.emitter) + (out_reg:Il.reg) + (fixup:Common.fixup) + (has_pcrel_code:bool) + (indirect:bool) + : Il.code = + if indirect + then + begin + load_fixup_addr e out_reg fixup (Il.ScalarTy (Il.AddrTy Il.CodeTy)); + Il.CodePtr (Il.Cell (Il.Mem (Il.RegIn (out_reg, None), + Il.ScalarTy (Il.AddrTy Il.CodeTy)))) + end + else + if has_pcrel_code + then (Il.CodePtr (Il.ImmPtr (fixup, Il.CodeTy))) + else + begin + load_fixup_addr e out_reg fixup Il.CodeTy; + Il.CodePtr (Il.Cell (Il.Reg (out_reg, Il.AddrTy Il.CodeTy))) + end +;; + + +(* + * Local Variables: + * fill-column: 78; + * indent-tabs-mode: nil + * buffer-file-coding-system: utf-8-unix + * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'"; + * End: + *) diff --git a/src/boot/be/asm.ml b/src/boot/be/asm.ml new file mode 100644 index 00000000..10b2142a --- /dev/null +++ b/src/boot/be/asm.ml @@ -0,0 +1,755 @@ +(* + + Our assembler is an all-at-once, buffer-in-memory job, very simple + minded. I have 1gb of memory on my laptop: I don't expect to ever + emit a program that large with this code. + + It is based on the 'frag' type, which has a variant for every major + type of machine-blob we know how to write (bytes, zstrings, BSS + blocks, words of various sorts). + + A frag can contain symbolic references between the sub-parts of + it. These are accomplished through ref cells we call fixups, and a + 2-pass (resolution and writing) process defined recursively over + the frag structure. + + Fixups are defined by wrapping a frag in a DEF pseudo-frag with + a fixup attached. This will record information about the wrapped + frag -- positions and sizes -- in the fixup during resolution. + + We say "positions" and "sizes" there, in plural, because both a + file number and a memory number is recorded for each concept. + + File numbers refer to positions and sizes in the file we're + generating, and are based on the native int type for the host + platform -- usually 31 or 62 bits -- whereas the expressions that + *use* position fixups tend to promote them up to 32 or 64 bits + somehow. On a 32 bit platform, you can't generate output buffers + with 64-bit positions (ocaml limitation!) + + Memory numbers are 64 bit, always, and refer to sizes and positions + of frags when they are loaded into memory in the target. When + you're generating code for a 32-bit target, or using a memory + number in a context that's less than 64 bits, the value is + range-checked and truncated. But in all other respects, we imagine + a 32-bit address space is just the prefix of the continuing 64-bit + address space. If you need to pin an object at a particular place + from the point 2^32-1, say, you will need to do arithmetic and use + the MEMPOS pseudo-frag, that sets the current memory position as + it's being processed. + + Fixups can be *used* anywhere else in the frag tree, as many times + as you like. If you try to write an unresolved fixup, the emitter + faults. When you specify the use of a fixup, you need to specify + whether you want to use its file size, file position, memory size, + or memory position. + + Positions, addresses, sizes and such, of course, are in bytes. + + Expressions are evaluated to an int64 (signed), even if the + expression is an int32 or less. Depending on how you use the result + of the expression, a range check error may fire (for example, if + the expression evaluates to -2^24 and you're emitting a word16). + + Word endianness is per-file. At the moment this seems acceptable. + + Because we want to be *very specific* about the time and place + arithmetic promotions occur, we define two separate expression-tree + types (with the same polymorphic constructors) and two separate + evaluation functions, with an explicit operator for marking the + promotion-points. + +*) + +open Common;; + + +let log (sess:Session.sess) = + Session.log "asm" + sess.Session.sess_log_asm + sess.Session.sess_log_out +;; + +let iflog (sess:Session.sess) (thunk:(unit -> unit)) : unit = + if sess.Session.sess_log_asm + then thunk () + else () +;; + +exception Bad_fit of string;; +exception Undef_sym of string;; + +type ('a, 'b) expr = + IMM of 'a + | ADD of (('a, 'b) expr) * (('a, 'b) expr) + | SUB of (('a, 'b) expr) * (('a, 'b) expr) + | MUL of (('a, 'b) expr) * (('a, 'b) expr) + | DIV of (('a, 'b) expr) * (('a, 'b) expr) + | REM of (('a, 'b) expr) * (('a, 'b) expr) + | MAX of (('a, 'b) expr) * (('a, 'b) expr) + | ALIGN of (('a, 'b) expr) * (('a, 'b) expr) + | SLL of (('a, 'b) expr) * int + | SLR of (('a, 'b) expr) * int + | SAR of (('a, 'b) expr) * int + | AND of (('a, 'b) expr) * (('a, 'b) expr) + | XOR of (('a, 'b) expr) * (('a, 'b) expr) + | OR of (('a, 'b) expr) * (('a, 'b) expr) + | NOT of (('a, 'b) expr) + | NEG of (('a, 'b) expr) + | F_POS of fixup + | F_SZ of fixup + | M_POS of fixup + | M_SZ of fixup + | EXT of 'b + +type expr32 = (int32, int) expr +;; + +type expr64 = (int64, expr32) expr +;; + + +let rec eval32 (e:expr32) + : int32 = + let chop64 kind name v = + let x = Int64.to_int32 v in + if (Int64.compare v (Int64.of_int32 x)) = 0 then + x + else raise (Bad_fit (kind + ^ " fixup " + ^ name + ^ " overflowed 32 bits in eval32: " + ^ Int64.to_string v)) + in + let expandInt _ _ v = Int32.of_int v in + let checkdef kind name v inj = + match v with + None -> + raise (Undef_sym (kind ^ " fixup " ^ name + ^ " undefined in eval32")) + | Some x -> inj kind name x + in + match e with + IMM i -> i + | ADD (a, b) -> Int32.add (eval32 a) (eval32 b) + | SUB (a, b) -> Int32.sub (eval32 a) (eval32 b) + | MUL (a, b) -> Int32.mul (eval32 a) (eval32 b) + | DIV (a, b) -> Int32.div (eval32 a) (eval32 b) + | REM (a, b) -> Int32.rem (eval32 a) (eval32 b) + | MAX (a, b) -> i32_max (eval32 a) (eval32 b) + | ALIGN (a, b) -> i32_align (eval32 a) (eval32 b) + | SLL (a, b) -> Int32.shift_left (eval32 a) b + | SLR (a, b) -> Int32.shift_right_logical (eval32 a) b + | SAR (a, b) -> Int32.shift_right (eval32 a) b + | AND (a, b) -> Int32.logand (eval32 a) (eval32 b) + | XOR (a, b) -> Int32.logxor (eval32 a) (eval32 b) + | OR (a, b) -> Int32.logor (eval32 a) (eval32 b) + | NOT a -> Int32.lognot (eval32 a) + | NEG a -> Int32.neg (eval32 a) + | F_POS f -> + checkdef "file position" + f.fixup_name f.fixup_file_pos expandInt + | F_SZ f -> + checkdef "file size" + f.fixup_name f.fixup_file_sz expandInt + | M_POS f -> + checkdef "mem position" + f.fixup_name f.fixup_mem_pos chop64 + | M_SZ f -> + checkdef "mem size" f.fixup_name f.fixup_mem_sz chop64 + | EXT i -> Int32.of_int i +;; + +let rec eval64 (e:expr64) + : int64 = + let checkdef kind name v inj = + match v with + None -> + raise (Undef_sym (kind ^ " fixup '" + ^ name ^ "' undefined in eval64")) + | Some x -> inj x + in + match e with + IMM i -> i + | ADD (a, b) -> Int64.add (eval64 a) (eval64 b) + | SUB (a, b) -> Int64.sub (eval64 a) (eval64 b) + | MUL (a, b) -> Int64.mul (eval64 a) (eval64 b) + | DIV (a, b) -> Int64.div (eval64 a) (eval64 b) + | REM (a, b) -> Int64.rem (eval64 a) (eval64 b) + | MAX (a, b) -> i64_max (eval64 a) (eval64 b) + | ALIGN (a, b) -> i64_align (eval64 a) (eval64 b) + | SLL (a, b) -> Int64.shift_left (eval64 a) b + | SLR (a, b) -> Int64.shift_right_logical (eval64 a) b + | SAR (a, b) -> Int64.shift_right (eval64 a) b + | AND (a, b) -> Int64.logand (eval64 a) (eval64 b) + | XOR (a, b) -> Int64.logxor (eval64 a) (eval64 b) + | OR (a, b) -> Int64.logor (eval64 a) (eval64 b) + | NOT a -> Int64.lognot (eval64 a) + | NEG a -> Int64.neg (eval64 a) + | F_POS f -> + checkdef "file position" + f.fixup_name f.fixup_file_pos Int64.of_int + | F_SZ f -> + checkdef "file size" + f.fixup_name f.fixup_file_sz Int64.of_int + | M_POS f -> + checkdef "mem position" + f.fixup_name f.fixup_mem_pos (fun x -> x) + | M_SZ f -> + checkdef "mem size" + f.fixup_name f.fixup_mem_sz (fun x -> x) + | EXT e -> Int64.of_int32 (eval32 e) +;; + + +type frag = + MARK (* MARK == 'PAD (IMM 0L)' *) + | SEQ of frag array + | PAD of int + | BSS of int64 + | MEMPOS of int64 + | BYTE of int + | BYTES of int array + | CHAR of char + | STRING of string + | ZSTRING of string + | ULEB128 of expr64 + | SLEB128 of expr64 + | WORD of (ty_mach * expr64) + | ALIGN_FILE of (int * frag) + | ALIGN_MEM of (int * frag) + | DEF of (fixup * frag) + | RELAX of relaxation + +and relaxation = + { relax_options: frag array; + relax_choice: int ref; } +;; + +exception Relax_more of relaxation;; + +let new_relaxation (frags:frag array) = + RELAX { relax_options = frags; + relax_choice = ref ((Array.length frags) - 1); } +;; + + +let rec write_frag + ~(sess:Session.sess) + ~(lsb0:bool) + ~(buf:Buffer.t) + ~(frag:frag) + : unit = + let relax = Queue.create () in + let bump_relax r = + iflog sess (fun _ -> + log sess "bumping relaxation to position %d" + ((!(r.relax_choice)) - 1)); + r.relax_choice := (!(r.relax_choice)) - 1; + if !(r.relax_choice) < 0 + then bug () "relaxation ran out of options" + in + let rec loop _ = + Queue.clear relax; + Buffer.clear buf; + resolve_frag_full relax frag; + lower_frag ~sess ~lsb0 ~buf ~relax ~frag; + if Queue.is_empty relax + then () + else + begin + iflog sess (fun _ -> log sess "relaxing"); + Queue.iter bump_relax relax; + loop () + end + in + loop () + + +and resolve_frag_full (relax:relaxation Queue.t) (frag:frag) + : unit = + let file_pos = ref 0 in + let mem_pos = ref 0L in + let bump i = + mem_pos := Int64.add (!mem_pos) (Int64.of_int i); + file_pos := (!file_pos) + i + in + + let uleb (e:expr64) : unit = + let rec loop value = + let value = Int64.shift_right_logical value 7 in + if value = 0L + then bump 1 + else + begin + bump 1; + loop value + end + in + loop (eval64 e) + in + + let sleb (e:expr64) : unit = + let rec loop value = + let byte = Int64.logand value 0xf7L in + let value = Int64.shift_right value 7 in + let signbit = Int64.logand byte 0x40L in + if (((value = 0L) && (signbit = 0L)) || + ((value = -1L) && (signbit = 0x40L))) + then bump 1 + else + begin + bump 1; + loop value + end + in + loop (eval64 e) + in + let rec resolve_frag it = + match it with + | MARK -> () + | SEQ frags -> Array.iter resolve_frag frags + | PAD i -> bump i + | BSS i -> mem_pos := Int64.add (!mem_pos) i + | MEMPOS i -> mem_pos := i + | BYTE _ -> bump 1 + | BYTES ia -> bump (Array.length ia) + | CHAR _ -> bump 1 + | STRING s -> bump (String.length s) + | ZSTRING s -> bump ((String.length s) + 1) + | ULEB128 e -> uleb e + | SLEB128 e -> sleb e + | WORD (mach,_) -> bump (bytes_of_ty_mach mach) + | ALIGN_FILE (n, frag) -> + let spill = (!file_pos) mod n in + let pad = (n - spill) mod n in + file_pos := (!file_pos) + pad; + (* + * NB: aligning the file *causes* likewise alignment of + * memory, since we implement "file alignment" by + * padding! + *) + mem_pos := Int64.add (!mem_pos) (Int64.of_int pad); + resolve_frag frag + + | ALIGN_MEM (n, frag) -> + let n64 = Int64.of_int n in + let spill = Int64.rem (!mem_pos) n64 in + let pad = Int64.rem (Int64.sub n64 spill) n64 in + mem_pos := Int64.add (!mem_pos) pad; + resolve_frag frag + + | DEF (f, i) -> + let fpos1 = !file_pos in + let mpos1 = !mem_pos in + resolve_frag i; + f.fixup_file_pos <- Some fpos1; + f.fixup_mem_pos <- Some mpos1; + f.fixup_file_sz <- Some ((!file_pos) - fpos1); + f.fixup_mem_sz <- Some (Int64.sub (!mem_pos) mpos1) + + | RELAX rel -> + begin + try + resolve_frag rel.relax_options.(!(rel.relax_choice)) + with + Bad_fit _ -> Queue.add rel relax + end + in + resolve_frag frag + +and lower_frag + ~(sess:Session.sess) + ~(lsb0:bool) + ~(buf:Buffer.t) + ~(relax:relaxation Queue.t) + ~(frag:frag) + : unit = + let byte (i:int) = + if i < 0 + then raise (Bad_fit "byte underflow") + else + if i > 255 + then raise (Bad_fit "byte overflow") + else Buffer.add_char buf (Char.chr i) + in + + let uleb (e:expr64) : unit = + let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in + let rec loop value = + let byte = Int64.logand value 0x7fL in + let value = Int64.shift_right_logical value 7 in + if value = 0L + then emit1 byte + else + begin + emit1 (Int64.logor byte 0x80L); + loop value + end + in + loop (eval64 e) + in + + let sleb (e:expr64) : unit = + let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in + let rec loop value = + let byte = Int64.logand value 0x7fL in + let value = Int64.shift_right value 7 in + let signbit = Int64.logand byte 0x40L in + if (((value = 0L) && (signbit = 0L)) || + ((value = -1L) && (signbit = 0x40L))) + then emit1 byte + else + begin + emit1 (Int64.logor byte 0x80L); + loop value + end + in + loop (eval64 e) + in + + let word (nbytes:int) (signed:bool) (e:expr64) = + let i = eval64 e in + + (* + FIXME: + + We should really base the entire assembler and memory-position + system on Big_int.big_int, but in ocaml the big_int type lacks, + oh, just about every useful function (no format string spec, no + bitwise ops, blah blah) so it's useless; we're stuck on int64 + for bootstrapping. + + For the time being we're just going to require you to represent + those few unsigned 64 bit terms you have in mind via their + signed bit pattern. Suboptimal but it's the best we can do. + *) + + let (top,bot) = + if nbytes >= 8 + then + if signed + then (Int64.max_int,Int64.min_int) + else (Int64.max_int,0L) + else + if signed + then + let bound = (Int64.shift_left 1L ((8 * nbytes) - 1)) in + (Int64.sub bound 1L, Int64.neg bound) + else + let bound = (Int64.shift_left 1L (8 * nbytes)) in + (Int64.sub bound 1L, 0L) + in + + let mask1 = Int64.logand 0xffL in + let shift = Int64.shift_right_logical in + let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in + if Int64.compare i bot = (-1) + then raise (Bad_fit ("word underflow: " + ^ (Int64.to_string i) + ^ " into " + ^ (string_of_int nbytes) + ^ (if signed then " signed" else " unsigned") + ^ " bytes")) + else + if Int64.compare i top = 1 + then raise (Bad_fit ("word overflow: " + ^ (Int64.to_string i) + ^ " into " + ^ (string_of_int nbytes) + ^ (if signed then " signed" else " unsigned") + ^ " bytes")) + else + if lsb0 + then + for n = 0 to (nbytes - 1) do + emit1 (mask1 (shift i (8*n))) + done + else + for n = (nbytes - 1) downto 0 do + emit1 (mask1 (shift i (8*n))) + done + in + match frag with + MARK -> () + + | SEQ frags -> + Array.iter + begin + fun frag -> + lower_frag ~sess ~lsb0 ~buf ~relax ~frag + end frags + + | PAD c -> + for i = 1 to c do + Buffer.add_char buf '\x00' + done + + | BSS _ -> () + + | MEMPOS _ -> () + + | BYTE i -> byte i + + | BYTES bs -> + iflog sess (fun _ -> log sess "lowering %d bytes" + (Array.length bs)); + Array.iter byte bs + + | CHAR c -> + iflog sess (fun _ -> log sess "lowering char: %c" c); + Buffer.add_char buf c + + | STRING s -> + iflog sess (fun _ -> log sess "lowering string: %s" s); + Buffer.add_string buf s + + | ZSTRING s -> + iflog sess (fun _ -> log sess "lowering zstring: %s" s); + Buffer.add_string buf s; + byte 0 + + | ULEB128 e -> uleb e + | SLEB128 e -> sleb e + + | WORD (m,e) -> + iflog sess + (fun _ -> + log sess "lowering word %s" + (string_of_ty_mach m)); + word (bytes_of_ty_mach m) (mach_is_signed m) e + + | ALIGN_FILE (n, frag) -> + let spill = (Buffer.length buf) mod n in + let pad = (n - spill) mod n in + for i = 1 to pad do + Buffer.add_char buf '\x00' + done; + lower_frag sess lsb0 buf relax frag + + | ALIGN_MEM (_, i) -> lower_frag sess lsb0 buf relax i + | DEF (f, i) -> + iflog sess (fun _ -> log sess "lowering fixup: %s" f.fixup_name); + lower_frag sess lsb0 buf relax i; + + | RELAX rel -> + begin + try + lower_frag sess lsb0 buf relax + rel.relax_options.(!(rel.relax_choice)) + with + Bad_fit _ -> Queue.add rel relax + end +;; + +let fold_flags (f:'a -> int64) (flags:'a list) : int64 = + List.fold_left (Int64.logor) 0x0L (List.map f flags) +;; + +let write_out_frag sess lsb0 frag = + let buf = Buffer.create 0xffff in + let file = Session.filename_of sess.Session.sess_out in + let out = open_out_bin file in + write_frag ~sess ~lsb0 ~buf ~frag; + Buffer.output_buffer out buf; + flush out; + close_out out; + Unix.chmod file 0o755 +;; + +(* Asm-reader stuff for loading info back from mapped files. *) +(* + * Unfortunately the ocaml Bigarray interface takes 'int' indices, so + * f.e. can't do 64-bit offsets / files when running on a 32bit platform. + * Despite the fact that we can possibly produce them. Sigh. Yet another + * "bootstrap compiler limitation". + *) +type asm_reader = + { + asm_seek: int -> unit; + asm_get_u32: unit -> int; + asm_get_u16: unit -> int; + asm_get_u8: unit -> int; + asm_get_uleb: unit -> int; + asm_get_zstr: unit -> string; + asm_get_zstr_padded: int -> string; + asm_get_off: unit -> int; + asm_adv: int -> unit; + asm_adv_u32: unit -> unit; + asm_adv_u16: unit -> unit; + asm_adv_u8: unit -> unit; + asm_adv_zstr: unit -> unit; + asm_close: unit -> unit; + } +;; + +type mmap_arr = + (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) + Bigarray.Array1.t +;; + +let new_asm_reader (sess:Session.sess) (s:filename) : asm_reader = + iflog sess (fun _ -> log sess "opening file %s" s); + let fd = Unix.openfile s [ Unix.O_RDONLY ] 0 in + let arr = (Bigarray.Array1.map_file + fd ~pos:0L + Bigarray.int8_unsigned + Bigarray.c_layout + false (-1)) + in + let tmp = ref Nativeint.zero in + let buf = Buffer.create 16 in + let off = ref 0 in + let is_open = ref true in + let get_word_as_int (nbytes:int) : int = + assert (!is_open); + let lsb0 = true in + tmp := Nativeint.zero; + if lsb0 + then + for j = nbytes-1 downto 0 do + tmp := Nativeint.shift_left (!tmp) 8; + tmp := Nativeint.logor (!tmp) (Nativeint.of_int arr.{(!off) + j}) + done + else + for j = 0 to nbytes-1 do + tmp := Nativeint.shift_left (!tmp) 8; + tmp := Nativeint.logor (!tmp) (Nativeint.of_int arr.{(!off) + j}) + done; + off := (!off) + nbytes; + Nativeint.to_int (!tmp) + in + let get_zstr_padded pad_opt = + assert (!is_open); + let i = ref (!off) in + Buffer.clear buf; + let buflen_ok _ = + match pad_opt with + None -> true + | Some pad -> (Buffer.length buf) < pad + in + while arr.{!i} != 0 && (buflen_ok()) do + Buffer.add_char buf (Char.chr arr.{!i}); + incr i + done; + begin + match pad_opt with + None -> off := (!off) + (Buffer.length buf) + 1 + | Some pad -> + begin + assert ((Buffer.length buf) <= pad); + off := (!off) + pad + end + end; + Buffer.contents buf + in + let bump i = + assert (!is_open); + off := (!off) + i + in + { + asm_seek = (fun i -> off := i); + asm_get_u32 = (fun _ -> get_word_as_int 4); + asm_get_u16 = (fun _ -> get_word_as_int 2); + asm_get_u8 = (fun _ -> get_word_as_int 1); + asm_get_uleb = + begin + fun _ -> + let rec loop result shift = + let byte = arr.{!off} in + incr off; + let result = result lor ((byte land 0x7f) lsl shift) in + if (byte land 0x80) = 0 + then result + else loop result (shift+7) + in + loop 0 0 + end; + asm_get_zstr = (fun _ -> get_zstr_padded None); + asm_get_zstr_padded = (fun pad -> get_zstr_padded (Some pad)); + asm_get_off = (fun _ -> !off); + asm_adv = bump; + asm_adv_u32 = (fun _ -> bump 4); + asm_adv_u16 = (fun _ -> bump 2); + asm_adv_u8 = (fun _ -> bump 1); + asm_adv_zstr = (fun _ -> while arr.{!off} != 0 + do incr off done); + asm_close = (fun _ -> + assert (!is_open); + Unix.close fd; + is_open := false) + } +;; + + +(* + * Metadata note-section encoding / decoding. + * + * Since the only object format that defines a "note" section at all is + * ELF, we model the contents of the metadata section on ELF's + * notes. But the same blob of data is stuck into PE and Mach-O files + * too. + * + * The format is essentially just the ELF note format: + * + * + * + * + * + * <0-pad to 4-byte boundary> + * + * + * ... + * + * <0-pad to 4-byte boundary> + * + *) +let note_rust_frags (meta:(Ast.ident * string) array) : frag = + let desc_fixup = new_fixup ".rust.note metadata" in + let desc = + DEF (desc_fixup, + SEQ [| + WORD (TY_u32, IMM (Int64.of_int (Array.length meta))); + SEQ (Array.map + (fun (k,v) -> SEQ [| ZSTRING k; ZSTRING v; |]) + meta); + ALIGN_FILE (4, MARK) |]) + in + let name = "rust" in + let ty = 0L in + let padded_name = SEQ [| ZSTRING name; + ALIGN_FILE (4, MARK) |] + in + let name_sz = IMM (Int64.of_int ((String.length name) + 1)) in + SEQ [| WORD (TY_u32, name_sz); + WORD (TY_u32, F_SZ desc_fixup); + WORD (TY_u32, IMM ty); + padded_name; + desc;|] +;; + +let read_rust_note (ar:asm_reader) : (Ast.ident * string) array = + ar.asm_adv_u32 (); + ar.asm_adv_u32 (); + assert ((ar.asm_get_u32 ()) = 0); + let rust_name = ar.asm_get_zstr_padded 8 in + assert (rust_name = "rust"); + let n = ar.asm_get_u32() in + let meta = Queue.create () in + for i = 1 to n + do + let k = ar.asm_get_zstr() in + let v = ar.asm_get_zstr() in + Queue.add (k,v) meta + done; + queue_to_arr meta +;; + +(* + * Local Variables: + * fill-column: 78; + * indent-tabs-mode: nil + * buffer-file-coding-system: utf-8-unix + * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'"; + * End: + *) diff --git a/src/boot/be/elf.ml b/src/boot/be/elf.ml new file mode 100644 index 00000000..56905b2a --- /dev/null +++ b/src/boot/be/elf.ml @@ -0,0 +1,1760 @@ +(* + * Module for writing System V ELF files. + * + * FIXME: Presently heavily infected with x86 and elf32 specificities, + * though they are reasonably well marked. Needs to be refactored to + * depend on abi fields if it's to be usable for other elf + * configurations. + *) + +open Asm;; +open Common;; + +let log (sess:Session.sess) = + Session.log "obj (elf)" + sess.Session.sess_log_obj + sess.Session.sess_log_out +;; + +let iflog (sess:Session.sess) (thunk:(unit -> unit)) : unit = + if sess.Session.sess_log_obj + then thunk () + else () +;; + + +(* Fixed sizes of structs involved in elf32 spec. *) +let elf32_ehsize = 52L;; +let elf32_phentsize = 32L;; +let elf32_shentsize = 40L;; +let elf32_symsize = 16L;; +let elf32_rela_entsz = 0xcL;; + +type ei_class = + ELFCLASSNONE + | ELFCLASS32 + | ELFCLASS64 +;; + + +type ei_data = + ELFDATANONE + | ELFDATA2LSB + | ELFDATA2MSB +;; + + +let elf_identification ei_class ei_data = + SEQ + [| + STRING "\x7fELF"; + BYTES + [| + (match ei_class with (* EI_CLASS *) + ELFCLASSNONE -> 0 + | ELFCLASS32 -> 1 + | ELFCLASS64 -> 2); + (match ei_data with (* EI_DATA *) + ELFDATANONE -> 0 + | ELFDATA2LSB -> 1 + | ELFDATA2MSB -> 2); + 1; (* EI_VERSION = EV_CURRENT *) + 0; (* EI_PAD #7 *) + 0; (* EI_PAD #8 *) + 0; (* EI_PAD #9 *) + 0; (* EI_PAD #A *) + 0; (* EI_PAD #B *) + 0; (* EI_PAD #C *) + 0; (* EI_PAD #D *) + 0; (* EI_PAD #E *) + 0; (* EI_PAD #F *) + |] + |] +;; + + +type e_type = + ET_NONE + | ET_REL + | ET_EXEC + | ET_DYN + | ET_CORE +;; + + +type e_machine = + (* Maybe support more later. *) + EM_NONE + | EM_386 + | EM_X86_64 +;; + + +type e_version = + EV_NONE + | EV_CURRENT +;; + + +let elf32_header + ~(sess:Session.sess) + ~(ei_data:ei_data) + ~(e_type:e_type) + ~(e_machine:e_machine) + ~(e_version:e_version) + ~(e_entry_fixup:fixup) + ~(e_phoff_fixup:fixup) + ~(e_shoff_fixup:fixup) + ~(e_phnum:int64) + ~(e_shnum:int64) + ~(e_shstrndx:int64) + : frag = + let elf_header_fixup = new_fixup "elf header" in + let entry_pos = + if sess.Session.sess_library_mode + then (IMM 0L) + else (M_POS e_entry_fixup) + in + DEF + (elf_header_fixup, + SEQ [| elf_identification ELFCLASS32 ei_data; + WORD (TY_u16, (IMM (match e_type with + ET_NONE -> 0L + | ET_REL -> 1L + | ET_EXEC -> 2L + | ET_DYN -> 3L + | ET_CORE -> 4L))); + WORD (TY_u16, (IMM (match e_machine with + EM_NONE -> 0L + | EM_386 -> 3L + | EM_X86_64 -> 62L))); + WORD (TY_u32, (IMM (match e_version with + EV_NONE -> 0L + | EV_CURRENT -> 1L))); + WORD (TY_u32, entry_pos); + WORD (TY_u32, (F_POS e_phoff_fixup)); + WORD (TY_u32, (F_POS e_shoff_fixup)); + WORD (TY_u32, (IMM 0L)); (* e_flags *) + WORD (TY_u16, (IMM elf32_ehsize)); + WORD (TY_u16, (IMM elf32_phentsize)); + WORD (TY_u16, (IMM e_phnum)); + WORD (TY_u16, (IMM elf32_shentsize)); + WORD (TY_u16, (IMM e_shnum)); + WORD (TY_u16, (IMM e_shstrndx)); + |]) +;; + + +type sh_type = + SHT_NULL + | SHT_PROGBITS + | SHT_SYMTAB + | SHT_STRTAB + | SHT_RELA + | SHT_HASH + | SHT_DYNAMIC + | SHT_NOTE + | SHT_NOBITS + | SHT_REL + | SHT_SHLIB + | SHT_DYNSYM +;; + + +type sh_flags = + SHF_WRITE + | SHF_ALLOC + | SHF_EXECINSTR +;; + + +let section_header + ~(shstring_table_fixup:fixup) + ~(shname_string_fixup:fixup) + ~(sh_type:sh_type) + ~(sh_flags:sh_flags list) + ~(section_fixup:fixup option) + ~(sh_addralign:int64) + ~(sh_entsize:int64) + ~(sh_link:int64 option) + : frag = + SEQ + [| + WORD (TY_i32, (SUB + ((F_POS shname_string_fixup), + (F_POS shstring_table_fixup)))); + WORD (TY_u32, (IMM (match sh_type with + SHT_NULL -> 0L + | SHT_PROGBITS -> 1L + | SHT_SYMTAB -> 2L + | SHT_STRTAB -> 3L + | SHT_RELA -> 4L + | SHT_HASH -> 5L + | SHT_DYNAMIC -> 6L + | SHT_NOTE -> 7L + | SHT_NOBITS -> 8L + | SHT_REL -> 9L + | SHT_SHLIB -> 10L + | SHT_DYNSYM -> 11L))); + WORD (TY_u32, (IMM (fold_flags + (fun f -> match f with + SHF_WRITE -> 0x1L + | SHF_ALLOC -> 0x2L + | SHF_EXECINSTR -> 0x4L) sh_flags))); + WORD (TY_u32, (match section_fixup with + None -> (IMM 0L) + | Some s -> (M_POS s))); + WORD (TY_u32, (match section_fixup with + None -> (IMM 0L) + | Some s -> (F_POS s))); + WORD (TY_u32, (match section_fixup with + None -> (IMM 0L) + | Some s -> (F_SZ s))); + WORD (TY_u32, (IMM (match sh_link with + None -> 0L + | Some i -> i))); + WORD (TY_u32, (IMM 0L)); (* sh_info *) + WORD (TY_u32, (IMM sh_addralign)); + WORD (TY_u32, (IMM sh_entsize)); + |] +;; + + +type p_type = + PT_NULL + | PT_LOAD + | PT_DYNAMIC + | PT_INTERP + | PT_NOTE + | PT_SHLIB + | PT_PHDR +;; + + +type p_flag = + PF_X + | PF_W + | PF_R +;; + + +let program_header + ~(p_type:p_type) + ~(segment_fixup:fixup) + ~(p_flags:p_flag list) + ~(p_align:int64) + : frag = + SEQ + [| + WORD (TY_u32, (IMM (match p_type with + PT_NULL -> 0L + | PT_LOAD -> 1L + | PT_DYNAMIC -> 2L + | PT_INTERP -> 3L + | PT_NOTE -> 4L + | PT_SHLIB -> 5L + | PT_PHDR -> 6L))); + WORD (TY_u32, (F_POS segment_fixup)); + WORD (TY_u32, (M_POS segment_fixup)); + WORD (TY_u32, (M_POS segment_fixup)); + WORD (TY_u32, (F_SZ segment_fixup)); + WORD (TY_u32, (M_SZ segment_fixup)); + WORD (TY_u32, (IMM (fold_flags + (fun f -> + match f with + PF_X -> 0x1L + | PF_W -> 0x2L + | PF_R -> 0x4L) + p_flags))); + WORD (TY_u32, (IMM p_align)); + |] +;; + + +type st_bind = + STB_LOCAL + | STB_GLOBAL + | STB_WEAK +;; + + +type st_type = + STT_NOTYPE + | STT_OBJECT + | STT_FUNC + | STT_SECTION + | STT_FILE +;; + + +(* Special symbol-section indices *) +let shn_UNDEF = 0L;; +let shn_ABS = 0xfff1L;; +let shn_ABS = 0xfff2L;; + + +let symbol + ~(string_table_fixup:fixup) + ~(name_string_fixup:fixup) + ~(sym_target_fixup:fixup option) + ~(st_bind:st_bind) + ~(st_type:st_type) + ~(st_shndx:int64) + : frag = + let st_bind_num = + match st_bind with + STB_LOCAL -> 0L + | STB_GLOBAL -> 1L + | STB_WEAK -> 2L + in + let st_type_num = + match st_type with + STT_NOTYPE -> 0L + | STT_OBJECT -> 1L + | STT_FUNC -> 2L + | STT_SECTION -> 3L + | STT_FILE -> 4L + in + SEQ + [| + WORD (TY_u32, (SUB + ((F_POS name_string_fixup), + (F_POS string_table_fixup)))); + WORD (TY_u32, (match sym_target_fixup with + None -> (IMM 0L) + | Some f -> (M_POS f))); + WORD (TY_u32, (match sym_target_fixup with + None -> (IMM 0L) + | Some f -> (M_SZ f))); + WORD (TY_u8, (* st_info *) + (OR + ((SLL ((IMM st_bind_num), 4)), + (AND ((IMM st_type_num), (IMM 0xfL)))))); + WORD (TY_u8, (IMM 0L)); (* st_other *) + WORD (TY_u16, (IMM st_shndx)); + |] +;; + +type d_tag = + DT_NULL + | DT_NEEDED + | DT_PLTRELSZ + | DT_PLTGOT + | DT_HASH + | DT_STRTAB + | DT_SYMTAB + | DT_RELA + | DT_RELASZ + | DT_RELAENT + | DT_STRSZ + | DT_SYMENT + | DT_INIT + | DT_FINI + | DT_SONAME + | DT_RPATH + | DT_SYMBOLIC + | DT_REL + | DT_RELSZ + | DT_RELENT + | DT_PLTREL + | DT_DEBUG + | DT_TEXTREL + | DT_JMPREL + | DT_BIND_NOW + | DT_INIT_ARRAY + | DT_FINI_ARRAY + | DT_INIT_ARRAYSZ + | DT_FINI_ARRAYSZ + | DT_RUNPATH + | DT_FLAGS + | DT_ENCODING + | DT_PREINIT_ARRAY + | DT_PREINIT_ARRAYSZ +;; + +type elf32_dyn = (d_tag * expr64);; + +let elf32_num_of_dyn_tag tag = + match tag with + DT_NULL -> 0L + | DT_NEEDED -> 1L + | DT_PLTRELSZ -> 2L + | DT_PLTGOT -> 3L + | DT_HASH -> 4L + | DT_STRTAB -> 5L + | DT_SYMTAB -> 6L + | DT_RELA -> 7L + | DT_RELASZ -> 8L + | DT_RELAENT -> 9L + | DT_STRSZ -> 10L + | DT_SYMENT -> 11L + | DT_INIT -> 12L + | DT_FINI -> 13L + | DT_SONAME -> 14L + | DT_RPATH -> 15L + | DT_SYMBOLIC -> 16L + | DT_REL -> 17L + | DT_RELSZ -> 18L + | DT_RELENT -> 19L + | DT_PLTREL -> 20L + | DT_DEBUG -> 21L + | DT_TEXTREL -> 22L + | DT_JMPREL -> 23L + | DT_BIND_NOW -> 24L + | DT_INIT_ARRAY -> 25L + | DT_FINI_ARRAY -> 26L + | DT_INIT_ARRAYSZ -> 27L + | DT_FINI_ARRAYSZ -> 28L + | DT_RUNPATH -> 29L + | DT_FLAGS -> 30L + | DT_ENCODING -> 31L + | DT_PREINIT_ARRAY -> 32L + | DT_PREINIT_ARRAYSZ -> 33L +;; + +let elf32_dyn_frag d = + let (tag, expr) = d in + let tagval = elf32_num_of_dyn_tag tag in + SEQ [| WORD (TY_u32, (IMM tagval)); WORD (TY_u32, expr) |] +;; + +type elf32_386_reloc_type = + R_386_NONE + | R_386_32 + | R_386_PC32 + | R_386_GOT32 + | R_386_PLT32 + | R_386_COPY + | R_386_GLOB_DAT + | R_386_JMP_SLOT + | R_386_RELATIVE + | R_386_GOTOFF + | R_386_GOTPC +;; + + +type elf32_386_rela = + { elf32_386_rela_type: elf32_386_reloc_type; + elf32_386_rela_offset: expr64; + elf32_386_rela_sym: expr64; + elf32_386_rela_addend: expr64 } +;; + +let elf32_386_rela_frag r = + let type_val = + match r.elf32_386_rela_type with + R_386_NONE -> 0L + | R_386_32 -> 1L + | R_386_PC32 -> 2L + | R_386_GOT32 -> 3L + | R_386_PLT32 -> 4L + | R_386_COPY -> 5L + | R_386_GLOB_DAT -> 6L + | R_386_JMP_SLOT -> 7L + | R_386_RELATIVE -> 8L + | R_386_GOTOFF -> 9L + | R_386_GOTPC -> 10L + in + let info_expr = + WORD (TY_u32, + (OR + (SLL ((r.elf32_386_rela_sym), 8), + AND ((IMM 0xffL), (IMM type_val))))) + in + SEQ [| WORD (TY_u32, r.elf32_386_rela_offset); + info_expr; + WORD (TY_u32, r.elf32_386_rela_addend) |] +;; + + +let elf32_linux_x86_file + ~(sess:Session.sess) + ~(crate:Ast.crate) + ~(entry_name:string) + ~(text_frags:(string option, frag) Hashtbl.t) + ~(data_frags:(string option, frag) Hashtbl.t) + ~(rodata_frags:(string option, frag) Hashtbl.t) + ~(required_fixups:(string, fixup) Hashtbl.t) + ~(dwarf:Dwarf.debug_records) + ~(sem:Semant.ctxt) + ~(needed_libs:string array) + : frag = + + (* Procedure Linkage Tables (PLTs), Global Offset Tables + * (GOTs), and the relocations that set them up: + * + * The PLT goes in a section called .plt and GOT in a section called + * .got. The portion of the GOT that holds PLT jump slots goes in a + * section called .got.plt. Dynamic relocations for these jump slots go in + * section .rela.plt. + * + * The easiest way to understand the PLT/GOT system is to draw it: + * + * PLT GOT + * +----------------------+ +----------------------+ + * 0| push & 0| + * | jmp *GOT[2] 1| + * | 2| & + * 1| jmp *GOT[3] 3| & <'push 0' in PLT[1]> + * | push 0 4| & <'push 1' in PLT[2]> + * | jmp *PLT[0] 5| & <'push 2' in PLT[3]> + * | + * 2| jmp *GOT[4] + * | push 1 + * | jmp *PLT[0] + * | + * 2| jmp *GOT[5] + * | push 2 + * | jmp *PLT[0] + * + * + * In normal user code, we call PLT entries with a call to a + * PC-relative address, the PLT entry, which itself does an indirect + * jump through a slot in the GOT that it also addresses + * PC-relative. This makes the whole scheme PIC. + * + * The linker fills in the GOT on startup. For the first 3, it uses + * its own thinking. For the remainder it needs to be instructed to + * fill them in with "jump slot relocs", type R_386_JUMP_SLOT, each + * of which says in effect which PLT entry it's to point back to and + * which symbol it's to be resolved to later. These relocs go in the + * section .rela.plt. + *) + + let plt0_fixup = new_fixup "PLT[0]" in + let got_prefix = SEQ [| WORD (TY_u32, (IMM 0L)); + WORD (TY_u32, (IMM 0L)); + WORD (TY_u32, (IMM 0L)); |] + in + + let got_cell reg i = + let got_entry_off = Int64.of_int (i*4) in + let got_entry_mem = Il.RegIn (reg, (Some (Asm.IMM got_entry_off))) in + Il.Mem (got_entry_mem, Il.ScalarTy (Il.AddrTy Il.CodeTy)) + in + + let got_code_cell reg i = + Il.CodePtr (Il.Cell (got_cell reg i)) + in + + let plt0_frag = + let reg = Il.Hreg X86.eax in + let e = X86.new_emitter_without_vregs () in + Il.emit e (Il.Push (Il.Cell (got_cell reg 1))); + Il.emit e (Il.jmp Il.JMP (got_code_cell reg 2)); + Il.emit e Il.Nop; + Il.emit e Il.Nop; + Il.emit e Il.Nop; + Il.emit e Il.Nop; + DEF (plt0_fixup, (X86.frags_of_emitted_quads sess e)) + in + + (* + * The existence of the GOT/PLT mish-mash causes, therefore, the + * following new sections: + * + * .plt - the PLT itself, in the r/x text segment + * .got.plt - the PLT-used portion of the GOT, in the r/w segment + * .rela.plt - the dynamic relocs for the GOT-PLT, in the r/x segment + * + * In addition, because we're starting up a dynamically linked executable, + * we have to have several more sections! + * + * .interp - the read-only section that names ld.so + * .dynsym - symbols named by the PLT/GOT entries, r/x segment + * .dynstr - string-names used in those symbols, r/x segment + * .hash - hashtable in which to look these up, r/x segment + * .dynamic - the machine-readable description of the dynamic + * linkage requirements of this elf file, in the + * r/w _DYNAMIC segment + * + * The Dynamic section contains a sequence of 2-word records of type + * d_tag. + * + *) + + (* There are 17 official section headers in the file we're making: *) + (* *) + (* section 0: *) + (* *) + (* section 1: .interp (segment 1: R+X, INTERP) *) + (* *) + (* section 2: .text (segment 2: R+X, LOAD) *) + (* section 3: .rodata ... *) + (* section 4: .dynsym ... *) + (* section 5: .dynstr ... *) + (* section 6: .hash ... *) + (* section 7: .plt ... *) + (* section 8: .got ... *) + (* section 9: .rela.plt ... *) + (* *) + (* section 10: .data (segment 3: R+W, LOAD) *) + (* section 11: .bss ... *) + (* *) + (* section 12: .dynamic (segment 4: R+W, DYNAMIC) *) + (* *) + (* section 13: .shstrtab (not in a segment) *) + (* section 14: .debug_aranges (segment 2: cont'd) *) + (* section 15: .debug_pubnames ... *) + (* section 14: .debug_info ... *) + (* section 15: .debug_abbrev ... *) + (* section 14: .debug_line ... *) + (* section 15: .debug_frame ... *) + (* section 16: .note..rust (segment 5: NOTE) *) + + let sname s = + new_fixup (Printf.sprintf "string name of '%s' section" s) + in + let null_section_name_fixup = sname "" in + let interp_section_name_fixup = sname ".interp"in + let text_section_name_fixup = sname ".text" in + let rodata_section_name_fixup = sname ".rodata" in + let dynsym_section_name_fixup = sname ".dynsym" in + let dynstr_section_name_fixup = sname ".dynstr" in + let hash_section_name_fixup = sname ".hash" in + let plt_section_name_fixup = sname ".plt" in + let got_plt_section_name_fixup = sname ".got.plt" in + let rela_plt_section_name_fixup = sname ".rela.plt" in + let data_section_name_fixup = sname ".data" in + let bss_section_name_fixup = sname ".bss" in + let dynamic_section_name_fixup = sname ".dynamic" in + let shstrtab_section_name_fixup = sname ".shstrtab" in + let debug_aranges_section_name_fixup = sname ".debug_aranges" in + let debug_pubnames_section_name_fixup = sname ".debug_pubnames" in + let debug_info_section_name_fixup = sname ".debug_info" in + let debug_abbrev_section_name_fixup = sname ".debug_abbrev" in + let debug_line_section_name_fixup = sname ".debug_line" in + let debug_frame_section_name_fixup = sname ".debug_frame" in + let note_rust_section_name_fixup = sname ".note.rust" in + + (* let interpndx = 1L in *) (* Section index of .interp *) + let textndx = 2L in (* Section index of .text *) + let rodatandx = 3L in (* Section index of .rodata *) + let dynsymndx = 4L in (* Section index of .dynsym *) + let dynstrndx = 5L in (* Section index of .dynstr *) + (* let hashndx = 6L in *) (* Section index of .hash *) + (* let pltndx = 7L in *) (* Section index of .plt *) + (* let gotpltndx = 8L in *) (* Section index of .got.plt *) + (* let relapltndx = 9L in *) (* Section index of .rela.plt *) + let datandx = 10L in (* Section index of .data *) + (* let bssndx = 11L in *) (* Section index of .bss *) + (* let dynamicndx = 12L in *) (* Section index of .dynamic *) + let shstrtabndx = 13L in (* Section index of .shstrtab *) + + let section_header_table_fixup = new_fixup ".section header table" in + let interp_section_fixup = new_fixup ".interp section" in + let text_section_fixup = new_fixup ".text section" in + let rodata_section_fixup = new_fixup ".rodata section" in + let dynsym_section_fixup = new_fixup ".dynsym section" in + let dynstr_section_fixup = new_fixup ".dynstr section" in + let hash_section_fixup = new_fixup ".hash section" in + let plt_section_fixup = new_fixup ".plt section" in + let got_plt_section_fixup = new_fixup ".got.plt section" in + let rela_plt_section_fixup = new_fixup ".rela.plt section" in + let data_section_fixup = new_fixup ".data section" in + let bss_section_fixup = new_fixup ".bss section" in + let dynamic_section_fixup = new_fixup ".dynamic section" in + let shstrtab_section_fixup = new_fixup ".shstrtab section" in + let note_rust_section_fixup = new_fixup ".shstrtab section" in + + let shstrtab_section = + SEQ + [| + DEF (null_section_name_fixup, ZSTRING ""); + DEF (interp_section_name_fixup, ZSTRING ".interp"); + DEF (text_section_name_fixup, ZSTRING ".text"); + DEF (rodata_section_name_fixup, ZSTRING ".rodata"); + DEF (dynsym_section_name_fixup, ZSTRING ".dynsym"); + DEF (dynstr_section_name_fixup, ZSTRING ".dynstr"); + DEF (hash_section_name_fixup, ZSTRING ".hash"); + DEF (plt_section_name_fixup, ZSTRING ".plt"); + DEF (got_plt_section_name_fixup, ZSTRING ".got.plt"); + DEF (rela_plt_section_name_fixup, ZSTRING ".rela.plt"); + DEF (data_section_name_fixup, ZSTRING ".data"); + DEF (bss_section_name_fixup, ZSTRING ".bss"); + DEF (dynamic_section_name_fixup, ZSTRING ".dynamic"); + DEF (shstrtab_section_name_fixup, ZSTRING ".shstrtab"); + DEF (debug_aranges_section_name_fixup, ZSTRING ".debug_aranges"); + DEF (debug_pubnames_section_name_fixup, ZSTRING ".debug_pubnames"); + DEF (debug_info_section_name_fixup, ZSTRING ".debug_info"); + DEF (debug_abbrev_section_name_fixup, ZSTRING ".debug_abbrev"); + DEF (debug_line_section_name_fixup, ZSTRING ".debug_line"); + DEF (debug_frame_section_name_fixup, ZSTRING ".debug_frame"); + DEF (note_rust_section_name_fixup, ZSTRING ".note.rust"); + |] + in + + let section_headers = + [| + (* *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: null_section_name_fixup + ~sh_type: SHT_NULL + ~sh_flags: [] + ~section_fixup: None + ~sh_addralign: 0L + ~sh_entsize: 0L + ~sh_link: None); + + (* .interp *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: interp_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some interp_section_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + + (* .text *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: text_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ] + ~section_fixup: (Some text_section_fixup) + ~sh_addralign: 32L + ~sh_entsize: 0L + ~sh_link: None); + + (* .rodata *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: rodata_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some rodata_section_fixup) + ~sh_addralign: 32L + ~sh_entsize: 0L + ~sh_link: None); + + (* .dynsym *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: dynsym_section_name_fixup + ~sh_type: SHT_DYNSYM + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some dynsym_section_fixup) + ~sh_addralign: 8L + ~sh_entsize: elf32_symsize + ~sh_link: (Some dynstrndx) ); + + (* .dynstr *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: dynstr_section_name_fixup + ~sh_type: SHT_STRTAB + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some dynstr_section_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + + (* .hash *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: hash_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some hash_section_fixup) + ~sh_addralign: 4L + ~sh_entsize: 4L + ~sh_link: (Some dynsymndx)); + + (* .plt *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: plt_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC; SHF_EXECINSTR ] + ~section_fixup: (Some plt_section_fixup) + ~sh_addralign: 4L + ~sh_entsize: 0L + ~sh_link: None); + + (* .got.plt *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: got_plt_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] + ~section_fixup: (Some got_plt_section_fixup) + ~sh_addralign: 4L + ~sh_entsize: 0L + ~sh_link: None); + + (* .rela.plt *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: rela_plt_section_name_fixup + ~sh_type: SHT_RELA + ~sh_flags: [ SHF_ALLOC ] + ~section_fixup: (Some rela_plt_section_fixup) + ~sh_addralign: 4L + ~sh_entsize: elf32_rela_entsz + ~sh_link: (Some dynsymndx)); + + (* .data *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: data_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] + ~section_fixup: (Some data_section_fixup) + ~sh_addralign: 32L + ~sh_entsize: 0L + ~sh_link: None); + + (* .bss *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: bss_section_name_fixup + ~sh_type: SHT_NOBITS + ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] + ~section_fixup: (Some bss_section_fixup) + ~sh_addralign: 32L + ~sh_entsize: 0L + ~sh_link: None); + + (* .dynamic *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: dynamic_section_name_fixup + ~sh_type: SHT_DYNAMIC + ~sh_flags: [ SHF_ALLOC; SHF_WRITE ] + ~section_fixup: (Some dynamic_section_fixup) + ~sh_addralign: 8L + ~sh_entsize: 0L + ~sh_link: None); + + (* .shstrtab *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: shstrtab_section_name_fixup + ~sh_type: SHT_STRTAB + ~sh_flags: [] + ~section_fixup: (Some shstrtab_section_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + +(* + FIXME: uncomment the dwarf section headers as you make use of them; + recent gdb versions have got fussier about parsing dwarf and don't + like seeing junk there. +*) + + (* .debug_aranges *) +(* + + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_aranges_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_aranges_fixup) + ~sh_addralign: 8L + ~sh_entsize: 0L + ~sh_link: None); +*) + (* .debug_pubnames *) +(* + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_pubnames_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_pubnames_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); +*) + + (* .debug_info *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_info_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_info_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + + (* .debug_abbrev *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_abbrev_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_abbrev_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + (* .debug_line *) +(* + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_line_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_line_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); +*) + + (* .debug_frame *) +(* + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: debug_frame_section_name_fixup + ~sh_type: SHT_PROGBITS + ~sh_flags: [] + ~section_fixup: (Some sem.Semant.ctxt_debug_frame_fixup) + ~sh_addralign: 4L + ~sh_entsize: 0L + ~sh_link: None); +*) + + (* .note.rust *) + (section_header + ~shstring_table_fixup: shstrtab_section_fixup + ~shname_string_fixup: note_rust_section_name_fixup + ~sh_type: SHT_NOTE + ~sh_flags: [] + ~section_fixup: (Some note_rust_section_fixup) + ~sh_addralign: 1L + ~sh_entsize: 0L + ~sh_link: None); + + |] + in + let section_header_table = SEQ section_headers in + + + (* There are 6 official program headers in the file we're making: *) + (* segment 0: RX / PHDR *) + (* segment 1: R / INTERP *) + (* segment 2: RX / LOAD *) + (* segment 3: RW / LOAD *) + (* segment 4: RW / DYNAMIC *) + (* segment 5: R *) + + let program_header_table_fixup = new_fixup "program header table" in + let segment_0_fixup = new_fixup "segment 0" in + let segment_1_fixup = new_fixup "segment 1" in + let segment_2_fixup = new_fixup "segment 2" in + let segment_3_fixup = new_fixup "segment 3" in + let segment_4_fixup = new_fixup "segment 4" in + let segment_5_fixup = new_fixup "segment 5" in + + let segment_0_align = 4 in + let segment_1_align = 1 in + let segment_2_align = 0x1000 in + let segment_3_align = 0x1000 in + let segment_4_align = 0x1000 in + let segment_5_align = 1 in + + let program_headers = [| + (program_header + ~p_type: PT_PHDR + ~segment_fixup: segment_0_fixup + ~p_flags: [ PF_R; PF_X ] + ~p_align: (Int64.of_int segment_0_align)); + (program_header + ~p_type: PT_INTERP + ~segment_fixup: segment_1_fixup + ~p_flags: [ PF_R ] + ~p_align: (Int64.of_int segment_1_align)); + (program_header + ~p_type: PT_LOAD + ~segment_fixup: segment_2_fixup + ~p_flags: [ PF_R; PF_X ] + ~p_align: (Int64.of_int segment_2_align)); + (program_header + ~p_type: PT_LOAD + ~segment_fixup: segment_3_fixup + ~p_flags: [ PF_R; PF_W ] + ~p_align: (Int64.of_int segment_3_align)); + (program_header + ~p_type: PT_DYNAMIC + ~segment_fixup: segment_4_fixup + ~p_flags: [ PF_R; PF_W ] + ~p_align: (Int64.of_int segment_4_align)); + (program_header + ~p_type: PT_NOTE + ~segment_fixup: segment_5_fixup + ~p_flags: [ PF_R;] + ~p_align: (Int64.of_int segment_5_align)); + |] + in + let program_header_table = SEQ program_headers in + + let e_entry_fixup = new_fixup "entry symbol" in + + let elf_header = + elf32_header + ~sess + ~ei_data: ELFDATA2LSB + ~e_type: ET_DYN + ~e_machine: EM_386 + ~e_version: EV_CURRENT + + ~e_entry_fixup: e_entry_fixup + ~e_phoff_fixup: program_header_table_fixup + ~e_shoff_fixup: section_header_table_fixup + ~e_phnum: (Int64.of_int (Array.length program_headers)) + ~e_shnum: (Int64.of_int (Array.length section_headers)) + ~e_shstrndx: shstrtabndx + in + + let n_syms = ref 1 in (* The empty symbol, implicit. *) + + let data_sym name st_bind fixup = + let name_fixup = new_fixup ("data symbol name fixup: '" ^ name ^ "'") in + let strtab_entry = DEF (name_fixup, ZSTRING name) in + let symtab_entry = + symbol + ~string_table_fixup: dynstr_section_fixup + ~name_string_fixup: name_fixup + ~sym_target_fixup: (Some fixup) + ~st_bind + ~st_type: STT_OBJECT + ~st_shndx: datandx + in + incr n_syms; + (strtab_entry, symtab_entry) + in + + let rodata_sym name st_bind fixup = + let name_fixup = new_fixup ("rodata symbol name fixup: '" ^ name ^ "'") in + let strtab_entry = DEF (name_fixup, ZSTRING name) in + let symtab_entry = + symbol + ~string_table_fixup: dynstr_section_fixup + ~name_string_fixup: name_fixup + ~sym_target_fixup: (Some fixup) + ~st_bind + ~st_type: STT_OBJECT + ~st_shndx: rodatandx + in + incr n_syms; + (strtab_entry, symtab_entry) + in + + let text_sym name st_bind fixup = + let name_fixup = new_fixup ("text symbol name fixup: '" ^ name ^ "'") in + let strtab_frag = DEF (name_fixup, ZSTRING name) in + let symtab_frag = + symbol + ~string_table_fixup: dynstr_section_fixup + ~name_string_fixup: name_fixup + ~sym_target_fixup: (Some fixup) + ~st_bind: st_bind + ~st_type: STT_FUNC + ~st_shndx: textndx + in + incr n_syms; + (strtab_frag, symtab_frag) + in + + let require_sym name st_bind _(*fixup*) = + let name_fixup = + new_fixup ("require symbol name fixup: '" ^ name ^ "'") + in + let strtab_frag = DEF (name_fixup, ZSTRING name) in + let symtab_frag = + symbol + ~string_table_fixup: dynstr_section_fixup + ~name_string_fixup: name_fixup + ~sym_target_fixup: None + ~st_bind + ~st_type: STT_FUNC + ~st_shndx: shn_UNDEF + in + incr n_syms; + (strtab_frag, symtab_frag) + in + + let frags_of_symbol sym_emitter st_bind symname_opt symbody x = + let (strtab_frags, symtab_frags, body_frags) = x in + let (strtab_frag, symtab_frag, body_frag) = + match symname_opt with + None -> (MARK, MARK, symbody) + | Some symname -> + let body_fixup = + new_fixup ("symbol body fixup: '" ^ symname ^ "'") + in + let body = + if symname = entry_name + then DEF (e_entry_fixup, DEF (body_fixup, symbody)) + else DEF (body_fixup, symbody) + in + let (str, sym) = sym_emitter symname st_bind body_fixup in + (str, sym, body) + in + ((strtab_frag :: strtab_frags), + (symtab_frag :: symtab_frags), + (body_frag :: body_frags)) + in + + let frags_of_require_symbol sym_emitter st_bind symname plt_entry_fixup x = + let (i, strtab_frags, symtab_frags, + plt_frags, got_plt_frags, rela_plt_frags) = x in + let (strtab_frag, symtab_frag) = sym_emitter symname st_bind None in + let e = X86.new_emitter_without_vregs () in + let jump_slot_fixup = new_fixup ("jump slot #" ^ string_of_int i) in + let jump_slot_initial_target_fixup = + new_fixup ("jump slot #" ^ string_of_int i ^ " initial target") in + + (* You may notice this PLT entry doesn't look like either of the + * types of "normal" PLT entries outlined in the ELF manual. It is, + * however, just what you get when you combine a PIC PLT entry with + * inline calls to the horrible __i686.get_pc_thunk.ax kludge used + * on x86 to support entering PIC PLTs. We're just doing it *in* + * the PLT entries rather than infecting all the callers with the + * obligation of having the GOT address in a register on + * PLT-entry. + *) + + let plt_frag = + let (reg, _, _) = X86.get_next_pc_thunk in + + Il.emit_full e (Some plt_entry_fixup) [] Il.Dead; + + Abi.load_fixup_addr e reg got_plt_section_fixup Il.CodeTy; + + Il.emit e (Il.jmp Il.JMP (got_code_cell reg (2+i))); + + Il.emit_full e (Some jump_slot_initial_target_fixup) + [] (Il.Push (X86.immi (Int64.of_int i))); + + Il.emit e (Il.jmp Il.JMP (Il.direct_code_ptr plt0_fixup)); + X86.frags_of_emitted_quads sess e + in + let got_plt_frag = + DEF (jump_slot_fixup, + WORD (TY_u32, (M_POS jump_slot_initial_target_fixup))) + in + let rela_plt = + { elf32_386_rela_type = R_386_JMP_SLOT; + elf32_386_rela_offset = (M_POS jump_slot_fixup); + elf32_386_rela_sym = (IMM (Int64.of_int i)); + elf32_386_rela_addend = (IMM 0L) } + in + let rela_plt_frag = elf32_386_rela_frag rela_plt in + (i+1, + (strtab_frag :: strtab_frags), + (symtab_frag :: symtab_frags), + (plt_frag :: plt_frags), + (got_plt_frag :: got_plt_frags), + (rela_plt_frag :: rela_plt_frags)) + in + + (* Emit text export symbols. *) + let (global_text_strtab_frags, global_text_symtab_frags) = + match htab_search sem.Semant.ctxt_native_provided SEG_text with + None -> ([], []) + | Some etab -> + Hashtbl.fold + begin + fun name fix x -> + let (strtab_frags, symtab_frags) = x in + let (str, sym) = text_sym name STB_GLOBAL fix in + (str :: strtab_frags, + sym :: symtab_frags) + end + etab + ([],[]) + in + + (* Emit text fragments (possibly named). *) + let (global_text_strtab_frags, + global_text_symtab_frags, + text_body_frags) = + Hashtbl.fold + (frags_of_symbol text_sym STB_GLOBAL) + text_frags + (global_text_strtab_frags, global_text_symtab_frags, []) + in + + let (local_text_strtab_frags, + local_text_symtab_frags) = + + let symbol_frags_of_code _ code accum = + let (strtab_frags, symtab_frags) = accum in + let fix = code.Semant.code_fixup in + let (strtab_frag, symtab_frag) = + text_sym fix.fixup_name STB_LOCAL fix + in + (strtab_frag :: strtab_frags, + symtab_frag :: symtab_frags) + in + + let symbol_frags_of_glue_code g code accum = + let (strtab_frags, symtab_frags) = accum in + let fix = code.Semant.code_fixup in + let (strtab_frag, symtab_frag) = + text_sym (Semant.glue_str sem g) STB_LOCAL fix + in + (strtab_frag :: strtab_frags, + symtab_frag :: symtab_frags) + in + + let item_str_frags, item_sym_frags = + Hashtbl.fold symbol_frags_of_code + sem.Semant.ctxt_all_item_code ([], []) + in + let glue_str_frags, glue_sym_frags = + Hashtbl.fold symbol_frags_of_glue_code + sem.Semant.ctxt_glue_code ([], []) + in + (item_str_frags @ glue_str_frags, + item_sym_frags @ glue_sym_frags) + in + + (* Emit rodata export symbols. *) + let (rodata_strtab_frags, rodata_symtab_frags) = + match htab_search sem.Semant.ctxt_native_provided SEG_data with + None -> ([], []) + | Some etab -> + Hashtbl.fold + begin + fun name fix x -> + let (strtab_frags, symtab_frags) = x in + let (str, sym) = rodata_sym name STB_GLOBAL fix in + (str :: strtab_frags, + sym :: symtab_frags) + end + etab + ([],[]) + in + + (* Emit rodata fragments (possibly named). *) + let (rodata_strtab_frags, + rodata_symtab_frags, + rodata_body_frags) = + Hashtbl.fold + (frags_of_symbol rodata_sym STB_GLOBAL) + rodata_frags + (rodata_strtab_frags, rodata_symtab_frags, []) + in + + + let (data_strtab_frags, + data_symtab_frags, + data_body_frags) = + Hashtbl.fold (frags_of_symbol data_sym STB_GLOBAL) data_frags ([],[],[]) + in + + let (_, + require_strtab_frags, + require_symtab_frags, + plt_frags, + got_plt_frags, + rela_plt_frags) = + Hashtbl.fold (frags_of_require_symbol require_sym STB_GLOBAL) + required_fixups + (1,[],[],[plt0_frag],[got_prefix],[]) + in + let require_symtab_frags = List.rev require_symtab_frags in + let plt_frags = List.rev plt_frags in + let got_plt_frags = List.rev got_plt_frags in + let rela_plt_frags = List.rev rela_plt_frags in + + let dynamic_needed_strtab_frags = + Array.make (Array.length needed_libs) MARK + in + + let dynamic_frags = + let dynamic_needed_frags = Array.make (Array.length needed_libs) MARK in + for i = 0 to (Array.length needed_libs) - 1 do + let fixup = + new_fixup ("needed library name fixup: " ^ needed_libs.(i)) + in + dynamic_needed_frags.(i) <- + elf32_dyn_frag (DT_NEEDED, SUB (M_POS fixup, + M_POS dynstr_section_fixup)); + dynamic_needed_strtab_frags.(i) <- + DEF (fixup, ZSTRING needed_libs.(i)) + done; + (SEQ [| + SEQ dynamic_needed_frags; + elf32_dyn_frag (DT_STRTAB, M_POS dynstr_section_fixup); + elf32_dyn_frag (DT_STRSZ, M_SZ dynstr_section_fixup); + + elf32_dyn_frag (DT_SYMTAB, M_POS dynsym_section_fixup); + elf32_dyn_frag (DT_SYMENT, IMM elf32_symsize); + + elf32_dyn_frag (DT_HASH, M_POS hash_section_fixup); + elf32_dyn_frag (DT_PLTGOT, M_POS got_plt_section_fixup); + + elf32_dyn_frag (DT_PLTREL, IMM (elf32_num_of_dyn_tag DT_RELA)); + elf32_dyn_frag (DT_PLTRELSZ, M_SZ rela_plt_section_fixup); + elf32_dyn_frag (DT_JMPREL, M_POS rela_plt_section_fixup); + + elf32_dyn_frag (DT_NULL, IMM 0L) + |]) + in + + let null_strtab_fixup = new_fixup "null dynstrtab entry" in + let null_strtab_frag = DEF (null_strtab_fixup, ZSTRING "") in + let null_symtab_frag = (symbol + ~string_table_fixup: dynstr_section_fixup + ~name_string_fixup: null_strtab_fixup + ~sym_target_fixup: None + ~st_bind: STB_LOCAL + ~st_type: STT_NOTYPE + ~st_shndx: 0L) in + + let dynsym_frags = (null_symtab_frag :: + (require_symtab_frags @ + global_text_symtab_frags @ + local_text_symtab_frags @ + rodata_symtab_frags @ + data_symtab_frags)) + in + + let dynstr_frags = (null_strtab_frag :: + (require_strtab_frags @ + global_text_strtab_frags @ + local_text_strtab_frags @ + rodata_strtab_frags @ + data_strtab_frags @ + (Array.to_list dynamic_needed_strtab_frags))) + in + + let interp_section = + DEF (interp_section_fixup, ZSTRING "/lib/ld-linux.so.2") + in + + let text_section = + DEF (text_section_fixup, + SEQ (Array.of_list text_body_frags)) + in + let rodata_section = + DEF (rodata_section_fixup, + SEQ (Array.of_list rodata_body_frags)) + in + let data_section = + DEF (data_section_fixup, + SEQ (Array.of_list data_body_frags)) + in + let bss_section = + DEF (bss_section_fixup, + SEQ [| |]) + in + let dynsym_section = + DEF (dynsym_section_fixup, + SEQ (Array.of_list dynsym_frags)) + in + let dynstr_section = + DEF (dynstr_section_fixup, + SEQ (Array.of_list dynstr_frags)) + in + + let hash_section = + let n_syms = !n_syms in + + DEF (hash_section_fixup, + (* Worst hashtable ever: one chain. *) + SEQ [| + WORD (TY_u32, IMM 1L); (* nbucket *) + WORD (TY_u32, (* nchain *) + IMM (Int64.of_int n_syms)); + WORD (TY_u32, IMM 1L); (* bucket 0 => symbol 1. *) + SEQ + begin + Array.init + n_syms + (fun i -> + let next = (* chain[i] => if last then 0 else i+1 *) + if i > 0 && i < (n_syms-1) + then Int64.of_int (i+1) + else 0L + in + WORD (TY_u32, IMM next)) + end; + |]) + in + + let plt_section = + DEF (plt_section_fixup, + SEQ (Array.of_list plt_frags)) + in + + let got_plt_section = + DEF (got_plt_section_fixup, + SEQ (Array.of_list got_plt_frags)) + in + + let rela_plt_section = + DEF (rela_plt_section_fixup, + SEQ (Array.of_list rela_plt_frags)) + in + + let dynamic_section = + DEF (dynamic_section_fixup, dynamic_frags) + in + + let note_rust_section = + DEF (note_rust_section_fixup, + (Asm.note_rust_frags crate.node.Ast.crate_meta)) + in + + + let page_alignment = 0x1000 in + + let align_both i = + ALIGN_FILE (page_alignment, + (ALIGN_MEM (page_alignment, i))) + in + + let def_aligned f i = + align_both + (SEQ [| DEF(f,i); + (align_both MARK)|]) + in + + let debug_aranges_section = + def_aligned + sem.Semant.ctxt_debug_aranges_fixup + dwarf.Dwarf.debug_aranges + in + let debug_pubnames_section = + def_aligned + sem.Semant.ctxt_debug_pubnames_fixup + dwarf.Dwarf.debug_pubnames + in + let debug_info_section = + def_aligned + sem.Semant.ctxt_debug_info_fixup + dwarf.Dwarf.debug_info + in + let debug_abbrev_section = + def_aligned + sem.Semant.ctxt_debug_abbrev_fixup + dwarf.Dwarf.debug_abbrev + in + let debug_line_section = + def_aligned + sem.Semant.ctxt_debug_line_fixup + dwarf.Dwarf.debug_line + in + let debug_frame_section = + def_aligned sem.Semant.ctxt_debug_frame_fixup dwarf.Dwarf.debug_frame + in + + let load_address = 0x0804_8000L in + + SEQ + [| + MEMPOS load_address; + ALIGN_FILE + (segment_2_align, + DEF + (segment_2_fixup, + SEQ + [| + DEF (sem.Semant.ctxt_image_base_fixup, MARK); + elf_header; + ALIGN_FILE + (segment_0_align, + DEF + (segment_0_fixup, + SEQ + [| + DEF (program_header_table_fixup, + program_header_table); + |])); + ALIGN_FILE + (segment_1_align, + DEF (segment_1_fixup, interp_section)); + text_section; + rodata_section; + dynsym_section; + dynstr_section; + hash_section; + plt_section; + rela_plt_section; + debug_aranges_section; + debug_pubnames_section; + debug_info_section; + debug_abbrev_section; + debug_line_section; + debug_frame_section; + |])); + ALIGN_FILE + (segment_3_align, + DEF + (segment_3_fixup, + SEQ + [| + data_section; + got_plt_section; + bss_section; + ALIGN_FILE + (segment_4_align, + DEF (segment_4_fixup, + dynamic_section)); + ALIGN_FILE + (segment_5_align, + DEF (segment_5_fixup, + note_rust_section)); + |])); + DEF (shstrtab_section_fixup, + shstrtab_section); + DEF (section_header_table_fixup, + section_header_table); + |] +;; + +let emit_file + (sess:Session.sess) + (crate:Ast.crate) + (code:Asm.frag) + (data:Asm.frag) + (sem:Semant.ctxt) + (dwarf:Dwarf.debug_records) + : unit = + + let text_frags = Hashtbl.create 4 in + let rodata_frags = Hashtbl.create 4 in + let data_frags = Hashtbl.create 4 in + let required_fixups = Hashtbl.create 4 in + + (* + * Startup on elf-linux is more complex than in win32. It's + * thankfully documented in some detail around the net. + * + * - The elf entry address is for _start. + * + * - _start pushes: + * + * eax (should be zero) + * esp (holding the kernel-provided stack end) + * edx (address of _rtld_fini) + * address of _fini + * address of _init + * ecx (argv) + * esi (argc) + * address of main + * + * and then calls __libc_start_main@plt. + * + * - This means any sensible binary has a PLT. Fun. So + * We call into the PLT, which itself is just a bunch + * of indirect jumps through slots in the GOT, and wind + * up in __libc_start_main. Which calls _init, then + * essentially exit(main(argc,argv)). + *) + + + let init_fixup = new_fixup "_init function entry" in + let fini_fixup = new_fixup "_fini function entry" in + let (start_fixup, rust_start_fixup) = + if sess.Session.sess_library_mode + then (None, None) + else (Some (new_fixup "start function entry"), + Some (Semant.require_native sem REQUIRED_LIB_rustrt "rust_start")) + in + let libc_start_main_fixup = new_fixup "__libc_start_main@plt stub" in + + let start_fn _ = + let start_fixup = + match start_fixup with + None -> bug () "missing start fixup in non-library mode" + | Some s -> s + in + let e = X86.new_emitter_without_vregs () in + let push_r32 r = Il.emit e + (Il.Push (Il.Cell (Il.Reg (Il.Hreg r, Il.ValTy Il.Bits32)))) + in + let push_pos32 = X86.push_pos32 e in + + Il.emit e (Il.unary Il.UMOV (X86.rc X86.ebp) (X86.immi 0L)); + Il.emit e (Il.Pop (X86.rc X86.esi)); + Il.emit e (Il.unary Il.UMOV (X86.rc X86.ecx) (X86.ro X86.esp)); + Il.emit e (Il.binary Il.AND + (X86.rc X86.esp) (X86.ro X86.esp) + (X86.immi 0xfffffffffffffff0L)); + + push_r32 X86.eax; + push_r32 X86.esp; + push_r32 X86.edx; + push_pos32 fini_fixup; + push_pos32 init_fixup; + push_r32 X86.ecx; + push_r32 X86.esi; + push_pos32 start_fixup; + Il.emit e (Il.call + (Il.Reg (Il.Hreg X86.eax, Il.ValTy Il.Bits32)) + (Il.direct_code_ptr libc_start_main_fixup)); + X86.frags_of_emitted_quads sess e + in + + let do_nothing_fn _ = + let e = X86.new_emitter_without_vregs () in + Il.emit e Il.Ret; + X86.frags_of_emitted_quads sess e + in + + let main_fn _ = + match (start_fixup, rust_start_fixup, sem.Semant.ctxt_main_fn_fixup) with + (None, _, _) + | (_, None, _) + | (_, _, None) -> MARK + | (Some start_fixup, + Some rust_start_fixup, + Some main_fn_fixup) -> + let e = X86.new_emitter_without_vregs () in + X86.objfile_start e + ~start_fixup + ~rust_start_fixup + ~main_fn_fixup + ~crate_fixup: sem.Semant.ctxt_crate_fixup + ~indirect_start: false; + X86.frags_of_emitted_quads sess e + in + + let needed_libs = + [| + "libc.so.6"; + "librustrt.so" + |] + in + + let _ = + if not sess.Session.sess_library_mode + then + begin + htab_put text_frags (Some "_start") (start_fn()); + htab_put text_frags (Some "_init") + (DEF (init_fixup, do_nothing_fn())); + htab_put text_frags (Some "_fini") + (DEF (fini_fixup, do_nothing_fn())); + htab_put text_frags (Some "main") (main_fn ()); + htab_put required_fixups "__libc_start_main" libc_start_main_fixup; + end; + htab_put text_frags None code; + htab_put rodata_frags None data; + + Hashtbl.iter + begin + fun _ tab -> + Hashtbl.iter + begin + fun name fixup -> + htab_put required_fixups name fixup + end + tab + end + sem.Semant.ctxt_native_required + in + let all_frags = + elf32_linux_x86_file + ~sess + ~crate + ~entry_name: "_start" + ~text_frags + ~data_frags + ~dwarf + ~sem + ~rodata_frags + ~required_fixups + ~needed_libs + in + write_out_frag sess true all_frags +;; + +let elf_magic = "\x7fELF";; + +let sniff + (sess:Session.sess) + (filename:filename) + : asm_reader option = + try + let stat = Unix.stat filename in + if (stat.Unix.st_kind = Unix.S_REG) && + (stat.Unix.st_size > 4) + then + let ar = new_asm_reader sess filename in + let _ = log sess "sniffing ELF file" in + if (ar.asm_get_zstr_padded 4) = elf_magic + then (ar.asm_seek 0; Some ar) + else None + else + None + with + _ -> None +;; + +let get_sections + (sess:Session.sess) + (ar:asm_reader) + : (string,(int*int)) Hashtbl.t = + let sects = Hashtbl.create 0 in + let _ = log sess "reading sections" in + let elf_id = ar.asm_get_zstr_padded 4 in + let _ = assert (elf_id = elf_magic) in + + let _ = ar.asm_seek 0x10 in + let _ = ar.asm_adv_u16 () in (* e_type *) + let _ = ar.asm_adv_u16 () in (* e_machine *) + let _ = ar.asm_adv_u32 () in (* e_version *) + let _ = ar.asm_adv_u32 () in (* e_entry *) + let _ = ar.asm_adv_u32 () in (* e_phoff *) + let e_shoff = ar.asm_get_u32 () in (* e_shoff *) + let _ = ar.asm_adv_u32 () in (* e_flags *) + let _ = ar.asm_adv_u16 () in (* e_ehsize *) + let _ = ar.asm_adv_u16 () in (* e_phentsize *) + let _ = ar.asm_adv_u16 () in (* e_phnum *) + let e_shentsize = ar.asm_get_u16 () in + let e_shnum = ar.asm_get_u16 () in + let e_shstrndx = ar.asm_get_u16 () in + let _ = log sess + "%d ELF section headers, %d bytes each, starting at 0x%x" + e_shnum e_shentsize e_shoff + in + let _ = log sess "section %d is .shstrtab" e_shstrndx in + + let read_section_hdr n = + let _ = ar.asm_seek (e_shoff + n * e_shentsize) in + let str_off = ar.asm_get_u32() in + let _ = ar.asm_adv_u32() in (* sh_type *) + let _ = ar.asm_adv_u32() in (* sh_flags *) + let _ = ar.asm_adv_u32() in (* sh_addr *) + let off = ar.asm_get_u32() in (* sh_off *) + let size = ar.asm_get_u32() in (* sh_size *) + let _ = ar.asm_adv_u32() in (* sh_link *) + let _ = ar.asm_adv_u32() in (* sh_info *) + let _ = ar.asm_adv_u32() in (* sh_addralign *) + let _ = ar.asm_adv_u32() in (* sh_entsize *) + (str_off, off, size) + in + + let (_, str_base, _) = read_section_hdr e_shstrndx in + + let _ = ar.asm_seek e_shoff in + for i = 0 to (e_shnum - 1) do + let (str_off, off, size) = read_section_hdr i in + let _ = ar.asm_seek (str_base + str_off) in + let name = ar.asm_get_zstr() in + log sess "section %d: %s, size %d, offset 0x%x" i name size off; + Hashtbl.add sects name (off, size); + done; + sects +;; + + +(* + * Local Variables: + * fill-column: 78; + * indent-tabs-mode: nil + * buffer-file-coding-system: utf-8-unix + * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'"; + * End: + *) diff --git a/src/boot/be/il.ml b/src/boot/be/il.ml new file mode 100644 index 00000000..e095e627 --- /dev/null +++ b/src/boot/be/il.ml @@ -0,0 +1,1135 @@ +open Common;; + +(* FIXME (issue #1): thread a session object through this eventually. *) +let log_iltypes = ref false;; + +(* IL type system, very rudimentary. *) + +type bits = + Bits8 + | Bits16 + | Bits32 + | Bits64 +;; + +type scalar_ty = + ValTy of bits + | AddrTy of referent_ty + +and referent_ty = + ScalarTy of scalar_ty + | StructTy of referent_ty array + | UnionTy of referent_ty array + | ParamTy of ty_param_idx (* Thing of current-frame type-param #n *) + | OpaqueTy (* Unknown memory-resident thing. *) + | CodeTy (* Executable machine code. *) + | NilTy (* 0 bits of space. *) +;; + +let (voidptr_t:scalar_ty) = AddrTy OpaqueTy;; +let (codeptr_t:scalar_ty) = AddrTy CodeTy;; + +(* Operands. *) + +type vreg = int ;; +type hreg = int ;; +type label = int ;; +type spill = int ;; + +type reg = + Vreg of vreg + | Hreg of hreg +;; + +type mem = + Abs of Asm.expr64 + | RegIn of (reg * (Asm.expr64 option)) + | Spill of spill +;; + +type typed_reg = (reg * scalar_ty);; +type typed_mem = (mem * referent_ty);; +type typed_imm = (Asm.expr64 * ty_mach);; +type typed_imm_ptr = (fixup * referent_ty);; + +type cell = + Reg of typed_reg + | Mem of typed_mem +;; + +(* + * ImmPtr (a, rty) can be assigned to anything of scalar_ty + * AddrTy rty; the difference is that ImmAddr carries its value + * so can be used in cases where we want to have an immediate + * address constant-propagated through the code to the backend. + *) +type operand = + Cell of cell + | Imm of typed_imm + | ImmPtr of typed_imm_ptr +;; + + +type code = + CodeLabel of label (* Index into current quad block. *) + | CodePtr of operand + | CodeNone +;; + +(* NB: for the most part, we let the register allocator assign spills + * from vregs, and we permanently allocate aliased slots to stack + * locations by static aliasing information early, in layout. + * + * The one awkward case this doesn't handle is when someone tries to + * pass a literal-atom to an alias-slot. This *requires* a memory slot + * but we only realize it rather late, much later than we'd normally + * have thougt to desugar the literal into a temporary. + * + * So in these cases, we let the trans module explicitly demand a + * "Spill n" operand, which the register allocator mops up before it + * gets started on the vregs. + * + * NOTE: if we were more clever we'd integrate vregs and spills like + * this together along with the general notion of a temporary way back + * at the desugaring stage, and use some kind of size-class + * consolidation so that spills with non-overlapping lifetimes could + * share memory. But we're not that clever yet. + *) + + +(* Helpers. *) + +let direct_code_ptr fix = + (CodePtr (ImmPtr (fix, CodeTy))) +;; + +let cell_referent_ty c = + match c with + Reg (_, st) -> ScalarTy st + | Mem (_, rt) -> rt +;; + +let cell_is_nil c = + match c with + Mem (_, NilTy) -> true + | Reg (_, AddrTy NilTy) -> true + | _ -> false +;; + +let operand_is_nil o = + match o with + Cell c -> cell_is_nil c + | _ -> false +;; + +let mem_off (mem:mem) (off:Asm.expr64) : mem = + let addto e = Asm.ADD (off, e) in + match mem with + Abs e -> Abs (addto e) + | RegIn (r, None) -> RegIn (r, Some off) + | RegIn (r, Some e) -> RegIn (r, Some (addto e)) + | Spill _ -> bug () "Adding offset to spill slot" +;; + +let mem_off_imm (mem:mem) (imm:int64) : mem = + mem_off mem (Asm.IMM imm) +;; + + +(* Quads. *) + +type binop = + ADD | SUB + | IMUL | UMUL + | IDIV | UDIV + | IMOD | UMOD + | AND | OR | XOR + | LSL | LSR | ASR +;; + +type unop = + NEG | NOT + | UMOV | IMOV + | ZERO +;; + +type jmpop = + JE | JNE + | JZ | JNZ (* FIXME: Synonyms with JE/JNE in x86, others? *) + | JL | JLE | JG | JGE (* Signed. *) + | JB | JBE | JA | JAE (* Unsigned. *) + | JC | JNC | JO | JNO + | JMP +;; + +type binary = + { + binary_op: binop; + binary_dst: cell; + binary_lhs: operand; + binary_rhs: operand + } +;; + +type unary = + { + unary_op: unop; + unary_dst: cell; + unary_src: operand + } +;; + +type cmp = + { + cmp_lhs: operand; + cmp_rhs: operand + } +;; + +type lea = + { + lea_dst: cell; + lea_src: operand + } +;; + +type jmp = + { + jmp_op: jmpop; + jmp_targ: code; + } +;; + +type call = + { + call_dst: cell; + call_targ: code + } + +type quad' = + Binary of binary + | Unary of unary + | Lea of lea + | Cmp of cmp + | Jmp of jmp + | Push of operand + | Pop of cell + | Call of call + | Debug (* Debug-break pseudo-instruction. *) + | Enter of fixup (* Enter-fixup-block pseudo-instruction. *) + | Leave (* Leave-fixup-block pseudo-instruction. *) + | Ret (* Return to caller. *) + | Nop (* Keep this quad here, emit CPU nop. *) + | Dead (* Keep this quad but emit nothing. *) + | Regfence (* Clobber all hregs. *) + | End (* Space past the end of quads to emit. *) +;; + +type quad = + { quad_fixup: fixup option; + quad_implicits: label list; + quad_body: quad'; } + +type quads = quad array ;; + +(* Query functions. *) + +let cell_is_scalar (c:cell) : bool = + match c with + Reg (_, _) -> true + | Mem (_, ScalarTy _) -> true + | _ -> false +;; + + +let bits_of_ty_mach (tm:ty_mach) : bits = + match tm with + | TY_u8 -> Bits8 + | TY_i8 -> Bits8 + | TY_u16 -> Bits16 + | TY_i16 -> Bits16 + | TY_u32 -> Bits32 + | TY_i32 -> Bits32 + | TY_u64 -> Bits64 + | TY_i64 -> Bits64 + | TY_f32 -> Bits32 + | TY_f64 -> Bits64 +;; + +let cell_scalar_ty (c:cell) : scalar_ty = + match c with + Reg (_, st) -> st + | Mem (_, ScalarTy st) -> st + | _ -> bug () "mem of non-scalar in Il.cell_scalar_ty" +;; + +let operand_scalar_ty (op:operand) : scalar_ty = + match op with + Cell c -> cell_scalar_ty c + | Imm (_, t) -> ValTy (bits_of_ty_mach t) + | ImmPtr (_, t) -> AddrTy t +;; + + +let scalar_ty_bits (word_bits:bits) (st:scalar_ty) : bits = + match st with + ValTy bits -> bits + | AddrTy _ -> word_bits +;; + +let cell_bits (word_bits:bits) (c:cell) : bits = + match c with + Reg (_, st) -> scalar_ty_bits word_bits st + | Mem (_, ScalarTy st) -> scalar_ty_bits word_bits st + | Mem _ -> bug () "mem of non-scalar in Il.cell_bits" +;; + +let operand_bits (word_bits:bits) (op:operand) : bits = + match op with + Cell cell -> cell_bits word_bits cell + | Imm (_, tm) -> bits_of_ty_mach tm + | ImmPtr _ -> word_bits +;; + +let bits_size (bits:bits) : int64 = + match bits with + Bits8 -> 1L + | Bits16 -> 2L + | Bits32 -> 4L + | Bits64 -> 8L +;; + +let bits_align (bits:bits) : int64 = + match bits with + Bits8 -> 1L + | Bits16 -> 2L + | Bits32 -> 4L + | Bits64 -> 8L +;; + +let scalar_ty_size (word_bits:bits) (st:scalar_ty) : int64 = + bits_size (scalar_ty_bits word_bits st) +;; + +let scalar_ty_align (word_bits:bits) (st:scalar_ty) : int64 = + bits_align (scalar_ty_bits word_bits st) +;; + +let rec referent_ty_layout (word_bits:bits) (rt:referent_ty) : (size * size) = + match rt with + ScalarTy st -> (SIZE_fixed (scalar_ty_size word_bits st), + SIZE_fixed (scalar_ty_align word_bits st)) + | StructTy rts -> + begin + let accum (off,align) rt : (size * size) = + let (elt_size, elt_align) = referent_ty_layout word_bits rt in + let elt_off = align_sz elt_align off in + (add_sz elt_off elt_size, max_sz elt_align align) + in + Array.fold_left accum (SIZE_fixed 0L, SIZE_fixed 1L) rts + end + | UnionTy rts -> + begin + let accum (sz,align) rt : (size * size) = + let (elt_size, elt_align) = referent_ty_layout word_bits rt in + (max_sz sz elt_size, max_sz elt_align align) + in + Array.fold_left accum (SIZE_fixed 0L, SIZE_fixed 1L) rts + end + | OpaqueTy -> bug () "opaque ty in referent_ty_layout" + | CodeTy -> bug () "code ty in referent_ty_layout" + | ParamTy i -> (SIZE_param_size i, SIZE_param_align i) + | NilTy -> (SIZE_fixed 0L, SIZE_fixed 1L) + +and referent_ty_size (word_bits:bits) (rt:referent_ty) : size = + (fst (referent_ty_layout word_bits rt)) + +and referent_ty_align (word_bits:bits) (rt:referent_ty) : size = + (snd (referent_ty_layout word_bits rt)) + +;; + +let get_element_offset + (word_bits:bits) + (elts:referent_ty array) + (i:int) + : size = + let elts_before = Array.sub elts 0 i in + let elt_rty = elts.(i) in + let elts_before_size = referent_ty_size word_bits (StructTy elts_before) in + let elt_align = referent_ty_align word_bits elt_rty in + let elt_off = align_sz elt_align elts_before_size in + elt_off +;; + +(* Processor. *) + +type quad_processor = + { qp_reg: (quad_processor -> reg -> reg); + qp_mem: (quad_processor -> mem -> mem); + qp_cell_read: (quad_processor -> cell -> cell); + qp_cell_write: (quad_processor -> cell -> cell); + qp_code: (quad_processor -> code -> code); + qp_op: (quad_processor -> operand -> operand); } +;; + +let identity_processor = + let qp_cell = (fun qp c -> match c with + Reg (r, b) -> Reg (qp.qp_reg qp r, b) + | Mem (a, b) -> Mem (qp.qp_mem qp a, b)) + in + { qp_reg = (fun _ r -> r); + qp_mem = (fun qp a -> match a with + RegIn (r, o) -> RegIn (qp.qp_reg qp r, o) + | Abs _ + | Spill _ -> a); + qp_cell_read = qp_cell; + qp_cell_write = qp_cell; + qp_code = (fun qp c -> match c with + CodePtr op -> CodePtr (qp.qp_op qp op) + | CodeLabel _ + | CodeNone -> c); + qp_op = (fun qp op -> match op with + Cell c -> Cell (qp.qp_cell_read qp c) + | ImmPtr _ -> op + | Imm _ -> op) } +;; + +let process_quad (qp:quad_processor) (q:quad) : quad = + { q with + quad_body = match q.quad_body with + Binary b -> + Binary { b with + binary_dst = qp.qp_cell_write qp b.binary_dst; + binary_lhs = qp.qp_op qp b.binary_lhs; + binary_rhs = qp.qp_op qp b.binary_rhs } + | Unary u -> + Unary { u with + unary_dst = qp.qp_cell_write qp u.unary_dst; + unary_src = qp.qp_op qp u.unary_src } + + | Lea le -> + Lea { lea_dst = qp.qp_cell_write qp le.lea_dst; + lea_src = qp.qp_op qp le.lea_src } + + | Cmp c -> + Cmp { cmp_lhs = qp.qp_op qp c.cmp_lhs; + cmp_rhs = qp.qp_op qp c.cmp_rhs } + + | Jmp j -> + Jmp { j with + jmp_targ = qp.qp_code qp j.jmp_targ } + + | Push op -> + Push (qp.qp_op qp op) + + | Pop c -> + Pop (qp.qp_cell_write qp c) + + | Call c -> + Call { call_dst = qp.qp_cell_write qp c.call_dst; + call_targ = qp.qp_code qp c.call_targ } + + | Ret -> Ret + | Nop -> Nop + | Debug -> Debug + | Regfence -> Regfence + | Enter f -> Enter f + | Leave -> Leave + | Dead -> Dead + | End -> End } +;; + +let visit_quads (qp:quad_processor) (qs:quads) : unit = + Array.iter (fun x ->ignore ( process_quad qp x); ()) qs +;; + +let process_quads (qp:quad_processor) (qs:quads) : quads = + Array.map (process_quad qp) qs +;; + +let rewrite_quads (qp:quad_processor) (qs:quads) : unit = + for i = 0 to ((Array.length qs) - 1) do + qs.(i) <- process_quad qp qs.(i) + done +;; + + +(* A little partial-evaluator to help lowering sizes. *) + +let rec size_to_expr64 (a:size) : Asm.expr64 option = + let binary a b f = + match (size_to_expr64 a, size_to_expr64 b) with + (Some a, Some b) -> Some (f a b) + | _ -> None + in + match a with + SIZE_fixed i -> Some (Asm.IMM i) + | SIZE_fixup_mem_sz f -> Some (Asm.M_SZ f) + | SIZE_fixup_mem_pos f -> Some (Asm.M_POS f) + | SIZE_rt_neg s -> + begin + match (size_to_expr64 s) with + None -> None + | Some s -> Some (Asm.NEG s) + end + | SIZE_rt_add (a, b) -> binary a b (fun a b -> Asm.ADD (a,b)) + | SIZE_rt_mul (a, b) -> binary a b (fun a b -> Asm.MUL (a,b)) + | SIZE_rt_max (a, b) -> binary a b (fun a b -> Asm.MAX (a,b)) + | SIZE_rt_align (a, b) -> binary a b (fun a b -> Asm.ALIGN (a,b)) + | _ -> None +;; + + +(* Formatters. *) + +let string_of_bits (b:bits) : string = + match b with + Bits8 -> "b8" + | Bits16 -> "b16" + | Bits32 -> "b32" + | Bits64 -> "b64" +;; + +let rec string_of_scalar_ty (s:scalar_ty) : string = + match s with + ValTy b -> (string_of_bits b) + | AddrTy r -> (string_of_referent_ty r) ^ "*" + +and string_of_referent_ty (r:referent_ty) : string = + match r with + ScalarTy s -> (string_of_scalar_ty s) + | StructTy rs -> + Printf.sprintf "[%s]" + (String.concat "," + (Array.to_list (Array.map string_of_referent_ty rs))) + | UnionTy rs -> + Printf.sprintf "(%s)" + (String.concat "|" + (Array.to_list (Array.map string_of_referent_ty rs))) + | ParamTy i -> Printf.sprintf "#%d" i + | OpaqueTy -> "?" + | CodeTy -> "!" + | NilTy -> "()" +;; + + +type hreg_formatter = hreg -> string;; + +let string_of_reg (f:hreg_formatter) (r:reg) : string = + match r with + Vreg i -> Printf.sprintf "" i + | Hreg i -> f i +;; + +let rec string_of_expr64 (e64:Asm.expr64) : string = + let bin op a b = + Printf.sprintf "(%s %s %s)" (string_of_expr64 a) op (string_of_expr64 b) + in + let bini op a b = + Printf.sprintf "(%s %s %d)" (string_of_expr64 a) op b + in + match e64 with + Asm.IMM i when (i64_lt i 0L) -> Printf.sprintf "-0x%Lx" (Int64.neg i) + | Asm.IMM i -> Printf.sprintf "0x%Lx" i + | Asm.ADD (a,b) -> bin "+" a b + | Asm.SUB (a,b) -> bin "-" a b + | Asm.MUL (a,b) -> bin "*" a b + | Asm.DIV (a,b) -> bin "/" a b + | Asm.REM (a,b) -> bin "%" a b + | Asm.MAX (a,b) -> + Printf.sprintf "(max %s %s)" + (string_of_expr64 a) (string_of_expr64 b) + | Asm.ALIGN (a,b) -> + Printf.sprintf "(align %s %s)" + (string_of_expr64 a) (string_of_expr64 b) + | Asm.SLL (a,b) -> bini "<<" a b + | Asm.SLR (a,b) -> bini ">>" a b + | Asm.SAR (a,b) -> bini ">>>" a b + | Asm.AND (a,b) -> bin "&" a b + | Asm.XOR (a,b) -> bin "xor" a b + | Asm.OR (a,b) -> bin "|" a b + | Asm.NOT a -> Printf.sprintf "(not %s)" (string_of_expr64 a) + | Asm.NEG a -> Printf.sprintf "-%s" (string_of_expr64 a) + | Asm.F_POS f -> Printf.sprintf "<%s>.fpos" f.fixup_name + | Asm.F_SZ f -> Printf.sprintf "<%s>.fsz" f.fixup_name + | Asm.M_POS f -> Printf.sprintf "<%s>.mpos" f.fixup_name + | Asm.M_SZ f -> Printf.sprintf "<%s>.msz" f.fixup_name + | Asm.EXT _ -> "??ext??" +;; + +let string_of_off (e:Asm.expr64 option) : string = + match e with + None -> "" + | Some (Asm.IMM i) when (i64_lt i 0L) -> + Printf.sprintf " - 0x%Lx" (Int64.neg i) + | Some e' -> " + " ^ (string_of_expr64 e') +;; + +let string_of_mem (f:hreg_formatter) (a:mem) : string = + match a with + Abs e -> + Printf.sprintf "[%s]" (string_of_expr64 e) + | RegIn (r, off) -> + Printf.sprintf "[%s%s]" (string_of_reg f r) (string_of_off off) + | Spill i -> + Printf.sprintf "[]" i +;; +let string_of_cell (f:hreg_formatter) (c:cell) : string = + match c with + Reg (r,ty) -> + if !log_iltypes + then + Printf.sprintf "%s:%s" (string_of_reg f r) (string_of_scalar_ty ty) + else + Printf.sprintf "%s" (string_of_reg f r) + | Mem (a,ty) -> + if !log_iltypes + then + Printf.sprintf "%s:%s" + (string_of_mem f a) (string_of_referent_ty ty) + else + Printf.sprintf "%s" (string_of_mem f a) +;; + +let string_of_operand (f:hreg_formatter) (op:operand) : string = + match op with + Cell c -> string_of_cell f c + | ImmPtr (f, ty) -> + if !log_iltypes + then + Printf.sprintf "$<%s>.mpos:%s*" + f.fixup_name (string_of_referent_ty ty) + else + Printf.sprintf "$<%s>.mpos" f.fixup_name + | Imm (i, ty) -> + if !log_iltypes + then + Printf.sprintf "$%s:%s" (string_of_expr64 i) (string_of_ty_mach ty) + else + Printf.sprintf "$%s" (string_of_expr64 i) +;; + + +let string_of_code (f:hreg_formatter) (c:code) : string = + match c with + CodeLabel lab -> Printf.sprintf "